aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/textmodes
diff options
context:
space:
mode:
authorMiles Bader2008-01-30 07:57:28 +0000
committerMiles Bader2008-01-30 07:57:28 +0000
commitd235ca2ff8fab139ce797757fcb159d1e28fa7e0 (patch)
tree96c5cd1a06a0d9dc26e8470c6eabfc032c0046f3 /lisp/textmodes
parent3709a060f679dba14df71ae64a0035fa2b5b3106 (diff)
parent02cbe062bee38a6705bafb1699d77e3c44cfafcf (diff)
downloademacs-d235ca2ff8fab139ce797757fcb159d1e28fa7e0.tar.gz
emacs-d235ca2ff8fab139ce797757fcb159d1e28fa7e0.zip
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-324
Diffstat (limited to 'lisp/textmodes')
-rw-r--r--lisp/textmodes/bibtex.el263
-rw-r--r--lisp/textmodes/ispell.el4
-rw-r--r--lisp/textmodes/org-export-latex.el1065
-rw-r--r--lisp/textmodes/org-mouse.el1110
-rw-r--r--lisp/textmodes/org-publish.el21
-rw-r--r--lisp/textmodes/org.el3491
-rw-r--r--lisp/textmodes/reftex-index.el10
-rw-r--r--lisp/textmodes/reftex-toc.el10
-rw-r--r--lisp/textmodes/remember.el4
-rw-r--r--lisp/textmodes/sgml-mode.el2
10 files changed, 4375 insertions, 1605 deletions
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 9cdd3082168..1544e4fd24f 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -119,6 +119,7 @@ inherit-booktitle If entry contains a crossref field and the booktitle
119realign Realign entries, so that field texts and perhaps equal 119realign Realign entries, so that field texts and perhaps equal
120 signs (depending on the value of 120 signs (depending on the value of
121 `bibtex-align-at-equal-sign') begin in the same column. 121 `bibtex-align-at-equal-sign') begin in the same column.
122 Also fill fields.
122last-comma Add or delete comma on end of last field in entry, 123last-comma Add or delete comma on end of last field in entry,
123 according to value of `bibtex-comma-after-last-field'. 124 according to value of `bibtex-comma-after-last-field'.
124delimiters Change delimiters according to variables 125delimiters Change delimiters according to variables
@@ -1085,6 +1086,7 @@ Used by `bibtex-find-crossref' and for font-locking."
1085 "--" 1086 "--"
1086 ["Convert Alien Buffer" bibtex-convert-alien t]) 1087 ["Convert Alien Buffer" bibtex-convert-alien t])
1087 ("Operating on Multiple Buffers" 1088 ("Operating on Multiple Buffers"
1089 ["(Re)Initialize BibTeX Buffers" bibtex-initialize t]
1088 ["Validate Entries" bibtex-validate-globally t]))) 1090 ["Validate Entries" bibtex-validate-globally t])))
1089 1091
1090(easy-menu-define 1092(easy-menu-define
@@ -1782,7 +1784,7 @@ If FLAG is nil, a message is echoed if point was incremented at least
1782 ")")) 1784 ")"))
1783 1785
1784(defun bibtex-flash-head (prompt) 1786(defun bibtex-flash-head (prompt)
1785 "Flash at BibTeX entry head before point, if exists." 1787 "Flash at BibTeX entry head before point, if it exists."
1786 (let ((case-fold-search t) 1788 (let ((case-fold-search t)
1787 (pnt (point))) 1789 (pnt (point)))
1788 (save-excursion 1790 (save-excursion
@@ -1790,7 +1792,8 @@ If FLAG is nil, a message is echoed if point was incremented at least
1790 (when (and (looking-at bibtex-any-entry-maybe-empty-head) 1792 (when (and (looking-at bibtex-any-entry-maybe-empty-head)
1791 (< (point) pnt)) 1793 (< (point) pnt))
1792 (goto-char (match-beginning bibtex-type-in-head)) 1794 (goto-char (match-beginning bibtex-type-in-head))
1793 (if (pos-visible-in-window-p (point)) 1795 (if (and (< 0 blink-matching-delay)
1796 (pos-visible-in-window-p (point)))
1794 (sit-for blink-matching-delay) 1797 (sit-for blink-matching-delay)
1795 (message "%s%s" prompt (buffer-substring-no-properties 1798 (message "%s%s" prompt (buffer-substring-no-properties
1796 (point) (match-end bibtex-key-in-head)))))))) 1799 (point) (match-end bibtex-key-in-head))))))))
@@ -1875,38 +1878,42 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
1875(defun bibtex-format-entry () 1878(defun bibtex-format-entry ()
1876 "Helper function for `bibtex-clean-entry'. 1879 "Helper function for `bibtex-clean-entry'.
1877Formats current entry according to variable `bibtex-entry-format'." 1880Formats current entry according to variable `bibtex-entry-format'."
1881 ;; initialize `bibtex-field-braces-opt' if necessary
1882 (if (and bibtex-field-braces-alist (not bibtex-field-braces-opt))
1883 (setq bibtex-field-braces-opt
1884 (bibtex-field-re-init bibtex-field-braces-alist 'braces)))
1885 ;; initialize `bibtex-field-strings-opt' if necessary
1886 (if (and bibtex-field-strings-alist (not bibtex-field-strings-opt))
1887 (setq bibtex-field-strings-opt
1888 (bibtex-field-re-init bibtex-field-strings-alist 'strings)))
1889
1878 (save-excursion 1890 (save-excursion
1879 (save-restriction 1891 (save-restriction
1880 (bibtex-narrow-to-entry) 1892 (bibtex-narrow-to-entry)
1881 (let ((case-fold-search t) 1893 (let ((case-fold-search t)
1882 (format (if (eq bibtex-entry-format t) 1894 (format (if (eq bibtex-entry-format t)
1883 '(realign opts-or-alts required-fields 1895 '(realign opts-or-alts required-fields numerical-fields
1884 numerical-fields 1896 page-dashes whitespace inherit-booktitle
1885 last-comma page-dashes delimiters 1897 last-comma delimiters unify-case braces
1886 unify-case inherit-booktitle) 1898 strings)
1887 bibtex-entry-format)) 1899 bibtex-entry-format))
1888 crossref-key bounds alternatives-there non-empty-alternative 1900 bounds crossref-key req-field-list default-field-list field-list)
1889 entry-list req-field-list field-list) 1901
1890 1902 ;; There are more elegant high-level functions for several tasks
1891 ;; Initialize `bibtex-field-braces-opt' and `bibtex-field-strings-opt' 1903 ;; done by `bibtex-format-entry'. However, they contain some
1892 ;; if necessary. 1904 ;; redundancy compared with what we need to do anyway.
1893 (unless bibtex-field-braces-opt 1905 ;; So for speed-up we avoid using them.
1894 (setq bibtex-field-braces-opt 1906 ;; (`bibtex-format-entry' is called many times by `bibtex-reformat'.)
1895 (bibtex-field-re-init bibtex-field-braces-alist 'braces)))
1896 (unless bibtex-field-strings-opt
1897 (setq bibtex-field-strings-opt
1898 (bibtex-field-re-init bibtex-field-strings-alist 'strings)))
1899 1907
1900 ;; identify entry type 1908 ;; identify entry type
1901 (goto-char (point-min)) 1909 (goto-char (point-min))
1902 (or (re-search-forward bibtex-entry-type nil t) 1910 (or (re-search-forward bibtex-entry-type nil t)
1903 (error "Not inside a BibTeX entry")) 1911 (error "Not inside a BibTeX entry"))
1904 (let ((beg-type (1+ (match-beginning 0))) 1912 (let* ((beg-type (1+ (match-beginning 0)))
1905 (end-type (match-end 0))) 1913 (end-type (match-end 0))
1906 (setq entry-list (assoc-string (buffer-substring-no-properties 1914 (entry-list (assoc-string (buffer-substring-no-properties
1907 beg-type end-type) 1915 beg-type end-type)
1908 bibtex-entry-field-alist 1916 bibtex-entry-field-alist t)))
1909 t))
1910 1917
1911 ;; unify case of entry name 1918 ;; unify case of entry name
1912 (when (memq 'unify-case format) 1919 (when (memq 'unify-case format)
@@ -1918,35 +1925,24 @@ Formats current entry according to variable `bibtex-entry-format'."
1918 (goto-char end-type) 1925 (goto-char end-type)
1919 (skip-chars-forward " \t\n") 1926 (skip-chars-forward " \t\n")
1920 (delete-char 1) 1927 (delete-char 1)
1921 (insert (bibtex-entry-left-delimiter)))) 1928 (insert (bibtex-entry-left-delimiter)))
1922 1929
1923 ;; determine if entry has crossref field and if at least 1930 ;; Do we have a crossref key?
1924 ;; one alternative is non-empty 1931 (goto-char (point-min))
1925 (goto-char (point-min)) 1932 (if (setq bounds (bibtex-search-forward-field "crossref"))
1926 (let* ((fields-alist (bibtex-parse-entry t)) 1933 (let ((text (bibtex-text-in-field-bounds bounds t)))
1927 (field (assoc-string "crossref" fields-alist t))) 1934 (unless (equal "" text)
1928 (setq crossref-key (and field 1935 (setq crossref-key text))))
1929 (not (equal "" (cdr field))) 1936
1930 (cdr field)) 1937 ;; list of required fields appropriate for an entry with
1931 req-field-list (if crossref-key 1938 ;; or without crossref key.
1932 (nth 0 (nth 2 entry-list)) ; crossref part 1939 (setq req-field-list (if (and crossref-key (nth 2 entry-list))
1933 (nth 0 (nth 1 entry-list)))) ; required part 1940 (car (nth 2 entry-list))
1934 1941 (car (nth 1 entry-list)))
1935 (dolist (rfield req-field-list) 1942 ;; default list of fields that may appear in this entry
1936 (when (nth 3 rfield) ; we should have an alternative 1943 default-field-list (append (nth 0 (nth 1 entry-list))
1937 (setq alternatives-there t 1944 (nth 1 (nth 1 entry-list))
1938 field (assoc-string (car rfield) fields-alist t)) 1945 bibtex-user-optional-fields)))
1939 (if (and field
1940 (not (equal "" (cdr field))))
1941 (cond ((not non-empty-alternative)
1942 (setq non-empty-alternative t))
1943 ((memq 'required-fields format)
1944 (error "More than one non-empty alternative")))))))
1945
1946 (if (and alternatives-there
1947 (not non-empty-alternative)
1948 (memq 'required-fields format))
1949 (error "All alternatives are empty"))
1950 1946
1951 ;; process all fields 1947 ;; process all fields
1952 (bibtex-beginning-first-field (point-min)) 1948 (bibtex-beginning-first-field (point-min))
@@ -1965,25 +1961,18 @@ Formats current entry according to variable `bibtex-entry-format'."
1965 (empty-field (equal "" (bibtex-text-in-field-bounds bounds t))) 1961 (empty-field (equal "" (bibtex-text-in-field-bounds bounds t)))
1966 deleted) 1962 deleted)
1967 1963
1968 ;; We have more elegant high-level functions for several
1969 ;; tasks done by `bibtex-format-entry'. However, they contain
1970 ;; quite some redundancy compared with what we need to do
1971 ;; anyway. So for speed-up we avoid using them.
1972
1973 (if (memq 'opts-or-alts format) 1964 (if (memq 'opts-or-alts format)
1965 ;; delete empty optional and alternative fields
1966 ;; (but keep empty required fields)
1974 (cond ((and empty-field 1967 (cond ((and empty-field
1975 (or opt-alt 1968 (or opt-alt
1976 (let ((field (assoc-string 1969 (let ((field (assoc-string
1977 field-name req-field-list t))) 1970 field-name req-field-list t)))
1978 (or (not field) ; OPT field 1971 (or (not field) ; OPT field
1979 (nth 3 field))))) ; ALT field 1972 (nth 3 field))))) ; ALT field
1980 ;; Either it is an empty ALT field. Then we have checked
1981 ;; already that we have one non-empty alternative. Or it
1982 ;; is an empty OPT field that we do not miss anyway.
1983 ;; So we can safely delete this field.
1984 (delete-region beg-field end-field) 1973 (delete-region beg-field end-field)
1985 (setq deleted t)) 1974 (setq deleted t))
1986 ;; otherwise: not empty, delete "OPT" or "ALT" 1975 ;; otherwise nonempty field: delete "OPT" or "ALT"
1987 (opt-alt 1976 (opt-alt
1988 (goto-char beg-name) 1977 (goto-char beg-name)
1989 (delete-char 3)))) 1978 (delete-char 3))))
@@ -2087,16 +2076,7 @@ Formats current entry according to variable `bibtex-entry-format'."
2087 (goto-char (1+ beg-text)) 2076 (goto-char (1+ beg-text))
2088 (insert title)))) 2077 (insert title))))
2089 2078
2090 ;; Use booktitle to set a missing title. 2079 ;; if empty field is a required field, complain
2091 (if (and empty-field
2092 (bibtex-string= field-name "title"))
2093 (let ((booktitle (bibtex-text-in-field "booktitle")))
2094 (when booktitle
2095 (setq empty-field nil)
2096 (goto-char (1+ beg-text))
2097 (insert booktitle))))
2098
2099 ;; if empty field, complain
2100 (if (and empty-field 2080 (if (and empty-field
2101 (memq 'required-fields format) 2081 (memq 'required-fields format)
2102 (assoc-string field-name req-field-list t)) 2082 (assoc-string field-name req-field-list t))
@@ -2104,12 +2084,8 @@ Formats current entry according to variable `bibtex-entry-format'."
2104 2084
2105 ;; unify case of field name 2085 ;; unify case of field name
2106 (if (memq 'unify-case format) 2086 (if (memq 'unify-case format)
2107 (let ((fname (car (assoc-string 2087 (let ((fname (car (assoc-string field-name
2108 field-name 2088 default-field-list t))))
2109 (append (nth 0 (nth 1 entry-list))
2110 (nth 1 (nth 1 entry-list))
2111 bibtex-user-optional-fields)
2112 t))))
2113 (if fname 2089 (if fname
2114 (progn 2090 (progn
2115 (delete-region beg-name end-name) 2091 (delete-region beg-name end-name)
@@ -2123,23 +2099,21 @@ Formats current entry according to variable `bibtex-entry-format'."
2123 2099
2124 ;; check whether all required fields are present 2100 ;; check whether all required fields are present
2125 (if (memq 'required-fields format) 2101 (if (memq 'required-fields format)
2126 (let ((found 0) altlist) 2102 (let ((found 0) alt-list)
2127 (dolist (fname req-field-list) 2103 (dolist (fname req-field-list)
2128 (if (nth 3 fname) 2104 (cond ((nth 3 fname) ; t if field has alternative flag
2129 (push (car fname) altlist)) 2105 (push (car fname) alt-list)
2130 (unless (or (member (car fname) field-list) 2106 (if (member-ignore-case (car fname) field-list)
2131 (nth 3 fname)) 2107 (setq found (1+ found))))
2132 (error "Mandatory field `%s' is missing" (car fname)))) 2108 ((not (member-ignore-case (car fname) field-list))
2133 (when altlist 2109 (error "Mandatory field `%s' is missing" (car fname)))))
2134 (dolist (fname altlist) 2110 (if alt-list
2135 (if (member fname field-list) 2111 (cond ((= found 0)
2136 (setq found (1+ found)))) 2112 (error "Alternative mandatory field `%s' is missing"
2137 (cond ((= found 0) 2113 alt-list))
2138 (error "Alternative mandatory field `%s' is missing" 2114 ((> found 1)
2139 altlist)) 2115 (error "Alternative fields `%s' are defined %s times"
2140 ((> found 1) 2116 alt-list found))))))
2141 (error "Alternative fields `%s' are defined %s times"
2142 altlist found))))))
2143 2117
2144 ;; update comma after last field 2118 ;; update comma after last field
2145 (if (memq 'last-comma format) 2119 (if (memq 'last-comma format)
@@ -2158,7 +2132,7 @@ Formats current entry according to variable `bibtex-entry-format'."
2158 (delete-char 1) 2132 (delete-char 1)
2159 (insert (bibtex-entry-right-delimiter))) 2133 (insert (bibtex-entry-right-delimiter)))
2160 2134
2161 ;; fill entry 2135 ;; realign and fill entry
2162 (if (memq 'realign format) 2136 (if (memq 'realign format)
2163 (bibtex-fill-entry)))))) 2137 (bibtex-fill-entry))))))
2164 2138
@@ -2426,7 +2400,7 @@ Concatenate the key:
2426 (apply 'append 2400 (apply 'append
2427 (mapcar (lambda (buf) 2401 (mapcar (lambda (buf)
2428 (with-current-buffer buf bibtex-reference-keys)) 2402 (with-current-buffer buf bibtex-reference-keys))
2429 (bibtex-files-expand t))) 2403 (bibtex-initialize t)))
2430 bibtex-reference-keys)) 2404 bibtex-reference-keys))
2431 2405
2432(defun bibtex-read-key (prompt &optional key global) 2406(defun bibtex-read-key (prompt &optional key global)
@@ -2606,14 +2580,22 @@ Parsing initializes `bibtex-reference-keys' and `bibtex-strings'."
2606 (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick))))) 2580 (setq bibtex-buffer-last-parsed-tick (buffer-modified-tick)))))
2607 (setq buffers (cdr buffers)))))) 2581 (setq buffers (cdr buffers))))))
2608 2582
2609(defun bibtex-files-expand (&optional current force) 2583;;;###autoload
2610 "Return an expanded list of BibTeX buffers based on `bibtex-files'. 2584(defun bibtex-initialize (&optional current force select)
2585 "(Re)Initialize BibTeX buffers.
2586Visit the BibTeX files defined by `bibtex-files' and return a list
2587of corresponding buffers.
2611Initialize in these buffers `bibtex-reference-keys' if not yet set. 2588Initialize in these buffers `bibtex-reference-keys' if not yet set.
2612List of BibTeX buffers includes current buffer if CURRENT is non-nil. 2589List of BibTeX buffers includes current buffer if CURRENT is non-nil.
2613If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if 2590If FORCE is non-nil, (re)initialize `bibtex-reference-keys' even if
2614already set." 2591already set. If SELECT is non-nil interactively select a BibTeX buffer.
2592When called interactively, FORCE is t, CURRENT is t if current buffer uses
2593`bibtex-mode', and SELECT is t if current buffer does not use `bibtex-mode',"
2594 (interactive (list (eq major-mode 'bibtex-mode) t
2595 (not (eq major-mode 'bibtex-mode))))
2615 (let ((file-path (split-string (or bibtex-file-path default-directory) ":+")) 2596 (let ((file-path (split-string (or bibtex-file-path default-directory) ":+"))
2616 file-list dir-list buffer-list) 2597 file-list dir-list buffer-list)
2598 ;; generate list of BibTeX files
2617 (dolist (file bibtex-files) 2599 (dolist (file bibtex-files)
2618 (cond ((eq file 'bibtex-file-path) 2600 (cond ((eq file 'bibtex-file-path)
2619 (setq dir-list (append dir-list file-path))) 2601 (setq dir-list (append dir-list file-path)))
@@ -2624,34 +2606,46 @@ already set."
2624 (file-name-absolute-p file)) 2606 (file-name-absolute-p file))
2625 (push file file-list)) 2607 (push file file-list))
2626 (t 2608 (t
2627 (let (fullfilename found) 2609 (let (expanded-file-name found)
2628 (dolist (dir file-path) 2610 (dolist (dir file-path)
2629 (when (file-readable-p 2611 (when (file-readable-p
2630 (setq fullfilename (expand-file-name file dir))) 2612 (setq expanded-file-name (expand-file-name file dir)))
2631 (push fullfilename file-list) 2613 (push expanded-file-name file-list)
2632 (setq found t))) 2614 (setq found t)))
2633 (unless found 2615 (unless found
2634 (error "File %s not in paths defined via bibtex-file-path" 2616 (error "File `%s' not in paths defined via bibtex-file-path"
2635 file)))))) 2617 file))))))
2636 (dolist (file file-list) 2618 (dolist (file file-list)
2637 (unless (file-readable-p file) 2619 (unless (file-readable-p file)
2638 (error "BibTeX file %s not found" file))) 2620 (error "BibTeX file `%s' not found" file)))
2639 ;; expand dir-list 2621 ;; expand dir-list
2640 (dolist (dir dir-list) 2622 (dolist (dir dir-list)
2641 (setq file-list 2623 (setq file-list
2642 (append file-list (directory-files dir t "\\.bib\\'" t)))) 2624 (append file-list (directory-files dir t "\\.bib\\'" t))))
2643 (delete-dups file-list) 2625 (delete-dups file-list)
2626 ;; visit files in FILE-LIST
2644 (dolist (file file-list) 2627 (dolist (file file-list)
2645 (when (file-readable-p file) 2628 (if (file-readable-p file)
2646 (push (find-file-noselect file) buffer-list) 2629 (push (find-file-noselect file) buffer-list)))
2647 (with-current-buffer (car buffer-list) 2630 ;; include current buffer iff we want it
2648 (if (or force (not (listp bibtex-reference-keys)))
2649 (bibtex-parse-keys)))))
2650 (cond ((and current (not (memq (current-buffer) buffer-list))) 2631 (cond ((and current (not (memq (current-buffer) buffer-list)))
2651 (push (current-buffer) buffer-list) 2632 (push (current-buffer) buffer-list))
2652 (if force (bibtex-parse-keys)))
2653 ((and (not current) (memq (current-buffer) buffer-list)) 2633 ((and (not current) (memq (current-buffer) buffer-list))
2654 (setq buffer-list (delq (current-buffer) buffer-list)))) 2634 (setq buffer-list (delq (current-buffer) buffer-list))))
2635 ;; parse keys
2636 (dolist (buffer buffer-list)
2637 (with-current-buffer buffer
2638 (if (or force (nlistp bibtex-reference-keys))
2639 (bibtex-parse-keys))))
2640 ;; select BibTeX buffer
2641 (if select
2642 (if buffer-list
2643 (switch-to-buffer
2644 (completing-read "Switch to BibTeX buffer: "
2645 (mapcar 'buffer-name buffer-list)
2646 nil t
2647 (if current (buffer-name (current-buffer)))))
2648 (message "No BibTeX buffers defined")))
2655 buffer-list)) 2649 buffer-list))
2656 2650
2657(defun bibtex-complete-internal (completions) 2651(defun bibtex-complete-internal (completions)
@@ -3130,7 +3124,6 @@ field contents of the neighboring entry. Finally try to update the text
3130based on the difference between the keys of the neighboring and the current 3124based on the difference between the keys of the neighboring and the current
3131entry (for example, the year parts of the keys)." 3125entry (for example, the year parts of the keys)."
3132 (interactive) 3126 (interactive)
3133 (undo-boundary) ;So you can easily undo it, if it didn't work right.
3134 (bibtex-beginning-of-entry) 3127 (bibtex-beginning-of-entry)
3135 (when (looking-at bibtex-entry-head) 3128 (when (looking-at bibtex-entry-head)
3136 (let ((type (bibtex-type-in-head)) 3129 (let ((type (bibtex-type-in-head))
@@ -3413,13 +3406,18 @@ If its value is nil use plain sorting."
3413 (cond ((not index1) (not index2)) ; indices can be nil 3406 (cond ((not index1) (not index2)) ; indices can be nil
3414 ((not index2) nil) 3407 ((not index2) nil)
3415 ((eq bibtex-maintain-sorted-entries 'crossref) 3408 ((eq bibtex-maintain-sorted-entries 'crossref)
3416 (if (nth 1 index1) 3409 ;; CROSSREF-KEY may be nil or it can point to an entry
3417 (if (nth 1 index2) 3410 ;; in another BibTeX file. In both cases we ignore CROSSREF-KEY.
3411 (if (and (nth 1 index1)
3412 (cdr (assoc-string (nth 1 index1) bibtex-reference-keys)))
3413 (if (and (nth 1 index2)
3414 (cdr (assoc-string (nth 1 index2) bibtex-reference-keys)))
3418 (or (string-lessp (nth 1 index1) (nth 1 index2)) 3415 (or (string-lessp (nth 1 index1) (nth 1 index2))
3419 (and (string-equal (nth 1 index1) (nth 1 index2)) 3416 (and (string-equal (nth 1 index1) (nth 1 index2))
3420 (string-lessp (nth 0 index1) (nth 0 index2)))) 3417 (string-lessp (nth 0 index1) (nth 0 index2))))
3421 (not (string-lessp (nth 0 index2) (nth 1 index1)))) 3418 (not (string-lessp (nth 0 index2) (nth 1 index1))))
3422 (if (nth 1 index2) 3419 (if (and (nth 1 index2)
3420 (cdr (assoc-string (nth 1 index2) bibtex-reference-keys)))
3423 (string-lessp (nth 0 index1) (nth 1 index2)) 3421 (string-lessp (nth 0 index1) (nth 1 index2))
3424 (string-lessp (nth 0 index1) (nth 0 index2))))) 3422 (string-lessp (nth 0 index1) (nth 0 index2)))))
3425 ((eq bibtex-maintain-sorted-entries 'entry-class) 3423 ((eq bibtex-maintain-sorted-entries 'entry-class)
@@ -3444,6 +3442,9 @@ are ignored."
3444 (interactive) 3442 (interactive)
3445 (bibtex-beginning-of-first-entry) ; Needed by `sort-subr' 3443 (bibtex-beginning-of-first-entry) ; Needed by `sort-subr'
3446 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. 3444 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3445 (if (and (eq bibtex-maintain-sorted-entries 'crossref)
3446 (nlistp bibtex-reference-keys))
3447 (bibtex-parse-keys)) ; Needed by `bibtex-lessp'.
3447 (sort-subr nil 3448 (sort-subr nil
3448 'bibtex-skip-to-valid-entry ; NEXTREC function 3449 'bibtex-skip-to-valid-entry ; NEXTREC function
3449 'bibtex-end-of-entry ; ENDREC function 3450 'bibtex-end-of-entry ; ENDREC function
@@ -3539,7 +3540,7 @@ Otherwise, use `set-buffer'. DISPLAY is t when called interactively."
3539 (interactive (list (bibtex-read-key "Find key: " nil current-prefix-arg) 3540 (interactive (list (bibtex-read-key "Find key: " nil current-prefix-arg)
3540 current-prefix-arg nil t)) 3541 current-prefix-arg nil t))
3541 (if (and global bibtex-files) 3542 (if (and global bibtex-files)
3542 (let ((buffer-list (bibtex-files-expand t)) 3543 (let ((buffer-list (bibtex-initialize t))
3543 buffer found) 3544 buffer found)
3544 (while (and (not found) 3545 (while (and (not found)
3545 (setq buffer (pop buffer-list))) 3546 (setq buffer (pop buffer-list)))
@@ -3581,6 +3582,9 @@ search to look for place for KEY. This requires that buffer is sorted,
3581see `bibtex-validate'. 3582see `bibtex-validate'.
3582Return t if preparation was successful or nil if entry KEY already exists." 3583Return t if preparation was successful or nil if entry KEY already exists."
3583 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'. 3584 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3585 (if (and (eq bibtex-maintain-sorted-entries 'crossref)
3586 (nlistp bibtex-reference-keys))
3587 (bibtex-parse-keys)) ; Needed by `bibtex-lessp'.
3584 (let ((key (nth 0 index)) 3588 (let ((key (nth 0 index))
3585 key-exist) 3589 key-exist)
3586 (cond ((or (null key) 3590 (cond ((or (null key)
@@ -3671,6 +3675,9 @@ Return t if test was successful, nil otherwise."
3671 (setq syntax-error t) 3675 (setq syntax-error t)
3672 3676
3673 ;; Check for duplicate keys and correct sort order 3677 ;; Check for duplicate keys and correct sort order
3678 (bibtex-init-sort-entry-class-alist) ; Needed by `bibtex-lessp'.
3679 (bibtex-parse-keys) ; Possibly needed by `bibtex-lessp'.
3680 ; Always needed by subsequent global key check.
3674 (let (previous current key-list) 3681 (let (previous current key-list)
3675 (bibtex-progress-message "Checking for duplicate keys") 3682 (bibtex-progress-message "Checking for duplicate keys")
3676 (bibtex-map-entries 3683 (bibtex-map-entries
@@ -3692,9 +3699,12 @@ Return t if test was successful, nil otherwise."
3692 (bibtex-progress-message 'done)) 3699 (bibtex-progress-message 'done))
3693 3700
3694 ;; Check for duplicate keys in `bibtex-files'. 3701 ;; Check for duplicate keys in `bibtex-files'.
3695 (bibtex-parse-keys) 3702 ;; `bibtex-validate' only compares keys in current buffer with keys
3703 ;; in `bibtex-files'. `bibtex-validate-globally' compares keys for
3704 ;; each file in `bibtex-files' with keys of all other files in
3705 ;; `bibtex-files'.
3696 ;; We don't want to be fooled by outdated `bibtex-reference-keys'. 3706 ;; We don't want to be fooled by outdated `bibtex-reference-keys'.
3697 (dolist (buffer (bibtex-files-expand nil t)) 3707 (dolist (buffer (bibtex-initialize nil t))
3698 (dolist (key (with-current-buffer buffer bibtex-reference-keys)) 3708 (dolist (key (with-current-buffer buffer bibtex-reference-keys))
3699 (when (and (cdr key) 3709 (when (and (cdr key)
3700 (cdr (assoc-string (car key) bibtex-reference-keys))) 3710 (cdr (assoc-string (car key) bibtex-reference-keys)))
@@ -3792,7 +3802,7 @@ Return t if test was successful, nil otherwise."
3792With optional prefix arg STRINGS, check for duplicate strings, too. 3802With optional prefix arg STRINGS, check for duplicate strings, too.
3793Return t if test was successful, nil otherwise." 3803Return t if test was successful, nil otherwise."
3794 (interactive "P") 3804 (interactive "P")
3795 (let ((buffer-list (bibtex-files-expand t)) 3805 (let ((buffer-list (bibtex-initialize t))
3796 buffer-key-list current-buf current-keys error-list) 3806 buffer-key-list current-buf current-keys error-list)
3797 ;; Check for duplicate keys within BibTeX buffer 3807 ;; Check for duplicate keys within BibTeX buffer
3798 (dolist (buffer buffer-list) 3808 (dolist (buffer buffer-list)
@@ -4133,14 +4143,15 @@ At end of the cleaning process, the functions in
4133 (error "Not inside a BibTeX entry"))) 4143 (error "Not inside a BibTeX entry")))
4134 (entry-type (bibtex-type-in-head)) 4144 (entry-type (bibtex-type-in-head))
4135 (key (bibtex-key-in-head))) 4145 (key (bibtex-key-in-head)))
4136 ;; formatting 4146 ;; formatting (undone if error occurs)
4137 (cond ((bibtex-string= entry-type "preamble") 4147 (atomic-change-group
4138 ;; (bibtex-format-preamble) 4148 (cond ((bibtex-string= entry-type "preamble")
4139 (error "No clean up of @Preamble entries")) 4149 ;; (bibtex-format-preamble)
4140 ((bibtex-string= entry-type "string") 4150 (error "No clean up of @Preamble entries"))
4141 (setq entry-type 'string)) 4151 ((bibtex-string= entry-type "string")
4142 ;; (bibtex-format-string) 4152 (setq entry-type 'string))
4143 (t (bibtex-format-entry))) 4153 ;; (bibtex-format-string)
4154 (t (bibtex-format-entry))))
4144 ;; set key 4155 ;; set key
4145 (when (or new-key (not key)) 4156 (when (or new-key (not key))
4146 (setq key (bibtex-generate-autokey)) 4157 (setq key (bibtex-generate-autokey))
@@ -4184,7 +4195,7 @@ At end of the cleaning process, the functions in
4184 (bibtex-find-entry key nil end)))) 4195 (bibtex-find-entry key nil end))))
4185 (if error 4196 (if error
4186 (error "New inserted entry yields duplicate key")) 4197 (error "New inserted entry yields duplicate key"))
4187 (dolist (buffer (bibtex-files-expand)) 4198 (dolist (buffer (bibtex-initialize))
4188 (with-current-buffer buffer 4199 (with-current-buffer buffer
4189 (if (cdr (assoc-string key bibtex-reference-keys)) 4200 (if (cdr (assoc-string key bibtex-reference-keys))
4190 (error "Duplicate key in %s" (buffer-file-name))))) 4201 (error "Duplicate key in %s" (buffer-file-name)))))
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 900a2c36893..796a6a6d7e1 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1597,7 +1597,7 @@ quit spell session exited."
1597 (or quietly 1597 (or quietly
1598 (message "%s is correct" 1598 (message "%s is correct"
1599 (funcall ispell-format-word-function word))) 1599 (funcall ispell-format-word-function word)))
1600 (and (fboundp 'extent-at) 1600 (and (featurep 'xemacs)
1601 (extent-at start) 1601 (extent-at start)
1602 (and (fboundp 'delete-extent) 1602 (and (fboundp 'delete-extent)
1603 (delete-extent (extent-at start))))) 1603 (delete-extent (extent-at start)))))
@@ -1606,7 +1606,7 @@ quit spell session exited."
1606 (message "%s is correct because of root %s" 1606 (message "%s is correct because of root %s"
1607 (funcall ispell-format-word-function word) 1607 (funcall ispell-format-word-function word)
1608 (funcall ispell-format-word-function poss))) 1608 (funcall ispell-format-word-function poss)))
1609 (and (fboundp 'extent-at) 1609 (and (featurep 'xemacs)
1610 (extent-at start) 1610 (extent-at start)
1611 (and (fboundp 'delete-extent) 1611 (and (fboundp 'delete-extent)
1612 (delete-extent (extent-at start))))) 1612 (delete-extent (extent-at start)))))
diff --git a/lisp/textmodes/org-export-latex.el b/lisp/textmodes/org-export-latex.el
index eef1c10e5b6..7624af8aa0e 100644
--- a/lisp/textmodes/org-export-latex.el
+++ b/lisp/textmodes/org-export-latex.el
@@ -1,10 +1,10 @@
1 ;;; org-export-latex.el --- LaTeX exporter for org-mode 1;;; org-export-latex.el --- LaTeX exporter for org-mode
2;; 2;;
3;; Copyright (C) 2007 Free Software Foundation, Inc. 3;; Copyright (c) 2007, 2008 Free Software Foundation, Inc.
4;; 4;;
5;; Emacs Lisp Archive Entry 5;; Emacs Lisp Archive Entry
6;; Filename: org-export-latex.el 6;; Filename: org-export-latex.el
7;; Version: 5.12 7;; Version: 5.19
8;; Author: Bastien Guerry <bzg AT altern DOT org> 8;; Author: Bastien Guerry <bzg AT altern DOT org>
9;; Maintainer: Bastien Guerry <bzg AT altern DOT org> 9;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
10;; Keywords: org, wp, tex 10;; Keywords: org, wp, tex
@@ -18,31 +18,31 @@
18;; Free Software Foundation; either version 3, or (at your option) any 18;; Free Software Foundation; either version 3, or (at your option) any
19;; later version. 19;; later version.
20;; 20;;
21;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT 21;; GNU Emacs is distributed in the hope that it will be useful, but
22;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 22;; WITHOUT ANY WARRANTY; without even the implied warranty of
23;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24;; more details. 24;; General Public License for more details.
25;; 25;;
26;; You should have received a copy of the GNU General Public License along 26;; You should have received a copy of the GNU General Public License
27;; with GNU Emacs; see the file COPYING. If not, write to the Free Software 27;; along with GNU Emacs; see the file COPYING. If not, write to the Free
28;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 28;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
29;; 02110-1301, USA. 29;; MA 02110-1301, USA.
30;; 30;;
31;;; Commentary: 31;;; Commentary:
32;; 32;;
33;; This library implements a LaTeX exporter for org-mode. 33;; This library implements a LaTeX exporter for org-mode.
34;; 34;;
35;; Put this file into your load-path and the following into your ~/.emacs: 35;; Put this file into your load-path and the following into your ~/.emacs:
36;; (require 'org-export-latex) 36;; (require 'org-export-latex)
37;; 37;;
38;; The interactive functions are similar to those of the HTML exporter: 38;; The interactive functions are similar to those of the HTML exporter:
39;; 39;;
40;; M-x `org-export-as-latex' 40;; M-x `org-export-as-latex'
41;; M-x `org-export-as-latex-batch' 41;; M-x `org-export-as-latex-batch'
42;; M-x `org-export-as-latex-to-buffer' 42;; M-x `org-export-as-latex-to-buffer'
43;; M-x `org-export-region-as-latex' 43;; M-x `org-export-region-as-latex'
44;; M-x `org-replace-region-by-latex' 44;; M-x `org-replace-region-by-latex'
45;; 45;;
46;;; Code: 46;;; Code:
47 47
48(eval-when-compile 48(eval-when-compile
@@ -52,15 +52,19 @@
52(require 'org) 52(require 'org)
53 53
54;;; Variables: 54;;; Variables:
55(defvar org-latex-options-plist nil) 55(defvar org-export-latex-class nil)
56(defvar org-latex-todo-keywords-1 nil) 56(defvar org-export-latex-header nil)
57(defvar org-latex-all-targets-regexp nil) 57(defvar org-export-latex-append-header nil)
58(defvar org-latex-add-level 0) 58(defvar org-export-latex-options-plist nil)
59(defvar org-latex-sectioning-depth 0) 59(defvar org-export-latex-todo-keywords-1 nil)
60(defvar org-export-latex-all-targets-re nil)
61(defvar org-export-latex-add-level 0)
62(defvar org-export-latex-sectioning "")
63(defvar org-export-latex-sectioning-depth 0)
60(defvar org-export-latex-list-beginning-re 64(defvar org-export-latex-list-beginning-re
61 "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?") 65 "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +?")
62 66
63(defvar org-latex-special-string-regexps 67(defvar org-export-latex-special-string-regexps
64 '(org-ts-regexp 68 '(org-ts-regexp
65 org-scheduled-string 69 org-scheduled-string
66 org-deadline-string 70 org-deadline-string
@@ -71,28 +75,82 @@
71(defvar re-quote) ; dynamically scoped from org.el 75(defvar re-quote) ; dynamically scoped from org.el
72(defvar commentsp) ; dynamically scoped from org.el 76(defvar commentsp) ; dynamically scoped from org.el
73 77
74;;; Custom variables: 78;;; User variables:
75(defcustom org-export-latex-sectioning-alist
76 '((1 "\\section{%s}" "\\section*{%s}")
77 (2 "\\subsection{%s}" "\\subsection*{%s}")
78 (3 "\\subsubsection{%s}" "\\subsubsection*{%s}")
79 (4 "\\paragraph{%s}" "\\paragraph*{%s}")
80 (5 "\\subparagraph{%s}" "\\subparagraph*{%s}"))
81 "Alist of LaTeX commands for inserting sections.
82Here is the structure of each cell:
83 79
84 \(level unnumbered-section numbered-section\) 80(defcustom org-export-latex-default-class "article"
81 "The default LaTeX class."
82 :group 'org-export-latex
83 :type '(string :tag "LaTeX class"))
85 84
86The %s formatter will be replaced by the title of the section." 85(defcustom org-export-latex-classes
86 '(("article"
87 "\\documentclass[11pt,a4paper]{article}
88\\usepackage[utf8]{inputenc}
89\\usepackage[T1]{fontenc}
90\\usepackage{hyperref}"
91 ("\\section{%s}" . "\\section*{%s}")
92 ("\\subsection{%s}" . "\\subsection*{%s}")
93 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
94 ("\\paragraph{%s}" . "\\paragraph*{%s}")
95 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
96 ("report"
97 "\\documentclass[11pt,a4paper]{report}
98\\usepackage[utf8]{inputenc}
99\\usepackage[T1]{fontenc}
100\\usepackage{hyperref}"
101 ("\\part{%s}" . "\\part*{%s}")
102 ("\\chapter{%s}" . "\\chapter*{%s}")
103 ("\\section{%s}" . "\\section*{%s}")
104 ("\\subsection{%s}" . "\\subsection*{%s}")
105 ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
106 ("book"
107 "\\documentclass[11pt,a4paper]{book}
108\\usepackage[utf8]{inputenc}
109\\usepackage[T1]{fontenc}
110\\usepackage{hyperref}"
111 ("\\part{%s}" . "\\part*{%s}")
112 ("\\chapter{%s}" . "\\chapter*{%s}")
113 ("\\section{%s}" . "\\section*{%s}")
114 ("\\subsection{%s}" . "\\subsection*{%s}")
115 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))
116 "Alist of LaTeX classes and associated header and structure.
117If #+LaTeX_CLASS is set in the buffer, use its value and the
118associated information. Here is the structure of each cell:
119
120 \(class-name
121 header-string
122 (unnumbered-section numbered-section\)
123 ...\)
124
125A %s formatter is mandatory in each section string and will be
126replaced by the title of the section."
87 :group 'org-export-latex 127 :group 'org-export-latex
88 :type 'alist) 128 :type '(repeat
129 (list (string :tag "LaTeX class")
130 (string :tag "LaTeX header")
131 (cons :tag "Level 1"
132 (string :tag "Numbered")
133 (string :tag "Unnumbered"))
134 (cons :tag "Level 2"
135 (string :tag "Numbered")
136 (string :tag "Unnumbered"))
137 (cons :tag "Level 3"
138 (string :tag "Numbered")
139 (string :tag "Unnumbered"))
140 (cons :tag "Level 4"
141 (string :tag "Numbered")
142 (string :tag "Unnumbered"))
143 (cons :tag "Level 5"
144 (string :tag "Numbered")
145 (string :tag "Unnumbered")))))
89 146
90(defcustom org-export-latex-emphasis-alist 147(defcustom org-export-latex-emphasis-alist
91 '(("*" "\\textbf{%s}" nil) 148 '(("*" "\\textbf{%s}" nil)
92 ("/" "\\emph{%s}" nil) 149 ("/" "\\emph{%s}" nil)
93 ("_" "\\underline{%s}" nil) 150 ("_" "\\underline{%s}" nil)
94 ("+" "\\texttt{%s}" nil) 151 ("+" "\\texttt{%s}" nil)
95 ("=" "\\texttt{%s}" nil)) 152 ("=" "\\texttt{%s}" nil)
153 ("~" "\\texttt{%s}" t))
96 "Alist of LaTeX expressions to convert emphasis fontifiers. 154 "Alist of LaTeX expressions to convert emphasis fontifiers.
97Each element of the list is a list of three elements. 155Each element of the list is a list of three elements.
98The first element is the character used as a marker for fontification. 156The first element is the character used as a marker for fontification.
@@ -102,15 +160,6 @@ conversions."
102 :group 'org-export-latex 160 :group 'org-export-latex
103 :type 'alist) 161 :type 'alist)
104 162
105(defcustom org-export-latex-preamble
106 "\\documentclass[11pt,a4paper]{article}
107\\usepackage[utf8]{inputenc}
108\\usepackage[T1]{fontenc}
109\\usepackage{hyperref}"
110 "Preamble to be inserted at the very beginning of the LaTeX export."
111 :group 'org-export-latex
112 :type 'string)
113
114(defcustom org-export-latex-title-command "\\maketitle" 163(defcustom org-export-latex-title-command "\\maketitle"
115 "The command used to insert the title just after \\begin{document}. 164 "The command used to insert the title just after \\begin{document}.
116If this string contains the formatting specification \"%s\" then 165If this string contains the formatting specification \"%s\" then
@@ -119,7 +168,7 @@ argument."
119 :group 'org-export-latex 168 :group 'org-export-latex
120 :type 'string) 169 :type 'string)
121 170
122(defcustom org-export-latex-date-format 171(defcustom org-export-latex-date-format
123 "%d %B %Y" 172 "%d %B %Y"
124 "Format string for \\date{...}." 173 "Format string for \\date{...}."
125 :group 'org-export-latex 174 :group 'org-export-latex
@@ -130,14 +179,15 @@ argument."
130 :group 'org-export-latex 179 :group 'org-export-latex
131 :type 'boolean) 180 :type 'boolean)
132 181
133(defcustom org-export-latex-packages-alist nil 182(defcustom org-export-latex-tables-column-borders nil
134 "Alist of packages to be inserted in the preamble. 183 "When non-nil, group of columns are surrounded with borders,
135Each cell is of the forma \( option . package \). 184XSeven if these borders are the outside borders of the table."
136 185 :group 'org-export-latex
137For example: 186 :type 'boolean)
138 187
139\(setq org-export-latex-packages-alist 188(defcustom org-export-latex-packages-alist nil
140 '((\"french\" \"babel\"))" 189 "Alist of packages to be inserted in the header.
190Each cell is of the forma \( \"option\" . \"package\" \)."
141 :group 'org-export-latex 191 :group 'org-export-latex
142 :type 'alist) 192 :type 'alist)
143 193
@@ -167,17 +217,42 @@ Don't remove the keys, just change their values."
167(defcustom org-export-latex-image-default-option "width=10em" 217(defcustom org-export-latex-image-default-option "width=10em"
168 "Default option for images." 218 "Default option for images."
169 :group 'org-export-latex 219 :group 'org-export-latex
170 :type '(string)) 220 :type 'string)
171 221
172(defcustom org-export-latex-coding-system nil 222(defcustom org-export-latex-coding-system nil
173 "Coding system for the exported LaTex file." 223 "Coding system for the exported LaTex file."
174 :group 'org-export-latex 224 :group 'org-export-latex
175 :type 'coding-system) 225 :type 'coding-system)
176 226
177;; FIXME Do we want this one? 227(defcustom org-list-radio-list-templates
178;; (defun org-export-as-latex-and-open (arg) ...) 228 '((latex-mode "% BEGIN RECEIVE ORGLST %n
229% END RECEIVE ORGLST %n
230\\begin{comment}
231#+ORGLST: SEND %n org-list-to-latex
232| | |
233\\end{comment}\n")
234 (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
235@c END RECEIVE ORGLST %n
236@ignore
237#+ORGLST: SEND %n org-list-to-texinfo
238| | |
239@end ignore\n")
240 (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
241<!-- END RECEIVE ORGLST %n -->
242<!--
243#+ORGLST: SEND %n org-list-to-html
244| | |
245-->\n"))
246 "Templates for radio lists in different major modes.
247All occurrences of %n in a template will be replaced with the name of the
248list, obtained by prompting the user."
249 :group 'org-plain-lists
250 :type '(repeat
251 (list (symbol :tag "Major mode")
252 (string :tag "Format"))))
179 253
180;;; Autoload functions: 254;;; Autoload functions:
255
181;;;###autoload 256;;;###autoload
182(defun org-export-as-latex-batch () 257(defun org-export-as-latex-batch ()
183 "Call `org-export-as-latex', may be used in batch processing as 258 "Call `org-export-as-latex', may be used in batch processing as
@@ -199,7 +274,7 @@ No file is created. The prefix ARG is passed through to `org-export-as-latex'."
199(defun org-replace-region-by-latex (beg end) 274(defun org-replace-region-by-latex (beg end)
200 "Replace the region from BEG to END with its LaTeX export. 275 "Replace the region from BEG to END with its LaTeX export.
201It assumes the region has `org-mode' syntax, and then convert it to 276It assumes the region has `org-mode' syntax, and then convert it to
202LaTeX. This can be used in any buffer. For example, you could 277LaTeX. This can be used in any buffer. For example, you could
203write an itemized list in `org-mode' syntax in an LaTeX buffer and 278write an itemized list in `org-mode' syntax in an LaTeX buffer and
204then use this command to convert it." 279then use this command to convert it."
205 (interactive "r") 280 (interactive "r")
@@ -255,7 +330,21 @@ in a window. A non-interactive call will only retunr the buffer."
255;;;###autoload 330;;;###autoload
256(defun org-export-as-latex (arg &optional hidden ext-plist 331(defun org-export-as-latex (arg &optional hidden ext-plist
257 to-buffer body-only) 332 to-buffer body-only)
258 "Export current buffer to a LaTeX file." 333 "Export current buffer to a LaTeX file.
334If there is an active region, export only the region. The prefix
335ARG specifies how many levels of the outline should become
336headlines. The default is 3. Lower levels will be exported
337depending on `org-export-latex-low-levels'. The default is to
338convert them as description lists. When HIDDEN is non-nil, don't
339display the LaTeX buffer. EXT-PLIST is a property list with
340external parameters overriding org-mode's default settings, but
341still inferior to file-local settings. When TO-BUFFER is
342non-nil, create a buffer with that name and export to that
343buffer. If TO-BUFFER is the symbol `string', don't leave any
344buffer behind but just return the resulting LaTeX as a string.
345When BODY-ONLY is set, don't produce the file header and footer,
346simply return the content of \begin{document}...\end{document},
347without even the \begin{document} and \end{document} commands."
259 (interactive "P") 348 (interactive "P")
260 ;; Make sure we have a file name when we need it. 349 ;; Make sure we have a file name when we need it.
261 (when (and (not (or to-buffer body-only)) 350 (when (and (not (or to-buffer body-only))
@@ -268,9 +357,23 @@ in a window. A non-interactive call will only retunr the buffer."
268 357
269 (message "Exporting to LaTeX...") 358 (message "Exporting to LaTeX...")
270 (org-update-radio-target-regexp) 359 (org-update-radio-target-regexp)
271 (org-export-latex-set-initial-vars ext-plist) 360 (org-export-latex-set-initial-vars ext-plist arg)
272 (let* ((wcf (current-window-configuration)) 361 (let* ((wcf (current-window-configuration))
273 (opt-plist org-latex-options-plist) 362 (opt-plist org-export-latex-options-plist)
363 (region-p (org-region-active-p))
364 (subtree-p
365 (when region-p
366 (save-excursion
367 (goto-char (region-beginning))
368 (and (org-at-heading-p)
369 (>= (org-end-of-subtree t t) (region-end))))))
370 (title (or (and subtree-p (org-export-get-title-from-subtree))
371 (plist-get opt-plist :title)
372 (and (not
373 (plist-get opt-plist :skip-before-1st-heading))
374 (org-export-grab-title-from-buffer))
375 (file-name-sans-extension
376 (file-name-nondirectory buffer-file-name))))
274 (filename (concat (file-name-as-directory 377 (filename (concat (file-name-as-directory
275 (org-export-directory :LaTeX ext-plist)) 378 (org-export-directory :LaTeX ext-plist))
276 (file-name-sans-extension 379 (file-name-sans-extension
@@ -286,10 +389,11 @@ in a window. A non-interactive call will only retunr the buffer."
286 "*Org LaTeX Export*")) 389 "*Org LaTeX Export*"))
287 (t (get-buffer-create to-buffer))) 390 (t (get-buffer-create to-buffer)))
288 (find-file-noselect filename))) 391 (find-file-noselect filename)))
289 (region-p (org-region-active-p))
290 (odd org-odd-levels-only) 392 (odd org-odd-levels-only)
291 (preamble (org-export-latex-make-preamble opt-plist)) 393 (header (org-export-latex-make-header title opt-plist))
292 (skip (plist-get opt-plist :skip-before-1st-heading)) 394 (skip (if subtree-p nil
395 ;; never skip first lines when exporting a subtree
396 (plist-get opt-plist :skip-before-1st-heading)))
293 (text (plist-get opt-plist :text)) 397 (text (plist-get opt-plist :text))
294 (first-lines (if skip "" (org-export-latex-first-lines))) 398 (first-lines (if skip "" (org-export-latex-first-lines)))
295 (coding-system (and (boundp 'buffer-file-coding-system) 399 (coding-system (and (boundp 'buffer-file-coding-system)
@@ -310,19 +414,21 @@ in a window. A non-interactive call will only retunr the buffer."
310 :skip-before-1st-heading skip 414 :skip-before-1st-heading skip
311 :LaTeX-fragments nil))) 415 :LaTeX-fragments nil)))
312 416
313 (set-buffer buffer) 417 (set-buffer buffer)
314 (erase-buffer) 418 (erase-buffer)
315 419
316 (and (fboundp 'set-buffer-file-coding-system) 420 (and (fboundp 'set-buffer-file-coding-system)
317 (set-buffer-file-coding-system coding-system-for-write)) 421 (set-buffer-file-coding-system coding-system-for-write))
318 422
319 ;; insert the preamble and initial document commands 423 ;; insert the header and initial document commands
320 (unless (or (eq to-buffer 'string) body-only) 424 (unless (or (eq to-buffer 'string) body-only)
321 (insert preamble)) 425 (insert header))
322 426
323 ;; insert text found in #+TEXT 427 ;; insert text found in #+TEXT
324 (when (and text (not (eq to-buffer 'string))) 428 (when (and text (not (eq to-buffer 'string)))
325 (insert (org-export-latex-content text) "\n\n")) 429 (insert (org-export-latex-content
430 text '(lists tables fixed-width keywords))
431 "\n\n"))
326 432
327 ;; insert lines before the first headline 433 ;; insert lines before the first headline
328 (unless (or skip (eq to-buffer 'string)) 434 (unless (or skip (eq to-buffer 'string))
@@ -342,7 +448,7 @@ in a window. A non-interactive call will only retunr the buffer."
342 (when (re-search-forward "^\\(\\*+\\) " nil t) 448 (when (re-search-forward "^\\(\\*+\\) " nil t)
343 (let* ((asters (length (match-string 1))) 449 (let* ((asters (length (match-string 1)))
344 (level (if odd (- asters 2) (- asters 1)))) 450 (level (if odd (- asters 2) (- asters 1))))
345 (setq org-latex-add-level 451 (setq org-export-latex-add-level
346 (if odd (1- (/ (1+ asters) 2)) (1- asters))) 452 (if odd (1- (/ (1+ asters) 2)) (1- asters)))
347 (org-export-latex-parse-global level odd))))) 453 (org-export-latex-parse-global level odd)))))
348 454
@@ -358,16 +464,16 @@ in a window. A non-interactive call will only retunr the buffer."
358 (current-buffer)) 464 (current-buffer))
359 (set-window-configuration wcf)))) 465 (set-window-configuration wcf))))
360 466
361
362;;; Parsing functions: 467;;; Parsing functions:
468
363(defun org-export-latex-parse-global (level odd) 469(defun org-export-latex-parse-global (level odd)
364 "Parse the current buffer recursively, starting at LEVEL. 470 "Parse the current buffer recursively, starting at LEVEL.
365If ODD is non-nil, assume the buffer only contains odd sections. 471If ODD is non-nil, assume the buffer only contains odd sections.
366Return A list reflecting the document structure." 472Return a list reflecting the document structure."
367 (save-excursion 473 (save-excursion
368 (goto-char (point-min)) 474 (goto-char (point-min))
369 (let* ((cnt 0) output 475 (let* ((cnt 0) output
370 (depth org-latex-sectioning-depth)) 476 (depth org-export-latex-sectioning-depth))
371 (while (re-search-forward 477 (while (re-search-forward
372 (concat "^\\(\\(?:\\*\\)\\{" 478 (concat "^\\(\\(?:\\*\\)\\{"
373 (number-to-string (+ (if odd 2 1) level)) 479 (number-to-string (+ (if odd 2 1) level))
@@ -404,57 +510,11 @@ Return A list reflecting the document structure."
404 `(occur . ,cnt) 510 `(occur . ,cnt)
405 `(heading . ,heading) 511 `(heading . ,heading)
406 `(content . ,(org-export-latex-parse-content)) 512 `(content . ,(org-export-latex-parse-content))
407 `(subcontent . ,(org-export-latex-parse-subcontent 513 `(subcontent . ,(org-export-latex-parse-subcontent
408 level odd))))))) 514 level odd)))))))
409 (widen))) 515 (widen)))
410 (list output)))) 516 (list output))))
411 517
412(defun org-export-latex-parse-list (&optional delete)
413 "Parse the list at point.
414Return a list containing first level items as strings and
415sublevels as list of strings."
416 (let ((start (point))
417 ;; Find the end of the list
418 (end (save-excursion
419 (catch 'exit
420 (while (or (looking-at org-export-latex-list-beginning-re)
421 (looking-at "^[ \t]+\\|^$"))
422 (if (eq (point) (point-max))
423 (throw 'exit (point-max)))
424 (forward-line 1))) (point)))
425 output itemsep)
426 (while (re-search-forward org-export-latex-list-beginning-re end t)
427 (setq itemsep (if (save-match-data
428 (string-match "^[0-9]" (match-string 2)))
429 "[0-9]+\\(?:\\.\\|)\\)" "[-+]"))
430 (let* ((indent1 (match-string 1))
431 (nextitem (save-excursion
432 (save-match-data
433 (or (and (re-search-forward
434 (concat "^" indent1 itemsep " *?") end t)
435 (match-beginning 0)) end))))
436 (item (buffer-substring
437 (point)
438 (or (and (re-search-forward
439 org-export-latex-list-beginning-re end t)
440 (goto-char (match-beginning 0)))
441 (goto-char end))))
442 (nextindent (match-string 1))
443 (item (org-trim item))
444 (item (if (string-match "^\\[.+\\]" item)
445 (replace-match "\\\\texttt{\\&}"
446 t nil item) item)))
447 (push item output)
448 (when (> (length nextindent)
449 (length indent1))
450 (narrow-to-region (point) nextitem)
451 (push (org-export-latex-parse-list) output)
452 (widen))))
453 (when delete (delete-region start end))
454 (setq output (nreverse output))
455 (push (if (string-match "^\\[0" itemsep)
456 'ordered 'unordered) output)))
457
458(defun org-export-latex-parse-content () 518(defun org-export-latex-parse-content ()
459 "Extract the content of a section." 519 "Extract the content of a section."
460 (let ((beg (point)) 520 (let ((beg (point))
@@ -487,7 +547,7 @@ CONTENT is an element of the list produced by
487 "Export the list SUBCONTENT to LaTeX. 547 "Export the list SUBCONTENT to LaTeX.
488SUBCONTENT is an alist containing information about the headline 548SUBCONTENT is an alist containing information about the headline
489and its content." 549and its content."
490 (let ((num (plist-get org-latex-options-plist :section-numbers))) 550 (let ((num (plist-get org-export-latex-options-plist :section-numbers)))
491 (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) 551 (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent)))
492 552
493(defun org-export-latex-subcontent (subcontent num) 553(defun org-export-latex-subcontent (subcontent num)
@@ -495,20 +555,20 @@ and its content."
495 (let ((heading (org-export-latex-fontify-headline 555 (let ((heading (org-export-latex-fontify-headline
496 (cdr (assoc 'heading subcontent)))) 556 (cdr (assoc 'heading subcontent))))
497 (level (- (cdr (assoc 'level subcontent)) 557 (level (- (cdr (assoc 'level subcontent))
498 org-latex-add-level)) 558 org-export-latex-add-level))
499 (occur (number-to-string (cdr (assoc 'occur subcontent)))) 559 (occur (number-to-string (cdr (assoc 'occur subcontent))))
500 (content (cdr (assoc 'content subcontent))) 560 (content (cdr (assoc 'content subcontent)))
501 (subcontent (cadr (assoc 'subcontent subcontent)))) 561 (subcontent (cadr (assoc 'subcontent subcontent))))
502 (cond 562 (cond
503 ;; Normal conversion 563 ;; Normal conversion
504 ((<= level org-latex-sectioning-depth) 564 ((<= level org-export-latex-sectioning-depth)
505 (let ((sec (assoc level org-export-latex-sectioning-alist))) 565 (let ((sec (nth (1- level) org-export-latex-sectioning)))
506 (insert (format (if num (cadr sec) (caddr sec)) heading) "\n")) 566 (insert (format (if num (car sec) (cdr sec)) heading) "\n"))
507 (insert (org-export-latex-content content)) 567 (insert (org-export-latex-content content))
508 (cond ((stringp subcontent) (insert subcontent)) 568 (cond ((stringp subcontent) (insert subcontent))
509 ((listp subcontent) (org-export-latex-sub subcontent)))) 569 ((listp subcontent) (org-export-latex-sub subcontent))))
510 ;; At a level under the hl option: we can drop this subsection 570 ;; At a level under the hl option: we can drop this subsection
511 ((> level org-latex-sectioning-depth) 571 ((> level org-export-latex-sectioning-depth)
512 (cond ((eq org-export-latex-low-levels 'description) 572 (cond ((eq org-export-latex-low-levels 'description)
513 (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading)) 573 (insert (format "\\begin{description}\n\n\\item[%s]\n\n" heading))
514 (insert (org-export-latex-content content)) 574 (insert (org-export-latex-content content))
@@ -521,52 +581,47 @@ and its content."
521 (cond ((stringp subcontent) (insert subcontent)) 581 (cond ((stringp subcontent) (insert subcontent))
522 ((listp subcontent) (org-export-latex-sub subcontent))))))))) 582 ((listp subcontent) (org-export-latex-sub subcontent)))))))))
523 583
524
525;;; Exporting internals: 584;;; Exporting internals:
526(defun org-export-latex-protect-string (string) 585(defun org-export-latex-set-initial-vars (ext-plist level)
527 "Prevent further conversion for STRING by adding the
528org-protect property."
529 (add-text-properties
530 0 (length string) '(org-protected t) string) string)
531
532(defun org-export-latex-protect-char-in-string (char-list string)
533 "Add org-protected text-property to char from CHAR-LIST in STRING."
534 (with-temp-buffer
535 (save-match-data
536 (insert string)
537 (goto-char (point-min))
538 (while (re-search-forward (regexp-opt char-list) nil t)
539 (add-text-properties (match-beginning 0)
540 (match-end 0) '(org-protected t)))
541 (buffer-string))))
542
543(defun org-export-latex-set-initial-vars (ext-plist)
544 "Store org local variables required for LaTeX export. 586 "Store org local variables required for LaTeX export.
545EXT-PLIST is an optional additional plist." 587EXT-PLIST is an optional additional plist.
546 (setq org-latex-todo-keywords-1 org-todo-keywords-1 588LEVEL indicates the default depth for export."
547 org-latex-all-targets-regexp 589 (setq org-export-latex-todo-keywords-1 org-todo-keywords-1
590 org-export-latex-all-targets-re
548 (org-make-target-link-regexp (org-all-targets)) 591 (org-make-target-link-regexp (org-all-targets))
549 org-latex-options-plist 592 org-export-latex-options-plist
550 (org-combine-plists (org-default-export-plist) ext-plist 593 (org-combine-plists (org-default-export-plist) ext-plist
551 (org-infile-export-plist)) 594 (org-infile-export-plist))
552 org-latex-sectioning-depth 595 org-export-latex-class
553 (let ((hl-levels (plist-get org-latex-options-plist :headline-levels)) 596 (save-excursion
554 (sec-depth (length org-export-latex-sectioning-alist))) 597 (goto-char (point-min))
555 ;; Fall back on org-export-latex-sectioning-alist length if 598 (if (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([a-zA-Z]+\\)" nil t)
556 ;; headline-levels goes beyond it 599 (assoc (match-string 1) org-export-latex-classes))
557 (if (> hl-levels sec-depth) sec-depth hl-levels)))) 600 (match-string 1)
558 601 org-export-latex-default-class))
559(defun org-export-latex-make-preamble (opt-plist) 602 org-export-latex-header
560 "Make the LaTeX preamble and return it as a string. 603 (cadr (assoc org-export-latex-class org-export-latex-classes))
561Argument OPT-PLIST is the options plist for current buffer." 604 org-export-latex-sectioning
562 (let ((toc (plist-get opt-plist :table-of-contents))) 605 (cddr (assoc org-export-latex-class org-export-latex-classes))
563 (concat 606 org-export-latex-sectioning-depth
607 (or level
608 (let ((hl-levels
609 (plist-get org-export-latex-options-plist :headline-levels))
610 (sec-depth (length org-export-latex-sectioning)))
611 (if (> hl-levels sec-depth) sec-depth hl-levels)))))
612
613(defun org-export-latex-make-header (title opt-plist)
614 "Make the LaTeX header and return it as a string.
615TITLE is the current title from the buffer or region.
616OPT-PLIST is the options plist for current buffer."
617 (let ((toc (plist-get opt-plist :table-of-contents))
618 (author (plist-get opt-plist :author)))
619 (concat
564 (if (plist-get opt-plist :time-stamp-file) 620 (if (plist-get opt-plist :time-stamp-file)
565 (format-time-string "% Created %Y-%m-%d %a %H:%M\n")) 621 (format-time-string "% Created %Y-%m-%d %a %H:%M\n"))
566 622 ;; insert LaTeX custom header
567 ;; insert LaTeX custom preamble 623 org-export-latex-header
568 org-export-latex-preamble "\n" 624 "\n"
569
570 ;; insert information on LaTeX packages 625 ;; insert information on LaTeX packages
571 (when org-export-latex-packages-alist 626 (when org-export-latex-packages-alist
572 (mapconcat (lambda(p) 627 (mapconcat (lambda(p)
@@ -575,46 +630,34 @@ Argument OPT-PLIST is the options plist for current buffer."
575 (format "\\usepackage[%s]{%s}" 630 (format "\\usepackage[%s]{%s}"
576 (car p) (cadr p)))) 631 (car p) (cadr p))))
577 org-export-latex-packages-alist "\n")) 632 org-export-latex-packages-alist "\n"))
578 633 ;; insert additional commands in the header
634 org-export-latex-append-header
579 ;; insert the title 635 ;; insert the title
580 (format 636 (format
581 "\\title{%s}\n" 637 "\n\n\\title{%s}\n"
582 ;; convert the title 638 ;; convert the title
583 (org-export-latex-content 639 (org-export-latex-content
584 (or (plist-get opt-plist :title) 640 title '(lists tables fixed-width keywords)))
585 (and (not
586 (plist-get opt-plist :skip-before-1st-heading))
587 (org-export-grab-title-from-buffer))
588 (and buffer-file-name
589 (file-name-sans-extension
590 (file-name-nondirectory buffer-file-name)))
591 "UNTITLED")))
592
593 ;; insert author info 641 ;; insert author info
594 (if (plist-get opt-plist :author-info) 642 (if (plist-get opt-plist :author-info)
595 (format "\\author{%s}\n" 643 (format "\\author{%s}\n"
596 (or (plist-get opt-plist :author) user-full-name)) 644 (or author user-full-name))
597 (format "%%\\author{%s}\n" 645 (format "%%\\author{%s}\n"
598 (or (plist-get opt-plist :author) user-full-name))) 646 (or author user-full-name)))
599
600 ;; insert the date 647 ;; insert the date
601 (format "\\date{%s}\n" 648 (format "\\date{%s}\n"
602 (format-time-string 649 (format-time-string
603 (or (plist-get opt-plist :date) 650 (or (plist-get opt-plist :date)
604 org-export-latex-date-format))) 651 org-export-latex-date-format)))
605
606 ;; beginning of the document 652 ;; beginning of the document
607 "\n\\begin{document}\n\n" 653 "\n\\begin{document}\n\n"
608
609 ;; insert the title command 654 ;; insert the title command
610 (if (string-match "%s" org-export-latex-title-command) 655 (if (string-match "%s" org-export-latex-title-command)
611 (format org-export-latex-title-command 656 (format org-export-latex-title-command title)
612 (plist-get opt-plist :title))
613 org-export-latex-title-command) 657 org-export-latex-title-command)
614 "\n\n" 658 "\n\n"
615
616 ;; table of contents 659 ;; table of contents
617 (when (and org-export-with-toc 660 (when (and org-export-with-toc
618 (plist-get opt-plist :section-numbers)) 661 (plist-get opt-plist :section-numbers))
619 (cond ((numberp toc) 662 (cond ((numberp toc)
620 (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n" 663 (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\n"
@@ -628,8 +671,9 @@ COMMENTS is either nil to replace them with the empty string or a
628formatting string like %%%%s if we want to comment them out." 671formatting string like %%%%s if we want to comment them out."
629 (save-excursion 672 (save-excursion
630 (goto-char (point-min)) 673 (goto-char (point-min))
674 (if (org-at-heading-p) (beginning-of-line 2))
631 (let* ((pt (point)) 675 (let* ((pt (point))
632 (end (if (and (re-search-forward "^\\*" nil t) 676 (end (if (and (re-search-forward "^\\* " nil t)
633 (not (eq pt (match-beginning 0)))) 677 (not (eq pt (match-beginning 0))))
634 (goto-char (match-beginning 0)) 678 (goto-char (match-beginning 0))
635 (goto-char (point-max))))) 679 (goto-char (point-max)))))
@@ -643,10 +687,58 @@ formatting string like %%%%s if we want to comment them out."
643 :skip-before-1st-heading nil 687 :skip-before-1st-heading nil
644 :LaTeX-fragments nil))))) 688 :LaTeX-fragments nil)))))
645 689
690(defun org-export-latex-content (content &optional exclude-list)
691 "Convert CONTENT string to LaTeX.
692Don't perform conversions that are in EXCLUDE-LIST. Recognized
693conversion types are: quotation-marks, emphasis, sub-superscript,
694links, keywords, lists, tables, fixed-width"
695 (with-temp-buffer
696 (insert content)
697 (unless (memq 'quotation-marks exclude-list)
698 (org-export-latex-quotation-marks))
699 (unless (memq 'emphasis exclude-list)
700 (when (plist-get org-export-latex-options-plist :emphasize)
701 (org-export-latex-fontify)))
702 (unless (memq 'sub-superscript exclude-list)
703 (org-export-latex-special-chars
704 (plist-get org-export-latex-options-plist :sub-superscript)))
705 (unless (memq 'links exclude-list)
706 (org-export-latex-links))
707 (unless (memq 'keywords exclude-list)
708 (org-export-latex-keywords
709 (plist-get org-export-latex-options-plist :timestamps)))
710 (unless (memq 'lists exclude-list)
711 (org-export-latex-lists))
712 (unless (memq 'tables exclude-list)
713 (org-export-latex-tables
714 (plist-get org-export-latex-options-plist :tables)))
715 (unless (memq 'fixed-width exclude-list)
716 (org-export-latex-fixed-width
717 (plist-get org-export-latex-options-plist :fixed-width)))
718 ;; return string
719 (buffer-substring (point-min) (point-max))))
720
721(defun org-export-latex-protect-string (s)
722 "Prevent further conversion for string S by adding the
723org-protect property."
724 (add-text-properties 0 (length s) '(org-protected t) s) s)
725
726(defun org-export-latex-protect-char-in-string (char-list string)
727 "Add org-protected text-property to char from CHAR-LIST in STRING."
728 (with-temp-buffer
729 (save-match-data
730 (insert string)
731 (goto-char (point-min))
732 (while (re-search-forward (regexp-opt char-list) nil t)
733 (add-text-properties (match-beginning 0)
734 (match-end 0) '(org-protected t)))
735 (buffer-string))))
736
646(defun org-export-latex-keywords-maybe (remove-list) 737(defun org-export-latex-keywords-maybe (remove-list)
647 "Maybe remove keywords depending on rules in REMOVE-LIST." 738 "Maybe remove keywords depending on rules in REMOVE-LIST."
648 (goto-char (point-min)) 739 (goto-char (point-min))
649 (let ((re-todo (mapconcat 'identity org-latex-todo-keywords-1 "\\|"))) 740 (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|"))
741 (case-fold-search nil))
650 ;; convert TODO keywords 742 ;; convert TODO keywords
651 (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) 743 (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t)
652 (if (plist-get remove-list :todo) 744 (if (plist-get remove-list :todo)
@@ -664,48 +756,25 @@ formatting string like %%%%s if we want to comment them out."
664 (replace-match "") 756 (replace-match "")
665 (replace-match (format "\\texttt{%s}" (match-string 0)) t t))))) 757 (replace-match (format "\\texttt{%s}" (match-string 0)) t t)))))
666 758
667(defun org-export-latex-fontify-headline (headline) 759(defun org-export-latex-fontify-headline (string)
668 "Fontify special words in a HEADLINE." 760 "Fontify special words in string."
669 (with-temp-buffer 761 (with-temp-buffer
670 ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at 762 ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at
671 ;; the beginning of the buffer - inserting "\n" is safe here though. 763 ;; the beginning of the buffer - inserting "\n" is safe here though.
672 (insert "\n" headline) 764 (insert "\n" string)
673 (goto-char (point-min)) 765 (goto-char (point-min))
674 (when (plist-get org-latex-options-plist :emphasize) 766 (when (plist-get org-export-latex-options-plist :emphasize)
675 (org-export-latex-fontify)) 767 (org-export-latex-fontify))
676 (org-export-latex-special-chars 768 (org-export-latex-special-chars
677 (plist-get org-latex-options-plist :sub-superscript)) 769 (plist-get org-export-latex-options-plist :sub-superscript))
678 (org-export-latex-keywords-maybe 770 (org-export-latex-keywords-maybe
679 org-export-latex-remove-from-headlines) 771 org-export-latex-remove-from-headlines)
680 (org-export-latex-links) 772 (org-export-latex-links)
681 (org-trim (buffer-substring-no-properties (point-min) (point-max))))) 773 (org-trim (buffer-substring-no-properties (point-min) (point-max)))))
682 774
683(defun org-export-latex-content (content)
684 "Convert CONTENT string to LaTeX."
685 (with-temp-buffer
686 (insert content)
687 (org-export-latex-quotation-marks)
688 (when (plist-get org-latex-options-plist :emphasize)
689 (org-export-latex-fontify))
690 (org-export-latex-special-chars
691 (plist-get org-latex-options-plist :sub-superscript))
692 (org-export-latex-links)
693 (org-export-latex-keywords
694 (plist-get org-latex-options-plist :timestamps))
695 (org-export-latex-lists)
696 (org-export-latex-tables
697 (plist-get org-latex-options-plist :tables))
698 (org-export-latex-fixed-width
699 (plist-get org-latex-options-plist :fixed-width))
700 ;; return string
701 (buffer-substring (point-min) (point-max))))
702
703(defun org-export-latex-quotation-marks () 775(defun org-export-latex-quotation-marks ()
704 "Export question marks depending on language conventions. 776 "Export question marks depending on language conventions."
705Local definition of the language overrides 777 (let* ((lang (plist-get org-export-latex-options-plist :language))
706`org-export-latex-quotation-marks-convention' which overrides
707`org-export-default-language'."
708 (let* ((lang (plist-get org-latex-options-plist :language))
709 (quote-rpl (if (equal lang "fr") 778 (quote-rpl (if (equal lang "fr")
710 '(("\\(\\s-\\)\"" "«~") 779 '(("\\(\\s-\\)\"" "«~")
711 ("\\(\\S-\\)\"" "~»") 780 ("\\(\\S-\\)\"" "~»")
@@ -720,21 +789,6 @@ Local definition of the language overrides
720 (org-if-unprotected 789 (org-if-unprotected
721 (replace-match rpl t t))))) quote-rpl))) 790 (replace-match rpl t t))))) quote-rpl)))
722 791
723;; | chars/string in Org | normal environment | math environment |
724;; |-----------------------+-----------------------+-----------------------|
725;; | & # % $ | \& \# \% \$ | \& \# \% \$ |
726;; | { } _ ^ \ | \{ \} \_ \^ \\ | { } _ ^ \ |
727;; |-----------------------+-----------------------+-----------------------|
728;; | a_b and a^b | $a_b$ and $a^b$ | a_b and a^b |
729;; | a_abc and a_{abc} | $a_a$bc and $a_{abc}$ | a_abc and a_{abc} |
730;; | \tau and \mu | $\tau$ and $\mu$ | \tau and \mu |
731;; |-----------------------+-----------------------+-----------------------|
732;; | \_ \^ | \_ \^ | \_ \^ |
733;; | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) | \(a=\mu\mbox{m}\) |
734;; | \[\beta^2-a=0\] | \[\beta^2-a=0\] | \[\beta^2-a=0\] |
735;; | $x=22\tau$ | $x=22\tau$ | $x=22\tau$ |
736;; | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ | $$\alpha=\sqrt{a^3}$$ |
737
738(defun org-export-latex-special-chars (sub-superscript) 792(defun org-export-latex-special-chars (sub-superscript)
739 "Export special characters to LaTeX. 793 "Export special characters to LaTeX.
740If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. 794If SUB-SUPERSCRIPT is non-nil, convert \\ and ^.
@@ -744,7 +798,8 @@ See the `org-export-latex.el' code for a complete conversion table."
744 (goto-char (point-min)) 798 (goto-char (point-min))
745 (while (re-search-forward c nil t) 799 (while (re-search-forward c nil t)
746 ;; Put the point where to check for org-protected 800 ;; Put the point where to check for org-protected
747 (unless (get-text-property (match-beginning 2) 'org-protected) 801 (unless (or (get-text-property (match-beginning 2) 'org-protected)
802 (org-at-table-p))
748 (cond ((member (match-string 2) '("\\$" "$")) 803 (cond ((member (match-string 2) '("\\$" "$"))
749 (if (equal (match-string 2) "\\$") 804 (if (equal (match-string 2) "\\$")
750 (replace-match (concat (match-string 1) "$" 805 (replace-match (concat (match-string 1) "$"
@@ -756,11 +811,15 @@ See the `org-export-latex.el' code for a complete conversion table."
756 (replace-match (match-string 2) t t) 811 (replace-match (match-string 2) t t)
757 (replace-match (concat (match-string 1) "\\" 812 (replace-match (concat (match-string 1) "\\"
758 (match-string 2)) t t))) 813 (match-string 2)) t t)))
814 ((equal (match-string 2) "...")
815 (replace-match
816 (concat (match-string 1)
817 (org-export-latex-protect-string "\\ldots{}")) t t))
759 ((equal (match-string 2) "~") 818 ((equal (match-string 2) "~")
760 (cond ((equal (match-string 1) "\\") nil) 819 (cond ((equal (match-string 1) "\\") nil)
761 ((eq 'org-link (get-text-property 0 'face (match-string 2))) 820 ((eq 'org-link (get-text-property 0 'face (match-string 2)))
762 (replace-match (concat (match-string 1) "\\~") t t)) 821 (replace-match (concat (match-string 1) "\\~") t t))
763 (t (replace-match 822 (t (replace-match
764 (org-export-latex-protect-string 823 (org-export-latex-protect-string
765 (concat (match-string 1) "\\~{}")) t t)))) 824 (concat (match-string 1) "\\~{}")) t t))))
766 ((member (match-string 2) '("{" "}")) 825 ((member (match-string 2) '("{" "}"))
@@ -791,6 +850,7 @@ See the `org-export-latex.el' code for a complete conversion table."
791 "\\(.\\|^\\)\\({\\)" 850 "\\(.\\|^\\)\\({\\)"
792 "\\(.\\|^\\)\\(}\\)" 851 "\\(.\\|^\\)\\(}\\)"
793 "\\(.\\|^\\)\\(~\\)" 852 "\\(.\\|^\\)\\(~\\)"
853 "\\(.\\|^\\)\\(\\.\\.\\.\\)"
794 ;; (?\< . "\\textless{}") 854 ;; (?\< . "\\textless{}")
795 ;; (?\> . "\\textgreater{}") 855 ;; (?\> . "\\textgreater{}")
796 ))) 856 )))
@@ -812,7 +872,7 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER."
812 (cond ((eq 1 (length string-after)) 872 (cond ((eq 1 (length string-after))
813 (concat string-before char string-after)) 873 (concat string-before char string-after))
814 ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) 874 ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after)
815 (format "%s%s{%s}" string-before char 875 (format "%s%s{%s}" string-before char
816 (match-string 1 string-after)))))) 876 (match-string 1 string-after))))))
817 ((and subsup 877 ((and subsup
818 (> (length string-after) 1) 878 (> (length string-after) 1)
@@ -842,7 +902,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
842 (string-match "^[ \t\n]" string-after))) 902 (string-match "^[ \t\n]" string-after)))
843 ;; backslash might escape a character (like \#) or a user TeX 903 ;; backslash might escape a character (like \#) or a user TeX
844 ;; macro (like \setcounter) 904 ;; macro (like \setcounter)
845 (org-export-latex-protect-string 905 (org-export-latex-protect-string
846 (concat string-before "\\" string-after))) 906 (concat string-before "\\" string-after)))
847 ((and (string-match "^[ \t\n]" string-after) 907 ((and (string-match "^[ \t\n]" string-after)
848 (string-match "[ \t\n]\\'" string-before)) 908 (string-match "[ \t\n]\\'" string-before))
@@ -854,19 +914,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
854 914
855(defun org-export-latex-keywords (timestamps) 915(defun org-export-latex-keywords (timestamps)
856 "Convert special keywords to LaTeX. 916 "Convert special keywords to LaTeX.
857Regexps are those from `org-latex-special-string-regexps'." 917Regexps are those from `org-export-latex-special-string-regexps'."
858 (let ((rg org-latex-special-string-regexps) r) 918 (let ((rg org-export-latex-special-string-regexps) r)
859 (while (setq r (pop rg)) 919 (while (setq r (pop rg))
860 (goto-char (point-min)) 920 (goto-char (point-min))
861 (while (re-search-forward (eval r) nil t) 921 (while (re-search-forward (eval r) nil t)
862 (if (not timestamps) 922 (if (not timestamps)
863 (replace-match (format "\\\\texttt{%s}" (match-string 0)) t) 923 (replace-match (format "\\\\texttt{%s}" (match-string 0)) t)
864 (replace-match "")))))) 924 (replace-match ""))))))
865 925
866(defun org-export-latex-fixed-width (opt) 926(defun org-export-latex-fixed-width (opt)
867 "When OPT is non-nil convert fixed-width sections to LaTeX." 927 "When OPT is non-nil convert fixed-width sections to LaTeX."
868 (goto-char (point-min)) 928 (goto-char (point-min))
869 ;; FIXME the search shouldn't be performed on already converted text
870 (while (re-search-forward "^[ \t]*:" nil t) 929 (while (re-search-forward "^[ \t]*:" nil t)
871 (if opt 930 (if opt
872 (progn (goto-char (match-beginning 0)) 931 (progn (goto-char (match-beginning 0))
@@ -882,73 +941,6 @@ Regexps are those from `org-latex-special-string-regexps'."
882 (match-string 2)) t t) 941 (match-string 2)) t t)
883 (forward-line)))))) 942 (forward-line))))))
884 943
885(defun org-export-latex-lists ()
886 "Convert lists to LaTeX."
887 (goto-char (point-min))
888 (while (re-search-forward org-export-latex-list-beginning-re nil t)
889 (beginning-of-line)
890 (org-export-list-to-latex
891 (org-export-latex-parse-list t))))
892
893(defun org-export-list-to-generic (list params)
894 "Convert a LIST parsed through `org-export-latex-parse-list' to other formats.
895
896Valid parameters are
897
898:ustart String to start an unordered list
899:uend String to end an unordered list
900
901:ostart String to start an ordered list
902:oend String to end an ordered list
903
904:splice When set to t, return only list body lines, don't wrap
905 them into :[u/o]start and :[u/o]end. Default is nil.
906
907:istart String to start a list item
908:iend String to end a list item
909:isep String to separate items
910:lsep String to separate sublists"
911 (interactive)
912 (let* ((p params) sublist
913 (splicep (plist-get p :splice))
914 (ostart (plist-get p :ostart))
915 (oend (plist-get p :oend))
916 (ustart (plist-get p :ustart))
917 (uend (plist-get p :uend))
918 (istart (plist-get p :istart))
919 (iend (plist-get p :iend))
920 (isep (plist-get p :isep))
921 (lsep (plist-get p :lsep)))
922 (let ((wrapper
923 (cond ((eq (car list) 'ordered)
924 (concat ostart "\n%s" oend "\n"))
925 ((eq (car list) 'unordered)
926 (concat ustart "\n%s" uend "\n"))))
927 rtn)
928 (while (setq sublist (pop list))
929 (cond ((symbolp sublist) nil)
930 ((stringp sublist)
931 (setq rtn (concat rtn istart sublist iend isep)))
932 (t
933 (setq rtn (concat rtn ;; previous list
934 lsep ;; list separator
935 (org-export-list-to-generic sublist p)
936 lsep ;; list separator
937 )))))
938 (format wrapper rtn))))
939
940(defun org-export-list-to-latex (list)
941 "Convert LIST into a LaTeX list."
942 (insert
943 (org-export-list-to-generic
944 list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
945 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
946 :istart "\\item " :iend ""
947 :isep "\n" :lsep "\n"))
948 ;; Add a trailing \n after list conversion
949 "\n"))
950
951;; FIXME Use org-export-highlight-first-table-line ?
952(defun org-export-latex-tables (insert) 944(defun org-export-latex-tables (insert)
953 "Convert tables to LaTeX and INSERT it." 945 "Convert tables to LaTeX and INSERT it."
954 (goto-char (point-min)) 946 (goto-char (point-min))
@@ -975,7 +967,7 @@ Valid parameters are
975 (unless (string-match "^[ \t]*|-" line) 967 (unless (string-match "^[ \t]*|-" line)
976 (setq fields (org-split-string line "[ \t]*|[ \t]*")) 968 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
977 (setq fnum (make-vector (length fields) 0)) 969 (setq fnum (make-vector (length fields) 0))
978 (setq line-fmt 970 (setq line-fmt
979 (mapconcat 971 (mapconcat
980 (lambda (x) 972 (lambda (x)
981 (setq gr (pop org-table-colgroup-info)) 973 (setq gr (pop org-table-colgroup-info))
@@ -991,18 +983,21 @@ Valid parameters are
991 (progn (setq colgropen nil) "|") 983 (progn (setq colgropen nil) "|")
992 ""))) 984 "")))
993 fnum "")))) 985 fnum ""))))
986 ;; fix double || in line-fmt
987 (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt))
994 ;; maybe remove the first and last "|" 988 ;; maybe remove the first and last "|"
995 (when (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt) 989 (when (and (not org-export-latex-tables-column-borders)
990 (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt))
996 (setq line-fmt (match-string 2 line-fmt))) 991 (setq line-fmt (match-string 2 line-fmt)))
997 ;; format alignment 992 ;; format alignment
998 (setq align (apply 'format 993 (setq align (apply 'format
999 (cons line-fmt 994 (cons line-fmt
1000 (mapcar (lambda (x) (if x "r" "l")) 995 (mapcar (lambda (x) (if x "r" "l"))
1001 org-table-last-alignment)))) 996 org-table-last-alignment))))
1002 ;; prepare the table to send to orgtbl-to-latex 997 ;; prepare the table to send to orgtbl-to-latex
1003 (setq lines 998 (setq lines
1004 (mapcar 999 (mapcar
1005 (lambda(elem) 1000 (lambda(elem)
1006 (or (and (string-match "[ \t]*|-+" elem) 'hline) 1001 (or (and (string-match "[ \t]*|-+" elem) 'hline)
1007 (split-string (org-trim elem) "|" t))) 1002 (split-string (org-trim elem) "|" t)))
1008 lines)) 1003 lines))
@@ -1016,8 +1011,8 @@ Valid parameters are
1016 (goto-char (point-min)) 1011 (goto-char (point-min))
1017 (while (re-search-forward org-emph-re nil t) 1012 (while (re-search-forward org-emph-re nil t)
1018 ;; The match goes one char after the *string* 1013 ;; The match goes one char after the *string*
1019 (let ((emph (assoc (match-string 3) 1014 (let ((emph (assoc (match-string 3)
1020 org-export-latex-emphasis-alist)) 1015 org-export-latex-emphasis-alist))
1021 rpl) 1016 rpl)
1022 (unless (get-text-property (1- (point)) 'org-protected) 1017 (unless (get-text-property (1- (point)) 'org-protected)
1023 (setq rpl (concat (match-string 1) 1018 (setq rpl (concat (match-string 1)
@@ -1025,7 +1020,7 @@ Valid parameters are
1025 '("\\" "{" "}") (cadr emph)) 1020 '("\\" "{" "}") (cadr emph))
1026 (match-string 4)) 1021 (match-string 4))
1027 (match-string 5))) 1022 (match-string 5)))
1028 (if (caddr emph) 1023 (if (caddr emph)
1029 (setq rpl (org-export-latex-protect-string rpl))) 1024 (setq rpl (org-export-latex-protect-string rpl)))
1030 (replace-match rpl t t))) 1025 (replace-match rpl t t)))
1031 (backward-char))) 1026 (backward-char)))
@@ -1038,7 +1033,7 @@ Valid parameters are
1038 (while (re-search-forward org-bracket-link-analytic-regexp nil t) 1033 (while (re-search-forward org-bracket-link-analytic-regexp nil t)
1039 (org-if-unprotected 1034 (org-if-unprotected
1040 (goto-char (match-beginning 0)) 1035 (goto-char (match-beginning 0))
1041 (let* ((re-radio org-latex-all-targets-regexp) 1036 (let* ((re-radio org-export-latex-all-targets-re)
1042 (remove (list (match-beginning 0) (match-end 0))) 1037 (remove (list (match-beginning 0) (match-end 0)))
1043 (type (match-string 2)) 1038 (type (match-string 2))
1044 (raw-path (match-string 3)) 1039 (raw-path (match-string 3))
@@ -1063,22 +1058,22 @@ Valid parameters are
1063 (if (file-exists-p raw-path) 1058 (if (file-exists-p raw-path)
1064 (concat type "://" (expand-file-name raw-path)) 1059 (concat type "://" (expand-file-name raw-path))
1065 (concat type "://" (org-export-directory 1060 (concat type "://" (org-export-directory
1066 :LaTeX org-latex-options-plist) 1061 :LaTeX org-export-latex-options-plist)
1067 raw-path)))))))) 1062 raw-path))))))))
1068 ;; process with link inserting 1063 ;; process with link inserting
1069 (apply 'delete-region remove) 1064 (apply 'delete-region remove)
1070 (cond ((and imgp (plist-get org-latex-options-plist :inline-images)) 1065 (cond ((and imgp (plist-get org-export-latex-options-plist :inline-images))
1071 (insert (format "\\includegraphics[%s]{%s}" 1066 (insert (format "\\includegraphics[%s]{%s}"
1072 ;; image option should be set be a comment line 1067 ;; image option should be set be a comment line
1073 org-export-latex-image-default-option 1068 org-export-latex-image-default-option
1074 (expand-file-name raw-path)))) 1069 (expand-file-name raw-path))))
1075 ;; FIXME: what about caption? image properties?
1076 (radiop (insert (format "\\hyperref[%s]{%s}" raw-path desc))) 1070 (radiop (insert (format "\\hyperref[%s]{%s}" raw-path desc)))
1077 (path (insert (format "\\href{%s}{%s}" path desc))) 1071 (path (insert (format "\\href{%s}{%s}" path desc)))
1078 (t (insert "\\texttt{" desc "}"))))))) 1072 (t (insert "\\texttt{" desc "}")))))))
1079 1073
1080(defun org-export-latex-cleaned-string (&optional commentsp) 1074(defvar org-latex-entities) ; defined below
1081 ;; FIXME remove commentsp call in org.el and here 1075
1076(defun org-export-latex-cleaned-string ()
1082 "Clean stuff in the LaTeX export." 1077 "Clean stuff in the LaTeX export."
1083 1078
1084 ;; Preserve line breaks 1079 ;; Preserve line breaks
@@ -1091,7 +1086,7 @@ Valid parameters are
1091 (goto-char (point-min)) 1086 (goto-char (point-min))
1092 (let ((case-fold-search nil) rpl) 1087 (let ((case-fold-search nil) rpl)
1093 (while (re-search-forward "\\([^+_]\\)LaTeX" nil t) 1088 (while (re-search-forward "\\([^+_]\\)LaTeX" nil t)
1094 (replace-match (org-export-latex-protect-string 1089 (replace-match (org-export-latex-protect-string
1095 (concat (match-string 1) "\\LaTeX{}")) t t))) 1090 (concat (match-string 1) "\\LaTeX{}")) t t)))
1096 1091
1097 ;; Convert horizontal rules 1092 ;; Convert horizontal rules
@@ -1099,19 +1094,25 @@ Valid parameters are
1099 (while (re-search-forward "^----+.$" nil t) 1094 (while (re-search-forward "^----+.$" nil t)
1100 (replace-match (org-export-latex-protect-string "\\hrule") t t)) 1095 (replace-match (org-export-latex-protect-string "\\hrule") t t))
1101 1096
1102 ;; Protect LaTeX \commands{...} 1097 ;; Protect LaTeX commands like \commad[...]{...} or \command{...}
1103 (goto-char (point-min)) 1098 (goto-char (point-min))
1104 (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) 1099 (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t)
1105 (add-text-properties (match-beginning 0) (match-end 0) 1100 (add-text-properties (match-beginning 0) (match-end 0)
1106 '(org-protected t))) 1101 '(org-protected t)))
1107 1102
1103 ;; Protect LaTeX entities
1104 (goto-char (point-min))
1105 (while (re-search-forward (regexp-opt org-latex-entities) nil t)
1106 (add-text-properties (match-beginning 0) (match-end 0)
1107 '(org-protected t)))
1108
1108 ;; Replace radio links 1109 ;; Replace radio links
1109 (goto-char (point-min)) 1110 (goto-char (point-min))
1110 (while (re-search-forward 1111 (while (re-search-forward
1111 (concat "<<<?" org-latex-all-targets-regexp 1112 (concat "<<<?" org-export-latex-all-targets-re
1112 ">>>?\\((INVISIBLE)\\)?") nil t) 1113 ">>>?\\((INVISIBLE)\\)?") nil t)
1113 (replace-match 1114 (replace-match
1114 (org-export-latex-protect-string 1115 (org-export-latex-protect-string
1115 (format "\\label{%s}%s"(match-string 1) 1116 (format "\\label{%s}%s"(match-string 1)
1116 (if (match-string 2) "" (match-string 1)))) t t)) 1117 (if (match-string 2) "" (match-string 1)))) t t))
1117 1118
@@ -1123,7 +1124,7 @@ Valid parameters are
1123 1124
1124 ;; When converting to LaTeX, replace footnotes 1125 ;; When converting to LaTeX, replace footnotes
1125 ;; FIXME: don't protect footnotes from conversion 1126 ;; FIXME: don't protect footnotes from conversion
1126 (when (plist-get org-latex-options-plist :footnotes) 1127 (when (plist-get org-export-latex-options-plist :footnotes)
1127 (goto-char (point-min)) 1128 (goto-char (point-min))
1128 (while (re-search-forward "\\[[0-9]+\\]" nil t) 1129 (while (re-search-forward "\\[[0-9]+\\]" nil t)
1129 (when (save-match-data 1130 (when (save-match-data
@@ -1133,34 +1134,402 @@ Valid parameters are
1133 (foot-end (match-end 0)) 1134 (foot-end (match-end 0))
1134 (foot-prefix (match-string 0)) 1135 (foot-prefix (match-string 0))
1135 footnote footnote-rpl) 1136 footnote footnote-rpl)
1136 (when (and (re-search-forward (regexp-quote foot-prefix) nil t)) 1137 (save-excursion
1137 (replace-match "") 1138 (when (search-forward foot-prefix nil t)
1138 (let ((end (save-excursion 1139 (replace-match "")
1139 (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t) 1140 (let ((end (save-excursion
1140 (match-beginning 0) (point-max))))) 1141 (if (re-search-forward "^$\\|^#.*$\\|\\[[0-9]+\\]" nil t)
1141 (setq footnote 1142 (match-beginning 0) (point-max)))))
1142 (concat 1143 (setq footnote (concat (org-trim (buffer-substring (point) end))
1143 (org-trim (buffer-substring (point) end)) 1144 " ")) ; prevent last } being part of a link
1144 ;; FIXME stupid workaround for cases where 1145 (delete-region (point) end))
1145 ;; `org-bracket-link-analytic-regexp' matches 1146 (goto-char foot-beg)
1146 ;; }. as part of the link. 1147 (delete-region foot-beg foot-end)
1147 " ")) 1148 (unless (null footnote)
1148 (delete-region (point) end))) 1149 (setq footnote-rpl (format "\\footnote{%s}" footnote))
1149 (goto-char foot-beg) 1150 (add-text-properties 0 10 '(org-protected t) footnote-rpl)
1150 (delete-region foot-beg foot-end) 1151 (add-text-properties (1- (length footnote-rpl))
1151 (setq footnote-rpl (format "\\footnote{%s}" footnote)) 1152 (length footnote-rpl)
1152 (add-text-properties 0 10 '(org-protected t) footnote-rpl) 1153 '(org-protected t) footnote-rpl)
1153 (add-text-properties (1- (length footnote-rpl)) 1154 (insert footnote-rpl)))))))
1154 (length footnote-rpl) 1155
1155 '(org-protected t) footnote-rpl)
1156 (insert footnote-rpl))))
1157
1158 ;; Replace footnote section tag for LaTeX 1156 ;; Replace footnote section tag for LaTeX
1159 (goto-char (point-min)) 1157 (goto-char (point-min))
1160 (while (re-search-forward 1158 (while (re-search-forward
1161 (concat "^" footnote-section-tag-regexp) nil t) 1159 (concat "^" footnote-section-tag-regexp) nil t)
1162 (replace-match "")))) 1160 (replace-match ""))))
1163 1161
1162;;; List handling:
1163
1164(defun org-export-latex-lists ()
1165 "Replace plain text lists in current buffer into LaTeX lists."
1166 "Convert lists to LaTeX."
1167 (goto-char (point-min))
1168 (while (re-search-forward org-export-latex-list-beginning-re nil t)
1169 (beginning-of-line)
1170 (insert (org-list-to-latex (org-list-parse-list t)) "\n")))
1171
1172(defun org-list-parse-list (&optional delete)
1173 "Parse the list at point.
1174Return a list containing first level items as strings and
1175sublevels as a list of strings."
1176 (let ((start (org-list-item-begin))
1177 (end (org-list-end))
1178 output itemsep)
1179 (while (re-search-forward org-export-latex-list-beginning-re end t)
1180 (setq itemsep (if (save-match-data
1181 (string-match "^[0-9]" (match-string 2)))
1182 "[0-9]+\\(?:\\.\\|)\\)" "[-+]"))
1183 (let* ((indent1 (match-string 1))
1184 (nextitem (save-excursion
1185 (save-match-data
1186 (or (and (re-search-forward
1187 (concat "^" indent1 itemsep " *?") end t)
1188 (match-beginning 0)) end))))
1189 (item (buffer-substring
1190 (point)
1191 (or (and (re-search-forward
1192 org-export-latex-list-beginning-re end t)
1193 (goto-char (match-beginning 0)))
1194 (goto-char end))))
1195 (nextindent (match-string 1))
1196 (item (org-trim item))
1197 (item (if (string-match "^\\[.+\\]" item)
1198 (replace-match "\\\\texttt{\\&}"
1199 t nil item) item)))
1200 (push item output)
1201 (when (> (length nextindent)
1202 (length indent1))
1203 (narrow-to-region (point) nextitem)
1204 (push (org-list-parse-list) output)
1205 (widen))))
1206 (when delete (delete-region start end))
1207 (setq output (nreverse output))
1208 (push (if (string-match "^\\[0" itemsep)
1209 'ordered 'unordered) output)))
1210
1211(defun org-list-item-begin ()
1212 "Find the beginning of the list item and return its position."
1213 (save-excursion
1214 (if (not (or (looking-at org-export-latex-list-beginning-re)
1215 (re-search-backward
1216 org-export-latex-list-beginning-re nil t)))
1217 (progn (goto-char (point-min)) (point))
1218 (match-beginning 0))))
1219
1220(defun org-list-end ()
1221 "Find the end of the list and return its position."
1222 (save-excursion
1223 (catch 'exit
1224 (while (or (looking-at org-export-latex-list-beginning-re)
1225 (looking-at "^[ \t]+\\|^$"))
1226 (if (eq (point) (point-max))
1227 (throw 'exit (point-max)))
1228 (forward-line 1))) (point)))
1229
1230(defun org-list-insert-radio-list ()
1231 "Insert a radio list template appropriate for this major mode."
1232 (interactive)
1233 (let* ((e (assq major-mode org-list-radio-list-templates))
1234 (txt (nth 1 e))
1235 name pos)
1236 (unless e (error "No radio list setup defined for %s" major-mode))
1237 (setq name (read-string "List name: "))
1238 (while (string-match "%n" txt)
1239 (setq txt (replace-match name t t txt)))
1240 (or (bolp) (insert "\n"))
1241 (setq pos (point))
1242 (insert txt)
1243 (goto-char pos)))
1244
1245(defun org-list-send-list (&optional maybe)
1246 "Send a tranformed version of this list to the receiver position.
1247With argument MAYBE, fail quietly if no transformation is defined for
1248this list."
1249 (interactive)
1250 (catch 'exit
1251 (unless (org-at-item-p) (error "Not at a list"))
1252 (save-excursion
1253 (goto-char (org-list-item-begin))
1254 (beginning-of-line 0)
1255 (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
1256 (if maybe
1257 (throw 'exit nil)
1258 (error "Don't know how to transform this list"))))
1259 (let* ((name (match-string 1))
1260 beg
1261 (transform (intern (match-string 2)))
1262 (txt (buffer-substring-no-properties
1263 (org-list-item-begin)
1264 (org-list-end)))
1265 (list (org-list-parse-list)))
1266 (unless (fboundp transform)
1267 (error "No such transformation function %s" transform))
1268 (setq txt (funcall transform list))
1269 ;; Find the insertion place
1270 (save-excursion
1271 (goto-char (point-min))
1272 (unless (re-search-forward
1273 (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
1274 (error "Don't know where to insert translated list"))
1275 (goto-char (match-beginning 0))
1276 (beginning-of-line 2)
1277 (setq beg (point))
1278 (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
1279 (error "Cannot find end of insertion region"))
1280 (beginning-of-line 1)
1281 (delete-region beg (point))
1282 (goto-char beg)
1283 (insert txt "\n"))
1284 (message "List converted and installed at receiver location"))))
1285
1286(defun org-list-to-generic (list params)
1287 "Convert a LIST parsed through `org-list-parse-list' to other formats.
1288
1289Valid parameters are
1290
1291:ustart String to start an unordered list
1292:uend String to end an unordered list
1293
1294:ostart String to start an ordered list
1295:oend String to end an ordered list
1296
1297:splice When set to t, return only list body lines, don't wrap
1298 them into :[u/o]start and :[u/o]end. Default is nil.
1299
1300:istart String to start a list item
1301:iend String to end a list item
1302:isep String to separate items
1303:lsep String to separate sublists"
1304 (interactive)
1305 (let* ((p params) sublist
1306 (splicep (plist-get p :splice))
1307 (ostart (plist-get p :ostart))
1308 (oend (plist-get p :oend))
1309 (ustart (plist-get p :ustart))
1310 (uend (plist-get p :uend))
1311 (istart (plist-get p :istart))
1312 (iend (plist-get p :iend))
1313 (isep (plist-get p :isep))
1314 (lsep (plist-get p :lsep)))
1315 (let ((wrapper
1316 (cond ((eq (car list) 'ordered)
1317 (concat ostart "\n%s" oend "\n"))
1318 ((eq (car list) 'unordered)
1319 (concat ustart "\n%s" uend "\n"))))
1320 rtn)
1321 (while (setq sublist (pop list))
1322 (cond ((symbolp sublist) nil)
1323 ((stringp sublist)
1324 (setq rtn (concat rtn istart sublist iend isep)))
1325 (t
1326 (setq rtn (concat rtn ;; previous list
1327 lsep ;; list separator
1328 (org-list-to-generic sublist p)
1329 lsep ;; list separator
1330 )))))
1331 (format wrapper rtn))))
1332
1333(defun org-list-to-latex (list)
1334 "Convert LIST into a LaTeX list."
1335 (org-list-to-generic
1336 list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
1337 :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1338 :istart "\\item " :iend ""
1339 :isep "\n" :lsep "\n")))
1340
1341(defun org-list-to-html (list)
1342 "Convert LIST into a HTML list."
1343 (org-list-to-generic
1344 list '(:splicep nil :ostart "<ol>" :oend "</ol>"
1345 :ustart "<ul>" :uend "</ul>"
1346 :istart "<li>" :iend "</li>"
1347 :isep "\n" :lsep "\n")))
1348
1349(defun org-list-to-texinfo (list)
1350 "Convert LIST into a Texinfo list."
1351 (org-list-to-generic
1352 list '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1353 :ustart "@enumerate" :uend "@end enumerate"
1354 :istart "@item\n" :iend ""
1355 :isep "\n" :lsep "\n")))
1356
1357(defconst org-latex-entities
1358 '("\\!"
1359 "\\'"
1360 "\\+"
1361 "\\,"
1362 "\\-"
1363 "\\:"
1364 "\\;"
1365 "\\<"
1366 "\\="
1367 "\\>"
1368 "\\Huge"
1369 "\\LARGE"
1370 "\\Large"
1371 "\\Styles"
1372 "\\\\"
1373 "\\`"
1374 "\\addcontentsline"
1375 "\\address"
1376 "\\addtocontents"
1377 "\\addtocounter"
1378 "\\addtolength"
1379 "\\addvspace"
1380 "\\alph"
1381 "\\appendix"
1382 "\\arabic"
1383 "\\author"
1384 "\\begin{array}"
1385 "\\begin{center}"
1386 "\\begin{description}"
1387 "\\begin{enumerate}"
1388 "\\begin{eqnarray}"
1389 "\\begin{equation}"
1390 "\\begin{figure}"
1391 "\\begin{flushleft}"
1392 "\\begin{flushright}"
1393 "\\begin{itemize}"
1394 "\\begin{list}"
1395 "\\begin{minipage}"
1396 "\\begin{picture}"
1397 "\\begin{quotation}"
1398 "\\begin{quote}"
1399 "\\begin{tabbing}"
1400 "\\begin{table}"
1401 "\\begin{tabular}"
1402 "\\begin{thebibliography}"
1403 "\\begin{theorem}"
1404 "\\begin{titlepage}"
1405 "\\begin{verbatim}"
1406 "\\begin{verse}"
1407 "\\bf"
1408 "\\bf"
1409 "\\bibitem"
1410 "\\bigskip"
1411 "\\cdots"
1412 "\\centering"
1413 "\\circle"
1414 "\\cite"
1415 "\\cleardoublepage"
1416 "\\clearpage"
1417 "\\cline"
1418 "\\closing"
1419 "\\dashbox"
1420 "\\date"
1421 "\\ddots"
1422 "\\dotfill"
1423 "\\em"
1424 "\\fbox"
1425 "\\flushbottom"
1426 "\\fnsymbol"
1427 "\\footnote"
1428 "\\footnotemark"
1429 "\\footnotesize"
1430 "\\footnotetext"
1431 "\\frac"
1432 "\\frame"
1433 "\\framebox"
1434 "\\hfill"
1435 "\\hline"
1436 "\\hrulespace"
1437 "\\hspace"
1438 "\\huge"
1439 "\\hyphenation"
1440 "\\include"
1441 "\\includeonly"
1442 "\\indent"
1443 "\\input"
1444 "\\it"
1445 "\\kill"
1446 "\\label"
1447 "\\large"
1448 "\\ldots"
1449 "\\line"
1450 "\\linebreak"
1451 "\\linethickness"
1452 "\\listoffigures"
1453 "\\listoftables"
1454 "\\location"
1455 "\\makebox"
1456 "\\maketitle"
1457 "\\mark"
1458 "\\mbox"
1459 "\\medskip"
1460 "\\multicolumn"
1461 "\\multiput"
1462 "\\newcommand"
1463 "\\newcounter"
1464 "\\newenvironment"
1465 "\\newfont"
1466 "\\newlength"
1467 "\\newline"
1468 "\\newpage"
1469 "\\newsavebox"
1470 "\\newtheorem"
1471 "\\nocite"
1472 "\\nofiles"
1473 "\\noindent"
1474 "\\nolinebreak"
1475 "\\nopagebreak"
1476 "\\normalsize"
1477 "\\onecolumn"
1478 "\\opening"
1479 "\\oval"
1480 "\\overbrace"
1481 "\\overline"
1482 "\\pagebreak"
1483 "\\pagenumbering"
1484 "\\pageref"
1485 "\\pagestyle"
1486 "\\par"
1487 "\\parbox"
1488 "\\put"
1489 "\\raggedbottom"
1490 "\\raggedleft"
1491 "\\raggedright"
1492 "\\raisebox"
1493 "\\ref"
1494 "\\rm"
1495 "\\roman"
1496 "\\rule"
1497 "\\savebox"
1498 "\\sc"
1499 "\\scriptsize"
1500 "\\setcounter"
1501 "\\setlength"
1502 "\\settowidth"
1503 "\\sf"
1504 "\\shortstack"
1505 "\\signature"
1506 "\\sl"
1507 "\\small"
1508 "\\smallskip"
1509 "\\sqrt"
1510 "\\tableofcontents"
1511 "\\telephone"
1512 "\\thanks"
1513 "\\thispagestyle"
1514 "\\tiny"
1515 "\\title"
1516 "\\tt"
1517 "\\twocolumn"
1518 "\\typein"
1519 "\\typeout"
1520 "\\underbrace"
1521 "\\underline"
1522 "\\usebox"
1523 "\\usecounter"
1524 "\\value"
1525 "\\vdots"
1526 "\\vector"
1527 "\\verb"
1528 "\\vfill"
1529 "\\vline"
1530 "\\vspace")
1531 "A list of LaTeX commands to be protected when performing conversion.")
1532
1164(provide 'org-export-latex) 1533(provide 'org-export-latex)
1165 1534
1166;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad 1535;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad
diff --git a/lisp/textmodes/org-mouse.el b/lisp/textmodes/org-mouse.el
new file mode 100644
index 00000000000..f91dc3af853
--- /dev/null
+++ b/lisp/textmodes/org-mouse.el
@@ -0,0 +1,1110 @@
1;;; org-mouse.el --- Better mouse support for org-mode
2
3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation
4;;
5;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
6;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
7;; Version: 5.19
8;;
9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 3, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26;;
27;;; Commentary:
28;;
29;; Org-mouse provides mouse support for org-mode.
30;;
31;; http://orgmode.org
32;;
33;; Org-mouse implements the following features:
34;; * following links with the left mouse button (in Emacs 22)
35;; * subtree expansion/collapse (org-cycle) with the left mouse button
36;; * several context menus on the right mouse button:
37;; + general text
38;; + headlines
39;; + timestamps
40;; + priorities
41;; + links
42;; + tags
43;; * promoting/demoting/moving subtrees with mouse-3
44;; + if the drag starts and ends in the same line then promote/demote
45;; + otherwise move the subtree
46;;
47;; Use
48;; ---
49;;
50;; To use this package, put the following line in your .emacs:
51;;
52;; (require 'org-mouse)
53;;
54
55;; Fixme:
56;; + deal with folding / unfolding issues
57
58;; TODO (This list is only theoretical, if you'd like to have some
59;; feature implemented or a bug fix please send me an email, even if
60;; something similar appears in the list below. This will help me get
61;; the priorities right.):
62;;
63;; + org-store-link, insert link
64;; + org tables
65;; + occur with the current word/tag (same menu item)
66;; + ctrl-c ctrl-c, for example, renumber the current list
67;; + internal links
68
69;; Please email the maintainer with new feature suggestions / bugs
70
71;; History:
72;;
73;; SInce version 5.10: Changes are listed in the general org-mode docs.
74;;
75;; Version 5.09
76;; + Version number synchronization with Org-mode.
77;;
78;; Version 0.25
79;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch)
80;;
81;; Version 0.24
82;; + minor changes to the table menu
83;;
84;; Version 0.23
85;; + preliminary support for tables and calculation marks
86;; + context menu support for org-agenda-undo & org-sort-entries
87;;
88;; Version 0.22
89;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
90;;
91;; Version 0.21
92;; + selected text activates its context menu
93;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link
94;;
95;; Version 0.20
96;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item
97;; + the TODO menu can now list occurrences of a specific TODO keyword
98;; + #+STARTUP line is now recognized
99;;
100;; Version 0.19
101;; + added support for dragging URLs to the org-buffer
102;;
103;; Version 0.18
104;; + added support for agenda blocks
105;;
106;; Version 0.17
107;; + toggle checkboxes with a single click
108;;
109;; Version 0.16
110;; + added support for checkboxes
111;;
112;; Version 0.15
113;; + org-mode now works with the Agenda buffer as well
114;;
115;; Version 0.14
116;; + added a menu option that converts plain list items to outline items
117;;
118;; Version 0.13
119;; + "Insert Heading" now inserts a sibling heading if the point is
120;; on "***" and a child heading otherwise
121;;
122;; Version 0.12
123;; + compatible with Emacs 21
124;; + custom agenda commands added to the main menu
125;; + moving trees should now work between windows in the same frame
126;;
127;; Version 0.11
128;; + fixed org-mouse-at-link (thanks to Carsten)
129;; + removed [follow-link] bindings
130;;
131;; Version 0.10
132;; + added a menu option to remove highlights
133;; + compatible with org-mode 4.21 now
134;;
135;; Version 0.08:
136;; + trees can be moved/promoted/demoted by dragging with the right
137;; mouse button (mouse-3)
138;; + small changes in the above function
139;;
140;; Versions 0.01 -- 0.07: (I don't remember)
141
142(eval-when-compile (require 'cl))
143(require 'org)
144
145(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
146 "Regular expression that matches a plain list.")
147(defvar org-mouse-direct t
148 "Internal variable indicating whether the current action is direct.
149
150If t, then the current action has been invoked directly through the buffer
151it is intended to operate on. If nil, then the action has been invoked
152indirectly, for example, through the agenda buffer.")
153
154(defgroup org-mouse nil
155 "Mouse support for org-mode."
156 :tag "Org Mouse"
157 :group 'org)
158
159(defcustom org-mouse-punctuation ":"
160 "Punctuation used when inserting text by drag and drop."
161 :group 'org-mouse
162 :type 'string)
163
164
165(defun org-mouse-re-search-line (regexp)
166 "Search the current line for a given regular expression."
167 (beginning-of-line)
168 (re-search-forward regexp (point-at-eol) t))
169
170(defun org-mouse-end-headline ()
171 "Go to the end of current headline (ignoring tags)."
172 (interactive)
173 (end-of-line)
174 (skip-chars-backward "\t ")
175 (when (looking-back ":[A-Za-z]+:")
176 (skip-chars-backward ":A-Za-z")
177 (skip-chars-backward "\t ")))
178
179(defvar org-mouse-context-menu-function nil
180 "Function to create the context menu.
181The value of this variable is the function invoked by
182`org-mouse-context-menu' as the context menu.")
183(make-variable-buffer-local 'org-mouse-context-menu-function)
184
185(defun org-mouse-show-context-menu (event prefix)
186 "Invoke the context menu.
187
188If the value of `org-mouse-context-menu-function' is a function, then
189this function is called. Otherwise, the current major mode menu is used."
190 (interactive "@e \nP")
191 (if (and (= (event-click-count event) 1)
192 (or (not mark-active)
193 (sit-for (/ double-click-time 1000.0))))
194 (progn
195 (select-window (posn-window (event-start event)))
196 (when (not (org-mouse-mark-active))
197 (goto-char (posn-point (event-start event)))
198 (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook)))
199 (let ((redisplay-dont-pause t))
200 (sit-for 0)))
201 (if (functionp org-mouse-context-menu-function)
202 (funcall org-mouse-context-menu-function event)
203 (mouse-major-mode-menu event prefix)))
204 (setq this-command 'mouse-save-then-kill)
205 (mouse-save-then-kill event)))
206
207
208(defun org-mouse-line-position ()
209 "Returns `:beginning' or `:middle' or `:end', depending on the point position.
210
211If the point is at the end of the line, return `:end'.
212If the point is separated from the beginning of the line only by white
213space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise,
214return `:middle'."
215 (cond
216 ((eolp) :end)
217 ((org-mouse-bolp) :beginning)
218 (t :middle)))
219
220(defun org-mouse-empty-line ()
221 "Return non-nil iff the line contains only white space."
222 (save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
223
224(defun org-mouse-next-heading ()
225 "Go to the next heading.
226If there is none, ensure that the point is at the beginning of an empty line."
227 (unless (outline-next-heading)
228 (beginning-of-line)
229 (unless (org-mouse-empty-line)
230 (end-of-line)
231 (newline))))
232
233(defun org-mouse-insert-heading ()
234 "Insert a new heading, as `org-insert-heading'.
235
236If the point is at the :beginning (`org-mouse-line-position') of the line,
237insert the new heading before the current line. Otherwise, insert it
238after the current heading."
239 (interactive)
240 (case (org-mouse-line-position)
241 (:beginning (beginning-of-line)
242 (org-insert-heading))
243 (t (org-mouse-next-heading)
244 (org-insert-heading))))
245
246(defun org-mouse-timestamp-today (&optional shift units)
247 "Change the timestamp into SHIFT UNITS in the future.
248
249For the acceptable UNITS, see `org-timestamp-change'."
250 (interactive)
251 (flet ((org-read-date (&rest rest) (current-time)))
252 (org-time-stamp nil))
253 (when shift
254 (org-timestamp-change shift units)))
255
256(defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
257 "A helper function.
258
259Returns a menu fragment consisting of KEYWORDS. When a keyword
260is selected by the user, FUNCTION is called with the selected
261keyword as the only argument.
262
263If SELECTED is nil, then all items are normal menu items. If
264SELECTED is a function, then each item is a checkbox, which is
265enabled for a given keyword iff (funcall SELECTED keyword) return
266non-nil. If SELECTED is neither nil nor a function, then the
267items are radio buttons. A radio button is enabled for the
268keyword `equal' to SELECTED.
269
270ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
271is a function, it is invoked with the keyword as the only
272argument. If it is a string, it is interpreted as the format
273string to (format ITEMFORMAT keyword). If it is neither a string
274nor a function, elements of KEYWORDS are used directly. "
275 (mapcar
276 `(lambda (keyword)
277 (vector (cond
278 ((functionp ,itemformat) (funcall ,itemformat keyword))
279 ((stringp ,itemformat) (format ,itemformat keyword))
280 (t keyword))
281 (list 'funcall ,function keyword)
282 :style (cond
283 ((null ,selected) t)
284 ((functionp ,selected) 'toggle)
285 (t 'radio))
286 :selected (if (functionp ,selected)
287 (and (funcall ,selected keyword) t)
288 (equal ,selected keyword))))
289 keywords))
290
291(defun org-mouse-remove-match-and-spaces ()
292 "Remove the match, make just one space around the point."
293 (interactive)
294 (replace-match "")
295 (just-one-space))
296
297(defvar rest)
298(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
299 literal string subexp)
300 "The same as `replace-match', but surrounds the replacement with spaces."
301 (apply 'replace-match rest)
302 (save-excursion
303 (goto-char (match-beginning (or subexp 0)))
304 (just-one-space)
305 (goto-char (match-end (or subexp 0)))
306 (just-one-space)))
307
308
309(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat
310 nosurround)
311 "A helper function.
312
313Returns a menu fragment consisting of KEYWORDS. When a keyword
314is selected, group GROUP of the current match is replaced by the
315keyword. The method ensures that both ends of the replacement
316are separated from the rest of the text in the buffer by
317individual spaces (unless NOSURROND is non-nil).
318
319The final entry of the menu is always \"None\", which removes the
320match.
321
322ITEMFORMAT governs formatting of the elements of KEYWORDS. If it
323is a function, it is invoked with the keyword as the only
324argument. If it is a string, it is interpreted as the format
325string to (format ITEMFORMAT keyword). If it is neither a string
326nor a function, elements of KEYWORDS are used directly.
327"
328 (setq group (or group 0))
329 (let ((replace (org-mouse-match-closure
330 (if nosurround 'replace-match
331 'org-mouse-replace-match-and-surround))))
332 (append
333 (org-mouse-keyword-menu
334 keywords
335 `(lambda (keyword) (funcall ,replace keyword t t nil ,group))
336 (match-string group)
337 itemformat)
338 `(["None" org-mouse-remove-match-and-spaces
339 :style radio
340 :selected ,(not (member (match-string group) keywords))]))))
341
342(defun org-mouse-show-headlines ()
343 "Change the visibility of the current org buffer to only show headlines."
344 (interactive)
345 (let ((this-command 'org-cycle)
346 (last-command 'org-cycle)
347 (org-cycle-global-status nil))
348 (org-cycle '(4))
349 (org-cycle '(4))))
350
351(defun org-mouse-show-overview ()
352 "Change visibility of current org buffer to first-level headlines only."
353 (interactive)
354 (let ((org-cycle-global-status nil))
355 (org-cycle '(4))))
356
357(defun org-mouse-set-priority (priority)
358 "Set the priority of the current headline to PRIORITY."
359 (flet ((read-char-exclusive () priority))
360 (org-priority)))
361
362(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
363 "Regular expression matching the priority indicator.
364Differs from `org-priority-regexp' in that it doesn't contain the
365leading '.*?'.")
366
367(defun org-mouse-get-priority (&optional default)
368 "Return the priority of the current headline.
369DEFAULT is returned if no priority is given in the headline."
370 (save-excursion
371 (if (org-mouse-re-search-line org-mouse-priority-regexp)
372 (match-string 1)
373 (when default (char-to-string org-default-priority)))))
374
375;; (defun org-mouse-at-link ()
376;; (and (eq (get-text-property (point) 'face) 'org-link)
377;; (save-excursion
378;; (goto-char (previous-single-property-change (point) 'face))
379;; (or (looking-at org-bracket-link-regexp)
380;; (looking-at org-angle-link-re)
381;; (looking-at org-plain-link-re)))))
382
383
384(defun org-mouse-delete-timestamp ()
385 "Deletes the current timestamp as well as the preceding keyword.
386SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
387 (when (or (org-at-date-range-p) (org-at-timestamp-p))
388 (replace-match "") ; delete the timestamp
389 (skip-chars-backward " :A-Z")
390 (when (looking-at " *[A-Z][A-Z]+:")
391 (replace-match ""))))
392
393(defun org-mouse-looking-at (regexp skipchars &optional movechars)
394 (save-excursion
395 (let ((point (point)))
396 (if (looking-at regexp) t
397 (skip-chars-backward skipchars)
398 (forward-char (or movechars 0))
399 (when (looking-at regexp)
400 (> (match-end 0) point))))))
401
402(defun org-mouse-priority-list ()
403 (loop for priority from ?A to org-lowest-priority
404 collect (char-to-string priority)))
405
406(defun org-mouse-tag-menu () ;todo
407 (append
408 (let ((tags (org-split-string (org-get-tags) ":")))
409 (org-mouse-keyword-menu
410 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
411 `(lambda (tag)
412 (org-mouse-set-tags
413 (sort (if (member tag (quote ,tags))
414 (delete tag (quote ,tags))
415 (cons tag (quote ,tags)))
416 'string-lessp)))
417 `(lambda (tag) (member tag (quote ,tags)))
418 ))
419 '("--"
420 ["Align Tags Here" (org-set-tags nil t) t]
421 ["Align Tags in Buffer" (org-set-tags t t) t]
422 ["Set Tags ..." (org-set-tags) t])))
423
424
425
426(defun org-mouse-set-tags (tags)
427 (save-excursion
428 ;; remove existing tags first
429 (beginning-of-line)
430 (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)")
431 (replace-match ""))
432
433 ;; set new tags if any
434 (when tags
435 (end-of-line)
436 (insert " :" (mapconcat 'identity tags ":") ":")
437 (org-set-tags nil t))))
438
439(defun org-mouse-insert-checkbox ()
440 (interactive)
441 (and (org-at-item-p)
442 (goto-char (match-end 0))
443 (unless (org-at-item-checkbox-p)
444 (delete-horizontal-space)
445 (insert " [ ] "))))
446
447(defun org-mouse-agenda-type (type)
448 (case type
449 ('tags "Tags: ")
450 ('todo "TODO: ")
451 ('tags-tree "Tags tree: ")
452 ('todo-tree "TODO tree: ")
453 ('occur-tree "Occur tree: ")
454 (t "Agenda command ???")))
455
456
457(defun org-mouse-list-options-menu (alloptions &optional function)
458 (let ((options (save-match-data
459 (split-string (match-string-no-properties 1)))))
460 (print options)
461 (loop for name in alloptions
462 collect
463 (vector name
464 `(progn
465 (replace-match
466 (mapconcat 'identity
467 (sort (if (member ',name ',options)
468 (delete ',name ',options)
469 (cons ',name ',options))
470 'string-lessp)
471 " ")
472 nil nil nil 1)
473 (when (functionp ',function) (funcall ',function)))
474 :style 'toggle
475 :selected (and (member name options) t)))))
476
477(defun org-mouse-clip-text (text maxlength)
478 (if (> (length text) maxlength)
479 (concat (substring text 0 (- maxlength 3)) "...")
480 text))
481
482(defun org-mouse-popup-global-menu ()
483 (popup-menu
484 `("Main Menu"
485 ["Show Overview" org-mouse-show-overview t]
486 ["Show Headlines" org-mouse-show-headlines t]
487 ["Show All" show-all t]
488 ["Remove Highlights" org-remove-occur-highlights
489 :visible org-occur-highlights]
490 "--"
491 ["Check Deadlines"
492 (if (functionp 'org-check-deadlines-and-todos)
493 (org-check-deadlines-and-todos org-deadline-warning-days)
494 (org-check-deadlines org-deadline-warning-days)) t]
495 ["Check TODOs" org-show-todo-tree t]
496 ("Check Tags"
497 ,@(org-mouse-keyword-menu
498 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
499 '(lambda (tag) (org-tags-sparse-tree nil tag)))
500 "--"
501 ["Custom Tag ..." org-tags-sparse-tree t])
502 ["Check Phrase ..." org-occur]
503 "--"
504 ["Display Agenda" org-agenda-list t]
505 ["Display Timeline" org-timeline t]
506 ["Display TODO List" org-todo-list t]
507 ("Display Tags"
508 ,@(org-mouse-keyword-menu
509 (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
510 '(lambda (tag) (org-tags-view nil tag)))
511 "--"
512 ["Custom Tag ..." org-tags-view t])
513 ["Display Calendar" org-goto-calendar t]
514 "--"
515 ,@(org-mouse-keyword-menu
516 (mapcar 'car org-agenda-custom-commands)
517 '(lambda (key)
518 (eval `(flet ((read-char-exclusive () (string-to-char ,key)))
519 (org-agenda nil))))
520 nil
521 '(lambda (key)
522 (let ((entry (assoc key org-agenda-custom-commands)))
523 (org-mouse-clip-text
524 (cond
525 ((stringp (nth 1 entry)) (nth 1 entry))
526 ((stringp (nth 2 entry))
527 (concat (org-mouse-agenda-type (nth 1 entry))
528 (nth 2 entry)))
529 (t "Agenda Command '%s'"))
530 30))))
531 "--"
532 ["Delete Blank Lines" delete-blank-lines
533 :visible (org-mouse-empty-line)]
534 ["Insert Checkbox" org-mouse-insert-checkbox
535 :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
536 ["Insert Checkboxes"
537 (org-mouse-for-each-item 'org-mouse-insert-checkbox)
538 :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))]
539 ["Plain List to Outline" org-mouse-transform-to-outline
540 :visible (org-at-item-p)])))
541
542
543(defun org-mouse-get-context (contextlist context)
544 (let ((contextdata (assq context contextlist)))
545 (when contextdata
546 (save-excursion
547 (goto-char (second contextdata))
548 (re-search-forward ".*" (third contextdata))))))
549
550(defun org-mouse-for-each-item (function)
551 (save-excursion
552 (ignore-errors
553 (while t (org-previous-item)))
554 (ignore-errors
555 (while t
556 (funcall function)
557 (org-next-item)))))
558
559(defun org-mouse-bolp ()
560 "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point"
561 (save-excursion
562 (skip-chars-backward " \t*") (bolp)))
563
564(defun org-mouse-insert-item (text)
565 (case (org-mouse-line-position)
566 (:beginning ; insert before
567 (beginning-of-line)
568 (looking-at "[ \t]*")
569 (open-line 1)
570 (indent-to (- (match-end 0) (match-beginning 0)))
571 (insert "+ "))
572
573 (:middle ; insert after
574 (end-of-line)
575 (newline t)
576 (indent-relative)
577 (insert "+ "))
578
579 (:end ; insert text here
580 (skip-chars-backward " \t")
581 (kill-region (point) (point-at-eol))
582 (unless (looking-back org-mouse-punctuation)
583 (insert (concat org-mouse-punctuation " ")))))
584
585 (insert text)
586 (beginning-of-line))
587
588(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate)
589 (if (eq major-mode 'org-mode)
590 (org-mouse-insert-item text)
591 ad-do-it))
592
593(defadvice dnd-open-file (around org-mouse-dnd-open-file activate)
594 (if (eq major-mode 'org-mode)
595 (org-mouse-insert-item uri)
596 ad-do-it))
597
598(defun org-mouse-match-closure (function)
599 (let ((match (match-data t)))
600 `(lambda (&rest rest)
601 (save-match-data
602 (set-match-data ',match)
603 (apply ',function rest)))))
604
605(defun org-mouse-todo-keywords ()
606 (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords))
607
608(defun org-mouse-match-todo-keyword ()
609 (save-excursion
610 (org-back-to-heading)
611 (if (looking-at outline-regexp) (goto-char (match-end 0)))
612 (or (looking-at (concat " +" org-todo-regexp " *"))
613 (looking-at " \\( *\\)"))))
614
615(defun org-mouse-yank-link (click)
616 (interactive "e")
617 ;; Give temporary modes such as isearch a chance to turn off.
618 (run-hooks 'mouse-leave-buffer-hook)
619 (mouse-set-point click)
620 (setq mouse-selection-click-count 0)
621 (delete-horizontal-space)
622 (insert-for-yank (concat " [[" (current-kill 0) "]] ")))
623
624(defun org-mouse-context-menu (&optional event)
625 (let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
626 (contextlist (org-context)))
627 (flet ((get-context (context) (org-mouse-get-context contextlist context)))
628 (cond
629 ((org-mouse-mark-active)
630 (let ((region-string (buffer-substring (region-beginning) (region-end))))
631 (popup-menu
632 `(nil
633 ["Sparse Tree" (org-occur ',region-string)]
634 ["Find in Buffer" (occur ',region-string)]
635 ["Grep in Current Dir"
636 (grep (format "grep -rnH -e '%s' *" ',region-string))]
637 ["Grep in Parent Dir"
638 (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
639 "--"
640 ["Convert to Link"
641 (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
642 (save-excursion (goto-char (region-end)) (insert "]]")))]
643 ["Insert Link Here" (org-mouse-yank-link ',event)]))))
644
645 ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
646 (popup-menu
647 `(nil
648 ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
649 'org-mode-restart))))
650 ((or (eolp)
651 (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
652 (looking-back " \\|\t")))
653 (org-mouse-popup-global-menu))
654 ((get-context :checkbox)
655 (popup-menu
656 '(nil
657 ["Toggle" org-toggle-checkbox t]
658 ["Remove" org-mouse-remove-match-and-spaces t]
659 ""
660 ["All Clear" (org-mouse-for-each-item
661 (lambda ()
662 (when (save-excursion (org-at-item-checkbox-p))
663 (replace-match "[ ]"))))]
664 ["All Set" (org-mouse-for-each-item
665 (lambda ()
666 (when (save-excursion (org-at-item-checkbox-p))
667 (replace-match "[X]"))))]
668 ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
669 ["All Remove" (org-mouse-for-each-item
670 (lambda ()
671 (when (save-excursion (org-at-item-checkbox-p))
672 (org-mouse-remove-match-and-spaces))))]
673 )))
674 ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
675 (member (match-string 0) (org-mouse-todo-keywords)))
676 (popup-menu
677 `(nil
678 ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords))
679 "--"
680 ["Check TODOs" org-show-todo-tree t]
681 ["List all TODO keywords" org-todo-list t]
682 [,(format "List only %s" (match-string 0))
683 (org-todo-list (match-string 0)) t]
684 )))
685 ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
686 (member (match-string 0) stamp-prefixes))
687 (popup-menu
688 `(nil
689 ,@(org-mouse-keyword-replace-menu stamp-prefixes)
690 "--"
691 ["Check Deadlines" org-check-deadlines t]
692 )))
693 ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
694 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
695 (org-mouse-priority-list) 1 "Priority %s" t))))
696 ((get-context :link)
697 (popup-menu
698 '(nil
699 ["Open" org-open-at-point t]
700 ["Open in Emacs" (org-open-at-point t) t]
701 "--"
702 ["Copy link" (kill-new (match-string 0))]
703 ["Cut link"
704 (progn
705 (kill-region (match-beginning 0) (match-end 0))
706 (just-one-space))]
707 "--"
708 ["Grep for TODOs"
709 (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
710; ["Paste file link" ((insert "file:") (yank))]
711 )))
712 ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
713 (popup-menu
714 `(nil
715 [,(format "Display '%s'" (match-string 1))
716 (org-tags-view nil ,(match-string 1))]
717 [,(format "Sparse Tree '%s'" (match-string 1))
718 (org-tags-sparse-tree nil ,(match-string 1))]
719 "--"
720 ,@(org-mouse-tag-menu))))
721 ((org-at-timestamp-p)
722 (popup-menu
723 '(nil
724 ["Show Day" org-open-at-point t]
725 ["Change Timestamp" org-time-stamp t]
726 ["Delete Timestamp" (org-mouse-delete-timestamp) t]
727 ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
728 "--"
729 ["Set for Today" org-mouse-timestamp-today]
730 ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
731 ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
732 ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
733 ["Set in a Month" (org-mouse-timestamp-today 1 'month)]
734 "--"
735 ["+ 1 Day" (org-timestamp-change 1 'day)]
736 ["+ 1 Week" (org-timestamp-change 7 'day)]
737 ["+ 1 Month" (org-timestamp-change 1 'month)]
738 "--"
739 ["- 1 Day" (org-timestamp-change -1 'day)]
740 ["- 1 Week" (org-timestamp-change -7 'day)]
741 ["- 1 Month" (org-timestamp-change -1 'month)])))
742 ((get-context :table-special)
743 (let ((mdata (match-data)))
744 (incf (car mdata) 2)
745 (store-match-data mdata))
746 (message "match: %S" (match-string 0))
747 (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
748 '(" " "!" "^" "_" "$" "#" "*" "'") 0
749 (lambda (mark)
750 (case (string-to-char mark)
751 (? "( ) Nothing Special")
752 (?! "(!) Column Names")
753 (?^ "(^) Field Names Above")
754 (?_ "(^) Field Names Below")
755 (?$ "($) Formula Parameters")
756 (?# "(#) Recalculation: Auto")
757 (?* "(*) Recalculation: Manual")
758 (?' "(') Recalculation: None"))) t))))
759 ((assq :table contextlist)
760 (popup-menu
761 '(nil
762 ["Align Table" org-ctrl-c-ctrl-c]
763 ["Blank Field" org-table-blank-field]
764 ["Edit Field" org-table-edit-field]
765 "--"
766 ("Column"
767 ["Move Column Left" org-metaleft]
768 ["Move Column Right" org-metaright]
769 ["Delete Column" org-shiftmetaleft]
770 ["Insert Column" org-shiftmetaright]
771 "--"
772 ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
773 ("Row"
774 ["Move Row Up" org-metaup]
775 ["Move Row Down" org-metadown]
776 ["Delete Row" org-shiftmetaup]
777 ["Insert Row" org-shiftmetadown]
778 ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
779 "--"
780 ["Insert Hline" org-table-insert-hline])
781 ("Rectangle"
782 ["Copy Rectangle" org-copy-special]
783 ["Cut Rectangle" org-cut-special]
784 ["Paste Rectangle" org-paste-special]
785 ["Fill Rectangle" org-table-wrap-region])
786 "--"
787 ["Set Column Formula" org-table-eval-formula]
788 ["Set Field Formula" (org-table-eval-formula '(4))]
789 ["Edit Formulas" org-table-edit-formulas]
790 "--"
791 ["Recalculate Line" org-table-recalculate]
792 ["Recalculate All" (org-table-recalculate '(4))]
793 ["Iterate All" (org-table-recalculate '(16))]
794 "--"
795 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
796 ["Sum Column/Rectangle" org-table-sum
797 :active (or (org-at-table-p) (org-region-active-p))]
798 ["Field Info" org-table-field-info]
799 ["Debug Formulas"
800 (setq org-table-formula-debug (not org-table-formula-debug))
801 :style toggle :selected org-table-formula-debug]
802 )))
803 ((and (assq :headline contextlist) (not (eolp)))
804 (let ((priority (org-mouse-get-priority t)))
805 (popup-menu
806 `("Headline Menu"
807 ("Tags and Priorities"
808 ,@(org-mouse-keyword-menu
809 (org-mouse-priority-list)
810 '(lambda (keyword)
811 (org-mouse-set-priority (string-to-char keyword)))
812 priority "Priority %s")
813 "--"
814 ,@(org-mouse-tag-menu))
815 ("TODO Status"
816 ,@(progn (org-mouse-match-todo-keyword)
817 (org-mouse-keyword-replace-menu (org-mouse-todo-keywords)
818 1)))
819 ["Show Tags"
820 (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
821 :visible (not org-mouse-direct)]
822 ["Show Priority"
823 (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
824 :visible (not org-mouse-direct)]
825 ,@(if org-mouse-direct '("--") nil)
826 ["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
827 ["Set Deadline"
828 (progn (org-mouse-end-headline) (insert " ") (org-deadline))
829 :active (not (save-excursion
830 (org-mouse-re-search-line org-deadline-regexp)))]
831 ["Schedule Task"
832 (progn (org-mouse-end-headline) (insert " ") (org-schedule))
833 :active (not (save-excursion
834 (org-mouse-re-search-line org-scheduled-regexp)))]
835 ["Insert Timestamp"
836 (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
837; ["Timestamp (inactive)" org-time-stamp-inactive t]
838 "--"
839 ["Archive Subtree" org-archive-subtree]
840 ["Cut Subtree" org-cut-special]
841 ["Copy Subtree" org-copy-special]
842 ["Paste Subtree" org-paste-special :visible org-mouse-direct]
843 ("Sort Children"
844 ["Alphabetically" (org-sort-entries nil ?a)]
845 ["Numerically" (org-sort-entries nil ?n)]
846 ["By Time/Date" (org-sort-entries nil ?t)]
847 "--"
848 ["Reverse Alphabetically" (org-sort-entries nil ?A)]
849 ["Reverse Numerically" (org-sort-entries nil ?N)]
850 ["Reverse By Time/Date" (org-sort-entries nil ?T)])
851 "--"
852 ["Move Trees" org-mouse-move-tree :active nil]
853 ))))
854 (t
855 (org-mouse-popup-global-menu))))))
856
857;; (defun org-mouse-at-regexp (regexp)
858;; (save-excursion
859;; (let ((point (point))
860;; (bol (progn (beginning-of-line) (point)))
861;; (eol (progn (end-of-line) (point))))
862;; (goto-char point)
863;; (re-search-backward regexp bol 1)
864;; (and (not (eolp))
865;; (progn (forward-char)
866;; (re-search-forward regexp eol t))
867;; (<= (match-beginning 0) point)))))
868
869(defun org-mouse-mark-active ()
870 (and mark-active transient-mark-mode))
871
872(defun org-mouse-in-region-p (pos)
873 (and (org-mouse-mark-active)
874 (>= pos (region-beginning))
875 (< pos (region-end))))
876
877(defun org-mouse-down-mouse (event)
878 (interactive "e")
879 (setq this-command last-command)
880 (unless (and (= 1 (event-click-count event))
881 (org-mouse-in-region-p (posn-point (event-start event))))
882 (mouse-drag-region event)))
883
884(add-hook 'org-mode-hook
885 '(lambda ()
886 (setq org-mouse-context-menu-function 'org-mouse-context-menu)
887
888; (define-key org-mouse-map [follow-link] 'mouse-face)
889 (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil)
890 (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)
891 (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
892 (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
893 (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)
894 (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link)
895 (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)
896 (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
897 (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)
898
899 (font-lock-add-keywords nil
900 `((,outline-regexp
901 0 `(face org-link mouse-face highlight keymap ,org-mouse-map)
902 'prepend)
903 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +"
904 (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) 'prepend))
905 ("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)"
906 (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t)))
907 t)
908
909 (defadvice org-open-at-point (around org-mouse-open-at-point activate)
910 (let ((context (org-context)))
911 (cond
912 ((assq :headline-stars context) (org-cycle))
913 ((assq :checkbox context) (org-toggle-checkbox))
914 ((assq :item-bullet context)
915 (let ((org-cycle-include-plain-lists t)) (org-cycle)))
916 (t ad-do-it))))))
917
918(defun org-mouse-move-tree-start (event)
919 (interactive "e")
920 (message "Same line: promote/demote, (***):move before, (text): make a child"))
921
922
923(defun org-mouse-make-marker (position)
924 (with-current-buffer (window-buffer (posn-window position))
925 (copy-marker (posn-point position))))
926
927(defun org-mouse-move-tree (event)
928 ;; todo: handle movements between different buffers
929 (interactive "e")
930 (save-excursion
931 (let* ((start (org-mouse-make-marker (event-start event)))
932 (end (org-mouse-make-marker (event-end event)))
933 (sbuf (marker-buffer start))
934 (ebuf (marker-buffer end)))
935
936 (when (and sbuf ebuf)
937 (set-buffer sbuf)
938 (goto-char start)
939 (org-back-to-heading)
940 (if (and (eq sbuf ebuf)
941 (equal
942 (point)
943 (save-excursion (goto-char end) (org-back-to-heading) (point))))
944 ;; if the same line then promote/demote
945 (if (>= end start) (org-demote-subtree) (org-promote-subtree))
946 ;; if different lines then move
947 (org-cut-subtree)
948
949 (set-buffer ebuf)
950 (goto-char end)
951 (org-back-to-heading)
952 (when (and (eq sbuf ebuf)
953 (equal
954 (point)
955 (save-excursion (goto-char start)
956 (org-back-to-heading) (point))))
957 (outline-end-of-subtree)
958 (end-of-line)
959 (if (eobp) (newline) (forward-char)))
960
961 (when (looking-at outline-regexp)
962 (let ((level (- (match-end 0) (match-beginning 0))))
963 (when (> end (match-end 0))
964 (outline-end-of-subtree)
965 (end-of-line)
966 (if (eobp) (newline) (forward-char))
967 (setq level (1+ level)))
968 (org-paste-subtree level)
969 (save-excursion
970 (outline-end-of-subtree)
971 (when (bolp) (delete-char -1))))))))))
972
973
974(defun org-mouse-transform-to-outline ()
975 (interactive)
976 (org-back-to-heading)
977 (let ((minlevel 1000)
978 (replace-text (concat (match-string 0) "* ")))
979 (beginning-of-line 2)
980 (save-excursion
981 (while (not (or (eobp) (looking-at outline-regexp)))
982 (when (looking-at org-mouse-plain-list-regexp)
983 (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1)))))
984 (forward-line)))
985 (while (not (or (eobp) (looking-at outline-regexp)))
986 (when (and (looking-at org-mouse-plain-list-regexp)
987 (eq minlevel (- (match-end 1) (match-beginning 1))))
988 (replace-match replace-text))
989 (forward-line))))
990
991(defvar _cmd) ;dynamically scoped from `org-with-remote-undo'.
992
993(defun org-mouse-do-remotely (command)
994; (org-agenda-check-no-diary)
995 (when (get-text-property (point) 'org-marker)
996 (let* ((anticol (- (point-at-eol) (point)))
997 (marker (get-text-property (point) 'org-marker))
998 (buffer (marker-buffer marker))
999 (pos (marker-position marker))
1000 (hdmarker (get-text-property (point) 'org-hd-marker))
1001 (buffer-read-only nil)
1002 (newhead "--- removed ---")
1003 (org-mouse-direct nil)
1004 (org-mouse-main-buffer (current-buffer)))
1005 (when (eq (with-current-buffer buffer major-mode) 'org-mode)
1006 (let ((endmarker (save-excursion
1007 (set-buffer buffer)
1008 (outline-end-of-subtree)
1009 (forward-char 1)
1010 (copy-marker (point)))))
1011 (org-with-remote-undo buffer
1012 (with-current-buffer buffer
1013 (widen)
1014 (goto-char pos)
1015 (org-show-hidden-entry)
1016 (save-excursion
1017 (and (outline-next-heading)
1018 (org-flag-heading nil))) ; show the next heading
1019 (org-back-to-heading)
1020 (setq marker (copy-marker (point)))
1021 (goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
1022 (funcall command)
1023 (message "_cmd: %S" _cmd)
1024 (message "this-command: %S" this-command)
1025 (unless (eq (marker-position marker) (marker-position endmarker))
1026 (setq newhead (org-get-heading))))
1027
1028 (beginning-of-line 1)
1029 (save-excursion
1030 (org-agenda-change-all-lines newhead hdmarker 'fixface))))
1031 t))))
1032
1033(defun org-mouse-agenda-context-menu (&optional event)
1034 (or (org-mouse-do-remotely 'org-mouse-context-menu)
1035 (popup-menu
1036 '("Agenda"
1037 ("Agenda Files")
1038 "--"
1039 ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo))
1040 :visible (if (eq last-command 'org-agenda-undo)
1041 org-agenda-pending-undo-list
1042 org-agenda-undo-list)]
1043 ["Rebuild Buffer" org-agenda-redo t]
1044 ["New Diary Entry"
1045 org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t]
1046 "--"
1047 ["Goto Today" org-agenda-goto-today
1048 (org-agenda-check-type nil 'agenda 'timeline) t]
1049 ["Display Calendar" org-agenda-goto-calendar
1050 (org-agenda-check-type nil 'agenda 'timeline) t]
1051 ("Calendar Commands"
1052 ["Phases of the Moon" org-agenda-phases-of-moon
1053 (org-agenda-check-type nil 'agenda 'timeline)]
1054 ["Sunrise/Sunset" org-agenda-sunrise-sunset
1055 (org-agenda-check-type nil 'agenda 'timeline)]
1056 ["Holidays" org-agenda-holidays
1057 (org-agenda-check-type nil 'agenda 'timeline)]
1058 ["Convert" org-agenda-convert-date
1059 (org-agenda-check-type nil 'agenda 'timeline)]
1060 "--"
1061 ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
1062 "--"
1063 ["Day View" org-agenda-day-view
1064 :active (org-agenda-check-type nil 'agenda)
1065 :style radio :selected (equal org-agenda-ndays 1)]
1066 ["Week View" org-agenda-week-view
1067 :active (org-agenda-check-type nil 'agenda)
1068 :style radio :selected (equal org-agenda-ndays 7)]
1069 "--"
1070 ["Show Logbook entries" org-agenda-log-mode
1071 :style toggle :selected org-agenda-show-log
1072 :active (org-agenda-check-type nil 'agenda 'timeline)]
1073 ["Include Diary" org-agenda-toggle-diary
1074 :style toggle :selected org-agenda-include-diary
1075 :active (org-agenda-check-type nil 'agenda)]
1076 ["Use Time Grid" org-agenda-toggle-time-grid
1077 :style toggle :selected org-agenda-use-time-grid
1078 :active (org-agenda-check-type nil 'agenda)]
1079 ["Follow Mode" org-agenda-follow-mode
1080 :style toggle :selected org-agenda-follow-mode]
1081 "--"
1082 ["Quit" org-agenda-quit t]
1083 ["Exit and Release Buffers" org-agenda-exit t]
1084 ))))
1085
1086(defun org-mouse-get-gesture (event)
1087 (let ((startxy (posn-x-y (event-start event)))
1088 (endxy (posn-x-y (event-end event))))
1089 (if (< (car startxy) (car endxy)) :right :left)))
1090
1091
1092; (setq org-agenda-mode-hook nil)
1093(add-hook 'org-agenda-mode-hook
1094 '(lambda ()
1095 (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
1096 (define-key org-agenda-keymap
1097 (if (featurep 'xemacs) [button3] [mouse-3])
1098 'org-mouse-show-context-menu)
1099 (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start)
1100 (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier)
1101 (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later)
1102 (define-key org-agenda-keymap [drag-mouse-3]
1103 '(lambda (event) (interactive "e")
1104 (case (org-mouse-get-gesture event)
1105 (:left (org-agenda-earlier 1))
1106 (:right (org-agenda-later 1)))))))
1107
1108(provide 'org-mouse)
1109
1110;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f
diff --git a/lisp/textmodes/org-publish.el b/lisp/textmodes/org-publish.el
index 807a844c425..0a8e9019827 100644
--- a/lisp/textmodes/org-publish.el
+++ b/lisp/textmodes/org-publish.el
@@ -1,28 +1,28 @@
1;;; org-publish.el --- publish related org-mode files as a website 1;;; org-publish.el --- publish related org-mode files as a website
2 2
3;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. 3;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
4 4
5;; Author: David O'Toole <dto@gnu.org> 5;; Author: David O'Toole <dto@gnu.org>
6;; Keywords: hypermedia, outlines 6;; Keywords: hypermedia, outlines
7;; Version: 1.80a 7;; Version: 1.80b
8 8
9;; This file is free software; you can redistribute it and/or modify 9;; This file is part of GNU Emacs.
10;;
11;; GNU Emacs is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by 12;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 3, or (at your option) 13;; the Free Software Foundation; either version 3, or (at your option)
12;; any later version. 14;; any later version.
13 15
14;; This file is distributed in the hope that it will be useful, 16;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details. 19;; GNU General Public License for more details.
18 20
19;; You should have received a copy of the GNU General Public License 21;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING. If not, write to 22;; along with GNU Emacs; see the file COPYING. If not, write to the
21;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22;; Boston, MA 02110-1301, USA. 24;; Boston, MA 02110-1301, USA.
23 25
24;; This file is part of GNU Emacs.
25
26;;; Commentary: 26;;; Commentary:
27 27
28;; Requires at least version 4.27 of org.el 28;; Requires at least version 4.27 of org.el
@@ -572,11 +572,10 @@ default is 'index.org'."
572With prefix argument, force publishing all files in project." 572With prefix argument, force publishing all files in project."
573 (interactive "P") 573 (interactive "P")
574 (save-window-excursion 574 (save-window-excursion
575 (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name))) 575 (let* ((project-name (org-publish-get-project-from-filename (buffer-file-name))))
576 (org-publish-use-timestamps-flag (if force nil t)))
577 (if (not project-name) 576 (if (not project-name)
578 (error "File %s is not part of any known project." (buffer-file-name))) 577 (error "File %s is not part of any known project." (buffer-file-name)))
579 (org-publish project-name)))) 578 (org-publish project-name (if force nil t)))))
580 579
581 580
582;;;###autoload 581;;;###autoload
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 15ad87f4f23..bc63a962b9c 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
5;; Author: Carsten Dominik <carsten at orgmode dot org> 5;; Author: Carsten Dominik <carsten at orgmode dot org>
6;; Keywords: outlines, hypermedia, calendar, wp 6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org 7;; Homepage: http://orgmode.org
8;; Version: 5.13i 8;; Version: 5.19a
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -77,13 +77,14 @@
77(require 'outline) (require 'noutline) 77(require 'outline) (require 'noutline)
78;; Other stuff we need. 78;; Other stuff we need.
79(require 'time-date) 79(require 'time-date)
80(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
80(require 'easymenu) 81(require 'easymenu)
81 82
82;;;; Customization variables 83;;;; Customization variables
83 84
84;;; Version 85;;; Version
85 86
86(defconst org-version "5.13i" 87(defconst org-version "5.19a"
87 "The version number of the file org.el.") 88 "The version number of the file org.el.")
88(defun org-version () 89(defun org-version ()
89 (interactive) 90 (interactive)
@@ -97,8 +98,12 @@
97 (get-text-property 0 'test (format "%s" x))) 98 (get-text-property 0 'test (format "%s" x)))
98 "Does format transport text properties?") 99 "Does format transport text properties?")
99 100
101(defmacro org-bound-and-true-p (var)
102 "Return the value of symbol VAR if it is bound, else nil."
103 `(and (boundp (quote ,var)) ,var))
104
100(defmacro org-unmodified (&rest body) 105(defmacro org-unmodified (&rest body)
101 "Execute body without changing buffer-modified-p." 106 "Execute body without changing `buffer-modified-p'."
102 `(set-buffer-modified-p 107 `(set-buffer-modified-p
103 (prog1 (buffer-modified-p) ,@body))) 108 (prog1 (buffer-modified-p) ,@body)))
104 109
@@ -251,7 +256,7 @@ Or return the original if not disputed."
251 "Define a key, possibly translated, as returned by `org-key'." 256 "Define a key, possibly translated, as returned by `org-key'."
252 (define-key keymap (org-key key) def)) 257 (define-key keymap (org-key key) def))
253 258
254(defcustom org-ellipsis 'org-ellipsis 259(defcustom org-ellipsis nil
255 "The ellipsis to use in the Org-mode outline. 260 "The ellipsis to use in the Org-mode outline.
256When nil, just use the standard three dots. When a string, use that instead, 261When nil, just use the standard three dots. When a string, use that instead,
257When a face, use the standart 3 dots, but with the specified face. 262When a face, use the standart 3 dots, but with the specified face.
@@ -332,6 +337,25 @@ After a match, group 1 contains the repeat expression.")
332 :tag "Org Reveal Location" 337 :tag "Org Reveal Location"
333 :group 'org-structure) 338 :group 'org-structure)
334 339
340(defconst org-context-choice
341 '(choice
342 (const :tag "Always" t)
343 (const :tag "Never" nil)
344 (repeat :greedy t :tag "Individual contexts"
345 (cons
346 (choice :tag "Context"
347 (const agenda)
348 (const org-goto)
349 (const occur-tree)
350 (const tags-tree)
351 (const link-search)
352 (const mark-goto)
353 (const bookmark-jump)
354 (const isearch)
355 (const default))
356 (boolean))))
357 "Contexts for the reveal options.")
358
335(defcustom org-show-hierarchy-above '((default . t)) 359(defcustom org-show-hierarchy-above '((default . t))
336 "Non-nil means, show full hierarchy when revealing a location. 360 "Non-nil means, show full hierarchy when revealing a location.
337Org-mode often shows locations in an org-mode file which might have 361Org-mode often shows locations in an org-mode file which might have
@@ -350,22 +374,7 @@ contexts. Valid contexts are
350 isearch when exiting from an incremental search 374 isearch when exiting from an incremental search
351 default default for all contexts not set explicitly" 375 default default for all contexts not set explicitly"
352 :group 'org-reveal-location 376 :group 'org-reveal-location
353 :type '(choice 377 :type org-context-choice)
354 (const :tag "Always" t)
355 (const :tag "Never" nil)
356 (repeat :greedy t :tag "Individual contexts"
357 (cons
358 (choice :tag "Context"
359 (const agenda)
360 (const org-goto)
361 (const occur-tree)
362 (const tags-tree)
363 (const link-search)
364 (const mark-goto)
365 (const bookmark-jump)
366 (const isearch)
367 (const default))
368 (boolean)))))
369 378
370(defcustom org-show-following-heading '((default . nil)) 379(defcustom org-show-following-heading '((default . nil))
371 "Non-nil means, show following heading when revealing a location. 380 "Non-nil means, show following heading when revealing a location.
@@ -378,22 +387,7 @@ use the command \\[org-reveal] to show more context.
378Instead of t, this can also be an alist specifying this option for different 387Instead of t, this can also be an alist specifying this option for different
379contexts. See `org-show-hierarchy-above' for valid contexts." 388contexts. See `org-show-hierarchy-above' for valid contexts."
380 :group 'org-reveal-location 389 :group 'org-reveal-location
381 :type '(choice 390 :type org-context-choice)
382 (const :tag "Always" t)
383 (const :tag "Never" nil)
384 (repeat :greedy t :tag "Individual contexts"
385 (cons
386 (choice :tag "Context"
387 (const agenda)
388 (const org-goto)
389 (const occur-tree)
390 (const tags-tree)
391 (const link-search)
392 (const mark-goto)
393 (const bookmark-jump)
394 (const isearch)
395 (const default))
396 (boolean)))))
397 391
398(defcustom org-show-siblings '((default . nil) (isearch t)) 392(defcustom org-show-siblings '((default . nil) (isearch t))
399 "Non-nil means, show all sibling heading when revealing a location. 393 "Non-nil means, show all sibling heading when revealing a location.
@@ -409,22 +403,19 @@ use the command \\[org-reveal] to show more context.
409Instead of t, this can also be an alist specifying this option for different 403Instead of t, this can also be an alist specifying this option for different
410contexts. See `org-show-hierarchy-above' for valid contexts." 404contexts. See `org-show-hierarchy-above' for valid contexts."
411 :group 'org-reveal-location 405 :group 'org-reveal-location
412 :type '(choice 406 :type org-context-choice)
413 (const :tag "Always" t) 407
414 (const :tag "Never" nil) 408(defcustom org-show-entry-below '((default . nil))
415 (repeat :greedy t :tag "Individual contexts" 409 "Non-nil means, show the entry below a headline when revealing a location.
416 (cons 410Org-mode often shows locations in an org-mode file which might have
417 (choice :tag "Context" 411been invisible before. When this is set, the text below the headline that is
418 (const agenda) 412exposed is also shown.
419 (const org-goto) 413
420 (const occur-tree) 414By default this is off for all contexts.
421 (const tags-tree) 415Instead of t, this can also be an alist specifying this option for different
422 (const link-search) 416contexts. See `org-show-hierarchy-above' for valid contexts."
423 (const mark-goto) 417 :group 'org-reveal-location
424 (const bookmark-jump) 418 :type org-context-choice)
425 (const isearch)
426 (const default))
427 (boolean)))))
428 419
429(defgroup org-cycle nil 420(defgroup org-cycle nil
430 "Options concerning visibility cycling in Org-mode." 421 "Options concerning visibility cycling in Org-mode."
@@ -463,7 +454,7 @@ of the buffer."
463 "Where should `org-cycle' emulate TAB. 454 "Where should `org-cycle' emulate TAB.
464nil Never 455nil Never
465white Only in completely white lines 456white Only in completely white lines
466whitestart Only at the beginning of lines, before the first non-white char. 457whitestart Only at the beginning of lines, before the first non-white char
467t Everywhere except in headlines 458t Everywhere except in headlines
468exc-hl-bol Everywhere except at the start of a headline 459exc-hl-bol Everywhere except at the start of a headline
469If TAB is used in a place where it does not emulate TAB, the current subtree 460If TAB is used in a place where it does not emulate TAB, the current subtree
@@ -568,7 +559,7 @@ and a boolean flag as cdr."
568(defcustom org-insert-heading-hook nil 559(defcustom org-insert-heading-hook nil
569 "Hook being run after inserting a new heading." 560 "Hook being run after inserting a new heading."
570 :group 'org-edit-structure 561 :group 'org-edit-structure
571 :type 'boolean) 562 :type 'hook)
572 563
573(defcustom org-enable-fixed-width-editor t 564(defcustom org-enable-fixed-width-editor t
574 "Non-nil means, lines starting with \":\" are treated as fixed-width. 565 "Non-nil means, lines starting with \":\" are treated as fixed-width.
@@ -658,7 +649,9 @@ with \\[org-ctrl-c-ctrl-c\\]."
658(defcustom org-archive-tag "ARCHIVE" 649(defcustom org-archive-tag "ARCHIVE"
659 "The tag that marks a subtree as archived. 650 "The tag that marks a subtree as archived.
660An archived subtree does not open during visibility cycling, and does 651An archived subtree does not open during visibility cycling, and does
661not contribute to the agenda listings." 652not contribute to the agenda listings.
653After changing this, font-lock must be restarted in the relevant buffers to
654get the proper fontification."
662 :group 'org-archive 655 :group 'org-archive
663 :group 'org-keywords 656 :group 'org-keywords
664 :type 'string) 657 :type 'string)
@@ -767,6 +760,17 @@ information."
767 (const :tag "Inherited tags" itags) 760 (const :tag "Inherited tags" itags)
768 (const :tag "Local tags" ltags))) 761 (const :tag "Local tags" ltags)))
769 762
763(defgroup org-imenu-and-speedbar nil
764 "Options concerning imenu and speedbar in Org-mode."
765 :tag "Org Imenu and Speedbar"
766 :group 'org-structure)
767
768(defcustom org-imenu-depth 2
769 "The maximum level for Imenu access to Org-mode headlines.
770This also applied for speedbar access."
771 :group 'org-imenu-and-speedbar
772 :type 'number)
773
770(defgroup org-table nil 774(defgroup org-table nil
771 "Options concerning tables in Org-mode." 775 "Options concerning tables in Org-mode."
772 :tag "Org Table" 776 :tag "Org Table"
@@ -892,7 +896,7 @@ alignment to the right border applies."
892 :type 'number) 896 :type 'number)
893 897
894(defgroup org-table-editing nil 898(defgroup org-table-editing nil
895 "Bahavior of tables during editing in Org-mode." 899 "Behavior of tables during editing in Org-mode."
896 :tag "Org Table Editing" 900 :tag "Org Table Editing"
897 :group 'org-table) 901 :group 'org-table)
898 902
@@ -1031,15 +1035,18 @@ links in Org-mode buffers can have an optional tag after a double colon, e.g.
1031 [[linkkey:tag][description]] 1035 [[linkkey:tag][description]]
1032 1036
1033If REPLACE is a string, the tag will simply be appended to create the link. 1037If REPLACE is a string, the tag will simply be appended to create the link.
1034If the string contains \"%s\", the tag will be inserted there. REPLACE may 1038If the string contains \"%s\", the tag will be inserted there.
1035also be a function that will be called with the tag as the only argument to 1039
1036create the link. See the manual for examples." 1040REPLACE may also be a function that will be called with the tag as the
1041only argument to create the link, which should be returned as a string.
1042
1043See the manual for examples."
1037 :group 'org-link 1044 :group 'org-link
1038 :type 'alist) 1045 :type 'alist)
1039 1046
1040(defcustom org-descriptive-links t 1047(defcustom org-descriptive-links t
1041 "Non-nil means, hide link part and only show description of bracket links. 1048 "Non-nil means, hide link part and only show description of bracket links.
1042Bracket links are like [[link][descritpion]]. This variable sets the initial 1049Bracket links are like [[link][descritpion]]. This variable sets the initial
1043state in new org-mode buffers. The setting can then be toggled on a 1050state in new org-mode buffers. The setting can then be toggled on a
1044per-buffer basis from the Org->Hyperlinks menu." 1051per-buffer basis from the Org->Hyperlinks menu."
1045 :group 'org-link 1052 :group 'org-link
@@ -1049,10 +1056,10 @@ per-buffer basis from the Org->Hyperlinks menu."
1049 "How the path name in file links should be stored. 1056 "How the path name in file links should be stored.
1050Valid values are: 1057Valid values are:
1051 1058
1052relative relative to the current directory, i.e. the directory of the file 1059relative Relative to the current directory, i.e. the directory of the file
1053 into which the link is being inserted. 1060 into which the link is being inserted.
1054absolute absolute path, if possible with ~ for home directory. 1061absolute Absolute path, if possible with ~ for home directory.
1055noabbrev absolute path, no abbreviation of home directory. 1062noabbrev Absolute path, no abbreviation of home directory.
1056adaptive Use relative path for files in the current directory and sub- 1063adaptive Use relative path for files in the current directory and sub-
1057 directories of it. For other files, use an absolute path." 1064 directories of it. For other files, use an absolute path."
1058 :group 'org-link 1065 :group 'org-link
@@ -1404,6 +1411,14 @@ When this variable is nil, `C-c C-c' give you the prompts, and
1404 :group 'org-remember 1411 :group 'org-remember
1405 :type 'boolean) 1412 :type 'boolean)
1406 1413
1414(defcustom org-remember-use-refile-when-interactive t
1415 "Non-nil means, use refile to file a remember note.
1416This is only used when the interactive mode for selecting a filing
1417location is used (see the variable `org-remember-store-without-prompt').
1418When nil, the `org-goto' interface is used."
1419 :group 'org-remember
1420 :type 'boolean)
1421
1407(defcustom org-remember-default-headline "" 1422(defcustom org-remember-default-headline ""
1408 "The headline that should be the default location in the notes file. 1423 "The headline that should be the default location in the notes file.
1409When filing remember notes, the cursor will start at that position. 1424When filing remember notes, the cursor will start at that position.
@@ -1416,9 +1431,9 @@ You can set this on a per-template basis with the variable
1416 "Templates for the creation of remember buffers. 1431 "Templates for the creation of remember buffers.
1417When nil, just let remember make the buffer. 1432When nil, just let remember make the buffer.
1418When not nil, this is a list of 5-element lists. In each entry, the first 1433When not nil, this is a list of 5-element lists. In each entry, the first
1419element is a the name of the template, It should be a single short word. 1434element is the name of the template, which should be a single short word.
1420The second element is a character, a unique key to select this template. 1435The second element is a character, a unique key to select this template.
1421The third element is the template. The forth element is optional and can 1436The third element is the template. The fourth element is optional and can
1422specify a destination file for remember items created with this template. 1437specify a destination file for remember items created with this template.
1423The default file is given by `org-default-notes-file'. An optional fifth 1438The default file is given by `org-default-notes-file'. An optional fifth
1424element can specify the headline in that file that should be offered 1439element can specify the headline in that file that should be offered
@@ -1429,7 +1444,9 @@ The template specifies the structure of the remember buffer. It should have
1429a first line starting with a star, to act as the org-mode headline. 1444a first line starting with a star, to act as the org-mode headline.
1430Furthermore, the following %-escapes will be replaced with content: 1445Furthermore, the following %-escapes will be replaced with content:
1431 1446
1432 %^{prompt} prompt the user for a string and replace this sequence with it. 1447 %^{prompt} Prompt the user for a string and replace this sequence with it.
1448 A default value and a completion table ca be specified like this:
1449 %^{prompt|default|completion2|completion3|...}
1433 %t time stamp, date only 1450 %t time stamp, date only
1434 %T time stamp with date and time 1451 %T time stamp with date and time
1435 %u, %U like the above, but inactive time stamps 1452 %u, %U like the above, but inactive time stamps
@@ -1440,6 +1457,13 @@ Furthermore, the following %-escapes will be replaced with content:
1440 %i initial content, the region when remember is called with C-u. 1457 %i initial content, the region when remember is called with C-u.
1441 If %i is indented, the entire inserted text will be indented 1458 If %i is indented, the entire inserted text will be indented
1442 as well. 1459 as well.
1460 %c content of the clipboard, or current kill ring head
1461 %^g prompt for tags, with completion on tags in target file
1462 %^G prompt for tags, with completion all tags in all agenda files
1463 %:keyword specific information for certain link types, see below
1464 %[pathname] insert the contents of the file given by `pathname'
1465 %(sexp) evaluate elisp `(sexp)' and replace with the result
1466 %! Store this note immediately after filling the template
1443 1467
1444 %? After completing the template, position cursor here. 1468 %? After completing the template, position cursor here.
1445 1469
@@ -1483,7 +1507,9 @@ calendar | %:type %:date"
1483 1507
1484(defcustom org-reverse-note-order nil 1508(defcustom org-reverse-note-order nil
1485 "Non-nil means, store new notes at the beginning of a file or entry. 1509 "Non-nil means, store new notes at the beginning of a file or entry.
1486When nil, new notes will be filed to the end of a file or entry." 1510When nil, new notes will be filed to the end of a file or entry.
1511This can also be a list with cons cells of regular expressions that
1512are matched against file names, and values."
1487 :group 'org-remember 1513 :group 'org-remember
1488 :type '(choice 1514 :type '(choice
1489 (const :tag "Reverse always" t) 1515 (const :tag "Reverse always" t)
@@ -1491,6 +1517,51 @@ When nil, new notes will be filed to the end of a file or entry."
1491 (repeat :tag "By file name regexp" 1517 (repeat :tag "By file name regexp"
1492 (cons regexp boolean)))) 1518 (cons regexp boolean))))
1493 1519
1520(defcustom org-refile-targets nil
1521 "Targets for refiling entries with \\[org-refile].
1522This is list of cons cells. Each cell contains:
1523- a specification of the files to be considered, either a list of files,
1524 or a symbol whose function or value fields will be used to retrieve
1525 a file name or a list of file names. Nil means, refile to a different
1526 heading in the current buffer.
1527- A specification of how to find candidate refile targets. This may be
1528 any of
1529 - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
1530 This tag has to be present in all target headlines, inheritance will
1531 not be considered.
1532 - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
1533 todo keyword.
1534 - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
1535 headlines that are refiling targets.
1536 - a cons cell (:level . N). Any headline of level N is considered a target.
1537 - a cons cell (:maxlevel . N). Any headline with level <= N is a target."
1538;; FIXME: what if there are a var and func with same name???
1539 :group 'org-remember
1540 :type '(repeat
1541 (cons
1542 (choice :value org-agenda-files
1543 (const :tag "All agenda files" org-agenda-files)
1544 (const :tag "Current buffer" nil)
1545 (function) (variable) (file))
1546 (choice :tag "Identify target headline by"
1547 (cons :tag "Specific tag" (const :tag) (string))
1548 (cons :tag "TODO keyword" (const :todo) (string))
1549 (cons :tag "Regular expression" (const :regexp) (regexp))
1550 (cons :tag "Level number" (const :level) (integer))
1551 (cons :tag "Max Level number" (const :maxlevel) (integer))))))
1552
1553(defcustom org-refile-use-outline-path nil
1554 "Non-nil means, provide refile targets as paths.
1555So a level 3 headline will be available as level1/level2/level3.
1556When the value is `file', also include the file name (without directory)
1557into the path. When `full-file-path', include the full file path."
1558 :group 'org-remember
1559 :type '(choice
1560 (const :tag "Not" nil)
1561 (const :tag "Yes" t)
1562 (const :tag "Start with file name" file)
1563 (const :tag "Start with full file path" full-file-path)))
1564
1494(defgroup org-todo nil 1565(defgroup org-todo nil
1495 "Options concerning TODO items in Org-mode." 1566 "Options concerning TODO items in Org-mode."
1496 :tag "Org TODO" 1567 :tag "Org TODO"
@@ -1712,6 +1783,15 @@ Nil means, clock will keep running until stopped explicitly with
1712 :group 'org-progress 1783 :group 'org-progress
1713 :type 'boolean) 1784 :type 'boolean)
1714 1785
1786(defcustom org-clock-in-switch-to-state nil
1787 "Set task to a special todo state while clocking it.
1788The value should be the state to which the entry should be switched."
1789 :group 'org-progress
1790 :group 'org-todo
1791 :type '(choice
1792 (const :tag "Don't force a state" nil)
1793 (string :tag "State")))
1794
1715(defgroup org-priorities nil 1795(defgroup org-priorities nil
1716 "Priorities in Org-mode." 1796 "Priorities in Org-mode."
1717 :tag "Org Priorities" 1797 :tag "Org Priorities"
@@ -1795,13 +1875,52 @@ end of the second format."
1795 (concat "[" (substring f 1 -1) "]") 1875 (concat "[" (substring f 1 -1) "]")
1796 f))) 1876 f)))
1797 1877
1798(defcustom org-popup-calendar-for-date-prompt t 1878(defcustom org-read-date-prefer-future t
1879 "Non-nil means, assume future for incomplete date input from user.
1880This affects the following situations:
18811. The user gives a day, but no month.
1882 For example, if today is the 15th, and you enter \"3\", Org-mode will
1883 read this as the third of *next* month. However, if you enter \"17\",
1884 it will be considered as *this* month.
18852. The user gives a month but not a year.
1886 For example, if it is april and you enter \"feb 2\", this will be read
1887 as feb 2, *next* year. \"May 5\", however, will be this year.
1888
1889When this option is nil, the current month and year will always be used
1890as defaults."
1891 :group 'org-time
1892 :type 'boolean)
1893
1894(defcustom org-read-date-display-live t
1895 "Non-nil means, display current interpretation of date prompt live.
1896This display will be in an overlay, in the minibuffer."
1897 :group 'org-time
1898 :type 'boolean)
1899
1900(defcustom org-read-date-popup-calendar t
1799 "Non-nil means, pop up a calendar when prompting for a date. 1901 "Non-nil means, pop up a calendar when prompting for a date.
1800In the calendar, the date can be selected with mouse-1. However, the 1902In the calendar, the date can be selected with mouse-1. However, the
1801minibuffer will also be active, and you can simply enter the date as well. 1903minibuffer will also be active, and you can simply enter the date as well.
1802When nil, only the minibuffer will be available." 1904When nil, only the minibuffer will be available."
1803 :group 'org-time 1905 :group 'org-time
1804 :type 'boolean) 1906 :type 'boolean)
1907(if (fboundp 'defvaralias)
1908 (defvaralias 'org-popup-calendar-for-date-prompt
1909 'org-read-date-popup-calendar))
1910
1911(defcustom org-extend-today-until 0
1912 "The hour when your day really ends.
1913This has influence for the following applications:
1914- When switching the agenda to \"today\". It it is still earlier than
1915 the time given here, the day recognized as TODAY is actually yesterday.
1916- When a date is read from the user and it is still before the time given
1917 here, the current date and time will be assumed to be yesterday, 23:59.
1918
1919FIXME:
1920IMPORTANT: This is still a very experimental feature, it may disappear
1921again or it may be extended to mean more things."
1922 :group 'org-time
1923 :type 'number)
1805 1924
1806(defcustom org-edit-timestamp-down-means-later nil 1925(defcustom org-edit-timestamp-down-means-later nil
1807 "Non-nil means, S-down will increase the time in a time stamp. 1926 "Non-nil means, S-down will increase the time in a time stamp.
@@ -1816,6 +1935,13 @@ moved to the new date."
1816 :group 'org-time 1935 :group 'org-time
1817 :type 'boolean) 1936 :type 'boolean)
1818 1937
1938(defcustom org-clock-heading-function nil
1939 "When non-nil, should be a function to create `org-clock-heading'.
1940This is the string shown in the mode line when a clock is running.
1941The function is called with point at the beginning of the headline."
1942 :group 'org-time ; FIXME: Should we have a separate group????
1943 :type 'function)
1944
1819(defgroup org-tags nil 1945(defgroup org-tags nil
1820 "Options concerning tags in Org-mode." 1946 "Options concerning tags in Org-mode."
1821 :tag "Org Tags" 1947 :tag "Org Tags"
@@ -1929,16 +2055,23 @@ lined-up with respect to each other."
1929 2055
1930(defcustom org-use-property-inheritance nil 2056(defcustom org-use-property-inheritance nil
1931 "Non-nil means, properties apply also for sublevels. 2057 "Non-nil means, properties apply also for sublevels.
1932This can cause significant overhead when doing a search, so this is turned 2058This setting is only relevant during property searches, not when querying
1933off by default. 2059an entry with `org-entry-get'. To retrieve a property with inheritance,
2060you need to call `org-entry-get' with the inheritance flag.
2061Turning this on can cause significant overhead when doing a search, so
2062this is turned off by default.
1934When nil, only the properties directly given in the current entry count. 2063When nil, only the properties directly given in the current entry count.
2064The value may also be a list of properties that shouldhave inheritance.
1935 2065
1936However, note that some special properties use inheritance under special 2066However, note that some special properties use inheritance under special
1937circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, 2067circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
1938and the properties ending in \"_ALL\" when they are used as descriptor 2068and the properties ending in \"_ALL\" when they are used as descriptor
1939for valid values of a property." 2069for valid values of a property."
1940 :group 'org-properties 2070 :group 'org-properties
1941 :type 'boolean) 2071 :type '(choice
2072 (const :tag "Not" nil)
2073 (const :tag "Always" nil)
2074 (repeat :tag "Specific properties" (string :tag "Property"))))
1942 2075
1943(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" 2076(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
1944 "The default column format, if no other format has been defined. 2077 "The default column format, if no other format has been defined.
@@ -1998,7 +2131,7 @@ agenda file per line."
1998 (repeat :tag "List of files and directories" file) 2131 (repeat :tag "List of files and directories" file)
1999 (file :tag "Store list in a file\n" :value "~/.agenda_files"))) 2132 (file :tag "Store list in a file\n" :value "~/.agenda_files")))
2000 2133
2001(defcustom org-agenda-file-regexp "\\.org\\'" 2134(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'"
2002 "Regular expression to match files for `org-agenda-files'. 2135 "Regular expression to match files for `org-agenda-files'.
2003If any element in the list in that variable contains a directory instead 2136If any element in the list in that variable contains a directory instead
2004of a normal file, all files in that directory that are matched by this 2137of a normal file, all files in that directory that are matched by this
@@ -2318,6 +2451,11 @@ deadlines are always turned off when the item is DONE."
2318 :group 'org-agenda-skip 2451 :group 'org-agenda-skip
2319 :type 'boolean) 2452 :type 'boolean)
2320 2453
2454(defcustom org-agenda-skip-timestamp-if-done nil
2455 "Non-nil means don't select item by timestamp or -range if it is DONE."
2456 :group 'org-agenda-skip
2457 :type 'boolean)
2458
2321(defcustom org-timeline-show-empty-dates 3 2459(defcustom org-timeline-show-empty-dates 3
2322 "Non-nil means, `org-timeline' also shows dates without an entry. 2460 "Non-nil means, `org-timeline' also shows dates without an entry.
2323When nil, only the days which actually have entries are shown. 2461When nil, only the days which actually have entries are shown.
@@ -2400,7 +2538,9 @@ Valid values are:
2400current-window Display in the current window 2538current-window Display in the current window
2401other-window Just display in another window. 2539other-window Just display in another window.
2402dedicated-frame Create one new frame, and re-use it each time. 2540dedicated-frame Create one new frame, and re-use it each time.
2403new-frame Make a new frame each time." 2541new-frame Make a new frame each time. Note that in this case
2542 previously-made indirect buffers are kept, and you need to
2543 kill these buffers yourself."
2404 :group 'org-structure 2544 :group 'org-structure
2405 :group 'org-agenda-windows 2545 :group 'org-agenda-windows
2406 :type '(choice 2546 :type '(choice
@@ -2542,18 +2682,19 @@ a grid line."
2542 :tag "Org Agenda Sorting" 2682 :tag "Org Agenda Sorting"
2543 :group 'org-agenda) 2683 :group 'org-agenda)
2544 2684
2545(let ((sorting-choice 2685(defconst org-sorting-choice
2546 '(choice 2686 '(choice
2547 (const time-up) (const time-down) 2687 (const time-up) (const time-down)
2548 (const category-keep) (const category-up) (const category-down) 2688 (const category-keep) (const category-up) (const category-down)
2549 (const tag-down) (const tag-up) 2689 (const tag-down) (const tag-up)
2550 (const priority-up) (const priority-down)))) 2690 (const priority-up) (const priority-down))
2551 2691 "Sorting choices.")
2552 (defcustom org-agenda-sorting-strategy 2692
2553 '((agenda time-up category-keep priority-down) 2693(defcustom org-agenda-sorting-strategy
2554 (todo category-keep priority-down) 2694 '((agenda time-up category-keep priority-down)
2555 (tags category-keep priority-down)) 2695 (todo category-keep priority-down)
2556 "Sorting structure for the agenda items of a single day. 2696 (tags category-keep priority-down))
2697 "Sorting structure for the agenda items of a single day.
2557This is a list of symbols which will be used in sequence to determine 2698This is a list of symbols which will be used in sequence to determine
2558if an entry should be listed before another entry. The following 2699if an entry should be listed before another entry. The following
2559symbols are recognized: 2700symbols are recognized:
@@ -2580,17 +2721,21 @@ the sequence given in `org-agenda-files'. Within each category sort by
2580priority. 2721priority.
2581 2722
2582Leaving out `category-keep' would mean that items will be sorted across 2723Leaving out `category-keep' would mean that items will be sorted across
2583categories by priority." 2724categories by priority.
2725
2726Instead of a single list, this can also be a set of list for specific
2727contents, with a context symbol in the car of the list, any of
2728`agenda', `todo', `tags' for the corresponding agenda views."
2584 :group 'org-agenda-sorting 2729 :group 'org-agenda-sorting
2585 :type `(choice 2730 :type `(choice
2586 (repeat :tag "General" ,sorting-choice) 2731 (repeat :tag "General" ,org-sorting-choice)
2587 (list :tag "Individually" 2732 (list :tag "Individually"
2588 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) 2733 (cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
2589 (repeat ,sorting-choice)) 2734 (repeat ,org-sorting-choice))
2590 (cons (const :tag "Strategy for TODO lists" todo) 2735 (cons (const :tag "Strategy for TODO lists" todo)
2591 (repeat ,sorting-choice)) 2736 (repeat ,org-sorting-choice))
2592 (cons (const :tag "Strategy for Tags matches" tags) 2737 (cons (const :tag "Strategy for Tags matches" tags)
2593 (repeat ,sorting-choice)))))) 2738 (repeat ,org-sorting-choice)))))
2594 2739
2595(defcustom org-sort-agenda-notime-is-late t 2740(defcustom org-sort-agenda-notime-is-late t
2596 "Non-nil means, items without time are considered late. 2741 "Non-nil means, items without time are considered late.
@@ -2673,9 +2818,16 @@ See also the variables `org-agenda-remove-times-when-in-prefix' and
2673 "The compiled version of the most recently used prefix format. 2818 "The compiled version of the most recently used prefix format.
2674See the variable `org-agenda-prefix-format'.") 2819See the variable `org-agenda-prefix-format'.")
2675 2820
2821(defcustom org-agenda-todo-keyword-format "%-1s"
2822 "Format for the TODO keyword in agenda lines.
2823Set this to something like \"%-12s\" if you want all TODO keywords
2824to occupy a fixed space in the agenda display."
2825 :group 'org-agenda-line-format
2826 :type 'string)
2827
2676(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") 2828(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
2677 "Text preceeding scheduled items in the agenda view. 2829 "Text preceeding scheduled items in the agenda view.
2678THis is a list with two strings. The first applies when the item is 2830This is a list with two strings. The first applies when the item is
2679scheduled on the current day. The second applies when it has been scheduled 2831scheduled on the current day. The second applies when it has been scheduled
2680previously, it may contain a %d to capture how many days ago the item was 2832previously, it may contain a %d to capture how many days ago the item was
2681scheduled." 2833scheduled."
@@ -2811,23 +2963,23 @@ This is a property list with the following properties:
2811 :tag "Org Export General" 2963 :tag "Org Export General"
2812 :group 'org-export) 2964 :group 'org-export)
2813 2965
2814(defcustom org-export-publishing-directory "." 2966;; FIXME
2815 "Path to the location where exported files should be located. 2967(defvar org-export-publishing-directory nil)
2816This path may be relative to the directory where the Org-mode file lives. 2968
2817The default is to put them into the same directory as the Org-mode file. 2969(defcustom org-export-with-special-strings t
2818The variable may also be an alist with export types `:html', `:ascii', 2970 "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export.
2819`:ical', `:LaTeX', or `:xoxo' and the corresponding directories. 2971When this option is turned on, these strings will be exported as:
2820If a directory path is relative, it is interpreted relative to the 2972
2821directory where the exported Org-mode files lives." 2973 Org HTML LaTeX
2822 :group 'org-export-general 2974 -----+----------+--------
2823 :type '(choice 2975 \\- &shy; \\-
2824 (directory) 2976 -- &ndash; --
2825 (repeat 2977 --- &mdash; ---
2826 (cons 2978 ... &hellip; \ldots
2827 (choice :tag "Type" 2979
2828 (const :html) (const :LaTeX) 2980This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
2829 (const :ascii) (const :ical) (const :xoxo)) 2981 :group 'org-export-translation
2830 (directory))))) 2982 :type 'boolean)
2831 2983
2832(defcustom org-export-language-setup 2984(defcustom org-export-language-setup
2833 '(("en" "Author" "Date" "Table of Contents") 2985 '(("en" "Author" "Date" "Table of Contents")
@@ -3032,6 +3184,20 @@ This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
3032 (const :tag "Only with braces" {}) 3184 (const :tag "Only with braces" {})
3033 (const :tag "Never interpret" nil))) 3185 (const :tag "Never interpret" nil)))
3034 3186
3187(defcustom org-export-with-special-strings t
3188 "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export.
3189When this option is turned on, these strings will be exported as:
3190
3191\\- : &shy;
3192-- : &ndash;
3193--- : &mdash;
3194
3195Not all export backends support this, but HTML does.
3196
3197This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
3198 :group 'org-export-translation
3199 :type 'boolean)
3200
3035(defcustom org-export-with-TeX-macros t 3201(defcustom org-export-with-TeX-macros t
3036 "Non-nil means, interpret simple TeX-like macros when exporting. 3202 "Non-nil means, interpret simple TeX-like macros when exporting.
3037For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;. 3203For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;.
@@ -3138,7 +3304,7 @@ In the given sequence, these characters will be used for level 1, 2, ..."
3138 3304
3139(defcustom org-export-ascii-bullets '(?* ?+ ?-) 3305(defcustom org-export-ascii-bullets '(?* ?+ ?-)
3140 "Bullet characters for headlines converted to lists in ASCII export. 3306 "Bullet characters for headlines converted to lists in ASCII export.
3141The first character is is used for the first lest level generated in this 3307The first character is used for the first lest level generated in this
3142way, and so on. If there are more levels than characters given here, 3308way, and so on. If there are more levels than characters given here,
3143the list will be repeated. 3309the list will be repeated.
3144Note that plain lists will keep the same bullets as the have in the 3310Note that plain lists will keep the same bullets as the have in the
@@ -3377,8 +3543,20 @@ Changing this variable requires a restart of Emacs to take effect."
3377 :group 'org-font-lock 3543 :group 'org-font-lock
3378 :type 'boolean) 3544 :type 'boolean)
3379 3545
3546(defcustom org-highlight-latex-fragments-and-specials nil
3547 "Non-nil means, fontify what is treated specially by the exporters."
3548 :group 'org-font-lock
3549 :type 'boolean)
3550
3551(defcustom org-hide-emphasis-markers nil
3552 "Non-nil mean font-lock should hide the emphasis marker characters."
3553 :group 'org-font-lock
3554 :type 'boolean)
3555
3380(defvar org-emph-re nil 3556(defvar org-emph-re nil
3381 "Regular expression for matching emphasis.") 3557 "Regular expression for matching emphasis.")
3558(defvar org-verbatim-re nil
3559 "Regular expression for matching verbatim text.")
3382(defvar org-emphasis-regexp-components) ; defined just below 3560(defvar org-emphasis-regexp-components) ; defined just below
3383(defvar org-emphasis-alist) ; defined just below 3561(defvar org-emphasis-alist) ; defined just below
3384(defun org-set-emph-re (var val) 3562(defun org-set-emph-re (var val)
@@ -3393,33 +3571,53 @@ Changing this variable requires a restart of Emacs to take effect."
3393 (border (nth 2 e)) 3571 (border (nth 2 e))
3394 (body (nth 3 e)) 3572 (body (nth 3 e))
3395 (nl (nth 4 e)) 3573 (nl (nth 4 e))
3396 (stacked (nth 5 e)) 3574 (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil
3397 (body1 (concat body "*?")) 3575 (body1 (concat body "*?"))
3398 (markers (mapconcat 'car org-emphasis-alist ""))) 3576 (markers (mapconcat 'car org-emphasis-alist ""))
3577 (vmarkers (mapconcat
3578 (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) ""))
3579 org-emphasis-alist "")))
3399 ;; make sure special characters appear at the right position in the class 3580 ;; make sure special characters appear at the right position in the class
3400 (if (string-match "\\^" markers) 3581 (if (string-match "\\^" markers)
3401 (setq markers (concat (replace-match "" t t markers) "^"))) 3582 (setq markers (concat (replace-match "" t t markers) "^")))
3402 (if (string-match "-" markers) 3583 (if (string-match "-" markers)
3403 (setq markers (concat (replace-match "" t t markers) "-"))) 3584 (setq markers (concat (replace-match "" t t markers) "-")))
3585 (if (string-match "\\^" vmarkers)
3586 (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
3587 (if (string-match "-" vmarkers)
3588 (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
3404 (if (> nl 0) 3589 (if (> nl 0)
3405 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," 3590 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
3406 (int-to-string nl) "\\}"))) 3591 (int-to-string nl) "\\}")))
3407 ;; Make the regexp 3592 ;; Make the regexp
3408 (setq org-emph-re 3593 (setq org-emph-re
3409 (concat "\\([" pre (if stacked markers) "]\\|^\\)" 3594 (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)"
3410 "\\(" 3595 "\\("
3411 "\\([" markers "]\\)" 3596 "\\([" markers "]\\)"
3412 "\\(" 3597 "\\("
3598 "[^" border "]\\|"
3413 "[^" border (if (and nil stacked) markers) "]" 3599 "[^" border (if (and nil stacked) markers) "]"
3414 body1 3600 body1
3415 "[^" border (if (and nil stacked) markers) "]" 3601 "[^" border (if (and nil stacked) markers) "]"
3416 "\\)" 3602 "\\)"
3417 "\\3\\)" 3603 "\\3\\)"
3418 "\\([" post (if stacked markers) "]\\|$\\)"))))) 3604 "\\([" post (if (and nil stacked) markers) "]\\|$\\)"))
3605 (setq org-verbatim-re
3606 (concat "\\([" pre "]\\|^\\)"
3607 "\\("
3608 "\\([" vmarkers "]\\)"
3609 "\\("
3610 "[^" border "]\\|"
3611 "[^" border "]"
3612 body1
3613 "[^" border "]"
3614 "\\)"
3615 "\\3\\)"
3616 "\\([" post "]\\|$\\)")))))
3419 3617
3420(defcustom org-emphasis-regexp-components 3618(defcustom org-emphasis-regexp-components
3421 '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1 nil) 3619 '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1)
3422 "Components used to build the reqular expression for emphasis. 3620 "Components used to build the regular expression for emphasis.
3423This is a list with 6 entries. Terminology: In an emphasis string 3621This is a list with 6 entries. Terminology: In an emphasis string
3424like \" *strong word* \", we call the initial space PREMATCH, the final 3622like \" *strong word* \", we call the initial space PREMATCH, the final
3425space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters 3623space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters
@@ -3432,10 +3630,7 @@ border The chars *forbidden* as border characters.
3432body-regexp A regexp like \".\" to match a body character. Don't use 3630body-regexp A regexp like \".\" to match a body character. Don't use
3433 non-shy groups here, and don't allow newline here. 3631 non-shy groups here, and don't allow newline here.
3434newline The maximum number of newlines allowed in an emphasis exp. 3632newline The maximum number of newlines allowed in an emphasis exp.
3435stacked Non-nil means, allow stacked styles. This works only in HTML 3633
3436 export. When this is set, all marker characters (as given in
3437 `org-emphasis-alist') will be allowed as pre/post, aiding
3438 inside-out matching.
3439Use customize to modify this, or restart Emacs after changing it." 3634Use customize to modify this, or restart Emacs after changing it."
3440 :group 'org-font-lock 3635 :group 'org-font-lock
3441 :set 'org-set-emph-re 3636 :set 'org-set-emph-re
@@ -3445,16 +3640,17 @@ Use customize to modify this, or restart Emacs after changing it."
3445 (sexp :tag "Forbidden chars in border ") 3640 (sexp :tag "Forbidden chars in border ")
3446 (sexp :tag "Regexp for body ") 3641 (sexp :tag "Regexp for body ")
3447 (integer :tag "number of newlines allowed") 3642 (integer :tag "number of newlines allowed")
3448 (boolean :tag "Stacking allowed "))) 3643 (option (boolean :tag "Stacking (DISABLED) "))))
3449 3644
3450(defcustom org-emphasis-alist 3645(defcustom org-emphasis-alist
3451 '(("*" bold "<b>" "</b>") 3646 '(("*" bold "<b>" "</b>")
3452 ("/" italic "<i>" "</i>") 3647 ("/" italic "<i>" "</i>")
3453 ("_" underline "<u>" "</u>") 3648 ("_" underline "<u>" "</u>")
3454 ("=" org-code "<code>" "</code>") 3649 ("=" org-code "<code>" "</code>" verbatim)
3650 ("~" org-verbatim "" "" verbatim)
3455 ("+" (:strike-through t) "<del>" "</del>") 3651 ("+" (:strike-through t) "<del>" "</del>")
3456 ) 3652 )
3457"Special syntax for emphasized text. 3653 "Special syntax for emphasized text.
3458Text starting and ending with a special character will be emphasized, for 3654Text starting and ending with a special character will be emphasized, for
3459example *bold*, _underlined_ and /italic/. This variable sets the marker 3655example *bold*, _underlined_ and /italic/. This variable sets the marker
3460characters, the face to be used by font-lock for highlighting in Org-mode 3656characters, the face to be used by font-lock for highlighting in Org-mode
@@ -3469,7 +3665,8 @@ Use customize to modify this, or restart Emacs after changing it."
3469 (face :tag "Font-lock-face") 3665 (face :tag "Font-lock-face")
3470 (plist :tag "Face property list")) 3666 (plist :tag "Face property list"))
3471 (string :tag "HTML start tag") 3667 (string :tag "HTML start tag")
3472 (string :tag "HTML end tag")))) 3668 (string :tag "HTML end tag")
3669 (option (const verbatim)))))
3473 3670
3474;;; The faces 3671;;; The faces
3475 3672
@@ -3508,6 +3705,7 @@ any other entries, and any resulting duplicates will be removed entirely."
3508 (t (or (assoc (car e) r) (push e r))))) 3705 (t (or (assoc (car e) r) (push e r)))))
3509 (nreverse r))) 3706 (nreverse r)))
3510 (t specs))) 3707 (t specs)))
3708(put 'org-compatible-face 'lisp-indent-function 1)
3511 3709
3512(defface org-hide 3710(defface org-hide
3513 '((((background light)) (:foreground "white")) 3711 '((((background light)) (:foreground "white"))
@@ -3518,108 +3716,98 @@ color of the frame."
3518 :group 'org-faces) 3716 :group 'org-faces)
3519 3717
3520(defface org-level-1 ;; font-lock-function-name-face 3718(defface org-level-1 ;; font-lock-function-name-face
3521 (org-compatible-face 3719 (org-compatible-face 'outline-1
3522 'outline-1 3720 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3523 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3721 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3524 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3722 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3525 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3723 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3526 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3724 (((class color) (min-colors 8)) (:foreground "blue" :bold t))
3527 (((class color) (min-colors 8)) (:foreground "blue" :bold t)) 3725 (t (:bold t))))
3528 (t (:bold t))))
3529 "Face used for level 1 headlines." 3726 "Face used for level 1 headlines."
3530 :group 'org-faces) 3727 :group 'org-faces)
3531 3728
3532(defface org-level-2 ;; font-lock-variable-name-face 3729(defface org-level-2 ;; font-lock-variable-name-face
3533 (org-compatible-face 3730 (org-compatible-face 'outline-2
3534 'outline-2 3731 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
3535 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) 3732 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
3536 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) 3733 (((class color) (min-colors 8) (background light)) (:foreground "yellow"))
3537 (((class color) (min-colors 8) (background light)) (:foreground "yellow")) 3734 (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t))
3538 (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) 3735 (t (:bold t))))
3539 (t (:bold t))))
3540 "Face used for level 2 headlines." 3736 "Face used for level 2 headlines."
3541 :group 'org-faces) 3737 :group 'org-faces)
3542 3738
3543(defface org-level-3 ;; font-lock-keyword-face 3739(defface org-level-3 ;; font-lock-keyword-face
3544 (org-compatible-face 3740 (org-compatible-face 'outline-3
3545 'outline-3 3741 '((((class color) (min-colors 88) (background light)) (:foreground "Purple"))
3546 '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) 3742 (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
3547 (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) 3743 (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
3548 (((class color) (min-colors 16) (background light)) (:foreground "Purple")) 3744 (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
3549 (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) 3745 (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t))
3550 (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) 3746 (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t))
3551 (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) 3747 (t (:bold t))))
3552 (t (:bold t))))
3553 "Face used for level 3 headlines." 3748 "Face used for level 3 headlines."
3554 :group 'org-faces) 3749 :group 'org-faces)
3555 3750
3556(defface org-level-4 ;; font-lock-comment-face 3751(defface org-level-4 ;; font-lock-comment-face
3557 (org-compatible-face 3752 (org-compatible-face 'outline-4
3558 'outline-4 3753 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3559 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 3754 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3560 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 3755 (((class color) (min-colors 16) (background light)) (:foreground "red"))
3561 (((class color) (min-colors 16) (background light)) (:foreground "red")) 3756 (((class color) (min-colors 16) (background dark)) (:foreground "red1"))
3562 (((class color) (min-colors 16) (background dark)) (:foreground "red1")) 3757 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
3563 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) 3758 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3564 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 3759 (t (:bold t))))
3565 (t (:bold t))))
3566 "Face used for level 4 headlines." 3760 "Face used for level 4 headlines."
3567 :group 'org-faces) 3761 :group 'org-faces)
3568 3762
3569(defface org-level-5 ;; font-lock-type-face 3763(defface org-level-5 ;; font-lock-type-face
3570 (org-compatible-face 3764 (org-compatible-face 'outline-5
3571 'outline-5 3765 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
3572 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) 3766 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
3573 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) 3767 (((class color) (min-colors 8)) (:foreground "green"))))
3574 (((class color) (min-colors 8)) (:foreground "green"))))
3575 "Face used for level 5 headlines." 3768 "Face used for level 5 headlines."
3576 :group 'org-faces) 3769 :group 'org-faces)
3577 3770
3578(defface org-level-6 ;; font-lock-constant-face 3771(defface org-level-6 ;; font-lock-constant-face
3579 (org-compatible-face 3772 (org-compatible-face 'outline-6
3580 'outline-6 3773 '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
3581 '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) 3774 (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
3582 (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) 3775 (((class color) (min-colors 8)) (:foreground "magenta"))))
3583 (((class color) (min-colors 8)) (:foreground "magenta"))))
3584 "Face used for level 6 headlines." 3776 "Face used for level 6 headlines."
3585 :group 'org-faces) 3777 :group 'org-faces)
3586 3778
3587(defface org-level-7 ;; font-lock-builtin-face 3779(defface org-level-7 ;; font-lock-builtin-face
3588 (org-compatible-face 3780 (org-compatible-face 'outline-7
3589 'outline-7 3781 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
3590 '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) 3782 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
3591 (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) 3783 (((class color) (min-colors 8)) (:foreground "blue"))))
3592 (((class color) (min-colors 8)) (:foreground "blue"))))
3593 "Face used for level 7 headlines." 3784 "Face used for level 7 headlines."
3594 :group 'org-faces) 3785 :group 'org-faces)
3595 3786
3596(defface org-level-8 ;; font-lock-string-face 3787(defface org-level-8 ;; font-lock-string-face
3597 (org-compatible-face 3788 (org-compatible-face 'outline-8
3598 'outline-8 3789 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
3599 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) 3790 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
3600 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) 3791 (((class color) (min-colors 8)) (:foreground "green"))))
3601 (((class color) (min-colors 8)) (:foreground "green"))))
3602 "Face used for level 8 headlines." 3792 "Face used for level 8 headlines."
3603 :group 'org-faces) 3793 :group 'org-faces)
3604 3794
3605(defface org-special-keyword ;; font-lock-string-face 3795(defface org-special-keyword ;; font-lock-string-face
3606 (org-compatible-face 3796 (org-compatible-face nil
3607 nil 3797 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
3608 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) 3798 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
3609 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) 3799 (t (:italic t))))
3610 (t (:italic t))))
3611 "Face used for special keywords." 3800 "Face used for special keywords."
3612 :group 'org-faces) 3801 :group 'org-faces)
3613 3802
3614(defface org-drawer ;; font-lock-function-name-face 3803(defface org-drawer ;; font-lock-function-name-face
3615 (org-compatible-face 3804 (org-compatible-face nil
3616 nil 3805 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3617 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3806 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3618 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3807 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3619 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3808 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3620 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3809 (((class color) (min-colors 8)) (:foreground "blue" :bold t))
3621 (((class color) (min-colors 8)) (:foreground "blue" :bold t)) 3810 (t (:bold t))))
3622 (t (:bold t))))
3623 "Face used for drawers." 3811 "Face used for drawers."
3624 :group 'org-faces) 3812 :group 'org-faces)
3625 3813
@@ -3628,15 +3816,14 @@ color of the frame."
3628 :group 'org-faces) 3816 :group 'org-faces)
3629 3817
3630(defface org-column 3818(defface org-column
3631 (org-compatible-face 3819 (org-compatible-face nil
3632 nil 3820 '((((class color) (min-colors 16) (background light))
3633 '((((class color) (min-colors 16) (background light)) 3821 (:background "grey90"))
3634 (:background "grey90")) 3822 (((class color) (min-colors 16) (background dark))
3635 (((class color) (min-colors 16) (background dark)) 3823 (:background "grey30"))
3636 (:background "grey30")) 3824 (((class color) (min-colors 8))
3637 (((class color) (min-colors 8)) 3825 (:background "cyan" :foreground "black"))
3638 (:background "cyan" :foreground "black")) 3826 (t (:inverse-video t))))
3639 (t (:inverse-video t))))
3640 "Face for column display of entry properties." 3827 "Face for column display of entry properties."
3641 :group 'org-faces) 3828 :group 'org-faces)
3642 3829
@@ -3647,29 +3834,27 @@ color of the frame."
3647 :family (face-attribute 'default :family))) 3834 :family (face-attribute 'default :family)))
3648 3835
3649(defface org-warning 3836(defface org-warning
3650 (org-compatible-face 3837 (org-compatible-face 'font-lock-warning-face
3651 'font-lock-warning-face 3838 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
3652 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) 3839 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
3653 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) 3840 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
3654 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) 3841 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3655 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 3842 (t (:bold t))))
3656 (t (:bold t))))
3657 "Face for deadlines and TODO keywords." 3843 "Face for deadlines and TODO keywords."
3658 :group 'org-faces) 3844 :group 'org-faces)
3659 3845
3660(defface org-archived ; similar to shadow 3846(defface org-archived ; similar to shadow
3661 (org-compatible-face 3847 (org-compatible-face 'shadow
3662 'shadow 3848 '((((class color grayscale) (min-colors 88) (background light))
3663 '((((class color grayscale) (min-colors 88) (background light)) 3849 (:foreground "grey50"))
3664 (:foreground "grey50")) 3850 (((class color grayscale) (min-colors 88) (background dark))
3665 (((class color grayscale) (min-colors 88) (background dark)) 3851 (:foreground "grey70"))
3666 (:foreground "grey70")) 3852 (((class color) (min-colors 8) (background light))
3667 (((class color) (min-colors 8) (background light)) 3853 (:foreground "green"))
3668 (:foreground "green")) 3854 (((class color) (min-colors 8) (background dark))
3669 (((class color) (min-colors 8) (background dark)) 3855 (:foreground "yellow"))))
3670 (:foreground "yellow")))) 3856 "Face for headline with the ARCHIVE tag."
3671 "Face for headline with the ARCHIVE tag." 3857 :group 'org-faces)
3672 :group 'org-faces)
3673 3858
3674(defface org-link 3859(defface org-link
3675 '((((class color) (background light)) (:foreground "Purple" :underline t)) 3860 '((((class color) (background light)) (:foreground "Purple" :underline t))
@@ -3679,8 +3864,8 @@ color of the frame."
3679 :group 'org-faces) 3864 :group 'org-faces)
3680 3865
3681(defface org-ellipsis 3866(defface org-ellipsis
3682 '((((class color) (background light)) (:foreground "DarkGoldenrod" :strike-through t)) 3867 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
3683 (((class color) (background dark)) (:foreground "LightGoldenrod" :strike-through t)) 3868 (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t))
3684 (t (:strike-through t))) 3869 (t (:strike-through t)))
3685 "Face for the ellipsis in folded text." 3870 "Face for the ellipsis in folded text."
3686 :group 'org-faces) 3871 :group 'org-faces)
@@ -3712,32 +3897,29 @@ color of the frame."
3712 :group 'org-faces) 3897 :group 'org-faces)
3713 3898
3714(defface org-todo ; font-lock-warning-face 3899(defface org-todo ; font-lock-warning-face
3715 (org-compatible-face 3900 (org-compatible-face nil
3716 nil 3901 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
3717 '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) 3902 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
3718 (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) 3903 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
3719 (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) 3904 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3720 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 3905 (t (:inverse-video t :bold t))))
3721 (t (:inverse-video t :bold t))))
3722 "Face for TODO keywords." 3906 "Face for TODO keywords."
3723 :group 'org-faces) 3907 :group 'org-faces)
3724 3908
3725(defface org-done ;; font-lock-type-face 3909(defface org-done ;; font-lock-type-face
3726 (org-compatible-face 3910 (org-compatible-face nil
3727 nil 3911 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t))
3728 '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) 3912 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
3729 (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) 3913 (((class color) (min-colors 8)) (:foreground "green"))
3730 (((class color) (min-colors 8)) (:foreground "green")) 3914 (t (:bold t))))
3731 (t (:bold t))))
3732 "Face used for todo keywords that indicate DONE items." 3915 "Face used for todo keywords that indicate DONE items."
3733 :group 'org-faces) 3916 :group 'org-faces)
3734 3917
3735(defface org-headline-done ;; font-lock-string-face 3918(defface org-headline-done ;; font-lock-string-face
3736 (org-compatible-face 3919 (org-compatible-face nil
3737 nil 3920 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
3738 '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) 3921 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
3739 (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) 3922 (((class color) (min-colors 8) (background light)) (:bold nil))))
3740 (((class color) (min-colors 8) (background light)) (:bold nil))))
3741 "Face used to indicate that a headline is DONE. 3923 "Face used to indicate that a headline is DONE.
3742This face is only used if `org-fontify-done-headline' is set. If applies 3924This face is only used if `org-fontify-done-headline' is set. If applies
3743to the part of the headline after the DONE keyword." 3925to the part of the headline after the DONE keyword."
@@ -3756,84 +3938,91 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
3756 (sexp :tag "face")))) 3938 (sexp :tag "face"))))
3757 3939
3758(defface org-table ;; font-lock-function-name-face 3940(defface org-table ;; font-lock-function-name-face
3759 (org-compatible-face 3941 (org-compatible-face nil
3760 nil 3942 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3761 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3943 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3762 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3944 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3763 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3945 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3764 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3946 (((class color) (min-colors 8) (background light)) (:foreground "blue"))
3765 (((class color) (min-colors 8) (background light)) (:foreground "blue")) 3947 (((class color) (min-colors 8) (background dark)))))
3766 (((class color) (min-colors 8) (background dark)))))
3767 "Face used for tables." 3948 "Face used for tables."
3768 :group 'org-faces) 3949 :group 'org-faces)
3769 3950
3770(defface org-formula 3951(defface org-formula
3771 (org-compatible-face 3952 (org-compatible-face nil
3772 nil 3953 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3773 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 3954 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3774 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 3955 (((class color) (min-colors 8) (background light)) (:foreground "red"))
3775 (((class color) (min-colors 8) (background light)) (:foreground "red")) 3956 (((class color) (min-colors 8) (background dark)) (:foreground "red"))
3776 (((class color) (min-colors 8) (background dark)) (:foreground "red")) 3957 (t (:bold t :italic t))))
3777 (t (:bold t :italic t))))
3778 "Face for formulas." 3958 "Face for formulas."
3779 :group 'org-faces) 3959 :group 'org-faces)
3780 3960
3781(defface org-code 3961(defface org-code
3782 (org-compatible-face 3962 (org-compatible-face nil
3783 nil 3963 '((((class color grayscale) (min-colors 88) (background light))
3784 '((((class color grayscale) (min-colors 88) (background light)) 3964 (:foreground "grey50"))
3785 (:foreground "grey50")) 3965 (((class color grayscale) (min-colors 88) (background dark))
3786 (((class color grayscale) (min-colors 88) (background dark)) 3966 (:foreground "grey70"))
3787 (:foreground "grey70")) 3967 (((class color) (min-colors 8) (background light))
3788 (((class color) (min-colors 8) (background light)) 3968 (:foreground "green"))
3789 (:foreground "green")) 3969 (((class color) (min-colors 8) (background dark))
3790 (((class color) (min-colors 8) (background dark)) 3970 (:foreground "yellow"))))
3791 (:foreground "yellow")))) 3971 "Face for fixed-with text like code snippets."
3792 "Face for fixed-with text like code snippets." 3972 :group 'org-faces
3793 :group 'org-faces 3973 :version "22.1")
3794 :version "22.1") 3974
3975(defface org-verbatim
3976 (org-compatible-face nil
3977 '((((class color grayscale) (min-colors 88) (background light))
3978 (:foreground "grey50" :underline t))
3979 (((class color grayscale) (min-colors 88) (background dark))
3980 (:foreground "grey70" :underline t))
3981 (((class color) (min-colors 8) (background light))
3982 (:foreground "green" :underline t))
3983 (((class color) (min-colors 8) (background dark))
3984 (:foreground "yellow" :underline t))))
3985 "Face for fixed-with text like code snippets."
3986 :group 'org-faces
3987 :version "22.1")
3795 3988
3796(defface org-agenda-structure ;; font-lock-function-name-face 3989(defface org-agenda-structure ;; font-lock-function-name-face
3797 (org-compatible-face 3990 (org-compatible-face nil
3798 nil 3991 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
3799 '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) 3992 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
3800 (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) 3993 (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
3801 (((class color) (min-colors 16) (background light)) (:foreground "Blue")) 3994 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
3802 (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) 3995 (((class color) (min-colors 8)) (:foreground "blue" :bold t))
3803 (((class color) (min-colors 8)) (:foreground "blue" :bold t)) 3996 (t (:bold t))))
3804 (t (:bold t))))
3805 "Face used in agenda for captions and dates." 3997 "Face used in agenda for captions and dates."
3806 :group 'org-faces) 3998 :group 'org-faces)
3807 3999
3808(defface org-scheduled-today 4000(defface org-scheduled-today
3809 (org-compatible-face 4001 (org-compatible-face nil
3810 nil 4002 '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
3811 '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) 4003 (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
3812 (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) 4004 (((class color) (min-colors 8)) (:foreground "green"))
3813 (((class color) (min-colors 8)) (:foreground "green")) 4005 (t (:bold t :italic t))))
3814 (t (:bold t :italic t))))
3815 "Face for items scheduled for a certain day." 4006 "Face for items scheduled for a certain day."
3816 :group 'org-faces) 4007 :group 'org-faces)
3817 4008
3818(defface org-scheduled-previously 4009(defface org-scheduled-previously
3819 (org-compatible-face 4010 (org-compatible-face nil
3820 nil 4011 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3821 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 4012 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3822 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 4013 (((class color) (min-colors 8) (background light)) (:foreground "red"))
3823 (((class color) (min-colors 8) (background light)) (:foreground "red")) 4014 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3824 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 4015 (t (:bold t))))
3825 (t (:bold t))))
3826 "Face for items scheduled previously, and not yet done." 4016 "Face for items scheduled previously, and not yet done."
3827 :group 'org-faces) 4017 :group 'org-faces)
3828 4018
3829(defface org-upcoming-deadline 4019(defface org-upcoming-deadline
3830 (org-compatible-face 4020 (org-compatible-face nil
3831 nil 4021 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
3832 '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) 4022 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
3833 (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) 4023 (((class color) (min-colors 8) (background light)) (:foreground "red"))
3834 (((class color) (min-colors 8) (background light)) (:foreground "red")) 4024 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
3835 (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) 4025 (t (:bold t))))
3836 (t (:bold t))))
3837 "Face for items scheduled previously, and not yet done." 4026 "Face for items scheduled previously, and not yet done."
3838 :group 'org-faces) 4027 :group 'org-faces)
3839 4028
@@ -3842,8 +4031,8 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)."
3842 (0.5 . org-upcoming-deadline) 4031 (0.5 . org-upcoming-deadline)
3843 (0.0 . default)) 4032 (0.0 . default))
3844 "Faces for showing deadlines in the agenda. 4033 "Faces for showing deadlines in the agenda.
3845This is a list of cons cells. The cdr of each cess is a face to be used, 4034This is a list of cons cells. The cdr of each cell is a face to be used,
3846and it can also just be a like like '(:foreground \"yellow\"). 4035and it can also just be like '(:foreground \"yellow\").
3847Each car is a fraction of the head-warning time that must have passed for 4036Each car is a fraction of the head-warning time that must have passed for
3848this the face in the cdr to be used for display. The numbers must be 4037this the face in the cdr to be used for display. The numbers must be
3849given in descending order. The head-warning time is normally taken 4038given in descending order. The head-warning time is normally taken
@@ -3862,12 +4051,23 @@ month and 365.24 days for a year)."
3862 (number :tag "Fraction of head-warning time passed") 4051 (number :tag "Fraction of head-warning time passed")
3863 (sexp :tag "Face")))) 4052 (sexp :tag "Face"))))
3864 4053
4054;; FIXME: this is not a good face yet.
4055(defface org-agenda-restriction-lock
4056 (org-compatible-face nil
4057 '((((class color) (min-colors 88) (background light)) (:background "yellow1"))
4058 (((class color) (min-colors 88) (background dark)) (:background "skyblue4"))
4059 (((class color) (min-colors 16) (background light)) (:background "yellow1"))
4060 (((class color) (min-colors 16) (background dark)) (:background "skyblue4"))
4061 (((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
4062 (t (:inverse-video t))))
4063 "Face for showing the agenda restriction lock."
4064 :group 'org-faces)
4065
3865(defface org-time-grid ;; font-lock-variable-name-face 4066(defface org-time-grid ;; font-lock-variable-name-face
3866 (org-compatible-face 4067 (org-compatible-face nil
3867 nil 4068 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
3868 '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) 4069 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
3869 (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) 4070 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
3870 (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
3871 "Face used for time grids." 4071 "Face used for time grids."
3872 :group 'org-faces) 4072 :group 'org-faces)
3873 4073
@@ -3883,7 +4083,24 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3883 :type 'number 4083 :type 'number
3884 :group 'org-faces) 4084 :group 'org-faces)
3885 4085
3886;;; Function declarations. 4086;;; Functions and variables from ther packages
4087;; Declared here to avoid compiler warnings
4088
4089(eval-and-compile
4090 (unless (fboundp 'declare-function)
4091 (defmacro declare-function (fn file &optional arglist fileonly))))
4092
4093;; XEmacs only
4094(defvar outline-mode-menu-heading)
4095(defvar outline-mode-menu-show)
4096(defvar outline-mode-menu-hide)
4097(defvar zmacs-regions) ; XEmacs regions
4098
4099;; Emacs only
4100(defvar mark-active)
4101
4102;; Various packages
4103;; FIXME: get the argument lists for the UNKNOWN stuff
3887(declare-function add-to-diary-list "diary-lib" 4104(declare-function add-to-diary-list "diary-lib"
3888 (date string specifier &optional marker globcolor literal)) 4105 (date string specifier &optional marker globcolor literal))
3889(declare-function table--at-cell-p "table" (position &optional object at-column)) 4106(declare-function table--at-cell-p "table" (position &optional object at-column))
@@ -3899,6 +4116,8 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3899(declare-function bibtex-generate-autokey "bibtex" ()) 4116(declare-function bibtex-generate-autokey "bibtex" ())
3900(declare-function bibtex-parse-entry "bibtex" (&optional content)) 4117(declare-function bibtex-parse-entry "bibtex" (&optional content))
3901(declare-function bibtex-url "bibtex" (&optional pos no-browse)) 4118(declare-function bibtex-url "bibtex" (&optional pos no-browse))
4119(defvar calc-embedded-close-formula)
4120(defvar calc-embedded-open-formula)
3902(declare-function calendar-astro-date-string "cal-julian" (&optional date)) 4121(declare-function calendar-astro-date-string "cal-julian" (&optional date))
3903(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) 4122(declare-function calendar-bahai-date-string "cal-bahai" (&optional date))
3904(declare-function calendar-check-holidays "holidays" (date)) 4123(declare-function calendar-check-holidays "holidays" (date))
@@ -3915,10 +4134,23 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3915(declare-function calendar-julian-date-string "cal-julian" (&optional date)) 4134(declare-function calendar-julian-date-string "cal-julian" (&optional date))
3916(declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) 4135(declare-function calendar-mayan-date-string "cal-mayan" (&optional date))
3917(declare-function calendar-persian-date-string "cal-persia" (&optional date)) 4136(declare-function calendar-persian-date-string "cal-persia" (&optional date))
4137(defvar calendar-mode-map)
4138(defvar original-date) ; dynamically scoped in calendar.el does scope this
3918(declare-function cdlatex-tab "ext:cdlatex" ()) 4139(declare-function cdlatex-tab "ext:cdlatex" ())
3919(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) 4140(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
4141(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
4142(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type))
4143(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t)
4144;; backward compatibility to old version of elmo
4145(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (&rest unknown) t)
4146(defvar font-lock-unfontify-region-function)
3920(declare-function gnus-article-show-summary "gnus-art" ()) 4147(declare-function gnus-article-show-summary "gnus-art" ())
3921(declare-function gnus-summary-last-subject "gnus-sum" ()) 4148(declare-function gnus-summary-last-subject "gnus-sum" ())
4149(defvar gnus-other-frame-object)
4150(defvar gnus-group-name)
4151(defvar gnus-article-current)
4152(defvar Info-current-file)
4153(defvar Info-current-node)
3922(declare-function mh-display-msg "mh-show" (msg-num folder-name)) 4154(declare-function mh-display-msg "mh-show" (msg-num folder-name))
3923(declare-function mh-find-path "mh-utils" ()) 4155(declare-function mh-find-path "mh-utils" ())
3924(declare-function mh-get-header-field "mh-utils" (field)) 4156(declare-function mh-get-header-field "mh-utils" (field))
@@ -3934,16 +4166,25 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3934(declare-function mh-show-msg "mh-show" (msg)) 4166(declare-function mh-show-msg "mh-show" (msg))
3935(declare-function mh-show-show "mh-show" t t) 4167(declare-function mh-show-show "mh-show" t t)
3936(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data)) 4168(declare-function mh-visit-folder "mh-folder" (folder &optional range index-data))
3937(declare-function org-export-latex-cleaned-string "org-export-latex" (&optional commentsp)) 4169(defvar mh-progs)
4170(defvar mh-current-folder)
4171(defvar mh-show-folder-buffer)
4172(defvar mh-index-folder)
4173(defvar mh-searcher)
4174(declare-function org-export-latex-cleaned-string "org-export-latex" ())
3938(declare-function parse-time-string "parse-time" (string)) 4175(declare-function parse-time-string "parse-time" (string))
3939(declare-function remember "remember" (&optional initial)) 4176(declare-function remember "remember" (&optional initial))
3940(declare-function remember-buffer-desc "remember" ()) 4177(declare-function remember-buffer-desc "remember" ())
4178(defvar remember-save-after-remembering)
4179(defvar remember-data-file)
4180(defvar remember-register)
4181(defvar remember-buffer)
4182(defvar remember-handler-functions)
4183(defvar remember-annotation-functions)
3941(declare-function rmail-narrow-to-non-pruned-header "rmail" ()) 4184(declare-function rmail-narrow-to-non-pruned-header "rmail" ())
3942(declare-function rmail-show-message "rmail" (&optional n no-summary)) 4185(declare-function rmail-show-message "rmail" (&optional n no-summary))
3943(declare-function rmail-what-message "rmail" ()) 4186(declare-function rmail-what-message "rmail" ())
3944(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) 4187(defvar texmathp-why)
3945(declare-function elmo-message-entity-field "ext:elmo-msgdb" (entity field &optional type))
3946(declare-function elmo-message-field "ext:elmo" (folder number field &optional type) t)
3947(declare-function vm-beginning-of-message "ext:vm-page" ()) 4188(declare-function vm-beginning-of-message "ext:vm-page" ())
3948(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) 4189(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
3949(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep)) 4190(declare-function vm-get-header-contents "ext:vm-summary" (message header-name-regexp &optional clump-sep))
@@ -3953,6 +4194,12 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3953(declare-function vm-su-message-id "ext:vm-summary" (m)) 4194(declare-function vm-su-message-id "ext:vm-summary" (m))
3954(declare-function vm-su-subject "ext:vm-summary" (m)) 4195(declare-function vm-su-subject "ext:vm-summary" (m))
3955(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) 4196(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
4197(defvar vm-message-pointer)
4198(defvar vm-folder-directory)
4199(defvar w3m-current-url)
4200(defvar w3m-current-title)
4201;; backward compatibility to old version of wl
4202(declare-function wl-summary-buffer-msgdb "ext:wl-folder" (&rest unknown) t)
3956(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache)) 4203(declare-function wl-folder-get-elmo-folder "ext:wl-folder" (entity &optional no-cache))
3957(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit)) 4204(declare-function wl-summary-goto-folder-subr "ext:wl-summary" (&optional name scan-type other-window sticky interactive scoring force-exit))
3958(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) 4205(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id))
@@ -3960,6 +4207,12 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc."
3960(declare-function wl-summary-line-subject "ext:wl-summary" ()) 4207(declare-function wl-summary-line-subject "ext:wl-summary" ())
3961(declare-function wl-summary-message-number "ext:wl-summary" ()) 4208(declare-function wl-summary-message-number "ext:wl-summary" ())
3962(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) 4209(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
4210(defvar wl-summary-buffer-elmo-folder)
4211(defvar wl-summary-buffer-folder-name)
4212(declare-function speedbar-line-directory "speedbar" (&optional depth))
4213
4214(defvar org-latex-regexps)
4215(defvar constants-unit-system)
3963 4216
3964;;; Variables for pre-computed regular expressions, all buffer local 4217;;; Variables for pre-computed regular expressions, all buffer local
3965 4218
@@ -4134,7 +4387,7 @@ means to push this value onto the list in the variable.")
4134 ((equal key "CATEGORY") 4387 ((equal key "CATEGORY")
4135 (if (string-match "[ \t]+$" value) 4388 (if (string-match "[ \t]+$" value)
4136 (setq value (replace-match "" t t value))) 4389 (setq value (replace-match "" t t value)))
4137 (setq cat (intern value))) 4390 (setq cat value))
4138 ((member key '("SEQ_TODO" "TODO")) 4391 ((member key '("SEQ_TODO" "TODO"))
4139 (push (cons 'sequence (org-split-string value splitre)) kwds)) 4392 (push (cons 'sequence (org-split-string value splitre)) kwds))
4140 ((equal key "TYP_TODO") 4393 ((equal key "TYP_TODO")
@@ -4176,7 +4429,9 @@ means to push this value onto the list in the variable.")
4176 (remove-text-properties 0 (length arch) 4429 (remove-text-properties 0 (length arch)
4177 '(face t fontified t) arch))) 4430 '(face t fontified t) arch)))
4178 ))) 4431 )))
4179 (and cat (org-set-local 'org-category cat)) 4432 (when cat
4433 (org-set-local 'org-category (intern cat))
4434 (push (cons "CATEGORY" cat) props))
4180 (when prio 4435 (when prio
4181 (if (< (length prio) 3) (setq prio '("A" "C" "B"))) 4436 (if (< (length prio) 3) (setq prio '("A" "C" "B")))
4182 (setq prio (mapcar 'string-to-char prio)) 4437 (setq prio (mapcar 'string-to-char prio))
@@ -4332,7 +4587,7 @@ means to push this value onto the list in the variable.")
4332 "\\|" org-closed-string "\\|" org-clock-string 4587 "\\|" org-closed-string "\\|" org-clock-string
4333 "\\)\\>\\)") 4588 "\\)\\>\\)")
4334 ) 4589 )
4335 4590 (org-compute-latex-and-specials-regexp)
4336 (org-set-font-lock-defaults))) 4591 (org-set-font-lock-defaults)))
4337 4592
4338(defun org-remove-keyword-keys (list) 4593(defun org-remove-keyword-keys (list)
@@ -4342,6 +4597,31 @@ means to push this value onto the list in the variable.")
4342 x)) 4597 x))
4343 list)) 4598 list))
4344 4599
4600;; FIXME: this could be done much better, using second characters etc.
4601(defun org-assign-fast-keys (alist)
4602 "Assign fast keys to a keyword-key alist.
4603Respect keys that are already there."
4604 (let (new e k c c1 c2 (char ?a))
4605 (while (setq e (pop alist))
4606 (cond
4607 ((equal e '(:startgroup)) (push e new))
4608 ((equal e '(:endgroup)) (push e new))
4609 (t
4610 (setq k (car e) c2 nil)
4611 (if (cdr e)
4612 (setq c (cdr e))
4613 ;; automatically assign a character.
4614 (setq c1 (string-to-char
4615 (downcase (substring
4616 k (if (= (string-to-char k) ?@) 1 0)))))
4617 (if (or (rassoc c1 new) (rassoc c1 alist))
4618 (while (or (rassoc char new) (rassoc char alist))
4619 (setq char (1+ char)))
4620 (setq c2 c1))
4621 (setq c (or c2 char)))
4622 (push (cons k c) new))))
4623 (nreverse new)))
4624
4345;;; Some variables ujsed in various places 4625;;; Some variables ujsed in various places
4346 4626
4347(defvar org-window-configuration nil 4627(defvar org-window-configuration nil
@@ -4350,49 +4630,6 @@ means to push this value onto the list in the variable.")
4350 "Function to be called when `C-c C-c' is used. 4630 "Function to be called when `C-c C-c' is used.
4351This is for getting out of special buffers like remember.") 4631This is for getting out of special buffers like remember.")
4352 4632
4353;;; Foreign variables, to inform the compiler
4354
4355;; XEmacs only
4356(defvar outline-mode-menu-heading)
4357(defvar outline-mode-menu-show)
4358(defvar outline-mode-menu-hide)
4359(defvar zmacs-regions) ; XEmacs regions
4360;; Emacs only
4361(defvar mark-active)
4362
4363;; Packages that org-mode interacts with
4364(defvar calc-embedded-close-formula)
4365(defvar calc-embedded-open-formula)
4366(defvar font-lock-unfontify-region-function)
4367(defvar org-goto-start-pos)
4368(defvar vm-message-pointer)
4369(defvar vm-folder-directory)
4370(defvar wl-summary-buffer-elmo-folder)
4371(defvar wl-summary-buffer-folder-name)
4372(defvar gnus-other-frame-object)
4373(defvar gnus-group-name)
4374(defvar gnus-article-current)
4375(defvar w3m-current-url)
4376(defvar w3m-current-title)
4377(defvar mh-progs)
4378(defvar mh-current-folder)
4379(defvar mh-show-folder-buffer)
4380(defvar mh-index-folder)
4381(defvar mh-searcher)
4382(defvar calendar-mode-map)
4383(defvar Info-current-file)
4384(defvar Info-current-node)
4385(defvar texmathp-why)
4386(defvar remember-save-after-remembering)
4387(defvar remember-data-file)
4388(defvar remember-register)
4389(defvar remember-buffer)
4390(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
4391(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
4392(defvar org-latex-regexps)
4393(defvar constants-unit-system)
4394
4395(defvar original-date) ; dynamically scoped in calendar.el does scope this
4396 4633
4397;; FIXME: Occasionally check by commenting these, to make sure 4634;; FIXME: Occasionally check by commenting these, to make sure
4398;; no other functions uses these, forgetting to let-bind them. 4635;; no other functions uses these, forgetting to let-bind them.
@@ -4402,7 +4639,6 @@ This is for getting out of special buffers like remember.")
4402(defvar date) 4639(defvar date)
4403(defvar description) 4640(defvar description)
4404 4641
4405
4406;; Defined somewhere in this file, but used before definition. 4642;; Defined somewhere in this file, but used before definition.
4407(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized 4643(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
4408(defvar org-agenda-buffer-name) 4644(defvar org-agenda-buffer-name)
@@ -4495,8 +4731,10 @@ Works on both Emacs and XEmacs."
4495 (if org-ignore-region 4731 (if org-ignore-region
4496 nil 4732 nil
4497 (if (featurep 'xemacs) 4733 (if (featurep 'xemacs)
4498 (region-active-p) 4734 (and zmacs-regions (region-active-p))
4499 (use-region-p)))) 4735 (if (fboundp 'use-region-p)
4736 (use-region-p)
4737 (and transient-mark-mode mark-active))))) ; Emacs 22 and before
4500 4738
4501;; Invisibility compatibility 4739;; Invisibility compatibility
4502 4740
@@ -4624,6 +4862,10 @@ The following commands are available:
4624; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping 4862; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping
4625 (org-set-local 'comment-padding " ") 4863 (org-set-local 'comment-padding " ")
4626 4864
4865 ;; Imenu
4866 (org-set-local 'imenu-create-index-function
4867 'org-imenu-get-tree)
4868
4627 ;; Make isearch reveal context 4869 ;; Make isearch reveal context
4628 (if (or (featurep 'xemacs) 4870 (if (or (featurep 'xemacs)
4629 (not (boundp 'outline-isearch-open-invisible-function))) 4871 (not (boundp 'outline-isearch-open-invisible-function)))
@@ -4704,7 +4946,7 @@ that will be added to PLIST. Returns the string that was modified."
4704 4946
4705(defconst org-non-link-chars "]\t\n\r<>") 4947(defconst org-non-link-chars "]\t\n\r<>")
4706(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" 4948(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm"
4707 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) 4949 "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp" "message"))
4708(defvar org-link-re-with-space nil 4950(defvar org-link-re-with-space nil
4709 "Matches a link with spaces, optional angular brackets around it.") 4951 "Matches a link with spaces, optional angular brackets around it.")
4710(defvar org-link-re-with-space2 nil 4952(defvar org-link-re-with-space2 nil
@@ -4749,7 +4991,7 @@ This should be called after the variable `org-link-types' has changed."
4749 "\\)>") 4991 "\\)>")
4750 org-plain-link-re 4992 org-plain-link-re
4751 (concat 4993 (concat
4752 "\\(" (mapconcat 'identity org-link-types "\\|") "\\):" 4994 "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
4753 "\\([^]\t\n\r<>,;() ]+\\)") 4995 "\\([^]\t\n\r<>,;() ]+\\)")
4754 org-bracket-link-regexp 4996 org-bracket-link-regexp
4755 "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" 4997 "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
@@ -4810,7 +5052,12 @@ The time stamps may be either active or inactive.")
4810 org-emphasis-alist))) 5052 org-emphasis-alist)))
4811 (add-text-properties (match-beginning 2) (match-end 2) 5053 (add-text-properties (match-beginning 2) (match-end 2)
4812 '(font-lock-multiline t)) 5054 '(font-lock-multiline t))
4813 (backward-char 1)))) 5055 (when org-hide-emphasis-markers
5056 (add-text-properties (match-end 4) (match-beginning 5)
5057 '(invisible org-link))
5058 (add-text-properties (match-beginning 3) (match-end 3)
5059 '(invisible org-link)))))
5060 (backward-char 1))
4814 rtn)) 5061 rtn))
4815 5062
4816(defun org-emphasize (&optional char) 5063(defun org-emphasize (&optional char)
@@ -4925,10 +5172,10 @@ We use a macro so that the test can happen at compilation time."
4925 (ip (org-maybe-intangible 5172 (ip (org-maybe-intangible
4926 (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props 5173 (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props
4927 'keymap org-mouse-map 'mouse-face 'highlight 5174 'keymap org-mouse-map 'mouse-face 'highlight
4928 'help-echo help))) 5175 'font-lock-multiline t 'help-echo help)))
4929 (vp (list 'rear-nonsticky org-nonsticky-props 5176 (vp (list 'rear-nonsticky org-nonsticky-props
4930 'keymap org-mouse-map 'mouse-face 'highlight 5177 'keymap org-mouse-map 'mouse-face 'highlight
4931 'help-echo help))) 5178 ' font-lock-multiline t 'help-echo help)))
4932 ;; We need to remove the invisible property here. Table narrowing 5179 ;; We need to remove the invisible property here. Table narrowing
4933 ;; may have made some of this invisible. 5180 ;; may have made some of this invisible.
4934 (remove-text-properties (match-beginning 0) (match-end 0) 5181 (remove-text-properties (match-beginning 0) (match-end 0)
@@ -4998,6 +5245,97 @@ We use a macro so that the test can happen at compilation time."
4998 (goto-char e) 5245 (goto-char e)
4999 t))) 5246 t)))
5000 5247
5248(defvar org-latex-and-specials-regexp nil
5249 "Regular expression for highlighting export special stuff.")
5250(defvar org-match-substring-regexp)
5251(defvar org-match-substring-with-braces-regexp)
5252(defvar org-export-html-special-string-regexps)
5253
5254(defun org-compute-latex-and-specials-regexp ()
5255 "Compute regular expression for stuff treated specially by exporters."
5256 (if (not org-highlight-latex-fragments-and-specials)
5257 (org-set-local 'org-latex-and-specials-regexp nil)
5258 (let*
5259 ((matchers (plist-get org-format-latex-options :matchers))
5260 (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x))
5261 org-latex-regexps)))
5262 (options (org-combine-plists (org-default-export-plist)
5263 (org-infile-export-plist)))
5264 (org-export-with-sub-superscripts (plist-get options :sub-superscript))
5265 (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments))
5266 (org-export-with-TeX-macros (plist-get options :TeX-macros))
5267 (org-export-html-expand (plist-get options :expand-quoted-html))
5268 (org-export-with-special-strings (plist-get options :special-strings))
5269 (re-sub
5270 (cond
5271 ((equal org-export-with-sub-superscripts '{})
5272 (list org-match-substring-with-braces-regexp))
5273 (org-export-with-sub-superscripts
5274 (list org-match-substring-regexp))
5275 (t nil)))
5276 (re-latex
5277 (if org-export-with-LaTeX-fragments
5278 (mapcar (lambda (x) (nth 1 x)) latexs)))
5279 (re-macros
5280 (if org-export-with-TeX-macros
5281 (list (concat "\\\\"
5282 (regexp-opt
5283 (append (mapcar 'car org-html-entities)
5284 (if (boundp 'org-latex-entities)
5285 org-latex-entities nil))
5286 'words))) ; FIXME
5287 ))
5288 ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
5289 (re-special (if org-export-with-special-strings
5290 (mapcar (lambda (x) (car x))
5291 org-export-html-special-string-regexps)))
5292 (re-rest
5293 (delq nil
5294 (list
5295 (if org-export-html-expand "@<[^>\n]+>")
5296 ))))
5297 (org-set-local
5298 'org-latex-and-specials-regexp
5299 (mapconcat 'identity (append re-latex re-sub re-macros re-special
5300 re-rest) "\\|")))))
5301
5302(defface org-latex-and-export-specials
5303 (let ((font (cond ((assq :inherit custom-face-attributes)
5304 '(:inherit underline))
5305 (t '(:underline t)))))
5306 `((((class grayscale) (background light))
5307 (:foreground "DimGray" ,@font))
5308 (((class grayscale) (background dark))
5309 (:foreground "LightGray" ,@font))
5310 (((class color) (background light))
5311 (:foreground "SaddleBrown"))
5312 (((class color) (background dark))
5313 (:foreground "burlywood"))
5314 (t (,@font))))
5315 "Face used to highlight math latex and other special exporter stuff."
5316 :group 'org-faces)
5317
5318(defun org-do-latex-and-special-faces (limit)
5319 "Run through the buffer and add overlays to links."
5320 (when org-latex-and-specials-regexp
5321 (let (rtn d)
5322 (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp
5323 limit t))
5324 (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0))
5325 'face))
5326 '(org-code org-verbatim underline)))
5327 (progn
5328 (setq rtn t
5329 d (cond ((member (char-after (1+ (match-beginning 0)))
5330 '(?_ ?^)) 1)
5331 (t 0)))
5332 (font-lock-prepend-text-property
5333 (+ d (match-beginning 0)) (match-end 0)
5334 'face 'org-latex-and-export-specials)
5335 (add-text-properties (+ d (match-beginning 0)) (match-end 0)
5336 '(font-lock-multiline t)))))
5337 rtn)))
5338
5001(defun org-restart-font-lock () 5339(defun org-restart-font-lock ()
5002 "Restart font-lock-mode, to force refontification." 5340 "Restart font-lock-mode, to force refontification."
5003 (when (and (boundp 'font-lock-mode) font-lock-mode) 5341 (when (and (boundp 'font-lock-mode) font-lock-mode)
@@ -5064,7 +5402,7 @@ between words."
5064 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 5402 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
5065 (1 'org-table t)) 5403 (1 'org-table t))
5066 ;; Table internals 5404 ;; Table internals
5067 '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) 5405 '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
5068 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) 5406 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
5069 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) 5407 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
5070 ;; Drawers 5408 ;; Drawers
@@ -5113,14 +5451,17 @@ between words."
5113 (if org-provide-checkbox-statistics 5451 (if org-provide-checkbox-statistics
5114 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" 5452 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
5115 (0 (org-get-checkbox-statistics-face) t))) 5453 (0 (org-get-checkbox-statistics-face) t)))
5454 (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)")
5455 '(1 'org-archived prepend))
5456 ;; Specials
5457 '(org-do-latex-and-special-faces)
5458 ;; Code
5459 '(org-activate-code (1 'org-code t))
5116 ;; COMMENT 5460 ;; COMMENT
5117 (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string 5461 (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
5118 "\\|" org-quote-string "\\)\\>") 5462 "\\|" org-quote-string "\\)\\>")
5119 '(1 'org-special-keyword t)) 5463 '(1 'org-special-keyword t))
5120 '("^#.*" (0 'font-lock-comment-face t)) 5464 '("^#.*" (0 'font-lock-comment-face t))
5121 '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend))
5122 ;; Code
5123 '(org-activate-code (1 'org-code t))
5124 ))) 5465 )))
5125 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) 5466 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
5126 ;; Now set the full font-lock-keywords 5467 ;; Now set the full font-lock-keywords
@@ -5345,12 +5686,12 @@ If KWD is a number, get the corresponding match group."
5345 (>= (match-end 0) pos)))) 5686 (>= (match-end 0) pos))))
5346 t 5687 t
5347 (eq org-cycle-emulate-tab t)) 5688 (eq org-cycle-emulate-tab t))
5348 (if (and (looking-at "[ \n\r\t]") 5689; (if (and (looking-at "[ \n\r\t]")
5349 (string-match "^[ \t]*$" (buffer-substring 5690; (string-match "^[ \t]*$" (buffer-substring
5350 (point-at-bol) (point)))) 5691; (point-at-bol) (point))))
5351 (progn 5692; (progn
5352 (beginning-of-line 1) 5693; (beginning-of-line 1)
5353 (and (looking-at "[ \t]+") (replace-match "")))) 5694; (and (looking-at "[ \t]+") (replace-match ""))))
5354 (call-interactively (global-key-binding "\t"))) 5695 (call-interactively (global-key-binding "\t")))
5355 5696
5356 (t (save-excursion 5697 (t (save-excursion
@@ -5418,6 +5759,17 @@ This function is the default value of the hook `org-cycle-hook'."
5418 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) 5759 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
5419 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) 5760 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
5420 5761
5762(defun org-compact-display-after-subtree-move ()
5763 (let (beg end)
5764 (save-excursion
5765 (if (org-up-heading-safe)
5766 (progn
5767 (hide-subtree)
5768 (show-entry)
5769 (show-children)
5770 (org-cycle-show-empty-lines 'children)
5771 (org-cycle-hide-drawers 'children))
5772 (org-overview)))))
5421 5773
5422(defun org-cycle-show-empty-lines (state) 5774(defun org-cycle-show-empty-lines (state)
5423 "Show empty lines above all visible headlines. 5775 "Show empty lines above all visible headlines.
@@ -5508,6 +5860,8 @@ RET=jump to location [Q]uit and return to previous location
5508\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" 5860\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur"
5509) 5861)
5510 5862
5863(defvar org-goto-start-pos) ; dynamically scoped parameter
5864
5511(defun org-goto () 5865(defun org-goto ()
5512 "Look up a different location in the current file, keeping current visibility. 5866 "Look up a different location in the current file, keeping current visibility.
5513 5867
@@ -5631,8 +5985,10 @@ or nil."
5631 "Create indirect buffer and narrow it to current subtree. 5985 "Create indirect buffer and narrow it to current subtree.
5632With numerical prefix ARG, go up to this level and then take that tree. 5986With numerical prefix ARG, go up to this level and then take that tree.
5633If ARG is negative, go up that many levels. 5987If ARG is negative, go up that many levels.
5634Normally this command removes the indirect buffer previously made 5988If `org-indirect-buffer-display' is not `new-frame', the command removes the
5635with this command. However, when called with a C-u prefix, the last buffer 5989indirect buffer previously made with this command, to avoid proliferation of
5990indirect buffers. However, when you call the command with a `C-u' prefix, or
5991when `org-indirect-buffer-display' is `new-frame', the last buffer
5636is kept so that you can work with several indirect buffers at the same time. 5992is kept so that you can work with several indirect buffers at the same time.
5637If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also 5993If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also
5638requests that a new frame be made for the new buffer, so that the dedicated 5994requests that a new frame be made for the new buffer, so that the dedicated
@@ -5652,8 +6008,9 @@ frame is not changed."
5652 (setq beg (point) 6008 (setq beg (point)
5653 heading (org-get-heading)) 6009 heading (org-get-heading))
5654 (org-end-of-subtree t) (setq end (point))) 6010 (org-end-of-subtree t) (setq end (point)))
5655 (if (and (not arg) 6011 (if (and (buffer-live-p org-last-indirect-buffer)
5656 (buffer-live-p org-last-indirect-buffer)) 6012 (not (eq org-indirect-buffer-display 'new-frame))
6013 (not arg))
5657 (kill-buffer org-last-indirect-buffer)) 6014 (kill-buffer org-last-indirect-buffer))
5658 (setq ibuf (org-get-indirect-buffer cbuf) 6015 (setq ibuf (org-get-indirect-buffer cbuf)
5659 org-last-indirect-buffer ibuf) 6016 org-last-indirect-buffer ibuf)
@@ -5917,7 +6274,8 @@ would end up with no indentation after the change, nothing at all is done."
5917 col) 6274 col)
5918 (unless (save-excursion (end-of-line 1) 6275 (unless (save-excursion (end-of-line 1)
5919 (re-search-forward prohibit end t)) 6276 (re-search-forward prohibit end t))
5920 (while (re-search-forward "^[ \t]+" end t) 6277 (while (and (< (point) end)
6278 (re-search-forward "^[ \t]+" end t))
5921 (goto-char (match-end 0)) 6279 (goto-char (match-end 0))
5922 (setq col (current-column)) 6280 (setq col (current-column))
5923 (if (< diff 0) (replace-match "")) 6281 (if (< diff 0) (replace-match ""))
@@ -5980,38 +6338,65 @@ is signaled in this case."
5980 'outline-get-last-sibling)) 6338 'outline-get-last-sibling))
5981 (ins-point (make-marker)) 6339 (ins-point (make-marker))
5982 (cnt (abs arg)) 6340 (cnt (abs arg))
5983 beg end txt folded) 6341 beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
5984 ;; Select the tree 6342 ;; Select the tree
5985 (org-back-to-heading) 6343 (org-back-to-heading)
5986 (setq beg (point)) 6344 (setq beg0 (point))
6345 (save-excursion
6346 (setq ne-beg (org-back-over-empty-lines))
6347 (setq beg (point)))
5987 (save-match-data 6348 (save-match-data
5988 (save-excursion (outline-end-of-heading) 6349 (save-excursion (outline-end-of-heading)
5989 (setq folded (org-invisible-p))) 6350 (setq folded (org-invisible-p)))
5990 (outline-end-of-subtree)) 6351 (outline-end-of-subtree))
5991 (outline-next-heading) 6352 (outline-next-heading)
6353 (setq ne-end (org-back-over-empty-lines))
5992 (setq end (point)) 6354 (setq end (point))
6355 (goto-char beg0)
6356 (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg))
6357 ;; include less whitespace
6358 (save-excursion
6359 (goto-char beg)
6360 (forward-line (- ne-beg ne-end))
6361 (setq beg (point))))
5993 ;; Find insertion point, with error handling 6362 ;; Find insertion point, with error handling
5994 (goto-char beg)
5995 (while (> cnt 0) 6363 (while (> cnt 0)
5996 (or (and (funcall movfunc) (looking-at outline-regexp)) 6364 (or (and (funcall movfunc) (looking-at outline-regexp))
5997 (progn (goto-char beg) 6365 (progn (goto-char beg0)
5998 (error "Cannot move past superior level or buffer limit"))) 6366 (error "Cannot move past superior level or buffer limit")))
5999 (setq cnt (1- cnt))) 6367 (setq cnt (1- cnt)))
6000 (if (> arg 0) 6368 (if (> arg 0)
6001 ;; Moving forward - still need to move over subtree 6369 ;; Moving forward - still need to move over subtree
6002 (progn (outline-end-of-subtree) 6370 (progn (org-end-of-subtree t t)
6003 (outline-next-heading) 6371 (save-excursion
6004 (if (not (or (looking-at (concat "^" outline-regexp)) 6372 (org-back-over-empty-lines)
6005 (bolp))) 6373 (or (bolp) (newline)))))
6006 (newline)))) 6374 (setq ne-ins (org-back-over-empty-lines))
6007 (move-marker ins-point (point)) 6375 (move-marker ins-point (point))
6008 (setq txt (buffer-substring beg end)) 6376 (setq txt (buffer-substring beg end))
6009 (delete-region beg end) 6377 (delete-region beg end)
6378 (outline-flag-region (1- beg) beg nil)
6379 (outline-flag-region (1- (point)) (point) nil)
6010 (insert txt) 6380 (insert txt)
6011 (or (bolp) (insert "\n")) 6381 (or (bolp) (insert "\n"))
6382 (setq ins-end (point))
6012 (goto-char ins-point) 6383 (goto-char ins-point)
6013 (if folded (hide-subtree)) 6384 (org-skip-whitespace)
6014 (move-marker ins-point nil))) 6385 (when (and (< arg 0)
6386 (org-first-sibling-p)
6387 (> ne-ins ne-beg))
6388 ;; Move whitespace back to beginning
6389 (save-excursion
6390 (goto-char ins-end)
6391 (let ((kill-whole-line t))
6392 (kill-line (- ne-ins ne-beg)) (point)))
6393 (insert (make-string (- ne-ins ne-beg) ?\n)))
6394 (move-marker ins-point nil)
6395 (org-compact-display-after-subtree-move)
6396 (unless folded
6397 (org-show-entry)
6398 (show-children)
6399 (org-cycle-hide-drawers 'children))))
6015 6400
6016(defvar org-subtree-clip "" 6401(defvar org-subtree-clip ""
6017 "Clipboard for cut and paste of subtrees. 6402 "Clipboard for cut and paste of subtrees.
@@ -6035,11 +6420,13 @@ With prefix arg N, cut this many sequential subtrees.
6035This is a short-hand for marking the subtree and then copying it. 6420This is a short-hand for marking the subtree and then copying it.
6036If CUT is non-nil, actually cut the subtree." 6421If CUT is non-nil, actually cut the subtree."
6037 (interactive "p") 6422 (interactive "p")
6038 (let (beg end folded) 6423 (let (beg end folded (beg0 (point)))
6039 (if (interactive-p) 6424 (if (interactive-p)
6040 (org-back-to-heading nil) ; take what looks like a subtree 6425 (org-back-to-heading nil) ; take what looks like a subtree
6041 (org-back-to-heading t)) ; take what is really there 6426 (org-back-to-heading t)) ; take what is really there
6427 (org-back-over-empty-lines)
6042 (setq beg (point)) 6428 (setq beg (point))
6429 (skip-chars-forward " \t\r\n")
6043 (save-match-data 6430 (save-match-data
6044 (save-excursion (outline-end-of-heading) 6431 (save-excursion (outline-end-of-heading)
6045 (setq folded (org-invisible-p))) 6432 (setq folded (org-invisible-p)))
@@ -6047,8 +6434,9 @@ If CUT is non-nil, actually cut the subtree."
6047 (outline-forward-same-level (1- n)) 6434 (outline-forward-same-level (1- n))
6048 (error nil)) 6435 (error nil))
6049 (org-end-of-subtree t t)) 6436 (org-end-of-subtree t t))
6437 (org-back-over-empty-lines)
6050 (setq end (point)) 6438 (setq end (point))
6051 (goto-char beg) 6439 (goto-char beg0)
6052 (when (> end beg) 6440 (when (> end beg)
6053 (setq org-subtree-clip-folded folded) 6441 (setq org-subtree-clip-folded folded)
6054 (if cut (kill-region beg end) (copy-region-as-kill beg end)) 6442 (if cut (kill-region beg end) (copy-region-as-kill beg end))
@@ -6124,11 +6512,14 @@ If optional TREE is given, use this text instead of the kill ring."
6124 (delete-region (point-at-bol) (point))) 6512 (delete-region (point-at-bol) (point)))
6125 ;; Paste 6513 ;; Paste
6126 (beginning-of-line 1) 6514 (beginning-of-line 1)
6515 (org-back-over-empty-lines) ;; FIXME: correct fix????
6127 (setq beg (point)) 6516 (setq beg (point))
6128 (insert txt) 6517 (insert-before-markers txt) ;; FIXME: correct fix????
6129 (unless (string-match "\n[ \t]*\\'" txt) (insert "\n")) 6518 (unless (string-match "\n\\'" txt) (insert "\n"))
6130 (setq end (point)) 6519 (setq end (point))
6131 (goto-char beg) 6520 (goto-char beg)
6521 (skip-chars-forward " \t\n\r")
6522 (setq beg (point))
6132 ;; Shift if necessary 6523 ;; Shift if necessary
6133 (unless (= shift 0) 6524 (unless (= shift 0)
6134 (save-restriction 6525 (save-restriction
@@ -6154,10 +6545,12 @@ which is OK for `org-paste-subtree'.
6154If optional TXT is given, check this string instead of the current kill." 6545If optional TXT is given, check this string instead of the current kill."
6155 (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) 6546 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
6156 (start-level (and kill 6547 (start-level (and kill
6157 (string-match (concat "\\`" org-outline-regexp) kill) 6548 (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\("
6158 (- (match-end 0) (match-beginning 0) 1))) 6549 org-outline-regexp "\\)")
6550 kill)
6551 (- (match-end 2) (match-beginning 2) 1)))
6159 (re (concat "^" org-outline-regexp)) 6552 (re (concat "^" org-outline-regexp))
6160 (start 1)) 6553 (start (1+ (match-beginning 2))))
6161 (if (not start-level) 6554 (if (not start-level)
6162 (progn 6555 (progn
6163 nil) ;; does not even start with a heading 6556 nil) ;; does not even start with a heading
@@ -6228,7 +6621,11 @@ WITH-CASE, the sorting considers case as well."
6228 (condition-case nil (progn (org-back-to-heading) t) (error nil))) 6621 (condition-case nil (progn (org-back-to-heading) t) (error nil)))
6229 ;; we will sort the children of the current headline 6622 ;; we will sort the children of the current headline
6230 (org-back-to-heading) 6623 (org-back-to-heading)
6231 (setq start (point) end (org-end-of-subtree) what "children") 6624 (setq start (point)
6625 end (progn (org-end-of-subtree t t)
6626 (org-back-over-empty-lines)
6627 (point))
6628 what "children")
6232 (goto-char start) 6629 (goto-char start)
6233 (show-subtree) 6630 (show-subtree)
6234 (outline-next-heading)) 6631 (outline-next-heading))
@@ -6309,12 +6706,12 @@ WITH-CASE, the sorting considers case as well."
6309 (cond 6706 (cond
6310 ((= dcst ?n) 6707 ((= dcst ?n)
6311 (string-to-number (buffer-substring (match-end 0) 6708 (string-to-number (buffer-substring (match-end 0)
6312 (line-end-position)))) 6709 (point-at-eol))))
6313 ((= dcst ?a) 6710 ((= dcst ?a)
6314 (buffer-substring (match-end 0) (line-end-position))) 6711 (buffer-substring (match-end 0) (point-at-eol)))
6315 ((= dcst ?t) 6712 ((= dcst ?t)
6316 (if (re-search-forward org-ts-regexp 6713 (if (re-search-forward org-ts-regexp
6317 (line-end-position) t) 6714 (point-at-eol) t)
6318 (org-time-string-to-time (match-string 0)) 6715 (org-time-string-to-time (match-string 0))
6319 now)) 6716 now))
6320 ((= dcst ?f) 6717 ((= dcst ?f)
@@ -6330,11 +6727,11 @@ WITH-CASE, the sorting considers case as well."
6330 ((= dcst ?n) 6727 ((= dcst ?n)
6331 (if (looking-at outline-regexp) 6728 (if (looking-at outline-regexp)
6332 (string-to-number (buffer-substring (match-end 0) 6729 (string-to-number (buffer-substring (match-end 0)
6333 (line-end-position))) 6730 (point-at-eol)))
6334 nil)) 6731 nil))
6335 ((= dcst ?a) 6732 ((= dcst ?a)
6336 (funcall case-func (buffer-substring (line-beginning-position) 6733 (funcall case-func (buffer-substring (point-at-bol)
6337 (line-end-position)))) 6734 (point-at-eol))))
6338 ((= dcst ?t) 6735 ((= dcst ?t)
6339 (if (re-search-forward org-ts-regexp 6736 (if (re-search-forward org-ts-regexp
6340 (save-excursion 6737 (save-excursion
@@ -6343,7 +6740,7 @@ WITH-CASE, the sorting considers case as well."
6343 (org-time-string-to-time (match-string 0)) 6740 (org-time-string-to-time (match-string 0))
6344 now)) 6741 now))
6345 ((= dcst ?p) 6742 ((= dcst ?p)
6346 (if (re-search-forward org-priority-regexp (line-end-position) t) 6743 (if (re-search-forward org-priority-regexp (point-at-eol) t)
6347 (string-to-char (match-string 2)) 6744 (string-to-char (match-string 2))
6348 org-default-priority)) 6745 org-default-priority))
6349 ((= dcst ?r) 6746 ((= dcst ?r)
@@ -6383,7 +6780,8 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
6383 (setq extractfun 'string-to-number 6780 (setq extractfun 'string-to-number
6384 comparefun (if (= dcst sorting-type) '< '>))) 6781 comparefun (if (= dcst sorting-type) '< '>)))
6385 ((= dcst ?a) 6782 ((= dcst ?a)
6386 (setq extractfun (if with-case 'identity 'downcase) 6783 (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x))
6784 (lambda(x) (downcase (org-sort-remove-invisible x))))
6387 comparefun (if (= dcst sorting-type) 6785 comparefun (if (= dcst sorting-type)
6388 'string< 6786 'string<
6389 (lambda (a b) (and (not (string< a b)) 6787 (lambda (a b) (and (not (string< a b))
@@ -6483,12 +6881,13 @@ Return t when things worked, nil when we are not in an item."
6483 ((org-on-heading-p) 6881 ((org-on-heading-p)
6484 (setq beg (point) end (save-excursion (outline-next-heading) (point)))) 6882 (setq beg (point) end (save-excursion (outline-next-heading) (point))))
6485 ((org-at-item-checkbox-p) 6883 ((org-at-item-checkbox-p)
6486 (save-excursion 6884 (let ((pos (point)))
6487 (replace-match 6885 (replace-match
6488 (cond (arg "[-]") 6886 (cond (arg "[-]")
6489 ((member (match-string 0) '("[ ]" "[-]")) "[X]") 6887 ((member (match-string 0) '("[ ]" "[-]")) "[X]")
6490 (t "[ ]")) 6888 (t "[ ]"))
6491 t t)) 6889 t t)
6890 (goto-char pos))
6492 (throw 'exit t)) 6891 (throw 'exit t))
6493 (t (error "Not at a checkbox or heading, and no active region"))) 6892 (t (error "Not at a checkbox or heading, and no active region")))
6494 (save-excursion 6893 (save-excursion
@@ -6707,27 +7106,49 @@ Error if not at a plain list, or if this is the first item in the list."
6707 (error (goto-char pos) 7106 (error (goto-char pos)
6708 (error "On first item"))))) 7107 (error "On first item")))))
6709 7108
7109(defun org-first-list-item-p ()
7110 "Is this heading the item in a plain list?"
7111 (unless (org-at-item-p)
7112 (error "Not at a plain list item"))
7113 (org-beginning-of-item)
7114 (= (point) (save-excursion (org-beginning-of-item-list))))
7115
6710(defun org-move-item-down () 7116(defun org-move-item-down ()
6711 "Move the plain list item at point down, i.e. swap with following item. 7117 "Move the plain list item at point down, i.e. swap with following item.
6712Subitems (items with larger indentation) are considered part of the item, 7118Subitems (items with larger indentation) are considered part of the item,
6713so this really moves item trees." 7119so this really moves item trees."
6714 (interactive) 7120 (interactive)
6715 (let (beg end ind ind1 (pos (point)) txt) 7121 (let (beg beg0 end end0 ind ind1 (pos (point)) txt ne-end ne-beg)
6716 (org-beginning-of-item) 7122 (org-beginning-of-item)
6717 (setq beg (point)) 7123 (setq beg0 (point))
7124 (save-excursion
7125 (setq ne-beg (org-back-over-empty-lines))
7126 (setq beg (point)))
7127 (goto-char beg0)
6718 (setq ind (org-get-indentation)) 7128 (setq ind (org-get-indentation))
6719 (org-end-of-item) 7129 (org-end-of-item)
6720 (setq end (point)) 7130 (setq end0 (point))
6721 (setq ind1 (org-get-indentation)) 7131 (setq ind1 (org-get-indentation))
7132 (setq ne-end (org-back-over-empty-lines))
7133 (setq end (point))
7134 (goto-char beg0)
7135 (when (and (org-first-list-item-p) (< ne-end ne-beg))
7136 ;; include less whitespace
7137 (save-excursion
7138 (goto-char beg)
7139 (forward-line (- ne-beg ne-end))
7140 (setq beg (point))))
7141 (goto-char end0)
6722 (if (and (org-at-item-p) (= ind ind1)) 7142 (if (and (org-at-item-p) (= ind ind1))
6723 (progn 7143 (progn
6724 (org-end-of-item) 7144 (org-end-of-item)
7145 (org-back-over-empty-lines)
6725 (setq txt (buffer-substring beg end)) 7146 (setq txt (buffer-substring beg end))
6726 (save-excursion 7147 (save-excursion
6727 (delete-region beg end)) 7148 (delete-region beg end))
6728 (setq pos (point)) 7149 (setq pos (point))
6729 (insert txt) 7150 (insert txt)
6730 (goto-char pos) 7151 (goto-char pos) (org-skip-whitespace)
6731 (org-maybe-renumber-ordered-list)) 7152 (org-maybe-renumber-ordered-list))
6732 (goto-char pos) 7153 (goto-char pos)
6733 (error "Cannot move this item further down")))) 7154 (error "Cannot move this item further down"))))
@@ -6737,13 +7158,19 @@ so this really moves item trees."
6737Subitems (items with larger indentation) are considered part of the item, 7158Subitems (items with larger indentation) are considered part of the item,
6738so this really moves item trees." 7159so this really moves item trees."
6739 (interactive "p") 7160 (interactive "p")
6740 (let (beg end ind ind1 (pos (point)) txt) 7161 (let (beg beg0 end end0 ind ind1 (pos (point)) txt
7162 ne-beg ne-end ne-ins ins-end)
6741 (org-beginning-of-item) 7163 (org-beginning-of-item)
6742 (setq beg (point)) 7164 (setq beg0 (point))
6743 (setq ind (org-get-indentation)) 7165 (setq ind (org-get-indentation))
7166 (save-excursion
7167 (setq ne-beg (org-back-over-empty-lines))
7168 (setq beg (point)))
7169 (goto-char beg0)
6744 (org-end-of-item) 7170 (org-end-of-item)
7171 (setq ne-end (org-back-over-empty-lines))
6745 (setq end (point)) 7172 (setq end (point))
6746 (goto-char beg) 7173 (goto-char beg0)
6747 (catch 'exit 7174 (catch 'exit
6748 (while t 7175 (while t
6749 (beginning-of-line 0) 7176 (beginning-of-line 0)
@@ -6762,12 +7189,23 @@ so this really moves item trees."
6762 (setq ind1 (org-get-indentation)) 7189 (setq ind1 (org-get-indentation))
6763 (if (and (org-at-item-p) (= ind ind1)) 7190 (if (and (org-at-item-p) (= ind ind1))
6764 (progn 7191 (progn
7192 (setq ne-ins (org-back-over-empty-lines))
6765 (setq txt (buffer-substring beg end)) 7193 (setq txt (buffer-substring beg end))
6766 (save-excursion 7194 (save-excursion
6767 (delete-region beg end)) 7195 (delete-region beg end))
6768 (setq pos (point)) 7196 (setq pos (point))
6769 (insert txt) 7197 (insert txt)
6770 (goto-char pos) 7198 (setq ins-end (point))
7199 (goto-char pos) (org-skip-whitespace)
7200
7201 (when (and (org-first-list-item-p) (> ne-ins ne-beg))
7202 ;; Move whitespace back to beginning
7203 (save-excursion
7204 (goto-char ins-end)
7205 (let ((kill-whole-line t))
7206 (kill-line (- ne-ins ne-beg)) (point)))
7207 (insert (make-string (- ne-ins ne-beg) ?\n)))
7208
6771 (org-maybe-renumber-ordered-list)) 7209 (org-maybe-renumber-ordered-list))
6772 (goto-char pos) 7210 (goto-char pos)
6773 (error "Cannot move this item further up")))) 7211 (error "Cannot move this item further up"))))
@@ -7090,7 +7528,7 @@ C-c C-c Set tags / toggle checkbox"
7090 "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. 7528 "Unconditionally turn on `orgstruct-mode', and force org-mode indentations.
7091In addition to setting orgstruct-mode, this also exports all indentation and 7529In addition to setting orgstruct-mode, this also exports all indentation and
7092autofilling variables from org-mode into the buffer. Note that turning 7530autofilling variables from org-mode into the buffer. Note that turning
7093off orgstruct-mode will *not* remove these additonal settings." 7531off orgstruct-mode will *not* remove these additional settings."
7094 (orgstruct-mode 1) 7532 (orgstruct-mode 1)
7095 (let (var val) 7533 (let (var val)
7096 (mapc 7534 (mapc
@@ -7105,7 +7543,7 @@ off orgstruct-mode will *not* remove these additonal settings."
7105(defun orgstruct-error () 7543(defun orgstruct-error ()
7106 "Error when there is no default binding for a structure key." 7544 "Error when there is no default binding for a structure key."
7107 (interactive) 7545 (interactive)
7108 (error "This key is has no function outside structure elements")) 7546 (error "This key has no function outside structure elements"))
7109 7547
7110(defun orgstruct-setup () 7548(defun orgstruct-setup ()
7111 "Setup orgstruct keymaps." 7549 "Setup orgstruct keymaps."
@@ -7252,7 +7690,8 @@ this heading."
7252 (this-buffer (current-buffer)) 7690 (this-buffer (current-buffer))
7253 (org-archive-location org-archive-location) 7691 (org-archive-location org-archive-location)
7254 (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") 7692 (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
7255 ;; start of variables that will be used for savind context 7693 ;; start of variables that will be used for saving context
7694 ;; The compiler complains about them - keep them anyway!
7256 (file (abbreviate-file-name (buffer-file-name))) 7695 (file (abbreviate-file-name (buffer-file-name)))
7257 (time (format-time-string 7696 (time (format-time-string
7258 (substring (cdr org-time-stamp-formats) 1 -1) 7697 (substring (cdr org-time-stamp-formats) 1 -1)
@@ -7469,7 +7908,8 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
7469 (save-excursion 7908 (save-excursion
7470 (beginning-of-line 1) 7909 (beginning-of-line 1)
7471 (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") 7910 (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
7472 (let ((b (match-end 0))) 7911 (let ((b (match-end 0))
7912 (outline-regexp org-outline-regexp))
7473 (if (re-search-forward 7913 (if (re-search-forward
7474 "^[ \t]*:END:" 7914 "^[ \t]*:END:"
7475 (save-excursion (outline-next-heading) (point)) t) 7915 (save-excursion (outline-next-heading) (point)) t)
@@ -7488,7 +7928,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
7488 (goto-char beg) 7928 (goto-char beg)
7489 (if (looking-at (concat ".*:" org-archive-tag ":")) 7929 (if (looking-at (concat ".*:" org-archive-tag ":"))
7490 (message "%s" (substitute-command-keys 7930 (message "%s" (substitute-command-keys
7491 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) 7931 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
7492 7932
7493(defun org-force-cycle-archived () 7933(defun org-force-cycle-archived ()
7494 "Cycle subtree even if it is archived." 7934 "Cycle subtree even if it is archived."
@@ -7830,19 +8270,23 @@ This is being used to correctly align a single field after TAB or RET.")
7830 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) 8270 (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
7831 (hfmt1 (concat 8271 (hfmt1 (concat
7832 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) 8272 (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
7833 emptystrings links dates narrow fmax f1 len c e) 8273 emptystrings links dates emph narrow fmax f1 len c e)
7834 (untabify beg end) 8274 (untabify beg end)
7835 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) 8275 (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
7836 ;; Check if we have links or dates 8276 ;; Check if we have links or dates
7837 (goto-char beg) 8277 (goto-char beg)
7838 (setq links (re-search-forward org-bracket-link-regexp end t)) 8278 (setq links (re-search-forward org-bracket-link-regexp end t))
7839 (goto-char beg) 8279 (goto-char beg)
8280 (setq emph (and org-hide-emphasis-markers
8281 (re-search-forward org-emph-re end t)))
8282 (goto-char beg)
7840 (setq dates (and org-display-custom-times 8283 (setq dates (and org-display-custom-times
7841 (re-search-forward org-ts-regexp-both end t))) 8284 (re-search-forward org-ts-regexp-both end t)))
7842 ;; Make sure the link properties are right 8285 ;; Make sure the link properties are right
7843 (when links (goto-char beg) (while (org-activate-bracket-links end))) 8286 (when links (goto-char beg) (while (org-activate-bracket-links end)))
7844 ;; Make sure the date properties are right 8287 ;; Make sure the date properties are right
7845 (when dates (goto-char beg) (while (org-activate-dates end))) 8288 (when dates (goto-char beg) (while (org-activate-dates end)))
8289 (when emph (goto-char beg) (while (org-do-emphasis-faces end)))
7846 8290
7847 ;; Check if we are narrowing any columns 8291 ;; Check if we are narrowing any columns
7848 (goto-char beg) 8292 (goto-char beg)
@@ -7923,13 +8367,14 @@ This is being used to correctly align a single field after TAB or RET.")
7923 8367
7924 ;; With invisible characters, `format' does not get the field width right 8368 ;; With invisible characters, `format' does not get the field width right
7925 ;; So we need to make these fields wide by hand. 8369 ;; So we need to make these fields wide by hand.
7926 (when links 8370 (when (or links emph)
7927 (loop for i from 0 upto (1- maxfields) do 8371 (loop for i from 0 upto (1- maxfields) do
7928 (setq len (nth i lengths)) 8372 (setq len (nth i lengths))
7929 (loop for j from 0 upto (1- (length fields)) do 8373 (loop for j from 0 upto (1- (length fields)) do
7930 (setq c (nthcdr i (car (nthcdr j fields)))) 8374 (setq c (nthcdr i (car (nthcdr j fields))))
7931 (if (and (stringp (car c)) 8375 (if (and (stringp (car c))
7932 (string-match org-bracket-link-regexp (car c)) 8376 (text-property-any 0 (length (car c)) 'invisible 'org-link (car c))
8377; (string-match org-bracket-link-regexp (car c))
7933 (< (org-string-width (car c)) len)) 8378 (< (org-string-width (car c)) len))
7934 (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) 8379 (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ )))))))
7935 8380
@@ -8653,7 +9098,11 @@ should be done in reverse order."
8653 (skip-chars-backward "^|") 9098 (skip-chars-backward "^|")
8654 (setq ecol (1- (current-column))) 9099 (setq ecol (1- (current-column)))
8655 (org-table-goto-column column) 9100 (org-table-goto-column column)
8656 (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) 9101 (setq lns (mapcar (lambda(x) (cons
9102 (org-sort-remove-invisible
9103 (nth (1- column)
9104 (org-split-string x "[ \t]*|[ \t]*")))
9105 x))
8657 (org-split-string (buffer-substring beg end) "\n"))) 9106 (org-split-string (buffer-substring beg end) "\n")))
8658 (setq lns (org-do-sort lns "Table" with-case sorting-type)) 9107 (setq lns (org-do-sort lns "Table" with-case sorting-type))
8659 (delete-region beg end) 9108 (delete-region beg end)
@@ -8664,6 +9113,15 @@ should be done in reverse order."
8664 (org-table-goto-column thiscol) 9113 (org-table-goto-column thiscol)
8665 (message "%d lines sorted, based on column %d" (length lns) column))) 9114 (message "%d lines sorted, based on column %d" (length lns) column)))
8666 9115
9116;; FIXME: maybe we will not need this? Table sorting is broken....
9117(defun org-sort-remove-invisible (s)
9118 (remove-text-properties 0 (length s) org-rm-props s)
9119 (while (string-match org-bracket-link-regexp s)
9120 (setq s (replace-match (if (match-end 2)
9121 (match-string 3 s)
9122 (match-string 1 s)) t t s)))
9123 s)
9124
8667(defun org-table-cut-region (beg end) 9125(defun org-table-cut-region (beg end)
8668 "Copy region in table to the clipboard and blank all relevant fields." 9126 "Copy region in table to the clipboard and blank all relevant fields."
8669 (interactive "r") 9127 (interactive "r")
@@ -9366,8 +9824,7 @@ of the new mark."
9366 (goto-line l1))) 9824 (goto-line l1)))
9367 (if (not (= epos (point-at-eol))) (org-table-align)) 9825 (if (not (= epos (point-at-eol))) (org-table-align))
9368 (goto-line l) 9826 (goto-line l)
9369 (and (interactive-p) 9827 (and (interactive-p) (message "%s" (cdr (assoc new org-recalc-marks))))))
9370 (message "%s" (or (cdr (assoc new org-recalc-marks)) "")))))
9371 9828
9372(defun org-table-maybe-recalculate-line () 9829(defun org-table-maybe-recalculate-line ()
9373 "Recompute the current line if marked for it, and if we haven't just done it." 9830 "Recompute the current line if marked for it, and if we haven't just done it."
@@ -10679,7 +11136,7 @@ to execute outside of tables."
10679(defun orgtbl-error () 11136(defun orgtbl-error ()
10680 "Error when there is no default binding for a table key." 11137 "Error when there is no default binding for a table key."
10681 (interactive) 11138 (interactive)
10682 (error "This key is has no function outside tables")) 11139 (error "This key has no function outside tables"))
10683 11140
10684(defun orgtbl-setup () 11141(defun orgtbl-setup ()
10685 "Setup orgtbl keymaps." 11142 "Setup orgtbl keymaps."
@@ -11202,9 +11659,9 @@ TeXInfo are:
11202 %s for the original field value. For example, to wrap 11659 %s for the original field value. For example, to wrap
11203 everything in @kbd{}, you could use :fmt \"@kbd{%s}\". 11660 everything in @kbd{}, you could use :fmt \"@kbd{%s}\".
11204 This may also be a property list with column numbers and 11661 This may also be a property list with column numbers and
11205 formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). 11662 formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\").
11206 11663
11207:cf \"f1 f2..\" The column fractions for the table. Bye default these 11664:cf \"f1 f2..\" The column fractions for the table. By default these
11208 are computed automatically from the width of the columns 11665 are computed automatically from the width of the columns
11209 under org-mode. 11666 under org-mode.
11210 11667
@@ -11265,7 +11722,7 @@ value. Each function should check if it is responsible for creating
11265this link (for example by looking at the major mode). 11722this link (for example by looking at the major mode).
11266If not, it must exit and return nil. 11723If not, it must exit and return nil.
11267If yes, it should return a non-nil value after a calling 11724If yes, it should return a non-nil value after a calling
11268`org-store-link-properties' with a list of properties and values. 11725`org-store-link-props' with a list of properties and values.
11269Special properties are: 11726Special properties are:
11270 11727
11271:type The link prefix. like \"http\". This must be given. 11728:type The link prefix. like \"http\". This must be given.
@@ -11285,8 +11742,9 @@ FOLLOW and PUBLISH are two functions. Both take the link path as
11285an argument. 11742an argument.
11286FOLLOW should do whatever is necessary to follow the link, for example 11743FOLLOW should do whatever is necessary to follow the link, for example
11287to find a file or display a mail message. 11744to find a file or display a mail message.
11745
11288PUBLISH takes the path and retuns the string that should be used when 11746PUBLISH takes the path and retuns the string that should be used when
11289this document is published." 11747this document is published. FIMXE: This is actually not yet implemented."
11290 (add-to-list 'org-link-types type t) 11748 (add-to-list 'org-link-types type t)
11291 (org-make-link-regexps) 11749 (org-make-link-regexps)
11292 (add-to-list 'org-link-protocols 11750 (add-to-list 'org-link-protocols
@@ -11374,10 +11832,10 @@ For file links, arg negates `org-context-in-file-links'."
11374 (if (fboundp 'elmo-message-entity) 11832 (if (fboundp 'elmo-message-entity)
11375 (elmo-message-entity 11833 (elmo-message-entity
11376 wl-summary-buffer-elmo-folder msgnum) 11834 wl-summary-buffer-elmo-folder msgnum)
11377 (elmo-msgdb-overview-get-entity 11835 (elmo-msgdb-overview-get-entity
11378 msgnum (wl-summary-buffer-msgdb)))) 11836 msgnum (wl-summary-buffer-msgdb))))
11379 (from (wl-summary-line-from)) 11837 (from (wl-summary-line-from))
11380 (to (elmo-message-entity-field wl-message-entity 'to)) 11838 (to (car (elmo-message-entity-field wl-message-entity 'to)))
11381 (subject (let (wl-thr-indent-string wl-parent-message-entity) 11839 (subject (let (wl-thr-indent-string wl-parent-message-entity)
11382 (wl-summary-line-subject)))) 11840 (wl-summary-line-subject))))
11383 (org-store-link-props :type "wl" :from from :to to 11841 (org-store-link-props :type "wl" :from from :to to
@@ -11613,8 +12071,10 @@ according to FMT (default from `org-email-link-description-format')."
11613 (error "Empty link")) 12071 (error "Empty link"))
11614 (when (stringp description) 12072 (when (stringp description)
11615 ;; Remove brackets from the description, they are fatal. 12073 ;; Remove brackets from the description, they are fatal.
11616 (while (string-match "\\[\\|\\]" description) 12074 (while (string-match "\\[" description)
11617 (setq description (replace-match "" t t description)))) 12075 (setq description (replace-match "{" t t description)))
12076 (while (string-match "\\]" description)
12077 (setq description (replace-match "}" t t description))))
11618 (when (equal (org-link-escape link) description) 12078 (when (equal (org-link-escape link) description)
11619 ;; No description needed, it is identical 12079 ;; No description needed, it is identical
11620 (setq description nil)) 12080 (setq description nil))
@@ -11626,29 +12086,29 @@ according to FMT (default from `org-email-link-description-format')."
11626 "]")) 12086 "]"))
11627 12087
11628(defconst org-link-escape-chars 12088(defconst org-link-escape-chars
11629 '((" " . "%20") 12089 '((?\ . "%20")
11630 ("[" . "%5B") 12090 (?\[ . "%5B")
11631 ("]" . "%5d") 12091 (?\] . "%5D")
11632 ("\340" . "%E0") ; `a 12092 (?\340 . "%E0") ; `a
11633 ("\342" . "%E2") ; ^a 12093 (?\342 . "%E2") ; ^a
11634 ("\347" . "%E7") ; ,c 12094 (?\347 . "%E7") ; ,c
11635 ("\350" . "%E8") ; `e 12095 (?\350 . "%E8") ; `e
11636 ("\351" . "%E9") ; 'e 12096 (?\351 . "%E9") ; 'e
11637 ("\352" . "%EA") ; ^e 12097 (?\352 . "%EA") ; ^e
11638 ("\356" . "%EE") ; ^i 12098 (?\356 . "%EE") ; ^i
11639 ("\364" . "%F4") ; ^o 12099 (?\364 . "%F4") ; ^o
11640 ("\371" . "%F9") ; `u 12100 (?\371 . "%F9") ; `u
11641 ("\373" . "%FB") ; ^u 12101 (?\373 . "%FB") ; ^u
11642 (";" . "%3B") 12102 (?\; . "%3B")
11643 ("?" . "%3F") 12103 (?? . "%3F")
11644 ("=" . "%3D") 12104 (?= . "%3D")
11645 ("+" . "%2B") 12105 (?+ . "%2B")
11646 ) 12106 )
11647 "Association list of escapes for some characters problematic in links. 12107 "Association list of escapes for some characters problematic in links.
11648This is the list that is used for internal purposes.") 12108This is the list that is used for internal purposes.")
11649 12109
11650(defconst org-link-escape-chars-browser 12110(defconst org-link-escape-chars-browser
11651 '((" " . "%20")) 12111 '((?\ . "%20")) ; 32 for the SPC char
11652 "Association list of escapes for some characters problematic in links. 12112 "Association list of escapes for some characters problematic in links.
11653This is the list that is used before handing over to the browser.") 12113This is the list that is used before handing over to the browser.")
11654 12114
@@ -11656,12 +12116,14 @@ This is the list that is used before handing over to the browser.")
11656 "Escape charaters in TEXT that are problematic for links." 12116 "Escape charaters in TEXT that are problematic for links."
11657 (setq table (or table org-link-escape-chars)) 12117 (setq table (or table org-link-escape-chars))
11658 (when text 12118 (when text
11659 (let ((re (mapconcat (lambda (x) (regexp-quote (car x))) 12119 (let ((re (mapconcat (lambda (x) (regexp-quote
12120 (char-to-string (car x))))
11660 table "\\|"))) 12121 table "\\|")))
11661 (while (string-match re text) 12122 (while (string-match re text)
11662 (setq text 12123 (setq text
11663 (replace-match 12124 (replace-match
11664 (cdr (assoc (match-string 0 text) table)) 12125 (cdr (assoc (string-to-char (match-string 0 text))
12126 table))
11665 t t text))) 12127 t t text)))
11666 text))) 12128 text)))
11667 12129
@@ -11674,7 +12136,7 @@ This is the list that is used before handing over to the browser.")
11674 (while (string-match re text) 12136 (while (string-match re text)
11675 (setq text 12137 (setq text
11676 (replace-match 12138 (replace-match
11677 (car (rassoc (match-string 0 text) table)) 12139 (char-to-string (car (rassoc (match-string 0 text) table)))
11678 t t text))) 12140 t t text)))
11679 text))) 12141 text)))
11680 12142
@@ -11957,189 +12419,192 @@ the end of the current subtree.
11957Normally, files will be opened by an appropriate application. If the 12419Normally, files will be opened by an appropriate application. If the
11958optional argument IN-EMACS is non-nil, Emacs will visit the file." 12420optional argument IN-EMACS is non-nil, Emacs will visit the file."
11959 (interactive "P") 12421 (interactive "P")
11960 (move-marker org-open-link-marker (point)) 12422 (catch 'abort
11961 (setq org-window-config-before-follow-link (current-window-configuration)) 12423 (move-marker org-open-link-marker (point))
11962 (org-remove-occur-highlights nil nil t) 12424 (setq org-window-config-before-follow-link (current-window-configuration))
11963 (if (org-at-timestamp-p t) 12425 (org-remove-occur-highlights nil nil t)
11964 (org-follow-timestamp-link) 12426 (if (org-at-timestamp-p t)
11965 (let (type path link line search (pos (point))) 12427 (org-follow-timestamp-link)
11966 (catch 'match 12428 (let (type path link line search (pos (point)))
11967 (save-excursion 12429 (catch 'match
11968 (skip-chars-forward "^]\n\r") 12430 (save-excursion
11969 (when (org-in-regexp org-bracket-link-regexp) 12431 (skip-chars-forward "^]\n\r")
11970 (setq link (org-link-unescape (org-match-string-no-properties 1))) 12432 (when (org-in-regexp org-bracket-link-regexp)
11971 (while (string-match " *\n *" link) 12433 (setq link (org-link-unescape (org-match-string-no-properties 1)))
11972 (setq link (replace-match " " t t link))) 12434 (while (string-match " *\n *" link)
11973 (setq link (org-link-expand-abbrev link)) 12435 (setq link (replace-match " " t t link)))
11974 (if (string-match org-link-re-with-space2 link) 12436 (setq link (org-link-expand-abbrev link))
11975 (setq type (match-string 1 link) path (match-string 2 link)) 12437 (if (string-match org-link-re-with-space2 link)
11976 (setq type "thisfile" path link)) 12438 (setq type (match-string 1 link) path (match-string 2 link))
11977 (throw 'match t))) 12439 (setq type "thisfile" path link))
11978 12440 (throw 'match t)))
11979 (when (get-text-property (point) 'org-linked-text) 12441
11980 (setq type "thisfile" 12442 (when (get-text-property (point) 'org-linked-text)
11981 pos (if (get-text-property (1+ (point)) 'org-linked-text) 12443 (setq type "thisfile"
11982 (1+ (point)) (point)) 12444 pos (if (get-text-property (1+ (point)) 'org-linked-text)
11983 path (buffer-substring 12445 (1+ (point)) (point))
11984 (previous-single-property-change pos 'org-linked-text) 12446 path (buffer-substring
11985 (next-single-property-change pos 'org-linked-text))) 12447 (previous-single-property-change pos 'org-linked-text)
11986 (throw 'match t)) 12448 (next-single-property-change pos 'org-linked-text)))
12449 (throw 'match t))
11987 12450
11988 (save-excursion 12451 (save-excursion
11989 (when (or (org-in-regexp org-angle-link-re) 12452 (when (or (org-in-regexp org-angle-link-re)
11990 (org-in-regexp org-plain-link-re)) 12453 (org-in-regexp org-plain-link-re))
11991 (setq type (match-string 1) path (match-string 2)) 12454 (setq type (match-string 1) path (match-string 2))
11992 (throw 'match t))) 12455 (throw 'match t)))
11993 (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") 12456 (when (org-in-regexp "\\<\\([^><\n]+\\)\\>")
11994 (setq type "tree-match" 12457 (setq type "tree-match"
11995 path (match-string 1))
11996 (throw 'match t))
11997 (save-excursion
11998 (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$"))
11999 (setq type "tags"
12000 path (match-string 1)) 12458 path (match-string 1))
12001 (while (string-match ":" path) 12459 (throw 'match t))
12002 (setq path (replace-match "+" t t path))) 12460 (save-excursion
12003 (throw 'match t)))) 12461 (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$"))
12004 (unless path 12462 (setq type "tags"
12005 (error "No link found")) 12463 path (match-string 1))
12006 ;; Remove any trailing spaces in path 12464 (while (string-match ":" path)
12007 (if (string-match " +\\'" path) 12465 (setq path (replace-match "+" t t path)))
12008 (setq path (replace-match "" t t path))) 12466 (throw 'match t))))
12467 (unless path
12468 (error "No link found"))
12469 ;; Remove any trailing spaces in path
12470 (if (string-match " +\\'" path)
12471 (setq path (replace-match "" t t path)))
12009 12472
12010 (cond 12473 (cond
12011 12474
12012 ((assoc type org-link-protocols) 12475 ((assoc type org-link-protocols)
12013 (funcall (nth 1 (assoc type org-link-protocols)) path)) 12476 (funcall (nth 1 (assoc type org-link-protocols)) path))
12014 12477
12015 ((equal type "mailto") 12478 ((equal type "mailto")
12016 (let ((cmd (car org-link-mailto-program)) 12479 (let ((cmd (car org-link-mailto-program))
12017 (args (cdr org-link-mailto-program)) args1 12480 (args (cdr org-link-mailto-program)) args1
12018 (address path) (subject "") a) 12481 (address path) (subject "") a)
12019 (if (string-match "\\(.*\\)::\\(.*\\)" path) 12482 (if (string-match "\\(.*\\)::\\(.*\\)" path)
12020 (setq address (match-string 1 path) 12483 (setq address (match-string 1 path)
12021 subject (org-link-escape (match-string 2 path)))) 12484 subject (org-link-escape (match-string 2 path))))
12022 (while args 12485 (while args
12023 (cond 12486 (cond
12024 ((not (stringp (car args))) (push (pop args) args1)) 12487 ((not (stringp (car args))) (push (pop args) args1))
12025 (t (setq a (pop args)) 12488 (t (setq a (pop args))
12026 (if (string-match "%a" a) 12489 (if (string-match "%a" a)
12027 (setq a (replace-match address t t a))) 12490 (setq a (replace-match address t t a)))
12028 (if (string-match "%s" a) 12491 (if (string-match "%s" a)
12029 (setq a (replace-match subject t t a))) 12492 (setq a (replace-match subject t t a)))
12030 (push a args1)))) 12493 (push a args1))))
12031 (apply cmd (nreverse args1)))) 12494 (apply cmd (nreverse args1))))
12032 12495
12033 ((member type '("http" "https" "ftp" "news")) 12496 ((member type '("http" "https" "ftp" "news"))
12034 (browse-url (concat type ":" (org-link-escape 12497 (browse-url (concat type ":" (org-link-escape
12035 path org-link-escape-chars-browser)))) 12498 path org-link-escape-chars-browser))))
12036 12499
12037 ((string= type "tags") 12500 ((member type '("message"))
12038 (org-tags-view in-emacs path)) 12501 (browse-url (concat type ":" path)))
12039 ((string= type "thisfile") 12502
12040 (if in-emacs 12503 ((string= type "tags")
12041 (switch-to-buffer-other-window 12504 (org-tags-view in-emacs path))
12042 (org-get-buffer-for-internal-link (current-buffer))) 12505 ((string= type "thisfile")
12043 (org-mark-ring-push)) 12506 (if in-emacs
12044 (let ((cmd `(org-link-search 12507 (switch-to-buffer-other-window
12045 ,path 12508 (org-get-buffer-for-internal-link (current-buffer)))
12046 ,(cond ((equal in-emacs '(4)) 'occur) 12509 (org-mark-ring-push))
12047 ((equal in-emacs '(16)) 'org-occur) 12510 (let ((cmd `(org-link-search
12048 (t nil)) 12511 ,path
12049 ,pos))) 12512 ,(cond ((equal in-emacs '(4)) 'occur)
12050 (condition-case nil (eval cmd) 12513 ((equal in-emacs '(16)) 'org-occur)
12051 (error (progn (widen) (eval cmd)))))) 12514 (t nil))
12052 12515 ,pos)))
12053 ((string= type "tree-match") 12516 (condition-case nil (eval cmd)
12054 (org-occur (concat "\\[" (regexp-quote path) "\\]"))) 12517 (error (progn (widen) (eval cmd))))))
12055 12518
12056 ((string= type "file") 12519 ((string= type "tree-match")
12057 (if (string-match "::\\([0-9]+\\)\\'" path) 12520 (org-occur (concat "\\[" (regexp-quote path) "\\]")))
12058 (setq line (string-to-number (match-string 1 path)) 12521
12059 path (substring path 0 (match-beginning 0))) 12522 ((string= type "file")
12060 (if (string-match "::\\(.+\\)\\'" path) 12523 (if (string-match "::\\([0-9]+\\)\\'" path)
12061 (setq search (match-string 1 path) 12524 (setq line (string-to-number (match-string 1 path))
12062 path (substring path 0 (match-beginning 0))))) 12525 path (substring path 0 (match-beginning 0)))
12063 (org-open-file path in-emacs line search)) 12526 (if (string-match "::\\(.+\\)\\'" path)
12064 12527 (setq search (match-string 1 path)
12065 ((string= type "news") 12528 path (substring path 0 (match-beginning 0)))))
12066 (org-follow-gnus-link path)) 12529 (if (string-match "[*?{]" (file-name-nondirectory path))
12067 12530 (dired path)
12068 ((string= type "bbdb") 12531 (org-open-file path in-emacs line search)))
12069 (org-follow-bbdb-link path)) 12532
12070 12533 ((string= type "news")
12071 ((string= type "info") 12534 (org-follow-gnus-link path))
12072 (org-follow-info-link path)) 12535
12073 12536 ((string= type "bbdb")
12074 ((string= type "gnus") 12537 (org-follow-bbdb-link path))
12075 (let (group article) 12538
12076 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12539 ((string= type "info")
12077 (error "Error in Gnus link")) 12540 (org-follow-info-link path))
12078 (setq group (match-string 1 path) 12541
12079 article (match-string 3 path)) 12542 ((string= type "gnus")
12080 (org-follow-gnus-link group article))) 12543 (let (group article)
12081 12544 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12082 ((string= type "vm") 12545 (error "Error in Gnus link"))
12083 (let (folder article) 12546 (setq group (match-string 1 path)
12084 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12547 article (match-string 3 path))
12085 (error "Error in VM link")) 12548 (org-follow-gnus-link group article)))
12086 (setq folder (match-string 1 path) 12549
12087 article (match-string 3 path)) 12550 ((string= type "vm")
12088 ;; in-emacs is the prefix arg, will be interpreted as read-only 12551 (let (folder article)
12089 (org-follow-vm-link folder article in-emacs))) 12552 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12090 12553 (error "Error in VM link"))
12091 ((string= type "wl") 12554 (setq folder (match-string 1 path)
12092 (let (folder article) 12555 article (match-string 3 path))
12093 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12556 ;; in-emacs is the prefix arg, will be interpreted as read-only
12094 (error "Error in Wanderlust link")) 12557 (org-follow-vm-link folder article in-emacs)))
12095 (setq folder (match-string 1 path) 12558
12096 article (match-string 3 path)) 12559 ((string= type "wl")
12097 (org-follow-wl-link folder article))) 12560 (let (folder article)
12098 12561 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12099 ((string= type "mhe") 12562 (error "Error in Wanderlust link"))
12100 (let (folder article) 12563 (setq folder (match-string 1 path)
12101 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12564 article (match-string 3 path))
12102 (error "Error in MHE link")) 12565 (org-follow-wl-link folder article)))
12103 (setq folder (match-string 1 path) 12566
12104 article (match-string 3 path)) 12567 ((string= type "mhe")
12105 (org-follow-mhe-link folder article))) 12568 (let (folder article)
12106 12569 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12107 ((string= type "rmail") 12570 (error "Error in MHE link"))
12108 (let (folder article) 12571 (setq folder (match-string 1 path)
12109 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) 12572 article (match-string 3 path))
12110 (error "Error in RMAIL link")) 12573 (org-follow-mhe-link folder article)))
12111 (setq folder (match-string 1 path) 12574
12112 article (match-string 3 path)) 12575 ((string= type "rmail")
12113 (org-follow-rmail-link folder article))) 12576 (let (folder article)
12114 12577 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
12115 ((string= type "shell") 12578 (error "Error in RMAIL link"))
12116 (let ((cmd path)) 12579 (setq folder (match-string 1 path)
12117 ;; The following is only for backward compatibility 12580 article (match-string 3 path))
12118 (while (string-match "@{" cmd) (setq cmd (replace-match "<" t t cmd))) 12581 (org-follow-rmail-link folder article)))
12119 (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd))) 12582
12120 (if (or (not org-confirm-shell-link-function) 12583 ((string= type "shell")
12121 (funcall org-confirm-shell-link-function 12584 (let ((cmd path))
12122 (format "Execute \"%s\" in shell? " 12585 (if (or (not org-confirm-shell-link-function)
12123 (org-add-props cmd nil 12586 (funcall org-confirm-shell-link-function
12124 'face 'org-warning)))) 12587 (format "Execute \"%s\" in shell? "
12125 (progn 12588 (org-add-props cmd nil
12126 (message "Executing %s" cmd) 12589 'face 'org-warning))))
12127 (shell-command cmd)) 12590 (progn
12128 (error "Abort")))) 12591 (message "Executing %s" cmd)
12129 12592 (shell-command cmd))
12130 ((string= type "elisp") 12593 (error "Abort"))))
12131 (let ((cmd path)) 12594
12132 (if (or (not org-confirm-elisp-link-function) 12595 ((string= type "elisp")
12133 (funcall org-confirm-elisp-link-function 12596 (let ((cmd path))
12134 (format "Execute \"%s\" as elisp? " 12597 (if (or (not org-confirm-elisp-link-function)
12135 (org-add-props cmd nil 12598 (funcall org-confirm-elisp-link-function
12136 'face 'org-warning)))) 12599 (format "Execute \"%s\" as elisp? "
12137 (message "%s => %s" cmd (eval (read cmd))) 12600 (org-add-props cmd nil
12138 (error "Abort")))) 12601 'face 'org-warning))))
12602 (message "%s => %s" cmd (eval (read cmd)))
12603 (error "Abort"))))
12139 12604
12140 (t 12605 (t
12141 (browse-url-at-point))))) 12606 (browse-url-at-point)))))
12142 (move-marker org-open-link-marker nil)) 12607 (move-marker org-open-link-marker nil)))
12143 12608
12144;;; File search 12609;;; File search
12145 12610
@@ -12575,8 +13040,8 @@ use sequences."
12575 (mh-show-buffer-message-number)))) 13040 (mh-show-buffer-message-number))))
12576 13041
12577(defun org-mhe-get-header (header) 13042(defun org-mhe-get-header (header)
12578 "Return a header of the message in folder mode. This will create a 13043 "Return a header of the message in folder mode. This will create a
12579show buffer for the corresponding message. If you have a more clever 13044show buffer for the corresponding message. If you have a more clever
12580idea..." 13045idea..."
12581 (let* ((folder (org-mhe-get-message-folder)) 13046 (let* ((folder (org-mhe-get-message-folder))
12582 (num (org-mhe-get-message-num)) 13047 (num (org-mhe-get-message-num))
@@ -12727,9 +13192,10 @@ If the file does not exist, an error is thrown."
12727 (cond 13192 (cond
12728 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) 13193 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
12729 ;; Remove quotes around the file name - we'll use shell-quote-argument. 13194 ;; Remove quotes around the file name - we'll use shell-quote-argument.
12730 (if (string-match "['\"]%s['\"]" cmd) 13195 (while (string-match "['\"]%s['\"]" cmd)
12731 (setq cmd (replace-match "%s" t t cmd))) 13196 (setq cmd (replace-match "%s" t t cmd)))
12732 (setq cmd (format cmd (shell-quote-argument file))) 13197 (while (string-match "%s" cmd)
13198 (setq cmd (replace-match (shell-quote-argument file) t t cmd)))
12733 (save-window-excursion 13199 (save-window-excursion
12734 (start-process-shell-command cmd nil cmd))) 13200 (start-process-shell-command cmd nil cmd)))
12735 ((or (stringp cmd) 13201 ((or (stringp cmd)
@@ -12772,7 +13238,18 @@ on the system \"/user@host:\"."
12772 (t nil))) 13238 (t nil)))
12773 13239
12774 13240
12775;;;; Hooks for remember.el 13241;;;; Hooks for remember.el, and refiling
13242
13243(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode'
13244(defvar initial) ; from remember.el, dynamically scoped in `remember-mode'
13245
13246;;;###autoload
13247(defun org-remember-insinuate ()
13248 "Setup remember.el for use wiht Org-mode."
13249 (require 'remember)
13250 (setq remember-annotation-functions '(org-remember-annotation))
13251 (setq remember-handler-functions '(org-remember-handler))
13252 (add-hook 'remember-mode-hook 'org-remember-apply-template))
12776 13253
12777;;;###autoload 13254;;;###autoload
12778(defun org-remember-annotation () 13255(defun org-remember-annotation ()
@@ -12792,44 +13269,54 @@ RET at beg-of-buf -> Append to file as level 2 headline
12792(defvar org-remember-previous-location nil) 13269(defvar org-remember-previous-location nil)
12793(defvar org-force-remember-template-char) ;; dynamically scoped 13270(defvar org-force-remember-template-char) ;; dynamically scoped
12794 13271
13272(defun org-select-remember-template (&optional use-char)
13273 (when org-remember-templates
13274 (let* ((templates (mapcar (lambda (x)
13275 (if (stringp (car x))
13276 (append (list (nth 1 x) (car x)) (cddr x))
13277 (append (list (car x) "") (cdr x))))
13278 org-remember-templates))
13279 (char (or use-char
13280 (cond
13281 ((= (length templates) 1)
13282 (caar templates))
13283 ((and (boundp 'org-force-remember-template-char)
13284 org-force-remember-template-char)
13285 (if (stringp org-force-remember-template-char)
13286 (string-to-char org-force-remember-template-char)
13287 org-force-remember-template-char))
13288 (t
13289 (message "Select template: %s"
13290 (mapconcat
13291 (lambda (x)
13292 (cond
13293 ((not (string-match "\\S-" (nth 1 x)))
13294 (format "[%c]" (car x)))
13295 ((equal (downcase (car x))
13296 (downcase (aref (nth 1 x) 0)))
13297 (format "[%c]%s" (car x)
13298 (substring (nth 1 x) 1)))
13299 (t (format "[%c]%s" (car x) (nth 1 x)))))
13300 templates " "))
13301 (let ((inhibit-quit t) (char0 (read-char-exclusive)))
13302 (when (equal char0 ?\C-g)
13303 (jump-to-register remember-register)
13304 (kill-buffer remember-buffer))
13305 char0))))))
13306 (cddr (assoc char templates)))))
13307
13308(defvar x-last-selected-text)
13309(defvar x-last-selected-text-primary)
13310
12795;;;###autoload 13311;;;###autoload
12796(defun org-remember-apply-template (&optional use-char skip-interactive) 13312(defun org-remember-apply-template (&optional use-char skip-interactive)
12797 "Initialize *remember* buffer with template, invoke `org-mode'. 13313 "Initialize *remember* buffer with template, invoke `org-mode'.
12798This function should be placed into `remember-mode-hook' and in fact requires 13314This function should be placed into `remember-mode-hook' and in fact requires
12799to be run from that hook to fucntion properly." 13315to be run from that hook to function properly."
13316 (unless (fboundp 'remember-finalize)
13317 (defalias 'remember-finalize 'remember-buffer))
12800 (if org-remember-templates 13318 (if org-remember-templates
12801 (let* ((templates (mapcar (lambda (x) 13319 (let* ((entry (org-select-remember-template use-char))
12802 (if (stringp (car x))
12803 (append (list (nth 1 x) (car x)) (cddr x))
12804 (append (list (car x) "") (cdr x))))
12805 org-remember-templates))
12806 (char (or use-char
12807 (cond
12808 ((= (length templates) 1)
12809 (caar templates))
12810 ((and (boundp 'org-force-remember-template-char)
12811 org-force-remember-template-char)
12812 (if (stringp org-force-remember-template-char)
12813 (string-to-char org-force-remember-template-char)
12814 org-force-remember-template-char))
12815 (t
12816 (message "Select template: %s"
12817 (mapconcat
12818 (lambda (x)
12819 (cond
12820 ((not (string-match "\\S-" (nth 1 x)))
12821 (format "[%c]" (car x)))
12822 ((equal (downcase (car x))
12823 (downcase (aref (nth 1 x) 0)))
12824 (format "[%c]%s" (car x) (substring (nth 1 x) 1)))
12825 (t (format "[%c]%s" (car x) (nth 1 x)))))
12826 templates " "))
12827 (let ((inhibit-quit t) (char0 (read-char-exclusive)))
12828 (when (equal char0 ?\C-g)
12829 (jump-to-register remember-register)
12830 (kill-buffer remember-buffer))
12831 char0)))))
12832 (entry (cddr (assoc char templates)))
12833 (tpl (car entry)) 13320 (tpl (car entry))
12834 (plist-p (if org-store-link-plist t nil)) 13321 (plist-p (if org-store-link-plist t nil))
12835 (file (if (and (nth 1 entry) (stringp (nth 1 entry)) 13322 (file (if (and (nth 1 entry) (stringp (nth 1 entry))
@@ -12837,6 +13324,12 @@ to be run from that hook to fucntion properly."
12837 (nth 1 entry) 13324 (nth 1 entry)
12838 org-default-notes-file)) 13325 org-default-notes-file))
12839 (headline (nth 2 entry)) 13326 (headline (nth 2 entry))
13327 (v-c (or (and (eq window-system 'x)
13328 (fboundp 'x-cut-buffer-or-selection-value)
13329 (x-cut-buffer-or-selection-value))
13330 (org-bound-and-true-p x-last-selected-text)
13331 (org-bound-and-true-p x-last-selected-text-primary)
13332 (and (> (length kill-ring) 0) (current-kill 0))))
12840 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time))) 13333 (v-t (format-time-string (car org-time-stamp-formats) (org-current-time)))
12841 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time))) 13334 (v-T (format-time-string (cdr org-time-stamp-formats) (org-current-time)))
12842 (v-u (concat "[" (substring v-t 1 -1) "]")) 13335 (v-u (concat "[" (substring v-t 1 -1) "]"))
@@ -12852,11 +13345,12 @@ to be run from that hook to fucntion properly."
12852 v-a)) 13345 v-a))
12853 (v-n user-full-name) 13346 (v-n user-full-name)
12854 (org-startup-folded nil) 13347 (org-startup-folded nil)
12855 org-time-was-given org-end-time-was-given x prompt char time) 13348 org-time-was-given org-end-time-was-given x
13349 prompt completions char time pos default histvar)
12856 (setq org-store-link-plist 13350 (setq org-store-link-plist
12857 (append (list :annotation v-a :initial v-i) 13351 (append (list :annotation v-a :initial v-i)
12858 org-store-link-plist)) 13352 org-store-link-plist))
12859 (unless tpl (setq tpl "") (message "No template") (ding)) 13353 (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1))
12860 (erase-buffer) 13354 (erase-buffer)
12861 (insert (substitute-command-keys 13355 (insert (substitute-command-keys
12862 (format 13356 (format
@@ -12873,7 +13367,7 @@ to be run from that hook to fucntion properly."
12873 (or (cdr org-remember-previous-location) "???")))) 13367 (or (cdr org-remember-previous-location) "???"))))
12874 (insert tpl) (goto-char (point-min)) 13368 (insert tpl) (goto-char (point-min))
12875 ;; Simple %-escapes 13369 ;; Simple %-escapes
12876 (while (re-search-forward "%\\([tTuUaiA]\\)" nil t) 13370 (while (re-search-forward "%\\([tTuUaiAc]\\)" nil t)
12877 (when (and initial (equal (match-string 0) "%i")) 13371 (when (and initial (equal (match-string 0) "%i"))
12878 (save-match-data 13372 (save-match-data
12879 (let* ((lead (buffer-substring 13373 (let* ((lead (buffer-substring
@@ -12884,16 +13378,43 @@ to be run from that hook to fucntion properly."
12884 (replace-match 13378 (replace-match
12885 (or (eval (intern (concat "v-" (match-string 1)))) "") 13379 (or (eval (intern (concat "v-" (match-string 1)))) "")
12886 t t)) 13380 t t))
13381
13382 ;; %[] Insert contents of a file.
13383 (goto-char (point-min))
13384 (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
13385 (let ((start (match-beginning 0))
13386 (end (match-end 0))
13387 (filename (expand-file-name (match-string 1))))
13388 (goto-char start)
13389 (delete-region start end)
13390 (condition-case error
13391 (insert-file-contents filename)
13392 (error (insert (format "%%![Couldn't insert %s: %s]"
13393 filename error))))))
13394 ;; %() embedded elisp
13395 (goto-char (point-min))
13396 (while (re-search-forward "%\\((.+)\\)" nil t)
13397 (goto-char (match-beginning 0))
13398 (let ((template-start (point)))
13399 (forward-char 1)
13400 (let ((result
13401 (condition-case error
13402 (eval (read (current-buffer)))
13403 (error (format "%%![Error: %s]" error)))))
13404 (delete-region template-start (point))
13405 (insert result))))
13406
12887 ;; From the property list 13407 ;; From the property list
12888 (when plist-p 13408 (when plist-p
12889 (goto-char (point-min)) 13409 (goto-char (point-min))
12890 (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) 13410 (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
12891 (and (setq x (plist-get org-store-link-plist 13411 (and (setq x (or (plist-get org-store-link-plist
12892 (intern (match-string 1)))) 13412 (intern (match-string 1))) ""))
12893 (replace-match x t t)))) 13413 (replace-match x t t))))
13414
12894 ;; Turn on org-mode in the remember buffer, set local variables 13415 ;; Turn on org-mode in the remember buffer, set local variables
12895 (org-mode) 13416 (org-mode)
12896 (org-set-local 'org-finish-function 'remember-buffer) 13417 (org-set-local 'org-finish-function 'remember-finalize)
12897 (if (and file (string-match "\\S-" file) (not (file-directory-p file))) 13418 (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
12898 (org-set-local 'org-default-notes-file file)) 13419 (org-set-local 'org-default-notes-file file))
12899 (if (and headline (stringp headline) (string-match "\\S-" headline)) 13420 (if (and headline (stringp headline) (string-match "\\S-" headline))
@@ -12905,6 +13426,15 @@ to be run from that hook to fucntion properly."
12905 prompt (if (match-end 2) (match-string 2))) 13426 prompt (if (match-end 2) (match-string 2)))
12906 (goto-char (match-beginning 0)) 13427 (goto-char (match-beginning 0))
12907 (replace-match "") 13428 (replace-match "")
13429 (setq completions nil default nil)
13430 (when prompt
13431 (setq completions (org-split-string prompt "|")
13432 prompt (pop completions)
13433 default (car completions)
13434 histvar (intern (concat
13435 "org-remember-template-prompt-history::"
13436 (or prompt "")))
13437 completions (mapcar 'list completions)))
12908 (cond 13438 (cond
12909 ((member char '("G" "g")) 13439 ((member char '("G" "g"))
12910 (let* ((org-last-tags-completion-table 13440 (let* ((org-last-tags-completion-table
@@ -12930,33 +13460,92 @@ to be run from that hook to fucntion properly."
12930 (member char '("u" "U")) 13460 (member char '("u" "U"))
12931 nil nil (list org-end-time-was-given))) 13461 nil nil (list org-end-time-was-given)))
12932 (t 13462 (t
12933 (insert (read-string 13463 (insert (org-completing-read
12934 (if prompt (concat prompt ": ") "Enter string")))))) 13464 (concat (if prompt prompt "Enter string")
13465 (if default (concat " [" default "]"))
13466 ": ")
13467 completions nil nil nil histvar default)))))
12935 (goto-char (point-min)) 13468 (goto-char (point-min))
12936 (if (re-search-forward "%\\?" nil t) 13469 (if (re-search-forward "%\\?" nil t)
12937 (replace-match "") 13470 (replace-match "")
12938 (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) 13471 (and (re-search-forward "^[^#\n]" nil t) (backward-char 1))))
12939 (org-mode) 13472 (org-mode)
12940 (org-set-local 'org-finish-function 'remember-buffer))) 13473 (org-set-local 'org-finish-function 'remember-finalize))
13474 (when (save-excursion
13475 (goto-char (point-min))
13476 (re-search-forward "%!" nil t))
13477 (replace-match "")
13478 (add-hook 'post-command-hook 'org-remember-finish-immediately 'append)))
13479
13480(defun org-remember-finish-immediately ()
13481 "File remember note immediately.
13482This should be run in `post-command-hook' and will remove itself
13483from that hook."
13484 (remove-hook 'post-command-hook 'org-remember-finish-immediately)
13485 (when org-finish-function
13486 (funcall org-finish-function)))
13487
12941 13488
12942;;;###autoload 13489;;;###autoload
12943(defun org-remember (&optional org-force-remember-template-char) 13490(defun org-remember (&optional goto org-force-remember-template-char)
12944 "Call `remember'. If this is already a remember buffer, re-apply template. 13491 "Call `remember'. If this is already a remember buffer, re-apply template.
12945If there is an active region, make sure remember uses it as initial content 13492If there is an active region, make sure remember uses it as initial content
12946of the remember buffer." 13493of the remember buffer.
13494
13495When called interactively with a `C-u' prefix argument GOTO, don't remember
13496anything, just go to the file/headline where the selected template usually
13497stores its notes. With a double prefix arg `C-u C-u', go to the last
13498note stored by remember.
13499
13500Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character
13501associated with a template in `org-remember-templates'."
13502 (interactive "P")
13503 (cond
13504 ((equal goto '(4)) (org-go-to-remember-target))
13505 ((equal goto '(16)) (org-remember-goto-last-stored))
13506 (t
13507 (if (memq org-finish-function '(remember-buffer remember-finalize))
13508 (progn
13509 (when (< (length org-remember-templates) 2)
13510 (error "No other template available"))
13511 (erase-buffer)
13512 (let ((annotation (plist-get org-store-link-plist :annotation))
13513 (initial (plist-get org-store-link-plist :initial)))
13514 (org-remember-apply-template))
13515 (message "Press C-c C-c to remember data"))
13516 (if (org-region-active-p)
13517 (remember (buffer-substring (point) (mark)))
13518 (call-interactively 'remember))))))
13519
13520(defun org-remember-goto-last-stored ()
13521 "Go to the location where the last remember note was stored."
12947 (interactive) 13522 (interactive)
12948 (if (eq org-finish-function 'remember-buffer) 13523 (bookmark-jump "org-remember-last-stored")
12949 (progn 13524 (message "This is the last note stored by remember"))
12950 (when (< (length org-remember-templates) 2) 13525
12951 (error "No other template available")) 13526(defun org-go-to-remember-target (&optional template-key)
12952 (erase-buffer) 13527 "Go to the target location of a remember template.
12953 (let ((annotation (plist-get org-store-link-plist :annotation)) 13528The user is queried for the template."
12954 (initial (plist-get org-store-link-plist :initial))) 13529 (interactive)
12955 (org-remember-apply-template)) 13530 (let* ((entry (org-select-remember-template template-key))
12956 (message "Press C-c C-c to remember data")) 13531 (file (nth 1 entry))
12957 (if (org-region-active-p) 13532 (heading (nth 2 entry))
12958 (remember (buffer-substring (point) (mark))) 13533 visiting)
12959 (call-interactively 'remember)))) 13534 (unless (and file (stringp file) (string-match "\\S-" file))
13535 (setq file org-default-notes-file))
13536 (unless (and heading (stringp heading) (string-match "\\S-" heading))
13537 (setq heading org-remember-default-headline))
13538 (setq visiting (org-find-base-buffer-visiting file))
13539 (if (not visiting) (find-file-noselect file))
13540 (switch-to-buffer (or visiting (get-file-buffer file)))
13541 (widen)
13542 (goto-char (point-min))
13543 (if (re-search-forward
13544 (concat "^\\*+[ \t]+" (regexp-quote heading)
13545 (org-re "\\([ \t]+:[[:alnum:]@_:]*\\)?[ \t]*$"))
13546 nil t)
13547 (goto-char (match-beginning 0))
13548 (error "Target headline not found: %s" heading))))
12960 13549
12961(defvar org-note-abort nil) ; dynamically scoped 13550(defvar org-note-abort nil) ; dynamically scoped
12962 13551
@@ -13000,23 +13589,34 @@ See also the variable `org-reverse-note-order'."
13000 (while (looking-at "^[ \t]*\n\\|^##.*\n") 13589 (while (looking-at "^[ \t]*\n\\|^##.*\n")
13001 (replace-match "")) 13590 (replace-match ""))
13002 (goto-char (point-max)) 13591 (goto-char (point-max))
13003 (unless (equal (char-before) ?\n) (insert "\n")) 13592 (beginning-of-line 1)
13593 (while (looking-at "[ \t]*$\\|##.*")
13594 (delete-region (1- (point)) (point-max))
13595 (beginning-of-line 1))
13004 (catch 'quit 13596 (catch 'quit
13005 (if org-note-abort (throw 'quit nil)) 13597 (if org-note-abort (throw 'quit nil))
13006 (let* ((txt (buffer-substring (point-min) (point-max))) 13598 (let* ((txt (buffer-substring (point-min) (point-max)))
13007 (fastp (org-xor (equal current-prefix-arg '(4)) 13599 (fastp (org-xor (equal current-prefix-arg '(4))
13008 org-remember-store-without-prompt)) 13600 org-remember-store-without-prompt))
13009 (file (if fastp org-default-notes-file (org-get-org-file))) 13601 (file (cond
13602 (fastp org-default-notes-file)
13603 ((and org-remember-use-refile-when-interactive
13604 org-refile-targets)
13605 org-default-notes-file)
13606 (t (org-get-org-file))))
13010 (heading org-remember-default-headline) 13607 (heading org-remember-default-headline)
13011 (visiting (org-find-base-buffer-visiting file)) 13608 (visiting (and file (org-find-base-buffer-visiting file)))
13012 (org-startup-folded nil) 13609 (org-startup-folded nil)
13013 (org-startup-align-all-tables nil) 13610 (org-startup-align-all-tables nil)
13014 (org-goto-start-pos 1) 13611 (org-goto-start-pos 1)
13015 spos exitcmd level indent reversed) 13612 spos exitcmd level indent reversed)
13016 (if (and (equal current-prefix-arg '(16)) org-remember-previous-location) 13613 (if (and (equal current-prefix-arg '(16)) org-remember-previous-location)
13017 (setq file (car org-remember-previous-location) 13614 (setq file (car org-remember-previous-location)
13018 heading (cdr org-remember-previous-location))) 13615 heading (cdr org-remember-previous-location)
13616 fastp t))
13019 (setq current-prefix-arg nil) 13617 (setq current-prefix-arg nil)
13618 (if (string-match "[ \t\n]+\\'" txt)
13619 (setq txt (replace-match "" t t txt)))
13020 ;; Modify text so that it becomes a nice subtree which can be inserted 13620 ;; Modify text so that it becomes a nice subtree which can be inserted
13021 ;; into an org tree. 13621 ;; into an org tree.
13022 (let* ((lines (split-string txt "\n")) 13622 (let* ((lines (split-string txt "\n"))
@@ -13031,9 +13631,25 @@ See also the variable `org-reverse-note-order'."
13031 " (" (remember-buffer-desc) ")") 13631 " (" (remember-buffer-desc) ")")
13032 indent " ")) 13632 indent " "))
13033 (if (and org-adapt-indentation indent) 13633 (if (and org-adapt-indentation indent)
13034 (setq lines (mapcar (lambda (x) (concat indent x)) lines))) 13634 (setq lines (mapcar
13635 (lambda (x)
13636 (if (string-match "\\S-" x)
13637 (concat indent x) x))
13638 lines)))
13035 (setq txt (concat first "\n" 13639 (setq txt (concat first "\n"
13036 (mapconcat 'identity lines "\n")))) 13640 (mapconcat 'identity lines "\n"))))
13641 (if (string-match "\n[ \t]*\n[ \t\n]*\\'" txt)
13642 (setq txt (replace-match "\n\n" t t txt))
13643 (if (string-match "[ \t\n]*\\'" txt)
13644 (setq txt (replace-match "\n" t t txt))))
13645 ;; Put the modified text back into the remember buffer, for refile.
13646 (erase-buffer)
13647 (insert txt)
13648 (goto-char (point-min))
13649 (when (and org-remember-use-refile-when-interactive
13650 (not fastp))
13651 (org-refile nil (or visiting (find-file-noselect file)))
13652 (throw 'quit t))
13037 ;; Find the file 13653 ;; Find the file
13038 (if (not visiting) (find-file-noselect file)) 13654 (if (not visiting) (find-file-noselect file))
13039 (with-current-buffer (or visiting (get-file-buffer file)) 13655 (with-current-buffer (or visiting (get-file-buffer file))
@@ -13082,19 +13698,22 @@ See also the variable `org-reverse-note-order'."
13082 (org-get-heading 'notags))) 13698 (org-get-heading 'notags)))
13083 (if reversed 13699 (if reversed
13084 (outline-next-heading) 13700 (outline-next-heading)
13085 (org-end-of-subtree) 13701 (org-end-of-subtree t)
13086 (if (not (bolp)) 13702 (if (not (bolp))
13087 (if (looking-at "[ \t]*\n") 13703 (if (looking-at "[ \t]*\n")
13088 (beginning-of-line 2) 13704 (beginning-of-line 2)
13089 (end-of-line 1) 13705 (end-of-line 1)
13090 (insert "\n")))) 13706 (insert "\n"))))
13707 (bookmark-set "org-remember-last-stored")
13091 (org-paste-subtree (org-get-legal-level level 1) txt)) 13708 (org-paste-subtree (org-get-legal-level level 1) txt))
13092 ((eq exitcmd 'left) 13709 ((eq exitcmd 'left)
13093 ;; before current 13710 ;; before current
13711 (bookmark-set "org-remember-last-stored")
13094 (org-paste-subtree level txt)) 13712 (org-paste-subtree level txt))
13095 ((eq exitcmd 'right) 13713 ((eq exitcmd 'right)
13096 ;; after current 13714 ;; after current
13097 (org-end-of-subtree t) 13715 (org-end-of-subtree t)
13716 (bookmark-set "org-remember-last-stored")
13098 (org-paste-subtree level txt)) 13717 (org-paste-subtree level txt))
13099 (t (error "This should not happen")))) 13718 (t (error "This should not happen"))))
13100 13719
@@ -13104,6 +13723,7 @@ See also the variable `org-reverse-note-order'."
13104 (widen) 13723 (widen)
13105 (goto-char (point-max)) 13724 (goto-char (point-max))
13106 (if (not (bolp)) (newline)) 13725 (if (not (bolp)) (newline))
13726 (bookmark-set "org-remember-last-stored")
13107 (org-paste-subtree (org-get-legal-level 1 1) txt))) 13727 (org-paste-subtree (org-get-legal-level 1 1) txt)))
13108 13728
13109 ((and (bobp) reversed) 13729 ((and (bobp) reversed)
@@ -13113,16 +13733,19 @@ See also the variable `org-reverse-note-order'."
13113 (goto-char (point-min)) 13733 (goto-char (point-min))
13114 (re-search-forward "^\\*+ " nil t) 13734 (re-search-forward "^\\*+ " nil t)
13115 (beginning-of-line 1) 13735 (beginning-of-line 1)
13736 (bookmark-set "org-remember-last-stored")
13116 (org-paste-subtree 1 txt))) 13737 (org-paste-subtree 1 txt)))
13117 (t 13738 (t
13118 ;; Put it right there, with automatic level determined by 13739 ;; Put it right there, with automatic level determined by
13119 ;; org-paste-subtree or from prefix arg 13740 ;; org-paste-subtree or from prefix arg
13741 (bookmark-set "org-remember-last-stored")
13120 (org-paste-subtree 13742 (org-paste-subtree
13121 (if (numberp current-prefix-arg) current-prefix-arg) 13743 (if (numberp current-prefix-arg) current-prefix-arg)
13122 txt))) 13744 txt)))
13123 (when remember-save-after-remembering 13745 (when remember-save-after-remembering
13124 (save-buffer) 13746 (save-buffer)
13125 (if (not visiting) (kill-buffer (current-buffer))))))))) 13747 (if (not visiting) (kill-buffer (current-buffer)))))))))
13748
13126 t) ;; return t to indicate that we took care of this note. 13749 t) ;; return t to indicate that we took care of this note.
13127 13750
13128(defun org-get-org-file () 13751(defun org-get-org-file ()
@@ -13146,6 +13769,160 @@ See also the variable `org-reverse-note-order'."
13146 (throw 'exit (cdr entry)))) 13769 (throw 'exit (cdr entry))))
13147 nil))))) 13770 nil)))))
13148 13771
13772;;; Refiling
13773
13774(defvar org-refile-target-table nil
13775 "The list of refile targets, created by `org-refile'.")
13776
13777(defvar org-agenda-new-buffers nil
13778 "Buffers created to visit agenda files.")
13779
13780(defun org-get-refile-targets (&optional default-buffer)
13781 "Produce a table with refile targets."
13782 (let ((entries (or org-refile-targets '((nil . (:level . 1)))))
13783 org-agenda-new-buffers targets txt re files f desc descre)
13784 (with-current-buffer (or default-buffer (current-buffer))
13785 (while (setq entry (pop entries))
13786 (setq files (car entry) desc (cdr entry))
13787 (cond
13788 ((null files) (setq files (list (current-buffer))))
13789 ((eq files 'org-agenda-files)
13790 (setq files (org-agenda-files 'unrestricted)))
13791 ((and (symbolp files) (fboundp files))
13792 (setq files (funcall files)))
13793 ((and (symbolp files) (boundp files))
13794 (setq files (symbol-value files))))
13795 (if (stringp files) (setq files (list files)))
13796 (cond
13797 ((eq (car desc) :tag)
13798 (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
13799 ((eq (car desc) :todo)
13800 (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
13801 ((eq (car desc) :regexp)
13802 (setq descre (cdr desc)))
13803 ((eq (car desc) :level)
13804 (setq descre (concat "^\\*\\{" (number-to-string
13805 (if org-odd-levels-only
13806 (1- (* 2 (cdr desc)))
13807 (cdr desc)))
13808 "\\}[ \t]")))
13809 ((eq (car desc) :maxlevel)
13810 (setq descre (concat "^\\*\\{1," (number-to-string
13811 (if org-odd-levels-only
13812 (1- (* 2 (cdr desc)))
13813 (cdr desc)))
13814 "\\}[ \t]")))
13815 (t (error "Bad refiling target description %s" desc)))
13816 (while (setq f (pop files))
13817 (save-excursion
13818 (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)))
13819 (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f))))
13820 (save-excursion
13821 (save-restriction
13822 (widen)
13823 (goto-char (point-min))
13824 (while (re-search-forward descre nil t)
13825 (goto-char (point-at-bol))
13826 (when (looking-at org-complex-heading-regexp)
13827 (setq txt (match-string 4)
13828 re (concat "^" (regexp-quote
13829 (buffer-substring (match-beginning 1)
13830 (match-end 4)))))
13831 (if (match-end 5) (setq re (concat re "[ \t]+"
13832 (regexp-quote
13833 (match-string 5)))))
13834 (setq re (concat re "[ \t]*$"))
13835 (when org-refile-use-outline-path
13836 (setq txt (mapconcat 'identity
13837 (append
13838 (if (eq org-refile-use-outline-path 'file)
13839 (list (file-name-nondirectory
13840 (buffer-file-name (buffer-base-buffer))))
13841 (if (eq org-refile-use-outline-path 'full-file-path)
13842 (list (buffer-file-name (buffer-base-buffer)))))
13843 (org-get-outline-path)
13844 (list txt))
13845 "/")))
13846 (push (list txt f re (point)) targets))
13847 (goto-char (point-at-eol))))))))
13848 (org-release-buffers org-agenda-new-buffers)
13849 (nreverse targets))))
13850
13851(defun org-get-outline-path ()
13852 (let (rtn)
13853 (save-excursion
13854 (while (org-up-heading-safe)
13855 (when (looking-at org-complex-heading-regexp)
13856 (push (org-match-string-no-properties 4) rtn)))
13857 rtn)))
13858
13859(defvar org-refile-history nil
13860 "History for refiling operations.")
13861
13862(defun org-refile (&optional reversed-or-update default-buffer)
13863 "Move the entry at point to another heading.
13864The list of target headings is compiled using the information in
13865`org-refile-targets', which see. This list is created upon first use, and
13866you can update it by calling this command with a double prefix (`C-u C-u').
13867FIXME: Can we find a better way of updating?
13868
13869At the target location, the entry is filed as a subitem of the target heading.
13870Depending on `org-reverse-note-order', the new subitem will either be the
13871first of the last subitem. A single C-u prefix will toggle the value of this
13872variable for the duration of the command."
13873 (interactive "P")
13874 (if (equal reversed-or-update '(16))
13875 (progn
13876 (setq org-refile-target-table (org-get-refile-targets default-buffer))
13877 (message "Refile targets updated (%d targets)"
13878 (length org-refile-target-table)))
13879 (when (or (not org-refile-target-table)
13880 (assq nil org-refile-targets))
13881 (setq org-refile-target-table (org-get-refile-targets default-buffer)))
13882 (unless org-refile-target-table
13883 (error "No refile targets"))
13884 (let* ((cbuf (current-buffer))
13885 (filename (buffer-file-name (buffer-base-buffer cbuf)))
13886 (fname (and filename (file-truename filename)))
13887 (tbl (mapcar
13888 (lambda (x)
13889 (if (not (equal fname (file-truename (nth 1 x))))
13890 (cons (concat (car x) " (" (file-name-nondirectory
13891 (nth 1 x)) ")")
13892 (cdr x))
13893 x))
13894 org-refile-target-table))
13895 (completion-ignore-case t)
13896 pos it nbuf file re level reversed)
13897 (when (setq it (completing-read "Refile to: " tbl
13898 nil t nil 'org-refile-history))
13899 (setq it (assoc it tbl)
13900 file (nth 1 it)
13901 re (nth 2 it))
13902 (org-copy-special)
13903 (save-excursion
13904 (set-buffer (setq nbuf (or (find-buffer-visiting file)
13905 (find-file-noselect file))))
13906 (setq reversed (org-notes-order-reversed-p))
13907 (if (equal reversed-or-update '(16)) (setq reversed (not reversed)))
13908 (save-excursion
13909 (save-restriction
13910 (widen)
13911 (goto-char (point-min))
13912 (unless (re-search-forward re nil t)
13913 (error "Cannot find target location - try again with `C-u' prefix."))
13914 (goto-char (match-beginning 0))
13915 (looking-at outline-regexp)
13916 (setq level (org-get-legal-level (funcall outline-level) 1))
13917 (goto-char (or (save-excursion
13918 (if reversed
13919 (outline-next-heading)
13920 (outline-get-next-sibling)))
13921 (point-max)))
13922 (org-paste-subtree level))))
13923 (org-cut-special)
13924 (message "Entry refiled to \"%s\"" (car it))))))
13925
13149;;;; Dynamic blocks 13926;;;; Dynamic blocks
13150 13927
13151(defun org-find-dblock (name) 13928(defun org-find-dblock (name)
@@ -13264,7 +14041,8 @@ This function can be used in a hook."
13264 14041
13265(defconst org-additional-option-like-keywords 14042(defconst org-additional-option-like-keywords
13266 '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" 14043 '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX"
13267 "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:")) 14044 "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:" "TBLFM"
14045 "BEGIN_EXAMPLE" "END_EXAMPLE"))
13268 14046
13269(defun org-complete (&optional arg) 14047(defun org-complete (&optional arg)
13270 "Perform completion on word at point. 14048 "Perform completion on word at point.
@@ -13385,13 +14163,14 @@ At all other locations, this simply calls the value of
13385 (interactive) 14163 (interactive)
13386 (save-excursion 14164 (save-excursion
13387 (org-back-to-heading) 14165 (org-back-to-heading)
13388 (if (looking-at (concat outline-regexp 14166 (let (case-fold-search)
13389 "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) 14167 (if (looking-at (concat outline-regexp
13390 (replace-match "" t t nil 1) 14168 "\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
13391 (if (looking-at outline-regexp) 14169 (replace-match "" t t nil 1)
13392 (progn 14170 (if (looking-at outline-regexp)
13393 (goto-char (match-end 0)) 14171 (progn
13394 (insert org-comment-string " ")))))) 14172 (goto-char (match-end 0))
14173 (insert org-comment-string " ")))))))
13395 14174
13396(defvar org-last-todo-state-is-todo nil 14175(defvar org-last-todo-state-is-todo nil
13397 "This is non-nil when the last TODO state change led to a TODO state. 14176 "This is non-nil when the last TODO state change led to a TODO state.
@@ -13491,7 +14270,7 @@ For calling through lisp, arg is also interpreted in the following way:
13491 (or (looking-at (concat " +" org-todo-regexp " *")) 14270 (or (looking-at (concat " +" org-todo-regexp " *"))
13492 (looking-at " *")) 14271 (looking-at " *"))
13493 (let* ((match-data (match-data)) 14272 (let* ((match-data (match-data))
13494 (startpos (line-beginning-position)) 14273 (startpos (point-at-bol))
13495 (logging (save-match-data (org-entry-get nil "LOGGING" t))) 14274 (logging (save-match-data (org-entry-get nil "LOGGING" t)))
13496 (org-log-done (org-parse-local-options logging 'org-log-done)) 14275 (org-log-done (org-parse-local-options logging 'org-log-done))
13497 (org-log-repeat (org-parse-local-options logging 'org-log-repeat)) 14276 (org-log-repeat (org-parse-local-options logging 'org-log-repeat))
@@ -13666,8 +14445,6 @@ Returns the new TODO keyword, or nil if no state change should occur."
13666 (save-window-excursion 14445 (save-window-excursion
13667 (if expert 14446 (if expert
13668 (set-buffer (get-buffer-create " *Org todo*")) 14447 (set-buffer (get-buffer-create " *Org todo*"))
13669; (delete-other-windows)
13670; (split-window-vertically)
13671 (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) 14448 (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
13672 (erase-buffer) 14449 (erase-buffer)
13673 (org-set-local 'org-done-keywords done-keywords) 14450 (org-set-local 'org-done-keywords done-keywords)
@@ -13968,7 +14745,7 @@ The auto-repeater uses this.")
13968 (end-of-line 1) 14745 (end-of-line 1)
13969 (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) 14746 (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
13970 (indent-relative nil) 14747 (indent-relative nil)
13971 (insert " - " (pop lines)) 14748 (insert "- " (pop lines))
13972 (org-indent-line-function) 14749 (org-indent-line-function)
13973 (beginning-of-line 1) 14750 (beginning-of-line 1)
13974 (looking-at "[ \t]*") 14751 (looking-at "[ \t]*")
@@ -13994,12 +14771,17 @@ t Show entries with a specific TODO keyword.
13994T Show entries selected by a tags match. 14771T Show entries selected by a tags match.
13995p Enter a property name and its value (both with completion on existing 14772p Enter a property name and its value (both with completion on existing
13996 names/values) and show entries with that property. 14773 names/values) and show entries with that property.
13997r Show entries matching a regular expression" 14774r Show entries matching a regular expression
14775d Show deadlines due within `org-deadline-warning-days'."
13998 (interactive "P") 14776 (interactive "P")
13999 (let (ans kwd value) 14777 (let (ans kwd value)
14000 (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty") 14778 (message "Sparse tree: [/]regexp [t]odo-kwd [T]ag [p]roperty [d]eadlines [b]efore-date")
14001 (setq ans (read-char-exclusive)) 14779 (setq ans (read-char-exclusive))
14002 (cond 14780 (cond
14781 ((equal ans ?d)
14782 (call-interactively 'org-check-deadlines))
14783 ((equal ans ?b)
14784 (call-interactively 'org-check-before-date))
14003 ((equal ans ?t) 14785 ((equal ans ?t)
14004 (org-show-todo-tree '(4))) 14786 (org-show-todo-tree '(4)))
14005 ((equal ans ?T) 14787 ((equal ans ?T)
@@ -14012,7 +14794,7 @@ r Show entries matching a regular expression"
14012 (unless (string-match "\\`{.*}\\'" value) 14794 (unless (string-match "\\`{.*}\\'" value)
14013 (setq value (concat "\"" value "\""))) 14795 (setq value (concat "\"" value "\"")))
14014 (org-tags-sparse-tree arg (concat kwd "=" value))) 14796 (org-tags-sparse-tree arg (concat kwd "=" value)))
14015 ((member ans '(?r ?R)) 14797 ((member ans '(?r ?R ?/))
14016 (call-interactively 'org-occur)) 14798 (call-interactively 'org-occur))
14017 (t (error "No such sparse tree command \"%c\"" ans))))) 14799 (t (error "No such sparse tree command \"%c\"" ans)))))
14018 14800
@@ -14063,12 +14845,13 @@ How much context is shown depends upon the variables
14063 (let ((heading-p (org-on-heading-p t)) 14845 (let ((heading-p (org-on-heading-p t))
14064 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) 14846 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
14065 (following-p (org-get-alist-option org-show-following-heading key)) 14847 (following-p (org-get-alist-option org-show-following-heading key))
14848 (entry-p (org-get-alist-option org-show-entry-below key))
14066 (siblings-p (org-get-alist-option org-show-siblings key))) 14849 (siblings-p (org-get-alist-option org-show-siblings key)))
14067 (catch 'exit 14850 (catch 'exit
14068 ;; Show heading or entry text 14851 ;; Show heading or entry text
14069 (if heading-p 14852 (if (and heading-p (not entry-p))
14070 (org-flag-heading nil) ; only show the heading 14853 (org-flag-heading nil) ; only show the heading
14071 (and (or (org-invisible-p) (org-invisible-p2)) 14854 (and (or entry-p (org-invisible-p) (org-invisible-p2))
14072 (org-show-hidden-entry))) ; show entire entry 14855 (org-show-hidden-entry))) ; show entire entry
14073 (when following-p 14856 (when following-p
14074 ;; Show next sibling, or heading below text 14857 ;; Show next sibling, or heading below text
@@ -14303,11 +15086,13 @@ MATCH can contain positive and negative selection of tags, like
14303If optional argument TODO_ONLY is non-nil, only select lines that are 15086If optional argument TODO_ONLY is non-nil, only select lines that are
14304also TODO lines." 15087also TODO lines."
14305 (interactive "P") 15088 (interactive "P")
15089 (org-prepare-agenda-buffers (list (current-buffer)))
14306 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) 15090 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
14307 15091
14308(defvar org-cached-props nil) 15092(defvar org-cached-props nil)
14309(defun org-cached-entry-get (pom property) 15093(defun org-cached-entry-get (pom property)
14310 (if org-use-property-inheritance 15094 (if (or (eq t org-use-property-inheritance)
15095 (member property org-use-property-inheritance))
14311 ;; Caching is not possible, check it directly 15096 ;; Caching is not possible, check it directly
14312 (org-entry-get pom property 'inherit) 15097 (org-entry-get pom property 'inherit)
14313 ;; Get all properties, so that we can do complicated checks easily 15098 ;; Get all properties, so that we can do complicated checks easily
@@ -14345,7 +15130,7 @@ also TODO lines."
14345 (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)")) 15130 (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)"))
14346 minus tag mm 15131 minus tag mm
14347 tagsmatch todomatch tagsmatcher todomatcher kwd matcher 15132 tagsmatch todomatch tagsmatcher todomatcher kwd matcher
14348 orterms term orlist re-p level-p prop-p pn pv) 15133 orterms term orlist re-p level-p prop-p pn pv cat-p gv)
14349 (if (string-match "/+" match) 15134 (if (string-match "/+" match)
14350 ;; match contains also a todo-matching request 15135 ;; match contains also a todo-matching request
14351 (progn 15136 (progn
@@ -14379,11 +15164,15 @@ also TODO lines."
14379 (prop-p 15164 (prop-p
14380 (setq pn (match-string 4 term) 15165 (setq pn (match-string 4 term)
14381 pv (match-string 5 term) 15166 pv (match-string 5 term)
15167 cat-p (equal pn "CATEGORY")
14382 re-p (equal (string-to-char pv) ?{) 15168 re-p (equal (string-to-char pv) ?{)
14383 pv (substring pv 1 -1)) 15169 pv (substring pv 1 -1))
15170 (if (equal pn "CATEGORY")
15171 (setq gv '(get-text-property (point) 'org-category))
15172 (setq gv `(org-cached-entry-get nil ,pn)))
14384 (if re-p 15173 (if re-p
14385 `(string-match ,pv (or (org-cached-entry-get nil ,pn) "")) 15174 `(string-match ,pv (or ,gv ""))
14386 `(equal ,pv (org-cached-entry-get nil ,pn)))) 15175 `(equal ,pv ,gv)))
14387 (t `(member ,(downcase tag) tags-list))) 15176 (t `(member ,(downcase tag) tags-list)))
14388 mm (if minus (list 'not mm) mm) 15177 mm (if minus (list 'not mm) mm)
14389 term (substring term (match-end 0))) 15178 term (substring term (match-end 0)))
@@ -14839,7 +15628,8 @@ Returns the new tags string, or nil to not change the current settings."
14839;;; Setting and retrieving properties 15628;;; Setting and retrieving properties
14840 15629
14841(defconst org-special-properties 15630(defconst org-special-properties
14842 '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY") 15631 '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY"
15632 "TIMESTAMP" "TIMESTAMP_IA")
14843 "The special properties valid in Org-mode. 15633 "The special properties valid in Org-mode.
14844 15634
14845These are properties that are not defined in the property drawer, 15635These are properties that are not defined in the property drawer,
@@ -14935,11 +15725,12 @@ If WHICH is nil or `all', get all properties. If WHICH is
14935 (org-with-point-at pom 15725 (org-with-point-at pom
14936 (let ((clockstr (substring org-clock-string 0 -1)) 15726 (let ((clockstr (substring org-clock-string 0 -1))
14937 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) 15727 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY"))
14938 beg end range props sum-props key value) 15728 beg end range props sum-props key value string clocksum)
14939 (save-excursion 15729 (save-excursion
14940 (when (condition-case nil (org-back-to-heading t) (error nil)) 15730 (when (condition-case nil (org-back-to-heading t) (error nil))
14941 (setq beg (point)) 15731 (setq beg (point))
14942 (setq sum-props (get-text-property (point) 'org-summaries)) 15732 (setq sum-props (get-text-property (point) 'org-summaries))
15733 (setq clocksum (get-text-property (point) :org-clock-minutes))
14943 (outline-next-heading) 15734 (outline-next-heading)
14944 (setq end (point)) 15735 (setq end (point))
14945 (when (memq which '(all special)) 15736 (when (memq which '(all special))
@@ -14955,17 +15746,23 @@ If WHICH is nil or `all', get all properties. If WHICH is
14955 (when (setq value (org-get-tags-at)) 15746 (when (setq value (org-get-tags-at))
14956 (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) 15747 (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":"))
14957 props)) 15748 props))
14958 (while (re-search-forward org-keyword-time-regexp end t) 15749 (while (re-search-forward org-maybe-keyword-time-regexp end t)
14959 (setq key (substring (org-match-string-no-properties 1) 0 -1)) 15750 (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1))
14960 (unless (member key excluded) (push key excluded)) 15751 string (if (equal key clockstr)
14961 (push (cons key 15752 (org-no-properties
14962 (if (equal key clockstr) 15753 (org-trim
14963 (org-no-properties 15754 (buffer-substring
14964 (org-trim 15755 (match-beginning 3) (goto-char (point-at-eol)))))
14965 (buffer-substring 15756 (substring (org-match-string-no-properties 3) 1 -1)))
14966 (match-beginning 2) (point-at-eol)))) 15757 (unless key
14967 (org-match-string-no-properties 2))) 15758 (if (= (char-after (match-beginning 3)) ?\[)
14968 props))) 15759 (setq key "TIMESTAMP_IA")
15760 (setq key "TIMESTAMP")))
15761 (when (or (equal key clockstr) (not (assoc key props)))
15762 (push (cons key string) props)))
15763
15764 )
15765
14969 (when (memq which '(all standard)) 15766 (when (memq which '(all standard))
14970 ;; Get the standard properties, like :PORP: ... 15767 ;; Get the standard properties, like :PORP: ...
14971 (setq range (org-get-property-block beg end)) 15768 (setq range (org-get-property-block beg end))
@@ -14978,6 +15775,11 @@ If WHICH is nil or `all', get all properties. If WHICH is
14978 value (org-trim (or (org-match-string-no-properties 2) ""))) 15775 value (org-trim (or (org-match-string-no-properties 2) "")))
14979 (unless (member key excluded) 15776 (unless (member key excluded)
14980 (push (cons key (or value "")) props))))) 15777 (push (cons key (or value "")) props)))))
15778 (if clocksum
15779 (push (cons "CLOCKSUM"
15780 (org-column-number-to-string (/ (float clocksum) 60.)
15781 'add_times))
15782 props))
14981 (append sum-props (nreverse props))))))) 15783 (append sum-props (nreverse props)))))))
14982 15784
14983(defun org-entry-get (pom property &optional inherit) 15785(defun org-entry-get (pom property &optional inherit)
@@ -15175,6 +15977,7 @@ internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING."
15175 (and (equal (char-after) ?\n) (forward-char 1)) 15977 (and (equal (char-after) ?\n) (forward-char 1))
15176 (org-skip-over-state-notes) 15978 (org-skip-over-state-notes)
15177 (skip-chars-backward " \t\n\r") 15979 (skip-chars-backward " \t\n\r")
15980 (if (eq (char-before) ?*) (forward-char 1))
15178 (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) 15981 (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
15179 (beginning-of-line 0) 15982 (beginning-of-line 0)
15180 (indent-to-column indent) 15983 (indent-to-column indent)
@@ -15610,6 +16413,8 @@ Where possible, use the standard interface for changing this line."
15610 org-columns-overlays))) 16413 org-columns-overlays)))
15611 nval eval allowed) 16414 nval eval allowed)
15612 (cond 16415 (cond
16416 ((equal key "CLOCKSUM")
16417 (error "This special column cannot be edited"))
15613 ((equal key "ITEM") 16418 ((equal key "ITEM")
15614 (setq eval '(org-with-point-at pom 16419 (setq eval '(org-with-point-at pom
15615 (org-edit-headline)))) 16420 (org-edit-headline))))
@@ -15680,7 +16485,7 @@ Where possible, use the standard interface for changing this line."
15680 (key1 (concat key "_ALL")) 16485 (key1 (concat key "_ALL"))
15681 (allowed (org-entry-get (point) key1 t)) 16486 (allowed (org-entry-get (point) key1 t))
15682 nval) 16487 nval)
15683 ;; FIXME: Cover editing TODO, TAGS etc inbiffer settings.???? 16488 ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
15684 (setq nval (read-string "Allowed: " allowed)) 16489 (setq nval (read-string "Allowed: " allowed))
15685 (org-entry-put 16490 (org-entry-put
15686 (cond ((marker-position org-entry-property-inherited-from) 16491 (cond ((marker-position org-entry-property-inherited-from)
@@ -15697,7 +16502,7 @@ Where possible, use the standard interface for changing this line."
15697 (save-excursion 16502 (save-excursion
15698 (beginning-of-line 1) 16503 (beginning-of-line 1)
15699 ;; `next-line' is needed here, because it skips invisible line. 16504 ;; `next-line' is needed here, because it skips invisible line.
15700 (condition-case nil (org-no-warnings (next-line 1)) (error nil)) 16505 (condition-case nil (org-no-warnings (next-line 1)) (error nil))
15701 (setq hidep (org-on-heading-p 1))) 16506 (setq hidep (org-on-heading-p 1)))
15702 (eval form) 16507 (eval form)
15703 (and hidep (hide-entry)))) 16508 (and hidep (hide-entry))))
@@ -15797,7 +16602,7 @@ Where possible, use the standard interface for changing this line."
15797 (org-verify-version 'columns) 16602 (org-verify-version 'columns)
15798 (org-columns-remove-overlays) 16603 (org-columns-remove-overlays)
15799 (move-marker org-columns-begin-marker (point)) 16604 (move-marker org-columns-begin-marker (point))
15800 (let (beg end fmt cache maxwidths) 16605 (let (beg end fmt cache maxwidths clocksump)
15801 (setq fmt (org-columns-get-format-and-top-level)) 16606 (setq fmt (org-columns-get-format-and-top-level))
15802 (save-excursion 16607 (save-excursion
15803 (goto-char org-columns-top-level-marker) 16608 (goto-char org-columns-top-level-marker)
@@ -15806,8 +16611,14 @@ Where possible, use the standard interface for changing this line."
15806 (org-columns-compute-all)) 16611 (org-columns-compute-all))
15807 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) 16612 (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
15808 (point-max))) 16613 (point-max)))
15809 (goto-char beg)
15810 ;; Get and cache the properties 16614 ;; Get and cache the properties
16615 (goto-char beg)
16616 (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
16617 (setq clocksump t)
16618 (save-excursion
16619 (save-restriction
16620 (narrow-to-region beg end)
16621 (org-clock-sum))))
15811 (while (re-search-forward (concat "^" outline-regexp) end t) 16622 (while (re-search-forward (concat "^" outline-regexp) end t)
15812 (push (cons (org-current-line) (org-entry-properties)) cache)) 16623 (push (cons (org-current-line) (org-entry-properties)) cache))
15813 (when cache 16624 (when cache
@@ -15819,7 +16630,7 @@ Where possible, use the standard interface for changing this line."
15819 (org-columns-display-here (cdr x))) 16630 (org-columns-display-here (cdr x)))
15820 cache))))) 16631 cache)))))
15821 16632
15822(defun org-columns-new (&optional prop title width op fmt) 16633(defun org-columns-new (&optional prop title width op fmt &rest rest)
15823 "Insert a new column, to the leeft o the current column." 16634 "Insert a new column, to the leeft o the current column."
15824 (interactive) 16635 (interactive)
15825 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) 16636 (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
@@ -15833,7 +16644,7 @@ Where possible, use the standard interface for changing this line."
15833 (setq width (string-to-number width)) 16644 (setq width (string-to-number width))
15834 (setq width nil)) 16645 (setq width nil))
15835 (setq fmt (completing-read "Summary [none]: " 16646 (setq fmt (completing-read "Summary [none]: "
15836 '(("none") ("add_numbers") ("add_times") ("checkbox")) 16647 '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox"))
15837 nil t)) 16648 nil t))
15838 (if (string-match "\\S-" fmt) 16649 (if (string-match "\\S-" fmt)
15839 (setq fmt (intern fmt)) 16650 (setq fmt (intern fmt))
@@ -16036,6 +16847,7 @@ display, or in the #+COLUMNS line of the current buffer."
16036 (level 0) 16847 (level 0)
16037 (ass (assoc property org-columns-current-fmt-compiled)) 16848 (ass (assoc property org-columns-current-fmt-compiled))
16038 (format (nth 4 ass)) 16849 (format (nth 4 ass))
16850 (printf (nth 5 ass))
16039 (beg org-columns-top-level-marker) 16851 (beg org-columns-top-level-marker)
16040 last-level val valflag flag end sumpos sum-alist sum str str1 useval) 16852 last-level val valflag flag end sumpos sum-alist sum str str1 useval)
16041 (save-excursion 16853 (save-excursion
@@ -16055,7 +16867,7 @@ display, or in the #+COLUMNS line of the current buffer."
16055 ;; put the sum of lower levels here as a property 16867 ;; put the sum of lower levels here as a property
16056 (setq sum (aref lsum last-level) ; current sum 16868 (setq sum (aref lsum last-level) ; current sum
16057 flag (aref lflag last-level) ; any valid entries from children? 16869 flag (aref lflag last-level) ; any valid entries from children?
16058 str (org-column-number-to-string sum format) 16870 str (org-column-number-to-string sum format printf)
16059 str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) 16871 str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
16060 useval (if flag str1 (if valflag val "")) 16872 useval (if flag str1 (if valflag val ""))
16061 sum-alist (get-text-property sumpos 'org-summaries)) 16873 sum-alist (get-text-property sumpos 'org-summaries))
@@ -16069,7 +16881,6 @@ display, or in the #+COLUMNS line of the current buffer."
16069 (org-entry-put nil property (if flag str val))) 16881 (org-entry-put nil property (if flag str val)))
16070 ;; add current to current level accumulator 16882 ;; add current to current level accumulator
16071 (when (or flag valflag) 16883 (when (or flag valflag)
16072 ;; FIXME: is this ok?????????
16073 (aset lsum level (+ (aref lsum level) 16884 (aset lsum level (+ (aref lsum level)
16074 (if flag sum (org-column-string-to-number 16885 (if flag sum (org-column-string-to-number
16075 (if flag str val) format)))) 16886 (if flag str val) format))))
@@ -16112,7 +16923,7 @@ display, or in the #+COLUMNS line of the current buffer."
16112 (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) 16923 (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
16113 sum))) 16924 sum)))
16114 16925
16115(defun org-column-number-to-string (n fmt) 16926(defun org-column-number-to-string (n fmt &optional printf)
16116 "Convert a computed column number to a string value, according to FMT." 16927 "Convert a computed column number to a string value, according to FMT."
16117 (cond 16928 (cond
16118 ((eq fmt 'add_times) 16929 ((eq fmt 'add_times)
@@ -16122,6 +16933,9 @@ display, or in the #+COLUMNS line of the current buffer."
16122 (cond ((= n (floor n)) "[X]") 16933 (cond ((= n (floor n)) "[X]")
16123 ((> n 1.) "[-]") 16934 ((> n 1.) "[-]")
16124 (t "[ ]"))) 16935 (t "[ ]")))
16936 (printf (format printf n))
16937 ((eq fmt 'currency)
16938 (format "%.2f" n))
16125 (t (number-to-string n)))) 16939 (t (number-to-string n))))
16126 16940
16127(defun org-column-string-to-number (s fmt) 16941(defun org-column-string-to-number (s fmt)
@@ -16138,17 +16952,20 @@ display, or in the #+COLUMNS line of the current buffer."
16138 16952
16139(defun org-columns-uncompile-format (cfmt) 16953(defun org-columns-uncompile-format (cfmt)
16140 "Turn the compiled columns format back into a string representation." 16954 "Turn the compiled columns format back into a string representation."
16141 (let ((rtn "") e s prop title op width fmt) 16955 (let ((rtn "") e s prop title op width fmt printf)
16142 (while (setq e (pop cfmt)) 16956 (while (setq e (pop cfmt))
16143 (setq prop (car e) 16957 (setq prop (car e)
16144 title (nth 1 e) 16958 title (nth 1 e)
16145 width (nth 2 e) 16959 width (nth 2 e)
16146 op (nth 3 e) 16960 op (nth 3 e)
16147 fmt (nth 4 e)) 16961 fmt (nth 4 e)
16962 printf (nth 5 e))
16148 (cond 16963 (cond
16149 ((eq fmt 'add_times) (setq op ":")) 16964 ((eq fmt 'add_times) (setq op ":"))
16150 ((eq fmt 'checkbox) (setq op "X")) 16965 ((eq fmt 'checkbox) (setq op "X"))
16151 ((eq fmt 'add_numbers) (setq op "+"))) 16966 ((eq fmt 'add_numbers) (setq op "+"))
16967 ((eq fmt 'currency) (setq op "$")))
16968 (if (and op printf) (setq op (concat op ";" printf)))
16152 (if (equal title prop) (setq title nil)) 16969 (if (equal title prop) (setq title nil))
16153 (setq s (concat "%" (if width (number-to-string width)) 16970 (setq s (concat "%" (if width (number-to-string width))
16154 prop 16971 prop
@@ -16165,8 +16982,9 @@ property the property
16165title the title field for the columns 16982title the title field for the columns
16166width the column width in characters, can be nil for automatic 16983width the column width in characters, can be nil for automatic
16167operator the operator if any 16984operator the operator if any
16168format the output format for computed results, derived from operator" 16985format the output format for computed results, derived from operator
16169 (let ((start 0) width prop title op f) 16986printf a printf format for computed values"
16987 (let ((start 0) width prop title op f printf)
16170 (setq org-columns-current-fmt-compiled nil) 16988 (setq org-columns-current-fmt-compiled nil)
16171 (while (string-match 16989 (while (string-match
16172 (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") 16990 (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
@@ -16176,13 +16994,18 @@ format the output format for computed results, derived from operator"
16176 prop (match-string 2 fmt) 16994 prop (match-string 2 fmt)
16177 title (or (match-string 3 fmt) prop) 16995 title (or (match-string 3 fmt) prop)
16178 op (match-string 4 fmt) 16996 op (match-string 4 fmt)
16179 f nil) 16997 f nil
16998 printf nil)
16180 (if width (setq width (string-to-number width))) 16999 (if width (setq width (string-to-number width)))
17000 (when (and op (string-match ";" op))
17001 (setq printf (substring op (match-end 0))
17002 op (substring op 0 (match-beginning 0))))
16181 (cond 17003 (cond
16182 ((equal op "+") (setq f 'add_numbers)) 17004 ((equal op "+") (setq f 'add_numbers))
17005 ((equal op "$") (setq f 'currency))
16183 ((equal op ":") (setq f 'add_times)) 17006 ((equal op ":") (setq f 'add_times))
16184 ((equal op "X") (setq f 'checkbox))) 17007 ((equal op "X") (setq f 'checkbox)))
16185 (push (list prop title width op f) org-columns-current-fmt-compiled)) 17008 (push (list prop title width op f printf) org-columns-current-fmt-compiled))
16186 (setq org-columns-current-fmt-compiled 17009 (setq org-columns-current-fmt-compiled
16187 (nreverse org-columns-current-fmt-compiled)))) 17010 (nreverse org-columns-current-fmt-compiled))))
16188 17011
@@ -16311,28 +17134,30 @@ So if you press just return without typing anything, the time stamp
16311will represent the current date/time. If there is already a timestamp 17134will represent the current date/time. If there is already a timestamp
16312at the cursor, it will be modified." 17135at the cursor, it will be modified."
16313 (interactive "P") 17136 (interactive "P")
16314 (let ((default-time 17137 (let* ((ts nil)
16315 ;; Default time is either today, or, when entering a range, 17138 (default-time
16316 ;; the range start. 17139 ;; Default time is either today, or, when entering a range,
16317 (if (or (org-at-timestamp-p t) 17140 ;; the range start.
16318 (save-excursion 17141 (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0)))
16319 (re-search-backward 17142 (save-excursion
16320 (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses 17143 (re-search-backward
16321 (- (point) 20) t))) 17144 (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
16322 (apply 'encode-time (org-parse-time-string (match-string 1))) 17145 (- (point) 20) t)))
16323 (current-time))) 17146 (apply 'encode-time (org-parse-time-string (match-string 1)))
16324 org-time-was-given org-end-time-was-given time) 17147 (current-time)))
17148 (default-input (and ts (org-get-compact-tod ts)))
17149 org-time-was-given org-end-time-was-given time)
16325 (cond 17150 (cond
16326 ((and (org-at-timestamp-p) 17151 ((and (org-at-timestamp-p)
16327 (eq last-command 'org-time-stamp) 17152 (eq last-command 'org-time-stamp)
16328 (eq this-command 'org-time-stamp)) 17153 (eq this-command 'org-time-stamp))
16329 (insert "--") 17154 (insert "--")
16330 (setq time (let ((this-command this-command)) 17155 (setq time (let ((this-command this-command))
16331 (org-read-date arg 'totime nil nil default-time))) 17156 (org-read-date arg 'totime nil nil default-time default-input)))
16332 (org-insert-time-stamp time (or org-time-was-given arg))) 17157 (org-insert-time-stamp time (or org-time-was-given arg)))
16333 ((org-at-timestamp-p) 17158 ((org-at-timestamp-p)
16334 (setq time (let ((this-command this-command)) 17159 (setq time (let ((this-command this-command))
16335 (org-read-date arg 'totime nil nil default-time))) 17160 (org-read-date arg 'totime nil nil default-time default-input)))
16336 (when (org-at-timestamp-p) ; just to get the match data 17161 (when (org-at-timestamp-p) ; just to get the match data
16337 (replace-match "") 17162 (replace-match "")
16338 (setq org-last-changed-timestamp 17163 (setq org-last-changed-timestamp
@@ -16342,10 +17167,28 @@ at the cursor, it will be modified."
16342 (message "Timestamp updated")) 17167 (message "Timestamp updated"))
16343 (t 17168 (t
16344 (setq time (let ((this-command this-command)) 17169 (setq time (let ((this-command this-command))
16345 (org-read-date arg 'totime nil nil default-time))) 17170 (org-read-date arg 'totime nil nil default-time default-input)))
16346 (org-insert-time-stamp time (or org-time-was-given arg) 17171 (org-insert-time-stamp time (or org-time-was-given arg)
16347 nil nil nil (list org-end-time-was-given)))))) 17172 nil nil nil (list org-end-time-was-given))))))
16348 17173
17174;; FIXME: can we use this for something else????
17175;; like computing time differences?????
17176(defun org-get-compact-tod (s)
17177 (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
17178 (let* ((t1 (match-string 1 s))
17179 (h1 (string-to-number (match-string 2 s)))
17180 (m1 (string-to-number (match-string 3 s)))
17181 (t2 (and (match-end 4) (match-string 5 s)))
17182 (h2 (and t2 (string-to-number (match-string 6 s))))
17183 (m2 (and t2 (string-to-number (match-string 7 s))))
17184 dh dm)
17185 (if (not t2)
17186 t1
17187 (setq dh (- h2 h1) dm (- m2 m1))
17188 (if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
17189 (concat t1 "+" (number-to-string dh)
17190 (if (/= 0 dm) (concat ":" (number-to-string dm))))))))
17191
16349(defun org-time-stamp-inactive (&optional arg) 17192(defun org-time-stamp-inactive (&optional arg)
16350 "Insert an inactive time stamp. 17193 "Insert an inactive time stamp.
16351An inactive time stamp is enclosed in square brackets instead of angle 17194An inactive time stamp is enclosed in square brackets instead of angle
@@ -16366,9 +17209,13 @@ So these are more for recording a certain time/date."
16366(defvar org-ans2) ; dynamically scoped parameter 17209(defvar org-ans2) ; dynamically scoped parameter
16367 17210
16368(defvar org-plain-time-of-day-regexp) ; defined below 17211(defvar org-plain-time-of-day-regexp) ; defined below
17212
17213(defvar org-read-date-overlay nil)
17214(defvar org-dcst nil) ; dynamically scoped
17215
16369(defun org-read-date (&optional with-time to-time from-string prompt 17216(defun org-read-date (&optional with-time to-time from-string prompt
16370 default-time) 17217 default-time default-input)
16371 "Read a date and make things smooth for the user. 17218 "Read a date, possibly a time, and make things smooth for the user.
16372The prompt will suggest to enter an ISO date, but you can also enter anything 17219The prompt will suggest to enter an ISO date, but you can also enter anything
16373which will at least partially be understood by `parse-time-string'. 17220which will at least partially be understood by `parse-time-string'.
16374Unrecognized parts of the date will default to the current day, month, year, 17221Unrecognized parts of the date will default to the current day, month, year,
@@ -16402,7 +17249,7 @@ While prompting, a calendar is popped up - you can also select the
16402date with the mouse (button 1). The calendar shows a period of three 17249date with the mouse (button 1). The calendar shows a period of three
16403months. To scroll it to other months, use the keys `>' and `<'. 17250months. To scroll it to other months, use the keys `>' and `<'.
16404If you don't like the calendar, turn it off with 17251If you don't like the calendar, turn it off with
16405 \(setq org-popup-calendar-for-date-prompt nil) 17252 \(setq org-read-date-popup-calendar nil)
16406 17253
16407With optional argument TO-TIME, the date will immediately be converted 17254With optional argument TO-TIME, the date will immediately be converted
16408to an internal time. 17255to an internal time.
@@ -16411,29 +17258,35 @@ insert a time. Note that when WITH-TIME is not set, you can still
16411enter a time, and this function will inform the calling routine about 17258enter a time, and this function will inform the calling routine about
16412this change. The calling routine may then choose to change the format 17259this change. The calling routine may then choose to change the format
16413used to insert the time stamp into the buffer to include the time. 17260used to insert the time stamp into the buffer to include the time.
16414With optional argument FROM-STRING, read fomr this string instead from 17261With optional argument FROM-STRING, read from this string instead from
16415the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is 17262the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
16416the time/date that is used for everything that is not specified by the 17263the time/date that is used for everything that is not specified by the
16417user." 17264user."
16418 (require 'parse-time) 17265 (require 'parse-time)
16419 (let* ((org-time-stamp-rounding-minutes 17266 (let* ((org-time-stamp-rounding-minutes
16420 (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes)) 17267 (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes))
17268 (org-dcst org-display-custom-times)
16421 (ct (org-current-time)) 17269 (ct (org-current-time))
16422 (def (or default-time ct)) 17270 (def (or default-time ct))
16423 ; (defdecode (decode-time def)) 17271 (defdecode (decode-time def))
17272 (dummy (progn
17273 (when (< (nth 2 defdecode) org-extend-today-until)
17274 (setcar (nthcdr 2 defdecode) -1)
17275 (setcar (nthcdr 1 defdecode) 59)
17276 (setq def (apply 'encode-time defdecode)
17277 defdecode (decode-time def)))))
16424 (calendar-move-hook nil) 17278 (calendar-move-hook nil)
16425 (view-diary-entries-initially nil) 17279 (view-diary-entries-initially nil)
16426 (view-calendar-holidays-initially nil) 17280 (view-calendar-holidays-initially nil)
16427 (timestr (format-time-string 17281 (timestr (format-time-string
16428 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) 17282 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
16429 (prompt (concat (if prompt (concat prompt " ") "") 17283 (prompt (concat (if prompt (concat prompt " ") "")
16430 (format "Date and/or time (default [%s]): " timestr))) 17284 (format "Date+time [%s]: " timestr)))
16431 ans (org-ans0 "") org-ans1 org-ans2 delta deltan deltaw deltadef 17285 ans (org-ans0 "") org-ans1 org-ans2 final)
16432 second minute hour day month year tl wday wday1 pm h2 m2)
16433 17286
16434 (cond 17287 (cond
16435 (from-string (setq ans from-string)) 17288 (from-string (setq ans from-string))
16436 (org-popup-calendar-for-date-prompt 17289 (org-read-date-popup-calendar
16437 (save-excursion 17290 (save-excursion
16438 (save-window-excursion 17291 (save-window-excursion
16439 (calendar) 17292 (calendar)
@@ -16455,6 +17308,12 @@ user."
16455 (org-defkey minibuffer-local-map [(meta shift right)] 17308 (org-defkey minibuffer-local-map [(meta shift right)]
16456 (lambda () (interactive) 17309 (lambda () (interactive)
16457 (org-eval-in-calendar '(calendar-forward-month 1)))) 17310 (org-eval-in-calendar '(calendar-forward-month 1))))
17311 (org-defkey minibuffer-local-map [(meta shift up)]
17312 (lambda () (interactive)
17313 (org-eval-in-calendar '(calendar-backward-year 1))))
17314 (org-defkey minibuffer-local-map [(meta shift down)]
17315 (lambda () (interactive)
17316 (org-eval-in-calendar '(calendar-forward-year 1))))
16458 (org-defkey minibuffer-local-map [(shift up)] 17317 (org-defkey minibuffer-local-map [(shift up)]
16459 (lambda () (interactive) 17318 (lambda () (interactive)
16460 (org-eval-in-calendar '(calendar-backward-week 1)))) 17319 (org-eval-in-calendar '(calendar-backward-week 1))))
@@ -16476,15 +17335,75 @@ user."
16476 (unwind-protect 17335 (unwind-protect
16477 (progn 17336 (progn
16478 (use-local-map map) 17337 (use-local-map map)
16479 (setq org-ans0 (read-string prompt "" nil nil)) 17338 (add-hook 'post-command-hook 'org-read-date-display)
17339 (setq org-ans0 (read-string prompt default-input nil nil))
16480 ;; org-ans0: from prompt 17340 ;; org-ans0: from prompt
16481 ;; org-ans1: from mouse click 17341 ;; org-ans1: from mouse click
16482 ;; org-ans2: from calendar motion 17342 ;; org-ans2: from calendar motion
16483 (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) 17343 (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
16484 (use-local-map old-map)))))) 17344 (remove-hook 'post-command-hook 'org-read-date-display)
17345 (use-local-map old-map)
17346 (when org-read-date-overlay
17347 (org-delete-overlay org-read-date-overlay)
17348 (setq org-read-date-overlay nil)))))))
17349
16485 (t ; Naked prompt only 17350 (t ; Naked prompt only
16486 (setq ans (read-string prompt "" nil timestr)))) 17351 (unwind-protect
16487 (org-detach-overlay org-date-ovl) 17352 (setq ans (read-string prompt default-input nil timestr))
17353 (when org-read-date-overlay
17354 (org-delete-overlay org-read-date-overlay)
17355 (setq org-read-date-overlay nil)))))
17356
17357 (setq final (org-read-date-analyze ans def defdecode))
17358
17359 (if to-time
17360 (apply 'encode-time final)
17361 (if (and (boundp 'org-time-was-given) org-time-was-given)
17362 (format "%04d-%02d-%02d %02d:%02d"
17363 (nth 5 final) (nth 4 final) (nth 3 final)
17364 (nth 2 final) (nth 1 final))
17365 (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
17366(defvar def)
17367(defvar defdecode)
17368(defvar with-time)
17369(defun org-read-date-display ()
17370 "Display the currrent date prompt interpretation in the minibuffer."
17371 (when org-read-date-display-live
17372 (when org-read-date-overlay
17373 (org-delete-overlay org-read-date-overlay))
17374 (let ((p (point)))
17375 (end-of-line 1)
17376 (while (not (equal (buffer-substring
17377 (max (point-min) (- (point) 4)) (point))
17378 " "))
17379 (insert " "))
17380 (goto-char p))
17381 (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
17382 " " (or org-ans1 org-ans2)))
17383 (org-end-time-was-given nil)
17384 (f (org-read-date-analyze ans def defdecode))
17385 (fmts (if org-dcst
17386 org-time-stamp-custom-formats
17387 org-time-stamp-formats))
17388 (fmt (if (or with-time
17389 (and (boundp 'org-time-was-given) org-time-was-given))
17390 (cdr fmts)
17391 (car fmts)))
17392 (txt (concat "=> " (format-time-string fmt (apply 'encode-time f)))))
17393 (when (and org-end-time-was-given
17394 (string-match org-plain-time-of-day-regexp txt))
17395 (setq txt (concat (substring txt 0 (match-end 0)) "-"
17396 org-end-time-was-given
17397 (substring txt (match-end 0)))))
17398 (setq org-read-date-overlay
17399 (make-overlay (1- (point-at-eol)) (point-at-eol)))
17400 (org-overlay-display org-read-date-overlay txt 'secondary-selection))))
17401
17402(defun org-read-date-analyze (ans def defdecode)
17403 "Analyze the combined answer of the date prompt."
17404 ;; FIXME: cleanup and comment
17405 (let (delta deltan deltaw deltadef year month day
17406 hour minute second wday pm h2 m2 tl wday1)
16488 17407
16489 (when (setq delta (org-read-date-get-relative ans (current-time) def)) 17408 (when (setq delta (org-read-date-get-relative ans (current-time) def))
16490 (setq ans (replace-match "" t t ans) 17409 (setq ans (replace-match "" t t ans)
@@ -16527,22 +17446,32 @@ user."
16527 h2 (+ hour (string-to-number (match-string 3 ans))) 17446 h2 (+ hour (string-to-number (match-string 3 ans)))
16528 minute (string-to-number (match-string 2 ans)) 17447 minute (string-to-number (match-string 2 ans))
16529 m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) 17448 m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0)))
17449 (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
16530 (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) 17450 (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans)))
16531 17451
16532 ;; Check if there is a time range 17452 ;; Check if there is a time range
16533 (when (and (boundp 'org-end-time-was-given) 17453 (when (boundp 'org-end-time-was-given)
16534 (string-match org-plain-time-of-day-regexp ans) 17454 (setq org-time-was-given nil)
16535 (match-end 8)) 17455 (when (and (string-match org-plain-time-of-day-regexp ans)
16536 (setq org-end-time-was-given (match-string 8 ans)) 17456 (match-end 8))
16537 (setq ans (concat (substring ans 0 (match-beginning 7)) 17457 (setq org-end-time-was-given (match-string 8 ans))
16538 (substring ans (match-end 7))))) 17458 (setq ans (concat (substring ans 0 (match-beginning 7))
17459 (substring ans (match-end 7))))))
16539 17460
16540 (setq tl (parse-time-string ans) 17461 (setq tl (parse-time-string ans)
16541 day (or (nth 3 tl) (string-to-number (format-time-string "%d" def))) 17462 day (or (nth 3 tl) (nth 3 defdecode))
16542 month (or (nth 4 tl) (string-to-number (format-time-string "%m" def))) 17463 month (or (nth 4 tl)
16543 year (or (nth 5 tl) (string-to-number (format-time-string "%Y" def))) 17464 (if (and org-read-date-prefer-future
16544 hour (or (nth 2 tl) (string-to-number (format-time-string "%H" def))) 17465 (nth 3 tl) (< (nth 3 tl) (nth 3 defdecode)))
16545 minute (or (nth 1 tl) (string-to-number (format-time-string "%M" def))) 17466 (1+ (nth 4 defdecode))
17467 (nth 4 defdecode)))
17468 year (or (nth 5 tl)
17469 (if (and org-read-date-prefer-future
17470 (nth 4 tl) (< (nth 4 tl) (nth 4 defdecode)))
17471 (1+ (nth 5 defdecode))
17472 (nth 5 defdecode)))
17473 hour (or (nth 2 tl) (nth 2 defdecode))
17474 minute (or (nth 1 tl) (nth 1 defdecode))
16546 second (or (nth 0 tl) 0) 17475 second (or (nth 0 tl) 0)
16547 wday (nth 6 tl)) 17476 wday (nth 6 tl))
16548 (when deltan 17477 (when deltan
@@ -16563,25 +17492,8 @@ user."
16563 (nth 2 tl)) 17492 (nth 2 tl))
16564 (setq org-time-was-given t)) 17493 (setq org-time-was-given t))
16565 (if (< year 100) (setq year (+ 2000 year))) 17494 (if (< year 100) (setq year (+ 2000 year)))
16566 (if to-time 17495 (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable
16567 (encode-time second minute hour day month year) 17496 (list second minute hour day month year)))
16568 (if (or (nth 1 tl) (nth 2 tl))
16569 (format "%04d-%02d-%02d %02d:%02d" year month day hour minute)
16570 (format "%04d-%02d-%02d" year month day)))))
16571
16572;(defun org-parse-for-shift (n1 n2 given-dec default-dec)
16573; (cond
16574; ((not (nth n1 given-dec))
16575; (nth n1 default-dec))
16576; ((or (> (nth n1 given-dec) (nth n1 (default-dec)))
16577; (not org-read-date-prefer-future))
16578; (nth n1 given-dec))
16579; (t (1+
16580; (if (nth 3 given-dec)
16581; (nth 3 given-dec)
16582; (if (> (nth
16583; (setq given
16584; (if (and
16585 17497
16586(defvar parse-time-weekdays) 17498(defvar parse-time-weekdays)
16587 17499
@@ -16589,8 +17501,8 @@ user."
16589 "Check string S for special relative date string. 17501 "Check string S for special relative date string.
16590TODAY and DEFAULT are internal times, for today and for a default. 17502TODAY and DEFAULT are internal times, for today and for a default.
16591Return shift list (N what def-flag) 17503Return shift list (N what def-flag)
16592WHAT is \"d\", \"w\", \"m\", or \"y\" for day. week, month, year. 17504WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
16593N is the number if WHATs to shift 17505N is the number of WHATs to shift.
16594DEF-FLAG is t when a double ++ or -- indicates shift relative to 17506DEF-FLAG is t when a double ++ or -- indicates shift relative to
16595 the DEFAULT date rather than TODAY." 17507 the DEFAULT date rather than TODAY."
16596 (when (string-match 17508 (when (string-match
@@ -16628,17 +17540,18 @@ Also, store the cursor date in variable org-ans2."
16628 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 17540 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
16629 (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) 17541 (setq org-ans2 (format-time-string "%Y-%m-%d" time))))
16630 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) 17542 (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
16631 (select-window sw) 17543 (select-window sw)))
16632 ;; Update the prompt to show new default date 17544
16633 (save-excursion 17545; ;; Update the prompt to show new default date
16634 (goto-char (point-min)) 17546; (save-excursion
16635 (when (and org-ans2 17547; (goto-char (point-min))
16636 (re-search-forward "\\[[-0-9]+\\]" nil t) 17548; (when (and org-ans2
16637 (get-text-property (match-end 0) 'field)) 17549; (re-search-forward "\\[[-0-9]+\\]" nil t)
16638 (let ((inhibit-read-only t)) 17550; (get-text-property (match-end 0) 'field))
16639 (replace-match (concat "[" org-ans2 "]") t t) 17551; (let ((inhibit-read-only t))
16640 (add-text-properties (point-min) (1+ (match-end 0)) 17552; (replace-match (concat "[" org-ans2 "]") t t)
16641 (text-properties-at (1+ (point-min))))))))) 17553; (add-text-properties (point-min) (1+ (match-end 0))
17554; (text-properties-at (1+ (point-min)))))))))
16642 17555
16643(defun org-calendar-select () 17556(defun org-calendar-select ()
16644 "Return to `org-read-date' with the date currently selected. 17557 "Return to `org-read-date' with the date currently selected.
@@ -16817,6 +17730,20 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
16817 (org-occur regexp nil callback) 17730 (org-occur regexp nil callback)
16818 org-warn-days))) 17731 org-warn-days)))
16819 17732
17733(defun org-check-before-date (date)
17734 "Check if there are deadlines or scheduled entries before DATE."
17735 (interactive (list (org-read-date)))
17736 (let ((case-fold-search nil)
17737 (regexp (concat "\\<\\(" org-deadline-string
17738 "\\|" org-scheduled-string
17739 "\\) *<\\([^>]+\\)>"))
17740 (callback
17741 (lambda () (time-less-p
17742 (org-time-string-to-time (match-string 2))
17743 (org-time-string-to-time date)))))
17744 (message "%d entries before %s"
17745 (org-occur regexp nil callback) date)))
17746
16820(defun org-evaluate-time-range (&optional to-buffer) 17747(defun org-evaluate-time-range (&optional to-buffer)
16821 "Evaluate a time range by computing the difference between start and end. 17748 "Evaluate a time range by computing the difference between start and end.
16822Normally the result is just printed in the echo area, but with prefix arg 17749Normally the result is just printed in the echo area, but with prefix arg
@@ -16865,10 +17792,12 @@ days in order to avoid rounding problems."
16865 h 0 m 0)) 17792 h 0 m 0))
16866 (if (not to-buffer) 17793 (if (not to-buffer)
16867 (message "%s" (org-make-tdiff-string y d h m)) 17794 (message "%s" (org-make-tdiff-string y d h m))
16868 (when (org-at-table-p) 17795 (if (org-at-table-p)
16869 (goto-char match-end) 17796 (progn
16870 (setq align t) 17797 (goto-char match-end)
16871 (and (looking-at " *|") (goto-char (match-end 0)))) 17798 (setq align t)
17799 (and (looking-at " *|") (goto-char (match-end 0))))
17800 (goto-char match-end))
16872 (if (looking-at 17801 (if (looking-at
16873 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") 17802 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
16874 (replace-match "")) 17803 (replace-match ""))
@@ -16917,7 +17846,10 @@ D may be an absolute day number, or a calendar-type list (month day year)."
16917 17846
16918(defun org-calendar-holiday () 17847(defun org-calendar-holiday ()
16919 "List of holidays, for Diary display in Org-mode." 17848 "List of holidays, for Diary display in Org-mode."
16920 (let ((hl (calendar-check-holidays date))) 17849 (require 'holidays)
17850 (let ((hl (funcall
17851 (if (fboundp 'calendar-check-holidays)
17852 'calendar-check-holidays 'check-calendar-holidays) date)))
16921 (if hl (mapconcat 'identity hl "; ")))) 17853 (if hl (mapconcat 'identity hl "; "))))
16922 17854
16923(defun org-diary-sexp-entry (sexp entry date) 17855(defun org-diary-sexp-entry (sexp entry date)
@@ -16941,7 +17873,7 @@ D may be an absolute day number, or a calendar-type list (month day year)."
16941 (t nil)))) 17873 (t nil))))
16942 17874
16943(defun org-diary-to-ical-string (frombuf) 17875(defun org-diary-to-ical-string (frombuf)
16944 "Get iCalendar entreis from diary entries in buffer FROMBUF. 17876 "Get iCalendar entries from diary entries in buffer FROMBUF.
16945This uses the icalendar.el library." 17877This uses the icalendar.el library."
16946 (let* ((tmpdir (if (featurep 'xemacs) 17878 (let* ((tmpdir (if (featurep 'xemacs)
16947 (temp-directory) 17879 (temp-directory)
@@ -17292,6 +18224,7 @@ belonging to the category \"Work\"."
17292 (if (equal filter '(4)) 18224 (if (equal filter '(4))
17293 (setq filter (read-from-minibuffer "Regexp filter: "))) 18225 (setq filter (read-from-minibuffer "Regexp filter: ")))
17294 (let* ((cnt 0) ; count added events 18226 (let* ((cnt 0) ; count added events
18227 (org-agenda-new-buffers nil)
17295 (today (org-date-to-gregorian 18228 (today (org-date-to-gregorian
17296 (time-to-days (current-time)))) 18229 (time-to-days (current-time))))
17297 (files (org-agenda-files)) entries file) 18230 (files (org-agenda-files)) entries file)
@@ -17316,7 +18249,7 @@ belonging to the category \"Work\"."
17316 (cadr (assoc 'category filter)) cat) 18249 (cadr (assoc 'category filter)) cat)
17317 (string-match 18250 (string-match
17318 (cadr (assoc 'headline filter)) evt)))))) 18251 (cadr (assoc 'headline filter)) evt))))))
17319 ;; FIXME Shall we remove text-properties for the appt text? 18252 ;; FIXME: Shall we remove text-properties for the appt text?
17320 ;; (setq evt (set-text-properties 0 (length evt) nil evt)) 18253 ;; (setq evt (set-text-properties 0 (length evt) nil evt))
17321 (when (and ok tod) 18254 (when (and ok tod)
17322 (setq tod (number-to-string tod) 18255 (setq tod (number-to-string tod)
@@ -17326,6 +18259,7 @@ belonging to the category \"Work\"."
17326 (match-string 2 tod)))) 18259 (match-string 2 tod))))
17327 (appt-add tod evt) 18260 (appt-add tod evt)
17328 (setq cnt (1+ cnt))))) entries) 18261 (setq cnt (1+ cnt))))) entries)
18262 (org-release-buffers org-agenda-new-buffers)
17329 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))) 18263 (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))
17330 18264
17331;;; The clock for measuring work time. 18265;;; The clock for measuring work time.
@@ -17360,9 +18294,17 @@ If necessary, clock-out of the currently active clock."
17360 (let (ts) 18294 (let (ts)
17361 (save-excursion 18295 (save-excursion
17362 (org-back-to-heading t) 18296 (org-back-to-heading t)
17363 (if (looking-at org-todo-line-regexp) 18297 (when (and org-clock-in-switch-to-state
17364 (setq org-clock-heading (match-string 3)) 18298 (not (looking-at (concat outline-regexp "[ \t]*"
17365 (setq org-clock-heading "???")) 18299 org-clock-in-switch-to-state
18300 "\\>"))))
18301 (org-todo org-clock-in-switch-to-state))
18302 (if (and org-clock-heading-function
18303 (functionp org-clock-heading-function))
18304 (setq org-clock-heading (funcall org-clock-heading-function))
18305 (if (looking-at org-complex-heading-regexp)
18306 (setq org-clock-heading (match-string 4))
18307 (setq org-clock-heading "???")))
17366 (setq org-clock-heading (propertize org-clock-heading 'face nil)) 18308 (setq org-clock-heading (propertize org-clock-heading 'face nil))
17367 (org-clock-find-position) 18309 (org-clock-find-position)
17368 18310
@@ -17480,6 +18422,9 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set."
17480 (set-buffer (marker-buffer org-clock-marker)) 18422 (set-buffer (marker-buffer org-clock-marker))
17481 (goto-char org-clock-marker) 18423 (goto-char org-clock-marker)
17482 (delete-region (1- (point-at-bol)) (point-at-eol))) 18424 (delete-region (1- (point-at-bol)) (point-at-eol)))
18425 (setq global-mode-string
18426 (delq 'org-mode-line-string global-mode-string))
18427 (force-mode-line-update)
17483 (message "Clock canceled")) 18428 (message "Clock canceled"))
17484 18429
17485(defun org-clock-goto (&optional delete-windows) 18430(defun org-clock-goto (&optional delete-windows)
@@ -18016,8 +18961,10 @@ The following commands are available:
18016(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) 18961(org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode)
18017(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) 18962(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
18018(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) 18963(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
18019(org-defkey org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) 18964(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
18020(org-defkey org-agenda-mode-map "r" 'org-agenda-redo) 18965(org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
18966(org-defkey org-agenda-mode-map "g" 'org-agenda-redo)
18967(org-defkey org-agenda-mode-map "e" 'org-agenda-execute)
18021(org-defkey org-agenda-mode-map "q" 'org-agenda-quit) 18968(org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
18022(org-defkey org-agenda-mode-map "x" 'org-agenda-exit) 18969(org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
18023(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) 18970(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda)
@@ -18234,6 +19181,7 @@ that have been changed along."
18234(defvar org-agenda-restrict-begin (make-marker)) 19181(defvar org-agenda-restrict-begin (make-marker))
18235(defvar org-agenda-restrict-end (make-marker)) 19182(defvar org-agenda-restrict-end (make-marker))
18236(defvar org-agenda-last-dispatch-buffer nil) 19183(defvar org-agenda-last-dispatch-buffer nil)
19184(defvar org-agenda-overriding-restriction nil)
18237 19185
18238;;;###autoload 19186;;;###autoload
18239(defun org-agenda (arg &optional keys restriction) 19187(defun org-agenda (arg &optional keys restriction)
@@ -18263,6 +19211,7 @@ Pressing `<' twice means to restrict to the current subtree or region
18263 (interactive "P") 19211 (interactive "P")
18264 (catch 'exit 19212 (catch 'exit
18265 (let* ((prefix-descriptions nil) 19213 (let* ((prefix-descriptions nil)
19214 (org-agenda-custom-commands-orig org-agenda-custom-commands)
18266 (org-agenda-custom-commands 19215 (org-agenda-custom-commands
18267 ;; normalize different versions 19216 ;; normalize different versions
18268 (delq nil 19217 (delq nil
@@ -18278,11 +19227,12 @@ Pressing `<' twice means to restrict to the current subtree or region
18278 (buf (current-buffer)) 19227 (buf (current-buffer))
18279 (bfn (buffer-file-name (buffer-base-buffer))) 19228 (bfn (buffer-file-name (buffer-base-buffer)))
18280 entry key type match lprops ans) 19229 entry key type match lprops ans)
18281 ;; Turn off restriction 19230 ;; Turn off restriction unless there is an overriding one
18282 (put 'org-agenda-files 'org-restrict nil) 19231 (unless org-agenda-overriding-restriction
18283 (setq org-agenda-restrict nil) 19232 (put 'org-agenda-files 'org-restrict nil)
18284 (move-marker org-agenda-restrict-begin nil) 19233 (setq org-agenda-restrict nil)
18285 (move-marker org-agenda-restrict-end nil) 19234 (move-marker org-agenda-restrict-begin nil)
19235 (move-marker org-agenda-restrict-end nil))
18286 ;; Delete old local properties 19236 ;; Delete old local properties
18287 (put 'org-agenda-redo-command 'org-lprops nil) 19237 (put 'org-agenda-redo-command 'org-lprops nil)
18288 ;; Remember where this call originated 19238 ;; Remember where this call originated
@@ -18292,7 +19242,7 @@ Pressing `<' twice means to restrict to the current subtree or region
18292 keys (car ans) 19242 keys (car ans)
18293 restriction (cdr ans))) 19243 restriction (cdr ans)))
18294 ;; Estabish the restriction, if any 19244 ;; Estabish the restriction, if any
18295 (when restriction 19245 (when (and (not org-agenda-overriding-restriction) restriction)
18296 (put 'org-agenda-files 'org-restrict (list bfn)) 19246 (put 'org-agenda-files 'org-restrict (list bfn))
18297 (cond 19247 (cond
18298 ((eq restriction 'region) 19248 ((eq restriction 'region)
@@ -18346,7 +19296,9 @@ Pressing `<' twice means to restrict to the current subtree or region
18346 (org-let lprops '(funcall type match))) 19296 (org-let lprops '(funcall type match)))
18347 (t (error "Invalid custom agenda command type %s" type)))) 19297 (t (error "Invalid custom agenda command type %s" type))))
18348 (org-run-agenda-series (nth 1 entry) (cddr entry)))) 19298 (org-run-agenda-series (nth 1 entry) (cddr entry))))
18349 ((equal keys "C") (customize-variable 'org-agenda-custom-commands)) 19299 ((equal keys "C")
19300 (setq org-agenda-custom-commands org-agenda-custom-commands-orig)
19301 (customize-variable 'org-agenda-custom-commands))
18350 ((equal keys "a") (call-interactively 'org-agenda-list)) 19302 ((equal keys "a") (call-interactively 'org-agenda-list))
18351 ((equal keys "t") (call-interactively 'org-todo-list)) 19303 ((equal keys "t") (call-interactively 'org-todo-list))
18352 ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) 19304 ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
@@ -18364,6 +19316,16 @@ Pressing `<' twice means to restrict to the current subtree or region
18364 ((equal keys "!") (customize-variable 'org-stuck-projects)) 19316 ((equal keys "!") (customize-variable 'org-stuck-projects))
18365 (t (error "Invalid agenda key")))))) 19317 (t (error "Invalid agenda key"))))))
18366 19318
19319(defun org-agenda-normalize-custom-commands (cmds)
19320 (delq nil
19321 (mapcar
19322 (lambda (x)
19323 (cond ((stringp (cdr x)) nil)
19324 ((stringp (nth 1 x)) x)
19325 ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
19326 (t (cons (car x) (cons "" (cdr x))))))
19327 cmds)))
19328
18367(defun org-agenda-get-restriction-and-command (prefix-descriptions) 19329(defun org-agenda-get-restriction-and-command (prefix-descriptions)
18368 "The user interface for selecting an agenda command." 19330 "The user interface for selecting an agenda command."
18369 (catch 'exit 19331 (catch 'exit
@@ -18380,13 +19342,14 @@ Pressing `<' twice means to restrict to the current subtree or region
18380 (erase-buffer) 19342 (erase-buffer)
18381 (insert (eval-when-compile 19343 (insert (eval-when-compile
18382 (let ((header 19344 (let ((header
18383"Press key for an agenda command: < Buffer,subtree/region restriction 19345"
18384-------------------------------- C Configure custom agenda commands 19346Press key for an agenda command: < Buffer,subtree/region restriction
19347-------------------------------- > Remove restriction
18385a Agenda for current week or day e Export agenda views 19348a Agenda for current week or day e Export agenda views
18386t List of all TODO entries T Entries with special TODO kwd 19349t List of all TODO entries T Entries with special TODO kwd
18387m Match a TAGS query M Like m, but only TODO entries 19350m Match a TAGS query M Like m, but only TODO entries
18388L Timeline for current buffer # List stuck projects (!=configure) 19351L Timeline for current buffer # List stuck projects (!=configure)
18389/ Multi-occur 19352/ Multi-occur C Configure custom agenda commands
18390") 19353")
18391 (start 0)) 19354 (start 0))
18392 (while (string-match 19355 (while (string-match
@@ -18402,10 +19365,10 @@ L Timeline for current buffer # List stuck projects (!=configure)
18402 (when (eq rmheader t) 19365 (when (eq rmheader t)
18403 (goto-line 1) 19366 (goto-line 1)
18404 (re-search-forward ":" nil t) 19367 (re-search-forward ":" nil t)
18405 (delete-region (match-end 0) (line-end-position)) 19368 (delete-region (match-end 0) (point-at-eol))
18406 (forward-char 1) 19369 (forward-char 1)
18407 (looking-at "-+") 19370 (looking-at "-+")
18408 (delete-region (match-end 0) (line-end-position)) 19371 (delete-region (match-end 0) (point-at-eol))
18409 (move-marker header-end (match-end 0))) 19372 (move-marker header-end (match-end 0)))
18410 (goto-char header-end) 19373 (goto-char header-end)
18411 (delete-region (point) (point-max)) 19374 (delete-region (point) (point-max))
@@ -18458,10 +19421,12 @@ L Timeline for current buffer # List stuck projects (!=configure)
18458 (setq second-time t) 19421 (setq second-time t)
18459 (fit-window-to-buffer))) 19422 (fit-window-to-buffer)))
18460 (message "Press key for agenda command%s:" 19423 (message "Press key for agenda command%s:"
18461 (if restrict-ok 19424 (if (or restrict-ok org-agenda-overriding-restriction)
18462 (if restriction 19425 (if org-agenda-overriding-restriction
18463 (format " (restricted to %s)" restriction) 19426 " (restriction lock active)"
18464 " (unrestricted)") 19427 (if restriction
19428 (format " (restricted to %s)" restriction)
19429 " (unrestricted)"))
18465 "")) 19430 ""))
18466 (setq c (read-char-exclusive)) 19431 (setq c (read-char-exclusive))
18467 (message "") 19432 (message "")
@@ -18484,10 +19449,13 @@ L Timeline for current buffer # List stuck projects (!=configure)
18484 (message "Restriction is only possible in Org-mode buffers") 19449 (message "Restriction is only possible in Org-mode buffers")
18485 (ding) (sit-for 1)) 19450 (ding) (sit-for 1))
18486 ((eq c ?1) 19451 ((eq c ?1)
19452 (org-agenda-remove-restriction-lock 'noupdate)
18487 (setq restriction 'buffer)) 19453 (setq restriction 'buffer))
18488 ((eq c ?0) 19454 ((eq c ?0)
19455 (org-agenda-remove-restriction-lock 'noupdate)
18489 (setq restriction (if region-p 'region 'subtree))) 19456 (setq restriction (if region-p 'region 'subtree)))
18490 ((eq c ?<) 19457 ((eq c ?<)
19458 (org-agenda-remove-restriction-lock 'noupdate)
18491 (setq restriction 19459 (setq restriction
18492 (cond 19460 (cond
18493 ((eq restriction 'buffer) 19461 ((eq restriction 'buffer)
@@ -18495,8 +19463,15 @@ L Timeline for current buffer # List stuck projects (!=configure)
18495 ((memq restriction '(subtree region)) 19463 ((memq restriction '(subtree region))
18496 nil) 19464 nil)
18497 (t 'buffer)))) 19465 (t 'buffer))))
18498 ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?/))) 19466 ((eq c ?>)
19467 (org-agenda-remove-restriction-lock 'noupdate)
19468 (setq restriction nil))
19469 ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/)))
18499 (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) 19470 (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
19471 ((and (> (length selstring) 0) (eq c ?\d))
19472 (delete-window)
19473 (org-agenda-get-restriction-and-command prefix-descriptions))
19474
18500 ((equal c ?q) (error "Abort")) 19475 ((equal c ?q) (error "Abort"))
18501 (t (error "Invalid key %c" c)))))))) 19476 (t (error "Invalid key %c" c))))))))
18502 19477
@@ -18543,7 +19518,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
18543 "Run an agenda command in batch mode and send the result to STDOUT. 19518 "Run an agenda command in batch mode and send the result to STDOUT.
18544If CMD-KEY is a string of length 1, it is used as a key in 19519If CMD-KEY is a string of length 1, it is used as a key in
18545`org-agenda-custom-commands' and triggers this command. If it is a 19520`org-agenda-custom-commands' and triggers this command. If it is a
18546longer string is is used as a tags/todo match string. 19521longer string it is used as a tags/todo match string.
18547Paramters are alternating variable names and values that will be bound 19522Paramters are alternating variable names and values that will be bound
18548before running the agenda command." 19523before running the agenda command."
18549 (let (pars) 19524 (let (pars)
@@ -18568,7 +19543,7 @@ before running the agenda command."
18568 "Run an agenda command in batch mode and send the result to STDOUT. 19543 "Run an agenda command in batch mode and send the result to STDOUT.
18569If CMD-KEY is a string of length 1, it is used as a key in 19544If CMD-KEY is a string of length 1, it is used as a key in
18570`org-agenda-custom-commands' and triggers this command. If it is a 19545`org-agenda-custom-commands' and triggers this command. If it is a
18571longer string is is used as a tags/todo match string. 19546longer string it is used as a tags/todo match string.
18572Paramters are alternating variable names and values that will be bound 19547Paramters are alternating variable names and values that will be bound
18573before running the agenda command. 19548before running the agenda command.
18574 19549
@@ -18625,7 +19600,7 @@ agenda-day The day in the agenda where this is listed"
18625 19600
18626(defun org-fix-agenda-info (props) 19601(defun org-fix-agenda-info (props)
18627 "Make sure all properties on an agenda item have a canonical form, 19602 "Make sure all properties on an agenda item have a canonical form,
18628so the the export commands caneasily use it." 19603so the export commands can easily use it."
18629 (let (tmp re) 19604 (let (tmp re)
18630 (when (setq tmp (plist-get props 'tags)) 19605 (when (setq tmp (plist-get props 'tags))
18631 (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) 19606 (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
@@ -18675,7 +19650,7 @@ so the the export commands caneasily use it."
18675;;;###autoload 19650;;;###autoload
18676(defmacro org-batch-store-agenda-views (&rest parameters) 19651(defmacro org-batch-store-agenda-views (&rest parameters)
18677 "Run all custom agenda commands that have a file argument." 19652 "Run all custom agenda commands that have a file argument."
18678 (let ((cmds org-agenda-custom-commands) 19653 (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
18679 (pop-up-frames nil) 19654 (pop-up-frames nil)
18680 (dir default-directory) 19655 (dir default-directory)
18681 pars cmd thiscmdkey files opts) 19656 pars cmd thiscmdkey files opts)
@@ -18686,8 +19661,8 @@ so the the export commands caneasily use it."
18686 (while cmds 19661 (while cmds
18687 (setq cmd (pop cmds) 19662 (setq cmd (pop cmds)
18688 thiscmdkey (car cmd) 19663 thiscmdkey (car cmd)
18689 opts (nth 3 cmd) 19664 opts (nth 4 cmd)
18690 files (nth 4 cmd)) 19665 files (nth 5 cmd))
18691 (if (stringp files) (setq files (list files))) 19666 (if (stringp files) (setq files (list files)))
18692 (when files 19667 (when files
18693 (eval (list 'let (append org-agenda-exporter-settings opts pars) 19668 (eval (list 'let (append org-agenda-exporter-settings opts pars)
@@ -18777,7 +19752,8 @@ is currently in place."
18777 (setq files (apply 'append 19752 (setq files (apply 'append
18778 (mapcar (lambda (f) 19753 (mapcar (lambda (f)
18779 (if (file-directory-p f) 19754 (if (file-directory-p f)
18780 (directory-files f t "\\.org\\'") 19755 (directory-files f t
19756 org-agenda-file-regexp)
18781 (list f))) 19757 (list f)))
18782 files))) 19758 files)))
18783 (if org-agenda-skip-unavailable-files 19759 (if org-agenda-skip-unavailable-files
@@ -18808,7 +19784,7 @@ the buffer and restores the previous window configuration."
18808 (message "New agenda file list installed")) 19784 (message "New agenda file list installed"))
18809 nil 'local) 19785 nil 'local)
18810 (message "%s" (substitute-command-keys 19786 (message "%s" (substitute-command-keys
18811 "Edit list and finish with \\[save-buffer]"))) 19787 "Edit list and finish with \\[save-buffer]")))
18812 (customize-variable 'org-agenda-files))) 19788 (customize-variable 'org-agenda-files)))
18813 19789
18814(defun org-store-new-agenda-file-list (list) 19790(defun org-store-new-agenda-file-list (list)
@@ -18893,7 +19869,7 @@ Optional argument FILE means, use this file instead of the current."
18893 (org-store-new-agenda-file-list files) 19869 (org-store-new-agenda-file-list files)
18894 (org-install-agenda-files-menu) 19870 (org-install-agenda-files-menu)
18895 (message "Removed file: %s" afile)) 19871 (message "Removed file: %s" afile))
18896 (message "File was not in list: %s" afile)))) 19872 (message "File was not in list: %s (not removed)" afile))))
18897 19873
18898(defun org-file-menu-entry (file) 19874(defun org-file-menu-entry (file)
18899 (vector file (list 'find-file file) t)) 19875 (vector file (list 'find-file file) t))
@@ -18982,10 +19958,9 @@ Optional argument FILE means, use this file instead of the current."
18982 (interactive) 19958 (interactive)
18983 (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) 19959 (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority)
18984 (org-delete-overlay o))) 19960 (org-delete-overlay o)))
18985 (overlays-in (point-min) (point-max))) 19961 (org-overlays-in (point-min) (point-max)))
18986 (save-excursion 19962 (save-excursion
18987 (let ((ovs (org-overlays-in (point-min) (point-max))) 19963 (let ((inhibit-read-only t)
18988 (inhibit-read-only t)
18989 b e p ov h l) 19964 b e p ov h l)
18990 (goto-char (point-min)) 19965 (goto-char (point-min))
18991 (while (re-search-forward "\\[#\\(.\\)\\]" nil t) 19966 (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
@@ -18994,7 +19969,7 @@ Optional argument FILE means, use this file instead of the current."
18994 l (or (get-char-property (point) 'org-lowest-priority) 19969 l (or (get-char-property (point) 'org-lowest-priority)
18995 org-lowest-priority) 19970 org-lowest-priority)
18996 p (string-to-char (match-string 1)) 19971 p (string-to-char (match-string 1))
18997 b (match-beginning 0) e (line-end-position) 19972 b (match-beginning 0) e (point-at-eol)
18998 ov (org-make-overlay b e)) 19973 ov (org-make-overlay b e))
18999 (org-overlay-put 19974 (org-overlay-put
19000 ov 'face 19975 ov 'face
@@ -19016,8 +19991,10 @@ Optional argument FILE means, use this file instead of the current."
19016 (save-excursion 19991 (save-excursion
19017 (save-restriction 19992 (save-restriction
19018 (while (setq file (pop files)) 19993 (while (setq file (pop files))
19019 (org-check-agenda-file file) 19994 (if (bufferp file)
19020 (set-buffer (org-get-agenda-file-buffer file)) 19995 (set-buffer file)
19996 (org-check-agenda-file file)
19997 (set-buffer (org-get-agenda-file-buffer file)))
19021 (widen) 19998 (widen)
19022 (setq bmp (buffer-modified-p)) 19999 (setq bmp (buffer-modified-p))
19023 (org-refresh-category-properties) 20000 (org-refresh-category-properties)
@@ -19096,9 +20073,6 @@ no longer in use."
19096 (while org-agenda-markers 20073 (while org-agenda-markers
19097 (move-marker (pop org-agenda-markers) nil)))) 20074 (move-marker (pop org-agenda-markers) nil))))
19098 20075
19099(defvar org-agenda-new-buffers nil
19100 "Buffers created to visit agenda files.")
19101
19102(defun org-get-agenda-file-buffer (file) 20076(defun org-get-agenda-file-buffer (file)
19103 "Get a buffer visiting FILE. If the buffer needs to be created, add 20077 "Get a buffer visiting FILE. If the buffer needs to be created, add
19104it to the list of buffers which might be released later." 20078it to the list of buffers which might be released later."
@@ -19303,7 +20277,9 @@ given in `org-agenda-start-on-weekday'."
19303 org-agenda-start-on-weekday nil)) 20277 org-agenda-start-on-weekday nil))
19304 (thefiles (org-agenda-files)) 20278 (thefiles (org-agenda-files))
19305 (files thefiles) 20279 (files thefiles)
19306 (today (time-to-days (current-time))) 20280 (today (time-to-days
20281 (time-subtract (current-time)
20282 (list 0 (* 3600 org-extend-today-until) 0))))
19307 (sd (or start-day today)) 20283 (sd (or start-day today))
19308 (start (if (or (null org-agenda-start-on-weekday) 20284 (start (if (or (null org-agenda-start-on-weekday)
19309 (< org-agenda-ndays 7)) 20285 (< org-agenda-ndays 7))
@@ -19576,11 +20552,12 @@ to skip this subtree. This is a function that can be put into
19576 20552
19577(defun org-agenda-skip-entry-if (&rest conditions) 20553(defun org-agenda-skip-entry-if (&rest conditions)
19578 "Skip entry if any of CONDITIONS is true. 20554 "Skip entry if any of CONDITIONS is true.
19579See `org-agenda-skip-if for details." 20555See `org-agenda-skip-if' for details."
19580 (org-agenda-skip-if nil conditions)) 20556 (org-agenda-skip-if nil conditions))
20557
19581(defun org-agenda-skip-subtree-if (&rest conditions) 20558(defun org-agenda-skip-subtree-if (&rest conditions)
19582 "Skip entry if any of CONDITIONS is true. 20559 "Skip entry if any of CONDITIONS is true.
19583See `org-agenda-skip-if for details." 20560See `org-agenda-skip-if' for details."
19584 (org-agenda-skip-if t conditions)) 20561 (org-agenda-skip-if t conditions))
19585 20562
19586(defun org-agenda-skip-if (subtree conditions) 20563(defun org-agenda-skip-if (subtree conditions)
@@ -19598,13 +20575,13 @@ notdeadline Check if there is no deadline
19598regexp Check if regexp matches 20575regexp Check if regexp matches
19599notregexp Check if regexp does not match. 20576notregexp Check if regexp does not match.
19600 20577
19601The regexp is taken from the conditions list, it must com right after the 20578The regexp is taken from the conditions list, it must come right after
19602`regexp' of `notregexp' element. 20579the `regexp' or `notregexp' element.
19603 20580
19604If any of these conditions is met, this function returns the end point of 20581If any of these conditions is met, this function returns the end point of
19605the entity, causing the search to continue from there. This is a function 20582the entity, causing the search to continue from there. This is a function
19606that can be put into `org-agenda-skip-function' for the duration of a command." 20583that can be put into `org-agenda-skip-function' for the duration of a command."
19607 (let (beg end m r) 20584 (let (beg end m)
19608 (org-back-to-heading t) 20585 (org-back-to-heading t)
19609 (setq beg (point) 20586 (setq beg (point)
19610 end (if subtree 20587 end (if subtree
@@ -19622,13 +20599,14 @@ that can be put into `org-agenda-skip-function' for the duration of a command."
19622 (and (memq 'notdeadline conditions) 20599 (and (memq 'notdeadline conditions)
19623 (not (re-search-forward org-deadline-time-regexp end t))) 20600 (not (re-search-forward org-deadline-time-regexp end t)))
19624 (and (setq m (memq 'regexp conditions)) 20601 (and (setq m (memq 'regexp conditions))
19625 (stringp (setq r (nth 1 m))) 20602 (stringp (nth 1 m))
19626 (re-search-forward (nth 1 m) end t)) 20603 (re-search-forward (nth 1 m) end t))
19627 (and (setq m (memq 'notregexp conditions)) 20604 (and (setq m (memq 'notregexp conditions))
19628 (stringp (setq r (nth 1 m))) 20605 (stringp (nth 1 m))
19629 (not (re-search-forward (nth 1 m) end t)))) 20606 (not (re-search-forward (nth 1 m) end t))))
19630 end))) 20607 end)))
19631 20608
20609;;;###autoload
19632(defun org-agenda-list-stuck-projects (&rest ignore) 20610(defun org-agenda-list-stuck-projects (&rest ignore)
19633 "Create agenda view for projects that are stuck. 20611 "Create agenda view for projects that are stuck.
19634Stuck projects are project that have no next actions. For the definitions 20612Stuck projects are project that have no next actions. For the definitions
@@ -19895,14 +20873,6 @@ the documentation of `org-diary'."
19895 (setq results (append results rtn)))))))) 20873 (setq results (append results rtn))))))))
19896 results)))) 20874 results))))
19897 20875
19898;; FIXME: this works only if the cursor is *not* at the
19899;; beginning of the entry
19900;(defun org-entry-is-done-p ()
19901; "Is the current entry marked DONE?"
19902; (save-excursion
19903; (and (re-search-backward "[\r\n]\\*+ " nil t)
19904; (looking-at org-nl-done-regexp))))
19905
19906(defun org-entry-is-todo-p () 20876(defun org-entry-is-todo-p ()
19907 (member (org-get-todo-state) org-not-done-keywords)) 20877 (member (org-get-todo-state) org-not-done-keywords))
19908 20878
@@ -20024,7 +20994,7 @@ the documentation of `org-diary'."
20024 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" 20994 "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
20025 "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) 20995 "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
20026 marker hdmarker deadlinep scheduledp donep tmp priority category 20996 marker hdmarker deadlinep scheduledp donep tmp priority category
20027 ee txt timestr tags b0 b3 e3) 20997 ee txt timestr tags b0 b3 e3 head)
20028 (goto-char (point-min)) 20998 (goto-char (point-min))
20029 (while (re-search-forward regexp nil t) 20999 (while (re-search-forward regexp nil t)
20030 (setq b0 (match-beginning 0) 21000 (setq b0 (match-beginning 0)
@@ -20058,8 +21028,10 @@ the documentation of `org-diary'."
20058 (setq hdmarker (org-agenda-new-marker) 21028 (setq hdmarker (org-agenda-new-marker)
20059 tags (org-get-tags-at)) 21029 tags (org-get-tags-at))
20060 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 21030 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
21031 (setq head (match-string 1))
21032 (and org-agenda-skip-timestamp-if-done donep (throw :skip t))
20061 (setq txt (org-format-agenda-item 21033 (setq txt (org-format-agenda-item
20062 nil (match-string 1) category tags timestr nil 21034 nil head category tags timestr nil
20063 remove-re))) 21035 remove-re)))
20064 (setq txt org-agenda-no-heading-message)) 21036 (setq txt org-agenda-no-heading-message))
20065 (setq priority (org-get-priority txt)) 21037 (setq priority (org-get-priority txt))
@@ -20331,7 +21303,8 @@ FRACTION is what fraction of the head-warning time has passed."
20331 (abbreviate-file-name buffer-file-name)))) 21303 (abbreviate-file-name buffer-file-name))))
20332 (regexp org-tr-regexp) 21304 (regexp org-tr-regexp)
20333 (d0 (calendar-absolute-from-gregorian date)) 21305 (d0 (calendar-absolute-from-gregorian date))
20334 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos) 21306 marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos
21307 donep head)
20335 (goto-char (point-min)) 21308 (goto-char (point-min))
20336 (while (re-search-forward regexp nil t) 21309 (while (re-search-forward regexp nil t)
20337 (catch :skip 21310 (catch :skip
@@ -20354,10 +21327,14 @@ FRACTION is what fraction of the head-warning time has passed."
20354 (setq hdmarker (org-agenda-new-marker (point))) 21327 (setq hdmarker (org-agenda-new-marker (point)))
20355 (setq tags (org-get-tags-at)) 21328 (setq tags (org-get-tags-at))
20356 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") 21329 (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
21330 (setq head (match-string 1))
21331 (and org-agenda-skip-timestamp-if-done
21332 (org-entry-is-done-p)
21333 (throw :skip t))
20357 (setq txt (org-format-agenda-item 21334 (setq txt (org-format-agenda-item
20358 (format (if (= d1 d2) "" "(%d/%d): ") 21335 (format (if (= d1 d2) "" "(%d/%d): ")
20359 (1+ (- d0 d1)) (1+ (- d2 d1))) 21336 (1+ (- d0 d1)) (1+ (- d2 d1)))
20360 (match-string 1) category tags 21337 head category tags
20361 (if (= d0 d1) timestr)))) 21338 (if (= d0 d1) timestr))))
20362 (setq txt org-agenda-no-heading-message)) 21339 (setq txt org-agenda-no-heading-message))
20363 (org-add-props txt props 21340 (org-add-props txt props
@@ -20518,7 +21495,7 @@ Any match of REMOVE-RE will be removed from TXT."
20518 'extra extra 21495 'extra extra
20519 'dotime dotime)))) 21496 'dotime dotime))))
20520 21497
20521(defvar org-agenda-sorting-strategy) ;; FIXME: can be removed? 21498(defvar org-agenda-sorting-strategy) ;; because the def is in a let form
20522(defvar org-agenda-sorting-strategy-selected nil) 21499(defvar org-agenda-sorting-strategy-selected nil)
20523 21500
20524(defun org-agenda-add-time-grid-maybe (list ndays todayp) 21501(defun org-agenda-add-time-grid-maybe (list ndays todayp)
@@ -20636,16 +21613,32 @@ HH:MM."
20636 (beginning-of-line 1) 21613 (beginning-of-line 1)
20637 (setq re (get-text-property (point) 'org-todo-regexp)) 21614 (setq re (get-text-property (point) 'org-todo-regexp))
20638 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) 21615 (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0)))
20639 (and (looking-at (concat "[ \t]*\\.*" re)) 21616 (when (looking-at (concat "[ \t]*\\.*" re " +"))
20640 (add-text-properties (match-beginning 0) (match-end 0) 21617 (add-text-properties (match-beginning 0) (match-end 0)
20641 (list 'face (org-get-todo-face 0))))) 21618 (list 'face (org-get-todo-face 0)))
21619 (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
21620 (delete-region (match-beginning 1) (1- (match-end 0)))
21621 (goto-char (match-beginning 1))
21622 (insert (format org-agenda-todo-keyword-format s)))))
20642 (setq re (concat (get-text-property 0 'org-todo-regexp x)) 21623 (setq re (concat (get-text-property 0 'org-todo-regexp x))
20643 pl (get-text-property 0 'prefix-length x)) 21624 pl (get-text-property 0 'prefix-length x))
20644 (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) 21625; (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl)
20645 (add-text-properties 21626; (add-text-properties
20646 (or (match-end 1) (match-end 0)) (match-end 0) 21627; (or (match-end 1) (match-end 0)) (match-end 0)
20647 (list 'face (org-get-todo-face (match-string 2 x))) 21628; (list 'face (org-get-todo-face (match-string 2 x)))
20648 x)) 21629; x))
21630 (when (and re
21631 (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
21632 x (or pl 0)) pl))
21633 (add-text-properties
21634 (or (match-end 1) (match-end 0)) (match-end 0)
21635 (list 'face (org-get-todo-face (match-string 2 x)))
21636 x)
21637 (setq x (concat (substring x 0 (match-end 1))
21638 (format org-agenda-todo-keyword-format
21639 (match-string 2 x))
21640 " "
21641 (substring x (match-end 3)))))
20649 x))) 21642 x)))
20650 21643
20651(defsubst org-cmp-priority (a b) 21644(defsubst org-cmp-priority (a b)
@@ -20700,6 +21693,85 @@ HH:MM."
20700 (eval (cons 'or org-agenda-sorting-strategy-selected)) 21693 (eval (cons 'or org-agenda-sorting-strategy-selected))
20701 '((-1 . t) (1 . nil) (nil . nil)))))) 21694 '((-1 . t) (1 . nil) (nil . nil))))))
20702 21695
21696;;; Agenda restriction lock
21697
21698(defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1)
21699 "Overlay to mark the headline to which arenda commands are restricted.")
21700(org-overlay-put org-agenda-restriction-lock-overlay
21701 'face 'org-agenda-restriction-lock)
21702(org-overlay-put org-agenda-restriction-lock-overlay
21703 'help-echo "Agendas are currently limited to this subtree.")
21704(org-detach-overlay org-agenda-restriction-lock-overlay)
21705(defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1)
21706 "Overlay marking the agenda restriction line in speedbar.")
21707(org-overlay-put org-speedbar-restriction-lock-overlay
21708 'face 'org-agenda-restriction-lock)
21709(org-overlay-put org-speedbar-restriction-lock-overlay
21710 'help-echo "Agendas are currently limited to this item.")
21711(org-detach-overlay org-speedbar-restriction-lock-overlay)
21712
21713(defun org-agenda-set-restriction-lock (&optional type)
21714 "Set restriction lock for agenda, to current subtree or file.
21715Restriction will be the file if TYPE is `file', or if type is the
21716universal prefix '(4), or if the cursor is before the first headline
21717in the file. Otherwise, restriction will be to the current subtree."
21718 (interactive "P")
21719 (and (equal type '(4)) (setq type 'file))
21720 (setq type (cond
21721 (type type)
21722 ((org-at-heading-p) 'subtree)
21723 ((condition-case nil (org-back-to-heading t) (error nil))
21724 'subtree)
21725 (t 'file)))
21726 (if (eq type 'subtree)
21727 (progn
21728 (setq org-agenda-restrict t)
21729 (setq org-agenda-overriding-restriction 'subtree)
21730 (put 'org-agenda-files 'org-restrict
21731 (list (buffer-file-name (buffer-base-buffer))))
21732 (org-back-to-heading t)
21733 (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol))
21734 (move-marker org-agenda-restrict-begin (point))
21735 (move-marker org-agenda-restrict-end
21736 (save-excursion (org-end-of-subtree t)))
21737 (message "Locking agenda restriction to subtree"))
21738 (put 'org-agenda-files 'org-restrict
21739 (list (buffer-file-name (buffer-base-buffer))))
21740 (setq org-agenda-restrict nil)
21741 (setq org-agenda-overriding-restriction 'file)
21742 (move-marker org-agenda-restrict-begin nil)
21743 (move-marker org-agenda-restrict-end nil)
21744 (message "Locking agenda restriction to file"))
21745 (setq current-prefix-arg nil)
21746 (org-agenda-maybe-redo))
21747
21748(defun org-agenda-remove-restriction-lock (&optional noupdate)
21749 "Remove the agenda restriction lock."
21750 (interactive "P")
21751 (org-detach-overlay org-agenda-restriction-lock-overlay)
21752 (org-detach-overlay org-speedbar-restriction-lock-overlay)
21753 (setq org-agenda-overriding-restriction nil)
21754 (setq org-agenda-restrict nil)
21755 (put 'org-agenda-files 'org-restrict nil)
21756 (move-marker org-agenda-restrict-begin nil)
21757 (move-marker org-agenda-restrict-end nil)
21758 (setq current-prefix-arg nil)
21759 (message "Agenda restriction lock removed")
21760 (or noupdate (org-agenda-maybe-redo)))
21761
21762(defun org-agenda-maybe-redo ()
21763 "If there is any window showing the agenda view, update it."
21764 (let ((w (get-buffer-window org-agenda-buffer-name t))
21765 (w0 (selected-window)))
21766 (when w
21767 (select-window w)
21768 (org-agenda-redo)
21769 (select-window w0)
21770 (if org-agenda-overriding-restriction
21771 (message "Agenda view shifted to new %s restriction"
21772 org-agenda-overriding-restriction)
21773 (message "Agenda restriction lock removed")))))
21774
20703;;; Agenda commands 21775;;; Agenda commands
20704 21776
20705(defun org-agenda-check-type (error &rest types) 21777(defun org-agenda-check-type (error &rest types)
@@ -20734,6 +21806,13 @@ Org-mode buffers visited directly by the user will not be touched."
20734 (setq org-agenda-new-buffers nil) 21806 (setq org-agenda-new-buffers nil)
20735 (org-agenda-quit)) 21807 (org-agenda-quit))
20736 21808
21809(defun org-agenda-execute (arg)
21810 "Execute another agenda command, keeping same window.\\<global-map>
21811So this is just a shortcut for `\\[org-agenda]', available in the agenda."
21812 (interactive "P")
21813 (let ((org-agenda-window-setup 'current-window))
21814 (org-agenda arg)))
21815
20737(defun org-save-all-org-buffers () 21816(defun org-save-all-org-buffers ()
20738 "Save all Org-mode buffers without user confirmation." 21817 "Save all Org-mode buffers without user confirmation."
20739 (interactive) 21818 (interactive)
@@ -20770,7 +21849,9 @@ When this is the global TODO list, a prefix argument will be interpreted."
20770 (cond 21849 (cond
20771 (tdpos (goto-char tdpos)) 21850 (tdpos (goto-char tdpos))
20772 ((eq org-agenda-type 'agenda) 21851 ((eq org-agenda-type 'agenda)
20773 (let* ((sd (time-to-days (current-time))) 21852 (let* ((sd (time-to-days
21853 (time-subtract (current-time)
21854 (list 0 (* 3600 org-extend-today-until) 0))))
20774 (comp (org-agenda-compute-time-span sd org-agenda-span)) 21855 (comp (org-agenda-compute-time-span sd org-agenda-span))
20775 (org-agenda-overriding-arguments org-agenda-last-arguments)) 21856 (org-agenda-overriding-arguments org-agenda-last-arguments))
20776 (setf (nth 1 org-agenda-overriding-arguments) (car comp)) 21857 (setf (nth 1 org-agenda-overriding-arguments) (car comp))
@@ -22034,6 +23115,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22034 (:archived-trees . org-export-with-archived-trees) 23115 (:archived-trees . org-export-with-archived-trees)
22035 (:emphasize . org-export-with-emphasize) 23116 (:emphasize . org-export-with-emphasize)
22036 (:sub-superscript . org-export-with-sub-superscripts) 23117 (:sub-superscript . org-export-with-sub-superscripts)
23118 (:special-strings . org-export-with-special-strings)
22037 (:footnotes . org-export-with-footnotes) 23119 (:footnotes . org-export-with-footnotes)
22038 (:drawers . org-export-with-drawers) 23120 (:drawers . org-export-with-drawers)
22039 (:tags . org-export-with-tags) 23121 (:tags . org-export-with-tags)
@@ -22047,10 +23129,11 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22047 (:tables . org-export-with-tables) 23129 (:tables . org-export-with-tables)
22048 (:table-auto-headline . org-export-highlight-first-table-line) 23130 (:table-auto-headline . org-export-highlight-first-table-line)
22049 (:style . org-export-html-style) 23131 (:style . org-export-html-style)
22050 (:agenda-style . org-agenda-export-html-style) ;; FIXME: Does this work???? 23132 (:agenda-style . org-agenda-export-html-style)
22051 (:convert-org-links . org-export-html-link-org-files-as-html) 23133 (:convert-org-links . org-export-html-link-org-files-as-html)
22052 (:inline-images . org-export-html-inline-images) 23134 (:inline-images . org-export-html-inline-images)
22053 (:html-extension . org-export-html-extension) 23135 (:html-extension . org-export-html-extension)
23136 (:html-table-tag . org-export-html-table-tag)
22054 (:expand-quoted-html . org-export-html-expand) 23137 (:expand-quoted-html . org-export-html-expand)
22055 (:timestamp . org-export-html-with-timestamp) 23138 (:timestamp . org-export-html-with-timestamp)
22056 (:publishing-directory . org-export-publishing-directory) 23139 (:publishing-directory . org-export-publishing-directory)
@@ -22071,50 +23154,53 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22071(defun org-infile-export-plist () 23154(defun org-infile-export-plist ()
22072 "Return the property list with file-local settings for export." 23155 "Return the property list with file-local settings for export."
22073 (save-excursion 23156 (save-excursion
22074 (goto-char 0) 23157 (save-restriction
22075 (let ((re (org-make-options-regexp 23158 (widen)
22076 '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) 23159 (goto-char 0)
22077 p key val text options) 23160 (let ((re (org-make-options-regexp
22078 (while (re-search-forward re nil t) 23161 '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")))
22079 (setq key (org-match-string-no-properties 1) 23162 p key val text options)
22080 val (org-match-string-no-properties 2)) 23163 (while (re-search-forward re nil t)
22081 (cond 23164 (setq key (org-match-string-no-properties 1)
22082 ((string-equal key "TITLE") (setq p (plist-put p :title val))) 23165 val (org-match-string-no-properties 2))
22083 ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) 23166 (cond
22084 ((string-equal key "EMAIL") (setq p (plist-put p :email val))) 23167 ((string-equal key "TITLE") (setq p (plist-put p :title val)))
22085 ((string-equal key "DATE") (setq p (plist-put p :date val))) 23168 ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
22086 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) 23169 ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
22087 ((string-equal key "TEXT") 23170 ((string-equal key "DATE") (setq p (plist-put p :date val)))
22088 (setq text (if text (concat text "\n" val) val))) 23171 ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
22089 ((string-equal key "OPTIONS") (setq options val)))) 23172 ((string-equal key "TEXT")
22090 (setq p (plist-put p :text text)) 23173 (setq text (if text (concat text "\n" val) val)))
22091 (when options 23174 ((string-equal key "OPTIONS") (setq options val))))
22092 (let ((op '(("H" . :headline-levels) 23175 (setq p (plist-put p :text text))
22093 ("num" . :section-numbers) 23176 (when options
22094 ("toc" . :table-of-contents) 23177 (let ((op '(("H" . :headline-levels)
22095 ("\\n" . :preserve-breaks) 23178 ("num" . :section-numbers)
22096 ("@" . :expand-quoted-html) 23179 ("toc" . :table-of-contents)
22097 (":" . :fixed-width) 23180 ("\\n" . :preserve-breaks)
22098 ("|" . :tables) 23181 ("@" . :expand-quoted-html)
22099 ("^" . :sub-superscript) 23182 (":" . :fixed-width)
22100 ("f" . :footnotes) 23183 ("|" . :tables)
22101 ("d" . :drawers) 23184 ("^" . :sub-superscript)
22102 ("tags" . :tags) 23185 ("-" . :special-strings)
22103 ("*" . :emphasize) 23186 ("f" . :footnotes)
22104 ("TeX" . :TeX-macros) 23187 ("d" . :drawers)
22105 ("LaTeX" . :LaTeX-fragments) 23188 ("tags" . :tags)
22106 ("skip" . :skip-before-1st-heading) 23189 ("*" . :emphasize)
22107 ("author" . :author-info) 23190 ("TeX" . :TeX-macros)
22108 ("timestamp" . :time-stamp-file))) 23191 ("LaTeX" . :LaTeX-fragments)
22109 o) 23192 ("skip" . :skip-before-1st-heading)
22110 (while (setq o (pop op)) 23193 ("author" . :author-info)
22111 (if (string-match (concat (regexp-quote (car o)) 23194 ("timestamp" . :time-stamp-file)))
22112 ":\\([^ \t\n\r;,.]*\\)") 23195 o)
22113 options) 23196 (while (setq o (pop op))
22114 (setq p (plist-put p (cdr o) 23197 (if (string-match (concat (regexp-quote (car o))
22115 (car (read-from-string 23198 ":\\([^ \t\n\r;,.]*\\)")
22116 (match-string 1 options))))))))) 23199 options)
22117 p))) 23200 (setq p (plist-put p (cdr o)
23201 (car (read-from-string
23202 (match-string 1 options)))))))))
23203 p))))
22118 23204
22119(defun org-export-directory (type plist) 23205(defun org-export-directory (type plist)
22120 (let* ((val (plist-get plist :publishing-directory)) 23206 (let* ((val (plist-get plist :publishing-directory))
@@ -22397,8 +23483,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
22397 ("prop") ("proptp"."&prop;") 23483 ("prop") ("proptp"."&prop;")
22398 ("infin") ("infty"."&infin;") 23484 ("infin") ("infty"."&infin;")
22399 ("ang") ("angle"."&ang;") 23485 ("ang") ("angle"."&ang;")
22400 ("and") ("vee"."&and;") 23486 ("and") ("wedge"."&and;")
22401 ("or") ("wedge"."&or;") 23487 ("or") ("vee"."&or;")
22402 ("cap") 23488 ("cap")
22403 ("cup") 23489 ("cup")
22404 ("int") 23490 ("int")
@@ -22523,6 +23609,8 @@ translations. There is currently no way for users to extend this.")
22523 (commentsp (plist-get parameters :comments)) 23609 (commentsp (plist-get parameters :comments))
22524 (archived-trees (plist-get parameters :archived-trees)) 23610 (archived-trees (plist-get parameters :archived-trees))
22525 (inhibit-read-only t) 23611 (inhibit-read-only t)
23612 (drawers org-drawers)
23613 (exp-drawers (plist-get parameters :drawers))
22526 (outline-regexp "\\*+ ") 23614 (outline-regexp "\\*+ ")
22527 a b xx 23615 a b xx
22528 rtn p) 23616 rtn p)
@@ -22561,14 +23649,14 @@ translations. There is currently no way for users to extend this.")
22561 (if (> b a) (delete-region a b))))) 23649 (if (> b a) (delete-region a b)))))
22562 23650
22563 ;; Get rid of drawers 23651 ;; Get rid of drawers
22564 (unless (eq t org-export-with-drawers) 23652 (unless (eq t exp-drawers)
22565 (goto-char (point-min)) 23653 (goto-char (point-min))
22566 (let ((re (concat "^[ \t]*:\\(" 23654 (let ((re (concat "^[ \t]*:\\("
22567 (mapconcat 'identity 23655 (mapconcat
22568 (if (listp org-export-with-drawers) 23656 'identity
22569 org-export-with-drawers 23657 (org-delete-all exp-drawers
22570 org-drawers) 23658 (copy-sequence drawers))
22571 "\\|") 23659 "\\|")
22572 "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n"))) 23660 "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n")))
22573 (while (re-search-forward re nil t) 23661 (while (re-search-forward re nil t)
22574 (replace-match "")))) 23662 (replace-match ""))))
@@ -22580,12 +23668,18 @@ translations. There is currently no way for users to extend this.")
22580 (replace-match "\\1(INVISIBLE)")) 23668 (replace-match "\\1(INVISIBLE)"))
22581 23669
22582 ;; Protect backend specific stuff, throw away the others. 23670 ;; Protect backend specific stuff, throw away the others.
22583 (goto-char (point-min))
22584 (let ((formatters 23671 (let ((formatters
22585 `((,htmlp "HTML" "BEGIN_HTML" "END_HTML") 23672 `((,htmlp "HTML" "BEGIN_HTML" "END_HTML")
22586 (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII") 23673 (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII")
22587 (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) 23674 (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX")))
22588 fmt) 23675 fmt)
23676 (goto-char (point-min))
23677 (while (re-search-forward "^#\\+BEGIN_EXAMPLE[ \t]*\n" nil t)
23678 (goto-char (match-end 0))
23679 (while (not (looking-at "#\\+END_EXAMPLE"))
23680 (insert ": ")
23681 (beginning-of-line 2)))
23682 (goto-char (point-min))
22589 (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) 23683 (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t)
22590 (add-text-properties (match-beginning 0) (match-end 0) 23684 (add-text-properties (match-beginning 0) (match-end 0)
22591 '(org-protected t))) 23685 '(org-protected t)))
@@ -22617,6 +23711,13 @@ translations. There is currently no way for users to extend this.")
22617 (add-text-properties (point) (org-end-of-subtree t) 23711 (add-text-properties (point) (org-end-of-subtree t)
22618 '(org-protected t))) 23712 '(org-protected t)))
22619 23713
23714 ;; Protect verbatim elements
23715 (goto-char (point-min))
23716 (while (re-search-forward org-verbatim-re nil t)
23717 (add-text-properties (match-beginning 4) (match-end 4)
23718 '(org-protected t))
23719 (goto-char (1+ (match-end 4))))
23720
22620 ;; Remove subtrees that are commented 23721 ;; Remove subtrees that are commented
22621 (goto-char (point-min)) 23722 (goto-char (point-min))
22622 (while (re-search-forward re-commented nil t) 23723 (while (re-search-forward re-commented nil t)
@@ -22640,6 +23741,9 @@ translations. There is currently no way for users to extend this.")
22640 (require 'org-export-latex nil) 23741 (require 'org-export-latex nil)
22641 (org-export-latex-cleaned-string)) 23742 (org-export-latex-cleaned-string))
22642 23743
23744 (when asciip
23745 (org-export-ascii-clean-string))
23746
22643 ;; Specific HTML stuff 23747 ;; Specific HTML stuff
22644 (when htmlp 23748 (when htmlp
22645 ;; Convert LaTeX fragments to images 23749 ;; Convert LaTeX fragments to images
@@ -22887,6 +23991,8 @@ underlined headlines. The default is 3."
22887 :for-ascii t 23991 :for-ascii t
22888 :skip-before-1st-heading 23992 :skip-before-1st-heading
22889 (plist-get opt-plist :skip-before-1st-heading) 23993 (plist-get opt-plist :skip-before-1st-heading)
23994 :drawers (plist-get opt-plist :drawers)
23995 :verbatim-multiline t
22890 :archived-trees 23996 :archived-trees
22891 (plist-get opt-plist :archived-trees) 23997 (plist-get opt-plist :archived-trees)
22892 :add-text (plist-get opt-plist :text)) 23998 :add-text (plist-get opt-plist :text))
@@ -23083,6 +24189,16 @@ underlined headlines. The default is 3."
23083 (goto-char beg))) 24189 (goto-char beg)))
23084 (goto-char (point-min)))) 24190 (goto-char (point-min))))
23085 24191
24192(defun org-export-ascii-clean-string ()
24193 "Do extra work for ASCII export"
24194 (goto-char (point-min))
24195 (while (re-search-forward org-verbatim-re nil t)
24196 (goto-char (match-end 2))
24197 (backward-delete-char 1) (insert "'")
24198 (goto-char (match-beginning 2))
24199 (delete-char 1) (insert "`")
24200 (goto-char (match-end 2))))
24201
23086(defun org-search-todo-below (line lines level) 24202(defun org-search-todo-below (line lines level)
23087 "Search the subtree below LINE for any TODO entries." 24203 "Search the subtree below LINE for any TODO entries."
23088 (let ((rest (cdr (memq line lines))) 24204 (let ((rest (cdr (memq line lines)))
@@ -23232,7 +24348,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
23232#+EMAIL: %s 24348#+EMAIL: %s
23233#+LANGUAGE: %s 24349#+LANGUAGE: %s
23234#+TEXT: Some descriptive text to be emitted. Several lines OK. 24350#+TEXT: Some descriptive text to be emitted. Several lines OK.
23235#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s 24351#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s TeX:%s LaTeX:%s skip:%s d:%s tags:%s
23236#+CATEGORY: %s 24352#+CATEGORY: %s
23237#+SEQ_TODO: %s 24353#+SEQ_TODO: %s
23238#+TYP_TODO: %s 24354#+TYP_TODO: %s
@@ -23252,6 +24368,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
23252 org-export-with-fixed-width 24368 org-export-with-fixed-width
23253 org-export-with-tables 24369 org-export-with-tables
23254 org-export-with-sub-superscripts 24370 org-export-with-sub-superscripts
24371 org-export-with-special-strings
23255 org-export-with-footnotes 24372 org-export-with-footnotes
23256 org-export-with-emphasize 24373 org-export-with-emphasize
23257 org-export-with-TeX-macros 24374 org-export-with-TeX-macros
@@ -23308,6 +24425,7 @@ this line is also exported in fixed-width font."
23308 (beg (if regionp (region-beginning) (point))) 24425 (beg (if regionp (region-beginning) (point)))
23309 (end (if regionp (region-end))) 24426 (end (if regionp (region-end)))
23310 (nlines (or arg (if (and beg end) (count-lines beg end) 1))) 24427 (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
24428 (case-fold-search nil)
23311 (re "[ \t]*\\(:\\)") 24429 (re "[ \t]*\\(:\\)")
23312 off) 24430 off)
23313 (if regionp 24431 (if regionp
@@ -23415,6 +24533,7 @@ in a window. A non-interactive call will only retunr the buffer."
23415 (switch-to-buffer-other-window rtn) 24533 (switch-to-buffer-other-window rtn)
23416 rtn))) 24534 rtn)))
23417 24535
24536(defvar html-table-tag nil) ; dynamically scoped into this.
23418(defun org-export-as-html (arg &optional hidden ext-plist 24537(defun org-export-as-html (arg &optional hidden ext-plist
23419 to-buffer body-only) 24538 to-buffer body-only)
23420 "Export the outline as a pretty HTML file. 24539 "Export the outline as a pretty HTML file.
@@ -23469,14 +24588,16 @@ the body tags themselves."
23469 (umax nil) 24588 (umax nil)
23470 (umax-toc nil) 24589 (umax-toc nil)
23471 (filename (if to-buffer nil 24590 (filename (if to-buffer nil
23472 (concat (file-name-as-directory 24591 (expand-file-name
23473 (org-export-directory :html opt-plist)) 24592 (concat
23474 (file-name-sans-extension 24593 (file-name-sans-extension
23475 (or (and subtree-p 24594 (or (and subtree-p
23476 (org-entry-get (region-beginning) 24595 (org-entry-get (region-beginning)
23477 "EXPORT_FILE_NAME" t)) 24596 "EXPORT_FILE_NAME" t))
23478 (file-name-nondirectory buffer-file-name))) 24597 (file-name-nondirectory buffer-file-name)))
23479 "." org-export-html-extension))) 24598 "." org-export-html-extension)
24599 (file-name-as-directory
24600 (org-export-directory :html opt-plist)))))
23480 (current-dir (if buffer-file-name 24601 (current-dir (if buffer-file-name
23481 (file-name-directory buffer-file-name) 24602 (file-name-directory buffer-file-name)
23482 default-directory)) 24603 default-directory))
@@ -23497,6 +24618,7 @@ the body tags themselves."
23497 (file-name-sans-extension 24618 (file-name-sans-extension
23498 (file-name-nondirectory buffer-file-name))) 24619 (file-name-nondirectory buffer-file-name)))
23499 "UNTITLED")) 24620 "UNTITLED"))
24621 (html-table-tag (plist-get opt-plist :html-table-tag))
23500 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) 24622 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
23501 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) 24623 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
23502 (inquote nil) 24624 (inquote nil)
@@ -23533,6 +24655,7 @@ the body tags themselves."
23533 :for-html t 24655 :for-html t
23534 :skip-before-1st-heading 24656 :skip-before-1st-heading
23535 (plist-get opt-plist :skip-before-1st-heading) 24657 (plist-get opt-plist :skip-before-1st-heading)
24658 :drawers (plist-get opt-plist :drawers)
23536 :archived-trees 24659 :archived-trees
23537 (plist-get opt-plist :archived-trees) 24660 (plist-get opt-plist :archived-trees)
23538 :add-text 24661 :add-text
@@ -23569,7 +24692,7 @@ the body tags themselves."
23569 24692
23570 ;; Switch to the output buffer 24693 ;; Switch to the output buffer
23571 (set-buffer buffer) 24694 (set-buffer buffer)
23572 (erase-buffer) 24695 (let ((inhibit-read-only t)) (erase-buffer))
23573 (fundamental-mode) 24696 (fundamental-mode)
23574 24697
23575 (and (fboundp 'set-buffer-file-coding-system) 24698 (and (fboundp 'set-buffer-file-coding-system)
@@ -23732,7 +24855,8 @@ lang=\"%s\" xml:lang=\"%s\">
23732 (replace-match "\\2\n")) 24855 (replace-match "\\2\n"))
23733 (insert line "\n") 24856 (insert line "\n")
23734 (while (and lines 24857 (while (and lines
23735 (get-text-property 0 'org-protected (car lines))) 24858 (or (= (length (car lines)) 0)
24859 (get-text-property 0 'org-protected (car lines))))
23736 (insert (pop lines) "\n")) 24860 (insert (pop lines) "\n"))
23737 (and par (insert "<p>\n"))) 24861 (and par (insert "<p>\n")))
23738 (throw 'nextline nil)) 24862 (throw 'nextline nil))
@@ -23768,7 +24892,8 @@ lang=\"%s\" xml:lang=\"%s\">
23768 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;" 24892 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
23769 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>") 24893 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
23770 ;; Also handle sub_superscripts and checkboxes 24894 ;; Also handle sub_superscripts and checkboxes
23771 (setq line (org-html-expand line)) 24895 (or (string-match org-table-hline-regexp line)
24896 (setq line (org-html-expand line)))
23772 24897
23773 ;; Format the links 24898 ;; Format the links
23774 (setq start 0) 24899 (setq start 0)
@@ -23868,14 +24993,17 @@ lang=\"%s\" xml:lang=\"%s\">
23868 24993
23869 ;; Does this contain a reference to a footnote? 24994 ;; Does this contain a reference to a footnote?
23870 (when org-export-with-footnotes 24995 (when org-export-with-footnotes
23871 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line) 24996 (setq start 0)
23872 (let ((n (match-string 2 line))) 24997 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
23873 (setq line 24998 (if (get-text-property (match-beginning 2) 'org-protected line)
23874 (replace-match 24999 (setq start (match-end 2))
23875 (format 25000 (let ((n (match-string 2 line)))
23876 "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" 25001 (setq line
23877 (match-string 1 line) n n n) 25002 (replace-match
23878 t t line))))) 25003 (format
25004 "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>"
25005 (match-string 1 line) n n n)
25006 t t line))))))
23879 25007
23880 (cond 25008 (cond
23881 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) 25009 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
@@ -24005,7 +25133,7 @@ lang=\"%s\" xml:lang=\"%s\">
24005 (pop local-list-num)) 25133 (pop local-list-num))
24006 (setq local-list-indent nil 25134 (setq local-list-indent nil
24007 in-local-list nil)) 25135 in-local-list nil))
24008 (org-html-level-start 0 nil umax 25136 (org-html-level-start 1 nil umax
24009 (and org-export-with-toc (<= level umax)) 25137 (and org-export-with-toc (<= level umax))
24010 head-count) 25138 head-count)
24011 25139
@@ -24016,8 +25144,13 @@ lang=\"%s\" xml:lang=\"%s\">
24016 (insert "<p class=\"author\"> " 25144 (insert "<p class=\"author\"> "
24017 (nth 1 lang-words) ": " author "\n") 25145 (nth 1 lang-words) ": " author "\n")
24018 (when email 25146 (when email
24019 (insert "<a href=\"mailto:" email "\">&lt;" 25147 (if (listp (split-string email ",+ *"))
24020 email "&gt;</a>\n")) 25148 (mapc (lambda(e)
25149 (insert "<a href=\"mailto:" e "\">&lt;"
25150 e "&gt;</a>\n"))
25151 (split-string email ",+ *"))
25152 (insert "<a href=\"mailto:" email "\">&lt;"
25153 email "&gt;</a>\n")))
24021 (insert "</p>\n")) 25154 (insert "</p>\n"))
24022 (when (and date org-export-time-stamp-file) 25155 (when (and date org-export-time-stamp-file)
24023 (insert "<p class=\"date\"> " 25156 (insert "<p class=\"date\"> "
@@ -24201,11 +25334,11 @@ lang=\"%s\" xml:lang=\"%s\">
24201 (unless splice (push "</table>\n" html)) 25334 (unless splice (push "</table>\n" html))
24202 (setq html (nreverse html)) 25335 (setq html (nreverse html))
24203 (unless splice 25336 (unless splice
24204 ;; Put in COL tags with the alignment (unfortuntely often ignored...) 25337 ;; Put in col tags with the alignment (unfortuntely often ignored...)
24205 (push (mapconcat 25338 (push (mapconcat
24206 (lambda (x) 25339 (lambda (x)
24207 (setq gr (pop org-table-colgroup-info)) 25340 (setq gr (pop org-table-colgroup-info))
24208 (format "%s<COL align=\"%s\"></COL>%s" 25341 (format "%s<col align=\"%s\"></col>%s"
24209 (if (memq gr '(:start :startend)) 25342 (if (memq gr '(:start :startend))
24210 (prog1 25343 (prog1
24211 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") 25344 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
@@ -24219,7 +25352,7 @@ lang=\"%s\" xml:lang=\"%s\">
24219 fnum "") 25352 fnum "")
24220 html) 25353 html)
24221 (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) 25354 (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html)))))
24222 (push org-export-html-table-tag html)) 25355 (push html-table-tag html))
24223 (concat (mapconcat 'identity html "\n") "\n"))) 25356 (concat (mapconcat 'identity html "\n") "\n")))
24224 25357
24225(defun org-table-clean-before-export (lines) 25358(defun org-table-clean-before-export (lines)
@@ -24267,8 +25400,7 @@ If yes remove the column and the special lines."
24267 ((or (string-match "^\\([ \t]*\\)|-+\\+" x) 25400 ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
24268 (string-match "^\\([ \t]*\\)|[^|]*|" x)) 25401 (string-match "^\\([ \t]*\\)|[^|]*|" x))
24269 ;; remove the first column 25402 ;; remove the first column
24270 (replace-match "\\1|" t nil x)) 25403 (replace-match "\\1|" t nil x))))
24271 (t (error "This should not happen"))))
24272 lines)))) 25404 lines))))
24273 25405
24274(defun org-format-table-table-html (lines) 25406(defun org-format-table-table-html (lines)
@@ -24279,7 +25411,7 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
24279 (let (line field-buffer 25411 (let (line field-buffer
24280 (head org-export-highlight-first-table-line) 25412 (head org-export-highlight-first-table-line)
24281 fields html empty) 25413 fields html empty)
24282 (setq html (concat org-export-html-table-tag "\n")) 25414 (setq html (concat html-table-tag "\n"))
24283 (while (setq line (pop lines)) 25415 (while (setq line (pop lines))
24284 (setq empty "&nbsp;") 25416 (setq empty "&nbsp;")
24285 (catch 'next-line 25417 (catch 'next-line
@@ -24407,21 +25539,26 @@ If there are links in the string, don't modify these."
24407 "Apply all active conversions to translate special ASCII to HTML." 25539 "Apply all active conversions to translate special ASCII to HTML."
24408 (setq s (org-html-protect s)) 25540 (setq s (org-html-protect s))
24409 (if org-export-html-expand 25541 (if org-export-html-expand
24410 (while (string-match "@&lt;\\([^&]*\\)&gt;" s) 25542 (let ((start 0))
24411 (setq s (replace-match "<\\1>" t nil s)))) 25543 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
25544 (setq s (replace-match "<\\1>" t nil s)))))
24412 (if org-export-with-emphasize 25545 (if org-export-with-emphasize
24413 (setq s (org-export-html-convert-emphasize s))) 25546 (setq s (org-export-html-convert-emphasize s)))
25547 (if org-export-with-special-strings
25548 (setq s (org-export-html-convert-special-strings s)))
24414 (if org-export-with-sub-superscripts 25549 (if org-export-with-sub-superscripts
24415 (setq s (org-export-html-convert-sub-super s))) 25550 (setq s (org-export-html-convert-sub-super s)))
24416 (if org-export-with-TeX-macros 25551 (if org-export-with-TeX-macros
24417 (let ((start 0) wd ass) 25552 (let ((start 0) wd ass)
24418 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) 25553 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start))
24419 (setq wd (match-string 1 s)) 25554 (if (get-text-property (match-beginning 0) 'org-protected s)
24420 (if (setq ass (assoc wd org-html-entities)) 25555 (setq start (match-end 0))
24421 (setq s (replace-match (or (cdr ass) 25556 (setq wd (match-string 1 s))
24422 (concat "&" (car ass) ";")) 25557 (if (setq ass (assoc wd org-html-entities))
24423 t t s)) 25558 (setq s (replace-match (or (cdr ass)
24424 (setq start (+ start (length wd))))))) 25559 (concat "&" (car ass) ";"))
25560 t t s))
25561 (setq start (+ start (length wd))))))))
24425 s) 25562 s)
24426 25563
24427(defun org-create-multibrace-regexp (left right n) 25564(defun org-create-multibrace-regexp (left right n)
@@ -24452,16 +25589,41 @@ stacked delimiters is N. Escaping delimiters is not possible."
24452 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") 25589 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
24453 "The regular expression matching a sub- or superscript.") 25590 "The regular expression matching a sub- or superscript.")
24454 25591
24455;(let ((s "a\\_b")) 25592(defvar org-match-substring-with-braces-regexp
24456; (and (string-match org-match-substring-regexp s) 25593 (concat
24457; (conca t (match-string 1 s) ":::" (match-string 2 s)))) 25594 "\\([^\\]\\)\\([_^]\\)\\("
25595 "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
25596 "\\)")
25597 "The regular expression matching a sub- or superscript, forcing braces.")
25598
25599(defconst org-export-html-special-string-regexps
25600 '(("\\\\-" . "&shy;")
25601 ("---\\([^-]\\)" . "&mdash;\\1")
25602 ("--\\([^-]\\)" . "&ndash;\\1")
25603 ("\\.\\.\\." . "&hellip;"))
25604 "Regular expressions for special string conversion.")
25605
25606(defun org-export-html-convert-special-strings (string)
25607 "Convert special characters in STRING to HTML."
25608 (let ((all org-export-html-special-string-regexps)
25609 e a re rpl start)
25610 (while (setq a (pop all))
25611 (setq re (car a) rpl (cdr a) start 0)
25612 (while (string-match re string start)
25613 (if (get-text-property (match-beginning 0) 'org-protected string)
25614 (setq start (match-end 0))
25615 (setq string (replace-match rpl t nil string)))))
25616 string))
24458 25617
24459(defun org-export-html-convert-sub-super (string) 25618(defun org-export-html-convert-sub-super (string)
24460 "Convert sub- and superscripts in STRING to HTML." 25619 "Convert sub- and superscripts in STRING to HTML."
24461 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) 25620 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
24462 (while (string-match org-match-substring-regexp string s) 25621 (while (string-match org-match-substring-regexp string s)
24463 (if (and requireb (match-end 8)) 25622 (cond
24464 (setq s (match-end 2)) 25623 ((and requireb (match-end 8)) (setq s (match-end 2)))
25624 ((get-text-property (match-beginning 2) 'org-protected string)
25625 (setq s (match-end 2)))
25626 (t
24465 (setq s (match-end 1) 25627 (setq s (match-end 1)
24466 key (if (string= (match-string 2 string) "_") "sub" "sup") 25628 key (if (string= (match-string 2 string) "_") "sub" "sup")
24467 c (or (match-string 8 string) 25629 c (or (match-string 8 string)
@@ -24470,22 +25632,29 @@ stacked delimiters is N. Escaping delimiters is not possible."
24470 string (replace-match 25632 string (replace-match
24471 (concat (match-string 1 string) 25633 (concat (match-string 1 string)
24472 "<" key ">" c "</" key ">") 25634 "<" key ">" c "</" key ">")
24473 t t string)))) 25635 t t string)))))
24474 (while (string-match "\\\\\\([_^]\\)" string) 25636 (while (string-match "\\\\\\([_^]\\)" string)
24475 (setq string (replace-match (match-string 1 string) t t string))) 25637 (setq string (replace-match (match-string 1 string) t t string)))
24476 string)) 25638 string))
24477 25639
24478(defun org-export-html-convert-emphasize (string) 25640(defun org-export-html-convert-emphasize (string)
24479 "Apply emphasis." 25641 "Apply emphasis."
24480 (let ((s 0)) 25642 (let ((s 0) rpl)
24481 (while (string-match org-emph-re string s) 25643 (while (string-match org-emph-re string s)
24482 (if (not (equal 25644 (if (not (equal
24483 (substring string (match-beginning 3) (1+ (match-beginning 3))) 25645 (substring string (match-beginning 3) (1+ (match-beginning 3)))
24484 (substring string (match-beginning 4) (1+ (match-beginning 4))))) 25646 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
24485 (setq string (replace-match 25647 (setq s (match-beginning 0)
24486 (concat "\\1" (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) 25648 rpl
24487 "\\4" (nth 3 (assoc (match-string 3 string) org-emphasis-alist)) 25649 (concat
24488 "\\5") t nil string)) 25650 (match-string 1 string)
25651 (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
25652 (match-string 4 string)
25653 (nth 3 (assoc (match-string 3 string)
25654 org-emphasis-alist))
25655 (match-string 5 string))
25656 string (replace-match rpl t t string)
25657 s (+ s (- (length rpl) 2)))
24489 (setq s (1+ s)))) 25658 (setq s (1+ s))))
24490 string)) 25659 string))
24491 25660
@@ -24511,7 +25680,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
24511When TITLE is nil, just close all open levels." 25680When TITLE is nil, just close all open levels."
24512 (org-close-par-maybe) 25681 (org-close-par-maybe)
24513 (let ((l org-level-max)) 25682 (let ((l org-level-max))
24514 (while (>= l (1+ level)) 25683 (while (>= l level)
24515 (if (aref org-levels-open (1- l)) 25684 (if (aref org-levels-open (1- l))
24516 (progn 25685 (progn
24517 (org-html-level-close l umax) 25686 (org-html-level-close l umax)
@@ -24657,10 +25826,14 @@ When COMBINE is non nil, add the category to each line."
24657 ts (match-string 0) 25826 ts (match-string 0)
24658 inc t 25827 inc t
24659 hd (org-get-heading) 25828 hd (org-get-heading)
24660 summary (org-entry-get nil "SUMMARY") 25829 summary (org-icalendar-cleanup-string
24661 desc (or (org-entry-get nil "DESCRIPTION") 25830 (org-entry-get nil "SUMMARY"))
24662 (org-get-cleaned-entry org-icalendar-include-body)) 25831 desc (org-icalendar-cleanup-string
24663 location (org-entry-get nil "LOCATION") 25832 (or (org-entry-get nil "DESCRIPTION")
25833 (and org-icalendar-include-body (org-get-entry)))
25834 t org-icalendar-include-body)
25835 location (org-icalendar-cleanup-string
25836 (org-entry-get nil "LOCATION"))
24664 category (org-get-category)) 25837 category (org-get-category))
24665 (if (looking-at re2) 25838 (if (looking-at re2)
24666 (progn 25839 (progn
@@ -24748,10 +25921,14 @@ END:VEVENT\n"
24748 (not (member org-archive-tag (org-get-tags-at))) 25921 (not (member org-archive-tag (org-get-tags-at)))
24749 ) 25922 )
24750 (setq hd (match-string 3) 25923 (setq hd (match-string 3)
24751 summary (org-entry-get nil "SUMMARY") 25924 summary (org-icalendar-cleanup-string
24752 desc (or (org-entry-get nil "DESCRIPTION") 25925 (org-entry-get nil "SUMMARY"))
24753 (org-get-cleaned-entry org-icalendar-include-body)) 25926 desc (org-icalendar-cleanup-string
24754 location (org-entry-get nil "LOCATION")) 25927 (or (org-entry-get nil "DESCRIPTION")
25928 (and org-icalendar-include-body (org-get-entry)))
25929 t org-icalendar-include-body)
25930 location (org-icalendar-cleanup-string
25931 (org-entry-get nil "LOCATION")))
24755 (if (string-match org-bracket-link-regexp hd) 25932 (if (string-match org-bracket-link-regexp hd)
24756 (setq hd (replace-match (if (match-end 3) (match-string 3 hd) 25933 (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
24757 (match-string 1 hd)) 25934 (match-string 1 hd))
@@ -24780,24 +25957,38 @@ END:VTODO\n"
24780 (concat "\nDESCRIPTION: " desc) "") 25957 (concat "\nDESCRIPTION: " desc) "")
24781 category pri status))))))))) 25958 category pri status)))))))))
24782 25959
24783(defun org-get-cleaned-entry (what) 25960(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
24784 "Clean-up description string." 25961 "Take out stuff and quote what needs to be quoted.
24785 (when what 25962When IS-BODY is non-nil, assume that this is the body of an item, clean up
24786 (save-excursion 25963whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
24787 (org-back-to-heading t) 25964characters."
24788 (let ((s (buffer-substring (point-at-bol 2) (org-end-of-subtree t))) 25965 (if (not s)
24789 (re (concat org-drawer-regexp "[^\000]*?:END:.*\n?")) 25966 nil
25967 (when is-body
25968 (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
24790 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) 25969 (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
24791 (while (string-match re s) (setq s (replace-match "" t t s))) 25970 (while (string-match re s) (setq s (replace-match "" t t s)))
24792 (while (string-match re2 s) (setq s (replace-match "" t t s))) 25971 (while (string-match re2 s) (setq s (replace-match "" t t s)))))
24793 (if (string-match "[ \t\r\n]+\\'" s) (setq s (replace-match "" t t s))) 25972 (let ((start 0))
24794 (while (string-match "[ \t]*\n[ \t]*" s) 25973 (while (string-match "\\([,;\\]\\)" s start)
24795 (setq s (replace-match "\\n" t t s))) 25974 (setq start (+ (match-beginning 0) 2)
24796 (setq s (org-trim s)) 25975 s (replace-match "\\\\\\1" nil nil s))))
24797 (if (and (numberp what) 25976 (when is-body
24798 (> (length s) what)) 25977 (while (string-match "[ \t]*\n[ \t]*" s)
24799 (substring s 0 what) 25978 (setq s (replace-match "\\n" t t s))))
24800 s))))) 25979 (setq s (org-trim s))
25980 (if is-body
25981 (if maxlength
25982 (if (and (numberp maxlength)
25983 (> (length s) maxlength))
25984 (setq s (substring s 0 maxlength)))))
25985 s))
25986
25987(defun org-get-entry ()
25988 "Clean-up description string."
25989 (save-excursion
25990 (org-back-to-heading t)
25991 (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
24801 25992
24802(defun org-start-icalendar-file (name) 25993(defun org-start-icalendar-file (name)
24803 "Start an iCalendar file by inserting the header." 25994 "Start an iCalendar file by inserting the header."
@@ -24853,8 +26044,8 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
24853 26044
24854 ;; Output everything as XOXO 26045 ;; Output everything as XOXO
24855 (with-current-buffer (get-buffer buffer) 26046 (with-current-buffer (get-buffer buffer)
24856 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. 26047 (let* ((pos (point))
24857 (let* ((opt-plist (org-combine-plists (org-default-export-plist) 26048 (opt-plist (org-combine-plists (org-default-export-plist)
24858 (org-infile-export-plist))) 26049 (org-infile-export-plist)))
24859 (filename (concat (file-name-as-directory 26050 (filename (concat (file-name-as-directory
24860 (org-export-directory :xoxo opt-plist)) 26051 (org-export-directory :xoxo opt-plist))
@@ -24864,6 +26055,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
24864 (out (find-file-noselect filename)) 26055 (out (find-file-noselect filename))
24865 (last-level 1) 26056 (last-level 1)
24866 (hanging-li nil)) 26057 (hanging-li nil))
26058 (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
24867 ;; Check the output buffer is empty. 26059 ;; Check the output buffer is empty.
24868 (with-current-buffer out (erase-buffer)) 26060 (with-current-buffer out (erase-buffer))
24869 ;; Kick off the output 26061 ;; Kick off the output
@@ -24916,6 +26108,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
24916 (org-export-as-xoxo-insert-into out "</li>\n")) 26108 (org-export-as-xoxo-insert-into out "</li>\n"))
24917 (org-export-as-xoxo-insert-into out "</ol>\n")) 26109 (org-export-as-xoxo-insert-into out "</ol>\n"))
24918 26110
26111 (goto-char pos)
24919 ;; Finish the buffer off and clean it up. 26112 ;; Finish the buffer off and clean it up.
24920 (switch-to-buffer-other-window out) 26113 (switch-to-buffer-other-window out)
24921 (indent-region (point-min) (point-max) nil) 26114 (indent-region (point-min) (point-max) nil)
@@ -25009,7 +26202,7 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
25009(org-defkey org-mode-map "\C-c\C-d" 'org-deadline) 26202(org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
25010(org-defkey org-mode-map "\C-c;" 'org-toggle-comment) 26203(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
25011(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) 26204(org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree)
25012(org-defkey org-mode-map "\C-c\C-w" 'org-check-deadlines) 26205(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
25013(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved 26206(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
25014(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. 26207(org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res.
25015(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) 26208(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
@@ -25032,12 +26225,15 @@ The XOXO buffer is named *xoxo-<source buffer name>*"
25032(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) 26225(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files)
25033(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) 26226(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
25034(org-defkey org-mode-map "\C-c]" 'org-remove-file) 26227(org-defkey org-mode-map "\C-c]" 'org-remove-file)
26228(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock)
26229(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
25035(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) 26230(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
25036(org-defkey org-mode-map "\C-c^" 'org-sort) 26231(org-defkey org-mode-map "\C-c^" 'org-sort)
25037(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) 26232(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
25038(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) 26233(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
25039(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) 26234(org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count)
25040(org-defkey org-mode-map "\C-m" 'org-return) 26235(org-defkey org-mode-map "\C-m" 'org-return)
26236(org-defkey org-mode-map "\C-j" 'org-return-indent)
25041(org-defkey org-mode-map "\C-c?" 'org-table-field-info) 26237(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
25042(org-defkey org-mode-map "\C-c " 'org-table-blank-field) 26238(org-defkey org-mode-map "\C-c " 'org-table-blank-field)
25043(org-defkey org-mode-map "\C-c+" 'org-table-sum) 26239(org-defkey org-mode-map "\C-c+" 'org-table-sum)
@@ -25175,12 +26371,9 @@ because, in this case the deletion might narrow the column."
25175(put 'org-delete-char 'flyspell-delayed t) 26371(put 'org-delete-char 'flyspell-delayed t)
25176(put 'org-delete-backward-char 'flyspell-delayed t) 26372(put 'org-delete-backward-char 'flyspell-delayed t)
25177 26373
25178(eval-after-load "pabbrev" 26374;; Make pabbrev-mode expand after org-mode commands
25179 '(progn 26375(put 'org-self-insert-command 'pabbrev-expand-after-command t)
25180 (add-to-list 'pabbrev-expand-after-command-list 26376(put 'orgybl-self-insert-command 'pabbrev-expand-after-command t)
25181 'orgtbl-self-insert-command t)
25182 (add-to-list 'pabbrev-expand-after-command-list
25183 'org-self-insert-command t)))
25184 26377
25185;; How to do this: Measure non-white length of current string 26378;; How to do this: Measure non-white length of current string
25186;; If equal to column width, we should realign. 26379;; If equal to column width, we should realign.
@@ -25442,7 +26635,9 @@ This command does many different things, depending on context:
25442 links in this buffer. 26635 links in this buffer.
25443 26636
25444- If the cursor is on a numbered item in a plain list, renumber the 26637- If the cursor is on a numbered item in a plain list, renumber the
25445 ordered list." 26638 ordered list.
26639
26640- If the cursor is on a checkbox, toggle it."
25446 (interactive "P") 26641 (interactive "P")
25447 (let ((org-enable-table-editor t)) 26642 (let ((org-enable-table-editor t))
25448 (cond 26643 (cond
@@ -25500,25 +26695,31 @@ Also updates the keyword regular expressions."
25500 (message "Org-mode restarted to refresh keyword and special line setup")) 26695 (message "Org-mode restarted to refresh keyword and special line setup"))
25501 26696
25502(defun org-kill-note-or-show-branches () 26697(defun org-kill-note-or-show-branches ()
25503 "If this is a Note buffer, abort storing the note. Else call `show-branches'." 26698 "If this is a Note buffer, abort storing the note. Else call `show-branches'."
25504 (interactive) 26699 (interactive)
25505 (if (not org-finish-function) 26700 (if (not org-finish-function)
25506 (call-interactively 'show-branches) 26701 (call-interactively 'show-branches)
25507 (let ((org-note-abort t)) 26702 (let ((org-note-abort t))
25508 (funcall org-finish-function)))) 26703 (funcall org-finish-function))))
25509 26704
25510(defun org-return () 26705(defun org-return (&optional indent)
25511 "Goto next table row or insert a newline. 26706 "Goto next table row or insert a newline.
25512Calls `org-table-next-row' or `newline', depending on context. 26707Calls `org-table-next-row' or `newline', depending on context.
25513See the individual commands for more information." 26708See the individual commands for more information."
25514 (interactive) 26709 (interactive)
25515 (cond 26710 (cond
25516 ((bobp) (newline)) 26711 ((bobp) (if indent (newline-and-indent) (newline)))
25517 ((org-at-table-p) 26712 ((org-at-table-p)
25518 (org-table-justify-field-maybe) 26713 (org-table-justify-field-maybe)
25519 (call-interactively 'org-table-next-row)) 26714 (call-interactively 'org-table-next-row))
25520 (t (newline)))) 26715 (t (if indent (newline-and-indent) (newline)))))
25521 26716
26717(defun org-return-indent ()
26718 (interactive)
26719 "Goto next table row or insert a newline and indent.
26720Calls `org-table-next-row' or `newline-and-indent', depending on
26721context. See the individual commands for more information."
26722 (org-return t))
25522 26723
25523(defun org-ctrl-c-minus () 26724(defun org-ctrl-c-minus ()
25524 "Insert separator line in table or modify bullet type in list. 26725 "Insert separator line in table or modify bullet type in list.
@@ -25723,6 +26924,7 @@ See the individual commands for more information."
25723 :style toggle :selected org-log-done]) 26924 :style toggle :selected org-log-done])
25724 "--" 26925 "--"
25725 ["Agenda Command..." org-agenda t] 26926 ["Agenda Command..." org-agenda t]
26927 ["Set Restriction Lock" org-agenda-set-restriction-lock t]
25726 ("File List for Agenda") 26928 ("File List for Agenda")
25727 ("Special views current file" 26929 ("Special views current file"
25728 ["TODO Tree" org-show-todo-tree t] 26930 ["TODO Tree" org-show-todo-tree t]
@@ -25981,6 +27183,18 @@ really on, so that the block visually is on the match."
25981 (setq list (delete (pop elts) list))) 27183 (setq list (delete (pop elts) list)))
25982 list) 27184 list)
25983 27185
27186(defun org-back-over-empty-lines ()
27187 "Move backwards over witespace, to the beginning of the first empty line.
27188Returns the number o empty lines passed."
27189 (let ((pos (point)))
27190 (skip-chars-backward " \t\n\r")
27191 (beginning-of-line 2)
27192 (goto-char (min (point) pos))
27193 (count-lines (point) pos)))
27194
27195(defun org-skip-whitespace ()
27196 (skip-chars-forward " \t\n\r"))
27197
25984(defun org-point-in-group (point group &optional context) 27198(defun org-point-in-group (point group &optional context)
25985 "Check if POINT is in match-group GROUP. 27199 "Check if POINT is in match-group GROUP.
25986If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the 27200If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
@@ -26129,10 +27343,13 @@ not an indirect buffer"
26129 (setq column tcol) 27343 (setq column tcol)
26130 (goto-char pos) 27344 (goto-char pos)
26131 (beginning-of-line 1) 27345 (beginning-of-line 1)
26132 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") 27346 (if (looking-at "\\S-")
26133 (setq bullet (match-string 1) 27347 (progn
26134 btype (if (string-match "[0-9]" bullet) "n" bullet)) 27348 (looking-at "[ \t]*\\(\\S-+\\)[ \t]*")
26135 (setq column (if (equal btype bullet-type) bcol tcol)))) 27349 (setq bullet (match-string 1)
27350 btype (if (string-match "[0-9]" bullet) "n" bullet))
27351 (setq column (if (equal btype bullet-type) bcol tcol)))
27352 (setq column (org-get-indentation)))))
26136 (t (setq column (org-get-indentation)))))) 27353 (t (setq column (org-get-indentation))))))
26137 (goto-char pos) 27354 (goto-char pos)
26138 (if (<= (current-column) (current-indentation)) 27355 (if (<= (current-column) (current-indentation))
@@ -26141,7 +27358,7 @@ not an indirect buffer"
26141 (setq column (current-column)) 27358 (setq column (current-column))
26142 (beginning-of-line 1) 27359 (beginning-of-line 1)
26143 (if (looking-at 27360 (if (looking-at
26144 "\\([ \t]+\\)\\(:[0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") 27361 "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
26145 (replace-match (concat "\\1" (format org-property-format 27362 (replace-match (concat "\\1" (format org-property-format
26146 (match-string 2) (match-string 3))) 27363 (match-string 2) (match-string 3)))
26147 t nil)) 27364 t nil))
@@ -26183,10 +27400,13 @@ not an indirect buffer"
26183 "Re-align a table, pass through to fill-paragraph if no table." 27400 "Re-align a table, pass through to fill-paragraph if no table."
26184 (let ((table-p (org-at-table-p)) 27401 (let ((table-p (org-at-table-p))
26185 (table.el-p (org-at-table.el-p))) 27402 (table.el-p (org-at-table.el-p)))
26186 (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines 27403 (cond ((and (equal (char-after (point-at-bol)) ?*)
26187 (table.el-p t) ; skip table.el tables 27404 (save-excursion (goto-char (point-at-bol))
26188 (table-p (org-table-align) t) ; align org-mode tables 27405 (looking-at outline-regexp)))
26189 (t nil)))) ; call paragraph-fill 27406 t) ; skip headlines
27407 (table.el-p t) ; skip table.el tables
27408 (table-p (org-table-align) t) ; align org-mode tables
27409 (t nil)))) ; call paragraph-fill
26190 27410
26191;; For reference, this is the default value of adaptive-fill-regexp 27411;; For reference, this is the default value of adaptive-fill-regexp
26192;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" 27412;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
@@ -26318,6 +27538,20 @@ headline found, or nil if no higher level is found."
26318 (if (< level start-level) (throw 'exit level))) 27538 (if (< level start-level) (throw 'exit level)))
26319 nil))) 27539 nil)))
26320 27540
27541(defun org-first-sibling-p ()
27542 "Is this heading the first child of its parents?"
27543 (interactive)
27544 (let ((re (concat "^" outline-regexp))
27545 level l)
27546 (unless (org-at-heading-p t)
27547 (error "Not at a heading"))
27548 (setq level (funcall outline-level))
27549 (save-excursion
27550 (if (not (re-search-backward re nil t))
27551 t
27552 (setq l (funcall outline-level))
27553 (< l level)))))
27554
26321(defun org-goto-sibling (&optional previous) 27555(defun org-goto-sibling (&optional previous)
26322 "Goto the next sibling, even if it is invisible. 27556 "Goto the next sibling, even if it is invisible.
26323When PREVIOUS is set, go to the previous sibling instead. Returns t 27557When PREVIOUS is set, go to the previous sibling instead. Returns t
@@ -26446,7 +27680,104 @@ Show the heading too, if it is currently invisible."
26446 (org-show-context 'isearch)) 27680 (org-show-context 'isearch))
26447 27681
26448 27682
26449;;;; Address problems with some other packages 27683;;;; Integration with and fixes for other packages
27684
27685;;; Imenu support
27686
27687(defvar org-imenu-markers nil
27688 "All markers currently used by Imenu.")
27689(make-variable-buffer-local 'org-imenu-markers)
27690
27691(defun org-imenu-new-marker (&optional pos)
27692 "Return a new marker for use by Imenu, and remember the marker."
27693 (let ((m (make-marker)))
27694 (move-marker m (or pos (point)))
27695 (push m org-imenu-markers)
27696 m))
27697
27698(defun org-imenu-get-tree ()
27699 "Produce the index for Imenu."
27700 (mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
27701 (setq org-imenu-markers nil)
27702 (let* ((n org-imenu-depth)
27703 (re (concat "^" outline-regexp))
27704 (subs (make-vector (1+ n) nil))
27705 (last-level 0)
27706 m tree level head)
27707 (save-excursion
27708 (save-restriction
27709 (widen)
27710 (goto-char (point-max))
27711 (while (re-search-backward re nil t)
27712 (setq level (org-reduced-level (funcall outline-level)))
27713 (when (<= level n)
27714 (looking-at org-complex-heading-regexp)
27715 (setq head (org-match-string-no-properties 4)
27716 m (org-imenu-new-marker))
27717 (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
27718 (if (>= level last-level)
27719 (push (cons head m) (aref subs level))
27720 (push (cons head (aref subs (1+ level))) (aref subs level))
27721 (loop for i from (1+ level) to n do (aset subs i nil)))
27722 (setq last-level level)))))
27723 (aref subs 1)))
27724
27725(eval-after-load "imenu"
27726 '(progn
27727 (add-hook 'imenu-after-jump-hook
27728 (lambda () (org-show-context 'org-goto)))))
27729
27730;; Speedbar support
27731
27732(defun org-speedbar-set-agenda-restriction ()
27733 "Restrict future agenda commands to the location at point in speedbar.
27734To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
27735 (interactive)
27736 (let (p m tp np dir txt w)
27737 (cond
27738 ((setq p (text-property-any (point-at-bol) (point-at-eol)
27739 'org-imenu t))
27740 (setq m (get-text-property p 'org-imenu-marker))
27741 (save-excursion
27742 (save-restriction
27743 (set-buffer (marker-buffer m))
27744 (goto-char m)
27745 (org-agenda-set-restriction-lock 'subtree))))
27746 ((setq p (text-property-any (point-at-bol) (point-at-eol)
27747 'speedbar-function 'speedbar-find-file))
27748 (setq tp (previous-single-property-change
27749 (1+ p) 'speedbar-function)
27750 np (next-single-property-change
27751 tp 'speedbar-function)
27752 dir (speedbar-line-directory)
27753 txt (buffer-substring-no-properties (or tp (point-min))
27754 (or np (point-max))))
27755 (save-excursion
27756 (save-restriction
27757 (set-buffer (find-file-noselect
27758 (let ((default-directory dir))
27759 (expand-file-name txt))))
27760 (unless (org-mode-p)
27761 (error "Cannot restrict to non-Org-mode file"))
27762 (org-agenda-set-restriction-lock 'file))))
27763 (t (error "Don't know how to restrict Org-mode's agenda")))
27764 (org-move-overlay org-speedbar-restriction-lock-overlay
27765 (point-at-bol) (point-at-eol))
27766 (setq current-prefix-arg nil)
27767 (org-agenda-maybe-redo)))
27768
27769(eval-after-load "speedbar"
27770 '(progn
27771 (speedbar-add-supported-extension ".org")
27772 (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
27773 (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
27774 (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
27775 (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
27776 (add-hook 'speedbar-visiting-tag-hook
27777 (lambda () (org-show-context 'org-goto)))))
27778
27779
27780;;; Fixes and Hacks
26450 27781
26451;; Make flyspell not check words in links, to not mess up our keymap 27782;; Make flyspell not check words in links, to not mess up our keymap
26452(defun org-mode-flyspell-verify () 27783(defun org-mode-flyspell-verify ()
@@ -26471,6 +27802,13 @@ Show the heading too, if it is currently invisible."
26471 (org-invisible-p))) 27802 (org-invisible-p)))
26472 (org-show-context 'bookmark-jump))) 27803 (org-show-context 'bookmark-jump)))
26473 27804
27805;; Fix a bug in htmlize where there are text properties (face nil)
27806(eval-after-load "htmlize"
27807 '(progn
27808 (defadvice htmlize-faces-in-buffer (after org-no-nil-faces activate)
27809 "Make sure there are no nil faces"
27810 (setq ad-return-value (delq nil ad-return-value)))))
27811
26474;; Make session.el ignore our circular variable 27812;; Make session.el ignore our circular variable
26475(eval-after-load "session" 27813(eval-after-load "session"
26476 '(add-to-list 'session-globals-exclude 'org-mark-ring)) 27814 '(add-to-list 'session-globals-exclude 'org-mark-ring))
@@ -26479,7 +27817,7 @@ Show the heading too, if it is currently invisible."
26479 27817
26480(defun org-closed-in-range () 27818(defun org-closed-in-range ()
26481 "Sparse tree of items closed in a certain time range. 27819 "Sparse tree of items closed in a certain time range.
26482Still experimental, may disappear in the furture." 27820Still experimental, may disappear in the future."
26483 (interactive) 27821 (interactive)
26484 ;; Get the time interval from the user. 27822 ;; Get the time interval from the user.
26485 (let* ((time1 (time-to-seconds 27823 (let* ((time1 (time-to-seconds
@@ -26498,64 +27836,6 @@ Still experimental, may disappear in the furture."
26498 ;; make tree, check each match with the callback 27836 ;; make tree, check each match with the callback
26499 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) 27837 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
26500 27838
26501(defun org-fill-paragraph-experimental (&optional justify)
26502 "Re-align a table, pass through to fill-paragraph if no table."
26503 (let ((table-p (org-at-table-p))
26504 (table.el-p (org-at-table.el-p)))
26505 (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines
26506 (table.el-p t) ; skip table.el tables
26507 (table-p (org-table-align) t) ; align org-mode tables
26508 ((save-excursion
26509 (let ((pos (1+ (point-at-eol))))
26510 (backward-paragraph 1)
26511 (re-search-forward "\\\\\\\\[ \t]*$" pos t)))
26512 (save-excursion
26513 (save-restriction
26514 (narrow-to-region (1+ (match-end 0)) (point-max))
26515 (fill-paragraph nil)
26516 t)))
26517 (t nil)))) ; call paragraph-fill
26518
26519;; FIXME: this needs a much better algorithm
26520(defun org-assign-fast-keys (alist)
26521 "Assign fast keys to a keyword-key alist.
26522Respect keys that are already there."
26523 (let (new e k c c1 c2 (char ?a))
26524 (while (setq e (pop alist))
26525 (cond
26526 ((equal e '(:startgroup)) (push e new))
26527 ((equal e '(:endgroup)) (push e new))
26528 (t
26529 (setq k (car e) c2 nil)
26530 (if (cdr e)
26531 (setq c (cdr e))
26532 ;; automatically assign a character.
26533 (setq c1 (string-to-char
26534 (downcase (substring
26535 k (if (= (string-to-char k) ?@) 1 0)))))
26536 (if (or (rassoc c1 new) (rassoc c1 alist))
26537 (while (or (rassoc char new) (rassoc char alist))
26538 (setq char (1+ char)))
26539 (setq c2 c1))
26540 (setq c (or c2 char)))
26541 (push (cons k c) new))))
26542 (nreverse new)))
26543
26544;(defcustom org-read-date-prefer-future nil
26545; "Non-nil means, when reading an incomplete date from the user, assume future.
26546;This affects the following situations:
26547;1. The user give a day, but no month.
26548; In this case, if the day number if after today, the current month will
26549; be used, otherwise the next month.
26550;2. The user gives a month but not a year.
26551; In this case, the the given month is after the current month, the current
26552; year will be used. Otherwise the next year will be used.;
26553;
26554;When nil, always the current month and year will be used."
26555; :group 'org-time ;????
26556; :type 'boolean)
26557
26558
26559;;;; Finish up 27839;;;; Finish up
26560 27840
26561(provide 'org) 27841(provide 'org)
@@ -26565,4 +27845,3 @@ Respect keys that are already there."
26565;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 27845;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
26566;;; org.el ends here 27846;;; org.el ends here
26567 27847
26568
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 2d489eb5896..15fba461fd3 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1243,8 +1243,9 @@ If the buffer is non-empty, delete the old header first."
1243 (beginning-of-line 2)) 1243 (beginning-of-line 2))
1244 (while (looking-at "^[ \t]*$") 1244 (while (looking-at "^[ \t]*$")
1245 (beginning-of-line 2)) 1245 (beginning-of-line 2))
1246 (cond ((fboundp 'zmacs-activate-region) (zmacs-activate-region)) 1246 (if (featurep 'xemacs)
1247 ((boundp 'make-active) (setq mark-active t))) 1247 (zmacs-activate-region)
1248 (setq mark-active t))
1248 (if (yes-or-no-p "Delete and rebuild header? ") 1249 (if (yes-or-no-p "Delete and rebuild header? ")
1249 (delete-region (point-min) (point)))) 1250 (delete-region (point-min) (point))))
1250 1251
@@ -1495,8 +1496,9 @@ index the new part without having to go over the unchanged parts again."
1495 (unwind-protect 1496 (unwind-protect
1496 (progn 1497 (progn
1497 ;; Hide the region highlighting 1498 ;; Hide the region highlighting
1498 (cond ((fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region)) 1499 (if (featurep 'xemacs)
1499 ((fboundp 'deactivate-mark) (deactivate-mark))) 1500 (zmacs-deactivate-region)
1501 (deactivate-mark))
1500 (delete-other-windows) 1502 (delete-other-windows)
1501 (reftex-index-visit-phrases-buffer) 1503 (reftex-index-visit-phrases-buffer)
1502 (reftex-index-all-phrases)) 1504 (reftex-index-all-phrases))
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 0e501fdf23e..e57e9a59a73 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -326,7 +326,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
326(defun reftex-toc-next (&optional arg) 326(defun reftex-toc-next (&optional arg)
327 "Move to next selectable item." 327 "Move to next selectable item."
328 (interactive "p") 328 (interactive "p")
329 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 329 (when (featurep 'xemacs) (setq zmacs-region-stays t))
330 (setq reftex-callback-fwd t) 330 (setq reftex-callback-fwd t)
331 (or (eobp) (forward-char 1)) 331 (or (eobp) (forward-char 1))
332 (goto-char (or (next-single-property-change (point) :data) 332 (goto-char (or (next-single-property-change (point) :data)
@@ -334,21 +334,21 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
334(defun reftex-toc-previous (&optional arg) 334(defun reftex-toc-previous (&optional arg)
335 "Move to previous selectable item." 335 "Move to previous selectable item."
336 (interactive "p") 336 (interactive "p")
337 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 337 (when (featurep 'xemacs) (setq zmacs-region-stays t))
338 (setq reftex-callback-fwd nil) 338 (setq reftex-callback-fwd nil)
339 (goto-char (or (previous-single-property-change (point) :data) 339 (goto-char (or (previous-single-property-change (point) :data)
340 (point)))) 340 (point))))
341(defun reftex-toc-next-heading (&optional arg) 341(defun reftex-toc-next-heading (&optional arg)
342 "Move to next table of contentes line." 342 "Move to next table of contentes line."
343 (interactive "p") 343 (interactive "p")
344 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 344 (when (featurep 'xemacs) (setq zmacs-region-stays t))
345 (end-of-line) 345 (end-of-line)
346 (re-search-forward "^ " nil t arg) 346 (re-search-forward "^ " nil t arg)
347 (beginning-of-line)) 347 (beginning-of-line))
348(defun reftex-toc-previous-heading (&optional arg) 348(defun reftex-toc-previous-heading (&optional arg)
349 "Move to previous table of contentes line." 349 "Move to previous table of contentes line."
350 (interactive "p") 350 (interactive "p")
351 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 351 (when (featurep 'xemacs) (setq zmacs-region-stays t))
352 (re-search-backward "^ " nil t arg)) 352 (re-search-backward "^ " nil t arg))
353(defun reftex-toc-toggle-follow () 353(defun reftex-toc-toggle-follow ()
354 "Toggle follow (other window follows with context)." 354 "Toggle follow (other window follows with context)."
@@ -637,7 +637,7 @@ point."
637 (if mark-line 637 (if mark-line
638 (progn 638 (progn
639 (set-mark mpos) 639 (set-mark mpos)
640 (if (fboundp 'zmacs-activate-region) 640 (if (featurep 'xemacs)
641 (zmacs-activate-region) 641 (zmacs-activate-region)
642 (setq mark-active t 642 (setq mark-active t
643 deactivate-mark nil))))) 643 deactivate-mark nil)))))
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 0790bee55ae..58027f2b478 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -1,7 +1,7 @@
1;;; remember --- a mode for quickly jotting down things to remember 1;;; remember --- a mode for quickly jotting down things to remember
2 2
3;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 3;; Copyright (C) 1999, 2000, 2001, 2003, 2004, 2005, 2006, 2007,
4;; 2007 Free Software Foundation, Inc. 4;; 2008 Free Software Foundation, Inc.
5 5
6;; Author: John Wiegley <johnw@gnu.org> 6;; Author: John Wiegley <johnw@gnu.org>
7;; Created: 29 Mar 1999 7;; Created: 29 Mar 1999
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 40e0e85194b..7897fbaa9df 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -157,7 +157,7 @@ This takes effect when first loading the `sgml-mode' library.")
157 "Syntax table used in SGML mode. See also `sgml-specials'.") 157 "Syntax table used in SGML mode. See also `sgml-specials'.")
158 158
159(defconst sgml-tag-syntax-table 159(defconst sgml-tag-syntax-table
160 (let ((table (sgml-make-syntax-table '(?- ?\" ?\')))) 160 (let ((table (sgml-make-syntax-table sgml-specials)))
161 (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/)) 161 (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
162 (modify-syntax-entry char "." table)) 162 (modify-syntax-entry char "." table))
163 table) 163 table)
generated by cgit v1.2.1 (git 2.18.0) at 2026-03-17 15:28:23 +0000