Mercurial > emacs
changeset 84933:d6e2d9d9924a
2007-09-26 Bastien Guerry <bzg@altern.org>
* org-export-latex.el (org-export-latex-tables-verbatim): New
function.
(org-export-latex-remove-from-headlines): Name changed because of
typo.
(org-export-latex-quotation-marks-convention): Option removed.
(org-export-latex-make-preamble): Handle the DATE option.
(org-export-latex-cleaned-string): Now the only cleaning function,
synched up with org.el.
(org-export-latex-lists, org-export-latex-parse-list)
(org-export-list-to-latex): New functions.
2007-09-26 Carsten Dominik <dominik@science.uva.nl>
* org.el (org-kill-is-subtree-p): Use `org-outline-regexp'.
(org-outline-regexp): New constant.
(org-remember-handler): Throw error when the target file is not in
org-mode.
(org-cleaned-string-for-export): No longer call
`org-export-latex-cleaned-string' with an argument.
(org-get-tags): Returns now a list, not a string.
(org-get-tags-string): New function.
(org-archive-subtree): No need to split return of `org-get-tags'.
(org-set-tags, org-entry-properties): Call `org-get-tags-string'
instead of `org-get-tags'.
(org-agenda-format-date): Renamed from `org-agenda-date-format'.
(org-time-from-absolute, org-agenda-format-date-aligned): New
functions.
(org-compatible-face): New argument INHERITS. Inherit from this
face if possible.
(org-level-1, org-level-2, org-level-3, org-level-4)
(org-level-5, org-level-6, org-level-7, org-level-8)
(org-special-keyword, org-drawer, org-column, org-warning)
(org-archived, org-todo, org-done, org-headline-done, org-table)
(org-formula, org-code, org-agenda-structure)
(org-scheduled-today, org-scheduled-previously)
(org-upcoming-deadline, org-time-grid): Call `org-compatible-face'
in the new way.
(org-get-heading): New argument NO-TAGS.
(org-fast-tag-selection-include-todo): Made defvar instead of
defcustom, feature is not deprecated.
(org-remember-store-without-prompt): New default value t.
(org-todo-log-states): New variable.
(org-set-regexps-and-options): #+TODO is an alias for SEQ_TODO.
Compute the log states.
(org-goto-map): More commands copied from global map. Also bind
`org-occur'.
(org-goto): Made into a general lookup command.
(org-get-location): Complete rewrite.
(org-goto-exit-command): New variable.
(org-goto-selected-point): New variable.
(org-goto-ret, org-goto-left, org-goto-right, org-goto-quit): Set
the new variables.
(org-paste-subtree): Whitespace insertion strategy revised.
(org-remember-apply-template): Protect v-A from the possibility
that v-a might be nil.
(org-remember-handler): Insertion rules revised.
(org-todo): Respect org-todo-log-states.
(org-up-heading-safe): New function.
(org-entry-get-with-inheritance): Use `org-up-heading-safe'.
* org.texi: Change links to webpage and maintained email.
(Remember): Promoted to Chapter, significant changes.
(Fast access to TODO states): New section.
(Faces for TODO keywords): New section.
(Export options): Example for #+DATE.
(Progress logging): Section moved.
| author | John Wiegley <johnw@newartisans.com> |
|---|---|
| date | Wed, 26 Sep 2007 05:05:01 +0000 |
| parents | b10f8731b217 |
| children | 659f550b9193 |
| files | lisp/ChangeLog lisp/textmodes/org-export-latex.el lisp/textmodes/org-publish.el lisp/textmodes/org.el |
| diffstat | 4 files changed, 642 insertions(+), 583 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Sep 26 03:18:21 2007 +0000 +++ b/lisp/ChangeLog Wed Sep 26 05:05:01 2007 +0000 @@ -1,3 +1,73 @@ +2007-09-26 Bastien Guerry <bzg@altern.org> + + * org-export-latex.el (org-export-latex-tables-verbatim): New + function. + (org-export-latex-remove-from-headlines): Name changed because of + typo. + (org-export-latex-quotation-marks-convention): Option removed. + (org-export-latex-make-preamble): Handle the DATE option. + (org-export-latex-cleaned-string): Now the only cleaning function, + synched up with org.el. + (org-export-latex-lists, org-export-latex-parse-list) + (org-export-list-to-latex): New functions. + + +2007-09-26 Carsten Dominik <dominik@science.uva.nl> + + * org.el (org-kill-is-subtree-p): Use `org-outline-regexp'. + (org-outline-regexp): New constant. + (org-remember-handler): Throw error when the target file is not in + org-mode. + (org-cleaned-string-for-export): No longer call + `org-export-latex-cleaned-string' with an argument. + (org-get-tags): Returns now a list, not a string. + (org-get-tags-string): New function. + (org-archive-subtree): No need to split return of `org-get-tags'. + (org-set-tags, org-entry-properties): Call `org-get-tags-string' + instead of `org-get-tags'. + (org-agenda-format-date): Renamed from `org-agenda-date-format'. + (org-time-from-absolute, org-agenda-format-date-aligned): New + functions. + (org-compatible-face): New argument INHERITS. Inherit from this + face if possible. + (org-level-1, org-level-2, org-level-3, org-level-4) + (org-level-5, org-level-6, org-level-7, org-level-8) + (org-special-keyword, org-drawer, org-column, org-warning) + (org-archived, org-todo, org-done, org-headline-done, org-table) + (org-formula, org-code, org-agenda-structure) + (org-scheduled-today, org-scheduled-previously) + (org-upcoming-deadline, org-time-grid): Call `org-compatible-face' + in the new way. + (org-get-heading): New argument NO-TAGS. + (org-fast-tag-selection-include-todo): Made defvar instead of + defcustom, feature is not deprecated. + (org-remember-store-without-prompt): New default value t. + (org-todo-log-states): New variable. + (org-set-regexps-and-options): #+TODO is an alias for SEQ_TODO. + Compute the log states. + (org-goto-map): More commands copied from global map. Also bind + `org-occur'. + (org-goto): Made into a general lookup command. + (org-get-location): Complete rewrite. + (org-goto-exit-command): New variable. + (org-goto-selected-point): New variable. + (org-goto-ret, org-goto-left, org-goto-right, org-goto-quit): Set + the new variables. + (org-paste-subtree): Whitespace insertion strategy revised. + (org-remember-apply-template): Protect v-A from the possibility + that v-a might be nil. + (org-remember-handler): Insertion rules revised. + (org-todo): Respect org-todo-log-states. + (org-up-heading-safe): New function. + (org-entry-get-with-inheritance): Use `org-up-heading-safe'. + + * org.texi: Change links to webpage and maintained email. + (Remember): Promoted to Chapter, significant changes. + (Fast access to TODO states): New section. + (Faces for TODO keywords): New section. + (Export options): Example for #+DATE. + (Progress logging): Section moved. + 2007-09-26 Dan Nicolaescu <dann@ics.uci.edu> * progmodes/cc-cmds.el (c-indent-line-or-region): Only indent the
--- a/lisp/textmodes/org-export-latex.el Wed Sep 26 03:18:21 2007 +0000 +++ b/lisp/textmodes/org-export-latex.el Wed Sep 26 05:05:01 2007 +0000 @@ -3,8 +3,8 @@ ;; ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Keywords: org organizer latex export convert -;; Version: $Id: org-export-latex.el,v 1.5 2007/09/07 20:16:45 johnw Exp $ -;; X-URL: <http://www.cognition.ens.fr/~guerry/u/org-export-latex.el> +;; Homepage: http://www.cognition.ens.fr/~guerry/u/org-export-latex.el +;; Version: 5.09 ;; ;; This file is part of GNU Emacs. ;; @@ -52,6 +52,8 @@ (defvar org-latex-all-targets-regexp nil) (defvar org-latex-add-level 0) (defvar org-latex-sectioning-depth 0) +(defvar org-export-latex-list-beginning-re + "^\\([ \t]*\\)\\([-+]\\|[0-9]+\\(?:\\.\\|)\\)\\) *?") (defvar org-latex-special-string-regexps '(org-ts-regexp @@ -99,11 +101,17 @@ :group 'org-export-latex :type 'string) -(defcustom org-export-latex-date-format nil +(defcustom org-export-latex-date-format + "%d %B %Y" "Format string for \\date{...}." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-tables-verbatim nil + "When non-nil, export tables as verbatim." + :group 'org-export-latex + :type 'boolean) + (defcustom org-export-latex-packages-alist nil "Alist of packages to be inserted in the preamble. Each cell is of the forma \( option . package \). @@ -126,7 +134,7 @@ (symbol :tag "Convert as descriptive list" description) (string :tag "Use a section string" :value "\\subparagraph{%s}"))) -(defcustom org-export-latex-remove-from-headines +(defcustom org-export-latex-remove-from-headlines '(:todo t :priority t :tags t) "A plist of keywords to remove from headlines. Non-nil means remove this keyword type from the headline. @@ -135,13 +143,6 @@ :type 'plist :group 'org-export-latex) -(defcustom org-export-latex-quotation-marks-convention "en" - "Convention for conversion of the quotation marks. -This value is overriden by any infile language setup." - :group 'org-export-latex - :type '(choice (string :tag "english" "en") - (string :tag "french" "fr"))) - (defcustom org-export-latex-image-default-option "width=10em" "Default option for images." :group 'org-export-latex @@ -155,7 +156,6 @@ ;; FIXME Do we want this one? ;; (defun org-export-as-latex-and-open (arg) ...) - ;;; Autoload functions: ;;;###autoload (defun org-export-as-latex-batch () @@ -280,13 +280,12 @@ (if region-p (region-beginning) (point-min)) (if region-p (region-end) (point-max)))) (string-for-export - ;; FIXME Use org-cleaned-string-for-export instead, only when - ;; everyone uses Org >5.04 - (org-latex-cleaned-string-for-export - region :for-html nil + (org-cleaned-string-for-export + region :emph-multiline t + :for-LaTeX t :comments nil - :for-LaTeX t - :skip-before-1st-heading nil + :add-text text + :skip-before-1st-heading skip :LaTeX-fragments nil))) (set-buffer buffer) (erase-buffer) @@ -311,7 +310,7 @@ (setq org-latex-add-level (if odd (1- (/ (1+ asters) 2)) (1- asters))) (org-export-latex-parse-global level odd)))) - + (unless body-only (insert "\n\\end{document}")) (or to-buffer (save-buffer)) (goto-char (point-min)) @@ -321,7 +320,6 @@ (kill-buffer (current-buffer))) (current-buffer)))) - ;;; Parsing functions: (defun org-export-latex-parse-global (level odd) "Parse the current buffer recursively, starting at LEVEL. @@ -372,6 +370,52 @@ (widen))) (list output)))) +(defun org-export-latex-parse-list (&optional delete) + "Parse the list at point. +Return a list containing first level items as strings and +sublevels as list of strings." + (let ((start (point)) + ;; Find the end of the list + (end (save-excursion + (catch 'exit + (while (or (looking-at org-export-latex-list-beginning-re) + (looking-at "^[ \t]+\\|^$")) + (if (eq (point) (point-max)) + (throw 'exit (point-max))) + (forward-line 1))) (point))) + output itemsep) + (while (re-search-forward org-export-latex-list-beginning-re end t) + (setq itemsep (if (save-match-data + (string-match "^[0-9]" (match-string 2))) + "[0-9]+\\(?:\\.\\|)\\)" "[-+]")) + (let* ((indent1 (match-string 1)) + (nextitem (save-excursion + (save-match-data + (or (and (re-search-forward + (concat "^" indent1 itemsep " *?") end t) + (match-beginning 0)) end)))) + (item (buffer-substring + (point) + (or (and (re-search-forward + org-export-latex-list-beginning-re end t) + (goto-char (match-beginning 0))) + (goto-char end)))) + (nextindent (match-string 1)) + (item (org-trim item)) + (item (if (string-match "^\\[.+\\]" item) + (replace-match "\\\\texttt{\\&}" + t nil item) item))) + (push item output) + (when (> (length nextindent) + (length indent1)) + (narrow-to-region (point) nextitem) + (push (org-export-latex-parse-list) output) + (widen)))) + (when delete (delete-region start end)) + (setq output (nreverse output)) + (push (if (string-match "^\\[0" itemsep) + 'ordered 'unordered) output))) + (defun org-export-latex-parse-content () "Extract the content of a section." (let ((beg (point)) @@ -391,7 +435,6 @@ nil ; subcontent is nil (org-export-latex-parse-global (+ (if odd 2 1) level) odd))) - ;;; Rendering functions: (defun org-export-latex-global (content) "Export CONTENT to LaTeX. @@ -405,9 +448,10 @@ "Export the list SUBCONTENT to LaTeX. SUBCONTENT is an alist containing information about the headline and its content." - (mapc (lambda(x) (org-export-latex-subcontent x)) subcontent)) + (let ((num (plist-get org-latex-options-plist :section-numbers))) + (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) -(defun org-export-latex-subcontent (subcontent) +(defun org-export-latex-subcontent (subcontent num) "Export each cell of SUBCONTENT to LaTeX." (let ((heading (org-export-latex-fontify-headline (cdr (assoc 'heading subcontent)))) @@ -415,8 +459,7 @@ org-latex-add-level)) (occur (number-to-string (cdr (assoc 'occur subcontent)))) (content (cdr (assoc 'content subcontent))) - (subcontent (cadr (assoc 'subcontent subcontent))) - (num (plist-get org-latex-options-plist :section-numbers))) + (subcontent (cadr (assoc 'subcontent subcontent)))) (cond ;; Normal conversion ((<= level org-latex-sectioning-depth) @@ -475,49 +518,54 @@ "Make the LaTeX preamble and return it as a string. Argument OPT-PLIST is the options plist for current buffer." (let ((toc (plist-get opt-plist :table-of-contents))) - (format (concat org-export-latex-preamble - " -%s + (concat (if (plist-get opt-plist :time-stamp-file) + (format-time-string "% Created %Y-%m-%d %a %H:%M\n")) + + ;; LaTeX custom preamble + org-export-latex-preamble "\n" -\\begin{document} + ;; LaTeX packages + (if org-export-latex-packages-alist + (mapconcat (lambda(p) + (if (equal "" (car p)) + (format "\\usepackage{%s}" (cadr p)) + (format "\\usepackage[%s]{%s}" + (car p) (cadr p)))) + org-export-latex-packages-alist "\n") "") + "\n\\begin{document}\n\n" -\\title{%s} -%s -%s -\\maketitle -%s -%s -") - (if org-export-latex-packages-alist - (mapconcat (lambda(p) - (if (equal "" (car p)) - (format "\\usepackage{%s}" (cadr p)) - (format "\\usepackage[%s]{%s}" - (car p) (cadr p)))) - org-export-latex-packages-alist "\n") "") - (or (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED") - (if (plist-get opt-plist :author-info) - (format "\\author{%s}" - (or (plist-get opt-plist :author) user-full-name)) - (format "%%\\author{%s}" - (or (plist-get opt-plist :author) user-full-name))) - (if (plist-get opt-plist :timestamps) - (format "\\date{%s}" - (format-time-string (or org-export-latex-date-format - (car org-time-stamp-formats)))) - "%\\date{}") - (if (and (plist-get opt-plist :section-numbers) toc) - (format "\\setcounter{tocdepth}{%s}" - (plist-get opt-plist :headline-levels)) "") - (if (and (plist-get opt-plist :section-numbers) toc) - "\\tableofcontents" "")))) + ;; title + (format + "\\title{%s}\n" + (or (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (and buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + "UNTITLED")) + + ;; author info + (if (plist-get opt-plist :author-info) + (format "\\author{%s}\n" + (or (plist-get opt-plist :author) user-full-name)) + (format "%%\\author{%s}\n" + (or (plist-get opt-plist :author) user-full-name))) + + ;; date + (format "\\date{%s}\n" + (format-time-string + (or (plist-get opt-plist :date) + org-export-latex-date-format))) + + "\\maketitle\n\n" + ;; table of contents + (if (and (plist-get opt-plist :section-numbers) toc) + (format "\\setcounter{tocdepth}{%s}\n" + (plist-get opt-plist :headline-levels)) "") + (if (and (plist-get opt-plist :section-numbers) toc) + "\\tableofcontents\n" "\n")))) (defun org-export-latex-first-lines (&optional comments) "Export the first lines before first headline. @@ -529,10 +577,11 @@ (goto-char (match-beginning 0)) (goto-char (point-max))))) (org-export-latex-content - (org-latex-cleaned-string-for-export + (org-cleaned-string-for-export (buffer-substring (point-min) end) - :for-html nil :for-LaTeX t + :emph-multiline t + :add-text nil :comments nil :skip-before-1st-heading nil :LaTeX-fragments nil))))) @@ -565,39 +614,32 @@ ;; the beginning of the buffer - inserting "\n" is safe here though. (insert "\n" headline) (goto-char (point-min)) - (org-export-latex-special-chars - (plist-get org-latex-options-plist :sub-superscript)) (when (plist-get org-latex-options-plist :emphasize) (org-export-latex-fontify)) + (org-export-latex-special-chars + (plist-get org-latex-options-plist :sub-superscript)) (org-export-latex-keywords-maybe - org-export-latex-remove-from-headines) + org-export-latex-remove-from-headlines) (org-export-latex-links) (org-trim (buffer-substring-no-properties (point-min) (point-max))))) -(defun org-export-latex-fix-invisible-strings () - "Comment out (INVISIBLE) warnings." - (goto-char (point-min)) - (while (re-search-forward "(INVISIBLE)" nil t) - (replace-match "%\\&"))) - (defun org-export-latex-content (content) "Convert CONTENT string to LaTeX." (with-temp-buffer (insert content) (org-export-latex-quotation-marks) - (org-export-latex-special-chars - (plist-get org-latex-options-plist :sub-superscript)) (when (plist-get org-latex-options-plist :emphasize) (org-export-latex-fontify)) + (org-export-latex-special-chars + (plist-get org-latex-options-plist :sub-superscript)) (org-export-latex-links) - (org-export-latex-keywords) - (org-export-latex-itemize) - (org-export-latex-enumerate) + (org-export-latex-keywords + (plist-get org-latex-options-plist :timestamps)) + (org-export-latex-lists) (org-export-latex-tables (plist-get org-latex-options-plist :tables)) (org-export-latex-fixed-width (plist-get org-latex-options-plist :fixed-width)) - (org-export-latex-fix-invisible-strings) (buffer-substring (point-min) (point-max)))) (defun org-export-latex-quotation-marks () @@ -605,8 +647,7 @@ Local definition of the language overrides `org-export-latex-quotation-marks-convention' which overrides `org-export-default-language'." - (let* ((lang (or (plist-get org-latex-options-plist :language) - org-export-latex-quotation-marks-convention)) + (let* ((lang (plist-get org-latex-options-plist :language)) (quote-rpl (if (equal lang "fr") '(("\\(\\s-\\)\"" "«~") ("\\(\\S-\\)\"" "~»") @@ -624,7 +665,7 @@ ;; | chars/string in Org | normal environment | math environment | ;; |-----------------------+-----------------------+-----------------------| ;; | & # % $ | \& \# \% \$ | \& \# \% \$ | -;; | { } _ ^ \ | \ { \ } \_ \^ \\ | { } _ ^ \ | +;; | { } _ ^ \ | \{ \} \_ \^ \\ | { } _ ^ \ | ;; |-----------------------+-----------------------+-----------------------| ;; | a_b and a^b | $a_b$ and $a^b$ | a_b and a^b | ;; | a_abc and a_{abc} | $a_a$bc and $a_{abc}$ | a_abc and a_{abc} | @@ -718,8 +759,10 @@ (format "$%s%s{%s}$" string-before char (match-string 1 string-after))) (subsup (concat "$" string-before char string-after "$")) - (t (concat string-before "\\" char string-after)))) - (t (concat string-before "\\" char string-after)))) + (t (org-latex-protect + (concat string-before "\\" char "{}" string-after))))) + (t (org-latex-protect + (concat string-before "\\" char "{}" string-after))))) (defun org-export-latex-treat-backslash-char (string-before string-after) "Convert the \"$\" special character to LaTeX. @@ -744,16 +787,17 @@ (concat string-before "$\\backslash$" string-after)) (t (concat string-before "$\\backslash$" string-after)))) -(defun org-export-latex-keywords () +(defun org-export-latex-keywords (timestamps) "Convert special keywords to LaTeX. Regexps are those from `org-latex-special-string-regexps'." (let ((rg org-latex-special-string-regexps) r) (while (setq r (pop rg)) (goto-char (point-min)) (while (re-search-forward (eval r) nil t) - (replace-match (format "\\\\texttt{%s}" (match-string 0)) t))))) - -;; FIXME - we need better implementation for nested lists + (if (not timestamps) + (replace-match (format "\\\\texttt{%s}" (match-string 0)) t) + (replace-match "")))))) + (defun org-export-latex-fixed-width (opt) "When OPT is non-nil convert fixed-width sections to LaTeX." (goto-char (point-min)) @@ -773,12 +817,78 @@ (forward-line)))))) ;; FIXME Use org-export-highlight-first-table-line ? +(defun org-export-latex-lists () + "Convert lists to LaTeX." + (goto-char (point-min)) + (while (re-search-forward org-export-latex-list-beginning-re nil t) + (beginning-of-line) + (org-export-list-to-latex + (org-export-latex-parse-list t)))) + +(defun org-export-list-to-generic (list params) + "Convert a LIST parsed through `org-export-latex-parse-list' to other formats. + +Valid parameters are + +:ustart String to start an unordered list +:uend String to end an unordered list + +:ostart String to start an ordered list +:oend String to end an ordered list + +:splice When set to t, return only list body lines, don't wrap + them into :[u/o]start and :[u/o]end. Default is nil. + +:istart String to start a list item +:iend String to end a list item +:isep String to separate items +:lsep String to separate sublists" + (interactive) + (let* ((p params) sublist + (splicep (plist-get p :splice)) + (ostart (plist-get p :ostart)) + (oend (plist-get p :oend)) + (ustart (plist-get p :ustart)) + (uend (plist-get p :uend)) + (istart (plist-get p :istart)) + (iend (plist-get p :iend)) + (isep (plist-get p :isep)) + (lsep (plist-get p :lsep))) + (let ((wrapper + (cond ((eq (car list) 'ordered) + (concat ostart "\n%s" oend "\n")) + ((eq (car list) 'unordered) + (concat ustart "\n%s" uend "\n")))) + rtn) + (while (setq sublist (pop list)) + (cond ((symbolp sublist) nil) + ((stringp sublist) + (setq rtn (concat rtn istart sublist iend isep))) + (t + (setq rtn (concat rtn ;; previous list + lsep ;; list separator + (org-export-list-to-generic sublist p) + lsep ;; list separator + ))))) + (format wrapper rtn)))) + +(defun org-export-list-to-latex (list) + "Convert LIST into a LaTeX list." + (insert + (org-export-list-to-generic + list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" + :ustart "\\begin{itemize}" :uend "\\end{itemize}" + :istart "\\item " :iend "" + :isep "\n" :lsep "\n")) + ;; Add a trailing \n after list conversion + "\n")) + (defun org-export-latex-tables (opt) "When OPT is non-nil convert tables to LaTeX." (goto-char (point-min)) (while (re-search-forward "^\\([ \t]*\\)|" nil t) ;; Re-align the table to update org-table-last-alignment - (save-window-excursion (save-match-data (org-table-align))) + ;; (save-excursion (save-match-data (org-table-align))) (let (tbl-list (beg (match-beginning 0)) (end (save-excursion @@ -786,63 +896,22 @@ (concat "^" (regexp-quote (match-string 1)) "[^|]\\|\\'") nil t) (match-beginning 0)))) (beginning-of-line) - (while (not (eq end (point))) - (if (looking-at "[ \t]*|\\([^-|].+\\)|[ \t]*$") - (push (split-string (org-trim (match-string 1)) "|") tbl-list) - (push 'hline tbl-list)) - (forward-line)) - ;; comment region out instead of deleting it ? - (apply 'delete-region (list beg end)) - (when opt (insert (orgtbl-to-latex (nreverse tbl-list) - nil) "\n\n"))))) - -(defun org-export-latex-list (srch0 srch1 srch2 rpl0 rpl1) - "Convert lists to LaTeX." - (goto-char (point-min)) - (while (re-search-forward srch0 nil t) - (let* ((beg (match-beginning 0)) - (prefix (regexp-quote (match-string 1))) - (end-string (when (re-search-forward srch1 nil t) - (match-string 0)))) - (goto-char beg) (insert rpl0) - (while (re-search-forward - (concat "^" prefix srch2) - (if (not end-string) - (point-max) - (save-match-data - (save-excursion - (re-search-forward - (regexp-quote end-string) nil t)))) t) - (replace-match - (concat "\\item " - (if (match-string 1) - (format "\\texttt{%s}" (match-string 1)))) - t t)) - (goto-char (if end-string - (progn (re-search-forward - (regexp-quote end-string) nil t) - (match-beginning 0)) - (point-max))) - (skip-chars-backward "\n") (forward-line 2) - (insert rpl1)))) - -(defun org-export-latex-itemize () - "Convert item list to LaTeX." - (org-export-latex-list - "^\\([ \t]*\\)-" - "^[^ \n\t-]+.*$" - "- ?\\(\\[.+\\]\\)?" - "\\begin{itemize}\n" - "\\end{itemize}\n")) - -(defun org-export-latex-enumerate () - "Convert numeric list to LaTeX." - (org-export-latex-list - "^\\([ \t]*\\)[0-9]+[\.)] \\(\\[.+\\]\\)? ?" - "^[^ \n\t0-9]+.*$" - "[0-9]+[\.)] ?\\(\\[.+\\]\\)?" - "\\begin{enumerate}\n" - "\\end{enumerate}\n")) + (if org-export-latex-tables-verbatim + (let* ((raw-table (buffer-substring beg end)) + (tbl (concat "\\begin{verbatim}\n" raw-table + "\\end{verbatim}\n"))) + (apply 'delete-region (list beg end)) + (insert tbl)) + (progn + (while (not (eq end (point))) + (if (looking-at "[ \t]*|\\([^-|].+\\)|[ \t]*$") + (push (split-string (org-trim (match-string 1)) "|") tbl-list) + (push 'hline tbl-list)) + (forward-line)) + ;; comment region out instead of deleting it ? + (apply 'delete-region (list beg end)) + (when opt (insert (orgtbl-to-latex (nreverse tbl-list) + nil) "\n\n"))))))) (defun org-export-latex-fontify () "Convert fontification to LaTeX." @@ -908,181 +977,16 @@ (path (insert (format "\\href{%s}{%s}" path desc))) (t (insert "\\texttt{" desc "}"))))))) - -;;; org-latex-cleaned-string-for-export: -(defun org-latex-cleaned-string-for-export (string &rest parameters) - "Cleanup a buffer STRING so that links can be created safely." - (interactive) - (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 ":")) - (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")) - (htmlp (plist-get parameters :for-html)) - (latexp (plist-get parameters :for-LaTeX)) - (commentsp (plist-get parameters :comments)) - (inhibit-read-only t) - (outline-regexp "\\*+ ") - a b xx - rtn p) - (save-excursion - (set-buffer (get-buffer-create " org-mode-tmp")) - (erase-buffer) - (insert string) - ;; Remove license-to-kill stuff - (while (setq p (text-property-any (point-min) (point-max) - :org-license-to-kill t)) - (delete-region p (next-single-property-change p :org-license-to-kill))) - - (let ((org-inhibit-startup t)) (org-mode)) - (untabify (point-min) (point-max)) - - ;; Get the correct stuff before the first headline - (when (plist-get parameters :skip-before-1st-heading) - (goto-char (point-min)) - (when (re-search-forward "^\\*+[ \t]" nil t) - (delete-region (point-min) (match-beginning 0)) - (goto-char (point-min)) - (insert "\n"))) - (when (plist-get parameters :add-text) - (goto-char (point-min)) - (insert (plist-get parameters :add-text) "\n")) - - ;; 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 t)) - (org-end-of-subtree t) - (beginning-of-line 1) - (setq a (if org-export-with-archived-trees - (1+ (point-at-eol)) (point)) - b (org-end-of-subtree t)) - (if (> b a) (delete-region a b))))) - - ;; Get rid of property drawers - (unless org-export-with-property-drawer - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:PROPERTIES:[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n" nil t) - (replace-match ""))) - - ;; 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)")) - - ;; Specific LaTeX cleaning - (when latexp - (require 'org-export-latex nil t) - (org-export-latex-cleaned-string)) +(defun org-export-latex-cleaned-string + ;; FIXME remove commentsp call in org.el and here + (&optional commentsp) + "Clean stuff in the LaTeX export." - ;; Protect stuff from HTML processing - (goto-char (point-min)) - (let ((formatters `((,htmlp "HTML" "BEGIN_HTML" "END_HTML"))) fmt) - (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))) - (while formatters - (setq fmt (pop formatters)) - (when (car fmt) - (goto-char (point-min)) - (while (re-search-forward (concat "^#\\+" (cadr fmt) - ":[ \t]*\\(.*\\)") nil t) - (replace-match "\\1" t) - (add-text-properties - (point-at-bol) (min (1+ (point-at-eol)) (point-max)) - '(org-protected t)))) - (goto-char (point-min)) - (while (re-search-forward - (concat "^#\\+" - (caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+" - (cadddr fmt) "\\>.*\n?") nil t) - (if (car fmt) - (add-text-properties (match-beginning 1) (1+ (match-end 1)) - '(org-protected t)) - (delete-region (match-beginning 0) (match-end 0)))) - (goto-char (point-min)) - (while (re-search-forward re-quote nil t) - (goto-char (match-beginning 0)) - (end-of-line 1) - (add-text-properties (point) (org-end-of-subtree t) - '(org-protected t))))) - - ;; 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) - (org-if-unprotected - (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) - (org-if-unprotected - (replace-match "\\1 \\3") - (goto-char (match-beginning 0)))) - - ;; Convert LaTeX fragments to images - (when (plist-get parameters :LaTeX-fragments) - (org-format-latex - (concat "ltxpng/" (file-name-sans-extension - (file-name-nondirectory - org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s")) - (message "Exporting...") - - ;; Normalize links: Convert angle and plain links into bracket links - ;; Expand link abbreviations - (goto-char (point-min)) - (while (re-search-forward re-plain-link nil t) - (goto-char (1- (match-end 0))) - (org-if-unprotected - (let* ((s (concat (match-string 1) "[[" (match-string 2) - ":" (match-string 3) "]]"))) - ;; added 'org-protected property to links - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))) - (goto-char (point-min)) - (while (re-search-forward re-angle-link nil t) - (goto-char (1- (match-end 0))) - (org-if-unprotected - (let* ((s (concat (match-string 1) "[[" (match-string 2) - ":" (match-string 3) "]]"))) - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp nil t) - (org-if-unprotected - (let* ((s (concat "[[" (setq xx (save-match-data - (org-link-expand-abbrev (match-string 1)))) - "]" - (if (match-end 3) - (match-string 2) - (concat "[" xx "]")) - "]"))) - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))) - - ;; Find multiline emphasis and put them into single line - (when (plist-get parameters :emph-multiline) - (goto-char (point-min)) - (while (re-search-forward org-emph-re nil t) - (if (not (= (char-after (match-beginning 3)) - (char-after (match-beginning 4)))) - (org-if-unprotected - (subst-char-in-region (match-beginning 0) (match-end 0) - ?\n ?\ t) - (goto-char (1- (match-end 0)))) - (goto-char (1+ (match-beginning 0)))))) - - (setq rtn (buffer-string))) - (kill-buffer " org-mode-tmp") - rtn)) - -(defun org-export-latex-cleaned-string () - "Clean stuff in the LaTeX export." + ;; align all tables + (goto-char (point-min)) + (while (re-search-forward "^\\([ \t]*\\)|" nil t) + ;; Re-align the table to update org-table-last-alignment + (org-table-align)) ;; Preserve line breaks (goto-char (point-min)) @@ -1090,7 +994,7 @@ (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))) - ;; Convert LaTeX to @LaTeX{} + ;; Convert LaTeX to \LaTeX{} (goto-char (point-min)) (let ((case-fold-search nil) rpl) (while (re-search-forward "\\([^+_]\\)LaTeX" nil t) @@ -1102,91 +1006,28 @@ (while (re-search-forward "^----+.$" nil t) (replace-match (org-latex-protect "\\hrule") t t)) - ;; Remove COMMENT subtrees - ;; What about QUOTE subtrees? - (goto-char (point-min)) - (while (re-search-forward - (concat "^\\*+ \\(" org-comment-string "\\)") - nil t) - (beginning-of-line) - (org-cut-subtree)) - ;; Protect LaTeX \commands{...} (goto-char (point-min)) (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))) - + ;; Replace radio links (goto-char (point-min)) - (let ((search (concat "<<<?" org-latex-all-targets-regexp ">?>>"))) - (while (re-search-forward search nil t) - (replace-match - (org-latex-protect (format "\\label{%s}" (match-string 1))) t t))) - + (while (re-search-forward + (concat "<<<?" org-latex-all-targets-regexp + ">>>?\\((INVISIBLE)\\)?") nil t) + (replace-match + (org-latex-protect + (format "\\label{%s}%s"(match-string 1) + (if (match-string 2) "" (match-string 1)))) t t)) + ;; Delete @<...> constructs (goto-char (point-min)) ;; Thanks to Daniel Clemente for this regexp (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t) (replace-match "")) - - ;; Add #+BEGIN_LaTeX before any \begin{...} - (goto-char (point-min)) - (while (re-search-forward "^ *\\\\begin{" nil t) - (replace-match "#+BEGIN_LaTeX:\n\\&" t)) - - ;; Add #+END_LaTeX after any \end{...} - (goto-char (point-min)) - (while (re-search-forward "^ *\\\\end{.+}.*$" nil t) - (replace-match "\\&\n#+END_LaTeX" t)) - - ;; Protect stuff from LaTeX processing. - ;; We will get rid on this once org.el integrate org-export-latex.el - (goto-char (point-min)) - (let ((formatters `((,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) fmt) - (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))) - (while formatters - (setq fmt (pop formatters)) - (when (car fmt) - (goto-char (point-min)) - (while (re-search-forward (concat "^#\\+" (cadr fmt) - ;; ":[ \t]*\\(.*\\)") nil t) - ;; FIXME: authorize spaces after #+LaTeX: - ;; to get list correctly exported - ":\\(.*\\)") nil t) - (replace-match "\\1" t) - (add-text-properties - (point-at-bol) (min (1+ (point-at-eol)) (point-max)) - '(org-protected t)))) - (goto-char (point-min)) - (while (re-search-forward - (concat "^#\\+" - (caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+" - (cadddr fmt) "\\>.*\n?") nil t) - (if (car fmt) - (add-text-properties (match-beginning 1) (1+ (match-end 1)) - '(org-protected t)) - (delete-region (match-beginning 0) (match-end 0)))) - (goto-char (point-min)) - (while (re-search-forward re-quote nil t) - (goto-char (match-beginning 0)) - (end-of-line 1) - (add-text-properties (point) (org-end-of-subtree t) - '(org-protected t))))) - ;; Remove or replace comments - ;; If :comments is set, use this char for commenting out comments and - ;; protect them. otherwise delete them - (goto-char (point-min)) - (while (re-search-forward "^#\\(.*\n?\\)" nil t) - (if commentsp - (progn (add-text-properties - (match-beginning 0) (match-end 0) '(org-protected t)) - (replace-match (format commentsp (match-string 1)) t t)) - (replace-match ""))) - ;; When converting to LaTeX, replace footnotes ;; FIXME: don't protect footnotes from conversion (when (plist-get org-latex-options-plist :footnotes)
--- a/lisp/textmodes/org-publish.el Wed Sep 26 03:18:21 2007 +0000 +++ b/lisp/textmodes/org-publish.el Wed Sep 26 05:05:01 2007 +0000 @@ -6,19 +6,19 @@ ;; Keywords: hypermedia, outlines ;; Version: 1.80 -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;; This file is part of GNU Emacs. @@ -438,6 +438,20 @@ ;;;; Pluggable publishing back-end functions + +(defun org-publish-org-to-html (plist filename) + "Publish an org file to HTML. +PLIST is the property list for the given project. +FILENAME is the filename of the org file to be published." + (require 'org) + (let* ((arg (plist-get plist :headline-levels))) + (progn + (find-file filename) + (org-export-as-html arg nil plist) + ;; get rid of HTML buffer + (kill-buffer (current-buffer))))) + + (defun org-publish-org-to-latex (plist filename) "Publish an org file to LaTeX." (org-publish-org-to "latex" plist filename)) @@ -600,8 +614,9 @@ (plists (org-publish-get-plists))) (mapcar 'org-publish-plist plists)))) + + (provide 'org-publish) ;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb ;;; org-publish.el ends here -
--- a/lisp/textmodes/org.el Wed Sep 26 03:18:21 2007 +0000 +++ b/lisp/textmodes/org.el Wed Sep 26 05:05:01 2007 +0000 @@ -60,7 +60,7 @@ ;; in the etc/ directory of Emacs 22. ;; ;; A list of recent changes can be found at -;; http://orgmode.org/Changes +;; http://orgmode.org/Changes.html ;; ;;; Code: @@ -83,7 +83,7 @@ ;;; Version -(defconst org-version "5.08" +(defconst org-version "5.09" "The version number of the file org.el.") (defun org-version () (interactive) @@ -1231,15 +1231,15 @@ (defcustom org-confirm-shell-link-function 'yes-or-no-p "Non-nil means, ask for confirmation before executing shell links. -Shell links can be dangerous: just think about a link +Shell links can be dangerous, just thing about a link [[shell:rm -rf ~/*][Google Search]] -This link would show up in your Org-mode document as \"Google Search\", +This link would show up in your Org-mode document as \"Google Search\" but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -You can change it to `y-or-n-p' if you want to confirm -with a single keystroke instead of \"yes\"." +Therefore I *definitely* advise against setting this variable to nil. +Just change it to `y-or-n-p' of you want to confirm with a single key press +rather than having to type \"yes\"." :group 'org-link-follow :type '(choice (const :tag "with yes-or-no (safer)" yes-or-no-p) @@ -1247,16 +1247,16 @@ (const :tag "no confirmation (dangerous)" nil))) (defcustom org-confirm-elisp-link-function 'yes-or-no-p - "Non-nil means, ask for confirmation before executing Emacs Lisp links. -Emacs Lisp links can be dangerous: just think about a link + "Non-nil means, ask for confirmation before executing elisp links. +Elisp links can be dangerous, just think about a link [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] -This link would show up in your Org-mode document as \"Google Search\", +This link would show up in your Org-mode document as \"Google Search\" but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -You can change it to `y-or-n-p' if you want to confirm -with a single keystroke instead of \"yes\"." +Therefore I *definitely* advise against setting this variable to nil. +Just change it to `y-or-n-p' of you want to confirm with a single key press +rather than having to type \"yes\"." :group 'org-link-follow :type '(choice (const :tag "with yes-or-no (safer)" yes-or-no-p) @@ -1372,7 +1372,7 @@ (const :tag "Default from remember-data-file" nil) file)) -(defcustom org-remember-store-without-prompt nil +(defcustom org-remember-store-without-prompt t "Non-nil means, `C-c C-c' stores remember note without further promts. In this case, you need `C-u C-c C-c' to get the prompts for note file and headline. @@ -1520,6 +1520,8 @@ (make-variable-buffer-local 'org-todo-heads) (defvar org-todo-sets nil) (make-variable-buffer-local 'org-todo-sets) +(defvar org-todo-log-states nil) +(make-variable-buffer-local 'org-todo-log-states) (defvar org-todo-kwd-alist nil) (make-variable-buffer-local 'org-todo-kwd-alist) (defvar org-todo-key-alist nil) @@ -1818,11 +1820,9 @@ (const :tag "Yes" t) (const :tag "Expert" expert))) -(defcustom org-fast-tag-selection-include-todo nil - "Non-nil means, fast tags selection interface will also offer TODO states." - :group 'org-tags - :group 'org-todo - :type 'boolean) +(defvar org-fast-tag-selection-include-todo nil + "Non-nil means, fast tags selection interface will also offer TODO states. +This is an undocumented feature, you should not rely on it.") (defcustom org-tags-column 48 "The column to which tags should be indented in a headline. @@ -1867,6 +1867,8 @@ "History of minibuffer reads for tags.") (defvar org-last-tags-completion-table nil "The last used completion table for tags.") +(defvar org-after-tags-change-hook nil + "Hook that is run after the tags in a line have changed.") (defgroup org-properties nil "Options concerning properties in Org-mode." @@ -2314,13 +2316,25 @@ :group 'org-agenda-daily/weekly :type 'boolean) -(defcustom org-agenda-date-format "%A %d %B %Y" +(defcustom org-agenda-format-date 'org-agenda-format-date-aligned "Format string for displaying dates in the agenda. Used by the daily/weekly agenda and by the timeline. This should be -a format string understood by `format-time-string'. -FIXME: Not used currently, because of timezone problem." +a format string understood by `format-time-string', or a function returning +the formatted date as a string. The function must take a single argument, +a calendar-style date list like (month day year)." :group 'org-agenda-daily/weekly - :type 'string) + :type '(choice + (string :tag "Format string") + (function :tag "Function"))) + +(defun org-agenda-format-date-aligned (date) + "Format a date string for display in the daily/weekly agenda, or timeline. +This function makes sure that dates are aligned for easy reading." + (format "%-9s %2d %s %4d" + (calendar-day-name date) + (extract-calendar-day date) + (calendar-month-name (extract-calendar-month date)) + (extract-calendar-year date))) (defcustom org-agenda-include-diary nil "If non-nil, include in the agenda entries from the Emacs Calendar's diary." @@ -3269,26 +3283,36 @@ ;; FIXME: convert that into a macro? Not critical, because this ;; is only executed a few times at load time. -(defun org-compatible-face (specs) +(defun org-compatible-face (inherits specs) "Make a compatible face specification. +If INHERITS is an existing face and if the Emacs version supports it, +just inherit the face. If not, use SPECS to define the face. XEmacs and Emacs 21 do not know about the `min-colors' attribute. For them we convert a (min-colors 8) entry to a `tty' entry and move it to the top of the list. The `min-colors' attribute will be removed from any other entries, and any resulting duplicates will be removed entirely." - (if (or (featurep 'xemacs) (< emacs-major-version 22)) - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r)) - specs)) + (cond + ((and inherits (facep inherits) + (not (featurep 'xemacs)) (> emacs-major-version 22)) + ;; In Emacs 23, we use inheritance where possible. + ;; We only do this in Emacs 23, because only there the outline + ;; faces have been changed to the original org-mode-level-faces. + (list (list t :inherit inherits))) + ((or (featurep 'xemacs) (< emacs-major-version 22)) + ;; These do not understand the `min-colors' attribute. + (let (r e a) + (while (setq e (pop specs)) + (cond + ((memq (car e) '(t default)) (push e r)) + ((setq a (member '(min-colors 8) (car e))) + (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) + (cdr e))))) + ((setq a (assq 'min-colors (car e))) + (setq e (cons (delq a (car e)) (cdr e))) + (or (assoc (car e) r) (push e r))) + (t (or (assoc (car e) r) (push e r))))) + (nreverse r))) + (t specs))) (defface org-hide '((((background light)) (:foreground "white")) @@ -3300,6 +3324,7 @@ (defface org-level-1 ;; font-lock-function-name-face (org-compatible-face + 'outline-1 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) (((class color) (min-colors 16) (background light)) (:foreground "Blue")) @@ -3311,6 +3336,7 @@ (defface org-level-2 ;; font-lock-variable-name-face (org-compatible-face + 'outline-2 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) (((class color) (min-colors 8) (background light)) (:foreground "yellow")) @@ -3321,6 +3347,7 @@ (defface org-level-3 ;; font-lock-keyword-face (org-compatible-face + 'outline-3 '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) (((class color) (min-colors 16) (background light)) (:foreground "Purple")) @@ -3333,6 +3360,7 @@ (defface org-level-4 ;; font-lock-comment-face (org-compatible-face + 'outline-4 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) (((class color) (min-colors 16) (background light)) (:foreground "red")) @@ -3345,6 +3373,7 @@ (defface org-level-5 ;; font-lock-type-face (org-compatible-face + 'outline-5 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) (((class color) (min-colors 8)) (:foreground "green")))) @@ -3353,6 +3382,7 @@ (defface org-level-6 ;; font-lock-constant-face (org-compatible-face + 'outline-6 '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) (((class color) (min-colors 8)) (:foreground "magenta")))) @@ -3361,6 +3391,7 @@ (defface org-level-7 ;; font-lock-builtin-face (org-compatible-face + 'outline-7 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) (((class color) (min-colors 8)) (:foreground "blue")))) @@ -3369,6 +3400,7 @@ (defface org-level-8 ;; font-lock-string-face (org-compatible-face + 'outline-8 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) (((class color) (min-colors 8)) (:foreground "green")))) @@ -3377,6 +3409,7 @@ (defface org-special-keyword ;; font-lock-string-face (org-compatible-face + nil '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) (t (:italic t)))) @@ -3385,6 +3418,7 @@ (defface org-drawer ;; font-lock-function-name-face (org-compatible-face + nil '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) (((class color) (min-colors 16) (background light)) (:foreground "Blue")) @@ -3400,6 +3434,7 @@ (defface org-column (org-compatible-face + nil '((((class color) (min-colors 16) (background light)) (:background "grey90")) (((class color) (min-colors 16) (background dark)) @@ -3416,8 +3451,9 @@ :height (face-attribute 'default :height) :family (face-attribute 'default :family))) -(defface org-warning ;; font-lock-warning-face +(defface org-warning (org-compatible-face + 'font-lock-warning-face '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) @@ -3428,6 +3464,7 @@ (defface org-archived ; similar to shadow (org-compatible-face + 'shadow '((((class color grayscale) (min-colors 88) (background light)) (:foreground "grey50")) (((class color grayscale) (min-colors 88) (background dark)) @@ -3472,8 +3509,9 @@ "Face for tags." :group 'org-faces) -(defface org-todo ;; font-lock-warning-face +(defface org-todo ; font-lock-warning-face (org-compatible-face + nil '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) @@ -3484,6 +3522,7 @@ (defface org-done ;; font-lock-type-face (org-compatible-face + nil '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) (((class color) (min-colors 8)) (:foreground "green")) @@ -3493,6 +3532,7 @@ (defface org-headline-done ;; font-lock-string-face (org-compatible-face + nil '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) (((class color) (min-colors 8) (background light)) (:bold nil)))) @@ -3515,6 +3555,7 @@ (defface org-table ;; font-lock-function-name-face (org-compatible-face + nil '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) (((class color) (min-colors 16) (background light)) (:foreground "Blue")) @@ -3526,6 +3567,7 @@ (defface org-formula (org-compatible-face + nil '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) (((class color) (min-colors 8) (background light)) (:foreground "red")) @@ -3536,6 +3578,7 @@ (defface org-code (org-compatible-face + nil '((((class color grayscale) (min-colors 88) (background light)) (:foreground "grey50")) (((class color grayscale) (min-colors 88) (background dark)) @@ -3550,6 +3593,7 @@ (defface org-agenda-structure ;; font-lock-function-name-face (org-compatible-face + nil '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) (((class color) (min-colors 16) (background light)) (:foreground "Blue")) @@ -3561,6 +3605,7 @@ (defface org-scheduled-today (org-compatible-face + nil '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) (((class color) (min-colors 8)) (:foreground "green")) @@ -3570,6 +3615,7 @@ (defface org-scheduled-previously (org-compatible-face + nil '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) (((class color) (min-colors 8) (background light)) (:foreground "red")) @@ -3580,6 +3626,7 @@ (defface org-upcoming-deadline (org-compatible-face + nil '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) (((class color) (min-colors 8) (background light)) (:foreground "red")) @@ -3615,6 +3662,7 @@ (defface org-time-grid ;; font-lock-variable-name-face (org-compatible-face + nil '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) @@ -3779,13 +3827,15 @@ (org-set-local 'org-done-keywords nil) (org-set-local 'org-todo-heads nil) (org-set-local 'org-todo-sets nil) + (org-set-local 'org-todo-log-states nil) (let ((re (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "COLUMNS" + '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY"))) (splitre "[ \t]+") kwds kws0 kwsa key value cat arch tags const links hw dws - tail sep kws1 prio props) + tail sep kws1 prio props + ex log note) (save-excursion (save-restriction (widen) @@ -3797,7 +3847,7 @@ (if (string-match "[ \t]+$" value) (setq value (replace-match "" t t value))) (setq cat (intern value))) - ((equal key "SEQ_TODO") + ((member key '("SEQ_TODO" "TODO")) (push (cons 'sequence (org-split-string value splitre)) kwds)) ((equal key "TYP_TODO") (push (cons 'type (org-split-string value splitre)) kwds)) @@ -3855,21 +3905,25 @@ (default-value 'org-todo-keywords))))) (setq kwds (reverse kwds))) (setq kwds (nreverse kwds)) - (let (inter kws) + (let (inter kws kw) (while (setq kws (pop kwds)) (setq inter (pop kws) sep (member "|" kws) kws0 (delete "|" (copy-sequence kws)) kwsa nil - kws1 (mapcar (lambda (x) - (if (string-match "\\(.*\\)(\\(.\\))" x) - (progn - (push (cons (match-string 1 x) - (string-to-char - (match-string 2 x))) kwsa) - (match-string 1 x)) - (push (list x) kwsa) - x)) - kws0) + kws1 (mapcar + (lambda (x) + (if (string-match "^\\(.*?\\)\\(?:(\\(..?\\))\\)?$" x) + (progn + (setq kw (match-string 1 x) + ex (and (match-end 2) (match-string 2 x)) + log (and ex (string-match "@" ex)) + key (and ex (substring ex 0 1))) + (if (equal key "@") (setq key nil)) + (push (cons kw (and key (string-to-char key))) kwsa) + (and log (push kw org-todo-log-states)) + kw) + (error "Invalid TODO keyword %s" x))) + kws0) kwsa (if kwsa (append '((:startgroup)) (nreverse kwsa) '((:endgroup)))) @@ -3987,7 +4041,7 @@ (defun org-remove-keyword-keys (list) (mapcar (lambda (x) - (if (string-match "(.)$" x) + (if (string-match "(..?)$" x) (substring x 0 (match-beginning 0)) x)) list)) @@ -4196,7 +4250,7 @@ (defvar org-inhibit-startup nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. (defvar org-table-buffer-is-an nil) - +(defconst org-outline-regexp "\\*+ ") ;;;###autoload (define-derived-mode org-mode outline-mode "Org" @@ -4239,8 +4293,8 @@ (org-add-to-invisibility-spec '(org-cwidth)) (when (featurep 'xemacs) (org-set-local 'line-move-ignore-invisible t)) - (org-set-local 'outline-regexp "\\*+ ") - (setq outline-level 'org-outline-level) + (org-set-local 'outline-regexp org-outline-regexp) + (org-set-local 'outline-level 'org-outline-level) (when (and org-ellipsis (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) (fboundp 'make-glyph-code)) @@ -5119,7 +5173,7 @@ (defvar org-goto-marker nil) (defvar org-goto-map (let ((map (make-sparse-keymap))) - (let ((cmds '(isearch-forward isearch-backward)) cmd) + (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd) (while (setq cmd (pop cmds)) (substitute-key-definition cmd cmd map global-map))) (org-defkey map "\C-m" 'org-goto-ret) @@ -5136,6 +5190,7 @@ (org-defkey map "f" 'outline-forward-same-level) (org-defkey map "b" 'outline-backward-same-level) (org-defkey map "u" 'outline-up-heading) + (org-defkey map "/" 'org-occur) (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) (org-defkey map "\C-c\C-f" 'outline-forward-same-level) @@ -5147,55 +5202,63 @@ map)) (defconst org-goto-help -"Select a location to jump to, press RET -\[Up]/[Down]=next/prev headline TAB=cycle visibility RET=select [Q]uit") +"Browse copy of buffer to find location or copy text. +RET=jump to location [Q]uit and return to previous location +\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" +) (defun org-goto () - "Go to a different location of the document, keeping current visibility. - -When you want to go to a different location in a document, the fastest way -is often to fold the entire buffer and then dive into the tree. This -method has the disadvantage, that the previous location will be folded, + "Look up a different location in the current file, keeping current visibility. + +When you want look-up or go to a different location in a document, the +fastest way is often to fold the entire buffer and then dive into the tree. +This method has the disadvantage, that the previous location will be folded, which may not be what you want. -This command works around this by showing a copy of the current buffer in -overview mode. You can dive into the tree in that copy, to find the -location you want to reach. When pressing RET, the command returns to the -original buffer in which the visibility is still unchanged. It then jumps -to the new location, making it and the headline hierarchy above it visible." +This command works around this by showing a copy of the current buffer +in an indirect buffer, in overview mode. You can dive into the tree in +that copy, use org-occur and incremental search to find a location. +When pressing RET or `Q', the command returns to the original buffer in +which the visibility is still unchanged. After RET is will also jump to +the location selected in the indirect buffer and expose the +the headline hierarchy above." (interactive) (let* ((org-goto-start-pos (point)) (selected-point - (org-get-location (current-buffer) org-goto-help))) + (car (org-get-location (current-buffer) org-goto-help)))) (if selected-point (progn (org-mark-ring-push org-goto-start-pos) (goto-char selected-point) (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'org-goto))) - (error "Quit")))) - -(defvar org-selected-point nil) ; dynamically scoped parameter + (message "Quit")))) + +(defvar org-goto-selected-point nil) ; dynamically scoped parameter +(defvar org-goto-exit-command nil) ; dynamically scoped parameter (defun org-get-location (buf help) "Let the user select a location in the Org-mode buffer BUF. This function uses a recursive edit. It returns the selected position or nil." - (let (org-selected-point) + (let (org-goto-selected-point org-goto-exit-command) (save-excursion (save-window-excursion (delete-other-windows) - (switch-to-buffer (get-buffer-create "*org-goto*")) + (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) + (switch-to-buffer + (condition-case nil + (make-indirect-buffer (current-buffer) "*org-goto*") + (error (make-indirect-buffer (current-buffer) "*org-goto*")))) (with-output-to-temp-buffer "*Help*" (princ help)) (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) (setq buffer-read-only nil) - (erase-buffer) - (insert-buffer-substring buf) (let ((org-startup-truncated t) - (org-startup-folded t) + (org-startup-folded nil) (org-startup-align-all-tables nil)) - (org-mode)) + (org-mode) + (org-overview)) (setq buffer-read-only t) (if (and (boundp 'org-goto-start-pos) (integer-or-marker-p org-goto-start-pos)) @@ -5209,21 +5272,24 @@ (message "Select location and press RET") ;; now we make sure that during selection, ony very few keys work ;; and that it is impossible to switch to another window. - (let ((gm (current-global-map)) - (overriding-local-map org-goto-map)) - (unwind-protect - (progn - (use-global-map org-goto-map) - (recursive-edit)) - (use-global-map gm))))) +; (let ((gm (current-global-map)) +; (overriding-local-map org-goto-map)) +; (unwind-protect +; (progn +; (use-global-map org-goto-map) +; (recursive-edit)) +; (use-global-map gm))) + (use-local-map org-goto-map) + (recursive-edit) + )) (kill-buffer "*org-goto*") - org-selected-point)) + (cons org-goto-selected-point org-goto-exit-command))) (defun org-goto-ret (&optional arg) "Finish `org-goto' by going to the new location." (interactive "P") - (setq org-selected-point (point) - current-prefix-arg arg) + (setq org-goto-selected-point (point) + org-goto-exit-command 'return) (throw 'exit nil)) (defun org-goto-left () @@ -5232,8 +5298,8 @@ (if (org-on-heading-p) (progn (beginning-of-line 1) - (setq org-selected-point (point) - current-prefix-arg (- (match-end 0) (match-beginning 0))) + (setq org-goto-selected-point (point) + org-goto-exit-command 'left) (throw 'exit nil)) (error "Not on a heading"))) @@ -5242,17 +5308,16 @@ (interactive) (if (org-on-heading-p) (progn - (outline-end-of-subtree) - (or (eobp) (forward-char 1)) - (setq org-selected-point (point) - current-prefix-arg (- (match-end 0) (match-beginning 0))) + (setq org-goto-selected-point (point) + org-goto-exit-command 'right) (throw 'exit nil)) (error "Not on a heading"))) (defun org-goto-quit () "Finish `org-goto' without cursor motion." (interactive) - (setq org-selected-point nil) + (setq org-goto-selected-point nil) + (setq org-goto-exit-command 'quit) (throw 'exit nil)) ;;; Indirect buffer display of subtrees @@ -5741,21 +5806,15 @@ (func (if (> shift 0) 'org-demote 'org-promote)) (org-odd-levels-only nil) beg end) - ;; Remove the forces level indicator + ;; Remove the forced level indicator (if force-level (delete-region (point-at-bol) (point))) - ;; Make sure we start at the beginning of an empty line - (if (not (bolp)) (insert "\n")) - (if (not (looking-at "[ \t]*$")) - (progn (insert "\n") (backward-char 1))) ;; Paste + (beginning-of-line 1) (setq beg (point)) - (if (string-match "[ \t\r\n]+\\'" txt) - (setq txt (replace-match "\n" t t txt))) (insert txt) + (unless (string-match "\n[ \t]*\\'" txt) (insert "\n")) (setq end (point)) - (if (looking-at "[ \t\r\n]+") - (replace-match "\n")) (goto-char beg) ;; Shift if necessary (unless (= shift 0) @@ -5782,16 +5841,17 @@ If optional TXT is given, check this string instead of the current kill." (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) (start-level (and kill - (string-match (concat "\\`" outline-regexp) kill) - (- (match-end 0) (match-beginning 0)))) - (re (concat "^" outline-regexp)) + (string-match (concat "\\`" org-outline-regexp) kill) + (- (match-end 0) (match-beginning 0) 1))) + (re (concat "^" org-outline-regexp)) (start 1)) (if (not start-level) - nil ;; does not even start with a heading + (progn + nil) ;; does not even start with a heading (catch 'exit (while (setq start (string-match re kill (1+ start))) - (if (< (- (match-end 0) (match-beginning 0)) start-level) - (throw 'exit nil))) + (when (< (- (match-end 0) (match-beginning 0) 1) start-level) + (throw 'exit nil))) t)))) (defun org-narrow-to-subtree () @@ -6773,11 +6833,12 @@ (save-excursion (org-back-to-heading t) ;; Get context information that will be lost by moving the tree - (setq category (org-get-category) + (setq org-category-table (org-get-category-table) + category (org-get-category) todo (and (looking-at org-todo-line-regexp) - (match-string 2)) + (match-string 2)) priority (org-get-priority (if (match-end 3) (match-string 3) "")) - ltags (org-split-string (org-get-tags) ":") + ltags (org-get-tags) itags (org-delete-all ltags (org-get-tags-at))) (setq ltags (mapconcat 'identity ltags " ") itags (mapconcat 'identity itags " ")) @@ -6984,8 +7045,9 @@ (end-of-line 1) (when current (insert " :" (mapconcat 'identity (nreverse current) ":") ":")) - (org-set-tags nil t)) - res)) + (org-set-tags nil t) + res) + (run-hooks 'org-after-tags-change-hook))) (defun org-toggle-archive-tag (&optional arg) "Toggle the archive tag for the current headline. @@ -10940,10 +11002,11 @@ (setq cpltxt (substring cpltxt 0 -2))) (setq link (org-make-link cpltxt))) - (buffer-file-name + ((buffer-file-name (buffer-base-buffer)) ;; Just link to this file here. (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) ;; Add a context string (when (org-xor org-context-in-file-links arg) (setq txt (if (org-region-active-p) @@ -11063,6 +11126,8 @@ (defconst org-link-escape-chars '((" " . "%20") + ("[" . "%5B") + ("]" . "%5d") ("\340" . "%E0") ; `a ("\342" . "%E2") ; ^a ("\347" . "%E7") ; ,c @@ -12208,10 +12273,12 @@ (defconst org-remember-help "Select a destination location for the note. UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store +RET on headline -> Store as sublevel entry to current headline RET at beg-of-buf -> Append to file as level 2 headline -RET on headline -> Store as sublevel entry to current headline <left>/<right> -> before/after current headline, same headings level") +(defvar org-remember-previous-location nil) + ;;;###autoload (defun org-remember-apply-template (&optional use-char skip-interactive) "Initialize *remember* buffer with template, invoke `org-mode'. @@ -12241,7 +12308,8 @@ (v-U (concat "[" (substring v-T 1 -1) "]")) (v-i initial) ; defined in `remember-mode' (v-a (if (equal annotation "[[]]") "" annotation)) ; likewise - (v-A (if (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a) + (v-A (if (and v-a + (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) (replace-match "[\\1[%^{Link description}]]" nil nil v-a) v-a)) (v-n user-full-name) @@ -12254,13 +12322,17 @@ (erase-buffer) (insert (substitute-command-keys (format - "## `%sC-c C-c' to file directly, `%sC-c C-c' to file interactively. -## Target file \"%s\", headline \"%s\" +"## Filing location: Select interactively, default, or last used: +## %s to select file and header location interactively. +## %s \"%s\" -> \"* %s\" +## C-u C-u C-c C-c \"%s\" -> \"* %s\" ## To switch templates, use `\\[org-remember]'.\n\n" - (if org-remember-store-without-prompt "" "C-u ") - (if org-remember-store-without-prompt "C-u " "") + (if org-remember-store-without-prompt " C-u C-c C-c" " C-c C-c") + (if org-remember-store-without-prompt " C-c C-c" " C-u C-c C-c") (abbreviate-file-name (or file org-default-notes-file)) - (or headline "")))) + (or headline "") + (or (car org-remember-previous-location) "???") + (or (cdr org-remember-previous-location) "???")))) (insert tpl) (goto-char (point-min)) ;; Simple %-escapes (while (re-search-forward "%\\([tTuUaiA]\\)" nil t) @@ -12361,7 +12433,7 @@ Key Cursor position Note gets inserted ----------------------------------------------------------------------------- -RET buffer-start as level 2 heading at end of file +RET buffer-start as level 1 heading at end of file RET on headline as sublevel of the heading at cursor RET no heading at cursor position, level taken from context. Or use prefix arg to specify level manually. @@ -12397,7 +12469,10 @@ (org-startup-folded nil) (org-startup-align-all-tables nil) (org-goto-start-pos 1) - spos level indent reversed) + spos exitcmd level indent reversed) + (if (and (equal current-prefix-arg '(16)) org-remember-previous-location) + (setq file (car org-remember-previous-location) + heading (cdr org-remember-previous-location))) (setq current-prefix-arg nil) ;; Modify text so that it becomes a nice subtree which can be inserted ;; into an org tree. @@ -12419,6 +12494,8 @@ ;; Find the file (if (not visiting) (find-file-noselect file)) (with-current-buffer (or visiting (get-file-buffer file)) + (unless (org-mode-p) + (error "Target files for remember notes must be in Org-mode")) (save-excursion (save-restriction (widen) @@ -12437,19 +12514,50 @@ (setq org-goto-start-pos (match-beginning 0)))) ;; Ask the User for a location - (setq spos (if fastp - org-goto-start-pos - (org-get-location (current-buffer) org-remember-help))) + (if fastp + (setq spos org-goto-start-pos + exitcmd 'return) + (setq spos (org-get-location (current-buffer) org-remember-help) + exitcmd (cdr spos) + spos (car spos))) (if (not spos) (throw 'quit nil)) ; return nil to show we did ; not handle this note (goto-char spos) - (cond ((and (bobp) (not reversed)) + (cond ((org-on-heading-p t) + (org-back-to-heading t) + (setq level (funcall outline-level)) + (cond + ((eq exitcmd 'return) + ;; sublevel of current + (setq org-remember-previous-location + (cons (abbreviate-file-name file) + (org-get-heading 'notags))) + (if reversed + (outline-next-heading) + (org-end-of-subtree) + (if (not (bolp)) + (if (looking-at "[ \t]*\n") + (beginning-of-line 2) + (end-of-line 1) + (insert "\n")))) + (org-paste-subtree (org-get-legal-level level 1) txt)) + ((eq exitcmd 'left) + ;; before current + (org-paste-subtree level txt)) + ((eq exitcmd 'right) + ;; after current + (org-end-of-subtree t) + (org-paste-subtree level txt)) + (t (error "This should not happen")))) + + ((and (bobp) (not reversed)) ;; Put it at the end, one level below level 1 (save-restriction (widen) (goto-char (point-max)) (if (not (bolp)) (newline)) (org-paste-subtree (org-get-legal-level 1 1) txt))) + ((and (bobp) reversed) ;; Put it at the start, as level 1 (save-restriction @@ -12458,16 +12566,6 @@ (re-search-forward "^\\*+ " nil t) (beginning-of-line 1) (org-paste-subtree 1 txt))) - ((and (org-on-heading-p t) (not current-prefix-arg)) - ;; Put it below this entry, at the beg/end of the subtree - (org-back-to-heading t) - (setq level (funcall outline-level)) - (if reversed - (outline-next-heading) - (org-end-of-subtree t)) - (if (not (bolp)) (newline)) - (beginning-of-line 1) - (org-paste-subtree (org-get-legal-level level 1) txt)) (t ;; Put it right there, with automatic level determined by ;; org-paste-subtree or from prefix arg @@ -12762,12 +12860,6 @@ \"WAITING\" -> switch to the specified keyword, but only if it really is a member of `org-todo-keywords'." (interactive "P") - (when (and org-todo-key-trigger ; keys have been set up by the user - (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix)) - (and (not arg) org-use-fast-todo-selection - (not (eq org-use-fast-todo-selection 'prefix))))) - ;; Get the keyword with direct selction - (setq arg (org-fast-todo-selection))) (save-excursion (org-back-to-heading) (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) @@ -12784,8 +12876,13 @@ (member (member this org-todo-keywords-1)) (tail (cdr member)) (state (cond - ;; FIXME: most the fast interface here - ((equal arg '(4)) + ((and org-todo-key-trigger + (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix)) + (and (not arg) org-use-fast-todo-selection + (not (eq org-use-fast-todo-selection 'prefix))))) + ;; Use fast selection + (org-fast-todo-selection)) + ((and (equal arg '(4)) (eq org-use-fast-todo-selection nil)) ;; Read a state with completion (completing-read "State: " (mapcar (lambda(x) (list x)) org-todo-keywords-1) @@ -12801,6 +12898,8 @@ (nth (- (length org-todo-keywords-1) (length tail) 2) org-todo-keywords-1) (org-last org-todo-keywords-1)))) + ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) + (setq arg nil))) ; hack to fall back to cycling (arg ;; user or caller requests a specific state (cond @@ -12847,8 +12946,10 @@ (setq org-last-todo-state-is-todo (not (member state org-done-keywords))) (when (and org-log-done (not (memq arg '(nextset previousset)))) - (setq dostates (and (eq interpret 'sequence) - (listp org-log-done) (memq 'state org-log-done))) + (setq dostates (and (listp org-log-done) (memq 'state org-log-done) + (or (not org-todo-log-states) + (member state org-todo-log-states)))) + (cond ((and state (member state org-not-done-keywords) (not (member this org-not-done-keywords))) @@ -13368,6 +13469,9 @@ (setq new action) (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) (setq new (read-char-exclusive))) + (if (and (= (upcase org-highest-priority) org-highest-priority) + (= (upcase org-lowest-priority) org-lowest-priority)) + (setq new (upcase new))) (cond ((equal new ?\ ) (setq remove t)) ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) (error "Priority must be between `%c' and `%c'" @@ -13377,7 +13481,9 @@ ((eq action 'down) (setq new (1+ current))) (t (error "Invalid action"))) - (setq new (min (max org-highest-priority (upcase new)) org-lowest-priority)) + (if (or (< (upcase new) org-highest-priority) + (> (upcase new) org-lowest-priority)) + (setq remove t)) (setq news (format "%c" new)) (if have (if remove @@ -13654,7 +13760,7 @@ With prefix ARG, realign all tags in headings in the current buffer." (interactive "P") (let* ((re (concat "^" outline-regexp)) - (current (org-get-tags)) + (current (org-get-tags-string)) (col (current-column)) (org-setting-tags t) table current-tags inherited-tags ; computed below when needed @@ -13716,7 +13822,9 @@ (and (not (featurep 'xemacs)) c0 (tabify p0 (point))) tags) (t (error "Tags alignment failed"))) - (move-to-column col)))) + (move-to-column col) + (unless just-align + (run-hooks 'org-after-tags-change-hook))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. @@ -13994,7 +14102,7 @@ (mapconcat 'identity current ":") nil)))) -(defun org-get-tags () +(defun org-get-tags-string () "Get the TAGS string in the current headline." (unless (org-on-heading-p t) (error "Not on a heading")) @@ -14004,6 +14112,10 @@ (org-match-string-no-properties 1) ""))) +(defun org-get-tags () + "Get the list of tags specified in the current headline." + (org-split-string (org-get-tags-string) ":")) + (defun org-get-buffer-tags () "Get a table of all tags used in the buffer, for completion." (let (tags) @@ -14128,7 +14240,8 @@ (push (cons "TODO" (org-match-string-no-properties 2)) props)) (when (looking-at org-priority-regexp) (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) - (when (and (setq value (org-get-tags)) (string-match "\\S-" value)) + (when (and (setq value (org-get-tags-string)) + (string-match "\\S-" value)) (push (cons "TAGS" value) props)) (when (setq value (org-get-tags-at)) (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) @@ -14209,9 +14322,7 @@ (org-back-to-heading t) (move-marker org-entry-property-inherited-from (point)) (throw 'ex tmp)) - (condition-case nil - (org-up-heading-all 1) - (error (throw 'ex nil)))))) + (or (org-up-heading-safe) (throw 'ex nil))))) (or tmp (cdr (assoc property org-local-properties)) (cdr (assoc property org-global-properties))))) @@ -15692,6 +15803,12 @@ (time-to-days (current-time))) (match-string 0 s))) (t (time-to-days (apply 'encode-time (org-parse-time-string s)))))) +(defun org-time-from-absolute (d) + "Return the time corresponding to date D. +D may be an absolute day number, or a calendar-type list (month day year)." + (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) + (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) + (defun org-calendar-holiday () "List of holidays, for Diary display in Org-mode." (let ((hl (check-calendar-holidays date))) @@ -17626,14 +17743,12 @@ entry date args))) (if (or rtn (equal d today) org-timeline-show-empty-dates) (progn - (insert (calendar-day-name date) " " - (number-to-string (extract-calendar-day date)) " " - (calendar-month-name (extract-calendar-month date)) " " - (number-to-string (extract-calendar-year date)) "\n") -; FIXME: this gives a timezone problem -; (insert (format-time-string org-agenda-date-format -; (calendar-time-from-absolute d 0)) -; "\n") + (insert + (if (stringp org-agenda-format-date) + (format-time-string org-agenda-format-date + (org-time-from-absolute date)) + (funcall org-agenda-format-date date)) + "\n") (put-text-property s (1- (point)) 'face 'org-agenda-structure) (put-text-property s (1- (point)) 'org-date-line t) (if (equal d today) @@ -17806,14 +17921,12 @@ (setq rtnall (append rtnall rtn)))) (if (or rtnall org-agenda-show-all-dates) (progn - (insert (format "%-9s %2d %s %4d\n" - (calendar-day-name date) - (extract-calendar-day date) - (calendar-month-name (extract-calendar-month date)) - (extract-calendar-year date))) -; FIXME: this gives a timezone problem -; (insert (format-time-string org-agenda-date-format -; (calendar-time-from-absolute d 0)) "\n") + (insert + (if (stringp org-agenda-format-date) + (format-time-string org-agenda-format-date + (org-time-from-absolute date)) + (funcall org-agenda-format-date date)) + "\n") (put-text-property s (1- (point)) 'face 'org-agenda-structure) (put-text-property s (1- (point)) 'org-date-line t) (if todayp (put-text-property s (1- (point)) 'org-today t)) @@ -19909,11 +20022,15 @@ (setq ts (org-deadline)) (message "Deadline for this item set to %s" ts))))) -(defun org-get-heading () +(defun org-get-heading (&optional no-tags) "Return the heading of the current entry, without the stars." (save-excursion (org-back-to-heading t) - (if (looking-at "\\*+[ \t]+\\([^\r\n]*\\)") (match-string 1) ""))) + (if (looking-at + (if no-tags + (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$") + "\\*+[ \t]+\\([^\r\n]*\\)")) + (match-string 1) ""))) (defun org-agenda-clock-in (&optional arg) "Start the clock on the currently selected item." @@ -21003,8 +21120,8 @@ ;; Specific LaTeX stuff (when latexp - (require 'org-export-latex nil t) - (org-export-latex-cleaned-string commentsp)) + (require 'org-export-latex nil) + (org-export-latex-cleaned-string)) ;; Specific HTML stuff (when htmlp @@ -24534,6 +24651,21 @@ (outline-up-heading-all arg) ; emacs 21 version of outline.el (outline-up-heading arg t))) ; emacs 22 version of outline.el +(defun org-up-heading-safe () + "Move to the heading line of which the present line is a subheading. +This version will not throw an error. It will return the level of the +headline found, or nil if no higher level is found." + (let ((pos (point)) start-level level + (re (concat "^" outline-regexp))) + (catch 'exit + (outline-back-to-heading t) + (setq start-level (funcall outline-level)) + (if (equal start-level 1) (throw 'exit nil)) + (while (re-search-backward re nil t) + (setq level (funcall outline-level)) + (if (< level start-level) (throw 'exit level))) + nil))) + (defun org-goto-sibling (&optional previous) "Goto the next sibling, even if it is invisible. When PREVIOUS is set, go to the previous sibling instead. Returns t @@ -24751,6 +24883,7 @@ t))) (t nil)))) ; call paragraph-fill +;; FIXME: this needs a much better algorithm (defun org-assign-fast-keys (alist) "Assign fast keys to a keyword-key alist. Respect keys that are already there."