Mercurial > emacs
changeset 83783:ee2968c8da3a
(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.
| author | Carsten Dominik <dominik@science.uva.nl> |
|---|---|
| date | Thu, 30 Aug 2007 09:48:23 +0000 |
| parents | dfd0da6b4550 |
| children | 348ef65f4eaf |
| files | lisp/textmodes/org.el |
| diffstat | 1 files changed, 511 insertions(+), 209 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/textmodes/org.el Thu Aug 30 09:48:05 2007 +0000 +++ b/lisp/textmodes/org.el Thu Aug 30 09:48:23 2007 +0000 @@ -5,7 +5,7 @@ ;; 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: 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 @@ (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 @@ :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 @@ :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 @@ :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 @@ :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 @@ (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 @@ (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 @@ (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 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 @@ '(("*" bold "<b>" "</b>") ("/" italic "<i>" "</i>") ("_" underline "<u>" "</u>") - ("=" shadow "<code>" "</code>") + ("=" org-code "<code>" "</code>") ("+" (:strike-through t) "<del>" "</del>") ) "Special syntax for emphasized text. @@ -3418,6 +3458,18 @@ 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 @@ "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 @@ (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 @@ "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 @@ (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 @@ (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 @@ ;; 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 @@ (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 @@ (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 @@ (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 @@ '("^&?%%(.*\\|<%%([^>\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 @@ "\\|" 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 @@ ((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 @@ `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 @@ (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 @@ 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 @@ 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 @@ (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-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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ "]")) (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 @@ ;;;###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 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ "[^\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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ "--" ("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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ "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 @@ 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 @@ 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 @@ ((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 @@ 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 @@ (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 @@ "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 @@ (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 @@ (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 @@ (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 @@ '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 @@ (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 @@ (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 @@ '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 @@ (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 @@ (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 @@ 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 @@ (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 @@ "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 @@ "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 @@ (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 @@ (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 @@ '(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 @@ (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 @@ (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 @@ ;; 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 @@ ;;; 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 @@ (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 @@ (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 @@ (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 @@ :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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ 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 @@ (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 @@ (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 @@ :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 @@ (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 @@ ))) line) lines)) - (while (> org-last-level 0) + (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) (push "</li>\n</ul>\n" thetoc)) (setq thetoc (if have-headings (nreverse thetoc) nil)))) @@ -23410,11 +23690,7 @@ ["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 @@ ["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 @@ (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 @@ ((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 @@ (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 @@ 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