From: Carsten Dominik Date: Thu, 30 Aug 2007 09:49:14 +0000 (+0000) Subject: (org-export-visible): Fix drawers before export. X-Git-Tag: emacs-pretest-23.0.90~11194 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=374585c99c01e496251798d2d6aeeb7d8eeddcb2;p=emacs.git (org-export-visible): Fix drawers before export. (org-do-sort): Allow sorting by priority. (org-agenda-files): Ignore non-existing files. (org-agenda-skip-unavailable-files): New variable. (org-ellipsis): All a face as value. (org-mode): Interprete the face value of `org-ellipsis'. (org-archive-save-context-info): New option. (org-archive-subtree): Store context info in archived entry. (org-fast-tag-selection-can-set-todo-state): New variable. (org-fast-tag-selection): Allow setting TODO states through this interface. (org-cycle): Docstring updated. (org-todo-keyword-faces): New option. (org-get-todo-face): New function. (org-set-font-lock-defaults, org-agenda-highlight-todo): Use `org-get-todo-face'. (org-switch-to-buffer-other-window): New function. (org-table-edit-field, org-table-show-reference) (org-table-edit-formulas, org-add-log-note) (org-fast-tag-selection, org-agenda, org-prepare-agenda) (org-timeline): Use `org-switch-to-buffer-other-window' instead of `switch-to-buffer-other-window' to make sure that the temporary windows show up on the current frame. (org-mhe-get-message-real-folder, org-batch-store-agenda-views) (org-get-entries-from-diary, org-replace-region-by-html): Don't allow pop-up frames. (org-agenda-get-deadlines, org-agenda-get-scheduled): Fixed problems with time-of-day. (org-export-get-title-from-subtree): New function. (org-agenda-get-scheduled, org-agenda-get-deadlines): Fix problems with listing items that are DONE. (org-change-tag-in-region): New command. (org-agenda-skip-scheduled-if-done) (org-agenda-skip-deadline-if-done): Docstring clarified. (org-mode): Hide drawers on startup. (org-get-todo-face): New function. (org-todo-keyword-faces): New option. --- diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index e6f289a4a6d..98874754664 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 5.05 +;; Version: 5.07 ;; ;; This file is part of GNU Emacs. ;; @@ -83,7 +83,7 @@ ;;; Version -(defconst org-version "5.05" +(defconst org-version "5.07" "The version number of the file org.el.") (defun org-version () (interactive) @@ -236,11 +236,13 @@ Or return the original if not disputed." (defcustom org-ellipsis nil "The ellipsis to use in the Org-mode outline. When nil, just use the standard three dots. When a string, use that instead, -and just in Org-mode (which will then use its own display table). +When a face, use the standart 3 dots, but with the specified face. +The change affects only Org-mode (which will then use its own display table). Changing this requires executing `M-x org-mode' in a buffer to become effective." :group 'org-startup :type '(choice (const :tag "Default" nil) + (face :tag "Face" :value org-warning) (string :tag "String" :value "...#"))) (defvar org-display-table nil @@ -274,11 +276,6 @@ Changes become only effective after restarting Emacs." :group 'org-keywords :type 'string) -(defcustom org-archived-string "ARCHIVED:" - "String used as the prefix for timestamps logging archiving a TODO entry." - :group 'org-keywords - :type 'string) - (defcustom org-clock-string "CLOCK:" "String used as prefix for timestamps clocking work hours on an item." :group 'org-keywords @@ -428,7 +425,7 @@ the property API." :group 'org-structure :type '(repeat (string :tag "Drawer Name"))) -(defcustom org-cycle-global-at-bob t +(defcustom org-cycle-global-at-bob nil "Cycle globally if cursor is at beginning of buffer and not at a headline. This makes it possible to do global cycling without having to use S-TAB or C-u TAB. For this special case to work, the first line of the buffer @@ -489,19 +486,24 @@ the values `folded', `children', or `subtree'." :tag "Org Edit Structure" :group 'org-structure) - (defcustom org-special-ctrl-a/e nil "Non-nil means `C-a' and `C-e' behave specially in headlines and items. -When set, `C-a' will bring back the cursor to the beginning of the +When t, `C-a' will bring back the cursor to the beginning of the headline text, i.e. after the stars and after a possible TODO keyword. In an item, this will be the position after the bullet. When the cursor is already at that position, another `C-a' will bring it to the beginning of the line. `C-e' will jump to the end of the headline, ignoring the presence of tags in the headline. A second `C-e' will then jump to the true end of the -line, after any tags." +line, after any tags. +When set to the symbol `reversed', the first `C-a' or `C-e' works normally, +and only a directly following, identical keypress will bring the cursor +to the special positions." :group 'org-edit-structure - :type 'boolean) + :type '(choice + (const :tag "off" nil) + (const :tag "after bullet first" t) + (const :tag "border first" reversed))) (if (fboundp 'defvaralias) (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) @@ -714,6 +716,32 @@ use the first keyword in its list that means done." :group 'org-archive :type 'boolean) +(defcustom org-archive-save-context-info '(time file category todo itags) + "Parts of context info that should be stored as properties when archiving. +When a subtree is moved to an archive file, it looses information given by +context, like inherited tags, the category, and possibly also the TODO +state (depending on the variable `org-archive-mark-done'). +This variable can be a list of any of the following symbols: + +time The time of archiving. +file The file where the entry originates. +itags The local tags, in the headline of the subtree. +ltags The tags the subtree inherits from further up the hierarchy. +todo The pre-archive TODO state. +category The category, taken from file name or #+CATEGORY lines. + +For each symbol present in the list, a property will be created in +the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this +information." + :group 'org-archive + :type '(set + (const :tag "File" file) + (const :tag "Category" category) + (const :tag "TODO state" todo) + (const :tag "TODO state" priority) + (const :tag "Inherited tags" itags) + (const :tag "Local tags" ltags))) + (defgroup org-table nil "Options concerning tables in Org-mode." :tag "Org Table" @@ -1480,6 +1508,8 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (defvar org-todo-keywords-1 nil) (make-variable-buffer-local 'org-todo-keywords-1) +(defvar org-todo-tag-alist nil) +(make-variable-buffer-local 'org-todo-tag-alist) (defvar org-todo-keywords-for-agenda nil) (defvar org-done-keywords-for-agenda nil) (defvar org-not-done-keywords nil) @@ -1863,6 +1893,11 @@ agenda file per line." (repeat :tag "List of files" file) (file :tag "Store list in a file\n" :value "~/.agenda_files"))) +(defcustom org-agenda-skip-unavailable-files nil + "t means to just skip non-reachable files in `org-agenda-files'. +Nil means to remove them, after a query, from the list." + :group 'org-agenda + :type 'boolean) (defcustom org-agenda-confirm-kill 1 "When set, remote killing from the agenda buffer needs confirmation. @@ -2111,15 +2146,19 @@ The idea behind this is that such items will appear in the agenda anyway." (defcustom org-agenda-skip-scheduled-if-done nil "Non-nil means don't show scheduled items in agenda when they are done. -This is relevant for the daily/weekly agenda, not for the TODO list." +This is relevant for the daily/weekly agenda, not for the TODO list. And +it applied only to the actualy date of the scheduling. Warnings about +an item with a past scheduling dates are always turned off when the item +is DONE." :group 'org-agenda-skip :type 'boolean) (defcustom org-agenda-skip-deadline-if-done nil "Non-nil means don't show deadines when the corresponding item is done. When nil, the deadline is still shown and should give you a happy feeling. - -This is relevant for the daily/weekly agenda." +This is relevant for the daily/weekly agenda. And it applied only to the +actualy date of the deadline. Warnings about approching and past-due +deadlines are always turned off when the item is DONE." :group 'org-agenda-skip :type 'boolean) @@ -2544,16 +2583,17 @@ This is a property list with the following properties: This path may be relative to the directory where the Org-mode file lives. The default is to put them into the same directory as the Org-mode file. The variable may also be an alist with export types `:html', `:ascii', -`:ical', or `:xoxo' and the corresponding directories. If a directory path -is relative, it is interpreted relative to the directory where the exported -Org-mode files lives." +`:ical', `:LaTeX', or `:xoxo' and the corresponding directories. +If a directory path is relative, it is interpreted relative to the +directory where the exported Org-mode files lives." :group 'org-export-general :type '(choice (directory) (repeat (cons (choice :tag "Type" - (const :html) (const :ascii) (const :ical) (const :xoxo)) + (const :html) (const :LaTeX) + (const :ascii) (const :ical) (const :xoxo)) (directory))))) (defcustom org-export-language-setup @@ -3157,7 +3197,7 @@ Use customize to modify this, or restart Emacs after changing it." '(("*" bold "" "") ("/" italic "" "") ("_" underline "" "") - ("=" shadow "" "") + ("=" org-code "" "") ("+" (:strike-through t) "" "") ) "Special syntax for emphasized text. @@ -3418,6 +3458,18 @@ This face is only used if `org-fontify-done-headline' is set. If applies to the part of the headline after the DONE keyword." :group 'org-faces) +(defcustom org-todo-keyword-faces nil + "Faces for specific TODO keywords. +This is a list of cons cells, with TODO keywords in the car +and faces in the cdr. The face can be a symbol, or a property +list of attributes, like (:foreground \"blue\" :weight bold :underline t)." + :group 'org-faces + :group 'org-todo + :type '(repeat + (cons + (string :tag "keyword") + (sexp :tag "face")))) + (defface org-table ;; font-lock-function-name-face (org-compatible-face '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) @@ -3439,6 +3491,20 @@ to the part of the headline after the DONE keyword." "Face for formulas." :group 'org-faces) +(defface org-code + (org-compatible-face + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face for fixed-with text like code snippets." + :group 'org-faces + :version "22.1") + (defface org-agenda-structure ;; font-lock-function-name-face (org-compatible-face '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) @@ -3665,6 +3731,7 @@ means to push this value onto the list in the variable.") (when (org-mode-p) (org-set-local 'org-todo-kwd-alist nil) (org-set-local 'org-todo-keywords-1 nil) + (org-set-local 'org-todo-tag-alist nil) (org-set-local 'org-done-keywords nil) (org-set-local 'org-todo-heads nil) (org-set-local 'org-todo-sets nil) @@ -3673,8 +3740,8 @@ means to push this value onto the list in the variable.") "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY"))) (splitre "[ \t]+") - kwds key value cat arch tags const links hw dws tail sep kws1 prio - props) + kwds kws0 kwsa key value cat arch tags const links hw dws + tail sep kws1 prio props) (save-excursion (save-restriction (widen) @@ -3747,13 +3814,25 @@ means to push this value onto the list in the variable.") (let (inter kws) (while (setq kws (pop kwds)) (setq inter (pop kws) sep (member "|" kws) - kws1 (delete "|" (copy-sequence kws)) + kws0 (delete "|" (copy-sequence kws)) + kwsa nil + kws1 (mapcar (lambda (x) + (if (string-match "\\(.*\\)(\\(.\\))" x) + (progn + (push (cons (match-string 1 x) + (string-to-char + (match-string 2 x))) kwsa) + (match-string 1 x)) + x)) + kws0) + kwsa (if kwsa (append '((:startgroup)) kwsa '((:endgroup)))) hw (car kws1) dws (if sep (cdr sep) (last kws1)) tail (list inter hw (car dws) (org-last dws))) (add-to-list 'org-todo-heads hw 'append) (push kws1 org-todo-sets) (setq org-done-keywords (append org-done-keywords dws nil)) + (setq org-todo-tag-alist (append org-todo-tag-alist kwsa)) (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) (setq org-todo-sets (nreverse org-todo-sets) @@ -3834,28 +3913,25 @@ means to push this value onto the list in the variable.") (concat "\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string - "\\|" org-archived-string "\\|" org-clock-string "\\)" " *[[<]\\([^]>]+\\)[]>]") org-keyword-time-not-clock-regexp (concat "\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string - "\\|" org-archived-string "\\)" " *[[<]\\([^]>]+\\)[]>]") org-maybe-keyword-time-regexp (concat "\\(\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string - "\\|" org-archived-string "\\|" org-clock-string "\\)\\)?" " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") org-planning-or-clock-line-re (concat "\\(?:^[ \t]*\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string "\\|" org-clock-string - "\\|" org-archived-string "\\)\\>\\)") + "\\)\\>\\)") ) (org-set-font-lock-defaults))) @@ -3922,6 +3998,7 @@ This is for getting out of special buffers like remember.") ;; Defined somewhere in this file, but used before definition. (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized +(defvar org-agenda-buffer-name) (defvar org-agenda-undo-list) (defvar org-agenda-pending-undo-list) (defvar org-agenda-overriding-header) @@ -4109,12 +4186,17 @@ The following commands are available: (org-set-local 'line-move-ignore-invisible t)) (org-set-local 'outline-regexp "\\*+ ") (setq outline-level 'org-outline-level) - (when (and org-ellipsis (stringp org-ellipsis) - (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)) + (when (and org-ellipsis + (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) + (fboundp 'make-glyph-code)) (unless org-display-table (setq org-display-table (make-display-table))) - (set-display-table-slot org-display-table - 4 (string-to-vector org-ellipsis)) + (set-display-table-slot + org-display-table 4 + (vconcat (mapcar + (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) + org-ellipsis))) + (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) ;; Calc embedded @@ -4159,6 +4241,7 @@ The following commands are available: (let ((bmp (buffer-modified-p))) (org-table-map-tables 'org-table-align) (set-buffer-modified-p bmp))) + (org-cycle-hide-drawers 'all) (cond ((eq org-startup-folded t) (org-cycle '(4))) @@ -4560,10 +4643,11 @@ between words." (let* ((em org-fontify-emphasized-text) (lk org-activate-links) (org-font-lock-extra-keywords - ;; Headlines (list + ;; Headlines '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1)) (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) + ;; Table lines '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" (1 'org-table)) ;; Links @@ -4576,15 +4660,21 @@ between words." '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) '(org-hide-wide-columns (0 nil append)) ;; TODO lines - (list (concat "^\\*+[ \t]+" org-not-done-regexp) - '(1 'org-todo t)) + (list (concat "^\\*+[ \t]+" org-todo-regexp) + '(1 (org-get-todo-face 1) t)) + ;; DONE + (if org-fontify-done-headline + (list (concat "^[*]+ +\\<\\(" + (mapconcat 'regexp-quote org-done-keywords "\\|") + "\\)\\(.*\\)") + '(2 'org-headline-done t)) + nil) ;; Priorities (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) ;; Special keywords (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-archived-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) ;; Emphasis (if em @@ -4602,25 +4692,13 @@ between words." "\\|" org-quote-string "\\)\\>") '(1 'org-special-keyword t)) '("^#.*" (0 'font-lock-comment-face t)) - ;; DONE - (if org-fontify-done-headline - (list (concat "^[*]+ +\\<\\(" - (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)\\(.*\\)") - '(1 'org-done t) '(2 'org-headline-done t)) - (list (concat "^[*]+ +\\<\\(" - (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)\\>") - '(1 'org-done t))) - ;; Table stuff - '("^[ \t]*\\(:.*\\)" (1 'org-table t)) + ;; Code + '("^[ \t]*\\(:.*\\)" (1 'org-code t)) + ;; Table internals '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) -; '("^[ \t]*| *\\([#!$*_^/]\\) *|" (1 'org-formula t)) '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) ;; Drawers -; (list org-drawer-regexp '(0 'org-drawer t)) -; (list "^[ \t]*:END:" '(0 'org-drawer t)) (list org-drawer-regexp '(0 'org-special-keyword t)) (list "^[ \t]*:END:" '(0 'org-special-keyword t)) ;; Properties @@ -4651,6 +4729,15 @@ between words." ((eq n 2) org-f) (t (if org-level-color-stars-only nil org-f)))) + +(defun org-get-todo-face (kwd) + "Get the right face for a TODO keyword KWD. +If KWD is a number, get the corresponding match group." + (if (numberp kwd) (setq kwd (match-string kwd))) + (or (cdr (assoc kwd org-todo-keyword-faces)) + (and (member kwd org-done-keywords) 'org-done) + 'org-todo)) + (defun org-unfontify-region (beg end &optional maybe_loudly) "Remove fontification and activation overlays from links." (font-lock-default-unfontify-region beg end) @@ -4699,7 +4786,8 @@ between words." `org-cycle-emulate-tab' for details. - Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg." + no headline in line 1, this function will act as if called with prefix arg. + But only if also the variable `org-cycle-global-at-bob' is t." (interactive "P") (let* ((outline-regexp (if (and (org-mode-p) org-cycle-include-plain-lists) @@ -4756,7 +4844,7 @@ between words." (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview)))) - ((and org-drawers + ((and org-drawers org-drawer-regexp (save-excursion (beginning-of-line 1) (looking-at org-drawer-regexp))) @@ -5752,6 +5840,8 @@ WITH-CASE, the sorting considers case as well. With two prefix arguments nentries (if unique (format ", %d duplicates removed" nremoved) "")))) +(defvar org-priority-regexp) ; defined later in the file + (defun org-do-sort (table what &optional with-case sorting-type) "Sort TABLE of WHAT according to SORTING-TYPE. The user will be prompted for the SORTING-TYPE if the call to this @@ -5761,7 +5851,7 @@ the car of the elements of the table. If WITH-CASE is non-nil, the sorting will be case-sensitive." (unless sorting-type (message - "Sort %s: [a]lphabetically [n]umerically [t]ime. A/N/T means reversed:" + "Sort %s: [a]lphabetic. [n]umeric. [t]ime [p]riority. A/N/T/P means reversed:" what) (setq sorting-type (read-char-exclusive))) (let ((dcst (downcase sorting-type)) @@ -5785,6 +5875,13 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." (org-time-string-to-time (match-string 0 x))) 0)) comparefun (if (= dcst sorting-type) '< '>))) + ((= dcst ?p) + (setq extractfun + (lambda (x) + (if (string-match org-priority-regexp x) + (string-to-char (match-string 2 x)) + org-default-priority)) + comparefun (if (= dcst sorting-type) '< '>))) (t (error "Invalid sorting type `%c'" sorting-type))) (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) @@ -6590,7 +6687,12 @@ this heading." (this-buffer (current-buffer)) (org-archive-location org-archive-location) (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") - file heading buffer level newfile-p) + (file (abbreviate-file-name (buffer-file-name))) + (time (format-time-string + (substring (cdr org-time-stamp-formats) 1 -1) + (current-time))) + afile heading buffer level newfile-p + category todo priority ltags itags) ;; Try to find a local archive location (save-excursion @@ -6601,21 +6703,31 @@ this heading." (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) (progn - (setq file (format (match-string 1 org-archive-location) + (setq afile (format (match-string 1 org-archive-location) (file-name-nondirectory buffer-file-name)) heading (match-string 2 org-archive-location))) (error "Invalid `org-archive-location'")) - (if (> (length file) 0) - (setq newfile-p (not (file-exists-p file)) - buffer (find-file-noselect file)) + (if (> (length afile) 0) + (setq newfile-p (not (file-exists-p afile)) + buffer (find-file-noselect afile)) (setq buffer (current-buffer))) (unless buffer - (error "Cannot access file \"%s\"" file)) + (error "Cannot access file \"%s\"" afile)) (if (and (> (length heading) 0) (string-match "^\\*+" heading)) (setq level (match-end 0)) (setq heading nil level 0)) (save-excursion + (org-back-to-heading t) + ;; Get context information that will be lost by moving the tree + (setq category (org-get-category) + todo (and (looking-at org-todo-line-regexp) + (match-string 2)) + priority (org-get-priority (if (match-end 3) (match-string 3) "")) + ltags (org-split-string (org-get-tags) ":") + itags (org-delete-all ltags (org-get-tags-at))) + (setq ltags (mapconcat 'identity ltags " ") + itags (mapconcat 'identity itags " ")) ;; We first only copy, in case something goes wrong ;; we need to protect this-command, to avoid kill-region sets it, ;; which would lead to duplication of subtrees @@ -6676,9 +6788,15 @@ this heading." (car (or (member org-archive-mark-done org-done-keywords) org-done-keywords))))) - ;; Move cursor to right after the TODO keyword - (when org-archive-stamp-time - (org-add-planning-info 'archived (org-current-time))) + ;; Add the context info + (when org-archive-save-context-info + (let ((l org-archive-save-context-info) e n v) + (while (setq e (pop l)) + (when (and (setq v (symbol-value e)) + (stringp v) (string-match "\\S-" v)) + (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) + (org-entry-put (point) n v))))) + ;; Save the buffer, if it is not the same buffer. (if (not (eq this-buffer buffer)) (save-buffer)))) ;; Here we are back in the original buffer. Everything seems to have @@ -6688,7 +6806,7 @@ this heading." (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name file))))))) + (concat "in file: " (abbreviate-file-name afile))))))) (defun org-archive-all-done (&optional tag) "Archive sublevels of the current tree without open TODO items. @@ -6735,7 +6853,8 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change." - (when (not (memq state '(overview folded))) + (when (and (org-mode-p) + (not (memq state '(overview folded)))) (save-excursion (let* ((globalp (memq state '(contents all))) (beg (if globalp (point-min) (point))) @@ -8127,7 +8246,7 @@ it can be edited in place." (field (org-table-get-field)) (cw (current-window-configuration)) p) - (switch-to-buffer-other-window "*Org tmp*") + (org-switch-to-buffer-other-window "*Org tmp*") (erase-buffer) (insert "#\n# Edit field and finish with C-c C-c\n#\n") (let ((org-inhibit-startup t)) (org-mode)) @@ -9223,7 +9342,7 @@ Parameters get priority." (field . "# Field Formulas\n") (named . "# Named Field Formulas\n"))) entry s type title) - (switch-to-buffer-other-window "*Edit Formulas*") + (org-switch-to-buffer-other-window "*Edit Formulas*") (erase-buffer) ;; Keep global-font-lock-mode from turning on font-lock-mode (let ((font-lock-global-modes '(not fundamental-mode))) @@ -9578,7 +9697,7 @@ With prefix ARG, apply the new formulas to the table." (if (and (markerp pos) (marker-buffer pos)) (if (get-buffer-window (marker-buffer pos)) (select-window (get-buffer-window (marker-buffer pos))) - (switch-to-buffer-other-window (get-buffer-window + (org-switch-to-buffer-other-window (get-buffer-window (marker-buffer pos))))) (goto-char pos) (org-table-force-dataline) @@ -10799,7 +10918,7 @@ For file links, arg negates `org-context-in-file-links'." (setq org-stored-links (cons (list cpltxt link desc) org-stored-links)) (message "Stored: %s" (or cpltxt link))) - (org-make-link-string link desc)))) + (and link (org-make-link-string link desc))))) (defun org-store-link-props (&rest plist) "Store link properties, extract names and addresses." @@ -10873,6 +10992,8 @@ according to FMT (default from `org-email-link-description-format')." (defun org-make-link-string (link &optional description) "Make a link with brackets, consisting of LINK and DESCRIPTION." + (unless (string-match "\\S-" link) + (error "Empty link")) (when (stringp description) ;; Remove brackets from the description, they are fatal. (while (string-match "\\[\\|\\]" description) @@ -10888,14 +11009,22 @@ according to FMT (default from `org-email-link-description-format')." "]")) (defconst org-link-escape-chars - '((" " . "%20") ("\340" . "%E0") - ("\342" . "%E2") ("\347" . "%E7") - ("\350" . "%E8") ("\351" . "%E9") - ("\352" . "%EA") ("\356" . "%EE") - ("\364" . "%F4") ("\371" . "%F9") - ("\373" . "%FB") (";" . "%3B") - ("?" . "%3F") ("=" . "%3D") - ("+" . "%2B")) + '((" " . "%20") + ("\340" . "%E0") ; `a + ("\342" . "%E2") ; ^a + ("\347" . "%E7") ; ,c + ("\350" . "%E8") ; `e + ("\351" . "%E9") ; 'e + ("\352" . "%EA") ; ^e + ("\356" . "%EE") ; ^i + ("\364" . "%F4") ; ^o + ("\371" . "%F9") ; `u + ("\373" . "%FB") ; ^u + (";" . "%3B") + ("?" . "%3F") + ("=" . "%3D") + ("+" . "%2B") + ) "Association list of escapes for some characters problematic in links.") (defun org-link-escape (text) @@ -10963,8 +11092,7 @@ according to FMT (default from `org-email-link-description-format')." ;;;###autoload (defun org-insert-link-global () "Insert a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax." +This command can be called in any mode to insert a link in Org-mode syntax." (interactive) (org-run-like-in-org-mode 'org-insert-link)) @@ -11774,12 +11902,13 @@ sequences, it will now work." (string= mh-index-folder (substring folder 0 end-index))) (if (equal major-mode 'mh-show-mode) (save-window-excursion - (when (buffer-live-p (get-buffer folder)) - (progn - (pop-to-buffer folder) - (org-mhe-get-message-folder-from-index) - ) - )) + (let (pop-up-frames) + (when (buffer-live-p (get-buffer folder)) + (progn + (pop-to-buffer folder) + (org-mhe-get-message-folder-from-index) + ) + ))) (org-mhe-get-message-folder-from-index) ) folder @@ -12065,9 +12194,11 @@ to be run from that hook to fucntion properly." (erase-buffer) (insert (substitute-command-keys (format - "## `C-c C-c' to file interactively, `C-u C-c C-c' to file directly. + "## `%sC-c C-c' to file directly, `%sC-c C-c' to file interactively. ## Target file \"%s\", headline \"%s\" ## To switch templates, use `\\[org-remember]'.\n\n" + (if org-remember-store-without-prompt "" "C-u ") + (if org-remember-store-without-prompt "C-u " "") (abbreviate-file-name (or file org-default-notes-file)) (or headline "")))) (insert tpl) (goto-char (point-min)) @@ -12544,6 +12675,8 @@ At all other locations, this simply calls `ispell-complete-word'." If the last change removed the TODO tag or switched to DONE, then this is nil.") +(defvar org-setting-tags nil) ; dynamically skiped + (defun org-todo (&optional arg) "Change the TODO state of an item. The state of an item is given by a keyword at the start of the heading, @@ -12658,11 +12791,13 @@ For calling through lisp, arg is also interpreted in the following way: (org-add-log-maybe 'state state 'findpos)) ((member state org-done-keywords) ;; Planning info calls the note-setting command. - (org-add-planning-info 'closed (org-current-time) - (if (org-get-repeat) nil 'scheduled)) + ;; FIXME: We used to remove scheduling info.... +; (org-add-planning-info 'closed (org-current-time) +; (if (org-get-repeat) nil 'scheduled)) + (org-add-planning-info 'closed (org-current-time)) (org-add-log-maybe 'done state 'findpos)))) ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) + (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) (run-hooks 'org-after-todo-state-change-hook) (and (member state org-done-keywords) (org-auto-repeat-maybe)) (if (and arg (not (member state org-done-keywords))) @@ -12844,8 +12979,7 @@ be removed." (if (not (equal (char-before) ?\ )) " " "") (cond ((eq what 'scheduled) org-scheduled-string) ((eq what 'deadline) org-deadline-string) - ((eq what 'closed) org-closed-string) - ((eq what 'archived) org-archived-string)) + ((eq what 'closed) org-closed-string)) " ") (org-insert-time-stamp time @@ -12881,17 +13015,22 @@ The auto-repeater uses this.") "[^\r\n]*\\)?")) (goto-char (match-end 0)) (unless org-log-states-order-reversed - (if (looking-at "\n[ \t]*- State") (forward-char 1)) - (while (looking-at "[ \t]*- State") - (condition-case nil - (org-next-item) - (error (org-end-of-item)))) + (and (= (char-after) ?\n) (forward-char 1)) + (org-skip-over-state-notes) (skip-chars-backward " \t\n\r"))) (move-marker org-log-note-marker (point)) (setq org-log-note-purpose purpose) (setq org-log-note-state state) (add-hook 'post-command-hook 'org-add-log-note 'append)))) +(defun org-skip-over-state-notes () + "Skip past the list of State notes in an entry." + (if (looking-at "\n[ \t]*- State") (forward-char 1)) + (while (looking-at "[ \t]*- State") + (condition-case nil + (org-next-item) + (error (org-end-of-item))))) + (defun org-add-log-note (&optional purpose) "Pop up a window for taking a note, and add this note later at point." (remove-hook 'post-command-hook 'org-add-log-note) @@ -12900,7 +13039,7 @@ The auto-repeater uses this.") (move-marker org-log-note-return-to (point)) (switch-to-buffer (marker-buffer org-log-note-marker)) (goto-char org-log-note-marker) - (switch-to-buffer-other-window "*Org Note*") + (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) (let ((org-inhibit-startup t)) (org-mode)) (insert (format "# Insert note for %s, finish with C-c C-c.\n\n" @@ -13382,6 +13521,8 @@ With prefix ARG, realign all tags in headings in the current buffer." (interactive "P") (let* ((re (concat "^" outline-regexp)) (current (org-get-tags)) + (col (current-column)) + (org-setting-tags t) table current-tags inherited-tags ; computed below when needed tags p0 c0 c1 rpl) (if arg @@ -13406,7 +13547,8 @@ With prefix ARG, realign all tags in headings in the current buffer." (if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection (delq nil (mapcar 'cdr table)))) - (org-fast-tag-selection current-tags inherited-tags table) + (org-fast-tag-selection current-tags inherited-tags + table org-todo-tag-alist) (let ((org-add-colon-after-tag-completion t)) (org-trim (completing-read "Tags: " 'org-tags-completion-function @@ -13438,7 +13580,47 @@ With prefix ARG, realign all tags in headings in the current buffer." (replace-match rpl t t) (and (not (featurep 'xemacs)) c0 (tabify p0 (point))) tags) - (t (error "Tags alignment failed")))))) + (t (error "Tags alignment failed"))) + (move-to-column col)))) + +(defun org-change-tag-in-region (beg end tag off) + "Add or remove TAG for each entry in the region. +This works in the agenda, and also in an org-mode buffer." + (interactive + (list (region-beginning) (region-end) + (let ((org-last-tags-completion-table + (if (org-mode-p) + (org-get-buffer-tags) + (org-global-tags-completion-table)))) + (completing-read + "Tag: " 'org-tags-completion-function nil nil nil + 'org-tags-history)) + (progn + (message "[s]et or [r]emove? ") + (equal (read-char-exclusive) ?r)))) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (let ((agendap (equal major-mode 'org-agenda-mode)) + l1 l2 m buf pos newhead (cnt 0)) + (goto-char end) + (setq l2 (1- (org-current-line))) + (goto-char beg) + (setq l1 (org-current-line)) + (loop for l from l1 to l2 do + (goto-line l) + (setq m (get-text-property (point) 'org-hd-marker)) + (when (or (and (org-mode-p) (org-on-heading-p)) + (and agendap m)) + (setq buf (if agendap (marker-buffer m) (current-buffer)) + pos (if agendap m (point))) + (with-current-buffer buf + (save-excursion + (save-restriction + (goto-char pos) + (setq cnt (1+ cnt)) + (org-toggle-tag tag (if off 'off 'on)) + (setq newhead (org-get-heading))))) + (and agendap (org-agenda-change-all-lines newhead m)))) + (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) (defun org-tags-completion-function (string predicate &optional flag) (let (s1 s2 rtn (ctable org-last-tags-completion-table) @@ -13491,17 +13673,19 @@ With prefix ARG, realign all tags in headings in the current buffer." (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) (org-overlay-display org-tags-overlay (concat prefix s))))) -(defun org-fast-tag-selection (current inherited table) +(defun org-fast-tag-selection (current inherited table &optional todo-table) "Fast tag selection with single keys. CURRENT is the current list of tags in the headline, INHERITED is the list of inherited tags, and TABLE is an alist of tags and corresponding keys, -possibly with grouping information. +possibly with grouping information. TODO-TABLE is a similar table with +TODO keywords, should these have keys assigned to them. If the keys are nil, a-z are automatically assigned. Returns the new tags string, or nil to not change the current settings." - (let* ((maxlen (apply 'max (mapcar + (let* ((fulltable (append table todo-table)) + (maxlen (apply 'max (mapcar (lambda (x) (if (stringp (car x)) (string-width (car x)) 0)) - table))) + fulltable))) (buf (current-buffer)) (expert (eq org-fast-tag-selection-single-key 'expert)) (buffer-tags nil) @@ -13535,13 +13719,13 @@ Returns the new tags string, or nil to not change the current settings." (set-buffer (get-buffer-create " *Org tags*")) (delete-other-windows) (split-window-vertically) - (switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) + (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) - (setq tbl table char ?a cnt 0) + (setq tbl fulltable char ?a cnt 0) (while (setq e (pop tbl)) (cond ((equal e '(:startgroup)) @@ -13605,7 +13789,7 @@ Returns the new tags string, or nil to not change the current settings." (setq expert nil) (delete-other-windows) (split-window-vertically) - (switch-to-buffer-other-window " *Org tags*") + (org-switch-to-buffer-other-window " *Org tags*") (and (fboundp 'fit-window-to-buffer) (fit-window-to-buffer)))) ((or (= c ?\C-g) @@ -13629,6 +13813,10 @@ Returns the new tags string, or nil to not change the current settings." (setq current (delete tg current)) (push tg current))) (if exit-after-next (setq exit-after-next 'now))) + ((setq e (rassoc c todo-table) tg (car e)) + (with-current-buffer buf + (save-excursion (org-todo tg))) + (if exit-after-next (setq exit-after-next 'now))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) @@ -13970,6 +14158,9 @@ If the property is not present at all, nil is returned." (while (re-search-forward re end t)) (setq hiddenp (org-invisible-p)) (end-of-line 1) + (and (= (char-after) ?\n) (forward-char 1)) + (org-skip-over-state-notes) + (end-of-line 0) (insert "\n:PROPERTIES:\n:END:") (beginning-of-line 0) (org-indent-line-function) @@ -16290,7 +16481,8 @@ The following commands are available: "--" ("Tags and Properties" ["Show all Tags" org-agenda-show-tags t] - ["Set Tags" org-agenda-set-tags t] + ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] + ["Change tag in region" org-agenda-set-tags (org-region-active-p)] "--" ["Column View" org-columns t]) ("Date/Schedule" @@ -16470,7 +16662,7 @@ next use of \\[org-agenda]) restricted to the current file." (setq org-agenda-last-dispatch-buffer (current-buffer)) (save-window-excursion (delete-other-windows) - (switch-to-buffer-other-window " *Agenda Commands*") + (org-switch-to-buffer-other-window " *Agenda Commands*") (erase-buffer) (insert (eval-when-compile (let ((header @@ -16649,7 +16841,7 @@ before running the agenda command." (list 'org-tags-view nil cmd-key))) (flet ((read-char-exclusive () (string-to-char cmd-key))) (eval (list 'let (nreverse pars) '(org-agenda nil))))) - (set-buffer "*Org Agenda*") + (set-buffer org-agenda-buffer-name) (princ (org-encode-for-stdout (buffer-string))))) (defun org-encode-for-stdout (string) @@ -16704,7 +16896,7 @@ agenda-day The day in the agenda where this is listed" (list 'org-tags-view nil cmd-key))) (flet ((read-char-exclusive () (string-to-char cmd-key))) (eval (list 'let (nreverse pars) '(org-agenda nil))))) - (set-buffer "*Org Agenda*") + (set-buffer org-agenda-buffer-name) (let* ((lines (org-split-string (buffer-string) "\n")) line) (while (setq line (pop lines)) @@ -16767,13 +16959,12 @@ agenda-day The day in the agenda where this is listed" (interactive) (eval (list 'org-batch-store-agenda-views))) -(defvar org-agenda-buffer-name) - ;; FIXME, why is this a macro????? ;;;###autoload (defmacro org-batch-store-agenda-views (&rest parameters) "Run all custom agenda commands that have a file argument." (let ((cmds org-agenda-custom-commands) + (pop-up-frames nil) (dir default-directory) pars cmd thiscmdkey files opts) (while parameters @@ -16784,18 +16975,19 @@ agenda-day The day in the agenda where this is listed" (setq cmd (pop cmds) thiscmdkey (car cmd) opts (nth 3 cmd) - files (org-last cmd)) + files (nth 4 cmd)) (if (stringp files) (setq files (list files))) (when files (flet ((read-char-exclusive () (string-to-char thiscmdkey))) (eval (list 'let (append org-agenda-exporter-settings opts pars) '(org-agenda nil)))) - (set-buffer "*Org Agenda*") + (set-buffer org-agenda-buffer-name) (while files (eval (list 'let (append org-agenda-exporter-settings opts pars) (list 'org-write-agenda - (expand-file-name (pop files) dir) t))))) - (kill-buffer org-agenda-buffer-name))))) + (expand-file-name (pop files) dir) t)))) + (and (get-buffer org-agenda-buffer-name) + (kill-buffer org-agenda-buffer-name))))))) (defun org-write-agenda (file &optional nosettings) "Write the current buffer (an agenda view) as a file. @@ -16863,11 +17055,19 @@ higher priority settings." "Get the list of agenda files. Optional UNRESTRICTED means return the full list even if a restriction is currently in place." - (cond - ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) - ((stringp org-agenda-files) (org-read-agenda-file-list)) - ((listp org-agenda-files) org-agenda-files) - (t (error "Invalid value of `org-agenda-files'")))) + (let ((files + (cond + ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) + ((stringp org-agenda-files) (org-read-agenda-file-list)) + ((listp org-agenda-files) org-agenda-files) + (t (error "Invalid value of `org-agenda-files'"))))) + (if org-agenda-skip-unavailable-files + (delq nil + (mapcar (function + (lambda (file) + (and (file-readable-p file) file))) + files)) + files))) ; `org-check-agenda-file' will remove them from the list (defun org-edit-agenda-file-list () "Edit the list of agenda files. @@ -16937,7 +17137,8 @@ If the file is not present in the list, it is added to the front. If it is present, it is moved there. With optional argument TO-END, add/move to the end of the list." (interactive "P") - (let ((file-alist (mapcar (lambda (x) + (let ((org-agenda-skip-unavailable-files nil) + (file-alist (mapcar (lambda (x) (cons (file-truename x) x)) (org-agenda-files t))) (ctf (file-truename buffer-file-name)) @@ -16958,7 +17159,8 @@ end of the list." These are the files which are being checked for agenda entries. Optional argument FILE means, use this file instead of the current." (interactive) - (let* ((file (or file buffer-file-name)) + (let* ((org-agenda-skip-unavailable-files nil) + (file (or file buffer-file-name)) (true-file (file-truename file)) (afile (abbreviate-file-name file)) (files (delq nil (mapcar @@ -17020,12 +17222,12 @@ Optional argument FILE means, use this file instead of the current." ((equal org-agenda-window-setup 'current-window) (switch-to-buffer abuf)) ((equal org-agenda-window-setup 'other-window) - (switch-to-buffer-other-window abuf)) + (org-switch-to-buffer-other-window abuf)) ((equal org-agenda-window-setup 'other-frame) (switch-to-buffer-other-frame abuf)) ((equal org-agenda-window-setup 'reorganize-frame) (delete-other-windows) - (switch-to-buffer-other-window abuf)))) + (org-switch-to-buffer-other-window abuf)))) (setq buffer-read-only nil) (erase-buffer) (org-agenda-mode) @@ -17233,7 +17435,7 @@ dates." s e rtn d emptyp) (setq org-agenda-redo-command (list 'progn - (list 'switch-to-buffer-other-window (current-buffer)) + (list 'org-switch-to-buffer-other-window (current-buffer)) (list 'org-timeline (list 'quote include-all)))) (if (not dopast) ;; Remove past dates from the list of dates. @@ -17688,10 +17890,10 @@ that can be put into `org-agenda-skip-function' for the duration of a command." (not (re-search-forward org-deadline-time-regexp end t))) (and (setq m (memq 'regexp conditions)) (stringp (setq r (nth 1 m))) - (re-search-forward m end t)) + (re-search-forward (nth 1 m) end t)) (and (setq m (memq 'notregexp conditions)) (stringp (setq r (nth 1 m))) - (not (re-search-forward m end t)))) + (not (re-search-forward (nth 1 m) end t)))) end))) (defun org-agenda-list-stuck-projects (&rest ignore) @@ -17748,6 +17950,7 @@ MATCH is being ignored." "Get the (Emacs Calendar) diary entries for DATE." (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") (diary-display-hook '(fancy-diary-display)) + (pop-up-frames nil) (list-diary-entries-hook (cons 'org-diary-default-entry list-diary-entries-hook)) (diary-file-name-prefix-function nil) ; turn this feature off @@ -18018,7 +18221,7 @@ the documentation of `org-diary'." (and org-agenda-todo-ignore-deadlines (goto-char beg) (re-search-forward org-deadline-time-regexp end t) (org-deadline-close (match-string 1)))) - (goto-char beg) + (goto-char (1+ beg)) (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) (throw :skip nil))) (goto-char beg) @@ -18220,7 +18423,7 @@ the documentation of `org-diary'." (todayp (equal date (calendar-current-date))) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar d2 diff dfrac wdays pos pos1 category tags - ee txt head face s upcomingp) + ee txt head face s upcomingp donep timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -18255,14 +18458,20 @@ the documentation of `org-diary'." (point) (progn (skip-chars-forward "^\r\n") (point)))) - (if (and org-agenda-skip-deadline-if-done - (string-match org-looking-at-done-regexp head)) + (setq donep (string-match org-looking-at-done-regexp head)) + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (setq timestr + (concat (substring s (match-beginning 1)) " ")) + (setq timestr 'time)) + (if (and donep + (or org-agenda-skip-deadline-if-done + (not (= diff 0)))) (setq txt nil) (setq txt (org-format-agenda-item (if (= diff 0) "Deadline: " (format "In %3d d.: " diff)) - head category tags)))) + head category tags timestr)))) (setq txt org-agenda-no-heading-message)) (when txt (setq face (org-agenda-deadline-face dfrac)) @@ -18274,7 +18483,8 @@ the documentation of `org-diary'." 'org-category category 'type (if upcomingp "upcoming-deadline" "deadline") 'date (if upcomingp date d2) - 'face face 'undone-face face 'done-face 'org-done) + 'face (if donep 'org-done face) + 'undone-face face 'done-face 'org-done) (push txt ee)))))) ee)) @@ -18300,15 +18510,16 @@ FRACTION is what fraction of the head-warning time has passed." (todayp (equal date (calendar-current-date))) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar d2 diff pos pos1 category tags - ee txt head pastduep donep face) + ee txt head pastschedp donep face timestr s) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip (org-agenda-skip) - (setq pos (1- (match-beginning 1)) + (setq s (match-string 1) + pos (1- (match-beginning 1)) d2 (org-time-string-to-absolute (match-string 1) d1) diff (- d2 d1)) - (setq pastduep (and todayp (< diff 0))) + (setq pastschedp (and todayp (< diff 0))) ;; When to show a scheduled item in the calendar: ;; If it is on or past the date. (if (or (and (< diff 0) todayp) @@ -18324,16 +18535,22 @@ FRACTION is what fraction of the head-warning time has passed." (point) (progn (skip-chars-forward "^\r\n") (point)))) (setq donep (string-match org-looking-at-done-regexp head)) - (if (and org-agenda-skip-scheduled-if-done donep) + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (setq timestr + (concat (substring s (match-beginning 1)) " ")) + (setq timestr 'time)) + (if (and donep + (or org-agenda-skip-scheduled-if-done + (not (= diff 0)))) (setq txt nil) (setq txt (org-format-agenda-item (if (= diff 0) "Scheduled: " (format "Sched.%2dx: " (- 1 diff))) - head category tags)))) + head category tags timestr)))) (setq txt org-agenda-no-heading-message)) (when txt - (setq face (if pastduep + (setq face (if pastschedp 'org-scheduled-previously 'org-scheduled-today)) (org-add-props txt props @@ -18341,8 +18558,8 @@ FRACTION is what fraction of the head-warning time has passed." 'face (if donep 'org-done face) 'org-marker (org-agenda-new-marker pos) 'org-hd-marker (org-agenda-new-marker pos1) - 'type (if pastduep "past-scheduled" "scheduled") - 'date (if pastduep d2 date) + 'type (if pastschedp "past-scheduled" "scheduled") + 'date (if pastschedp d2 date) 'priority (+ (- 5 diff) (org-get-priority txt)) 'org-category category) (push txt ee)))))) @@ -18646,16 +18863,18 @@ HH:MM." (if (eq x 'line) (save-excursion (beginning-of-line 1) - (setq re (get-text-property (point) 'org-not-done-regexp)) + (setq re (get-text-property (point) 'org-todo-regexp)) (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) (and (looking-at (concat "[ \t]*\\.*" re)) (add-text-properties (match-beginning 0) (match-end 0) - '(face org-todo)))) - (setq re (concat (get-text-property 0 'org-not-done-regexp x)) + (list 'face (org-get-todo-face 0))))) + (setq re (concat (get-text-property 0 'org-todo-regexp x)) pl (get-text-property 0 'prefix-length x)) (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) - (add-text-properties (or (match-end 1) (match-end 0)) (match-end 0) - '(face org-todo) x)) + (add-text-properties + (or (match-end 1) (match-end 0)) (match-end 0) + (list 'face (org-get-todo-face (match-string 2 x))) + x)) x))) (defsubst org-cmp-priority (a b) @@ -19050,7 +19269,7 @@ and by additional input from the age of a schedules or deadline entry." (goto-char pos) (if (and (org-mode-p) (not (member type '("sexp")))) (setq dbeg (progn (org-back-to-heading t) (point)) - dend (org-end-of-subtree t)) + dend (org-end-of-subtree t t)) (setq dbeg (point-at-bol) dend (min (point-max) (1+ (point-at-eol))))) (goto-char dbeg) @@ -19342,7 +19561,7 @@ POS defaults to point. If tags are inherited, the list contains the targets in the same sequence as the headlines appear, i.e. the tags of the current headline come last." (interactive) - (let (tags) + (let (tags lastpos) (save-excursion (save-restriction (widen) @@ -19350,7 +19569,8 @@ the tags of the current headline come last." (save-match-data (org-back-to-heading t) (condition-case nil - (while t + (while (not (equal lastpos (point))) + (setq lastpos (point)) (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) (setq tags (append (org-split-string (org-match-string-no-properties 1) ":") @@ -19365,28 +19585,30 @@ the tags of the current headline come last." "Set tags for the current headline." (interactive) (org-agenda-check-no-diary) - (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed - (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) - (call-interactively 'org-set-tags) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) - (beginning-of-line 1)))) + (if (and (org-region-active-p) (interactive-p)) + (call-interactively 'org-change-tag-in-region) + (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed + (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (save-excursion + (org-show-context 'agenda)) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (goto-char pos) + (call-interactively 'org-set-tags) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1))))) (defun org-agenda-toggle-archive-tag () "Toggle the archive tag for the current entry." @@ -19681,6 +19903,7 @@ This is a command that has to be installed in `calendar-mode-map'." "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" "French: " (calendar-french-date-string date) "\n" + "Bahai: " (calendar-bahai-date-string date) " (until sunset)\n" "Mayan: " (calendar-mayan-date-string date) "\n" "Coptic: " (calendar-coptic-date-string date) "\n" "Ethiopic: " (calendar-ethiopic-date-string date) "\n" @@ -20501,6 +20724,7 @@ translations. There is currently no way for users to extend this.") (asciip (plist-get parameters :for-ascii)) (latexp (plist-get parameters :for-LaTeX)) (commentsp (plist-get parameters :comments)) + (archived-trees (plist-get parameters :archived-trees)) (inhibit-read-only t) (outline-regexp "\\*+ ") a b xx @@ -20528,13 +20752,13 @@ translations. There is currently no way for users to extend this.") (insert (plist-get parameters :add-text) "\n")) ;; Get rid of archived trees - (when (not (eq org-export-with-archived-trees t)) + (when (not (eq archived-trees t)) (goto-char (point-min)) (while (re-search-forward re-archive nil t) (if (not (org-on-heading-p t)) (org-end-of-subtree t) (beginning-of-line 1) - (setq a (if org-export-with-archived-trees + (setq a (if archived-trees (1+ (point-at-eol)) (point)) b (org-end-of-subtree t)) (if (> b a) (delete-region a b))))) @@ -20581,7 +20805,7 @@ translations. There is currently no way for users to extend this.") '(org-protected t)) (delete-region (match-beginning 0) (match-end 0)))))) - ;; Protect quoted subtreedes + ;; Protect quoted subtrees (goto-char (point-min)) (while (re-search-forward re-quote nil t) (goto-char (match-beginning 0)) @@ -20607,12 +20831,24 @@ translations. There is currently no way for users to extend this.") (point-at-eol)) (end-of-line 1)))) - ;; Specific LaTeX cleaning + ;; Specific LaTeX stuff (when latexp (require 'org-export-latex nil t) (org-export-latex-cleaned-string)) + ;; Specific HTML stuff + (when htmlp + ;; Convert LaTeX fragments to images + (when (plist-get parameters :LaTeX-fragments) + (org-format-latex + (concat "ltxpng/" (file-name-sans-extension + (file-name-nondirectory + org-current-export-file))) + org-current-export-dir nil "Creating LaTeX image %s")) + (message "Exporting...")) + ;; Remove or replace comments + ;; FIXME: Does LaTeX export take care of its own comments? ;; If :comments is set, use this char for commenting out comments and ;; protect them. otherwise delete them (goto-char (point-min)) @@ -20637,14 +20873,6 @@ translations. There is currently no way for users to extend this.") (replace-match "\\1 \\3") (goto-char (match-beginning 0)))) - ;; Convert LaTeX fragments to images - (when (plist-get parameters :LaTeX-fragments) - (org-format-latex - (concat "ltxpng/" (file-name-sans-extension - (file-name-nondirectory - org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s")) - (message "Exporting...") ;; Normalize links: Convert angle and plain links into bracket links ;; Expand link abbreviations @@ -20708,6 +20936,22 @@ translations. There is currently no way for users to extend this.") ;; Return the title string (org-trim (match-string 0))))))) +(defun org-export-get-title-from-subtree () + "Return subtree title and exclude it from export." + (let (title (m (mark))) + (save-excursion + (goto-char (region-beginning)) + (when (and (org-at-heading-p) + (>= (org-end-of-subtree t t) (region-end))) + ;; This is a subtree, we take the title from the first heading + (goto-char (region-beginning)) + (looking-at org-todo-line-regexp) + (setq title (match-string 3)) + (org-unmodified + (add-text-properties (point) (1+ (point-at-eol)) + (list :org-license-to-kill t))))) + title)) + (defun org-solidify-link-text (s &optional alist) "Take link text and make a safe target out of it." (save-match-data @@ -20767,6 +21011,7 @@ When LEVEL is non-nil, increase section numbers on that level." ;;; ASCII export (defvar org-last-level nil) ; dynamically scoped variable +(defvar org-min-level nil) ; dynamically scoped variable (defvar org-levels-open nil) ; dynamically scoped parameter (defvar org-ascii-current-indentation nil) ; For communication @@ -20779,6 +21024,13 @@ underlined headlines. The default is 3." (setq-default org-todo-line-regexp org-todo-line-regexp) (let* ((opt-plist (org-combine-plists (org-default-export-plist) (org-infile-export-plist))) + (region-p (org-region-active-p)) + (subtree-p + (when region-p + (save-excursion + (goto-char (region-beginning)) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) (region-end)))))) (custom-times org-display-custom-times) (org-ascii-current-indentation '(0 . 0)) (level 0) line txt @@ -20788,7 +21040,10 @@ underlined headlines. The default is 3." (filename (concat (file-name-as-directory (org-export-directory :ascii opt-plist)) (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory buffer-file-name))) ".txt")) (filename (if (equal (file-truename filename) (file-truename buffer-file-name)) @@ -20800,7 +21055,8 @@ underlined headlines. The default is 3." (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (org-current-time))) (author (plist-get opt-plist :author)) - (title (or (plist-get opt-plist :title) + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) (and (not (plist-get opt-plist :skip-before-1st-heading)) (org-export-grab-title-from-buffer)) @@ -20822,6 +21078,8 @@ underlined headlines. The default is 3." :for-ascii t :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) + :archived-trees + (plist-get opt-plist :archived-trees) :add-text (plist-get opt-plist :text)) "[\r\n]")) ;; FIXME: why \r here???/ thetoc have-headings first-heading-pos @@ -20832,7 +21090,8 @@ underlined headlines. The default is 3." (remove-text-properties (point-min) (point-max) '(:org-license-to-kill t)))) - (setq org-last-level 1) + (setq org-min-level (org-get-min-level lines)) + (setq org-last-level org-min-level) (org-init-section-numbers) (find-file-noselect filename) @@ -20908,7 +21167,8 @@ underlined headlines. The default is 3." (progn (push (concat - (make-string (* (1- level) 4) ?\ ) + (make-string + (* (max 0 (- level org-min-level)) 4) ?\ ) (format (if todo "%s (*)\n" "%s\n") txt)) thetoc) (setq org-last-level level)) @@ -21084,6 +21344,12 @@ command." (file buffer-file-name) (buffer (get-buffer-create "*Org Export Visible*")) s e) + ;; Need to hack the drawers here. + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (goto-char (match-beginning 1)) + (or (org-invisible-p) (org-flag-drawer nil)))) (with-current-buffer buffer (erase-buffer)) (save-excursion (setq s (goto-char (point-min))) @@ -21091,6 +21357,7 @@ command." (goto-char (org-find-invisible)) (append-to-buffer buffer s (point)) (setq s (goto-char (org-find-visible)))) + (org-cycle-hide-drawers 'all) (goto-char (point-min)) (unless keepp ;; Copy all comment lines to the end, to make sure #+ settings are @@ -21267,7 +21534,7 @@ This can be used in any buffer. For example, you could write an itemized list in org-mode syntax in an HTML buffer and then use this command to convert it." (interactive "r") - (let (reg html buf) + (let (reg html buf pop-up-frames) (save-window-excursion (if (org-mode-p) (setq html (org-export-region-as-html @@ -21354,6 +21621,12 @@ the body tags themselves." valid thetoc have-headings first-heading-pos (odd org-odd-levels-only) (region-p (org-region-active-p)) + (subtree-p + (when region-p + (save-excursion + (goto-char (region-beginning)) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) (region-end)))))) ;; The following two are dynamically scoped into other ;; routines below. (org-current-export-dir (org-export-directory :html opt-plist)) @@ -21365,7 +21638,10 @@ the body tags themselves." (concat (file-name-as-directory (org-export-directory :html opt-plist)) (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory buffer-file-name))) ".html"))) (current-dir (if buffer-file-name (file-name-directory buffer-file-name) @@ -21379,7 +21655,8 @@ the body tags themselves." (date (format-time-string "%Y/%m/%d" (current-time))) (time (format-time-string "%X" (org-current-time))) (author (plist-get opt-plist :author)) - (title (or (plist-get opt-plist :title) + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) (and (not (plist-get opt-plist :skip-before-1st-heading)) (org-export-grab-title-from-buffer)) @@ -21423,6 +21700,8 @@ the body tags themselves." :for-html t :skip-before-1st-heading (plist-get opt-plist :skip-before-1st-heading) + :archived-trees + (plist-get opt-plist :archived-trees) :add-text (plist-get opt-plist :text) :LaTeX-fragments @@ -21441,7 +21720,8 @@ the body tags themselves." (message "Exporting...") - (setq org-last-level 1) + (setq org-min-level (org-get-min-level lines)) + (setq org-last-level org-min-level) (org-init-section-numbers) ;; Get the language-dependent settings @@ -21572,7 +21852,7 @@ lang=\"%s\" xml:lang=\"%s\"> ))) line) lines)) - (while (> org-last-level 0) + (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) (push "\n\n" thetoc)) (setq thetoc (if have-headings (nreverse thetoc) nil)))) @@ -23410,11 +23690,7 @@ See the individual commands for more information." ["Next Same Level" outline-forward-same-level t] ["Previous Same Level" outline-backward-same-level t] "--" - ["Jump" org-goto t] - "--" - ["C-a/e find headline/item start/end" - (setq org-special-ctrl-a/e (not org-special-ctrl-a/e)) - :style toggle :selected org-special-ctrl-a/e]) + ["Jump" org-goto t]) ("Edit Structure" ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] @@ -23470,6 +23746,7 @@ See the individual commands for more information." ["Priority Down" org-shiftdown t]) ("TAGS and Properties" ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] + ["Change tag in region" 'org-change-tag-in-region (org-region-active-p)] ;FIXME ["Column view of properties" org-columns t]) ("Dates and Scheduling" ["Timestamp" org-time-stamp t] @@ -23757,6 +24034,13 @@ return nil." (list context (match-beginning group) (match-end group)) t))) +(defun org-switch-to-buffer-other-window (&rest args) + "Switch to buffer in a second window on the current frame. +In particular, do not allow pop-up frames." + (let (pop-up-frames special-display-buffer-names special-display-regexps + special-display-function) + (apply 'switch-to-buffer-other-window args))) + (defun org-combine-plists (&rest plists) "Create a single property list from all plists in PLISTS. The process starts by copying the first list, and then setting properties @@ -23983,14 +24267,22 @@ beyond the end of the headline." ((and (looking-at org-todo-line-regexp) (= (char-after (match-end 1)) ?\ )) (goto-char - (cond ((> pos (match-beginning 3)) (match-beginning 3)) - ((= pos (point)) (match-beginning 3)) - (t (point))))) + (if (eq org-special-ctrl-a/e t) + (cond ((> pos (match-beginning 3)) (match-beginning 3)) + ((= pos (point)) (match-beginning 3)) + (t (point))) + (cond ((> pos (point)) (point)) + ((not (eq last-command this-command)) (point)) + (t (match-beginning 3)))))) ((org-at-item-p) (goto-char - (cond ((> pos (match-end 4)) (match-end 4)) - ((= pos (point)) (match-end 4)) - (t (point))))))))) + (if (eq org-special-ctrl-a/e t) + (cond ((> pos (match-end 4)) (match-end 4)) + ((= pos (point)) (match-end 4)) + (t (point))) + (cond ((> pos (point)) (point)) + ((not (eq last-command this-command)) (point)) + (t (match-end 4)))))))))) (defun org-end-of-line (&optional arg) "Go to the end of the line. @@ -24004,10 +24296,14 @@ beyond the end of the headline." (let ((pos (point))) (beginning-of-line 1) (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) - (if (or (< pos (match-beginning 1)) - (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) + (if (eq org-special-ctrl-a/e t) + (if (or (< pos (match-beginning 1)) + (= pos (match-end 0))) + (goto-char (match-beginning 1)) + (goto-char (match-end 0))) + (if (or (< pos (match-end 0)) (not (eq this-command last-command))) + (goto-char (match-end 0)) + (goto-char (match-beginning 1)))) (end-of-line arg))))) (define-key org-mode-map "\C-a" 'org-beginning-of-line) @@ -24264,7 +24560,13 @@ Still experimental, may disappear in the furture." t))) (t nil)))) ; call paragraph-fill - +(defun org-get-min-level (lines) + (let ((re "^\\(\\*+\\) ") l min) + (catch 'exit + (while (setq l (pop lines)) + (if (string-match re l) + (throw 'exit (org-tr-level (length (match-string 1 l)))))) + 1))) ;;;; Finish up diff --git a/man/ChangeLog b/man/ChangeLog index dac0bf7570c..245b4c7e96f 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,7 @@ +2007-08-30 Carsten Dominik + + * org.texi: Version 5.07 + 2007-08-29 Glenn Morris * emacs.texi (EMACSVER): Increase to 23.0.50.