%s

# HG changeset patch # User John Wiegley # Date 1189196206 0 # Node ID a32093d94b4a8548d5c9c870bd3ea3ae15739fd9 # Parent 497448aab7db07abe068ccf7f8f912422b67b091 Updated to org-mode 5.08 diff -r 497448aab7db -r a32093d94b4a lisp/ChangeLog --- a/lisp/ChangeLog Fri Sep 07 20:04:58 2007 +0000 +++ b/lisp/ChangeLog Fri Sep 07 20:16:46 2007 +0000 @@ -1,3 +1,7 @@ +2007-09-07 Carsten Dominik + + * textmodes/org.el: Updated to org-mode 5.08. + 2007-09-07 Stefan Monnier * simple.el (normal-erase-is-backspace-setup-frame): Massage. diff -r 497448aab7db -r a32093d94b4a lisp/textmodes/org-export-latex.el --- a/lisp/textmodes/org-export-latex.el Fri Sep 07 20:04:58 2007 +0000 +++ b/lisp/textmodes/org-export-latex.el Fri Sep 07 20:16:46 2007 +0000 @@ -3,27 +3,29 @@ ;; ;; Author: Bastien Guerry ;; Keywords: org organizer latex export convert +;; Version: $Id: org-export-latex.el,v 0.28a 2007/08/31 06:22:06 guerry Exp guerry $ ;; X-URL: ;; ;; This file is part of GNU Emacs. ;; -;; This program 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 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. ;; -;; This program 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. +;; GNU Emacs 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, Boston, MA +;; 02110-1301, USA. ;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ;;; Commentary: - -;; This library is a LaTeX exporter for org-mode. +;; +;; This library implements a LaTeX exporter for org-mode. ;; ;; Put this file into your load-path and the following into your ~/.emacs: ;; (require 'org-export-latex) @@ -35,18 +37,16 @@ ;; M-x `org-export-as-latex-to-buffer' ;; M-x `org-export-region-as-latex' ;; M-x `org-replace-region-by-latex' - -;;; History: -;; -;; I started this piece of code in may 2007. Special thanks to Carsten -;; Dominik for helping me on this. -;; - +;; ;;; Code: -(require 'org) +(eval-when-compile + (require 'cl)) + (require 'footnote) +(require 'org) +;;; Variables: (defvar org-latex-options-plist nil) (defvar org-latex-todo-keywords-1 nil) (defvar org-latex-all-targets-regexp nil) @@ -60,6 +60,11 @@ org-clock-string) "A list of regexps to convert as special keywords.") +(defvar latexp) ; dynamically scoped from org.el +(defvar re-quote) ; dynamically scoped from org.el +(defvar commentsp) ; dynamically scoped from org.el + +;;; Custom variables: (defcustom org-export-latex-sectioning-alist '((1 "\\section{%s}" "\\section*{%s}") (2 "\\subsection{%s}" "\\subsection*{%s}") @@ -150,6 +155,8 @@ ;; FIXME Do we want this one? ;; (defun org-export-as-latex-and-open (arg) ...) + +;;; Autoload functions: ;;;###autoload (defun org-export-as-latex-batch () "Call `org-export-as-latex', may be used in batch processing as @@ -283,6 +290,7 @@ :LaTeX-fragments nil))) (set-buffer buffer) (erase-buffer) + (unless body-only (insert preamble)) (when text (insert (org-export-latex-content text) "\n\n")) (unless skip (insert first-lines)) @@ -305,7 +313,7 @@ (org-export-latex-parse-global level odd)))) (unless body-only (insert "\n\\end{document}")) - (or to-buffer (write-file filename)) + (or to-buffer (save-buffer)) (goto-char (point-min)) (message "Exporting to LaTeX...done") (if (eq to-buffer 'string) @@ -313,6 +321,140 @@ (kill-buffer (current-buffer))) (current-buffer)))) + +;;; Parsing functions: +(defun org-export-latex-parse-global (level odd) + "Parse the current buffer recursively, starting at LEVEL. +If ODD is non-nil, assume the buffer only contains odd sections. +Return A list reflecting the document structure." + (save-excursion + (goto-char (point-min)) + (let* ((cnt 0) output + (depth org-latex-sectioning-depth)) + (while (re-search-forward + (concat "^\$\\(?:\\*\$\\{" + (number-to-string (+ (if odd 2 1) level)) + "\\}\\) \$.*\$$") + ;; make sure that there is no upper heading + (when (> level 0) + (save-excursion + (save-match-data + (re-search-forward + (concat "^\$\\(?:\\*\$\\{" + (number-to-string level) + "\\}\\) \$.*\$$") nil t)))) t) + (setq cnt (1+ cnt)) + (let* ((pos (match-beginning 0)) + (heading (match-string 2)) + (nlevel (if odd (/ (+ 3 level) 2) (1+ level)))) + (save-excursion + (narrow-to-region + (point) + (save-match-data + (if (re-search-forward + (concat "^\$\\(?:\\*\$\\{" + (number-to-string (+ (if odd 2 1) level)) + "\\}\\) \$.*\$$") nil t) + (match-beginning 0) + (point-max)))) + (goto-char (point-min)) + (setq output + (append output + (list + (list + `(pos . ,pos) + `(level . ,nlevel) + `(occur . ,cnt) + `(heading . ,heading) + `(content . ,(org-export-latex-parse-content)) + `(subcontent . ,(org-export-latex-parse-subcontent + level odd))))))) + (widen))) + (list output)))) + +(defun org-export-latex-parse-content () + "Extract the content of a section." + (let ((beg (point)) + (end (if (re-search-forward "^\$\\*\$+ .*$" nil t) + (progn (beginning-of-line) (point)) + (point-max)))) + (buffer-substring beg end))) + +(defun org-export-latex-parse-subcontent (level odd) + "Extract the subcontent of a section at LEVEL. +If ODD Is non-nil, assume subcontent only contains odd sections." + (if (not (re-search-forward + (concat "^\$\\(?:\\*\$\\{" + (number-to-string (+ (if odd 4 2) level)) + "\\}\\) \$.*\$$") + nil t)) + 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. +CONTENT is an element of the list produced by +`org-export-latex-parse-global'." + (if (eq (car content) 'subcontent) + (mapc 'org-export-latex-sub (cdr content)) + (org-export-latex-sub (car content)))) + +(defun org-export-latex-sub (subcontent) + "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)) + +(defun org-export-latex-subcontent (subcontent) + "Export each cell of SUBCONTENT to LaTeX." + (let ((heading (org-export-latex-fontify-headline + (cdr (assoc 'heading subcontent)))) + (level (- (cdr (assoc 'level subcontent)) + 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))) + (cond + ;; Normal conversion + ((<= level org-latex-sectioning-depth) + (let ((sec (assoc level org-export-latex-sectioning-alist))) + (insert (format (if num (cadr sec) (caddr sec)) heading) "\n")) + (insert (org-export-latex-content content)) + (cond ((stringp subcontent) (insert subcontent)) + ((listp subcontent) (org-export-latex-sub subcontent)))) + ;; At a level under the hl option: we can drop this subsection + ((> level org-latex-sectioning-depth) + (cond ((eq org-export-latex-low-levels 'description) + (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading)) + (insert (org-export-latex-content content)) + (cond ((stringp subcontent) (insert subcontent)) + ((listp subcontent) (org-export-latex-sub subcontent))) + (insert "\\end{description}\n")) + ((stringp org-export-latex-low-levels) + (insert (format org-export-latex-low-levels heading) "\n") + (insert (org-export-latex-content content)) + (cond ((stringp subcontent) (insert subcontent)) + ((listp subcontent) (org-export-latex-sub subcontent))))))))) + + +;;; Exporting internals: +(defun org-latex-protect (string) + (add-text-properties 0 (length string) '(org-protected t) string) string) + +(defun org-export-latex-protect-char-in-string (char-list string) + "Add org-protected text-property to char from CHAR-LIST in STRING." + (with-temp-buffer + (save-match-data + (insert string) + (goto-char (point-min)) + (while (re-search-forward (regexp-opt char-list) nil t) + (add-text-properties (match-beginning 0) + (match-end 0) '(org-protected t))) + (buffer-string)))) + (defun org-export-latex-set-initial-vars (ext-plist) "Store org local variables required for LaTeX export. EXT-PLIST is an optional additional plist." @@ -395,121 +537,7 @@ :skip-before-1st-heading nil :LaTeX-fragments nil))))) -(defun org-export-latex-parse-global (level odd) - "Parse the current buffer recursively, starting at LEVEL. -If ODD is non-nil, assume the buffer only contains odd sections. -Return A list reflecting the document structure." - (save-excursion - (goto-char (point-min)) - (let* ((cnt 0) output - (depth org-latex-sectioning-depth)) - (while (re-search-forward - (concat "^\$\\(?:\\*\$\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \$.*\$$") - ;; make sure that there is no upper heading - (when (> level 0) - (save-excursion - (save-match-data - (re-search-forward - (concat "^\$\\(?:\\*\$\\{" - (number-to-string level) - "\\}\\) \$.*\$$") nil t)))) t) - (setq cnt (1+ cnt)) - (let* ((pos (match-beginning 0)) - (heading (match-string 2)) - (nlevel (if odd (/ (+ 3 level) 2) (1+ level)))) - (save-excursion - (narrow-to-region - (point) - (save-match-data - (if (re-search-forward - (concat "^\$\\(?:\\*\$\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \$.*\$$") nil t) - (match-beginning 0) - (point-max)))) - (goto-char (point-min)) - (setq output - (append output - (list - (list - `(pos . ,pos) - `(level . ,nlevel) - `(occur . ,cnt) - `(heading . ,heading) - `(content . ,(org-export-latex-parse-content)) - `(subcontent . ,(org-export-latex-parse-subcontent - level odd))))))) - (widen))) - (list output)))) - -(defun org-export-latex-parse-content () - "Extract the content of a section." - (let ((beg (point)) - (end (if (re-search-forward "^\$\\*\$+ .*$" nil t) - (progn (beginning-of-line) (point)) - (point-max)))) - (buffer-substring beg end))) - -(defun org-export-latex-parse-subcontent (level odd) - "Extract the subcontent of a section at LEVEL. -If ODD Is non-nil, assume subcontent only contains odd sections." - (if (not (re-search-forward - (concat "^\$\\(?:\\*\$\\{" - (number-to-string (+ (if odd 4 2) level)) - "\\}\\) \$.*\$$") - nil t)) - nil ; subcontent is nil - (org-export-latex-parse-global (+ (if odd 2 1) level) odd))) - -(defun org-export-latex-global (content) - "Export CONTENT to LaTeX. -CONTENT is an element of the list produced by -`org-export-latex-parse-global'." - (if (eq (car content) 'subcontent) - (mapc 'org-export-latex-sub (cdr content)) - (org-export-latex-sub (car content)))) - -(defun org-export-latex-sub (subcontent) - "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)) - -(defun org-export-latex-subcontent (subcontent) - "Export each cell of SUBCONTENT to LaTeX." - (let ((heading (org-export-latex-fontify-headline - (cdr (assoc 'heading subcontent)))) - (level (- (cdr (assoc 'level subcontent)) - 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))) - (cond - ;; Normal conversion - ((<= level org-latex-sectioning-depth) - (let ((sec (assoc level org-export-latex-sectioning-alist))) - (insert (format (if num (cadr sec) (caddr sec)) heading) "\n")) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent)))) - ;; At a level under the hl option: we can drop this subsection - ((> level org-latex-sectioning-depth) - (cond ((eq org-export-latex-low-levels 'description) - (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading)) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert "\\end{description}\n")) - ((stringp org-export-latex-low-levels) - (insert (format org-export-latex-low-levels heading) "\n") - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))))))))) - -(defun org-export-latex-special-keywords-maybe (remove-list) +(defun org-export-latex-keywords-maybe (remove-list) "Maybe remove keywords depending on rules in REMOVE-LIST." (goto-char (point-min)) (let ((re-todo (mapconcat 'identity org-latex-todo-keywords-1 "\\|"))) @@ -525,7 +553,8 @@ (replace-match (format "\\texttt{%s}" (match-string 0)) t t))) ;; convert tags (when (re-search-forward "\$:[a-zA-Z0-9]+\$+:" nil t) - (if (plist-get remove-list :tags) + (if (or (not org-export-with-tags) + (plist-get remove-list :tags)) (replace-match "") (replace-match (format "\\texttt{%s}" (match-string 0)) t t))))) @@ -536,40 +565,41 @@ ;; the beginning of the buffer - inserting "\n" is safe here though. (insert "\n" headline) (goto-char (point-min)) - (org-export-latex-fontify) (org-export-latex-special-chars (plist-get org-latex-options-plist :sub-superscript)) - (org-export-latex-special-keywords-maybe + (when (plist-get org-latex-options-plist :emphasize) + (org-export-latex-fontify)) + (org-export-latex-keywords-maybe org-export-latex-remove-from-headines) (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-special-keywords) + (org-export-latex-keywords) (org-export-latex-itemize) (org-export-latex-enumerate) (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-fix-invisible-strings) + (org-export-latex-fix-invisible-strings) (buffer-substring (point-min) (point-max)))) -(defun org-export-fix-invisible-strings () - "Comment out (INVISIBLE) warnings." - (goto-char (point-min)) - (while (re-search-forward "(INVISIBLE)" nil t) - (replace-match "%\\&"))) - (defun org-export-latex-quotation-marks () "Export question marks depending on language conventions. Local definition of the language overrides @@ -628,11 +658,12 @@ (replace-match (concat (match-string 1) "\\" (match-string 2)) t t))) ((equal (match-string 2) "~") - (unless (get-text-property 0 'org-protected (match-string 2)) - (if (equal (match-string 1) "\\") nil - (replace-match - (org-latex-protect - (concat (match-string 1) "\\textasciitilde{}")) t t)))) + (cond ((equal (match-string 1) "\\") nil) + ((eq 'org-link (get-text-property 0 'face (match-string 2))) + (replace-match (concat (match-string 1) "\\~") t t)) + (t (replace-match + (org-latex-protect + (concat (match-string 1) "\\~{}")) t t)))) ((member (match-string 2) '("{" "}")) (unless (save-match-data (org-inside-LaTeX-fragment-p)) (if (equal (match-string 1) "\\") @@ -653,8 +684,8 @@ (match-string 2) (match-string 3))) "") t t))))))) '("^\$[^\n$]*?\\|^\$\$\\\\?\\$\$\$[^\n$]*\$$" - "\$[a-za-z0-9]+\\|[ \t\n]\\|\\\\\$\$_\\|\\^\$\$[a-za-z0-9]+\\|[ \t\n]\\|[:punct:]\\|{[a-za-z0-9]+}\\|([a-za-z0-9]+)\$" - "\$.\\|^\$\$\\\\\$\$[ \t\n]\\|[a-za-z&#%{}]+\$" + "\$[a-za-z0-9]+\\|[ \t\n]\\|\\b\\|\\\\\$\$_\\|\\^\$\$[a-za-z0-9]+\\|[ \t\n]\\|[:punct:]\\|{[a-za-z0-9]+}\\|([a-za-z0-9]+)\$" + "\$.\\|^\$\$\\\\\$\$[ \t\n]\\|[a-zA-Z&#%{}\"]+\$" "\$.\\|^\$\$&\$" "\$.\\|^\$\$#\$" "\$.\\|^\$\$%\$" @@ -672,7 +703,7 @@ ;; this is part of a math formula ((and (string-match "\\S-+" string-before) (string-match "\\S-+" string-after)) - (cond ((get-text-property 0 'org-protected char) + (cond ((eq 'org-link (get-text-property 0 'face char)) (concat string-before "\\" char string-after)) ((save-match-data (org-inside-LaTeX-fragment-p)) (if subsup @@ -681,13 +712,13 @@ ((string-match "[({]?\$[^)}]+\$[)}]?" string-after) (format "%s%s{%s}" string-before char (match-string 1 string-after)))))) - ((and subsup + ((and subsup (> (length string-after) 1) (string-match "[({]?\$[^)}]+\$[)}]?" string-after)) (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)))) + (subsup (concat "$" string-before char string-after "$")) + (t (concat string-before "\\" char string-after)))) (t (concat string-before "\\" char string-after)))) (defun org-export-latex-treat-backslash-char (string-before string-after) @@ -699,7 +730,7 @@ (or (cdar (member (list string-after) org-html-entities)) string-after) "$")) ((and (not (string-match "^[ \n\t]" string-after)) - (not (string-match "[ \n\t]\\'" string-before))) + (not (string-match "[ \t]\\'\\|^" string-before))) ;; backslash is inside a word (concat string-before "$\\backslash$" string-after)) ((not (or (equal string-after "") @@ -713,6 +744,16 @@ (concat string-before "$\\backslash$" string-after)) (t (concat string-before "$\\backslash$" string-after)))) +(defun org-export-latex-keywords () + "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 (defun org-export-latex-fixed-width (opt) "When OPT is non-nil convert fixed-width sections to LaTeX." (goto-char (point-min)) @@ -731,12 +772,13 @@ (match-string 2)) t t) (forward-line)))))) +;; FIXME Use org-export-highlight-first-table-line ? (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-excursion (save-match-data (org-table-align))) + (save-window-excursion (save-match-data (org-table-align))) (let (tbl-list (beg (match-beginning 0)) (end (save-excursion @@ -749,21 +791,11 @@ (push (split-string (org-trim (match-string 1)) "|") tbl-list) (push 'hline tbl-list)) (forward-line)) - ;; comment region out instead of deleting it ? + ;; 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-special-keywords () - "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 (defun org-export-latex-list (srch0 srch1 srch2 rpl0 rpl1) "Convert lists to LaTeX." (goto-char (point-min)) @@ -829,17 +861,6 @@ (match-string 5)) t t) (backward-char)))) -(defun org-export-latex-protect-char-in-string (char-list string) - "Add org-protected text-property to char from CHAR-LIST in STRING." - (with-temp-buffer - (save-match-data - (insert string) - (goto-char (point-min)) - (while (re-search-forward (regexp-opt char-list) nil t) - (add-text-properties (match-beginning 0) - (match-end 0) '(org-protected t))) - (buffer-string)))) - (defun org-export-latex-links () ;; Make sure to use the LaTeX hyperref and graphicx package ;; or send some warnings. @@ -888,6 +909,7 @@ (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) @@ -988,17 +1010,6 @@ (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 ""))) - ;; Find matches for radio targets and turn them into internal links (goto-char (point-min)) (when re-radio @@ -1031,7 +1042,7 @@ (let* ((s (concat (match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]"))) ;; added 'org-protected property to links - (add-text-properties 0 (length s) '(org-protected t) s) + (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) @@ -1039,7 +1050,7 @@ (org-if-unprotected (let* ((s (concat (match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]"))) - (add-text-properties 0 (length s) '(org-protected t) s) + (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) @@ -1051,7 +1062,7 @@ (match-string 2) (concat "[" xx "]")) "]"))) - (add-text-properties 0 (length s) '(org-protected t) s) + (put-text-property 0 (length s) 'face 'org-link s) (replace-match s t t)))) ;; Find multiline emphasis and put them into single line @@ -1070,27 +1081,23 @@ (kill-buffer " org-mode-tmp") rtn)) -(defsubst org-latex-protect (string) - (add-text-properties 0 (length string) '(org-protected t) string) - string) - (defun org-export-latex-cleaned-string () "Clean stuff in the LaTeX export." - ;; preserve line breaks + ;; Preserve line breaks (goto-char (point-min)) (while (re-search-forward "\\\\\\\\" nil t) (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) (replace-match (org-latex-protect (concat (match-string 1) "\\LaTeX{}")) t t))) - ;; convert horizontal rules + ;; Convert horizontal rules (goto-char (point-min)) (while (re-search-forward "^----+.$" nil t) (replace-match (org-latex-protect "\\hrule") t t)) @@ -1103,10 +1110,10 @@ nil t) (beginning-of-line) (org-cut-subtree)) - - ;; protect LaTeX \commands{...} + + ;; Protect LaTeX \commands{...} (goto-char (point-min)) - (while (re-search-forward "\\\\[a-z]+{.+}" nil t) + (while (re-search-forward "\\\\[a-zA-Z]+\$?:\\[.*\\]\$?{.*}" nil t) (add-text-properties (match-beginning 0) (match-end 0) '(org-protected t))) @@ -1117,21 +1124,69 @@ (replace-match (org-latex-protect (format "\\label{%s}" (match-string 1))) t t))) - ;; delete @
cookies + ;; Delete @<...> constructs (goto-char (point-min)) - (while (re-search-forward "@<[^<>\n]*>" nil t) + ;; Thanks to Daniel Clemente for this regexp + (while (re-search-forward "@<\$?:[^\"\n]\\|\".*\"\$*?>" nil t) (replace-match "")) - ;; add #+BEGIN_LaTeX before any \begin{...} + ;; 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{...} + ;; 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) @@ -1149,18 +1204,18 @@ (let ((end (save-excursion (if (re-search-forward "^$\\|\\[[0-9]+\\]" nil t) (match-beginning 0) (point-max))))) - (setq footnote (concat - (org-trim (buffer-substring (point) end)) - ;; FIXME stupid workaround for cases where - ;; `org-bracket-link-analytic-regexp' matches - ;; }. as part of the link. - " ")) + (setq footnote + (concat + (org-trim (buffer-substring (point) end)) + ;; FIXME stupid workaround for cases where + ;; `org-bracket-link-analytic-regexp' matches + ;; }. as part of the link. + " ")) (delete-region (point) end))) (goto-char foot-beg) (delete-region foot-beg foot-end) (setq footnote-rpl (format "\\footnote{%s}" footnote)) - (add-text-properties 0 1 '(org-protected t) footnote-rpl) - (add-text-properties 9 10 '(org-protected t) footnote-rpl) + (add-text-properties 0 10 '(org-protected t) footnote-rpl) (add-text-properties (1- (length footnote-rpl)) (length footnote-rpl) '(org-protected t) footnote-rpl) @@ -1170,43 +1225,8 @@ (goto-char (point-min)) (while (re-search-forward (concat "^" footnote-section-tag-regexp) nil t) - (replace-match ""))) - - ;; Protect stuff from LaTeX processing. - ;; We will get rid on this once org.el integrate org-export-latex.el - ;; FIXME: #+LaTeX should be aware of the preceeding indentation in lists - (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) - (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)))))) + (replace-match "")))) (provide 'org-export-latex) -;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad ;;; org-export-latex.el ends here diff -r 497448aab7db -r a32093d94b4a lisp/textmodes/org-publish.el --- a/lisp/textmodes/org-publish.el Fri Sep 07 20:04:58 2007 +0000 +++ b/lisp/textmodes/org-publish.el Fri Sep 07 20:16:46 2007 +0000 @@ -6,9 +6,11 @@ ;; Keywords: hypermedia, outlines ;; Version: 1.80 +;; $Id: org-publish.el,v 1.80 2007/03/22 02:31:03 dto Exp dto $ + ;; 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) +;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, @@ -617,6 +619,4 @@ (provide 'org-publish) - -;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb ;;; org-publish.el ends here diff -r 497448aab7db -r a32093d94b4a lisp/textmodes/org.el --- a/lisp/textmodes/org.el Fri Sep 07 20:04:58 2007 +0000 +++ b/lisp/textmodes/org.el Fri Sep 07 20:16:46 2007 +0000 @@ -2,9 +2,9 @@ ;; Carstens outline-mode for keeping track of everything. ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; -;; Author: Carsten Dominik +;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ +;; Homepage: http://orgmode.org ;; Version: 5.08 ;; ;; This file is part of GNU Emacs. @@ -49,7 +49,7 @@ ;; --------------------------- ;; See the corresponding sections in the manual at ;; -;; http://staff.science.uva.nl/~dominik/Tools/org/org.html#Installation +;; http://orgmode.org/org.html#Installation ;; ;; Documentation ;; ------------- @@ -60,7 +60,7 @@ ;; in the etc/ directory of Emacs 22. ;; ;; A list of recent changes can be found at -;; http://www.astro.uva.nl/~dominik/Tools/org/Changes +;; http://orgmode.org/Changes ;; ;;; Code: @@ -83,7 +83,7 @@ ;;; Version -(defconst org-version "5.07" +(defconst org-version "5.08" "The version number of the file org.el.") (defun org-version () (interactive) @@ -109,6 +109,8 @@ (save-match-data (while (string-match "\\[:alnum:\\]" ss) (setq ss (replace-match "a-zA-Z0-9" t t ss))) + (while (string-match "\\[:alpha:\\]" ss) + (setq ss (replace-match "a-zA-Z" t t ss))) ss)) s)) @@ -1508,8 +1510,6 @@ (defvar org-todo-keywords-1 nil) (make-variable-buffer-local 'org-todo-keywords-1) -(defvar org-todo-tag-alist nil) -(make-variable-buffer-local 'org-todo-tag-alist) (defvar org-todo-keywords-for-agenda nil) (defvar org-done-keywords-for-agenda nil) (defvar org-not-done-keywords nil) @@ -1522,6 +1522,10 @@ (make-variable-buffer-local 'org-todo-sets) (defvar org-todo-kwd-alist nil) (make-variable-buffer-local 'org-todo-kwd-alist) +(defvar org-todo-key-alist nil) +(make-variable-buffer-local 'org-todo-key-alist) +(defvar org-todo-key-trigger nil) +(make-variable-buffer-local 'org-todo-key-trigger) (defcustom org-todo-interpretation 'sequence "Controls how TODO keywords are interpreted. @@ -1534,6 +1538,30 @@ :type '(choice (const sequence) (const type))) +(defcustom org-use-fast-todo-selection 'prefix + "Non-nil means, use the fast todo selection scheme with C-c C-t. +This variable describes if and under what circumstances the cycling +mechanism for TODO keywords will be replaced by a single-key, direct +selection scheme. + +When nil, fast selection is never used. + +When the symbol `prefix', it will be used when `org-todo' is called with +a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' +in an agenda buffer. + +When t, fast selection is used by default. In this case, the prefix +argument forces cycling instead. + +In all cases, the special interface is only used if access keys have actually +been assigned by the user, i.e. if keywords in the configuration are followed +by a letter in parenthesis, like TODO(t)." + :group 'org-todo + :type '(choice + (const :tag "Never" nil) + (const :tag "By default" t) + (const :tag "Only with C-u C-c C-t" prefix))) + (defcustom org-after-todo-state-change-hook nil "Hook which is run after the state of a TODO item was changed. The new state (a string with a TODO keyword, or nil) is available in the @@ -1543,8 +1571,8 @@ (defcustom org-log-done nil "When set, insert a (non-active) time stamp when TODO entry is marked DONE. -When the state of an entry is changed from nothing to TODO, remove a previous -closing date. +When the state of an entry is changed from nothing or a DONE state to +a not-done TODO state, remove a previous closing date. This can also be a list of symbols indicating under which conditions the time stamp recording the action should be annotated with a short note. @@ -1713,9 +1741,11 @@ (concat "[" (substring f 1 -1) "]") f))) -(defcustom org-deadline-warning-days 30 +(defcustom org-deadline-warning-days 14 "No. of days before expiration during which a deadline becomes active. -This variable governs the display in sparse trees and in the agenda." +This variable governs the display in sparse trees and in the agenda. +When negative, it means use this number (the absolute value of it) +even if a deadline has a different individual lead time specified." :group 'org-time :type 'number) @@ -1727,6 +1757,12 @@ :group 'org-time :type 'boolean) +(defcustom org-edit-timestamp-down-means-later nil + "Non-nil means, S-down will increase the time in a time stamp. +When nil, S-up will increase." + :group 'org-time + :type 'boolean) + (defcustom org-calendar-follow-timestamp-change t "Non-nil means, make the calendar window follow timestamp changes. When a timestamp is modified and the calendar window is visible, it will be @@ -1743,9 +1779,10 @@ "List of tags allowed in Org-mode files. When this list is nil, Org-mode will base TAG input on what is already in the buffer. -The value of this variable is an alist, the car may be (and should) be a -character that is used to select that tag through the fast-tag-selection -interface. See the manual for details." +The value of this variable is an alist, the car of each entry must be a +keyword as a string, the cdr may be a character that is used to select +that tag through the fast-tag-selection interface. +See the manual for details." :group 'org-tags :type '(repeat (choice @@ -1781,6 +1818,12 @@ (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) + (defcustom org-tags-column 48 "The column to which tags should be indented in a headline. If this number is positive, it specifies the column. If it is negative, @@ -2601,8 +2644,8 @@ ("cs" "Autor" "Datum" "Obsah") ("da" "Ophavsmand" "Dato" "Indhold") ("de" "Autor" "Datum" "Inhaltsverzeichnis") - ("es" "Autor" "Fecha" "\xccndice") - ("fr" "Auteur" "Date" "Table des Mati\xe8res") + ("es" "Autor" "Fecha" "\xcdndice") + ("fr" "Auteur" "Date" "Table des mati\xe8res") ("it" "Autore" "Data" "Indice") ("nl" "Auteur" "Datum" "Inhoudsopgave") ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk) @@ -3730,8 +3773,9 @@ "Precompute regular expressions for current buffer." (when (org-mode-p) (org-set-local 'org-todo-kwd-alist nil) + (org-set-local 'org-todo-key-alist nil) + (org-set-local 'org-todo-key-trigger nil) (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-todo-tag-alist nil) (org-set-local 'org-done-keywords nil) (org-set-local 'org-todo-heads nil) (org-set-local 'org-todo-sets nil) @@ -3823,20 +3867,25 @@ (string-to-char (match-string 2 x))) kwsa) (match-string 1 x)) + (push (list x) kwsa) x)) kws0) - kwsa (if kwsa (append '((:startgroup)) kwsa '((:endgroup)))) + kwsa (if kwsa (append '((:startgroup)) + (nreverse kwsa) + '((:endgroup)))) hw (car kws1) dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) tail (list inter hw (car dws) (org-last dws))) (add-to-list 'org-todo-heads hw 'append) (push kws1 org-todo-sets) (setq org-done-keywords (append org-done-keywords dws nil)) - (setq org-todo-tag-alist (append org-todo-tag-alist kwsa)) + (setq org-todo-key-alist (append org-todo-key-alist kwsa)) (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) (setq org-todo-sets (nreverse org-todo-sets) - org-todo-kwd-alist (nreverse org-todo-kwd-alist))) + org-todo-kwd-alist (nreverse org-todo-kwd-alist) + org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) + org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) ;; Process the constants (when const (let (e cst) @@ -4642,7 +4691,7 @@ (defvar org-font-lock-keywords nil) -(defconst org-property-re "^[ \t]*\$:\\([a-zA-Z_0-9]+\$:\\)[ \t]*\$\\S-.*\$" +(defconst org-property-re (org-re "^[ \t]*\$:\\([[:alnum:]_]+\$:\\)[ \t]*\$\\S-.*\$") "Regular expression matching a property line.") (defun org-set-font-lock-defaults () @@ -4735,7 +4784,6 @@ ((eq n 2) org-f) (t (if org-level-color-stars-only nil org-f)))) - (defun org-get-todo-face (kwd) "Get the right face for a TODO keyword KWD. If KWD is a number, get the corresponding match group." @@ -5710,16 +5758,15 @@ (replace-match "\n")) (goto-char beg) ;; Shift if necessary - (if (= shift 0) - (message "Pasted at level %d, without shift" new-level) + (unless (= shift 0) (save-restriction (narrow-to-region beg end) (while (not (= shift 0)) (org-map-region func (point-min) (point-max)) (setq shift (+ delta shift))) - (goto-char (point-min)) - (message "Pasted at level %d, with shift by %d levels" - new-level shift1))) + (goto-char (point-min)))) + (when (interactive-p) + (message "Clipboard pasted as level %d subtree" new-level)) (if (and kill-ring (eq org-subtree-clip (current-kill 0)) org-subtree-clip-folded) @@ -10922,8 +10969,8 @@ (if (and (interactive-p) link) (progn (setq org-stored-links - (cons (list cpltxt link desc) org-stored-links)) - (message "Stored: %s" (or cpltxt link))) + (cons (list link desc) org-stored-links)) + (message "Stored: %s" (or desc link))) (and link (org-make-link-string link desc))))) (defun org-store-link-props (&rest plist) @@ -11172,7 +11219,10 @@ (princ "Insert a link. Use TAB to complete valid link prefixes.\n") (when org-stored-links (princ "\nStored links are available with / (most recent with RET):\n\n") - (princ (mapconcat 'car (reverse org-stored-links) "\n")))) + (princ (mapconcat + (lambda (x) + (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) + (reverse org-stored-links) "\n")))) (let ((cw (selected-window))) (select-window (get-buffer-window "*Org Links*")) (shrink-window-if-larger-than-buffer) @@ -11200,9 +11250,8 @@ (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) - desc (or region desc (nth 2 entry))))) - + (setq desc (or region desc (nth 1 entry))))) + (if (string-match org-plain-link-re link) ;; URL-like link, normalize the use of angular brackets. (setq link (org-make-link (org-remove-angle-brackets link)))) @@ -11222,6 +11271,7 @@ ;; Check if we can/should use a relative path. If yes, simplify the link (when (string-match "\\ 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)))) @@ -12724,6 +12784,7 @@ (member (member this org-todo-keywords-1)) (tail (cdr member)) (state (cond + ;; FIXME: most the fast interface here ((equal arg '(4)) ;; Read a state with completion (completing-read "State: " (mapcar (lambda(x) (list x)) @@ -12789,14 +12850,18 @@ (setq dostates (and (eq interpret 'sequence) (listp org-log-done) (memq 'state org-log-done))) (cond - ((and state (not this)) - ;; FIXME: should we remove CLOSED already then state is nil? + ((and state (member state org-not-done-keywords) + (not (member this org-not-done-keywords))) + ;; This is now a todo state and was not one before + ;; Remove any CLOSED timestamp, and possibly log the state change (org-add-planning-info nil nil 'closed) (and dostates (org-add-log-maybe 'state state 'findpos))) ((and state dostates) + ;; This is a non-nil state, and we need to log it (org-add-log-maybe 'state state 'findpos)) - ((member state org-done-keywords) - ;; Planning info calls the note-setting command. + ((and (member state org-done-keywords) + (not (member this org-done-keywords))) + ;; It is now done, and it was not done before ;; FIXME: We used to remove scheduling info.... ; (org-add-planning-info 'closed (org-current-time) ; (if (org-get-repeat) nil 'scheduled)) @@ -12835,6 +12900,68 @@ (car org-todo-keywords-1)) (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) +(defun org-fast-todo-selection () + "Fast TODO keyword selection with single keys. +Returns the new TODO keyword, or nil if no state change should occur." + (let* ((fulltable org-todo-key-alist) + (done-keywords org-done-keywords) ;; needed for the faces. + (maxlen (apply 'max (mapcar + (lambda (x) + (if (stringp (car x)) (string-width (car x)) 0)) + fulltable))) + (buf (current-buffer)) + (expert nil) + (fwidth (+ maxlen 3 1 3)) + (ncol (/ (- (window-width) 4) fwidth)) + tg cnt e c char c1 c2 ntable tbl rtn + groups ingroup) + (save-window-excursion + (if expert + (set-buffer (get-buffer-create " *Org todo*")) +; (delete-other-windows) +; (split-window-vertically) + (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) + (erase-buffer) + (org-set-local 'org-done-keywords done-keywords) + (setq tbl fulltable char ?a cnt 0) + (while (setq e (pop tbl)) + (cond + ((equal e '(:startgroup)) + (push '() groups) (setq ingroup t) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n")) + (insert "{ ")) + ((equal e '(:endgroup)) + (setq ingroup nil cnt 0) + (insert "}\n")) + (t + (setq tg (car e) c (cdr e)) + (if ingroup (push tg (car groups))) + (setq tg (org-add-props tg nil 'face + (org-get-todo-face tg))) + (if (and (= cnt 0) (not ingroup)) (insert " ")) + (insert "[" c "] " tg (make-string + (- fwidth 4 (length tg)) ?\ )) + (when (= (setq cnt (1+ cnt)) ncol) + (insert "\n") + (if ingroup (insert " ")) + (setq cnt 0))))) + (insert "\n") + (goto-char (point-min)) + (if (and (not expert) (fboundp 'fit-window-to-buffer)) + (fit-window-to-buffer)) + (message "[a-z..]:Set [SPC]:clear") + (setq c (let ((inhibit-quit t)) (read-char-exclusive))) + (cond + ((or (= c ?\C-g) + (and (= c ?q) (not (rassoc c fulltable)))) + (setq quit-flag t)) + ((= c ?\ ) 'none) + ((setq e (rassoc c fulltable) tg (car e)) + tg) + (t (setq quit-flag t)))))) + (defun org-get-repeat () "Check if tere is a deadline/schedule with repeater in this entry." (save-match-data @@ -13048,7 +13175,7 @@ (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) (let ((org-inhibit-startup t)) (org-mode)) - (insert (format "# Insert note for %s, finish with C-c C-c.\n\n" + (insert (format "# Insert note for %s, finish with C-c C-c, or cancel with C-u C-c C-c.\n\n" (cond ((eq org-log-note-purpose 'clock-out) "stopped clock") ((eq org-log-note-purpose 'done) "closed todo item") @@ -13081,6 +13208,7 @@ ""))))) (if lines (setq note (concat note " \\\\"))) (push note lines)) + (when current-prefix-arg (setq lines nil)) (when lines (save-excursion (set-buffer (marker-buffer org-log-note-marker)) @@ -13553,8 +13681,9 @@ (if (or (eq t org-use-fast-tag-selection) (and org-use-fast-tag-selection (delq nil (mapcar 'cdr table)))) - (org-fast-tag-selection current-tags inherited-tags - table org-todo-tag-alist) + (org-fast-tag-selection + current-tags inherited-tags table + (if org-fast-tag-selection-include-todo org-todo-key-alist)) (let ((org-add-colon-after-tag-completion t)) (org-trim (completing-read "Tags: " 'org-tags-completion-function @@ -13702,6 +13831,7 @@ tg cnt e c char c1 c2 ntable tbl rtn ov-start ov-end ov-prefix (exit-after-next org-fast-tag-selection-single-key) + (done-keywords org-done-keywords) groups ingroup) (save-excursion (beginning-of-line 1) @@ -13727,6 +13857,7 @@ (split-window-vertically) (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) (erase-buffer) + (org-set-local 'org-done-keywords done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) @@ -13759,6 +13890,8 @@ (if ingroup (push tg (car groups))) (setq tg (org-add-props tg nil 'face (cond + ((not (assoc tg table)) + (org-get-todo-face tg)) ((member tg current) c-face) ((member tg inherited) i-face) (t nil)))) @@ -13848,12 +13981,13 @@ (while (re-search-forward (org-re "\\[.\\] \$[[:alnum:]_@]+\$") nil t) (setq tg (match-string 1)) - (add-text-properties (match-beginning 1) (match-end 1) - (list 'face - (cond - ((member tg current) c-face) - ((member tg inherited) i-face) - (t nil))))) + (add-text-properties + (match-beginning 1) (match-end 1) + (list 'face + (cond + ((member tg current) c-face) + ((member tg inherited) i-face) + (t (get-text-property (match-beginning 1) 'face)))))) (goto-char (point-min))))) (org-detach-overlay org-tags-overlay) (if rtn @@ -13927,7 +14061,7 @@ ;; This is used by C-c C-c for property action. (save-excursion (beginning-of-line 1) - (looking-at "^[ \t]*\$:\\([a-zA-Z_0-9]+\$:\\)[ \t]*\$.*\$"))) + (looking-at (org-re "^[ \t]*\$:\\([[:alpha:]][[:alnum:]_-]*\$:\\)[ \t]*\$.*\$")))) (defmacro org-with-point-at (pom &rest body) "Move to buffer and point of point-or-marker POM for the duration of BODY." @@ -14016,7 +14150,7 @@ (when range (goto-char (car range)) (while (re-search-forward - "^[ \t]*:\$[a-zA-Z][a-zA-Z_0-9]*\$:[ \t]*\$\\S-.*\$?" + (org-re "^[ \t]*:\$[[:alpha:]][[:alnum:]_-]*\$:[ \t]*\$\\S-.*\$?") (cdr range) t) (setq key (org-match-string-no-properties 1) value (org-trim (or (org-match-string-no-properties 2) ""))) @@ -14144,7 +14278,9 @@ (while (re-search-forward org-property-start-re nil t) (setq range (org-get-property-block)) (goto-char (car range)) - (while (re-search-forward "^[ \t]*:\$[a-zA-Z0-9]+\$:" (cdr range) t) + (while (re-search-forward + (org-re "^[ \t]*:\$[[:alnum:]_-]+\$:") + (cdr range) t) (add-to-list 'rtn (org-match-string-no-properties 1))) (outline-next-heading)))) (when include-specials @@ -14385,8 +14521,8 @@ (beg (point-at-bol)) (level-face (save-excursion (beginning-of-line 1) - (looking-at "\$\\**\$\$\\* \$") - (org-get-level-face 2))) + (and (looking-at "\$\\**\$\$\\* \$") + (org-get-level-face 2)))) (color (list :foreground (face-attribute (or level-face 'default) :foreground))) props pom property ass width f string ov column) @@ -14851,7 +14987,7 @@ (defun org-columns-get-autowidth-alist (s cache) "Derive the maximum column widths from the format and the cache." (let ((start 0) rtn) - (while (string-match "%\$[a-zA-Z]\\S-*\$" s start) + (while (string-match (org-re "%\$[[:alpha:]]\\S-*\$") s start) (push (cons (match-string 1 s) 1) rtn) (setq start (match-end 0))) (mapc (lambda (x) @@ -15010,8 +15146,9 @@ "FIXME" (let ((start 0) width prop title op f) (setq org-columns-current-fmt-compiled nil) - (while (string-match "%\$[0-9]+\$?\$[a-zA-Z_0-9]+\$\$?:(\\([^)]+\$)\\)?\$?:{\\([^}]+\$}\\)?\\s-*" - fmt start) + (while (string-match + (org-re "%\$[0-9]+\$?\$[[:alnum:]_-]+\$\$?:(\\([^)]+\$)\\)?\$?:{\\([^}]+\$}\\)?\\s-*") + fmt start) (setq start (match-end 0) width (match-string 1 fmt) prop (match-string 2 fmt) @@ -15412,10 +15549,25 @@ (defun org-deadline-close (timestamp-string &optional ndays) "Is the time in TIMESTAMP-STRING close to the current date?" - (and (< (org-days-to-time timestamp-string) - (or ndays org-deadline-warning-days)) + (setq ndays (or ndays (org-get-wdays timestamp-string))) + (and (< (org-days-to-time timestamp-string) ndays) (not (org-entry-is-done-p)))) +(defun org-get-wdays (ts) + "Get the deadline lead time appropriate for timestring TS." + (cond + ((<= org-deadline-warning-days 0) + ;; 0 or negative, enforce this value no matter what + (- org-deadline-warning-days)) + ((string-match "-\$[0-9]+\$\$[dwmy]\$\$\\'\\|>\$" ts) + ;; lead time is specified. + (floor (* (string-to-number (match-string 1 ts)) + (cdr (assoc (match-string 2 ts) + '(("d" . 1) ("w" . 7) + ("m" . 30.4) ("y" . 365.25))))))) + ;; go for the default. + (t org-deadline-warning-days))) + (defun org-calendar-select-mouse (ev) "Return to `org-read-date' with the date currently selected. This is used by `org-read-date' in a temporary keymap for the calendar buffer." @@ -15438,7 +15590,7 @@ (cond ((equal ndays '(4)) 100000) (ndays (prefix-numeric-value ndays)) - (t org-deadline-warning-days))) + (t (abs org-deadline-warning-days)))) (case-fold-search nil) (regexp (concat "\\<" org-deadline-string " *<\$[^>]+\$>")) (callback @@ -17544,7 +17696,7 @@ (defvar org-starting-day nil) ; local variable in the agenda buffer (defvar org-agenda-span nil) ; local variable in the agenda buffer (defvar org-include-all-loc nil) ; local variable - +(defvar org-agenda-remove-date nil) ; dynamically scoped ;;;###autoload (defun org-agenda-list (&optional include-all start-day ndays) @@ -18262,6 +18414,13 @@ (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (d1 (calendar-absolute-from-gregorian date)) + (remove-re + (concat + (regexp-quote + (format-time-string + "<%Y-%m-%d" + (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) + ".*?>")) (regexp (concat (regexp-quote @@ -18309,7 +18468,8 @@ tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\$[^\r\n]+\$") (setq txt (org-format-agenda-item - nil (match-string 1) category tags timestr))) + nil (match-string 1) category tags timestr nil + remove-re))) (setq txt org-agenda-no-heading-message)) (setq priority (org-get-priority txt)) (org-add-props txt props @@ -18437,17 +18597,10 @@ (setq s (match-string 1) pos (1- (match-beginning 1)) d2 (org-time-string-to-absolute (match-string 1) d1) - diff (- d2 d1)) - (if (string-match "-\$[0-9]+\$\$[dwmy]\$\\'" s) - (setq wdays - (floor - (* (string-to-number (match-string 1 s)) - (cdr (assoc (match-string 2 s) - '(("d" . 1) ("w" . 7) - ("m" . 30.4) ("y" . 365.25))))))) - (setq wdays org-deadline-warning-days)) - (setq dfrac (/ (* 1.0 (- wdays diff)) wdays)) - (setq upcomingp (and todayp (> diff 0))) + diff (- d2 d1) + wdays (org-get-wdays s) + dfrac (/ (* 1.0 (- wdays diff)) wdays) + upcomingp (and todayp (> diff 0))) ;; 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 @@ -18492,7 +18645,7 @@ 'face (if donep 'org-done face) 'undone-face face 'done-face 'org-done) (push txt ee)))))) - ee)) + (nreverse ee))) (defun org-agenda-deadline-face (fraction) "Return the face to displaying a deadline item. @@ -18569,7 +18722,7 @@ 'priority (+ (- 5 diff) (org-get-priority txt)) 'org-category category) (push txt ee)))))) - ee)) + (nreverse ee))) (defun org-agenda-get-blocks () "Return the date-range information for agenda display." @@ -18659,7 +18812,7 @@ The flag is set if the currently compiled format contains a `%T'.") (defun org-format-agenda-item (extra txt &optional category tags dotime - noprefix) + noprefix remove-re) "Format TXT to be inserted into the agenda buffer. In particular, it adds the prefix and corresponding text properties. EXTRA must be a string and replaces the `%s' specifier in the prefix format. @@ -18670,7 +18823,8 @@ the `%t' specifier in the format. When DOTIME is a string, this string is searched for a time before TXT is. NOPREFIX is a flag and indicates that only the correctly processes TXT should be returned - this is used by -`org-agenda-change-all-lines'. TAGS can be the tags of the headline." +`org-agenda-change-all-lines'. TAGS can be the tags of the headline. +Any match of REMOVE-RE will be removed from TXT." (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) @@ -18728,6 +18882,10 @@ (match-string 2 txt)) t t txt)))) + (when remove-re + (while (string-match remove-re txt) + (setq txt (replace-match "" t t txt)))) + ;; Create the final string (if noprefix (setq rtn txt) @@ -19257,8 +19415,13 @@ (save-excursion (and (outline-next-heading) (org-flag-heading nil)))) ; show the next heading + (run-hooks 'org-agenda-after-show-hook) (and highlight (org-highlight (point-at-bol) (point-at-eol))))) +(defvar org-agenda-after-show-hook nil + "Normal hook run after an item has been shown from the agenda. +Point is in the buffer where the item originated.") + (defun org-agenda-kill () "Kill the entry or subtree belonging to the current agenda entry." (interactive) @@ -19909,7 +20072,7 @@ "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" "French: " (calendar-french-date-string date) "\n" - "Bahai: " (calendar-bahai-date-string date) " (until sunset)\n" + "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n" "Mayan: " (calendar-mayan-date-string date) "\n" "Coptic: " (calendar-coptic-date-string date) "\n" "Ethiopic: " (calendar-ethiopic-date-string date) "\n" @@ -20284,7 +20447,7 @@ (save-excursion (goto-char 0) (let ((re (org-make-options-regexp - '("TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) + '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) p key val text options) (while (re-search-forward re nil t) (setq key (org-match-string-no-properties 1) @@ -20293,6 +20456,7 @@ ((string-equal key "TITLE") (setq p (plist-put p :title val))) ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) ((string-equal key "EMAIL") (setq p (plist-put p :email val))) + ((string-equal key "DATE") (setq p (plist-put p :date val))) ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) ((string-equal key "TEXT") (setq text (if text (concat text "\n" val) val))) @@ -20840,7 +21004,7 @@ ;; Specific LaTeX stuff (when latexp (require 'org-export-latex nil t) - (org-export-latex-cleaned-string)) + (org-export-latex-cleaned-string commentsp)) ;; Specific HTML stuff (when htmlp @@ -20854,9 +21018,6 @@ (message "Exporting...")) ;; Remove or replace comments - ;; FIXME: Does LaTeX export take care of its own comments? - ;; If :comments is set, use this char for commenting out comments and - ;; protect them. otherwise delete them (goto-char (point-min)) (while (re-search-forward "^#\$.*\n?\$" nil t) (if commentsp @@ -20968,6 +21129,15 @@ (a (assoc rtn alist))) (or (cdr a) rtn)))) +(defun org-get-min-level (lines) + "Get the minimum level in LINES." + (let ((re "^\$\\*+\$ ") l min) + (catch 'exit + (while (setq l (pop lines)) + (if (string-match re l) + (throw 'exit (org-tr-level (length (match-string 1 l)))))) + 1))) + ;; Variable holding the vector with section numbers (defvar org-section-numbers (make-vector org-level-max 0)) @@ -21058,8 +21228,7 @@ (buffer (find-file-noselect filename)) (org-levels-open (make-vector org-level-max nil)) (odd org-odd-levels-only) - (date (format-time-string "%Y/%m/%d" (current-time))) - (time (format-time-string "%X" (org-current-time))) + (date (plist-get opt-plist :date)) (author (plist-get opt-plist :author)) (title (or (and subtree-p (org-export-get-title-from-subtree)) (plist-get opt-plist :title) @@ -21128,8 +21297,15 @@ (insert (concat (nth 1 lang-words) ": " (or author "") (if email (concat " <" email ">") "") "\n"))) - (if (and date time org-export-time-stamp-file) - (insert (concat (nth 2 lang-words) ": " date " " time "\n"))) + + (cond + ((and date (string-match "%" date)) + (setq date (format-time-string date (current-time)))) + (date) + (t (setq date (format-time-string "%Y/%m/%d %X" (current-time))))) + + (if (and date org-export-time-stamp-file) + (insert (concat (nth 2 lang-words) ": " date"\n"))) (insert "\n\n") @@ -21658,8 +21834,7 @@ (t (get-buffer-create to-buffer))) (find-file-noselect filename))) (org-levels-open (make-vector org-level-max nil)) - (date (format-time-string "%Y/%m/%d" (current-time))) - (time (format-time-string "%X" (org-current-time))) + (date (plist-get opt-plist :date)) (author (plist-get opt-plist :author)) (title (or (and subtree-p (org-export-get-title-from-subtree)) (plist-get opt-plist :title) @@ -21730,6 +21905,12 @@ (setq org-last-level org-min-level) (org-init-section-numbers) + (cond + ((and date (string-match "%" date)) + (setq date (format-time-string date (current-time)))) + (date) + (t (setq date (format-time-string "%Y/%m/%d %X" (current-time))))) + ;; Get the language-dependent settings (setq lang-words (or (assoc language org-export-language-setup) (assoc "en" org-export-language-setup))) @@ -21766,13 +21947,13 @@ %s - + %s " language language (org-html-expand title) - (or charset "iso-8859-1") date time author style)) + (or charset "iso-8859-1") date author style)) (insert (or (plist-get opt-plist :preamble) "")) @@ -22187,10 +22368,10 @@ (insert "<" email ">\n")) (insert "

\n")) - (when (and date time org-export-time-stamp-file) + (when (and date org-export-time-stamp-file) (insert "

" (nth 2 lang-words) ": " - date " " time "

\n"))) + date "

\n"))) (if org-export-html-with-timestamp (insert org-export-html-html-helper-timestamp)) @@ -23418,7 +23599,9 @@ depending on context. See the individual commands for more information." (interactive "P") (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up)) + ((org-at-timestamp-p t) + (call-interactively (if org-edit-timestamp-down-means-later + 'org-timestamp-down 'org-timestamp-up))) ((org-on-heading-p) (call-interactively 'org-priority-up)) ((org-at-item-p) (call-interactively 'org-previous-item)) (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) @@ -23429,7 +23612,9 @@ depending on context. See the individual commands for more information." (interactive "P") (cond - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down)) + ((org-at-timestamp-p t) + (call-interactively (if org-edit-timestamp-down-means-later + 'org-timestamp-up 'org-timestamp-down))) ((org-on-heading-p) (call-interactively 'org-priority-down)) (t (call-interactively 'org-next-item)))) @@ -24566,13 +24751,29 @@ t))) (t nil)))) ; call paragraph-fill -(defun org-get-min-level (lines) - (let ((re "^\$\\*+\$ ") l min) - (catch 'exit - (while (setq l (pop lines)) - (if (string-match re l) - (throw 'exit (org-tr-level (length (match-string 1 l)))))) - 1))) +(defun org-assign-fast-keys (alist) + "Assign fast keys to a keyword-key alist. +Respect keys that are already there." + (let (new e k c c1 c2 (char ?a)) + (while (setq e (pop alist)) + (cond + ((equal e '(:startgroup)) (push e new)) + ((equal e '(:endgroup)) (push e new)) + (t + (setq k (car e) c2 nil) + (if (cdr e) + (setq c (cdr e)) + ;; automatically assign a character. + (setq c1 (string-to-char + (downcase (substring + k (if (= (string-to-char k) ?@) 1 0))))) + (if (or (rassoc c1 new) (rassoc c1 alist)) + (while (or (rassoc char new) (rassoc char alist)) + (setq char (1+ char))) + (setq c2 c1)) + (setq c (or c2 char))) + (push (cons k c) new)))) + (nreverse new))) ;;;; Finish up