diff options
Diffstat (limited to 'lisp/textmodes/org.el')
| -rw-r--r-- | lisp/textmodes/org.el | 1849 |
1 files changed, 1379 insertions, 470 deletions
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index dd4dfc1a857..b2d79c1acbb 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -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: 4.36b +;; Version: 4.39 ;; ;; This file is part of GNU Emacs. ;; @@ -90,6 +90,21 @@ ;; ;; Recent changes ;; -------------- +;; Version 4.39 +;; - Special tag ARCHIVE keeps a subtree closed and away from agenda lists. +;; - LaTeX code in Org-mode files can be converted to images for HTML. +;; - Bug fixes. +;; - CDLaTeX-mode features can be used in Org-mode to help inserting +;; LaTeX environment and math. +;; +;; Version 4.38 +;; - noutline.el is now required (important for XEmacs users only). +;; - Dynamic blocks. +;; - Archiving of all level 1 trees without open TODO items. +;; - Clock reports can be inserted into the file in a special section. +;; - FAQ removed from the manual, now only on the web. +;; - Bug fixes. +;; ;; Version 4.37 ;; - Clock-feature for measuring time spent on specific items. ;; - Improved emphasizing allows configuration and stacking. @@ -170,13 +185,18 @@ (eval-when-compile (require 'cl) (require 'calendar)) -(require 'outline) +;; For XEmacs, noutline is not yet provided by outline.el, so arrange for +;; the file noutline.el being loaded. +(if (featurep 'xemacs) (condition-case nil (require 'noutline))) +;; We require noutline, which might be provided in outline.el +(require 'outline) (require 'noutline) +;; Other stuff we need. (require 'time-date) (require 'easymenu) ;;; Customization variables -(defvar org-version "4.36b" +(defvar org-version "4.39" "The version number of the file org.el.") (defun org-version () (interactive) @@ -396,7 +416,8 @@ visibility is cycled." (const :tag "Everywhere except in headlines" t) )) -(defcustom org-cycle-hook '(org-optimize-window-after-visibility-change) +(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees + org-optimize-window-after-visibility-change) "Hook that is run after `org-cycle' has changed the buffer visibility. The function(s) in this hook must accept a single argument which indicates the new state that was set by the most recent `org-cycle' command. The @@ -524,6 +545,38 @@ use \\[org-ctrl-c-ctrl-c] to trigger renumbering." :tag "Org Archive" :group 'org-structure) +(defcustom org-archive-tag "ARCHIVE" + "The tag that marks a subtree as archived. +An archived subtree does not open during visibility cycling, and does +not contribute to the agenda listings." + :group 'org-archive + :group 'org-keywords + :type 'string) + +(defcustom org-agenda-skip-archived-trees t + "Non-nil means, the agenda will skip any items located in archived trees. +An archived tree is a tree marked with the tag ARCHIVE." + :group 'org-archive + :group 'org-agenda-display + :type 'boolean) + +(defcustom org-cycle-open-archived-trees nil + "Non-nil means, `org-cycle' will open archived trees. +An archived tree is a tree marked with the tag ARCHIVE. +When nil, archived trees will stay folded. You can still open them with +normal outline commands like `show-all', but not with the cycling commands." + :group 'org-archive + :group 'org-cycle + :type 'boolean) + +(defcustom org-sparse-tree-open-archived-trees nil + "Non-nil means sparse tree construction shows matches in archived trees. +When nil, matches in these trees are highlighted, but the trees are kept in +collapsed state." + :group 'org-archive + :group 'org-sparse-trees + :type 'boolean) + (defcustom org-archive-location "%s_archive::" "The location where subtrees should be archived. This string consists of two parts, separated by a double-colon. @@ -561,12 +614,12 @@ line like :type 'string) (defcustom org-archive-mark-done t - "Non-nil means, mark archived entries as DONE." + "Non-nil means, mark entries as DONE when they are moved to the archive file." :group 'org-archive :type 'boolean) (defcustom org-archive-stamp-time t - "Non-nil means, add a time stamp to archived entries. + "Non-nil means, add a time stamp to entries moved to an archive file. The time stamp will be added directly after the TODO state keyword in the first line, so it is probably best to use this in combinations with `org-archive-mark-done'." @@ -1015,12 +1068,14 @@ rather than having to type \"yes\"." (const :tag "no confirmation (dangerous)" nil))) (defconst org-file-apps-defaults-gnu - '((t . mailcap)) + '((remote . emacs) + (t . mailcap)) "Default file applications on a UNIX or GNU/Linux system. See `org-file-apps'.") (defconst org-file-apps-defaults-macosx - '((t . "open %s") + '((remote . emacs) + (t . "open %s") ("ps" . "gv %s") ("ps.gz" . "gv %s") ("eps" . "gv %s") @@ -1033,11 +1088,13 @@ for some files for which the OS does not have a good default. See `org-file-apps'.") (defconst org-file-apps-defaults-windowsnt - (list (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) + (list + '(remote . emacs) + (cons t + (list (if (featurep 'xemacs) + 'mswindows-shell-execute + 'w32-shell-execute) + "open" 'file))) "Default file applications on a Windows NT system. The system \"open\" is used for most files. See `org-file-apps'.") @@ -1059,6 +1116,9 @@ files and the cdr the corresponding command. Possible values for the file identifier are \"ext\" A string identifying an extension `directory' Matches a directory + `remote' Matches a remove file, accessible through tramp or efs. + Remote files most likely should be visited through emacs + because external applications cannot handle such paths. t Default for all remaining files Possible values for the command are: @@ -1077,6 +1137,7 @@ For more examples, see the system specific constants (cons (choice :value "" (string :tag "Extension") (const :tag "Default for unrecognized files" t) + (const :tag "Remote file" remote) (const :tag "Links to a directory" directory)) (choice :value "" (const :tag "Visit with Emacs" emacs) @@ -1702,6 +1763,29 @@ N days, just insert a special line indicating the size of the gap." (const :tag "All" t) (number :tag "at most"))) +(defgroup org-latex nil + "Options for embedding LaTeX code into Org-mode" + :tag "Org LaTeX" + :group 'org) + +(defcustom org-format-latex-options + '(:foreground "Black" :background "Transparent" :scale 1.0 + :matchers ("begin" "$" "$$" "\\(" "\\[")) + "Options for creating images from LaTeX fragments. +This is a property list with the following properties: +:foreground the foreground color, for example \"Black\". +:background the background color, or \"Transparent\". +:scale a scaling factor for the size of the images +:matchers a list indicating which matchers should be used to + find LaTeX fragments. Valid members of this list are: + \"begin\" find environments + \"$\" find mathc expressions surrounded by $...$ + \"$$\" find math expressions surrounded by $$....$$ + \"\\(\" find math expressions surrounded by \\(...\\) + \"\\[\" find math expressions surrounded by \\[...\\]" + :group 'org-latex + :type 'plist) + (defgroup org-export nil "Options for exporting org-listings." :tag "Org Export" @@ -1800,6 +1884,19 @@ This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." :group 'org-export-general :type 'boolean) +(defcustom org-export-with-archived-trees 'headline + "Whether subtrees with the ARCHIVE tag should be exported. +This can have three different values +nil Do not export, pretend this tree is not present +t Do export the entire tree +headline Only export the headline, but skip the tree below it." + :group 'org-export-general + :group 'org-archive + :type '(choice + (const :tag "not at all" nil) + (const :tag "headline only" 'headline) + (const :tag "entirely" t))) + (defcustom org-export-with-timestamps t "Nil means, do not export time stamps and associated keywords." :group 'org-export @@ -1863,6 +1960,19 @@ Not all export backends support this. This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." :group 'org-export-translation + :group 'org-latex + :type 'boolean) + +(defcustom org-export-with-LaTeX-fragments nil + "Non-nil means, convert LaTeX fragments to images when exporting to HTML. +When set, the exporter will find LaTeX environments if the \\begin line is +the first non-white thing on a line. It will also find the math delimiters +like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for +display math. + +This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." + :group 'org-export-translation + :group 'org-latex :type 'boolean) (defcustom org-export-with-fixed-width t @@ -2202,7 +2312,7 @@ stacked Non-nil means, allow stacked styles. This works only in HTML `org-emphasis-alist') will be allowed as pre/post, aiding inside-out matching. Use customize to modify this, or restart emacs after changing it." - :group 'org-fixme + :group 'org-font-lock :set 'org-set-emph-re :type '(list (sexp :tag "Allowed chars in pre ") @@ -2216,19 +2326,23 @@ Use customize to modify this, or restart emacs after changing it." '(("*" bold "<b>" "</b>") ("/" italic "<i>" "</i>") ("_" underline "<u>" "</u>") - ("=" shadow "<code>" "</code>")) + ("=" shadow "<code>" "</code>") + ("+" (:strike-through t) "<del>" "</del>") +) "Special syntax for emphasised text. Text starting and ending with a special character will be emphasized, for example *bold*, _underlined_ and /italic/. This variable sets the marker characters, the face to bbe used by font-lock for highlighting in Org-mode emacs buffers, and the HTML tags to be used for this. Use customize to modify this, or restart emacs after changing it." - :group 'org-fixme + :group 'org-font-lock :set 'org-set-emph-re :type '(repeat (list (string :tag "Marker character") - (face :tag "Font-lock-face") + (choice + (face :tag "Font-lock-face") + (plist :tag "Face property list")) (string :tag "HTML start tag") (string :tag "HTML end tag")))) @@ -2370,6 +2484,19 @@ color of the frame." This face is only used if `org-fontify-done-headline' is set." :group 'org-faces) +(defface org-archived ; similar to shadow + (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 headline with the ARCHIVE tag." + :group 'org-faces) + (defface org-link '((((class color) (background light)) (:foreground "Purple" :underline t)) (((class color) (background dark)) (:foreground "Cyan" :underline t)) @@ -2608,7 +2735,7 @@ Also put tags into group 4 if tags are present.") (and arch (set (make-local-variable 'org-archive-location) arch)) (and int (set (make-local-variable 'org-todo-interpretation) int)) (when tags - (let (e tg c tgs) + (let (e tgs) (while (setq e (pop tags)) (cond ((equal e "{") (push '(:startgroup) tgs)) @@ -2690,6 +2817,8 @@ Also put tags into group 4 if tags are present.") (defvar org-goto-start-pos) ; dynamically scoped parameter (defvar org-time-was-given) ; dynamically scoped parameter (defvar org-ts-what) ; dynamically scoped parameter +(defvar org-current-export-file) ; dynamically scoped parameter +(defvar org-current-export-dir) ; dynamically scoped parameter (defvar mark-active) ; Emacs only, not available in XEmacs. (defvar timecnt) ; dynamically scoped parameter (defvar levels-open) ; dynamically scoped parameter @@ -2708,6 +2837,7 @@ Also put tags into group 4 if tags are present.") (defvar gnus-group-name) ; from gnus (defvar gnus-article-current) ; from gnus (defvar w3m-current-url) ; from w3m +(defvar w3m-current-title) ; from w3m (defvar mh-progs) ; from MH-E (defvar mh-current-folder) ; from MH-E (defvar mh-show-folder-buffer) ; from MH-E @@ -2823,8 +2953,10 @@ The following commands are available: (insert " -*- mode: org -*-\n\n")) (unless org-inhibit-startup - (if org-startup-align-all-tables - (org-table-map-tables 'org-table-align)) + (when org-startup-align-all-tables + (let ((bmp (buffer-modified-p))) + (org-table-map-tables 'org-table-align) + (set-buffer-modified-p bmp))) (if org-startup-with-deadline-check (call-interactively 'org-check-deadlines) (cond @@ -3177,6 +3309,7 @@ between words." '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) (if org-format-transports-properties-p '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) + '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) ;; Now set the full font-lock-keywords @@ -3253,7 +3386,11 @@ between words." outline-regexp)) (bob-special (and org-cycle-global-at-bob (bobp) (not (looking-at outline-regexp)))) - (org-cycle-hook (if bob-special nil org-cycle-hook)) + (org-cycle-hook + (if bob-special + (delq 'org-optimize-window-after-visibility-change + (copy-sequence org-cycle-hook)) + org-cycle-hook)) (pos (point))) (if (or bob-special (equal arg '(4))) @@ -3271,7 +3408,7 @@ between words." (call-interactively 'org-table-next-field))))) ((eq arg t) ;; Global cycling - + (cond ((and (eq last-command this-command) (eq org-cycle-global-status 'overview)) @@ -3350,6 +3487,9 @@ between words." ;; TAB emulation (buffer-read-only (org-back-to-heading)) + + ((org-try-cdlatex-tab)) + ((if (and (memq org-cycle-emulate-tab '(white whitestart)) (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) (or (and (eq org-cycle-emulate-tab 'white) @@ -3617,10 +3757,8 @@ Return t when things worked, nil when we are not in an item." t) (error nil))) (let* ((bul (match-string 0)) - (end (match-end 0)) (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") (match-end 0))) - (eowcol (save-excursion (goto-char eow) (current-column))) pos) (cond ((and (org-at-item-p) (<= (point) eow)) @@ -3722,9 +3860,7 @@ in the region." (replace-match up-head nil t) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation - (org-fixup-indentation (if (> diff 1) "^ " "^ ") "" - (if (> diff 1) "^ ? ?\\S-" "^ ?\\S-"))))) + (if org-adapt-indentation (org-fixup-indentation (- diff))))) (defun org-demote () "Demote the current heading lower down the tree. @@ -3737,8 +3873,7 @@ in the region." (replace-match down-head nil t) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation - (org-fixup-indentation "^ " (if (> diff 1) " " " ") "^\\S-")))) + (if org-adapt-indentation (org-fixup-indentation diff)))) (defun org-map-tree (fun) "Call FUN for every heading underneath the current one." @@ -3767,20 +3902,23 @@ in the region." (not (eobp))) (funcall fun))))) -;; FIXME: this does not work well with Tabulators. This has to be re-written entirely. -(defun org-fixup-indentation (from to prohibit) - "Change the indentation in the current entry by re-replacing FROM with TO. -However, if the regexp PROHIBIT matches at all, don't do anything. -This is being used to change indentation along with the length of the -heading marker. But if there are any lines which are not indented, nothing -is changed at all." +(defun org-fixup-indentation (diff) + "Change the indentation in the current entry by DIFF +However, if any line in the current entry has no indentation, or if it +would end up with no indentation after the change, nothing at all is done." (save-excursion (let ((end (save-excursion (outline-next-heading) - (point-marker)))) + (point-marker))) + (prohibit (if (> diff 0) + "^\\S-" + (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) + col) (unless (save-excursion (re-search-forward prohibit end t)) - (while (re-search-forward from end t) - (replace-match to) - (beginning-of-line 2))) + (while (re-search-forward "^[ \t]+" end t) + (goto-char (match-end 0)) + (setq col (current-column)) + (if (< diff 0) (replace-match "")) + (indent-to (+ diff col)))) (move-marker end nil)))) ;;; Vertical tree motion, cutting and pasting of subtrees @@ -3984,6 +4122,14 @@ If optional TXT is given, check this string instead of the current kill." (throw 'exit nil))) t)))) +(defun org-narrow-to-subtree () + "Narrow buffer to the current subtree." + (interactive) + (save-excursion + (narrow-to-region + (progn (org-back-to-heading) (point)) + (progn (org-end-of-subtree t) (point))))) + ;;; Plain list items (defun org-at-item-p () @@ -4101,12 +4247,10 @@ If the cursor is not in an item, throw an error." "Move to the beginning of the next item in the current plain list. Error if not at a plain list, or if this is the last item in the list." (interactive) - (let (beg end ind ind1 (pos (point)) txt) + (let (ind ind1 (pos (point))) (org-beginning-of-item) - (setq beg (point)) (setq ind (org-get-indentation)) (org-end-of-item) - (setq end (point)) (setq ind1 (org-get-indentation)) (unless (and (org-at-item-p) (= ind ind1)) (goto-char pos) @@ -4116,7 +4260,7 @@ Error if not at a plain list, or if this is the last item in the list." "Move to the beginning of the previous item in the current plain list. Error if not at a plain list, or if this is the last item in the list." (interactive) - (let (beg end ind ind1 (pos (point)) txt) + (let (beg ind (pos (point))) (org-beginning-of-item) (setq beg (point)) (setq ind (org-get-indentation)) @@ -4126,7 +4270,7 @@ Error if not at a plain list, or if this is the last item in the list." (beginning-of-line 0) (if (looking-at "[ \t]*$") nil - (if (<= (setq ind1 (org-get-indentation)) ind) + (if (<= (org-get-indentation) ind) (throw 'exit t))))) (condition-case nil (org-beginning-of-item) @@ -4292,103 +4436,391 @@ with something like \"1.\" or \"2)\"." ;;; Archiving -(defun org-archive-subtree () +(defun org-archive-subtree (&optional find-done) "Move the current subtree to the archive. The archive can be a certain top-level heading in the current file, or in a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added." - (interactive) - ;; Save all relevant TODO keyword-relatex variables - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords org-todo-keywords) - (tr-org-todo-interpretation org-todo-interpretation) - (tr-org-done-string org-done-string) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (this-buffer (current-buffer)) - file heading buffer level newfile-p) - (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) +heading be marked DONE, and the current time will be added. + +When called with prefix argument FIND-DONE, find whole trees without any +open TODO items and archive them (after getting confirmation from the user). +If the cursor is not at a headline when this comand is called, try all level +1 trees. If the cursor is on a headline, only try the direct children of +this heading. " + (interactive "P") + (if find-done + (org-archive-all-done) + ;; Save all relevant TODO keyword-relatex variables + + (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler + (tr-org-todo-keywords org-todo-keywords) + (tr-org-todo-interpretation org-todo-interpretation) + (tr-org-done-string org-done-string) + (tr-org-todo-regexp org-todo-regexp) + (tr-org-todo-line-regexp org-todo-line-regexp) + (this-buffer (current-buffer)) + file heading buffer level newfile-p) + (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) + (progn + (setq file (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)) + (setq buffer (current-buffer))) + (unless buffer + (error "Cannot access file \"%s\"" file)) + (if (and (> (length heading) 0) + (string-match "^\\*+" heading)) + (setq level (match-end 0)) + (setq heading nil level 0)) + (save-excursion + ;; 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 + (let (this-command) (org-copy-subtree)) + (set-buffer buffer) + ;; Enforce org-mode for the archive buffer + (if (not (eq major-mode 'org-mode)) + ;; Force the mode for future visits. + (let ((org-insert-mode-line-in-empty-file t)) + (call-interactively 'org-mode))) + (when newfile-p + (goto-char (point-max)) + (insert (format "\nArchived entries from file %s\n\n" + (buffer-file-name this-buffer)))) + ;; Force the TODO keywords of the original buffer + (let ((org-todo-line-regexp tr-org-todo-line-regexp) + (org-todo-keywords tr-org-todo-keywords) + (org-todo-interpretation tr-org-todo-interpretation) + (org-done-string tr-org-done-string) + (org-todo-regexp tr-org-todo-regexp) + (org-todo-line-regexp tr-org-todo-line-regexp)) + (goto-char (point-min)) + (if heading + (progn + (if (re-search-forward + (concat "\\(^\\|\r\\)" + (regexp-quote heading) "[ \t]*\\($\\|\r\\)") + nil t) + (goto-char (match-end 0)) + ;; Heading not found, just insert it at the end + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "\n" heading "\n") + (end-of-line 0)) + ;; Make the subtree visible + (show-subtree) + (org-end-of-subtree t) + (skip-chars-backward " \t\r\n]") + (and (looking-at "[ \t\r\n]*") + (replace-match "\n\n"))) + ;; No specific heading, just go to end of file. + (goto-char (point-max)) (insert "\n")) + ;; Paste + (org-paste-subtree (1+ level)) + ;; Mark the entry as done, i.e. set to last work in org-todo-keywords + (if org-archive-mark-done + (org-todo (length org-todo-keywords))) + ;; Move cursor to right after the TODO keyword + (when org-archive-stamp-time + (beginning-of-line 1) + (looking-at org-todo-line-regexp) + (goto-char (or (match-end 2) (match-beginning 3))) + (insert "(" (format-time-string (cdr org-time-stamp-formats) + (org-current-time)) + ")")) + ;; 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 + ;; worked. So now cut the tree and finish up. + (let (this-command) (org-cut-subtree)) + (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) + (message "Subtree archived %s" + (if (eq this-buffer buffer) + (concat "under heading: " heading) + (concat "in file: " (abbreviate-file-name file))))))) + +(defun org-archive-all-done (&optional tag) + "Archive sublevels of the current tree without open TODO items. +If the cursor is not on a headline, try all level 1 trees. If +it is on a headline, try all direct children. +When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." + (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 + (rea (concat ".*:" org-archive-tag ":")) + (begm (make-marker)) + (endm (make-marker)) + (question (if tag "Set ARCHIVE tag (no open TODO items)? " + "Move subtree to archive (no open TODO items)? ")) + beg end (cntarch 0)) + (if (org-on-heading-p) (progn - (setq file (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)) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" file)) - (if (and (> (length heading) 0) - (string-match "^\\*+" heading)) - (setq level (match-end 0)) - (setq heading nil level 0)) + (setq re1 (concat "^" (regexp-quote + (make-string + (1+ (- (match-end 0) (match-beginning 0))) + ?*)) + " ")) + (move-marker begm (point)) + (move-marker endm (org-end-of-subtree))) + (setq re1 "^* ") + (move-marker begm (point-min)) + (move-marker endm (point-max))) (save-excursion - ;; 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 - (let (this-command) (org-copy-subtree)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (eq major-mode 'org-mode)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t)) - (call-interactively 'org-mode))) - (when newfile-p - (goto-char (point-max)) - (insert (format "\nArchived entries from file %s\n\n" - (buffer-file-name this-buffer)))) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords tr-org-todo-keywords) - (org-todo-interpretation tr-org-todo-interpretation) - (org-done-string tr-org-done-string) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp)) - (goto-char (point-min)) - (if heading - (progn - (if (re-search-forward - (concat "\\(^\\|\r\\)" - (regexp-quote heading) "[ \t]*\\($\\|\r\\)") - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "\n" heading "\n") - (end-of-line 0)) - ;; Make the subtree visible - (show-subtree) - (org-end-of-subtree t) - (skip-chars-backward " \t\r\n]") - (and (looking-at "[ \t\r\n]*") - (replace-match "\n\n"))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) (insert "\n")) - ;; Paste - (org-paste-subtree (1+ level)) - ;; Mark the entry as done, i.e. set to last work in org-todo-keywords - (if org-archive-mark-done - (org-todo (length org-todo-keywords))) - ;; Move cursor to right after the TODO keyword - (when org-archive-stamp-time - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (goto-char (or (match-end 2) (match-beginning 3))) - (insert "(" (format-time-string (cdr org-time-stamp-formats) - (org-current-time)) - ")")) - ;; 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 - ;; worked. So now cut the tree and finish up. - (let (this-command) (org-cut-subtree)) - (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) - (message "Subtree archived %s" - (if (eq this-buffer buffer) - (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name file)))))) + (goto-char begm) + (while (re-search-forward re1 endm t) + beg (match-beginning 0) + end (save-excursion (org-end-of-subtree t) (point))) + (goto-char beg) + (if (re-search-forward re end t) + (goto-char end) + (goto-char beg) + (if (and (or (not tag) (not (looking-at rea))) + (y-or-n-p question)) + (progn + (if tag + (org-toggle-tag org-archive-tag 'on) + (org-archive-subtree)) + (setq cntarch (1+ cntarch))) + (goto-char end)))) + (message "%d trees archived" cntarch))) + + +(defun org-cycle-hide-archived-subtrees (state) + "Re-hide all archived subtrees after a visibility state change." + (when (and (not org-cycle-open-archived-trees) + (not (memq state '(overview folded)))) + (save-excursion + (let* ((globalp (memq state '(contents all))) + (beg (if globalp (point-min) (point))) + (end (if globalp (point-max) (org-end-of-subtree)))) + (org-hide-archived-subtrees beg end))))) + +(defun org-hide-archived-subtrees (beg end) + "Re-hide all archived subtrees after a visibility state change." + (save-excursion + (let* ((re (concat ":" org-archive-tag ":"))) + (goto-char beg) + (while (re-search-forward re end t) + (and (org-on-heading-p) (hide-subtree)) + (org-end-of-subtree))))) + +(defun org-toggle-tag (tag &optional onoff) + "Toggle the tag TAG for the current line. +If ONOFF is `on' or `off', don't toggle but set to this state." + (unless (org-on-heading-p) (error "Not on headling")) + (let (res current) + (save-excursion + (beginning-of-line) + (if (re-search-forward "[ \t]:\\([a-zA-Z0-9_@:]+\\):[ \t]*$" + (point-at-eol) t) + (progn + (setq current (match-string 1)) + (replace-match "")) + (setq current "")) + (setq current (nreverse (org-split-string current ":"))) + (cond + ((eq onoff 'on) + (setq res t) + (or (member tag current) (push tag current))) + ((eq onoff 'off) + (or (not (member tag current)) (setq current (delete tag current)))) + (t (if (member tag current) + (setq current (delete tag current)) + (setq res t) + (push tag current)))) + (end-of-line 1) + (when current + (insert " :" (mapconcat 'identity (nreverse current) ":") ":")) + (org-set-tags nil t)) + res)) + +(defun org-toggle-archive-tag (&optional arg) + "Toggle the archive tag for the current headline. +With prefix ARG, check all children of current headline and offer tagging +the children that do not contain any open TODO items." + (interactive "P") + (if arg + (org-archive-all-done 'tag) + (let (set) + (save-excursion + (org-back-to-heading t) + (setq set (org-toggle-tag org-archive-tag)) + (when set (hide-subtree))) + (and set (beginning-of-line 1)) + (message "Subtree %s" (if set "archived" "unarchived"))))) + +(defun org-prepare-agenda-buffers (files) + "Create buffers for all agenda files, protect archived trees and comments." + (let ((pa '(:org-archived t)) + (pc '(:org-comment t)) + (pall '(:org-archived t :org-comment t)) + (rea (concat ":" org-archive-tag ":")) + file re) + (save-excursion + (while (setq file (pop files)) + (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file)) + (widen) + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (if (org-on-heading-p) + (add-text-properties (point-at-bol) (org-end-of-subtree) pa)))) + (goto-char (point-min)) + (setq re (concat "^\\*+ +" org-comment-string "\\>")) + (while (re-search-forward re nil t) + (add-text-properties + (match-beginning 0) (org-end-of-subtree) pc))))))) + +(defun org-agenda-skip () + "Throw to `:skip' in places that should be skipped." + (let ((p (point-at-bol))) + (and org-agenda-skip-archived-trees + (get-text-property p :org-archived) + (org-end-of-subtree) + (throw :skip t)) + (and (get-text-property p :org-comment) + (org-end-of-subtree) + (throw :skip t)) + (if (equal (char-after p) ?#) (throw :skip t)))) + +(defun org-agenda-toggle-archive-tag () + "Toggle the archive tag for the current entry." + (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)) + (buffer-read-only nil) + newhead) + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-hidden-entry) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (call-interactively 'org-toggle-archive-tag) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1))) + +;;; Dynamic blocks + +(defun org-find-dblock (name) + "Find the first dynamic block with name NAME in the buffer. +If not found, stay at current position and return nil." + (let (pos) + (save-excursion + (goto-char (point-min)) + (setq pos (and (re-search-forward (concat "^#\\+BEGIN:[ \t]+" name "\\>") + nil t) + (match-beginning 0)))) + (if pos (goto-char pos)) + pos)) + +(defconst org-dblock-start-re + "^#\\+BEGIN:[ \t]+\\(\\S-+\\)[ \t]+\\(.*\\)" + "Matches the startline of a dynamic block, with parameters.") + +(defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)" + "Matches the end of a dyhamic block.") + +(defun org-create-dblock (plist) + "Create a dynamic block section, with parameters taken from PLIST. +PLIST must containe a :name entry which is used as name of the block." + (unless (bolp) (newline)) + (let ((name (plist-get plist :name))) + (insert "#+BEGIN: " name) + (while plist + (if (eq (car plist) :name) + (setq plist (cddr plist)) + (insert " " (prin1-to-string (pop plist))))) + (insert "\n\n#+END:\n") + (beginning-of-line -2))) + +(defun org-prepare-dblock () + "Prepare dynamic block for refresh. +This empties the block, puts the cursor at the insert position and returns +the property list including an extra property :name with the block name." + (unless (looking-at org-dblock-start-re) + (error "Not at a dynamic block")) + (let* ((begdel (1+ (match-end 0))) + (name (match-string 1)) + (params (append (list :name name) + (read (concat "(" (match-string 2) ")"))))) + (unless (re-search-forward org-dblock-end-re nil t) + (error "Dynamic block not terminated")) + (delete-region begdel (match-beginning 0)) + (goto-char begdel) + (open-line 1) + params)) + +(defun org-map-dblocks (&optional command) + "Apply COMMAND to all dynamic blocks in the current buffer. +If COMMAND is not given, use `org-update-dblock'." + (let ((cmd (or command 'org-update-dblock)) + pos) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-dblock-start-re nil t) + (goto-char (setq pos (match-beginning 0))) + (condition-case nil + (funcall cmd) + (error (message "Error during update of dynamic block"))) + (goto-char pos) + (unless (re-search-forward org-dblock-end-re nil t) + (error "Dynamic block not terminated")))))) + +(defun org-dblock-update (&optional arg) + "User command for updating dynamic blocks. +Update the dynamic block at point. With prefix ARG, update all dynamic +blocks in the buffer." + (interactive "P") + (if arg + (org-update-all-dblocks) + (or (looking-at org-dblock-start-re) + (org-beginning-of-dblock)) + (org-update-dblock))) + +(defun org-update-dblock () + "Update the dynamic block at point +This means to empty the block, parse for parameters and then call +the correct writing function." + (let* ((pos (point)) + (params (org-prepare-dblock)) + (name (plist-get params :name)) + (cmd (intern (concat "org-dblock-write:" name)))) + (funcall cmd params) + (goto-char pos))) + +(defun org-beginning-of-dblock () + "Find the beginning of the dynamic block at point. +Error if there is no scuh block at point." + (let ((pos (point)) + beg) + (end-of-line 1) + (if (and (re-search-backward org-dblock-start-re nil t) + (setq beg (match-beginning 0)) + (re-search-forward org-dblock-end-re nil t) + (> (match-end 0) pos)) + (goto-char beg) + (goto-char pos) + (error "Not in a dynamic block")))) + +(defun org-update-all-dblocks () + "Update all dynamic blocks in the buffer. +This function can be used in a hook." + (when (eq major-mode 'org-mode) + (org-map-dblocks 'org-update-dblock))) + ;;; Completion @@ -4662,9 +5094,8 @@ be removed." (format-time-string (car org-time-stamp-formats) time)) (setq what nil)) (save-excursion - (let (beg end col list elt (buffer-invisibility-spec nil) ts) + (let (col list elt (buffer-invisibility-spec nil) ts) (org-back-to-heading t) - (setq beg (point)) (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) (goto-char (match-end 1)) (setq col (current-column)) @@ -4734,6 +5165,8 @@ that the match should indeed be shown." (org-show-hierarchy-above)))) (org-add-hook 'before-change-functions 'org-remove-occur-highlights nil 'local) + (unless org-sparse-tree-open-archived-trees + (org-hide-archived-subtrees (point-min) (point-max))) (run-hooks 'org-occur-hook) (if (interactive-p) (message "%d match(es) for regexp %s" cnt regexp)) @@ -4777,22 +5210,25 @@ that the match should indeed be shown." (overlay-put ovl prop value))) (defvar org-occur-highlights nil) +(make-variable-buffer-local 'org-occur-highlights) (defun org-highlight-new-match (beg end) "Highlight from BEG to END and mark the highlight is an occur headline." (let ((ov (org-make-overlay beg end))) (org-overlay-put ov 'face 'secondary-selection) (push ov org-occur-highlights))) +(defvar org-inhibit-highlight-removal nil) (defun org-remove-occur-highlights (&optional beg end noremove) "Remove the occur highlights from the buffer. BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) - (mapc 'org-delete-overlay org-occur-highlights) - (setq org-occur-highlights nil) - (unless noremove - (remove-hook 'before-change-functions - 'org-remove-occur-highlights 'local))) + (unless org-inhibit-highlight-removal + (mapc 'org-delete-overlay org-occur-highlights) + (setq org-occur-highlights nil) + (unless noremove + (remove-hook 'before-change-functions + 'org-remove-occur-highlights 'local)))) ;;; Priorities @@ -5449,15 +5885,16 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline." (interactive) - (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) - (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" + (let* ((bmp (buffer-modified-p)) + (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" org-clock-string ".*=>[ \t]*\\([0-9]+\\):\\([0-9]+\\)[ \t]*$")) (lmax 30) (ltimes (make-vector lmax 0)) (t1 0) (level 0) - (lastlevel 0) time) + time) + (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) (save-excursion (goto-char (point-max)) (while (re-search-backward re nil t) @@ -5475,7 +5912,8 @@ Puts the resulting times in minutes as a text property on each headline." (aset ltimes l 0)) (goto-char (match-beginning 0)) (put-text-property (point) (point-at-eol) :org-clock-minutes time)))) - (setq org-clock-file-total-minutes (aref ltimes 0))))) + (setq org-clock-file-total-minutes (aref ltimes 0))) + (set-buffer-modified-p bmp))) (defun org-clock-display (&optional total-only) "Show subtree times in the entire buffer. @@ -5500,6 +5938,8 @@ in the echo area." (message "Total file time: %d:%02d (%d hours and %d minutes)" h m h m))) (defvar org-clock-overlays nil) +(make-variable-buffer-local 'org-clock-overlays) + (defun org-put-clock-overlay (time &optional level) "Put an overlays on the current line, displaying TIME. If LEVEL is given, prefix time with a corresponding number of stars. @@ -5510,11 +5950,11 @@ will be easy to remove." (off 0) ov tx) (move-to-column c) - (if (eolp) (setq off 1)) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (org-make-overlay (- (point) off) (point-at-eol)) - tx (concat (make-string (+ off (max 0 (- c (current-column)))) ?.) + (setq ov (org-make-overlay (1- (point)) (point-at-eol)) + tx (concat (buffer-substring (1- (point)) (point)) + (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (format "%s %2d:%02d%s" (make-string l ?*) h m (make-string (- 10 l) ?\ )) @@ -5528,11 +5968,12 @@ will be easy to remove." BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) - (mapc 'org-delete-overlay org-clock-overlays) - (setq org-clock-overlays nil) - (unless noremove - (remove-hook 'before-change-functions - 'org-remove-clock-overlays 'local))) + (unless org-inhibit-highlight-removal + (mapc 'org-delete-overlay org-clock-overlays) + (setq org-clock-overlays nil) + (unless noremove + (remove-hook 'before-change-functions + 'org-remove-clock-overlays 'local)))) (defun org-clock-out-if-current () "Clock out if the current entry contains the running clock. @@ -5557,6 +5998,112 @@ If yes, offer to stop it and to save the buffer with the changes." (when (y-or-n-p "Save changed buffer?") (save-buffer)))) +(defun org-clock-report () + "Create a table containing a report about clocked time. +If the buffer contains lines +#+BEGIN: clocktable :maxlevel 3 :emphasize nil + +#+END: clocktable +then the table will be inserted between these lines, replacing whatever +is was there before. If these lines are not in the buffer, the table +is inserted at point, surrounded by the special lines. +The BEGIN line can contain parameters. Allowed are: +:maxlevel The maximum level to be included in the table. Default is 3. +:emphasize t/nil, if levell 1 and level 2 should be bold/italic in the table." + (interactive) + (org-remove-clock-overlays) + (unless (org-find-dblock "clocktable") + (org-create-dblock (list :name "clocktable" + :maxlevel 2 :emphasize nil))) + (org-update-dblock)) + +(defun org-dblock-write:clocktable (params) + "Write the standard clocktable." + (let ((hlchars '((1 . "*") (2 . ?/))) + (emph nil) + (ins (make-marker)) + ipos time h m p level hlc hdl maxlevel) + (setq maxlevel (or (plist-get params :maxlevel) 3) + emph (plist-get params :emphasize)) + (move-marker ins (point)) + (setq ipos (point)) + (insert-before-markers "Clock summary at [" + (substring + (format-time-string (cdr org-time-stamp-formats)) + 1 -1) + "]\n|L|Headline|Time|\n") + (org-clock-sum) + (setq h (/ org-clock-file-total-minutes 60) + m (- org-clock-file-total-minutes (* 60 h))) + (insert-before-markers "|-\n|0|" "*Total file time*| " + (format "*%d:%02d*" h m) + "|\n") + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) :org-clock-minutes)) + (goto-char p) + (when (setq time (get-text-property p :org-clock-minutes)) + (beginning-of-line 1) + (when (and (looking-at "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[0-9a-zA-Z_@:]+:\\)?[ \t]*$") + (setq level (- (match-end 1) (match-beginning 1))) + (<= level maxlevel)) + (setq hlc (if emph (or (cdr (assoc level hlchars)) "") "") + hdl (match-string 2) + h (/ time 60) + m (- time (* 60 h))) + (save-excursion + (goto-char ins) + (if (= level 1) (insert-before-markers "|-\n")) + (insert-before-markers + "| " (int-to-string level) "|" hlc hdl hlc " |" + (make-string (1- level) ?|) + hlc + (format "%d:%02d" h m) + hlc + " |\n"))))) + (goto-char ins) + (backward-delete-char 1) + (goto-char ipos) + (skip-chars-forward "^|") + (org-table-align))) + +(defun org-collect-clock-time-entries () + "Return an internal list with clocking information. +This list has one entry for each CLOCK interval. +FIXME: describe the elements." + (interactive) + (let ((re (concat "^[ \t]*" org-clock-string + " *\\[\\(.*?\\)\\]--\\[\\(.*?\\)\\]")) + rtn beg end next cont level title total closedp leafp + clockpos titlepos h m donep) + (save-excursion + (org-clock-sum) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (setq clockpos (match-beginning 0) + beg (match-string 1) end (match-string 2) + cont (match-end 0)) + (setq beg (apply 'encode-time (org-parse-time-string beg)) + end (apply 'encode-time (org-parse-time-string end))) + (org-back-to-heading t) + (setq donep (org-entry-is-done-p)) + (setq titlepos (point) + total (or (get-text-property (1+ (point)) :org-clock-minutes) 0) + h (/ total 60) m (- total (* 60 h)) + total (cons h m)) + (looking-at "\\(\\*+\\) +\\(.*\\)") + (setq level (- (match-end 1) (match-beginning 1)) + title (org-match-string-no-properties 2)) + (save-excursion (outline-next-heading) (setq next (point))) + (setq closedp (re-search-forward org-closed-time-regexp next t)) + (goto-char next) + (setq leafp (and (looking-at "^\\*+ ") + (<= (- (match-end 0) (point)) level))) + (push (list beg end clockpos closedp donep + total title titlepos level leafp) + rtn) + (goto-char cont))) + (nreverse rtn))) + ;;; Agenda, and Diary Integration ;;; Define the mode @@ -5616,6 +6163,7 @@ The following commands are available: (define-key org-agenda-mode-map "o" 'delete-other-windows) (define-key org-agenda-mode-map "L" 'org-agenda-recenter) (define-key org-agenda-mode-map "t" 'org-agenda-todo) +(define-key org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) (define-key org-agenda-mode-map ":" 'org-agenda-set-tags) (define-key org-agenda-mode-map "." 'org-agenda-goto-today) (define-key org-agenda-mode-map "d" 'org-agenda-day-view) @@ -5983,6 +6531,7 @@ dates." (past t) args s e rtn d emptyp) + (org-prepare-agenda-buffers org-agenda-files) (setq org-agenda-redo-command (list 'progn (list 'switch-to-buffer-other-window (current-buffer)) @@ -6077,6 +6626,7 @@ NDAYS defaults to `org-agenda-ndays'." (day-numbers (list start)) (inhibit-redisplay t) s e rtn rtnall file date d start-pos end-pos todayp nd) + (org-prepare-agenda-buffers files) (setq org-agenda-redo-command (list 'org-agenda-list (list 'quote include-all) start-day ndays t)) ;; Make the list of days @@ -6212,6 +6762,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in '(org-todo-list (or current-prefix-arg last-arg) t)) (setq files (org-agenda-files) rtnall nil) + (org-prepare-agenda-buffers files) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) @@ -6820,8 +7371,11 @@ the documentation of `org-diary'." ee txt) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (when (not (and org-agenda-todo-ignore-scheduled - (save-match-data (looking-at sched-re)))) + (catch :skip + (and org-agenda-todo-ignore-scheduled + (looking-at sched-re) + (throw :skip nil)) + (org-agenda-skip) (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (1+ (match-beginning 0))) category (org-get-category) @@ -6833,14 +7387,14 @@ the documentation of `org-diary'." (- org-todo-kwd-max-priority -2 (length (member (match-string 2) org-todo-keywords))) - 1))) + 1))) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'priority priority 'category category) - (push txt ee)) - (if org-agenda-todo-list-sublevels - (goto-char (match-end 1)) - (org-end-of-subtree 'invisible))) + (push txt ee) + (if org-agenda-todo-list-sublevels + (goto-char (match-end 1)) + (org-end-of-subtree 'invisible)))) (nreverse ee))) (defconst org-agenda-no-heading-message @@ -6866,50 +7420,51 @@ the documentation of `org-diary'." ee txt timestr tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (if (not (save-match-data (org-at-date-range-p))) - (progn - (setq marker (org-agenda-new-marker (match-beginning 0)) - category (org-get-category (match-beginning 0)) - tmp (buffer-substring (max (point-min) - (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0)) - timestr (buffer-substring (match-beginning 0) (point-at-eol)) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - donep (org-entry-is-done-p)) - (if (string-match ">" timestr) - ;; substring should only run to end of time stamp - (setq timestr (substring timestr 0 (match-end 0)))) - (save-excursion - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) - (progn - (goto-char (match-end 1)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item - (format "%s%s" - (if deadlinep "Deadline: " "") - (if scheduledp "Scheduled: " "")) - (match-string 1) category tags timestr))) - (setq txt org-agenda-no-heading-message)) - (setq priority (org-get-priority txt)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker) - (if deadlinep - (org-add-props txt nil - 'face (if donep 'org-done 'org-warning) - 'undone-face 'org-warning 'done-face 'org-done - 'category category 'priority (+ 100 priority)) - (if scheduledp - (org-add-props txt nil - 'face 'org-scheduled-today - 'undone-face 'org-scheduled-today 'done-face 'org-done - 'category category 'priority (+ 99 priority)) - (org-add-props txt nil 'priority priority 'category category))) - (push txt ee)) - (outline-next-heading)))) + (catch :skip + (and (save-match-data (org-at-date-range-p)) (throw :skip nil)) + (org-agenda-skip) + (setq marker (org-agenda-new-marker (match-beginning 0)) + category (org-get-category (match-beginning 0)) + tmp (buffer-substring (max (point-min) + (- (match-beginning 0) + org-ds-keyword-length)) + (match-beginning 0)) + timestr (buffer-substring (match-beginning 0) (point-at-eol)) + deadlinep (string-match org-deadline-regexp tmp) + scheduledp (string-match org-scheduled-regexp tmp) + donep (org-entry-is-done-p)) + (if (string-match ">" timestr) + ;; substring should only run to end of time stamp + (setq timestr (substring timestr 0 (match-end 0)))) + (save-excursion + (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (progn + (goto-char (match-end 1)) + (setq hdmarker (org-agenda-new-marker) + tags (org-get-tags-at)) + (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (setq txt (org-format-agenda-item + (format "%s%s" + (if deadlinep "Deadline: " "") + (if scheduledp "Scheduled: " "")) + (match-string 1) category tags timestr))) + (setq txt org-agenda-no-heading-message)) + (setq priority (org-get-priority txt)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker) + (if deadlinep + (org-add-props txt nil + 'face (if donep 'org-done 'org-warning) + 'undone-face 'org-warning 'done-face 'org-done + 'category category 'priority (+ 100 priority)) + (if scheduledp + (org-add-props txt nil + 'face 'org-scheduled-today + 'undone-face 'org-scheduled-today 'done-face 'org-done + 'category category 'priority (+ 99 priority)) + (org-add-props txt nil 'priority priority 'category category))) + (push txt ee)) + (outline-next-heading))) (nreverse ee))) (defun org-agenda-get-closed () @@ -6933,35 +7488,35 @@ the documentation of `org-diary'." ee txt timestr) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (if (not (save-match-data (org-at-date-range-p))) - (progn - (setq marker (org-agenda-new-marker (match-beginning 0)) - closedp (equal (match-string 1) org-closed-string) - category (org-get-category (match-beginning 0)) - timestr (buffer-substring (match-beginning 0) (point-at-eol)) - ;; donep (org-entry-is-done-p) - ) - (if (string-match "\\]" timestr) - ;; substring should only run to end of time stamp - (setq timestr (substring timestr 0 (match-end 0)))) - (save-excursion - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) - (progn - (goto-char (match-end 1)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item - (if closedp "Closed: " "Clocked: ") - (match-string 1) category tags timestr))) - (setq txt org-agenda-no-heading-message)) - (setq priority 100000) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done - 'priority priority 'category category - 'undone-face 'org-warning 'done-face 'org-done) - (push txt ee)) - (outline-next-heading)))) + (catch :skip + (org-agenda-skip) + (setq marker (org-agenda-new-marker (match-beginning 0)) + closedp (equal (match-string 1) org-closed-string) + category (org-get-category (match-beginning 0)) + timestr (buffer-substring (match-beginning 0) (point-at-eol)) + ;; donep (org-entry-is-done-p) + ) + (if (string-match "\\]" timestr) + ;; substring should only run to end of time stamp + (setq timestr (substring timestr 0 (match-end 0)))) + (save-excursion + (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (progn + (goto-char (match-end 1)) + (setq hdmarker (org-agenda-new-marker) + tags (org-get-tags-at)) + (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (setq txt (org-format-agenda-item + (if closedp "Closed: " "Clocked: ") + (match-string 1) category tags timestr))) + (setq txt org-agenda-no-heading-message)) + (setq priority 100000) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done + 'priority priority 'category category + 'undone-face 'org-warning 'done-face 'org-done) + (push txt ee)) + (outline-next-heading))) (nreverse ee))) (defun org-agenda-get-deadlines () @@ -6980,41 +7535,43 @@ the documentation of `org-diary'." ee txt head face) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (setq pos (1- (match-beginning 1)) - d2 (time-to-days - (org-time-string-to-time (match-string 1))) - diff (- d2 d1)) - ;; When to show a deadline in the calendar: - ;; If the expiration is within wdays warning time. - ;; Past-due deadlines are only shown on the current date - (if (and (< diff wdays) todayp (not (= diff 0))) - (save-excursion - (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) - (progn - (goto-char (match-end 0)) - (setq pos1 (match-end 1)) - (setq tags (org-get-tags-at pos1)) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") - (point)))) - (if (string-match org-looking-at-done-regexp head) - (setq txt nil) - (setq txt (org-format-agenda-item - (format "In %3d d.: " diff) head category tags)))) - (setq txt org-agenda-no-heading-message)) - (when txt - (setq face (cond ((<= diff 0) 'org-warning) - ((<= diff 5) 'org-upcoming-deadline) - (t nil))) - (org-add-props txt props - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker pos1) - 'priority (+ (- 10 diff) (org-get-priority txt)) - 'category category - 'face face 'undone-face face 'done-face 'org-done) - (push txt ee))))) + (catch :skip + (org-agenda-skip) + (setq pos (1- (match-beginning 1)) + d2 (time-to-days + (org-time-string-to-time (match-string 1))) + diff (- d2 d1)) + ;; When to show a deadline in the calendar: + ;; If the expiration is within wdays warning time. + ;; Past-due deadlines are only shown on the current date + (if (and (< diff wdays) todayp (not (= diff 0))) + (save-excursion + (setq category (org-get-category)) + (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) + (progn + (goto-char (match-end 0)) + (setq pos1 (match-end 1)) + (setq tags (org-get-tags-at pos1)) + (setq head (buffer-substring-no-properties + (point) + (progn (skip-chars-forward "^\r\n") + (point)))) + (if (string-match org-looking-at-done-regexp head) + (setq txt nil) + (setq txt (org-format-agenda-item + (format "In %3d d.: " diff) head category tags)))) + (setq txt org-agenda-no-heading-message)) + (when txt + (setq face (cond ((<= diff 0) 'org-warning) + ((<= diff 5) 'org-upcoming-deadline) + (t nil))) + (org-add-props txt props + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker pos1) + 'priority (+ (- 10 diff) (org-get-priority txt)) + 'category category + 'face face 'undone-face face 'done-face 'org-done) + (push txt ee)))))) ee)) (defun org-agenda-get-scheduled () @@ -7035,36 +7592,38 @@ the documentation of `org-diary'." ee txt head) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (setq pos (1- (match-beginning 1)) - d2 (time-to-days - (org-time-string-to-time (match-string 1))) - diff (- d2 d1)) - ;; When to show a scheduled item in the calendar: - ;; If it is on or past the date. - (if (and (< diff 0) todayp) - (save-excursion - (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) - (progn - (goto-char (match-end 0)) - (setq pos1 (match-end 1)) - (setq tags (org-get-tags-at)) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") (point)))) - (if (string-match org-looking-at-done-regexp head) - (setq txt nil) - (setq txt (org-format-agenda-item - (format "Sched.%2dx: " (- 1 diff)) head - category tags)))) - (setq txt org-agenda-no-heading-message)) - (when txt - (org-add-props txt props - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker pos1) - 'priority (+ (- 5 diff) (org-get-priority txt)) - 'category category) - (push txt ee))))) + (catch :skip + (org-agenda-skip) + (setq pos (1- (match-beginning 1)) + d2 (time-to-days + (org-time-string-to-time (match-string 1))) + diff (- d2 d1)) + ;; When to show a scheduled item in the calendar: + ;; If it is on or past the date. + (if (and (< diff 0) todayp) + (save-excursion + (setq category (org-get-category)) + (if (re-search-backward "\\(^\\|\r\\)\\*+[ \t]*" nil t) + (progn + (goto-char (match-end 0)) + (setq pos1 (match-end 1)) + (setq tags (org-get-tags-at)) + (setq head (buffer-substring-no-properties + (point) + (progn (skip-chars-forward "^\r\n") (point)))) + (if (string-match org-looking-at-done-regexp head) + (setq txt nil) + (setq txt (org-format-agenda-item + (format "Sched.%2dx: " (- 1 diff)) head + category tags)))) + (setq txt org-agenda-no-heading-message)) + (when txt + (org-add-props txt props + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker pos1) + 'priority (+ (- 5 diff) (org-get-priority txt)) + 'category category) + (push txt ee)))))) ee)) (defun org-agenda-get-blocks () @@ -7081,34 +7640,36 @@ the documentation of `org-diary'." marker hdmarker ee txt d1 d2 s1 s2 timestr category tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (setq timestr (match-string 0) - s1 (match-string 1) - s2 (match-string 2) - d1 (time-to-days (org-time-string-to-time s1)) - d2 (time-to-days (org-time-string-to-time s2))) - (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) - ;; Only allow days between the limits, because the normal - ;; date stamps will catch the limits. - (save-excursion - (setq marker (org-agenda-new-marker (point))) - (setq category (org-get-category)) - (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) - (progn - (setq hdmarker (org-agenda-new-marker (match-end 1))) - (goto-char (match-end 1)) - (setq tags (org-get-tags-at)) - (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item - (format (if (= d1 d2) "" "(%d/%d): ") - (1+ (- d0 d1)) (1+ (- d2 d1))) - (match-string 1) category tags - (if (= d0 d1) timestr)))) - (setq txt org-agenda-no-heading-message)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker - 'priority (org-get-priority txt) 'category category) - (push txt ee))) - (outline-next-heading)) + (catch :skip + (org-agenda-skip) + (setq timestr (match-string 0) + s1 (match-string 1) + s2 (match-string 2) + d1 (time-to-days (org-time-string-to-time s1)) + d2 (time-to-days (org-time-string-to-time s2))) + (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) + ;; Only allow days between the limits, because the normal + ;; date stamps will catch the limits. + (save-excursion + (setq marker (org-agenda-new-marker (point))) + (setq category (org-get-category)) + (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) + (progn + (setq hdmarker (org-agenda-new-marker (match-end 1))) + (goto-char (match-end 1)) + (setq tags (org-get-tags-at)) + (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") + (setq txt (org-format-agenda-item + (format (if (= d1 d2) "" "(%d/%d): ") + (1+ (- d0 d1)) (1+ (- d2 d1))) + (match-string 1) category tags + (if (= d0 d1) timestr)))) + (setq txt org-agenda-no-heading-message)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker + 'priority (org-get-priority txt) 'category category) + (push txt ee))) + (outline-next-heading))) ;; Sort the entries by expiration date. (nreverse ee))) @@ -7709,9 +8270,7 @@ be used to request time specification in the time stamp." (org-agenda-check-no-diary) (let* ((marker (or (get-text-property (point) 'org-marker) (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (hdmarker (get-text-property (point) 'org-hd-marker))) + (pos (marker-position marker))) (with-current-buffer (marker-buffer marker) (widen) (goto-char pos) @@ -7877,53 +8436,59 @@ are included in the output." lspos tags tags-list tags-alist (llast 0) rtn level category i txt todo marker) - (save-excursion (goto-char (point-min)) (when (eq action 'sparse-tree) (org-overview)) (while (re-search-forward re nil t) - (setq todo (if (match-end 1) (match-string 2)) - tags (if (match-end 4) (match-string 4))) - (goto-char (setq lspos (1+ (match-beginning 0)))) - (setq level (funcall outline-level) - category (org-get-category)) - (setq i llast llast level) - ;; remove tag lists from same and sublevels - (while (>= i level) - (when (setq entry (assoc i tags-alist)) - (setq tags-alist (delete entry tags-alist))) - (setq i (1- i))) - ;; add the nex tags - (when tags - (setq tags (mapcar 'downcase (org-split-string tags ":")) - tags-alist - (cons (cons level tags) tags-alist))) - ;; compile tags for current headline - (setq tags-list - (if org-use-tag-inheritance - (apply 'append (mapcar 'cdr tags-alist)) - tags)) - (when (and (or (not todo-only) todo) - (eval matcher)) - ;; list this headline - (if (eq action 'sparse-tree) - (progn - (org-show-hierarchy-above)) - (setq txt (org-format-agenda-item - "" - (concat - (if org-tags-match-list-sublevels - (make-string (1- level) ?.) "") - (org-get-heading)) - category tags-list)) - (goto-char lspos) - (setq marker (org-agenda-new-marker)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker 'category category) - (push txt rtn)) - ;; if we are to skip sublevels, jump to end of subtree - (point) - (or org-tags-match-list-sublevels (org-end-of-subtree))))) + (catch :skip + (and (eq action 'agenda) (org-agenda-skip)) + (setq todo (if (match-end 1) (match-string 2)) + tags (if (match-end 4) (match-string 4))) + (goto-char (setq lspos (1+ (match-beginning 0)))) + (setq level (funcall outline-level) + category (org-get-category)) + (setq i llast llast level) + ;; remove tag lists from same and sublevels + (while (>= i level) + (when (setq entry (assoc i tags-alist)) + (setq tags-alist (delete entry tags-alist))) + (setq i (1- i))) + ;; add the nex tags + (when tags + (setq tags (mapcar 'downcase (org-split-string tags ":")) + tags-alist + (cons (cons level tags) tags-alist))) + ;; compile tags for current headline + (setq tags-list + (if org-use-tag-inheritance + (apply 'append (mapcar 'cdr tags-alist)) + tags)) + (when (and (or (not todo-only) todo) + (eval matcher) + (or (not org-agenda-skip-archived-trees) + (not (member org-archive-tag tags-list)))) + ;; list this headline + (if (eq action 'sparse-tree) + (progn + (org-show-hierarchy-above)) + (setq txt (org-format-agenda-item + "" + (concat + (if org-tags-match-list-sublevels + (make-string (1- level) ?.) "") + (org-get-heading)) + category tags-list)) + (goto-char lspos) + (setq marker (org-agenda-new-marker)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker 'category category) + (push txt rtn)) + ;; if we are to skip sublevels, jump to end of subtree + (point) + (or org-tags-match-list-sublevels (org-end-of-subtree)))))) + (when (and (eq action 'sparse-tree) + (not org-sparse-tree-open-archived-trees)) + (org-hide-archived-subtrees (point-min) (point-max))) (nreverse rtn))) (defun org-tags-sparse-tree (&optional arg match) @@ -7994,6 +8559,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (list 'if 'current-prefix-arg nil match) t)) (setq files (org-agenda-files) rtnall nil) + (org-prepare-agenda-buffers files) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) @@ -8084,7 +8650,11 @@ With prefix ARG, realign all tags in headings in the current buffer." (setq hd (match-string 1)) (delete-region (match-beginning 0) (match-end 0)) (insert-before-markers (org-trim hd) (if empty "" " "))) - (unless (equal tags "") + (if (equal tags "") + (save-excursion + (beginning-of-line 1) + (and (re-search-forward "[ \t]+$" (point-at-eol) t) + (replace-match ""))) (move-to-column (max (current-column) (if (> org-tags-column 0) org-tags-column @@ -8590,7 +9160,7 @@ in all files." (defun org-search-not-link (&rest args) "Execute `re-search-forward', but only accept matches that are not a link." (catch 'exit - (let ((pos (point)) p1) + (let (p1) (while (apply 're-search-forward args) (setq p1 (point)) (if (not (save-match-data @@ -8990,24 +9560,23 @@ If the file does not exist, an error is thrown." (setq in-emacs (or in-emacs line search)) (let* ((file (if (equal path "") buffer-file-name - (convert-standard-filename (org-expand-file-name path)))) - (dirp (file-directory-p file)) + path)) + (apps (append org-file-apps (org-default-apps))) + (remp (and (assq 'remote apps) (org-file-remote-p file))) + (dirp (if remp nil (file-directory-p file))) (dfile (downcase file)) (old-buffer (current-buffer)) (old-pos (point)) (old-mode major-mode) - ext cmd apps) - (if (and (not (file-exists-p file)) - (not org-open-non-existing-files)) - (error "No such file: %s" file)) + ext cmd) (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) (setq ext (match-string 1 dfile)) (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) (setq ext (match-string 1 dfile)))) - (setq apps (append org-file-apps (org-default-apps))) (if in-emacs (setq cmd 'emacs) - (setq cmd (or (and dirp (cdr (assoc 'directory apps))) + (setq cmd (or (and remp (cdr (assoc 'remote apps))) + (and dirp (cdr (assoc 'directory apps))) (cdr (assoc ext apps)) (cdr (assoc t apps))))) (when (eq cmd 'mailcap) @@ -9018,6 +9587,10 @@ If the file does not exist, an error is thrown." (if (stringp command) (setq cmd command) (setq cmd 'emacs)))) + (if (and (not (eq cmd 'emacs)) ; Emacs has not problems with non-ex files + (not (file-exists-p file)) + (not org-open-non-existing-files)) + (error "No such file: %s" file)) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) ;; Normalize use of quote, this can vary. @@ -9028,8 +9601,9 @@ If the file does not exist, an error is thrown." (shell-command (concat cmd " &")))) ((or (stringp cmd) (eq cmd 'emacs)) - (unless (equal (file-truename file) (file-truename (or buffer-file-name ""))) - (funcall (cdr (assq 'file org-link-frame-setup)) file)) +; (unless (equal (file-truename file) (file-truename (or buffer-file-name ""))) +; (funcall (cdr (assq 'file org-link-frame-setup)) file)) + (funcall (cdr (assq 'file org-link-frame-setup)) file) (if line (goto-line line) (if search (org-link-search search)))) ((consp cmd) @@ -9053,6 +9627,20 @@ If the file does not exist, an error is thrown." "Replace special path abbreviations and expand the file name." (expand-file-name path)) +(defun org-file-remote-p (file) + "Test whether FILE specifies a location on a remote system. +Return non-nil if the location is indeed remote. + +For example, the filename \"/user@host:/foo\" specifies a location +on the system \"/user@host:\"." + (cond ((fboundp 'file-remote-p) + (file-remote-p file)) + ((fboundp 'tramp-handle-file-remote-p) + (tramp-handle-file-remote-p file)) + ((and (boundp 'ange-ftp-name-format) + (string-match ange-ftp-name-format file)) + t) + (t nil))) (defvar org-insert-link-history nil "Minibuffer history for links inserted with `org-insert-link'.") @@ -9186,8 +9774,8 @@ For file links, arg negates `org-context-in-file-links'." (setq cpltxt (url-view-url t) link (org-make-link cpltxt))) ((eq major-mode 'w3m-mode) - (setq cpltxt w3m-current-url - link (org-make-link cpltxt))) + (setq cpltxt (or w3m-current-title w3m-current-url) + link (org-make-link w3m-current-url))) ((setq search (run-hook-with-args-until-success 'org-create-file-search-functions)) @@ -9195,6 +9783,11 @@ For file links, arg negates `org-context-in-file-links'." "::" search)) (setq cpltxt (or description link))) + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link (org-make-link cpltxt))) + ((eq major-mode 'org-mode) ;; Just link to current headline (setq cpltxt (concat "file:" @@ -9414,7 +10007,9 @@ subdirectory. Otherwise, the link will be the absolute path as completed in the minibuffer (i.e. normally ~/path/to/file). With two \\[universal-argument] prefixes, enforce an absolute path even if the file -is in the current directory or below." +is in the current directory or below. +With three \\[universal-argument] prefixes, negate the meaning of +`org-keep-stored-link-after-insertion'." (interactive "P") (let (link desc entry remove file (pos (point))) (cond @@ -9430,7 +10025,7 @@ is in the current directory or below." (setq link (read-string "Link: " (org-link-unescape (org-match-string-no-properties 1))))) - (complete-file + ((equal complete-file '(4)) ;; Completing read for file names. (setq file (read-file-name "File: ")) (let ((pwd (file-name-as-directory (expand-file-name "."))) @@ -9455,7 +10050,8 @@ is in the current directory or below." org-insert-link-history (or (car (car org-stored-links))))) (setq entry (assoc link org-stored-links)) - (if (not org-keep-stored-link-after-insertion) + (if (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-keep-stored-link-after-insertion)) (setq org-stored-links (delq (assoc link org-stored-links) org-stored-links))) (setq link (if entry (nth 1 entry) link) @@ -9908,7 +10504,7 @@ This is being used to correctly align a single field after TAB or RET.") (linepos (+ (if (bolp) 1 0) (count-lines (point-min) (point)))) (colpos (org-table-current-column)) (winstart (window-start)) - text lines (new "") lengths l typenums ty fields maxfields i + lines (new "") lengths l typenums ty fields maxfields i column (indent "") cnt frac rfmt hfmt @@ -9919,7 +10515,7 @@ This is being used to correctly align a single field after TAB or RET.") (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) (hfmt1 (concat (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings xx links narrow fmax fmin f1 len c e) + emptystrings links narrow fmax f1 len c e) (untabify beg end) (remove-text-properties beg end '(org-cwidth t display t)) ;; Check if we have links @@ -12055,9 +12651,11 @@ overwritten, and the table is not marked as requiring realignment." (:headline-levels . org-export-headline-levels) (:section-numbers . org-export-with-section-numbers) (:table-of-contents . org-export-with-toc) + (:archived-trees . org-export-with-archived-trees) (:emphasize . org-export-with-emphasize) (:sub-superscript . org-export-with-sub-superscripts) (:TeX-macros . org-export-with-TeX-macros) + (:LaTeX-fragments . org-export-with-LaTeX-fragments) (:fixed-width . org-export-with-fixed-width) (:timestamps . org-export-with-timestamps) (:tables . org-export-with-tables) @@ -12088,7 +12686,6 @@ overwritten, and the table is not marked as requiring realignment." (goto-char 0) (let ((re (org-make-options-regexp '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) - (text nil) p key val text options) (while (re-search-forward re nil t) (setq key (org-match-string-no-properties 1) @@ -12112,7 +12709,8 @@ overwritten, and the table is not marked as requiring realignment." ("|" . :tables) ("^" . :sub-superscript) ("*" . :emphasize) - ("TeX" . :TeX-macros))) + ("TeX" . :TeX-macros) + ("LaTeX" . :LaTeX-fragments))) o) (while (setq o (pop op)) (if (string-match (concat (regexp-quote (car o)) @@ -12199,7 +12797,8 @@ ones and overrule settings in the other lists." \[X] publish... (project will be prompted for) \[A] publish all projects") (cmds - '((?v . org-export-visible) + '((?t . org-insert-export-options-template) + (?v . org-export-visible) (?a . org-export-as-ascii) (?h . org-export-as-html) (?b . org-export-as-html-and-open) @@ -12526,32 +13125,56 @@ translations. There is currently no way for users to extend this.") (defun org-cleaned-string-for-export (string &rest parameters) "Cleanup a buffer substring so that links can be created safely." (interactive) - (let* ((cb (current-buffer)) - (re-radio (and org-target-link-regexp + (let* ((re-radio (and org-target-link-regexp (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))) (re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) + (re-archive (concat ":" org-archive-tag ":")) rtn) (save-excursion (set-buffer (get-buffer-create " org-mode-tmp")) (erase-buffer) (insert string) - (org-mode) + (let ((org-inhibit-startup t)) (org-mode)) + + ;; Get rid of archived trees + (when (not (eq org-export-with-archived-trees t)) + (goto-char (point-min)) + (while (re-search-forward re-archive nil t) + (if (not (org-on-heading-p)) + (org-end-of-subtree t) + (beginning-of-line 1) + (delete-region + (if org-export-with-archived-trees (1+ (point-at-eol)) (point)) + (org-end-of-subtree))))) + ;; Find targets in comments and move them out of comments, ;; but mark them as targets that should be invisible (goto-char (point-min)) (while (re-search-forward "^#.*?\\(<<<?[^>\r\n]+>>>?\\).*" nil t) (replace-match "\\1(INVISIBLE)")) + ;; Find matches for radio targets and turn them into internal links (goto-char (point-min)) (when re-radio (while (re-search-forward re-radio nil t) (replace-match "\\1[[\\2]]"))) + ;; Find all links that contain a newline and put them into a single line (goto-char (point-min)) (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) (replace-match "\\1 \\3") (goto-char (match-beginning 0))) + + ;; Convert LaTeX fragments to images + (when (memq :LaTeX-fragments parameters) + (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 "Expriting...") + ;; Normalize links: Convert angle and plain links into bracket links (goto-char (point-min)) (while (re-search-forward re-plain-link nil t) @@ -12565,8 +13188,9 @@ translations. There is currently no way for users to extend this.") (concat (match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]") t t)) + ;; Find multiline emphasis and put them into single line - (when (assq :emph-multiline parameters) + (when (memq :emph-multiline parameters) (goto-char (point-min)) (while (re-search-forward org-emph-re nil t) (subst-char-in-region (match-beginning 0) (match-end 0) ?\n ?\ t) @@ -12671,7 +13295,6 @@ underlined headlines. The default is 3." (title (or (plist-get opt-plist :title) (file-name-sans-extension (file-name-nondirectory buffer-file-name)))) - (options nil) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) (text nil) @@ -12772,7 +13395,7 @@ underlined headlines. The default is 3." (normal-mode) (save-buffer) ;; remove display and invisible chars - (let (beg end s) + (let (beg end) (goto-char (point-min)) (while (setq beg (next-single-property-change (point) 'display)) (setq end (next-single-property-change beg 'display)) @@ -12849,22 +13472,27 @@ underlined headlines. The default is 3." (defun org-export-visible (type arg) "Create a copy of the visible part of the current buffer, and export it. The copy is created in a temporary buffer and removed after use. -TYPE is the final key (as a string) of the `C-c C-x' key sequence that will -run the export command - in interactive use, the command prompts for this -key. As a special case, if the you type SPC at the prompt, the temporary +TYPE is the final key (as a string) that also select the export command in +the `C-c C-e' export dispatcher. +As a special case, if the you type SPC at the prompt, the temporary org-mode file will not be removed but presented to you so that you can continue to use it. The prefix arg ARG is passed through to the exporting command." (interactive (list (progn (message "Export visible: [a]SCII [h]tml [b]rowse HTML [x]OXO [ ]keep buffer") - (char-to-string (read-char-exclusive))) + (read-char-exclusive)) current-prefix-arg)) - (if (not (member type '("a" "\C-a" "b" "\C-b" "h" "x" " "))) + (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?x ?\ ))) (error "Invalid export key")) - ;; FIXME: do this more explicit? - (let* ((binding (key-binding (concat "\C-c\C-x" type))) - (keepp (equal type " ")) + (let* ((binding (cdr (assoc type + '((?a . org-export-as-ascii) + (?\C-a . org-export-as-ascii) + (?b . org-export-as-html-and-open) + (?\C-b . org-export-as-html-and-open) + (?h . org-export-as-html) + (?x . org-export-as-xoxo))))) + (keepp (equal type ?\ )) (file buffer-file-name) (buffer (get-buffer-create "*Org Export Visible*")) s e) @@ -12925,7 +13553,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EMAIL: %s #+LANGUAGE: %s #+TEXT: Some descriptive text to be emitted. Several lines OK. -#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s +#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s *:%s TeX:%s LaTeX:%s #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -12944,6 +13572,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." org-export-with-sub-superscripts org-export-with-emphasize org-export-with-TeX-macros + org-export-with-LaTeX-fragments (file-name-nondirectory buffer-file-name) (if (equal org-todo-interpretation 'sequence) (mapconcat 'identity org-todo-keywords " ") @@ -13041,6 +13670,7 @@ When HIDDEN is non-nil, don't display the HTML buffer. EXT-PLIST is a property list with external parameters overriding org-mode's default settings, but still inferior to file-local settings." (interactive "P") + (message "Exporting...") (setq-default org-todo-line-regexp org-todo-line-regexp) (setq-default org-deadline-line-regexp org-deadline-line-regexp) (setq-default org-done-string org-done-string) @@ -13049,16 +13679,24 @@ org-mode's default settings, but still inferior to file-local settings." (org-infile-export-plist))) (style (plist-get opt-plist :style)) + (link-validate (plist-get opt-plist :link-validation-function)) + valid (odd org-odd-levels-only) (region-p (org-region-active-p)) (region (buffer-substring (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) + ;; The following two are dynamically scoped into other + ;; routines below. + (org-current-export-dir (org-export-directory :html opt-plist)) + (org-current-export-file buffer-file-name) (all_lines (org-skip-comments (org-split-string (org-cleaned-string-for-export - region :emph-multiline) + region :emph-multiline + (if (plist-get opt-plist :LaTeX-fragments) + :LaTeX-fragments)) "[\r\n]"))) (lines (org-export-find-first-heading-line all_lines)) (level 0) (line "") (origline "") txt todo @@ -13068,6 +13706,7 @@ org-mode's default settings, but still inferior to file-local settings." (file-name-sans-extension (file-name-nondirectory buffer-file-name)) ".html")) + (current-dir (file-name-directory buffer-file-name)) (buffer (find-file-noselect filename)) (levels-open (make-vector org-level-max nil)) (date (format-time-string "%Y/%m/%d" (current-time))) @@ -13314,6 +13953,10 @@ lang=\"%s\" xml:lang=\"%s\"> (if (string-match "::\\(.*\\)" filename) (setq search (match-string 1 filename) filename (replace-match "" t nil filename))) + (setq valid + (if (functionp link-validate) + (funcall link-validate filename current-dir) + t)) (setq file-is-image-p (string-match (org-image-file-name-regexp) filename)) (setq thefile (if abs-p (expand-file-name filename) filename)) @@ -13339,7 +13982,8 @@ lang=\"%s\" xml:lang=\"%s\"> (and org-export-html-inline-images (not descp)))) (concat "<img src=\"" thefile "\"/>") - (concat "<a href=\"" thefile "\">" desc "</a>"))))) + (concat "<a href=\"" thefile "\">" desc "</a>"))) + (if (not valid) (setq rpl desc)))) ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) (setq rpl (concat "<i><" type ":" (save-match-data (org-link-unescape path)) @@ -13497,7 +14141,9 @@ lang=\"%s\" xml:lang=\"%s\"> (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) (replace-match "")) (save-buffer) - (goto-char (point-min))))) + (goto-char (point-min)) + (message "Exporting... done")))) + (defun org-format-table-html (lines olines) "Find out which HTML converter to use and return the HTML code." @@ -13650,27 +14296,31 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used." (defun org-html-handle-time-stamps (s) "Format time stamps in string S, or remove them." - (let (r b) - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (if (not org-export-with-timestamps) - (setq r (concat r (substring s 0 (match-beginning 0))) - s (substring s (match-end 0))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - (if (match-end 1) - (format "@<span class=\"timestamp-kwd\">%s @</span>" - (match-string 1 s))) - (format " @<span class=\"timestamp\">%s@</span>" - (substring (match-string 3 s) 1 -1))) - s (substring s (match-end 0))))) - ;; Line break of line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@<br/>"))) - r))) + (catch 'exit + (let (r b) + (while (string-match org-maybe-keyword-time-regexp s) + ;; FIXME: is it good to never export CLOCK, or do we need control? + (if (and (match-end 1) (equal (match-string 1 s) org-clock-string)) + (throw 'exit "")) + (or b (setq b (substring s 0 (match-beginning 0)))) + (if (not org-export-with-timestamps) + (setq r (concat r (substring s 0 (match-beginning 0))) + s (substring s (match-end 0))) + (setq r (concat + r (substring s 0 (match-beginning 0)) + (if (match-end 1) + (format "@<span class=\"timestamp-kwd\">%s @</span>" + (match-string 1 s))) + (format " @<span class=\"timestamp\">%s@</span>" + (substring (match-string 3 s) 1 -1))) + s (substring s (match-end 0))))) + ;; Line break if line started and ended with time stamp stuff + (if (not r) + s + (setq r (concat r s)) + (unless (string-match "\\S-" (concat b s)) + (setq r (concat r "@<br/>"))) + r)))) (defun org-html-protect (s) ;; convert & to &, < to < and > to > @@ -14147,6 +14797,255 @@ a time), or the day by one (if it does not contain a time)." (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) (concat keyword (format-time-string fmt time)))) +;;; LaTeX stuff + +(defvar org-cdlatex-mode-map (make-sparse-keymap) + "Keymap for the minor `org-cdlatex-mode'.") + +(define-key org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) +(define-key org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) +(define-key org-cdlatex-mode-map "`" 'cdlatex-math-symbol) +(define-key org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) +(define-key org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) + +(defvar org-cdlatex-texmathp-advice-is-done nil + "Flag remembering if we have applied the advice to texmathp already.") + +(define-minor-mode org-cdlatex-mode + "Toggle the minor `org-cdlatex-mode'. +This mode supports entering LaTeX environment and math in LaTeX fragments +in Org-mode. +\\{org-cdlatex-mode-map}" + nil " CDLtx" nil + (when org-cdlatex-mode (require 'cdlatex)) + (unless org-cdlatex-texmathp-advice-is-done + (setq org-cdlatex-texmathp-advice-is-done t) + (defadvice texmathp (around org-math-always-on activate) + "Always return t in org-mode buffers. +This is because we want to insert math symbols without dollars even outside +the LaTeX math segments. +\\[org-cdlatex-mode-map]" + (interactive) + (if (or (not (eq major-mode 'org-mode)) + (org-inside-LaTeX-fragment-p)) + ad-do-it + (if (eq this-command 'cdlatex-math-symbol) + (setq ad-return-value t)))))) + +(defun org-inside-LaTeX-fragment-p () + "Test if point is inside a LaTeX fragment. I.e. after a \\begin, \\(, \\[, $, or $$, withoout the corresponding closing +sequence appearing also before point." + (let ((pos (point)) + (lim (progn + (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) + (point))) + dollar-on p1) + (goto-char pos) + (if (re-search-backward "\\(\\\\begin{\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\)" lim t) + (progn + (goto-char pos) + (cond + ((match-beginning 1) (match-beginning 0)) + ((match-beginning 2) nil) + (t (while (re-search-backward "\\$" lim t) + (setq dollar-on (not dollar-on)) + (if (= (char-before) ?$) (backward-char 1)) + (setq p1 (or p1 (point)))) + (goto-char pos) + (if dollar-on p1)))) + (goto-char pos) + nil))) + +(defun org-try-cdlatex-tab () + "Check if it makes sense to execute `cdlatex-tab', and do it if yes. +It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is + - inside a LaTeX fragment, or + - after the first word in a line, where an abbreviation expansion could + insert a LaTeX environment." + ;; FIXME: This may still need refinement. + (when org-cdlatex-mode + (cond + ((save-excursion + (skip-chars-backward "a-zA-Z0-9*") + (skip-chars-backward " \t") + (bolp)) + (cdlatex-tab) t) + ((org-inside-LaTeX-fragment-p) + (cdlatex-tab) t) + (t nil)))) + +(defun org-cdlatex-underscore-caret (&optional arg) + "Execute `cdlatex-sub-superscript' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-sub-superscript) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + +(defun org-cdlatex-math-modify (&optional arg) + "Execute `cdlatex-math-modify' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-math-modify) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + +(defvar org-latex-fragment-image-overlays nil + "List of overlays carrying the images of latex fragments.") +(make-variable-buffer-local 'org-latex-fragment-image-overlays) + +(defun org-remove-latex-fragment-image-overlays () + "Remove all overlays with LaTeX fragment images in current buffer." + (mapc 'org-delete-overlay org-latex-fragment-image-overlays) + (setq org-latex-fragment-image-overlays nil)) + +(defun org-preview-latex-fragment (&optional subtree) + "Preview the LaTeX fragment at point, or all locally or globally. +If the cursor is in a LaTeX fragment, create the image and overlay +it over the source code. If there is no fragment at point, display +all fragments in the current text, from one headline to the next. With +prefix SUBTREE, display all fragments in the current subtree. With a +double prefix `C-u C-u', or when the cursor is before the first headline, +display all fragments in the buffer. +The images can be removed again with \\[org-ctrl-c-ctrl-c]." + (interactive "P") + (org-remove-latex-fragment-image-overlays) + (save-excursion + (save-restriction + (let (beg end at msg) + (cond + ((or (equal subtree '(16)) + (not (save-excursion + (re-search-backward (concat "^" outline-regexp) nil t)))) + (setq beg (point-min) end (point-max) + msg "Creating images for buffer...%s")) + ((equal subtree '(4)) + (org-back-to-heading) + (setq beg (point) end (org-end-of-subtree) + msg "Creating images for subtree...%s")) + (t + (if (setq at (org-inside-LaTeX-fragment-p)) + (goto-char (max (point-min) (- at 2))) + (org-back-to-heading)) + (setq beg (point) end (progn (outline-next-heading) (point)) + msg (if at "Creating image...%s" + "Creating images for entry...%s")))) + (message msg "") + (narrow-to-region beg end) + (org-format-latex + (concat "ltxpng/" (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + default-directory 'overlays msg at) + (message msg "done. Use `C-c C-c' to remove images."))))) + +(defun org-format-latex (prefix &optional dir overlays msg at) + "Replace LaTeX fragments with links to an image, and produce images." + (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) + (let* ((prefixnodir (file-name-nondirectory prefix)) + (absprefix (expand-file-name prefix dir)) + (todir (file-name-directory absprefix)) + (opt org-format-latex-options) + (matchers (plist-get opt :matchers)) + (re-list + '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) + ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) + ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 t) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t))) + (cnt 0) txt link beg end re e oldfiles + m n block linkfile movefile ov) + ;; Make sure the directory exists + (or (file-directory-p todir) (make-directory todir)) + ;; Check if there are old images files with this prefix, and remove them + (setq oldfiles (directory-files + todir 'full + (concat (regexp-quote prefixnodir) "_[0-9]+\\.png$"))) + (while oldfiles (delete-file (pop oldfiles))) + ;; Check the different regular expressions + (while (setq e (pop re-list)) + (setq m (car e) re (nth 1 e) n (nth 2 e) + block (if (nth 3 e) "\n\n" "")) + (when (member m matchers) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (when (or (not at) (equal at (match-beginning n))) + (setq txt (match-string n) + beg (match-beginning n) end (match-end n) + cnt (1+ cnt) + linkfile (format "%s_%04d.png" prefix cnt) + movefile (format "%s_%04d.png" absprefix cnt) + link (concat block "[[file:" linkfile "]]" block)) + (if msg (message msg cnt)) + (goto-char beg) + (org-create-formula-image + txt movefile opt) + (if overlays + (progn + (setq ov (org-make-overlay beg end)) + (if (featurep 'xemacs) + (progn + (org-overlay-put ov 'invisible t) + (org-overlay-put + ov 'end-glyph + (make-glyph (vector 'png :file movefile)))) + (org-overlay-put + ov 'display + (list 'image :type 'png :file movefile :ascent 'center))) + (push ov org-latex-fragment-image-overlays) + (goto-char end)) + (delete-region beg end) + (insert link)))))))) + +;; This function borrows from Ganesh Swami's latex2png.el +(defun org-create-formula-image (string tofile options) + (let* ((tmpdir (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)) + (texfilebase (make-temp-name + (expand-file-name "orgtex" tmpdir))) + +;(texfilebase (make-temp-file "orgtex")) +; (dummy (delete-file texfilebase)) + (texfile (concat texfilebase ".tex")) + (dvifile (concat texfilebase ".dvi")) + (pngfile (concat texfilebase ".png")) + (scale (number-to-string (* 1000 (or (plist-get options :scale) 1.0)))) + (fg (or (plist-get options :foreground) "Black")) + (bg (or (plist-get options :background) "Transparent"))) + (with-temp-file texfile + (insert "\\documentclass{article} +\\usepackage{fullpage} +\\usepackage{amssymb} +\\usepackage[usenames]{color} +\\usepackage{amsmath} +\\usepackage{latexsym} +\\usepackage[mathscr]{eucal} +\\pagestyle{empty} +\\begin{document}\n" string "\n\\end{document}\n")) + (let ((dir default-directory)) + (condition-case nil + (progn + (cd tmpdir) + (call-process "latex" nil nil nil texfile)) + (error nil)) + (cd dir)) + (if (not (file-exists-p dvifile)) + (progn (message "Failed to create dvi file from %s" texfile) nil) + (call-process "dvipng" nil nil nil + "-E" "-fg" fg "-bg" bg + "-x" scale "-y" scale "-T" "tight" + "-o" pngfile + dvifile) + (if (not (file-exists-p pngfile)) + (progn (message "Failed to create png file from %s" texfile) nil) + ;; Use the requested file name and clean up + (copy-file pngfile tofile 'replace) + (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do + (delete-file (concat texfilebase e))) + pngfile)))) ;;; Key bindings @@ -14212,7 +15111,9 @@ a time), or the day by one (if it does not contain a time)." ;; All the other keys (define-key org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. +(define-key org-mode-map "\C-xns" 'org-narrow-to-subtree) (define-key org-mode-map "\C-c$" 'org-archive-subtree) +(define-key org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) (define-key org-mode-map "\C-c\C-j" 'org-goto) (define-key org-mode-map "\C-c\C-t" 'org-todo) (define-key org-mode-map "\C-c\C-s" 'org-schedule) @@ -14255,24 +15156,7 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c~" 'org-table-create-with-table.el) (define-key org-mode-map "\C-c\C-q" 'org-table-wrap-region) (define-key org-mode-map "\C-c\C-e" 'org-export) -;(define-key org-mode-map "\C-c\C-xa" 'org-export-as-ascii) -;(define-key org-mode-map "\C-c\C-x\C-a" 'org-export-as-ascii) -;(define-key org-mode-map "\C-c\C-xv" 'org-export-visible) -;(define-key org-mode-map "\C-c\C-x\C-v" 'org-export-visible) -;; OPML support is only an option for the future -;(define-key org-mode-map "\C-c\C-xo" 'org-export-as-opml) -;(define-key org-mode-map "\C-c\C-x\C-o" 'org-export-as-opml) -;(define-key org-mode-map "\C-c\C-xi" 'org-export-icalendar-this-file) -;(define-key org-mode-map "\C-c\C-x\C-i" 'org-export-icalendar-all-agenda-files) -;(define-key org-mode-map "\C-c\C-xc" 'org-export-icalendar-combine-agenda-files) -;(define-key org-mode-map "\C-c\C-x\C-c" 'org-export-icalendar-combine-agenda-files) -;(define-key org-mode-map "\C-c\C-xt" 'org-insert-export-options-template) (define-key org-mode-map "\C-c:" 'org-toggle-fixed-width-section) -;(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) -;(define-key org-mode-map "\C-c\C-xx" 'org-export-as-xoxo) -;(define-key org-mode-map "\C-c\C-x\C-x" 'org-export-as-xoxo) -;(define-key org-mode-map "\C-c\C-xb" 'org-export-as-html-and-open) -;(define-key org-mode-map "\C-c\C-x\C-b" 'org-export-as-html-and-open) (define-key org-mode-map "\C-c\C-x\C-k" 'org-cut-special) (define-key org-mode-map "\C-c\C-x\C-w" 'org-cut-special) @@ -14283,15 +15167,9 @@ a time), or the day by one (if it does not contain a time)." (define-key org-mode-map "\C-c\C-x\C-o" 'org-clock-out) (define-key org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) (define-key org-mode-map "\C-c\C-x\C-d" 'org-clock-display) - -;(define-key org-mode-map "\C-c\C-ef" 'org-publish-current-file) -;(define-key org-mode-map "\C-c\C-ep" 'org-publish-current-project) -;(define-key org-mode-map "\C-c\C-ec" 'org-publish) -;(define-key org-mode-map "\C-c\C-ea" 'org-publish-all) -;(define-key org-mode-map "\C-c\C-e\C-f" 'org-publish-current-file) -;(define-key org-mode-map "\C-c\C-e\C-p" 'org-publish-current-project) -;(define-key org-mode-map "\C-c\C-e\C-c" 'org-publish) -;(define-key org-mode-map "\C-c\C-e\C-a" 'org-publish-all) +(define-key org-mode-map "\C-c\C-x\C-r" 'org-clock-report) +(define-key org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) +(define-key org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) (when (featurep 'xemacs) (define-key org-mode-map 'button3 'popup-mode-menu)) @@ -14598,12 +15476,12 @@ This command does many different things, depending on context: (interactive "P") (let ((org-enable-table-editor t)) (cond - (org-clock-overlays + ((or org-clock-overlays org-occur-highlights + org-latex-fragment-image-overlays) (org-remove-clock-overlays) - (message "Clock overlays removed")) - (org-occur-highlights (org-remove-occur-highlights) - (message "occur highlights removed")) + (org-remove-latex-fragment-image-overlays) + (message "Temporary highlights/overlays removed from current buffer")) ((and (local-variable-p 'org-finish-function (current-buffer)) (fboundp org-finish-function)) (funcall org-finish-function)) @@ -14753,10 +15631,26 @@ See the individual commands for more information." ["Demote Heading" org-metaright (not (org-at-table-p))] ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] "--" - ["Archive Subtree" org-archive-subtree t] - "--" ["Convert to odd levels" org-convert-to-odd-levels t] ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) + ("Archive" + ["Toggle ARCHIVE tag" org-toggle-archive-tag t] + ["Check and Tag Children" (org-toggle-archive-tag (4)) + :active t :keys "C-u C-c C-x C-a"] + ["Sparse trees open ARCHIVE trees" + (setq org-sparse-tree-open-archived-trees + (not org-sparse-tree-open-archived-trees)) + :style toggle :selected org-sparse-tree-open-archived-trees] + ["Cycling opens ARCHIVE trees" + (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) + :style toggle :selected org-cycle-open-archived-trees] + ["Agenda includes ARCHIVE trees" + (setq org-agenda-skip-archived-trees (not org-agenda-skip-archived-trees)) + :style toggle :selected (not org-agenda-skip-archived-trees)] + "--" + ["Move Subtree to Archive" org-archive-subtree t] + ["Check and Move Children" (org-archive-subtree '(4)) + :active t :keys "C-u C-c $"]) "--" ("TODO Lists" ["TODO/DONE/-" org-todo t] @@ -14785,6 +15679,7 @@ See the individual commands for more information." ["Clock out" org-clock-out t] ["Clock cancel" org-clock-cancel t] ["Display times" org-clock-display t] + ["Create clock table" org-clock-report t] "--" ["Record DONE time" (progn (setq org-log-done (not org-log-done)) @@ -14819,6 +15714,16 @@ See the individual commands for more information." (re-search-forward "<[a-z]+:" nil t))]) "--" ["Export/Publish" org-export t] + ("LaTeX" + ["Org CDLaTeX mode" org-cdlatex-mode :style toggle + :selected org-cdlatex-mode] + ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] + ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] + ["Modify math symbol" org-cdlatex-math-modify + (org-inside-LaTeX-fragment-p)] + ["Export LaTeX fragments as images" + (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) + :style toggle :selected org-export-with-LaTeX-fragments]) "--" ("Documentation" ["Show Version" org-version t] @@ -15012,6 +15917,7 @@ return nil." ;; In the paragraph separator we include headlines, because filling ;; text in a line directly attached to a headline would otherwise ;; fill the headline as well. + (set (make-local-variable 'comment-start-skip) "^#+[ \t]*") (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") ;; The paragraph starter includes hand-formatted lists. (set (make-local-variable 'paragraph-start) @@ -15284,7 +16190,8 @@ When ENTRY is non-nil, show the entire entry." (forward-char -1) (if (memq (preceding-char) '(?\n ?\^M)) ;; leave blank line before heading - (forward-char -1)))))) + (forward-char -1))))) + (point)) (defun org-show-subtree () "Show everything after this heading at deeper levels." @@ -15334,8 +16241,10 @@ Show the heading too, if it is currently invisible." (org-invisible-p))) (org-show-hierarchy-above))) -;;; Finish up +;;; Experimental code +;;; Finish up + (provide 'org) (run-hooks 'org-load-hook) |