Commit | Line | Data |
---|---|---|
a3fbe8c4 | 1 | ;;; org.el --- Outline-based notes management and organizer |
791d856f | 2 | ;; Carstens outline-mode for keeping track of everything. |
d7a0267c | 3 | ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. |
ef943dba | 4 | ;; |
0b8568f5 | 5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> |
4da1a99d | 6 | ;; Keywords: outlines, hypermedia, calendar, wp |
0b8568f5 | 7 | ;; Homepage: http://orgmode.org |
8635fef0 | 8 | ;; Version: 5.13i |
ef943dba | 9 | ;; |
359ec616 | 10 | ;; This file is part of GNU Emacs. |
ef943dba | 11 | ;; |
359ec616 RS |
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
13 | ;; it under the terms of the GNU General Public License as published by | |
76b872c7 | 14 | ;; the Free Software Foundation; either version 3, or (at your option) |
891f4676 RS |
15 | ;; any later version. |
16 | ||
359ec616 RS |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
891f4676 RS |
21 | |
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
27e81652 TTN |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
891f4676 | 26 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
891f4676 RS |
27 | ;; |
28 | ;;; Commentary: | |
29 | ;; | |
30 | ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing | |
31 | ;; project planning with a fast and effective plain-text system. | |
32 | ;; | |
f85d958a CD |
33 | ;; Org-mode develops organizational tasks around NOTES files that contain |
34 | ;; information about projects as plain text. Org-mode is implemented on | |
35 | ;; top of outline-mode, which makes it possible to keep the content of | |
36 | ;; large files well structured. Visibility cycling and structure editing | |
37 | ;; help to work with the tree. Tables are easily created with a built-in | |
38 | ;; table editor. Org-mode supports ToDo items, deadlines, time stamps, | |
39 | ;; and scheduling. It dynamically compiles entries into an agenda that | |
40 | ;; utilizes and smoothly integrates much of the Emacs calendar and diary. | |
41 | ;; Plain text URL-like links connect to websites, emails, Usenet | |
42 | ;; messages, BBDB entries, and any files related to the projects. For | |
43 | ;; printing and sharing of notes, an Org-mode file can be exported as a | |
44 | ;; structured ASCII file, as HTML, or (todo and agenda items only) as an | |
45 | ;; iCalendar file. It can also serve as a publishing tool for a set of | |
46 | ;; linked webpages. | |
47 | ;; | |
3278a016 CD |
48 | ;; Installation and Activation |
49 | ;; --------------------------- | |
50 | ;; See the corresponding sections in the manual at | |
891f4676 | 51 | ;; |
0b8568f5 | 52 | ;; http://orgmode.org/org.html#Installation |
891f4676 RS |
53 | ;; |
54 | ;; Documentation | |
55 | ;; ------------- | |
eb2f9c59 CD |
56 | ;; The documentation of Org-mode can be found in the TeXInfo file. The |
57 | ;; distribution also contains a PDF version of it. At the homepage of | |
58 | ;; Org-mode, you can read the same text online as HTML. There is also an | |
7a368970 CD |
59 | ;; excellent reference card made by Philip Rooke. This card can be found |
60 | ;; in the etc/ directory of Emacs 22. | |
891f4676 | 61 | ;; |
d3f4dbe8 | 62 | ;; A list of recent changes can be found at |
d5098885 | 63 | ;; http://orgmode.org/Changes.html |
0fee8d6e | 64 | ;; |
891f4676 RS |
65 | ;;; Code: |
66 | ||
d3f4dbe8 CD |
67 | ;;;; Require other packages |
68 | ||
edd21304 | 69 | (eval-when-compile |
ab27a4a0 | 70 | (require 'cl) |
e31ececb | 71 | (require 'gnus-sum) |
ab27a4a0 | 72 | (require 'calendar)) |
0fee8d6e CD |
73 | ;; For XEmacs, noutline is not yet provided by outline.el, so arrange for |
74 | ;; the file noutline.el being loaded. | |
75 | (if (featurep 'xemacs) (condition-case nil (require 'noutline))) | |
76 | ;; We require noutline, which might be provided in outline.el | |
77 | (require 'outline) (require 'noutline) | |
78 | ;; Other stuff we need. | |
891f4676 RS |
79 | (require 'time-date) |
80 | (require 'easymenu) | |
81 | ||
d3f4dbe8 | 82 | ;;;; Customization variables |
891f4676 | 83 | |
d3f4dbe8 CD |
84 | ;;; Version |
85 | ||
8635fef0 | 86 | (defconst org-version "5.13i" |
891f4676 | 87 | "The version number of the file org.el.") |
32073b07 CD |
88 | (defun org-version () |
89 | (interactive) | |
891f4676 RS |
90 | (message "Org-mode version %s" org-version)) |
91 | ||
d3f4dbe8 | 92 | ;;; Compatibility constants |
bea5b1ba | 93 | (defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself |
ab27a4a0 CD |
94 | (defconst org-format-transports-properties-p |
95 | (let ((x "a")) | |
96 | (add-text-properties 0 1 '(test t) x) | |
97 | (get-text-property 0 'test (format "%s" x))) | |
98 | "Does format transport text properties?") | |
891f4676 | 99 | |
38f8646b CD |
100 | (defmacro org-unmodified (&rest body) |
101 | "Execute body without changing buffer-modified-p." | |
102 | `(set-buffer-modified-p | |
103 | (prog1 (buffer-modified-p) ,@body))) | |
104 | ||
5152b597 CD |
105 | (defmacro org-re (s) |
106 | "Replace posix classes in regular expression." | |
107 | (if (featurep 'xemacs) | |
108 | (let ((ss s)) | |
109 | (save-match-data | |
110 | (while (string-match "\\[:alnum:\\]" ss) | |
111 | (setq ss (replace-match "a-zA-Z0-9" t t ss))) | |
0b8568f5 JW |
112 | (while (string-match "\\[:alpha:\\]" ss) |
113 | (setq ss (replace-match "a-zA-Z" t t ss))) | |
5152b597 CD |
114 | ss)) |
115 | s)) | |
116 | ||
38f8646b CD |
117 | (defmacro org-preserve-lc (&rest body) |
118 | `(let ((_line (org-current-line)) | |
119 | (_col (current-column))) | |
120 | (unwind-protect | |
121 | (progn ,@body) | |
122 | (goto-line _line) | |
15841868 JW |
123 | (move-to-column _col)))) |
124 | ||
125 | (defmacro org-without-partial-completion (&rest body) | |
126 | `(let ((pc-mode (and (boundp 'partial-completion-mode) | |
127 | partial-completion-mode))) | |
128 | (unwind-protect | |
129 | (progn | |
130 | (if pc-mode (partial-completion-mode -1)) | |
131 | ,@body) | |
fbe6c10d | 132 | (if pc-mode (partial-completion-mode 1))))) |
38f8646b | 133 | |
d3f4dbe8 CD |
134 | ;;; The custom variables |
135 | ||
891f4676 | 136 | (defgroup org nil |
b0a10108 | 137 | "Outline-based notes management and organizer." |
891f4676 RS |
138 | :tag "Org" |
139 | :group 'outlines | |
140 | :group 'hypermedia | |
141 | :group 'calendar) | |
142 | ||
15841868 JW |
143 | ;; FIXME: Needs a separate group... |
144 | (defcustom org-completion-fallback-command 'hippie-expand | |
145 | "The expansion command called by \\[org-complete] in normal context. | |
146 | Normal means, no org-mode-specific context." | |
147 | :group 'org | |
148 | :type 'function) | |
149 | ||
891f4676 RS |
150 | (defgroup org-startup nil |
151 | "Options concerning startup of Org-mode." | |
152 | :tag "Org Startup" | |
153 | :group 'org) | |
154 | ||
155 | (defcustom org-startup-folded t | |
ef943dba CD |
156 | "Non-nil means, entering Org-mode will switch to OVERVIEW. |
157 | This can also be configured on a per-file basis by adding one of | |
158 | the following lines anywhere in the buffer: | |
159 | ||
160 | #+STARTUP: fold | |
161 | #+STARTUP: nofold | |
35fb9989 | 162 | #+STARTUP: content" |
891f4676 | 163 | :group 'org-startup |
35fb9989 | 164 | :type '(choice |
c8d16429 CD |
165 | (const :tag "nofold: show all" nil) |
166 | (const :tag "fold: overview" t) | |
167 | (const :tag "content: all headlines" content))) | |
891f4676 RS |
168 | |
169 | (defcustom org-startup-truncated t | |
170 | "Non-nil means, entering Org-mode will set `truncate-lines'. | |
171 | This is useful since some lines containing links can be very long and | |
172 | uninteresting. Also tables look terrible when wrapped." | |
173 | :group 'org-startup | |
174 | :type 'boolean) | |
175 | ||
ab27a4a0 CD |
176 | (defcustom org-startup-align-all-tables nil |
177 | "Non-nil means, align all tables when visiting a file. | |
178 | This is useful when the column width in tables is forced with <N> cookies | |
4146eb16 CD |
179 | in table fields. Such tables will look correct only after the first re-align. |
180 | This can also be configured on a per-file basis by adding one of | |
181 | the following lines anywhere in the buffer: | |
182 | #+STARTUP: align | |
183 | #+STARTUP: noalign" | |
ab27a4a0 CD |
184 | :group 'org-startup |
185 | :type 'boolean) | |
186 | ||
c52dbe8c | 187 | (defcustom org-insert-mode-line-in-empty-file nil |
891f4676 | 188 | "Non-nil means insert the first line setting Org-mode in empty files. |
35fb9989 | 189 | When the function `org-mode' is called interactively in an empty file, this |
891f4676 RS |
190 | normally means that the file name does not automatically trigger Org-mode. |
191 | To ensure that the file will always be in Org-mode in the future, a | |
35fb9989 CD |
192 | line enforcing Org-mode will be inserted into the buffer, if this option |
193 | has been set." | |
891f4676 RS |
194 | :group 'org-startup |
195 | :type 'boolean) | |
196 | ||
a3fbe8c4 CD |
197 | (defcustom org-replace-disputed-keys nil |
198 | "Non-nil means use alternative key bindings for some keys. | |
199 | Org-mode uses S-<cursor> keys for changing timestamps and priorities. | |
200 | These keys are also used by other packages like `CUA-mode' or `windmove.el'. | |
201 | If you want to use Org-mode together with one of these other modes, | |
202 | or more generally if you would like to move some Org-mode commands to | |
203 | other keys, set this variable and configure the keys with the variable | |
ab27a4a0 | 204 | `org-disputed-keys'. |
891f4676 | 205 | |
d3f4dbe8 CD |
206 | This option is only relevant at load-time of Org-mode, and must be set |
207 | *before* org.el is loaded. Changing it requires a restart of Emacs to | |
208 | become effective." | |
ab27a4a0 CD |
209 | :group 'org-startup |
210 | :type 'boolean) | |
891f4676 | 211 | |
a3fbe8c4 CD |
212 | (if (fboundp 'defvaralias) |
213 | (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)) | |
214 | ||
215 | (defcustom org-disputed-keys | |
216 | '(([(shift up)] . [(meta p)]) | |
217 | ([(shift down)] . [(meta n)]) | |
218 | ([(shift left)] . [(meta -)]) | |
219 | ([(shift right)] . [(meta +)]) | |
220 | ([(control shift right)] . [(meta shift +)]) | |
221 | ([(control shift left)] . [(meta shift -)])) | |
ab27a4a0 | 222 | "Keys for which Org-mode and other modes compete. |
a3fbe8c4 CD |
223 | This is an alist, cars are the default keys, second element specifies |
224 | the alternative to use when `org-replace-disputed-keys' is t. | |
225 | ||
226 | Keys can be specified in any syntax supported by `define-key'. | |
227 | The value of this option takes effect only at Org-mode's startup, | |
228 | therefore you'll have to restart Emacs to apply it after changing." | |
229 | :group 'org-startup | |
230 | :type 'alist) | |
ab27a4a0 CD |
231 | |
232 | (defun org-key (key) | |
a3fbe8c4 CD |
233 | "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. |
234 | Or return the original if not disputed." | |
235 | (if org-replace-disputed-keys | |
236 | (let* ((nkey (key-description key)) | |
237 | (x (org-find-if (lambda (x) | |
238 | (equal (key-description (car x)) nkey)) | |
239 | org-disputed-keys))) | |
240 | (if x (cdr x) key)) | |
241 | key)) | |
242 | ||
243 | (defun org-find-if (predicate seq) | |
244 | (catch 'exit | |
245 | (while seq | |
246 | (if (funcall predicate (car seq)) | |
247 | (throw 'exit (car seq)) | |
248 | (pop seq))))) | |
249 | ||
250 | (defun org-defkey (keymap key def) | |
251 | "Define a key, possibly translated, as returned by `org-key'." | |
252 | (define-key keymap (org-key key) def)) | |
ab27a4a0 | 253 | |
03f3cf35 | 254 | (defcustom org-ellipsis 'org-ellipsis |
ab27a4a0 CD |
255 | "The ellipsis to use in the Org-mode outline. |
256 | When nil, just use the standard three dots. When a string, use that instead, | |
374585c9 CD |
257 | When a face, use the standart 3 dots, but with the specified face. |
258 | The change affects only Org-mode (which will then use its own display table). | |
ab27a4a0 CD |
259 | Changing this requires executing `M-x org-mode' in a buffer to become |
260 | effective." | |
261 | :group 'org-startup | |
262 | :type '(choice (const :tag "Default" nil) | |
374585c9 | 263 | (face :tag "Face" :value org-warning) |
ab27a4a0 CD |
264 | (string :tag "String" :value "...#"))) |
265 | ||
266 | (defvar org-display-table nil | |
267 | "The display table for org-mode, in case `org-ellipsis' is non-nil.") | |
268 | ||
269 | (defgroup org-keywords nil | |
270 | "Keywords in Org-mode." | |
271 | :tag "Org Keywords" | |
272 | :group 'org) | |
891f4676 RS |
273 | |
274 | (defcustom org-deadline-string "DEADLINE:" | |
275 | "String to mark deadline entries. | |
276 | A deadline is this string, followed by a time stamp. Should be a word, | |
277 | terminated by a colon. You can insert a schedule keyword and | |
278 | a timestamp with \\[org-deadline]. | |
279 | Changes become only effective after restarting Emacs." | |
280 | :group 'org-keywords | |
281 | :type 'string) | |
282 | ||
283 | (defcustom org-scheduled-string "SCHEDULED:" | |
284 | "String to mark scheduled TODO entries. | |
285 | A schedule is this string, followed by a time stamp. Should be a word, | |
286 | terminated by a colon. You can insert a schedule keyword and | |
287 | a timestamp with \\[org-schedule]. | |
288 | Changes become only effective after restarting Emacs." | |
289 | :group 'org-keywords | |
290 | :type 'string) | |
291 | ||
7ac93e3c | 292 | (defcustom org-closed-string "CLOSED:" |
b0a10108 | 293 | "String used as the prefix for timestamps logging closing a TODO entry." |
7ac93e3c CD |
294 | :group 'org-keywords |
295 | :type 'string) | |
296 | ||
edd21304 CD |
297 | (defcustom org-clock-string "CLOCK:" |
298 | "String used as prefix for timestamps clocking work hours on an item." | |
299 | :group 'org-keywords | |
300 | :type 'string) | |
301 | ||
891f4676 RS |
302 | (defcustom org-comment-string "COMMENT" |
303 | "Entries starting with this keyword will never be exported. | |
304 | An entry can be toggled between COMMENT and normal with | |
305 | \\[org-toggle-comment]. | |
306 | Changes become only effective after restarting Emacs." | |
307 | :group 'org-keywords | |
308 | :type 'string) | |
309 | ||
b9661543 CD |
310 | (defcustom org-quote-string "QUOTE" |
311 | "Entries starting with this keyword will be exported in fixed-width font. | |
312 | Quoting applies only to the text in the entry following the headline, and does | |
313 | not extend beyond the next headline, even if that is lower level. | |
314 | An entry can be toggled between QUOTE and normal with | |
b0a10108 | 315 | \\[org-toggle-fixed-width-section]." |
b9661543 CD |
316 | :group 'org-keywords |
317 | :type 'string) | |
318 | ||
a3fbe8c4 CD |
319 | (defconst org-repeat-re |
320 | (concat "\\(?:\\<\\(?:" org-scheduled-string "\\|" org-deadline-string "\\)" | |
321 | " +<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*\\)\\(\\+[0-9]+[dwmy]\\)") | |
d3f4dbe8 CD |
322 | "Regular expression for specifying repeated events. |
323 | After a match, group 1 contains the repeat expression.") | |
324 | ||
ab27a4a0 CD |
325 | (defgroup org-structure nil |
326 | "Options concerning the general structure of Org-mode files." | |
327 | :tag "Org Structure" | |
328 | :group 'org) | |
634a7d0b | 329 | |
d3f4dbe8 CD |
330 | (defgroup org-reveal-location nil |
331 | "Options about how to make context of a location visible." | |
332 | :tag "Org Reveal Location" | |
333 | :group 'org-structure) | |
334 | ||
335 | (defcustom org-show-hierarchy-above '((default . t)) | |
336 | "Non-nil means, show full hierarchy when revealing a location. | |
337 | Org-mode often shows locations in an org-mode file which might have | |
338 | been invisible before. When this is set, the hierarchy of headings | |
339 | above the exposed location is shown. | |
340 | Turning this off for example for sparse trees makes them very compact. | |
341 | Instead of t, this can also be an alist specifying this option for different | |
342 | contexts. Valid contexts are | |
343 | agenda when exposing an entry from the agenda | |
344 | org-goto when using the command `org-goto' on key C-c C-j | |
345 | occur-tree when using the command `org-occur' on key C-c / | |
346 | tags-tree when constructing a sparse tree based on tags matches | |
347 | link-search when exposing search matches associated with a link | |
348 | mark-goto when exposing the jump goal of a mark | |
349 | bookmark-jump when exposing a bookmark location | |
350 | isearch when exiting from an incremental search | |
351 | default default for all contexts not set explicitly" | |
352 | :group 'org-reveal-location | |
353 | :type '(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 | ||
a3fbe8c4 | 370 | (defcustom org-show-following-heading '((default . nil)) |
d3f4dbe8 CD |
371 | "Non-nil means, show following heading when revealing a location. |
372 | Org-mode often shows locations in an org-mode file which might have | |
373 | been invisible before. When this is set, the heading following the | |
374 | match is shown. | |
375 | Turning this off for example for sparse trees makes them very compact, | |
376 | but makes it harder to edit the location of the match. In such a case, | |
377 | use the command \\[org-reveal] to show more context. | |
378 | Instead of t, this can also be an alist specifying this option for different | |
379 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
380 | :group 'org-reveal-location | |
381 | :type '(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 | ||
398 | (defcustom org-show-siblings '((default . nil) (isearch t)) | |
399 | "Non-nil means, show all sibling heading when revealing a location. | |
400 | Org-mode often shows locations in an org-mode file which might have | |
401 | been invisible before. When this is set, the sibling of the current entry | |
402 | heading are all made visible. If `org-show-hierarchy-above' is t, | |
403 | the same happens on each level of the hierarchy above the current entry. | |
404 | ||
405 | By default this is on for the isearch context, off for all other contexts. | |
406 | Turning this off for example for sparse trees makes them very compact, | |
407 | but makes it harder to edit the location of the match. In such a case, | |
408 | use the command \\[org-reveal] to show more context. | |
409 | Instead of t, this can also be an alist specifying this option for different | |
410 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
411 | :group 'org-reveal-location | |
412 | :type '(choice | |
413 | (const :tag "Always" t) | |
414 | (const :tag "Never" nil) | |
415 | (repeat :greedy t :tag "Individual contexts" | |
416 | (cons | |
417 | (choice :tag "Context" | |
418 | (const agenda) | |
419 | (const org-goto) | |
420 | (const occur-tree) | |
421 | (const tags-tree) | |
422 | (const link-search) | |
423 | (const mark-goto) | |
424 | (const bookmark-jump) | |
425 | (const isearch) | |
426 | (const default)) | |
427 | (boolean))))) | |
428 | ||
ab27a4a0 CD |
429 | (defgroup org-cycle nil |
430 | "Options concerning visibility cycling in Org-mode." | |
431 | :tag "Org Cycle" | |
432 | :group 'org-structure) | |
634a7d0b | 433 | |
15841868 | 434 | (defcustom org-drawers '("PROPERTIES" "CLOCK") |
5152b597 CD |
435 | "Names of drawers. Drawers are not opened by cycling on the headline above. |
436 | Drawers only open with a TAB on the drawer line itself. A drawer looks like | |
437 | this: | |
438 | :DRAWERNAME: | |
439 | ..... | |
38f8646b CD |
440 | :END: |
441 | The drawer \"PROPERTIES\" is special for capturing properties through | |
03f3cf35 JW |
442 | the property API. |
443 | ||
444 | Drawers can be defined on the per-file basis with a line like: | |
445 | ||
446 | #+DRAWERS: HIDDEN STATE PROPERTIES" | |
5152b597 CD |
447 | :group 'org-structure |
448 | :type '(repeat (string :tag "Drawer Name"))) | |
449 | ||
374585c9 | 450 | (defcustom org-cycle-global-at-bob nil |
4b3a9ba7 CD |
451 | "Cycle globally if cursor is at beginning of buffer and not at a headline. |
452 | This makes it possible to do global cycling without having to use S-TAB or | |
453 | C-u TAB. For this special case to work, the first line of the buffer | |
454 | must not be a headline - it may be empty ot some other text. When used in | |
455 | this way, `org-cycle-hook' is disables temporarily, to make sure the | |
456 | cursor stays at the beginning of the buffer. | |
457 | When this option is nil, don't do anything special at the beginning | |
458 | of the buffer." | |
459 | :group 'org-cycle | |
460 | :type 'boolean) | |
461 | ||
ab27a4a0 CD |
462 | (defcustom org-cycle-emulate-tab t |
463 | "Where should `org-cycle' emulate TAB. | |
7d143c25 CD |
464 | nil Never |
465 | white Only in completely white lines | |
466 | whitestart Only at the beginning of lines, before the first non-white char. | |
467 | t Everywhere except in headlines | |
a3fbe8c4 | 468 | exc-hl-bol Everywhere except at the start of a headline |
7d143c25 CD |
469 | If TAB is used in a place where it does not emulate TAB, the current subtree |
470 | visibility is cycled." | |
ab27a4a0 CD |
471 | :group 'org-cycle |
472 | :type '(choice (const :tag "Never" nil) | |
473 | (const :tag "Only in completely white lines" white) | |
7d143c25 | 474 | (const :tag "Before first char in a line" whitestart) |
ab27a4a0 | 475 | (const :tag "Everywhere except in headlines" t) |
a3fbe8c4 | 476 | (const :tag "Everywhere except at bol in headlines" exc-hl-bol) |
ab27a4a0 | 477 | )) |
094f65d4 | 478 | |
a3fbe8c4 CD |
479 | (defcustom org-cycle-separator-lines 2 |
480 | "Number of empty lines needed to keep an empty line between collapsed trees. | |
481 | If you leave an empty line between the end of a subtree and the following | |
482 | headline, this empty line is hidden when the subtree is folded. | |
483 | Org-mode will leave (exactly) one empty line visible if the number of | |
484 | empty lines is equal or larger to the number given in this variable. | |
485 | So the default 2 means, at least 2 empty lines after the end of a subtree | |
486 | are needed to produce free space between a collapsed subtree and the | |
487 | following headline. | |
488 | ||
489 | Special case: when 0, never leave empty lines in collapsed view." | |
490 | :group 'org-cycle | |
491 | :type 'integer) | |
492 | ||
6769c0dc | 493 | (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees |
5152b597 | 494 | org-cycle-hide-drawers |
a3fbe8c4 | 495 | org-cycle-show-empty-lines |
6769c0dc | 496 | org-optimize-window-after-visibility-change) |
ab27a4a0 CD |
497 | "Hook that is run after `org-cycle' has changed the buffer visibility. |
498 | The function(s) in this hook must accept a single argument which indicates | |
499 | the new state that was set by the most recent `org-cycle' command. The | |
500 | argument is a symbol. After a global state change, it can have the values | |
501 | `overview', `content', or `all'. After a local state change, it can have | |
502 | the values `folded', `children', or `subtree'." | |
503 | :group 'org-cycle | |
504 | :type 'hook) | |
094f65d4 | 505 | |
ab27a4a0 CD |
506 | (defgroup org-edit-structure nil |
507 | "Options concerning structure editing in Org-mode." | |
508 | :tag "Org Edit Structure" | |
509 | :group 'org-structure) | |
634a7d0b | 510 | |
1e8fbb6d | 511 | (defcustom org-special-ctrl-a/e nil |
48aaad2d | 512 | "Non-nil means `C-a' and `C-e' behave specially in headlines and items. |
374585c9 | 513 | When t, `C-a' will bring back the cursor to the beginning of the |
a3fbe8c4 | 514 | headline text, i.e. after the stars and after a possible TODO keyword. |
48aaad2d | 515 | In an item, this will be the position after the bullet. |
a3fbe8c4 | 516 | When the cursor is already at that position, another `C-a' will bring |
1e8fbb6d CD |
517 | it to the beginning of the line. |
518 | `C-e' will jump to the end of the headline, ignoring the presence of tags | |
519 | in the headline. A second `C-e' will then jump to the true end of the | |
374585c9 CD |
520 | line, after any tags. |
521 | When set to the symbol `reversed', the first `C-a' or `C-e' works normally, | |
522 | and only a directly following, identical keypress will bring the cursor | |
523 | to the special positions." | |
a3fbe8c4 | 524 | :group 'org-edit-structure |
374585c9 CD |
525 | :type '(choice |
526 | (const :tag "off" nil) | |
527 | (const :tag "after bullet first" t) | |
528 | (const :tag "border first" reversed))) | |
a3fbe8c4 | 529 | |
1e8fbb6d CD |
530 | (if (fboundp 'defvaralias) |
531 | (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) | |
532 | ||
ab27a4a0 CD |
533 | (defcustom org-odd-levels-only nil |
534 | "Non-nil means, skip even levels and only use odd levels for the outline. | |
535 | This has the effect that two stars are being added/taken away in | |
536 | promotion/demotion commands. It also influences how levels are | |
537 | handled by the exporters. | |
538 | Changing it requires restart of `font-lock-mode' to become effective | |
4146eb16 CD |
539 | for fontification also in regions already fontified. |
540 | You may also set this on a per-file basis by adding one of the following | |
541 | lines to the buffer: | |
542 | ||
543 | #+STARTUP: odd | |
544 | #+STARTUP: oddeven" | |
ab27a4a0 CD |
545 | :group 'org-edit-structure |
546 | :group 'org-font-lock | |
547 | :type 'boolean) | |
891f4676 | 548 | |
ab27a4a0 CD |
549 | (defcustom org-adapt-indentation t |
550 | "Non-nil means, adapt indentation when promoting and demoting. | |
551 | When this is set and the *entire* text in an entry is indented, the | |
552 | indentation is increased by one space in a demotion command, and | |
553 | decreased by one in a promotion command. If any line in the entry | |
554 | body starts at column 0, indentation is not changed at all." | |
555 | :group 'org-edit-structure | |
556 | :type 'boolean) | |
30313b90 | 557 | |
3278a016 CD |
558 | (defcustom org-blank-before-new-entry '((heading . nil) |
559 | (plain-list-item . nil)) | |
560 | "Should `org-insert-heading' leave a blank line before new heading/item? | |
561 | The value is an alist, with `heading' and `plain-list-item' as car, | |
562 | and a boolean flag as cdr." | |
563 | :group 'org-edit-structure | |
564 | :type '(list | |
565 | (cons (const heading) (boolean)) | |
566 | (cons (const plain-list-item) (boolean)))) | |
567 | ||
4b3a9ba7 CD |
568 | (defcustom org-insert-heading-hook nil |
569 | "Hook being run after inserting a new heading." | |
570 | :group 'org-edit-structure | |
571 | :type 'boolean) | |
572 | ||
ab27a4a0 CD |
573 | (defcustom org-enable-fixed-width-editor t |
574 | "Non-nil means, lines starting with \":\" are treated as fixed-width. | |
575 | This currently only means, they are never auto-wrapped. | |
576 | When nil, such lines will be treated like ordinary lines. | |
577 | See also the QUOTE keyword." | |
578 | :group 'org-edit-structure | |
579 | :type 'boolean) | |
30313b90 | 580 | |
ab27a4a0 CD |
581 | (defgroup org-sparse-trees nil |
582 | "Options concerning sparse trees in Org-mode." | |
583 | :tag "Org Sparse Trees" | |
584 | :group 'org-structure) | |
891f4676 | 585 | |
ab27a4a0 CD |
586 | (defcustom org-highlight-sparse-tree-matches t |
587 | "Non-nil means, highlight all matches that define a sparse tree. | |
588 | The highlights will automatically disappear the next time the buffer is | |
589 | changed by an edit command." | |
590 | :group 'org-sparse-trees | |
15f43010 | 591 | :type 'boolean) |
891f4676 | 592 | |
3278a016 CD |
593 | (defcustom org-remove-highlights-with-change t |
594 | "Non-nil means, any change to the buffer will remove temporary highlights. | |
595 | Such highlights are created by `org-occur' and `org-clock-display'. | |
596 | When nil, `C-c C-c needs to be used to get rid of the highlights. | |
597 | The highlights created by `org-preview-latex-fragment' always need | |
598 | `C-c C-c' to be removed." | |
ab27a4a0 | 599 | :group 'org-sparse-trees |
3278a016 | 600 | :group 'org-time |
891f4676 RS |
601 | :type 'boolean) |
602 | ||
7ac93e3c | 603 | |
ab27a4a0 CD |
604 | (defcustom org-occur-hook '(org-first-headline-recenter) |
605 | "Hook that is run after `org-occur' has constructed a sparse tree. | |
606 | This can be used to recenter the window to show as much of the structure | |
607 | as possible." | |
608 | :group 'org-sparse-trees | |
609 | :type 'hook) | |
d924f2e5 | 610 | |
ab27a4a0 CD |
611 | (defgroup org-plain-lists nil |
612 | "Options concerning plain lists in Org-mode." | |
613 | :tag "Org Plain lists" | |
614 | :group 'org-structure) | |
d924f2e5 | 615 | |
ab27a4a0 CD |
616 | (defcustom org-cycle-include-plain-lists nil |
617 | "Non-nil means, include plain lists into visibility cycling. | |
618 | This means that during cycling, plain list items will *temporarily* be | |
619 | interpreted as outline headlines with a level given by 1000+i where i is the | |
620 | indentation of the bullet. In all other operations, plain list items are | |
621 | not seen as headlines. For example, you cannot assign a TODO keyword to | |
622 | such an item." | |
623 | :group 'org-plain-lists | |
891f4676 RS |
624 | :type 'boolean) |
625 | ||
ab27a4a0 CD |
626 | (defcustom org-plain-list-ordered-item-terminator t |
627 | "The character that makes a line with leading number an ordered list item. | |
628 | Valid values are ?. and ?\). To get both terminators, use t. While | |
629 | ?. may look nicer, it creates the danger that a line with leading | |
630 | number may be incorrectly interpreted as an item. ?\) therefore is | |
631 | the safe choice." | |
632 | :group 'org-plain-lists | |
633 | :type '(choice (const :tag "dot like in \"2.\"" ?.) | |
634 | (const :tag "paren like in \"2)\"" ?\)) | |
635 | (const :tab "both" t))) | |
ef943dba | 636 | |
ab27a4a0 CD |
637 | (defcustom org-auto-renumber-ordered-lists t |
638 | "Non-nil means, automatically renumber ordered plain lists. | |
639 | Renumbering happens when the sequence have been changed with | |
640 | \\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, | |
641 | use \\[org-ctrl-c-ctrl-c] to trigger renumbering." | |
642 | :group 'org-plain-lists | |
891f4676 RS |
643 | :type 'boolean) |
644 | ||
3278a016 CD |
645 | (defcustom org-provide-checkbox-statistics t |
646 | "Non-nil means, update checkbox statistics after insert and toggle. | |
647 | When this is set, checkbox statistics is updated each time you either insert | |
648 | a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox | |
649 | with \\[org-ctrl-c-ctrl-c\\]." | |
d3f4dbe8 | 650 | :group 'org-plain-lists |
3278a016 CD |
651 | :type 'boolean) |
652 | ||
ab27a4a0 CD |
653 | (defgroup org-archive nil |
654 | "Options concerning archiving in Org-mode." | |
655 | :tag "Org Archive" | |
656 | :group 'org-structure) | |
891f4676 | 657 | |
6769c0dc CD |
658 | (defcustom org-archive-tag "ARCHIVE" |
659 | "The tag that marks a subtree as archived. | |
660 | An archived subtree does not open during visibility cycling, and does | |
661 | not contribute to the agenda listings." | |
662 | :group 'org-archive | |
663 | :group 'org-keywords | |
664 | :type 'string) | |
665 | ||
666 | (defcustom org-agenda-skip-archived-trees t | |
667 | "Non-nil means, the agenda will skip any items located in archived trees. | |
668 | An archived tree is a tree marked with the tag ARCHIVE." | |
669 | :group 'org-archive | |
d3f4dbe8 | 670 | :group 'org-agenda-skip |
6769c0dc CD |
671 | :type 'boolean) |
672 | ||
673 | (defcustom org-cycle-open-archived-trees nil | |
674 | "Non-nil means, `org-cycle' will open archived trees. | |
675 | An archived tree is a tree marked with the tag ARCHIVE. | |
676 | When nil, archived trees will stay folded. You can still open them with | |
677 | normal outline commands like `show-all', but not with the cycling commands." | |
678 | :group 'org-archive | |
679 | :group 'org-cycle | |
680 | :type 'boolean) | |
681 | ||
682 | (defcustom org-sparse-tree-open-archived-trees nil | |
683 | "Non-nil means sparse tree construction shows matches in archived trees. | |
684 | When nil, matches in these trees are highlighted, but the trees are kept in | |
685 | collapsed state." | |
686 | :group 'org-archive | |
687 | :group 'org-sparse-trees | |
688 | :type 'boolean) | |
689 | ||
ab27a4a0 CD |
690 | (defcustom org-archive-location "%s_archive::" |
691 | "The location where subtrees should be archived. | |
692 | This string consists of two parts, separated by a double-colon. | |
891f4676 | 693 | |
ab27a4a0 CD |
694 | The first part is a file name - when omitted, archiving happens in the same |
695 | file. %s will be replaced by the current file name (without directory part). | |
696 | Archiving to a different file is useful to keep archived entries from | |
697 | contributing to the Org-mode Agenda. | |
891f4676 | 698 | |
ab27a4a0 CD |
699 | The part after the double colon is a headline. The archived entries will be |
700 | filed under that headline. When omitted, the subtrees are simply filed away | |
701 | at the end of the file, as top-level entries. | |
891f4676 | 702 | |
ab27a4a0 CD |
703 | Here are a few examples: |
704 | \"%s_archive::\" | |
705 | If the current file is Projects.org, archive in file | |
706 | Projects.org_archive, as top-level trees. This is the default. | |
891f4676 | 707 | |
ab27a4a0 CD |
708 | \"::* Archived Tasks\" |
709 | Archive in the current file, under the top-level headline | |
710 | \"* Archived Tasks\". | |
891f4676 | 711 | |
ab27a4a0 CD |
712 | \"~/org/archive.org::\" |
713 | Archive in file ~/org/archive.org (absolute path), as top-level trees. | |
891f4676 | 714 | |
ab27a4a0 CD |
715 | \"basement::** Finished Tasks\" |
716 | Archive in file ./basement (relative path), as level 3 trees | |
717 | below the level 2 heading \"** Finished Tasks\". | |
891f4676 | 718 | |
ab27a4a0 CD |
719 | You may set this option on a per-file basis by adding to the buffer a |
720 | line like | |
634a7d0b | 721 | |
ab27a4a0 CD |
722 | #+ARCHIVE: basement::** Finished Tasks" |
723 | :group 'org-archive | |
724 | :type 'string) | |
634a7d0b | 725 | |
ab27a4a0 | 726 | (defcustom org-archive-mark-done t |
48aaad2d CD |
727 | "Non-nil means, mark entries as DONE when they are moved to the archive file. |
728 | This can be a string to set the keyword to use. When t, Org-mode will | |
729 | use the first keyword in its list that means done." | |
ab27a4a0 | 730 | :group 'org-archive |
48aaad2d CD |
731 | :type '(choice |
732 | (const :tag "No" nil) | |
733 | (const :tag "Yes" t) | |
734 | (string :tag "Use this keyword"))) | |
eb2f9c59 | 735 | |
ab27a4a0 | 736 | (defcustom org-archive-stamp-time t |
15841868 JW |
737 | "Non-nil means, add a time stamp to entries moved to an archive file. |
738 | This variable is obsolete and has no effect anymore, instead add ot remove | |
739 | `time' from the variablle `org-archive-save-context-info'." | |
ab27a4a0 CD |
740 | :group 'org-archive |
741 | :type 'boolean) | |
eb2f9c59 | 742 | |
374585c9 CD |
743 | (defcustom org-archive-save-context-info '(time file category todo itags) |
744 | "Parts of context info that should be stored as properties when archiving. | |
745 | When a subtree is moved to an archive file, it looses information given by | |
746 | context, like inherited tags, the category, and possibly also the TODO | |
747 | state (depending on the variable `org-archive-mark-done'). | |
748 | This variable can be a list of any of the following symbols: | |
749 | ||
750 | time The time of archiving. | |
751 | file The file where the entry originates. | |
752 | itags The local tags, in the headline of the subtree. | |
753 | ltags The tags the subtree inherits from further up the hierarchy. | |
754 | todo The pre-archive TODO state. | |
755 | category The category, taken from file name or #+CATEGORY lines. | |
756 | ||
757 | For each symbol present in the list, a property will be created in | |
758 | the archived entry, with a prefix \"PRE_ARCHIVE_\", to remember this | |
759 | information." | |
760 | :group 'org-archive | |
15841868 JW |
761 | :type '(set :greedy t |
762 | (const :tag "Time" time) | |
374585c9 CD |
763 | (const :tag "File" file) |
764 | (const :tag "Category" category) | |
765 | (const :tag "TODO state" todo) | |
766 | (const :tag "TODO state" priority) | |
767 | (const :tag "Inherited tags" itags) | |
768 | (const :tag "Local tags" ltags))) | |
769 | ||
ab27a4a0 CD |
770 | (defgroup org-table nil |
771 | "Options concerning tables in Org-mode." | |
772 | :tag "Org Table" | |
773 | :group 'org) | |
eb2f9c59 | 774 | |
ab27a4a0 CD |
775 | (defcustom org-enable-table-editor 'optimized |
776 | "Non-nil means, lines starting with \"|\" are handled by the table editor. | |
777 | When nil, such lines will be treated like ordinary lines. | |
eb2f9c59 | 778 | |
ab27a4a0 CD |
779 | When equal to the symbol `optimized', the table editor will be optimized to |
780 | do the following: | |
3278a016 CD |
781 | - Automatic overwrite mode in front of whitespace in table fields. |
782 | This makes the structure of the table stay in tact as long as the edited | |
ab27a4a0 CD |
783 | field does not exceed the column width. |
784 | - Minimize the number of realigns. Normally, the table is aligned each time | |
785 | TAB or RET are pressed to move to another field. With optimization this | |
786 | happens only if changes to a field might have changed the column width. | |
787 | Optimization requires replacing the functions `self-insert-command', | |
788 | `delete-char', and `backward-delete-char' in Org-mode buffers, with a | |
789 | slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is | |
790 | very good at guessing when a re-align will be necessary, but you can always | |
791 | force one with \\[org-ctrl-c-ctrl-c]. | |
eb2f9c59 | 792 | |
ab27a4a0 CD |
793 | If you would like to use the optimized version in Org-mode, but the |
794 | un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. | |
eb2f9c59 | 795 | |
ab27a4a0 CD |
796 | This variable can be used to turn on and off the table editor during a session, |
797 | but in order to toggle optimization, a restart is required. | |
634a7d0b | 798 | |
ab27a4a0 CD |
799 | See also the variable `org-table-auto-blank-field'." |
800 | :group 'org-table | |
801 | :type '(choice | |
802 | (const :tag "off" nil) | |
803 | (const :tag "on" t) | |
804 | (const :tag "on, optimized" optimized))) | |
634a7d0b | 805 | |
ab27a4a0 CD |
806 | (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) |
807 | "Non-nil means, use the optimized table editor version for `orgtbl-mode'. | |
808 | In the optimized version, the table editor takes over all simple keys that | |
809 | normally just insert a character. In tables, the characters are inserted | |
810 | in a way to minimize disturbing the table structure (i.e. in overwrite mode | |
811 | for empty fields). Outside tables, the correct binding of the keys is | |
812 | restored. | |
eb2f9c59 | 813 | |
ab27a4a0 CD |
814 | The default for this option is t if the optimized version is also used in |
815 | Org-mode. See the variable `org-enable-table-editor' for details. Changing | |
816 | this variable requires a restart of Emacs to become effective." | |
817 | :group 'org-table | |
eb2f9c59 CD |
818 | :type 'boolean) |
819 | ||
d3f4dbe8 CD |
820 | (defcustom orgtbl-radio-table-templates |
821 | '((latex-mode "% BEGIN RECEIVE ORGTBL %n | |
822 | % END RECEIVE ORGTBL %n | |
823 | \\begin{comment} | |
824 | #+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0 | |
825 | | | | | |
826 | \\end{comment}\n") | |
827 | (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n | |
828 | @c END RECEIVE ORGTBL %n | |
829 | @ignore | |
830 | #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 | |
831 | | | | | |
832 | @end ignore\n") | |
833 | (html-mode "<!-- BEGIN RECEIVE ORGTBL %n --> | |
834 | <!-- END RECEIVE ORGTBL %n --> | |
835 | <!-- | |
836 | #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 | |
837 | | | | | |
838 | -->\n")) | |
839 | "Templates for radio tables in different major modes. | |
840 | All occurrences of %n in a template will be replaced with the name of the | |
841 | table, obtained by prompting the user." | |
842 | :group 'org-table | |
843 | :type '(repeat | |
844 | (list (symbol :tag "Major mode") | |
845 | (string :tag "Format")))) | |
846 | ||
ab27a4a0 CD |
847 | (defgroup org-table-settings nil |
848 | "Settings for tables in Org-mode." | |
849 | :tag "Org Table Settings" | |
850 | :group 'org-table) | |
30313b90 | 851 | |
ab27a4a0 CD |
852 | (defcustom org-table-default-size "5x2" |
853 | "The default size for newly created tables, Columns x Rows." | |
854 | :group 'org-table-settings | |
855 | :type 'string) | |
30313b90 | 856 | |
3278a016 | 857 | (defcustom org-table-number-regexp |
48aaad2d | 858 | "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" |
ab27a4a0 CD |
859 | "Regular expression for recognizing numbers in table columns. |
860 | If a table column contains mostly numbers, it will be aligned to the | |
861 | right. If not, it will be aligned to the left. | |
30313b90 | 862 | |
ab27a4a0 CD |
863 | The default value of this option is a regular expression which allows |
864 | anything which looks remotely like a number as used in scientific | |
865 | context. For example, all of the following will be considered a | |
866 | number: | |
867 | 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 | |
eb2f9c59 | 868 | |
ab27a4a0 CD |
869 | Other options offered by the customize interface are more restrictive." |
870 | :group 'org-table-settings | |
eb2f9c59 | 871 | :type '(choice |
ab27a4a0 CD |
872 | (const :tag "Positive Integers" |
873 | "^[0-9]+$") | |
874 | (const :tag "Integers" | |
875 | "^[-+]?[0-9]+$") | |
876 | (const :tag "Floating Point Numbers" | |
877 | "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") | |
878 | (const :tag "Floating Point Number or Integer" | |
879 | "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") | |
880 | (const :tag "Exponential, Floating point, Integer" | |
881 | "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") | |
3278a016 | 882 | (const :tag "Very General Number-Like, including hex" |
48aaad2d | 883 | "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") |
ab27a4a0 | 884 | (string :tag "Regexp:"))) |
891f4676 | 885 | |
ab27a4a0 CD |
886 | (defcustom org-table-number-fraction 0.5 |
887 | "Fraction of numbers in a column required to make the column align right. | |
888 | In a column all non-white fields are considered. If at least this | |
889 | fraction of fields is matched by `org-table-number-fraction', | |
890 | alignment to the right border applies." | |
891 | :group 'org-table-settings | |
892 | :type 'number) | |
6e2752e7 | 893 | |
ab27a4a0 CD |
894 | (defgroup org-table-editing nil |
895 | "Bahavior of tables during editing in Org-mode." | |
896 | :tag "Org Table Editing" | |
897 | :group 'org-table) | |
891f4676 | 898 | |
ab27a4a0 CD |
899 | (defcustom org-table-automatic-realign t |
900 | "Non-nil means, automatically re-align table when pressing TAB or RETURN. | |
901 | When nil, aligning is only done with \\[org-table-align], or after column | |
902 | removal/insertion." | |
903 | :group 'org-table-editing | |
f425a6ea CD |
904 | :type 'boolean) |
905 | ||
ab27a4a0 CD |
906 | (defcustom org-table-auto-blank-field t |
907 | "Non-nil means, automatically blank table field when starting to type into it. | |
908 | This only happens when typing immediately after a field motion | |
909 | command (TAB, S-TAB or RET). | |
910 | Only relevant when `org-enable-table-editor' is equal to `optimized'." | |
911 | :group 'org-table-editing | |
f425a6ea CD |
912 | :type 'boolean) |
913 | ||
ab27a4a0 CD |
914 | (defcustom org-table-tab-jumps-over-hlines t |
915 | "Non-nil means, tab in the last column of a table with jump over a hline. | |
916 | If a horizontal separator line is following the current line, | |
917 | `org-table-next-field' can either create a new row before that line, or jump | |
918 | over the line. When this option is nil, a new line will be created before | |
919 | this line." | |
920 | :group 'org-table-editing | |
f425a6ea CD |
921 | :type 'boolean) |
922 | ||
ab27a4a0 CD |
923 | (defcustom org-table-tab-recognizes-table.el t |
924 | "Non-nil means, TAB will automatically notice a table.el table. | |
925 | When it sees such a table, it moves point into it and - if necessary - | |
926 | calls `table-recognize-table'." | |
927 | :group 'org-table-editing | |
79c4be8e CD |
928 | :type 'boolean) |
929 | ||
ab27a4a0 CD |
930 | (defgroup org-table-calculation nil |
931 | "Options concerning tables in Org-mode." | |
932 | :tag "Org Table Calculation" | |
933 | :group 'org-table) | |
934 | ||
a3fbe8c4 CD |
935 | (defcustom org-table-use-standard-references t |
936 | "Should org-mode work with table refrences like B3 instead of @3$2? | |
937 | Possible values are: | |
938 | nil never use them | |
939 | from accept as input, do not present for editing | |
940 | t: accept as input and present for editing" | |
941 | :group 'org-table-calculation | |
942 | :type '(choice | |
943 | (const :tag "Never, don't even check unser input for them" nil) | |
944 | (const :tag "Always, both as user input, and when editing" t) | |
945 | (const :tag "Convert user input, don't offer during editing" 'from))) | |
946 | ||
ab27a4a0 CD |
947 | (defcustom org-table-copy-increment t |
948 | "Non-nil means, increment when copying current field with \\[org-table-copy-down]." | |
949 | :group 'org-table-calculation | |
891f4676 RS |
950 | :type 'boolean) |
951 | ||
ab27a4a0 CD |
952 | (defcustom org-calc-default-modes |
953 | '(calc-internal-prec 12 | |
954 | calc-float-format (float 5) | |
955 | calc-angle-mode deg | |
956 | calc-prefer-frac nil | |
957 | calc-symbolic-mode nil | |
958 | calc-date-format (YYYY "-" MM "-" DD " " Www (" " HH ":" mm)) | |
959 | calc-display-working-message t | |
960 | ) | |
961 | "List with Calc mode settings for use in calc-eval for table formulas. | |
962 | The list must contain alternating symbols (Calc modes variables and values). | |
963 | Don't remove any of the default settings, just change the values. Org-mode | |
964 | relies on the variables to be present in the list." | |
965 | :group 'org-table-calculation | |
966 | :type 'plist) | |
f425a6ea | 967 | |
ab27a4a0 CD |
968 | (defcustom org-table-formula-evaluate-inline t |
969 | "Non-nil means, TAB and RET evaluate a formula in current table field. | |
970 | If the current field starts with an equal sign, it is assumed to be a formula | |
971 | which should be evaluated as described in the manual and in the documentation | |
972 | string of the command `org-table-eval-formula'. This feature requires the | |
973 | Emacs calc package. | |
974 | When this variable is nil, formula calculation is only available through | |
975 | the command \\[org-table-eval-formula]." | |
976 | :group 'org-table-calculation | |
f425a6ea CD |
977 | :type 'boolean) |
978 | ||
ab27a4a0 CD |
979 | (defcustom org-table-formula-use-constants t |
980 | "Non-nil means, interpret constants in formulas in tables. | |
981 | A constant looks like `$c' or `$Grav' and will be replaced before evaluation | |
982 | by the value given in `org-table-formula-constants', or by a value obtained | |
983 | from the `constants.el' package." | |
984 | :group 'org-table-calculation | |
28e5b051 CD |
985 | :type 'boolean) |
986 | ||
ab27a4a0 CD |
987 | (defcustom org-table-formula-constants nil |
988 | "Alist with constant names and values, for use in table formulas. | |
989 | The car of each element is a name of a constant, without the `$' before it. | |
990 | The cdr is the value as a string. For example, if you'd like to use the | |
991 | speed of light in a formula, you would configure | |
4da1a99d | 992 | |
ab27a4a0 | 993 | (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) |
4da1a99d | 994 | |
38f8646b CD |
995 | and then use it in an equation like `$1*$c'. |
996 | ||
997 | Constants can also be defined on a per-file basis using a line like | |
998 | ||
999 | #+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" | |
ab27a4a0 CD |
1000 | :group 'org-table-calculation |
1001 | :type '(repeat | |
1002 | (cons (string :tag "name") | |
1003 | (string :tag "value")))) | |
d924f2e5 | 1004 | |
38f8646b CD |
1005 | (defvar org-table-formula-constants-local nil |
1006 | "Local version of `org-table-formula-constants'.") | |
1007 | (make-variable-buffer-local 'org-table-formula-constants-local) | |
1008 | ||
ab27a4a0 CD |
1009 | (defcustom org-table-allow-automatic-line-recalculation t |
1010 | "Non-nil means, lines marked with |#| or |*| will be recomputed automatically. | |
1011 | Automatically means, when TAB or RET or C-c C-c are pressed in the line." | |
1012 | :group 'org-table-calculation | |
4da1a99d CD |
1013 | :type 'boolean) |
1014 | ||
891f4676 RS |
1015 | (defgroup org-link nil |
1016 | "Options concerning links in Org-mode." | |
1017 | :tag "Org Link" | |
1018 | :group 'org) | |
1019 | ||
3278a016 | 1020 | (defvar org-link-abbrev-alist-local nil |
a3fbe8c4 | 1021 | "Buffer-local version of `org-link-abbrev-alist', which see. |
3278a016 CD |
1022 | The value of this is taken from the #+LINK lines.") |
1023 | (make-variable-buffer-local 'org-link-abbrev-alist-local) | |
1024 | ||
1025 | (defcustom org-link-abbrev-alist nil | |
1026 | "Alist of link abbreviations. | |
1027 | The car of each element is a string, to be replaced at the start of a link. | |
1028 | The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated | |
1029 | links in Org-mode buffers can have an optional tag after a double colon, e.g. | |
1030 | ||
d3f4dbe8 | 1031 | [[linkkey:tag][description]] |
3278a016 CD |
1032 | |
1033 | If REPLACE is a string, the tag will simply be appended to create the link. | |
1034 | If the string contains \"%s\", the tag will be inserted there. REPLACE may | |
1035 | also be a function that will be called with the tag as the only argument to | |
1036 | create the link. See the manual for examples." | |
1037 | :group 'org-link | |
1038 | :type 'alist) | |
1039 | ||
ab27a4a0 CD |
1040 | (defcustom org-descriptive-links t |
1041 | "Non-nil means, hide link part and only show description of bracket links. | |
1042 | Bracket links are like [[link][descritpion]]. This variable sets the initial | |
1043 | state in new org-mode buffers. The setting can then be toggled on a | |
1044 | per-buffer basis from the Org->Hyperlinks menu." | |
4da1a99d CD |
1045 | :group 'org-link |
1046 | :type 'boolean) | |
1047 | ||
4b3a9ba7 CD |
1048 | (defcustom org-link-file-path-type 'adaptive |
1049 | "How the path name in file links should be stored. | |
1050 | Valid values are: | |
1051 | ||
1052 | relative relative to the current directory, i.e. the directory of the file | |
1053 | into which the link is being inserted. | |
1054 | absolute absolute path, if possible with ~ for home directory. | |
1055 | noabbrev absolute path, no abbreviation of home directory. | |
1056 | adaptive Use relative path for files in the current directory and sub- | |
1057 | directories of it. For other files, use an absolute path." | |
1058 | :group 'org-link | |
1059 | :type '(choice | |
1060 | (const relative) | |
1061 | (const absolute) | |
1062 | (const noabbrev) | |
1063 | (const adaptive))) | |
1064 | ||
ab27a4a0 CD |
1065 | (defcustom org-activate-links '(bracket angle plain radio tag date) |
1066 | "Types of links that should be activated in Org-mode files. | |
1067 | This is a list of symbols, each leading to the activation of a certain link | |
1068 | type. In principle, it does not hurt to turn on most link types - there may | |
1069 | be a small gain when turning off unused link types. The types are: | |
1070 | ||
1071 | bracket The recommended [[link][description]] or [[link]] links with hiding. | |
1072 | angular Links in angular brackes that may contain whitespace like | |
1073 | <bbdb:Carsten Dominik>. | |
1074 | plain Plain links in normal text, no whitespace, like http://google.com. | |
1075 | radio Text that is matched by a radio target, see manual for details. | |
1076 | tag Tag settings in a headline (link to tag search). | |
1077 | date Time stamps (link to calendar). | |
ab27a4a0 CD |
1078 | |
1079 | Changing this variable requires a restart of Emacs to become effective." | |
a96ee7df | 1080 | :group 'org-link |
ab27a4a0 CD |
1081 | :type '(set (const :tag "Double bracket links (new style)" bracket) |
1082 | (const :tag "Angular bracket links (old style)" angular) | |
1083 | (const :tag "plain text links" plain) | |
1084 | (const :tag "Radio target matches" radio) | |
1085 | (const :tag "Tags" tag) | |
b38c6895 | 1086 | (const :tag "Tags" target) |
d3f4dbe8 | 1087 | (const :tag "Timestamps" date))) |
ab27a4a0 CD |
1088 | |
1089 | (defgroup org-link-store nil | |
1090 | "Options concerning storing links in Org-mode" | |
1091 | :tag "Org Store Link" | |
1092 | :group 'org-link) | |
891f4676 | 1093 | |
d3f4dbe8 CD |
1094 | (defcustom org-email-link-description-format "Email %c: %.30s" |
1095 | "Format of the description part of a link to an email or usenet message. | |
1096 | The following %-excapes will be replaced by corresponding information: | |
1097 | ||
1098 | %F full \"From\" field | |
1099 | %f name, taken from \"From\" field, address if no name | |
1100 | %T full \"To\" field | |
1101 | %t first name in \"To\" field, address if no name | |
1102 | %c correspondent. Unually \"from NAME\", but if you sent it yourself, it | |
1103 | will be \"to NAME\". See also the variable `org-from-is-user-regexp'. | |
1104 | %s subject | |
1105 | %m message-id. | |
1106 | ||
1107 | You may use normal field width specification between the % and the letter. | |
1108 | This is for example useful to limit the length of the subject. | |
1109 | ||
1110 | Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" | |
1111 | :group 'org-link-store | |
1112 | :type 'string) | |
1113 | ||
1114 | (defcustom org-from-is-user-regexp | |
1115 | (let (r1 r2) | |
1116 | (when (and user-mail-address (not (string= user-mail-address ""))) | |
1117 | (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) | |
1118 | (when (and user-full-name (not (string= user-full-name ""))) | |
1119 | (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) | |
1120 | (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) | |
1121 | "Regexp mached against the \"From:\" header of an email or usenet message. | |
1122 | It should match if the message is from the user him/herself." | |
1123 | :group 'org-link-store | |
1124 | :type 'regexp) | |
1125 | ||
f425a6ea CD |
1126 | (defcustom org-context-in-file-links t |
1127 | "Non-nil means, file links from `org-store-link' contain context. | |
a96ee7df | 1128 | A search string will be added to the file name with :: as separator and |
f425a6ea CD |
1129 | used to find the context when the link is activated by the command |
1130 | `org-open-at-point'. | |
891f4676 RS |
1131 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') |
1132 | negates this setting for the duration of the command." | |
ab27a4a0 | 1133 | :group 'org-link-store |
891f4676 RS |
1134 | :type 'boolean) |
1135 | ||
1136 | (defcustom org-keep-stored-link-after-insertion nil | |
1137 | "Non-nil means, keep link in list for entire session. | |
1138 | ||
1139 | The command `org-store-link' adds a link pointing to the current | |
2dd9129f | 1140 | location to an internal list. These links accumulate during a session. |
891f4676 RS |
1141 | The command `org-insert-link' can be used to insert links into any |
1142 | Org-mode file (offering completion for all stored links). When this | |
634a7d0b | 1143 | option is nil, every link which has been inserted once using \\[org-insert-link] |
891f4676 RS |
1144 | will be removed from the list, to make completing the unused links |
1145 | more efficient." | |
ab27a4a0 CD |
1146 | :group 'org-link-store |
1147 | :type 'boolean) | |
1148 | ||
1149 | (defcustom org-usenet-links-prefer-google nil | |
1150 | "Non-nil means, `org-store-link' will create web links to Google groups. | |
1151 | When nil, Gnus will be used for such links. | |
1152 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') | |
1153 | negates this setting for the duration of the command." | |
1154 | :group 'org-link-store | |
1155 | :type 'boolean) | |
1156 | ||
1157 | (defgroup org-link-follow nil | |
1158 | "Options concerning following links in Org-mode" | |
1159 | :tag "Org Follow Link" | |
1160 | :group 'org-link) | |
1161 | ||
1162 | (defcustom org-tab-follows-link nil | |
1163 | "Non-nil means, on links TAB will follow the link. | |
1164 | Needs to be set before org.el is loaded." | |
1165 | :group 'org-link-follow | |
1166 | :type 'boolean) | |
1167 | ||
1168 | (defcustom org-return-follows-link nil | |
1169 | "Non-nil means, on links RET will follow the link. | |
1170 | Needs to be set before org.el is loaded." | |
1171 | :group 'org-link-follow | |
891f4676 RS |
1172 | :type 'boolean) |
1173 | ||
a4b39e39 CD |
1174 | (defcustom org-mouse-1-follows-link t |
1175 | "Non-nil means, mouse-1 on a link will follow the link. | |
1176 | A longer mouse click will still set point. Does not wortk on XEmacs. | |
1177 | Needs to be set before org.el is loaded." | |
1178 | :group 'org-link-follow | |
1179 | :type 'boolean) | |
1180 | ||
ab27a4a0 CD |
1181 | (defcustom org-mark-ring-length 4 |
1182 | "Number of different positions to be recorded in the ring | |
1183 | Changing this requires a restart of Emacs to work correctly." | |
1184 | :group 'org-link-follow | |
1185 | :type 'interger) | |
1186 | ||
891f4676 RS |
1187 | (defcustom org-link-frame-setup |
1188 | '((vm . vm-visit-folder-other-frame) | |
1189 | (gnus . gnus-other-frame) | |
1190 | (file . find-file-other-window)) | |
1191 | "Setup the frame configuration for following links. | |
1192 | When following a link with Emacs, it may often be useful to display | |
1193 | this link in another window or frame. This variable can be used to | |
1194 | set this up for the different types of links. | |
1195 | For VM, use any of | |
634a7d0b CD |
1196 | `vm-visit-folder' |
1197 | `vm-visit-folder-other-frame' | |
891f4676 | 1198 | For Gnus, use any of |
634a7d0b CD |
1199 | `gnus' |
1200 | `gnus-other-frame' | |
891f4676 | 1201 | For FILE, use any of |
634a7d0b CD |
1202 | `find-file' |
1203 | `find-file-other-window' | |
1204 | `find-file-other-frame' | |
891f4676 RS |
1205 | For the calendar, use the variable `calendar-setup'. |
1206 | For BBDB, it is currently only possible to display the matches in | |
1207 | another window." | |
ab27a4a0 | 1208 | :group 'org-link-follow |
891f4676 | 1209 | :type '(list |
c8d16429 CD |
1210 | (cons (const vm) |
1211 | (choice | |
1212 | (const vm-visit-folder) | |
1213 | (const vm-visit-folder-other-window) | |
1214 | (const vm-visit-folder-other-frame))) | |
1215 | (cons (const gnus) | |
1216 | (choice | |
1217 | (const gnus) | |
1218 | (const gnus-other-frame))) | |
1219 | (cons (const file) | |
1220 | (choice | |
1221 | (const find-file) | |
1222 | (const find-file-other-window) | |
1223 | (const find-file-other-frame))))) | |
891f4676 | 1224 | |
3278a016 CD |
1225 | (defcustom org-display-internal-link-with-indirect-buffer nil |
1226 | "Non-nil means, use indirect buffer to display infile links. | |
1227 | Activating internal links (from one location in a file to another location | |
1228 | in the same file) normally just jumps to the location. When the link is | |
1229 | activated with a C-u prefix (or with mouse-3), the link is displayed in | |
1230 | another window. When this option is set, the other window actually displays | |
1231 | an indirect buffer clone of the current buffer, to avoid any visibility | |
1232 | changes to the current buffer." | |
1233 | :group 'org-link-follow | |
1234 | :type 'boolean) | |
1235 | ||
891f4676 | 1236 | (defcustom org-open-non-existing-files nil |
d3f4dbe8 | 1237 | "Non-nil means, `org-open-file' will open non-existing files. |
891f4676 | 1238 | When nil, an error will be generated." |
ab27a4a0 | 1239 | :group 'org-link-follow |
891f4676 RS |
1240 | :type 'boolean) |
1241 | ||
3278a016 CD |
1242 | (defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") |
1243 | "Function and arguments to call for following mailto links. | |
1244 | This is a list with the first element being a lisp function, and the | |
1245 | remaining elements being arguments to the function. In string arguments, | |
1246 | %a will be replaced by the address, and %s will be replaced by the subject | |
1247 | if one was given like in <mailto:arthur@galaxy.org::this subject>." | |
1248 | :group 'org-link-follow | |
1249 | :type '(choice | |
1250 | (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) | |
1251 | (const :tag "compose-mail" (compose-mail "%a" "%s")) | |
1252 | (const :tag "message-mail" (message-mail "%a" "%s")) | |
1253 | (cons :tag "other" (function) (repeat :tag "argument" sexp)))) | |
1254 | ||
4b3a9ba7 | 1255 | (defcustom org-confirm-shell-link-function 'yes-or-no-p |
891f4676 | 1256 | "Non-nil means, ask for confirmation before executing shell links. |
03f3cf35 | 1257 | Shell links can be dangerous: just think about a link |
ab27a4a0 CD |
1258 | |
1259 | [[shell:rm -rf ~/*][Google Search]] | |
1260 | ||
03f3cf35 | 1261 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1262 | but really it would remove your entire home directory. |
03f3cf35 JW |
1263 | Therefore we advise against setting this variable to nil. |
1264 | Just change it to `y-or-n-p' of you want to confirm with a | |
1265 | single keystroke rather than having to type \"yes\"." | |
4b3a9ba7 CD |
1266 | :group 'org-link-follow |
1267 | :type '(choice | |
1268 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
1269 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
1270 | (const :tag "no confirmation (dangerous)" nil))) | |
1271 | ||
1272 | (defcustom org-confirm-elisp-link-function 'yes-or-no-p | |
03f3cf35 JW |
1273 | "Non-nil means, ask for confirmation before executing Emacs Lisp links. |
1274 | Elisp links can be dangerous: just think about a link | |
4b3a9ba7 CD |
1275 | |
1276 | [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] | |
1277 | ||
03f3cf35 | 1278 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1279 | but really it would remove your entire home directory. |
03f3cf35 JW |
1280 | Therefore we advise against setting this variable to nil. |
1281 | Just change it to `y-or-n-p' of you want to confirm with a | |
1282 | single keystroke rather than having to type \"yes\"." | |
ab27a4a0 CD |
1283 | :group 'org-link-follow |
1284 | :type '(choice | |
1285 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
1286 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
1287 | (const :tag "no confirmation (dangerous)" nil))) | |
891f4676 | 1288 | |
ee53c9b7 | 1289 | (defconst org-file-apps-defaults-gnu |
6769c0dc CD |
1290 | '((remote . emacs) |
1291 | (t . mailcap)) | |
b0a10108 | 1292 | "Default file applications on a UNIX or GNU/Linux system. |
891f4676 RS |
1293 | See `org-file-apps'.") |
1294 | ||
1295 | (defconst org-file-apps-defaults-macosx | |
6769c0dc | 1296 | '((remote . emacs) |
3278a016 | 1297 | (t . "open %s") |
891f4676 RS |
1298 | ("ps" . "gv %s") |
1299 | ("ps.gz" . "gv %s") | |
1300 | ("eps" . "gv %s") | |
1301 | ("eps.gz" . "gv %s") | |
1302 | ("dvi" . "xdvi %s") | |
1303 | ("fig" . "xfig %s")) | |
1304 | "Default file applications on a MacOS X system. | |
1305 | The system \"open\" is known as a default, but we use X11 applications | |
1306 | for some files for which the OS does not have a good default. | |
1307 | See `org-file-apps'.") | |
1308 | ||
1309 | (defconst org-file-apps-defaults-windowsnt | |
c44f0d75 | 1310 | (list |
6769c0dc CD |
1311 | '(remote . emacs) |
1312 | (cons t | |
1313 | (list (if (featurep 'xemacs) | |
1314 | 'mswindows-shell-execute | |
1315 | 'w32-shell-execute) | |
1316 | "open" 'file))) | |
891f4676 RS |
1317 | "Default file applications on a Windows NT system. |
1318 | The system \"open\" is used for most files. | |
1319 | See `org-file-apps'.") | |
1320 | ||
1321 | (defcustom org-file-apps | |
1322 | '( | |
1323 | ("txt" . emacs) | |
1324 | ("tex" . emacs) | |
1325 | ("ltx" . emacs) | |
1326 | ("org" . emacs) | |
1327 | ("el" . emacs) | |
4b3a9ba7 | 1328 | ("bib" . emacs) |
891f4676 RS |
1329 | ) |
1330 | "External applications for opening `file:path' items in a document. | |
1331 | Org-mode uses system defaults for different file types, but | |
1332 | you can use this variable to set the application for a given file | |
4b3a9ba7 CD |
1333 | extension. The entries in this list are cons cells where the car identifies |
1334 | files and the cdr the corresponding command. Possible values for the | |
1335 | file identifier are | |
1336 | \"ext\" A string identifying an extension | |
1337 | `directory' Matches a directory | |
5137195a | 1338 | `remote' Matches a remote file, accessible through tramp or efs. |
c44f0d75 | 1339 | Remote files most likely should be visited through Emacs |
6769c0dc | 1340 | because external applications cannot handle such paths. |
4b3a9ba7 CD |
1341 | t Default for all remaining files |
1342 | ||
1343 | Possible values for the command are: | |
1344 | `emacs' The file will be visited by the current Emacs process. | |
1345 | `default' Use the default application for this file type. | |
1346 | string A command to be executed by a shell; %s will be replaced | |
1347 | by the path to the file. | |
1348 | sexp A Lisp form which will be evaluated. The file path will | |
1349 | be available in the Lisp variable `file'. | |
891f4676 RS |
1350 | For more examples, see the system specific constants |
1351 | `org-file-apps-defaults-macosx' | |
1352 | `org-file-apps-defaults-windowsnt' | |
ee53c9b7 | 1353 | `org-file-apps-defaults-gnu'." |
ab27a4a0 | 1354 | :group 'org-link-follow |
891f4676 | 1355 | :type '(repeat |
a96ee7df CD |
1356 | (cons (choice :value "" |
1357 | (string :tag "Extension") | |
1358 | (const :tag "Default for unrecognized files" t) | |
6769c0dc | 1359 | (const :tag "Remote file" remote) |
a96ee7df | 1360 | (const :tag "Links to a directory" directory)) |
c8d16429 | 1361 | (choice :value "" |
a96ee7df CD |
1362 | (const :tag "Visit with Emacs" emacs) |
1363 | (const :tag "Use system default" default) | |
1364 | (string :tag "Command") | |
1365 | (sexp :tag "Lisp form"))))) | |
891f4676 | 1366 | |
7204b00e | 1367 | (defcustom org-mhe-search-all-folders nil |
ab27a4a0 | 1368 | "Non-nil means, that the search for the mh-message will be extended to |
7204b00e | 1369 | all folders if the message cannot be found in the folder given in the link. |
d3f4dbe8 | 1370 | Searching all folders is very efficient with one of the search engines |
7204b00e | 1371 | supported by MH-E, but will be slow with pick." |
ab27a4a0 | 1372 | :group 'org-link-follow |
7204b00e CD |
1373 | :type 'boolean) |
1374 | ||
891f4676 RS |
1375 | (defgroup org-remember nil |
1376 | "Options concerning interaction with remember.el." | |
1377 | :tag "Org Remember" | |
1378 | :group 'org) | |
1379 | ||
1380 | (defcustom org-directory "~/org" | |
1381 | "Directory with org files. | |
1382 | This directory will be used as default to prompt for org files. | |
1383 | Used by the hooks for remember.el." | |
1384 | :group 'org-remember | |
1385 | :type 'directory) | |
1386 | ||
1387 | (defcustom org-default-notes-file "~/.notes" | |
1388 | "Default target for storing notes. | |
1389 | Used by the hooks for remember.el. This can be a string, or nil to mean | |
d3f4dbe8 CD |
1390 | the value of `remember-data-file'. |
1391 | You can set this on a per-template basis with the variable | |
1392 | `org-remember-templates'." | |
891f4676 RS |
1393 | :group 'org-remember |
1394 | :type '(choice | |
c8d16429 CD |
1395 | (const :tag "Default from remember-data-file" nil) |
1396 | file)) | |
891f4676 | 1397 | |
d5098885 | 1398 | (defcustom org-remember-store-without-prompt t |
48aaad2d CD |
1399 | "Non-nil means, `C-c C-c' stores remember note without further promts. |
1400 | In this case, you need `C-u C-c C-c' to get the prompts for | |
1401 | note file and headline. | |
1402 | When this variable is nil, `C-c C-c' give you the prompts, and | |
1403 | `C-u C-c C-c' trigger the fasttrack." | |
1404 | :group 'org-remember | |
1405 | :type 'boolean) | |
fbe6c10d | 1406 | |
d3f4dbe8 CD |
1407 | (defcustom org-remember-default-headline "" |
1408 | "The headline that should be the default location in the notes file. | |
1409 | When filing remember notes, the cursor will start at that position. | |
1410 | You can set this on a per-template basis with the variable | |
1411 | `org-remember-templates'." | |
1412 | :group 'org-remember | |
1413 | :type 'string) | |
1414 | ||
ab27a4a0 CD |
1415 | (defcustom org-remember-templates nil |
1416 | "Templates for the creation of remember buffers. | |
1417 | When nil, just let remember make the buffer. | |
03f3cf35 JW |
1418 | When not nil, this is a list of 5-element lists. In each entry, the first |
1419 | element is a the name of the template, It should be a single short word. | |
1420 | The second element is a character, a unique key to select this template. | |
1421 | The third element is the template. The forth element is optional and can | |
ab27a4a0 | 1422 | specify a destination file for remember items created with this template. |
03f3cf35 | 1423 | The default file is given by `org-default-notes-file'. An optional fifth |
d3f4dbe8 CD |
1424 | element can specify the headline in that file that should be offered |
1425 | first when the user is asked to file the entry. The default headline is | |
1426 | given in the variable `org-remember-default-headline'. | |
ab27a4a0 CD |
1427 | |
1428 | The template specifies the structure of the remember buffer. It should have | |
1429 | a first line starting with a star, to act as the org-mode headline. | |
1430 | Furthermore, the following %-escapes will be replaced with content: | |
d3f4dbe8 CD |
1431 | |
1432 | %^{prompt} prompt the user for a string and replace this sequence with it. | |
1433 | %t time stamp, date only | |
1434 | %T time stamp with date and time | |
1435 | %u, %U like the above, but inactive time stamps | |
1436 | %^t like %t, but prompt for date. Similarly %^T, %^u, %^U | |
1437 | You may define a prompt like %^{Please specify birthday}t | |
1438 | %n user name (taken from `user-full-name') | |
1439 | %a annotation, normally the link created with org-store-link | |
1440 | %i initial content, the region when remember is called with C-u. | |
1441 | If %i is indented, the entire inserted text will be indented | |
1442 | as well. | |
1443 | ||
1444 | %? After completing the template, position cursor here. | |
1445 | ||
1446 | Apart from these general escapes, you can access information specific to the | |
1447 | link type that is created. For example, calling `remember' in emails or gnus | |
1448 | will record the author and the subject of the message, which you can access | |
1449 | with %:author and %:subject, respectively. Here is a complete list of what | |
1450 | is recorded for each link type. | |
1451 | ||
1452 | Link type | Available information | |
1453 | -------------------+------------------------------------------------------ | |
1454 | bbdb | %:type %:name %:company | |
1455 | vm, wl, mh, rmail | %:type %:subject %:message-id | |
1456 | | %:from %:fromname %:fromaddress | |
1457 | | %:to %:toname %:toaddress | |
1458 | | %:fromto (either \"to NAME\" or \"from NAME\") | |
1459 | gnus | %:group, for messages also all email fields | |
1460 | w3, w3m | %:type %:url | |
1461 | info | %:type %:file %:node | |
1462 | calendar | %:type %:date" | |
ab27a4a0 | 1463 | :group 'org-remember |
03f3cf35 | 1464 | :get (lambda (var) ; Make sure all entries have 5 elements |
d3f4dbe8 | 1465 | (mapcar (lambda (x) |
03f3cf35 JW |
1466 | (if (not (stringp (car x))) (setq x (cons "" x))) |
1467 | (cond ((= (length x) 4) (append x '(""))) | |
1468 | ((= (length x) 3) (append x '("" ""))) | |
d3f4dbe8 CD |
1469 | (t x))) |
1470 | (default-value var))) | |
1471 | :type '(repeat | |
1472 | :tag "enabled" | |
03f3cf35 JW |
1473 | (list :value ("" ?a "\n" nil nil) |
1474 | (string :tag "Name") | |
d3f4dbe8 CD |
1475 | (character :tag "Selection Key") |
1476 | (string :tag "Template") | |
03f3cf35 JW |
1477 | (choice |
1478 | (file :tag "Destination file") | |
1479 | (const :tag "Prompt for file" nil)) | |
1480 | (choice | |
1481 | (string :tag "Destination headline") | |
1482 | (const :tag "Selection interface for heading"))))) | |
ab27a4a0 | 1483 | |
891f4676 RS |
1484 | (defcustom org-reverse-note-order nil |
1485 | "Non-nil means, store new notes at the beginning of a file or entry. | |
1486 | When nil, new notes will be filed to the end of a file or entry." | |
1487 | :group 'org-remember | |
1488 | :type '(choice | |
c8d16429 CD |
1489 | (const :tag "Reverse always" t) |
1490 | (const :tag "Reverse never" nil) | |
1491 | (repeat :tag "By file name regexp" | |
1492 | (cons regexp boolean)))) | |
891f4676 | 1493 | |
ab27a4a0 CD |
1494 | (defgroup org-todo nil |
1495 | "Options concerning TODO items in Org-mode." | |
1496 | :tag "Org TODO" | |
891f4676 RS |
1497 | :group 'org) |
1498 | ||
d3f4dbe8 CD |
1499 | (defgroup org-progress nil |
1500 | "Options concerning Progress logging in Org-mode." | |
1501 | :tag "Org Progress" | |
1502 | :group 'org-time) | |
1503 | ||
a3fbe8c4 CD |
1504 | (defcustom org-todo-keywords '((sequence "TODO" "DONE")) |
1505 | "List of TODO entry keyword sequences and their interpretation. | |
1506 | \\<org-mode-map>This is a list of sequences. | |
1507 | ||
1508 | Each sequence starts with a symbol, either `sequence' or `type', | |
1509 | indicating if the keywords should be interpreted as a sequence of | |
1510 | action steps, or as different types of TODO items. The first | |
1511 | keywords are states requiring action - these states will select a headline | |
1512 | for inclusion into the global TODO list Org-mode produces. If one of | |
1513 | the \"keywords\" is the vertical bat \"|\" the remaining keywords | |
1514 | signify that no further action is necessary. If \"|\" is not found, | |
1515 | the last keyword is treated as the only DONE state of the sequence. | |
1516 | ||
1517 | The command \\[org-todo] cycles an entry through these states, and one | |
ab27a4a0 | 1518 | additional state where no keyword is present. For details about this |
a3fbe8c4 CD |
1519 | cycling, see the manual. |
1520 | ||
1521 | TODO keywords and interpretation can also be set on a per-file basis with | |
1522 | the special #+SEQ_TODO and #+TYP_TODO lines. | |
1523 | ||
1524 | For backward compatibility, this variable may also be just a list | |
1525 | of keywords - in this case the interptetation (sequence or type) will be | |
1526 | taken from the (otherwise obsolete) variable `org-todo-interpretation'." | |
ab27a4a0 CD |
1527 | :group 'org-todo |
1528 | :group 'org-keywords | |
a3fbe8c4 CD |
1529 | :type '(choice |
1530 | (repeat :tag "Old syntax, just keywords" | |
1531 | (string :tag "Keyword")) | |
1532 | (repeat :tag "New syntax" | |
1533 | (cons | |
1534 | (choice | |
1535 | :tag "Interpretation" | |
1536 | (const :tag "Sequence (cycling hits every state)" sequence) | |
1537 | (const :tag "Type (cycling directly to DONE)" type)) | |
1538 | (repeat | |
1539 | (string :tag "Keyword")))))) | |
1540 | ||
1541 | (defvar org-todo-keywords-1 nil) | |
1542 | (make-variable-buffer-local 'org-todo-keywords-1) | |
1543 | (defvar org-todo-keywords-for-agenda nil) | |
1544 | (defvar org-done-keywords-for-agenda nil) | |
1545 | (defvar org-not-done-keywords nil) | |
1546 | (make-variable-buffer-local 'org-not-done-keywords) | |
1547 | (defvar org-done-keywords nil) | |
1548 | (make-variable-buffer-local 'org-done-keywords) | |
1549 | (defvar org-todo-heads nil) | |
1550 | (make-variable-buffer-local 'org-todo-heads) | |
1551 | (defvar org-todo-sets nil) | |
1552 | (make-variable-buffer-local 'org-todo-sets) | |
d5098885 JW |
1553 | (defvar org-todo-log-states nil) |
1554 | (make-variable-buffer-local 'org-todo-log-states) | |
a3fbe8c4 CD |
1555 | (defvar org-todo-kwd-alist nil) |
1556 | (make-variable-buffer-local 'org-todo-kwd-alist) | |
0b8568f5 JW |
1557 | (defvar org-todo-key-alist nil) |
1558 | (make-variable-buffer-local 'org-todo-key-alist) | |
1559 | (defvar org-todo-key-trigger nil) | |
1560 | (make-variable-buffer-local 'org-todo-key-trigger) | |
791d856f | 1561 | |
ab27a4a0 CD |
1562 | (defcustom org-todo-interpretation 'sequence |
1563 | "Controls how TODO keywords are interpreted. | |
a3fbe8c4 CD |
1564 | This variable is in principle obsolete and is only used for |
1565 | backward compatibility, if the interpretation of todo keywords is | |
1566 | not given already in `org-todo-keywords'. See that variable for | |
1567 | more information." | |
ab27a4a0 CD |
1568 | :group 'org-todo |
1569 | :group 'org-keywords | |
1570 | :type '(choice (const sequence) | |
1571 | (const type))) | |
28e5b051 | 1572 | |
0b8568f5 JW |
1573 | (defcustom org-use-fast-todo-selection 'prefix |
1574 | "Non-nil means, use the fast todo selection scheme with C-c C-t. | |
1575 | This variable describes if and under what circumstances the cycling | |
1576 | mechanism for TODO keywords will be replaced by a single-key, direct | |
1577 | selection scheme. | |
1578 | ||
1579 | When nil, fast selection is never used. | |
1580 | ||
1581 | When the symbol `prefix', it will be used when `org-todo' is called with | |
1582 | a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' | |
1583 | in an agenda buffer. | |
1584 | ||
1585 | When t, fast selection is used by default. In this case, the prefix | |
1586 | argument forces cycling instead. | |
1587 | ||
1588 | In all cases, the special interface is only used if access keys have actually | |
1589 | been assigned by the user, i.e. if keywords in the configuration are followed | |
1590 | by a letter in parenthesis, like TODO(t)." | |
1591 | :group 'org-todo | |
1592 | :type '(choice | |
1593 | (const :tag "Never" nil) | |
1594 | (const :tag "By default" t) | |
1595 | (const :tag "Only with C-u C-c C-t" prefix))) | |
1596 | ||
ab27a4a0 CD |
1597 | (defcustom org-after-todo-state-change-hook nil |
1598 | "Hook which is run after the state of a TODO item was changed. | |
1599 | The new state (a string with a TODO keyword, or nil) is available in the | |
1600 | Lisp variable `state'." | |
1601 | :group 'org-todo | |
1602 | :type 'hook) | |
891f4676 | 1603 | |
ab27a4a0 CD |
1604 | (defcustom org-log-done nil |
1605 | "When set, insert a (non-active) time stamp when TODO entry is marked DONE. | |
0b8568f5 JW |
1606 | When the state of an entry is changed from nothing or a DONE state to |
1607 | a not-done TODO state, remove a previous closing date. | |
3278a016 CD |
1608 | |
1609 | This can also be a list of symbols indicating under which conditions | |
1610 | the time stamp recording the action should be annotated with a short note. | |
1611 | Valid members of this list are | |
1612 | ||
1613 | done Offer to record a note when marking entries done | |
d3f4dbe8 CD |
1614 | state Offer to record a note whenever changing the TODO state |
1615 | of an item. This is only relevant if TODO keywords are | |
1616 | interpreted as sequence, see variable `org-todo-interpretation'. | |
1617 | When `state' is set, this includes tracking `done'. | |
3278a016 CD |
1618 | clock-out Offer to record a note when clocking out of an item. |
1619 | ||
1620 | A separate window will then pop up and allow you to type a note. | |
1621 | After finishing with C-c C-c, the note will be added directly after the | |
1622 | timestamp, as a plain list item. See also the variable | |
1623 | `org-log-note-headings'. | |
1624 | ||
1625 | Logging can also be configured on a per-file basis by adding one of | |
4b3a9ba7 CD |
1626 | the following lines anywhere in the buffer: |
1627 | ||
d3f4dbe8 CD |
1628 | #+STARTUP: logdone |
1629 | #+STARTUP: nologging | |
1630 | #+STARTUP: lognotedone | |
1631 | #+STARTUP: lognotestate | |
15841868 JW |
1632 | #+STARTUP: lognoteclock-out |
1633 | ||
1634 | You can have local logging settings for a subtree by setting the LOGGING | |
1635 | property to one or more of these keywords." | |
ab27a4a0 | 1636 | :group 'org-todo |
d3f4dbe8 | 1637 | :group 'org-progress |
3278a016 CD |
1638 | :type '(choice |
1639 | (const :tag "off" nil) | |
1640 | (const :tag "on" t) | |
d3f4dbe8 CD |
1641 | (set :tag "on, with notes, detailed control" :greedy t :value (done) |
1642 | (const :tag "when item is marked DONE" done) | |
1643 | (const :tag "when TODO state changes" state) | |
1644 | (const :tag "when clocking out" clock-out)))) | |
1645 | ||
a3fbe8c4 CD |
1646 | (defcustom org-log-done-with-time t |
1647 | "Non-nil means, the CLOSED time stamp will contain date and time. | |
1648 | When nil, only the date will be recorded." | |
1649 | :group 'org-progress | |
1650 | :type 'boolean) | |
1651 | ||
d3f4dbe8 CD |
1652 | (defcustom org-log-note-headings |
1653 | '((done . "CLOSING NOTE %t") | |
1654 | (state . "State %-12s %t") | |
1655 | (clock-out . "")) | |
3278a016 | 1656 | "Headings for notes added when clocking out or closing TODO items. |
48aaad2d | 1657 | The value is an alist, with the car being a symbol indicating the note |
3278a016 | 1658 | context, and the cdr is the heading to be used. The heading may also be the |
d3f4dbe8 CD |
1659 | empty string. |
1660 | %t in the heading will be replaced by a time stamp. | |
1661 | %s will be replaced by the new TODO state, in double quotes. | |
1662 | %u will be replaced by the user name. | |
1663 | %U will be replaced by the full user name." | |
3278a016 | 1664 | :group 'org-todo |
d3f4dbe8 | 1665 | :group 'org-progress |
3278a016 CD |
1666 | :type '(list :greedy t |
1667 | (cons (const :tag "Heading when closing an item" done) string) | |
d3f4dbe8 CD |
1668 | (cons (const :tag |
1669 | "Heading when changing todo state (todo sequence only)" | |
1670 | state) string) | |
3278a016 | 1671 | (cons (const :tag "Heading when clocking out" clock-out) string))) |
e0e66b8e | 1672 | |
48aaad2d CD |
1673 | (defcustom org-log-states-order-reversed t |
1674 | "Non-nil means, the latest state change note will be directly after heading. | |
1675 | When nil, the notes will be orderer according to time." | |
1676 | :group 'org-todo | |
1677 | :group 'org-progress | |
1678 | :type 'boolean) | |
1679 | ||
a3fbe8c4 CD |
1680 | (defcustom org-log-repeat t |
1681 | "Non-nil means, prompt for a note when REPEAT is resetting a TODO entry. | |
15841868 JW |
1682 | When nil, no note will be taken. |
1683 | This option can also be set with on a per-file-basis with | |
1684 | ||
1685 | #+STARTUP: logrepeat | |
1686 | #+STARTUP: nologrepeat | |
1687 | ||
1688 | You can have local logging settings for a subtree by setting the LOGGING | |
1689 | property to one or more of these keywords." | |
d3f4dbe8 CD |
1690 | :group 'org-todo |
1691 | :group 'org-progress | |
1692 | :type 'boolean) | |
1693 | ||
15841868 JW |
1694 | (defcustom org-clock-into-drawer 2 |
1695 | "Should clocking info be wrapped into a drawer? | |
1696 | When t, clocking info will always be inserted into a :CLOCK: drawer. | |
1697 | If necessary, the drawer will be created. | |
1698 | When nil, the drawer will not be created, but used when present. | |
1699 | When an integer and the number of clocking entries in an item | |
1700 | reaches or exceeds this number, a drawer will be created." | |
1701 | :group 'org-todo | |
1702 | :group 'org-progress | |
1703 | :type '(choice | |
1704 | (const :tag "Always" t) | |
1705 | (const :tag "Only when drawer exists" nil) | |
1706 | (integer :tag "When at least N clock entries"))) | |
1707 | ||
48aaad2d CD |
1708 | (defcustom org-clock-out-when-done t |
1709 | "When t, the clock will be stopped when the relevant entry is marked DONE. | |
1710 | Nil means, clock will keep running until stopped explicitly with | |
1711 | `C-c C-x C-o', or until the clock is started in a different item." | |
1712 | :group 'org-progress | |
1713 | :type 'boolean) | |
1714 | ||
ab27a4a0 | 1715 | (defgroup org-priorities nil |
4146eb16 | 1716 | "Priorities in Org-mode." |
ab27a4a0 CD |
1717 | :tag "Org Priorities" |
1718 | :group 'org-todo) | |
28e5b051 | 1719 | |
a3fbe8c4 CD |
1720 | (defcustom org-highest-priority ?A |
1721 | "The highest priority of TODO items. A character like ?A, ?B etc. | |
1722 | Must have a smaller ASCII number than `org-lowest-priority'." | |
ab27a4a0 CD |
1723 | :group 'org-priorities |
1724 | :type 'character) | |
891f4676 | 1725 | |
ab27a4a0 | 1726 | (defcustom org-lowest-priority ?C |
a3fbe8c4 CD |
1727 | "The lowest priority of TODO items. A character like ?A, ?B etc. |
1728 | Must have a larger ASCII number than `org-highest-priority'." | |
1729 | :group 'org-priorities | |
1730 | :type 'character) | |
1731 | ||
1732 | (defcustom org-default-priority ?B | |
1733 | "The default priority of TODO items. | |
1734 | This is the priority an item get if no explicit priority is given." | |
ab27a4a0 CD |
1735 | :group 'org-priorities |
1736 | :type 'character) | |
1737 | ||
15841868 JW |
1738 | (defcustom org-priority-start-cycle-with-default t |
1739 | "Non-nil means, start with default priority when starting to cycle. | |
1740 | When this is nil, the first step in the cycle will be (depending on the | |
1741 | command used) one higher or lower that the default priority." | |
1742 | :group 'org-priorities | |
1743 | :type 'boolean) | |
1744 | ||
ab27a4a0 CD |
1745 | (defgroup org-time nil |
1746 | "Options concerning time stamps and deadlines in Org-mode." | |
1747 | :tag "Org Time" | |
1748 | :group 'org) | |
1749 | ||
4b3a9ba7 CD |
1750 | (defcustom org-insert-labeled-timestamps-at-point nil |
1751 | "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. | |
1752 | When nil, these labeled time stamps are forces into the second line of an | |
1753 | entry, just after the headline. When scheduling from the global TODO list, | |
1754 | the time stamp will always be forced into the second line." | |
1755 | :group 'org-time | |
1756 | :type 'boolean) | |
1757 | ||
ab27a4a0 CD |
1758 | (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") |
1759 | "Formats for `format-time-string' which are used for time stamps. | |
1760 | It is not recommended to change this constant.") | |
1761 | ||
1762 | (defcustom org-time-stamp-rounding-minutes 0 | |
1763 | "Number of minutes to round time stamps to upon insertion. | |
1764 | When zero, insert the time unmodified. Useful rounding numbers | |
1765 | should be factors of 60, so for example 5, 10, 15. | |
1766 | When this is not zero, you can still force an exact time-stamp by using | |
1767 | a double prefix argument to a time-stamp command like `C-c .' or `C-c !'." | |
1768 | :group 'org-time | |
1769 | :type 'integer) | |
1770 | ||
3278a016 CD |
1771 | (defcustom org-display-custom-times nil |
1772 | "Non-nil means, overlay custom formats over all time stamps. | |
1773 | The formats are defined through the variable `org-time-stamp-custom-formats'. | |
1774 | To turn this on on a per-file basis, insert anywhere in the file: | |
1775 | #+STARTUP: customtime" | |
1776 | :group 'org-time | |
1777 | :set 'set-default | |
1778 | :type 'sexp) | |
1779 | (make-variable-buffer-local 'org-display-custom-times) | |
1780 | ||
1781 | (defcustom org-time-stamp-custom-formats | |
1782 | '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american | |
1783 | "Custom formats for time stamps. See `format-time-string' for the syntax. | |
1784 | These are overlayed over the default ISO format if the variable | |
b38c6895 CD |
1785 | `org-display-custom-times' is set. Time like %H:%M should be at the |
1786 | end of the second format." | |
3278a016 CD |
1787 | :group 'org-time |
1788 | :type 'sexp) | |
1789 | ||
d3f4dbe8 CD |
1790 | (defun org-time-stamp-format (&optional long inactive) |
1791 | "Get the right format for a time string." | |
1792 | (let ((f (if long (cdr org-time-stamp-formats) | |
1793 | (car org-time-stamp-formats)))) | |
1794 | (if inactive | |
1795 | (concat "[" (substring f 1 -1) "]") | |
1796 | f))) | |
1797 | ||
ab27a4a0 CD |
1798 | (defcustom org-popup-calendar-for-date-prompt t |
1799 | "Non-nil means, pop up a calendar when prompting for a date. | |
1800 | In the calendar, the date can be selected with mouse-1. However, the | |
1801 | minibuffer will also be active, and you can simply enter the date as well. | |
1802 | When nil, only the minibuffer will be available." | |
1803 | :group 'org-time | |
891f4676 RS |
1804 | :type 'boolean) |
1805 | ||
0b8568f5 JW |
1806 | (defcustom org-edit-timestamp-down-means-later nil |
1807 | "Non-nil means, S-down will increase the time in a time stamp. | |
1808 | When nil, S-up will increase." | |
1809 | :group 'org-time | |
1810 | :type 'boolean) | |
1811 | ||
ab27a4a0 CD |
1812 | (defcustom org-calendar-follow-timestamp-change t |
1813 | "Non-nil means, make the calendar window follow timestamp changes. | |
1814 | When a timestamp is modified and the calendar window is visible, it will be | |
1815 | moved to the new date." | |
1816 | :group 'org-time | |
1817 | :type 'boolean) | |
891f4676 | 1818 | |
ab27a4a0 | 1819 | (defgroup org-tags nil |
4146eb16 | 1820 | "Options concerning tags in Org-mode." |
ab27a4a0 CD |
1821 | :tag "Org Tags" |
1822 | :group 'org) | |
891f4676 | 1823 | |
4b3a9ba7 CD |
1824 | (defcustom org-tag-alist nil |
1825 | "List of tags allowed in Org-mode files. | |
1826 | When this list is nil, Org-mode will base TAG input on what is already in the | |
1827 | buffer. | |
0b8568f5 JW |
1828 | The value of this variable is an alist, the car of each entry must be a |
1829 | keyword as a string, the cdr may be a character that is used to select | |
1830 | that tag through the fast-tag-selection interface. | |
1831 | See the manual for details." | |
4b3a9ba7 CD |
1832 | :group 'org-tags |
1833 | :type '(repeat | |
7d143c25 CD |
1834 | (choice |
1835 | (cons (string :tag "Tag name") | |
1836 | (character :tag "Access char")) | |
1837 | (const :tag "Start radio group" (:startgroup)) | |
1838 | (const :tag "End radio group" (:endgroup))))) | |
4b3a9ba7 CD |
1839 | |
1840 | (defcustom org-use-fast-tag-selection 'auto | |
1841 | "Non-nil means, use fast tag selection scheme. | |
1842 | This is a special interface to select and deselect tags with single keys. | |
1843 | When nil, fast selection is never used. | |
1844 | When the symbol `auto', fast selection is used if and only if selection | |
1845 | characters for tags have been configured, either through the variable | |
1846 | `org-tag-alist' or through a #+TAGS line in the buffer. | |
1847 | When t, fast selection is always used and selection keys are assigned | |
1848 | automatically if necessary." | |
1849 | :group 'org-tags | |
1850 | :type '(choice | |
1851 | (const :tag "Always" t) | |
1852 | (const :tag "Never" nil) | |
1853 | (const :tag "When selection characters are configured" 'auto))) | |
1854 | ||
3278a016 CD |
1855 | (defcustom org-fast-tag-selection-single-key nil |
1856 | "Non-nil means, fast tag selection exits after first change. | |
1857 | When nil, you have to press RET to exit it. | |
d3f4dbe8 CD |
1858 | During fast tag selection, you can toggle this flag with `C-c'. |
1859 | This variable can also have the value `expert'. In this case, the window | |
1860 | displaying the tags menu is not even shown, until you press C-c again." | |
3278a016 | 1861 | :group 'org-tags |
d3f4dbe8 CD |
1862 | :type '(choice |
1863 | (const :tag "No" nil) | |
1864 | (const :tag "Yes" t) | |
1865 | (const :tag "Expert" expert))) | |
3278a016 | 1866 | |
d5098885 JW |
1867 | (defvar org-fast-tag-selection-include-todo nil |
1868 | "Non-nil means, fast tags selection interface will also offer TODO states. | |
1869 | This is an undocumented feature, you should not rely on it.") | |
0b8568f5 | 1870 | |
15841868 | 1871 | (defcustom org-tags-column -80 |
ab27a4a0 CD |
1872 | "The column to which tags should be indented in a headline. |
1873 | If this number is positive, it specifies the column. If it is negative, | |
1874 | it means that the tags should be flushright to that column. For example, | |
15841868 | 1875 | -80 works well for a normal 80 character screen." |
ab27a4a0 CD |
1876 | :group 'org-tags |
1877 | :type 'integer) | |
891f4676 | 1878 | |
ab27a4a0 CD |
1879 | (defcustom org-auto-align-tags t |
1880 | "Non-nil means, realign tags after pro/demotion of TODO state change. | |
1881 | These operations change the length of a headline and therefore shift | |
1882 | the tags around. With this options turned on, after each such operation | |
1883 | the tags are again aligned to `org-tags-column'." | |
1884 | :group 'org-tags | |
1885 | :type 'boolean) | |
891f4676 | 1886 | |
ab27a4a0 CD |
1887 | (defcustom org-use-tag-inheritance t |
1888 | "Non-nil means, tags in levels apply also for sublevels. | |
1889 | When nil, only the tags directly given in a specific line apply there. | |
1890 | If you turn off this option, you very likely want to turn on the | |
1891 | companion option `org-tags-match-list-sublevels'." | |
1892 | :group 'org-tags | |
1893 | :type 'boolean) | |
1894 | ||
1895 | (defcustom org-tags-match-list-sublevels nil | |
1896 | "Non-nil means list also sublevels of headlines matching tag search. | |
1897 | Because of tag inheritance (see variable `org-use-tag-inheritance'), | |
1898 | the sublevels of a headline matching a tag search often also match | |
1899 | the same search. Listing all of them can create very long lists. | |
1900 | Setting this variable to nil causes subtrees of a match to be skipped. | |
1901 | This option is off by default, because inheritance in on. If you turn | |
1902 | inheritance off, you very likely want to turn this option on. | |
1903 | ||
1904 | As a special case, if the tag search is restricted to TODO items, the | |
1905 | value of this variable is ignored and sublevels are always checked, to | |
1906 | make sure all corresponding TODO items find their way into the list." | |
1907 | :group 'org-tags | |
1908 | :type 'boolean) | |
1909 | ||
1910 | (defvar org-tags-history nil | |
1911 | "History of minibuffer reads for tags.") | |
1912 | (defvar org-last-tags-completion-table nil | |
1913 | "The last used completion table for tags.") | |
d5098885 JW |
1914 | (defvar org-after-tags-change-hook nil |
1915 | "Hook that is run after the tags in a line have changed.") | |
ab27a4a0 | 1916 | |
38f8646b CD |
1917 | (defgroup org-properties nil |
1918 | "Options concerning properties in Org-mode." | |
1919 | :tag "Org Properties" | |
1920 | :group 'org) | |
1921 | ||
1922 | (defcustom org-property-format "%-10s %s" | |
1923 | "How property key/value pairs should be formatted by `indent-line'. | |
1924 | When `indent-line' hits a property definition, it will format the line | |
1925 | according to this format, mainly to make sure that the values are | |
1926 | lined-up with respect to each other." | |
1927 | :group 'org-properties | |
1928 | :type 'string) | |
1929 | ||
03f3cf35 JW |
1930 | (defcustom org-use-property-inheritance nil |
1931 | "Non-nil means, properties apply also for sublevels. | |
1932 | This can cause significant overhead when doing a search, so this is turned | |
1933 | off by default. | |
1934 | When nil, only the properties directly given in the current entry count. | |
1935 | ||
1936 | However, note that some special properties use inheritance under special | |
1937 | circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, | |
1938 | and the properties ending in \"_ALL\" when they are used as descriptor | |
1939 | for valid values of a property." | |
1940 | :group 'org-properties | |
1941 | :type 'boolean) | |
1942 | ||
7d58338e | 1943 | (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" |
38f8646b CD |
1944 | "The default column format, if no other format has been defined. |
1945 | This variable can be set on the per-file basis by inserting a line | |
1946 | ||
1947 | #+COLUMNS: %25ITEM ....." | |
1948 | :group 'org-properties | |
1949 | :type 'string) | |
1950 | ||
48aaad2d CD |
1951 | (defcustom org-global-properties nil |
1952 | "List of property/value pairs that can be inherited by any entry. | |
1953 | You can set buffer-local values for this by adding lines like | |
1954 | ||
1955 | #+PROPERTY: NAME VALUE" | |
1956 | :group 'org-properties | |
1957 | :type '(repeat | |
1958 | (cons (string :tag "Property") | |
1959 | (string :tag "Value")))) | |
1960 | ||
1961 | (defvar org-local-properties nil | |
1962 | "List of property/value pairs that can be inherited by any entry. | |
1963 | Valid for the current buffer. | |
1964 | This variable is populated from #+PROPERTY lines.") | |
38f8646b | 1965 | |
ab27a4a0 | 1966 | (defgroup org-agenda nil |
d3f4dbe8 | 1967 | "Options concerning agenda views in Org-mode." |
ab27a4a0 CD |
1968 | :tag "Org Agenda" |
1969 | :group 'org) | |
1970 | ||
1971 | (defvar org-category nil | |
1972 | "Variable used by org files to set a category for agenda display. | |
1973 | Such files should use a file variable to set it, for example | |
1974 | ||
a3fbe8c4 | 1975 | # -*- mode: org; org-category: \"ELisp\" |
ab27a4a0 CD |
1976 | |
1977 | or contain a special line | |
1978 | ||
1979 | #+CATEGORY: ELisp | |
1980 | ||
1981 | If the file does not specify a category, then file's base name | |
1982 | is used instead.") | |
1983 | (make-variable-buffer-local 'org-category) | |
1984 | ||
1985 | (defcustom org-agenda-files nil | |
1986 | "The files to be used for agenda display. | |
1987 | Entries may be added to this list with \\[org-agenda-file-to-front] and removed with | |
1988 | \\[org-remove-file]. You can also use customize to edit the list. | |
1989 | ||
03f3cf35 JW |
1990 | If an entry is a directory, all files in that directory that are matched by |
1991 | `org-agenda-file-regexp' will be part of the file list. | |
1992 | ||
ab27a4a0 CD |
1993 | If the value of the variable is not a list but a single file name, then |
1994 | the list of agenda files is actually stored and maintained in that file, one | |
1995 | agenda file per line." | |
1996 | :group 'org-agenda | |
891f4676 | 1997 | :type '(choice |
03f3cf35 | 1998 | (repeat :tag "List of files and directories" file) |
ab27a4a0 | 1999 | (file :tag "Store list in a file\n" :value "~/.agenda_files"))) |
891f4676 | 2000 | |
03f3cf35 JW |
2001 | (defcustom org-agenda-file-regexp "\\.org\\'" |
2002 | "Regular expression to match files for `org-agenda-files'. | |
fbe6c10d | 2003 | If any element in the list in that variable contains a directory instead |
03f3cf35 JW |
2004 | of a normal file, all files in that directory that are matched by this |
2005 | regular expression will be included." | |
2006 | :group 'org-agenda | |
2007 | :type 'regexp) | |
2008 | ||
374585c9 CD |
2009 | (defcustom org-agenda-skip-unavailable-files nil |
2010 | "t means to just skip non-reachable files in `org-agenda-files'. | |
2011 | Nil means to remove them, after a query, from the list." | |
2012 | :group 'org-agenda | |
2013 | :type 'boolean) | |
d3f4dbe8 | 2014 | |
03f3cf35 JW |
2015 | (defcustom org-agenda-multi-occur-extra-files nil |
2016 | "List of extra files to be searched by `org-occur-in-agenda-files'. | |
2017 | The files in `org-agenda-files' are always searched." | |
2018 | :group 'org-agenda | |
2019 | :type '(repeat file)) | |
2020 | ||
d3f4dbe8 CD |
2021 | (defcustom org-agenda-confirm-kill 1 |
2022 | "When set, remote killing from the agenda buffer needs confirmation. | |
2023 | When t, a confirmation is always needed. When a number N, confirmation is | |
2024 | only needed when the text to be killed contains more than N non-white lines." | |
2025 | :group 'org-agenda | |
2026 | :type '(choice | |
2027 | (const :tag "Never" nil) | |
2028 | (const :tag "Always" t) | |
2029 | (number :tag "When more than N lines"))) | |
2030 | ||
2031 | (defcustom org-calendar-to-agenda-key [?c] | |
2032 | "The key to be installed in `calendar-mode-map' for switching to the agenda. | |
2033 | The command `org-calendar-goto-agenda' will be bound to this key. The | |
2034 | default is the character `c' because then `c' can be used to switch back and | |
2035 | forth between agenda and calendar." | |
2036 | :group 'org-agenda | |
2037 | :type 'sexp) | |
2038 | ||
15841868 JW |
2039 | (defcustom org-agenda-compact-blocks nil |
2040 | "Non-nil means, make the block agenda more compact. | |
2041 | This is done by leaving out unnecessary lines." | |
2042 | :group 'org-agenda | |
2043 | :type nil) | |
2044 | ||
a3fbe8c4 CD |
2045 | (defgroup org-agenda-export nil |
2046 | "Options concerning exporting agenda views in Org-mode." | |
2047 | :tag "Org Agenda Export" | |
2048 | :group 'org-agenda) | |
2049 | ||
2050 | (defcustom org-agenda-with-colors t | |
2051 | "Non-nil means, use colors in agenda views." | |
2052 | :group 'org-agenda-export | |
2053 | :type 'boolean) | |
2054 | ||
2055 | (defcustom org-agenda-exporter-settings nil | |
2056 | "Alist of variable/value pairs that should be active during agenda export. | |
2057 | This is a good place to set uptions for ps-print and for htmlize." | |
2058 | :group 'org-agenda-export | |
2059 | :type '(repeat | |
2060 | (list | |
2061 | (variable) | |
2062 | (sexp :tag "Value")))) | |
2063 | ||
2064 | (defcustom org-agenda-export-html-style "" | |
2065 | "The style specification for exported HTML Agenda files. | |
2066 | If this variable contains a string, it will replace the default <style> | |
2067 | section as produced by `htmlize'. | |
2068 | Since there are different ways of setting style information, this variable | |
2069 | needs to contain the full HTML structure to provide a style, including the | |
2070 | surrounding HTML tags. The style specifications should include definitions | |
2071 | the fonts used by the agenda, here is an example: | |
2072 | ||
2073 | <style type=\"text/css\"> | |
2074 | p { font-weight: normal; color: gray; } | |
2075 | .org-agenda-structure { | |
2076 | font-size: 110%; | |
2077 | color: #003399; | |
2078 | font-weight: 600; | |
2079 | } | |
2080 | .org-todo { | |
2081 | color: #cc6666;Week-agenda: | |
2082 | font-weight: bold; | |
2083 | } | |
2084 | .org-done { | |
2085 | color: #339933; | |
2086 | } | |
2087 | .title { text-align: center; } | |
2088 | .todo, .deadline { color: red; } | |
2089 | .done { color: green; } | |
2090 | </style> | |
2091 | ||
2092 | or, if you want to keep the style in a file, | |
2093 | ||
2094 | <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> | |
2095 | ||
2096 | As the value of this option simply gets inserted into the HTML <head> header, | |
2097 | you can \"misuse\" it to also add other text to the header. However, | |
2098 | <style>...</style> is required, if not present the variable will be ignored." | |
2099 | :group 'org-agenda-export | |
2100 | :group 'org-export-html | |
2101 | :type 'string) | |
2102 | ||
d3f4dbe8 CD |
2103 | (defgroup org-agenda-custom-commands nil |
2104 | "Options concerning agenda views in Org-mode." | |
2105 | :tag "Org Agenda Custom Commands" | |
2106 | :group 'org-agenda) | |
2107 | ||
a3fbe8c4 | 2108 | (defcustom org-agenda-custom-commands nil |
ab27a4a0 CD |
2109 | "Custom commands for the agenda. |
2110 | These commands will be offered on the splash screen displayed by the | |
3278a016 CD |
2111 | agenda dispatcher \\[org-agenda]. Each entry is a list like this: |
2112 | ||
03f3cf35 | 2113 | (key desc type match options files) |
3278a016 | 2114 | |
03f3cf35 JW |
2115 | key The key (one or more characters as a string) to be associated |
2116 | with the command. | |
2117 | desc A description of the commend, when omitted or nil, a default | |
2118 | description is built using MATCH. | |
3278a016 CD |
2119 | type The command type, any of the following symbols: |
2120 | todo Entries with a specific TODO keyword, in all agenda files. | |
2121 | tags Tags match in all agenda files. | |
2122 | tags-todo Tags match in all agenda files, TODO entries only. | |
2123 | todo-tree Sparse tree of specific TODO keyword in *current* file. | |
2124 | tags-tree Sparse tree with all tags matches in *current* file. | |
2125 | occur-tree Occur sparse tree for *current* file. | |
03f3cf35 | 2126 | ... A user-defined function. |
3278a016 CD |
2127 | match What to search for: |
2128 | - a single keyword for TODO keyword searches | |
2129 | - a tags match expression for tags searches | |
2130 | - a regular expression for occur searches | |
48aaad2d | 2131 | options A list of option settings, similar to that in a let form, so like |
3278a016 | 2132 | this: ((opt1 val1) (opt2 val2) ...) |
a3fbe8c4 CD |
2133 | files A list of files file to write the produced agenda buffer to |
2134 | with the command `org-store-agenda-views'. | |
2135 | If a file name ends in \".html\", an HTML version of the buffer | |
2136 | is written out. If it ends in \".ps\", a postscript version is | |
2137 | produced. Otherwide, only the plain text is written to the file. | |
3278a016 CD |
2138 | |
2139 | You can also define a set of commands, to create a composite agenda buffer. | |
2140 | In this case, an entry looks like this: | |
2141 | ||
a3fbe8c4 | 2142 | (key desc (cmd1 cmd2 ...) general-options file) |
3278a016 CD |
2143 | |
2144 | where | |
2145 | ||
2146 | desc A description string to be displayed in the dispatcher menu. | |
2147 | cmd An agenda command, similar to the above. However, tree commands | |
2148 | are no allowed, but instead you can get agenda and global todo list. | |
2149 | So valid commands for a set are: | |
2150 | (agenda) | |
2151 | (alltodo) | |
d3f4dbe8 | 2152 | (stuck) |
a3fbe8c4 CD |
2153 | (todo \"match\" options files) |
2154 | (tags \"match\" options files) | |
2155 | (tags-todo \"match\" options files) | |
3278a016 CD |
2156 | |
2157 | Each command can carry a list of options, and another set of options can be | |
2158 | given for the whole set of commands. Individual command options take | |
03f3cf35 JW |
2159 | precedence over the general options. |
2160 | ||
2161 | When using several characters as key to a command, the first characters | |
2162 | are prefix commands. For the dispatcher to display useful information, you | |
2163 | should provide a description for the prefix, like | |
2164 | ||
2165 | (setq org-agenda-custom-commands | |
2166 | '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" | |
2167 | (\"hl\" tags \"+HOME+Lisa\") | |
2168 | (\"hp\" tags \"+HOME+Peter\") | |
2169 | (\"hk\" tags \"+HOME+Kim\")))" | |
d3f4dbe8 | 2170 | :group 'org-agenda-custom-commands |
ab27a4a0 | 2171 | :type '(repeat |
03f3cf35 | 2172 | (choice :value ("a" "" tags "" nil) |
3278a016 | 2173 | (list :tag "Single command" |
03f3cf35 JW |
2174 | (string :tag "Access Key(s) ") |
2175 | (option (string :tag "Description")) | |
3278a016 | 2176 | (choice |
a3fbe8c4 CD |
2177 | (const :tag "Agenda" agenda) |
2178 | (const :tag "TODO list" alltodo) | |
2179 | (const :tag "Stuck projects" stuck) | |
3278a016 CD |
2180 | (const :tag "Tags search (all agenda files)" tags) |
2181 | (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) | |
2182 | (const :tag "TODO keyword search (all agenda files)" todo) | |
2183 | (const :tag "Tags sparse tree (current buffer)" tags-tree) | |
2184 | (const :tag "TODO keyword tree (current buffer)" todo-tree) | |
d3f4dbe8 | 2185 | (const :tag "Occur tree (current buffer)" occur-tree) |
03f3cf35 | 2186 | (sexp :tag "Other, user-defined function")) |
3278a016 CD |
2187 | (string :tag "Match") |
2188 | (repeat :tag "Local options" | |
a3fbe8c4 CD |
2189 | (list (variable :tag "Option") (sexp :tag "Value"))) |
2190 | (option (repeat :tag "Export" (file :tag "Export to")))) | |
3278a016 | 2191 | (list :tag "Command series, all agenda files" |
03f3cf35 JW |
2192 | (string :tag "Access Key(s)") |
2193 | (string :tag "Description ") | |
3278a016 CD |
2194 | (repeat |
2195 | (choice | |
2196 | (const :tag "Agenda" (agenda)) | |
2197 | (const :tag "TODO list" (alltodo)) | |
d3f4dbe8 | 2198 | (const :tag "Stuck projects" (stuck)) |
3278a016 CD |
2199 | (list :tag "Tags search" |
2200 | (const :format "" tags) | |
2201 | (string :tag "Match") | |
2202 | (repeat :tag "Local options" | |
2203 | (list (variable :tag "Option") | |
2204 | (sexp :tag "Value")))) | |
2205 | ||
2206 | (list :tag "Tags search, TODO entries only" | |
2207 | (const :format "" tags-todo) | |
2208 | (string :tag "Match") | |
2209 | (repeat :tag "Local options" | |
2210 | (list (variable :tag "Option") | |
2211 | (sexp :tag "Value")))) | |
2212 | ||
2213 | (list :tag "TODO keyword search" | |
2214 | (const :format "" todo) | |
2215 | (string :tag "Match") | |
d3f4dbe8 CD |
2216 | (repeat :tag "Local options" |
2217 | (list (variable :tag "Option") | |
2218 | (sexp :tag "Value")))) | |
2219 | ||
2220 | (list :tag "Other, user-defined function" | |
2221 | (symbol :tag "function") | |
2222 | (string :tag "Match") | |
3278a016 CD |
2223 | (repeat :tag "Local options" |
2224 | (list (variable :tag "Option") | |
2225 | (sexp :tag "Value")))))) | |
d3f4dbe8 | 2226 | |
3278a016 CD |
2227 | (repeat :tag "General options" |
2228 | (list (variable :tag "Option") | |
a3fbe8c4 | 2229 | (sexp :tag "Value"))) |
03f3cf35 JW |
2230 | (option (repeat :tag "Export" (file :tag "Export to")))) |
2231 | (cons :tag "Prefix key documentation" | |
2232 | (string :tag "Access Key(s)") | |
2233 | (string :tag "Description "))))) | |
ab27a4a0 | 2234 | |
d3f4dbe8 | 2235 | (defcustom org-stuck-projects |
a3fbe8c4 | 2236 | '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") |
d3f4dbe8 | 2237 | "How to identify stuck projects. |
a3fbe8c4 | 2238 | This is a list of four items: |
d3f4dbe8 | 2239 | 1. A tags/todo matcher string that is used to identify a project. |
a3fbe8c4 CD |
2240 | The entire tree below a headline matched by this is considered one project. |
2241 | 2. A list of TODO keywords identifying non-stuck projects. | |
d3f4dbe8 | 2242 | If the project subtree contains any headline with one of these todo |
a3fbe8c4 CD |
2243 | keywords, the project is considered to be not stuck. If you specify |
2244 | \"*\" as a keyword, any TODO keyword will mark the project unstuck. | |
d3f4dbe8 CD |
2245 | 3. A list of tags identifying non-stuck projects. |
2246 | If the project subtree contains any headline with one of these tags, | |
a3fbe8c4 CD |
2247 | the project is considered to be not stuck. If you specify \"*\" as |
2248 | a tag, any tag will mark the project unstuck. | |
2249 | 4. An arbitrary regular expression matching non-stuck projects. | |
d3f4dbe8 CD |
2250 | |
2251 | After defining this variable, you may use \\[org-agenda-list-stuck-projects] | |
2252 | or `C-c a #' to produce the list." | |
2253 | :group 'org-agenda-custom-commands | |
2254 | :type '(list | |
2255 | (string :tag "Tags/TODO match to identify a project") | |
2256 | (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) | |
a3fbe8c4 CD |
2257 | (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) |
2258 | (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree"))) | |
d3f4dbe8 CD |
2259 | |
2260 | ||
2261 | (defgroup org-agenda-skip nil | |
2262 | "Options concerning skipping parts of agenda files." | |
2263 | :tag "Org Agenda Skip" | |
2264 | :group 'org-agenda) | |
2265 | ||
4b3a9ba7 CD |
2266 | (defcustom org-agenda-todo-list-sublevels t |
2267 | "Non-nil means, check also the sublevels of a TODO entry for TODO entries. | |
2268 | When nil, the sublevels of a TODO entry are not checked, resulting in | |
2269 | potentially much shorter TODO lists." | |
d3f4dbe8 | 2270 | :group 'org-agenda-skip |
4b3a9ba7 CD |
2271 | :group 'org-todo |
2272 | :type 'boolean) | |
2273 | ||
03f3cf35 JW |
2274 | (defcustom org-agenda-todo-ignore-with-date nil |
2275 | "Non-nil means, don't show entries with a date in the global todo list. | |
2276 | You can use this if you prefer to mark mere appointments with a TODO keyword, | |
2277 | but don't want them to show up in the TODO list. | |
2278 | When this is set, it also covers deadlines and scheduled items, the settings | |
2279 | of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' | |
2280 | will be ignored." | |
2281 | :group 'org-agenda-skip | |
2282 | :group 'org-todo | |
2283 | :type 'boolean) | |
2284 | ||
4b3a9ba7 CD |
2285 | (defcustom org-agenda-todo-ignore-scheduled nil |
2286 | "Non-nil means, don't show scheduled entries in the global todo list. | |
2287 | The idea behind this is that by scheduling it, you have already taken care | |
03f3cf35 JW |
2288 | of this item. |
2289 | See also `org-agenda-todo-ignore-with-date'." | |
d3f4dbe8 | 2290 | :group 'org-agenda-skip |
4b3a9ba7 CD |
2291 | :group 'org-todo |
2292 | :type 'boolean) | |
2293 | ||
3278a016 CD |
2294 | (defcustom org-agenda-todo-ignore-deadlines nil |
2295 | "Non-nil means, don't show near deadline entries in the global todo list. | |
2296 | Near means closer than `org-deadline-warning-days' days. | |
03f3cf35 JW |
2297 | The idea behind this is that such items will appear in the agenda anyway. |
2298 | See also `org-agenda-todo-ignore-with-date'." | |
d3f4dbe8 | 2299 | :group 'org-agenda-skip |
3278a016 CD |
2300 | :group 'org-todo |
2301 | :type 'boolean) | |
2302 | ||
d3f4dbe8 CD |
2303 | (defcustom org-agenda-skip-scheduled-if-done nil |
2304 | "Non-nil means don't show scheduled items in agenda when they are done. | |
374585c9 | 2305 | This is relevant for the daily/weekly agenda, not for the TODO list. And |
15841868 | 2306 | it applies only to the actual date of the scheduling. Warnings about |
374585c9 CD |
2307 | an item with a past scheduling dates are always turned off when the item |
2308 | is DONE." | |
d3f4dbe8 CD |
2309 | :group 'org-agenda-skip |
2310 | :type 'boolean) | |
3278a016 | 2311 | |
a3fbe8c4 CD |
2312 | (defcustom org-agenda-skip-deadline-if-done nil |
2313 | "Non-nil means don't show deadines when the corresponding item is done. | |
2314 | When nil, the deadline is still shown and should give you a happy feeling. | |
374585c9 CD |
2315 | This is relevant for the daily/weekly agenda. And it applied only to the |
2316 | actualy date of the deadline. Warnings about approching and past-due | |
2317 | deadlines are always turned off when the item is DONE." | |
a3fbe8c4 CD |
2318 | :group 'org-agenda-skip |
2319 | :type 'boolean) | |
2320 | ||
3278a016 CD |
2321 | (defcustom org-timeline-show-empty-dates 3 |
2322 | "Non-nil means, `org-timeline' also shows dates without an entry. | |
2323 | When nil, only the days which actually have entries are shown. | |
2324 | When t, all days between the first and the last date are shown. | |
2325 | When an integer, show also empty dates, but if there is a gap of more than | |
2326 | N days, just insert a special line indicating the size of the gap." | |
d3f4dbe8 | 2327 | :group 'org-agenda-skip |
3278a016 CD |
2328 | :type '(choice |
2329 | (const :tag "None" nil) | |
2330 | (const :tag "All" t) | |
2331 | (number :tag "at most"))) | |
2332 | ||
500f86e0 | 2333 | |
d3f4dbe8 CD |
2334 | (defgroup org-agenda-startup nil |
2335 | "Options concerning initial settings in the Agenda in Org Mode." | |
2336 | :tag "Org Agenda Startup" | |
2337 | :group 'org-agenda) | |
891f4676 | 2338 | |
d3f4dbe8 CD |
2339 | (defcustom org-finalize-agenda-hook nil |
2340 | "Hook run just before displaying an agenda buffer." | |
2341 | :group 'org-agenda-startup | |
2342 | :type 'hook) | |
2343 | ||
2344 | (defcustom org-agenda-mouse-1-follows-link nil | |
2345 | "Non-nil means, mouse-1 on a link will follow the link in the agenda. | |
2346 | A longer mouse click will still set point. Does not wortk on XEmacs. | |
2347 | Needs to be set before org.el is loaded." | |
2348 | :group 'org-agenda-startup | |
c4f9780e CD |
2349 | :type 'boolean) |
2350 | ||
d3f4dbe8 | 2351 | (defcustom org-agenda-start-with-follow-mode nil |
a3fbe8c4 | 2352 | "The initial value of follow-mode in a newly created agenda window." |
d3f4dbe8 CD |
2353 | :group 'org-agenda-startup |
2354 | :type 'boolean) | |
9acdaa21 | 2355 | |
d3f4dbe8 CD |
2356 | (defgroup org-agenda-windows nil |
2357 | "Options concerning the windows used by the Agenda in Org Mode." | |
2358 | :tag "Org Agenda Windows" | |
ab27a4a0 CD |
2359 | :group 'org-agenda) |
2360 | ||
3278a016 CD |
2361 | (defcustom org-agenda-window-setup 'reorganize-frame |
2362 | "How the agenda buffer should be displayed. | |
2363 | Possible values for this option are: | |
2364 | ||
2365 | current-window Show agenda in the current window, keeping all other windows. | |
2366 | other-frame Use `switch-to-buffer-other-frame' to display agenda. | |
2367 | other-window Use `switch-to-buffer-other-window' to display agenda. | |
2368 | reorganize-frame Show only two windows on the current frame, the current | |
d3f4dbe8 | 2369 | window and the agenda. |
3278a016 | 2370 | See also the variable `org-agenda-restore-windows-after-quit'." |
d3f4dbe8 | 2371 | :group 'org-agenda-windows |
3278a016 CD |
2372 | :type '(choice |
2373 | (const current-window) | |
2374 | (const other-frame) | |
2375 | (const other-window) | |
2376 | (const reorganize-frame))) | |
2377 | ||
03f3cf35 JW |
2378 | (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) |
2379 | "The min and max height of the agenda window as a fraction of frame height. | |
2380 | The value of the variable is a cons cell with two numbers between 0 and 1. | |
2381 | It only matters if `org-agenda-window-setup' is `reorganize-frame'." | |
2382 | :group 'org-agenda-windows | |
2383 | :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) | |
2384 | ||
3278a016 CD |
2385 | (defcustom org-agenda-restore-windows-after-quit nil |
2386 | "Non-nil means, restore window configuration open exiting agenda. | |
2387 | Before the window configuration is changed for displaying the agenda, | |
2388 | the current status is recorded. When the agenda is exited with | |
2389 | `q' or `x' and this option is set, the old state is restored. If | |
2390 | `org-agenda-window-setup' is `other-frame', the value of this | |
2391 | option will be ignored.." | |
d3f4dbe8 | 2392 | :group 'org-agenda-windows |
ab27a4a0 | 2393 | :type 'boolean) |
9acdaa21 | 2394 | |
d3f4dbe8 CD |
2395 | (defcustom org-indirect-buffer-display 'other-window |
2396 | "How should indirect tree buffers be displayed? | |
2397 | This applies to indirect buffers created with the commands | |
2398 | \\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. | |
2399 | Valid values are: | |
2400 | current-window Display in the current window | |
2401 | other-window Just display in another window. | |
2402 | dedicated-frame Create one new frame, and re-use it each time. | |
2403 | new-frame Make a new frame each time." | |
2404 | :group 'org-structure | |
2405 | :group 'org-agenda-windows | |
2406 | :type '(choice | |
2407 | (const :tag "In current window" current-window) | |
2408 | (const :tag "In current frame, other window" other-window) | |
2409 | (const :tag "Each time a new frame" new-frame) | |
2410 | (const :tag "One dedicated frame" dedicated-frame))) | |
2411 | ||
2412 | (defgroup org-agenda-daily/weekly nil | |
2413 | "Options concerning the daily/weekly agenda." | |
2414 | :tag "Org Agenda Daily/Weekly" | |
2415 | :group 'org-agenda) | |
3278a016 | 2416 | |
d3f4dbe8 CD |
2417 | (defcustom org-agenda-ndays 7 |
2418 | "Number of days to include in overview display. | |
2419 | Should be 1 or 7." | |
2420 | :group 'org-agenda-daily/weekly | |
2421 | :type 'number) | |
9acdaa21 | 2422 | |
ab27a4a0 CD |
2423 | (defcustom org-agenda-start-on-weekday 1 |
2424 | "Non-nil means, start the overview always on the specified weekday. | |
2425 | 0 denotes Sunday, 1 denotes Monday etc. | |
2426 | When nil, always start on the current day." | |
d3f4dbe8 | 2427 | :group 'org-agenda-daily/weekly |
ab27a4a0 CD |
2428 | :type '(choice (const :tag "Today" nil) |
2429 | (number :tag "Weekday No."))) | |
9acdaa21 | 2430 | |
d3f4dbe8 CD |
2431 | (defcustom org-agenda-show-all-dates t |
2432 | "Non-nil means, `org-agenda' shows every day in the selected range. | |
2433 | When nil, only the days which actually have entries are shown." | |
2434 | :group 'org-agenda-daily/weekly | |
2435 | :type 'boolean) | |
2436 | ||
d5098885 | 2437 | (defcustom org-agenda-format-date 'org-agenda-format-date-aligned |
d3f4dbe8 CD |
2438 | "Format string for displaying dates in the agenda. |
2439 | Used by the daily/weekly agenda and by the timeline. This should be | |
d5098885 JW |
2440 | a format string understood by `format-time-string', or a function returning |
2441 | the formatted date as a string. The function must take a single argument, | |
2442 | a calendar-style date list like (month day year)." | |
d3f4dbe8 | 2443 | :group 'org-agenda-daily/weekly |
d5098885 JW |
2444 | :type '(choice |
2445 | (string :tag "Format string") | |
2446 | (function :tag "Function"))) | |
2447 | ||
2448 | (defun org-agenda-format-date-aligned (date) | |
2449 | "Format a date string for display in the daily/weekly agenda, or timeline. | |
2450 | This function makes sure that dates are aligned for easy reading." | |
2451 | (format "%-9s %2d %s %4d" | |
2452 | (calendar-day-name date) | |
2453 | (extract-calendar-day date) | |
2454 | (calendar-month-name (extract-calendar-month date)) | |
2455 | (extract-calendar-year date))) | |
a3fbe8c4 | 2456 | |
d3f4dbe8 CD |
2457 | (defcustom org-agenda-include-diary nil |
2458 | "If non-nil, include in the agenda entries from the Emacs Calendar's diary." | |
2459 | :group 'org-agenda-daily/weekly | |
2460 | :type 'boolean) | |
2461 | ||
2462 | (defcustom org-agenda-include-all-todo nil | |
2463 | "Set means weekly/daily agenda will always contain all TODO entries. | |
2464 | The TODO entries will be listed at the top of the agenda, before | |
2465 | the entries for specific days." | |
2466 | :group 'org-agenda-daily/weekly | |
2467 | :type 'boolean) | |
2468 | ||
48aaad2d CD |
2469 | (defcustom org-agenda-repeating-timestamp-show-all t |
2470 | "Non-nil means, show all occurences of a repeating stamp in the agenda. | |
2471 | When nil, only one occurence is shown, either today or the | |
2472 | nearest into the future." | |
2473 | :group 'org-agenda-daily/weekly | |
2474 | :type 'boolean) | |
2475 | ||
03f3cf35 JW |
2476 | (defcustom org-deadline-warning-days 14 |
2477 | "No. of days before expiration during which a deadline becomes active. | |
2478 | This variable governs the display in sparse trees and in the agenda. | |
2479 | When negative, it means use this number (the absolute value of it) | |
2480 | even if a deadline has a different individual lead time specified." | |
2481 | :group 'org-time | |
2482 | :group 'org-agenda-daily/weekly | |
2483 | :type 'number) | |
2484 | ||
2485 | (defcustom org-scheduled-past-days 10000 | |
2486 | "No. of days to continue listing scheduled items that are not marked DONE. | |
2487 | When an item is scheduled on a date, it shows up in the agenda on this | |
2488 | day and will be listed until it is marked done for the number of days | |
2489 | given here." | |
2490 | :group 'org-agenda-daily/weekly | |
2491 | :type 'number) | |
2492 | ||
d3f4dbe8 CD |
2493 | (defgroup org-agenda-time-grid nil |
2494 | "Options concerning the time grid in the Org-mode Agenda." | |
2495 | :tag "Org Agenda Time Grid" | |
2496 | :group 'org-agenda) | |
9acdaa21 | 2497 | |
ab27a4a0 CD |
2498 | (defcustom org-agenda-use-time-grid t |
2499 | "Non-nil means, show a time grid in the agenda schedule. | |
2500 | A time grid is a set of lines for specific times (like every two hours between | |
2501 | 8:00 and 20:00). The items scheduled for a day at specific times are | |
2502 | sorted in between these lines. | |
2503 | For details about when the grid will be shown, and what it will look like, see | |
2504 | the variable `org-agenda-time-grid'." | |
d3f4dbe8 | 2505 | :group 'org-agenda-time-grid |
ab27a4a0 CD |
2506 | :type 'boolean) |
2507 | ||
2508 | (defcustom org-agenda-time-grid | |
2509 | '((daily today require-timed) | |
2510 | "----------------" | |
2511 | (800 1000 1200 1400 1600 1800 2000)) | |
2512 | ||
2513 | "The settings for time grid for agenda display. | |
2514 | This is a list of three items. The first item is again a list. It contains | |
2515 | symbols specifying conditions when the grid should be displayed: | |
2516 | ||
2517 | daily if the agenda shows a single day | |
2518 | weekly if the agenda shows an entire week | |
2519 | today show grid on current date, independent of daily/weekly display | |
3278a016 | 2520 | require-timed show grid only if at least one item has a time specification |
ab27a4a0 CD |
2521 | |
2522 | The second item is a string which will be places behing the grid time. | |
2523 | ||
2524 | The third item is a list of integers, indicating the times that should have | |
2525 | a grid line." | |
d3f4dbe8 | 2526 | :group 'org-agenda-time-grid |
ab27a4a0 CD |
2527 | :type |
2528 | '(list | |
2529 | (set :greedy t :tag "Grid Display Options" | |
2530 | (const :tag "Show grid in single day agenda display" daily) | |
2531 | (const :tag "Show grid in weekly agenda display" weekly) | |
2532 | (const :tag "Always show grid for today" today) | |
2533 | (const :tag "Show grid only if any timed entries are present" | |
2534 | require-timed) | |
2535 | (const :tag "Skip grid times already present in an entry" | |
2536 | remove-match)) | |
2537 | (string :tag "Grid String") | |
2538 | (repeat :tag "Grid Times" (integer :tag "Time")))) | |
2539 | ||
d3f4dbe8 CD |
2540 | (defgroup org-agenda-sorting nil |
2541 | "Options concerning sorting in the Org-mode Agenda." | |
2542 | :tag "Org Agenda Sorting" | |
2543 | :group 'org-agenda) | |
2544 | ||
3278a016 CD |
2545 | (let ((sorting-choice |
2546 | '(choice | |
2547 | (const time-up) (const time-down) | |
2548 | (const category-keep) (const category-up) (const category-down) | |
2549 | (const tag-down) (const tag-up) | |
2550 | (const priority-up) (const priority-down)))) | |
2551 | ||
2552 | (defcustom org-agenda-sorting-strategy | |
2553 | '((agenda time-up category-keep priority-down) | |
2554 | (todo category-keep priority-down) | |
a3fbe8c4 | 2555 | (tags category-keep priority-down)) |
3278a016 | 2556 | "Sorting structure for the agenda items of a single day. |
ab27a4a0 CD |
2557 | This is a list of symbols which will be used in sequence to determine |
2558 | if an entry should be listed before another entry. The following | |
2559 | symbols are recognized: | |
2560 | ||
2561 | time-up Put entries with time-of-day indications first, early first | |
2562 | time-down Put entries with time-of-day indications first, late first | |
2563 | category-keep Keep the default order of categories, corresponding to the | |
2564 | sequence in `org-agenda-files'. | |
2565 | category-up Sort alphabetically by category, A-Z. | |
2566 | category-down Sort alphabetically by category, Z-A. | |
3278a016 CD |
2567 | tag-up Sort alphabetically by last tag, A-Z. |
2568 | tag-down Sort alphabetically by last tag, Z-A. | |
ab27a4a0 CD |
2569 | priority-up Sort numerically by priority, high priority last. |
2570 | priority-down Sort numerically by priority, high priority first. | |
2571 | ||
2572 | The different possibilities will be tried in sequence, and testing stops | |
2573 | if one comparison returns a \"not-equal\". For example, the default | |
2574 | '(time-up category-keep priority-down) | |
2575 | means: Pull out all entries having a specified time of day and sort them, | |
2576 | in order to make a time schedule for the current day the first thing in the | |
2577 | agenda listing for the day. Of the entries without a time indication, keep | |
2578 | the grouped in categories, don't sort the categories, but keep them in | |
2579 | the sequence given in `org-agenda-files'. Within each category sort by | |
2580 | priority. | |
2581 | ||
2582 | Leaving out `category-keep' would mean that items will be sorted across | |
2583 | categories by priority." | |
d3f4dbe8 | 2584 | :group 'org-agenda-sorting |
3278a016 CD |
2585 | :type `(choice |
2586 | (repeat :tag "General" ,sorting-choice) | |
2587 | (list :tag "Individually" | |
2588 | (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) | |
2589 | (repeat ,sorting-choice)) | |
2590 | (cons (const :tag "Strategy for TODO lists" todo) | |
2591 | (repeat ,sorting-choice)) | |
2592 | (cons (const :tag "Strategy for Tags matches" tags) | |
2593 | (repeat ,sorting-choice)))))) | |
9acdaa21 | 2594 | |
ab27a4a0 CD |
2595 | (defcustom org-sort-agenda-notime-is-late t |
2596 | "Non-nil means, items without time are considered late. | |
2597 | This is only relevant for sorting. When t, items which have no explicit | |
7d143c25 | 2598 | time like 15:30 will be considered as 99:01, i.e. later than any items which |
ab27a4a0 CD |
2599 | do have a time. When nil, the default time is before 0:00. You can use this |
2600 | option to decide if the schedule for today should come before or after timeless | |
2601 | agenda entries." | |
d3f4dbe8 | 2602 | :group 'org-agenda-sorting |
ef943dba CD |
2603 | :type 'boolean) |
2604 | ||
15841868 | 2605 | (defgroup org-agenda-line-format nil |
ab27a4a0 | 2606 | "Options concerning the entry prefix in the Org-mode agenda display." |
15841868 | 2607 | :tag "Org Agenda Line Format" |
ab27a4a0 CD |
2608 | :group 'org-agenda) |
2609 | ||
3278a016 CD |
2610 | (defcustom org-agenda-prefix-format |
2611 | '((agenda . " %-12:c%?-12t% s") | |
2612 | (timeline . " % s") | |
2613 | (todo . " %-12:c") | |
2614 | (tags . " %-12:c")) | |
2615 | "Format specifications for the prefix of items in the agenda views. | |
2616 | An alist with four entries, for the different agenda types. The keys to the | |
2617 | sublists are `agenda', `timeline', `todo', and `tags'. The values | |
2618 | are format strings. | |
ab27a4a0 CD |
2619 | This format works similar to a printf format, with the following meaning: |
2620 | ||
2621 | %c the category of the item, \"Diary\" for entries from the diary, or | |
2622 | as given by the CATEGORY keyword or derived from the file name. | |
3278a016 CD |
2623 | %T the *last* tag of the item. Last because inherited tags come |
2624 | first in the list. | |
ab27a4a0 CD |
2625 | %t the time-of-day specification if one applies to the entry, in the |
2626 | format HH:MM | |
2627 | %s Scheduling/Deadline information, a short string | |
2628 | ||
2629 | All specifiers work basically like the standard `%s' of printf, but may | |
2630 | contain two additional characters: A question mark just after the `%' and | |
2631 | a whitespace/punctuation character just before the final letter. | |
2632 | ||
2633 | If the first character after `%' is a question mark, the entire field | |
2634 | will only be included if the corresponding value applies to the | |
2635 | current entry. This is useful for fields which should have fixed | |
2636 | width when present, but zero width when absent. For example, | |
2637 | \"%?-12t\" will result in a 12 character time field if a time of the | |
2638 | day is specified, but will completely disappear in entries which do | |
2639 | not contain a time. | |
2640 | ||
2641 | If there is punctuation or whitespace character just before the final | |
2642 | format letter, this character will be appended to the field value if | |
2643 | the value is not empty. For example, the format \"%-12:c\" leads to | |
2644 | \"Diary: \" if the category is \"Diary\". If the category were be | |
2645 | empty, no additional colon would be interted. | |
2646 | ||
2647 | The default value of this option is \" %-12:c%?-12t% s\", meaning: | |
2648 | - Indent the line with two space characters | |
2649 | - Give the category in a 12 chars wide field, padded with whitespace on | |
2650 | the right (because of `-'). Append a colon if there is a category | |
2651 | (because of `:'). | |
2652 | - If there is a time-of-day, put it into a 12 chars wide field. If no | |
2653 | time, don't put in an empty field, just skip it (because of '?'). | |
2654 | - Finally, put the scheduling information and append a whitespace. | |
2655 | ||
2656 | As another example, if you don't want the time-of-day of entries in | |
2657 | the prefix, you could use: | |
2658 | ||
2659 | (setq org-agenda-prefix-format \" %-11:c% s\") | |
2660 | ||
2661 | See also the variables `org-agenda-remove-times-when-in-prefix' and | |
a3fbe8c4 | 2662 | `org-agenda-remove-tags'." |
3278a016 CD |
2663 | :type '(choice |
2664 | (string :tag "General format") | |
2665 | (list :greedy t :tag "View dependent" | |
2666 | (cons (const agenda) (string :tag "Format")) | |
2667 | (cons (const timeline) (string :tag "Format")) | |
2668 | (cons (const todo) (string :tag "Format")) | |
2669 | (cons (const tags) (string :tag "Format")))) | |
15841868 | 2670 | :group 'org-agenda-line-format) |
ab27a4a0 | 2671 | |
ab27a4a0 CD |
2672 | (defvar org-prefix-format-compiled nil |
2673 | "The compiled version of the most recently used prefix format. | |
3278a016 | 2674 | See the variable `org-agenda-prefix-format'.") |
ab27a4a0 | 2675 | |
03f3cf35 JW |
2676 | (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") |
2677 | "Text preceeding scheduled items in the agenda view. | |
2678 | THis is a list with two strings. The first applies when the item is | |
2679 | scheduled on the current day. The second applies when it has been scheduled | |
2680 | previously, it may contain a %d to capture how many days ago the item was | |
2681 | scheduled." | |
2682 | :group 'org-agenda-line-format | |
2683 | :type '(list | |
2684 | (string :tag "Scheduled today ") | |
2685 | (string :tag "Scheduled previously"))) | |
2686 | ||
2687 | (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") | |
2688 | "Text preceeding deadline items in the agenda view. | |
2689 | This is a list with two strings. The first applies when the item has its | |
2690 | deadline on the current day. The second applies when it is in the past or | |
2691 | in the future, it may contain %d to capture how many days away the deadline | |
2692 | is (was)." | |
2693 | :group 'org-agenda-line-format | |
2694 | :type '(list | |
2695 | (string :tag "Deadline today ") | |
2696 | (string :tag "Deadline relative"))) | |
2697 | ||
ab27a4a0 CD |
2698 | (defcustom org-agenda-remove-times-when-in-prefix t |
2699 | "Non-nil means, remove duplicate time specifications in agenda items. | |
2700 | When the format `org-agenda-prefix-format' contains a `%t' specifier, a | |
2701 | time-of-day specification in a headline or diary entry is extracted and | |
2702 | placed into the prefix. If this option is non-nil, the original specification | |
2703 | \(a timestamp or -range, or just a plain time(range) specification like | |
2704 | 11:30-4pm) will be removed for agenda display. This makes the agenda less | |
2705 | cluttered. | |
2706 | The option can be t or nil. It may also be the symbol `beg', indicating | |
2707 | that the time should only be removed what it is located at the beginning of | |
2708 | the headline/diary entry." | |
15841868 | 2709 | :group 'org-agenda-line-format |
ab27a4a0 CD |
2710 | :type '(choice |
2711 | (const :tag "Always" t) | |
2712 | (const :tag "Never" nil) | |
2713 | (const :tag "When at beginning of entry" beg))) | |
2714 | ||
5152b597 CD |
2715 | |
2716 | (defcustom org-agenda-default-appointment-duration nil | |
2717 | "Default duration for appointments that only have a starting time. | |
2718 | When nil, no duration is specified in such cases. | |
2719 | When non-nil, this must be the number of minutes, e.g. 60 for one hour." | |
15841868 | 2720 | :group 'org-agenda-line-format |
5152b597 CD |
2721 | :type '(choice |
2722 | (integer :tag "Minutes") | |
2723 | (const :tag "No default duration"))) | |
2724 | ||
2725 | ||
a3fbe8c4 | 2726 | (defcustom org-agenda-remove-tags nil |
ab27a4a0 CD |
2727 | "Non-nil means, remove the tags from the headline copy in the agenda. |
2728 | When this is the symbol `prefix', only remove tags when | |
2729 | `org-agenda-prefix-format' contains a `%T' specifier." | |
15841868 | 2730 | :group 'org-agenda-line-format |
ab27a4a0 CD |
2731 | :type '(choice |
2732 | (const :tag "Always" t) | |
2733 | (const :tag "Never" nil) | |
2734 | (const :tag "When prefix format contains %T" prefix))) | |
891f4676 | 2735 | |
a3fbe8c4 CD |
2736 | (if (fboundp 'defvaralias) |
2737 | (defvaralias 'org-agenda-remove-tags-when-in-prefix | |
2738 | 'org-agenda-remove-tags)) | |
2739 | ||
15841868 JW |
2740 | (defcustom org-agenda-tags-column -80 |
2741 | "Shift tags in agenda items to this column. | |
2742 | If this number is positive, it specifies the column. If it is negative, | |
2743 | it means that the tags should be flushright to that column. For example, | |
2744 | -80 works well for a normal 80 character screen." | |
2745 | :group 'org-agenda-line-format | |
3278a016 | 2746 | :type 'integer) |
c4b5acde | 2747 | |
15841868 JW |
2748 | (if (fboundp 'defvaralias) |
2749 | (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) | |
2750 | ||
03f3cf35 JW |
2751 | (defcustom org-agenda-fontify-priorities t |
2752 | "Non-nil means, highlight low and high priorities in agenda. | |
2753 | When t, the highest priority entries are bold, lowest priority italic. | |
2754 | This may also be an association list of priority faces. The face may be | |
2755 | a names face, or a list like `(:background \"Red\")'." | |
2756 | :group 'org-agenda-line-format | |
2757 | :type '(choice | |
2758 | (const :tag "Never" nil) | |
2759 | (const :tag "Defaults" t) | |
2760 | (repeat :tag "Specify" | |
2761 | (list (character :tag "Priority" :value ?A) | |
2762 | (sexp :tag "face"))))) | |
2763 | ||
6769c0dc CD |
2764 | (defgroup org-latex nil |
2765 | "Options for embedding LaTeX code into Org-mode" | |
2766 | :tag "Org LaTeX" | |
2767 | :group 'org) | |
2768 | ||
2769 | (defcustom org-format-latex-options | |
a3fbe8c4 CD |
2770 | '(:foreground default :background default :scale 1.0 |
2771 | :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 | |
2772 | :matchers ("begin" "$" "$$" "\\(" "\\[")) | |
6769c0dc CD |
2773 | "Options for creating images from LaTeX fragments. |
2774 | This is a property list with the following properties: | |
a3fbe8c4 CD |
2775 | :foreground the foreground color for images embedded in emacs, e.g. \"Black\". |
2776 | `default' means use the forground of the default face. | |
6769c0dc | 2777 | :background the background color, or \"Transparent\". |
a3fbe8c4 | 2778 | `default' means use the background of the default face. |
6769c0dc | 2779 | :scale a scaling factor for the size of the images |
a3fbe8c4 CD |
2780 | :html-foreground, :html-background, :html-scale |
2781 | The same numbers for HTML export. | |
6769c0dc CD |
2782 | :matchers a list indicating which matchers should be used to |
2783 | find LaTeX fragments. Valid members of this list are: | |
2784 | \"begin\" find environments | |
e39856be | 2785 | \"$\" find math expressions surrounded by $...$ |
6769c0dc | 2786 | \"$$\" find math expressions surrounded by $$....$$ |
e39856be CD |
2787 | \"\\(\" find math expressions surrounded by \\(...\\) |
2788 | \"\\ [\" find math expressions surrounded by \\ [...\\]" | |
15841868 | 2789 | :group 'org-latex |
6769c0dc CD |
2790 | :type 'plist) |
2791 | ||
a3fbe8c4 CD |
2792 | (defcustom org-format-latex-header "\\documentclass{article} |
2793 | \\usepackage{fullpage} % do not remove | |
2794 | \\usepackage{amssymb} | |
2795 | \\usepackage[usenames]{color} | |
2796 | \\usepackage{amsmath} | |
2797 | \\usepackage{latexsym} | |
2798 | \\usepackage[mathscr]{eucal} | |
2799 | \\pagestyle{empty} % do not remove" | |
2800 | "The document header used for processing LaTeX fragments." | |
15841868 | 2801 | :group 'org-latex |
a3fbe8c4 CD |
2802 | :type 'string) |
2803 | ||
891f4676 RS |
2804 | (defgroup org-export nil |
2805 | "Options for exporting org-listings." | |
2806 | :tag "Org Export" | |
2807 | :group 'org) | |
2808 | ||
ab27a4a0 CD |
2809 | (defgroup org-export-general nil |
2810 | "General options for exporting Org-mode files." | |
2811 | :tag "Org Export General" | |
2812 | :group 'org-export) | |
2813 | ||
4b3a9ba7 CD |
2814 | (defcustom org-export-publishing-directory "." |
2815 | "Path to the location where exported files should be located. | |
2816 | This path may be relative to the directory where the Org-mode file lives. | |
2817 | The default is to put them into the same directory as the Org-mode file. | |
2818 | The variable may also be an alist with export types `:html', `:ascii', | |
374585c9 CD |
2819 | `:ical', `:LaTeX', or `:xoxo' and the corresponding directories. |
2820 | If a directory path is relative, it is interpreted relative to the | |
2821 | directory where the exported Org-mode files lives." | |
4b3a9ba7 CD |
2822 | :group 'org-export-general |
2823 | :type '(choice | |
2824 | (directory) | |
2825 | (repeat | |
2826 | (cons | |
2827 | (choice :tag "Type" | |
fbe6c10d | 2828 | (const :html) (const :LaTeX) |
374585c9 | 2829 | (const :ascii) (const :ical) (const :xoxo)) |
4b3a9ba7 CD |
2830 | (directory))))) |
2831 | ||
891f4676 RS |
2832 | (defcustom org-export-language-setup |
2833 | '(("en" "Author" "Date" "Table of Contents") | |
5137195a | 2834 | ("cs" "Autor" "Datum" "Obsah") |
891f4676 RS |
2835 | ("da" "Ophavsmand" "Dato" "Indhold") |
2836 | ("de" "Autor" "Datum" "Inhaltsverzeichnis") | |
0b8568f5 JW |
2837 | ("es" "Autor" "Fecha" "\xcdndice") |
2838 | ("fr" "Auteur" "Date" "Table des mati\xe8res") | |
891f4676 RS |
2839 | ("it" "Autore" "Data" "Indice") |
2840 | ("nl" "Auteur" "Datum" "Inhoudsopgave") | |
2841 | ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk) | |
2842 | ("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll")) | |
2843 | "Terms used in export text, translated to different languages. | |
2844 | Use the variable `org-export-default-language' to set the language, | |
2845 | or use the +OPTION lines for a per-file setting." | |
ab27a4a0 | 2846 | :group 'org-export-general |
891f4676 | 2847 | :type '(repeat |
c8d16429 CD |
2848 | (list |
2849 | (string :tag "HTML language tag") | |
2850 | (string :tag "Author") | |
2851 | (string :tag "Date") | |
2852 | (string :tag "Table of Contents")))) | |
891f4676 RS |
2853 | |
2854 | (defcustom org-export-default-language "en" | |
2855 | "The default language of HTML export, as a string. | |
e0e66b8e | 2856 | This should have an association in `org-export-language-setup'." |
ab27a4a0 | 2857 | :group 'org-export-general |
891f4676 RS |
2858 | :type 'string) |
2859 | ||
a3fbe8c4 CD |
2860 | (defcustom org-export-skip-text-before-1st-heading t |
2861 | "Non-nil means, skip all text before the first headline when exporting. | |
2862 | When nil, that text is exported as well." | |
2863 | :group 'org-export-general | |
2864 | :type 'boolean) | |
2865 | ||
891f4676 RS |
2866 | (defcustom org-export-headline-levels 3 |
2867 | "The last level which is still exported as a headline. | |
2868 | Inferior levels will produce itemize lists when exported. | |
2869 | Note that a numeric prefix argument to an exporter function overrides | |
2870 | this setting. | |
2871 | ||
2872 | This option can also be set with the +OPTIONS line, e.g. \"H:2\"." | |
ab27a4a0 | 2873 | :group 'org-export-general |
891f4676 RS |
2874 | :type 'number) |
2875 | ||
2876 | (defcustom org-export-with-section-numbers t | |
2877 | "Non-nil means, add section numbers to headlines when exporting. | |
2878 | ||
2879 | This option can also be set with the +OPTIONS line, e.g. \"num:t\"." | |
ab27a4a0 | 2880 | :group 'org-export-general |
891f4676 RS |
2881 | :type 'boolean) |
2882 | ||
2883 | (defcustom org-export-with-toc t | |
2884 | "Non-nil means, create a table of contents in exported files. | |
2885 | The TOC contains headlines with levels up to`org-export-headline-levels'. | |
d3f4dbe8 CD |
2886 | When an integer, include levels up to N in the toc, this may then be |
2887 | different from `org-export-headline-levels', but it will not be allowed | |
2888 | to be larger than the number of headline levels. | |
2889 | When nil, no table of contents is made. | |
891f4676 RS |
2890 | |
2891 | Headlines which contain any TODO items will be marked with \"(*)\" in | |
d3f4dbe8 CD |
2892 | ASCII export, and with red color in HTML output, if the option |
2893 | `org-export-mark-todo-in-toc' is set. | |
891f4676 RS |
2894 | |
2895 | In HTML output, the TOC will be clickable. | |
2896 | ||
d3f4dbe8 CD |
2897 | This option can also be set with the +OPTIONS line, e.g. \"toc:nil\" |
2898 | or \"toc:3\"." | |
ab27a4a0 | 2899 | :group 'org-export-general |
d3f4dbe8 CD |
2900 | :type '(choice |
2901 | (const :tag "No Table of Contents" nil) | |
2902 | (const :tag "Full Table of Contents" t) | |
2903 | (integer :tag "TOC to level"))) | |
891f4676 | 2904 | |
ab27a4a0 CD |
2905 | (defcustom org-export-mark-todo-in-toc nil |
2906 | "Non-nil means, mark TOC lines that contain any open TODO items." | |
2907 | :group 'org-export-general | |
2908 | :type 'boolean) | |
e0e66b8e | 2909 | |
891f4676 RS |
2910 | (defcustom org-export-preserve-breaks nil |
2911 | "Non-nil means, preserve all line breaks when exporting. | |
2912 | Normally, in HTML output paragraphs will be reformatted. In ASCII | |
2913 | export, line breaks will always be preserved, regardless of this variable. | |
2914 | ||
2915 | This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." | |
ab27a4a0 | 2916 | :group 'org-export-general |
891f4676 RS |
2917 | :type 'boolean) |
2918 | ||
6769c0dc CD |
2919 | (defcustom org-export-with-archived-trees 'headline |
2920 | "Whether subtrees with the ARCHIVE tag should be exported. | |
2921 | This can have three different values | |
2922 | nil Do not export, pretend this tree is not present | |
2923 | t Do export the entire tree | |
2924 | headline Only export the headline, but skip the tree below it." | |
2925 | :group 'org-export-general | |
2926 | :group 'org-archive | |
2927 | :type '(choice | |
2928 | (const :tag "not at all" nil) | |
2929 | (const :tag "headline only" 'headline) | |
2930 | (const :tag "entirely" t))) | |
2931 | ||
48aaad2d CD |
2932 | (defcustom org-export-author-info t |
2933 | "Non-nil means, insert author name and email into the exported file. | |
2934 | ||
2935 | This option can also be set with the +OPTIONS line, | |
2936 | e.g. \"author-info:nil\"." | |
2937 | :group 'org-export-general | |
2938 | :type 'boolean) | |
2939 | ||
2940 | (defcustom org-export-time-stamp-file t | |
2941 | "Non-nil means, insert a time stamp into the exported file. | |
2942 | The time stamp shows when the file was created. | |
2943 | ||
2944 | This option can also be set with the +OPTIONS line, | |
2945 | e.g. \"timestamp:nil\"." | |
2946 | :group 'org-export-general | |
2947 | :type 'boolean) | |
2948 | ||
4b3a9ba7 | 2949 | (defcustom org-export-with-timestamps t |
64948f0f | 2950 | "If nil, do not export time stamps and associated keywords." |
3278a016 | 2951 | :group 'org-export-general |
4b3a9ba7 CD |
2952 | :type 'boolean) |
2953 | ||
8df0de1c | 2954 | (defcustom org-export-remove-timestamps-from-toc t |
64948f0f | 2955 | "If nil, remove timestamps from the table of contents entries." |
4b3a9ba7 CD |
2956 | :group 'org-export-general |
2957 | :type 'boolean) | |
2958 | ||
3278a016 | 2959 | (defcustom org-export-with-tags 'not-in-toc |
64948f0f GM |
2960 | "If nil, do not export tags, just remove them from headlines. |
2961 | If this is the symbol `not-in-toc', tags will be removed from table of | |
03f3cf35 JW |
2962 | contents entries, but still be shown in the headlines of the document. |
2963 | ||
2964 | This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"." | |
4b3a9ba7 | 2965 | :group 'org-export-general |
3278a016 CD |
2966 | :type '(choice |
2967 | (const :tag "Off" nil) | |
2968 | (const :tag "Not in TOC" not-in-toc) | |
2969 | (const :tag "On" t))) | |
4b3a9ba7 | 2970 | |
03f3cf35 JW |
2971 | (defcustom org-export-with-drawers nil |
2972 | "Non-nil means, export with drawers like the property drawer. | |
2973 | When t, all drawers are exported. This may also be a list of | |
2974 | drawer names to export." | |
38f8646b | 2975 | :group 'org-export-general |
03f3cf35 JW |
2976 | :type '(choice |
2977 | (const :tag "All drawers" t) | |
2978 | (const :tag "None" nil) | |
2979 | (repeat :tag "Selected drawers" | |
2980 | (string :tag "Drawer name")))) | |
38f8646b | 2981 | |
ab27a4a0 CD |
2982 | (defgroup org-export-translation nil |
2983 | "Options for translating special ascii sequences for the export backends." | |
2984 | :tag "Org Export Translation" | |
2985 | :group 'org-export) | |
2986 | ||
2987 | (defcustom org-export-with-emphasize t | |
2988 | "Non-nil means, interpret *word*, /word/, and _word_ as emphasized text. | |
2989 | If the export target supports emphasizing text, the word will be | |
2990 | typeset in bold, italic, or underlined, respectively. Works only for | |
2991 | single words, but you can say: I *really* *mean* *this*. | |
2992 | Not all export backends support this. | |
2993 | ||
2994 | This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." | |
2995 | :group 'org-export-translation | |
891f4676 RS |
2996 | :type 'boolean) |
2997 | ||
5152b597 CD |
2998 | (defcustom org-export-with-footnotes t |
2999 | "If nil, export [1] as a footnote marker. | |
3000 | Lines starting with [1] will be formatted as footnotes. | |
3001 | ||
3002 | This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." | |
3003 | :group 'org-export-translation | |
3004 | :type 'boolean) | |
3005 | ||
ab27a4a0 CD |
3006 | (defcustom org-export-with-sub-superscripts t |
3007 | "Non-nil means, interpret \"_\" and \"^\" for export. | |
3008 | When this option is turned on, you can use TeX-like syntax for sub- and | |
3009 | superscripts. Several characters after \"_\" or \"^\" will be | |
3010 | considered as a single item - so grouping with {} is normally not | |
3011 | needed. For example, the following things will be parsed as single | |
3012 | sub- or superscripts. | |
891f4676 | 3013 | |
ab27a4a0 CD |
3014 | 10^24 or 10^tau several digits will be considered 1 item. |
3015 | 10^-12 or 10^-tau a leading sign with digits or a word | |
3016 | x^2-y^3 will be read as x^2 - y^3, because items are | |
3017 | terminated by almost any nonword/nondigit char. | |
3018 | x_{i^2} or x^(2-i) braces or parenthesis do grouping. | |
3019 | ||
3020 | Still, ambiguity is possible - so when in doubt use {} to enclose the | |
a3fbe8c4 CD |
3021 | sub/superscript. If you set this variable to the symbol `{}', |
3022 | the braces are *required* in order to trigger interpretations as | |
3023 | sub/superscript. This can be helpful in documents that need \"_\" | |
3024 | frequently in plain text. | |
3025 | ||
ab27a4a0 CD |
3026 | Not all export backends support this, but HTML does. |
3027 | ||
3028 | This option can also be set with the +OPTIONS line, e.g. \"^:nil\"." | |
3029 | :group 'org-export-translation | |
a3fbe8c4 CD |
3030 | :type '(choice |
3031 | (const :tag "Always interpret" t) | |
3032 | (const :tag "Only with braces" {}) | |
3033 | (const :tag "Never interpret" nil))) | |
ab27a4a0 CD |
3034 | |
3035 | (defcustom org-export-with-TeX-macros t | |
3036 | "Non-nil means, interpret simple TeX-like macros when exporting. | |
3037 | For example, HTML export converts \\alpha to α and \\AA to Å. | |
3038 | No only real TeX macros will work here, but the standard HTML entities | |
3039 | for math can be used as macro names as well. For a list of supported | |
3040 | names in HTML export, see the constant `org-html-entities'. | |
3041 | Not all export backends support this. | |
3042 | ||
3043 | This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." | |
3044 | :group 'org-export-translation | |
48aaad2d | 3045 | :group 'org-export-latex |
6769c0dc CD |
3046 | :type 'boolean) |
3047 | ||
3048 | (defcustom org-export-with-LaTeX-fragments nil | |
3049 | "Non-nil means, convert LaTeX fragments to images when exporting to HTML. | |
3050 | When set, the exporter will find LaTeX environments if the \\begin line is | |
3051 | the first non-white thing on a line. It will also find the math delimiters | |
3052 | like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for | |
3053 | display math. | |
3054 | ||
3055 | This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." | |
3056 | :group 'org-export-translation | |
48aaad2d | 3057 | :group 'org-export-latex |
891f4676 RS |
3058 | :type 'boolean) |
3059 | ||
3060 | (defcustom org-export-with-fixed-width t | |
3061 | "Non-nil means, lines starting with \":\" will be in fixed width font. | |
35fb9989 | 3062 | This can be used to have pre-formatted text, fragments of code etc. For |
b0a10108 | 3063 | example: |
891f4676 RS |
3064 | : ;; Some Lisp examples |
3065 | : (while (defc cnt) | |
3066 | : (ding)) | |
ab27a4a0 CD |
3067 | will be looking just like this in also HTML. See also the QUOTE keyword. |
3068 | Not all export backends support this. | |
891f4676 RS |
3069 | |
3070 | This option can also be set with the +OPTIONS line, e.g. \"::nil\"." | |
ab27a4a0 | 3071 | :group 'org-export-translation |
891f4676 RS |
3072 | :type 'boolean) |
3073 | ||
ab27a4a0 CD |
3074 | (defcustom org-match-sexp-depth 3 |
3075 | "Number of stacked braces for sub/superscript matching. | |
3076 | This has to be set before loading org.el to be effective." | |
3077 | :group 'org-export-translation | |
3078 | :type 'integer) | |
3079 | ||
3080 | (defgroup org-export-tables nil | |
3081 | "Options for exporting tables in Org-mode." | |
3082 | :tag "Org Export Tables" | |
3083 | :group 'org-export) | |
3084 | ||
891f4676 | 3085 | (defcustom org-export-with-tables t |
2dd9129f | 3086 | "If non-nil, lines starting with \"|\" define a table. |
891f4676 RS |
3087 | For example: |
3088 | ||
3089 | | Name | Address | Birthday | | |
3090 | |-------------+----------+-----------| | |
3091 | | Arthur Dent | England | 29.2.2100 | | |
3092 | ||
ab27a4a0 | 3093 | Not all export backends support this. |
891f4676 RS |
3094 | |
3095 | This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." | |
ab27a4a0 CD |
3096 | :group 'org-export-tables |
3097 | :type 'boolean) | |
3098 | ||
3099 | (defcustom org-export-highlight-first-table-line t | |
3100 | "Non-nil means, highlight the first table line. | |
3101 | In HTML export, this means use <th> instead of <td>. | |
3102 | In tables created with table.el, this applies to the first table line. | |
3103 | In Org-mode tables, all lines before the first horizontal separator | |
3104 | line will be formatted with <th> tags." | |
3105 | :group 'org-export-tables | |
891f4676 RS |
3106 | :type 'boolean) |
3107 | ||
a96ee7df CD |
3108 | (defcustom org-export-table-remove-special-lines t |
3109 | "Remove special lines and marking characters in calculating tables. | |
3110 | This removes the special marking character column from tables that are set | |
3111 | up for spreadsheet calculations. It also removes the entire lines | |
3112 | marked with `!', `_', or `^'. The lines with `$' are kept, because | |
3113 | the values of constants may be useful to have." | |
ab27a4a0 | 3114 | :group 'org-export-tables |
a96ee7df CD |
3115 | :type 'boolean) |
3116 | ||
c4f9780e CD |
3117 | (defcustom org-export-prefer-native-exporter-for-tables nil |
3118 | "Non-nil means, always export tables created with table.el natively. | |
3119 | Natively means, use the HTML code generator in table.el. | |
3120 | When nil, Org-mode's own HTML generator is used when possible (i.e. if | |
3121 | the table does not use row- or column-spanning). This has the | |
3122 | advantage, that the automatic HTML conversions for math symbols and | |
3123 | sub/superscripts can be applied. Org-mode's HTML generator is also | |
3124 | much faster." | |
ab27a4a0 | 3125 | :group 'org-export-tables |
c4f9780e CD |
3126 | :type 'boolean) |
3127 | ||
ab27a4a0 CD |
3128 | (defgroup org-export-ascii nil |
3129 | "Options specific for ASCII export of Org-mode files." | |
3130 | :tag "Org Export ASCII" | |
3131 | :group 'org-export) | |
891f4676 | 3132 | |
c4b5acde CD |
3133 | (defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) |
3134 | "Characters for underlining headings in ASCII export. | |
3135 | In the given sequence, these characters will be used for level 1, 2, ..." | |
3136 | :group 'org-export-ascii | |
3137 | :type '(repeat character)) | |
3138 | ||
7d143c25 | 3139 | (defcustom org-export-ascii-bullets '(?* ?+ ?-) |
c4b5acde | 3140 | "Bullet characters for headlines converted to lists in ASCII export. |
b38c6895 | 3141 | The first character is is used for the first lest level generated in this |
c4b5acde CD |
3142 | way, and so on. If there are more levels than characters given here, |
3143 | the list will be repeated. | |
3144 | Note that plain lists will keep the same bullets as the have in the | |
3145 | Org-mode file." | |
3146 | :group 'org-export-ascii | |
3147 | :type '(repeat character)) | |
3148 | ||
ab27a4a0 CD |
3149 | (defgroup org-export-xml nil |
3150 | "Options specific for XML export of Org-mode files." | |
3151 | :tag "Org Export XML" | |
3152 | :group 'org-export) | |
891f4676 | 3153 | |
ab27a4a0 CD |
3154 | (defgroup org-export-html nil |
3155 | "Options specific for HTML export of Org-mode files." | |
3156 | :tag "Org Export HTML" | |
3157 | :group 'org-export) | |
891f4676 | 3158 | |
b38c6895 CD |
3159 | (defcustom org-export-html-coding-system nil |
3160 | "" | |
3161 | :group 'org-export-html | |
3162 | :type 'coding-system) | |
3163 | ||
15841868 JW |
3164 | (defcustom org-export-html-extension "html" |
3165 | "The extension for exported HTML files." | |
3166 | :group 'org-export-html | |
3167 | :type 'string) | |
3168 | ||
ab27a4a0 CD |
3169 | (defcustom org-export-html-style |
3170 | "<style type=\"text/css\"> | |
3171 | html { | |
3172 | font-family: Times, serif; | |
3173 | font-size: 12pt; | |
3174 | } | |
3175 | .title { text-align: center; } | |
4b3a9ba7 | 3176 | .todo { color: red; } |
ab27a4a0 | 3177 | .done { color: green; } |
4b3a9ba7 CD |
3178 | .timestamp { color: grey } |
3179 | .timestamp-kwd { color: CadetBlue } | |
3180 | .tag { background-color:lightblue; font-weight:normal } | |
ab27a4a0 CD |
3181 | .target { background-color: lavender; } |
3182 | pre { | |
3183 | border: 1pt solid #AEBDCC; | |
3184 | background-color: #F3F5F7; | |
3185 | padding: 5pt; | |
3186 | font-family: courier, monospace; | |
3187 | } | |
3188 | table { border-collapse: collapse; } | |
3189 | td, th { | |
3190 | vertical-align: top; | |
d3f4dbe8 | 3191 | <!--border: 1pt solid #ADB9CC;--> |
ab27a4a0 CD |
3192 | } |
3193 | </style>" | |
3194 | "The default style specification for exported HTML files. | |
3195 | Since there are different ways of setting style information, this variable | |
3196 | needs to contain the full HTML structure to provide a style, including the | |
3197 | surrounding HTML tags. The style specifications should include definitions | |
3198 | for new classes todo, done, title, and deadline. For example, legal values | |
3199 | would be: | |
891f4676 | 3200 | |
ab27a4a0 CD |
3201 | <style type=\"text/css\"> |
3202 | p { font-weight: normal; color: gray; } | |
3203 | h1 { color: black; } | |
3204 | .title { text-align: center; } | |
3205 | .todo, .deadline { color: red; } | |
3206 | .done { color: green; } | |
3207 | </style> | |
3208 | ||
3209 | or, if you want to keep the style in a file, | |
3210 | ||
3211 | <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> | |
3212 | ||
3213 | As the value of this option simply gets inserted into the HTML <head> header, | |
3214 | you can \"misuse\" it to add arbitrary text to the header." | |
3215 | :group 'org-export-html | |
3216 | :type 'string) | |
3217 | ||
a3fbe8c4 | 3218 | |
5137195a CD |
3219 | (defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n" |
3220 | "Format for typesetting the document title in HTML export." | |
3221 | :group 'org-export-html | |
3222 | :type 'string) | |
3223 | ||
3224 | (defcustom org-export-html-toplevel-hlevel 2 | |
3225 | "The <H> level for level 1 headings in HTML export." | |
3226 | :group 'org-export-html | |
3227 | :type 'string) | |
3228 | ||
d943b3c6 CD |
3229 | (defcustom org-export-html-link-org-files-as-html t |
3230 | "Non-nil means, make file links to `file.org' point to `file.html'. | |
3231 | When org-mode is exporting an org-mode file to HTML, links to | |
3232 | non-html files are directly put into a href tag in HTML. | |
3233 | However, links to other Org-mode files (recognized by the | |
3234 | extension `.org.) should become links to the corresponding html | |
3235 | file, assuming that the linked org-mode file will also be | |
3236 | converted to HTML. | |
3237 | When nil, the links still point to the plain `.org' file." | |
3238 | :group 'org-export-html | |
3239 | :type 'boolean) | |
3240 | ||
4b3a9ba7 | 3241 | (defcustom org-export-html-inline-images 'maybe |
ab27a4a0 | 3242 | "Non-nil means, inline images into exported HTML pages. |
4b3a9ba7 CD |
3243 | This is done using an <img> tag. When nil, an anchor with href is used to |
3244 | link to the image. If this option is `maybe', then images in links with | |
3245 | an empty description will be inlined, while images with a description will | |
3246 | be linked only." | |
ab27a4a0 | 3247 | :group 'org-export-html |
4b3a9ba7 CD |
3248 | :type '(choice (const :tag "Never" nil) |
3249 | (const :tag "Always" t) | |
3250 | (const :tag "When there is no description" maybe))) | |
891f4676 | 3251 | |
a3fbe8c4 | 3252 | ;; FIXME: rename |
ab27a4a0 CD |
3253 | (defcustom org-export-html-expand t |
3254 | "Non-nil means, for HTML export, treat @<...> as HTML tag. | |
3255 | When nil, these tags will be exported as plain text and therefore | |
3256 | not be interpreted by a browser. | |
891f4676 | 3257 | |
ab27a4a0 CD |
3258 | This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." |
3259 | :group 'org-export-html | |
891f4676 RS |
3260 | :type 'boolean) |
3261 | ||
ab27a4a0 | 3262 | (defcustom org-export-html-table-tag |
d3f4dbe8 | 3263 | "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">" |
a3fbe8c4 | 3264 | "The HTML tag that is used to start a table. |
ab27a4a0 CD |
3265 | This must be a <table> tag, but you may change the options like |
3266 | borders and spacing." | |
3267 | :group 'org-export-html | |
3268 | :type 'string) | |
3269 | ||
a3fbe8c4 CD |
3270 | (defcustom org-export-table-header-tags '("<th>" . "</th>") |
3271 | "The opening tag for table header fields. | |
3272 | This is customizable so that alignment options can be specified." | |
3273 | :group 'org-export-tables | |
3274 | :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) | |
3275 | ||
3276 | (defcustom org-export-table-data-tags '("<td>" . "</td>") | |
3277 | "The opening tag for table data fields. | |
3278 | This is customizable so that alignment options can be specified." | |
3279 | :group 'org-export-tables | |
3280 | :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) | |
3281 | ||
891f4676 | 3282 | (defcustom org-export-html-with-timestamp nil |
634a7d0b | 3283 | "If non-nil, write `org-export-html-html-helper-timestamp' |
79c4be8e | 3284 | into the exported HTML text. Otherwise, the buffer will just be saved |
891f4676 | 3285 | to a file." |
ab27a4a0 | 3286 | :group 'org-export-html |
891f4676 RS |
3287 | :type 'boolean) |
3288 | ||
3289 | (defcustom org-export-html-html-helper-timestamp | |
c4b5acde | 3290 | "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n" |
891f4676 | 3291 | "The HTML tag used as timestamp delimiter for HTML-helper-mode." |
ab27a4a0 | 3292 | :group 'org-export-html |
891f4676 RS |
3293 | :type 'string) |
3294 | ||
ab27a4a0 CD |
3295 | (defgroup org-export-icalendar nil |
3296 | "Options specific for iCalendar export of Org-mode files." | |
3297 | :tag "Org Export iCalendar" | |
3298 | :group 'org-export) | |
3299 | ||
46177585 CD |
3300 | (defcustom org-combined-agenda-icalendar-file "~/org.ics" |
3301 | "The file name for the iCalendar file covering all agenda files. | |
4b3a9ba7 | 3302 | This file is created with the command \\[org-export-icalendar-all-agenda-files]. |
15841868 | 3303 | The file name should be absolute, the file will be overwritten without warning." |
ab27a4a0 | 3304 | :group 'org-export-icalendar |
46177585 CD |
3305 | :type 'file) |
3306 | ||
3307 | (defcustom org-icalendar-include-todo nil | |
3308 | "Non-nil means, export to iCalendar files should also cover TODO items." | |
ab27a4a0 | 3309 | :group 'org-export-icalendar |
d3f4dbe8 CD |
3310 | :type '(choice |
3311 | (const :tag "None" nil) | |
3312 | (const :tag "Unfinished" t) | |
3313 | (const :tag "All" all))) | |
46177585 | 3314 | |
a3fbe8c4 CD |
3315 | (defcustom org-icalendar-include-sexps t |
3316 | "Non-nil means, export to iCalendar files should also cover sexp entries. | |
3317 | These are entries like in the diary, but directly in an Org-mode file." | |
3318 | :group 'org-export-icalendar | |
3319 | :type 'boolean) | |
3320 | ||
15841868 JW |
3321 | (defcustom org-icalendar-include-body 100 |
3322 | "Amount of text below headline to be included in iCalendar export. | |
3323 | This is a number of characters that should maximally be included. | |
3324 | Properties, scheduling and clocking lines will always be removed. | |
3325 | The text will be inserted into the DESCRIPTION field." | |
3326 | :group 'org-export-icalendar | |
3327 | :type '(choice | |
3328 | (const :tag "Nothing" nil) | |
3329 | (const :tag "Everything" t) | |
3330 | (integer :tag "Max characters"))) | |
3331 | ||
46177585 CD |
3332 | (defcustom org-icalendar-combined-name "OrgMode" |
3333 | "Calendar name for the combined iCalendar representing all agenda files." | |
ab27a4a0 | 3334 | :group 'org-export-icalendar |
46177585 CD |
3335 | :type 'string) |
3336 | ||
4ed31842 | 3337 | (defgroup org-font-lock nil |
ab27a4a0 | 3338 | "Font-lock settings for highlighting in Org-mode." |
4ed31842 | 3339 | :tag "Org Font Lock" |
891f4676 RS |
3340 | :group 'org) |
3341 | ||
4ed31842 CD |
3342 | (defcustom org-level-color-stars-only nil |
3343 | "Non-nil means fontify only the stars in each headline. | |
3344 | When nil, the entire headline is fontified. | |
3345 | Changing it requires restart of `font-lock-mode' to become effective | |
3346 | also in regions already fontified." | |
3347 | :group 'org-font-lock | |
3348 | :type 'boolean) | |
3349 | ||
3350 | (defcustom org-hide-leading-stars nil | |
3351 | "Non-nil means, hide the first N-1 stars in a headline. | |
3352 | This works by using the face `org-hide' for these stars. This | |
3353 | face is white for a light background, and black for a dark | |
3354 | background. You may have to customize the face `org-hide' to | |
3355 | make this work. | |
3356 | Changing it requires restart of `font-lock-mode' to become effective | |
4146eb16 CD |
3357 | also in regions already fontified. |
3358 | You may also set this on a per-file basis by adding one of the following | |
3359 | lines to the buffer: | |
3360 | ||
3361 | #+STARTUP: hidestars | |
3362 | #+STARTUP: showstars" | |
4ed31842 CD |
3363 | :group 'org-font-lock |
3364 | :type 'boolean) | |
3365 | ||
3366 | (defcustom org-fontify-done-headline nil | |
3367 | "Non-nil means, change the face of a headline if it is marked DONE. | |
3368 | Normally, only the TODO/DONE keyword indicates the state of a headline. | |
3369 | When this is non-nil, the headline after the keyword is set to the | |
3370 | `org-headline-done' as an additional indication." | |
3371 | :group 'org-font-lock | |
3372 | :type 'boolean) | |
3373 | ||
3374 | (defcustom org-fontify-emphasized-text t | |
3375 | "Non-nil means fontify *bold*, /italic/ and _underlined_ text. | |
3376 | Changing this variable requires a restart of Emacs to take effect." | |
3377 | :group 'org-font-lock | |
3378 | :type 'boolean) | |
3379 | ||
edd21304 CD |
3380 | (defvar org-emph-re nil |
3381 | "Regular expression for matching emphasis.") | |
3382 | (defvar org-emphasis-regexp-components) ; defined just below | |
3383 | (defvar org-emphasis-alist) ; defined just below | |
3384 | (defun org-set-emph-re (var val) | |
3385 | "Set variable and compute the emphasis regular expression." | |
3386 | (set var val) | |
3387 | (when (and (boundp 'org-emphasis-alist) | |
3388 | (boundp 'org-emphasis-regexp-components) | |
3389 | org-emphasis-alist org-emphasis-regexp-components) | |
3390 | (let* ((e org-emphasis-regexp-components) | |
3391 | (pre (car e)) | |
3392 | (post (nth 1 e)) | |
3393 | (border (nth 2 e)) | |
3394 | (body (nth 3 e)) | |
3395 | (nl (nth 4 e)) | |
3396 | (stacked (nth 5 e)) | |
3397 | (body1 (concat body "*?")) | |
3398 | (markers (mapconcat 'car org-emphasis-alist ""))) | |
3399 | ;; make sure special characters appear at the right position in the class | |
3400 | (if (string-match "\\^" markers) | |
3401 | (setq markers (concat (replace-match "" t t markers) "^"))) | |
3402 | (if (string-match "-" markers) | |
3403 | (setq markers (concat (replace-match "" t t markers) "-"))) | |
3278a016 CD |
3404 | (if (> nl 0) |
3405 | (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," | |
3406 | (int-to-string nl) "\\}"))) | |
edd21304 CD |
3407 | ;; Make the regexp |
3408 | (setq org-emph-re | |
3409 | (concat "\\([" pre (if stacked markers) "]\\|^\\)" | |
3410 | "\\(" | |
3411 | "\\([" markers "]\\)" | |
3412 | "\\(" | |
a3fbe8c4 | 3413 | "[^" border (if (and nil stacked) markers) "]" |
edd21304 | 3414 | body1 |
a3fbe8c4 | 3415 | "[^" border (if (and nil stacked) markers) "]" |
edd21304 CD |
3416 | "\\)" |
3417 | "\\3\\)" | |
3418 | "\\([" post (if stacked markers) "]\\|$\\)"))))) | |
3419 | ||
3420 | (defcustom org-emphasis-regexp-components | |
a3fbe8c4 | 3421 | '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1 nil) |
edd21304 CD |
3422 | "Components used to build the reqular expression for emphasis. |
3423 | This is a list with 6 entries. Terminology: In an emphasis string | |
3424 | like \" *strong word* \", we call the initial space PREMATCH, the final | |
3425 | space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters | |
3426 | and \"trong wor\" is the body. The different components in this variable | |
3427 | specify what is allowed/forbidden in each part: | |
3428 | ||
3429 | pre Chars allowed as prematch. Beginning of line will be allowed too. | |
3430 | post Chars allowed as postmatch. End of line will be allowed too. | |
a3fbe8c4 | 3431 | border The chars *forbidden* as border characters. |
edd21304 CD |
3432 | body-regexp A regexp like \".\" to match a body character. Don't use |
3433 | non-shy groups here, and don't allow newline here. | |
3434 | newline The maximum number of newlines allowed in an emphasis exp. | |
3435 | stacked Non-nil means, allow stacked styles. This works only in HTML | |
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. | |
c44f0d75 | 3439 | Use customize to modify this, or restart Emacs after changing it." |
0fee8d6e | 3440 | :group 'org-font-lock |
edd21304 CD |
3441 | :set 'org-set-emph-re |
3442 | :type '(list | |
3443 | (sexp :tag "Allowed chars in pre ") | |
3444 | (sexp :tag "Allowed chars in post ") | |
3445 | (sexp :tag "Forbidden chars in border ") | |
3446 | (sexp :tag "Regexp for body ") | |
3447 | (integer :tag "number of newlines allowed") | |
3448 | (boolean :tag "Stacking allowed "))) | |
3449 | ||
3450 | (defcustom org-emphasis-alist | |
3451 | '(("*" bold "<b>" "</b>") | |
3452 | ("/" italic "<i>" "</i>") | |
3453 | ("_" underline "<u>" "</u>") | |
374585c9 | 3454 | ("=" org-code "<code>" "</code>") |
0fee8d6e | 3455 | ("+" (:strike-through t) "<del>" "</del>") |
a3fbe8c4 | 3456 | ) |
c44f0d75 | 3457 | "Special syntax for emphasized text. |
edd21304 CD |
3458 | Text starting and ending with a special character will be emphasized, for |
3459 | example *bold*, _underlined_ and /italic/. This variable sets the marker | |
a3fbe8c4 | 3460 | characters, the face to be used by font-lock for highlighting in Org-mode |
c44f0d75 JB |
3461 | Emacs buffers, and the HTML tags to be used for this. |
3462 | Use customize to modify this, or restart Emacs after changing it." | |
0fee8d6e | 3463 | :group 'org-font-lock |
edd21304 CD |
3464 | :set 'org-set-emph-re |
3465 | :type '(repeat | |
3466 | (list | |
3467 | (string :tag "Marker character") | |
0fee8d6e CD |
3468 | (choice |
3469 | (face :tag "Font-lock-face") | |
3470 | (plist :tag "Face property list")) | |
edd21304 CD |
3471 | (string :tag "HTML start tag") |
3472 | (string :tag "HTML end tag")))) | |
3473 | ||
d3f4dbe8 CD |
3474 | ;;; The faces |
3475 | ||
ab27a4a0 CD |
3476 | (defgroup org-faces nil |
3477 | "Faces in Org-mode." | |
3478 | :tag "Org Faces" | |
3479 | :group 'org-font-lock) | |
3480 | ||
d5098885 | 3481 | (defun org-compatible-face (inherits specs) |
d943b3c6 | 3482 | "Make a compatible face specification. |
d5098885 JW |
3483 | If INHERITS is an existing face and if the Emacs version supports it, |
3484 | just inherit the face. If not, use SPECS to define the face. | |
d943b3c6 CD |
3485 | XEmacs and Emacs 21 do not know about the `min-colors' attribute. |
3486 | For them we convert a (min-colors 8) entry to a `tty' entry and move it | |
3487 | to the top of the list. The `min-colors' attribute will be removed from | |
3488 | any other entries, and any resulting duplicates will be removed entirely." | |
d5098885 JW |
3489 | (cond |
3490 | ((and inherits (facep inherits) | |
3491 | (not (featurep 'xemacs)) (> emacs-major-version 22)) | |
3492 | ;; In Emacs 23, we use inheritance where possible. | |
3493 | ;; We only do this in Emacs 23, because only there the outline | |
3494 | ;; faces have been changed to the original org-mode-level-faces. | |
3495 | (list (list t :inherit inherits))) | |
3496 | ((or (featurep 'xemacs) (< emacs-major-version 22)) | |
3497 | ;; These do not understand the `min-colors' attribute. | |
3498 | (let (r e a) | |
3499 | (while (setq e (pop specs)) | |
3500 | (cond | |
3501 | ((memq (car e) '(t default)) (push e r)) | |
3502 | ((setq a (member '(min-colors 8) (car e))) | |
3503 | (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) | |
3504 | (cdr e))))) | |
3505 | ((setq a (assq 'min-colors (car e))) | |
3506 | (setq e (cons (delq a (car e)) (cdr e))) | |
3507 | (or (assoc (car e) r) (push e r))) | |
3508 | (t (or (assoc (car e) r) (push e r))))) | |
3509 | (nreverse r))) | |
3510 | (t specs))) | |
d943b3c6 | 3511 | |
79c4be8e | 3512 | (defface org-hide |
d943b3c6 CD |
3513 | '((((background light)) (:foreground "white")) |
3514 | (((background dark)) (:foreground "black"))) | |
3515 | "Face used to hide leading stars in headlines. | |
3516 | The forground color of this face should be equal to the background | |
3517 | color of the frame." | |
ab27a4a0 | 3518 | :group 'org-faces) |
79c4be8e | 3519 | |
8e49668e | 3520 | (defface org-level-1 ;; font-lock-function-name-face |
d943b3c6 | 3521 | (org-compatible-face |
d5098885 | 3522 | 'outline-1 |
d943b3c6 CD |
3523 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
3524 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | |
3525 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | |
3526 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | |
3527 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) | |
3528 | (t (:bold t)))) | |
891f4676 | 3529 | "Face used for level 1 headlines." |
ab27a4a0 | 3530 | :group 'org-faces) |
891f4676 | 3531 | |
8e49668e | 3532 | (defface org-level-2 ;; font-lock-variable-name-face |
d943b3c6 | 3533 | (org-compatible-face |
d5098885 | 3534 | 'outline-2 |
d943b3c6 CD |
3535 | '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) |
3536 | (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) | |
3537 | (((class color) (min-colors 8) (background light)) (:foreground "yellow")) | |
3538 | (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) | |
3539 | (t (:bold t)))) | |
891f4676 | 3540 | "Face used for level 2 headlines." |
ab27a4a0 | 3541 | :group 'org-faces) |
891f4676 | 3542 | |
8e49668e | 3543 | (defface org-level-3 ;; font-lock-keyword-face |
d943b3c6 | 3544 | (org-compatible-face |
d5098885 | 3545 | 'outline-3 |
d943b3c6 CD |
3546 | '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) |
3547 | (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) | |
3548 | (((class color) (min-colors 16) (background light)) (:foreground "Purple")) | |
3549 | (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) | |
3550 | (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) | |
3551 | (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) | |
3552 | (t (:bold t)))) | |
891f4676 | 3553 | "Face used for level 3 headlines." |
ab27a4a0 | 3554 | :group 'org-faces) |
891f4676 | 3555 | |
30313b90 | 3556 | (defface org-level-4 ;; font-lock-comment-face |
d943b3c6 | 3557 | (org-compatible-face |
d5098885 | 3558 | 'outline-4 |
d943b3c6 CD |
3559 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
3560 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | |
3561 | (((class color) (min-colors 16) (background light)) (:foreground "red")) | |
3562 | (((class color) (min-colors 16) (background dark)) (:foreground "red1")) | |
3563 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) | |
3564 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | |
3565 | (t (:bold t)))) | |
891f4676 | 3566 | "Face used for level 4 headlines." |
ab27a4a0 | 3567 | :group 'org-faces) |
891f4676 | 3568 | |
8e49668e | 3569 | (defface org-level-5 ;; font-lock-type-face |
d943b3c6 | 3570 | (org-compatible-face |
d5098885 | 3571 | 'outline-5 |
d943b3c6 CD |
3572 | '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) |
3573 | (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) | |
3574 | (((class color) (min-colors 8)) (:foreground "green")))) | |
891f4676 | 3575 | "Face used for level 5 headlines." |
ab27a4a0 | 3576 | :group 'org-faces) |
891f4676 | 3577 | |
8e49668e | 3578 | (defface org-level-6 ;; font-lock-constant-face |
d943b3c6 | 3579 | (org-compatible-face |
d5098885 | 3580 | 'outline-6 |
d943b3c6 CD |
3581 | '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) |
3582 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) | |
3583 | (((class color) (min-colors 8)) (:foreground "magenta")))) | |
891f4676 | 3584 | "Face used for level 6 headlines." |
ab27a4a0 | 3585 | :group 'org-faces) |
891f4676 | 3586 | |
8e49668e | 3587 | (defface org-level-7 ;; font-lock-builtin-face |
d943b3c6 | 3588 | (org-compatible-face |
d5098885 | 3589 | 'outline-7 |
d943b3c6 CD |
3590 | '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) |
3591 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) | |
4b3a9ba7 | 3592 | (((class color) (min-colors 8)) (:foreground "blue")))) |
891f4676 | 3593 | "Face used for level 7 headlines." |
ab27a4a0 | 3594 | :group 'org-faces) |
891f4676 | 3595 | |
8e49668e | 3596 | (defface org-level-8 ;; font-lock-string-face |
d943b3c6 | 3597 | (org-compatible-face |
d5098885 | 3598 | 'outline-8 |
d943b3c6 CD |
3599 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) |
3600 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) | |
3601 | (((class color) (min-colors 8)) (:foreground "green")))) | |
891f4676 | 3602 | "Face used for level 8 headlines." |
ab27a4a0 | 3603 | :group 'org-faces) |
891f4676 | 3604 | |
b9661543 | 3605 | (defface org-special-keyword ;; font-lock-string-face |
d943b3c6 | 3606 | (org-compatible-face |
d5098885 | 3607 | nil |
d943b3c6 CD |
3608 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) |
3609 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) | |
3610 | (t (:italic t)))) | |
b0a10108 | 3611 | "Face used for special keywords." |
ab27a4a0 | 3612 | :group 'org-faces) |
b9661543 | 3613 | |
38f8646b CD |
3614 | (defface org-drawer ;; font-lock-function-name-face |
3615 | (org-compatible-face | |
d5098885 | 3616 | nil |
38f8646b CD |
3617 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
3618 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | |
3619 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | |
3620 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | |
3621 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) | |
3622 | (t (:bold t)))) | |
3623 | "Face used for drawers." | |
3624 | :group 'org-faces) | |
3625 | ||
3626 | (defface org-property-value nil | |
3627 | "Face used for the value of a property." | |
3628 | :group 'org-faces) | |
3629 | ||
3630 | (defface org-column | |
3631 | (org-compatible-face | |
d5098885 | 3632 | nil |
38f8646b CD |
3633 | '((((class color) (min-colors 16) (background light)) |
3634 | (:background "grey90")) | |
3635 | (((class color) (min-colors 16) (background dark)) | |
3636 | (:background "grey30")) | |
3637 | (((class color) (min-colors 8)) | |
3638 | (:background "cyan" :foreground "black")) | |
3639 | (t (:inverse-video t)))) | |
3640 | "Face for column display of entry properties." | |
3641 | :group 'org-faces) | |
3642 | ||
7d58338e CD |
3643 | (when (fboundp 'set-face-attribute) |
3644 | ;; Make sure that a fixed-width face is used when we have a column table. | |
3645 | (set-face-attribute 'org-column nil | |
3646 | :height (face-attribute 'default :height) | |
fbe6c10d | 3647 | :family (face-attribute 'default :family))) |
7d58338e | 3648 | |
d5098885 | 3649 | (defface org-warning |
d943b3c6 | 3650 | (org-compatible-face |
d5098885 | 3651 | 'font-lock-warning-face |
d943b3c6 CD |
3652 | '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) |
3653 | (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) | |
3654 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) | |
3655 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | |
3656 | (t (:bold t)))) | |
35fb9989 | 3657 | "Face for deadlines and TODO keywords." |
ab27a4a0 | 3658 | :group 'org-faces) |
ef943dba | 3659 | |
6769c0dc CD |
3660 | (defface org-archived ; similar to shadow |
3661 | (org-compatible-face | |
d5098885 | 3662 | 'shadow |
6769c0dc CD |
3663 | '((((class color grayscale) (min-colors 88) (background light)) |
3664 | (:foreground "grey50")) | |
3665 | (((class color grayscale) (min-colors 88) (background dark)) | |
3666 | (:foreground "grey70")) | |
3667 | (((class color) (min-colors 8) (background light)) | |
3668 | (:foreground "green")) | |
3669 | (((class color) (min-colors 8) (background dark)) | |
3670 | (:foreground "yellow")))) | |
3671 | "Face for headline with the ARCHIVE tag." | |
3672 | :group 'org-faces) | |
3673 | ||
64f72ae1 | 3674 | (defface org-link |
d943b3c6 | 3675 | '((((class color) (background light)) (:foreground "Purple" :underline t)) |
ab27a4a0 | 3676 | (((class color) (background dark)) (:foreground "Cyan" :underline t)) |
d943b3c6 | 3677 | (t (:underline t))) |
891f4676 | 3678 | "Face for links." |
ab27a4a0 | 3679 | :group 'org-faces) |
891f4676 | 3680 | |
03f3cf35 JW |
3681 | (defface org-ellipsis |
3682 | '((((class color) (background light)) (:foreground "DarkGoldenrod" :strike-through t)) | |
3683 | (((class color) (background dark)) (:foreground "LightGoldenrod" :strike-through t)) | |
3684 | (t (:strike-through t))) | |
3685 | "Face for the ellipsis in folded text." | |
3686 | :group 'org-faces) | |
3687 | ||
b38c6895 CD |
3688 | (defface org-target |
3689 | '((((class color) (background light)) (:underline t)) | |
3690 | (((class color) (background dark)) (:underline t)) | |
3691 | (t (:underline t))) | |
3692 | "Face for links." | |
3693 | :group 'org-faces) | |
3694 | ||
4146eb16 | 3695 | (defface org-date |
d943b3c6 | 3696 | '((((class color) (background light)) (:foreground "Purple" :underline t)) |
4146eb16 | 3697 | (((class color) (background dark)) (:foreground "Cyan" :underline t)) |
d943b3c6 | 3698 | (t (:underline t))) |
4146eb16 CD |
3699 | "Face for links." |
3700 | :group 'org-faces) | |
3701 | ||
a3fbe8c4 CD |
3702 | (defface org-sexp-date |
3703 | '((((class color) (background light)) (:foreground "Purple")) | |
3704 | (((class color) (background dark)) (:foreground "Cyan")) | |
3705 | (t (:underline t))) | |
3706 | "Face for links." | |
3707 | :group 'org-faces) | |
3708 | ||
7204b00e | 3709 | (defface org-tag |
d943b3c6 | 3710 | '((t (:bold t))) |
4ed31842 | 3711 | "Face for tags." |
ab27a4a0 | 3712 | :group 'org-faces) |
7204b00e | 3713 | |
d5098885 | 3714 | (defface org-todo ; font-lock-warning-face |
d943b3c6 | 3715 | (org-compatible-face |
d5098885 | 3716 | nil |
d943b3c6 CD |
3717 | '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) |
3718 | (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) | |
3719 | (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) | |
3720 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | |
3721 | (t (:inverse-video t :bold t)))) | |
4146eb16 CD |
3722 | "Face for TODO keywords." |
3723 | :group 'org-faces) | |
3724 | ||
8e49668e | 3725 | (defface org-done ;; font-lock-type-face |
d943b3c6 | 3726 | (org-compatible-face |
d5098885 | 3727 | nil |
3278a016 CD |
3728 | '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) |
3729 | (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) | |
d943b3c6 CD |
3730 | (((class color) (min-colors 8)) (:foreground "green")) |
3731 | (t (:bold t)))) | |
a3fbe8c4 CD |
3732 | "Face used for todo keywords that indicate DONE items." |
3733 | :group 'org-faces) | |
3734 | ||
3735 | (defface org-headline-done ;; font-lock-string-face | |
3736 | (org-compatible-face | |
d5098885 | 3737 | nil |
a3fbe8c4 CD |
3738 | '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) |
3739 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) | |
3740 | (((class color) (min-colors 8) (background light)) (:bold nil)))) | |
3741 | "Face used to indicate that a headline is DONE. | |
3742 | This face is only used if `org-fontify-done-headline' is set. If applies | |
3743 | to the part of the headline after the DONE keyword." | |
ab27a4a0 | 3744 | :group 'org-faces) |
891f4676 | 3745 | |
374585c9 CD |
3746 | (defcustom org-todo-keyword-faces nil |
3747 | "Faces for specific TODO keywords. | |
3748 | This is a list of cons cells, with TODO keywords in the car | |
3749 | and faces in the cdr. The face can be a symbol, or a property | |
3750 | list of attributes, like (:foreground \"blue\" :weight bold :underline t)." | |
3751 | :group 'org-faces | |
3752 | :group 'org-todo | |
3753 | :type '(repeat | |
3754 | (cons | |
3755 | (string :tag "keyword") | |
3756 | (sexp :tag "face")))) | |
3757 | ||
8e49668e | 3758 | (defface org-table ;; font-lock-function-name-face |
d943b3c6 | 3759 | (org-compatible-face |
d5098885 | 3760 | nil |
d943b3c6 CD |
3761 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
3762 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | |
3763 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | |
3764 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | |
3765 | (((class color) (min-colors 8) (background light)) (:foreground "blue")) | |
3766 | (((class color) (min-colors 8) (background dark))))) | |
891f4676 | 3767 | "Face used for tables." |
ab27a4a0 | 3768 | :group 'org-faces) |
891f4676 | 3769 | |
d943b3c6 CD |
3770 | (defface org-formula |
3771 | (org-compatible-face | |
d5098885 | 3772 | nil |
d943b3c6 CD |
3773 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
3774 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | |
3775 | (((class color) (min-colors 8) (background light)) (:foreground "red")) | |
3776 | (((class color) (min-colors 8) (background dark)) (:foreground "red")) | |
3777 | (t (:bold t :italic t)))) | |
3778 | "Face for formulas." | |
3779 | :group 'org-faces) | |
3780 | ||
374585c9 CD |
3781 | (defface org-code |
3782 | (org-compatible-face | |
d5098885 | 3783 | nil |
374585c9 CD |
3784 | '((((class color grayscale) (min-colors 88) (background light)) |
3785 | (:foreground "grey50")) | |
3786 | (((class color grayscale) (min-colors 88) (background dark)) | |
3787 | (:foreground "grey70")) | |
3788 | (((class color) (min-colors 8) (background light)) | |
3789 | (:foreground "green")) | |
3790 | (((class color) (min-colors 8) (background dark)) | |
3791 | (:foreground "yellow")))) | |
3792 | "Face for fixed-with text like code snippets." | |
3793 | :group 'org-faces | |
3794 | :version "22.1") | |
3795 | ||
a3fbe8c4 CD |
3796 | (defface org-agenda-structure ;; font-lock-function-name-face |
3797 | (org-compatible-face | |
d5098885 | 3798 | nil |
a3fbe8c4 CD |
3799 | '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) |
3800 | (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) | |
3801 | (((class color) (min-colors 16) (background light)) (:foreground "Blue")) | |
3802 | (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) | |
3803 | (((class color) (min-colors 8)) (:foreground "blue" :bold t)) | |
3804 | (t (:bold t)))) | |
3805 | "Face used in agenda for captions and dates." | |
3806 | :group 'org-faces) | |
3807 | ||
d943b3c6 CD |
3808 | (defface org-scheduled-today |
3809 | (org-compatible-face | |
d5098885 | 3810 | nil |
d943b3c6 CD |
3811 | '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) |
3812 | (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) | |
3813 | (((class color) (min-colors 8)) (:foreground "green")) | |
3814 | (t (:bold t :italic t)))) | |
3815 | "Face for items scheduled for a certain day." | |
3816 | :group 'org-faces) | |
3817 | ||
3818 | (defface org-scheduled-previously | |
3819 | (org-compatible-face | |
d5098885 | 3820 | nil |
d943b3c6 CD |
3821 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
3822 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | |
3823 | (((class color) (min-colors 8) (background light)) (:foreground "red")) | |
3824 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | |
3825 | (t (:bold t)))) | |
3826 | "Face for items scheduled previously, and not yet done." | |
3827 | :group 'org-faces) | |
3828 | ||
c4b5acde CD |
3829 | (defface org-upcoming-deadline |
3830 | (org-compatible-face | |
d5098885 | 3831 | nil |
c4b5acde CD |
3832 | '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) |
3833 | (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) | |
3834 | (((class color) (min-colors 8) (background light)) (:foreground "red")) | |
3835 | (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) | |
3836 | (t (:bold t)))) | |
3837 | "Face for items scheduled previously, and not yet done." | |
3838 | :group 'org-faces) | |
3839 | ||
48aaad2d CD |
3840 | (defcustom org-agenda-deadline-faces |
3841 | '((1.0 . org-warning) | |
3842 | (0.5 . org-upcoming-deadline) | |
3843 | (0.0 . default)) | |
3844 | "Faces for showing deadlines in the agenda. | |
3845 | This is a list of cons cells. The cdr of each cess is a face to be used, | |
3846 | and it can also just be a like like '(:foreground \"yellow\"). | |
3847 | Each car is a fraction of the head-warning time that must have passed for | |
3848 | this the face in the cdr to be used for display. The numbers must be | |
3849 | given in descending order. The head-warning time is normally taken | |
3850 | from `org-deadline-warning-days', but can also be specified in the deadline | |
3851 | timestamp itself, like this: | |
3852 | ||
3853 | DEADLINE: <2007-08-13 Mon -8d> | |
3854 | ||
3855 | You may use d for days, w for weeks, m for months and y for years. Months | |
3856 | and years will only be treated in an approximate fashion (30.4 days for a | |
3857 | month and 365.24 days for a year)." | |
3858 | :group 'org-faces | |
3859 | :group 'org-agenda-daily/weekly | |
3860 | :type '(repeat | |
3861 | (cons | |
3862 | (number :tag "Fraction of head-warning time passed") | |
3863 | (sexp :tag "Face")))) | |
3864 | ||
8e49668e | 3865 | (defface org-time-grid ;; font-lock-variable-name-face |
d943b3c6 | 3866 | (org-compatible-face |
d5098885 | 3867 | nil |
d943b3c6 CD |
3868 | '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) |
3869 | (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) | |
4b3a9ba7 | 3870 | (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) |
b0a10108 | 3871 | "Face used for time grids." |
ab27a4a0 | 3872 | :group 'org-faces) |
eb2f9c59 | 3873 | |
d943b3c6 | 3874 | (defconst org-level-faces |
7204b00e CD |
3875 | '(org-level-1 org-level-2 org-level-3 org-level-4 |
3876 | org-level-5 org-level-6 org-level-7 org-level-8 | |
3877 | )) | |
891f4676 | 3878 | |
1e8fbb6d CD |
3879 | (defcustom org-n-level-faces (length org-level-faces) |
3880 | "The number different faces to be used for headlines. | |
3881 | Org-mode defines 8 different headline faces, so this can be at most 8. | |
3882 | If it is less than 8, the level-1 face gets re-used for level N+1 etc." | |
3883 | :type 'number | |
3884 | :group 'org-faces) | |
ab27a4a0 | 3885 | |
182aef95 DN |
3886 | ;;; Function declarations. |
3887 | (declare-function add-to-diary-list "diary-lib" | |
3888 | (date string specifier &optional marker globcolor literal)) | |
3889 | (declare-function table--at-cell-p "table" (position &optional object at-column)) | |
3890 | (declare-function Info-find-node "info" (filename nodename &optional no-going-back)) | |
f30cf46c | 3891 | (declare-function Info-goto-node "info" (nodename &optional fork)) |
182aef95 DN |
3892 | (declare-function bbdb "ext:bbdb-com" (string elidep)) |
3893 | (declare-function bbdb-company "ext:bbdb-com" (string elidep)) | |
3894 | (declare-function bbdb-current-record "ext:bbdb-com" (&optional planning-on-modifying)) | |
3895 | (declare-function bbdb-name "ext:bbdb-com" (string elidep)) | |
3896 | (declare-function bbdb-record-getprop "ext:bbdb" (record property)) | |
3897 | (declare-function bbdb-record-name "ext:bbdb" (record)) | |
3898 | (declare-function bibtex-beginning-of-entry "bibtex" ()) | |
3899 | (declare-function bibtex-generate-autokey "bibtex" ()) | |
3900 | (declare-function bibtex-parse-entry "bibtex" (&optional content)) | |
3901 | (declare-function bibtex-url "bibtex" (&optional pos no-browse)) | |
f30cf46c GM |
3902 | (declare-function calendar-astro-date-string "cal-julian" (&optional date)) |
3903 | (declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) | |
3904 | (declare-function calendar-check-holidays "holidays" (date)) | |
3905 | (declare-function calendar-chinese-date-string "cal-china" (&optional date)) | |
3906 | (declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) | |
3907 | (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) | |
3908 | (declare-function calendar-forward-day "cal-move" (arg)) | |
3909 | (declare-function calendar-french-date-string "cal-french" (&optional date)) | |
3910 | (declare-function calendar-goto-date "cal-move" (date)) | |
3911 | (declare-function calendar-goto-today "cal-move" ()) | |
3912 | (declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) | |
3913 | (declare-function calendar-islamic-date-string "cal-islam" (&optional date)) | |
3914 | (declare-function calendar-iso-date-string "cal-iso" (&optional date)) | |
3915 | (declare-function calendar-julian-date-string "cal-julian" (&optional date)) | |
3916 | (declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) | |
3917 | (declare-function calendar-persian-date-string "cal-persia" (&optional date)) | |
182aef95 DN |
3918 | (declare-function cdlatex-tab "ext:cdlatex" ()) |
3919 | (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) | |
3920 | (declare-function gnus-article-show-summary "gnus-art" ()) | |
f30cf46c | 3921 | (declare-function gnus-summary-last-subject "gnus-sum" ()) |
182aef95 DN |
3922 | (declare-function mh-display-msg "mh-show" (msg-num folder-name)) |
3923 | (declare-function mh-find-path "mh-utils" ()) | |
3924 | (declare-function mh-get-header-field "mh-utils" (field)) | |
3925 | (declare-function mh-get-msg-num "mh-utils" (error-if-no-message)) | |
3926 | (declare-function mh-header-display "mh-show" ()) | |
3927 | (declare-function mh-index-previous-folder "mh-search" ()) | |
3928 | (declare-function mh-normalize-folder-name "mh-utils" (folder &optional empty-string-okay dont-remove-trailing-slash return-nil-if-folder-empty)) | |
3929 | (declare-function mh-search "mh-search" (folder search-regexp &optional redo-search-flag window-config)) | |
3930 | (declare-function mh-search-choose "mh-search" (&optional searcher)) | |
3931 | (declare-function mh-show "mh-show" (&optional message redisplay-flag)) | |
3932 | (declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer)) | |
3933 | (declare-function mh-show-header-display "mh-show" t t) | |
3934 | (declare-function mh-show-msg "mh-show" (msg)) | |
3935 | (declare-function mh-show-show "mh-show" t t) | |
3936 | (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)) | |
f30cf46c | 3938 | (declare-function parse-time-string "parse-time" (string)) |
182aef95 DN |
3939 | (declare-function remember "remember" (&optional initial)) |
3940 | (declare-function remember-buffer-desc "remember" ()) | |
3941 | (declare-function rmail-narrow-to-non-pruned-header "rmail" ()) | |
f30cf46c | 3942 | (declare-function rmail-show-message "rmail" (&optional n no-summary)) |
182aef95 DN |
3943 | (declare-function rmail-what-message "rmail" ()) |
3944 | (declare-function elmo-folder-exists-p "ext:elmo" (folder) t) | |
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" ()) | |
3948 | (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)) | |
3950 | (declare-function vm-isearch-narrow "ext:vm-search" ()) | |
3951 | (declare-function vm-isearch-update "ext:vm-search" ()) | |
3952 | (declare-function vm-select-folder-buffer "ext:vm-macro" ()) | |
3953 | (declare-function vm-su-message-id "ext:vm-summary" (m)) | |
3954 | (declare-function vm-su-subject "ext:vm-summary" (m)) | |
3955 | (declare-function vm-summarize "ext:vm-summary" (&optional display raise)) | |
3956 | (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)) | |
3958 | (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" (&optional id)) | |
3959 | (declare-function wl-summary-line-from "ext:wl-summary" ()) | |
3960 | (declare-function wl-summary-line-subject "ext:wl-summary" ()) | |
3961 | (declare-function wl-summary-message-number "ext:wl-summary" ()) | |
3962 | (declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) | |
3963 | ||
d3f4dbe8 CD |
3964 | ;;; Variables for pre-computed regular expressions, all buffer local |
3965 | ||
5152b597 CD |
3966 | (defvar org-drawer-regexp nil |
3967 | "Matches first line of a hidden block.") | |
3968 | (make-variable-buffer-local 'org-drawer-regexp) | |
ab27a4a0 CD |
3969 | (defvar org-todo-regexp nil |
3970 | "Matches any of the TODO state keywords.") | |
3971 | (make-variable-buffer-local 'org-todo-regexp) | |
3972 | (defvar org-not-done-regexp nil | |
3973 | "Matches any of the TODO state keywords except the last one.") | |
3974 | (make-variable-buffer-local 'org-not-done-regexp) | |
3975 | (defvar org-todo-line-regexp nil | |
3976 | "Matches a headline and puts TODO state into group 2 if present.") | |
3977 | (make-variable-buffer-local 'org-todo-line-regexp) | |
03f3cf35 JW |
3978 | (defvar org-complex-heading-regexp nil |
3979 | "Matches a headline and puts everything into groups: | |
3980 | group 1: the stars | |
3981 | group 2: The todo keyword, maybe | |
3982 | group 3: Priority cookie | |
3983 | group 4: True headline | |
3984 | group 5: Tags") | |
3985 | (make-variable-buffer-local 'org-complex-heading-regexp) | |
c4b5acde CD |
3986 | (defvar org-todo-line-tags-regexp nil |
3987 | "Matches a headline and puts TODO state into group 2 if present. | |
3988 | Also put tags into group 4 if tags are present.") | |
3989 | (make-variable-buffer-local 'org-todo-line-tags-regexp) | |
ab27a4a0 CD |
3990 | (defvar org-nl-done-regexp nil |
3991 | "Matches newline followed by a headline with the DONE keyword.") | |
3992 | (make-variable-buffer-local 'org-nl-done-regexp) | |
3993 | (defvar org-looking-at-done-regexp nil | |
3994 | "Matches the DONE keyword a point.") | |
3995 | (make-variable-buffer-local 'org-looking-at-done-regexp) | |
ab27a4a0 CD |
3996 | (defvar org-ds-keyword-length 12 |
3997 | "Maximum length of the Deadline and SCHEDULED keywords.") | |
3998 | (make-variable-buffer-local 'org-ds-keyword-length) | |
3999 | (defvar org-deadline-regexp nil | |
4000 | "Matches the DEADLINE keyword.") | |
4001 | (make-variable-buffer-local 'org-deadline-regexp) | |
4002 | (defvar org-deadline-time-regexp nil | |
4003 | "Matches the DEADLINE keyword together with a time stamp.") | |
4004 | (make-variable-buffer-local 'org-deadline-time-regexp) | |
4005 | (defvar org-deadline-line-regexp nil | |
4006 | "Matches the DEADLINE keyword and the rest of the line.") | |
4007 | (make-variable-buffer-local 'org-deadline-line-regexp) | |
4008 | (defvar org-scheduled-regexp nil | |
4009 | "Matches the SCHEDULED keyword.") | |
4010 | (make-variable-buffer-local 'org-scheduled-regexp) | |
4011 | (defvar org-scheduled-time-regexp nil | |
4012 | "Matches the SCHEDULED keyword together with a time stamp.") | |
4013 | (make-variable-buffer-local 'org-scheduled-time-regexp) | |
4b3a9ba7 CD |
4014 | (defvar org-closed-time-regexp nil |
4015 | "Matches the CLOSED keyword together with a time stamp.") | |
4016 | (make-variable-buffer-local 'org-closed-time-regexp) | |
4017 | ||
4018 | (defvar org-keyword-time-regexp nil | |
d3f4dbe8 | 4019 | "Matches any of the 4 keywords, together with the time stamp.") |
4b3a9ba7 | 4020 | (make-variable-buffer-local 'org-keyword-time-regexp) |
d3f4dbe8 CD |
4021 | (defvar org-keyword-time-not-clock-regexp nil |
4022 | "Matches any of the 3 keywords, together with the time stamp.") | |
4023 | (make-variable-buffer-local 'org-keyword-time-not-clock-regexp) | |
4b3a9ba7 CD |
4024 | (defvar org-maybe-keyword-time-regexp nil |
4025 | "Matches a timestamp, possibly preceeded by a keyword.") | |
d3f4dbe8 | 4026 | (make-variable-buffer-local 'org-maybe-keyword-time-regexp) |
a3fbe8c4 CD |
4027 | (defvar org-planning-or-clock-line-re nil |
4028 | "Matches a line with planning or clock info.") | |
4029 | (make-variable-buffer-local 'org-planning-or-clock-line-re) | |
4b3a9ba7 CD |
4030 | |
4031 | (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t | |
d3f4dbe8 | 4032 | rear-nonsticky t mouse-map t fontified t) |
4b3a9ba7 CD |
4033 | "Properties to remove when a string without properties is wanted.") |
4034 | ||
4035 | (defsubst org-match-string-no-properties (num &optional string) | |
4036 | (if (featurep 'xemacs) | |
4037 | (let ((s (match-string num string))) | |
4038 | (remove-text-properties 0 (length s) org-rm-props s) | |
4039 | s) | |
4040 | (match-string-no-properties num string))) | |
4041 | ||
4042 | (defsubst org-no-properties (s) | |
38f8646b CD |
4043 | (if (fboundp 'set-text-properties) |
4044 | (set-text-properties 0 (length s) nil s) | |
4045 | (remove-text-properties 0 (length s) org-rm-props s)) | |
4b3a9ba7 | 4046 | s) |
ab27a4a0 | 4047 | |
3278a016 CD |
4048 | (defsubst org-get-alist-option (option key) |
4049 | (cond ((eq key t) t) | |
4050 | ((eq option t) t) | |
4051 | ((assoc key option) (cdr (assoc key option))) | |
4052 | (t (cdr (assq 'default option))))) | |
4053 | ||
a3fbe8c4 CD |
4054 | (defsubst org-inhibit-invisibility () |
4055 | "Modified `buffer-invisibility-spec' for Emacs 21. | |
4056 | Some ops with invisible text do not work correctly on Emacs 21. For these | |
4057 | we turn off invisibility temporarily. Use this in a `let' form." | |
4058 | (if (< emacs-major-version 22) nil buffer-invisibility-spec)) | |
4059 | ||
5137195a CD |
4060 | (defsubst org-set-local (var value) |
4061 | "Make VAR local in current buffer and set it to VALUE." | |
4062 | (set (make-variable-buffer-local var) value)) | |
4063 | ||
b928f99a CD |
4064 | (defsubst org-mode-p () |
4065 | "Check if the current buffer is in Org-mode." | |
4066 | (eq major-mode 'org-mode)) | |
4067 | ||
3278a016 CD |
4068 | (defsubst org-last (list) |
4069 | "Return the last element of LIST." | |
4070 | (car (last list))) | |
4071 | ||
4072 | (defun org-let (list &rest body) | |
4073 | (eval (cons 'let (cons list body)))) | |
4074 | (put 'org-let 'lisp-indent-function 1) | |
4075 | ||
4076 | (defun org-let2 (list1 list2 &rest body) | |
4077 | (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) | |
4078 | (put 'org-let2 'lisp-indent-function 2) | |
3278a016 CD |
4079 | (defconst org-startup-options |
4080 | '(("fold" org-startup-folded t) | |
4081 | ("overview" org-startup-folded t) | |
4082 | ("nofold" org-startup-folded nil) | |
4083 | ("showall" org-startup-folded nil) | |
4084 | ("content" org-startup-folded content) | |
4085 | ("hidestars" org-hide-leading-stars t) | |
4086 | ("showstars" org-hide-leading-stars nil) | |
4087 | ("odd" org-odd-levels-only t) | |
4088 | ("oddeven" org-odd-levels-only nil) | |
4089 | ("align" org-startup-align-all-tables t) | |
4090 | ("noalign" org-startup-align-all-tables nil) | |
4091 | ("customtime" org-display-custom-times t) | |
4092 | ("logging" org-log-done t) | |
d3f4dbe8 | 4093 | ("logdone" org-log-done t) |
3278a016 | 4094 | ("nologging" org-log-done nil) |
d3f4dbe8 CD |
4095 | ("lognotedone" org-log-done done push) |
4096 | ("lognotestate" org-log-done state push) | |
a3fbe8c4 CD |
4097 | ("lognoteclock-out" org-log-done clock-out push) |
4098 | ("logrepeat" org-log-repeat t) | |
4099 | ("nologrepeat" org-log-repeat nil) | |
4100 | ("constcgs" constants-unit-system cgs) | |
4101 | ("constSI" constants-unit-system SI)) | |
d3f4dbe8 CD |
4102 | "Variable associated with STARTUP options for org-mode. |
4103 | Each element is a list of three items: The startup options as written | |
4104 | in the #+STARTUP line, the corresponding variable, and the value to | |
4105 | set this variable to if the option is found. An optional forth element PUSH | |
4106 | means to push this value onto the list in the variable.") | |
3278a016 | 4107 | |
1d676e9f CD |
4108 | (defun org-set-regexps-and-options () |
4109 | "Precompute regular expressions for current buffer." | |
b928f99a | 4110 | (when (org-mode-p) |
a3fbe8c4 | 4111 | (org-set-local 'org-todo-kwd-alist nil) |
0b8568f5 JW |
4112 | (org-set-local 'org-todo-key-alist nil) |
4113 | (org-set-local 'org-todo-key-trigger nil) | |
a3fbe8c4 CD |
4114 | (org-set-local 'org-todo-keywords-1 nil) |
4115 | (org-set-local 'org-done-keywords nil) | |
4116 | (org-set-local 'org-todo-heads nil) | |
4117 | (org-set-local 'org-todo-sets nil) | |
d5098885 | 4118 | (org-set-local 'org-todo-log-states nil) |
1d676e9f | 4119 | (let ((re (org-make-options-regexp |
d5098885 | 4120 | '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" |
38f8646b | 4121 | "STARTUP" "ARCHIVE" "TAGS" "LINK" "PRIORITIES" |
03f3cf35 | 4122 | "CONSTANTS" "PROPERTY" "DRAWERS"))) |
1d676e9f | 4123 | (splitre "[ \t]+") |
374585c9 | 4124 | kwds kws0 kwsa key value cat arch tags const links hw dws |
03f3cf35 JW |
4125 | tail sep kws1 prio props drawers |
4126 | ex log) | |
1d676e9f CD |
4127 | (save-excursion |
4128 | (save-restriction | |
4129 | (widen) | |
4130 | (goto-char (point-min)) | |
4131 | (while (re-search-forward re nil t) | |
4b3a9ba7 | 4132 | (setq key (match-string 1) value (org-match-string-no-properties 2)) |
1d676e9f CD |
4133 | (cond |
4134 | ((equal key "CATEGORY") | |
4135 | (if (string-match "[ \t]+$" value) | |
4136 | (setq value (replace-match "" t t value))) | |
4137 | (setq cat (intern value))) | |
d5098885 | 4138 | ((member key '("SEQ_TODO" "TODO")) |
a3fbe8c4 | 4139 | (push (cons 'sequence (org-split-string value splitre)) kwds)) |
1d676e9f | 4140 | ((equal key "TYP_TODO") |
a3fbe8c4 | 4141 | (push (cons 'type (org-split-string value splitre)) kwds)) |
4b3a9ba7 CD |
4142 | ((equal key "TAGS") |
4143 | (setq tags (append tags (org-split-string value splitre)))) | |
38f8646b | 4144 | ((equal key "COLUMNS") |
7d58338e | 4145 | (org-set-local 'org-columns-default-format value)) |
3278a016 CD |
4146 | ((equal key "LINK") |
4147 | (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) | |
4148 | (push (cons (match-string 1 value) | |
4149 | (org-trim (match-string 2 value))) | |
4150 | links))) | |
a3fbe8c4 CD |
4151 | ((equal key "PRIORITIES") |
4152 | (setq prio (org-split-string value " +"))) | |
48aaad2d CD |
4153 | ((equal key "PROPERTY") |
4154 | (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) | |
4155 | (push (cons (match-string 1 value) (match-string 2 value)) | |
4156 | props))) | |
03f3cf35 JW |
4157 | ((equal key "DRAWERS") |
4158 | (setq drawers (org-split-string value splitre))) | |
38f8646b CD |
4159 | ((equal key "CONSTANTS") |
4160 | (setq const (append const (org-split-string value splitre)))) | |
1d676e9f CD |
4161 | ((equal key "STARTUP") |
4162 | (let ((opts (org-split-string value splitre)) | |
1d676e9f | 4163 | l var val) |
a3fbe8c4 CD |
4164 | (while (setq l (pop opts)) |
4165 | (when (setq l (assoc l org-startup-options)) | |
4166 | (setq var (nth 1 l) val (nth 2 l)) | |
4167 | (if (not (nth 3 l)) | |
4168 | (set (make-local-variable var) val) | |
4169 | (if (not (listp (symbol-value var))) | |
4170 | (set (make-local-variable var) nil)) | |
4171 | (set (make-local-variable var) (symbol-value var)) | |
4172 | (add-to-list var val)))))) | |
1d676e9f CD |
4173 | ((equal key "ARCHIVE") |
4174 | (string-match " *$" value) | |
4175 | (setq arch (replace-match "" t t value)) | |
4176 | (remove-text-properties 0 (length arch) | |
4177 | '(face t fontified t) arch))) | |
4178 | ))) | |
5137195a | 4179 | (and cat (org-set-local 'org-category cat)) |
a3fbe8c4 CD |
4180 | (when prio |
4181 | (if (< (length prio) 3) (setq prio '("A" "C" "B"))) | |
4182 | (setq prio (mapcar 'string-to-char prio)) | |
4183 | (org-set-local 'org-highest-priority (nth 0 prio)) | |
4184 | (org-set-local 'org-lowest-priority (nth 1 prio)) | |
4185 | (org-set-local 'org-default-priority (nth 2 prio))) | |
48aaad2d | 4186 | (and props (org-set-local 'org-local-properties (nreverse props))) |
03f3cf35 | 4187 | (and drawers (org-set-local 'org-drawers drawers)) |
5137195a | 4188 | (and arch (org-set-local 'org-archive-location arch)) |
3278a016 | 4189 | (and links (setq org-link-abbrev-alist-local (nreverse links))) |
a3fbe8c4 CD |
4190 | ;; Process the TODO keywords |
4191 | (unless kwds | |
4192 | ;; Use the global values as if they had been given locally. | |
4193 | (setq kwds (default-value 'org-todo-keywords)) | |
4194 | (if (stringp (car kwds)) | |
4195 | (setq kwds (list (cons org-todo-interpretation | |
4196 | (default-value 'org-todo-keywords))))) | |
4197 | (setq kwds (reverse kwds))) | |
4198 | (setq kwds (nreverse kwds)) | |
d5098885 | 4199 | (let (inter kws kw) |
a3fbe8c4 CD |
4200 | (while (setq kws (pop kwds)) |
4201 | (setq inter (pop kws) sep (member "|" kws) | |
374585c9 CD |
4202 | kws0 (delete "|" (copy-sequence kws)) |
4203 | kwsa nil | |
d5098885 JW |
4204 | kws1 (mapcar |
4205 | (lambda (x) | |
4206 | (if (string-match "^\\(.*?\\)\\(?:(\\(..?\\))\\)?$" x) | |
4207 | (progn | |
4208 | (setq kw (match-string 1 x) | |
4209 | ex (and (match-end 2) (match-string 2 x)) | |
4210 | log (and ex (string-match "@" ex)) | |
4211 | key (and ex (substring ex 0 1))) | |
4212 | (if (equal key "@") (setq key nil)) | |
4213 | (push (cons kw (and key (string-to-char key))) kwsa) | |
4214 | (and log (push kw org-todo-log-states)) | |
4215 | kw) | |
4216 | (error "Invalid TODO keyword %s" x))) | |
4217 | kws0) | |
0b8568f5 JW |
4218 | kwsa (if kwsa (append '((:startgroup)) |
4219 | (nreverse kwsa) | |
4220 | '((:endgroup)))) | |
a3fbe8c4 | 4221 | hw (car kws1) |
a2ac8d76 | 4222 | dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) |
a3fbe8c4 CD |
4223 | tail (list inter hw (car dws) (org-last dws))) |
4224 | (add-to-list 'org-todo-heads hw 'append) | |
4225 | (push kws1 org-todo-sets) | |
4226 | (setq org-done-keywords (append org-done-keywords dws nil)) | |
0b8568f5 | 4227 | (setq org-todo-key-alist (append org-todo-key-alist kwsa)) |
a3fbe8c4 CD |
4228 | (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) |
4229 | (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) | |
4230 | (setq org-todo-sets (nreverse org-todo-sets) | |
0b8568f5 JW |
4231 | org-todo-kwd-alist (nreverse org-todo-kwd-alist) |
4232 | org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) | |
4233 | org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) | |
38f8646b CD |
4234 | ;; Process the constants |
4235 | (when const | |
4236 | (let (e cst) | |
4237 | (while (setq e (pop const)) | |
4238 | (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) | |
4239 | (push (cons (match-string 1 e) (match-string 2 e)) cst))) | |
4240 | (setq org-table-formula-constants-local cst))) | |
4241 | ||
a3fbe8c4 | 4242 | ;; Process the tags. |
4b3a9ba7 | 4243 | (when tags |
6769c0dc | 4244 | (let (e tgs) |
4b3a9ba7 | 4245 | (while (setq e (pop tags)) |
7d143c25 CD |
4246 | (cond |
4247 | ((equal e "{") (push '(:startgroup) tgs)) | |
4248 | ((equal e "}") (push '(:endgroup) tgs)) | |
5152b597 | 4249 | ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) |
7d143c25 CD |
4250 | (push (cons (match-string 1 e) |
4251 | (string-to-char (match-string 2 e))) | |
4252 | tgs)) | |
4253 | (t (push (list e) tgs)))) | |
5137195a | 4254 | (org-set-local 'org-tag-alist nil) |
4b3a9ba7 | 4255 | (while (setq e (pop tgs)) |
7d143c25 CD |
4256 | (or (and (stringp (car e)) |
4257 | (assoc (car e) org-tag-alist)) | |
4b3a9ba7 CD |
4258 | (push e org-tag-alist)))))) |
4259 | ||
1d676e9f | 4260 | ;; Compute the regular expressions and other local variables |
a3fbe8c4 CD |
4261 | (if (not org-done-keywords) |
4262 | (setq org-done-keywords (list (org-last org-todo-keywords-1)))) | |
4263 | (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) | |
1d676e9f | 4264 | (length org-scheduled-string))) |
5152b597 CD |
4265 | org-drawer-regexp |
4266 | (concat "^[ \t]*:\\(" | |
4267 | (mapconcat 'regexp-quote org-drawers "\\|") | |
4268 | "\\):[ \t]*$") | |
a3fbe8c4 CD |
4269 | org-not-done-keywords |
4270 | (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) | |
1d676e9f | 4271 | org-todo-regexp |
a3fbe8c4 | 4272 | (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 |
1d676e9f CD |
4273 | "\\|") "\\)\\>") |
4274 | org-not-done-regexp | |
4275 | (concat "\\<\\(" | |
a3fbe8c4 | 4276 | (mapconcat 'regexp-quote org-not-done-keywords "\\|") |
1d676e9f CD |
4277 | "\\)\\>") |
4278 | org-todo-line-regexp | |
7d58338e | 4279 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" |
a3fbe8c4 | 4280 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") |
1e8fbb6d | 4281 | "\\)\\>\\)?[ \t]*\\(.*\\)") |
03f3cf35 JW |
4282 | org-complex-heading-regexp |
4283 | (concat "^\\(\\*+\\)\\(?:[ \t]+\\(" | |
4284 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
4285 | "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" | |
4286 | "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") | |
1d676e9f | 4287 | org-nl-done-regexp |
7d58338e | 4288 | (concat "\n\\*+[ \t]+" |
a3fbe8c4 CD |
4289 | "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") |
4290 | "\\)" "\\>") | |
c4b5acde | 4291 | org-todo-line-tags-regexp |
7d58338e | 4292 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" |
a3fbe8c4 | 4293 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") |
5152b597 CD |
4294 | (org-re |
4295 | "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) | |
a3fbe8c4 CD |
4296 | org-looking-at-done-regexp |
4297 | (concat "^" "\\(?:" | |
4298 | (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" | |
4299 | "\\>") | |
1d676e9f CD |
4300 | org-deadline-regexp (concat "\\<" org-deadline-string) |
4301 | org-deadline-time-regexp | |
4302 | (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") | |
4303 | org-deadline-line-regexp | |
4304 | (concat "\\<\\(" org-deadline-string "\\).*") | |
4305 | org-scheduled-regexp | |
4306 | (concat "\\<" org-scheduled-string) | |
4307 | org-scheduled-time-regexp | |
4b3a9ba7 CD |
4308 | (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") |
4309 | org-closed-time-regexp | |
4310 | (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") | |
4311 | org-keyword-time-regexp | |
4312 | (concat "\\<\\(" org-scheduled-string | |
4313 | "\\|" org-deadline-string | |
edd21304 CD |
4314 | "\\|" org-closed-string |
4315 | "\\|" org-clock-string "\\)" | |
f85d958a | 4316 | " *[[<]\\([^]>]+\\)[]>]") |
d3f4dbe8 CD |
4317 | org-keyword-time-not-clock-regexp |
4318 | (concat "\\<\\(" org-scheduled-string | |
4319 | "\\|" org-deadline-string | |
38f8646b | 4320 | "\\|" org-closed-string |
38f8646b | 4321 | "\\)" |
d3f4dbe8 | 4322 | " *[[<]\\([^]>]+\\)[]>]") |
4b3a9ba7 CD |
4323 | org-maybe-keyword-time-regexp |
4324 | (concat "\\(\\<\\(" org-scheduled-string | |
4325 | "\\|" org-deadline-string | |
edd21304 CD |
4326 | "\\|" org-closed-string |
4327 | "\\|" org-clock-string "\\)\\)?" | |
a3fbe8c4 CD |
4328 | " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") |
4329 | org-planning-or-clock-line-re | |
4330 | (concat "\\(?:^[ \t]*\\(" org-scheduled-string | |
4331 | "\\|" org-deadline-string | |
38f8646b | 4332 | "\\|" org-closed-string "\\|" org-clock-string |
374585c9 | 4333 | "\\)\\>\\)") |
a3fbe8c4 | 4334 | ) |
4b3a9ba7 | 4335 | |
1d676e9f CD |
4336 | (org-set-font-lock-defaults))) |
4337 | ||
a2ac8d76 CD |
4338 | (defun org-remove-keyword-keys (list) |
4339 | (mapcar (lambda (x) | |
d5098885 | 4340 | (if (string-match "(..?)$" x) |
a2ac8d76 CD |
4341 | (substring x 0 (match-beginning 0)) |
4342 | x)) | |
4343 | list)) | |
d3f4dbe8 CD |
4344 | |
4345 | ;;; Some variables ujsed in various places | |
4346 | ||
4347 | (defvar org-window-configuration nil | |
4348 | "Used in various places to store a window configuration.") | |
4349 | (defvar org-finish-function nil | |
4350 | "Function to be called when `C-c C-c' is used. | |
4351 | This is for getting out of special buffers like remember.") | |
4352 | ||
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) | |
ab27a4a0 | 4359 | (defvar zmacs-regions) ; XEmacs regions |
d3f4dbe8 CD |
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) | |
257b8401 CD |
4388 | (defvar remember-register) |
4389 | (defvar remember-buffer) | |
ab27a4a0 CD |
4390 | (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' |
4391 | (defvar initial) ; from remember.el, dynamically scoped in `remember-mode' | |
e39856be | 4392 | (defvar org-latex-regexps) |
a3fbe8c4 | 4393 | (defvar constants-unit-system) |
4b3a9ba7 | 4394 | |
d3f4dbe8 CD |
4395 | (defvar original-date) ; dynamically scoped in calendar.el does scope this |
4396 | ||
4397 | ;; FIXME: Occasionally check by commenting these, to make sure | |
4398 | ;; no other functions uses these, forgetting to let-bind them. | |
4399 | (defvar entry) | |
4400 | (defvar state) | |
4401 | (defvar last-state) | |
4402 | (defvar date) | |
4403 | (defvar description) | |
4404 | ||
4405 | ||
4406 | ;; Defined somewhere in this file, but used before definition. | |
4407 | (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized | |
374585c9 | 4408 | (defvar org-agenda-buffer-name) |
d3f4dbe8 CD |
4409 | (defvar org-agenda-undo-list) |
4410 | (defvar org-agenda-pending-undo-list) | |
4411 | (defvar org-agenda-overriding-header) | |
4412 | (defvar orgtbl-mode) | |
4413 | (defvar org-html-entities) | |
4414 | (defvar org-struct-menu) | |
4415 | (defvar org-org-menu) | |
4416 | (defvar org-tbl-menu) | |
4417 | (defvar org-agenda-keymap) | |
d3f4dbe8 CD |
4418 | |
4419 | ;;;; Emacs/XEmacs compatibility | |
4420 | ||
4421 | ;; Overlay compatibility functions | |
4422 | (defun org-make-overlay (beg end &optional buffer) | |
4423 | (if (featurep 'xemacs) | |
4424 | (make-extent beg end buffer) | |
4425 | (make-overlay beg end buffer))) | |
4426 | (defun org-delete-overlay (ovl) | |
4427 | (if (featurep 'xemacs) (delete-extent ovl) (delete-overlay ovl))) | |
4428 | (defun org-detach-overlay (ovl) | |
4429 | (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) | |
4430 | (defun org-move-overlay (ovl beg end &optional buffer) | |
4431 | (if (featurep 'xemacs) | |
4432 | (set-extent-endpoints ovl beg end (or buffer (current-buffer))) | |
4433 | (move-overlay ovl beg end buffer))) | |
4434 | (defun org-overlay-put (ovl prop value) | |
4435 | (if (featurep 'xemacs) | |
4436 | (set-extent-property ovl prop value) | |
4437 | (overlay-put ovl prop value))) | |
4438 | (defun org-overlay-display (ovl text &optional face evap) | |
4439 | "Make overlay OVL display TEXT with face FACE." | |
4440 | (if (featurep 'xemacs) | |
4441 | (let ((gl (make-glyph text))) | |
4442 | (and face (set-glyph-face gl face)) | |
4443 | (set-extent-property ovl 'invisible t) | |
4444 | (set-extent-property ovl 'end-glyph gl)) | |
4445 | (overlay-put ovl 'display text) | |
4446 | (if face (overlay-put ovl 'face face)) | |
4447 | (if evap (overlay-put ovl 'evaporate t)))) | |
4448 | (defun org-overlay-before-string (ovl text &optional face evap) | |
4449 | "Make overlay OVL display TEXT with face FACE." | |
4450 | (if (featurep 'xemacs) | |
4451 | (let ((gl (make-glyph text))) | |
4452 | (and face (set-glyph-face gl face)) | |
4453 | (set-extent-property ovl 'begin-glyph gl)) | |
4454 | (if face (org-add-props text nil 'face face)) | |
4455 | (overlay-put ovl 'before-string text) | |
4456 | (if evap (overlay-put ovl 'evaporate t)))) | |
4457 | (defun org-overlay-get (ovl prop) | |
4458 | (if (featurep 'xemacs) | |
4459 | (extent-property ovl prop) | |
4460 | (overlay-get ovl prop))) | |
4461 | (defun org-overlays-at (pos) | |
4462 | (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) | |
4463 | (defun org-overlays-in (&optional start end) | |
4464 | (if (featurep 'xemacs) | |
4465 | (extent-list nil start end) | |
4466 | (overlays-in start end))) | |
4467 | (defun org-overlay-start (o) | |
4468 | (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) | |
4469 | (defun org-overlay-end (o) | |
4470 | (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) | |
4471 | (defun org-find-overlays (prop &optional pos delete) | |
4472 | "Find all overlays specifying PROP at POS or point. | |
4473 | If DELETE is non-nil, delete all those overlays." | |
4474 | (let ((overlays (org-overlays-at (or pos (point)))) | |
4475 | ov found) | |
4476 | (while (setq ov (pop overlays)) | |
4477 | (if (org-overlay-get ov prop) | |
4478 | (if delete (org-delete-overlay ov) (push ov found)))) | |
4479 | found)) | |
4480 | ||
4481 | ;; Region compatibility | |
4482 | ||
4483 | (defun org-add-hook (hook function &optional append local) | |
4484 | "Add-hook, compatible with both Emacsen." | |
4485 | (if (and local (featurep 'xemacs)) | |
4486 | (add-local-hook hook function append) | |
4487 | (add-hook hook function append local))) | |
4488 | ||
4489 | (defvar org-ignore-region nil | |
4490 | "To temporarily disable the active region.") | |
4491 | ||
4492 | (defun org-region-active-p () | |
4493 | "Is `transient-mark-mode' on and the region active? | |
4494 | Works on both Emacs and XEmacs." | |
4495 | (if org-ignore-region | |
4496 | nil | |
4497 | (if (featurep 'xemacs) | |
4498 | (and zmacs-regions (region-active-p)) | |
4499 | (and transient-mark-mode mark-active)))) | |
4500 | ||
4501 | ;; Invisibility compatibility | |
4502 | ||
4503 | (defun org-add-to-invisibility-spec (arg) | |
4504 | "Add elements to `buffer-invisibility-spec'. | |
4505 | See documentation for `buffer-invisibility-spec' for the kind of elements | |
4506 | that can be added." | |
4507 | (cond | |
4508 | ((fboundp 'add-to-invisibility-spec) | |
4509 | (add-to-invisibility-spec arg)) | |
4510 | ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) | |
4511 | (setq buffer-invisibility-spec (list arg))) | |
4512 | (t | |
4513 | (setq buffer-invisibility-spec | |
4514 | (cons arg buffer-invisibility-spec))))) | |
4515 | ||
4516 | (defun org-remove-from-invisibility-spec (arg) | |
4517 | "Remove elements from `buffer-invisibility-spec'." | |
4518 | (if (fboundp 'remove-from-invisibility-spec) | |
4519 | (remove-from-invisibility-spec arg) | |
4520 | (if (consp buffer-invisibility-spec) | |
4521 | (setq buffer-invisibility-spec | |
4522 | (delete arg buffer-invisibility-spec))))) | |
4523 | ||
4524 | (defun org-in-invisibility-spec-p (arg) | |
4525 | "Is ARG a member of `buffer-invisibility-spec'?" | |
4526 | (if (consp buffer-invisibility-spec) | |
4527 | (member arg buffer-invisibility-spec) | |
4528 | nil)) | |
4529 | ||
4530 | ;;;; Define the Org-mode | |
891f4676 | 4531 | |
98644ad4 CD |
4532 | (if (and (not (keymapp outline-mode-map)) (featurep 'allout)) |
4533 | (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.")) | |
891f4676 | 4534 | |
891f4676 | 4535 | |
634a7d0b CD |
4536 | ;; We use a before-change function to check if a table might need |
4537 | ;; an update. | |
4538 | (defvar org-table-may-need-update t | |
b0a10108 | 4539 | "Indicates that a table might need an update. |
35402b98 | 4540 | This variable is set by `org-before-change-function'. |
79c4be8e | 4541 | `org-table-align' sets it back to nil.") |
98644ad4 | 4542 | (defvar org-mode-map) |
634a7d0b CD |
4543 | (defvar org-mode-hook nil) |
4544 | (defvar org-inhibit-startup nil) ; Dynamically-scoped param. | |
7ac93e3c | 4545 | (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. |
a3fbe8c4 | 4546 | (defvar org-table-buffer-is-an nil) |
d5098885 | 4547 | (defconst org-outline-regexp "\\*+ ") |
634a7d0b | 4548 | |
891f4676 | 4549 | ;;;###autoload |
094f65d4 | 4550 | (define-derived-mode org-mode outline-mode "Org" |
64f72ae1 | 4551 | "Outline-based notes management and organizer, alias |
b0a10108 | 4552 | \"Carsten's outline-mode for keeping track of everything.\" |
891f4676 RS |
4553 | |
4554 | Org-mode develops organizational tasks around a NOTES file which | |
4555 | contains information about projects as plain text. Org-mode is | |
4556 | implemented on top of outline-mode, which is ideal to keep the content | |
4557 | of large files well structured. It supports ToDo items, deadlines and | |
4558 | time stamps, which magically appear in the diary listing of the Emacs | |
4559 | calendar. Tables are easily created with a built-in table editor. | |
4560 | Plain text URL-like links connect to websites, emails (VM), Usenet | |
4561 | messages (Gnus), BBDB entries, and any files related to the project. | |
4562 | For printing and sharing of notes, an Org-mode file (or a part of it) | |
094f65d4 | 4563 | can be exported as a structured ASCII or HTML file. |
891f4676 | 4564 | |
791d856f | 4565 | The following commands are available: |
891f4676 RS |
4566 | |
4567 | \\{org-mode-map}" | |
4b3a9ba7 CD |
4568 | |
4569 | ;; Get rid of Outline menus, they are not needed | |
4570 | ;; Need to do this here because define-derived-mode sets up | |
3278a016 CD |
4571 | ;; the keymap so late. Still, it is a waste to call this each time |
4572 | ;; we switch another buffer into org-mode. | |
4b3a9ba7 | 4573 | (if (featurep 'xemacs) |
3278a016 | 4574 | (when (boundp 'outline-mode-menu-heading) |
5137195a CD |
4575 | ;; Assume this is Greg's port, it used easymenu |
4576 | (easy-menu-remove outline-mode-menu-heading) | |
4577 | (easy-menu-remove outline-mode-menu-show) | |
4578 | (easy-menu-remove outline-mode-menu-hide)) | |
4b3a9ba7 CD |
4579 | (define-key org-mode-map [menu-bar headings] 'undefined) |
4580 | (define-key org-mode-map [menu-bar hide] 'undefined) | |
4581 | (define-key org-mode-map [menu-bar show] 'undefined)) | |
4582 | ||
891f4676 | 4583 | (easy-menu-add org-org-menu) |
9acdaa21 | 4584 | (easy-menu-add org-tbl-menu) |
891f4676 | 4585 | (org-install-agenda-files-menu) |
ab27a4a0 CD |
4586 | (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) |
4587 | (org-add-to-invisibility-spec '(org-cwidth)) | |
4b3a9ba7 | 4588 | (when (featurep 'xemacs) |
5137195a | 4589 | (org-set-local 'line-move-ignore-invisible t)) |
d5098885 JW |
4590 | (org-set-local 'outline-regexp org-outline-regexp) |
4591 | (org-set-local 'outline-level 'org-outline-level) | |
374585c9 CD |
4592 | (when (and org-ellipsis |
4593 | (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) | |
4594 | (fboundp 'make-glyph-code)) | |
ab27a4a0 CD |
4595 | (unless org-display-table |
4596 | (setq org-display-table (make-display-table))) | |
374585c9 CD |
4597 | (set-display-table-slot |
4598 | org-display-table 4 | |
4599 | (vconcat (mapcar | |
4600 | (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) | |
4601 | org-ellipsis))) | |
4602 | (if (stringp org-ellipsis) org-ellipsis "...")))) | |
ab27a4a0 | 4603 | (setq buffer-display-table org-display-table)) |
791d856f | 4604 | (org-set-regexps-and-options) |
5137195a CD |
4605 | ;; Calc embedded |
4606 | (org-set-local 'calc-embedded-open-mode "# ") | |
edd21304 | 4607 | (modify-syntax-entry ?# "<") |
a3fbe8c4 | 4608 | (modify-syntax-entry ?@ "w") |
ab27a4a0 | 4609 | (if org-startup-truncated (setq truncate-lines t)) |
5137195a CD |
4610 | (org-set-local 'font-lock-unfontify-region-function |
4611 | 'org-unfontify-region) | |
891f4676 | 4612 | ;; Activate before-change-function |
5137195a | 4613 | (org-set-local 'org-table-may-need-update t) |
a96ee7df CD |
4614 | (org-add-hook 'before-change-functions 'org-before-change-function nil |
4615 | 'local) | |
edd21304 CD |
4616 | ;; Check for running clock before killing a buffer |
4617 | (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) | |
e0e66b8e CD |
4618 | ;; Paragraphs and auto-filling |
4619 | (org-set-autofill-regexps) | |
a3fbe8c4 | 4620 | (setq indent-line-function 'org-indent-line-function) |
a96ee7df | 4621 | (org-update-radio-target-regexp) |
b928f99a | 4622 | |
d3f4dbe8 CD |
4623 | ;; Comment characters |
4624 | ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping | |
4625 | (org-set-local 'comment-padding " ") | |
4626 | ||
4627 | ;; Make isearch reveal context | |
4628 | (if (or (featurep 'xemacs) | |
4629 | (not (boundp 'outline-isearch-open-invisible-function))) | |
4630 | ;; Emacs 21 and XEmacs make use of the hook | |
4631 | (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) | |
4632 | ;; Emacs 22 deals with this through a special variable | |
4633 | (org-set-local 'outline-isearch-open-invisible-function | |
4634 | (lambda (&rest ignore) (org-show-context 'isearch)))) | |
4635 | ||
4636 | ;; If empty file that did not turn on org-mode automatically, make it to. | |
094f65d4 | 4637 | (if (and org-insert-mode-line-in-empty-file |
c8d16429 CD |
4638 | (interactive-p) |
4639 | (= (point-min) (point-max))) | |
a3fbe8c4 | 4640 | (insert "# -*- mode: org -*-\n\n")) |
9acdaa21 | 4641 | |
634a7d0b | 4642 | (unless org-inhibit-startup |
0fee8d6e CD |
4643 | (when org-startup-align-all-tables |
4644 | (let ((bmp (buffer-modified-p))) | |
4645 | (org-table-map-tables 'org-table-align) | |
4646 | (set-buffer-modified-p bmp))) | |
374585c9 | 4647 | (org-cycle-hide-drawers 'all) |
d3f4dbe8 CD |
4648 | (cond |
4649 | ((eq org-startup-folded t) | |
4650 | (org-cycle '(4))) | |
4651 | ((eq org-startup-folded 'content) | |
4652 | (let ((this-command 'org-cycle) (last-command 'org-cycle)) | |
4653 | (org-cycle '(4)) (org-cycle '(4))))))) | |
891f4676 | 4654 | |
a3fbe8c4 CD |
4655 | (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) |
4656 | ||
4b3a9ba7 CD |
4657 | (defsubst org-call-with-arg (command arg) |
4658 | "Call COMMAND interactively, but pretend prefix are was ARG." | |
4659 | (let ((current-prefix-arg arg)) (call-interactively command))) | |
4660 | ||
9acdaa21 | 4661 | (defsubst org-current-line (&optional pos) |
761311e3 CD |
4662 | (save-excursion |
4663 | (and pos (goto-char pos)) | |
48aaad2d | 4664 | ;; works also in narrowed buffer, because we start at 1, not point-min |
7e466139 | 4665 | (+ (if (bolp) 1 0) (count-lines 1 (point))))) |
9acdaa21 | 4666 | |
ab27a4a0 CD |
4667 | (defun org-current-time () |
4668 | "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." | |
4669 | (if (> org-time-stamp-rounding-minutes 0) | |
4670 | (let ((r org-time-stamp-rounding-minutes) | |
4671 | (time (decode-time))) | |
4672 | (apply 'encode-time | |
4673 | (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) | |
4674 | (nthcdr 2 time)))) | |
4675 | (current-time))) | |
4676 | ||
4677 | (defun org-add-props (string plist &rest props) | |
4678 | "Add text properties to entire string, from beginning to end. | |
4679 | PLIST may be a list of properties, PROPS are individual properties and values | |
4680 | that will be added to PLIST. Returns the string that was modified." | |
4681 | (add-text-properties | |
4682 | 0 (length string) (if props (append plist props) plist) string) | |
04d18304 | 4683 | string) |
ab27a4a0 CD |
4684 | (put 'org-add-props 'lisp-indent-function 2) |
4685 | ||
04d18304 | 4686 | |
d3f4dbe8 | 4687 | ;;;; Font-Lock stuff, including the activators |
891f4676 RS |
4688 | |
4689 | (defvar org-mouse-map (make-sparse-keymap)) | |
a3fbe8c4 | 4690 | (org-defkey org-mouse-map |
ab27a4a0 | 4691 | (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) |
a3fbe8c4 | 4692 | (org-defkey org-mouse-map |
ab27a4a0 | 4693 | (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) |
a4b39e39 | 4694 | (when org-mouse-1-follows-link |
a3fbe8c4 | 4695 | (org-defkey org-mouse-map [follow-link] 'mouse-face)) |
4da1a99d | 4696 | (when org-tab-follows-link |
a3fbe8c4 CD |
4697 | (org-defkey org-mouse-map [(tab)] 'org-open-at-point) |
4698 | (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) | |
4da1a99d | 4699 | (when org-return-follows-link |
a3fbe8c4 CD |
4700 | (org-defkey org-mouse-map [(return)] 'org-open-at-point) |
4701 | (org-defkey org-mouse-map "\C-m" 'org-open-at-point)) | |
891f4676 RS |
4702 | |
4703 | (require 'font-lock) | |
4704 | ||
ab27a4a0 | 4705 | (defconst org-non-link-chars "]\t\n\r<>") |
48aaad2d | 4706 | (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" "bbdb" "vm" |
4b3a9ba7 | 4707 | "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) |
48aaad2d | 4708 | (defvar org-link-re-with-space nil |
ab27a4a0 | 4709 | "Matches a link with spaces, optional angular brackets around it.") |
48aaad2d | 4710 | (defvar org-link-re-with-space2 nil |
ab27a4a0 | 4711 | "Matches a link with spaces, optional angular brackets around it.") |
48aaad2d | 4712 | (defvar org-angle-link-re nil |
ab27a4a0 | 4713 | "Matches link with angular brackets, spaces are allowed.") |
48aaad2d | 4714 | (defvar org-plain-link-re nil |
ab27a4a0 | 4715 | "Matches plain link, without spaces.") |
48aaad2d | 4716 | (defvar org-bracket-link-regexp nil |
a96ee7df | 4717 | "Matches a link in double brackets.") |
48aaad2d CD |
4718 | (defvar org-bracket-link-analytic-regexp nil |
4719 | "Regular expression used to analyze links. | |
4720 | Here is what the match groups contain after a match: | |
4721 | 1: http: | |
4722 | 2: http | |
4723 | 3: path | |
4724 | 4: [desc] | |
4725 | 5: desc") | |
4726 | (defvar org-any-link-re nil | |
a3fbe8c4 | 4727 | "Regular expression matching any link.") |
d3f4dbe8 | 4728 | |
48aaad2d CD |
4729 | (defun org-make-link-regexps () |
4730 | "Update the link regular expressions. | |
4731 | This should be called after the variable `org-link-types' has changed." | |
4732 | (setq org-link-re-with-space | |
4733 | (concat | |
4734 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4735 | "\\([^" org-non-link-chars " ]" | |
4736 | "[^" org-non-link-chars "]*" | |
4737 | "[^" org-non-link-chars " ]\\)>?") | |
4738 | org-link-re-with-space2 | |
4739 | (concat | |
4740 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4741 | "\\([^" org-non-link-chars " ]" | |
4742 | "[^]\t\n\r]*" | |
4743 | "[^" org-non-link-chars " ]\\)>?") | |
4744 | org-angle-link-re | |
4745 | (concat | |
4746 | "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4747 | "\\([^" org-non-link-chars " ]" | |
4748 | "[^" org-non-link-chars "]*" | |
4749 | "\\)>") | |
4750 | org-plain-link-re | |
4751 | (concat | |
4752 | "\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4753 | "\\([^]\t\n\r<>,;() ]+\\)") | |
4754 | org-bracket-link-regexp | |
4755 | "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" | |
4756 | org-bracket-link-analytic-regexp | |
4757 | (concat | |
4758 | "\\[\\[" | |
4759 | "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" | |
4760 | "\\([^]]+\\)" | |
4761 | "\\]" | |
4762 | "\\(\\[" "\\([^]]+\\)" "\\]\\)?" | |
4763 | "\\]") | |
4764 | org-any-link-re | |
4765 | (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" | |
4766 | org-angle-link-re "\\)\\|\\(" | |
4767 | org-plain-link-re "\\)"))) | |
4768 | ||
4769 | (org-make-link-regexps) | |
4770 | ||
a3fbe8c4 | 4771 | (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" |
7ac93e3c | 4772 | "Regular expression for fast time stamp matching.") |
a3fbe8c4 | 4773 | (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" |
891f4676 | 4774 | "Regular expression for fast time stamp matching.") |
b38c6895 CD |
4775 | (defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" |
4776 | "Regular expression matching time strings for analysis. | |
4777 | This one does not require the space after the date.") | |
a3fbe8c4 | 4778 | (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) \\([^]0-9>\r\n]*\\)\\(\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" |
891f4676 | 4779 | "Regular expression matching time strings for analysis.") |
15841868 | 4780 | (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") |
891f4676 | 4781 | "Regular expression matching time stamps, with groups.") |
15841868 | 4782 | (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") |
8df0de1c | 4783 | "Regular expression matching time stamps (also [..]), with groups.") |
891f4676 RS |
4784 | (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) |
4785 | "Regular expression matching a time stamp range.") | |
3278a016 CD |
4786 | (defconst org-tr-regexp-both |
4787 | (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) | |
4788 | "Regular expression matching a time stamp range.") | |
891f4676 | 4789 | (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" |
c8d16429 | 4790 | org-ts-regexp "\\)?") |
891f4676 | 4791 | "Regular expression matching a time stamp or time stamp range.") |
3278a016 CD |
4792 | (defconst org-tsr-regexp-both (concat org-ts-regexp-both "\\(--?-?" |
4793 | org-ts-regexp-both "\\)?") | |
4794 | "Regular expression matching a time stamp or time stamp range. | |
4795 | The time stamps may be either active or inactive.") | |
891f4676 | 4796 | |
1a20db36 | 4797 | (defvar org-emph-face nil) |
edd21304 CD |
4798 | |
4799 | (defun org-do-emphasis-faces (limit) | |
4800 | "Run through the buffer and add overlays to links." | |
a3fbe8c4 CD |
4801 | (let (rtn) |
4802 | (while (and (not rtn) (re-search-forward org-emph-re limit t)) | |
4803 | (if (not (= (char-after (match-beginning 3)) | |
4804 | (char-after (match-beginning 4)))) | |
4805 | (progn | |
4806 | (setq rtn t) | |
4807 | (font-lock-prepend-text-property (match-beginning 2) (match-end 2) | |
4808 | 'face | |
4809 | (nth 1 (assoc (match-string 3) | |
4810 | org-emphasis-alist))) | |
4811 | (add-text-properties (match-beginning 2) (match-end 2) | |
4812 | '(font-lock-multiline t)) | |
4813 | (backward-char 1)))) | |
4814 | rtn)) | |
4815 | ||
4816 | (defun org-emphasize (&optional char) | |
4817 | "Insert or change an emphasis, i.e. a font like bold or italic. | |
4818 | If there is an active region, change that region to a new emphasis. | |
4819 | If there is no region, just insert the marker characters and position | |
4820 | the cursor between them. | |
4821 | CHAR should be either the marker character, or the first character of the | |
4822 | HTML tag associated with that emphasis. If CHAR is a space, the means | |
4823 | to remove the emphasis of the selected region. | |
4824 | If char is not given (for example in an interactive call) it | |
4825 | will be prompted for." | |
4826 | (interactive) | |
4827 | (let ((eal org-emphasis-alist) e det | |
4828 | (erc org-emphasis-regexp-components) | |
4829 | (prompt "") | |
4830 | (string "") beg end move tag c s) | |
4831 | (if (org-region-active-p) | |
4832 | (setq beg (region-beginning) end (region-end) | |
4833 | string (buffer-substring beg end)) | |
4834 | (setq move t)) | |
4835 | ||
4836 | (while (setq e (pop eal)) | |
4837 | (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) | |
4838 | c (aref tag 0)) | |
4839 | (push (cons c (string-to-char (car e))) det) | |
4840 | (setq prompt (concat prompt (format " [%s%c]%s" (car e) c | |
4841 | (substring tag 1))))) | |
4842 | (unless char | |
4843 | (message "%s" (concat "Emphasis marker or tag:" prompt)) | |
4844 | (setq char (read-char-exclusive))) | |
4845 | (setq char (or (cdr (assoc char det)) char)) | |
4846 | (if (equal char ?\ ) | |
4847 | (setq s "" move nil) | |
4848 | (unless (assoc (char-to-string char) org-emphasis-alist) | |
4849 | (error "No such emphasis marker: \"%c\"" char)) | |
4850 | (setq s (char-to-string char))) | |
4851 | (while (and (> (length string) 1) | |
4852 | (equal (substring string 0 1) (substring string -1)) | |
4853 | (assoc (substring string 0 1) org-emphasis-alist)) | |
4854 | (setq string (substring string 1 -1))) | |
4855 | (setq string (concat s string s)) | |
4856 | (if beg (delete-region beg end)) | |
4857 | (unless (or (bolp) | |
4858 | (string-match (concat "[" (nth 0 erc) "\n]") | |
4859 | (char-to-string (char-before (point))))) | |
4860 | (insert " ")) | |
4861 | (unless (string-match (concat "[" (nth 1 erc) "\n]") | |
4862 | (char-to-string (char-after (point)))) | |
4863 | (insert " ") (backward-char 1)) | |
4864 | (insert string) | |
4865 | (and move (backward-char 1)))) | |
edd21304 | 4866 | |
15841868 JW |
4867 | (defconst org-nonsticky-props |
4868 | '(mouse-face highlight keymap invisible intangible help-echo org-linked-text)) | |
4869 | ||
03f3cf35 | 4870 | |
ab27a4a0 | 4871 | (defun org-activate-plain-links (limit) |
891f4676 | 4872 | "Run through the buffer and add overlays to links." |
a3fbe8c4 CD |
4873 | (catch 'exit |
4874 | (let (f) | |
4875 | (while (re-search-forward org-plain-link-re limit t) | |
4876 | (setq f (get-text-property (match-beginning 0) 'face)) | |
4877 | (if (or (eq f 'org-tag) | |
4878 | (and (listp f) (memq 'org-tag f))) | |
4879 | nil | |
4880 | (add-text-properties (match-beginning 0) (match-end 0) | |
4881 | (list 'mouse-face 'highlight | |
15841868 | 4882 | 'rear-nonsticky org-nonsticky-props |
a3fbe8c4 CD |
4883 | 'keymap org-mouse-map |
4884 | )) | |
4885 | (throw 'exit t)))))) | |
891f4676 | 4886 | |
03f3cf35 JW |
4887 | (defun org-activate-code (limit) |
4888 | (if (re-search-forward "^[ \t]*\\(:.*\\)" limit t) | |
4889 | (unless (get-text-property (match-beginning 1) 'face) | |
4890 | (remove-text-properties (match-beginning 0) (match-end 0) | |
4891 | '(display t invisible t intangible t)) | |
4892 | t))) | |
4893 | ||
ab27a4a0 | 4894 | (defun org-activate-angle-links (limit) |
a96ee7df | 4895 | "Run through the buffer and add overlays to links." |
ab27a4a0 | 4896 | (if (re-search-forward org-angle-link-re limit t) |
a96ee7df CD |
4897 | (progn |
4898 | (add-text-properties (match-beginning 0) (match-end 0) | |
4899 | (list 'mouse-face 'highlight | |
15841868 | 4900 | 'rear-nonsticky org-nonsticky-props |
ab27a4a0 CD |
4901 | 'keymap org-mouse-map |
4902 | )) | |
4903 | t))) | |
4904 | ||
3278a016 CD |
4905 | (defmacro org-maybe-intangible (props) |
4906 | "Add '(intangigble t) to PROPS if Emacs version is earlier than Emacs 22. | |
4907 | In emacs 21, invisible text is not avoided by the command loop, so the | |
4908 | intangible property is needed to make sure point skips this text. | |
4909 | In Emacs 22, this is not necessary. The intangible text property has | |
4910 | led to problems with flyspell. These problems are fixed in flyspell.el, | |
4911 | but we still avoid setting the property in Emacs 22 and later. | |
4912 | We use a macro so that the test can happen at compilation time." | |
4913 | (if (< emacs-major-version 22) | |
4914 | `(append '(intangible t) ,props) | |
4915 | props)) | |
4916 | ||
ab27a4a0 CD |
4917 | (defun org-activate-bracket-links (limit) |
4918 | "Run through the buffer and add overlays to bracketed links." | |
4919 | (if (re-search-forward org-bracket-link-regexp limit t) | |
4146eb16 CD |
4920 | (let* ((help (concat "LINK: " |
4921 | (org-match-string-no-properties 1))) | |
4922 | ;; FIXME: above we should remove the escapes. | |
7d143c25 CD |
4923 | ;; but that requires another match, protecting match data, |
4924 | ;; a lot of overhead for font-lock. | |
3278a016 | 4925 | (ip (org-maybe-intangible |
15841868 | 4926 | (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props |
3278a016 CD |
4927 | 'keymap org-mouse-map 'mouse-face 'highlight |
4928 | 'help-echo help))) | |
15841868 | 4929 | (vp (list 'rear-nonsticky org-nonsticky-props |
ab27a4a0 CD |
4930 | 'keymap org-mouse-map 'mouse-face 'highlight |
4931 | 'help-echo help))) | |
4932 | ;; We need to remove the invisible property here. Table narrowing | |
4933 | ;; may have made some of this invisible. | |
4934 | (remove-text-properties (match-beginning 0) (match-end 0) | |
4935 | '(invisible nil)) | |
4936 | (if (match-end 3) | |
4937 | (progn | |
4938 | (add-text-properties (match-beginning 0) (match-beginning 3) ip) | |
4939 | (add-text-properties (match-beginning 3) (match-end 3) vp) | |
4940 | (add-text-properties (match-end 3) (match-end 0) ip)) | |
4941 | (add-text-properties (match-beginning 0) (match-beginning 1) ip) | |
4942 | (add-text-properties (match-beginning 1) (match-end 1) vp) | |
4943 | (add-text-properties (match-end 1) (match-end 0) ip)) | |
a96ee7df CD |
4944 | t))) |
4945 | ||
891f4676 | 4946 | (defun org-activate-dates (limit) |
35fb9989 | 4947 | "Run through the buffer and add overlays to dates." |
3278a016 | 4948 | (if (re-search-forward org-tsr-regexp-both limit t) |
891f4676 | 4949 | (progn |
c8d16429 CD |
4950 | (add-text-properties (match-beginning 0) (match-end 0) |
4951 | (list 'mouse-face 'highlight | |
15841868 | 4952 | 'rear-nonsticky org-nonsticky-props |
c8d16429 | 4953 | 'keymap org-mouse-map)) |
3278a016 CD |
4954 | (when org-display-custom-times |
4955 | (if (match-end 3) | |
4956 | (org-display-custom-time (match-beginning 3) (match-end 3))) | |
4957 | (org-display-custom-time (match-beginning 1) (match-end 1))) | |
c8d16429 | 4958 | t))) |
891f4676 | 4959 | |
a96ee7df CD |
4960 | (defvar org-target-link-regexp nil |
4961 | "Regular expression matching radio targets in plain text.") | |
4962 | (defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" | |
4963 | "Regular expression matching a link target.") | |
4964 | (defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" | |
b38c6895 CD |
4965 | "Regular expression matching a radio target.") |
4966 | (defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target. | |
4967 | "Regular expression matching any target.") | |
a96ee7df CD |
4968 | |
4969 | (defun org-activate-target-links (limit) | |
4970 | "Run through the buffer and add overlays to target matches." | |
ab27a4a0 | 4971 | (when org-target-link-regexp |
a96ee7df CD |
4972 | (let ((case-fold-search t)) |
4973 | (if (re-search-forward org-target-link-regexp limit t) | |
4974 | (progn | |
4975 | (add-text-properties (match-beginning 0) (match-end 0) | |
4976 | (list 'mouse-face 'highlight | |
15841868 | 4977 | 'rear-nonsticky org-nonsticky-props |
a96ee7df | 4978 | 'keymap org-mouse-map |
ab27a4a0 | 4979 | 'help-echo "Radio target link" |
a96ee7df CD |
4980 | 'org-linked-text t)) |
4981 | t))))) | |
4982 | ||
4983 | (defun org-update-radio-target-regexp () | |
4984 | "Find all radio targets in this file and update the regular expression." | |
4985 | (interactive) | |
ab27a4a0 | 4986 | (when (memq 'radio org-activate-links) |
a96ee7df CD |
4987 | (setq org-target-link-regexp |
4988 | (org-make-target-link-regexp (org-all-targets 'radio))) | |
ab27a4a0 CD |
4989 | (org-restart-font-lock))) |
4990 | ||
4991 | (defun org-hide-wide-columns (limit) | |
4992 | (let (s e) | |
4993 | (setq s (text-property-any (point) (or limit (point-max)) | |
4994 | 'org-cwidth t)) | |
4995 | (when s | |
4996 | (setq e (next-single-property-change s 'org-cwidth)) | |
3278a016 | 4997 | (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) |
ab27a4a0 CD |
4998 | (goto-char e) |
4999 | t))) | |
5000 | ||
5001 | (defun org-restart-font-lock () | |
5002 | "Restart font-lock-mode, to force refontification." | |
5003 | (when (and (boundp 'font-lock-mode) font-lock-mode) | |
a96ee7df CD |
5004 | (font-lock-mode -1) |
5005 | (font-lock-mode 1))) | |
5006 | ||
5007 | (defun org-all-targets (&optional radio) | |
5008 | "Return a list of all targets in this file. | |
5009 | With optional argument RADIO, only find radio targets." | |
5010 | (let ((re (if radio org-radio-target-regexp org-target-regexp)) | |
5011 | rtn) | |
5012 | (save-excursion | |
5013 | (goto-char (point-min)) | |
5014 | (while (re-search-forward re nil t) | |
ab27a4a0 | 5015 | (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) |
a96ee7df CD |
5016 | rtn))) |
5017 | ||
5018 | (defun org-make-target-link-regexp (targets) | |
5019 | "Make regular expression matching all strings in TARGETS. | |
5020 | The regular expression finds the targets also if there is a line break | |
5021 | between words." | |
7204b00e CD |
5022 | (and targets |
5023 | (concat | |
5024 | "\\<\\(" | |
5025 | (mapconcat | |
5026 | (lambda (x) | |
5027 | (while (string-match " +" x) | |
5028 | (setq x (replace-match "\\s-+" t t x))) | |
5029 | x) | |
5030 | targets | |
5031 | "\\|") | |
5032 | "\\)\\>"))) | |
a96ee7df | 5033 | |
4da1a99d | 5034 | (defun org-activate-tags (limit) |
48aaad2d | 5035 | (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) |
4da1a99d CD |
5036 | (progn |
5037 | (add-text-properties (match-beginning 1) (match-end 1) | |
5038 | (list 'mouse-face 'highlight | |
15841868 | 5039 | 'rear-nonsticky org-nonsticky-props |
4da1a99d CD |
5040 | 'keymap org-mouse-map)) |
5041 | t))) | |
5042 | ||
f425a6ea CD |
5043 | (defun org-outline-level () |
5044 | (save-excursion | |
5045 | (looking-at outline-regexp) | |
5046 | (if (match-beginning 1) | |
5047 | (+ (org-get-string-indentation (match-string 1)) 1000) | |
7d58338e | 5048 | (1- (- (match-end 0) (match-beginning 0)))))) |
f425a6ea | 5049 | |
634a7d0b CD |
5050 | (defvar org-font-lock-keywords nil) |
5051 | ||
0b8568f5 | 5052 | (defconst org-property-re (org-re "^[ \t]*\\(:\\([[:alnum:]_]+\\):\\)[ \t]*\\(\\S-.*\\)") |
7d58338e CD |
5053 | "Regular expression matching a property line.") |
5054 | ||
891f4676 | 5055 | (defun org-set-font-lock-defaults () |
4ed31842 | 5056 | (let* ((em org-fontify-emphasized-text) |
ab27a4a0 | 5057 | (lk org-activate-links) |
4ed31842 CD |
5058 | (org-font-lock-extra-keywords |
5059 | (list | |
374585c9 | 5060 | ;; Headlines |
7d58338e | 5061 | '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1)) |
4ed31842 | 5062 | (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) |
374585c9 | 5063 | ;; Table lines |
ab27a4a0 | 5064 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" |
03f3cf35 JW |
5065 | (1 'org-table t)) |
5066 | ;; Table internals | |
5067 | '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) | |
5068 | '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) | |
5069 | '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) | |
5070 | ;; Drawers | |
5071 | (list org-drawer-regexp '(0 'org-special-keyword t)) | |
5072 | (list "^[ \t]*:END:" '(0 'org-special-keyword t)) | |
5073 | ;; Properties | |
5074 | (list org-property-re | |
5075 | '(1 'org-special-keyword t) | |
5076 | '(3 'org-property-value t)) | |
5077 | (if org-format-transports-properties-p | |
5078 | '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) | |
4b3a9ba7 | 5079 | ;; Links |
a3fbe8c4 | 5080 | (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) |
ab27a4a0 CD |
5081 | (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) |
5082 | (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) | |
5083 | (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) | |
5084 | (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) | |
4146eb16 | 5085 | (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) |
a3fbe8c4 | 5086 | '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) |
a6a42486 | 5087 | '(org-hide-wide-columns (0 nil append)) |
4b3a9ba7 | 5088 | ;; TODO lines |
374585c9 CD |
5089 | (list (concat "^\\*+[ \t]+" org-todo-regexp) |
5090 | '(1 (org-get-todo-face 1) t)) | |
5091 | ;; DONE | |
5092 | (if org-fontify-done-headline | |
5093 | (list (concat "^[*]+ +\\<\\(" | |
5094 | (mapconcat 'regexp-quote org-done-keywords "\\|") | |
5095 | "\\)\\(.*\\)") | |
5096 | '(2 'org-headline-done t)) | |
5097 | nil) | |
4b3a9ba7 | 5098 | ;; Priorities |
a3fbe8c4 | 5099 | (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) |
4b3a9ba7 | 5100 | ;; Special keywords |
4ed31842 CD |
5101 | (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) |
5102 | (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) | |
5103 | (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) | |
edd21304 | 5104 | (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) |
4b3a9ba7 | 5105 | ;; Emphasis |
3278a016 CD |
5106 | (if em |
5107 | (if (featurep 'xemacs) | |
5108 | '(org-do-emphasis-faces (0 nil append)) | |
5109 | '(org-do-emphasis-faces))) | |
03f3cf35 | 5110 | ;; Checkboxes |
1e8fbb6d | 5111 | '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" |
4b3a9ba7 | 5112 | 2 'bold prepend) |
3278a016 CD |
5113 | (if org-provide-checkbox-statistics |
5114 | '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" | |
5115 | (0 (org-get-checkbox-statistics-face) t))) | |
4b3a9ba7 | 5116 | ;; COMMENT |
7d58338e | 5117 | (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string |
4ed31842 CD |
5118 | "\\|" org-quote-string "\\)\\>") |
5119 | '(1 'org-special-keyword t)) | |
5120 | '("^#.*" (0 'font-lock-comment-face t)) | |
6769c0dc | 5121 | '("^\\*+ \\(.*:ARCHIVE:.*\\)" (1 'org-archived prepend)) |
03f3cf35 JW |
5122 | ;; Code |
5123 | '(org-activate-code (1 'org-code t)) | |
4ed31842 CD |
5124 | ))) |
5125 | (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) | |
79c4be8e | 5126 | ;; Now set the full font-lock-keywords |
5137195a CD |
5127 | (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) |
5128 | (org-set-local 'font-lock-defaults | |
5129 | '(org-font-lock-keywords t nil nil backward-paragraph)) | |
891f4676 | 5130 | (kill-local-variable 'font-lock-keywords) nil)) |
64f72ae1 | 5131 | |
7204b00e CD |
5132 | (defvar org-m nil) |
5133 | (defvar org-l nil) | |
5134 | (defvar org-f nil) | |
5135 | (defun org-get-level-face (n) | |
5136 | "Get the right face for match N in font-lock matching of healdines." | |
7d58338e | 5137 | (setq org-l (- (match-end 2) (match-beginning 1) 1)) |
7204b00e | 5138 | (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) |
1e8fbb6d | 5139 | (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) |
7204b00e CD |
5140 | (cond |
5141 | ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) | |
5142 | ((eq n 2) org-f) | |
5143 | (t (if org-level-color-stars-only nil org-f)))) | |
5144 | ||
374585c9 CD |
5145 | (defun org-get-todo-face (kwd) |
5146 | "Get the right face for a TODO keyword KWD. | |
5147 | If KWD is a number, get the corresponding match group." | |
5148 | (if (numberp kwd) (setq kwd (match-string kwd))) | |
5149 | (or (cdr (assoc kwd org-todo-keyword-faces)) | |
5150 | (and (member kwd org-done-keywords) 'org-done) | |
5151 | 'org-todo)) | |
5152 | ||
891f4676 RS |
5153 | (defun org-unfontify-region (beg end &optional maybe_loudly) |
5154 | "Remove fontification and activation overlays from links." | |
5155 | (font-lock-default-unfontify-region beg end) | |
634a7d0b | 5156 | (let* ((buffer-undo-list t) |
c8d16429 CD |
5157 | (inhibit-read-only t) (inhibit-point-motion-hooks t) |
5158 | (inhibit-modification-hooks t) | |
5159 | deactivate-mark buffer-file-name buffer-file-truename) | |
a96ee7df | 5160 | (remove-text-properties beg end |
3278a016 | 5161 | '(mouse-face t keymap t org-linked-text t |
3278a016 CD |
5162 | invisible t intangible t)))) |
5163 | ||
d3f4dbe8 CD |
5164 | ;;;; Visibility cycling, including org-goto and indirect buffer |
5165 | ||
5166 | ;;; Cycling | |
891f4676 RS |
5167 | |
5168 | (defvar org-cycle-global-status nil) | |
4b3a9ba7 | 5169 | (make-variable-buffer-local 'org-cycle-global-status) |
891f4676 | 5170 | (defvar org-cycle-subtree-status nil) |
4b3a9ba7 CD |
5171 | (make-variable-buffer-local 'org-cycle-subtree-status) |
5172 | ||
5173 | ;;;###autoload | |
891f4676 | 5174 | (defun org-cycle (&optional arg) |
ef943dba | 5175 | "Visibility cycling for Org-mode. |
891f4676 RS |
5176 | |
5177 | - When this function is called with a prefix argument, rotate the entire | |
c8d16429 | 5178 | buffer through 3 states (global cycling) |
891f4676 RS |
5179 | 1. OVERVIEW: Show only top-level headlines. |
5180 | 2. CONTENTS: Show all headlines of all levels, but no body text. | |
5181 | 3. SHOW ALL: Show everything. | |
5182 | ||
5183 | - When point is at the beginning of a headline, rotate the subtree started | |
c8d16429 | 5184 | by this line through 3 different states (local cycling) |
891f4676 | 5185 | 1. FOLDED: Only the main headline is shown. |
b0a10108 JB |
5186 | 2. CHILDREN: The main headline and the direct children are shown. |
5187 | From this state, you can move to one of the children | |
5188 | and zoom in further. | |
891f4676 RS |
5189 | 3. SUBTREE: Show the entire subtree, including body text. |
5190 | ||
9acdaa21 CD |
5191 | - When there is a numeric prefix, go up to a heading with level ARG, do |
5192 | a `show-subtree' and return to the previous cursor position. If ARG | |
5193 | is negative, go up that many levels. | |
ef943dba | 5194 | |
891f4676 RS |
5195 | - When point is not at the beginning of a headline, execute |
5196 | `indent-relative', like TAB normally does. See the option | |
5197 | `org-cycle-emulate-tab' for details. | |
5198 | ||
b38c6895 | 5199 | - Special case: if point is at the beginning of the buffer and there is |
374585c9 CD |
5200 | no headline in line 1, this function will act as if called with prefix arg. |
5201 | But only if also the variable `org-cycle-global-at-bob' is t." | |
891f4676 | 5202 | (interactive "P") |
4b3a9ba7 | 5203 | (let* ((outline-regexp |
3278a016 | 5204 | (if (and (org-mode-p) org-cycle-include-plain-lists) |
7d58338e | 5205 | "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" |
4b3a9ba7 | 5206 | outline-regexp)) |
edd21304 | 5207 | (bob-special (and org-cycle-global-at-bob (bobp) |
4b3a9ba7 | 5208 | (not (looking-at outline-regexp)))) |
6769c0dc CD |
5209 | (org-cycle-hook |
5210 | (if bob-special | |
5211 | (delq 'org-optimize-window-after-visibility-change | |
5212 | (copy-sequence org-cycle-hook)) | |
5213 | org-cycle-hook)) | |
7d143c25 | 5214 | (pos (point))) |
891f4676 | 5215 | |
4b3a9ba7 CD |
5216 | (if (or bob-special (equal arg '(4))) |
5217 | ;; special case: use global cycling | |
5218 | (setq arg t)) | |
891f4676 | 5219 | |
f425a6ea | 5220 | (cond |
891f4676 | 5221 | |
f425a6ea CD |
5222 | ((org-at-table-p 'any) |
5223 | ;; Enter the table or move to the next field in the table | |
5224 | (or (org-table-recognize-table.el) | |
5225 | (progn | |
ab27a4a0 CD |
5226 | (if arg (org-table-edit-field t) |
5227 | (org-table-justify-field-maybe) | |
4b3a9ba7 | 5228 | (call-interactively 'org-table-next-field))))) |
891f4676 | 5229 | |
f425a6ea | 5230 | ((eq arg t) ;; Global cycling |
c44f0d75 | 5231 | |
f425a6ea CD |
5232 | (cond |
5233 | ((and (eq last-command this-command) | |
5234 | (eq org-cycle-global-status 'overview)) | |
5235 | ;; We just created the overview - now do table of contents | |
5236 | ;; This can be slow in very large buffers, so indicate action | |
5237 | (message "CONTENTS...") | |
4b3a9ba7 CD |
5238 | (org-content) |
5239 | (message "CONTENTS...done") | |
f425a6ea CD |
5240 | (setq org-cycle-global-status 'contents) |
5241 | (run-hook-with-args 'org-cycle-hook 'contents)) | |
891f4676 | 5242 | |
f425a6ea CD |
5243 | ((and (eq last-command this-command) |
5244 | (eq org-cycle-global-status 'contents)) | |
5245 | ;; We just showed the table of contents - now show everything | |
5246 | (show-all) | |
5247 | (message "SHOW ALL") | |
5248 | (setq org-cycle-global-status 'all) | |
5249 | (run-hook-with-args 'org-cycle-hook 'all)) | |
ef943dba | 5250 | |
f425a6ea CD |
5251 | (t |
5252 | ;; Default action: go to overview | |
4b3a9ba7 | 5253 | (org-overview) |
f425a6ea CD |
5254 | (message "OVERVIEW") |
5255 | (setq org-cycle-global-status 'overview) | |
5256 | (run-hook-with-args 'org-cycle-hook 'overview)))) | |
5257 | ||
374585c9 | 5258 | ((and org-drawers org-drawer-regexp |
38f8646b CD |
5259 | (save-excursion |
5260 | (beginning-of-line 1) | |
5261 | (looking-at org-drawer-regexp))) | |
5262 | ;; Toggle block visibility | |
5263 | (org-flag-drawer | |
5264 | (not (get-char-property (match-end 0) 'invisible)))) | |
5265 | ||
f425a6ea CD |
5266 | ((integerp arg) |
5267 | ;; Show-subtree, ARG levels up from here. | |
891f4676 | 5268 | (save-excursion |
634a7d0b | 5269 | (org-back-to-heading) |
f425a6ea | 5270 | (outline-up-heading (if (< arg 0) (- arg) |
7204b00e | 5271 | (- (funcall outline-level) arg))) |
f425a6ea CD |
5272 | (org-show-subtree))) |
5273 | ||
a3fbe8c4 CD |
5274 | ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) |
5275 | (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) | |
f425a6ea CD |
5276 | ;; At a heading: rotate between three different views |
5277 | (org-back-to-heading) | |
5278 | (let ((goal-column 0) eoh eol eos) | |
5279 | ;; First, some boundaries | |
891f4676 | 5280 | (save-excursion |
f425a6ea CD |
5281 | (org-back-to-heading) |
5282 | (save-excursion | |
5283 | (beginning-of-line 2) | |
5284 | (while (and (not (eobp)) ;; this is like `next-line' | |
5285 | (get-char-property (1- (point)) 'invisible)) | |
5286 | (beginning-of-line 2)) (setq eol (point))) | |
5287 | (outline-end-of-heading) (setq eoh (point)) | |
d3f4dbe8 | 5288 | (org-end-of-subtree t) |
a3fbe8c4 CD |
5289 | (unless (eobp) |
5290 | (skip-chars-forward " \t\n") | |
5291 | (beginning-of-line 1) ; in case this is an item | |
5292 | ) | |
d3f4dbe8 | 5293 | (setq eos (1- (point)))) |
f425a6ea CD |
5294 | ;; Find out what to do next and set `this-command' |
5295 | (cond | |
d3f4dbe8 | 5296 | ((= eos eoh) |
f425a6ea CD |
5297 | ;; Nothing is hidden behind this heading |
5298 | (message "EMPTY ENTRY") | |
a3fbe8c4 CD |
5299 | (setq org-cycle-subtree-status nil) |
5300 | (save-excursion | |
5301 | (goto-char eos) | |
5302 | (outline-next-heading) | |
5303 | (if (org-invisible-p) (org-flag-heading nil)))) | |
48aaad2d CD |
5304 | ((or (>= eol eos) |
5305 | (not (string-match "\\S-" (buffer-substring eol eos)))) | |
f425a6ea CD |
5306 | ;; Entire subtree is hidden in one line: open it |
5307 | (org-show-entry) | |
5308 | (show-children) | |
5309 | (message "CHILDREN") | |
a3fbe8c4 CD |
5310 | (save-excursion |
5311 | (goto-char eos) | |
5312 | (outline-next-heading) | |
5313 | (if (org-invisible-p) (org-flag-heading nil))) | |
f425a6ea CD |
5314 | (setq org-cycle-subtree-status 'children) |
5315 | (run-hook-with-args 'org-cycle-hook 'children)) | |
5316 | ((and (eq last-command this-command) | |
5317 | (eq org-cycle-subtree-status 'children)) | |
5318 | ;; We just showed the children, now show everything. | |
5319 | (org-show-subtree) | |
5320 | (message "SUBTREE") | |
5321 | (setq org-cycle-subtree-status 'subtree) | |
5322 | (run-hook-with-args 'org-cycle-hook 'subtree)) | |
5323 | (t | |
5324 | ;; Default action: hide the subtree. | |
5325 | (hide-subtree) | |
5326 | (message "FOLDED") | |
5327 | (setq org-cycle-subtree-status 'folded) | |
5328 | (run-hook-with-args 'org-cycle-hook 'folded))))) | |
5329 | ||
5330 | ;; TAB emulation | |
5331 | (buffer-read-only (org-back-to-heading)) | |
6769c0dc CD |
5332 | |
5333 | ((org-try-cdlatex-tab)) | |
5334 | ||
a3fbe8c4 CD |
5335 | ((and (eq org-cycle-emulate-tab 'exc-hl-bol) |
5336 | (or (not (bolp)) | |
5337 | (not (looking-at outline-regexp)))) | |
5338 | (call-interactively (global-key-binding "\t"))) | |
5339 | ||
7d143c25 CD |
5340 | ((if (and (memq org-cycle-emulate-tab '(white whitestart)) |
5341 | (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) | |
5342 | (or (and (eq org-cycle-emulate-tab 'white) | |
5343 | (= (match-end 0) (point-at-eol))) | |
5344 | (and (eq org-cycle-emulate-tab 'whitestart) | |
5345 | (>= (match-end 0) pos)))) | |
f425a6ea CD |
5346 | t |
5347 | (eq org-cycle-emulate-tab t)) | |
5348 | (if (and (looking-at "[ \n\r\t]") | |
5349 | (string-match "^[ \t]*$" (buffer-substring | |
5350 | (point-at-bol) (point)))) | |
5351 | (progn | |
5352 | (beginning-of-line 1) | |
5353 | (and (looking-at "[ \t]+") (replace-match "")))) | |
a3fbe8c4 | 5354 | (call-interactively (global-key-binding "\t"))) |
891f4676 | 5355 | |
f425a6ea CD |
5356 | (t (save-excursion |
5357 | (org-back-to-heading) | |
5358 | (org-cycle)))))) | |
891f4676 | 5359 | |
4b3a9ba7 | 5360 | ;;;###autoload |
edd21304 | 5361 | (defun org-global-cycle (&optional arg) |
4b3a9ba7 | 5362 | "Cycle the global visibility. For details see `org-cycle'." |
edd21304 | 5363 | (interactive "P") |
3278a016 CD |
5364 | (let ((org-cycle-include-plain-lists |
5365 | (if (org-mode-p) org-cycle-include-plain-lists nil))) | |
5366 | (if (integerp arg) | |
5367 | (progn | |
5368 | (show-all) | |
5369 | (hide-sublevels arg) | |
5370 | (setq org-cycle-global-status 'contents)) | |
5371 | (org-cycle '(4))))) | |
4b3a9ba7 CD |
5372 | |
5373 | (defun org-overview () | |
5374 | "Switch to overview mode, shoing only top-level headlines. | |
5375 | Really, this shows all headlines with level equal or greater than the level | |
5376 | of the first headline in the buffer. This is important, because if the | |
5377 | first headline is not level one, then (hide-sublevels 1) gives confusing | |
5378 | results." | |
5379 | (interactive) | |
a3fbe8c4 CD |
5380 | (let ((level (save-excursion |
5381 | (goto-char (point-min)) | |
5382 | (if (re-search-forward (concat "^" outline-regexp) nil t) | |
5383 | (progn | |
5384 | (goto-char (match-beginning 0)) | |
5385 | (funcall outline-level)))))) | |
5386 | (and level (hide-sublevels level)))) | |
4b3a9ba7 | 5387 | |
d3f4dbe8 CD |
5388 | (defun org-content (&optional arg) |
5389 | "Show all headlines in the buffer, like a table of contents. | |
5390 | With numerical argument N, show content up to level N." | |
5391 | (interactive "P") | |
4b3a9ba7 CD |
5392 | (save-excursion |
5393 | ;; Visit all headings and show their offspring | |
d3f4dbe8 | 5394 | (and (integerp arg) (org-overview)) |
4b3a9ba7 CD |
5395 | (goto-char (point-max)) |
5396 | (catch 'exit | |
5397 | (while (and (progn (condition-case nil | |
5398 | (outline-previous-visible-heading 1) | |
5399 | (error (goto-char (point-min)))) | |
5400 | t) | |
5401 | (looking-at outline-regexp)) | |
d3f4dbe8 CD |
5402 | (if (integerp arg) |
5403 | (show-children (1- arg)) | |
5404 | (show-branches)) | |
4b3a9ba7 CD |
5405 | (if (bobp) (throw 'exit nil)))))) |
5406 | ||
5407 | ||
35fb9989 CD |
5408 | (defun org-optimize-window-after-visibility-change (state) |
5409 | "Adjust the window after a change in outline visibility. | |
5410 | This function is the default value of the hook `org-cycle-hook'." | |
ab27a4a0 CD |
5411 | (when (get-buffer-window (current-buffer)) |
5412 | (cond | |
a3fbe8c4 CD |
5413 | ; ((eq state 'overview) (org-first-headline-recenter 1)) |
5414 | ; ((eq state 'overview) (org-beginning-of-line)) | |
ab27a4a0 CD |
5415 | ((eq state 'content) nil) |
5416 | ((eq state 'all) nil) | |
5417 | ((eq state 'folded) nil) | |
5418 | ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) | |
5419 | ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) | |
35fb9989 | 5420 | |
a3fbe8c4 CD |
5421 | |
5422 | (defun org-cycle-show-empty-lines (state) | |
5423 | "Show empty lines above all visible headlines. | |
5424 | The region to be covered depends on STATE when called through | |
5425 | `org-cycle-hook'. Lisp program can use t for STATE to get the | |
5426 | entire buffer covered. Note that an empty line is only shown if there | |
5427 | are at least `org-cycle-separator-lines' empty lines before the headeline." | |
5428 | (when (> org-cycle-separator-lines 0) | |
5429 | (save-excursion | |
5430 | (let* ((n org-cycle-separator-lines) | |
5431 | (re (cond | |
5432 | ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") | |
5433 | ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") | |
5434 | (t (let ((ns (number-to-string (- n 2)))) | |
5435 | (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" | |
5436 | "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) | |
5437 | beg end) | |
5438 | (cond | |
5439 | ((memq state '(overview contents t)) | |
5440 | (setq beg (point-min) end (point-max))) | |
5441 | ((memq state '(children folded)) | |
5442 | (setq beg (point) end (progn (org-end-of-subtree t t) | |
5443 | (beginning-of-line 2) | |
5444 | (point))))) | |
5445 | (when beg | |
5446 | (goto-char beg) | |
5447 | (while (re-search-forward re end t) | |
5448 | (if (not (get-char-property (match-end 1) 'invisible)) | |
5449 | (outline-flag-region | |
5450 | (match-beginning 1) (match-end 1) nil))))))) | |
5451 | ;; Never hide empty lines at the end of the file. | |
5452 | (save-excursion | |
5453 | (goto-char (point-max)) | |
5454 | (outline-previous-heading) | |
5455 | (outline-end-of-heading) | |
5456 | (if (and (looking-at "[ \t\n]+") | |
5457 | (= (match-end 0) (point-max))) | |
5458 | (outline-flag-region (point) (match-end 0) nil)))) | |
5459 | ||
35fb9989 CD |
5460 | (defun org-subtree-end-visible-p () |
5461 | "Is the end of the current subtree visible?" | |
5462 | (pos-visible-in-window-p | |
04d18304 | 5463 | (save-excursion (org-end-of-subtree t) (point)))) |
35fb9989 CD |
5464 | |
5465 | (defun org-first-headline-recenter (&optional N) | |
5466 | "Move cursor to the first headline and recenter the headline. | |
5467 | Optional argument N means, put the headline into the Nth line of the window." | |
5468 | (goto-char (point-min)) | |
b928f99a | 5469 | (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) |
634a7d0b CD |
5470 | (beginning-of-line) |
5471 | (recenter (prefix-numeric-value N)))) | |
35fb9989 | 5472 | |
d3f4dbe8 CD |
5473 | ;;; Org-goto |
5474 | ||
891f4676 RS |
5475 | (defvar org-goto-window-configuration nil) |
5476 | (defvar org-goto-marker nil) | |
48aaad2d CD |
5477 | (defvar org-goto-map |
5478 | (let ((map (make-sparse-keymap))) | |
d5098885 | 5479 | (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd) |
48aaad2d CD |
5480 | (while (setq cmd (pop cmds)) |
5481 | (substitute-key-definition cmd cmd map global-map))) | |
15841868 | 5482 | (suppress-keymap map) |
48aaad2d CD |
5483 | (org-defkey map "\C-m" 'org-goto-ret) |
5484 | (org-defkey map [(left)] 'org-goto-left) | |
5485 | (org-defkey map [(right)] 'org-goto-right) | |
5486 | (org-defkey map [(?q)] 'org-goto-quit) | |
5487 | (org-defkey map [(control ?g)] 'org-goto-quit) | |
5488 | (org-defkey map "\C-i" 'org-cycle) | |
5489 | (org-defkey map [(tab)] 'org-cycle) | |
5490 | (org-defkey map [(down)] 'outline-next-visible-heading) | |
5491 | (org-defkey map [(up)] 'outline-previous-visible-heading) | |
5492 | (org-defkey map "n" 'outline-next-visible-heading) | |
5493 | (org-defkey map "p" 'outline-previous-visible-heading) | |
5494 | (org-defkey map "f" 'outline-forward-same-level) | |
5495 | (org-defkey map "b" 'outline-backward-same-level) | |
5496 | (org-defkey map "u" 'outline-up-heading) | |
d5098885 | 5497 | (org-defkey map "/" 'org-occur) |
48aaad2d CD |
5498 | (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) |
5499 | (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) | |
5500 | (org-defkey map "\C-c\C-f" 'outline-forward-same-level) | |
5501 | (org-defkey map "\C-c\C-b" 'outline-backward-same-level) | |
5502 | (org-defkey map "\C-c\C-u" 'outline-up-heading) | |
48aaad2d | 5503 | map)) |
891f4676 RS |
5504 | |
5505 | (defconst org-goto-help | |
d5098885 JW |
5506 | "Browse copy of buffer to find location or copy text. |
5507 | RET=jump to location [Q]uit and return to previous location | |
5508 | \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur" | |
5509 | ) | |
891f4676 RS |
5510 | |
5511 | (defun org-goto () | |
d5098885 | 5512 | "Look up a different location in the current file, keeping current visibility. |
891f4676 | 5513 | |
d5098885 JW |
5514 | When you want look-up or go to a different location in a document, the |
5515 | fastest way is often to fold the entire buffer and then dive into the tree. | |
5516 | This method has the disadvantage, that the previous location will be folded, | |
35fb9989 | 5517 | which may not be what you want. |
891f4676 | 5518 | |
d5098885 JW |
5519 | This command works around this by showing a copy of the current buffer |
5520 | in an indirect buffer, in overview mode. You can dive into the tree in | |
5521 | that copy, use org-occur and incremental search to find a location. | |
5522 | When pressing RET or `Q', the command returns to the original buffer in | |
5523 | which the visibility is still unchanged. After RET is will also jump to | |
5524 | the location selected in the indirect buffer and expose the | |
5525 | the headline hierarchy above." | |
891f4676 RS |
5526 | (interactive) |
5527 | (let* ((org-goto-start-pos (point)) | |
c8d16429 | 5528 | (selected-point |
d5098885 | 5529 | (car (org-get-location (current-buffer) org-goto-help)))) |
891f4676 | 5530 | (if selected-point |
c8d16429 | 5531 | (progn |
a96ee7df | 5532 | (org-mark-ring-push org-goto-start-pos) |
c8d16429 | 5533 | (goto-char selected-point) |
a96ee7df | 5534 | (if (or (org-invisible-p) (org-invisible-p2)) |
3278a016 | 5535 | (org-show-context 'org-goto))) |
d5098885 | 5536 | (message "Quit")))) |
891f4676 | 5537 | |
d5098885 JW |
5538 | (defvar org-goto-selected-point nil) ; dynamically scoped parameter |
5539 | (defvar org-goto-exit-command nil) ; dynamically scoped parameter | |
d3f4dbe8 | 5540 | |
891f4676 RS |
5541 | (defun org-get-location (buf help) |
5542 | "Let the user select a location in the Org-mode buffer BUF. | |
5543 | This function uses a recursive edit. It returns the selected position | |
5544 | or nil." | |
d5098885 | 5545 | (let (org-goto-selected-point org-goto-exit-command) |
891f4676 RS |
5546 | (save-excursion |
5547 | (save-window-excursion | |
c8d16429 | 5548 | (delete-other-windows) |
d5098885 JW |
5549 | (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) |
5550 | (switch-to-buffer | |
5551 | (condition-case nil | |
5552 | (make-indirect-buffer (current-buffer) "*org-goto*") | |
5553 | (error (make-indirect-buffer (current-buffer) "*org-goto*")))) | |
c8d16429 CD |
5554 | (with-output-to-temp-buffer "*Help*" |
5555 | (princ help)) | |
5556 | (shrink-window-if-larger-than-buffer (get-buffer-window "*Help*")) | |
5557 | (setq buffer-read-only nil) | |
c8d16429 | 5558 | (let ((org-startup-truncated t) |
d5098885 | 5559 | (org-startup-folded nil) |
d3f4dbe8 | 5560 | (org-startup-align-all-tables nil)) |
d5098885 JW |
5561 | (org-mode) |
5562 | (org-overview)) | |
c8d16429 | 5563 | (setq buffer-read-only t) |
d3f4dbe8 CD |
5564 | (if (and (boundp 'org-goto-start-pos) |
5565 | (integer-or-marker-p org-goto-start-pos)) | |
5566 | (let ((org-show-hierarchy-above t) | |
5567 | (org-show-siblings t) | |
5568 | (org-show-following-heading t)) | |
5569 | (goto-char org-goto-start-pos) | |
5570 | (and (org-invisible-p) (org-show-context))) | |
c8d16429 CD |
5571 | (goto-char (point-min))) |
5572 | (org-beginning-of-line) | |
5573 | (message "Select location and press RET") | |
5574 | ;; now we make sure that during selection, ony very few keys work | |
5575 | ;; and that it is impossible to switch to another window. | |
d5098885 JW |
5576 | ; (let ((gm (current-global-map)) |
5577 | ; (overriding-local-map org-goto-map)) | |
5578 | ; (unwind-protect | |
5579 | ; (progn | |
5580 | ; (use-global-map org-goto-map) | |
5581 | ; (recursive-edit)) | |
5582 | ; (use-global-map gm))) | |
5583 | (use-local-map org-goto-map) | |
5584 | (recursive-edit) | |
5585 | )) | |
891f4676 | 5586 | (kill-buffer "*org-goto*") |
d5098885 | 5587 | (cons org-goto-selected-point org-goto-exit-command))) |
891f4676 | 5588 | |
891f4676 | 5589 | (defun org-goto-ret (&optional arg) |
b0a10108 | 5590 | "Finish `org-goto' by going to the new location." |
891f4676 | 5591 | (interactive "P") |
d5098885 JW |
5592 | (setq org-goto-selected-point (point) |
5593 | org-goto-exit-command 'return) | |
891f4676 RS |
5594 | (throw 'exit nil)) |
5595 | ||
634a7d0b | 5596 | (defun org-goto-left () |
b0a10108 | 5597 | "Finish `org-goto' by going to the new location." |
634a7d0b | 5598 | (interactive) |
891f4676 RS |
5599 | (if (org-on-heading-p) |
5600 | (progn | |
c8d16429 | 5601 | (beginning-of-line 1) |
d5098885 JW |
5602 | (setq org-goto-selected-point (point) |
5603 | org-goto-exit-command 'left) | |
c8d16429 | 5604 | (throw 'exit nil)) |
891f4676 RS |
5605 | (error "Not on a heading"))) |
5606 | ||
634a7d0b | 5607 | (defun org-goto-right () |
b0a10108 | 5608 | "Finish `org-goto' by going to the new location." |
634a7d0b | 5609 | (interactive) |
891f4676 RS |
5610 | (if (org-on-heading-p) |
5611 | (progn | |
d5098885 JW |
5612 | (setq org-goto-selected-point (point) |
5613 | org-goto-exit-command 'right) | |
c8d16429 | 5614 | (throw 'exit nil)) |
891f4676 RS |
5615 | (error "Not on a heading"))) |
5616 | ||
5617 | (defun org-goto-quit () | |
b0a10108 | 5618 | "Finish `org-goto' without cursor motion." |
891f4676 | 5619 | (interactive) |
d5098885 JW |
5620 | (setq org-goto-selected-point nil) |
5621 | (setq org-goto-exit-command 'quit) | |
891f4676 RS |
5622 | (throw 'exit nil)) |
5623 | ||
d3f4dbe8 CD |
5624 | ;;; Indirect buffer display of subtrees |
5625 | ||
5626 | (defvar org-indirect-dedicated-frame nil | |
5627 | "This is the frame being used for indirect tree display.") | |
5628 | (defvar org-last-indirect-buffer nil) | |
5629 | ||
5630 | (defun org-tree-to-indirect-buffer (&optional arg) | |
5631 | "Create indirect buffer and narrow it to current subtree. | |
5632 | With numerical prefix ARG, go up to this level and then take that tree. | |
5633 | If ARG is negative, go up that many levels. | |
5634 | Normally this command removes the indirect buffer previously made | |
5635 | with this command. However, when called with a C-u prefix, the last buffer | |
5636 | is kept so that you can work with several indirect buffers at the same time. | |
5637 | If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also | |
5638 | requests that a new frame be made for the new buffer, so that the dedicated | |
5639 | frame is not changed." | |
5640 | (interactive "P") | |
5641 | (let ((cbuf (current-buffer)) | |
5642 | (cwin (selected-window)) | |
5643 | (pos (point)) | |
5644 | beg end level heading ibuf) | |
5645 | (save-excursion | |
5646 | (org-back-to-heading t) | |
5647 | (when (numberp arg) | |
5648 | (setq level (org-outline-level)) | |
5649 | (if (< arg 0) (setq arg (+ level arg))) | |
5650 | (while (> (setq level (org-outline-level)) arg) | |
5651 | (outline-up-heading 1 t))) | |
5652 | (setq beg (point) | |
5653 | heading (org-get-heading)) | |
5654 | (org-end-of-subtree t) (setq end (point))) | |
5655 | (if (and (not arg) | |
5656 | (buffer-live-p org-last-indirect-buffer)) | |
5657 | (kill-buffer org-last-indirect-buffer)) | |
5658 | (setq ibuf (org-get-indirect-buffer cbuf) | |
5659 | org-last-indirect-buffer ibuf) | |
5660 | (cond | |
5661 | ((or (eq org-indirect-buffer-display 'new-frame) | |
5662 | (and arg (eq org-indirect-buffer-display 'dedicated-frame))) | |
5663 | (select-frame (make-frame)) | |
5664 | (delete-other-windows) | |
5665 | (switch-to-buffer ibuf) | |
5666 | (org-set-frame-title heading)) | |
5667 | ((eq org-indirect-buffer-display 'dedicated-frame) | |
5668 | (raise-frame | |
5669 | (select-frame (or (and org-indirect-dedicated-frame | |
5670 | (frame-live-p org-indirect-dedicated-frame) | |
5671 | org-indirect-dedicated-frame) | |
5672 | (setq org-indirect-dedicated-frame (make-frame))))) | |
5673 | (delete-other-windows) | |
5674 | (switch-to-buffer ibuf) | |
5675 | (org-set-frame-title (concat "Indirect: " heading))) | |
5676 | ((eq org-indirect-buffer-display 'current-window) | |
5677 | (switch-to-buffer ibuf)) | |
5678 | ((eq org-indirect-buffer-display 'other-window) | |
5679 | (pop-to-buffer ibuf)) | |
5680 | (t (error "Invalid value."))) | |
5681 | (if (featurep 'xemacs) | |
5682 | (save-excursion (org-mode) (turn-on-font-lock))) | |
5683 | (narrow-to-region beg end) | |
5684 | (show-all) | |
5685 | (goto-char pos) | |
5686 | (and (window-live-p cwin) (select-window cwin)))) | |
5687 | ||
5688 | (defun org-get-indirect-buffer (&optional buffer) | |
5689 | (setq buffer (or buffer (current-buffer))) | |
5690 | (let ((n 1) (base (buffer-name buffer)) bname) | |
5691 | (while (buffer-live-p | |
5692 | (get-buffer (setq bname (concat base "-" (number-to-string n))))) | |
5693 | (setq n (1+ n))) | |
5694 | (condition-case nil | |
5695 | (make-indirect-buffer buffer bname 'clone) | |
5696 | (error (make-indirect-buffer buffer bname))))) | |
5697 | ||
5698 | (defun org-set-frame-title (title) | |
5699 | "Set the title of the current frame to the string TITLE." | |
5700 | ;; FIXME: how to name a single frame in XEmacs??? | |
5701 | (unless (featurep 'xemacs) | |
5702 | (modify-frame-parameters (selected-frame) (list (cons 'name title))))) | |
891f4676 | 5703 | |
d3f4dbe8 CD |
5704 | ;;;; Structure editing |
5705 | ||
5706 | ;;; Inserting headlines | |
891f4676 | 5707 | |
b2de034e | 5708 | (defun org-insert-heading (&optional force-heading) |
4b3a9ba7 CD |
5709 | "Insert a new heading or item with same depth at point. |
5710 | If point is in a plain list and FORCE-HEADING is nil, create a new list item. | |
5711 | If point is at the beginning of a headline, insert a sibling before the | |
5712 | current headline. If point is in the middle of a headline, split the headline | |
5713 | at that position and make the rest of the headline part of the sibling below | |
5714 | the current headline." | |
b2de034e | 5715 | (interactive "P") |
4b3a9ba7 CD |
5716 | (if (= (buffer-size) 0) |
5717 | (insert "\n* ") | |
5718 | (when (or force-heading (not (org-insert-item))) | |
5719 | (let* ((head (save-excursion | |
5720 | (condition-case nil | |
5721 | (progn | |
5722 | (org-back-to-heading) | |
5723 | (match-string 0)) | |
5724 | (error "*")))) | |
3278a016 | 5725 | (blank (cdr (assq 'heading org-blank-before-new-entry))) |
4b3a9ba7 | 5726 | pos) |
edd21304 CD |
5727 | (cond |
5728 | ((and (org-on-heading-p) (bolp) | |
a3fbe8c4 CD |
5729 | (or (bobp) |
5730 | (save-excursion (backward-char 1) (not (org-invisible-p))))) | |
3278a016 | 5731 | (open-line (if blank 2 1))) |
a3fbe8c4 CD |
5732 | ((and (bolp) |
5733 | (or (bobp) | |
5734 | (save-excursion | |
5735 | (backward-char 1) (not (org-invisible-p))))) | |
edd21304 | 5736 | nil) |
3278a016 | 5737 | (t (newline (if blank 2 1)))) |
4b3a9ba7 CD |
5738 | (insert head) (just-one-space) |
5739 | (setq pos (point)) | |
5740 | (end-of-line 1) | |
5741 | (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) | |
5742 | (run-hooks 'org-insert-heading-hook))))) | |
5743 | ||
15841868 JW |
5744 | (defun org-insert-heading-after-current () |
5745 | "Insert a new heading with same level as current, after current subtree." | |
5746 | (interactive) | |
5747 | (org-back-to-heading) | |
5748 | (org-insert-heading) | |
5749 | (org-move-subtree-down) | |
5750 | (end-of-line 1)) | |
5751 | ||
35fb9989 CD |
5752 | (defun org-insert-todo-heading (arg) |
5753 | "Insert a new heading with the same level and TODO state as current heading. | |
5754 | If the heading has no TODO state, or if the state is DONE, use the first | |
5755 | state (TODO by default). Also with prefix arg, force first state." | |
5756 | (interactive "P") | |
4b3a9ba7 CD |
5757 | (when (not (org-insert-item 'checkbox)) |
5758 | (org-insert-heading) | |
5759 | (save-excursion | |
5760 | (org-back-to-heading) | |
5137195a | 5761 | (outline-previous-heading) |
4b3a9ba7 CD |
5762 | (looking-at org-todo-line-regexp)) |
5763 | (if (or arg | |
5764 | (not (match-beginning 2)) | |
a3fbe8c4 CD |
5765 | (member (match-string 2) org-done-keywords)) |
5766 | (insert (car org-todo-keywords-1) " ") | |
4b3a9ba7 | 5767 | (insert (match-string 2) " ")))) |
35fb9989 | 5768 | |
48aaad2d CD |
5769 | (defun org-insert-subheading (arg) |
5770 | "Insert a new subheading and demote it. | |
5771 | Works for outline headings and for plain lists alike." | |
5772 | (interactive "P") | |
5773 | (org-insert-heading arg) | |
5774 | (cond | |
5775 | ((org-on-heading-p) (org-do-demote)) | |
5776 | ((org-at-item-p) (org-indent-item 1)))) | |
5777 | ||
5778 | (defun org-insert-todo-subheading (arg) | |
5779 | "Insert a new subheading with TODO keyword or checkbox and demote it. | |
5780 | Works for outline headings and for plain lists alike." | |
5781 | (interactive "P") | |
5782 | (org-insert-todo-heading arg) | |
5783 | (cond | |
5784 | ((org-on-heading-p) (org-do-demote)) | |
5785 | ((org-at-item-p) (org-indent-item 1)))) | |
fbe6c10d | 5786 | |
d3f4dbe8 CD |
5787 | ;;; Promotion and Demotion |
5788 | ||
634a7d0b | 5789 | (defun org-promote-subtree () |
891f4676 RS |
5790 | "Promote the entire subtree. |
5791 | See also `org-promote'." | |
634a7d0b CD |
5792 | (interactive) |
5793 | (save-excursion | |
3278a016 CD |
5794 | (org-map-tree 'org-promote)) |
5795 | (org-fix-position-after-promote)) | |
891f4676 | 5796 | |
634a7d0b | 5797 | (defun org-demote-subtree () |
891f4676 RS |
5798 | "Demote the entire subtree. See `org-demote'. |
5799 | See also `org-promote'." | |
634a7d0b CD |
5800 | (interactive) |
5801 | (save-excursion | |
3278a016 CD |
5802 | (org-map-tree 'org-demote)) |
5803 | (org-fix-position-after-promote)) | |
5804 | ||
891f4676 | 5805 | |
634a7d0b | 5806 | (defun org-do-promote () |
891f4676 | 5807 | "Promote the current heading higher up the tree. |
2dd9129f | 5808 | If the region is active in `transient-mark-mode', promote all headings |
891f4676 | 5809 | in the region." |
634a7d0b | 5810 | (interactive) |
891f4676 RS |
5811 | (save-excursion |
5812 | (if (org-region-active-p) | |
c8d16429 | 5813 | (org-map-region 'org-promote (region-beginning) (region-end)) |
891f4676 RS |
5814 | (org-promote))) |
5815 | (org-fix-position-after-promote)) | |
5816 | ||
634a7d0b | 5817 | (defun org-do-demote () |
891f4676 | 5818 | "Demote the current heading lower down the tree. |
634a7d0b | 5819 | If the region is active in `transient-mark-mode', demote all headings |
891f4676 | 5820 | in the region." |
634a7d0b | 5821 | (interactive) |
891f4676 RS |
5822 | (save-excursion |
5823 | (if (org-region-active-p) | |
c8d16429 | 5824 | (org-map-region 'org-demote (region-beginning) (region-end)) |
891f4676 RS |
5825 | (org-demote))) |
5826 | (org-fix-position-after-promote)) | |
5827 | ||
5828 | (defun org-fix-position-after-promote () | |
5829 | "Make sure that after pro/demotion cursor position is right." | |
d3f4dbe8 CD |
5830 | (let ((pos (point))) |
5831 | (when (save-excursion | |
5832 | (beginning-of-line 1) | |
5833 | (looking-at org-todo-line-regexp) | |
5834 | (or (equal pos (match-end 1)) (equal pos (match-end 2)))) | |
5835 | (cond ((eobp) (insert " ")) | |
5836 | ((eolp) (insert " ")) | |
5837 | ((equal (char-after) ?\ ) (forward-char 1)))))) | |
891f4676 | 5838 | |
38f8646b CD |
5839 | (defun org-reduced-level (l) |
5840 | (if org-odd-levels-only (1+ (floor (/ l 2))) l)) | |
5841 | ||
3278a016 | 5842 | (defun org-get-legal-level (level &optional change) |
79c4be8e CD |
5843 | "Rectify a level change under the influence of `org-odd-levels-only' |
5844 | LEVEL is a current level, CHANGE is by how much the level should be | |
5845 | modified. Even if CHANGE is nil, LEVEL may be returned modified because | |
5846 | even level numbers will become the next higher odd number." | |
5847 | (if org-odd-levels-only | |
3278a016 | 5848 | (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) |
79c4be8e CD |
5849 | ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) |
5850 | ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) | |
5851 | (max 1 (+ level change)))) | |
5852 | ||
891f4676 RS |
5853 | (defun org-promote () |
5854 | "Promote the current heading higher up the tree. | |
634a7d0b | 5855 | If the region is active in `transient-mark-mode', promote all headings |
891f4676 RS |
5856 | in the region." |
5857 | (org-back-to-heading t) | |
5858 | (let* ((level (save-match-data (funcall outline-level))) | |
7d58338e CD |
5859 | (up-head (concat (make-string (org-get-legal-level level -1) ?*) " ")) |
5860 | (diff (abs (- level (length up-head) -1)))) | |
500f86e0 | 5861 | (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) |
891f4676 | 5862 | (replace-match up-head nil t) |
d924f2e5 CD |
5863 | ;; Fixup tag positioning |
5864 | (and org-auto-align-tags (org-set-tags nil t)) | |
0fee8d6e | 5865 | (if org-adapt-indentation (org-fixup-indentation (- diff))))) |
891f4676 RS |
5866 | |
5867 | (defun org-demote () | |
5868 | "Demote the current heading lower down the tree. | |
634a7d0b | 5869 | If the region is active in `transient-mark-mode', demote all headings |
891f4676 RS |
5870 | in the region." |
5871 | (org-back-to-heading t) | |
5872 | (let* ((level (save-match-data (funcall outline-level))) | |
7d58338e CD |
5873 | (down-head (concat (make-string (org-get-legal-level level 1) ?*) " ")) |
5874 | (diff (abs (- level (length down-head) -1)))) | |
891f4676 | 5875 | (replace-match down-head nil t) |
d924f2e5 CD |
5876 | ;; Fixup tag positioning |
5877 | (and org-auto-align-tags (org-set-tags nil t)) | |
0fee8d6e | 5878 | (if org-adapt-indentation (org-fixup-indentation diff)))) |
891f4676 RS |
5879 | |
5880 | (defun org-map-tree (fun) | |
5881 | "Call FUN for every heading underneath the current one." | |
5882 | (org-back-to-heading) | |
7204b00e | 5883 | (let ((level (funcall outline-level))) |
891f4676 RS |
5884 | (save-excursion |
5885 | (funcall fun) | |
5886 | (while (and (progn | |
c8d16429 CD |
5887 | (outline-next-heading) |
5888 | (> (funcall outline-level) level)) | |
5889 | (not (eobp))) | |
5890 | (funcall fun))))) | |
891f4676 RS |
5891 | |
5892 | (defun org-map-region (fun beg end) | |
5893 | "Call FUN for every heading between BEG and END." | |
5894 | (let ((org-ignore-region t)) | |
5895 | (save-excursion | |
5896 | (setq end (copy-marker end)) | |
5897 | (goto-char beg) | |
891f4676 | 5898 | (if (and (re-search-forward (concat "^" outline-regexp) nil t) |
c8d16429 CD |
5899 | (< (point) end)) |
5900 | (funcall fun)) | |
891f4676 | 5901 | (while (and (progn |
c8d16429 CD |
5902 | (outline-next-heading) |
5903 | (< (point) end)) | |
5904 | (not (eobp))) | |
5905 | (funcall fun))))) | |
891f4676 | 5906 | |
0fee8d6e CD |
5907 | (defun org-fixup-indentation (diff) |
5908 | "Change the indentation in the current entry by DIFF | |
5909 | However, if any line in the current entry has no indentation, or if it | |
5910 | would end up with no indentation after the change, nothing at all is done." | |
891f4676 RS |
5911 | (save-excursion |
5912 | (let ((end (save-excursion (outline-next-heading) | |
0fee8d6e CD |
5913 | (point-marker))) |
5914 | (prohibit (if (> diff 0) | |
c44f0d75 | 5915 | "^\\S-" |
0fee8d6e CD |
5916 | (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) |
5917 | col) | |
48aaad2d CD |
5918 | (unless (save-excursion (end-of-line 1) |
5919 | (re-search-forward prohibit end t)) | |
0fee8d6e CD |
5920 | (while (re-search-forward "^[ \t]+" end t) |
5921 | (goto-char (match-end 0)) | |
5922 | (setq col (current-column)) | |
5923 | (if (< diff 0) (replace-match "")) | |
5924 | (indent-to (+ diff col)))) | |
891f4676 RS |
5925 | (move-marker end nil)))) |
5926 | ||
d3f4dbe8 CD |
5927 | (defun org-convert-to-odd-levels () |
5928 | "Convert an org-mode file with all levels allowed to one with odd levels. | |
5929 | This will leave level 1 alone, convert level 2 to level 3, level 3 to | |
5930 | level 5 etc." | |
5931 | (interactive) | |
5932 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") | |
5933 | (let ((org-odd-levels-only nil) n) | |
5934 | (save-excursion | |
5935 | (goto-char (point-min)) | |
7d58338e CD |
5936 | (while (re-search-forward "^\\*\\*+ " nil t) |
5937 | (setq n (- (length (match-string 0)) 2)) | |
d3f4dbe8 CD |
5938 | (while (>= (setq n (1- n)) 0) |
5939 | (org-demote)) | |
5940 | (end-of-line 1)))))) | |
5941 | ||
5942 | ||
5943 | (defun org-convert-to-oddeven-levels () | |
5944 | "Convert an org-mode file with only odd levels to one with odd and even levels. | |
5945 | This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a | |
5946 | section with an even level, conversion would destroy the structure of the file. An error | |
5947 | is signaled in this case." | |
5948 | (interactive) | |
5949 | (goto-char (point-min)) | |
5950 | ;; First check if there are no even levels | |
7d58338e | 5951 | (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) |
d3f4dbe8 CD |
5952 | (org-show-context t) |
5953 | (error "Not all levels are odd in this file. Conversion not possible.")) | |
5954 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") | |
5955 | (let ((org-odd-levels-only nil) n) | |
5956 | (save-excursion | |
5957 | (goto-char (point-min)) | |
7d58338e | 5958 | (while (re-search-forward "^\\*\\*+ " nil t) |
03f3cf35 | 5959 | (setq n (/ (1- (length (match-string 0))) 2)) |
d3f4dbe8 CD |
5960 | (while (>= (setq n (1- n)) 0) |
5961 | (org-promote)) | |
5962 | (end-of-line 1)))))) | |
5963 | ||
5964 | (defun org-tr-level (n) | |
5965 | "Make N odd if required." | |
5966 | (if org-odd-levels-only (1+ (/ n 2)) n)) | |
5967 | ||
5968 | ;;; Vertical tree motion, cutting and pasting of subtrees | |
5969 | ||
5970 | (defun org-move-subtree-up (&optional arg) | |
5971 | "Move the current subtree up past ARG headlines of the same level." | |
5972 | (interactive "p") | |
5973 | (org-move-subtree-down (- (prefix-numeric-value arg)))) | |
5974 | ||
5975 | (defun org-move-subtree-down (&optional arg) | |
5976 | "Move the current subtree down past ARG headlines of the same level." | |
5977 | (interactive "p") | |
891f4676 RS |
5978 | (setq arg (prefix-numeric-value arg)) |
5979 | (let ((movfunc (if (> arg 0) 'outline-get-next-sibling | |
5980 | 'outline-get-last-sibling)) | |
5981 | (ins-point (make-marker)) | |
5982 | (cnt (abs arg)) | |
5983 | beg end txt folded) | |
5984 | ;; Select the tree | |
5985 | (org-back-to-heading) | |
5986 | (setq beg (point)) | |
5987 | (save-match-data | |
5988 | (save-excursion (outline-end-of-heading) | |
5989 | (setq folded (org-invisible-p))) | |
5990 | (outline-end-of-subtree)) | |
ef943dba | 5991 | (outline-next-heading) |
891f4676 RS |
5992 | (setq end (point)) |
5993 | ;; Find insertion point, with error handling | |
5994 | (goto-char beg) | |
5995 | (while (> cnt 0) | |
5996 | (or (and (funcall movfunc) (looking-at outline-regexp)) | |
5997 | (progn (goto-char beg) | |
5998 | (error "Cannot move past superior level or buffer limit"))) | |
5999 | (setq cnt (1- cnt))) | |
6000 | (if (> arg 0) | |
6001 | ;; Moving forward - still need to move over subtree | |
6002 | (progn (outline-end-of-subtree) | |
c8d16429 CD |
6003 | (outline-next-heading) |
6004 | (if (not (or (looking-at (concat "^" outline-regexp)) | |
6005 | (bolp))) | |
6006 | (newline)))) | |
891f4676 RS |
6007 | (move-marker ins-point (point)) |
6008 | (setq txt (buffer-substring beg end)) | |
6009 | (delete-region beg end) | |
6010 | (insert txt) | |
a3fbe8c4 | 6011 | (or (bolp) (insert "\n")) |
891f4676 RS |
6012 | (goto-char ins-point) |
6013 | (if folded (hide-subtree)) | |
6014 | (move-marker ins-point nil))) | |
6015 | ||
6016 | (defvar org-subtree-clip "" | |
6017 | "Clipboard for cut and paste of subtrees. | |
ef943dba | 6018 | This is actually only a copy of the kill, because we use the normal kill |
891f4676 RS |
6019 | ring. We need it to check if the kill was created by `org-copy-subtree'.") |
6020 | ||
6021 | (defvar org-subtree-clip-folded nil | |
35fb9989 | 6022 | "Was the last copied subtree folded? |
891f4676 RS |
6023 | This is used to fold the tree back after pasting.") |
6024 | ||
03f3cf35 | 6025 | (defun org-cut-subtree (&optional n) |
891f4676 | 6026 | "Cut the current subtree into the clipboard. |
03f3cf35 | 6027 | With prefix arg N, cut this many sequential subtrees. |
891f4676 | 6028 | This is a short-hand for marking the subtree and then cutting it." |
03f3cf35 JW |
6029 | (interactive "p") |
6030 | (org-copy-subtree n 'cut)) | |
891f4676 | 6031 | |
03f3cf35 | 6032 | (defun org-copy-subtree (&optional n cut) |
891f4676 | 6033 | "Cut the current subtree into the clipboard. |
03f3cf35 | 6034 | With prefix arg N, cut this many sequential subtrees. |
891f4676 | 6035 | This is a short-hand for marking the subtree and then copying it. |
b1f50b95 | 6036 | If CUT is non-nil, actually cut the subtree." |
03f3cf35 | 6037 | (interactive "p") |
891f4676 | 6038 | (let (beg end folded) |
a3fbe8c4 CD |
6039 | (if (interactive-p) |
6040 | (org-back-to-heading nil) ; take what looks like a subtree | |
6041 | (org-back-to-heading t)) ; take what is really there | |
891f4676 RS |
6042 | (setq beg (point)) |
6043 | (save-match-data | |
6044 | (save-excursion (outline-end-of-heading) | |
c8d16429 | 6045 | (setq folded (org-invisible-p))) |
03f3cf35 JW |
6046 | (condition-case nil |
6047 | (outline-forward-same-level (1- n)) | |
6048 | (error nil)) | |
6049 | (org-end-of-subtree t t)) | |
891f4676 RS |
6050 | (setq end (point)) |
6051 | (goto-char beg) | |
6052 | (when (> end beg) | |
6053 | (setq org-subtree-clip-folded folded) | |
6054 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) | |
6055 | (setq org-subtree-clip (current-kill 0)) | |
03f3cf35 | 6056 | (message "%s: Subtree(s) with %d characters" |
c8d16429 CD |
6057 | (if cut "Cut" "Copied") |
6058 | (length org-subtree-clip))))) | |
891f4676 RS |
6059 | |
6060 | (defun org-paste-subtree (&optional level tree) | |
6061 | "Paste the clipboard as a subtree, with modification of headline level. | |
6062 | The entire subtree is promoted or demoted in order to match a new headline | |
6063 | level. By default, the new level is derived from the visible headings | |
6064 | before and after the insertion point, and taken to be the inferior headline | |
6065 | level of the two. So if the previous visible heading is level 3 and the | |
6066 | next is level 4 (or vice versa), level 4 will be used for insertion. | |
6067 | This makes sure that the subtree remains an independent subtree and does | |
6068 | not swallow low level entries. | |
6069 | ||
6070 | You can also force a different level, either by using a numeric prefix | |
6071 | argument, or by inserting the heading marker by hand. For example, if the | |
6072 | cursor is after \"*****\", then the tree will be shifted to level 5. | |
6073 | ||
6074 | If you want to insert the tree as is, just use \\[yank]. | |
6075 | ||
6076 | If optional TREE is given, use this text instead of the kill ring." | |
6077 | (interactive "P") | |
6078 | (unless (org-kill-is-subtree-p tree) | |
40b0e87a | 6079 | (error "%s" |
891f4676 RS |
6080 | (substitute-command-keys |
6081 | "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) | |
f85d958a | 6082 | (let* ((txt (or tree (and kill-ring (current-kill 0)))) |
c8d16429 CD |
6083 | (^re (concat "^\\(" outline-regexp "\\)")) |
6084 | (re (concat "\\(" outline-regexp "\\)")) | |
03f3cf35 | 6085 | (^re_ (concat "\\(\\*+\\)[ \t]*")) |
c8d16429 CD |
6086 | |
6087 | (old-level (if (string-match ^re txt) | |
1e8fbb6d | 6088 | (- (match-end 0) (match-beginning 0) 1) |
c8d16429 CD |
6089 | -1)) |
6090 | (force-level (cond (level (prefix-numeric-value level)) | |
6091 | ((string-match | |
6092 | ^re_ (buffer-substring (point-at-bol) (point))) | |
03f3cf35 | 6093 | (- (match-end 1) (match-beginning 1))) |
c8d16429 CD |
6094 | (t nil))) |
6095 | (previous-level (save-excursion | |
6096 | (condition-case nil | |
6097 | (progn | |
6098 | (outline-previous-visible-heading 1) | |
6099 | (if (looking-at re) | |
03f3cf35 | 6100 | (- (match-end 0) (match-beginning 0) 1) |
c8d16429 CD |
6101 | 1)) |
6102 | (error 1)))) | |
6103 | (next-level (save-excursion | |
6104 | (condition-case nil | |
6105 | (progn | |
03f3cf35 JW |
6106 | (or (looking-at outline-regexp) |
6107 | (outline-next-visible-heading 1)) | |
c8d16429 | 6108 | (if (looking-at re) |
03f3cf35 | 6109 | (- (match-end 0) (match-beginning 0) 1) |
c8d16429 CD |
6110 | 1)) |
6111 | (error 1)))) | |
6112 | (new-level (or force-level (max previous-level next-level))) | |
6113 | (shift (if (or (= old-level -1) | |
6114 | (= new-level -1) | |
6115 | (= old-level new-level)) | |
6116 | 0 | |
6117 | (- new-level old-level))) | |
c8d16429 CD |
6118 | (delta (if (> shift 0) -1 1)) |
6119 | (func (if (> shift 0) 'org-demote 'org-promote)) | |
79c4be8e | 6120 | (org-odd-levels-only nil) |
c8d16429 | 6121 | beg end) |
d5098885 | 6122 | ;; Remove the forced level indicator |
891f4676 | 6123 | (if force-level |
c8d16429 | 6124 | (delete-region (point-at-bol) (point))) |
891f4676 | 6125 | ;; Paste |
d5098885 | 6126 | (beginning-of-line 1) |
891f4676 RS |
6127 | (setq beg (point)) |
6128 | (insert txt) | |
d5098885 | 6129 | (unless (string-match "\n[ \t]*\\'" txt) (insert "\n")) |
891f4676 RS |
6130 | (setq end (point)) |
6131 | (goto-char beg) | |
6132 | ;; Shift if necessary | |
0b8568f5 | 6133 | (unless (= shift 0) |
891f4676 | 6134 | (save-restriction |
c8d16429 CD |
6135 | (narrow-to-region beg end) |
6136 | (while (not (= shift 0)) | |
6137 | (org-map-region func (point-min) (point-max)) | |
6138 | (setq shift (+ delta shift))) | |
0b8568f5 JW |
6139 | (goto-char (point-min)))) |
6140 | (when (interactive-p) | |
6141 | (message "Clipboard pasted as level %d subtree" new-level)) | |
f85d958a CD |
6142 | (if (and kill-ring |
6143 | (eq org-subtree-clip (current-kill 0)) | |
c8d16429 CD |
6144 | org-subtree-clip-folded) |
6145 | ;; The tree was folded before it was killed/copied | |
6146 | (hide-subtree)))) | |
891f4676 RS |
6147 | |
6148 | (defun org-kill-is-subtree-p (&optional txt) | |
6149 | "Check if the current kill is an outline subtree, or a set of trees. | |
6150 | Returns nil if kill does not start with a headline, or if the first | |
6151 | headline level is not the largest headline level in the tree. | |
35fb9989 | 6152 | So this will actually accept several entries of equal levels as well, |
891f4676 RS |
6153 | which is OK for `org-paste-subtree'. |
6154 | If optional TXT is given, check this string instead of the current kill." | |
f85d958a CD |
6155 | (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) |
6156 | (start-level (and kill | |
d5098885 JW |
6157 | (string-match (concat "\\`" org-outline-regexp) kill) |
6158 | (- (match-end 0) (match-beginning 0) 1))) | |
6159 | (re (concat "^" org-outline-regexp)) | |
c8d16429 | 6160 | (start 1)) |
891f4676 | 6161 | (if (not start-level) |
d5098885 JW |
6162 | (progn |
6163 | nil) ;; does not even start with a heading | |
891f4676 | 6164 | (catch 'exit |
c8d16429 | 6165 | (while (setq start (string-match re kill (1+ start))) |
d5098885 JW |
6166 | (when (< (- (match-end 0) (match-beginning 0) 1) start-level) |
6167 | (throw 'exit nil))) | |
c8d16429 | 6168 | t)))) |
891f4676 | 6169 | |
0fee8d6e CD |
6170 | (defun org-narrow-to-subtree () |
6171 | "Narrow buffer to the current subtree." | |
6172 | (interactive) | |
6173 | (save-excursion | |
6174 | (narrow-to-region | |
6175 | (progn (org-back-to-heading) (point)) | |
a3fbe8c4 | 6176 | (progn (org-end-of-subtree t t) (point))))) |
0fee8d6e | 6177 | |
d3f4dbe8 CD |
6178 | |
6179 | ;;; Outline Sorting | |
6180 | ||
6181 | (defun org-sort (with-case) | |
03f3cf35 JW |
6182 | "Call `org-sort-entries-or-items' or `org-table-sort-lines'. |
6183 | Optional argument WITH-CASE means sort case-sensitively." | |
d3f4dbe8 CD |
6184 | (interactive "P") |
6185 | (if (org-at-table-p) | |
6186 | (org-call-with-arg 'org-table-sort-lines with-case) | |
03f3cf35 JW |
6187 | (org-call-with-arg 'org-sort-entries-or-items with-case))) |
6188 | ||
6189 | (defvar org-priority-regexp) ; defined later in the file | |
d3f4dbe8 | 6190 | |
03f3cf35 | 6191 | (defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func property) |
d3f4dbe8 CD |
6192 | "Sort entries on a certain level of an outline tree. |
6193 | If there is an active region, the entries in the region are sorted. | |
6194 | Else, if the cursor is before the first entry, sort the top-level items. | |
6195 | Else, the children of the entry at point are sorted. | |
6196 | ||
6197 | Sorting can be alphabetically, numerically, and by date/time as given by | |
6198 | the first time stamp in the entry. The command prompts for the sorting | |
6199 | type unless it has been given to the function through the SORTING-TYPE | |
03f3cf35 JW |
6200 | argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F). |
6201 | If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be | |
6202 | called with point at the beginning of the record. It must return either | |
6203 | a string or a number that should serve as the sorting key for that record. | |
d3f4dbe8 CD |
6204 | |
6205 | Comparing entries ignores case by default. However, with an optional argument | |
03f3cf35 | 6206 | WITH-CASE, the sorting considers case as well." |
d3f4dbe8 | 6207 | (interactive "P") |
03f3cf35 JW |
6208 | (let ((case-func (if with-case 'identity 'downcase)) |
6209 | start beg end stars re re2 | |
6210 | txt what tmp plain-list-p) | |
d3f4dbe8 CD |
6211 | ;; Find beginning and end of region to sort |
6212 | (cond | |
6213 | ((org-region-active-p) | |
6214 | ;; we will sort the region | |
6215 | (setq end (region-end) | |
03f3cf35 | 6216 | what "region") |
d3f4dbe8 CD |
6217 | (goto-char (region-beginning)) |
6218 | (if (not (org-on-heading-p)) (outline-next-heading)) | |
6219 | (setq start (point))) | |
03f3cf35 JW |
6220 | ((org-at-item-p) |
6221 | ;; we will sort this plain list | |
6222 | (org-beginning-of-item-list) (setq start (point)) | |
6223 | (org-end-of-item-list) (setq end (point)) | |
6224 | (goto-char start) | |
6225 | (setq plain-list-p t | |
6226 | what "plain list")) | |
d3f4dbe8 | 6227 | ((or (org-on-heading-p) |
03f3cf35 | 6228 | (condition-case nil (progn (org-back-to-heading) t) (error nil))) |
d3f4dbe8 CD |
6229 | ;; we will sort the children of the current headline |
6230 | (org-back-to-heading) | |
6231 | (setq start (point) end (org-end-of-subtree) what "children") | |
6232 | (goto-char start) | |
6233 | (show-subtree) | |
6234 | (outline-next-heading)) | |
6235 | (t | |
6236 | ;; we will sort the top-level entries in this file | |
6237 | (goto-char (point-min)) | |
6238 | (or (org-on-heading-p) (outline-next-heading)) | |
6239 | (setq start (point) end (point-max) what "top-level") | |
6240 | (goto-char start) | |
6241 | (show-all))) | |
d3f4dbe8 | 6242 | |
03f3cf35 JW |
6243 | (setq beg (point)) |
6244 | (if (>= beg end) (error "Nothing to sort")) | |
6245 | ||
6246 | (unless plain-list-p | |
6247 | (looking-at "\\(\\*+\\)") | |
6248 | (setq stars (match-string 1) | |
6249 | re (concat "^" (regexp-quote stars) " +") | |
6250 | re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") | |
6251 | txt (buffer-substring beg end)) | |
6252 | (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) | |
6253 | (if (and (not (equal stars "*")) (string-match re2 txt)) | |
6254 | (error "Region to sort contains a level above the first entry"))) | |
6255 | ||
6256 | (unless sorting-type | |
6257 | (message | |
6258 | (if plain-list-p | |
6259 | "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" | |
6260 | "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty [f]unc A/N/T/P/F means reversed:") | |
6261 | what) | |
6262 | (setq sorting-type (read-char-exclusive)) | |
6263 | ||
6264 | (and (= (downcase sorting-type) ?f) | |
6265 | (setq getkey-func | |
6266 | (completing-read "Sort using function: " | |
6267 | obarray 'fboundp t nil nil)) | |
6268 | (setq getkey-func (intern getkey-func))) | |
fbe6c10d | 6269 | |
03f3cf35 JW |
6270 | (and (= (downcase sorting-type) ?r) |
6271 | (setq property | |
6272 | (completing-read "Property: " | |
6273 | (mapcar 'list (org-buffer-property-keys t)) | |
6274 | nil t)))) | |
d3f4dbe8 | 6275 | |
03f3cf35 | 6276 | (message "Sorting entries...") |
d3f4dbe8 | 6277 | |
03f3cf35 JW |
6278 | (save-restriction |
6279 | (narrow-to-region start end) | |
6280 | ||
6281 | (let ((dcst (downcase sorting-type)) | |
6282 | (now (current-time))) | |
6283 | (sort-subr | |
6284 | (/= dcst sorting-type) | |
6285 | ;; This function moves to the beginning character of the "record" to | |
6286 | ;; be sorted. | |
6287 | (if plain-list-p | |
6288 | (lambda nil | |
6289 | (if (org-at-item-p) t (goto-char (point-max)))) | |
6290 | (lambda nil | |
6291 | (if (re-search-forward re nil t) | |
6292 | (goto-char (match-beginning 0)) | |
6293 | (goto-char (point-max))))) | |
6294 | ;; This function moves to the last character of the "record" being | |
6295 | ;; sorted. | |
6296 | (if plain-list-p | |
6297 | 'org-end-of-item | |
6298 | (lambda nil | |
6299 | (save-match-data | |
6300 | (condition-case nil | |
6301 | (outline-forward-same-level 1) | |
6302 | (error | |
6303 | (goto-char (point-max))))))) | |
6304 | ||
6305 | ;; This function returns the value that gets sorted against. | |
6306 | (if plain-list-p | |
6307 | (lambda nil | |
6308 | (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") | |
6309 | (cond | |
6310 | ((= dcst ?n) | |
6311 | (string-to-number (buffer-substring (match-end 0) | |
6312 | (line-end-position)))) | |
6313 | ((= dcst ?a) | |
6314 | (buffer-substring (match-end 0) (line-end-position))) | |
6315 | ((= dcst ?t) | |
6316 | (if (re-search-forward org-ts-regexp | |
6317 | (line-end-position) t) | |
6318 | (org-time-string-to-time (match-string 0)) | |
6319 | now)) | |
6320 | ((= dcst ?f) | |
6321 | (if getkey-func | |
6322 | (progn | |
6323 | (setq tmp (funcall getkey-func)) | |
6324 | (if (stringp tmp) (setq tmp (funcall case-func tmp))) | |
6325 | tmp) | |
6326 | (error "Invalid key function `%s'" getkey-func))) | |
6327 | (t (error "Invalid sorting type `%c'" sorting-type))))) | |
6328 | (lambda nil | |
6329 | (cond | |
6330 | ((= dcst ?n) | |
6331 | (if (looking-at outline-regexp) | |
6332 | (string-to-number (buffer-substring (match-end 0) | |
6333 | (line-end-position))) | |
6334 | nil)) | |
6335 | ((= dcst ?a) | |
6336 | (funcall case-func (buffer-substring (line-beginning-position) | |
6337 | (line-end-position)))) | |
6338 | ((= dcst ?t) | |
6339 | (if (re-search-forward org-ts-regexp | |
6340 | (save-excursion | |
6341 | (forward-line 2) | |
6342 | (point)) t) | |
6343 | (org-time-string-to-time (match-string 0)) | |
6344 | now)) | |
6345 | ((= dcst ?p) | |
6346 | (if (re-search-forward org-priority-regexp (line-end-position) t) | |
6347 | (string-to-char (match-string 2)) | |
6348 | org-default-priority)) | |
6349 | ((= dcst ?r) | |
6350 | (or (org-entry-get nil property) "")) | |
6351 | ((= dcst ?f) | |
6352 | (if getkey-func | |
6353 | (progn | |
6354 | (setq tmp (funcall getkey-func)) | |
6355 | (if (stringp tmp) (setq tmp (funcall case-func tmp))) | |
6356 | tmp) | |
6357 | (error "Invalid key function `%s'" getkey-func))) | |
6358 | (t (error "Invalid sorting type `%c'" sorting-type))))) | |
6359 | nil | |
6360 | (cond | |
6361 | ((= dcst ?a) 'string<) | |
6362 | ((= dcst ?t) 'time-less-p) | |
6363 | (t nil))))) | |
6364 | (message "Sorting entries...done"))) | |
374585c9 | 6365 | |
d3f4dbe8 CD |
6366 | (defun org-do-sort (table what &optional with-case sorting-type) |
6367 | "Sort TABLE of WHAT according to SORTING-TYPE. | |
6368 | The user will be prompted for the SORTING-TYPE if the call to this | |
6369 | function does not specify it. WHAT is only for the prompt, to indicate | |
6370 | what is being sorted. The sorting key will be extracted from | |
6371 | the car of the elements of the table. | |
6372 | If WITH-CASE is non-nil, the sorting will be case-sensitive." | |
6373 | (unless sorting-type | |
6374 | (message | |
03f3cf35 | 6375 | "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:" |
d3f4dbe8 CD |
6376 | what) |
6377 | (setq sorting-type (read-char-exclusive))) | |
6378 | (let ((dcst (downcase sorting-type)) | |
6379 | extractfun comparefun) | |
6380 | ;; Define the appropriate functions | |
6381 | (cond | |
6382 | ((= dcst ?n) | |
6383 | (setq extractfun 'string-to-number | |
6384 | comparefun (if (= dcst sorting-type) '< '>))) | |
6385 | ((= dcst ?a) | |
6386 | (setq extractfun (if with-case 'identity 'downcase) | |
6387 | comparefun (if (= dcst sorting-type) | |
6388 | 'string< | |
6389 | (lambda (a b) (and (not (string< a b)) | |
6390 | (not (string= a b))))))) | |
6391 | ((= dcst ?t) | |
6392 | (setq extractfun | |
6393 | (lambda (x) | |
6394 | (if (string-match org-ts-regexp x) | |
6395 | (time-to-seconds | |
6396 | (org-time-string-to-time (match-string 0 x))) | |
6397 | 0)) | |
6398 | comparefun (if (= dcst sorting-type) '< '>))) | |
6399 | (t (error "Invalid sorting type `%c'" sorting-type))) | |
6400 | ||
6401 | (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) | |
6402 | table) | |
6403 | (lambda (a b) (funcall comparefun (car a) (car b)))))) | |
6404 | ||
6405 | ;;;; Plain list items, including checkboxes | |
6406 | ||
4da1a99d | 6407 | ;;; Plain list items |
7a368970 CD |
6408 | |
6409 | (defun org-at-item-p () | |
6410 | "Is point in a line starting a hand-formatted item?" | |
6411 | (let ((llt org-plain-list-ordered-item-terminator)) | |
6412 | (save-excursion | |
6413 | (goto-char (point-at-bol)) | |
b0a10108 | 6414 | (looking-at |
7a368970 CD |
6415 | (cond |
6416 | ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") | |
6417 | ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") | |
6418 | ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") | |
6419 | (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) | |
6420 | ||
d3f4dbe8 CD |
6421 | (defun org-in-item-p () |
6422 | "It the cursor inside a plain list item. | |
6423 | Does not have to be the first line." | |
6424 | (save-excursion | |
6425 | (condition-case nil | |
6426 | (progn | |
6427 | (org-beginning-of-item) | |
6428 | (org-at-item-p) | |
6429 | t) | |
6430 | (error nil)))) | |
6431 | ||
6432 | (defun org-insert-item (&optional checkbox) | |
6433 | "Insert a new item at the current level. | |
6434 | Return t when things worked, nil when we are not in an item." | |
6435 | (when (save-excursion | |
6436 | (condition-case nil | |
6437 | (progn | |
6438 | (org-beginning-of-item) | |
6439 | (org-at-item-p) | |
6440 | (if (org-invisible-p) (error "Invisible item")) | |
6441 | t) | |
6442 | (error nil))) | |
6443 | (let* ((bul (match-string 0)) | |
6444 | (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") | |
6445 | (match-end 0))) | |
6446 | (blank (cdr (assq 'plain-list-item org-blank-before-new-entry))) | |
6447 | pos) | |
6448 | (cond | |
6449 | ((and (org-at-item-p) (<= (point) eow)) | |
6450 | ;; before the bullet | |
6451 | (beginning-of-line 1) | |
6452 | (open-line (if blank 2 1))) | |
6453 | ((<= (point) eow) | |
6454 | (beginning-of-line 1)) | |
6455 | (t (newline (if blank 2 1)))) | |
6456 | (insert bul (if checkbox "[ ]" "")) | |
6457 | (just-one-space) | |
6458 | (setq pos (point)) | |
6459 | (end-of-line 1) | |
6460 | (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) | |
6461 | (org-maybe-renumber-ordered-list) | |
6462 | (and checkbox (org-update-checkbox-count-maybe)) | |
6463 | t)) | |
6464 | ||
6465 | ;;; Checkboxes | |
6466 | ||
4b3a9ba7 CD |
6467 | (defun org-at-item-checkbox-p () |
6468 | "Is point at a line starting a plain-list item with a checklet?" | |
6469 | (and (org-at-item-p) | |
6470 | (save-excursion | |
6471 | (goto-char (match-end 0)) | |
6472 | (skip-chars-forward " \t") | |
1e8fbb6d | 6473 | (looking-at "\\[[- X]\\]")))) |
4b3a9ba7 | 6474 | |
8df0de1c | 6475 | (defun org-toggle-checkbox (&optional arg) |
4b3a9ba7 | 6476 | "Toggle the checkbox in the current line." |
8df0de1c CD |
6477 | (interactive "P") |
6478 | (catch 'exit | |
6479 | (let (beg end status (firstnew 'unknown)) | |
6480 | (cond | |
6481 | ((org-region-active-p) | |
6482 | (setq beg (region-beginning) end (region-end))) | |
6483 | ((org-on-heading-p) | |
6484 | (setq beg (point) end (save-excursion (outline-next-heading) (point)))) | |
6485 | ((org-at-item-checkbox-p) | |
6486 | (save-excursion | |
1e8fbb6d CD |
6487 | (replace-match |
6488 | (cond (arg "[-]") | |
6489 | ((member (match-string 0) '("[ ]" "[-]")) "[X]") | |
6490 | (t "[ ]")) | |
6491 | t t)) | |
8df0de1c CD |
6492 | (throw 'exit t)) |
6493 | (t (error "Not at a checkbox or heading, and no active region"))) | |
6494 | (save-excursion | |
6495 | (goto-char beg) | |
6496 | (while (< (point) end) | |
6497 | (when (org-at-item-checkbox-p) | |
6498 | (setq status (equal (match-string 0) "[X]")) | |
6499 | (when (eq firstnew 'unknown) | |
6500 | (setq firstnew (not status))) | |
c44f0d75 | 6501 | (replace-match |
8df0de1c | 6502 | (if (if arg (not status) firstnew) "[X]" "[ ]") t t)) |
3278a016 CD |
6503 | (beginning-of-line 2))))) |
6504 | (org-update-checkbox-count-maybe)) | |
6505 | ||
6506 | (defun org-update-checkbox-count-maybe () | |
6507 | "Update checkbox statistics unless turned off by user." | |
6508 | (when org-provide-checkbox-statistics | |
6509 | (org-update-checkbox-count))) | |
6510 | ||
6511 | (defun org-update-checkbox-count (&optional all) | |
6512 | "Update the checkbox statistics in the current section. | |
6513 | This will find all statistic cookies like [57%] and [6/12] and update them | |
6514 | with the current numbers. With optional prefix argument ALL, do this for | |
6515 | the whole buffer." | |
6516 | (interactive "P") | |
6517 | (save-excursion | |
a3fbe8c4 | 6518 | (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 |
38f8646b CD |
6519 | (beg (condition-case nil |
6520 | (progn (outline-back-to-heading) (point)) | |
6521 | (error (point-min)))) | |
3278a016 CD |
6522 | (end (move-marker (make-marker) |
6523 | (progn (outline-next-heading) (point)))) | |
6524 | (re "\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)") | |
1e8fbb6d | 6525 | (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") |
3278a016 CD |
6526 | b1 e1 f1 c-on c-off lim (cstat 0)) |
6527 | (when all | |
6528 | (goto-char (point-min)) | |
6529 | (outline-next-heading) | |
6530 | (setq beg (point) end (point-max))) | |
6531 | (goto-char beg) | |
6532 | (while (re-search-forward re end t) | |
6533 | (setq cstat (1+ cstat) | |
6534 | b1 (match-beginning 0) | |
6535 | e1 (match-end 0) | |
6536 | f1 (match-beginning 1) | |
6537 | lim (cond | |
6538 | ((org-on-heading-p) (outline-next-heading) (point)) | |
6539 | ((org-at-item-p) (org-end-of-item) (point)) | |
6540 | (t nil)) | |
6541 | c-on 0 c-off 0) | |
6542 | (goto-char e1) | |
6543 | (when lim | |
6544 | (while (re-search-forward re-box lim t) | |
1e8fbb6d | 6545 | (if (member (match-string 2) '("[ ]" "[-]")) |
3278a016 CD |
6546 | (setq c-off (1+ c-off)) |
6547 | (setq c-on (1+ c-on)))) | |
48aaad2d | 6548 | ; (delete-region b1 e1) |
3278a016 CD |
6549 | (goto-char b1) |
6550 | (insert (if f1 | |
6551 | (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) | |
48aaad2d CD |
6552 | (format "[%d/%d]" c-on (+ c-on c-off)))) |
6553 | (and (looking-at "\\[.*?\\]") | |
6554 | (replace-match "")))) | |
3278a016 CD |
6555 | (when (interactive-p) |
6556 | (message "Checkbox satistics updated %s (%d places)" | |
6557 | (if all "in entire file" "in current outline entry") cstat))))) | |
6558 | ||
6559 | (defun org-get-checkbox-statistics-face () | |
6560 | "Select the face for checkbox statistics. | |
6561 | The face will be `org-done' when all relevant boxes are checked. Otherwise | |
6562 | it will be `org-todo'." | |
6563 | (if (match-end 1) | |
6564 | (if (equal (match-string 1) "100%") 'org-done 'org-todo) | |
6565 | (if (and (> (match-end 2) (match-beginning 2)) | |
6566 | (equal (match-string 2) (match-string 3))) | |
6567 | 'org-done | |
6568 | 'org-todo))) | |
4b3a9ba7 | 6569 | |
7d143c25 CD |
6570 | (defun org-get-indentation (&optional line) |
6571 | "Get the indentation of the current line, interpreting tabs. | |
6572 | When LINE is given, assume it represents a line and compute its indentation." | |
6573 | (if line | |
6574 | (if (string-match "^ *" (org-remove-tabs line)) | |
6575 | (match-end 0)) | |
6576 | (save-excursion | |
6577 | (beginning-of-line 1) | |
6578 | (skip-chars-forward " \t") | |
6579 | (current-column)))) | |
6580 | ||
6581 | (defun org-remove-tabs (s &optional width) | |
6582 | "Replace tabulators in S with spaces. | |
6583 | Assumes that s is a single line, starting in column 0." | |
6584 | (setq width (or width tab-width)) | |
6585 | (while (string-match "\t" s) | |
6586 | (setq s (replace-match | |
6587 | (make-string | |
6588 | (- (* width (/ (+ (match-beginning 0) width) width)) | |
6589 | (match-beginning 0)) ?\ ) | |
6590 | t t s))) | |
6591 | s) | |
6592 | ||
7d143c25 | 6593 | (defun org-fix-indentation (line ind) |
d3f4dbe8 CD |
6594 | "Fix indentation in LINE. |
6595 | IND is a cons cell with target and minimum indentation. | |
6596 | If the current indenation in LINE is smaller than the minimum, | |
6597 | leave it alone. If it is larger than ind, set it to the target." | |
7d143c25 CD |
6598 | (let* ((l (org-remove-tabs line)) |
6599 | (i (org-get-indentation l)) | |
6600 | (i1 (car ind)) (i2 (cdr ind))) | |
6601 | (if (>= i i2) (setq l (substring line i2))) | |
6602 | (if (> i1 0) | |
6603 | (concat (make-string i1 ?\ ) l) | |
6604 | l))) | |
7a368970 | 6605 | |
a3fbe8c4 CD |
6606 | (defcustom org-empty-line-terminates-plain-lists nil |
6607 | "Non-nil means, an empty line ends all plain list levels. | |
6608 | When nil, empty lines are part of the preceeding item." | |
6609 | :group 'org-plain-lists | |
6610 | :type 'boolean) | |
6611 | ||
7a368970 CD |
6612 | (defun org-beginning-of-item () |
6613 | "Go to the beginning of the current hand-formatted item. | |
6614 | If the cursor is not in an item, throw an error." | |
4b3a9ba7 | 6615 | (interactive) |
7a368970 | 6616 | (let ((pos (point)) |
a3fbe8c4 CD |
6617 | (limit (save-excursion |
6618 | (condition-case nil | |
6619 | (progn | |
6620 | (org-back-to-heading) | |
6621 | (beginning-of-line 2) (point)) | |
6622 | (error (point-min))))) | |
6623 | (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) | |
7a368970 CD |
6624 | ind ind1) |
6625 | (if (org-at-item-p) | |
6626 | (beginning-of-line 1) | |
6627 | (beginning-of-line 1) | |
6628 | (skip-chars-forward " \t") | |
6629 | (setq ind (current-column)) | |
6630 | (if (catch 'exit | |
6631 | (while t | |
6632 | (beginning-of-line 0) | |
a3fbe8c4 CD |
6633 | (if (or (bobp) (< (point) limit)) (throw 'exit nil)) |
6634 | ||
6635 | (if (looking-at "[ \t]*$") | |
6636 | (setq ind1 ind-empty) | |
7a368970 | 6637 | (skip-chars-forward " \t") |
a3fbe8c4 CD |
6638 | (setq ind1 (current-column))) |
6639 | (if (< ind1 ind) | |
6640 | (progn (beginning-of-line 1) (throw 'exit (org-at-item-p)))))) | |
7a368970 CD |
6641 | nil |
6642 | (goto-char pos) | |
6643 | (error "Not in an item"))))) | |
6644 | ||
6645 | (defun org-end-of-item () | |
b0a10108 | 6646 | "Go to the end of the current hand-formatted item. |
7a368970 | 6647 | If the cursor is not in an item, throw an error." |
4b3a9ba7 | 6648 | (interactive) |
a3fbe8c4 CD |
6649 | (let* ((pos (point)) |
6650 | ind1 | |
6651 | (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) | |
6652 | (limit (save-excursion (outline-next-heading) (point))) | |
6653 | (ind (save-excursion | |
6654 | (org-beginning-of-item) | |
6655 | (skip-chars-forward " \t") | |
6656 | (current-column))) | |
6657 | (end (catch 'exit | |
6658 | (while t | |
6659 | (beginning-of-line 2) | |
6660 | (if (eobp) (throw 'exit (point))) | |
6661 | (if (>= (point) limit) (throw 'exit (point-at-bol))) | |
6662 | (if (looking-at "[ \t]*$") | |
6663 | (setq ind1 ind-empty) | |
6664 | (skip-chars-forward " \t") | |
6665 | (setq ind1 (current-column))) | |
6666 | (if (<= ind1 ind) | |
6667 | (throw 'exit (point-at-bol))))))) | |
6668 | (if end | |
6669 | (goto-char end) | |
7a368970 CD |
6670 | (goto-char pos) |
6671 | (error "Not in an item")))) | |
b0a10108 | 6672 | |
4b3a9ba7 CD |
6673 | (defun org-next-item () |
6674 | "Move to the beginning of the next item in the current plain list. | |
6675 | Error if not at a plain list, or if this is the last item in the list." | |
6676 | (interactive) | |
6769c0dc | 6677 | (let (ind ind1 (pos (point))) |
4b3a9ba7 | 6678 | (org-beginning-of-item) |
4b3a9ba7 CD |
6679 | (setq ind (org-get-indentation)) |
6680 | (org-end-of-item) | |
4b3a9ba7 CD |
6681 | (setq ind1 (org-get-indentation)) |
6682 | (unless (and (org-at-item-p) (= ind ind1)) | |
6683 | (goto-char pos) | |
edd21304 | 6684 | (error "On last item")))) |
4b3a9ba7 CD |
6685 | |
6686 | (defun org-previous-item () | |
6687 | "Move to the beginning of the previous item in the current plain list. | |
b38c6895 | 6688 | Error if not at a plain list, or if this is the first item in the list." |
4b3a9ba7 | 6689 | (interactive) |
b38c6895 | 6690 | (let (beg ind ind1 (pos (point))) |
4b3a9ba7 CD |
6691 | (org-beginning-of-item) |
6692 | (setq beg (point)) | |
6693 | (setq ind (org-get-indentation)) | |
6694 | (goto-char beg) | |
6695 | (catch 'exit | |
6696 | (while t | |
6697 | (beginning-of-line 0) | |
6698 | (if (looking-at "[ \t]*$") | |
6699 | nil | |
b38c6895 | 6700 | (if (<= (setq ind1 (org-get-indentation)) ind) |
4b3a9ba7 CD |
6701 | (throw 'exit t))))) |
6702 | (condition-case nil | |
b38c6895 CD |
6703 | (if (or (not (org-at-item-p)) |
6704 | (< ind1 (1- ind))) | |
6705 | (error "") | |
6706 | (org-beginning-of-item)) | |
4b3a9ba7 | 6707 | (error (goto-char pos) |
f85d958a | 6708 | (error "On first item"))))) |
4b3a9ba7 CD |
6709 | |
6710 | (defun org-move-item-down () | |
7a368970 | 6711 | "Move the plain list item at point down, i.e. swap with following item. |
b0a10108 | 6712 | Subitems (items with larger indentation) are considered part of the item, |
7a368970 | 6713 | so this really moves item trees." |
4b3a9ba7 | 6714 | (interactive) |
7a368970 CD |
6715 | (let (beg end ind ind1 (pos (point)) txt) |
6716 | (org-beginning-of-item) | |
6717 | (setq beg (point)) | |
6718 | (setq ind (org-get-indentation)) | |
6719 | (org-end-of-item) | |
6720 | (setq end (point)) | |
6721 | (setq ind1 (org-get-indentation)) | |
6722 | (if (and (org-at-item-p) (= ind ind1)) | |
6723 | (progn | |
6724 | (org-end-of-item) | |
6725 | (setq txt (buffer-substring beg end)) | |
6726 | (save-excursion | |
6727 | (delete-region beg end)) | |
6728 | (setq pos (point)) | |
6729 | (insert txt) | |
6730 | (goto-char pos) | |
6731 | (org-maybe-renumber-ordered-list)) | |
6732 | (goto-char pos) | |
6733 | (error "Cannot move this item further down")))) | |
b0a10108 | 6734 | |
7a368970 CD |
6735 | (defun org-move-item-up (arg) |
6736 | "Move the plain list item at point up, i.e. swap with previous item. | |
b0a10108 | 6737 | Subitems (items with larger indentation) are considered part of the item, |
7a368970 CD |
6738 | so this really moves item trees." |
6739 | (interactive "p") | |
6740 | (let (beg end ind ind1 (pos (point)) txt) | |
6741 | (org-beginning-of-item) | |
6742 | (setq beg (point)) | |
6743 | (setq ind (org-get-indentation)) | |
6744 | (org-end-of-item) | |
6745 | (setq end (point)) | |
6746 | (goto-char beg) | |
6747 | (catch 'exit | |
6748 | (while t | |
6749 | (beginning-of-line 0) | |
6750 | (if (looking-at "[ \t]*$") | |
a3fbe8c4 CD |
6751 | (if org-empty-line-terminates-plain-lists |
6752 | (progn | |
6753 | (goto-char pos) | |
6754 | (error "Cannot move this item further up")) | |
6755 | nil) | |
7a368970 CD |
6756 | (if (<= (setq ind1 (org-get-indentation)) ind) |
6757 | (throw 'exit t))))) | |
6758 | (condition-case nil | |
6759 | (org-beginning-of-item) | |
6760 | (error (goto-char beg) | |
6761 | (error "Cannot move this item further up"))) | |
6762 | (setq ind1 (org-get-indentation)) | |
6763 | (if (and (org-at-item-p) (= ind ind1)) | |
6764 | (progn | |
6765 | (setq txt (buffer-substring beg end)) | |
6766 | (save-excursion | |
6767 | (delete-region beg end)) | |
6768 | (setq pos (point)) | |
6769 | (insert txt) | |
6770 | (goto-char pos) | |
6771 | (org-maybe-renumber-ordered-list)) | |
6772 | (goto-char pos) | |
6773 | (error "Cannot move this item further up")))) | |
b0a10108 | 6774 | |
7a368970 CD |
6775 | (defun org-maybe-renumber-ordered-list () |
6776 | "Renumber the ordered list at point if setup allows it. | |
6777 | This tests the user option `org-auto-renumber-ordered-lists' before | |
6778 | doing the renumbering." | |
b38c6895 CD |
6779 | (interactive) |
6780 | (when (and org-auto-renumber-ordered-lists | |
6781 | (org-at-item-p)) | |
6782 | (if (match-beginning 3) | |
6783 | (org-renumber-ordered-list 1) | |
15841868 | 6784 | (org-fix-bullet-type)))) |
b38c6895 CD |
6785 | |
6786 | (defun org-maybe-renumber-ordered-list-safe () | |
6787 | (condition-case nil | |
6788 | (save-excursion | |
6789 | (org-maybe-renumber-ordered-list)) | |
6790 | (error nil))) | |
7a368970 | 6791 | |
38f8646b CD |
6792 | (defun org-cycle-list-bullet (&optional which) |
6793 | "Cycle through the different itemize/enumerate bullets. | |
6794 | This cycle the entire list level through the sequence: | |
6795 | ||
6796 | `-' -> `+' -> `*' -> `1.' -> `1)' | |
6797 | ||
6798 | If WHICH is a string, use that as the new bullet. If WHICH is an integer, | |
6799 | 0 meand `-', 1 means `+' etc." | |
6800 | (interactive "P") | |
6801 | (org-preserve-lc | |
6802 | (org-beginning-of-item-list) | |
6803 | (org-at-item-p) | |
6804 | (beginning-of-line 1) | |
03f3cf35 JW |
6805 | (let ((current (match-string 0)) |
6806 | (prevp (eq which 'previous)) | |
6807 | new) | |
38f8646b | 6808 | (setq new (cond |
03f3cf35 JW |
6809 | ((and (numberp which) |
6810 | (nth (1- which) '("-" "+" "*" "1." "1)")))) | |
6811 | ((string-match "-" current) (if prevp "1)" "+")) | |
38f8646b | 6812 | ((string-match "\\+" current) |
03f3cf35 JW |
6813 | (if prevp "-" (if (looking-at "\\S-") "1." "*"))) |
6814 | ((string-match "\\*" current) (if prevp "+" "1.")) | |
6815 | ((string-match "\\." current) (if prevp "*" "1)")) | |
6816 | ((string-match ")" current) (if prevp "1." "-")) | |
38f8646b CD |
6817 | (t (error "This should not happen")))) |
6818 | (and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new))) | |
15841868 | 6819 | (org-fix-bullet-type) |
38f8646b CD |
6820 | (org-maybe-renumber-ordered-list)))) |
6821 | ||
7a368970 CD |
6822 | (defun org-get-string-indentation (s) |
6823 | "What indentation has S due to SPACE and TAB at the beginning of the string?" | |
6824 | (let ((n -1) (i 0) (w tab-width) c) | |
6825 | (catch 'exit | |
6826 | (while (< (setq n (1+ n)) (length s)) | |
6827 | (setq c (aref s n)) | |
6828 | (cond ((= c ?\ ) (setq i (1+ i))) | |
6829 | ((= c ?\t) (setq i (* (/ (+ w i) w) w))) | |
6830 | (t (throw 'exit t))))) | |
6831 | i)) | |
6832 | ||
6833 | (defun org-renumber-ordered-list (arg) | |
6834 | "Renumber an ordered plain list. | |
4b3a9ba7 | 6835 | Cursor needs to be in the first line of an item, the line that starts |
7a368970 CD |
6836 | with something like \"1.\" or \"2)\"." |
6837 | (interactive "p") | |
6838 | (unless (and (org-at-item-p) | |
6839 | (match-beginning 3)) | |
6840 | (error "This is not an ordered list")) | |
6841 | (let ((line (org-current-line)) | |
6842 | (col (current-column)) | |
6843 | (ind (org-get-string-indentation | |
6844 | (buffer-substring (point-at-bol) (match-beginning 3)))) | |
4da1a99d | 6845 | ;; (term (substring (match-string 3) -1)) |
b38c6895 CD |
6846 | ind1 (n (1- arg)) |
6847 | fmt) | |
7a368970 | 6848 | ;; find where this list begins |
b38c6895 CD |
6849 | (org-beginning-of-item-list) |
6850 | (looking-at "[ \t]*[0-9]+\\([.)]\\)") | |
6851 | (setq fmt (concat "%d" (match-string 1))) | |
6852 | (beginning-of-line 0) | |
6853 | ;; walk forward and replace these numbers | |
7a368970 CD |
6854 | (catch 'exit |
6855 | (while t | |
6856 | (catch 'next | |
b38c6895 CD |
6857 | (beginning-of-line 2) |
6858 | (if (eobp) (throw 'exit nil)) | |
6859 | (if (looking-at "[ \t]*$") (throw 'next nil)) | |
7a368970 | 6860 | (skip-chars-forward " \t") (setq ind1 (current-column)) |
b38c6895 CD |
6861 | (if (> ind1 ind) (throw 'next t)) |
6862 | (if (< ind1 ind) (throw 'exit t)) | |
6863 | (if (not (org-at-item-p)) (throw 'exit nil)) | |
6864 | (delete-region (match-beginning 2) (match-end 2)) | |
6865 | (goto-char (match-beginning 2)) | |
6866 | (insert (format fmt (setq n (1+ n))))))) | |
6867 | (goto-line line) | |
6868 | (move-to-column col))) | |
6869 | ||
15841868 JW |
6870 | (defun org-fix-bullet-type () |
6871 | "Make sure all items in this list have the same bullet as the firsst item." | |
6872 | (interactive) | |
b38c6895 CD |
6873 | (unless (org-at-item-p) (error "This is not a list")) |
6874 | (let ((line (org-current-line)) | |
6875 | (col (current-column)) | |
6876 | (ind (current-indentation)) | |
38f8646b | 6877 | ind1 bullet) |
b38c6895 CD |
6878 | ;; find where this list begins |
6879 | (org-beginning-of-item-list) | |
6880 | (beginning-of-line 1) | |
6881 | ;; find out what the bullet type is | |
6882 | (looking-at "[ \t]*\\(\\S-+\\)") | |
6883 | (setq bullet (match-string 1)) | |
6884 | ;; walk forward and replace these numbers | |
6885 | (beginning-of-line 0) | |
7a368970 CD |
6886 | (catch 'exit |
6887 | (while t | |
6888 | (catch 'next | |
6889 | (beginning-of-line 2) | |
6890 | (if (eobp) (throw 'exit nil)) | |
6891 | (if (looking-at "[ \t]*$") (throw 'next nil)) | |
6892 | (skip-chars-forward " \t") (setq ind1 (current-column)) | |
6893 | (if (> ind1 ind) (throw 'next t)) | |
6894 | (if (< ind1 ind) (throw 'exit t)) | |
6895 | (if (not (org-at-item-p)) (throw 'exit nil)) | |
b38c6895 CD |
6896 | (skip-chars-forward " \t") |
6897 | (looking-at "\\S-+") | |
6898 | (replace-match bullet)))) | |
7a368970 | 6899 | (goto-line line) |
b38c6895 CD |
6900 | (move-to-column col) |
6901 | (if (string-match "[0-9]" bullet) | |
6902 | (org-renumber-ordered-list 1)))) | |
6903 | ||
6904 | (defun org-beginning-of-item-list () | |
6905 | "Go to the beginning of the current item list. | |
6906 | I.e. to the first item in this list." | |
6907 | (interactive) | |
6908 | (org-beginning-of-item) | |
6909 | (let ((pos (point-at-bol)) | |
6910 | (ind (org-get-indentation)) | |
6911 | ind1) | |
6912 | ;; find where this list begins | |
6913 | (catch 'exit | |
6914 | (while t | |
6915 | (catch 'next | |
6916 | (beginning-of-line 0) | |
48aaad2d CD |
6917 | (if (looking-at "[ \t]*$") |
6918 | (throw (if (bobp) 'exit 'next) t)) | |
b38c6895 CD |
6919 | (skip-chars-forward " \t") (setq ind1 (current-column)) |
6920 | (if (or (< ind1 ind) | |
6921 | (and (= ind1 ind) | |
48aaad2d CD |
6922 | (not (org-at-item-p))) |
6923 | (bobp)) | |
b38c6895 | 6924 | (throw 'exit t) |
38f8646b | 6925 | (when (org-at-item-p) (setq pos (point-at-bol))))))) |
b38c6895 | 6926 | (goto-char pos))) |
b2de034e | 6927 | |
03f3cf35 JW |
6928 | |
6929 | (defun org-end-of-item-list () | |
6930 | "Go to the end of the current item list. | |
6931 | I.e. to the text after the last item." | |
6932 | (interactive) | |
6933 | (org-beginning-of-item) | |
6934 | (let ((pos (point-at-bol)) | |
6935 | (ind (org-get-indentation)) | |
6936 | ind1) | |
6937 | ;; find where this list begins | |
6938 | (catch 'exit | |
6939 | (while t | |
6940 | (catch 'next | |
6941 | (beginning-of-line 2) | |
6942 | (if (looking-at "[ \t]*$") | |
6943 | (throw (if (eobp) 'exit 'next) t)) | |
6944 | (skip-chars-forward " \t") (setq ind1 (current-column)) | |
6945 | (if (or (< ind1 ind) | |
6946 | (and (= ind1 ind) | |
6947 | (not (org-at-item-p))) | |
6948 | (eobp)) | |
6949 | (progn | |
6950 | (setq pos (point-at-bol)) | |
6951 | (throw 'exit t)))))) | |
6952 | (goto-char pos))) | |
6953 | ||
6954 | ||
7a368970 CD |
6955 | (defvar org-last-indent-begin-marker (make-marker)) |
6956 | (defvar org-last-indent-end-marker (make-marker)) | |
6957 | ||
7a368970 CD |
6958 | (defun org-outdent-item (arg) |
6959 | "Outdent a local list item." | |
6960 | (interactive "p") | |
6961 | (org-indent-item (- arg))) | |
6962 | ||
6963 | (defun org-indent-item (arg) | |
6964 | "Indent a local list item." | |
6965 | (interactive "p") | |
6966 | (unless (org-at-item-p) | |
6967 | (error "Not on an item")) | |
4b3a9ba7 | 6968 | (save-excursion |
b38c6895 | 6969 | (let (beg end ind ind1 tmp delta ind-down ind-up) |
4b3a9ba7 | 6970 | (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) |
7a368970 CD |
6971 | (setq beg org-last-indent-begin-marker |
6972 | end org-last-indent-end-marker) | |
4b3a9ba7 CD |
6973 | (org-beginning-of-item) |
6974 | (setq beg (move-marker org-last-indent-begin-marker (point))) | |
6975 | (org-end-of-item) | |
6976 | (setq end (move-marker org-last-indent-end-marker (point)))) | |
6977 | (goto-char beg) | |
b38c6895 CD |
6978 | (setq tmp (org-item-indent-positions) |
6979 | ind (car tmp) | |
6980 | ind-down (nth 2 tmp) | |
6981 | ind-up (nth 1 tmp) | |
6982 | delta (if (> arg 0) | |
48aaad2d CD |
6983 | (if ind-down (- ind-down ind) 2) |
6984 | (if ind-up (- ind-up ind) -2))) | |
b38c6895 | 6985 | (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) |
4b3a9ba7 CD |
6986 | (while (< (point) end) |
6987 | (beginning-of-line 1) | |
6988 | (skip-chars-forward " \t") (setq ind1 (current-column)) | |
6989 | (delete-region (point-at-bol) (point)) | |
b38c6895 CD |
6990 | (or (eolp) (indent-to-column (+ ind1 delta))) |
6991 | (beginning-of-line 2)))) | |
15841868 | 6992 | (org-fix-bullet-type) |
b38c6895 CD |
6993 | (org-maybe-renumber-ordered-list-safe) |
6994 | (save-excursion | |
6995 | (beginning-of-line 0) | |
6996 | (condition-case nil (org-beginning-of-item) (error nil)) | |
6997 | (org-maybe-renumber-ordered-list-safe))) | |
6998 | ||
b38c6895 | 6999 | (defun org-item-indent-positions () |
15841868 JW |
7000 | "Return indentation for plain list items. |
7001 | This returns a list with three values: The current indentation, the | |
7002 | parent indentation and the indentation a child should habe. | |
7003 | Assumes cursor in item line." | |
b38c6895 CD |
7004 | (let* ((bolpos (point-at-bol)) |
7005 | (ind (org-get-indentation)) | |
7006 | ind-down ind-up pos) | |
7007 | (save-excursion | |
7008 | (org-beginning-of-item-list) | |
7009 | (skip-chars-backward "\n\r \t") | |
7010 | (when (org-in-item-p) | |
7011 | (org-beginning-of-item) | |
7012 | (setq ind-up (org-get-indentation)))) | |
7013 | (setq pos (point)) | |
7014 | (save-excursion | |
7015 | (cond | |
7016 | ((and (condition-case nil (progn (org-previous-item) t) | |
7017 | (error nil)) | |
7018 | (or (forward-char 1) t) | |
7019 | (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) | |
7020 | (setq ind-down (org-get-indentation))) | |
7021 | ((and (goto-char pos) | |
7022 | (org-at-item-p)) | |
7023 | (goto-char (match-end 0)) | |
7024 | (skip-chars-forward " \t") | |
7025 | (setq ind-down (current-column))))) | |
7026 | (list ind ind-up ind-down))) | |
7a368970 | 7027 | |
38f8646b CD |
7028 | ;;; The orgstruct minor mode |
7029 | ||
7030 | ;; Define a minor mode which can be used in other modes in order to | |
7031 | ;; integrate the org-mode structure editing commands. | |
7032 | ||
7033 | ;; This is really a hack, because the org-mode structure commands use | |
7034 | ;; keys which normally belong to the major mode. Here is how it | |
7035 | ;; works: The minor mode defines all the keys necessary to operate the | |
7036 | ;; structure commands, but wraps the commands into a function which | |
7037 | ;; tests if the cursor is currently at a headline or a plain list | |
7038 | ;; item. If that is the case, the structure command is used, | |
7039 | ;; temporarily setting many Org-mode variables like regular | |
7040 | ;; expressions for filling etc. However, when any of those keys is | |
7041 | ;; used at a different location, function uses `key-binding' to look | |
7042 | ;; up if the key has an associated command in another currently active | |
7043 | ;; keymap (minor modes, major mode, global), and executes that | |
7044 | ;; command. There might be problems if any of the keys is otherwise | |
7045 | ;; used as a prefix key. | |
7046 | ||
7047 | ;; Another challenge is that the key binding for TAB can be tab or \C-i, | |
7048 | ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode | |
7049 | ;; addresses this by checking explicitly for both bindings. | |
7050 | ||
7051 | (defvar orgstruct-mode-map (make-sparse-keymap) | |
48aaad2d | 7052 | "Keymap for the minor `orgstruct-mode'.") |
38f8646b | 7053 | |
15841868 JW |
7054 | (defvar org-local-vars nil |
7055 | "List of local variables, for use by `orgstruct-mode'") | |
7056 | ||
38f8646b CD |
7057 | ;;;###autoload |
7058 | (define-minor-mode orgstruct-mode | |
7059 | "Toggle the minor more `orgstruct-mode'. | |
7060 | This mode is for using Org-mode structure commands in other modes. | |
7061 | The following key behave as if Org-mode was active, if the cursor | |
7062 | is on a headline, or on a plain list item (both in the definition | |
7063 | of Org-mode). | |
7064 | ||
7065 | M-up Move entry/item up | |
7066 | M-down Move entry/item down | |
7067 | M-left Promote | |
7068 | M-right Demote | |
7069 | M-S-up Move entry/item up | |
7070 | M-S-down Move entry/item down | |
7071 | M-S-left Promote subtree | |
7072 | M-S-right Demote subtree | |
7073 | M-q Fill paragraph and items like in Org-mode | |
7074 | C-c ^ Sort entries | |
7075 | C-c - Cycle list bullet | |
7076 | TAB Cycle item visibility | |
7077 | M-RET Insert new heading/item | |
7078 | S-M-RET Insert new TODO heading / Chekbox item | |
7079 | C-c C-c Set tags / toggle checkbox" | |
7080 | nil " OrgStruct" nil | |
7081 | (and (orgstruct-setup) (defun orgstruct-setup () nil))) | |
7082 | ||
7083 | ;;;###autoload | |
7084 | (defun turn-on-orgstruct () | |
7085 | "Unconditionally turn on `orgstruct-mode'." | |
7086 | (orgstruct-mode 1)) | |
7087 | ||
15841868 JW |
7088 | ;;;###autoload |
7089 | (defun turn-on-orgstruct++ () | |
7090 | "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. | |
7091 | In addition to setting orgstruct-mode, this also exports all indentation and | |
7092 | autofilling variables from org-mode into the buffer. Note that turning | |
7093 | off orgstruct-mode will *not* remove these additonal settings." | |
7094 | (orgstruct-mode 1) | |
7095 | (let (var val) | |
7096 | (mapc | |
7097 | (lambda (x) | |
7098 | (when (string-match | |
7099 | "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" | |
7100 | (symbol-name (car x))) | |
7101 | (setq var (car x) val (nth 1 x)) | |
7102 | (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) | |
7103 | org-local-vars))) | |
7104 | ||
38f8646b CD |
7105 | (defun orgstruct-error () |
7106 | "Error when there is no default binding for a structure key." | |
7107 | (interactive) | |
7108 | (error "This key is has no function outside structure elements")) | |
7109 | ||
38f8646b CD |
7110 | (defun orgstruct-setup () |
7111 | "Setup orgstruct keymaps." | |
7112 | (let ((nfunc 0) | |
7113 | (bindings | |
7114 | (list | |
7115 | '([(meta up)] org-metaup) | |
7116 | '([(meta down)] org-metadown) | |
7117 | '([(meta left)] org-metaleft) | |
7118 | '([(meta right)] org-metaright) | |
7119 | '([(meta shift up)] org-shiftmetaup) | |
7120 | '([(meta shift down)] org-shiftmetadown) | |
7121 | '([(meta shift left)] org-shiftmetaleft) | |
7122 | '([(meta shift right)] org-shiftmetaright) | |
7d58338e CD |
7123 | '([(shift up)] org-shiftup) |
7124 | '([(shift down)] org-shiftdown) | |
48aaad2d | 7125 | '("\C-c\C-c" org-ctrl-c-ctrl-c) |
38f8646b CD |
7126 | '("\M-q" fill-paragraph) |
7127 | '("\C-c^" org-sort) | |
7128 | '("\C-c-" org-cycle-list-bullet))) | |
7129 | elt key fun cmd) | |
7130 | (while (setq elt (pop bindings)) | |
7131 | (setq nfunc (1+ nfunc)) | |
7132 | (setq key (org-key (car elt)) | |
7133 | fun (nth 1 elt) | |
7134 | cmd (orgstruct-make-binding fun nfunc key)) | |
7135 | (org-defkey orgstruct-mode-map key cmd)) | |
7136 | ||
7137 | ;; Special treatment needed for TAB and RET | |
7138 | (org-defkey orgstruct-mode-map [(tab)] | |
7139 | (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) | |
7140 | (org-defkey orgstruct-mode-map "\C-i" | |
7141 | (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) | |
fbe6c10d | 7142 | |
38f8646b CD |
7143 | (org-defkey orgstruct-mode-map "\M-\C-m" |
7144 | (orgstruct-make-binding 'org-insert-heading 105 | |
7145 | "\M-\C-m" [(meta return)])) | |
7146 | (org-defkey orgstruct-mode-map [(meta return)] | |
7147 | (orgstruct-make-binding 'org-insert-heading 106 | |
7148 | [(meta return)] "\M-\C-m")) | |
7149 | ||
7150 | (org-defkey orgstruct-mode-map [(shift meta return)] | |
7151 | (orgstruct-make-binding 'org-insert-todo-heading 107 | |
7152 | [(meta return)] "\M-\C-m")) | |
fbe6c10d | 7153 | |
48aaad2d CD |
7154 | (unless org-local-vars |
7155 | (setq org-local-vars (org-get-local-variables))) | |
fbe6c10d | 7156 | |
38f8646b CD |
7157 | t)) |
7158 | ||
7159 | (defun orgstruct-make-binding (fun n &rest keys) | |
7160 | "Create a function for binding in the structure minor mode. | |
7161 | FUN is the command to call inside a table. N is used to create a unique | |
7162 | command name. KEYS are keys that should be checked in for a command | |
7163 | to execute outside of tables." | |
7164 | (eval | |
7165 | (list 'defun | |
7166 | (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) | |
7167 | '(arg) | |
7168 | (concat "In Structure, run `" (symbol-name fun) "'.\n" | |
7169 | "Outside of structure, run the binding of `" | |
7170 | (mapconcat (lambda (x) (format "%s" x)) keys "' or `") | |
7171 | "'.") | |
7172 | '(interactive "p") | |
7173 | (list 'if | |
7174 | '(org-context-p 'headline 'item) | |
7175 | (list 'org-run-like-in-org-mode (list 'quote fun)) | |
7176 | (list 'let '(orgstruct-mode) | |
7177 | (list 'call-interactively | |
7178 | (append '(or) | |
7179 | (mapcar (lambda (k) | |
7180 | (list 'key-binding k)) | |
7181 | keys) | |
7182 | '('orgstruct-error)))))))) | |
7183 | ||
7184 | (defun org-context-p (&rest contexts) | |
15841868 JW |
7185 | "Check if local context is and of CONTEXTS. |
7186 | Possible values in the list of contexts are `table', `headline', and `item'." | |
38f8646b CD |
7187 | (let ((pos (point))) |
7188 | (goto-char (point-at-bol)) | |
7189 | (prog1 (or (and (memq 'table contexts) | |
7190 | (looking-at "[ \t]*|")) | |
7191 | (and (memq 'headline contexts) | |
7192 | (looking-at "\\*+")) | |
7193 | (and (memq 'item contexts) | |
7194 | (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) | |
7195 | (goto-char pos)))) | |
7196 | ||
7197 | (defun org-get-local-variables () | |
7198 | "Return a list of all local variables in an org-mode buffer." | |
7199 | (let (varlist) | |
7200 | (with-current-buffer (get-buffer-create "*Org tmp*") | |
7201 | (erase-buffer) | |
7202 | (org-mode) | |
7203 | (setq varlist (buffer-local-variables))) | |
7204 | (kill-buffer "*Org tmp*") | |
7205 | (delq nil | |
7206 | (mapcar | |
fbe6c10d | 7207 | (lambda (x) |
38f8646b CD |
7208 | (setq x |
7209 | (if (symbolp x) | |
7210 | (list x) | |
7211 | (list (car x) (list 'quote (cdr x))))) | |
7212 | (if (string-match | |
7213 | "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" | |
7214 | (symbol-name (car x))) | |
7215 | x nil)) | |
7216 | varlist)))) | |
7217 | ||
48aaad2d | 7218 | ;;;###autoload |
38f8646b | 7219 | (defun org-run-like-in-org-mode (cmd) |
48aaad2d CD |
7220 | (unless org-local-vars |
7221 | (setq org-local-vars (org-get-local-variables))) | |
38f8646b CD |
7222 | (eval (list 'let org-local-vars |
7223 | (list 'call-interactively (list 'quote cmd))))) | |
7224 | ||
d3f4dbe8 CD |
7225 | ;;;; Archiving |
7226 | ||
7227 | (defalias 'org-advertized-archive-subtree 'org-archive-subtree) | |
7a368970 | 7228 | |
0fee8d6e | 7229 | (defun org-archive-subtree (&optional find-done) |
30313b90 CD |
7230 | "Move the current subtree to the archive. |
7231 | The archive can be a certain top-level heading in the current file, or in | |
7232 | a different file. The tree will be moved to that location, the subtree | |
0fee8d6e CD |
7233 | heading be marked DONE, and the current time will be added. |
7234 | ||
7235 | When called with prefix argument FIND-DONE, find whole trees without any | |
7236 | open TODO items and archive them (after getting confirmation from the user). | |
7237 | If the cursor is not at a headline when this comand is called, try all level | |
7238 | 1 trees. If the cursor is on a headline, only try the direct children of | |
a3fbe8c4 | 7239 | this heading." |
0fee8d6e CD |
7240 | (interactive "P") |
7241 | (if find-done | |
7242 | (org-archive-all-done) | |
7243 | ;; Save all relevant TODO keyword-relatex variables | |
c44f0d75 | 7244 | |
0fee8d6e | 7245 | (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler |
a3fbe8c4 CD |
7246 | (tr-org-todo-keywords-1 org-todo-keywords-1) |
7247 | (tr-org-todo-kwd-alist org-todo-kwd-alist) | |
7248 | (tr-org-done-keywords org-done-keywords) | |
0fee8d6e CD |
7249 | (tr-org-todo-regexp org-todo-regexp) |
7250 | (tr-org-todo-line-regexp org-todo-line-regexp) | |
d3f4dbe8 | 7251 | (tr-org-odd-levels-only org-odd-levels-only) |
0fee8d6e | 7252 | (this-buffer (current-buffer)) |
d3f4dbe8 CD |
7253 | (org-archive-location org-archive-location) |
7254 | (re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") | |
03f3cf35 | 7255 | ;; start of variables that will be used for savind context |
374585c9 CD |
7256 | (file (abbreviate-file-name (buffer-file-name))) |
7257 | (time (format-time-string | |
7258 | (substring (cdr org-time-stamp-formats) 1 -1) | |
7259 | (current-time))) | |
7260 | afile heading buffer level newfile-p | |
03f3cf35 JW |
7261 | category todo priority |
7262 | ;; start of variables that will be used for savind context | |
7263 | ltags itags prop) | |
d3f4dbe8 CD |
7264 | |
7265 | ;; Try to find a local archive location | |
7266 | (save-excursion | |
a3fbe8c4 CD |
7267 | (save-restriction |
7268 | (widen) | |
15841868 JW |
7269 | (setq prop (org-entry-get nil "ARCHIVE" 'inherit)) |
7270 | (if (and prop (string-match "\\S-" prop)) | |
7271 | (setq org-archive-location prop) | |
7272 | (if (or (re-search-backward re nil t) | |
7273 | (re-search-forward re nil t)) | |
7274 | (setq org-archive-location (match-string 1)))))) | |
d3f4dbe8 | 7275 | |
0fee8d6e CD |
7276 | (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location) |
7277 | (progn | |
374585c9 | 7278 | (setq afile (format (match-string 1 org-archive-location) |
0fee8d6e CD |
7279 | (file-name-nondirectory buffer-file-name)) |
7280 | heading (match-string 2 org-archive-location))) | |
7281 | (error "Invalid `org-archive-location'")) | |
374585c9 CD |
7282 | (if (> (length afile) 0) |
7283 | (setq newfile-p (not (file-exists-p afile)) | |
7284 | buffer (find-file-noselect afile)) | |
0fee8d6e CD |
7285 | (setq buffer (current-buffer))) |
7286 | (unless buffer | |
374585c9 | 7287 | (error "Cannot access file \"%s\"" afile)) |
0fee8d6e CD |
7288 | (if (and (> (length heading) 0) |
7289 | (string-match "^\\*+" heading)) | |
7290 | (setq level (match-end 0)) | |
7291 | (setq heading nil level 0)) | |
7292 | (save-excursion | |
374585c9 CD |
7293 | (org-back-to-heading t) |
7294 | ;; Get context information that will be lost by moving the tree | |
15841868 JW |
7295 | (org-refresh-category-properties) |
7296 | (setq category (org-get-category) | |
374585c9 | 7297 | todo (and (looking-at org-todo-line-regexp) |
d5098885 | 7298 | (match-string 2)) |
374585c9 | 7299 | priority (org-get-priority (if (match-end 3) (match-string 3) "")) |
d5098885 | 7300 | ltags (org-get-tags) |
374585c9 CD |
7301 | itags (org-delete-all ltags (org-get-tags-at))) |
7302 | (setq ltags (mapconcat 'identity ltags " ") | |
7303 | itags (mapconcat 'identity itags " ")) | |
0fee8d6e CD |
7304 | ;; We first only copy, in case something goes wrong |
7305 | ;; we need to protect this-command, to avoid kill-region sets it, | |
7306 | ;; which would lead to duplication of subtrees | |
7307 | (let (this-command) (org-copy-subtree)) | |
7308 | (set-buffer buffer) | |
7309 | ;; Enforce org-mode for the archive buffer | |
b928f99a | 7310 | (if (not (org-mode-p)) |
0fee8d6e | 7311 | ;; Force the mode for future visits. |
a3fbe8c4 CD |
7312 | (let ((org-insert-mode-line-in-empty-file t) |
7313 | (org-inhibit-startup t)) | |
0fee8d6e CD |
7314 | (call-interactively 'org-mode))) |
7315 | (when newfile-p | |
7316 | (goto-char (point-max)) | |
7317 | (insert (format "\nArchived entries from file %s\n\n" | |
7318 | (buffer-file-name this-buffer)))) | |
7319 | ;; Force the TODO keywords of the original buffer | |
7320 | (let ((org-todo-line-regexp tr-org-todo-line-regexp) | |
a3fbe8c4 CD |
7321 | (org-todo-keywords-1 tr-org-todo-keywords-1) |
7322 | (org-todo-kwd-alist tr-org-todo-kwd-alist) | |
7323 | (org-done-keywords tr-org-done-keywords) | |
0fee8d6e | 7324 | (org-todo-regexp tr-org-todo-regexp) |
d3f4dbe8 | 7325 | (org-todo-line-regexp tr-org-todo-line-regexp) |
fc24d8af | 7326 | (org-odd-levels-only |
a3fbe8c4 | 7327 | (if (local-variable-p 'org-odd-levels-only (current-buffer)) |
fc24d8af CD |
7328 | org-odd-levels-only |
7329 | tr-org-odd-levels-only))) | |
0fee8d6e CD |
7330 | (goto-char (point-min)) |
7331 | (if heading | |
7332 | (progn | |
7333 | (if (re-search-forward | |
7d58338e | 7334 | (concat "^" (regexp-quote heading) |
5152b597 | 7335 | (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) |
0fee8d6e CD |
7336 | nil t) |
7337 | (goto-char (match-end 0)) | |
7338 | ;; Heading not found, just insert it at the end | |
7339 | (goto-char (point-max)) | |
7340 | (or (bolp) (insert "\n")) | |
7341 | (insert "\n" heading "\n") | |
7342 | (end-of-line 0)) | |
7343 | ;; Make the subtree visible | |
7344 | (show-subtree) | |
7345 | (org-end-of-subtree t) | |
969ef2b7 | 7346 | (skip-chars-backward " \t\r\n") |
0fee8d6e CD |
7347 | (and (looking-at "[ \t\r\n]*") |
7348 | (replace-match "\n\n"))) | |
7349 | ;; No specific heading, just go to end of file. | |
7350 | (goto-char (point-max)) (insert "\n")) | |
7351 | ;; Paste | |
d3f4dbe8 | 7352 | (org-paste-subtree (org-get-legal-level level 1)) |
48aaad2d CD |
7353 | |
7354 | ;; Mark the entry as done | |
38f8646b CD |
7355 | (when (and org-archive-mark-done |
7356 | (looking-at org-todo-line-regexp) | |
48aaad2d CD |
7357 | (or (not (match-end 2)) |
7358 | (not (member (match-string 2) org-done-keywords)))) | |
38f8646b | 7359 | (let (org-log-done) |
48aaad2d CD |
7360 | (org-todo |
7361 | (car (or (member org-archive-mark-done org-done-keywords) | |
7362 | org-done-keywords))))) | |
38f8646b | 7363 | |
374585c9 CD |
7364 | ;; Add the context info |
7365 | (when org-archive-save-context-info | |
7366 | (let ((l org-archive-save-context-info) e n v) | |
7367 | (while (setq e (pop l)) | |
7368 | (when (and (setq v (symbol-value e)) | |
7369 | (stringp v) (string-match "\\S-" v)) | |
7370 | (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) | |
7371 | (org-entry-put (point) n v))))) | |
7372 | ||
0fee8d6e CD |
7373 | ;; Save the buffer, if it is not the same buffer. |
7374 | (if (not (eq this-buffer buffer)) (save-buffer)))) | |
7375 | ;; Here we are back in the original buffer. Everything seems to have | |
7376 | ;; worked. So now cut the tree and finish up. | |
7377 | (let (this-command) (org-cut-subtree)) | |
7378 | (if (and (not (eobp)) (looking-at "[ \t]*$")) (kill-line)) | |
7379 | (message "Subtree archived %s" | |
7380 | (if (eq this-buffer buffer) | |
7381 | (concat "under heading: " heading) | |
374585c9 | 7382 | (concat "in file: " (abbreviate-file-name afile))))))) |
0fee8d6e | 7383 | |
15841868 JW |
7384 | (defun org-refresh-category-properties () |
7385 | "Refresh category text properties in teh buffer." | |
7386 | (let ((def-cat (cond | |
7387 | ((null org-category) | |
7388 | (if buffer-file-name | |
7389 | (file-name-sans-extension | |
7390 | (file-name-nondirectory buffer-file-name)) | |
7391 | "???")) | |
7392 | ((symbolp org-category) (symbol-name org-category)) | |
7393 | (t org-category))) | |
7394 | beg end cat pos optionp) | |
7395 | (org-unmodified | |
7396 | (save-excursion | |
7397 | (save-restriction | |
7398 | (widen) | |
7399 | (goto-char (point-min)) | |
7400 | (put-text-property (point) (point-max) 'org-category def-cat) | |
7401 | (while (re-search-forward | |
7402 | "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) | |
7403 | (setq pos (match-end 0) | |
7404 | optionp (equal (char-after (match-beginning 0)) ?#) | |
7405 | cat (org-trim (match-string 2))) | |
7406 | (if optionp | |
7407 | (setq beg (point-at-bol) end (point-max)) | |
7408 | (org-back-to-heading t) | |
7409 | (setq beg (point) end (org-end-of-subtree t t))) | |
7410 | (put-text-property beg end 'org-category cat) | |
7411 | (goto-char pos))))))) | |
7412 | ||
6769c0dc | 7413 | (defun org-archive-all-done (&optional tag) |
0fee8d6e CD |
7414 | "Archive sublevels of the current tree without open TODO items. |
7415 | If the cursor is not on a headline, try all level 1 trees. If | |
6769c0dc CD |
7416 | it is on a headline, try all direct children. |
7417 | When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." | |
0fee8d6e | 7418 | (let ((re (concat "^\\*+ +" org-not-done-regexp)) re1 |
6769c0dc | 7419 | (rea (concat ".*:" org-archive-tag ":")) |
0fee8d6e CD |
7420 | (begm (make-marker)) |
7421 | (endm (make-marker)) | |
6769c0dc CD |
7422 | (question (if tag "Set ARCHIVE tag (no open TODO items)? " |
7423 | "Move subtree to archive (no open TODO items)? ")) | |
0fee8d6e CD |
7424 | beg end (cntarch 0)) |
7425 | (if (org-on-heading-p) | |
c8d16429 | 7426 | (progn |
0fee8d6e | 7427 | (setq re1 (concat "^" (regexp-quote |
c44f0d75 | 7428 | (make-string |
0fee8d6e CD |
7429 | (1+ (- (match-end 0) (match-beginning 0))) |
7430 | ?*)) | |
7431 | " ")) | |
7432 | (move-marker begm (point)) | |
3278a016 | 7433 | (move-marker endm (org-end-of-subtree t))) |
0fee8d6e CD |
7434 | (setq re1 "^* ") |
7435 | (move-marker begm (point-min)) | |
7436 | (move-marker endm (point-max))) | |
30313b90 | 7437 | (save-excursion |
0fee8d6e CD |
7438 | (goto-char begm) |
7439 | (while (re-search-forward re1 endm t) | |
8df0de1c | 7440 | (setq beg (match-beginning 0) |
0fee8d6e CD |
7441 | end (save-excursion (org-end-of-subtree t) (point))) |
7442 | (goto-char beg) | |
7443 | (if (re-search-forward re end t) | |
7444 | (goto-char end) | |
7445 | (goto-char beg) | |
6769c0dc CD |
7446 | (if (and (or (not tag) (not (looking-at rea))) |
7447 | (y-or-n-p question)) | |
0fee8d6e | 7448 | (progn |
6769c0dc CD |
7449 | (if tag |
7450 | (org-toggle-tag org-archive-tag 'on) | |
7451 | (org-archive-subtree)) | |
0fee8d6e | 7452 | (setq cntarch (1+ cntarch))) |
8df0de1c | 7453 | (goto-char end))))) |
0fee8d6e CD |
7454 | (message "%d trees archived" cntarch))) |
7455 | ||
5152b597 | 7456 | (defun org-cycle-hide-drawers (state) |
48aaad2d | 7457 | "Re-hide all drawers after a visibility state change." |
374585c9 CD |
7458 | (when (and (org-mode-p) |
7459 | (not (memq state '(overview folded)))) | |
5152b597 CD |
7460 | (save-excursion |
7461 | (let* ((globalp (memq state '(contents all))) | |
7462 | (beg (if globalp (point-min) (point))) | |
7463 | (end (if globalp (point-max) (org-end-of-subtree t)))) | |
7464 | (goto-char beg) | |
7465 | (while (re-search-forward org-drawer-regexp end t) | |
7466 | (org-flag-drawer t)))))) | |
7467 | ||
7468 | (defun org-flag-drawer (flag) | |
7469 | (save-excursion | |
7470 | (beginning-of-line 1) | |
7471 | (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") | |
7472 | (let ((b (match-end 0))) | |
7473 | (if (re-search-forward | |
7474 | "^[ \t]*:END:" | |
7475 | (save-excursion (outline-next-heading) (point)) t) | |
7476 | (outline-flag-region b (point-at-eol) flag) | |
7477 | (error ":END: line missing")))))) | |
7478 | ||
6769c0dc CD |
7479 | (defun org-cycle-hide-archived-subtrees (state) |
7480 | "Re-hide all archived subtrees after a visibility state change." | |
7481 | (when (and (not org-cycle-open-archived-trees) | |
7482 | (not (memq state '(overview folded)))) | |
7483 | (save-excursion | |
7484 | (let* ((globalp (memq state '(contents all))) | |
7485 | (beg (if globalp (point-min) (point))) | |
3278a016 CD |
7486 | (end (if globalp (point-max) (org-end-of-subtree t)))) |
7487 | (org-hide-archived-subtrees beg end) | |
7488 | (goto-char beg) | |
7489 | (if (looking-at (concat ".*:" org-archive-tag ":")) | |
274f1353 | 7490 | (message "%s" (substitute-command-keys |
3278a016 CD |
7491 | "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) |
7492 | ||
7493 | (defun org-force-cycle-archived () | |
7494 | "Cycle subtree even if it is archived." | |
7495 | (interactive) | |
7496 | (setq this-command 'org-cycle) | |
7497 | (let ((org-cycle-open-archived-trees t)) | |
7498 | (call-interactively 'org-cycle))) | |
6769c0dc CD |
7499 | |
7500 | (defun org-hide-archived-subtrees (beg end) | |
7501 | "Re-hide all archived subtrees after a visibility state change." | |
7502 | (save-excursion | |
7503 | (let* ((re (concat ":" org-archive-tag ":"))) | |
7504 | (goto-char beg) | |
7505 | (while (re-search-forward re end t) | |
7506 | (and (org-on-heading-p) (hide-subtree)) | |
3278a016 | 7507 | (org-end-of-subtree t))))) |
6769c0dc CD |
7508 | |
7509 | (defun org-toggle-tag (tag &optional onoff) | |
7510 | "Toggle the tag TAG for the current line. | |
7511 | If ONOFF is `on' or `off', don't toggle but set to this state." | |
a3fbe8c4 | 7512 | (unless (org-on-heading-p t) (error "Not on headling")) |
6769c0dc CD |
7513 | (let (res current) |
7514 | (save-excursion | |
7515 | (beginning-of-line) | |
5152b597 | 7516 | (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") |
6769c0dc CD |
7517 | (point-at-eol) t) |
7518 | (progn | |
7519 | (setq current (match-string 1)) | |
7520 | (replace-match "")) | |
7521 | (setq current "")) | |
7522 | (setq current (nreverse (org-split-string current ":"))) | |
7523 | (cond | |
7524 | ((eq onoff 'on) | |
7525 | (setq res t) | |
7526 | (or (member tag current) (push tag current))) | |
7527 | ((eq onoff 'off) | |
7528 | (or (not (member tag current)) (setq current (delete tag current)))) | |
7529 | (t (if (member tag current) | |
7530 | (setq current (delete tag current)) | |
7531 | (setq res t) | |
7532 | (push tag current)))) | |
7533 | (end-of-line 1) | |
03f3cf35 JW |
7534 | (if current |
7535 | (progn | |
7536 | (insert " :" (mapconcat 'identity (nreverse current) ":") ":") | |
7537 | (org-set-tags nil t)) | |
7538 | (delete-horizontal-space)) | |
7539 | (run-hooks 'org-after-tags-change-hook)) | |
7540 | res)) | |
6769c0dc CD |
7541 | |
7542 | (defun org-toggle-archive-tag (&optional arg) | |
7543 | "Toggle the archive tag for the current headline. | |
7544 | With prefix ARG, check all children of current headline and offer tagging | |
7545 | the children that do not contain any open TODO items." | |
7546 | (interactive "P") | |
7547 | (if arg | |
7548 | (org-archive-all-done 'tag) | |
7549 | (let (set) | |
7550 | (save-excursion | |
7551 | (org-back-to-heading t) | |
7552 | (setq set (org-toggle-tag org-archive-tag)) | |
7553 | (when set (hide-subtree))) | |
7554 | (and set (beginning-of-line 1)) | |
7555 | (message "Subtree %s" (if set "archived" "unarchived"))))) | |
7556 | ||
3278a016 | 7557 | |
d3f4dbe8 | 7558 | ;;;; Tables |
3278a016 | 7559 | |
d3f4dbe8 | 7560 | ;;; The table editor |
6769c0dc | 7561 | |
d3f4dbe8 CD |
7562 | ;; Watch out: Here we are talking about two different kind of tables. |
7563 | ;; Most of the code is for the tables created with the Org-mode table editor. | |
7564 | ;; Sometimes, we talk about tables created and edited with the table.el | |
7565 | ;; Emacs package. We call the former org-type tables, and the latter | |
7566 | ;; table.el-type tables. | |
c44f0d75 | 7567 | |
d3f4dbe8 CD |
7568 | (defun org-before-change-function (beg end) |
7569 | "Every change indicates that a table might need an update." | |
7570 | (setq org-table-may-need-update t)) | |
6769c0dc | 7571 | |
d3f4dbe8 CD |
7572 | (defconst org-table-line-regexp "^[ \t]*|" |
7573 | "Detects an org-type table line.") | |
7574 | (defconst org-table-dataline-regexp "^[ \t]*|[^-]" | |
7575 | "Detects an org-type table line.") | |
7576 | (defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" | |
7577 | "Detects a table line marked for automatic recalculation.") | |
7578 | (defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" | |
7579 | "Detects a table line marked for automatic recalculation.") | |
7580 | (defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" | |
7581 | "Detects a table line marked for automatic recalculation.") | |
7582 | (defconst org-table-hline-regexp "^[ \t]*|-" | |
7583 | "Detects an org-type table hline.") | |
7584 | (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" | |
7585 | "Detects a table-type table hline.") | |
7586 | (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" | |
7587 | "Detects an org-type or table-type table.") | |
7588 | (defconst org-table-border-regexp "^[ \t]*[^| \t]" | |
7589 | "Searching from within a table (any type) this finds the first line | |
7590 | outside the table.") | |
7591 | (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" | |
7592 | "Searching from within a table (any type) this finds the first line | |
7593 | outside the table.") | |
0fee8d6e | 7594 | |
d3f4dbe8 CD |
7595 | (defvar org-table-last-highlighted-reference nil) |
7596 | (defvar org-table-formula-history nil) | |
0fee8d6e | 7597 | |
d3f4dbe8 CD |
7598 | (defvar org-table-column-names nil |
7599 | "Alist with column names, derived from the `!' line.") | |
7600 | (defvar org-table-column-name-regexp nil | |
7601 | "Regular expression matching the current column names.") | |
7602 | (defvar org-table-local-parameters nil | |
7603 | "Alist with parameter names, derived from the `$' line.") | |
7604 | (defvar org-table-named-field-locations nil | |
7605 | "Alist with locations of named fields.") | |
0fee8d6e | 7606 | |
d3f4dbe8 CD |
7607 | (defvar org-table-current-line-types nil |
7608 | "Table row types, non-nil only for the duration of a comand.") | |
7609 | (defvar org-table-current-begin-line nil | |
7610 | "Table begin line, non-nil only for the duration of a comand.") | |
a3fbe8c4 CD |
7611 | (defvar org-table-current-begin-pos nil |
7612 | "Table begin position, non-nil only for the duration of a comand.") | |
d3f4dbe8 CD |
7613 | (defvar org-table-dlines nil |
7614 | "Vector of data line line numbers in the current table.") | |
7615 | (defvar org-table-hlines nil | |
7616 | "Vector of hline line numbers in the current table.") | |
0fee8d6e | 7617 | |
d3f4dbe8 CD |
7618 | (defconst org-table-range-regexp |
7619 | "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" | |
7620 | ;; 1 2 3 4 5 | |
7621 | "Regular expression for matching ranges in formulas.") | |
0fee8d6e | 7622 | |
d3f4dbe8 | 7623 | (defconst org-table-range-regexp2 |
a3fbe8c4 CD |
7624 | (concat |
7625 | "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)" | |
7626 | "\\.\\." | |
7627 | "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") | |
7628 | "Match a range for reference display.") | |
0fee8d6e | 7629 | |
a3fbe8c4 CD |
7630 | (defconst org-table-translate-regexp |
7631 | (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") | |
7632 | "Match a reference that needs translation, for reference display.") | |
0fee8d6e | 7633 | |
a3fbe8c4 | 7634 | (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param |
d3f4dbe8 CD |
7635 | |
7636 | (defun org-table-create-with-table.el () | |
7637 | "Use the table.el package to insert a new table. | |
7638 | If there is already a table at point, convert between Org-mode tables | |
7639 | and table.el tables." | |
7640 | (interactive) | |
7641 | (require 'table) | |
7642 | (cond | |
7643 | ((org-at-table.el-p) | |
7644 | (if (y-or-n-p "Convert table to Org-mode table? ") | |
7645 | (org-table-convert))) | |
7646 | ((org-at-table-p) | |
7647 | (if (y-or-n-p "Convert table to table.el table? ") | |
7648 | (org-table-convert))) | |
7649 | (t (call-interactively 'table-insert)))) | |
7650 | ||
7651 | (defun org-table-create-or-convert-from-region (arg) | |
7652 | "Convert region to table, or create an empty table. | |
a3fbe8c4 | 7653 | If there is an active region, convert it to a table, using the function |
15841868 JW |
7654 | `org-table-convert-region'. See the documentation of that function |
7655 | to learn how the prefix argument is interpreted to determine the field | |
7656 | separator. | |
a3fbe8c4 | 7657 | If there is no such region, create an empty table with `org-table-create'." |
0fee8d6e | 7658 | (interactive "P") |
d3f4dbe8 CD |
7659 | (if (org-region-active-p) |
7660 | (org-table-convert-region (region-beginning) (region-end) arg) | |
7661 | (org-table-create arg))) | |
7662 | ||
7663 | (defun org-table-create (&optional size) | |
7664 | "Query for a size and insert a table skeleton. | |
7665 | SIZE is a string Columns x Rows like for example \"3x2\"." | |
7666 | (interactive "P") | |
7667 | (unless size | |
7668 | (setq size (read-string | |
7669 | (concat "Table size Columns x Rows [e.g. " | |
7670 | org-table-default-size "]: ") | |
7671 | "" nil org-table-default-size))) | |
0fee8d6e | 7672 | |
0fee8d6e | 7673 | (let* ((pos (point)) |
d3f4dbe8 CD |
7674 | (indent (make-string (current-column) ?\ )) |
7675 | (split (org-split-string size " *x *")) | |
7676 | (rows (string-to-number (nth 1 split))) | |
7677 | (columns (string-to-number (car split))) | |
7678 | (line (concat (apply 'concat indent "|" (make-list columns " |")) | |
7679 | "\n"))) | |
7680 | (if (string-match "^[ \t]*$" (buffer-substring-no-properties | |
7681 | (point-at-bol) (point))) | |
7682 | (beginning-of-line 1) | |
7683 | (newline)) | |
7684 | ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) | |
7685 | (dotimes (i rows) (insert line)) | |
7686 | (goto-char pos) | |
7687 | (if (> rows 1) | |
7688 | ;; Insert a hline after the first row. | |
7689 | (progn | |
7690 | (end-of-line 1) | |
7691 | (insert "\n|-") | |
7692 | (goto-char pos))) | |
7693 | (org-table-align))) | |
0fee8d6e | 7694 | |
15841868 | 7695 | (defun org-table-convert-region (beg0 end0 &optional separator) |
d3f4dbe8 CD |
7696 | "Convert region to a table. |
7697 | The region goes from BEG0 to END0, but these borders will be moved | |
7698 | slightly, to make sure a beginning of line in the first line is included. | |
15841868 JW |
7699 | |
7700 | SEPARATOR specifies the field separator in the lines. It can have the | |
7701 | following values: | |
7702 | ||
7703 | '(4) Use the comma as a field separator | |
7704 | '(16) Use a TAB as field separator | |
7705 | integer When a number, use that many spaces as field separator | |
7706 | nil When nil, the command tries to be smart and figure out the | |
7707 | separator in the following way: | |
7708 | - when each line contains a TAB, assume TAB-separated material | |
7709 | - when each line contains a comme, assume CSV material | |
7710 | - else, assume one or more SPACE charcters as separator." | |
d3f4dbe8 CD |
7711 | (interactive "rP") |
7712 | (let* ((beg (min beg0 end0)) | |
7713 | (end (max beg0 end0)) | |
03f3cf35 | 7714 | re) |
d3f4dbe8 CD |
7715 | (goto-char beg) |
7716 | (beginning-of-line 1) | |
7717 | (setq beg (move-marker (make-marker) (point))) | |
7718 | (goto-char end) | |
7719 | (if (bolp) (backward-char 1) (end-of-line 1)) | |
7720 | (setq end (move-marker (make-marker) (point))) | |
15841868 JW |
7721 | ;; Get the right field separator |
7722 | (unless separator | |
d3f4dbe8 | 7723 | (goto-char beg) |
15841868 JW |
7724 | (setq separator |
7725 | (cond | |
7726 | ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) | |
7727 | ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) | |
7728 | (t 1)))) | |
7729 | (setq re (cond | |
7730 | ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") | |
7731 | ((equal separator '(16)) "^\\|\t") | |
7732 | ((integerp separator) | |
7733 | (format "^ *\\| *\t *\\| \\{%d,\\}" separator)) | |
7734 | (t (error "This should not happen")))) | |
d3f4dbe8 CD |
7735 | (goto-char beg) |
7736 | (while (re-search-forward re end t) | |
7737 | (replace-match "| " t t)) | |
7738 | (goto-char beg) | |
7739 | (insert " ") | |
7740 | (org-table-align))) | |
0fee8d6e | 7741 | |
d3f4dbe8 CD |
7742 | (defun org-table-import (file arg) |
7743 | "Import FILE as a table. | |
7744 | The file is assumed to be tab-separated. Such files can be produced by most | |
7745 | spreadsheet and database applications. If no tabs (at least one per line) | |
7746 | are found, lines will be split on whitespace into fields." | |
7747 | (interactive "f\nP") | |
7748 | (or (bolp) (newline)) | |
7749 | (let ((beg (point)) | |
7750 | (pm (point-max))) | |
7751 | (insert-file-contents file) | |
7752 | (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) | |
0fee8d6e | 7753 | |
d3f4dbe8 CD |
7754 | (defun org-table-export () |
7755 | "Export table as a tab-separated file. | |
7756 | Such a file can be imported into a spreadsheet program like Excel." | |
7757 | (interactive) | |
7758 | (let* ((beg (org-table-begin)) | |
7759 | (end (org-table-end)) | |
7760 | (table (buffer-substring beg end)) | |
7761 | (file (read-file-name "Export table to: ")) | |
7762 | buf) | |
7763 | (unless (or (not (file-exists-p file)) | |
7764 | (y-or-n-p (format "Overwrite file %s? " file))) | |
7765 | (error "Abort")) | |
7766 | (with-current-buffer (find-file-noselect file) | |
7767 | (setq buf (current-buffer)) | |
7768 | (erase-buffer) | |
7769 | (fundamental-mode) | |
7770 | (insert table) | |
7771 | (goto-char (point-min)) | |
7772 | (while (re-search-forward "^[ \t]*|[ \t]*" nil t) | |
7773 | (replace-match "" t t) | |
7774 | (end-of-line 1)) | |
7775 | (goto-char (point-min)) | |
7776 | (while (re-search-forward "[ \t]*|[ \t]*$" nil t) | |
7777 | (replace-match "" t t) | |
7778 | (goto-char (min (1+ (point)) (point-max)))) | |
7779 | (goto-char (point-min)) | |
7780 | (while (re-search-forward "^-[-+]*$" nil t) | |
7781 | (replace-match "") | |
7782 | (if (looking-at "\n") | |
7783 | (delete-char 1))) | |
7784 | (goto-char (point-min)) | |
7785 | (while (re-search-forward "[ \t]*|[ \t]*" nil t) | |
7786 | (replace-match "\t" t t)) | |
7787 | (save-buffer)) | |
7788 | (kill-buffer buf))) | |
30313b90 | 7789 | |
d3f4dbe8 CD |
7790 | (defvar org-table-aligned-begin-marker (make-marker) |
7791 | "Marker at the beginning of the table last aligned. | |
7792 | Used to check if cursor still is in that table, to minimize realignment.") | |
7793 | (defvar org-table-aligned-end-marker (make-marker) | |
7794 | "Marker at the end of the table last aligned. | |
7795 | Used to check if cursor still is in that table, to minimize realignment.") | |
7796 | (defvar org-table-last-alignment nil | |
7797 | "List of flags for flushright alignment, from the last re-alignment. | |
7798 | This is being used to correctly align a single field after TAB or RET.") | |
7799 | (defvar org-table-last-column-widths nil | |
7800 | "List of max width of fields in each column. | |
7801 | This is being used to correctly align a single field after TAB or RET.") | |
7802 | (defvar org-table-overlay-coordinates nil | |
7803 | "Overlay coordinates after each align of a table.") | |
7804 | (make-variable-buffer-local 'org-table-overlay-coordinates) | |
891f4676 | 7805 | |
d3f4dbe8 CD |
7806 | (defvar org-last-recalc-line nil) |
7807 | (defconst org-narrow-column-arrow "=>" | |
7808 | "Used as display property in narrowed table columns.") | |
891f4676 | 7809 | |
d3f4dbe8 CD |
7810 | (defun org-table-align () |
7811 | "Align the table at point by aligning all vertical bars." | |
891f4676 | 7812 | (interactive) |
d3f4dbe8 CD |
7813 | (let* ( |
7814 | ;; Limits of table | |
7815 | (beg (org-table-begin)) | |
7816 | (end (org-table-end)) | |
7817 | ;; Current cursor position | |
7818 | (linepos (org-current-line)) | |
7819 | (colpos (org-table-current-column)) | |
7820 | (winstart (window-start)) | |
7821 | (winstartline (org-current-line (min winstart (1- (point-max))))) | |
7822 | lines (new "") lengths l typenums ty fields maxfields i | |
7823 | column | |
7824 | (indent "") cnt frac | |
7825 | rfmt hfmt | |
7826 | (spaces '(1 . 1)) | |
7827 | (sp1 (car spaces)) | |
7828 | (sp2 (cdr spaces)) | |
7829 | (rfmt1 (concat | |
7830 | (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) | |
7831 | (hfmt1 (concat | |
7832 | (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) | |
7833 | emptystrings links dates narrow fmax f1 len c e) | |
7834 | (untabify beg end) | |
7835 | (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) | |
7836 | ;; Check if we have links or dates | |
7837 | (goto-char beg) | |
7838 | (setq links (re-search-forward org-bracket-link-regexp end t)) | |
7839 | (goto-char beg) | |
7840 | (setq dates (and org-display-custom-times | |
7841 | (re-search-forward org-ts-regexp-both end t))) | |
7842 | ;; Make sure the link properties are right | |
7843 | (when links (goto-char beg) (while (org-activate-bracket-links end))) | |
7844 | ;; Make sure the date properties are right | |
7845 | (when dates (goto-char beg) (while (org-activate-dates end))) | |
891f4676 | 7846 | |
d3f4dbe8 CD |
7847 | ;; Check if we are narrowing any columns |
7848 | (goto-char beg) | |
7849 | (setq narrow (and org-format-transports-properties-p | |
7850 | (re-search-forward "<[0-9]+>" end t))) | |
7851 | ;; Get the rows | |
7852 | (setq lines (org-split-string | |
7853 | (buffer-substring beg end) "\n")) | |
7854 | ;; Store the indentation of the first line | |
7855 | (if (string-match "^ *" (car lines)) | |
7856 | (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) | |
7857 | ;; Mark the hlines by setting the corresponding element to nil | |
7858 | ;; At the same time, we remove trailing space. | |
7859 | (setq lines (mapcar (lambda (l) | |
7860 | (if (string-match "^ *|-" l) | |
7861 | nil | |
7862 | (if (string-match "[ \t]+$" l) | |
7863 | (substring l 0 (match-beginning 0)) | |
7864 | l))) | |
7865 | lines)) | |
7866 | ;; Get the data fields by splitting the lines. | |
7867 | (setq fields (mapcar | |
7868 | (lambda (l) | |
7869 | (org-split-string l " *| *")) | |
7870 | (delq nil (copy-sequence lines)))) | |
7871 | ;; How many fields in the longest line? | |
7872 | (condition-case nil | |
7873 | (setq maxfields (apply 'max (mapcar 'length fields))) | |
7874 | (error | |
7875 | (kill-region beg end) | |
7876 | (org-table-create org-table-default-size) | |
7877 | (error "Empty table - created default table"))) | |
7878 | ;; A list of empty strings to fill any short rows on output | |
7879 | (setq emptystrings (make-list maxfields "")) | |
7880 | ;; Check for special formatting. | |
7881 | (setq i -1) | |
7882 | (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns | |
7883 | (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) | |
7884 | ;; Check if there is an explicit width specified | |
7885 | (when narrow | |
7886 | (setq c column fmax nil) | |
7887 | (while c | |
7888 | (setq e (pop c)) | |
7889 | (if (and (stringp e) (string-match "^<\\([0-9]+\\)>$" e)) | |
7890 | (setq fmax (string-to-number (match-string 1 e)) c nil))) | |
7891 | ;; Find fields that are wider than fmax, and shorten them | |
7892 | (when fmax | |
7893 | (loop for xx in column do | |
7894 | (when (and (stringp xx) | |
7895 | (> (org-string-width xx) fmax)) | |
7896 | (org-add-props xx nil | |
7897 | 'help-echo | |
7898 | (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) | |
7899 | (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) | |
7900 | (unless (> f1 1) | |
7901 | (error "Cannot narrow field starting with wide link \"%s\"" | |
7902 | (match-string 0 xx))) | |
7903 | (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) | |
7904 | (add-text-properties (- f1 2) f1 | |
7905 | (list 'display org-narrow-column-arrow) | |
7906 | xx))))) | |
7907 | ;; Get the maximum width for each column | |
7908 | (push (apply 'max 1 (mapcar 'org-string-width column)) lengths) | |
7909 | ;; Get the fraction of numbers, to decide about alignment of the column | |
7910 | (setq cnt 0 frac 0.0) | |
7911 | (loop for x in column do | |
7912 | (if (equal x "") | |
7913 | nil | |
7914 | (setq frac ( / (+ (* frac cnt) | |
7915 | (if (string-match org-table-number-regexp x) 1 0)) | |
7916 | (setq cnt (1+ cnt)))))) | |
7917 | (push (>= frac org-table-number-fraction) typenums)) | |
7918 | (setq lengths (nreverse lengths) typenums (nreverse typenums)) | |
35fb9989 | 7919 | |
d3f4dbe8 CD |
7920 | ;; Store the alignment of this table, for later editing of single fields |
7921 | (setq org-table-last-alignment typenums | |
7922 | org-table-last-column-widths lengths) | |
891f4676 | 7923 | |
d3f4dbe8 CD |
7924 | ;; With invisible characters, `format' does not get the field width right |
7925 | ;; So we need to make these fields wide by hand. | |
7926 | (when links | |
7927 | (loop for i from 0 upto (1- maxfields) do | |
7928 | (setq len (nth i lengths)) | |
7929 | (loop for j from 0 upto (1- (length fields)) do | |
7930 | (setq c (nthcdr i (car (nthcdr j fields)))) | |
7931 | (if (and (stringp (car c)) | |
7932 | (string-match org-bracket-link-regexp (car c)) | |
7933 | (< (org-string-width (car c)) len)) | |
7934 | (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) | |
891f4676 | 7935 | |
d3f4dbe8 CD |
7936 | ;; Compute the formats needed for output of the table |
7937 | (setq rfmt (concat indent "|") hfmt (concat indent "|")) | |
7938 | (while (setq l (pop lengths)) | |
7939 | (setq ty (if (pop typenums) "" "-")) ; number types flushright | |
7940 | (setq rfmt (concat rfmt (format rfmt1 ty l)) | |
7941 | hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) | |
7942 | (setq rfmt (concat rfmt "\n") | |
7943 | hfmt (concat (substring hfmt 0 -1) "|\n")) | |
891f4676 | 7944 | |
d3f4dbe8 CD |
7945 | (setq new (mapconcat |
7946 | (lambda (l) | |
7947 | (if l (apply 'format rfmt | |
7948 | (append (pop fields) emptystrings)) | |
7949 | hfmt)) | |
7950 | lines "")) | |
7951 | ;; Replace the old one | |
7952 | (delete-region beg end) | |
7953 | (move-marker end nil) | |
7954 | (move-marker org-table-aligned-begin-marker (point)) | |
7955 | (insert new) | |
7956 | (move-marker org-table-aligned-end-marker (point)) | |
7957 | (when (and orgtbl-mode (not (org-mode-p))) | |
7958 | (goto-char org-table-aligned-begin-marker) | |
7959 | (while (org-hide-wide-columns org-table-aligned-end-marker))) | |
7960 | ;; Try to move to the old location | |
7961 | (goto-line winstartline) | |
7962 | (setq winstart (point-at-bol)) | |
7963 | (goto-line linepos) | |
7964 | (set-window-start (selected-window) winstart 'noforce) | |
7965 | (org-table-goto-column colpos) | |
7966 | (and org-table-overlay-coordinates (org-table-overlay-coordinates)) | |
7967 | (setq org-table-may-need-update nil) | |
7968 | )) | |
891f4676 | 7969 | |
d3f4dbe8 CD |
7970 | (defun org-string-width (s) |
7971 | "Compute width of string, ignoring invisible characters. | |
7972 | This ignores character with invisibility property `org-link', and also | |
7973 | characters with property `org-cwidth', because these will become invisible | |
7974 | upon the next fontification round." | |
7975 | (let (b l) | |
7976 | (when (or (eq t buffer-invisibility-spec) | |
7977 | (assq 'org-link buffer-invisibility-spec)) | |
7978 | (while (setq b (text-property-any 0 (length s) | |
7979 | 'invisible 'org-link s)) | |
7980 | (setq s (concat (substring s 0 b) | |
7981 | (substring s (or (next-single-property-change | |
7982 | b 'invisible s) (length s))))))) | |
7983 | (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) | |
7984 | (setq s (concat (substring s 0 b) | |
7985 | (substring s (or (next-single-property-change | |
7986 | b 'org-cwidth s) (length s)))))) | |
7987 | (setq l (string-width s) b -1) | |
7988 | (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) | |
7989 | (setq l (- l (get-text-property b 'org-dwidth-n s)))) | |
7990 | l)) | |
891f4676 | 7991 | |
d3f4dbe8 CD |
7992 | (defun org-table-begin (&optional table-type) |
7993 | "Find the beginning of the table and return its position. | |
7994 | With argument TABLE-TYPE, go to the beginning of a table.el-type table." | |
7995 | (save-excursion | |
7996 | (if (not (re-search-backward | |
7997 | (if table-type org-table-any-border-regexp | |
7998 | org-table-border-regexp) | |
7999 | nil t)) | |
8000 | (progn (goto-char (point-min)) (point)) | |
8001 | (goto-char (match-beginning 0)) | |
8002 | (beginning-of-line 2) | |
8003 | (point)))) | |
4b3a9ba7 | 8004 | |
d3f4dbe8 CD |
8005 | (defun org-table-end (&optional table-type) |
8006 | "Find the end of the table and return its position. | |
8007 | With argument TABLE-TYPE, go to the end of a table.el-type table." | |
4b3a9ba7 | 8008 | (save-excursion |
d3f4dbe8 CD |
8009 | (if (not (re-search-forward |
8010 | (if table-type org-table-any-border-regexp | |
8011 | org-table-border-regexp) | |
8012 | nil t)) | |
3278a016 | 8013 | (goto-char (point-max)) |
d3f4dbe8 CD |
8014 | (goto-char (match-beginning 0))) |
8015 | (point-marker))) | |
3278a016 | 8016 | |
d3f4dbe8 CD |
8017 | (defun org-table-justify-field-maybe (&optional new) |
8018 | "Justify the current field, text to left, number to right. | |
8019 | Optional argument NEW may specify text to replace the current field content." | |
8020 | (cond | |
8021 | ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway | |
8022 | ((org-at-table-hline-p)) | |
8023 | ((and (not new) | |
8024 | (or (not (equal (marker-buffer org-table-aligned-begin-marker) | |
8025 | (current-buffer))) | |
8026 | (< (point) org-table-aligned-begin-marker) | |
8027 | (>= (point) org-table-aligned-end-marker))) | |
8028 | ;; This is not the same table, force a full re-align | |
8029 | (setq org-table-may-need-update t)) | |
8030 | (t ;; realign the current field, based on previous full realign | |
8031 | (let* ((pos (point)) s | |
8032 | (col (org-table-current-column)) | |
8033 | (num (if (> col 0) (nth (1- col) org-table-last-alignment))) | |
8034 | l f n o e) | |
8035 | (when (> col 0) | |
8036 | (skip-chars-backward "^|\n") | |
8037 | (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") | |
8038 | (progn | |
8039 | (setq s (match-string 1) | |
8040 | o (match-string 0) | |
8041 | l (max 1 (- (match-end 0) (match-beginning 0) 3)) | |
8042 | e (not (= (match-beginning 2) (match-end 2)))) | |
8043 | (setq f (format (if num " %%%ds %s" " %%-%ds %s") | |
8044 | l (if e "|" (setq org-table-may-need-update t) "")) | |
8045 | n (format f s)) | |
8046 | (if new | |
8047 | (if (<= (length new) l) ;; FIXME: length -> str-width? | |
8048 | (setq n (format f new)) | |
8049 | (setq n (concat new "|") org-table-may-need-update t))) | |
8050 | (or (equal n o) | |
8051 | (let (org-table-may-need-update) | |
1e8fbb6d | 8052 | (replace-match n t t)))) |
d3f4dbe8 CD |
8053 | (setq org-table-may-need-update t)) |
8054 | (goto-char pos)))))) | |
3278a016 | 8055 | |
d3f4dbe8 CD |
8056 | (defun org-table-next-field () |
8057 | "Go to the next field in the current table, creating new lines as needed. | |
8058 | Before doing so, re-align the table if necessary." | |
8059 | (interactive) | |
8060 | (org-table-maybe-eval-formula) | |
8061 | (org-table-maybe-recalculate-line) | |
8062 | (if (and org-table-automatic-realign | |
8063 | org-table-may-need-update) | |
8064 | (org-table-align)) | |
8065 | (let ((end (org-table-end))) | |
8066 | (if (org-at-table-hline-p) | |
8067 | (end-of-line 1)) | |
8068 | (condition-case nil | |
8069 | (progn | |
8070 | (re-search-forward "|" end) | |
8071 | (if (looking-at "[ \t]*$") | |
8072 | (re-search-forward "|" end)) | |
8073 | (if (and (looking-at "-") | |
8074 | org-table-tab-jumps-over-hlines | |
8075 | (re-search-forward "^[ \t]*|\\([^-]\\)" end t)) | |
8076 | (goto-char (match-beginning 1))) | |
8077 | (if (looking-at "-") | |
8078 | (progn | |
8079 | (beginning-of-line 0) | |
8080 | (org-table-insert-row 'below)) | |
8081 | (if (looking-at " ") (forward-char 1)))) | |
8082 | (error | |
8083 | (org-table-insert-row 'below))))) | |
3278a016 | 8084 | |
d3f4dbe8 CD |
8085 | (defun org-table-previous-field () |
8086 | "Go to the previous field in the table. | |
8087 | Before doing so, re-align the table if necessary." | |
8088 | (interactive) | |
8089 | (org-table-justify-field-maybe) | |
8090 | (org-table-maybe-recalculate-line) | |
8091 | (if (and org-table-automatic-realign | |
8092 | org-table-may-need-update) | |
8093 | (org-table-align)) | |
8094 | (if (org-at-table-hline-p) | |
8095 | (end-of-line 1)) | |
8096 | (re-search-backward "|" (org-table-begin)) | |
8097 | (re-search-backward "|" (org-table-begin)) | |
8098 | (while (looking-at "|\\(-\\|[ \t]*$\\)") | |
8099 | (re-search-backward "|" (org-table-begin))) | |
8100 | (if (looking-at "| ?") | |
8101 | (goto-char (match-end 0)))) | |
891f4676 | 8102 | |
d3f4dbe8 CD |
8103 | (defun org-table-next-row () |
8104 | "Go to the next row (same column) in the current table. | |
8105 | Before doing so, re-align the table if necessary." | |
8106 | (interactive) | |
8107 | (org-table-maybe-eval-formula) | |
8108 | (org-table-maybe-recalculate-line) | |
8109 | (if (or (looking-at "[ \t]*$") | |
8110 | (save-excursion (skip-chars-backward " \t") (bolp))) | |
8111 | (newline) | |
8112 | (if (and org-table-automatic-realign | |
8113 | org-table-may-need-update) | |
8114 | (org-table-align)) | |
8115 | (let ((col (org-table-current-column))) | |
8116 | (beginning-of-line 2) | |
8117 | (if (or (not (org-at-table-p)) | |
8118 | (org-at-table-hline-p)) | |
8119 | (progn | |
8120 | (beginning-of-line 0) | |
8121 | (org-table-insert-row 'below))) | |
8122 | (org-table-goto-column col) | |
8123 | (skip-chars-backward "^|\n\r") | |
8124 | (if (looking-at " ") (forward-char 1))))) | |
3278a016 | 8125 | |
d3f4dbe8 CD |
8126 | (defun org-table-copy-down (n) |
8127 | "Copy a field down in the current column. | |
8128 | If the field at the cursor is empty, copy into it the content of the nearest | |
8129 | non-empty field above. With argument N, use the Nth non-empty field. | |
8130 | If the current field is not empty, it is copied down to the next row, and | |
8131 | the cursor is moved with it. Therefore, repeating this command causes the | |
8132 | column to be filled row-by-row. | |
8133 | If the variable `org-table-copy-increment' is non-nil and the field is an | |
a3fbe8c4 CD |
8134 | integer or a timestamp, it will be incremented while copying. In the case of |
8135 | a timestamp, if the cursor is on the year, change the year. If it is on the | |
8136 | month or the day, change that. Point will stay on the current date field | |
8137 | in order to easily repeat the interval." | |
d3f4dbe8 CD |
8138 | (interactive "p") |
8139 | (let* ((colpos (org-table-current-column)) | |
a3fbe8c4 | 8140 | (col (current-column)) |
d3f4dbe8 CD |
8141 | (field (org-table-get-field)) |
8142 | (non-empty (string-match "[^ \t]" field)) | |
8143 | (beg (org-table-begin)) | |
8144 | txt) | |
8145 | (org-table-check-inside-data-field) | |
8146 | (if non-empty | |
8147 | (progn | |
8148 | (setq txt (org-trim field)) | |
8149 | (org-table-next-row) | |
8150 | (org-table-blank-field)) | |
8151 | (save-excursion | |
8152 | (setq txt | |
8153 | (catch 'exit | |
8154 | (while (progn (beginning-of-line 1) | |
8155 | (re-search-backward org-table-dataline-regexp | |
8156 | beg t)) | |
8157 | (org-table-goto-column colpos t) | |
8158 | (if (and (looking-at | |
8159 | "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") | |
8160 | (= (setq n (1- n)) 0)) | |
8161 | (throw 'exit (match-string 1)))))))) | |
8162 | (if txt | |
8163 | (progn | |
8164 | (if (and org-table-copy-increment | |
8165 | (string-match "^[0-9]+$" txt)) | |
8166 | (setq txt (format "%d" (+ (string-to-number txt) 1)))) | |
8167 | (insert txt) | |
a3fbe8c4 CD |
8168 | (move-to-column col) |
8169 | (if (and org-table-copy-increment (org-at-timestamp-p t)) | |
8170 | (org-timestamp-up 1) | |
8171 | (org-table-maybe-recalculate-line)) | |
8172 | (org-table-align) | |
8173 | (move-to-column col)) | |
d3f4dbe8 | 8174 | (error "No non-empty field found")))) |
04d18304 | 8175 | |
d3f4dbe8 CD |
8176 | (defun org-table-check-inside-data-field () |
8177 | "Is point inside a table data field? | |
8178 | I.e. not on a hline or before the first or after the last column? | |
8179 | This actually throws an error, so it aborts the current command." | |
8180 | (if (or (not (org-at-table-p)) | |
8181 | (= (org-table-current-column) 0) | |
8182 | (org-at-table-hline-p) | |
8183 | (looking-at "[ \t]*$")) | |
8184 | (error "Not in table data field"))) | |
f425a6ea | 8185 | |
d3f4dbe8 CD |
8186 | (defvar org-table-clip nil |
8187 | "Clipboard for table regions.") | |
f425a6ea | 8188 | |
d3f4dbe8 CD |
8189 | (defun org-table-blank-field () |
8190 | "Blank the current table field or active region." | |
f425a6ea | 8191 | (interactive) |
d3f4dbe8 CD |
8192 | (org-table-check-inside-data-field) |
8193 | (if (and (interactive-p) (org-region-active-p)) | |
8194 | (let (org-table-clip) | |
8195 | (org-table-cut-region (region-beginning) (region-end))) | |
8196 | (skip-chars-backward "^|") | |
8197 | (backward-char 1) | |
8198 | (if (looking-at "|[^|\n]+") | |
8199 | (let* ((pos (match-beginning 0)) | |
8200 | (match (match-string 0)) | |
8201 | (len (org-string-width match))) | |
8202 | (replace-match (concat "|" (make-string (1- len) ?\ ))) | |
8203 | (goto-char (+ 2 pos)) | |
8204 | (substring match 1))))) | |
b0a10108 | 8205 | |
d3f4dbe8 CD |
8206 | (defun org-table-get-field (&optional n replace) |
8207 | "Return the value of the field in column N of current row. | |
8208 | N defaults to current field. | |
8209 | If REPLACE is a string, replace field with this value. The return value | |
8210 | is always the old value." | |
8211 | (and n (org-table-goto-column n)) | |
8212 | (skip-chars-backward "^|\n") | |
8213 | (backward-char 1) | |
8214 | (if (looking-at "|[^|\r\n]*") | |
8215 | (let* ((pos (match-beginning 0)) | |
8216 | (val (buffer-substring (1+ pos) (match-end 0)))) | |
8217 | (if replace | |
204dc8c5 | 8218 | (replace-match (concat "|" replace) t t)) |
d3f4dbe8 CD |
8219 | (goto-char (min (point-at-eol) (+ 2 pos))) |
8220 | val) | |
8221 | (forward-char 1) "")) | |
891f4676 | 8222 | |
d3f4dbe8 CD |
8223 | (defun org-table-field-info (arg) |
8224 | "Show info about the current field, and highlight any reference at point." | |
a3fbe8c4 | 8225 | (interactive "P") |
d3f4dbe8 CD |
8226 | (org-table-get-specials) |
8227 | (save-excursion | |
8228 | (let* ((pos (point)) | |
8229 | (col (org-table-current-column)) | |
8230 | (cname (car (rassoc (int-to-string col) org-table-column-names))) | |
8231 | (name (car (rassoc (list (org-current-line) col) | |
8232 | org-table-named-field-locations))) | |
8233 | (eql (org-table-get-stored-formulas)) | |
8234 | (dline (org-table-current-dline)) | |
8235 | (ref (format "@%d$%d" dline col)) | |
a3fbe8c4 | 8236 | (ref1 (org-table-convert-refs-to-an ref)) |
d3f4dbe8 | 8237 | (fequation (or (assoc name eql) (assoc ref eql))) |
a3fbe8c4 CD |
8238 | (cequation (assoc (int-to-string col) eql)) |
8239 | (eqn (or fequation cequation))) | |
d3f4dbe8 CD |
8240 | (goto-char pos) |
8241 | (condition-case nil | |
a3fbe8c4 | 8242 | (org-table-show-reference 'local) |
d3f4dbe8 | 8243 | (error nil)) |
a3fbe8c4 | 8244 | (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" |
d3f4dbe8 CD |
8245 | dline col |
8246 | (if cname (concat " or $" cname) "") | |
a3fbe8c4 | 8247 | dline col ref1 |
d3f4dbe8 CD |
8248 | (if name (concat " or $" name) "") |
8249 | ;; FIXME: formula info not correct if special table line | |
a3fbe8c4 CD |
8250 | (if eqn |
8251 | (concat ", formula: " | |
8252 | (org-table-formula-to-user | |
8253 | (concat | |
8254 | (if (string-match "^[$@]"(car eqn)) "" "$") | |
8255 | (car eqn) "=" (cdr eqn)))) | |
d3f4dbe8 | 8256 | ""))))) |
35fb9989 | 8257 | |
d3f4dbe8 CD |
8258 | (defun org-table-current-column () |
8259 | "Find out which column we are in. | |
8260 | When called interactively, column is also displayed in echo area." | |
891f4676 | 8261 | (interactive) |
d3f4dbe8 CD |
8262 | (if (interactive-p) (org-table-check-inside-data-field)) |
8263 | (save-excursion | |
8264 | (let ((cnt 0) (pos (point))) | |
8265 | (beginning-of-line 1) | |
8266 | (while (search-forward "|" pos t) | |
8267 | (setq cnt (1+ cnt))) | |
8268 | (if (interactive-p) (message "This is table column %d" cnt)) | |
8269 | cnt))) | |
891f4676 | 8270 | |
d3f4dbe8 CD |
8271 | (defun org-table-current-dline () |
8272 | "Find out what table data line we are in. | |
8273 | Only datalins count for this." | |
891f4676 | 8274 | (interactive) |
d3f4dbe8 CD |
8275 | (if (interactive-p) (org-table-check-inside-data-field)) |
8276 | (save-excursion | |
8277 | (let ((cnt 0) (pos (point))) | |
8278 | (goto-char (org-table-begin)) | |
8279 | (while (<= (point) pos) | |
8280 | (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) | |
8281 | (beginning-of-line 2)) | |
8282 | (if (interactive-p) (message "This is table line %d" cnt)) | |
8283 | cnt))) | |
891f4676 | 8284 | |
d3f4dbe8 CD |
8285 | (defun org-table-goto-column (n &optional on-delim force) |
8286 | "Move the cursor to the Nth column in the current table line. | |
8287 | With optional argument ON-DELIM, stop with point before the left delimiter | |
8288 | of the field. | |
8289 | If there are less than N fields, just go to after the last delimiter. | |
8290 | However, when FORCE is non-nil, create new columns if necessary." | |
8291 | (interactive "p") | |
8292 | (let ((pos (point-at-eol))) | |
8293 | (beginning-of-line 1) | |
8294 | (when (> n 0) | |
8295 | (while (and (> (setq n (1- n)) -1) | |
8296 | (or (search-forward "|" pos t) | |
8297 | (and force | |
8298 | (progn (end-of-line 1) | |
8299 | (skip-chars-backward "^|") | |
8300 | (insert " | ")))))) | |
8301 | ; (backward-char 2) t))))) | |
8302 | (when (and force (not (looking-at ".*|"))) | |
8303 | (save-excursion (end-of-line 1) (insert " | "))) | |
8304 | (if on-delim | |
8305 | (backward-char 1) | |
8306 | (if (looking-at " ") (forward-char 1)))))) | |
891f4676 | 8307 | |
d3f4dbe8 CD |
8308 | (defun org-at-table-p (&optional table-type) |
8309 | "Return t if the cursor is inside an org-type table. | |
8310 | If TABLE-TYPE is non-nil, also check for table.el-type tables." | |
8311 | (if org-enable-table-editor | |
8312 | (save-excursion | |
8313 | (beginning-of-line 1) | |
8314 | (looking-at (if table-type org-table-any-line-regexp | |
8315 | org-table-line-regexp))) | |
8316 | nil)) | |
64f72ae1 | 8317 | |
d3f4dbe8 CD |
8318 | (defun org-at-table.el-p () |
8319 | "Return t if and only if we are at a table.el table." | |
8320 | (and (org-at-table-p 'any) | |
8321 | (save-excursion | |
8322 | (goto-char (org-table-begin 'any)) | |
8323 | (looking-at org-table1-hline-regexp)))) | |
891f4676 | 8324 | |
d3f4dbe8 CD |
8325 | (defun org-table-recognize-table.el () |
8326 | "If there is a table.el table nearby, recognize it and move into it." | |
8327 | (if org-table-tab-recognizes-table.el | |
8328 | (if (org-at-table.el-p) | |
8329 | (progn | |
8330 | (beginning-of-line 1) | |
8331 | (if (looking-at org-table-dataline-regexp) | |
8332 | nil | |
8333 | (if (looking-at org-table1-hline-regexp) | |
8334 | (progn | |
8335 | (beginning-of-line 2) | |
8336 | (if (looking-at org-table-any-border-regexp) | |
8337 | (beginning-of-line -1))))) | |
8338 | (if (re-search-forward "|" (org-table-end t) t) | |
8339 | (progn | |
8340 | (require 'table) | |
8341 | (if (table--at-cell-p (point)) | |
8342 | t | |
8343 | (message "recognizing table.el table...") | |
8344 | (table-recognize-table) | |
8345 | (message "recognizing table.el table...done"))) | |
8346 | (error "This should not happen...")) | |
8347 | t) | |
8348 | nil) | |
8349 | nil)) | |
891f4676 | 8350 | |
d3f4dbe8 CD |
8351 | (defun org-at-table-hline-p () |
8352 | "Return t if the cursor is inside a hline in a table." | |
8353 | (if org-enable-table-editor | |
8354 | (save-excursion | |
8355 | (beginning-of-line 1) | |
8356 | (looking-at org-table-hline-regexp)) | |
8357 | nil)) | |
891f4676 | 8358 | |
d3f4dbe8 CD |
8359 | (defun org-table-insert-column () |
8360 | "Insert a new column into the table." | |
8361 | (interactive) | |
8362 | (if (not (org-at-table-p)) | |
8363 | (error "Not at a table")) | |
8364 | (org-table-find-dataline) | |
8365 | (let* ((col (max 1 (org-table-current-column))) | |
8366 | (beg (org-table-begin)) | |
8367 | (end (org-table-end)) | |
8368 | ;; Current cursor position | |
8369 | (linepos (org-current-line)) | |
8370 | (colpos col)) | |
8371 | (goto-char beg) | |
8372 | (while (< (point) end) | |
8373 | (if (org-at-table-hline-p) | |
8374 | nil | |
8375 | (org-table-goto-column col t) | |
8376 | (insert "| ")) | |
8377 | (beginning-of-line 2)) | |
8378 | (move-marker end nil) | |
8379 | (goto-line linepos) | |
8380 | (org-table-goto-column colpos) | |
8381 | (org-table-align) | |
8382 | (org-table-fix-formulas "$" nil (1- col) 1))) | |
28e5b051 | 8383 | |
d3f4dbe8 CD |
8384 | (defun org-table-find-dataline () |
8385 | "Find a dataline in the current table, which is needed for column commands." | |
8386 | (if (and (org-at-table-p) | |
8387 | (not (org-at-table-hline-p))) | |
8388 | t | |
8389 | (let ((col (current-column)) | |
8390 | (end (org-table-end))) | |
8391 | (move-to-column col) | |
8392 | (while (and (< (point) end) | |
8393 | (or (not (= (current-column) col)) | |
8394 | (org-at-table-hline-p))) | |
8395 | (beginning-of-line 2) | |
8396 | (move-to-column col)) | |
8397 | (if (and (org-at-table-p) | |
8398 | (not (org-at-table-hline-p))) | |
8399 | t | |
8400 | (error | |
8401 | "Please position cursor in a data line for column operations"))))) | |
04d18304 | 8402 | |
d3f4dbe8 CD |
8403 | (defun org-table-delete-column () |
8404 | "Delete a column from the table." | |
8405 | (interactive) | |
8406 | (if (not (org-at-table-p)) | |
8407 | (error "Not at a table")) | |
8408 | (org-table-find-dataline) | |
8409 | (org-table-check-inside-data-field) | |
8410 | (let* ((col (org-table-current-column)) | |
8411 | (beg (org-table-begin)) | |
8412 | (end (org-table-end)) | |
8413 | ;; Current cursor position | |
8414 | (linepos (org-current-line)) | |
8415 | (colpos col)) | |
8416 | (goto-char beg) | |
8417 | (while (< (point) end) | |
8418 | (if (org-at-table-hline-p) | |
8419 | nil | |
8420 | (org-table-goto-column col t) | |
8421 | (and (looking-at "|[^|\n]+|") | |
8422 | (replace-match "|"))) | |
8423 | (beginning-of-line 2)) | |
8424 | (move-marker end nil) | |
8425 | (goto-line linepos) | |
8426 | (org-table-goto-column colpos) | |
8427 | (org-table-align) | |
8428 | (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) | |
8429 | col -1 col))) | |
891f4676 | 8430 | |
d3f4dbe8 CD |
8431 | (defun org-table-move-column-right () |
8432 | "Move column to the right." | |
8433 | (interactive) | |
8434 | (org-table-move-column nil)) | |
8435 | (defun org-table-move-column-left () | |
8436 | "Move column to the left." | |
8437 | (interactive) | |
8438 | (org-table-move-column 'left)) | |
891f4676 | 8439 | |
d3f4dbe8 CD |
8440 | (defun org-table-move-column (&optional left) |
8441 | "Move the current column to the right. With arg LEFT, move to the left." | |
8442 | (interactive "P") | |
8443 | (if (not (org-at-table-p)) | |
8444 | (error "Not at a table")) | |
8445 | (org-table-find-dataline) | |
8446 | (org-table-check-inside-data-field) | |
8447 | (let* ((col (org-table-current-column)) | |
8448 | (col1 (if left (1- col) col)) | |
8449 | (beg (org-table-begin)) | |
8450 | (end (org-table-end)) | |
8451 | ;; Current cursor position | |
8452 | (linepos (org-current-line)) | |
8453 | (colpos (if left (1- col) (1+ col)))) | |
8454 | (if (and left (= col 1)) | |
8455 | (error "Cannot move column further left")) | |
8456 | (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) | |
8457 | (error "Cannot move column further right")) | |
8458 | (goto-char beg) | |
8459 | (while (< (point) end) | |
8460 | (if (org-at-table-hline-p) | |
8461 | nil | |
8462 | (org-table-goto-column col1 t) | |
8463 | (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") | |
8464 | (replace-match "|\\2|\\1|"))) | |
8465 | (beginning-of-line 2)) | |
8466 | (move-marker end nil) | |
8467 | (goto-line linepos) | |
8468 | (org-table-goto-column colpos) | |
8469 | (org-table-align) | |
a3fbe8c4 | 8470 | (org-table-fix-formulas |
d3f4dbe8 CD |
8471 | "$" (list (cons (number-to-string col) (number-to-string colpos)) |
8472 | (cons (number-to-string colpos) (number-to-string col)))))) | |
891f4676 | 8473 | |
d3f4dbe8 CD |
8474 | (defun org-table-move-row-down () |
8475 | "Move table row down." | |
8476 | (interactive) | |
8477 | (org-table-move-row nil)) | |
8478 | (defun org-table-move-row-up () | |
8479 | "Move table row up." | |
8480 | (interactive) | |
8481 | (org-table-move-row 'up)) | |
891f4676 | 8482 | |
d3f4dbe8 CD |
8483 | (defun org-table-move-row (&optional up) |
8484 | "Move the current table line down. With arg UP, move it up." | |
8485 | (interactive "P") | |
8486 | (let* ((col (current-column)) | |
8487 | (pos (point)) | |
a3fbe8c4 | 8488 | (hline1p (save-excursion (beginning-of-line 1) |
d3f4dbe8 CD |
8489 | (looking-at org-table-hline-regexp))) |
8490 | (dline1 (org-table-current-dline)) | |
8491 | (dline2 (+ dline1 (if up -1 1))) | |
8492 | (tonew (if up 0 2)) | |
8493 | txt hline2p) | |
8494 | (beginning-of-line tonew) | |
8495 | (unless (org-at-table-p) | |
8496 | (goto-char pos) | |
8497 | (error "Cannot move row further")) | |
8498 | (setq hline2p (looking-at org-table-hline-regexp)) | |
8499 | (goto-char pos) | |
8500 | (beginning-of-line 1) | |
8501 | (setq pos (point)) | |
8502 | (setq txt (buffer-substring (point) (1+ (point-at-eol)))) | |
8503 | (delete-region (point) (1+ (point-at-eol))) | |
8504 | (beginning-of-line tonew) | |
8505 | (insert txt) | |
8506 | (beginning-of-line 0) | |
8507 | (move-to-column col) | |
8508 | (unless (or hline1p hline2p) | |
a3fbe8c4 | 8509 | (org-table-fix-formulas |
d3f4dbe8 CD |
8510 | "@" (list (cons (number-to-string dline1) (number-to-string dline2)) |
8511 | (cons (number-to-string dline2) (number-to-string dline1))))))) | |
891f4676 | 8512 | |
d3f4dbe8 CD |
8513 | (defun org-table-insert-row (&optional arg) |
8514 | "Insert a new row above the current line into the table. | |
8515 | With prefix ARG, insert below the current line." | |
8516 | (interactive "P") | |
8517 | (if (not (org-at-table-p)) | |
8518 | (error "Not at a table")) | |
8519 | (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) | |
8520 | (new (org-table-clean-line line))) | |
8521 | ;; Fix the first field if necessary | |
8522 | (if (string-match "^[ \t]*| *[#$] *|" line) | |
8523 | (setq new (replace-match (match-string 0 line) t t new))) | |
8524 | (beginning-of-line (if arg 2 1)) | |
8525 | (let (org-table-may-need-update) (insert-before-markers new "\n")) | |
8526 | (beginning-of-line 0) | |
8527 | (re-search-forward "| ?" (point-at-eol) t) | |
8528 | (and (or org-table-may-need-update org-table-overlay-coordinates) | |
8529 | (org-table-align)) | |
8530 | (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))) | |
891f4676 | 8531 | |
a3fbe8c4 | 8532 | (defun org-table-insert-hline (&optional above) |
d3f4dbe8 | 8533 | "Insert a horizontal-line below the current line into the table. |
a3fbe8c4 | 8534 | With prefix ABOVE, insert above the current line." |
d3f4dbe8 CD |
8535 | (interactive "P") |
8536 | (if (not (org-at-table-p)) | |
8537 | (error "Not at a table")) | |
8538 | (let ((line (org-table-clean-line | |
8539 | (buffer-substring (point-at-bol) (point-at-eol)))) | |
8540 | (col (current-column))) | |
8541 | (while (string-match "|\\( +\\)|" line) | |
8542 | (setq line (replace-match | |
8543 | (concat "+" (make-string (- (match-end 1) (match-beginning 1)) | |
8544 | ?-) "|") t t line))) | |
8545 | (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) | |
a3fbe8c4 | 8546 | (beginning-of-line (if above 1 2)) |
d3f4dbe8 | 8547 | (insert line "\n") |
a3fbe8c4 | 8548 | (beginning-of-line (if above 1 -1)) |
d3f4dbe8 CD |
8549 | (move-to-column col) |
8550 | (and org-table-overlay-coordinates (org-table-align)))) | |
64f72ae1 | 8551 | |
a3fbe8c4 CD |
8552 | (defun org-table-hline-and-move (&optional same-column) |
8553 | "Insert a hline and move to the row below that line." | |
8554 | (interactive "P") | |
8555 | (let ((col (org-table-current-column))) | |
8556 | (org-table-maybe-eval-formula) | |
8557 | (org-table-maybe-recalculate-line) | |
8558 | (org-table-insert-hline) | |
8559 | (end-of-line 2) | |
8560 | (if (looking-at "\n[ \t]*|-") | |
8561 | (progn (insert "\n|") (org-table-align)) | |
8562 | (org-table-next-field)) | |
8563 | (if same-column (org-table-goto-column col)))) | |
8564 | ||
d3f4dbe8 CD |
8565 | (defun org-table-clean-line (s) |
8566 | "Convert a table line S into a string with only \"|\" and space. | |
8567 | In particular, this does handle wide and invisible characters." | |
8568 | (if (string-match "^[ \t]*|-" s) | |
8569 | ;; It's a hline, just map the characters | |
8570 | (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) | |
8571 | (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) | |
8572 | (setq s (replace-match | |
8573 | (concat "|" (make-string (org-string-width (match-string 1 s)) | |
8574 | ?\ ) "|") | |
8575 | t t s))) | |
8576 | s)) | |
3278a016 | 8577 | |
d3f4dbe8 CD |
8578 | (defun org-table-kill-row () |
8579 | "Delete the current row or horizontal line from the table." | |
3278a016 | 8580 | (interactive) |
d3f4dbe8 CD |
8581 | (if (not (org-at-table-p)) |
8582 | (error "Not at a table")) | |
8583 | (let ((col (current-column)) | |
8584 | (dline (org-table-current-dline))) | |
8585 | (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) | |
8586 | (if (not (org-at-table-p)) (beginning-of-line 0)) | |
8587 | (move-to-column col) | |
8588 | (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) | |
8589 | dline -1 dline))) | |
22a54481 | 8590 | |
d3f4dbe8 CD |
8591 | (defun org-table-sort-lines (with-case &optional sorting-type) |
8592 | "Sort table lines according to the column at point. | |
3278a016 | 8593 | |
d3f4dbe8 CD |
8594 | The position of point indicates the column to be used for |
8595 | sorting, and the range of lines is the range between the nearest | |
8596 | horizontal separator lines, or the entire table of no such lines | |
8597 | exist. If point is before the first column, you will be prompted | |
8598 | for the sorting column. If there is an active region, the mark | |
8599 | specifies the first line and the sorting column, while point | |
8600 | should be in the last line to be included into the sorting. | |
04d18304 | 8601 | |
d3f4dbe8 CD |
8602 | The command then prompts for the sorting type which can be |
8603 | alphabetically, numerically, or by time (as given in a time stamp | |
8604 | in the field). Sorting in reverse order is also possible. | |
3278a016 | 8605 | |
d3f4dbe8 | 8606 | With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. |
891f4676 | 8607 | |
d3f4dbe8 CD |
8608 | If SORTING-TYPE is specified when this function is called from a Lisp |
8609 | program, no prompting will take place. SORTING-TYPE must be a character, | |
8610 | any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting | |
8611 | should be done in reverse order." | |
891f4676 | 8612 | (interactive "P") |
d3f4dbe8 CD |
8613 | (let* ((thisline (org-current-line)) |
8614 | (thiscol (org-table-current-column)) | |
8615 | beg end bcol ecol tend tbeg column lns pos) | |
8616 | (when (equal thiscol 0) | |
8617 | (if (interactive-p) | |
8618 | (setq thiscol | |
8619 | (string-to-number | |
8620 | (read-string "Use column N for sorting: "))) | |
8621 | (setq thiscol 1)) | |
8622 | (org-table-goto-column thiscol)) | |
8623 | (org-table-check-inside-data-field) | |
8624 | (if (org-region-active-p) | |
8625 | (progn | |
8626 | (setq beg (region-beginning) end (region-end)) | |
8627 | (goto-char beg) | |
8628 | (setq column (org-table-current-column) | |
8629 | beg (point-at-bol)) | |
8630 | (goto-char end) | |
8631 | (setq end (point-at-bol 2))) | |
8632 | (setq column (org-table-current-column) | |
8633 | pos (point) | |
8634 | tbeg (org-table-begin) | |
8635 | tend (org-table-end)) | |
8636 | (if (re-search-backward org-table-hline-regexp tbeg t) | |
8637 | (setq beg (point-at-bol 2)) | |
8638 | (goto-char tbeg) | |
8639 | (setq beg (point-at-bol 1))) | |
8640 | (goto-char pos) | |
8641 | (if (re-search-forward org-table-hline-regexp tend t) | |
7d58338e | 8642 | (setq end (point-at-bol 1)) |
d3f4dbe8 CD |
8643 | (goto-char tend) |
8644 | (setq end (point-at-bol)))) | |
8645 | (setq beg (move-marker (make-marker) beg) | |
8646 | end (move-marker (make-marker) end)) | |
8647 | (untabify beg end) | |
8648 | (goto-char beg) | |
8649 | (org-table-goto-column column) | |
8650 | (skip-chars-backward "^|") | |
8651 | (setq bcol (current-column)) | |
8652 | (org-table-goto-column (1+ column)) | |
8653 | (skip-chars-backward "^|") | |
8654 | (setq ecol (1- (current-column))) | |
8655 | (org-table-goto-column column) | |
8656 | (setq lns (mapcar (lambda(x) (cons (org-trim (substring x bcol ecol)) x)) | |
8657 | (org-split-string (buffer-substring beg end) "\n"))) | |
8658 | (setq lns (org-do-sort lns "Table" with-case sorting-type)) | |
8659 | (delete-region beg end) | |
8660 | (move-marker beg nil) | |
8661 | (move-marker end nil) | |
8662 | (insert (mapconcat 'cdr lns "\n") "\n") | |
8663 | (goto-line thisline) | |
8664 | (org-table-goto-column thiscol) | |
8665 | (message "%d lines sorted, based on column %d" (length lns) column))) | |
891f4676 | 8666 | |
d3f4dbe8 CD |
8667 | (defun org-table-cut-region (beg end) |
8668 | "Copy region in table to the clipboard and blank all relevant fields." | |
8669 | (interactive "r") | |
8670 | (org-table-copy-region beg end 'cut)) | |
891f4676 | 8671 | |
d3f4dbe8 CD |
8672 | (defun org-table-copy-region (beg end &optional cut) |
8673 | "Copy rectangular region in table to clipboard. | |
8674 | A special clipboard is used which can only be accessed | |
8675 | with `org-table-paste-rectangle'." | |
8676 | (interactive "rP") | |
8677 | (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 | |
8678 | region cols | |
8679 | (rpl (if cut " " nil))) | |
8680 | (goto-char beg) | |
8681 | (org-table-check-inside-data-field) | |
8682 | (setq l01 (org-current-line) | |
8683 | c01 (org-table-current-column)) | |
8684 | (goto-char end) | |
8685 | (org-table-check-inside-data-field) | |
8686 | (setq l02 (org-current-line) | |
8687 | c02 (org-table-current-column)) | |
8688 | (setq l1 (min l01 l02) l2 (max l01 l02) | |
8689 | c1 (min c01 c02) c2 (max c01 c02)) | |
8690 | (catch 'exit | |
8691 | (while t | |
8692 | (catch 'nextline | |
8693 | (if (> l1 l2) (throw 'exit t)) | |
8694 | (goto-line l1) | |
8695 | (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) | |
8696 | (setq cols nil ic1 c1 ic2 c2) | |
8697 | (while (< ic1 (1+ ic2)) | |
8698 | (push (org-table-get-field ic1 rpl) cols) | |
8699 | (setq ic1 (1+ ic1))) | |
8700 | (push (nreverse cols) region) | |
8701 | (setq l1 (1+ l1))))) | |
8702 | (setq org-table-clip (nreverse region)) | |
8703 | (if cut (org-table-align)) | |
8704 | org-table-clip)) | |
891f4676 | 8705 | |
d3f4dbe8 CD |
8706 | (defun org-table-paste-rectangle () |
8707 | "Paste a rectangular region into a table. | |
8708 | The upper right corner ends up in the current field. All involved fields | |
8709 | will be overwritten. If the rectangle does not fit into the present table, | |
8710 | the table is enlarged as needed. The process ignores horizontal separator | |
8711 | lines." | |
8712 | (interactive) | |
8713 | (unless (and org-table-clip (listp org-table-clip)) | |
8714 | (error "First cut/copy a region to paste!")) | |
8715 | (org-table-check-inside-data-field) | |
8716 | (let* ((clip org-table-clip) | |
8717 | (line (org-current-line)) | |
8718 | (col (org-table-current-column)) | |
8719 | (org-enable-table-editor t) | |
8720 | (org-table-automatic-realign nil) | |
8721 | c cols field) | |
8722 | (while (setq cols (pop clip)) | |
8723 | (while (org-at-table-hline-p) (beginning-of-line 2)) | |
8724 | (if (not (org-at-table-p)) | |
8725 | (progn (end-of-line 0) (org-table-next-field))) | |
8726 | (setq c col) | |
8727 | (while (setq field (pop cols)) | |
8728 | (org-table-goto-column c nil 'force) | |
8729 | (org-table-get-field nil field) | |
8730 | (setq c (1+ c))) | |
8731 | (beginning-of-line 2)) | |
8732 | (goto-line line) | |
8733 | (org-table-goto-column col) | |
8734 | (org-table-align))) | |
891f4676 | 8735 | |
d3f4dbe8 CD |
8736 | (defun org-table-convert () |
8737 | "Convert from `org-mode' table to table.el and back. | |
8738 | Obviously, this only works within limits. When an Org-mode table is | |
8739 | converted to table.el, all horizontal separator lines get lost, because | |
8740 | table.el uses these as cell boundaries and has no notion of horizontal lines. | |
8741 | A table.el table can be converted to an Org-mode table only if it does not | |
8742 | do row or column spanning. Multiline cells will become multiple cells. | |
8743 | Beware, Org-mode does not test if the table can be successfully converted - it | |
8744 | blindly applies a recipe that works for simple tables." | |
891f4676 | 8745 | (interactive) |
d3f4dbe8 CD |
8746 | (require 'table) |
8747 | (if (org-at-table.el-p) | |
8748 | ;; convert to Org-mode table | |
8749 | (let ((beg (move-marker (make-marker) (org-table-begin t))) | |
8750 | (end (move-marker (make-marker) (org-table-end t)))) | |
8751 | (table-unrecognize-region beg end) | |
8752 | (goto-char beg) | |
8753 | (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) | |
8754 | (replace-match "")) | |
8755 | (goto-char beg)) | |
8756 | (if (org-at-table-p) | |
8757 | ;; convert to table.el table | |
8758 | (let ((beg (move-marker (make-marker) (org-table-begin))) | |
8759 | (end (move-marker (make-marker) (org-table-end)))) | |
8760 | ;; first, get rid of all horizontal lines | |
8761 | (goto-char beg) | |
8762 | (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) | |
8763 | (replace-match "")) | |
8764 | ;; insert a hline before first | |
8765 | (goto-char beg) | |
8766 | (org-table-insert-hline 'above) | |
8767 | (beginning-of-line -1) | |
8768 | ;; insert a hline after each line | |
8769 | (while (progn (beginning-of-line 3) (< (point) end)) | |
8770 | (org-table-insert-hline)) | |
8771 | (goto-char beg) | |
8772 | (setq end (move-marker end (org-table-end))) | |
8773 | ;; replace "+" at beginning and ending of hlines | |
8774 | (while (re-search-forward "^\\([ \t]*\\)|-" end t) | |
8775 | (replace-match "\\1+-")) | |
8776 | (goto-char beg) | |
8777 | (while (re-search-forward "-|[ \t]*$" end t) | |
8778 | (replace-match "-+")) | |
8779 | (goto-char beg))))) | |
891f4676 | 8780 | |
d3f4dbe8 CD |
8781 | (defun org-table-wrap-region (arg) |
8782 | "Wrap several fields in a column like a paragraph. | |
8783 | This is useful if you'd like to spread the contents of a field over several | |
8784 | lines, in order to keep the table compact. | |
891f4676 | 8785 | |
d3f4dbe8 CD |
8786 | If there is an active region, and both point and mark are in the same column, |
8787 | the text in the column is wrapped to minimum width for the given number of | |
8788 | lines. Generally, this makes the table more compact. A prefix ARG may be | |
8789 | used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' | |
8790 | formats the selected text to two lines. If the region was longer than two | |
8791 | lines, the remaining lines remain empty. A negative prefix argument reduces | |
8792 | the current number of lines by that amount. The wrapped text is pasted back | |
8793 | into the table. If you formatted it to more lines than it was before, fields | |
8794 | further down in the table get overwritten - so you might need to make space in | |
8795 | the table first. | |
891f4676 | 8796 | |
d3f4dbe8 CD |
8797 | If there is no region, the current field is split at the cursor position and |
8798 | the text fragment to the right of the cursor is prepended to the field one | |
8799 | line down. | |
891f4676 | 8800 | |
d3f4dbe8 CD |
8801 | If there is no region, but you specify a prefix ARG, the current field gets |
8802 | blank, and the content is appended to the field above." | |
8803 | (interactive "P") | |
8804 | (org-table-check-inside-data-field) | |
8805 | (if (org-region-active-p) | |
8806 | ;; There is a region: fill as a paragraph | |
8807 | (let* ((beg (region-beginning)) | |
8808 | (cline (save-excursion (goto-char beg) (org-current-line))) | |
8809 | (ccol (save-excursion (goto-char beg) (org-table-current-column))) | |
8810 | nlines) | |
8811 | (org-table-cut-region (region-beginning) (region-end)) | |
8812 | (if (> (length (car org-table-clip)) 1) | |
8813 | (error "Region must be limited to single column")) | |
8814 | (setq nlines (if arg | |
8815 | (if (< arg 1) | |
8816 | (+ (length org-table-clip) arg) | |
8817 | arg) | |
8818 | (length org-table-clip))) | |
8819 | (setq org-table-clip | |
8820 | (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") | |
8821 | nil nlines))) | |
8822 | (goto-line cline) | |
8823 | (org-table-goto-column ccol) | |
8824 | (org-table-paste-rectangle)) | |
8825 | ;; No region, split the current field at point | |
8826 | (if arg | |
8827 | ;; combine with field above | |
8828 | (let ((s (org-table-blank-field)) | |
8829 | (col (org-table-current-column))) | |
8830 | (beginning-of-line 0) | |
8831 | (while (org-at-table-hline-p) (beginning-of-line 0)) | |
8832 | (org-table-goto-column col) | |
8833 | (skip-chars-forward "^|") | |
8834 | (skip-chars-backward " ") | |
8835 | (insert " " (org-trim s)) | |
8836 | (org-table-align)) | |
8837 | ;; split field | |
8838 | (when (looking-at "\\([^|]+\\)+|") | |
8839 | (let ((s (match-string 1))) | |
8840 | (replace-match " |") | |
8841 | (goto-char (match-beginning 0)) | |
8842 | (org-table-next-row) | |
8843 | (insert (org-trim s) " ") | |
8844 | (org-table-align)))))) | |
edd21304 | 8845 | |
d3f4dbe8 | 8846 | (defvar org-field-marker nil) |
edd21304 | 8847 | |
d3f4dbe8 CD |
8848 | (defun org-table-edit-field (arg) |
8849 | "Edit table field in a different window. | |
8850 | This is mainly useful for fields that contain hidden parts. | |
8851 | When called with a \\[universal-argument] prefix, just make the full field visible so that | |
8852 | it can be edited in place." | |
8853 | (interactive "P") | |
8854 | (if arg | |
8855 | (let ((b (save-excursion (skip-chars-backward "^|") (point))) | |
8856 | (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) | |
8857 | (remove-text-properties b e '(org-cwidth t invisible t | |
8858 | display t intangible t)) | |
8859 | (if (and (boundp 'font-lock-mode) font-lock-mode) | |
8860 | (font-lock-fontify-block))) | |
8861 | (let ((pos (move-marker (make-marker) (point))) | |
8862 | (field (org-table-get-field)) | |
8863 | (cw (current-window-configuration)) | |
8864 | p) | |
374585c9 | 8865 | (org-switch-to-buffer-other-window "*Org tmp*") |
d3f4dbe8 CD |
8866 | (erase-buffer) |
8867 | (insert "#\n# Edit field and finish with C-c C-c\n#\n") | |
a3fbe8c4 | 8868 | (let ((org-inhibit-startup t)) (org-mode)) |
d3f4dbe8 CD |
8869 | (goto-char (setq p (point-max))) |
8870 | (insert (org-trim field)) | |
8871 | (remove-text-properties p (point-max) | |
8872 | '(invisible t org-cwidth t display t | |
8873 | intangible t)) | |
8874 | (goto-char p) | |
a3fbe8c4 | 8875 | (org-set-local 'org-finish-function 'org-table-finish-edit-field) |
d3f4dbe8 CD |
8876 | (org-set-local 'org-window-configuration cw) |
8877 | (org-set-local 'org-field-marker pos) | |
8878 | (message "Edit and finish with C-c C-c")))) | |
edd21304 | 8879 | |
d3f4dbe8 CD |
8880 | (defun org-table-finish-edit-field () |
8881 | "Finish editing a table data field. | |
8882 | Remove all newline characters, insert the result into the table, realign | |
8883 | the table and kill the editing buffer." | |
8884 | (let ((pos org-field-marker) | |
8885 | (cw org-window-configuration) | |
8886 | (cb (current-buffer)) | |
8887 | text) | |
8888 | (goto-char (point-min)) | |
8889 | (while (re-search-forward "^#.*\n?" nil t) (replace-match "")) | |
8890 | (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) | |
8891 | (replace-match " ")) | |
8892 | (setq text (org-trim (buffer-string))) | |
8893 | (set-window-configuration cw) | |
8894 | (kill-buffer cb) | |
8895 | (select-window (get-buffer-window (marker-buffer pos))) | |
8896 | (goto-char pos) | |
8897 | (move-marker pos nil) | |
8898 | (org-table-check-inside-data-field) | |
8899 | (org-table-get-field nil text) | |
8900 | (org-table-align) | |
8901 | (message "New field value inserted"))) | |
edd21304 | 8902 | |
d3f4dbe8 CD |
8903 | (defun org-trim (s) |
8904 | "Remove whitespace at beginning and end of string." | |
15841868 JW |
8905 | (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) |
8906 | (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) | |
d3f4dbe8 | 8907 | s) |
edd21304 | 8908 | |
d3f4dbe8 CD |
8909 | (defun org-wrap (string &optional width lines) |
8910 | "Wrap string to either a number of lines, or a width in characters. | |
8911 | If WIDTH is non-nil, the string is wrapped to that width, however many lines | |
8912 | that costs. If there is a word longer than WIDTH, the text is actually | |
8913 | wrapped to the length of that word. | |
8914 | IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | |
8915 | many lines, whatever width that takes. | |
8916 | The return value is a list of lines, without newlines at the end." | |
8917 | (let* ((words (org-split-string string "[ \t\n]+")) | |
8918 | (maxword (apply 'max (mapcar 'org-string-width words))) | |
8919 | w ll) | |
8920 | (cond (width | |
8921 | (org-do-wrap words (max maxword width))) | |
8922 | (lines | |
8923 | (setq w maxword) | |
8924 | (setq ll (org-do-wrap words maxword)) | |
8925 | (if (<= (length ll) lines) | |
8926 | ll | |
8927 | (setq ll words) | |
8928 | (while (> (length ll) lines) | |
8929 | (setq w (1+ w)) | |
8930 | (setq ll (org-do-wrap words w))) | |
8931 | ll)) | |
8932 | (t (error "Cannot wrap this"))))) | |
edd21304 | 8933 | |
edd21304 | 8934 | |
d3f4dbe8 CD |
8935 | (defun org-do-wrap (words width) |
8936 | "Create lines of maximum width WIDTH (in characters) from word list WORDS." | |
8937 | (let (lines line) | |
8938 | (while words | |
8939 | (setq line (pop words)) | |
8940 | (while (and words (< (+ (length line) (length (car words))) width)) | |
8941 | (setq line (concat line " " (pop words)))) | |
8942 | (setq lines (push line lines))) | |
8943 | (nreverse lines))) | |
edd21304 | 8944 | |
d3f4dbe8 CD |
8945 | (defun org-split-string (string &optional separators) |
8946 | "Splits STRING into substrings at SEPARATORS. | |
8947 | No empty strings are returned if there are matches at the beginning | |
8948 | and end of string." | |
8949 | (let ((rexp (or separators "[ \f\t\n\r\v]+")) | |
8950 | (start 0) | |
8951 | notfirst | |
8952 | (list nil)) | |
8953 | (while (and (string-match rexp string | |
8954 | (if (and notfirst | |
8955 | (= start (match-beginning 0)) | |
8956 | (< start (length string))) | |
8957 | (1+ start) start)) | |
8958 | (< (match-beginning 0) (length string))) | |
8959 | (setq notfirst t) | |
8960 | (or (eq (match-beginning 0) 0) | |
8961 | (and (eq (match-beginning 0) (match-end 0)) | |
8962 | (eq (match-beginning 0) start)) | |
8963 | (setq list | |
8964 | (cons (substring string start (match-beginning 0)) | |
8965 | list))) | |
8966 | (setq start (match-end 0))) | |
8967 | (or (eq start (length string)) | |
8968 | (setq list | |
8969 | (cons (substring string start) | |
8970 | list))) | |
8971 | (nreverse list))) | |
6769c0dc | 8972 | |
d3f4dbe8 CD |
8973 | (defun org-table-map-tables (function) |
8974 | "Apply FUNCTION to the start of all tables in the buffer." | |
8975 | (save-excursion | |
8976 | (save-restriction | |
8977 | (widen) | |
8978 | (goto-char (point-min)) | |
8979 | (while (re-search-forward org-table-any-line-regexp nil t) | |
8980 | (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) | |
8981 | (beginning-of-line 1) | |
8982 | (if (looking-at org-table-line-regexp) | |
8983 | (save-excursion (funcall function))) | |
8984 | (re-search-forward org-table-any-border-regexp nil 1)))) | |
8985 | (message "Mapping tables: done")) | |
edd21304 | 8986 | |
d3f4dbe8 CD |
8987 | (defvar org-timecnt) ; dynamically scoped parameter |
8988 | ||
8989 | (defun org-table-sum (&optional beg end nlast) | |
8990 | "Sum numbers in region of current table column. | |
8991 | The result will be displayed in the echo area, and will be available | |
8992 | as kill to be inserted with \\[yank]. | |
8993 | ||
8994 | If there is an active region, it is interpreted as a rectangle and all | |
8995 | numbers in that rectangle will be summed. If there is no active | |
8996 | region and point is located in a table column, sum all numbers in that | |
8997 | column. | |
8998 | ||
8999 | If at least one number looks like a time HH:MM or HH:MM:SS, all other | |
9000 | numbers are assumed to be times as well (in decimal hours) and the | |
9001 | numbers are added as such. | |
9002 | ||
9003 | If NLAST is a number, only the NLAST fields will actually be summed." | |
edd21304 | 9004 | (interactive) |
d3f4dbe8 CD |
9005 | (save-excursion |
9006 | (let (col (org-timecnt 0) diff h m s org-table-clip) | |
9007 | (cond | |
9008 | ((and beg end)) ; beg and end given explicitly | |
9009 | ((org-region-active-p) | |
9010 | (setq beg (region-beginning) end (region-end))) | |
9011 | (t | |
9012 | (setq col (org-table-current-column)) | |
9013 | (goto-char (org-table-begin)) | |
9014 | (unless (re-search-forward "^[ \t]*|[^-]" nil t) | |
9015 | (error "No table data")) | |
9016 | (org-table-goto-column col) | |
9017 | (setq beg (point)) | |
9018 | (goto-char (org-table-end)) | |
9019 | (unless (re-search-backward "^[ \t]*|[^-]" nil t) | |
9020 | (error "No table data")) | |
9021 | (org-table-goto-column col) | |
9022 | (setq end (point)))) | |
9023 | (let* ((items (apply 'append (org-table-copy-region beg end))) | |
9024 | (items1 (cond ((not nlast) items) | |
9025 | ((>= nlast (length items)) items) | |
9026 | (t (setq items (reverse items)) | |
9027 | (setcdr (nthcdr (1- nlast) items) nil) | |
9028 | (nreverse items)))) | |
9029 | (numbers (delq nil (mapcar 'org-table-get-number-for-summing | |
9030 | items1))) | |
9031 | (res (apply '+ numbers)) | |
9032 | (sres (if (= org-timecnt 0) | |
9033 | (format "%g" res) | |
9034 | (setq diff (* 3600 res) | |
9035 | h (floor (/ diff 3600)) diff (mod diff 3600) | |
9036 | m (floor (/ diff 60)) diff (mod diff 60) | |
9037 | s diff) | |
9038 | (format "%d:%02d:%02d" h m s)))) | |
9039 | (kill-new sres) | |
9040 | (if (interactive-p) | |
9041 | (message "%s" | |
9042 | (substitute-command-keys | |
9043 | (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" | |
9044 | (length numbers) sres)))) | |
9045 | sres)))) | |
edd21304 | 9046 | |
d3f4dbe8 CD |
9047 | (defun org-table-get-number-for-summing (s) |
9048 | (let (n) | |
9049 | (if (string-match "^ *|? *" s) | |
9050 | (setq s (replace-match "" nil nil s))) | |
9051 | (if (string-match " *|? *$" s) | |
9052 | (setq s (replace-match "" nil nil s))) | |
9053 | (setq n (string-to-number s)) | |
9054 | (cond | |
9055 | ((and (string-match "0" s) | |
9056 | (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) | |
9057 | ((string-match "\\`[ \t]+\\'" s) nil) | |
9058 | ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) | |
9059 | (let ((h (string-to-number (or (match-string 1 s) "0"))) | |
9060 | (m (string-to-number (or (match-string 2 s) "0"))) | |
9061 | (s (string-to-number (or (match-string 4 s) "0")))) | |
9062 | (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) | |
9063 | (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) | |
9064 | ((equal n 0) nil) | |
9065 | (t n)))) | |
edd21304 | 9066 | |
a3fbe8c4 | 9067 | (defun org-table-current-field-formula (&optional key noerror) |
d3f4dbe8 | 9068 | "Return the formula active for the current field. |
a3fbe8c4 CD |
9069 | Assumes that specials are in place. |
9070 | If KEY is given, return the key to this formula. | |
9071 | Otherwise return the formula preceeded with \"=\" or \":=\"." | |
d3f4dbe8 CD |
9072 | (let* ((name (car (rassoc (list (org-current-line) |
9073 | (org-table-current-column)) | |
9074 | org-table-named-field-locations))) | |
9075 | (col (org-table-current-column)) | |
9076 | (scol (int-to-string col)) | |
9077 | (ref (format "@%d$%d" (org-table-current-dline) col)) | |
a3fbe8c4 | 9078 | (stored-list (org-table-get-stored-formulas noerror)) |
d3f4dbe8 CD |
9079 | (ass (or (assoc name stored-list) |
9080 | (assoc ref stored-list) | |
9081 | (assoc scol stored-list)))) | |
a3fbe8c4 CD |
9082 | (if key |
9083 | (car ass) | |
9084 | (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") | |
9085 | (cdr ass)))))) | |
edd21304 | 9086 | |
d3f4dbe8 CD |
9087 | (defun org-table-get-formula (&optional equation named) |
9088 | "Read a formula from the minibuffer, offer stored formula as default. | |
9089 | When NAMED is non-nil, look for a named equation." | |
9090 | (let* ((stored-list (org-table-get-stored-formulas)) | |
9091 | (name (car (rassoc (list (org-current-line) | |
9092 | (org-table-current-column)) | |
9093 | org-table-named-field-locations))) | |
9094 | (ref (format "@%d$%d" (org-table-current-dline) | |
9095 | (org-table-current-column))) | |
9096 | (refass (assoc ref stored-list)) | |
9097 | (scol (if named | |
9098 | (if name name ref) | |
9099 | (int-to-string (org-table-current-column)))) | |
9100 | (dummy (and (or name refass) (not named) | |
9101 | (not (y-or-n-p "Replace field formula with column formula? " )) | |
9102 | (error "Abort"))) | |
9103 | (name (or name ref)) | |
9104 | (org-table-may-need-update nil) | |
9105 | (stored (cdr (assoc scol stored-list))) | |
9106 | (eq (cond | |
9107 | ((and stored equation (string-match "^ *=? *$" equation)) | |
9108 | stored) | |
9109 | ((stringp equation) | |
9110 | equation) | |
a3fbe8c4 CD |
9111 | (t (org-table-formula-from-user |
9112 | (read-string | |
9113 | (org-table-formula-to-user | |
9114 | (format "%s formula %s%s=" | |
9115 | (if named "Field" "Column") | |
9116 | (if (member (string-to-char scol) '(?$ ?@)) "" "$") | |
9117 | scol)) | |
9118 | (if stored (org-table-formula-to-user stored) "") | |
9119 | 'org-table-formula-history | |
9120 | ))))) | |
d3f4dbe8 CD |
9121 | mustsave) |
9122 | (when (not (string-match "\\S-" eq)) | |
9123 | ;; remove formula | |
9124 | (setq stored-list (delq (assoc scol stored-list) stored-list)) | |
9125 | (org-table-store-formulas stored-list) | |
9126 | (error "Formula removed")) | |
9127 | (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) | |
9128 | (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) | |
9129 | (if (and name (not named)) | |
9130 | ;; We set the column equation, delete the named one. | |
9131 | (setq stored-list (delq (assoc name stored-list) stored-list) | |
9132 | mustsave t)) | |
9133 | (if stored | |
9134 | (setcdr (assoc scol stored-list) eq) | |
9135 | (setq stored-list (cons (cons scol eq) stored-list))) | |
9136 | (if (or mustsave (not (equal stored eq))) | |
9137 | (org-table-store-formulas stored-list)) | |
9138 | eq)) | |
edd21304 | 9139 | |
d3f4dbe8 CD |
9140 | (defun org-table-store-formulas (alist) |
9141 | "Store the list of formulas below the current table." | |
a3fbe8c4 | 9142 | (setq alist (sort alist 'org-table-formula-less-p)) |
d3f4dbe8 CD |
9143 | (save-excursion |
9144 | (goto-char (org-table-end)) | |
9145 | (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)") | |
9146 | (progn | |
9147 | ;; don't overwrite TBLFM, we might use text properties to store stuff | |
9148 | (goto-char (match-beginning 2)) | |
9149 | (delete-region (match-beginning 2) (match-end 0))) | |
9150 | (insert "#+TBLFM:")) | |
9151 | (insert " " | |
9152 | (mapconcat (lambda (x) | |
9153 | (concat | |
9154 | (if (equal (string-to-char (car x)) ?@) "" "$") | |
9155 | (car x) "=" (cdr x))) | |
9156 | alist "::") | |
9157 | "\n"))) | |
0fee8d6e | 9158 | |
a3fbe8c4 CD |
9159 | (defsubst org-table-formula-make-cmp-string (a) |
9160 | (when (string-match "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" a) | |
9161 | (concat | |
9162 | (if (match-end 2) (format "@%05d" (string-to-number (match-string 2 a))) "") | |
9163 | (if (match-end 4) (format "$%05d" (string-to-number (match-string 4 a))) "") | |
9164 | (if (match-end 5) (concat "@@" (match-string 5 a)))))) | |
9165 | ||
9166 | (defun org-table-formula-less-p (a b) | |
9167 | "Compare two formulas for sorting." | |
9168 | (let ((as (org-table-formula-make-cmp-string (car a))) | |
9169 | (bs (org-table-formula-make-cmp-string (car b)))) | |
9170 | (and as bs (string< as bs)))) | |
9171 | ||
9172 | (defun org-table-get-stored-formulas (&optional noerror) | |
d3f4dbe8 | 9173 | "Return an alist with the stored formulas directly after current table." |
0fee8d6e | 9174 | (interactive) |
d3f4dbe8 CD |
9175 | (let (scol eq eq-alist strings string seen) |
9176 | (save-excursion | |
9177 | (goto-char (org-table-end)) | |
9178 | (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") | |
9179 | (setq strings (org-split-string (match-string 2) " *:: *")) | |
9180 | (while (setq string (pop strings)) | |
9181 | (when (string-match "\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) | |
a3fbe8c4 CD |
9182 | (setq scol (if (match-end 2) |
9183 | (match-string 2 string) | |
d3f4dbe8 CD |
9184 | (match-string 1 string)) |
9185 | eq (match-string 3 string) | |
9186 | eq-alist (cons (cons scol eq) eq-alist)) | |
9187 | (if (member scol seen) | |
a3fbe8c4 CD |
9188 | (if noerror |
9189 | (progn | |
9190 | (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) | |
9191 | (ding) | |
9192 | (sit-for 2)) | |
9193 | (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) | |
d3f4dbe8 CD |
9194 | (push scol seen)))))) |
9195 | (nreverse eq-alist))) | |
0fee8d6e | 9196 | |
d3f4dbe8 CD |
9197 | (defun org-table-fix-formulas (key replace &optional limit delta remove) |
9198 | "Modify the equations after the table structure has been edited. | |
9199 | KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. | |
9200 | For all numbers larger than LIMIT, shift them by DELTA." | |
5137195a | 9201 | (save-excursion |
d3f4dbe8 CD |
9202 | (goto-char (org-table-end)) |
9203 | (when (looking-at "#\\+TBLFM:") | |
9204 | (let ((re (concat key "\\([0-9]+\\)")) | |
9205 | (re2 | |
9206 | (when remove | |
9207 | (if (equal key "$") | |
9208 | (format "\\(@[0-9]+\\)?\\$%d=.*?\\(::\\|$\\)" remove) | |
9209 | (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) | |
9210 | s n a) | |
9211 | (when remove | |
9212 | (while (re-search-forward re2 (point-at-eol) t) | |
9213 | (replace-match ""))) | |
9214 | (while (re-search-forward re (point-at-eol) t) | |
9215 | (setq s (match-string 1) n (string-to-number s)) | |
9216 | (cond | |
9217 | ((setq a (assoc s replace)) | |
9218 | (replace-match (concat key (cdr a)) t t)) | |
9219 | ((and limit (> n limit)) | |
9220 | (replace-match (concat key (int-to-string (+ n delta))) t t)))))))) | |
5137195a | 9221 | |
d3f4dbe8 CD |
9222 | (defun org-table-get-specials () |
9223 | "Get the column names and local parameters for this table." | |
9224 | (save-excursion | |
9225 | (let ((beg (org-table-begin)) (end (org-table-end)) | |
9226 | names name fields fields1 field cnt | |
9227 | c v l line col types dlines hlines) | |
9228 | (setq org-table-column-names nil | |
9229 | org-table-local-parameters nil | |
9230 | org-table-named-field-locations nil | |
9231 | org-table-current-begin-line nil | |
a3fbe8c4 CD |
9232 | org-table-current-begin-pos nil |
9233 | org-table-current-line-types nil) | |
d3f4dbe8 CD |
9234 | (goto-char beg) |
9235 | (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) | |
9236 | (setq names (org-split-string (match-string 1) " *| *") | |
9237 | cnt 1) | |
9238 | (while (setq name (pop names)) | |
9239 | (setq cnt (1+ cnt)) | |
9240 | (if (string-match "^[a-zA-Z][a-zA-Z0-9]*$" name) | |
9241 | (push (cons name (int-to-string cnt)) org-table-column-names)))) | |
9242 | (setq org-table-column-names (nreverse org-table-column-names)) | |
9243 | (setq org-table-column-name-regexp | |
9244 | (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) | |
9245 | (goto-char beg) | |
9246 | (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) | |
9247 | (setq fields (org-split-string (match-string 1) " *| *")) | |
9248 | (while (setq field (pop fields)) | |
38f8646b | 9249 | (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) |
d3f4dbe8 CD |
9250 | (push (cons (match-string 1 field) (match-string 2 field)) |
9251 | org-table-local-parameters)))) | |
9252 | (goto-char beg) | |
9253 | (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) | |
9254 | (setq c (match-string 1) | |
9255 | fields (org-split-string (match-string 2) " *| *")) | |
e28844a4 | 9256 | (save-excursion |
d3f4dbe8 CD |
9257 | (beginning-of-line (if (equal c "_") 2 0)) |
9258 | (setq line (org-current-line) col 1) | |
9259 | (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") | |
9260 | (setq fields1 (org-split-string (match-string 1) " *| *")))) | |
9261 | (while (and fields1 (setq field (pop fields))) | |
9262 | (setq v (pop fields1) col (1+ col)) | |
9263 | (when (and (stringp field) (stringp v) | |
9264 | (string-match "^[a-zA-Z][a-zA-Z0-9]*$" field)) | |
9265 | (push (cons field v) org-table-local-parameters) | |
9266 | (push (list field line col) org-table-named-field-locations)))) | |
9267 | ;; Analyse the line types | |
9268 | (goto-char beg) | |
9269 | (setq org-table-current-begin-line (org-current-line) | |
a3fbe8c4 CD |
9270 | org-table-current-begin-pos (point) |
9271 | l org-table-current-begin-line) | |
d3f4dbe8 CD |
9272 | (while (looking-at "[ \t]*|\\(-\\)?") |
9273 | (push (if (match-end 1) 'hline 'dline) types) | |
9274 | (if (match-end 1) (push l hlines) (push l dlines)) | |
9275 | (beginning-of-line 2) | |
9276 | (setq l (1+ l))) | |
9277 | (setq org-table-current-line-types (apply 'vector (nreverse types)) | |
9278 | org-table-dlines (apply 'vector (cons nil (nreverse dlines))) | |
9279 | org-table-hlines (apply 'vector (cons nil (nreverse hlines))))))) | |
891f4676 | 9280 | |
d3f4dbe8 CD |
9281 | (defun org-table-maybe-eval-formula () |
9282 | "Check if the current field starts with \"=\" or \":=\". | |
9283 | If yes, store the formula and apply it." | |
9284 | ;; We already know we are in a table. Get field will only return a formula | |
9285 | ;; when appropriate. It might return a separator line, but no problem. | |
9286 | (when org-table-formula-evaluate-inline | |
9287 | (let* ((field (org-trim (or (org-table-get-field) ""))) | |
9288 | named eq) | |
9289 | (when (string-match "^:?=\\(.*\\)" field) | |
9290 | (setq named (equal (string-to-char field) ?:) | |
9291 | eq (match-string 1 field)) | |
9292 | (if (or (fboundp 'calc-eval) | |
9293 | (equal (substring eq 0 (min 2 (length eq))) "'(")) | |
a3fbe8c4 CD |
9294 | (org-table-eval-formula (if named '(4) nil) |
9295 | (org-table-formula-from-user eq)) | |
d3f4dbe8 | 9296 | (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) |
4da1a99d | 9297 | |
d3f4dbe8 CD |
9298 | (defvar org-recalc-commands nil |
9299 | "List of commands triggering the recalculation of a line. | |
9300 | Will be filled automatically during use.") | |
791d856f | 9301 | |
d3f4dbe8 CD |
9302 | (defvar org-recalc-marks |
9303 | '((" " . "Unmarked: no special line, no automatic recalculation") | |
9304 | ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") | |
9305 | ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") | |
9306 | ("!" . "Column name definition line. Reference in formula as $name.") | |
9307 | ("$" . "Parameter definition line name=value. Reference in formula as $name.") | |
9308 | ("_" . "Names for values in row below this one.") | |
9309 | ("^" . "Names for values in row above this one."))) | |
791d856f | 9310 | |
d3f4dbe8 CD |
9311 | (defun org-table-rotate-recalc-marks (&optional newchar) |
9312 | "Rotate the recalculation mark in the first column. | |
9313 | If in any row, the first field is not consistent with a mark, | |
9314 | insert a new column for the markers. | |
9315 | When there is an active region, change all the lines in the region, | |
9316 | after prompting for the marking character. | |
9317 | After each change, a message will be displayed indicating the meaning | |
9318 | of the new mark." | |
891f4676 | 9319 | (interactive) |
d3f4dbe8 CD |
9320 | (unless (org-at-table-p) (error "Not at a table")) |
9321 | (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) | |
9322 | (beg (org-table-begin)) | |
9323 | (end (org-table-end)) | |
9324 | (l (org-current-line)) | |
9325 | (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) | |
9326 | (l2 (if (org-region-active-p) (org-current-line (region-end)))) | |
9327 | (have-col | |
9328 | (save-excursion | |
9329 | (goto-char beg) | |
9330 | (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) | |
9331 | (col (org-table-current-column)) | |
9332 | (forcenew (car (assoc newchar org-recalc-marks))) | |
9333 | epos new) | |
9334 | (when l1 | |
9335 | (message "Change region to what mark? Type # * ! $ or SPC: ") | |
9336 | (setq newchar (char-to-string (read-char-exclusive)) | |
9337 | forcenew (car (assoc newchar org-recalc-marks)))) | |
9338 | (if (and newchar (not forcenew)) | |
9339 | (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" | |
9340 | newchar)) | |
9341 | (if l1 (goto-line l1)) | |
9342 | (save-excursion | |
9343 | (beginning-of-line 1) | |
9344 | (unless (looking-at org-table-dataline-regexp) | |
9345 | (error "Not at a table data line"))) | |
9346 | (unless have-col | |
9347 | (org-table-goto-column 1) | |
9348 | (org-table-insert-column) | |
9349 | (org-table-goto-column (1+ col))) | |
9350 | (setq epos (point-at-eol)) | |
9351 | (save-excursion | |
9352 | (beginning-of-line 1) | |
9353 | (org-table-get-field | |
9354 | 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") | |
9355 | (concat " " | |
9356 | (setq new (or forcenew | |
9357 | (cadr (member (match-string 1) marks)))) | |
9358 | " ") | |
9359 | " # "))) | |
9360 | (if (and l1 l2) | |
9361 | (progn | |
9362 | (goto-line l1) | |
9363 | (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) | |
9364 | (and (looking-at org-table-dataline-regexp) | |
9365 | (org-table-get-field 1 (concat " " new " ")))) | |
9366 | (goto-line l1))) | |
9367 | (if (not (= epos (point-at-eol))) (org-table-align)) | |
9368 | (goto-line l) | |
274f1353 DK |
9369 | (and (interactive-p) |
9370 | (message "%s" (or (cdr (assoc new org-recalc-marks)) ""))))) | |
891f4676 | 9371 | |
d3f4dbe8 CD |
9372 | (defun org-table-maybe-recalculate-line () |
9373 | "Recompute the current line if marked for it, and if we haven't just done it." | |
9374 | (interactive) | |
9375 | (and org-table-allow-automatic-line-recalculation | |
9376 | (not (and (memq last-command org-recalc-commands) | |
9377 | (equal org-last-recalc-line (org-current-line)))) | |
9378 | (save-excursion (beginning-of-line 1) | |
9379 | (looking-at org-table-auto-recalculate-regexp)) | |
9380 | (org-table-recalculate) t)) | |
891f4676 | 9381 | |
d3f4dbe8 CD |
9382 | (defvar org-table-formula-debug nil |
9383 | "Non-nil means, debug table formulas. | |
9384 | When nil, simply write \"#ERROR\" in corrupted fields.") | |
9385 | (make-variable-buffer-local 'org-table-formula-debug) | |
891f4676 | 9386 | |
d3f4dbe8 CD |
9387 | (defvar modes) |
9388 | (defsubst org-set-calc-mode (var &optional value) | |
9389 | (if (stringp var) | |
9390 | (setq var (assoc var '(("D" calc-angle-mode deg) | |
9391 | ("R" calc-angle-mode rad) | |
9392 | ("F" calc-prefer-frac t) | |
9393 | ("S" calc-symbolic-mode t))) | |
9394 | value (nth 2 var) var (nth 1 var))) | |
9395 | (if (memq var modes) | |
9396 | (setcar (cdr (memq var modes)) value) | |
9397 | (cons var (cons value modes))) | |
9398 | modes) | |
891f4676 | 9399 | |
d3f4dbe8 CD |
9400 | (defun org-table-eval-formula (&optional arg equation |
9401 | suppress-align suppress-const | |
9402 | suppress-store suppress-analysis) | |
9403 | "Replace the table field value at the cursor by the result of a calculation. | |
3278a016 | 9404 | |
d3f4dbe8 CD |
9405 | This function makes use of Dave Gillespie's Calc package, in my view the |
9406 | most exciting program ever written for GNU Emacs. So you need to have Calc | |
9407 | installed in order to use this function. | |
4da1a99d | 9408 | |
d3f4dbe8 CD |
9409 | In a table, this command replaces the value in the current field with the |
9410 | result of a formula. It also installs the formula as the \"current\" column | |
9411 | formula, by storing it in a special line below the table. When called | |
9412 | with a `C-u' prefix, the current field must ba a named field, and the | |
9413 | formula is installed as valid in only this specific field. | |
d924f2e5 | 9414 | |
d3f4dbe8 CD |
9415 | When called with two `C-u' prefixes, insert the active equation |
9416 | for the field back into the current field, so that it can be | |
a3fbe8c4 | 9417 | edited there. This is useful in order to use \\[org-table-show-reference] |
d3f4dbe8 | 9418 | to check the referenced fields. |
3278a016 | 9419 | |
d3f4dbe8 CD |
9420 | When called, the command first prompts for a formula, which is read in |
9421 | the minibuffer. Previously entered formulas are available through the | |
9422 | history list, and the last used formula is offered as a default. | |
9423 | These stored formulas are adapted correctly when moving, inserting, or | |
9424 | deleting columns with the corresponding commands. | |
4da1a99d | 9425 | |
d3f4dbe8 CD |
9426 | The formula can be any algebraic expression understood by the Calc package. |
9427 | For details, see the Org-mode manual. | |
3278a016 | 9428 | |
d3f4dbe8 CD |
9429 | This function can also be called from Lisp programs and offers |
9430 | additional arguments: EQUATION can be the formula to apply. If this | |
9431 | argument is given, the user will not be prompted. SUPPRESS-ALIGN is | |
9432 | used to speed-up recursive calls by by-passing unnecessary aligns. | |
9433 | SUPPRESS-CONST suppresses the interpretation of constants in the | |
9434 | formula, assuming that this has been done already outside the function. | |
9435 | SUPPRESS-STORE means the formula should not be stored, either because | |
9436 | it is already stored, or because it is a modified equation that should | |
9437 | not overwrite the stored one." | |
9438 | (interactive "P") | |
9439 | (org-table-check-inside-data-field) | |
9440 | (or suppress-analysis (org-table-get-specials)) | |
9441 | (if (equal arg '(16)) | |
9442 | (let ((eq (org-table-current-field-formula))) | |
9443 | (or eq (error "No equation active for current field")) | |
9444 | (org-table-get-field nil eq) | |
9445 | (org-table-align) | |
9446 | (setq org-table-may-need-update t)) | |
9447 | (let* (fields | |
9448 | (ndown (if (integerp arg) arg 1)) | |
9449 | (org-table-automatic-realign nil) | |
9450 | (case-fold-search nil) | |
9451 | (down (> ndown 1)) | |
9452 | (formula (if (and equation suppress-store) | |
9453 | equation | |
9454 | (org-table-get-formula equation (equal arg '(4))))) | |
9455 | (n0 (org-table-current-column)) | |
9456 | (modes (copy-sequence org-calc-default-modes)) | |
9457 | (numbers nil) ; was a variable, now fixed default | |
9458 | (keep-empty nil) | |
b38c6895 | 9459 | n form form0 bw fmt x ev orig c lispp literal) |
d3f4dbe8 CD |
9460 | ;; Parse the format string. Since we have a lot of modes, this is |
9461 | ;; a lot of work. However, I think calc still uses most of the time. | |
9462 | (if (string-match ";" formula) | |
9463 | (let ((tmp (org-split-string formula ";"))) | |
9464 | (setq formula (car tmp) | |
9465 | fmt (concat (cdr (assoc "%" org-table-local-parameters)) | |
9466 | (nth 1 tmp))) | |
9467 | (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) | |
9468 | (setq c (string-to-char (match-string 1 fmt)) | |
9469 | n (string-to-number (match-string 2 fmt))) | |
9470 | (if (= c ?p) | |
9471 | (setq modes (org-set-calc-mode 'calc-internal-prec n)) | |
9472 | (setq modes (org-set-calc-mode | |
9473 | 'calc-float-format | |
9474 | (list (cdr (assoc c '((?n . float) (?f . fix) | |
9475 | (?s . sci) (?e . eng)))) | |
9476 | n)))) | |
9477 | (setq fmt (replace-match "" t t fmt))) | |
9478 | (if (string-match "[NT]" fmt) | |
5152b597 CD |
9479 | (setq numbers (equal (match-string 0 fmt) "N") |
9480 | fmt (replace-match "" t t fmt))) | |
b38c6895 CD |
9481 | (if (string-match "L" fmt) |
9482 | (setq literal t | |
d3f4dbe8 CD |
9483 | fmt (replace-match "" t t fmt))) |
9484 | (if (string-match "E" fmt) | |
9485 | (setq keep-empty t | |
9486 | fmt (replace-match "" t t fmt))) | |
9487 | (while (string-match "[DRFS]" fmt) | |
9488 | (setq modes (org-set-calc-mode (match-string 0 fmt))) | |
9489 | (setq fmt (replace-match "" t t fmt))) | |
9490 | (unless (string-match "\\S-" fmt) | |
9491 | (setq fmt nil)))) | |
9492 | (if (and (not suppress-const) org-table-formula-use-constants) | |
9493 | (setq formula (org-table-formula-substitute-names formula))) | |
9494 | (setq orig (or (get-text-property 1 :orig-formula formula) "?")) | |
9495 | (while (> ndown 0) | |
9496 | (setq fields (org-split-string | |
9497 | (org-no-properties | |
9498 | (buffer-substring (point-at-bol) (point-at-eol))) | |
9499 | " *| *")) | |
b38c6895 | 9500 | (if (eq numbers t) |
d3f4dbe8 CD |
9501 | (setq fields (mapcar |
9502 | (lambda (x) (number-to-string (string-to-number x))) | |
9503 | fields))) | |
9504 | (setq ndown (1- ndown)) | |
9505 | (setq form (copy-sequence formula) | |
9506 | lispp (and (> (length form) 2)(equal (substring form 0 2) "'("))) | |
b38c6895 | 9507 | (if (and lispp literal) (setq lispp 'literal)) |
d3f4dbe8 CD |
9508 | ;; Check for old vertical references |
9509 | (setq form (org-rewrite-old-row-references form)) | |
9510 | ;; Insert complex ranges | |
9511 | (while (string-match org-table-range-regexp form) | |
9512 | (setq form | |
a3fbe8c4 | 9513 | (replace-match |
d3f4dbe8 CD |
9514 | (save-match-data |
9515 | (org-table-make-reference | |
9516 | (org-table-get-range (match-string 0 form) nil n0) | |
9517 | keep-empty numbers lispp)) | |
9518 | t t form))) | |
9519 | ;; Insert simple ranges | |
9520 | (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) | |
a3fbe8c4 | 9521 | (setq form |
d3f4dbe8 CD |
9522 | (replace-match |
9523 | (save-match-data | |
9524 | (org-table-make-reference | |
9525 | (org-sublist | |
9526 | fields (string-to-number (match-string 1 form)) | |
9527 | (string-to-number (match-string 2 form))) | |
9528 | keep-empty numbers lispp)) | |
9529 | t t form))) | |
9530 | (setq form0 form) | |
9531 | ;; Insert the references to fields in same row | |
a3fbe8c4 CD |
9532 | (while (string-match "\\$\\([0-9]+\\)" form) |
9533 | (setq n (string-to-number (match-string 1 form)) | |
9534 | x (nth (1- (if (= n 0) n0 n)) fields)) | |
d3f4dbe8 CD |
9535 | (unless x (error "Invalid field specifier \"%s\"" |
9536 | (match-string 0 form))) | |
9537 | (setq form (replace-match | |
9538 | (save-match-data | |
9539 | (org-table-make-reference x nil numbers lispp)) | |
9540 | t t form))) | |
a3fbe8c4 | 9541 | |
d3f4dbe8 CD |
9542 | (if lispp |
9543 | (setq ev (condition-case nil | |
9544 | (eval (eval (read form))) | |
9545 | (error "#ERROR")) | |
9546 | ev (if (numberp ev) (number-to-string ev) ev)) | |
9547 | (or (fboundp 'calc-eval) | |
9548 | (error "Calc does not seem to be installed, and is needed to evaluate the formula")) | |
9549 | (setq ev (calc-eval (cons form modes) | |
9550 | (if numbers 'num)))) | |
a3fbe8c4 | 9551 | |
d3f4dbe8 CD |
9552 | (when org-table-formula-debug |
9553 | (with-output-to-temp-buffer "*Substitution History*" | |
9554 | (princ (format "Substitution history of formula | |
9555 | Orig: %s | |
9556 | $xyz-> %s | |
9557 | @r$c-> %s | |
9558 | $1-> %s\n" orig formula form0 form)) | |
9559 | (if (listp ev) | |
9560 | (princ (format " %s^\nError: %s" | |
9561 | (make-string (car ev) ?\-) (nth 1 ev))) | |
9562 | (princ (format "Result: %s\nFormat: %s\nFinal: %s" | |
9563 | ev (or fmt "NONE") | |
9564 | (if fmt (format fmt (string-to-number ev)) ev))))) | |
9565 | (setq bw (get-buffer-window "*Substitution History*")) | |
9566 | (shrink-window-if-larger-than-buffer bw) | |
9567 | (unless (and (interactive-p) (not ndown)) | |
9568 | (unless (let (inhibit-redisplay) | |
9569 | (y-or-n-p "Debugging Formula. Continue to next? ")) | |
9570 | (org-table-align) | |
9571 | (error "Abort")) | |
9572 | (delete-window bw) | |
9573 | (message ""))) | |
9574 | (if (listp ev) (setq fmt nil ev "#ERROR")) | |
9575 | (org-table-justify-field-maybe | |
9576 | (if fmt (format fmt (string-to-number ev)) ev)) | |
9577 | (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) | |
9578 | (call-interactively 'org-return) | |
9579 | (setq ndown 0))) | |
9580 | (and down (org-table-maybe-recalculate-line)) | |
9581 | (or suppress-align (and org-table-may-need-update | |
9582 | (org-table-align)))))) | |
9583 | ||
38f8646b CD |
9584 | (defun org-table-put-field-property (prop value) |
9585 | (save-excursion | |
9586 | (put-text-property (progn (skip-chars-backward "^|") (point)) | |
9587 | (progn (skip-chars-forward "^|") (point)) | |
9588 | prop value))) | |
9589 | ||
d3f4dbe8 CD |
9590 | (defun org-table-get-range (desc &optional tbeg col highlight) |
9591 | "Get a calc vector from a column, accorting to descriptor DESC. | |
9592 | Optional arguments TBEG and COL can give the beginning of the table and | |
9593 | the current column, to avoid unnecessary parsing. | |
9594 | HIGHLIGHT means, just highlight the range." | |
9595 | (if (not (equal (string-to-char desc) ?@)) | |
9596 | (setq desc (concat "@" desc))) | |
9597 | (save-excursion | |
9598 | (or tbeg (setq tbeg (org-table-begin))) | |
9599 | (or col (setq col (org-table-current-column))) | |
9600 | (let ((thisline (org-current-line)) | |
9601 | beg end c1 c2 r1 r2 rangep tmp) | |
9602 | (unless (string-match org-table-range-regexp desc) | |
9603 | (error "Invalid table range specifier `%s'" desc)) | |
9604 | (setq rangep (match-end 3) | |
9605 | r1 (and (match-end 1) (match-string 1 desc)) | |
9606 | r2 (and (match-end 4) (match-string 4 desc)) | |
9607 | c1 (and (match-end 2) (substring (match-string 2 desc) 1)) | |
9608 | c2 (and (match-end 5) (substring (match-string 5 desc) 1))) | |
9609 | ||
9610 | (and c1 (setq c1 (+ (string-to-number c1) | |
9611 | (if (memq (string-to-char c1) '(?- ?+)) col 0)))) | |
9612 | (and c2 (setq c2 (+ (string-to-number c2) | |
9613 | (if (memq (string-to-char c2) '(?- ?+)) col 0)))) | |
9614 | (if (equal r1 "") (setq r1 nil)) | |
9615 | (if (equal r2 "") (setq r2 nil)) | |
9616 | (if r1 (setq r1 (org-table-get-descriptor-line r1))) | |
9617 | (if r2 (setq r2 (org-table-get-descriptor-line r2))) | |
9618 | ; (setq r2 (or r2 r1) c2 (or c2 c1)) | |
9619 | (if (not r1) (setq r1 thisline)) | |
9620 | (if (not r2) (setq r2 thisline)) | |
9621 | (if (not c1) (setq c1 col)) | |
9622 | (if (not c2) (setq c2 col)) | |
9623 | (if (or (not rangep) (and (= r1 r2) (= c1 c2))) | |
9624 | ;; just one field | |
9625 | (progn | |
9626 | (goto-line r1) | |
9627 | (while (not (looking-at org-table-dataline-regexp)) | |
9628 | (beginning-of-line 2)) | |
1e8fbb6d | 9629 | (prog1 (org-trim (org-table-get-field c1)) |
d3f4dbe8 CD |
9630 | (if highlight (org-table-highlight-rectangle (point) (point))))) |
9631 | ;; A range, return a vector | |
9632 | ;; First sort the numbers to get a regular ractangle | |
9633 | (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) | |
9634 | (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) | |
9635 | (goto-line r1) | |
9636 | (while (not (looking-at org-table-dataline-regexp)) | |
9637 | (beginning-of-line 2)) | |
9638 | (org-table-goto-column c1) | |
9639 | (setq beg (point)) | |
9640 | (goto-line r2) | |
9641 | (while (not (looking-at org-table-dataline-regexp)) | |
9642 | (beginning-of-line 0)) | |
9643 | (org-table-goto-column c2) | |
9644 | (setq end (point)) | |
9645 | (if highlight | |
9646 | (org-table-highlight-rectangle | |
9647 | beg (progn (skip-chars-forward "^|\n") (point)))) | |
9648 | ;; return string representation of calc vector | |
1e8fbb6d CD |
9649 | (mapcar 'org-trim |
9650 | (apply 'append (org-table-copy-region beg end))))))) | |
d3f4dbe8 CD |
9651 | |
9652 | (defun org-table-get-descriptor-line (desc &optional cline bline table) | |
9653 | "Analyze descriptor DESC and retrieve the corresponding line number. | |
9654 | The cursor is currently in line CLINE, the table begins in line BLINE, | |
9655 | and TABLE is a vector with line types." | |
9656 | (if (string-match "^[0-9]+$" desc) | |
9657 | (aref org-table-dlines (string-to-number desc)) | |
9658 | (setq cline (or cline (org-current-line)) | |
9659 | bline (or bline org-table-current-begin-line) | |
9660 | table (or table org-table-current-line-types)) | |
9661 | (if (or | |
9662 | (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc)) | |
9663 | ;; 1 2 3 4 5 6 | |
9664 | (and (not (match-end 3)) (not (match-end 6))) | |
9665 | (and (match-end 3) (match-end 6) (not (match-end 5)))) | |
9666 | (error "invalid row descriptor `%s'" desc)) | |
9667 | (let* ((hdir (and (match-end 2) (match-string 2 desc))) | |
9668 | (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) | |
9669 | (odir (and (match-end 5) (match-string 5 desc))) | |
9670 | (on (if (match-end 6) (string-to-number (match-string 6 desc)))) | |
9671 | (i (- cline bline)) | |
9672 | (rel (and (match-end 6) | |
9673 | (or (and (match-end 1) (not (match-end 3))) | |
9674 | (match-end 5))))) | |
9675 | (if (and hn (not hdir)) | |
9676 | (progn | |
9677 | (setq i 0 hdir "+") | |
9678 | (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) | |
9679 | (if (and (not hn) on (not odir)) | |
a3fbe8c4 | 9680 | (error "should never happen");;(aref org-table-dlines on) |
d3f4dbe8 CD |
9681 | (if (and hn (> hn 0)) |
9682 | (setq i (org-find-row-type table i 'hline (equal hdir "-") nil hn))) | |
9683 | (if on | |
9684 | (setq i (org-find-row-type table i 'dline (equal odir "-") rel on))) | |
9685 | (+ bline i))))) | |
9686 | ||
9687 | (defun org-find-row-type (table i type backwards relative n) | |
9688 | (let ((l (length table))) | |
9689 | (while (> n 0) | |
9690 | (while (and (setq i (+ i (if backwards -1 1))) | |
9691 | (>= i 0) (< i l) | |
9692 | (not (eq (aref table i) type)) | |
9693 | (if (and relative (eq (aref table i) 'hline)) | |
9694 | (progn (setq i (- i (if backwards -1 1)) n 1) nil) | |
9695 | t))) | |
9696 | (setq n (1- n))) | |
9697 | (if (or (< i 0) (>= i l)) | |
9698 | (error "Row descriptior leads outside table") | |
9699 | i))) | |
9700 | ||
9701 | (defun org-rewrite-old-row-references (s) | |
9702 | (if (string-match "&[-+0-9I]" s) | |
9703 | (error "Formula contains old &row reference, please rewrite using @-syntax") | |
9704 | s)) | |
3278a016 | 9705 | |
d3f4dbe8 CD |
9706 | (defun org-table-make-reference (elements keep-empty numbers lispp) |
9707 | "Convert list ELEMENTS to something appropriate to insert into formula. | |
9708 | KEEP-EMPTY indicated to keep empty fields, default is to skip them. | |
9709 | NUMBERS indicates that everything should be converted to numbers. | |
9710 | LISPP means to return something appropriate for a Lisp list." | |
9711 | (if (stringp elements) ; just a single val | |
9712 | (if lispp | |
b38c6895 CD |
9713 | (if (eq lispp 'literal) |
9714 | elements | |
9715 | (prin1-to-string (if numbers (string-to-number elements) elements))) | |
d3f4dbe8 CD |
9716 | (if (equal elements "") (setq elements "0")) |
9717 | (if numbers (number-to-string (string-to-number elements)) elements)) | |
9718 | (unless keep-empty | |
9719 | (setq elements | |
9720 | (delq nil | |
9721 | (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) | |
9722 | elements)))) | |
9723 | (setq elements (or elements '("0"))) | |
9724 | (if lispp | |
b38c6895 CD |
9725 | (mapconcat |
9726 | (lambda (x) | |
9727 | (if (eq lispp 'literal) | |
9728 | x | |
9729 | (prin1-to-string (if numbers (string-to-number x) x)))) | |
48aaad2d | 9730 | elements " ") |
d3f4dbe8 CD |
9731 | (concat "[" (mapconcat |
9732 | (lambda (x) | |
9733 | (if numbers (number-to-string (string-to-number x)) x)) | |
9734 | elements | |
9735 | ",") "]")))) | |
3278a016 | 9736 | |
d3f4dbe8 CD |
9737 | (defun org-table-recalculate (&optional all noalign) |
9738 | "Recalculate the current table line by applying all stored formulas. | |
9739 | With prefix arg ALL, do this for all lines in the table." | |
9740 | (interactive "P") | |
9741 | (or (memq this-command org-recalc-commands) | |
9742 | (setq org-recalc-commands (cons this-command org-recalc-commands))) | |
9743 | (unless (org-at-table-p) (error "Not at a table")) | |
9744 | (if (equal all '(16)) | |
9745 | (org-table-iterate) | |
9746 | (org-table-get-specials) | |
9747 | (let* ((eqlist (sort (org-table-get-stored-formulas) | |
9748 | (lambda (a b) (string< (car a) (car b))))) | |
9749 | (inhibit-redisplay (not debug-on-error)) | |
9750 | (line-re org-table-dataline-regexp) | |
9751 | (thisline (org-current-line)) | |
9752 | (thiscol (org-table-current-column)) | |
38f8646b | 9753 | beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name) |
d3f4dbe8 CD |
9754 | ;; Insert constants in all formulas |
9755 | (setq eqlist | |
9756 | (mapcar (lambda (x) | |
9757 | (setcdr x (org-table-formula-substitute-names (cdr x))) | |
9758 | x) | |
9759 | eqlist)) | |
9760 | ;; Split the equation list | |
9761 | (while (setq eq (pop eqlist)) | |
9762 | (if (<= (string-to-char (car eq)) ?9) | |
9763 | (push eq eqlnum) | |
9764 | (push eq eqlname))) | |
9765 | (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) | |
9766 | (if all | |
9767 | (progn | |
9768 | (setq end (move-marker (make-marker) (1+ (org-table-end)))) | |
9769 | (goto-char (setq beg (org-table-begin))) | |
9770 | (if (re-search-forward org-table-calculate-mark-regexp end t) | |
9771 | ;; This is a table with marked lines, compute selected lines | |
9772 | (setq line-re org-table-recalculate-regexp) | |
9773 | ;; Move forward to the first non-header line | |
9774 | (if (and (re-search-forward org-table-dataline-regexp end t) | |
9775 | (re-search-forward org-table-hline-regexp end t) | |
9776 | (re-search-forward org-table-dataline-regexp end t)) | |
9777 | (setq beg (match-beginning 0)) | |
9778 | nil))) ;; just leave beg where it is | |
9779 | (setq beg (point-at-bol) | |
9780 | end (move-marker (make-marker) (1+ (point-at-eol))))) | |
9781 | (goto-char beg) | |
9782 | (and all (message "Re-applying formulas to full table...")) | |
38f8646b CD |
9783 | |
9784 | ;; First find the named fields, and mark them untouchanble | |
9785 | (remove-text-properties beg end '(org-untouchable t)) | |
9786 | (while (setq eq (pop eqlname)) | |
9787 | (setq name (car eq) | |
9788 | a (assoc name org-table-named-field-locations)) | |
9789 | (and (not a) | |
9790 | (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) | |
9791 | (setq a (list name | |
9792 | (aref org-table-dlines | |
9793 | (string-to-number (match-string 1 name))) | |
9794 | (string-to-number (match-string 2 name))))) | |
9795 | (when (and a (or all (equal (nth 1 a) thisline))) | |
9796 | (message "Re-applying formula to field: %s" name) | |
9797 | (goto-line (nth 1 a)) | |
9798 | (org-table-goto-column (nth 2 a)) | |
9799 | (push (append a (list (cdr eq))) eqlname1) | |
38f8646b CD |
9800 | (org-table-put-field-property :org-untouchable t))) |
9801 | ||
9802 | ;; Now evauluate the column formulas, but skip fields covered by | |
9803 | ;; field formulas | |
9804 | (goto-char beg) | |
d3f4dbe8 | 9805 | (while (re-search-forward line-re end t) |
a3fbe8c4 | 9806 | (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) |
d3f4dbe8 CD |
9807 | ;; Unprotected line, recalculate |
9808 | (and all (message "Re-applying formulas to full table...(line %d)" | |
9809 | (setq cnt (1+ cnt)))) | |
9810 | (setq org-last-recalc-line (org-current-line)) | |
9811 | (setq eql eqlnum) | |
9812 | (while (setq entry (pop eql)) | |
9813 | (goto-line org-last-recalc-line) | |
9814 | (org-table-goto-column (string-to-number (car entry)) nil 'force) | |
38f8646b CD |
9815 | (unless (get-text-property (point) :org-untouchable) |
9816 | (org-table-eval-formula nil (cdr entry) | |
9817 | 'noalign 'nocst 'nostore 'noanalysis))))) | |
9818 | ||
9819 | ;; Now evaluate the field formulas | |
9820 | (while (setq eq (pop eqlname1)) | |
9821 | (message "Re-applying formula to field: %s" (car eq)) | |
9822 | (goto-line (nth 1 eq)) | |
9823 | (org-table-goto-column (nth 2 eq)) | |
9824 | (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst | |
9825 | 'nostore 'noanalysis)) | |
9826 | ||
d3f4dbe8 CD |
9827 | (goto-line thisline) |
9828 | (org-table-goto-column thiscol) | |
38f8646b | 9829 | (remove-text-properties (point-min) (point-max) '(org-untouchable t)) |
d3f4dbe8 CD |
9830 | (or noalign (and org-table-may-need-update (org-table-align)) |
9831 | (and all (message "Re-applying formulas to %d lines...done" cnt))) | |
38f8646b | 9832 | |
d3f4dbe8 CD |
9833 | ;; back to initial position |
9834 | (message "Re-applying formulas...done") | |
9835 | (goto-line thisline) | |
9836 | (org-table-goto-column thiscol) | |
9837 | (or noalign (and org-table-may-need-update (org-table-align)) | |
9838 | (and all (message "Re-applying formulas...done")))))) | |
a3fbe8c4 | 9839 | |
d3f4dbe8 CD |
9840 | (defun org-table-iterate (&optional arg) |
9841 | "Recalculate the table until it does not change anymore." | |
9842 | (interactive "P") | |
9843 | (let ((imax (if arg (prefix-numeric-value arg) 10)) | |
a3fbe8c4 | 9844 | (i 0) |
d3f4dbe8 CD |
9845 | (lasttbl (buffer-substring (org-table-begin) (org-table-end))) |
9846 | thistbl) | |
9847 | (catch 'exit | |
9848 | (while (< i imax) | |
9849 | (setq i (1+ i)) | |
9850 | (org-table-recalculate 'all) | |
9851 | (setq thistbl (buffer-substring (org-table-begin) (org-table-end))) | |
9852 | (if (not (string= lasttbl thistbl)) | |
9853 | (setq lasttbl thistbl) | |
9854 | (if (> i 1) | |
9855 | (message "Convergence after %d iterations" i) | |
9856 | (message "Table was already stable")) | |
9857 | (throw 'exit t))) | |
9858 | (error "No convergence after %d iterations" i)))) | |
04d18304 | 9859 | |
d3f4dbe8 CD |
9860 | (defun org-table-formula-substitute-names (f) |
9861 | "Replace $const with values in string F." | |
03f3cf35 | 9862 | (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) |
d3f4dbe8 CD |
9863 | ;; First, check for column names |
9864 | (while (setq start (string-match org-table-column-name-regexp f start)) | |
9865 | (setq start (1+ start)) | |
9866 | (setq a (assoc (match-string 1 f) org-table-column-names)) | |
9867 | (setq f (replace-match (concat "$" (cdr a)) t t f))) | |
9868 | ;; Parameters and constants | |
9869 | (setq start 0) | |
38f8646b | 9870 | (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)" f start)) |
d3f4dbe8 CD |
9871 | (setq start (1+ start)) |
9872 | (if (setq a (save-match-data | |
9873 | (org-table-get-constant (match-string 1 f)))) | |
03f3cf35 JW |
9874 | (setq f (replace-match |
9875 | (concat (if pp "(") a (if pp ")")) t t f)))) | |
d3f4dbe8 CD |
9876 | (if org-table-formula-debug |
9877 | (put-text-property 0 (length f) :orig-formula f1 f)) | |
9878 | f)) | |
4da1a99d | 9879 | |
d3f4dbe8 CD |
9880 | (defun org-table-get-constant (const) |
9881 | "Find the value for a parameter or constant in a formula. | |
9882 | Parameters get priority." | |
9883 | (or (cdr (assoc const org-table-local-parameters)) | |
38f8646b | 9884 | (cdr (assoc const org-table-formula-constants-local)) |
d3f4dbe8 CD |
9885 | (cdr (assoc const org-table-formula-constants)) |
9886 | (and (fboundp 'constants-get) (constants-get const)) | |
38f8646b CD |
9887 | (and (string= (substring const 0 (min 5 (length const))) "PROP_") |
9888 | (org-entry-get nil (substring const 5) 'inherit)) | |
d3f4dbe8 | 9889 | "#UNDEFINED_NAME")) |
ab27a4a0 | 9890 | |
48aaad2d CD |
9891 | (defvar org-table-fedit-map |
9892 | (let ((map (make-sparse-keymap))) | |
9893 | (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) | |
9894 | (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) | |
9895 | (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) | |
9896 | (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) | |
9897 | (org-defkey map "\C-c?" 'org-table-show-reference) | |
9898 | (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) | |
9899 | (org-defkey map [(meta shift down)] 'org-table-fedit-line-down) | |
9900 | (org-defkey map [(shift up)] 'org-table-fedit-ref-up) | |
9901 | (org-defkey map [(shift down)] 'org-table-fedit-ref-down) | |
9902 | (org-defkey map [(shift left)] 'org-table-fedit-ref-left) | |
9903 | (org-defkey map [(shift right)] 'org-table-fedit-ref-right) | |
9904 | (org-defkey map [(meta up)] 'org-table-fedit-scroll-down) | |
9905 | (org-defkey map [(meta down)] 'org-table-fedit-scroll) | |
9906 | (org-defkey map [(meta tab)] 'lisp-complete-symbol) | |
9907 | (org-defkey map "\M-\C-i" 'lisp-complete-symbol) | |
9908 | (org-defkey map [(tab)] 'org-table-fedit-lisp-indent) | |
9909 | (org-defkey map "\C-i" 'org-table-fedit-lisp-indent) | |
9910 | (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) | |
9911 | (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) | |
9912 | map)) | |
a3fbe8c4 CD |
9913 | |
9914 | (easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" | |
9915 | '("Edit-Formulas" | |
9916 | ["Finish and Install" org-table-fedit-finish t] | |
9917 | ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] | |
9918 | ["Abort" org-table-fedit-abort t] | |
9919 | "--" | |
9920 | ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t] | |
9921 | ["Complete Lisp Symbol" lisp-complete-symbol t] | |
9922 | "--" | |
9923 | "Shift Reference at Point" | |
9924 | ["Up" org-table-fedit-ref-up t] | |
9925 | ["Down" org-table-fedit-ref-down t] | |
9926 | ["Left" org-table-fedit-ref-left t] | |
9927 | ["Right" org-table-fedit-ref-right t] | |
9928 | "-" | |
9929 | "Change Test Row for Column Formulas" | |
9930 | ["Up" org-table-fedit-line-up t] | |
9931 | ["Down" org-table-fedit-line-down t] | |
9932 | "--" | |
9933 | ["Scroll Table Window" org-table-fedit-scroll t] | |
9934 | ["Scroll Table Window down" org-table-fedit-scroll-down t] | |
9935 | ["Show Table Grid" org-table-fedit-toggle-coordinates | |
9936 | :style toggle :selected (with-current-buffer (marker-buffer org-pos) | |
9937 | org-table-overlay-coordinates)] | |
9938 | "--" | |
9939 | ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type | |
9940 | :style toggle :selected org-table-buffer-is-an])) | |
ab27a4a0 | 9941 | |
d3f4dbe8 | 9942 | (defvar org-pos) |
ab27a4a0 | 9943 | |
d3f4dbe8 CD |
9944 | (defun org-table-edit-formulas () |
9945 | "Edit the formulas of the current table in a separate buffer." | |
9946 | (interactive) | |
a3fbe8c4 CD |
9947 | (when (save-excursion (beginning-of-line 1) (looking-at "#\\+TBLFM")) |
9948 | (beginning-of-line 0)) | |
d3f4dbe8 CD |
9949 | (unless (org-at-table-p) (error "Not at a table")) |
9950 | (org-table-get-specials) | |
a3fbe8c4 CD |
9951 | (let ((key (org-table-current-field-formula 'key 'noerror)) |
9952 | (eql (sort (org-table-get-stored-formulas 'noerror) | |
9953 | 'org-table-formula-less-p)) | |
d3f4dbe8 | 9954 | (pos (move-marker (make-marker) (point))) |
a3fbe8c4 | 9955 | (startline 1) |
d3f4dbe8 | 9956 | (wc (current-window-configuration)) |
a3fbe8c4 CD |
9957 | (titles '((column . "# Column Formulas\n") |
9958 | (field . "# Field Formulas\n") | |
9959 | (named . "# Named Field Formulas\n"))) | |
9960 | entry s type title) | |
374585c9 | 9961 | (org-switch-to-buffer-other-window "*Edit Formulas*") |
d3f4dbe8 | 9962 | (erase-buffer) |
28a419dd CD |
9963 | ;; Keep global-font-lock-mode from turning on font-lock-mode |
9964 | (let ((font-lock-global-modes '(not fundamental-mode))) | |
9965 | (fundamental-mode)) | |
9966 | (org-set-local 'font-lock-global-modes (list 'not major-mode)) | |
d3f4dbe8 CD |
9967 | (org-set-local 'org-pos pos) |
9968 | (org-set-local 'org-window-configuration wc) | |
a3fbe8c4 CD |
9969 | (use-local-map org-table-fedit-map) |
9970 | (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t) | |
9971 | (easy-menu-add org-table-fedit-menu) | |
9972 | (setq startline (org-current-line)) | |
d3f4dbe8 | 9973 | (while (setq entry (pop eql)) |
a3fbe8c4 CD |
9974 | (setq type (cond |
9975 | ((equal (string-to-char (car entry)) ?@) 'field) | |
9976 | ((string-match "^[0-9]" (car entry)) 'column) | |
9977 | (t 'named))) | |
9978 | (when (setq title (assq type titles)) | |
9979 | (or (bobp) (insert "\n")) | |
9980 | (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) | |
9981 | (setq titles (delq title titles))) | |
9982 | (if (equal key (car entry)) (setq startline (org-current-line))) | |
d3f4dbe8 CD |
9983 | (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$") |
9984 | (car entry) " = " (cdr entry) "\n")) | |
9985 | (remove-text-properties 0 (length s) '(face nil) s) | |
9986 | (insert s)) | |
a3fbe8c4 CD |
9987 | (if (eq org-table-use-standard-references t) |
9988 | (org-table-fedit-toggle-ref-type)) | |
9989 | (goto-line startline) | |
9990 | (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) | |
4da1a99d | 9991 | |
a3fbe8c4 | 9992 | (defun org-table-fedit-post-command () |
d3f4dbe8 CD |
9993 | (when (not (memq this-command '(lisp-complete-symbol))) |
9994 | (let ((win (selected-window))) | |
9995 | (save-excursion | |
9996 | (condition-case nil | |
a3fbe8c4 | 9997 | (org-table-show-reference) |
d3f4dbe8 CD |
9998 | (error nil)) |
9999 | (select-window win))))) | |
891f4676 | 10000 | |
a3fbe8c4 CD |
10001 | (defun org-table-formula-to-user (s) |
10002 | "Convert a formula from internal to user representation." | |
10003 | (if (eq org-table-use-standard-references t) | |
10004 | (org-table-convert-refs-to-an s) | |
10005 | s)) | |
10006 | ||
10007 | (defun org-table-formula-from-user (s) | |
10008 | "Convert a formula from user to internal representation." | |
10009 | (if org-table-use-standard-references | |
10010 | (org-table-convert-refs-to-rc s) | |
10011 | s)) | |
10012 | ||
10013 | (defun org-table-convert-refs-to-rc (s) | |
10014 | "Convert spreadsheet references from AB7 to @7$28. | |
10015 | Works for single references, but also for entire formulas and even the | |
10016 | full TBLFM line." | |
10017 | (let ((start 0)) | |
10018 | (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\)" s start) | |
10019 | (cond | |
10020 | ((match-end 3) | |
10021 | ;; format match, just advance | |
10022 | (setq start (match-end 0))) | |
10023 | ((and (> (match-beginning 0) 0) | |
48aaad2d CD |
10024 | (equal ?. (aref s (max (1- (match-beginning 0)) 0))) |
10025 | (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) | |
15841868 | 10026 | ;; 3.e5 or something like this. |
a3fbe8c4 CD |
10027 | (setq start (match-end 0))) |
10028 | (t | |
10029 | (setq start (match-beginning 0) | |
10030 | s (replace-match | |
10031 | (if (equal (match-string 2 s) "&") | |
10032 | (format "$%d" (org-letters-to-number (match-string 1 s))) | |
10033 | (format "@%d$%d" | |
10034 | (string-to-number (match-string 2 s)) | |
10035 | (org-letters-to-number (match-string 1 s)))) | |
10036 | t t s))))) | |
10037 | s)) | |
10038 | ||
10039 | (defun org-table-convert-refs-to-an (s) | |
10040 | "Convert spreadsheet references from to @7$28 to AB7. | |
10041 | Works for single references, but also for entire formulas and even the | |
10042 | full TBLFM line." | |
48aaad2d | 10043 | (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s) |
a3fbe8c4 CD |
10044 | (setq s (replace-match |
10045 | (format "%s%d" | |
10046 | (org-number-to-letters | |
10047 | (string-to-number (match-string 2 s))) | |
10048 | (string-to-number (match-string 1 s))) | |
10049 | t t s))) | |
10050 | (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s) | |
10051 | (setq s (replace-match (concat "\\1" | |
10052 | (org-number-to-letters | |
10053 | (string-to-number (match-string 2 s))) "&") | |
10054 | t nil s))) | |
10055 | s) | |
10056 | ||
10057 | (defun org-letters-to-number (s) | |
10058 | "Convert a base 26 number represented by letters into an integer. | |
10059 | For example: AB -> 28." | |
10060 | (let ((n 0)) | |
10061 | (setq s (upcase s)) | |
10062 | (while (> (length s) 0) | |
10063 | (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) | |
10064 | s (substring s 1))) | |
10065 | n)) | |
10066 | ||
10067 | (defun org-number-to-letters (n) | |
10068 | "Convert an integer into a base 26 number represented by letters. | |
10069 | For example: 28 -> AB." | |
10070 | (let ((s "")) | |
10071 | (while (> n 0) | |
10072 | (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s) | |
10073 | n (/ (1- n) 26))) | |
10074 | s)) | |
10075 | ||
10076 | (defun org-table-fedit-convert-buffer (function) | |
10077 | "Convert all references in this buffer, using FUNTION." | |
10078 | (let ((line (org-current-line))) | |
10079 | (goto-char (point-min)) | |
10080 | (while (not (eobp)) | |
10081 | (insert (funcall function (buffer-substring (point) (point-at-eol)))) | |
10082 | (delete-region (point) (point-at-eol)) | |
10083 | (or (eobp) (forward-char 1))) | |
10084 | (goto-line line))) | |
10085 | ||
10086 | (defun org-table-fedit-toggle-ref-type () | |
10087 | "Convert all references in the buffer from B3 to @3$2 and back." | |
10088 | (interactive) | |
10089 | (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) | |
10090 | (org-table-fedit-convert-buffer | |
10091 | (if org-table-buffer-is-an | |
10092 | 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) | |
10093 | (message "Reference type switched to %s" | |
10094 | (if org-table-buffer-is-an "A1 etc" "@row$column"))) | |
10095 | ||
10096 | (defun org-table-fedit-ref-up () | |
10097 | "Shift the reference at point one row/hline up." | |
10098 | (interactive) | |
10099 | (org-table-fedit-shift-reference 'up)) | |
10100 | (defun org-table-fedit-ref-down () | |
10101 | "Shift the reference at point one row/hline down." | |
10102 | (interactive) | |
10103 | (org-table-fedit-shift-reference 'down)) | |
10104 | (defun org-table-fedit-ref-left () | |
10105 | "Shift the reference at point one field to the left." | |
10106 | (interactive) | |
10107 | (org-table-fedit-shift-reference 'left)) | |
10108 | (defun org-table-fedit-ref-right () | |
10109 | "Shift the reference at point one field to the right." | |
10110 | (interactive) | |
10111 | (org-table-fedit-shift-reference 'right)) | |
10112 | ||
10113 | (defun org-table-fedit-shift-reference (dir) | |
10114 | (cond | |
10115 | ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") | |
10116 | (if (memq dir '(left right)) | |
10117 | (org-rematch-and-replace 1 (eq dir 'left)) | |
10118 | (error "Cannot shift reference in this direction"))) | |
10119 | ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") | |
10120 | ;; A B3-like reference | |
10121 | (if (memq dir '(up down)) | |
10122 | (org-rematch-and-replace 2 (eq dir 'up)) | |
10123 | (org-rematch-and-replace 1 (eq dir 'left)))) | |
10124 | ((org-at-regexp-p | |
10125 | "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") | |
10126 | ;; An internal reference | |
10127 | (if (memq dir '(up down)) | |
10128 | (org-rematch-and-replace 2 (eq dir 'up) (match-end 3)) | |
10129 | (org-rematch-and-replace 5 (eq dir 'left)))))) | |
10130 | ||
10131 | (defun org-rematch-and-replace (n &optional decr hline) | |
10132 | "Re-match the group N, and replace it with the shifted refrence." | |
10133 | (or (match-end n) (error "Cannot shift reference in this direction")) | |
10134 | (goto-char (match-beginning n)) | |
10135 | (and (looking-at (regexp-quote (match-string n))) | |
10136 | (replace-match (org-shift-refpart (match-string 0) decr hline) | |
10137 | t t))) | |
10138 | ||
10139 | (defun org-shift-refpart (ref &optional decr hline) | |
10140 | "Shift a refrence part REF. | |
10141 | If DECR is set, decrease the references row/column, else increase. | |
10142 | If HLINE is set, this may be a hline reference, it certainly is not | |
10143 | a translation reference." | |
10144 | (save-match-data | |
10145 | (let* ((sign (string-match "^[-+]" ref)) n) | |
10146 | ||
10147 | (if sign (setq sign (substring ref 0 1) ref (substring ref 1))) | |
10148 | (cond | |
10149 | ((and hline (string-match "^I+" ref)) | |
10150 | (setq n (string-to-number (concat sign (number-to-string (length ref))))) | |
10151 | (setq n (+ n (if decr -1 1))) | |
10152 | (if (= n 0) (setq n (+ n (if decr -1 1)))) | |
10153 | (if sign | |
10154 | (setq sign (if (< n 0) "-" "+") n (abs n)) | |
10155 | (setq n (max 1 n))) | |
10156 | (concat sign (make-string n ?I))) | |
10157 | ||
10158 | ((string-match "^[0-9]+" ref) | |
10159 | (setq n (string-to-number (concat sign ref))) | |
10160 | (setq n (+ n (if decr -1 1))) | |
10161 | (if sign | |
10162 | (concat (if (< n 0) "-" "+") (number-to-string (abs n))) | |
10163 | (number-to-string (max 1 n)))) | |
10164 | ||
10165 | ((string-match "^[a-zA-Z]+" ref) | |
10166 | (org-number-to-letters | |
10167 | (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) | |
10168 | ||
10169 | (t (error "Cannot shift reference")))))) | |
10170 | ||
10171 | (defun org-table-fedit-toggle-coordinates () | |
10172 | "Toggle the display of coordinates in the refrenced table." | |
10173 | (interactive) | |
10174 | (let ((pos (marker-position org-pos))) | |
10175 | (with-current-buffer (marker-buffer org-pos) | |
10176 | (save-excursion | |
10177 | (goto-char pos) | |
10178 | (org-table-toggle-coordinate-overlays))))) | |
10179 | ||
10180 | (defun org-table-fedit-finish (&optional arg) | |
d3f4dbe8 CD |
10181 | "Parse the buffer for formula definitions and install them. |
10182 | With prefix ARG, apply the new formulas to the table." | |
10183 | (interactive "P") | |
10184 | (org-table-remove-rectangle-highlight) | |
a3fbe8c4 CD |
10185 | (if org-table-use-standard-references |
10186 | (progn | |
10187 | (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) | |
10188 | (setq org-table-buffer-is-an nil))) | |
d3f4dbe8 | 10189 | (let ((pos org-pos) eql var form) |
d3f4dbe8 CD |
10190 | (goto-char (point-min)) |
10191 | (while (re-search-forward | |
10192 | "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" | |
10193 | nil t) | |
10194 | (setq var (if (match-end 2) (match-string 2) (match-string 1)) | |
10195 | form (match-string 3)) | |
10196 | (setq form (org-trim form)) | |
a3fbe8c4 CD |
10197 | (when (not (equal form "")) |
10198 | (while (string-match "[ \t]*\n[ \t]*" form) | |
10199 | (setq form (replace-match " " t t form))) | |
10200 | (when (assoc var eql) | |
10201 | (error "Double formulas for %s" var)) | |
10202 | (push (cons var form) eql))) | |
10203 | (setq org-pos nil) | |
d3f4dbe8 CD |
10204 | (set-window-configuration org-window-configuration) |
10205 | (select-window (get-buffer-window (marker-buffer pos))) | |
10206 | (goto-char pos) | |
10207 | (unless (org-at-table-p) | |
10208 | (error "Lost table position - cannot install formulae")) | |
10209 | (org-table-store-formulas eql) | |
10210 | (move-marker pos nil) | |
10211 | (kill-buffer "*Edit Formulas*") | |
10212 | (if arg | |
10213 | (org-table-recalculate 'all) | |
10214 | (message "New formulas installed - press C-u C-c C-c to apply.")))) | |
891f4676 | 10215 | |
a3fbe8c4 | 10216 | (defun org-table-fedit-abort () |
d3f4dbe8 CD |
10217 | "Abort editing formulas, without installing the changes." |
10218 | (interactive) | |
10219 | (org-table-remove-rectangle-highlight) | |
10220 | (let ((pos org-pos)) | |
10221 | (set-window-configuration org-window-configuration) | |
10222 | (select-window (get-buffer-window (marker-buffer pos))) | |
10223 | (goto-char pos) | |
10224 | (move-marker pos nil) | |
10225 | (message "Formula editing aborted without installing changes"))) | |
891f4676 | 10226 | |
a3fbe8c4 | 10227 | (defun org-table-fedit-lisp-indent () |
d3f4dbe8 CD |
10228 | "Pretty-print and re-indent Lisp expressions in the Formula Editor." |
10229 | (interactive) | |
10230 | (let ((pos (point)) beg end ind) | |
10231 | (beginning-of-line 1) | |
10232 | (cond | |
10233 | ((looking-at "[ \t]") | |
10234 | (goto-char pos) | |
10235 | (call-interactively 'lisp-indent-line)) | |
1e8fbb6d | 10236 | ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) |
d3f4dbe8 CD |
10237 | ((not (fboundp 'pp-buffer)) |
10238 | (error "Cannot pretty-print. Command `pp-buffer' is not available.")) | |
1e8fbb6d | 10239 | ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") |
d3f4dbe8 CD |
10240 | (goto-char (- (match-end 0) 2)) |
10241 | (setq beg (point)) | |
10242 | (setq ind (make-string (current-column) ?\ )) | |
10243 | (condition-case nil (forward-sexp 1) | |
10244 | (error | |
10245 | (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) | |
10246 | (setq end (point)) | |
10247 | (save-restriction | |
10248 | (narrow-to-region beg end) | |
10249 | (if (eq last-command this-command) | |
10250 | (progn | |
10251 | (goto-char (point-min)) | |
10252 | (setq this-command nil) | |
10253 | (while (re-search-forward "[ \t]*\n[ \t]*" nil t) | |
10254 | (replace-match " "))) | |
10255 | (pp-buffer) | |
10256 | (untabify (point-min) (point-max)) | |
10257 | (goto-char (1+ (point-min))) | |
10258 | (while (re-search-forward "^." nil t) | |
10259 | (beginning-of-line 1) | |
10260 | (insert ind)) | |
10261 | (goto-char (point-max)) | |
10262 | (backward-delete-char 1))) | |
10263 | (goto-char beg)) | |
10264 | (t nil)))) | |
891f4676 | 10265 | |
d3f4dbe8 | 10266 | (defvar org-show-positions nil) |
891f4676 | 10267 | |
a3fbe8c4 | 10268 | (defun org-table-show-reference (&optional local) |
d3f4dbe8 CD |
10269 | "Show the location/value of the $ expression at point." |
10270 | (interactive) | |
10271 | (org-table-remove-rectangle-highlight) | |
10272 | (catch 'exit | |
10273 | (let ((pos (if local (point) org-pos)) | |
10274 | (face2 'highlight) | |
10275 | (org-inhibit-highlight-removal t) | |
10276 | (win (selected-window)) | |
10277 | (org-show-positions nil) | |
10278 | var name e what match dest) | |
10279 | (if local (org-table-get-specials)) | |
10280 | (setq what (cond | |
a3fbe8c4 CD |
10281 | ((or (org-at-regexp-p org-table-range-regexp2) |
10282 | (org-at-regexp-p org-table-translate-regexp) | |
10283 | (org-at-regexp-p org-table-range-regexp)) | |
10284 | (setq match | |
10285 | (save-match-data | |
10286 | (org-table-convert-refs-to-rc (match-string 0)))) | |
10287 | 'range) | |
d3f4dbe8 CD |
10288 | ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) |
10289 | ((org-at-regexp-p "\\$[0-9]+") 'column) | |
10290 | ((not local) nil) | |
10291 | (t (error "No reference at point"))) | |
a3fbe8c4 | 10292 | match (and what (or match (match-string 0)))) |
d3f4dbe8 CD |
10293 | (when (and match (not (equal (match-beginning 0) (point-at-bol)))) |
10294 | (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) | |
10295 | 'secondary-selection)) | |
10296 | (org-add-hook 'before-change-functions | |
10297 | 'org-table-remove-rectangle-highlight) | |
10298 | (if (eq what 'name) (setq var (substring match 1))) | |
10299 | (when (eq what 'range) | |
10300 | (or (equal (string-to-char match) ?@) (setq match (concat "@" match))) | |
10301 | (setq match (org-table-formula-substitute-names match))) | |
10302 | (unless local | |
10303 | (save-excursion | |
a3fbe8c4 CD |
10304 | (end-of-line 1) |
10305 | (re-search-backward "^\\S-" nil t) | |
d3f4dbe8 | 10306 | (beginning-of-line 1) |
a3fbe8c4 CD |
10307 | (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=") |
10308 | (setq dest | |
10309 | (save-match-data | |
10310 | (org-table-convert-refs-to-rc (match-string 1)))) | |
d3f4dbe8 CD |
10311 | (org-table-add-rectangle-overlay |
10312 | (match-beginning 1) (match-end 1) face2)))) | |
10313 | (if (and (markerp pos) (marker-buffer pos)) | |
10314 | (if (get-buffer-window (marker-buffer pos)) | |
10315 | (select-window (get-buffer-window (marker-buffer pos))) | |
374585c9 | 10316 | (org-switch-to-buffer-other-window (get-buffer-window |
d3f4dbe8 CD |
10317 | (marker-buffer pos))))) |
10318 | (goto-char pos) | |
10319 | (org-table-force-dataline) | |
10320 | (when dest | |
10321 | (setq name (substring dest 1)) | |
10322 | (cond | |
10323 | ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) | |
10324 | (setq e (assoc name org-table-named-field-locations)) | |
10325 | (goto-line (nth 1 e)) | |
10326 | (org-table-goto-column (nth 2 e))) | |
10327 | ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) | |
10328 | (let ((l (string-to-number (match-string 1 dest))) | |
10329 | (c (string-to-number (match-string 2 dest)))) | |
10330 | (goto-line (aref org-table-dlines l)) | |
10331 | (org-table-goto-column c))) | |
10332 | (t (org-table-goto-column (string-to-number name)))) | |
10333 | (move-marker pos (point)) | |
10334 | (org-table-highlight-rectangle nil nil face2)) | |
10335 | (cond | |
10336 | ((equal dest match)) | |
10337 | ((not match)) | |
10338 | ((eq what 'range) | |
10339 | (condition-case nil | |
10340 | (save-excursion | |
10341 | (org-table-get-range match nil nil 'highlight)) | |
10342 | (error nil))) | |
10343 | ((setq e (assoc var org-table-named-field-locations)) | |
10344 | (goto-line (nth 1 e)) | |
10345 | (org-table-goto-column (nth 2 e)) | |
10346 | (org-table-highlight-rectangle (point) (point)) | |
10347 | (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) | |
10348 | ((setq e (assoc var org-table-column-names)) | |
10349 | (org-table-goto-column (string-to-number (cdr e))) | |
10350 | (org-table-highlight-rectangle (point) (point)) | |
10351 | (goto-char (org-table-begin)) | |
10352 | (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") | |
10353 | (org-table-end) t) | |
c4b5acde | 10354 | (progn |
d3f4dbe8 CD |
10355 | (goto-char (match-beginning 1)) |
10356 | (org-table-highlight-rectangle) | |
10357 | (message "Named column (column %s)" (cdr e))) | |
10358 | (error "Column name not found"))) | |
10359 | ((eq what 'column) | |
10360 | ;; column number | |
10361 | (org-table-goto-column (string-to-number (substring match 1))) | |
10362 | (org-table-highlight-rectangle (point) (point)) | |
10363 | (message "Column %s" (substring match 1))) | |
10364 | ((setq e (assoc var org-table-local-parameters)) | |
10365 | (goto-char (org-table-begin)) | |
10366 | (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) | |
c4b5acde | 10367 | (progn |
d3f4dbe8 CD |
10368 | (goto-char (match-beginning 1)) |
10369 | (org-table-highlight-rectangle) | |
10370 | (message "Local parameter.")) | |
10371 | (error "Parameter not found"))) | |
10372 | (t | |
10373 | (cond | |
10374 | ((not var) (error "No reference at point")) | |
38f8646b CD |
10375 | ((setq e (assoc var org-table-formula-constants-local)) |
10376 | (message "Local Constant: $%s=%s in #+CONSTANTS line." | |
10377 | var (cdr e))) | |
d3f4dbe8 CD |
10378 | ((setq e (assoc var org-table-formula-constants)) |
10379 | (message "Constant: $%s=%s in `org-table-formula-constants'." | |
10380 | var (cdr e))) | |
10381 | ((setq e (and (fboundp 'constants-get) (constants-get var))) | |
a3fbe8c4 CD |
10382 | (message "Constant: $%s=%s, from `constants.el'%s." |
10383 | var e (format " (%s units)" constants-unit-system))) | |
d3f4dbe8 CD |
10384 | (t (error "Undefined name $%s" var))))) |
10385 | (goto-char pos) | |
a3fbe8c4 CD |
10386 | (when (and org-show-positions |
10387 | (not (memq this-command '(org-table-fedit-scroll | |
10388 | org-table-fedit-scroll-down)))) | |
d3f4dbe8 | 10389 | (push pos org-show-positions) |
a3fbe8c4 | 10390 | (push org-table-current-begin-pos org-show-positions) |
d3f4dbe8 CD |
10391 | (let ((min (apply 'min org-show-positions)) |
10392 | (max (apply 'max org-show-positions))) | |
a3fbe8c4 CD |
10393 | (goto-char min) (recenter 0) |
10394 | (goto-char max) | |
10395 | (or (pos-visible-in-window-p max) (recenter -1)))) | |
d3f4dbe8 | 10396 | (select-window win)))) |
891f4676 | 10397 | |
d3f4dbe8 CD |
10398 | (defun org-table-force-dataline () |
10399 | "Make sure the cursor is in a dataline in a table." | |
10400 | (unless (save-excursion | |
10401 | (beginning-of-line 1) | |
10402 | (looking-at org-table-dataline-regexp)) | |
10403 | (let* ((re org-table-dataline-regexp) | |
10404 | (p1 (save-excursion (re-search-forward re nil 'move))) | |
10405 | (p2 (save-excursion (re-search-backward re nil 'move)))) | |
10406 | (cond ((and p1 p2) | |
10407 | (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) | |
10408 | p1 p2))) | |
10409 | ((or p1 p2) (goto-char (or p1 p2))) | |
10410 | (t (error "No table dataline around here")))))) | |
10411 | ||
a3fbe8c4 | 10412 | (defun org-table-fedit-line-up () |
d3f4dbe8 CD |
10413 | "Move cursor one line up in the window showing the table." |
10414 | (interactive) | |
a3fbe8c4 | 10415 | (org-table-fedit-move 'previous-line)) |
d3f4dbe8 | 10416 | |
a3fbe8c4 | 10417 | (defun org-table-fedit-line-down () |
d3f4dbe8 CD |
10418 | "Move cursor one line down in the window showing the table." |
10419 | (interactive) | |
fbe6c10d | 10420 | (org-table-fedit-move 'next-line)) |
d3f4dbe8 | 10421 | |
a3fbe8c4 | 10422 | (defun org-table-fedit-move (command) |
d3f4dbe8 CD |
10423 | "Move the cursor in the window shoinw the table. |
10424 | Use COMMAND to do the motion, repeat if necessary to end up in a data line." | |
10425 | (let ((org-table-allow-automatic-line-recalculation nil) | |
10426 | (pos org-pos) (win (selected-window)) p) | |
10427 | (select-window (get-buffer-window (marker-buffer org-pos))) | |
10428 | (setq p (point)) | |
10429 | (call-interactively command) | |
10430 | (while (and (org-at-table-p) | |
10431 | (org-at-table-hline-p)) | |
10432 | (call-interactively command)) | |
10433 | (or (org-at-table-p) (goto-char p)) | |
10434 | (move-marker pos (point)) | |
10435 | (select-window win))) | |
10436 | ||
a3fbe8c4 | 10437 | (defun org-table-fedit-scroll (N) |
d3f4dbe8 CD |
10438 | (interactive "p") |
10439 | (let ((other-window-scroll-buffer (marker-buffer org-pos))) | |
10440 | (scroll-other-window N))) | |
10441 | ||
a3fbe8c4 | 10442 | (defun org-table-fedit-scroll-down (N) |
d3f4dbe8 | 10443 | (interactive "p") |
a3fbe8c4 | 10444 | (org-table-fedit-scroll (- N))) |
d3f4dbe8 CD |
10445 | |
10446 | (defvar org-table-rectangle-overlays nil) | |
a3fbe8c4 | 10447 | |
d3f4dbe8 CD |
10448 | (defun org-table-add-rectangle-overlay (beg end &optional face) |
10449 | "Add a new overlay." | |
10450 | (let ((ov (org-make-overlay beg end))) | |
10451 | (org-overlay-put ov 'face (or face 'secondary-selection)) | |
10452 | (push ov org-table-rectangle-overlays))) | |
10453 | ||
10454 | (defun org-table-highlight-rectangle (&optional beg end face) | |
10455 | "Highlight rectangular region in a table." | |
10456 | (setq beg (or beg (point)) end (or end (point))) | |
10457 | (let ((b (min beg end)) | |
10458 | (e (max beg end)) | |
10459 | l1 c1 l2 c2 tmp) | |
10460 | (and (boundp 'org-show-positions) | |
10461 | (setq org-show-positions (cons b (cons e org-show-positions)))) | |
10462 | (goto-char (min beg end)) | |
10463 | (setq l1 (org-current-line) | |
10464 | c1 (org-table-current-column)) | |
10465 | (goto-char (max beg end)) | |
10466 | (setq l2 (org-current-line) | |
10467 | c2 (org-table-current-column)) | |
10468 | (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) | |
10469 | (goto-line l1) | |
10470 | (beginning-of-line 1) | |
10471 | (loop for line from l1 to l2 do | |
10472 | (when (looking-at org-table-dataline-regexp) | |
10473 | (org-table-goto-column c1) | |
10474 | (skip-chars-backward "^|\n") (setq beg (point)) | |
10475 | (org-table-goto-column c2) | |
10476 | (skip-chars-forward "^|\n") (setq end (point)) | |
10477 | (org-table-add-rectangle-overlay beg end face)) | |
10478 | (beginning-of-line 2)) | |
10479 | (goto-char b)) | |
10480 | (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight)) | |
10481 | ||
10482 | (defun org-table-remove-rectangle-highlight (&rest ignore) | |
10483 | "Remove the rectangle overlays." | |
10484 | (unless org-inhibit-highlight-removal | |
10485 | (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) | |
10486 | (mapc 'org-delete-overlay org-table-rectangle-overlays) | |
10487 | (setq org-table-rectangle-overlays nil))) | |
10488 | ||
10489 | (defvar org-table-coordinate-overlays nil | |
10490 | "Collects the cooordinate grid overlays, so that they can be removed.") | |
10491 | (make-variable-buffer-local 'org-table-coordinate-overlays) | |
10492 | ||
10493 | (defun org-table-overlay-coordinates () | |
10494 | "Add overlays to the table at point, to show row/column coordinates." | |
10495 | (interactive) | |
10496 | (mapc 'org-delete-overlay org-table-coordinate-overlays) | |
10497 | (setq org-table-coordinate-overlays nil) | |
10498 | (save-excursion | |
a3fbe8c4 | 10499 | (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) |
d3f4dbe8 CD |
10500 | (goto-char (org-table-begin)) |
10501 | (while (org-at-table-p) | |
10502 | (setq eol (point-at-eol)) | |
10503 | (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol)))) | |
10504 | (push ov org-table-coordinate-overlays) | |
10505 | (setq hline (looking-at org-table-hline-regexp)) | |
10506 | (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) | |
10507 | (format "%4d" (setq id (1+ id))))) | |
a3fbe8c4 | 10508 | (org-overlay-before-string ov str 'org-special-keyword 'evaporate) |
d3f4dbe8 CD |
10509 | (when hline |
10510 | (setq ic 0) | |
a3fbe8c4 | 10511 | (while (re-search-forward "[+|]\\(-+\\)" eol t) |
d3f4dbe8 | 10512 | (setq beg (1+ (match-beginning 0)) |
a3fbe8c4 CD |
10513 | ic (1+ ic) |
10514 | s1 (concat "$" (int-to-string ic)) | |
10515 | s2 (org-number-to-letters ic) | |
10516 | str (if (eq org-table-use-standard-references t) s2 s1)) | |
d3f4dbe8 CD |
10517 | (setq ov (org-make-overlay beg (+ beg (length str)))) |
10518 | (push ov org-table-coordinate-overlays) | |
a3fbe8c4 | 10519 | (org-overlay-display ov str 'org-special-keyword 'evaporate))) |
d3f4dbe8 CD |
10520 | (beginning-of-line 2))))) |
10521 | ||
10522 | (defun org-table-toggle-coordinate-overlays () | |
10523 | "Toggle the display of Row/Column numbers in tables." | |
10524 | (interactive) | |
10525 | (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) | |
10526 | (message "Row/Column number display turned %s" | |
10527 | (if org-table-overlay-coordinates "on" "off")) | |
10528 | (if (and (org-at-table-p) org-table-overlay-coordinates) | |
10529 | (org-table-align)) | |
10530 | (unless org-table-overlay-coordinates | |
10531 | (mapc 'org-delete-overlay org-table-coordinate-overlays) | |
10532 | (setq org-table-coordinate-overlays nil))) | |
10533 | ||
10534 | (defun org-table-toggle-formula-debugger () | |
10535 | "Toggle the formula debugger in tables." | |
10536 | (interactive) | |
10537 | (setq org-table-formula-debug (not org-table-formula-debug)) | |
10538 | (message "Formula debugging has been turned %s" | |
10539 | (if org-table-formula-debug "on" "off"))) | |
10540 | ||
10541 | ;;; The orgtbl minor mode | |
10542 | ||
10543 | ;; Define a minor mode which can be used in other modes in order to | |
10544 | ;; integrate the org-mode table editor. | |
10545 | ||
10546 | ;; This is really a hack, because the org-mode table editor uses several | |
10547 | ;; keys which normally belong to the major mode, for example the TAB and | |
10548 | ;; RET keys. Here is how it works: The minor mode defines all the keys | |
10549 | ;; necessary to operate the table editor, but wraps the commands into a | |
10550 | ;; function which tests if the cursor is currently inside a table. If that | |
10551 | ;; is the case, the table editor command is executed. However, when any of | |
10552 | ;; those keys is used outside a table, the function uses `key-binding' to | |
10553 | ;; look up if the key has an associated command in another currently active | |
10554 | ;; keymap (minor modes, major mode, global), and executes that command. | |
10555 | ;; There might be problems if any of the keys used by the table editor is | |
10556 | ;; otherwise used as a prefix key. | |
10557 | ||
10558 | ;; Another challenge is that the key binding for TAB can be tab or \C-i, | |
10559 | ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode | |
10560 | ;; addresses this by checking explicitly for both bindings. | |
10561 | ||
10562 | ;; The optimized version (see variable `orgtbl-optimized') takes over | |
10563 | ;; all keys which are bound to `self-insert-command' in the *global map*. | |
10564 | ;; Some modes bind other commands to simple characters, for example | |
10565 | ;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode | |
10566 | ;; active, this binding is ignored inside tables and replaced with a | |
10567 | ;; modified self-insert. | |
10568 | ||
10569 | (defvar orgtbl-mode nil | |
10570 | "Variable controlling `orgtbl-mode', a minor mode enabling the `org-mode' | |
10571 | table editor in arbitrary modes.") | |
10572 | (make-variable-buffer-local 'orgtbl-mode) | |
10573 | ||
10574 | (defvar orgtbl-mode-map (make-keymap) | |
10575 | "Keymap for `orgtbl-mode'.") | |
3278a016 | 10576 | |
891f4676 | 10577 | ;;;###autoload |
d3f4dbe8 CD |
10578 | (defun turn-on-orgtbl () |
10579 | "Unconditionally turn on `orgtbl-mode'." | |
10580 | (orgtbl-mode 1)) | |
3278a016 | 10581 | |
d3f4dbe8 CD |
10582 | (defvar org-old-auto-fill-inhibit-regexp nil |
10583 | "Local variable used by `orgtbl-mode'") | |
891f4676 | 10584 | |
d3f4dbe8 CD |
10585 | (defconst orgtbl-line-start-regexp "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\):\\)" |
10586 | "Matches a line belonging to an orgtbl.") | |
10587 | ||
10588 | (defconst orgtbl-extra-font-lock-keywords | |
10589 | (list (list (concat "^" orgtbl-line-start-regexp ".*") | |
10590 | 0 (quote 'org-table) 'prepend)) | |
10591 | "Extra font-lock-keywords to be added when orgtbl-mode is active.") | |
f425a6ea CD |
10592 | |
10593 | ;;;###autoload | |
d3f4dbe8 CD |
10594 | (defun orgtbl-mode (&optional arg) |
10595 | "The `org-mode' table editor as a minor mode for use in other modes." | |
10596 | (interactive) | |
10597 | (if (org-mode-p) | |
10598 | ;; Exit without error, in case some hook functions calls this | |
10599 | ;; by accident in org-mode. | |
10600 | (message "Orgtbl-mode is not useful in org-mode, command ignored") | |
10601 | (setq orgtbl-mode | |
10602 | (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) | |
10603 | (if orgtbl-mode | |
10604 | (progn | |
10605 | (and (orgtbl-setup) (defun orgtbl-setup () nil)) | |
10606 | ;; Make sure we are first in minor-mode-map-alist | |
10607 | (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) | |
10608 | (and c (setq minor-mode-map-alist | |
10609 | (cons c (delq c minor-mode-map-alist))))) | |
10610 | (org-set-local (quote org-table-may-need-update) t) | |
10611 | (org-add-hook 'before-change-functions 'org-before-change-function | |
10612 | nil 'local) | |
10613 | (org-set-local 'org-old-auto-fill-inhibit-regexp | |
10614 | auto-fill-inhibit-regexp) | |
10615 | (org-set-local 'auto-fill-inhibit-regexp | |
10616 | (if auto-fill-inhibit-regexp | |
10617 | (concat orgtbl-line-start-regexp "\\|" | |
10618 | auto-fill-inhibit-regexp) | |
10619 | orgtbl-line-start-regexp)) | |
10620 | (org-add-to-invisibility-spec '(org-cwidth)) | |
10621 | (when (fboundp 'font-lock-add-keywords) | |
10622 | (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) | |
10623 | (org-restart-font-lock)) | |
10624 | (easy-menu-add orgtbl-mode-menu) | |
10625 | (run-hooks 'orgtbl-mode-hook)) | |
10626 | (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) | |
10627 | (org-cleanup-narrow-column-properties) | |
10628 | (org-remove-from-invisibility-spec '(org-cwidth)) | |
10629 | (remove-hook 'before-change-functions 'org-before-change-function t) | |
10630 | (when (fboundp 'font-lock-remove-keywords) | |
10631 | (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) | |
10632 | (org-restart-font-lock)) | |
10633 | (easy-menu-remove orgtbl-mode-menu) | |
10634 | (force-mode-line-update 'all)))) | |
f425a6ea | 10635 | |
d3f4dbe8 CD |
10636 | (defun org-cleanup-narrow-column-properties () |
10637 | "Remove all properties related to narrow-column invisibility." | |
10638 | (let ((s 1)) | |
10639 | (while (setq s (text-property-any s (point-max) | |
10640 | 'display org-narrow-column-arrow)) | |
10641 | (remove-text-properties s (1+ s) '(display t))) | |
10642 | (setq s 1) | |
10643 | (while (setq s (text-property-any s (point-max) 'org-cwidth 1)) | |
10644 | (remove-text-properties s (1+ s) '(org-cwidth t))) | |
10645 | (setq s 1) | |
10646 | (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) | |
10647 | (remove-text-properties s (1+ s) '(invisible t))))) | |
891f4676 | 10648 | |
d3f4dbe8 CD |
10649 | ;; Install it as a minor mode. |
10650 | (put 'orgtbl-mode :included t) | |
10651 | (put 'orgtbl-mode :menu-tag "Org Table Mode") | |
10652 | (add-minor-mode 'orgtbl-mode " OrgTbl" orgtbl-mode-map) | |
04d18304 | 10653 | |
d3f4dbe8 CD |
10654 | (defun orgtbl-make-binding (fun n &rest keys) |
10655 | "Create a function for binding in the table minor mode. | |
10656 | FUN is the command to call inside a table. N is used to create a unique | |
10657 | command name. KEYS are keys that should be checked in for a command | |
10658 | to execute outside of tables." | |
10659 | (eval | |
10660 | (list 'defun | |
10661 | (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) | |
10662 | '(arg) | |
10663 | (concat "In tables, run `" (symbol-name fun) "'.\n" | |
10664 | "Outside of tables, run the binding of `" | |
10665 | (mapconcat (lambda (x) (format "%s" x)) keys "' or `") | |
10666 | "'.") | |
10667 | '(interactive "p") | |
10668 | (list 'if | |
10669 | '(org-at-table-p) | |
10670 | (list 'call-interactively (list 'quote fun)) | |
10671 | (list 'let '(orgtbl-mode) | |
10672 | (list 'call-interactively | |
10673 | (append '(or) | |
10674 | (mapcar (lambda (k) | |
10675 | (list 'key-binding k)) | |
10676 | keys) | |
10677 | '('orgtbl-error)))))))) | |
891f4676 | 10678 | |
d3f4dbe8 CD |
10679 | (defun orgtbl-error () |
10680 | "Error when there is no default binding for a table key." | |
634a7d0b | 10681 | (interactive) |
d3f4dbe8 | 10682 | (error "This key is has no function outside tables")) |
891f4676 | 10683 | |
d3f4dbe8 CD |
10684 | (defun orgtbl-setup () |
10685 | "Setup orgtbl keymaps." | |
10686 | (let ((nfunc 0) | |
10687 | (bindings | |
10688 | (list | |
10689 | '([(meta shift left)] org-table-delete-column) | |
10690 | '([(meta left)] org-table-move-column-left) | |
10691 | '([(meta right)] org-table-move-column-right) | |
10692 | '([(meta shift right)] org-table-insert-column) | |
10693 | '([(meta shift up)] org-table-kill-row) | |
10694 | '([(meta shift down)] org-table-insert-row) | |
10695 | '([(meta up)] org-table-move-row-up) | |
10696 | '([(meta down)] org-table-move-row-down) | |
10697 | '("\C-c\C-w" org-table-cut-region) | |
10698 | '("\C-c\M-w" org-table-copy-region) | |
10699 | '("\C-c\C-y" org-table-paste-rectangle) | |
10700 | '("\C-c-" org-table-insert-hline) | |
10701 | '("\C-c}" org-table-toggle-coordinate-overlays) | |
10702 | '("\C-c{" org-table-toggle-formula-debugger) | |
10703 | '("\C-m" org-table-next-row) | |
a3fbe8c4 | 10704 | '([(shift return)] org-table-copy-down) |
d3f4dbe8 CD |
10705 | '("\C-c\C-q" org-table-wrap-region) |
10706 | '("\C-c?" org-table-field-info) | |
10707 | '("\C-c " org-table-blank-field) | |
10708 | '("\C-c+" org-table-sum) | |
10709 | '("\C-c=" org-table-eval-formula) | |
10710 | '("\C-c'" org-table-edit-formulas) | |
10711 | '("\C-c`" org-table-edit-field) | |
10712 | '("\C-c*" org-table-recalculate) | |
10713 | '("\C-c|" org-table-create-or-convert-from-region) | |
10714 | '("\C-c^" org-table-sort-lines) | |
10715 | '([(control ?#)] org-table-rotate-recalc-marks))) | |
10716 | elt key fun cmd) | |
10717 | (while (setq elt (pop bindings)) | |
10718 | (setq nfunc (1+ nfunc)) | |
a3fbe8c4 | 10719 | (setq key (org-key (car elt)) |
d3f4dbe8 CD |
10720 | fun (nth 1 elt) |
10721 | cmd (orgtbl-make-binding fun nfunc key)) | |
a3fbe8c4 | 10722 | (org-defkey orgtbl-mode-map key cmd)) |
b928f99a | 10723 | |
d3f4dbe8 | 10724 | ;; Special treatment needed for TAB and RET |
a3fbe8c4 | 10725 | (org-defkey orgtbl-mode-map [(return)] |
d3f4dbe8 | 10726 | (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) |
a3fbe8c4 | 10727 | (org-defkey orgtbl-mode-map "\C-m" |
d3f4dbe8 | 10728 | (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) |
891f4676 | 10729 | |
a3fbe8c4 | 10730 | (org-defkey orgtbl-mode-map [(tab)] |
d3f4dbe8 | 10731 | (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) |
a3fbe8c4 | 10732 | (org-defkey orgtbl-mode-map "\C-i" |
d3f4dbe8 | 10733 | (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) |
3278a016 | 10734 | |
a3fbe8c4 | 10735 | (org-defkey orgtbl-mode-map [(shift tab)] |
d3f4dbe8 CD |
10736 | (orgtbl-make-binding 'org-table-previous-field 104 |
10737 | [(shift tab)] [(tab)] "\C-i")) | |
891f4676 | 10738 | |
a3fbe8c4 | 10739 | (org-defkey orgtbl-mode-map "\M-\C-m" |
d3f4dbe8 CD |
10740 | (orgtbl-make-binding 'org-table-wrap-region 105 |
10741 | "\M-\C-m" [(meta return)])) | |
a3fbe8c4 | 10742 | (org-defkey orgtbl-mode-map [(meta return)] |
d3f4dbe8 CD |
10743 | (orgtbl-make-binding 'org-table-wrap-region 106 |
10744 | [(meta return)] "\M-\C-m")) | |
891f4676 | 10745 | |
a3fbe8c4 | 10746 | (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) |
d3f4dbe8 CD |
10747 | (when orgtbl-optimized |
10748 | ;; If the user wants maximum table support, we need to hijack | |
10749 | ;; some standard editing functions | |
10750 | (org-remap orgtbl-mode-map | |
10751 | 'self-insert-command 'orgtbl-self-insert-command | |
10752 | 'delete-char 'org-delete-char | |
10753 | 'delete-backward-char 'org-delete-backward-char) | |
a3fbe8c4 | 10754 | (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) |
d3f4dbe8 CD |
10755 | (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" |
10756 | '("OrgTbl" | |
10757 | ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] | |
10758 | ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] | |
10759 | ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] | |
10760 | ["Next Row" org-return :active (org-at-table-p) :keys "RET"] | |
10761 | "--" | |
10762 | ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] | |
10763 | ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] | |
10764 | ["Copy Field from Above" | |
10765 | org-table-copy-down :active (org-at-table-p) :keys "S-RET"] | |
10766 | "--" | |
10767 | ("Column" | |
10768 | ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] | |
10769 | ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"] | |
10770 | ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"] | |
10771 | ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]) | |
10772 | ("Row" | |
10773 | ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"] | |
10774 | ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"] | |
10775 | ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"] | |
10776 | ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"] | |
10777 | ["Sort lines in region" org-table-sort-lines (org-at-table-p) :keys "C-c ^"] | |
10778 | "--" | |
10779 | ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) | |
10780 | ("Rectangle" | |
10781 | ["Copy Rectangle" org-copy-special :active (org-at-table-p)] | |
10782 | ["Cut Rectangle" org-cut-special :active (org-at-table-p)] | |
10783 | ["Paste Rectangle" org-paste-special :active (org-at-table-p)] | |
10784 | ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) | |
10785 | "--" | |
10786 | ("Radio tables" | |
10787 | ["Insert table template" orgtbl-insert-radio-table | |
10788 | (assq major-mode orgtbl-radio-table-templates)] | |
10789 | ["Comment/uncomment table" orgtbl-toggle-comment t]) | |
10790 | "--" | |
10791 | ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] | |
10792 | ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] | |
10793 | ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] | |
10794 | ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] | |
10795 | ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] | |
10796 | ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] | |
10797 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] | |
10798 | ["Sum Column/Rectangle" org-table-sum | |
10799 | :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] | |
10800 | ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] | |
10801 | ["Debug Formulas" | |
10802 | org-table-toggle-formula-debugger :active (org-at-table-p) | |
10803 | :keys "C-c {" | |
10804 | :style toggle :selected org-table-formula-debug] | |
10805 | ["Show Col/Row Numbers" | |
10806 | org-table-toggle-coordinate-overlays :active (org-at-table-p) | |
10807 | :keys "C-c }" | |
10808 | :style toggle :selected org-table-overlay-coordinates] | |
10809 | )) | |
10810 | t)) | |
891f4676 | 10811 | |
d3f4dbe8 CD |
10812 | (defun orgtbl-ctrl-c-ctrl-c (arg) |
10813 | "If the cursor is inside a table, realign the table. | |
10814 | It it is a table to be sent away to a receiver, do it. | |
10815 | With prefix arg, also recompute table." | |
10816 | (interactive "P") | |
10817 | (let ((pos (point)) action) | |
10818 | (save-excursion | |
10819 | (beginning-of-line 1) | |
10820 | (setq action (cond ((looking-at "#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) | |
10821 | ((looking-at "[ \t]*|") pos) | |
10822 | ((looking-at "#\\+TBLFM:") 'recalc)))) | |
10823 | (cond | |
10824 | ((integerp action) | |
10825 | (goto-char action) | |
10826 | (org-table-maybe-eval-formula) | |
10827 | (if arg | |
10828 | (call-interactively 'org-table-recalculate) | |
10829 | (org-table-maybe-recalculate-line)) | |
10830 | (call-interactively 'org-table-align) | |
10831 | (orgtbl-send-table 'maybe)) | |
10832 | ((eq action 'recalc) | |
10833 | (save-excursion | |
10834 | (beginning-of-line 1) | |
10835 | (skip-chars-backward " \r\n\t") | |
10836 | (if (org-at-table-p) | |
10837 | (org-call-with-arg 'org-table-recalculate t)))) | |
10838 | (t (let (orgtbl-mode) | |
10839 | (call-interactively (key-binding "\C-c\C-c"))))))) | |
9acdaa21 | 10840 | |
d3f4dbe8 CD |
10841 | (defun orgtbl-tab (arg) |
10842 | "Justification and field motion for `orgtbl-mode'." | |
10843 | (interactive "P") | |
10844 | (if arg (org-table-edit-field t) | |
10845 | (org-table-justify-field-maybe) | |
10846 | (org-table-next-field))) | |
10847 | ||
10848 | (defun orgtbl-ret () | |
10849 | "Justification and field motion for `orgtbl-mode'." | |
634a7d0b | 10850 | (interactive) |
d3f4dbe8 CD |
10851 | (org-table-justify-field-maybe) |
10852 | (org-table-next-row)) | |
891f4676 | 10853 | |
d3f4dbe8 CD |
10854 | (defun orgtbl-self-insert-command (N) |
10855 | "Like `self-insert-command', use overwrite-mode for whitespace in tables. | |
10856 | If the cursor is in a table looking at whitespace, the whitespace is | |
10857 | overwritten, and the table is not marked as requiring realignment." | |
35fb9989 | 10858 | (interactive "p") |
d3f4dbe8 CD |
10859 | (if (and (org-at-table-p) |
10860 | (or | |
10861 | (and org-table-auto-blank-field | |
10862 | (member last-command | |
10863 | '(orgtbl-hijacker-command-100 | |
10864 | orgtbl-hijacker-command-101 | |
10865 | orgtbl-hijacker-command-102 | |
10866 | orgtbl-hijacker-command-103 | |
10867 | orgtbl-hijacker-command-104 | |
10868 | orgtbl-hijacker-command-105)) | |
10869 | (org-table-blank-field)) | |
10870 | t) | |
10871 | (eq N 1) | |
10872 | (looking-at "[^|\n]* +|")) | |
10873 | (let (org-table-may-need-update) | |
10874 | (goto-char (1- (match-end 0))) | |
10875 | (delete-backward-char 1) | |
10876 | (goto-char (match-beginning 0)) | |
10877 | (self-insert-command N)) | |
10878 | (setq org-table-may-need-update t) | |
10879 | (let (orgtbl-mode) | |
10880 | (call-interactively (key-binding (vector last-input-event)))))) | |
35fb9989 | 10881 | |
d3f4dbe8 CD |
10882 | (defun org-force-self-insert (N) |
10883 | "Needed to enforce self-insert under remapping." | |
35fb9989 | 10884 | (interactive "p") |
d3f4dbe8 | 10885 | (self-insert-command N)) |
35fb9989 | 10886 | |
d3f4dbe8 CD |
10887 | (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" |
10888 | "Regula expression matching exponentials as produced by calc.") | |
634a7d0b | 10889 | |
a3fbe8c4 CD |
10890 | (defvar org-table-clean-did-remove-column nil) |
10891 | ||
10892 | (defun orgtbl-export (table target) | |
10893 | (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) | |
10894 | (lines (org-split-string table "[ \t]*\n[ \t]*")) | |
10895 | org-table-last-alignment org-table-last-column-widths | |
10896 | maxcol column) | |
10897 | (if (not (fboundp func)) | |
10898 | (error "Cannot export orgtbl table to %s" target)) | |
10899 | (setq lines (org-table-clean-before-export lines)) | |
10900 | (setq table | |
10901 | (mapcar | |
10902 | (lambda (x) | |
10903 | (if (string-match org-table-hline-regexp x) | |
10904 | 'hline | |
10905 | (org-split-string (org-trim x) "\\s-*|\\s-*"))) | |
10906 | lines)) | |
10907 | (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0)) | |
10908 | table))) | |
10909 | (loop for i from (1- maxcol) downto 0 do | |
10910 | (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table)) | |
10911 | (setq column (delq nil column)) | |
10912 | (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths) | |
10913 | (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment)) | |
10914 | (funcall func table nil))) | |
634a7d0b | 10915 | |
d3f4dbe8 CD |
10916 | (defun orgtbl-send-table (&optional maybe) |
10917 | "Send a tranformed version of this table to the receiver position. | |
10918 | With argument MAYBE, fail quietly if no transformation is defined for | |
10919 | this table." | |
891f4676 | 10920 | (interactive) |
d3f4dbe8 CD |
10921 | (catch 'exit |
10922 | (unless (org-at-table-p) (error "Not at a table")) | |
10923 | ;; when non-interactive, we assume align has just happened. | |
10924 | (when (interactive-p) (org-table-align)) | |
10925 | (save-excursion | |
10926 | (goto-char (org-table-begin)) | |
10927 | (beginning-of-line 0) | |
10928 | (unless (looking-at "#\\+ORGTBL: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") | |
10929 | (if maybe | |
10930 | (throw 'exit nil) | |
10931 | (error "Don't know how to transform this table.")))) | |
10932 | (let* ((name (match-string 1)) | |
10933 | beg | |
10934 | (transform (intern (match-string 2))) | |
10935 | (params (if (match-end 3) (read (concat "(" (match-string 3) ")")))) | |
10936 | (skip (plist-get params :skip)) | |
10937 | (skipcols (plist-get params :skipcols)) | |
10938 | (txt (buffer-substring-no-properties | |
10939 | (org-table-begin) (org-table-end))) | |
10940 | (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) | |
10941 | (lines (org-table-clean-before-export lines)) | |
a3fbe8c4 | 10942 | (i0 (if org-table-clean-did-remove-column 2 1)) |
d3f4dbe8 CD |
10943 | (table (mapcar |
10944 | (lambda (x) | |
10945 | (if (string-match org-table-hline-regexp x) | |
10946 | 'hline | |
10947 | (org-remove-by-index | |
10948 | (org-split-string (org-trim x) "\\s-*|\\s-*") | |
10949 | skipcols i0))) | |
10950 | lines)) | |
10951 | (fun (if (= i0 2) 'cdr 'identity)) | |
10952 | (org-table-last-alignment | |
10953 | (org-remove-by-index (funcall fun org-table-last-alignment) | |
10954 | skipcols i0)) | |
10955 | (org-table-last-column-widths | |
10956 | (org-remove-by-index (funcall fun org-table-last-column-widths) | |
10957 | skipcols i0))) | |
a3fbe8c4 | 10958 | |
d3f4dbe8 CD |
10959 | (unless (fboundp transform) |
10960 | (error "No such transformation function %s" transform)) | |
10961 | (setq txt (funcall transform table params)) | |
10962 | ;; Find the insertion place | |
10963 | (save-excursion | |
10964 | (goto-char (point-min)) | |
10965 | (unless (re-search-forward | |
10966 | (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) | |
10967 | (error "Don't know where to insert translated table")) | |
10968 | (goto-char (match-beginning 0)) | |
10969 | (beginning-of-line 2) | |
10970 | (setq beg (point)) | |
10971 | (unless (re-search-forward (concat "END RECEIVE ORGTBL +" name) nil t) | |
10972 | (error "Cannot find end of insertion region")) | |
10973 | (beginning-of-line 1) | |
10974 | (delete-region beg (point)) | |
10975 | (goto-char beg) | |
10976 | (insert txt "\n")) | |
10977 | (message "Table converted and installed at receiver location")))) | |
891f4676 | 10978 | |
d3f4dbe8 CD |
10979 | (defun org-remove-by-index (list indices &optional i0) |
10980 | "Remove the elements in LIST with indices in INDICES. | |
10981 | First element has index 0, or I0 if given." | |
10982 | (if (not indices) | |
10983 | list | |
10984 | (if (integerp indices) (setq indices (list indices))) | |
10985 | (setq i0 (1- (or i0 0))) | |
10986 | (delq :rm (mapcar (lambda (x) | |
10987 | (setq i0 (1+ i0)) | |
10988 | (if (memq i0 indices) :rm x)) | |
10989 | list)))) | |
a3fbe8c4 | 10990 | |
d3f4dbe8 CD |
10991 | (defun orgtbl-toggle-comment () |
10992 | "Comment or uncomment the orgtbl at point." | |
7ac93e3c | 10993 | (interactive) |
d3f4dbe8 CD |
10994 | (let* ((re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) |
10995 | (re2 (concat "^" orgtbl-line-start-regexp)) | |
10996 | (commented (save-excursion (beginning-of-line 1) | |
10997 | (cond ((looking-at re1) t) | |
10998 | ((looking-at re2) nil) | |
10999 | (t (error "Not at an org table"))))) | |
11000 | (re (if commented re1 re2)) | |
11001 | beg end) | |
11002 | (save-excursion | |
11003 | (beginning-of-line 1) | |
11004 | (while (looking-at re) (beginning-of-line 0)) | |
11005 | (beginning-of-line 2) | |
11006 | (setq beg (point)) | |
11007 | (while (looking-at re) (beginning-of-line 2)) | |
11008 | (setq end (point))) | |
11009 | (comment-region beg end (if commented '(4) nil)))) | |
7ac93e3c | 11010 | |
d3f4dbe8 CD |
11011 | (defun orgtbl-insert-radio-table () |
11012 | "Insert a radio table template appropriate for this major mode." | |
891f4676 | 11013 | (interactive) |
d3f4dbe8 CD |
11014 | (let* ((e (assq major-mode orgtbl-radio-table-templates)) |
11015 | (txt (nth 1 e)) | |
11016 | name pos) | |
11017 | (unless e (error "No radio table setup defined for %s" major-mode)) | |
11018 | (setq name (read-string "Table name: ")) | |
11019 | (while (string-match "%n" txt) | |
11020 | (setq txt (replace-match name t t txt))) | |
11021 | (or (bolp) (insert "\n")) | |
11022 | (setq pos (point)) | |
11023 | (insert txt) | |
11024 | (goto-char pos))) | |
891f4676 | 11025 | |
d3f4dbe8 CD |
11026 | (defun org-get-param (params header i sym &optional hsym) |
11027 | "Get parameter value for symbol SYM. | |
11028 | If this is a header line, actually get the value for the symbol with an | |
11029 | additional \"h\" inserted after the colon. | |
11030 | If the value is a protperty list, get the element for the current column. | |
11031 | Assumes variables VAL, PARAMS, HEAD and I to be scoped into the function." | |
11032 | (let ((val (plist-get params sym))) | |
11033 | (and hsym header (setq val (or (plist-get params hsym) val))) | |
11034 | (if (consp val) (plist-get val i) val))) | |
11035 | ||
11036 | (defun orgtbl-to-generic (table params) | |
11037 | "Convert the orgtbl-mode TABLE to some other format. | |
11038 | This generic routine can be used for many standard cases. | |
11039 | TABLE is a list, each entry either the symbol `hline' for a horizontal | |
11040 | separator line, or a list of fields for that line. | |
11041 | PARAMS is a property list of parameters that can influence the conversion. | |
11042 | For the generic converter, some parameters are obligatory: You need to | |
11043 | specify either :lfmt, or all of (:lstart :lend :sep). If you do not use | |
11044 | :splice, you must have :tstart and :tend. | |
11045 | ||
11046 | Valid parameters are | |
11047 | ||
11048 | :tstart String to start the table. Ignored when :splice is t. | |
11049 | :tend String to end the table. Ignored when :splice is t. | |
11050 | ||
11051 | :splice When set to t, return only table body lines, don't wrap | |
11052 | them into :tstart and :tend. Default is nil. | |
11053 | ||
11054 | :hline String to be inserted on horizontal separation lines. | |
11055 | May be nil to ignore hlines. | |
11056 | ||
11057 | :lstart String to start a new table line. | |
11058 | :lend String to end a table line | |
11059 | :sep Separator between two fields | |
11060 | :lfmt Format for entire line, with enough %s to capture all fields. | |
11061 | If this is present, :lstart, :lend, and :sep are ignored. | |
11062 | :fmt A format to be used to wrap the field, should contain | |
11063 | %s for the original field value. For example, to wrap | |
11064 | everything in dollars, you could use :fmt \"$%s$\". | |
11065 | This may also be a property list with column numbers and | |
11066 | formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") | |
11067 | ||
11068 | :hlstart :hlend :hlsep :hlfmt :hfmt | |
11069 | Same as above, specific for the header lines in the table. | |
11070 | All lines before the first hline are treated as header. | |
11071 | If any of these is not present, the data line value is used. | |
11072 | ||
11073 | :efmt Use this format to print numbers with exponentials. | |
11074 | The format should have %s twice for inserting mantissa | |
11075 | and exponent, for example \"%s\\\\times10^{%s}\". This | |
11076 | may also be a property list with column numbers and | |
11077 | formats. :fmt will still be applied after :efmt. | |
11078 | ||
11079 | In addition to this, the parameters :skip and :skipcols are always handled | |
11080 | directly by `orgtbl-send-table'. See manual." | |
eb2f9c59 | 11081 | (interactive) |
d3f4dbe8 CD |
11082 | (let* ((p params) |
11083 | (splicep (plist-get p :splice)) | |
11084 | (hline (plist-get p :hline)) | |
11085 | rtn line i fm efm lfmt h) | |
a3fbe8c4 | 11086 | |
d3f4dbe8 CD |
11087 | ;; Do we have a header? |
11088 | (if (and (not splicep) (listp (car table)) (memq 'hline table)) | |
11089 | (setq h t)) | |
11090 | ||
11091 | ;; Put header | |
11092 | (unless splicep | |
11093 | (push (or (plist-get p :tstart) "ERROR: no :tstart") rtn)) | |
a3fbe8c4 | 11094 | |
d3f4dbe8 CD |
11095 | ;; Now loop over all lines |
11096 | (while (setq line (pop table)) | |
11097 | (if (eq line 'hline) | |
11098 | ;; A horizontal separator line | |
11099 | (progn (if hline (push hline rtn)) | |
11100 | (setq h nil)) ; no longer in header | |
11101 | ;; A normal line. Convert the fields, push line onto the result list | |
11102 | (setq i 0) | |
11103 | (setq line | |
11104 | (mapcar | |
11105 | (lambda (f) | |
11106 | (setq i (1+ i) | |
11107 | fm (org-get-param p h i :fmt :hfmt) | |
11108 | efm (org-get-param p h i :efmt)) | |
11109 | (if (and efm (string-match orgtbl-exp-regexp f)) | |
11110 | (setq f (format | |
11111 | efm (match-string 1 f) (match-string 2 f)))) | |
11112 | (if fm (setq f (format fm f))) | |
11113 | f) | |
11114 | line)) | |
11115 | (if (setq lfmt (org-get-param p h i :lfmt :hlfmt)) | |
11116 | (push (apply 'format lfmt line) rtn) | |
11117 | (push (concat | |
11118 | (org-get-param p h i :lstart :hlstart) | |
11119 | (mapconcat 'identity line (org-get-param p h i :sep :hsep)) | |
11120 | (org-get-param p h i :lend :hlend)) | |
11121 | rtn)))) | |
a3fbe8c4 CD |
11122 | |
11123 | (unless splicep | |
d3f4dbe8 | 11124 | (push (or (plist-get p :tend) "ERROR: no :tend") rtn)) |
a3fbe8c4 | 11125 | |
d3f4dbe8 CD |
11126 | (mapconcat 'identity (nreverse rtn) "\n"))) |
11127 | ||
11128 | (defun orgtbl-to-latex (table params) | |
11129 | "Convert the orgtbl-mode TABLE to LaTeX. | |
11130 | TABLE is a list, each entry either the symbol `hline' for a horizontal | |
11131 | separator line, or a list of fields for that line. | |
11132 | PARAMS is a property list of parameters that can influence the conversion. | |
11133 | Supports all parameters from `orgtbl-to-generic'. Most important for | |
11134 | LaTeX are: | |
11135 | ||
11136 | :splice When set to t, return only table body lines, don't wrap | |
11137 | them into a tabular environment. Default is nil. | |
11138 | ||
11139 | :fmt A format to be used to wrap the field, should contain %s for the | |
11140 | original field value. For example, to wrap everything in dollars, | |
11141 | use :fmt \"$%s$\". This may also be a property list with column | |
11142 | numbers and formats. for example :fmt (2 \"$%s$\" 4 \"%s%%\") | |
11143 | ||
11144 | :efmt Format for transforming numbers with exponentials. The format | |
11145 | should have %s twice for inserting mantissa and exponent, for | |
11146 | example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". | |
11147 | This may also be a property list with column numbers and formats. | |
11148 | ||
11149 | The general parameters :skip and :skipcols have already been applied when | |
11150 | this function is called." | |
11151 | (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) | |
11152 | org-table-last-alignment "")) | |
11153 | (params2 | |
11154 | (list | |
11155 | :tstart (concat "\\begin{tabular}{" alignment "}") | |
11156 | :tend "\\end{tabular}" | |
11157 | :lstart "" :lend " \\\\" :sep " & " | |
11158 | :efmt "%s\\,(%s)" :hline "\\hline"))) | |
11159 | (orgtbl-to-generic table (org-combine-plists params2 params)))) | |
11160 | ||
11161 | (defun orgtbl-to-html (table params) | |
11162 | "Convert the orgtbl-mode TABLE to LaTeX. | |
11163 | TABLE is a list, each entry either the symbol `hline' for a horizontal | |
11164 | separator line, or a list of fields for that line. | |
11165 | PARAMS is a property list of parameters that can influence the conversion. | |
11166 | Currently this function recognizes the following parameters: | |
11167 | ||
11168 | :splice When set to t, return only table body lines, don't wrap | |
11169 | them into a <table> environment. Default is nil. | |
11170 | ||
11171 | The general parameters :skip and :skipcols have already been applied when | |
11172 | this function is called. The function does *not* use `orgtbl-to-generic', | |
11173 | so you cannot specify parameters for it." | |
11174 | (let* ((splicep (plist-get params :splice)) | |
11175 | html) | |
11176 | ;; Just call the formatter we already have | |
11177 | ;; We need to make text lines for it, so put the fields back together. | |
11178 | (setq html (org-format-org-table-html | |
11179 | (mapcar | |
11180 | (lambda (x) | |
11181 | (if (eq x 'hline) | |
11182 | "|----+----|" | |
11183 | (concat "| " (mapconcat 'identity x " | ") " |"))) | |
11184 | table) | |
11185 | splicep)) | |
11186 | (if (string-match "\n+\\'" html) | |
11187 | (setq html (replace-match "" t t html))) | |
11188 | html)) | |
eb2f9c59 | 11189 | |
d3f4dbe8 CD |
11190 | (defun orgtbl-to-texinfo (table params) |
11191 | "Convert the orgtbl-mode TABLE to TeXInfo. | |
11192 | TABLE is a list, each entry either the symbol `hline' for a horizontal | |
11193 | separator line, or a list of fields for that line. | |
11194 | PARAMS is a property list of parameters that can influence the conversion. | |
11195 | Supports all parameters from `orgtbl-to-generic'. Most important for | |
11196 | TeXInfo are: | |
11197 | ||
11198 | :splice nil/t When set to t, return only table body lines, don't wrap | |
11199 | them into a multitable environment. Default is nil. | |
11200 | ||
11201 | :fmt fmt A format to be used to wrap the field, should contain | |
11202 | %s for the original field value. For example, to wrap | |
11203 | everything in @kbd{}, you could use :fmt \"@kbd{%s}\". | |
11204 | This may also be a property list with column numbers and | |
11205 | formats. for example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). | |
11206 | ||
11207 | :cf \"f1 f2..\" The column fractions for the table. Bye default these | |
11208 | are computed automatically from the width of the columns | |
11209 | under org-mode. | |
11210 | ||
11211 | The general parameters :skip and :skipcols have already been applied when | |
11212 | this function is called." | |
11213 | (let* ((total (float (apply '+ org-table-last-column-widths))) | |
11214 | (colfrac (or (plist-get params :cf) | |
11215 | (mapconcat | |
11216 | (lambda (x) (format "%.3f" (/ (float x) total))) | |
11217 | org-table-last-column-widths " "))) | |
11218 | (params2 | |
11219 | (list | |
11220 | :tstart (concat "@multitable @columnfractions " colfrac) | |
11221 | :tend "@end multitable" | |
11222 | :lstart "@item " :lend "" :sep " @tab " | |
11223 | :hlstart "@headitem "))) | |
11224 | (orgtbl-to-generic table (org-combine-plists params2 params)))) | |
891f4676 | 11225 | |
d3f4dbe8 | 11226 | ;;;; Link Stuff |
891f4676 | 11227 | |
d3f4dbe8 | 11228 | ;;; Link abbreviations |
634a7d0b | 11229 | |
d3f4dbe8 CD |
11230 | (defun org-link-expand-abbrev (link) |
11231 | "Apply replacements as defined in `org-link-abbrev-alist." | |
48aaad2d | 11232 | (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link) |
d3f4dbe8 CD |
11233 | (let* ((key (match-string 1 link)) |
11234 | (as (or (assoc key org-link-abbrev-alist-local) | |
11235 | (assoc key org-link-abbrev-alist))) | |
11236 | (tag (and (match-end 2) (match-string 3 link))) | |
11237 | rpl) | |
11238 | (if (not as) | |
11239 | link | |
11240 | (setq rpl (cdr as)) | |
11241 | (cond | |
11242 | ((symbolp rpl) (funcall rpl tag)) | |
11243 | ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) | |
11244 | (t (concat rpl tag))))) | |
11245 | link)) | |
891f4676 | 11246 | |
d3f4dbe8 | 11247 | ;;; Storing and inserting links |
ef943dba | 11248 | |
d3f4dbe8 CD |
11249 | (defvar org-insert-link-history nil |
11250 | "Minibuffer history for links inserted with `org-insert-link'.") | |
b9661543 | 11251 | |
d3f4dbe8 CD |
11252 | (defvar org-stored-links nil |
11253 | "Contains the links stored with `org-store-link'.") | |
ef943dba | 11254 | |
d3f4dbe8 CD |
11255 | (defvar org-store-link-plist nil |
11256 | "Plist with info about the most recently link created with `org-store-link'.") | |
ef943dba | 11257 | |
48aaad2d CD |
11258 | (defvar org-link-protocols nil |
11259 | "Link protocols added to Org-mode using `org-add-link-type'.") | |
11260 | ||
11261 | (defvar org-store-link-functions nil | |
11262 | "List of functions that are called to create and store a link. | |
11263 | Each function will be called in turn until one returns a non-nil | |
11264 | value. Each function should check if it is responsible for creating | |
11265 | this link (for example by looking at the major mode). | |
11266 | If not, it must exit and return nil. | |
11267 | If yes, it should return a non-nil value after a calling | |
11268 | `org-store-link-properties' with a list of properties and values. | |
11269 | Special properties are: | |
11270 | ||
11271 | :type The link prefix. like \"http\". This must be given. | |
11272 | :link The link, like \"http://www.astro.uva.nl/~dominik\". | |
11273 | This is obligatory as well. | |
11274 | :description Optional default description for the second pair | |
11275 | of brackets in an Org-mode link. The user can still change | |
11276 | this when inserting this link into an Org-mode buffer. | |
11277 | ||
11278 | In addition to these, any additional properties can be specified | |
11279 | and then used in remember templates.") | |
11280 | ||
11281 | (defun org-add-link-type (type &optional follow publish) | |
11282 | "Add TYPE to the list of `org-link-types'. | |
11283 | Re-compute all regular expressions depending on `org-link-types' | |
11284 | FOLLOW and PUBLISH are two functions. Both take the link path as | |
11285 | an argument. | |
11286 | FOLLOW should do whatever is necessary to follow the link, for example | |
11287 | to find a file or display a mail message. | |
11288 | PUBLISH takes the path and retuns the string that should be used when | |
11289 | this document is published." | |
11290 | (add-to-list 'org-link-types type t) | |
11291 | (org-make-link-regexps) | |
11292 | (add-to-list 'org-link-protocols | |
11293 | (list type follow publish))) | |
11294 | ||
11295 | (defun org-add-agenda-custom-command (entry) | |
11296 | "Replace or add a command in `org-agenda-custom-commands'. | |
11297 | This is mostly for hacking and trying a new command - once the command | |
11298 | works you probably want to add it to `org-agenda-custom-commands' for good." | |
11299 | (let ((ass (assoc (car entry) org-agenda-custom-commands))) | |
11300 | (if ass | |
11301 | (setcdr ass (cdr entry)) | |
11302 | (push entry org-agenda-custom-commands)))) | |
11303 | ||
3278a016 | 11304 | ;;;###autoload |
d3f4dbe8 CD |
11305 | (defun org-store-link (arg) |
11306 | "\\<org-mode-map>Store an org-link to the current location. | |
11307 | This link can later be inserted into an org-buffer with | |
11308 | \\[org-insert-link]. | |
11309 | For some link types, a prefix arg is interpreted: | |
11310 | For links to usenet articles, arg negates `org-usenet-links-prefer-google'. | |
11311 | For file links, arg negates `org-context-in-file-links'." | |
e0e66b8e | 11312 | (interactive "P") |
d3f4dbe8 CD |
11313 | (setq org-store-link-plist nil) ; reset |
11314 | (let (link cpltxt desc description search txt) | |
11315 | (cond | |
891f4676 | 11316 | |
48aaad2d CD |
11317 | ((run-hook-with-args-until-success 'org-store-link-functions) |
11318 | (setq link (plist-get org-store-link-plist :link) | |
11319 | desc (or (plist-get org-store-link-plist :description) link))) | |
11320 | ||
d3f4dbe8 CD |
11321 | ((eq major-mode 'bbdb-mode) |
11322 | (let ((name (bbdb-record-name (bbdb-current-record))) | |
b38c6895 | 11323 | (company (bbdb-record-getprop (bbdb-current-record) 'company))) |
d3f4dbe8 CD |
11324 | (setq cpltxt (concat "bbdb:" (or name company)) |
11325 | link (org-make-link cpltxt)) | |
11326 | (org-store-link-props :type "bbdb" :name name :company company))) | |
a3fbe8c4 | 11327 | |
d3f4dbe8 CD |
11328 | ((eq major-mode 'Info-mode) |
11329 | (setq link (org-make-link "info:" | |
11330 | (file-name-nondirectory Info-current-file) | |
11331 | ":" Info-current-node)) | |
11332 | (setq cpltxt (concat (file-name-nondirectory Info-current-file) | |
11333 | ":" Info-current-node)) | |
11334 | (org-store-link-props :type "info" :file Info-current-file | |
11335 | :node Info-current-node)) | |
891f4676 | 11336 | |
d3f4dbe8 CD |
11337 | ((eq major-mode 'calendar-mode) |
11338 | (let ((cd (calendar-cursor-to-date))) | |
11339 | (setq link | |
11340 | (format-time-string | |
11341 | (car org-time-stamp-formats) | |
11342 | (apply 'encode-time | |
11343 | (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) | |
11344 | nil nil nil)))) | |
11345 | (org-store-link-props :type "calendar" :date cd))) | |
891f4676 | 11346 | |
d3f4dbe8 CD |
11347 | ((or (eq major-mode 'vm-summary-mode) |
11348 | (eq major-mode 'vm-presentation-mode)) | |
11349 | (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) | |
11350 | (vm-follow-summary-cursor) | |
11351 | (save-excursion | |
11352 | (vm-select-folder-buffer) | |
11353 | (let* ((message (car vm-message-pointer)) | |
11354 | (folder buffer-file-name) | |
11355 | (subject (vm-su-subject message)) | |
11356 | (to (vm-get-header-contents message "To")) | |
11357 | (from (vm-get-header-contents message "From")) | |
11358 | (message-id (vm-su-message-id message))) | |
11359 | (org-store-link-props :type "vm" :from from :to to :subject subject | |
11360 | :message-id message-id) | |
11361 | (setq message-id (org-remove-angle-brackets message-id)) | |
11362 | (setq folder (abbreviate-file-name folder)) | |
11363 | (if (string-match (concat "^" (regexp-quote vm-folder-directory)) | |
11364 | folder) | |
11365 | (setq folder (replace-match "" t t folder))) | |
11366 | (setq cpltxt (org-email-link-description)) | |
11367 | (setq link (org-make-link "vm:" folder "#" message-id))))) | |
891f4676 | 11368 | |
d3f4dbe8 CD |
11369 | ((eq major-mode 'wl-summary-mode) |
11370 | (let* ((msgnum (wl-summary-message-number)) | |
11371 | (message-id (elmo-message-field wl-summary-buffer-elmo-folder | |
11372 | msgnum 'message-id)) | |
11373 | (wl-message-entity | |
11374 | (if (fboundp 'elmo-message-entity) | |
11375 | (elmo-message-entity | |
11376 | wl-summary-buffer-elmo-folder msgnum) | |
11377 | (elmo-msgdb-overview-get-entity | |
11378 | msgnum (wl-summary-buffer-msgdb)))) | |
11379 | (from (wl-summary-line-from)) | |
03f3cf35 | 11380 | (to (elmo-message-entity-field wl-message-entity 'to)) |
d3f4dbe8 CD |
11381 | (subject (let (wl-thr-indent-string wl-parent-message-entity) |
11382 | (wl-summary-line-subject)))) | |
11383 | (org-store-link-props :type "wl" :from from :to to | |
11384 | :subject subject :message-id message-id) | |
11385 | (setq message-id (org-remove-angle-brackets message-id)) | |
11386 | (setq cpltxt (org-email-link-description)) | |
11387 | (setq link (org-make-link "wl:" wl-summary-buffer-folder-name | |
11388 | "#" message-id)))) | |
891f4676 | 11389 | |
d3f4dbe8 CD |
11390 | ((or (equal major-mode 'mh-folder-mode) |
11391 | (equal major-mode 'mh-show-mode)) | |
11392 | (let ((from (org-mhe-get-header "From:")) | |
11393 | (to (org-mhe-get-header "To:")) | |
11394 | (message-id (org-mhe-get-header "Message-Id:")) | |
11395 | (subject (org-mhe-get-header "Subject:"))) | |
11396 | (org-store-link-props :type "mh" :from from :to to | |
11397 | :subject subject :message-id message-id) | |
11398 | (setq cpltxt (org-email-link-description)) | |
11399 | (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#" | |
11400 | (org-remove-angle-brackets message-id))))) | |
891f4676 | 11401 | |
d3f4dbe8 CD |
11402 | ((eq major-mode 'rmail-mode) |
11403 | (save-excursion | |
11404 | (save-restriction | |
11405 | (rmail-narrow-to-non-pruned-header) | |
11406 | (let ((folder buffer-file-name) | |
11407 | (message-id (mail-fetch-field "message-id")) | |
11408 | (from (mail-fetch-field "from")) | |
11409 | (to (mail-fetch-field "to")) | |
11410 | (subject (mail-fetch-field "subject"))) | |
11411 | (org-store-link-props | |
11412 | :type "rmail" :from from :to to | |
11413 | :subject subject :message-id message-id) | |
11414 | (setq message-id (org-remove-angle-brackets message-id)) | |
11415 | (setq cpltxt (org-email-link-description)) | |
11416 | (setq link (org-make-link "rmail:" folder "#" message-id)))))) | |
891f4676 | 11417 | |
d3f4dbe8 CD |
11418 | ((eq major-mode 'gnus-group-mode) |
11419 | (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus | |
11420 | (gnus-group-group-name)) ; version | |
11421 | ((fboundp 'gnus-group-name) | |
11422 | (gnus-group-name)) | |
11423 | (t "???")))) | |
11424 | (unless group (error "Not on a group")) | |
11425 | (org-store-link-props :type "gnus" :group group) | |
11426 | (setq cpltxt (concat | |
11427 | (if (org-xor arg org-usenet-links-prefer-google) | |
11428 | "http://groups.google.com/groups?group=" | |
11429 | "gnus:") | |
11430 | group) | |
11431 | link (org-make-link cpltxt)))) | |
891f4676 | 11432 | |
d3f4dbe8 CD |
11433 | ((memq major-mode '(gnus-summary-mode gnus-article-mode)) |
11434 | (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) | |
11435 | (let* ((group gnus-newsgroup-name) | |
11436 | (article (gnus-summary-article-number)) | |
11437 | (header (gnus-summary-article-header article)) | |
11438 | (from (mail-header-from header)) | |
11439 | (message-id (mail-header-id header)) | |
11440 | (date (mail-header-date header)) | |
11441 | (subject (gnus-summary-subject-string))) | |
11442 | (org-store-link-props :type "gnus" :from from :subject subject | |
11443 | :message-id message-id :group group) | |
11444 | (setq cpltxt (org-email-link-description)) | |
11445 | (if (org-xor arg org-usenet-links-prefer-google) | |
11446 | (setq link | |
11447 | (concat | |
11448 | cpltxt "\n " | |
11449 | (format "http://groups.google.com/groups?as_umsgid=%s" | |
11450 | (org-fixup-message-id-for-http message-id)))) | |
11451 | (setq link (org-make-link "gnus:" group | |
11452 | "#" (number-to-string article)))))) | |
891f4676 | 11453 | |
d3f4dbe8 CD |
11454 | ((eq major-mode 'w3-mode) |
11455 | (setq cpltxt (url-view-url t) | |
11456 | link (org-make-link cpltxt)) | |
11457 | (org-store-link-props :type "w3" :url (url-view-url t))) | |
891f4676 | 11458 | |
d3f4dbe8 CD |
11459 | ((eq major-mode 'w3m-mode) |
11460 | (setq cpltxt (or w3m-current-title w3m-current-url) | |
11461 | link (org-make-link w3m-current-url)) | |
11462 | (org-store-link-props :type "w3m" :url (url-view-url t))) | |
891f4676 | 11463 | |
d3f4dbe8 CD |
11464 | ((setq search (run-hook-with-args-until-success |
11465 | 'org-create-file-search-functions)) | |
11466 | (setq link (concat "file:" (abbreviate-file-name buffer-file-name) | |
11467 | "::" search)) | |
11468 | (setq cpltxt (or description link))) | |
891f4676 | 11469 | |
d3f4dbe8 CD |
11470 | ((eq major-mode 'image-mode) |
11471 | (setq cpltxt (concat "file:" | |
11472 | (abbreviate-file-name buffer-file-name)) | |
11473 | link (org-make-link cpltxt)) | |
11474 | (org-store-link-props :type "image" :file buffer-file-name)) | |
891f4676 | 11475 | |
d3f4dbe8 CD |
11476 | ((eq major-mode 'dired-mode) |
11477 | ;; link to the file in the current line | |
11478 | (setq cpltxt (concat "file:" | |
11479 | (abbreviate-file-name | |
11480 | (expand-file-name | |
11481 | (dired-get-filename nil t)))) | |
11482 | link (org-make-link cpltxt))) | |
891f4676 | 11483 | |
d3f4dbe8 CD |
11484 | ((and buffer-file-name (org-mode-p)) |
11485 | ;; Just link to current headline | |
11486 | (setq cpltxt (concat "file:" | |
11487 | (abbreviate-file-name buffer-file-name))) | |
11488 | ;; Add a context search string | |
11489 | (when (org-xor org-context-in-file-links arg) | |
11490 | ;; Check if we are on a target | |
11491 | (if (org-in-regexp "<<\\(.*?\\)>>") | |
11492 | (setq cpltxt (concat cpltxt "::" (match-string 1))) | |
11493 | (setq txt (cond | |
11494 | ((org-on-heading-p) nil) | |
11495 | ((org-region-active-p) | |
11496 | (buffer-substring (region-beginning) (region-end))) | |
11497 | (t (buffer-substring (point-at-bol) (point-at-eol))))) | |
11498 | (when (or (null txt) (string-match "\\S-" txt)) | |
11499 | (setq cpltxt | |
11500 | (concat cpltxt "::" (org-make-org-heading-search-string txt)) | |
11501 | desc "NONE")))) | |
11502 | (if (string-match "::\\'" cpltxt) | |
11503 | (setq cpltxt (substring cpltxt 0 -2))) | |
11504 | (setq link (org-make-link cpltxt))) | |
a3fbe8c4 | 11505 | |
d5098885 | 11506 | ((buffer-file-name (buffer-base-buffer)) |
d3f4dbe8 CD |
11507 | ;; Just link to this file here. |
11508 | (setq cpltxt (concat "file:" | |
d5098885 JW |
11509 | (abbreviate-file-name |
11510 | (buffer-file-name (buffer-base-buffer))))) | |
d3f4dbe8 CD |
11511 | ;; Add a context string |
11512 | (when (org-xor org-context-in-file-links arg) | |
11513 | (setq txt (if (org-region-active-p) | |
11514 | (buffer-substring (region-beginning) (region-end)) | |
11515 | (buffer-substring (point-at-bol) (point-at-eol)))) | |
11516 | ;; Only use search option if there is some text. | |
11517 | (when (string-match "\\S-" txt) | |
11518 | (setq cpltxt | |
11519 | (concat cpltxt "::" (org-make-org-heading-search-string txt)) | |
11520 | desc "NONE"))) | |
11521 | (setq link (org-make-link cpltxt))) | |
891f4676 | 11522 | |
d3f4dbe8 CD |
11523 | ((interactive-p) |
11524 | (error "Cannot link to a buffer which is not visiting a file")) | |
891f4676 | 11525 | |
d3f4dbe8 | 11526 | (t (setq link nil))) |
891f4676 | 11527 | |
d3f4dbe8 CD |
11528 | (if (consp link) (setq cpltxt (car link) link (cdr link))) |
11529 | (setq link (or link cpltxt) | |
11530 | desc (or desc cpltxt)) | |
11531 | (if (equal desc "NONE") (setq desc nil)) | |
891f4676 | 11532 | |
d3f4dbe8 CD |
11533 | (if (and (interactive-p) link) |
11534 | (progn | |
11535 | (setq org-stored-links | |
0b8568f5 JW |
11536 | (cons (list link desc) org-stored-links)) |
11537 | (message "Stored: %s" (or desc link))) | |
374585c9 | 11538 | (and link (org-make-link-string link desc))))) |
d3f4dbe8 CD |
11539 | |
11540 | (defun org-store-link-props (&rest plist) | |
11541 | "Store link properties, extract names and addresses." | |
11542 | (let (x adr) | |
11543 | (when (setq x (plist-get plist :from)) | |
11544 | (setq adr (mail-extract-address-components x)) | |
11545 | (plist-put plist :fromname (car adr)) | |
11546 | (plist-put plist :fromaddress (nth 1 adr))) | |
11547 | (when (setq x (plist-get plist :to)) | |
11548 | (setq adr (mail-extract-address-components x)) | |
11549 | (plist-put plist :toname (car adr)) | |
11550 | (plist-put plist :toaddress (nth 1 adr)))) | |
11551 | (let ((from (plist-get plist :from)) | |
11552 | (to (plist-get plist :to))) | |
11553 | (when (and from to org-from-is-user-regexp) | |
11554 | (plist-put plist :fromto | |
11555 | (if (string-match org-from-is-user-regexp from) | |
11556 | (concat "to %t") | |
11557 | (concat "from %f"))))) | |
11558 | (setq org-store-link-plist plist)) | |
11559 | ||
11560 | (defun org-email-link-description (&optional fmt) | |
11561 | "Return the description part of an email link. | |
11562 | This takes information from `org-store-link-plist' and formats it | |
11563 | according to FMT (default from `org-email-link-description-format')." | |
11564 | (setq fmt (or fmt org-email-link-description-format)) | |
11565 | (let* ((p org-store-link-plist) | |
11566 | (to (plist-get p :toaddress)) | |
11567 | (from (plist-get p :fromaddress)) | |
11568 | (table | |
11569 | (list | |
11570 | (cons "%c" (plist-get p :fromto)) | |
11571 | (cons "%F" (plist-get p :from)) | |
11572 | (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) | |
11573 | (cons "%T" (plist-get p :to)) | |
11574 | (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) | |
11575 | (cons "%s" (plist-get p :subject)) | |
11576 | (cons "%m" (plist-get p :message-id))))) | |
11577 | (when (string-match "%c" fmt) | |
11578 | ;; Check if the user wrote this message | |
11579 | (if (and org-from-is-user-regexp from to | |
11580 | (save-match-data (string-match org-from-is-user-regexp from))) | |
11581 | (setq fmt (replace-match "to %t" t t fmt)) | |
11582 | (setq fmt (replace-match "from %f" t t fmt)))) | |
11583 | (org-replace-escapes fmt table))) | |
11584 | ||
11585 | (defun org-make-org-heading-search-string (&optional string heading) | |
11586 | "Make search string for STRING or current headline." | |
891f4676 | 11587 | (interactive) |
d3f4dbe8 CD |
11588 | (let ((s (or string (org-get-heading)))) |
11589 | (unless (and string (not heading)) | |
11590 | ;; We are using a headline, clean up garbage in there. | |
11591 | (if (string-match org-todo-regexp s) | |
11592 | (setq s (replace-match "" t t s))) | |
5152b597 | 11593 | (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) |
d3f4dbe8 CD |
11594 | (setq s (replace-match "" t t s))) |
11595 | (setq s (org-trim s)) | |
11596 | (if (string-match (concat "^\\(" org-quote-string "\\|" | |
11597 | org-comment-string "\\)") s) | |
11598 | (setq s (replace-match "" t t s))) | |
11599 | (while (string-match org-ts-regexp s) | |
11600 | (setq s (replace-match "" t t s)))) | |
11601 | (while (string-match "[^a-zA-Z_0-9 \t]+" s) | |
11602 | (setq s (replace-match " " t t s))) | |
11603 | (or string (setq s (concat "*" s))) ; Add * for headlines | |
11604 | (mapconcat 'identity (org-split-string s "[ \t]+") " "))) | |
891f4676 | 11605 | |
d3f4dbe8 | 11606 | (defun org-make-link (&rest strings) |
48aaad2d | 11607 | "Concatenate STRINGS." |
d3f4dbe8 | 11608 | (apply 'concat strings)) |
3278a016 | 11609 | |
d3f4dbe8 CD |
11610 | (defun org-make-link-string (link &optional description) |
11611 | "Make a link with brackets, consisting of LINK and DESCRIPTION." | |
374585c9 CD |
11612 | (unless (string-match "\\S-" link) |
11613 | (error "Empty link")) | |
d3f4dbe8 CD |
11614 | (when (stringp description) |
11615 | ;; Remove brackets from the description, they are fatal. | |
11616 | (while (string-match "\\[\\|\\]" description) | |
11617 | (setq description (replace-match "" t t description)))) | |
11618 | (when (equal (org-link-escape link) description) | |
11619 | ;; No description needed, it is identical | |
11620 | (setq description nil)) | |
11621 | (when (and (not description) | |
11622 | (not (equal link (org-link-escape link)))) | |
11623 | (setq description link)) | |
11624 | (concat "[[" (org-link-escape link) "]" | |
11625 | (if description (concat "[" description "]") "") | |
11626 | "]")) | |
891f4676 | 11627 | |
fbe6c10d | 11628 | (defconst org-link-escape-chars |
374585c9 | 11629 | '((" " . "%20") |
d5098885 JW |
11630 | ("[" . "%5B") |
11631 | ("]" . "%5d") | |
374585c9 | 11632 | ("\340" . "%E0") ; `a |
fbe6c10d | 11633 | ("\342" . "%E2") ; ^a |
374585c9 CD |
11634 | ("\347" . "%E7") ; ,c |
11635 | ("\350" . "%E8") ; `e | |
11636 | ("\351" . "%E9") ; 'e | |
11637 | ("\352" . "%EA") ; ^e | |
11638 | ("\356" . "%EE") ; ^i | |
11639 | ("\364" . "%F4") ; ^o | |
11640 | ("\371" . "%F9") ; `u | |
11641 | ("\373" . "%FB") ; ^u | |
11642 | (";" . "%3B") | |
11643 | ("?" . "%3F") | |
11644 | ("=" . "%3D") | |
11645 | ("+" . "%2B") | |
11646 | ) | |
15841868 JW |
11647 | "Association list of escapes for some characters problematic in links. |
11648 | This is the list that is used for internal purposes.") | |
11649 | ||
fbe6c10d | 11650 | (defconst org-link-escape-chars-browser |
15841868 JW |
11651 | '((" " . "%20")) |
11652 | "Association list of escapes for some characters problematic in links. | |
11653 | This is the list that is used before handing over to the browser.") | |
891f4676 | 11654 | |
15841868 | 11655 | (defun org-link-escape (text &optional table) |
d3f4dbe8 | 11656 | "Escape charaters in TEXT that are problematic for links." |
15841868 | 11657 | (setq table (or table org-link-escape-chars)) |
d3f4dbe8 CD |
11658 | (when text |
11659 | (let ((re (mapconcat (lambda (x) (regexp-quote (car x))) | |
15841868 | 11660 | table "\\|"))) |
d3f4dbe8 CD |
11661 | (while (string-match re text) |
11662 | (setq text | |
11663 | (replace-match | |
15841868 | 11664 | (cdr (assoc (match-string 0 text) table)) |
d3f4dbe8 CD |
11665 | t t text))) |
11666 | text))) | |
891f4676 | 11667 | |
15841868 | 11668 | (defun org-link-unescape (text &optional table) |
d3f4dbe8 | 11669 | "Reverse the action of `org-link-escape'." |
15841868 | 11670 | (setq table (or table org-link-escape-chars)) |
d3f4dbe8 CD |
11671 | (when text |
11672 | (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) | |
15841868 | 11673 | table "\\|"))) |
d3f4dbe8 CD |
11674 | (while (string-match re text) |
11675 | (setq text | |
11676 | (replace-match | |
15841868 | 11677 | (car (rassoc (match-string 0 text) table)) |
d3f4dbe8 CD |
11678 | t t text))) |
11679 | text))) | |
11680 | ||
11681 | (defun org-xor (a b) | |
11682 | "Exclusive or." | |
11683 | (if a (not b) b)) | |
11684 | ||
11685 | (defun org-get-header (header) | |
11686 | "Find a header field in the current buffer." | |
11687 | (save-excursion | |
7ac93e3c | 11688 | (goto-char (point-min)) |
d3f4dbe8 CD |
11689 | (let ((case-fold-search t) s) |
11690 | (cond | |
11691 | ((eq header 'from) | |
11692 | (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) | |
11693 | (setq s (match-string 1))) | |
11694 | (while (string-match "\"" s) | |
11695 | (setq s (replace-match "" t t s))) | |
11696 | (if (string-match "[<(].*" s) | |
11697 | (setq s (replace-match "" t t s)))) | |
11698 | ((eq header 'message-id) | |
11699 | (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) | |
11700 | (setq s (match-string 1)))) | |
11701 | ((eq header 'subject) | |
11702 | (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) | |
11703 | (setq s (match-string 1))))) | |
11704 | (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) | |
11705 | (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) | |
11706 | s))) | |
7ac93e3c | 11707 | |
891f4676 | 11708 | |
d3f4dbe8 CD |
11709 | (defun org-fixup-message-id-for-http (s) |
11710 | "Replace special characters in a message id, so it can be used in an http query." | |
11711 | (while (string-match "<" s) | |
11712 | (setq s (replace-match "%3C" t t s))) | |
11713 | (while (string-match ">" s) | |
11714 | (setq s (replace-match "%3E" t t s))) | |
11715 | (while (string-match "@" s) | |
11716 | (setq s (replace-match "%40" t t s))) | |
11717 | s) | |
891f4676 | 11718 | |
48aaad2d CD |
11719 | ;;;###autoload |
11720 | (defun org-insert-link-global () | |
11721 | "Insert a link like Org-mode does. | |
374585c9 | 11722 | This command can be called in any mode to insert a link in Org-mode syntax." |
48aaad2d CD |
11723 | (interactive) |
11724 | (org-run-like-in-org-mode 'org-insert-link)) | |
11725 | ||
d3f4dbe8 CD |
11726 | (defun org-insert-link (&optional complete-file) |
11727 | "Insert a link. At the prompt, enter the link. | |
891f4676 | 11728 | |
d3f4dbe8 CD |
11729 | Completion can be used to select a link previously stored with |
11730 | `org-store-link'. When the empty string is entered (i.e. if you just | |
11731 | press RET at the prompt), the link defaults to the most recently | |
11732 | stored link. As SPC triggers completion in the minibuffer, you need to | |
11733 | use M-SPC or C-q SPC to force the insertion of a space character. | |
eb2f9c59 | 11734 | |
d3f4dbe8 CD |
11735 | You will also be prompted for a description, and if one is given, it will |
11736 | be displayed in the buffer instead of the link. | |
eb2f9c59 | 11737 | |
d3f4dbe8 CD |
11738 | If there is already a link at point, this command will allow you to edit link |
11739 | and description parts. | |
eb2f9c59 | 11740 | |
d3f4dbe8 CD |
11741 | With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be |
11742 | selected using completion. The path to the file will be relative to | |
11743 | the current directory if the file is in the current directory or a | |
11744 | subdirectory. Otherwise, the link will be the absolute path as | |
11745 | completed in the minibuffer (i.e. normally ~/path/to/file). | |
c8d16429 | 11746 | |
d3f4dbe8 CD |
11747 | With two \\[universal-argument] prefixes, enforce an absolute path even if the file |
11748 | is in the current directory or below. | |
11749 | With three \\[universal-argument] prefixes, negate the meaning of | |
11750 | `org-keep-stored-link-after-insertion'." | |
11751 | (interactive "P") | |
15841868 JW |
11752 | (let* ((wcf (current-window-configuration)) |
11753 | (region (if (org-region-active-p) | |
11754 | (buffer-substring (region-beginning) (region-end)))) | |
11755 | (remove (and region (list (region-beginning) (region-end)))) | |
11756 | (desc region) | |
11757 | tmphist ; byte-compile incorrectly complains about this | |
11758 | link entry file) | |
d3f4dbe8 CD |
11759 | (cond |
11760 | ((org-in-regexp org-bracket-link-regexp 1) | |
11761 | ;; We do have a link at point, and we are going to edit it. | |
11762 | (setq remove (list (match-beginning 0) (match-end 0))) | |
11763 | (setq desc (if (match-end 3) (org-match-string-no-properties 3))) | |
11764 | (setq link (read-string "Link: " | |
11765 | (org-link-unescape | |
11766 | (org-match-string-no-properties 1))))) | |
11767 | ((or (org-in-regexp org-angle-link-re) | |
11768 | (org-in-regexp org-plain-link-re)) | |
11769 | ;; Convert to bracket link | |
11770 | (setq remove (list (match-beginning 0) (match-end 0)) | |
11771 | link (read-string "Link: " | |
11772 | (org-remove-angle-brackets (match-string 0))))) | |
11773 | ((equal complete-file '(4)) | |
11774 | ;; Completing read for file names. | |
11775 | (setq file (read-file-name "File: ")) | |
11776 | (let ((pwd (file-name-as-directory (expand-file-name "."))) | |
11777 | (pwd1 (file-name-as-directory (abbreviate-file-name | |
11778 | (expand-file-name "."))))) | |
11779 | (cond | |
11780 | ((equal complete-file '(16)) | |
11781 | (setq link (org-make-link | |
11782 | "file:" | |
11783 | (abbreviate-file-name (expand-file-name file))))) | |
11784 | ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) | |
11785 | (setq link (org-make-link "file:" (match-string 1 file)))) | |
11786 | ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") | |
11787 | (expand-file-name file)) | |
11788 | (setq link (org-make-link | |
11789 | "file:" (match-string 1 (expand-file-name file))))) | |
11790 | (t (setq link (org-make-link "file:" file)))))) | |
11791 | (t | |
11792 | ;; Read link, with completion for stored links. | |
a3fbe8c4 CD |
11793 | (with-output-to-temp-buffer "*Org Links*" |
11794 | (princ "Insert a link. Use TAB to complete valid link prefixes.\n") | |
11795 | (when org-stored-links | |
15841868 | 11796 | (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") |
0b8568f5 JW |
11797 | (princ (mapconcat |
11798 | (lambda (x) | |
11799 | (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) | |
11800 | (reverse org-stored-links) "\n")))) | |
a3fbe8c4 CD |
11801 | (let ((cw (selected-window))) |
11802 | (select-window (get-buffer-window "*Org Links*")) | |
11803 | (shrink-window-if-larger-than-buffer) | |
11804 | (setq truncate-lines t) | |
11805 | (select-window cw)) | |
11806 | ;; Fake a link history, containing the stored links. | |
d3f4dbe8 CD |
11807 | (setq tmphist (append (mapcar 'car org-stored-links) |
11808 | org-insert-link-history)) | |
a3fbe8c4 CD |
11809 | (unwind-protect |
11810 | (setq link (org-completing-read | |
11811 | "Link: " | |
11812 | (append | |
1e8fbb6d | 11813 | (mapcar (lambda (x) (list (concat (car x) ":"))) |
a3fbe8c4 | 11814 | (append org-link-abbrev-alist-local org-link-abbrev-alist)) |
1e8fbb6d CD |
11815 | (mapcar (lambda (x) (list (concat x ":"))) |
11816 | org-link-types)) | |
a3fbe8c4 CD |
11817 | nil nil nil |
11818 | 'tmphist | |
11819 | (or (car (car org-stored-links))))) | |
11820 | (set-window-configuration wcf) | |
11821 | (kill-buffer "*Org Links*")) | |
d3f4dbe8 CD |
11822 | (setq entry (assoc link org-stored-links)) |
11823 | (or entry (push link org-insert-link-history)) | |
11824 | (if (funcall (if (equal complete-file '(64)) 'not 'identity) | |
11825 | (not org-keep-stored-link-after-insertion)) | |
11826 | (setq org-stored-links (delq (assoc link org-stored-links) | |
11827 | org-stored-links))) | |
15841868 | 11828 | (setq desc (or desc (nth 1 entry))))) |
fbe6c10d | 11829 | |
d3f4dbe8 CD |
11830 | (if (string-match org-plain-link-re link) |
11831 | ;; URL-like link, normalize the use of angular brackets. | |
11832 | (setq link (org-make-link (org-remove-angle-brackets link)))) | |
6e2752e7 | 11833 | |
d3f4dbe8 CD |
11834 | ;; Check if we are linking to the current file with a search option |
11835 | ;; If yes, simplify the link by using only the search option. | |
11836 | (when (and buffer-file-name | |
11837 | (string-match "\\<file:\\(.+?\\)::\\([^>]+\\)" link)) | |
11838 | (let* ((path (match-string 1 link)) | |
11839 | (case-fold-search nil) | |
11840 | (search (match-string 2 link))) | |
11841 | (save-match-data | |
11842 | (if (equal (file-truename buffer-file-name) (file-truename path)) | |
11843 | ;; We are linking to this same file, with a search option | |
11844 | (setq link search))))) | |
64f72ae1 | 11845 | |
d3f4dbe8 CD |
11846 | ;; Check if we can/should use a relative path. If yes, simplify the link |
11847 | (when (string-match "\\<file:\\(.*\\)" link) | |
11848 | (let* ((path (match-string 1 link)) | |
15841868 | 11849 | (origpath path) |
0b8568f5 | 11850 | (desc-is-link (equal link desc)) |
d3f4dbe8 CD |
11851 | (case-fold-search nil)) |
11852 | (cond | |
11853 | ((eq org-link-file-path-type 'absolute) | |
11854 | (setq path (abbreviate-file-name (expand-file-name path)))) | |
11855 | ((eq org-link-file-path-type 'noabbrev) | |
11856 | (setq path (expand-file-name path))) | |
11857 | ((eq org-link-file-path-type 'relative) | |
11858 | (setq path (file-relative-name path))) | |
11859 | (t | |
11860 | (save-match-data | |
11861 | (if (string-match (concat "^" (regexp-quote | |
11862 | (file-name-as-directory | |
11863 | (expand-file-name ".")))) | |
11864 | (expand-file-name path)) | |
11865 | ;; We are linking a file with relative path name. | |
11866 | (setq path (substring (expand-file-name path) | |
11867 | (match-end 0))))))) | |
0b8568f5 | 11868 | (setq link (concat "file:" path)) |
15841868 JW |
11869 | (if (equal desc origpath) |
11870 | (setq desc path)))) | |
eb2f9c59 | 11871 | |
d3f4dbe8 CD |
11872 | (setq desc (read-string "Description: " desc)) |
11873 | (unless (string-match "\\S-" desc) (setq desc nil)) | |
11874 | (if remove (apply 'delete-region remove)) | |
11875 | (insert (org-make-link-string link desc)))) | |
3278a016 | 11876 | |
d3f4dbe8 CD |
11877 | (defun org-completing-read (&rest args) |
11878 | (let ((minibuffer-local-completion-map | |
11879 | (copy-keymap minibuffer-local-completion-map))) | |
a3fbe8c4 | 11880 | (org-defkey minibuffer-local-completion-map " " 'self-insert-command) |
d3f4dbe8 | 11881 | (apply 'completing-read args))) |
eb2f9c59 | 11882 | |
d3f4dbe8 CD |
11883 | ;;; Opening/following a link |
11884 | (defvar org-link-search-failed nil) | |
634a7d0b | 11885 | |
d3f4dbe8 CD |
11886 | (defun org-next-link () |
11887 | "Move forward to the next link. | |
11888 | If the link is in hidden text, expose it." | |
11889 | (interactive) | |
11890 | (when (and org-link-search-failed (eq this-command last-command)) | |
11891 | (goto-char (point-min)) | |
11892 | (message "Link search wrapped back to beginning of buffer")) | |
11893 | (setq org-link-search-failed nil) | |
11894 | (let* ((pos (point)) | |
11895 | (ct (org-context)) | |
11896 | (a (assoc :link ct))) | |
11897 | (if a (goto-char (nth 2 a))) | |
11898 | (if (re-search-forward org-any-link-re nil t) | |
11899 | (progn | |
11900 | (goto-char (match-beginning 0)) | |
11901 | (if (org-invisible-p) (org-show-context))) | |
11902 | (goto-char pos) | |
11903 | (setq org-link-search-failed t) | |
11904 | (error "No further link found")))) | |
3278a016 | 11905 | |
d3f4dbe8 CD |
11906 | (defun org-previous-link () |
11907 | "Move backward to the previous link. | |
11908 | If the link is in hidden text, expose it." | |
11909 | (interactive) | |
11910 | (when (and org-link-search-failed (eq this-command last-command)) | |
11911 | (goto-char (point-max)) | |
11912 | (message "Link search wrapped back to end of buffer")) | |
11913 | (setq org-link-search-failed nil) | |
11914 | (let* ((pos (point)) | |
11915 | (ct (org-context)) | |
11916 | (a (assoc :link ct))) | |
11917 | (if a (goto-char (nth 1 a))) | |
11918 | (if (re-search-backward org-any-link-re nil t) | |
11919 | (progn | |
11920 | (goto-char (match-beginning 0)) | |
11921 | (if (org-invisible-p) (org-show-context))) | |
11922 | (goto-char pos) | |
11923 | (setq org-link-search-failed t) | |
11924 | (error "No further link found")))) | |
891f4676 | 11925 | |
d3f4dbe8 CD |
11926 | (defun org-find-file-at-mouse (ev) |
11927 | "Open file link or URL at mouse." | |
11928 | (interactive "e") | |
11929 | (mouse-set-point ev) | |
11930 | (org-open-at-point 'in-emacs)) | |
891f4676 | 11931 | |
d3f4dbe8 CD |
11932 | (defun org-open-at-mouse (ev) |
11933 | "Open file link or URL at mouse." | |
11934 | (interactive "e") | |
11935 | (mouse-set-point ev) | |
11936 | (org-open-at-point)) | |
d943b3c6 | 11937 | |
d3f4dbe8 CD |
11938 | (defvar org-window-config-before-follow-link nil |
11939 | "The window configuration before following a link. | |
11940 | This is saved in case the need arises to restore it.") | |
891f4676 | 11941 | |
d3f4dbe8 CD |
11942 | (defvar org-open-link-marker (make-marker) |
11943 | "Marker pointing to the location where `org-open-at-point; was called.") | |
891f4676 | 11944 | |
48aaad2d CD |
11945 | ;;;###autoload |
11946 | (defun org-open-at-point-global () | |
11947 | "Follow a link like Org-mode does. | |
11948 | This command can be called in any mode to follow a link that has | |
11949 | Org-mode syntax." | |
11950 | (interactive) | |
11951 | (org-run-like-in-org-mode 'org-open-at-point)) | |
11952 | ||
d3f4dbe8 CD |
11953 | (defun org-open-at-point (&optional in-emacs) |
11954 | "Open link at or after point. | |
11955 | If there is no link at point, this function will search forward up to | |
11956 | the end of the current subtree. | |
11957 | Normally, files will be opened by an appropriate application. If the | |
11958 | optional argument IN-EMACS is non-nil, Emacs will visit the file." | |
11959 | (interactive "P") | |
11960 | (move-marker org-open-link-marker (point)) | |
11961 | (setq org-window-config-before-follow-link (current-window-configuration)) | |
11962 | (org-remove-occur-highlights nil nil t) | |
11963 | (if (org-at-timestamp-p t) | |
11964 | (org-follow-timestamp-link) | |
11965 | (let (type path link line search (pos (point))) | |
11966 | (catch 'match | |
11967 | (save-excursion | |
11968 | (skip-chars-forward "^]\n\r") | |
11969 | (when (org-in-regexp org-bracket-link-regexp) | |
11970 | (setq link (org-link-unescape (org-match-string-no-properties 1))) | |
11971 | (while (string-match " *\n *" link) | |
11972 | (setq link (replace-match " " t t link))) | |
11973 | (setq link (org-link-expand-abbrev link)) | |
11974 | (if (string-match org-link-re-with-space2 link) | |
11975 | (setq type (match-string 1 link) path (match-string 2 link)) | |
11976 | (setq type "thisfile" path link)) | |
11977 | (throw 'match t))) | |
3278a016 | 11978 | |
d3f4dbe8 CD |
11979 | (when (get-text-property (point) 'org-linked-text) |
11980 | (setq type "thisfile" | |
11981 | pos (if (get-text-property (1+ (point)) 'org-linked-text) | |
11982 | (1+ (point)) (point)) | |
11983 | path (buffer-substring | |
11984 | (previous-single-property-change pos 'org-linked-text) | |
11985 | (next-single-property-change pos 'org-linked-text))) | |
11986 | (throw 'match t)) | |
891f4676 | 11987 | |
d3f4dbe8 CD |
11988 | (save-excursion |
11989 | (when (or (org-in-regexp org-angle-link-re) | |
11990 | (org-in-regexp org-plain-link-re)) | |
11991 | (setq type (match-string 1) path (match-string 2)) | |
11992 | (throw 'match t))) | |
b38c6895 CD |
11993 | (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") |
11994 | (setq type "tree-match" | |
11995 | path (match-string 1)) | |
11996 | (throw 'match t)) | |
d3f4dbe8 | 11997 | (save-excursion |
5152b597 | 11998 | (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) |
d3f4dbe8 CD |
11999 | (setq type "tags" |
12000 | path (match-string 1)) | |
12001 | (while (string-match ":" path) | |
12002 | (setq path (replace-match "+" t t path))) | |
12003 | (throw 'match t)))) | |
12004 | (unless path | |
12005 | (error "No link found")) | |
12006 | ;; Remove any trailing spaces in path | |
12007 | (if (string-match " +\\'" path) | |
12008 | (setq path (replace-match "" t t path))) | |
891f4676 | 12009 | |
d3f4dbe8 | 12010 | (cond |
891f4676 | 12011 | |
48aaad2d CD |
12012 | ((assoc type org-link-protocols) |
12013 | (funcall (nth 1 (assoc type org-link-protocols)) path)) | |
12014 | ||
d3f4dbe8 CD |
12015 | ((equal type "mailto") |
12016 | (let ((cmd (car org-link-mailto-program)) | |
12017 | (args (cdr org-link-mailto-program)) args1 | |
12018 | (address path) (subject "") a) | |
12019 | (if (string-match "\\(.*\\)::\\(.*\\)" path) | |
12020 | (setq address (match-string 1 path) | |
12021 | subject (org-link-escape (match-string 2 path)))) | |
12022 | (while args | |
12023 | (cond | |
12024 | ((not (stringp (car args))) (push (pop args) args1)) | |
12025 | (t (setq a (pop args)) | |
12026 | (if (string-match "%a" a) | |
12027 | (setq a (replace-match address t t a))) | |
12028 | (if (string-match "%s" a) | |
12029 | (setq a (replace-match subject t t a))) | |
12030 | (push a args1)))) | |
12031 | (apply cmd (nreverse args1)))) | |
70a539ca | 12032 | |
d3f4dbe8 | 12033 | ((member type '("http" "https" "ftp" "news")) |
15841868 JW |
12034 | (browse-url (concat type ":" (org-link-escape |
12035 | path org-link-escape-chars-browser)))) | |
891f4676 | 12036 | |
d3f4dbe8 CD |
12037 | ((string= type "tags") |
12038 | (org-tags-view in-emacs path)) | |
12039 | ((string= type "thisfile") | |
12040 | (if in-emacs | |
12041 | (switch-to-buffer-other-window | |
12042 | (org-get-buffer-for-internal-link (current-buffer))) | |
12043 | (org-mark-ring-push)) | |
7d58338e CD |
12044 | (let ((cmd `(org-link-search |
12045 | ,path | |
12046 | ,(cond ((equal in-emacs '(4)) 'occur) | |
12047 | ((equal in-emacs '(16)) 'org-occur) | |
12048 | (t nil)) | |
12049 | ,pos))) | |
12050 | (condition-case nil (eval cmd) | |
12051 | (error (progn (widen) (eval cmd)))))) | |
500f86e0 | 12052 | |
b38c6895 CD |
12053 | ((string= type "tree-match") |
12054 | (org-occur (concat "\\[" (regexp-quote path) "\\]"))) | |
12055 | ||
d3f4dbe8 CD |
12056 | ((string= type "file") |
12057 | (if (string-match "::\\([0-9]+\\)\\'" path) | |
12058 | (setq line (string-to-number (match-string 1 path)) | |
12059 | path (substring path 0 (match-beginning 0))) | |
12060 | (if (string-match "::\\(.+\\)\\'" path) | |
12061 | (setq search (match-string 1 path) | |
12062 | path (substring path 0 (match-beginning 0))))) | |
12063 | (org-open-file path in-emacs line search)) | |
891f4676 | 12064 | |
d3f4dbe8 CD |
12065 | ((string= type "news") |
12066 | (org-follow-gnus-link path)) | |
891f4676 | 12067 | |
d3f4dbe8 CD |
12068 | ((string= type "bbdb") |
12069 | (org-follow-bbdb-link path)) | |
891f4676 | 12070 | |
d3f4dbe8 CD |
12071 | ((string= type "info") |
12072 | (org-follow-info-link path)) | |
891f4676 | 12073 | |
d3f4dbe8 CD |
12074 | ((string= type "gnus") |
12075 | (let (group article) | |
12076 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
12077 | (error "Error in Gnus link")) | |
12078 | (setq group (match-string 1 path) | |
12079 | article (match-string 3 path)) | |
12080 | (org-follow-gnus-link group article))) | |
891f4676 | 12081 | |
d3f4dbe8 CD |
12082 | ((string= type "vm") |
12083 | (let (folder article) | |
12084 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
12085 | (error "Error in VM link")) | |
12086 | (setq folder (match-string 1 path) | |
12087 | article (match-string 3 path)) | |
12088 | ;; in-emacs is the prefix arg, will be interpreted as read-only | |
12089 | (org-follow-vm-link folder article in-emacs))) | |
ef943dba | 12090 | |
d3f4dbe8 CD |
12091 | ((string= type "wl") |
12092 | (let (folder article) | |
12093 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
12094 | (error "Error in Wanderlust link")) | |
12095 | (setq folder (match-string 1 path) | |
12096 | article (match-string 3 path)) | |
12097 | (org-follow-wl-link folder article))) | |
891f4676 | 12098 | |
d3f4dbe8 CD |
12099 | ((string= type "mhe") |
12100 | (let (folder article) | |
12101 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
12102 | (error "Error in MHE link")) | |
12103 | (setq folder (match-string 1 path) | |
12104 | article (match-string 3 path)) | |
12105 | (org-follow-mhe-link folder article))) | |
35fb9989 | 12106 | |
d3f4dbe8 CD |
12107 | ((string= type "rmail") |
12108 | (let (folder article) | |
12109 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
12110 | (error "Error in RMAIL link")) | |
12111 | (setq folder (match-string 1 path) | |
12112 | article (match-string 3 path)) | |
12113 | (org-follow-rmail-link folder article))) | |
35fb9989 | 12114 | |
d3f4dbe8 CD |
12115 | ((string= type "shell") |
12116 | (let ((cmd path)) | |
15841868 | 12117 | ;; The following is only for backward compatibility |
d3f4dbe8 CD |
12118 | (while (string-match "@{" cmd) (setq cmd (replace-match "<" t t cmd))) |
12119 | (while (string-match "@}" cmd) (setq cmd (replace-match ">" t t cmd))) | |
12120 | (if (or (not org-confirm-shell-link-function) | |
12121 | (funcall org-confirm-shell-link-function | |
12122 | (format "Execute \"%s\" in shell? " | |
12123 | (org-add-props cmd nil | |
12124 | 'face 'org-warning)))) | |
12125 | (progn | |
12126 | (message "Executing %s" cmd) | |
12127 | (shell-command cmd)) | |
12128 | (error "Abort")))) | |
3278a016 | 12129 | |
d3f4dbe8 CD |
12130 | ((string= type "elisp") |
12131 | (let ((cmd path)) | |
12132 | (if (or (not org-confirm-elisp-link-function) | |
12133 | (funcall org-confirm-elisp-link-function | |
12134 | (format "Execute \"%s\" as elisp? " | |
12135 | (org-add-props cmd nil | |
12136 | 'face 'org-warning)))) | |
12137 | (message "%s => %s" cmd (eval (read cmd))) | |
12138 | (error "Abort")))) | |
891f4676 | 12139 | |
d3f4dbe8 CD |
12140 | (t |
12141 | (browse-url-at-point))))) | |
12142 | (move-marker org-open-link-marker nil)) | |
891f4676 | 12143 | |
d3f4dbe8 | 12144 | ;;; File search |
891f4676 | 12145 | |
d3f4dbe8 CD |
12146 | (defvar org-create-file-search-functions nil |
12147 | "List of functions to construct the right search string for a file link. | |
12148 | These functions are called in turn with point at the location to | |
12149 | which the link should point. | |
a96ee7df | 12150 | |
d3f4dbe8 CD |
12151 | A function in the hook should first test if it would like to |
12152 | handle this file type, for example by checking the major-mode or | |
12153 | the file extension. If it decides not to handle this file, it | |
12154 | should just return nil to give other functions a chance. If it | |
12155 | does handle the file, it must return the search string to be used | |
12156 | when following the link. The search string will be part of the | |
12157 | file link, given after a double colon, and `org-open-at-point' | |
12158 | will automatically search for it. If special measures must be | |
12159 | taken to make the search successful, another function should be | |
12160 | added to the companion hook `org-execute-file-search-functions', | |
12161 | which see. | |
d924f2e5 | 12162 | |
d3f4dbe8 CD |
12163 | A function in this hook may also use `setq' to set the variable |
12164 | `description' to provide a suggestion for the descriptive text to | |
12165 | be used for this link when it gets inserted into an Org-mode | |
12166 | buffer with \\[org-insert-link].") | |
891f4676 | 12167 | |
d3f4dbe8 CD |
12168 | (defvar org-execute-file-search-functions nil |
12169 | "List of functions to execute a file search triggered by a link. | |
891f4676 | 12170 | |
d3f4dbe8 CD |
12171 | Functions added to this hook must accept a single argument, the |
12172 | search string that was part of the file link, the part after the | |
12173 | double colon. The function must first check if it would like to | |
12174 | handle this search, for example by checking the major-mode or the | |
12175 | file extension. If it decides not to handle this search, it | |
12176 | should just return nil to give other functions a chance. If it | |
12177 | does handle the search, it must return a non-nil value to keep | |
12178 | other functions from trying. | |
891f4676 | 12179 | |
d3f4dbe8 CD |
12180 | Each function can access the current prefix argument through the |
12181 | variable `current-prefix-argument'. Note that a single prefix is | |
12182 | used to force opening a link in Emacs, so it may be good to only | |
12183 | use a numeric or double prefix to guide the search function. | |
4b3a9ba7 | 12184 | |
d3f4dbe8 CD |
12185 | In case this is needed, a function in this hook can also restore |
12186 | the window configuration before `org-open-at-point' was called using: | |
4b3a9ba7 | 12187 | |
d3f4dbe8 | 12188 | (set-window-configuration org-window-config-before-follow-link)") |
891f4676 | 12189 | |
d3f4dbe8 CD |
12190 | (defun org-link-search (s &optional type avoid-pos) |
12191 | "Search for a link search option. | |
12192 | If S is surrounded by forward slashes, it is interpreted as a | |
12193 | regular expression. In org-mode files, this will create an `org-occur' | |
12194 | sparse tree. In ordinary files, `occur' will be used to list matches. | |
12195 | If the current buffer is in `dired-mode', grep will be used to search | |
12196 | in all files. If AVOID-POS is given, ignore matches near that position." | |
12197 | (let ((case-fold-search t) | |
12198 | (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) | |
a3fbe8c4 | 12199 | (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) |
7d58338e | 12200 | (append '(("") (" ") ("\t") ("\n")) |
a3fbe8c4 CD |
12201 | org-emphasis-alist) |
12202 | "\\|") "\\)")) | |
d3f4dbe8 CD |
12203 | (pos (point)) |
12204 | (pre "") (post "") | |
12205 | words re0 re1 re2 re3 re4 re5 re2a reall) | |
12206 | (cond | |
12207 | ;; First check if there are any special | |
12208 | ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) | |
12209 | ;; Now try the builtin stuff | |
12210 | ((save-excursion | |
12211 | (goto-char (point-min)) | |
12212 | (and | |
12213 | (re-search-forward | |
12214 | (concat "<<" (regexp-quote s0) ">>") nil t) | |
12215 | (setq pos (match-beginning 0)))) | |
12216 | ;; There is an exact target for this | |
12217 | (goto-char pos)) | |
12218 | ((string-match "^/\\(.*\\)/$" s) | |
12219 | ;; A regular expression | |
12220 | (cond | |
12221 | ((org-mode-p) | |
12222 | (org-occur (match-string 1 s))) | |
12223 | ;;((eq major-mode 'dired-mode) | |
12224 | ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) | |
12225 | (t (org-do-occur (match-string 1 s))))) | |
12226 | (t | |
7d58338e | 12227 | ;; A normal search strings |
d3f4dbe8 CD |
12228 | (when (equal (string-to-char s) ?*) |
12229 | ;; Anchor on headlines, post may include tags. | |
7d58338e | 12230 | (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" |
5152b597 | 12231 | post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") |
d3f4dbe8 CD |
12232 | s (substring s 1))) |
12233 | (remove-text-properties | |
12234 | 0 (length s) | |
12235 | '(face nil mouse-face nil keymap nil fontified nil) s) | |
12236 | ;; Make a series of regular expressions to find a match | |
12237 | (setq words (org-split-string s "[ \n\r\t]+") | |
12238 | re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") | |
a3fbe8c4 CD |
12239 | re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") |
12240 | "\\)" markers) | |
d3f4dbe8 CD |
12241 | re2a (concat "[ \t\r\n]\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") |
12242 | re4 (concat "[^a-zA-Z_]\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") | |
12243 | re1 (concat pre re2 post) | |
12244 | re3 (concat pre re4 post) | |
12245 | re5 (concat pre ".*" re4) | |
12246 | re2 (concat pre re2) | |
12247 | re2a (concat pre re2a) | |
12248 | re4 (concat pre re4) | |
12249 | reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 | |
12250 | "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" | |
12251 | re5 "\\)" | |
12252 | )) | |
12253 | (cond | |
12254 | ((eq type 'org-occur) (org-occur reall)) | |
12255 | ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) | |
12256 | (t (goto-char (point-min)) | |
12257 | (if (or (org-search-not-self 1 re0 nil t) | |
12258 | (org-search-not-self 1 re1 nil t) | |
12259 | (org-search-not-self 1 re2 nil t) | |
12260 | (org-search-not-self 1 re2a nil t) | |
12261 | (org-search-not-self 1 re3 nil t) | |
12262 | (org-search-not-self 1 re4 nil t) | |
12263 | (org-search-not-self 1 re5 nil t) | |
12264 | ) | |
12265 | (goto-char (match-beginning 1)) | |
12266 | (goto-char pos) | |
12267 | (error "No match"))))) | |
12268 | (t | |
12269 | ;; Normal string-search | |
12270 | (goto-char (point-min)) | |
12271 | (if (search-forward s nil t) | |
12272 | (goto-char (match-beginning 0)) | |
12273 | (error "No match")))) | |
12274 | (and (org-mode-p) (org-show-context 'link-search)))) | |
edd21304 | 12275 | |
d3f4dbe8 CD |
12276 | (defun org-search-not-self (group &rest args) |
12277 | "Execute `re-search-forward', but only accept matches that do not | |
12278 | enclose the position of `org-open-link-marker'." | |
12279 | (let ((m org-open-link-marker)) | |
12280 | (catch 'exit | |
12281 | (while (apply 're-search-forward args) | |
a3fbe8c4 CD |
12282 | (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 |
12283 | (goto-char (match-end group)) | |
12284 | (if (and (or (not (eq (marker-buffer m) (current-buffer))) | |
12285 | (> (match-beginning 0) (marker-position m)) | |
12286 | (< (match-end 0) (marker-position m))) | |
12287 | (save-match-data | |
12288 | (or (not (org-in-regexp | |
12289 | org-bracket-link-analytic-regexp 1)) | |
12290 | (not (match-end 4)) ; no description | |
12291 | (and (<= (match-beginning 4) (point)) | |
12292 | (>= (match-end 4) (point)))))) | |
12293 | (throw 'exit (point)))))))) | |
ef943dba | 12294 | |
d3f4dbe8 CD |
12295 | (defun org-get-buffer-for-internal-link (buffer) |
12296 | "Return a buffer to be used for displaying the link target of internal links." | |
12297 | (cond | |
12298 | ((not org-display-internal-link-with-indirect-buffer) | |
12299 | buffer) | |
12300 | ((string-match "(Clone)$" (buffer-name buffer)) | |
12301 | (message "Buffer is already a clone, not making another one") | |
12302 | ;; we also do not modify visibility in this case | |
12303 | buffer) | |
12304 | (t ; make a new indirect buffer for displaying the link | |
12305 | (let* ((bn (buffer-name buffer)) | |
12306 | (ibn (concat bn "(Clone)")) | |
12307 | (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone)))) | |
12308 | (with-current-buffer ib (org-overview)) | |
12309 | ib)))) | |
ef943dba | 12310 | |
d3f4dbe8 CD |
12311 | (defun org-do-occur (regexp &optional cleanup) |
12312 | "Call the Emacs command `occur'. | |
12313 | If CLEANUP is non-nil, remove the printout of the regular expression | |
12314 | in the *Occur* buffer. This is useful if the regex is long and not useful | |
12315 | to read." | |
12316 | (occur regexp) | |
12317 | (when cleanup | |
12318 | (let ((cwin (selected-window)) win beg end) | |
12319 | (when (setq win (get-buffer-window "*Occur*")) | |
12320 | (select-window win)) | |
12321 | (goto-char (point-min)) | |
12322 | (when (re-search-forward "match[a-z]+" nil t) | |
12323 | (setq beg (match-end 0)) | |
12324 | (if (re-search-forward "^[ \t]*[0-9]+" nil t) | |
12325 | (setq end (1- (match-beginning 0))))) | |
48aaad2d | 12326 | (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) |
d3f4dbe8 CD |
12327 | (goto-char (point-min)) |
12328 | (select-window cwin)))) | |
ef943dba | 12329 | |
d3f4dbe8 | 12330 | ;;; The mark ring for links jumps |
ef943dba | 12331 | |
d3f4dbe8 CD |
12332 | (defvar org-mark-ring nil |
12333 | "Mark ring for positions before jumps in Org-mode.") | |
12334 | (defvar org-mark-ring-last-goto nil | |
12335 | "Last position in the mark ring used to go back.") | |
12336 | ;; Fill and close the ring | |
12337 | (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded | |
12338 | (loop for i from 1 to org-mark-ring-length do | |
12339 | (push (make-marker) org-mark-ring)) | |
12340 | (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) | |
12341 | org-mark-ring) | |
ef943dba | 12342 | |
d3f4dbe8 CD |
12343 | (defun org-mark-ring-push (&optional pos buffer) |
12344 | "Put the current position or POS into the mark ring and rotate it." | |
ef943dba | 12345 | (interactive) |
d3f4dbe8 CD |
12346 | (setq pos (or pos (point))) |
12347 | (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring)) | |
12348 | (move-marker (car org-mark-ring) | |
12349 | (or pos (point)) | |
12350 | (or buffer (current-buffer))) | |
274f1353 | 12351 | (message "%s" |
d3f4dbe8 CD |
12352 | (substitute-command-keys |
12353 | "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) | |
ef943dba | 12354 | |
d3f4dbe8 CD |
12355 | (defun org-mark-ring-goto (&optional n) |
12356 | "Jump to the previous position in the mark ring. | |
12357 | With prefix arg N, jump back that many stored positions. When | |
12358 | called several times in succession, walk through the entire ring. | |
12359 | Org-mode commands jumping to a different position in the current file, | |
12360 | or to another Org-mode file, automatically push the old position | |
12361 | onto the ring." | |
12362 | (interactive "p") | |
12363 | (let (p m) | |
12364 | (if (eq last-command this-command) | |
12365 | (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring))) | |
12366 | (setq p org-mark-ring)) | |
12367 | (setq org-mark-ring-last-goto p) | |
12368 | (setq m (car p)) | |
12369 | (switch-to-buffer (marker-buffer m)) | |
12370 | (goto-char m) | |
12371 | (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) | |
35fb9989 | 12372 | |
d3f4dbe8 CD |
12373 | (defun org-remove-angle-brackets (s) |
12374 | (if (equal (substring s 0 1) "<") (setq s (substring s 1))) | |
12375 | (if (equal (substring s -1) ">") (setq s (substring s 0 -1))) | |
12376 | s) | |
12377 | (defun org-add-angle-brackets (s) | |
12378 | (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s))) | |
12379 | (if (equal (substring s -1) ">") nil (setq s (concat s ">"))) | |
12380 | s) | |
ef943dba | 12381 | |
d3f4dbe8 | 12382 | ;;; Following specific links |
4da1a99d | 12383 | |
d3f4dbe8 CD |
12384 | (defun org-follow-timestamp-link () |
12385 | (cond | |
12386 | ((org-at-date-range-p t) | |
12387 | (let ((org-agenda-start-on-weekday) | |
12388 | (t1 (match-string 1)) | |
12389 | (t2 (match-string 2))) | |
12390 | (setq t1 (time-to-days (org-time-string-to-time t1)) | |
12391 | t2 (time-to-days (org-time-string-to-time t2))) | |
12392 | (org-agenda-list nil t1 (1+ (- t2 t1))))) | |
12393 | ((org-at-timestamp-p t) | |
12394 | (org-agenda-list nil (time-to-days (org-time-string-to-time | |
12395 | (substring (match-string 1) 0 10))) | |
12396 | 1)) | |
12397 | (t (error "This should not happen")))) | |
4da1a99d | 12398 | |
4da1a99d | 12399 | |
d3f4dbe8 CD |
12400 | (defun org-follow-bbdb-link (name) |
12401 | "Follow a BBDB link to NAME." | |
12402 | (require 'bbdb) | |
12403 | (let ((inhibit-redisplay (not debug-on-error)) | |
12404 | (bbdb-electric-p nil)) | |
12405 | (catch 'exit | |
12406 | ;; Exact match on name | |
12407 | (bbdb-name (concat "\\`" name "\\'") nil) | |
12408 | (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) | |
12409 | ;; Exact match on name | |
12410 | (bbdb-company (concat "\\`" name "\\'") nil) | |
12411 | (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) | |
12412 | ;; Partial match on name | |
12413 | (bbdb-name name nil) | |
12414 | (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) | |
12415 | ;; Partial match on company | |
12416 | (bbdb-company name nil) | |
12417 | (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) | |
12418 | ;; General match including network address and notes | |
12419 | (bbdb name nil) | |
12420 | (when (= 0 (buffer-size (get-buffer "*BBDB*"))) | |
12421 | (delete-window (get-buffer-window "*BBDB*")) | |
12422 | (error "No matching BBDB record"))))) | |
3278a016 | 12423 | |
d3f4dbe8 CD |
12424 | (defun org-follow-info-link (name) |
12425 | "Follow an info file & node link to NAME." | |
12426 | (if (or (string-match "\\(.*\\)::?\\(.*\\)" name) | |
12427 | (string-match "\\(.*\\)" name)) | |
12428 | (progn | |
12429 | (require 'info) | |
12430 | (if (match-string 2 name) ; If there isn't a node, choose "Top" | |
12431 | (Info-find-node (match-string 1 name) (match-string 2 name)) | |
12432 | (Info-find-node (match-string 1 name) "Top"))) | |
274f1353 | 12433 | (message "Could not open: %s" name))) |
3278a016 | 12434 | |
d3f4dbe8 CD |
12435 | (defun org-follow-gnus-link (&optional group article) |
12436 | "Follow a Gnus link to GROUP and ARTICLE." | |
12437 | (require 'gnus) | |
12438 | (funcall (cdr (assq 'gnus org-link-frame-setup))) | |
12439 | (if gnus-other-frame-object (select-frame gnus-other-frame-object)) | |
12440 | (cond ((and group article) | |
a3fbe8c4 | 12441 | (gnus-group-read-group 1 nil group) |
d3f4dbe8 CD |
12442 | (gnus-summary-goto-article (string-to-number article) nil t)) |
12443 | (group (gnus-group-jump-to-group group)))) | |
3278a016 | 12444 | |
d3f4dbe8 CD |
12445 | (defun org-follow-vm-link (&optional folder article readonly) |
12446 | "Follow a VM link to FOLDER and ARTICLE." | |
12447 | (require 'vm) | |
12448 | (setq article (org-add-angle-brackets article)) | |
12449 | (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) | |
12450 | ;; ange-ftp or efs or tramp access | |
12451 | (let ((user (or (match-string 1 folder) (user-login-name))) | |
12452 | (host (match-string 2 folder)) | |
12453 | (file (match-string 3 folder))) | |
12454 | (cond | |
12455 | ((featurep 'tramp) | |
12456 | ;; use tramp to access the file | |
12457 | (if (featurep 'xemacs) | |
12458 | (setq folder (format "[%s@%s]%s" user host file)) | |
12459 | (setq folder (format "/%s@%s:%s" user host file)))) | |
12460 | (t | |
12461 | ;; use ange-ftp or efs | |
12462 | (require (if (featurep 'xemacs) 'efs 'ange-ftp)) | |
12463 | (setq folder (format "/%s@%s:%s" user host file)))))) | |
12464 | (when folder | |
12465 | (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) | |
12466 | (sit-for 0.1) | |
12467 | (when article | |
12468 | (vm-select-folder-buffer) | |
12469 | (widen) | |
12470 | (let ((case-fold-search t)) | |
12471 | (goto-char (point-min)) | |
12472 | (if (not (re-search-forward | |
12473 | (concat "^" "message-id: *" (regexp-quote article)))) | |
12474 | (error "Could not find the specified message in this folder")) | |
12475 | (vm-isearch-update) | |
12476 | (vm-isearch-narrow) | |
12477 | (vm-beginning-of-message) | |
12478 | (vm-summarize))))) | |
3278a016 | 12479 | |
d3f4dbe8 CD |
12480 | (defun org-follow-wl-link (folder article) |
12481 | "Follow a Wanderlust link to FOLDER and ARTICLE." | |
12482 | (if (and (string= folder "%") | |
12483 | article | |
12484 | (string-match "^\\([^#]+\\)\\(#\\(.*\\)\\)?" article)) | |
12485 | ;; XXX: imap-uw supports folders starting with '#' such as "#mh/inbox". | |
12486 | ;; Thus, we recompose folder and article ids. | |
12487 | (setq folder (format "%s#%s" folder (match-string 1 article)) | |
12488 | article (match-string 3 article))) | |
12489 | (if (not (elmo-folder-exists-p (wl-folder-get-elmo-folder folder))) | |
12490 | (error "No such folder: %s" folder)) | |
12491 | (wl-summary-goto-folder-subr folder 'no-sync t nil t nil nil) | |
12492 | (and article | |
12493 | (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets article)) | |
12494 | (wl-summary-redisplay))) | |
3278a016 | 12495 | |
d3f4dbe8 CD |
12496 | (defun org-follow-rmail-link (folder article) |
12497 | "Follow an RMAIL link to FOLDER and ARTICLE." | |
12498 | (setq article (org-add-angle-brackets article)) | |
12499 | (let (message-number) | |
12500 | (save-excursion | |
12501 | (save-window-excursion | |
12502 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
12503 | (setq message-number | |
4da1a99d | 12504 | (save-restriction |
d3f4dbe8 CD |
12505 | (widen) |
12506 | (goto-char (point-max)) | |
12507 | (if (re-search-backward | |
12508 | (concat "^Message-ID:\\s-+" (regexp-quote | |
12509 | (or article ""))) | |
12510 | nil t) | |
12511 | (rmail-what-message)))))) | |
12512 | (if message-number | |
12513 | (progn | |
12514 | (rmail (if (string= folder "RMAIL") rmail-file-name folder)) | |
12515 | (rmail-show-message message-number) | |
12516 | message-number) | |
12517 | (error "Message not found")))) | |
4da1a99d | 12518 | |
d3f4dbe8 CD |
12519 | ;;; mh-e integration based on planner-mode |
12520 | (defun org-mhe-get-message-real-folder () | |
12521 | "Return the name of the current message real folder, so if you use | |
12522 | sequences, it will now work." | |
12523 | (save-excursion | |
12524 | (let* ((folder | |
12525 | (if (equal major-mode 'mh-folder-mode) | |
12526 | mh-current-folder | |
12527 | ;; Refer to the show buffer | |
12528 | mh-show-folder-buffer)) | |
12529 | (end-index | |
12530 | (if (boundp 'mh-index-folder) | |
12531 | (min (length mh-index-folder) (length folder)))) | |
12532 | ) | |
12533 | ;; a simple test on mh-index-data does not work, because | |
12534 | ;; mh-index-data is always nil in a show buffer. | |
12535 | (if (and (boundp 'mh-index-folder) | |
12536 | (string= mh-index-folder (substring folder 0 end-index))) | |
12537 | (if (equal major-mode 'mh-show-mode) | |
12538 | (save-window-excursion | |
374585c9 CD |
12539 | (let (pop-up-frames) |
12540 | (when (buffer-live-p (get-buffer folder)) | |
12541 | (progn | |
12542 | (pop-to-buffer folder) | |
12543 | (org-mhe-get-message-folder-from-index) | |
12544 | ) | |
12545 | ))) | |
d3f4dbe8 CD |
12546 | (org-mhe-get-message-folder-from-index) |
12547 | ) | |
12548 | folder | |
12549 | ) | |
12550 | ))) | |
4da1a99d | 12551 | |
d3f4dbe8 CD |
12552 | (defun org-mhe-get-message-folder-from-index () |
12553 | "Returns the name of the message folder in a index folder buffer." | |
12554 | (save-excursion | |
12555 | (mh-index-previous-folder) | |
12556 | (re-search-forward "^\\(+.*\\)$" nil t) | |
274f1353 | 12557 | (message "%s" (match-string 1)))) |
4b3a9ba7 | 12558 | |
d3f4dbe8 CD |
12559 | (defun org-mhe-get-message-folder () |
12560 | "Return the name of the current message folder. Be careful if you | |
12561 | use sequences." | |
3278a016 | 12562 | (save-excursion |
d3f4dbe8 CD |
12563 | (if (equal major-mode 'mh-folder-mode) |
12564 | mh-current-folder | |
12565 | ;; Refer to the show buffer | |
12566 | mh-show-folder-buffer))) | |
4b3a9ba7 | 12567 | |
d3f4dbe8 CD |
12568 | (defun org-mhe-get-message-num () |
12569 | "Return the number of the current message. Be careful if you | |
12570 | use sequences." | |
4da1a99d | 12571 | (save-excursion |
d3f4dbe8 CD |
12572 | (if (equal major-mode 'mh-folder-mode) |
12573 | (mh-get-msg-num nil) | |
12574 | ;; Refer to the show buffer | |
12575 | (mh-show-buffer-message-number)))) | |
4da1a99d | 12576 | |
d3f4dbe8 CD |
12577 | (defun org-mhe-get-header (header) |
12578 | "Return a header of the message in folder mode. This will create a | |
12579 | show buffer for the corresponding message. If you have a more clever | |
12580 | idea..." | |
12581 | (let* ((folder (org-mhe-get-message-folder)) | |
12582 | (num (org-mhe-get-message-num)) | |
12583 | (buffer (get-buffer-create (concat "show-" folder))) | |
12584 | (header-field)) | |
12585 | (with-current-buffer buffer | |
12586 | (mh-display-msg num folder) | |
12587 | (if (equal major-mode 'mh-folder-mode) | |
12588 | (mh-header-display) | |
12589 | (mh-show-header-display)) | |
12590 | (set-buffer buffer) | |
12591 | (setq header-field (mh-get-header-field header)) | |
12592 | (if (equal major-mode 'mh-folder-mode) | |
12593 | (mh-show) | |
12594 | (mh-show-show)) | |
12595 | header-field))) | |
4da1a99d | 12596 | |
d3f4dbe8 CD |
12597 | (defun org-follow-mhe-link (folder article) |
12598 | "Follow an MHE link to FOLDER and ARTICLE. | |
12599 | If ARTICLE is nil FOLDER is shown. If the configuration variable | |
12600 | `org-mhe-search-all-folders' is t and `mh-searcher' is pick, | |
12601 | ARTICLE is searched in all folders. Indexed searches (swish++, | |
12602 | namazu, and others supported by MH-E) will always search in all | |
12603 | folders." | |
12604 | (require 'mh-e) | |
12605 | (require 'mh-search) | |
12606 | (require 'mh-utils) | |
12607 | (mh-find-path) | |
12608 | (if (not article) | |
12609 | (mh-visit-folder (mh-normalize-folder-name folder)) | |
12610 | (setq article (org-add-angle-brackets article)) | |
12611 | (mh-search-choose) | |
12612 | (if (equal mh-searcher 'pick) | |
12613 | (progn | |
12614 | (mh-search folder (list "--message-id" article)) | |
12615 | (when (and org-mhe-search-all-folders | |
12616 | (not (org-mhe-get-message-real-folder))) | |
12617 | (kill-this-buffer) | |
12618 | (mh-search "+" (list "--message-id" article)))) | |
12619 | (mh-search "+" article)) | |
12620 | (if (org-mhe-get-message-real-folder) | |
12621 | (mh-show-msg 1) | |
12622 | (kill-this-buffer) | |
12623 | (error "Message not found")))) | |
891f4676 | 12624 | |
d3f4dbe8 | 12625 | ;;; BibTeX links |
4b3a9ba7 | 12626 | |
d3f4dbe8 CD |
12627 | ;; Use the custom search meachnism to construct and use search strings for |
12628 | ;; file links to BibTeX database entries. | |
4b3a9ba7 | 12629 | |
d3f4dbe8 CD |
12630 | (defun org-create-file-search-in-bibtex () |
12631 | "Create the search string and description for a BibTeX database entry." | |
12632 | (when (eq major-mode 'bibtex-mode) | |
12633 | ;; yes, we want to construct this search string. | |
12634 | ;; Make a good description for this entry, using names, year and the title | |
12635 | ;; Put it into the `description' variable which is dynamically scoped. | |
12636 | (let ((bibtex-autokey-names 1) | |
12637 | (bibtex-autokey-names-stretch 1) | |
12638 | (bibtex-autokey-name-case-convert-function 'identity) | |
12639 | (bibtex-autokey-name-separator " & ") | |
12640 | (bibtex-autokey-additional-names " et al.") | |
12641 | (bibtex-autokey-year-length 4) | |
12642 | (bibtex-autokey-name-year-separator " ") | |
12643 | (bibtex-autokey-titlewords 3) | |
12644 | (bibtex-autokey-titleword-separator " ") | |
12645 | (bibtex-autokey-titleword-case-convert-function 'identity) | |
12646 | (bibtex-autokey-titleword-length 'infty) | |
12647 | (bibtex-autokey-year-title-separator ": ")) | |
12648 | (setq description (bibtex-generate-autokey))) | |
12649 | ;; Now parse the entry, get the key and return it. | |
12650 | (save-excursion | |
12651 | (bibtex-beginning-of-entry) | |
12652 | (cdr (assoc "=key=" (bibtex-parse-entry)))))) | |
4b3a9ba7 | 12653 | |
d3f4dbe8 CD |
12654 | (defun org-execute-file-search-in-bibtex (s) |
12655 | "Find the link search string S as a key for a database entry." | |
12656 | (when (eq major-mode 'bibtex-mode) | |
12657 | ;; Yes, we want to do the search in this file. | |
12658 | ;; We construct a regexp that searches for "@entrytype{" followed by the key | |
12659 | (goto-char (point-min)) | |
12660 | (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*" | |
12661 | (regexp-quote s) "[ \t\n]*,") nil t) | |
12662 | (goto-char (match-beginning 0))) | |
12663 | (if (and (match-beginning 0) (equal current-prefix-arg '(16))) | |
12664 | ;; Use double prefix to indicate that any web link should be browsed | |
12665 | (let ((b (current-buffer)) (p (point))) | |
12666 | ;; Restore the window configuration because we just use the web link | |
12667 | (set-window-configuration org-window-config-before-follow-link) | |
12668 | (save-excursion (set-buffer b) (goto-char p) | |
12669 | (bibtex-url))) | |
12670 | (recenter 0)) ; Move entry start to beginning of window | |
12671 | ;; return t to indicate that the search is done. | |
12672 | t)) | |
4b3a9ba7 | 12673 | |
d3f4dbe8 CD |
12674 | ;; Finally add the functions to the right hooks. |
12675 | (add-hook 'org-create-file-search-functions 'org-create-file-search-in-bibtex) | |
12676 | (add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) | |
4b3a9ba7 | 12677 | |
d3f4dbe8 | 12678 | ;; end of Bibtex link setup |
4b3a9ba7 | 12679 | |
d3f4dbe8 | 12680 | ;;; Following file links |
4b3a9ba7 | 12681 | |
d3f4dbe8 CD |
12682 | (defun org-open-file (path &optional in-emacs line search) |
12683 | "Open the file at PATH. | |
12684 | First, this expands any special file name abbreviations. Then the | |
12685 | configuration variable `org-file-apps' is checked if it contains an | |
12686 | entry for this file type, and if yes, the corresponding command is launched. | |
12687 | If no application is found, Emacs simply visits the file. | |
12688 | With optional argument IN-EMACS, Emacs will visit the file. | |
12689 | Optional LINE specifies a line to go to, optional SEARCH a string to | |
12690 | search for. If LINE or SEARCH is given, the file will always be | |
12691 | opened in Emacs. | |
12692 | If the file does not exist, an error is thrown." | |
12693 | (setq in-emacs (or in-emacs line search)) | |
12694 | (let* ((file (if (equal path "") | |
12695 | buffer-file-name | |
12696 | (substitute-in-file-name (expand-file-name path)))) | |
12697 | (apps (append org-file-apps (org-default-apps))) | |
12698 | (remp (and (assq 'remote apps) (org-file-remote-p file))) | |
12699 | (dirp (if remp nil (file-directory-p file))) | |
12700 | (dfile (downcase file)) | |
12701 | (old-buffer (current-buffer)) | |
12702 | (old-pos (point)) | |
12703 | (old-mode major-mode) | |
12704 | ext cmd) | |
12705 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) | |
12706 | (setq ext (match-string 1 dfile)) | |
12707 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) | |
12708 | (setq ext (match-string 1 dfile)))) | |
12709 | (if in-emacs | |
12710 | (setq cmd 'emacs) | |
12711 | (setq cmd (or (and remp (cdr (assoc 'remote apps))) | |
12712 | (and dirp (cdr (assoc 'directory apps))) | |
12713 | (cdr (assoc ext apps)) | |
12714 | (cdr (assoc t apps))))) | |
12715 | (when (eq cmd 'mailcap) | |
12716 | (require 'mailcap) | |
12717 | (mailcap-parse-mailcaps) | |
12718 | (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) | |
12719 | (command (mailcap-mime-info mime-type))) | |
12720 | (if (stringp command) | |
12721 | (setq cmd command) | |
12722 | (setq cmd 'emacs)))) | |
a3fbe8c4 | 12723 | (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files |
d3f4dbe8 CD |
12724 | (not (file-exists-p file)) |
12725 | (not org-open-non-existing-files)) | |
12726 | (error "No such file: %s" file)) | |
12727 | (cond | |
12728 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | |
12729 | ;; Remove quotes around the file name - we'll use shell-quote-argument. | |
12730 | (if (string-match "['\"]%s['\"]" cmd) | |
12731 | (setq cmd (replace-match "%s" t t cmd))) | |
12732 | (setq cmd (format cmd (shell-quote-argument file))) | |
12733 | (save-window-excursion | |
15841868 | 12734 | (start-process-shell-command cmd nil cmd))) |
d3f4dbe8 CD |
12735 | ((or (stringp cmd) |
12736 | (eq cmd 'emacs)) | |
12737 | (funcall (cdr (assq 'file org-link-frame-setup)) file) | |
7d58338e | 12738 | (widen) |
d3f4dbe8 CD |
12739 | (if line (goto-line line) |
12740 | (if search (org-link-search search)))) | |
12741 | ((consp cmd) | |
12742 | (eval cmd)) | |
12743 | (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) | |
12744 | (and (org-mode-p) (eq old-mode 'org-mode) | |
12745 | (or (not (equal old-buffer (current-buffer))) | |
12746 | (not (equal old-pos (point)))) | |
12747 | (org-mark-ring-push old-pos old-buffer)))) | |
4b3a9ba7 | 12748 | |
d3f4dbe8 CD |
12749 | (defun org-default-apps () |
12750 | "Return the default applications for this operating system." | |
12751 | (cond | |
12752 | ((eq system-type 'darwin) | |
12753 | org-file-apps-defaults-macosx) | |
12754 | ((eq system-type 'windows-nt) | |
12755 | org-file-apps-defaults-windowsnt) | |
12756 | (t org-file-apps-defaults-gnu))) | |
891f4676 | 12757 | |
d3f4dbe8 CD |
12758 | (defvar ange-ftp-name-format) ; to silence the XEmacs compiler. |
12759 | (defun org-file-remote-p (file) | |
12760 | "Test whether FILE specifies a location on a remote system. | |
12761 | Return non-nil if the location is indeed remote. | |
4b3a9ba7 | 12762 | |
d3f4dbe8 CD |
12763 | For example, the filename \"/user@host:/foo\" specifies a location |
12764 | on the system \"/user@host:\"." | |
12765 | (cond ((fboundp 'file-remote-p) | |
12766 | (file-remote-p file)) | |
12767 | ((fboundp 'tramp-handle-file-remote-p) | |
12768 | (tramp-handle-file-remote-p file)) | |
12769 | ((and (boundp 'ange-ftp-name-format) | |
12770 | (string-match (car ange-ftp-name-format) file)) | |
12771 | t) | |
12772 | (t nil))) | |
a96ee7df | 12773 | |
a96ee7df | 12774 | |
d3f4dbe8 | 12775 | ;;;; Hooks for remember.el |
b0a10108 | 12776 | |
d3f4dbe8 CD |
12777 | ;;;###autoload |
12778 | (defun org-remember-annotation () | |
12779 | "Return a link to the current location as an annotation for remember.el. | |
12780 | If you are using Org-mode files as target for data storage with | |
12781 | remember.el, then the annotations should include a link compatible with the | |
12782 | conventions in Org-mode. This function returns such a link." | |
12783 | (org-store-link nil)) | |
b0a10108 | 12784 | |
d3f4dbe8 CD |
12785 | (defconst org-remember-help |
12786 | "Select a destination location for the note. | |
12787 | UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store | |
d3f4dbe8 | 12788 | RET on headline -> Store as sublevel entry to current headline |
d5098885 | 12789 | RET at beg-of-buf -> Append to file as level 2 headline |
d3f4dbe8 | 12790 | <left>/<right> -> before/after current headline, same headings level") |
3278a016 | 12791 | |
d5098885 | 12792 | (defvar org-remember-previous-location nil) |
15841868 | 12793 | (defvar org-force-remember-template-char) ;; dynamically scoped |
d5098885 | 12794 | |
d3f4dbe8 CD |
12795 | ;;;###autoload |
12796 | (defun org-remember-apply-template (&optional use-char skip-interactive) | |
12797 | "Initialize *remember* buffer with template, invoke `org-mode'. | |
12798 | This function should be placed into `remember-mode-hook' and in fact requires | |
12799 | to be run from that hook to fucntion properly." | |
12800 | (if org-remember-templates | |
03f3cf35 JW |
12801 | (let* ((templates (mapcar (lambda (x) |
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 | |
15841868 | 12807 | (cond |
03f3cf35 JW |
12808 | ((= (length templates) 1) |
12809 | (caar templates)) | |
15841868 JW |
12810 | ((and (boundp 'org-force-remember-template-char) |
12811 | org-force-remember-template-char) | |
03f3cf35 | 12812 | (if (stringp org-force-remember-template-char) |
15841868 JW |
12813 | (string-to-char org-force-remember-template-char) |
12814 | org-force-remember-template-char)) | |
12815 | (t | |
d3f4dbe8 CD |
12816 | (message "Select template: %s" |
12817 | (mapconcat | |
03f3cf35 JW |
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))) | |
d3f4dbe8 CD |
12833 | (tpl (car entry)) |
12834 | (plist-p (if org-store-link-plist t nil)) | |
12835 | (file (if (and (nth 1 entry) (stringp (nth 1 entry)) | |
12836 | (string-match "\\S-" (nth 1 entry))) | |
12837 | (nth 1 entry) | |
12838 | org-default-notes-file)) | |
12839 | (headline (nth 2 entry)) | |
12840 | (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))) | |
12842 | (v-u (concat "[" (substring v-t 1 -1) "]")) | |
12843 | (v-U (concat "[" (substring v-T 1 -1) "]")) | |
03f3cf35 JW |
12844 | ;; `initial' and `annotation' are bound in `remember' |
12845 | (v-i (if (boundp 'initial) initial)) | |
12846 | (v-a (if (and (boundp 'annotation) annotation) | |
12847 | (if (equal annotation "[[]]") "" annotation) | |
12848 | "")) | |
d5098885 JW |
12849 | (v-A (if (and v-a |
12850 | (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) | |
0b8568f5 JW |
12851 | (replace-match "[\\1[%^{Link description}]]" nil nil v-a) |
12852 | v-a)) | |
d3f4dbe8 CD |
12853 | (v-n user-full-name) |
12854 | (org-startup-folded nil) | |
b38c6895 | 12855 | org-time-was-given org-end-time-was-given x prompt char time) |
d3f4dbe8 | 12856 | (setq org-store-link-plist |
1e8fbb6d CD |
12857 | (append (list :annotation v-a :initial v-i) |
12858 | org-store-link-plist)) | |
d3f4dbe8 CD |
12859 | (unless tpl (setq tpl "") (message "No template") (ding)) |
12860 | (erase-buffer) | |
12861 | (insert (substitute-command-keys | |
12862 | (format | |
d5098885 JW |
12863 | "## Filing location: Select interactively, default, or last used: |
12864 | ## %s to select file and header location interactively. | |
12865 | ## %s \"%s\" -> \"* %s\" | |
12866 | ## C-u C-u C-c C-c \"%s\" -> \"* %s\" | |
03f3cf35 | 12867 | ## To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n" |
d5098885 JW |
12868 | (if org-remember-store-without-prompt " C-u C-c C-c" " C-c C-c") |
12869 | (if org-remember-store-without-prompt " C-c C-c" " C-u C-c C-c") | |
d3f4dbe8 | 12870 | (abbreviate-file-name (or file org-default-notes-file)) |
d5098885 JW |
12871 | (or headline "") |
12872 | (or (car org-remember-previous-location) "???") | |
12873 | (or (cdr org-remember-previous-location) "???")))) | |
d3f4dbe8 CD |
12874 | (insert tpl) (goto-char (point-min)) |
12875 | ;; Simple %-escapes | |
0b8568f5 | 12876 | (while (re-search-forward "%\\([tTuUaiA]\\)" nil t) |
d3f4dbe8 CD |
12877 | (when (and initial (equal (match-string 0) "%i")) |
12878 | (save-match-data | |
12879 | (let* ((lead (buffer-substring | |
12880 | (point-at-bol) (match-beginning 0)))) | |
12881 | (setq v-i (mapconcat 'identity | |
12882 | (org-split-string initial "\n") | |
12883 | (concat "\n" lead)))))) | |
12884 | (replace-match | |
12885 | (or (eval (intern (concat "v-" (match-string 1)))) "") | |
12886 | t t)) | |
12887 | ;; From the property list | |
12888 | (when plist-p | |
12889 | (goto-char (point-min)) | |
12890 | (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) | |
12891 | (and (setq x (plist-get org-store-link-plist | |
12892 | (intern (match-string 1)))) | |
12893 | (replace-match x t t)))) | |
12894 | ;; Turn on org-mode in the remember buffer, set local variables | |
12895 | (org-mode) | |
12896 | (org-set-local 'org-finish-function 'remember-buffer) | |
12897 | (if (and file (string-match "\\S-" file) (not (file-directory-p file))) | |
12898 | (org-set-local 'org-default-notes-file file)) | |
12899 | (if (and headline (stringp headline) (string-match "\\S-" headline)) | |
12900 | (org-set-local 'org-remember-default-headline headline)) | |
12901 | ;; Interactive template entries | |
12902 | (goto-char (point-min)) | |
38f8646b | 12903 | (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([guUtT]\\)?" nil t) |
d3f4dbe8 CD |
12904 | (setq char (if (match-end 3) (match-string 3)) |
12905 | prompt (if (match-end 2) (match-string 2))) | |
12906 | (goto-char (match-beginning 0)) | |
12907 | (replace-match "") | |
38f8646b CD |
12908 | (cond |
12909 | ((member char '("G" "g")) | |
12910 | (let* ((org-last-tags-completion-table | |
12911 | (org-global-tags-completion-table | |
12912 | (if (equal char "G") (org-agenda-files) (and file (list file))))) | |
7d58338e | 12913 | (org-add-colon-after-tag-completion t) |
38f8646b CD |
12914 | (ins (completing-read |
12915 | (if prompt (concat prompt ": ") "Tags: ") | |
12916 | 'org-tags-completion-function nil nil nil | |
12917 | 'org-tags-history))) | |
7d58338e CD |
12918 | (setq ins (mapconcat 'identity |
12919 | (org-split-string ins (org-re "[^[:alnum:]]+")) | |
12920 | ":")) | |
12921 | (when (string-match "\\S-" ins) | |
12922 | (or (equal (char-before) ?:) (insert ":")) | |
12923 | (insert ins) | |
fbe6c10d | 12924 | (or (equal (char-after) ?:) (insert ":"))))) |
38f8646b CD |
12925 | (char |
12926 | (setq org-time-was-given (equal (upcase char) char)) | |
12927 | (setq time (org-read-date (equal (upcase char) "U") t nil | |
12928 | prompt)) | |
12929 | (org-insert-time-stamp time org-time-was-given | |
12930 | (member char '("u" "U")) | |
12931 | nil nil (list org-end-time-was-given))) | |
12932 | (t | |
d3f4dbe8 | 12933 | (insert (read-string |
38f8646b | 12934 | (if prompt (concat prompt ": ") "Enter string")))))) |
d3f4dbe8 CD |
12935 | (goto-char (point-min)) |
12936 | (if (re-search-forward "%\\?" nil t) | |
12937 | (replace-match "") | |
12938 | (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) | |
12939 | (org-mode) | |
12940 | (org-set-local 'org-finish-function 'remember-buffer))) | |
b0a10108 | 12941 | |
d3f4dbe8 | 12942 | ;;;###autoload |
15841868 | 12943 | (defun org-remember (&optional org-force-remember-template-char) |
d3f4dbe8 CD |
12944 | "Call `remember'. If this is already a remember buffer, re-apply template. |
12945 | If there is an active region, make sure remember uses it as initial content | |
12946 | of the remember buffer." | |
12947 | (interactive) | |
12948 | (if (eq org-finish-function 'remember-buffer) | |
12949 | (progn | |
12950 | (when (< (length org-remember-templates) 2) | |
12951 | (error "No other template available")) | |
12952 | (erase-buffer) | |
12953 | (let ((annotation (plist-get org-store-link-plist :annotation)) | |
12954 | (initial (plist-get org-store-link-plist :initial))) | |
12955 | (org-remember-apply-template)) | |
12956 | (message "Press C-c C-c to remember data")) | |
12957 | (if (org-region-active-p) | |
12958 | (remember (buffer-substring (point) (mark))) | |
12959 | (call-interactively 'remember)))) | |
b0a10108 | 12960 | |
03f3cf35 JW |
12961 | (defvar org-note-abort nil) ; dynamically scoped |
12962 | ||
d3f4dbe8 CD |
12963 | ;;;###autoload |
12964 | (defun org-remember-handler () | |
12965 | "Store stuff from remember.el into an org file. | |
12966 | First prompts for an org file. If the user just presses return, the value | |
12967 | of `org-default-notes-file' is used. | |
12968 | Then the command offers the headings tree of the selected file in order to | |
12969 | file the text at a specific location. | |
12970 | You can either immediately press RET to get the note appended to the | |
12971 | file, or you can use vertical cursor motion and visibility cycling (TAB) to | |
12972 | find a better place. Then press RET or <left> or <right> in insert the note. | |
b0a10108 | 12973 | |
d3f4dbe8 CD |
12974 | Key Cursor position Note gets inserted |
12975 | ----------------------------------------------------------------------------- | |
d5098885 | 12976 | RET buffer-start as level 1 heading at end of file |
d3f4dbe8 CD |
12977 | RET on headline as sublevel of the heading at cursor |
12978 | RET no heading at cursor position, level taken from context. | |
12979 | Or use prefix arg to specify level manually. | |
12980 | <left> on headline as same level, before current heading | |
12981 | <right> on headline as same level, after current heading | |
b0a10108 | 12982 | |
d3f4dbe8 CD |
12983 | So the fastest way to store the note is to press RET RET to append it to |
12984 | the default file. This way your current train of thought is not | |
48aaad2d CD |
12985 | interrupted, in accordance with the principles of remember.el. |
12986 | You can also get the fast execution without prompting by using | |
12987 | C-u C-c C-c to exit the remember buffer. See also the variable | |
12988 | `org-remember-store-without-prompt'. | |
4b3a9ba7 | 12989 | |
d3f4dbe8 CD |
12990 | Before being stored away, the function ensures that the text has a |
12991 | headline, i.e. a first line that starts with a \"*\". If not, a headline | |
12992 | is constructed from the current date and some additional data. | |
b0a10108 | 12993 | |
d3f4dbe8 CD |
12994 | If the variable `org-adapt-indentation' is non-nil, the entire text is |
12995 | also indented so that it starts in the same column as the headline | |
12996 | \(i.e. after the stars). | |
b0a10108 | 12997 | |
d3f4dbe8 CD |
12998 | See also the variable `org-reverse-note-order'." |
12999 | (goto-char (point-min)) | |
13000 | (while (looking-at "^[ \t]*\n\\|^##.*\n") | |
13001 | (replace-match "")) | |
15841868 JW |
13002 | (goto-char (point-max)) |
13003 | (unless (equal (char-before) ?\n) (insert "\n")) | |
d3f4dbe8 | 13004 | (catch 'quit |
03f3cf35 | 13005 | (if org-note-abort (throw 'quit nil)) |
d3f4dbe8 | 13006 | (let* ((txt (buffer-substring (point-min) (point-max))) |
48aaad2d CD |
13007 | (fastp (org-xor (equal current-prefix-arg '(4)) |
13008 | org-remember-store-without-prompt)) | |
d3f4dbe8 CD |
13009 | (file (if fastp org-default-notes-file (org-get-org-file))) |
13010 | (heading org-remember-default-headline) | |
13011 | (visiting (org-find-base-buffer-visiting file)) | |
13012 | (org-startup-folded nil) | |
13013 | (org-startup-align-all-tables nil) | |
13014 | (org-goto-start-pos 1) | |
d5098885 JW |
13015 | spos exitcmd level indent reversed) |
13016 | (if (and (equal current-prefix-arg '(16)) org-remember-previous-location) | |
13017 | (setq file (car org-remember-previous-location) | |
13018 | heading (cdr org-remember-previous-location))) | |
a3fbe8c4 | 13019 | (setq current-prefix-arg nil) |
d3f4dbe8 CD |
13020 | ;; Modify text so that it becomes a nice subtree which can be inserted |
13021 | ;; into an org tree. | |
13022 | (let* ((lines (split-string txt "\n")) | |
13023 | first) | |
13024 | (setq first (car lines) lines (cdr lines)) | |
7d58338e | 13025 | (if (string-match "^\\*+ " first) |
d3f4dbe8 CD |
13026 | ;; Is already a headline |
13027 | (setq indent nil) | |
13028 | ;; We need to add a headline: Use time and first buffer line | |
13029 | (setq lines (cons first lines) | |
13030 | first (concat "* " (current-time-string) | |
13031 | " (" (remember-buffer-desc) ")") | |
13032 | indent " ")) | |
13033 | (if (and org-adapt-indentation indent) | |
13034 | (setq lines (mapcar (lambda (x) (concat indent x)) lines))) | |
13035 | (setq txt (concat first "\n" | |
13036 | (mapconcat 'identity lines "\n")))) | |
13037 | ;; Find the file | |
13038 | (if (not visiting) (find-file-noselect file)) | |
13039 | (with-current-buffer (or visiting (get-file-buffer file)) | |
d5098885 JW |
13040 | (unless (org-mode-p) |
13041 | (error "Target files for remember notes must be in Org-mode")) | |
d3f4dbe8 CD |
13042 | (save-excursion |
13043 | (save-restriction | |
13044 | (widen) | |
a3fbe8c4 CD |
13045 | (and (goto-char (point-min)) |
13046 | (not (re-search-forward "^\\* " nil t)) | |
15841868 | 13047 | (insert "\n* " (or heading "Notes") "\n")) |
a3fbe8c4 | 13048 | (setq reversed (org-notes-order-reversed-p)) |
b0a10108 | 13049 | |
d3f4dbe8 CD |
13050 | ;; Find the default location |
13051 | (when (and heading (stringp heading) (string-match "\\S-" heading)) | |
13052 | (goto-char (point-min)) | |
13053 | (if (re-search-forward | |
13054 | (concat "^\\*+[ \t]+" (regexp-quote heading) | |
5152b597 | 13055 | (org-re "\\([ \t]+:[[:alnum:]@_:]*\\)?[ \t]*$")) |
d3f4dbe8 | 13056 | nil t) |
15841868 JW |
13057 | (setq org-goto-start-pos (match-beginning 0)) |
13058 | (when fastp | |
13059 | (goto-char (point-max)) | |
13060 | (unless (bolp) (newline)) | |
13061 | (insert "* " heading "\n") | |
13062 | (setq org-goto-start-pos (point-at-bol 0))))) | |
a96ee7df | 13063 | |
d3f4dbe8 | 13064 | ;; Ask the User for a location |
d5098885 JW |
13065 | (if fastp |
13066 | (setq spos org-goto-start-pos | |
13067 | exitcmd 'return) | |
13068 | (setq spos (org-get-location (current-buffer) org-remember-help) | |
13069 | exitcmd (cdr spos) | |
13070 | spos (car spos))) | |
d3f4dbe8 | 13071 | (if (not spos) (throw 'quit nil)) ; return nil to show we did |
a3fbe8c4 | 13072 | ; not handle this note |
d3f4dbe8 | 13073 | (goto-char spos) |
d5098885 JW |
13074 | (cond ((org-on-heading-p t) |
13075 | (org-back-to-heading t) | |
13076 | (setq level (funcall outline-level)) | |
13077 | (cond | |
13078 | ((eq exitcmd 'return) | |
13079 | ;; sublevel of current | |
13080 | (setq org-remember-previous-location | |
13081 | (cons (abbreviate-file-name file) | |
13082 | (org-get-heading 'notags))) | |
13083 | (if reversed | |
13084 | (outline-next-heading) | |
13085 | (org-end-of-subtree) | |
13086 | (if (not (bolp)) | |
13087 | (if (looking-at "[ \t]*\n") | |
13088 | (beginning-of-line 2) | |
13089 | (end-of-line 1) | |
13090 | (insert "\n")))) | |
13091 | (org-paste-subtree (org-get-legal-level level 1) txt)) | |
13092 | ((eq exitcmd 'left) | |
13093 | ;; before current | |
13094 | (org-paste-subtree level txt)) | |
13095 | ((eq exitcmd 'right) | |
13096 | ;; after current | |
13097 | (org-end-of-subtree t) | |
13098 | (org-paste-subtree level txt)) | |
13099 | (t (error "This should not happen")))) | |
fbe6c10d | 13100 | |
d5098885 | 13101 | ((and (bobp) (not reversed)) |
d3f4dbe8 CD |
13102 | ;; Put it at the end, one level below level 1 |
13103 | (save-restriction | |
13104 | (widen) | |
13105 | (goto-char (point-max)) | |
13106 | (if (not (bolp)) (newline)) | |
13107 | (org-paste-subtree (org-get-legal-level 1 1) txt))) | |
fbe6c10d | 13108 | |
d3f4dbe8 CD |
13109 | ((and (bobp) reversed) |
13110 | ;; Put it at the start, as level 1 | |
13111 | (save-restriction | |
13112 | (widen) | |
13113 | (goto-char (point-min)) | |
7d58338e | 13114 | (re-search-forward "^\\*+ " nil t) |
d3f4dbe8 CD |
13115 | (beginning-of-line 1) |
13116 | (org-paste-subtree 1 txt))) | |
d3f4dbe8 CD |
13117 | (t |
13118 | ;; Put it right there, with automatic level determined by | |
13119 | ;; org-paste-subtree or from prefix arg | |
a3fbe8c4 CD |
13120 | (org-paste-subtree |
13121 | (if (numberp current-prefix-arg) current-prefix-arg) | |
13122 | txt))) | |
d3f4dbe8 CD |
13123 | (when remember-save-after-remembering |
13124 | (save-buffer) | |
13125 | (if (not visiting) (kill-buffer (current-buffer))))))))) | |
13126 | t) ;; return t to indicate that we took care of this note. | |
b0a10108 | 13127 | |
d3f4dbe8 CD |
13128 | (defun org-get-org-file () |
13129 | "Read a filename, with default directory `org-directory'." | |
13130 | (let ((default (or org-default-notes-file remember-data-file))) | |
13131 | (read-file-name (format "File name [%s]: " default) | |
13132 | (file-name-as-directory org-directory) | |
13133 | default))) | |
b0a10108 | 13134 | |
d3f4dbe8 CD |
13135 | (defun org-notes-order-reversed-p () |
13136 | "Check if the current file should receive notes in reversed order." | |
13137 | (cond | |
13138 | ((not org-reverse-note-order) nil) | |
13139 | ((eq t org-reverse-note-order) t) | |
13140 | ((not (listp org-reverse-note-order)) nil) | |
13141 | (t (catch 'exit | |
13142 | (let ((all org-reverse-note-order) | |
13143 | entry) | |
13144 | (while (setq entry (pop all)) | |
13145 | (if (string-match (car entry) buffer-file-name) | |
13146 | (throw 'exit (cdr entry)))) | |
13147 | nil))))) | |
4b3a9ba7 | 13148 | |
d3f4dbe8 | 13149 | ;;;; Dynamic blocks |
f425a6ea | 13150 | |
d3f4dbe8 CD |
13151 | (defun org-find-dblock (name) |
13152 | "Find the first dynamic block with name NAME in the buffer. | |
13153 | If not found, stay at current position and return nil." | |
13154 | (let (pos) | |
13155 | (save-excursion | |
13156 | (goto-char (point-min)) | |
13157 | (setq pos (and (re-search-forward (concat "^#\\+BEGIN:[ \t]+" name "\\>") | |
13158 | nil t) | |
13159 | (match-beginning 0)))) | |
13160 | (if pos (goto-char pos)) | |
13161 | pos)) | |
3278a016 | 13162 | |
d3f4dbe8 CD |
13163 | (defconst org-dblock-start-re |
13164 | "^#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" | |
13165 | "Matches the startline of a dynamic block, with parameters.") | |
f425a6ea | 13166 | |
d3f4dbe8 CD |
13167 | (defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)" |
13168 | "Matches the end of a dyhamic block.") | |
4ed31842 | 13169 | |
d3f4dbe8 CD |
13170 | (defun org-create-dblock (plist) |
13171 | "Create a dynamic block section, with parameters taken from PLIST. | |
13172 | PLIST must containe a :name entry which is used as name of the block." | |
13173 | (unless (bolp) (newline)) | |
13174 | (let ((name (plist-get plist :name))) | |
13175 | (insert "#+BEGIN: " name) | |
13176 | (while plist | |
13177 | (if (eq (car plist) :name) | |
13178 | (setq plist (cddr plist)) | |
13179 | (insert " " (prin1-to-string (pop plist))))) | |
13180 | (insert "\n\n#+END:\n") | |
13181 | (beginning-of-line -2))) | |
3278a016 | 13182 | |
d3f4dbe8 CD |
13183 | (defun org-prepare-dblock () |
13184 | "Prepare dynamic block for refresh. | |
13185 | This empties the block, puts the cursor at the insert position and returns | |
13186 | the property list including an extra property :name with the block name." | |
13187 | (unless (looking-at org-dblock-start-re) | |
13188 | (error "Not at a dynamic block")) | |
13189 | (let* ((begdel (1+ (match-end 0))) | |
15841868 | 13190 | (name (org-no-properties (match-string 1))) |
d3f4dbe8 CD |
13191 | (params (append (list :name name) |
13192 | (read (concat "(" (match-string 3) ")"))))) | |
13193 | (unless (re-search-forward org-dblock-end-re nil t) | |
13194 | (error "Dynamic block not terminated")) | |
13195 | (delete-region begdel (match-beginning 0)) | |
13196 | (goto-char begdel) | |
13197 | (open-line 1) | |
13198 | params)) | |
c8d16429 | 13199 | |
d3f4dbe8 CD |
13200 | (defun org-map-dblocks (&optional command) |
13201 | "Apply COMMAND to all dynamic blocks in the current buffer. | |
13202 | If COMMAND is not given, use `org-update-dblock'." | |
13203 | (let ((cmd (or command 'org-update-dblock)) | |
13204 | pos) | |
13205 | (save-excursion | |
13206 | (goto-char (point-min)) | |
13207 | (while (re-search-forward org-dblock-start-re nil t) | |
13208 | (goto-char (setq pos (match-beginning 0))) | |
13209 | (condition-case nil | |
13210 | (funcall cmd) | |
13211 | (error (message "Error during update of dynamic block"))) | |
13212 | (goto-char pos) | |
13213 | (unless (re-search-forward org-dblock-end-re nil t) | |
13214 | (error "Dynamic block not terminated")))))) | |
a96ee7df | 13215 | |
d3f4dbe8 CD |
13216 | (defun org-dblock-update (&optional arg) |
13217 | "User command for updating dynamic blocks. | |
13218 | Update the dynamic block at point. With prefix ARG, update all dynamic | |
13219 | blocks in the buffer." | |
13220 | (interactive "P") | |
13221 | (if arg | |
13222 | (org-update-all-dblocks) | |
13223 | (or (looking-at org-dblock-start-re) | |
13224 | (org-beginning-of-dblock)) | |
13225 | (org-update-dblock))) | |
a96ee7df | 13226 | |
d3f4dbe8 CD |
13227 | (defun org-update-dblock () |
13228 | "Update the dynamic block at point | |
13229 | This means to empty the block, parse for parameters and then call | |
13230 | the correct writing function." | |
15841868 JW |
13231 | (save-window-excursion |
13232 | (let* ((pos (point)) | |
13233 | (line (org-current-line)) | |
13234 | (params (org-prepare-dblock)) | |
13235 | (name (plist-get params :name)) | |
13236 | (cmd (intern (concat "org-dblock-write:" name)))) | |
13237 | (message "Updating dynamic block `%s' at line %d..." name line) | |
13238 | (funcall cmd params) | |
13239 | (message "Updating dynamic block `%s' at line %d...done" name line) | |
13240 | (goto-char pos)))) | |
a96ee7df | 13241 | |
d3f4dbe8 CD |
13242 | (defun org-beginning-of-dblock () |
13243 | "Find the beginning of the dynamic block at point. | |
13244 | Error if there is no scuh block at point." | |
13245 | (let ((pos (point)) | |
13246 | beg) | |
13247 | (end-of-line 1) | |
13248 | (if (and (re-search-backward org-dblock-start-re nil t) | |
13249 | (setq beg (match-beginning 0)) | |
13250 | (re-search-forward org-dblock-end-re nil t) | |
13251 | (> (match-end 0) pos)) | |
13252 | (goto-char beg) | |
13253 | (goto-char pos) | |
13254 | (error "Not in a dynamic block")))) | |
891f4676 | 13255 | |
d3f4dbe8 CD |
13256 | (defun org-update-all-dblocks () |
13257 | "Update all dynamic blocks in the buffer. | |
13258 | This function can be used in a hook." | |
13259 | (when (org-mode-p) | |
13260 | (org-map-dblocks 'org-update-dblock))) | |
a96ee7df | 13261 | |
3278a016 | 13262 | |
d3f4dbe8 | 13263 | ;;;; Completion |
3278a016 | 13264 | |
15841868 JW |
13265 | (defconst org-additional-option-like-keywords |
13266 | '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" | |
03f3cf35 | 13267 | "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "DATE:")) |
15841868 | 13268 | |
d3f4dbe8 CD |
13269 | (defun org-complete (&optional arg) |
13270 | "Perform completion on word at point. | |
13271 | At the beginning of a headline, this completes TODO keywords as given in | |
13272 | `org-todo-keywords'. | |
13273 | If the current word is preceded by a backslash, completes the TeX symbols | |
13274 | that are supported for HTML support. | |
13275 | If the current word is preceded by \"#+\", completes special words for | |
13276 | setting file options. | |
13277 | In the line after \"#+STARTUP:, complete valid keywords.\" | |
15841868 JW |
13278 | At all other locations, this simply calls the value of |
13279 | `org-completion-fallback-command'." | |
d3f4dbe8 | 13280 | (interactive "P") |
15841868 JW |
13281 | (org-without-partial-completion |
13282 | (catch 'exit | |
13283 | (let* ((end (point)) | |
13284 | (beg1 (save-excursion | |
13285 | (skip-chars-backward (org-re "[:alnum:]_@")) | |
13286 | (point))) | |
13287 | (beg (save-excursion | |
13288 | (skip-chars-backward "a-zA-Z0-9_:$") | |
d3f4dbe8 | 13289 | (point))) |
15841868 JW |
13290 | (confirm (lambda (x) (stringp (car x)))) |
13291 | (searchhead (equal (char-before beg) ?*)) | |
13292 | (tag (and (equal (char-before beg1) ?:) | |
13293 | (equal (char-after (point-at-bol)) ?*))) | |
13294 | (prop (and (equal (char-before beg1) ?:) | |
13295 | (not (equal (char-after (point-at-bol)) ?*)))) | |
13296 | (texp (equal (char-before beg) ?\\)) | |
13297 | (link (equal (char-before beg) ?\[)) | |
13298 | (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) | |
13299 | beg) | |
13300 | "#+")) | |
13301 | (startup (string-match "^#\\+STARTUP:.*" | |
13302 | (buffer-substring (point-at-bol) (point)))) | |
13303 | (completion-ignore-case opt) | |
13304 | (type nil) | |
13305 | (tbl nil) | |
13306 | (table (cond | |
13307 | (opt | |
13308 | (setq type :opt) | |
13309 | (append | |
13310 | (mapcar | |
13311 | (lambda (x) | |
13312 | (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) | |
13313 | (cons (match-string 2 x) (match-string 1 x))) | |
13314 | (org-split-string (org-get-current-options) "\n")) | |
13315 | (mapcar 'list org-additional-option-like-keywords))) | |
13316 | (startup | |
13317 | (setq type :startup) | |
13318 | org-startup-options) | |
13319 | (link (append org-link-abbrev-alist-local | |
13320 | org-link-abbrev-alist)) | |
13321 | (texp | |
13322 | (setq type :tex) | |
13323 | org-html-entities) | |
13324 | ((string-match "\\`\\*+[ \t]+\\'" | |
13325 | (buffer-substring (point-at-bol) beg)) | |
13326 | (setq type :todo) | |
13327 | (mapcar 'list org-todo-keywords-1)) | |
13328 | (searchhead | |
13329 | (setq type :searchhead) | |
13330 | (save-excursion | |
13331 | (goto-char (point-min)) | |
13332 | (while (re-search-forward org-todo-line-regexp nil t) | |
13333 | (push (list | |
13334 | (org-make-org-heading-search-string | |
13335 | (match-string 3) t)) | |
13336 | tbl))) | |
13337 | tbl) | |
13338 | (tag (setq type :tag beg beg1) | |
13339 | (or org-tag-alist (org-get-buffer-tags))) | |
13340 | (prop (setq type :prop beg beg1) | |
13341 | (mapcar 'list (org-buffer-property-keys))) | |
13342 | (t (progn | |
13343 | (call-interactively org-completion-fallback-command) | |
13344 | (throw 'exit nil))))) | |
13345 | (pattern (buffer-substring-no-properties beg end)) | |
13346 | (completion (try-completion pattern table confirm))) | |
13347 | (cond ((eq completion t) | |
13348 | (if (not (assoc (upcase pattern) table)) | |
13349 | (message "Already complete") | |
13350 | (if (equal type :opt) | |
13351 | (insert (substring (cdr (assoc (upcase pattern) table)) | |
13352 | (length pattern))) | |
13353 | (if (memq type '(:tag :prop)) (insert ":"))))) | |
13354 | ((null completion) | |
13355 | (message "Can't find completion for \"%s\"" pattern) | |
13356 | (ding)) | |
13357 | ((not (string= pattern completion)) | |
13358 | (delete-region beg end) | |
13359 | (if (string-match " +$" completion) | |
13360 | (setq completion (replace-match "" t t completion))) | |
13361 | (insert completion) | |
13362 | (if (get-buffer-window "*Completions*") | |
13363 | (delete-window (get-buffer-window "*Completions*"))) | |
13364 | (if (assoc completion table) | |
13365 | (if (eq type :todo) (insert " ") | |
13366 | (if (memq type '(:tag :prop)) (insert ":")))) | |
13367 | (if (and (equal type :opt) (assoc completion table)) | |
13368 | (message "%s" (substitute-command-keys | |
13369 | "Press \\[org-complete] again to insert example settings")))) | |
13370 | (t | |
13371 | (message "Making completion list...") | |
13372 | (let ((list (sort (all-completions pattern table confirm) | |
13373 | 'string<))) | |
13374 | (with-output-to-temp-buffer "*Completions*" | |
13375 | (condition-case nil | |
13376 | ;; Protection needed for XEmacs and emacs 21 | |
13377 | (display-completion-list list pattern) | |
13378 | (error (display-completion-list list))))) | |
13379 | (message "Making completion list...%s" "done"))))))) | |
891f4676 | 13380 | |
d3f4dbe8 | 13381 | ;;;; TODO, DEADLINE, Comments |
891f4676 | 13382 | |
d3f4dbe8 CD |
13383 | (defun org-toggle-comment () |
13384 | "Change the COMMENT state of an entry." | |
13385 | (interactive) | |
13386 | (save-excursion | |
13387 | (org-back-to-heading) | |
13388 | (if (looking-at (concat outline-regexp | |
03f3cf35 | 13389 | "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) |
d3f4dbe8 CD |
13390 | (replace-match "" t t nil 1) |
13391 | (if (looking-at outline-regexp) | |
13392 | (progn | |
13393 | (goto-char (match-end 0)) | |
7d58338e | 13394 | (insert org-comment-string " ")))))) |
891f4676 | 13395 | |
d3f4dbe8 CD |
13396 | (defvar org-last-todo-state-is-todo nil |
13397 | "This is non-nil when the last TODO state change led to a TODO state. | |
13398 | If the last change removed the TODO tag or switched to DONE, then | |
13399 | this is nil.") | |
891f4676 | 13400 | |
374585c9 CD |
13401 | (defvar org-setting-tags nil) ; dynamically skiped |
13402 | ||
15841868 JW |
13403 | ;; FIXME: better place |
13404 | (defun org-property-or-variable-value (var &optional inherit) | |
13405 | "Check if there is a property fixing the value of VAR. | |
13406 | If yes, return this value. If not, return the current value of the variable." | |
13407 | (let ((prop (org-entry-get nil (symbol-name var) inherit))) | |
13408 | (if (and prop (stringp prop) (string-match "\\S-" prop)) | |
13409 | (read prop) | |
13410 | (symbol-value var)))) | |
13411 | ||
03f3cf35 JW |
13412 | (defun org-parse-local-options (string var) |
13413 | "Parse STRING for startup setting relevant for variable VAR." | |
13414 | (let ((rtn (symbol-value var)) | |
13415 | e opts) | |
13416 | (save-match-data | |
13417 | (if (or (not string) (not (string-match "\\S-" string))) | |
13418 | rtn | |
13419 | (setq opts (delq nil (mapcar (lambda (x) | |
13420 | (setq e (assoc x org-startup-options)) | |
13421 | (if (eq (nth 1 e) var) e nil)) | |
13422 | (org-split-string string "[ \t]+")))) | |
13423 | (if (not opts) | |
13424 | rtn | |
13425 | (setq rtn nil) | |
13426 | (while (setq e (pop opts)) | |
13427 | (if (not (nth 3 e)) | |
13428 | (setq rtn (nth 2 e)) | |
13429 | (if (not (listp rtn)) (setq rtn nil)) | |
13430 | (push (nth 2 e) rtn))) | |
13431 | rtn))))) | |
13432 | ||
13433 | (defvar org-blocker-hook nil | |
13434 | "Hook for functions that are allowed to block a state change. | |
13435 | ||
13436 | Each function gets as its single argument a property list, see | |
13437 | `org-trigger-hook' for more information about this list. | |
13438 | ||
13439 | If any of the functions in this hook returns nil, the state change | |
13440 | is blocked.") | |
13441 | ||
13442 | (defvar org-trigger-hook nil | |
13443 | "Hook for functions that are triggered by a state change. | |
13444 | ||
13445 | Each function gets as its single argument a property list with at least | |
13446 | the following elements: | |
13447 | ||
13448 | (:type type-of-change :position pos-at-entry-start | |
fbe6c10d | 13449 | :from old-state :to new-state) |
03f3cf35 JW |
13450 | |
13451 | Depending on the type, more properties may be present. | |
13452 | ||
13453 | This mechanism is currently implemented for: | |
13454 | ||
13455 | TODO state changes | |
13456 | ------------------ | |
13457 | :type todo-state-change | |
13458 | :from previous state (keyword as a string), or nil | |
13459 | :to new state (keyword as a string), or nil") | |
13460 | ||
13461 | ||
d3f4dbe8 CD |
13462 | (defun org-todo (&optional arg) |
13463 | "Change the TODO state of an item. | |
13464 | The state of an item is given by a keyword at the start of the heading, | |
13465 | like | |
13466 | *** TODO Write paper | |
13467 | *** DONE Call mom | |
a96ee7df | 13468 | |
d3f4dbe8 CD |
13469 | The different keywords are specified in the variable `org-todo-keywords'. |
13470 | By default the available states are \"TODO\" and \"DONE\". | |
13471 | So for this example: when the item starts with TODO, it is changed to DONE. | |
13472 | When it starts with DONE, the DONE is removed. And when neither TODO nor | |
13473 | DONE are present, add TODO at the beginning of the heading. | |
a96ee7df | 13474 | |
d3f4dbe8 CD |
13475 | With C-u prefix arg, use completion to determine the new state. |
13476 | With numeric prefix arg, switch to that state. | |
a96ee7df | 13477 | |
d3f4dbe8 CD |
13478 | For calling through lisp, arg is also interpreted in the following way: |
13479 | 'none -> empty state | |
13480 | \"\"(empty string) -> switch to empty state | |
13481 | 'done -> switch to DONE | |
a3fbe8c4 CD |
13482 | 'nextset -> switch to the next set of keywords |
13483 | 'previousset -> switch to the previous set of keywords | |
d3f4dbe8 CD |
13484 | \"WAITING\" -> switch to the specified keyword, but only if it |
13485 | really is a member of `org-todo-keywords'." | |
13486 | (interactive "P") | |
a96ee7df | 13487 | (save-excursion |
03f3cf35 JW |
13488 | (catch 'exit |
13489 | (org-back-to-heading) | |
13490 | (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) | |
13491 | (or (looking-at (concat " +" org-todo-regexp " *")) | |
13492 | (looking-at " *")) | |
613bf6a7 CD |
13493 | (let* ((match-data (match-data)) |
13494 | (startpos (line-beginning-position)) | |
03f3cf35 JW |
13495 | (logging (save-match-data (org-entry-get nil "LOGGING" t))) |
13496 | (org-log-done (org-parse-local-options logging 'org-log-done)) | |
13497 | (org-log-repeat (org-parse-local-options logging 'org-log-repeat)) | |
13498 | (this (match-string 1)) | |
13499 | (hl-pos (match-beginning 0)) | |
13500 | (head (org-get-todo-sequence-head this)) | |
13501 | (ass (assoc head org-todo-kwd-alist)) | |
13502 | (interpret (nth 1 ass)) | |
13503 | (done-word (nth 3 ass)) | |
13504 | (final-done-word (nth 4 ass)) | |
13505 | (last-state (or this "")) | |
13506 | (completion-ignore-case t) | |
13507 | (member (member this org-todo-keywords-1)) | |
13508 | (tail (cdr member)) | |
13509 | (state (cond | |
13510 | ((and org-todo-key-trigger | |
13511 | (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix)) | |
13512 | (and (not arg) org-use-fast-todo-selection | |
13513 | (not (eq org-use-fast-todo-selection 'prefix))))) | |
13514 | ;; Use fast selection | |
13515 | (org-fast-todo-selection)) | |
13516 | ((and (equal arg '(4)) | |
13517 | (or (not org-use-fast-todo-selection) | |
13518 | (not org-todo-key-trigger))) | |
13519 | ;; Read a state with completion | |
13520 | (completing-read "State: " (mapcar (lambda(x) (list x)) | |
13521 | org-todo-keywords-1) | |
13522 | nil t)) | |
13523 | ((eq arg 'right) | |
d3f4dbe8 | 13524 | (if this |
03f3cf35 JW |
13525 | (if tail (car tail) nil) |
13526 | (car org-todo-keywords-1))) | |
13527 | ((eq arg 'left) | |
13528 | (if (equal member org-todo-keywords-1) | |
13529 | nil | |
13530 | (if this | |
13531 | (nth (- (length org-todo-keywords-1) (length tail) 2) | |
13532 | org-todo-keywords-1) | |
13533 | (org-last org-todo-keywords-1)))) | |
13534 | ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) | |
13535 | (setq arg nil))) ; hack to fall back to cycling | |
13536 | (arg | |
13537 | ;; user or caller requests a specific state | |
13538 | (cond | |
13539 | ((equal arg "") nil) | |
13540 | ((eq arg 'none) nil) | |
13541 | ((eq arg 'done) (or done-word (car org-done-keywords))) | |
13542 | ((eq arg 'nextset) | |
a3fbe8c4 | 13543 | (or (car (cdr (member head org-todo-heads))) |
03f3cf35 JW |
13544 | (car org-todo-heads))) |
13545 | ((eq arg 'previousset) | |
13546 | (let ((org-todo-heads (reverse org-todo-heads))) | |
13547 | (or (car (cdr (member head org-todo-heads))) | |
13548 | (car org-todo-heads)))) | |
13549 | ((car (member arg org-todo-keywords-1))) | |
13550 | ((nth (1- (prefix-numeric-value arg)) | |
a3fbe8c4 | 13551 | org-todo-keywords-1)))) |
03f3cf35 JW |
13552 | ((null member) (or head (car org-todo-keywords-1))) |
13553 | ((equal this final-done-word) nil) ;; -> make empty | |
13554 | ((null tail) nil) ;; -> first entry | |
13555 | ((eq interpret 'sequence) | |
13556 | (car tail)) | |
13557 | ((memq interpret '(type priority)) | |
13558 | (if (eq this-command last-command) | |
13559 | (car tail) | |
13560 | (if (> (length tail) 0) | |
13561 | (or done-word (car org-done-keywords)) | |
13562 | nil))) | |
13563 | (t nil))) | |
13564 | (next (if state (concat " " state " ") " ")) | |
13565 | (change-plist (list :type 'todo-state-change :from this :to state | |
13566 | :position startpos)) | |
13567 | dostates) | |
13568 | (when org-blocker-hook | |
13569 | (unless (save-excursion | |
13570 | (save-match-data | |
13571 | (run-hook-with-args-until-failure | |
13572 | 'org-blocker-hook change-plist))) | |
13573 | (if (interactive-p) | |
13574 | (error "TODO state change from %s to %s blocked" this state) | |
13575 | ;; fail silently | |
13576 | (message "TODO state change from %s to %s blocked" this state) | |
13577 | (throw 'exit nil)))) | |
613bf6a7 | 13578 | (store-match-data match-data) |
03f3cf35 JW |
13579 | (replace-match next t t) |
13580 | (unless (pos-visible-in-window-p hl-pos) | |
13581 | (message "TODO state changed to %s" (org-trim next))) | |
13582 | (unless head | |
13583 | (setq head (org-get-todo-sequence-head state) | |
13584 | ass (assoc head org-todo-kwd-alist) | |
13585 | interpret (nth 1 ass) | |
13586 | done-word (nth 3 ass) | |
13587 | final-done-word (nth 4 ass))) | |
13588 | (when (memq arg '(nextset previousset)) | |
13589 | (message "Keyword-Set %d/%d: %s" | |
13590 | (- (length org-todo-sets) -1 | |
13591 | (length (memq (assoc state org-todo-sets) org-todo-sets))) | |
13592 | (length org-todo-sets) | |
13593 | (mapconcat 'identity (assoc state org-todo-sets) " "))) | |
13594 | (setq org-last-todo-state-is-todo | |
13595 | (not (member state org-done-keywords))) | |
13596 | (when (and org-log-done (not (memq arg '(nextset previousset)))) | |
13597 | (setq dostates (and (listp org-log-done) (memq 'state org-log-done) | |
13598 | (or (not org-todo-log-states) | |
13599 | (member state org-todo-log-states)))) | |
fbe6c10d | 13600 | |
03f3cf35 JW |
13601 | (cond |
13602 | ((and state (member state org-not-done-keywords) | |
13603 | (not (member this org-not-done-keywords))) | |
13604 | ;; This is now a todo state and was not one before | |
13605 | ;; Remove any CLOSED timestamp, and possibly log the state change | |
13606 | (org-add-planning-info nil nil 'closed) | |
13607 | (and dostates (org-add-log-maybe 'state state 'findpos))) | |
13608 | ((and state dostates) | |
13609 | ;; This is a non-nil state, and we need to log it | |
13610 | (org-add-log-maybe 'state state 'findpos)) | |
13611 | ((and (member state org-done-keywords) | |
13612 | (not (member this org-done-keywords))) | |
13613 | ;; It is now done, and it was not done before | |
13614 | (org-add-planning-info 'closed (org-current-time)) | |
13615 | (org-add-log-maybe 'done state 'findpos)))) | |
13616 | ;; Fixup tag positioning | |
13617 | (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) | |
13618 | (run-hooks 'org-after-todo-state-change-hook) | |
13619 | (and (member state org-done-keywords) (org-auto-repeat-maybe)) | |
13620 | (if (and arg (not (member state org-done-keywords))) | |
13621 | (setq head (org-get-todo-sequence-head state))) | |
13622 | (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) | |
13623 | ;; Fixup cursor location if close to the keyword | |
13624 | (if (and (outline-on-heading-p) | |
13625 | (not (bolp)) | |
13626 | (save-excursion (beginning-of-line 1) | |
13627 | (looking-at org-todo-line-regexp)) | |
13628 | (< (point) (+ 2 (or (match-end 2) (match-end 1))))) | |
13629 | (progn | |
13630 | (goto-char (or (match-end 2) (match-end 1))) | |
13631 | (just-one-space))) | |
13632 | (when org-trigger-hook | |
13633 | (save-excursion | |
13634 | (run-hook-with-args 'org-trigger-hook change-plist))))))) | |
a96ee7df | 13635 | |
a3fbe8c4 CD |
13636 | (defun org-get-todo-sequence-head (kwd) |
13637 | "Return the head of the TODO sequence to which KWD belongs. | |
13638 | If KWD is not set, check if there is a text property remembering the | |
13639 | right sequence." | |
13640 | (let (p) | |
13641 | (cond | |
13642 | ((not kwd) | |
13643 | (or (get-text-property (point-at-bol) 'org-todo-head) | |
13644 | (progn | |
13645 | (setq p (next-single-property-change (point-at-bol) 'org-todo-head | |
13646 | nil (point-at-eol))) | |
13647 | (get-text-property p 'org-todo-head)))) | |
13648 | ((not (member kwd org-todo-keywords-1)) | |
13649 | (car org-todo-keywords-1)) | |
13650 | (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) | |
13651 | ||
0b8568f5 JW |
13652 | (defun org-fast-todo-selection () |
13653 | "Fast TODO keyword selection with single keys. | |
13654 | Returns the new TODO keyword, or nil if no state change should occur." | |
13655 | (let* ((fulltable org-todo-key-alist) | |
13656 | (done-keywords org-done-keywords) ;; needed for the faces. | |
13657 | (maxlen (apply 'max (mapcar | |
13658 | (lambda (x) | |
13659 | (if (stringp (car x)) (string-width (car x)) 0)) | |
13660 | fulltable))) | |
0b8568f5 JW |
13661 | (expert nil) |
13662 | (fwidth (+ maxlen 3 1 3)) | |
13663 | (ncol (/ (- (window-width) 4) fwidth)) | |
03f3cf35 | 13664 | tg cnt e c tbl |
0b8568f5 JW |
13665 | groups ingroup) |
13666 | (save-window-excursion | |
13667 | (if expert | |
13668 | (set-buffer (get-buffer-create " *Org todo*")) | |
13669 | ; (delete-other-windows) | |
13670 | ; (split-window-vertically) | |
257b8401 | 13671 | (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) |
0b8568f5 JW |
13672 | (erase-buffer) |
13673 | (org-set-local 'org-done-keywords done-keywords) | |
03f3cf35 | 13674 | (setq tbl fulltable cnt 0) |
0b8568f5 JW |
13675 | (while (setq e (pop tbl)) |
13676 | (cond | |
13677 | ((equal e '(:startgroup)) | |
13678 | (push '() groups) (setq ingroup t) | |
13679 | (when (not (= cnt 0)) | |
13680 | (setq cnt 0) | |
13681 | (insert "\n")) | |
13682 | (insert "{ ")) | |
13683 | ((equal e '(:endgroup)) | |
13684 | (setq ingroup nil cnt 0) | |
13685 | (insert "}\n")) | |
13686 | (t | |
13687 | (setq tg (car e) c (cdr e)) | |
13688 | (if ingroup (push tg (car groups))) | |
13689 | (setq tg (org-add-props tg nil 'face | |
13690 | (org-get-todo-face tg))) | |
13691 | (if (and (= cnt 0) (not ingroup)) (insert " ")) | |
13692 | (insert "[" c "] " tg (make-string | |
13693 | (- fwidth 4 (length tg)) ?\ )) | |
13694 | (when (= (setq cnt (1+ cnt)) ncol) | |
13695 | (insert "\n") | |
13696 | (if ingroup (insert " ")) | |
13697 | (setq cnt 0))))) | |
13698 | (insert "\n") | |
13699 | (goto-char (point-min)) | |
13700 | (if (and (not expert) (fboundp 'fit-window-to-buffer)) | |
13701 | (fit-window-to-buffer)) | |
13702 | (message "[a-z..]:Set [SPC]:clear") | |
13703 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
13704 | (cond | |
13705 | ((or (= c ?\C-g) | |
13706 | (and (= c ?q) (not (rassoc c fulltable)))) | |
13707 | (setq quit-flag t)) | |
15841868 | 13708 | ((= c ?\ ) nil) |
0b8568f5 JW |
13709 | ((setq e (rassoc c fulltable) tg (car e)) |
13710 | tg) | |
13711 | (t (setq quit-flag t)))))) | |
13712 | ||
d3f4dbe8 | 13713 | (defun org-get-repeat () |
a3fbe8c4 | 13714 | "Check if tere is a deadline/schedule with repeater in this entry." |
d3f4dbe8 CD |
13715 | (save-match-data |
13716 | (save-excursion | |
13717 | (org-back-to-heading t) | |
13718 | (if (re-search-forward | |
13719 | org-repeat-re (save-excursion (outline-next-heading) (point)) t) | |
13720 | (match-string 1))))) | |
13721 | ||
13722 | (defvar org-last-changed-timestamp) | |
13723 | (defvar org-log-post-message) | |
13724 | (defun org-auto-repeat-maybe () | |
a3fbe8c4 CD |
13725 | "Check if the current headline contains a repeated deadline/schedule. |
13726 | If yes, set TODO state back to what it was and change the base date | |
13727 | of repeating deadline/scheduled time stamps to new date. | |
d3f4dbe8 CD |
13728 | This function should be run in the `org-after-todo-state-change-hook'." |
13729 | ;; last-state is dynamically scoped into this function | |
a3fbe8c4 CD |
13730 | (let* ((repeat (org-get-repeat)) |
13731 | (aa (assoc last-state org-todo-kwd-alist)) | |
13732 | (interpret (nth 1 aa)) | |
13733 | (head (nth 2 aa)) | |
13734 | (done-word (nth 3 aa)) | |
13735 | (whata '(("d" . day) ("m" . month) ("y" . year))) | |
13736 | (msg "Entry repeats: ") | |
13737 | (org-log-done) | |
13738 | re type n what ts) | |
d3f4dbe8 | 13739 | (when repeat |
a3fbe8c4 CD |
13740 | (org-todo (if (eq interpret 'type) last-state head)) |
13741 | (when (and org-log-repeat | |
13742 | (not (memq 'org-add-log-note | |
13743 | (default-value 'post-command-hook)))) | |
d3f4dbe8 CD |
13744 | ;; Make sure a note is taken |
13745 | (let ((org-log-done '(done))) | |
a3fbe8c4 CD |
13746 | (org-add-log-maybe 'done (or done-word (car org-done-keywords)) |
13747 | 'findpos))) | |
d3f4dbe8 CD |
13748 | (org-back-to-heading t) |
13749 | (org-add-planning-info nil nil 'closed) | |
13750 | (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" | |
13751 | org-deadline-time-regexp "\\)")) | |
13752 | (while (re-search-forward | |
13753 | re (save-excursion (outline-next-heading) (point)) t) | |
13754 | (setq type (if (match-end 1) org-scheduled-string org-deadline-string) | |
a3fbe8c4 CD |
13755 | ts (match-string (if (match-end 2) 2 4))) |
13756 | (when (string-match "\\([-+]?[0-9]+\\)\\([dwmy]\\)" ts) | |
13757 | (setq n (string-to-number (match-string 1 ts)) | |
13758 | what (match-string 2 ts)) | |
d3f4dbe8 CD |
13759 | (if (equal what "w") (setq n (* n 7) what "d")) |
13760 | (org-timestamp-change n (cdr (assoc what whata)))) | |
13761 | (setq msg (concat msg type org-last-changed-timestamp " "))) | |
13762 | (setq org-log-post-message msg) | |
274f1353 | 13763 | (message "%s" msg)))) |
a96ee7df | 13764 | |
d3f4dbe8 CD |
13765 | (defun org-show-todo-tree (arg) |
13766 | "Make a compact tree which shows all headlines marked with TODO. | |
13767 | The tree will show the lines where the regexp matches, and all higher | |
13768 | headlines above the match. | |
13769 | With \\[universal-argument] prefix, also show the DONE entries. | |
13770 | With a numeric prefix N, construct a sparse tree for the Nth element | |
a3fbe8c4 | 13771 | of `org-todo-keywords-1'." |
d3f4dbe8 CD |
13772 | (interactive "P") |
13773 | (let ((case-fold-search nil) | |
13774 | (kwd-re | |
13775 | (cond ((null arg) org-not-done-regexp) | |
a3fbe8c4 CD |
13776 | ((equal arg '(4)) |
13777 | (let ((kwd (completing-read "Keyword (or KWD1|KWD2|...): " | |
13778 | (mapcar 'list org-todo-keywords-1)))) | |
13779 | (concat "\\(" | |
13780 | (mapconcat 'identity (org-split-string kwd "|") "\\|") | |
13781 | "\\)\\>"))) | |
13782 | ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) | |
d3f4dbe8 | 13783 | (regexp-quote (nth (1- (prefix-numeric-value arg)) |
a3fbe8c4 | 13784 | org-todo-keywords-1))) |
d3f4dbe8 CD |
13785 | (t (error "Invalid prefix argument: %s" arg))))) |
13786 | (message "%d TODO entries found" | |
7d58338e | 13787 | (org-occur (concat "^" outline-regexp " *" kwd-re ))))) |
4b3a9ba7 | 13788 | |
15841868 JW |
13789 | (defun org-deadline (&optional remove) |
13790 | "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. | |
13791 | With argument REMOVE, remove any deadline from the item." | |
13792 | (interactive "P") | |
13793 | (if remove | |
13794 | (progn | |
13795 | (org-add-planning-info nil nil 'deadline) | |
13796 | (message "Item no longer has a deadline.")) | |
13797 | (org-add-planning-info 'deadline nil 'closed))) | |
4b3a9ba7 | 13798 | |
15841868 JW |
13799 | (defun org-schedule (&optional remove) |
13800 | "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. | |
13801 | With argument REMOVE, remove any scheduling date from the item." | |
13802 | (interactive "P") | |
13803 | (if remove | |
13804 | (progn | |
13805 | (org-add-planning-info nil nil 'scheduled) | |
13806 | (message "Item is no longer scheduled.")) | |
13807 | (org-add-planning-info 'scheduled nil 'closed))) | |
d3f4dbe8 CD |
13808 | |
13809 | (defun org-add-planning-info (what &optional time &rest remove) | |
13810 | "Insert new timestamp with keyword in the line directly after the headline. | |
13811 | WHAT indicates what kind of time stamp to add. TIME indicated the time to use. | |
13812 | If non is given, the user is prompted for a date. | |
13813 | REMOVE indicates what kind of entries to remove. An old WHAT entry will also | |
13814 | be removed." | |
13815 | (interactive) | |
b38c6895 | 13816 | (let (org-time-was-given org-end-time-was-given) |
d3f4dbe8 CD |
13817 | (when what (setq time (or time (org-read-date nil 'to-time)))) |
13818 | (when (and org-insert-labeled-timestamps-at-point | |
13819 | (member what '(scheduled deadline))) | |
13820 | (insert | |
13821 | (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") | |
b38c6895 CD |
13822 | (org-insert-time-stamp time org-time-was-given |
13823 | nil nil nil (list org-end-time-was-given)) | |
d3f4dbe8 | 13824 | (setq what nil)) |
4b3a9ba7 | 13825 | (save-excursion |
d3f4dbe8 CD |
13826 | (save-restriction |
13827 | (let (col list elt ts buffer-invisibility-spec) | |
13828 | (org-back-to-heading t) | |
13829 | (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) | |
13830 | (goto-char (match-end 1)) | |
13831 | (setq col (current-column)) | |
5152b597 | 13832 | (goto-char (match-end 0)) |
fbe6c10d | 13833 | (if (eobp) (insert "\n") (forward-char 1)) |
d3f4dbe8 CD |
13834 | (if (and (not (looking-at outline-regexp)) |
13835 | (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp | |
13836 | "[^\r\n]*")) | |
13837 | (not (equal (match-string 1) org-clock-string))) | |
13838 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
48aaad2d | 13839 | (insert-before-markers "\n") |
d3f4dbe8 CD |
13840 | (backward-char 1) |
13841 | (narrow-to-region (point) (point)) | |
13842 | (indent-to-column col)) | |
13843 | ;; Check if we have to remove something. | |
13844 | (setq list (cons what remove)) | |
13845 | (while list | |
13846 | (setq elt (pop list)) | |
13847 | (goto-char (point-min)) | |
13848 | (when (or (and (eq elt 'scheduled) | |
13849 | (re-search-forward org-scheduled-time-regexp nil t)) | |
13850 | (and (eq elt 'deadline) | |
13851 | (re-search-forward org-deadline-time-regexp nil t)) | |
13852 | (and (eq elt 'closed) | |
13853 | (re-search-forward org-closed-time-regexp nil t))) | |
13854 | (replace-match "") | |
13855 | (if (looking-at "--+<[^>]+>") (replace-match "")) | |
13856 | (if (looking-at " +") (replace-match "")))) | |
13857 | (goto-char (point-max)) | |
13858 | (when what | |
13859 | (insert | |
13860 | (if (not (equal (char-before) ?\ )) " " "") | |
13861 | (cond ((eq what 'scheduled) org-scheduled-string) | |
13862 | ((eq what 'deadline) org-deadline-string) | |
374585c9 | 13863 | ((eq what 'closed) org-closed-string)) |
d3f4dbe8 | 13864 | " ") |
15841868 JW |
13865 | (setq ts (org-insert-time-stamp |
13866 | time | |
13867 | (or org-time-was-given | |
13868 | (and (eq what 'closed) org-log-done-with-time)) | |
13869 | (eq what 'closed) | |
13870 | nil nil (list org-end-time-was-given))) | |
d3f4dbe8 CD |
13871 | (end-of-line 1)) |
13872 | (goto-char (point-min)) | |
13873 | (widen) | |
13874 | (if (looking-at "[ \t]+\r?\n") | |
13875 | (replace-match "")) | |
13876 | ts))))) | |
4b3a9ba7 | 13877 | |
d3f4dbe8 CD |
13878 | (defvar org-log-note-marker (make-marker)) |
13879 | (defvar org-log-note-purpose nil) | |
13880 | (defvar org-log-note-state nil) | |
13881 | (defvar org-log-note-window-configuration nil) | |
13882 | (defvar org-log-note-return-to (make-marker)) | |
13883 | (defvar org-log-post-message nil | |
13884 | "Message to be displayed after a log note has been stored. | |
13885 | The auto-repeater uses this.") | |
4b3a9ba7 | 13886 | |
d3f4dbe8 | 13887 | (defun org-add-log-maybe (&optional purpose state findpos) |
a3fbe8c4 | 13888 | "Set up the post command hook to take a note." |
d3f4dbe8 CD |
13889 | (save-excursion |
13890 | (when (and (listp org-log-done) | |
13891 | (memq purpose org-log-done)) | |
13892 | (when findpos | |
13893 | (org-back-to-heading t) | |
13894 | (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" | |
13895 | "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp | |
13896 | "[^\r\n]*\\)?")) | |
48aaad2d CD |
13897 | (goto-char (match-end 0)) |
13898 | (unless org-log-states-order-reversed | |
374585c9 CD |
13899 | (and (= (char-after) ?\n) (forward-char 1)) |
13900 | (org-skip-over-state-notes) | |
48aaad2d | 13901 | (skip-chars-backward " \t\n\r"))) |
d3f4dbe8 CD |
13902 | (move-marker org-log-note-marker (point)) |
13903 | (setq org-log-note-purpose purpose) | |
13904 | (setq org-log-note-state state) | |
13905 | (add-hook 'post-command-hook 'org-add-log-note 'append)))) | |
4b3a9ba7 | 13906 | |
374585c9 CD |
13907 | (defun org-skip-over-state-notes () |
13908 | "Skip past the list of State notes in an entry." | |
13909 | (if (looking-at "\n[ \t]*- State") (forward-char 1)) | |
13910 | (while (looking-at "[ \t]*- State") | |
13911 | (condition-case nil | |
13912 | (org-next-item) | |
13913 | (error (org-end-of-item))))) | |
13914 | ||
d3f4dbe8 CD |
13915 | (defun org-add-log-note (&optional purpose) |
13916 | "Pop up a window for taking a note, and add this note later at point." | |
13917 | (remove-hook 'post-command-hook 'org-add-log-note) | |
13918 | (setq org-log-note-window-configuration (current-window-configuration)) | |
13919 | (delete-other-windows) | |
13920 | (move-marker org-log-note-return-to (point)) | |
13921 | (switch-to-buffer (marker-buffer org-log-note-marker)) | |
13922 | (goto-char org-log-note-marker) | |
374585c9 | 13923 | (org-switch-to-buffer-other-window "*Org Note*") |
d3f4dbe8 CD |
13924 | (erase-buffer) |
13925 | (let ((org-inhibit-startup t)) (org-mode)) | |
03f3cf35 JW |
13926 | (insert (format "# Insert note for %s. |
13927 | # Finish with C-c C-c, or cancel with C-c C-k.\n\n" | |
d3f4dbe8 CD |
13928 | (cond |
13929 | ((eq org-log-note-purpose 'clock-out) "stopped clock") | |
13930 | ((eq org-log-note-purpose 'done) "closed todo item") | |
03f3cf35 JW |
13931 | ((eq org-log-note-purpose 'state) |
13932 | (format "state change to \"%s\"" org-log-note-state)) | |
d3f4dbe8 CD |
13933 | (t (error "This should not happen"))))) |
13934 | (org-set-local 'org-finish-function 'org-store-log-note)) | |
4b3a9ba7 | 13935 | |
d3f4dbe8 CD |
13936 | (defun org-store-log-note () |
13937 | "Finish taking a log note, and insert it to where it belongs." | |
13938 | (let ((txt (buffer-string)) | |
13939 | (note (cdr (assq org-log-note-purpose org-log-note-headings))) | |
13940 | lines ind) | |
13941 | (kill-buffer (current-buffer)) | |
03f3cf35 JW |
13942 | (while (string-match "\\`#.*\n[ \t\n]*" txt) |
13943 | (setq txt (replace-match "" t t txt))) | |
d3f4dbe8 CD |
13944 | (if (string-match "\\s-+\\'" txt) |
13945 | (setq txt (replace-match "" t t txt))) | |
13946 | (setq lines (org-split-string txt "\n")) | |
13947 | (when (and note (string-match "\\S-" note)) | |
13948 | (setq note | |
13949 | (org-replace-escapes | |
13950 | note | |
13951 | (list (cons "%u" (user-login-name)) | |
13952 | (cons "%U" user-full-name) | |
13953 | (cons "%t" (format-time-string | |
13954 | (org-time-stamp-format 'long 'inactive) | |
13955 | (current-time))) | |
13956 | (cons "%s" (if org-log-note-state | |
13957 | (concat "\"" org-log-note-state "\"") | |
13958 | ""))))) | |
13959 | (if lines (setq note (concat note " \\\\"))) | |
13960 | (push note lines)) | |
03f3cf35 | 13961 | (when (or current-prefix-arg org-note-abort) (setq lines nil)) |
a3fbe8c4 | 13962 | (when lines |
d3f4dbe8 | 13963 | (save-excursion |
a3fbe8c4 CD |
13964 | (set-buffer (marker-buffer org-log-note-marker)) |
13965 | (save-excursion | |
13966 | (goto-char org-log-note-marker) | |
13967 | (move-marker org-log-note-marker nil) | |
13968 | (end-of-line 1) | |
03f3cf35 JW |
13969 | (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) |
13970 | (indent-relative nil) | |
a3fbe8c4 | 13971 | (insert " - " (pop lines)) |
48aaad2d CD |
13972 | (org-indent-line-function) |
13973 | (beginning-of-line 1) | |
13974 | (looking-at "[ \t]*") | |
13975 | (setq ind (concat (match-string 0) " ")) | |
13976 | (end-of-line 1) | |
13977 | (while lines (insert "\n" ind (pop lines))))))) | |
d3f4dbe8 CD |
13978 | (set-window-configuration org-log-note-window-configuration) |
13979 | (with-current-buffer (marker-buffer org-log-note-return-to) | |
13980 | (goto-char org-log-note-return-to)) | |
13981 | (move-marker org-log-note-return-to nil) | |
274f1353 | 13982 | (and org-log-post-message (message "%s" org-log-post-message))) |
2a94e282 | 13983 | |
03f3cf35 JW |
13984 | ;; FIXME: what else would be useful? |
13985 | ;; - priority | |
13986 | ;; - date | |
13987 | ||
13988 | (defun org-sparse-tree (&optional arg) | |
13989 | "Create a sparse tree, prompt for the details. | |
13990 | This command can create sparse trees. You first need to select the type | |
13991 | of match used to create the tree: | |
13992 | ||
13993 | t Show entries with a specific TODO keyword. | |
13994 | T Show entries selected by a tags match. | |
13995 | p Enter a property name and its value (both with completion on existing | |
13996 | names/values) and show entries with that property. | |
13997 | r Show entries matching a regular expression" | |
13998 | (interactive "P") | |
13999 | (let (ans kwd value) | |
14000 | (message "Sparse tree: [r]egexp [t]odo-kwd [T]ag [p]roperty") | |
14001 | (setq ans (read-char-exclusive)) | |
14002 | (cond | |
14003 | ((equal ans ?t) | |
14004 | (org-show-todo-tree '(4))) | |
14005 | ((equal ans ?T) | |
14006 | (call-interactively 'org-tags-sparse-tree)) | |
14007 | ((member ans '(?p ?P)) | |
fbe6c10d | 14008 | (setq kwd (completing-read "Property: " |
03f3cf35 JW |
14009 | (mapcar 'list (org-buffer-property-keys)))) |
14010 | (setq value (completing-read "Value: " | |
14011 | (mapcar 'list (org-property-values kwd)))) | |
14012 | (unless (string-match "\\`{.*}\\'" value) | |
14013 | (setq value (concat "\"" value "\""))) | |
14014 | (org-tags-sparse-tree arg (concat kwd "=" value))) | |
14015 | ((member ans '(?r ?R)) | |
14016 | (call-interactively 'org-occur)) | |
14017 | (t (error "No such sparse tree command \"%c\"" ans))))) | |
14018 | ||
d3f4dbe8 CD |
14019 | (defvar org-occur-highlights nil) |
14020 | (make-variable-buffer-local 'org-occur-highlights) | |
891f4676 | 14021 | |
d3f4dbe8 CD |
14022 | (defun org-occur (regexp &optional keep-previous callback) |
14023 | "Make a compact tree which shows all matches of REGEXP. | |
14024 | The tree will show the lines where the regexp matches, and all higher | |
14025 | headlines above the match. It will also show the heading after the match, | |
14026 | to make sure editing the matching entry is easy. | |
14027 | If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous | |
14028 | call to `org-occur' will be kept, to allow stacking of calls to this | |
14029 | command. | |
14030 | If CALLBACK is non-nil, it is a function which is called to confirm | |
14031 | that the match should indeed be shown." | |
14032 | (interactive "sRegexp: \nP") | |
14033 | (or keep-previous (org-remove-occur-highlights nil nil t)) | |
14034 | (let ((cnt 0)) | |
14035 | (save-excursion | |
14036 | (goto-char (point-min)) | |
14037 | (if (or (not keep-previous) ; do not want to keep | |
14038 | (not org-occur-highlights)) ; no previous matches | |
14039 | ;; hide everything | |
14040 | (org-overview)) | |
14041 | (while (re-search-forward regexp nil t) | |
14042 | (when (or (not callback) | |
14043 | (save-match-data (funcall callback))) | |
14044 | (setq cnt (1+ cnt)) | |
a3fbe8c4 CD |
14045 | (when org-highlight-sparse-tree-matches |
14046 | (org-highlight-new-match (match-beginning 0) (match-end 0))) | |
d3f4dbe8 CD |
14047 | (org-show-context 'occur-tree)))) |
14048 | (when org-remove-highlights-with-change | |
14049 | (org-add-hook 'before-change-functions 'org-remove-occur-highlights | |
14050 | nil 'local)) | |
14051 | (unless org-sparse-tree-open-archived-trees | |
14052 | (org-hide-archived-subtrees (point-min) (point-max))) | |
14053 | (run-hooks 'org-occur-hook) | |
14054 | (if (interactive-p) | |
14055 | (message "%d match(es) for regexp %s" cnt regexp)) | |
14056 | cnt)) | |
891f4676 | 14057 | |
d3f4dbe8 CD |
14058 | (defun org-show-context (&optional key) |
14059 | "Make sure point and context and visible. | |
14060 | How much context is shown depends upon the variables | |
14061 | `org-show-hierarchy-above', `org-show-following-heading'. and | |
14062 | `org-show-siblings'." | |
14063 | (let ((heading-p (org-on-heading-p t)) | |
14064 | (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) | |
14065 | (following-p (org-get-alist-option org-show-following-heading key)) | |
14066 | (siblings-p (org-get-alist-option org-show-siblings key))) | |
14067 | (catch 'exit | |
14068 | ;; Show heading or entry text | |
14069 | (if heading-p | |
14070 | (org-flag-heading nil) ; only show the heading | |
14071 | (and (or (org-invisible-p) (org-invisible-p2)) | |
14072 | (org-show-hidden-entry))) ; show entire entry | |
14073 | (when following-p | |
14074 | ;; Show next sibling, or heading below text | |
14075 | (save-excursion | |
14076 | (and (if heading-p (org-goto-sibling) (outline-next-heading)) | |
14077 | (org-flag-heading nil)))) | |
14078 | (when siblings-p (org-show-siblings)) | |
14079 | (when hierarchy-p | |
14080 | ;; show all higher headings, possibly with siblings | |
14081 | (save-excursion | |
14082 | (while (and (condition-case nil | |
14083 | (progn (org-up-heading-all 1) t) | |
14084 | (error nil)) | |
14085 | (not (bobp))) | |
14086 | (org-flag-heading nil) | |
14087 | (when siblings-p (org-show-siblings)))))))) | |
891f4676 | 14088 | |
d3f4dbe8 CD |
14089 | (defun org-reveal (&optional siblings) |
14090 | "Show current entry, hierarchy above it, and the following headline. | |
14091 | This can be used to show a consistent set of context around locations | |
14092 | exposed with `org-show-hierarchy-above' or `org-show-following-heading' | |
14093 | not t for the search context. | |
6769c0dc | 14094 | |
d3f4dbe8 CD |
14095 | With optional argument SIBLINGS, on each level of the hierarchy all |
14096 | siblings are shown. This repairs the tree structure to what it would | |
14097 | look like when opened with hierarchical calls to `org-cycle'." | |
14098 | (interactive "P") | |
14099 | (let ((org-show-hierarchy-above t) | |
14100 | (org-show-following-heading t) | |
14101 | (org-show-siblings (if siblings t org-show-siblings))) | |
14102 | (org-show-context nil))) | |
891f4676 | 14103 | |
d3f4dbe8 CD |
14104 | (defun org-highlight-new-match (beg end) |
14105 | "Highlight from BEG to END and mark the highlight is an occur headline." | |
14106 | (let ((ov (org-make-overlay beg end))) | |
14107 | (org-overlay-put ov 'face 'secondary-selection) | |
14108 | (push ov org-occur-highlights))) | |
891f4676 | 14109 | |
d3f4dbe8 CD |
14110 | (defun org-remove-occur-highlights (&optional beg end noremove) |
14111 | "Remove the occur highlights from the buffer. | |
14112 | BEG and END are ignored. If NOREMOVE is nil, remove this function | |
14113 | from the `before-change-functions' in the current buffer." | |
14114 | (interactive) | |
14115 | (unless org-inhibit-highlight-removal | |
14116 | (mapc 'org-delete-overlay org-occur-highlights) | |
14117 | (setq org-occur-highlights nil) | |
14118 | (unless noremove | |
14119 | (remove-hook 'before-change-functions | |
14120 | 'org-remove-occur-highlights 'local)))) | |
891f4676 | 14121 | |
d3f4dbe8 | 14122 | ;;;; Priorities |
891f4676 | 14123 | |
a3fbe8c4 | 14124 | (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)" |
d3f4dbe8 | 14125 | "Regular expression matching the priority indicator.") |
64f72ae1 | 14126 | |
d3f4dbe8 | 14127 | (defvar org-remove-priority-next-time nil) |
4b3a9ba7 | 14128 | |
d3f4dbe8 CD |
14129 | (defun org-priority-up () |
14130 | "Increase the priority of the current item." | |
14131 | (interactive) | |
14132 | (org-priority 'up)) | |
891f4676 | 14133 | |
d3f4dbe8 CD |
14134 | (defun org-priority-down () |
14135 | "Decrease the priority of the current item." | |
14136 | (interactive) | |
14137 | (org-priority 'down)) | |
891f4676 | 14138 | |
d3f4dbe8 CD |
14139 | (defun org-priority (&optional action) |
14140 | "Change the priority of an item by ARG. | |
5152b597 | 14141 | ACTION can be `set', `up', `down', or a character." |
d3f4dbe8 CD |
14142 | (interactive) |
14143 | (setq action (or action 'set)) | |
14144 | (let (current new news have remove) | |
14145 | (save-excursion | |
14146 | (org-back-to-heading) | |
14147 | (if (looking-at org-priority-regexp) | |
14148 | (setq current (string-to-char (match-string 2)) | |
14149 | have t) | |
14150 | (setq current org-default-priority)) | |
14151 | (cond | |
5152b597 CD |
14152 | ((or (eq action 'set) (integerp action)) |
14153 | (if (integerp action) | |
14154 | (setq new action) | |
14155 | (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) | |
14156 | (setq new (read-char-exclusive))) | |
d5098885 JW |
14157 | (if (and (= (upcase org-highest-priority) org-highest-priority) |
14158 | (= (upcase org-lowest-priority) org-lowest-priority)) | |
14159 | (setq new (upcase new))) | |
d3f4dbe8 | 14160 | (cond ((equal new ?\ ) (setq remove t)) |
a3fbe8c4 | 14161 | ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) |
d3f4dbe8 | 14162 | (error "Priority must be between `%c' and `%c'" |
a3fbe8c4 | 14163 | org-highest-priority org-lowest-priority)))) |
d3f4dbe8 | 14164 | ((eq action 'up) |
15841868 JW |
14165 | (if (and (not have) (eq last-command this-command)) |
14166 | (setq new org-lowest-priority) | |
14167 | (setq new (if (and org-priority-start-cycle-with-default (not have)) | |
14168 | org-default-priority (1- current))))) | |
d3f4dbe8 | 14169 | ((eq action 'down) |
15841868 JW |
14170 | (if (and (not have) (eq last-command this-command)) |
14171 | (setq new org-highest-priority) | |
14172 | (setq new (if (and org-priority-start-cycle-with-default (not have)) | |
14173 | org-default-priority (1+ current))))) | |
d3f4dbe8 | 14174 | (t (error "Invalid action"))) |
d5098885 JW |
14175 | (if (or (< (upcase new) org-highest-priority) |
14176 | (> (upcase new) org-lowest-priority)) | |
14177 | (setq remove t)) | |
d3f4dbe8 CD |
14178 | (setq news (format "%c" new)) |
14179 | (if have | |
14180 | (if remove | |
14181 | (replace-match "" t t nil 1) | |
14182 | (replace-match news t t nil 2)) | |
14183 | (if remove | |
14184 | (error "No priority cookie found in line") | |
14185 | (looking-at org-todo-line-regexp) | |
14186 | (if (match-end 2) | |
14187 | (progn | |
14188 | (goto-char (match-end 2)) | |
14189 | (insert " [#" news "]")) | |
14190 | (goto-char (match-beginning 3)) | |
14191 | (insert "[#" news "] "))))) | |
38f8646b | 14192 | (org-preserve-lc (org-set-tags nil 'align)) |
d3f4dbe8 CD |
14193 | (if remove |
14194 | (message "Priority removed") | |
14195 | (message "Priority of current item set to %s" news)))) | |
891f4676 | 14196 | |
a96ee7df | 14197 | |
d3f4dbe8 CD |
14198 | (defun org-get-priority (s) |
14199 | "Find priority cookie and return priority." | |
14200 | (save-match-data | |
14201 | (if (not (string-match org-priority-regexp s)) | |
14202 | (* 1000 (- org-lowest-priority org-default-priority)) | |
14203 | (* 1000 (- org-lowest-priority | |
14204 | (string-to-char (match-string 2 s))))))) | |
891f4676 | 14205 | |
d3f4dbe8 | 14206 | ;;;; Tags |
891f4676 | 14207 | |
d3f4dbe8 CD |
14208 | (defun org-scan-tags (action matcher &optional todo-only) |
14209 | "Scan headline tags with inheritance and produce output ACTION. | |
14210 | ACTION can be `sparse-tree' or `agenda'. MATCHER is a Lisp form to be | |
14211 | evaluated, testing if a given set of tags qualifies a headline for | |
14212 | inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword | |
14213 | are included in the output." | |
14214 | (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\(" | |
a3fbe8c4 | 14215 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") |
5152b597 CD |
14216 | (org-re |
14217 | "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) | |
d3f4dbe8 CD |
14218 | (props (list 'face nil |
14219 | 'done-face 'org-done | |
14220 | 'undone-face nil | |
14221 | 'mouse-face 'highlight | |
14222 | 'org-not-done-regexp org-not-done-regexp | |
a3fbe8c4 | 14223 | 'org-todo-regexp org-todo-regexp |
d3f4dbe8 CD |
14224 | 'keymap org-agenda-keymap |
14225 | 'help-echo | |
14226 | (format "mouse-2 or RET jump to org file %s" | |
fbe6c10d CD |
14227 | (abbreviate-file-name |
14228 | (or (buffer-file-name (buffer-base-buffer)) | |
14229 | (buffer-name (buffer-base-buffer))))))) | |
d3f4dbe8 CD |
14230 | (case-fold-search nil) |
14231 | lspos | |
14232 | tags tags-list tags-alist (llast 0) rtn level category i txt | |
a3fbe8c4 | 14233 | todo marker entry priority) |
d3f4dbe8 CD |
14234 | (save-excursion |
14235 | (goto-char (point-min)) | |
03f3cf35 JW |
14236 | (when (eq action 'sparse-tree) |
14237 | (org-overview) | |
14238 | (org-remove-occur-highlights)) | |
d3f4dbe8 CD |
14239 | (while (re-search-forward re nil t) |
14240 | (catch :skip | |
14241 | (setq todo (if (match-end 1) (match-string 2)) | |
14242 | tags (if (match-end 4) (match-string 4))) | |
14243 | (goto-char (setq lspos (1+ (match-beginning 0)))) | |
38f8646b | 14244 | (setq level (org-reduced-level (funcall outline-level)) |
d3f4dbe8 CD |
14245 | category (org-get-category)) |
14246 | (setq i llast llast level) | |
14247 | ;; remove tag lists from same and sublevels | |
14248 | (while (>= i level) | |
14249 | (when (setq entry (assoc i tags-alist)) | |
14250 | (setq tags-alist (delete entry tags-alist))) | |
14251 | (setq i (1- i))) | |
14252 | ;; add the nex tags | |
14253 | (when tags | |
14254 | (setq tags (mapcar 'downcase (org-split-string tags ":")) | |
14255 | tags-alist | |
14256 | (cons (cons level tags) tags-alist))) | |
14257 | ;; compile tags for current headline | |
14258 | (setq tags-list | |
14259 | (if org-use-tag-inheritance | |
14260 | (apply 'append (mapcar 'cdr tags-alist)) | |
14261 | tags)) | |
a3fbe8c4 | 14262 | (when (and (or (not todo-only) (member todo org-not-done-keywords)) |
d3f4dbe8 CD |
14263 | (eval matcher) |
14264 | (or (not org-agenda-skip-archived-trees) | |
14265 | (not (member org-archive-tag tags-list)))) | |
14266 | (and (eq action 'agenda) (org-agenda-skip)) | |
14267 | ;; list this headline | |
03f3cf35 | 14268 | |
d3f4dbe8 CD |
14269 | (if (eq action 'sparse-tree) |
14270 | (progn | |
03f3cf35 JW |
14271 | (and org-highlight-sparse-tree-matches |
14272 | (org-get-heading) (match-end 0) | |
14273 | (org-highlight-new-match | |
14274 | (match-beginning 0) (match-beginning 1))) | |
d3f4dbe8 CD |
14275 | (org-show-context 'tags-tree)) |
14276 | (setq txt (org-format-agenda-item | |
14277 | "" | |
14278 | (concat | |
14279 | (if org-tags-match-list-sublevels | |
14280 | (make-string (1- level) ?.) "") | |
14281 | (org-get-heading)) | |
a3fbe8c4 CD |
14282 | category tags-list) |
14283 | priority (org-get-priority txt)) | |
d3f4dbe8 CD |
14284 | (goto-char lspos) |
14285 | (setq marker (org-agenda-new-marker)) | |
14286 | (org-add-props txt props | |
a3fbe8c4 CD |
14287 | 'org-marker marker 'org-hd-marker marker 'org-category category |
14288 | 'priority priority 'type "tagsmatch") | |
d3f4dbe8 CD |
14289 | (push txt rtn)) |
14290 | ;; if we are to skip sublevels, jump to end of subtree | |
14291 | (or org-tags-match-list-sublevels (org-end-of-subtree t)))))) | |
14292 | (when (and (eq action 'sparse-tree) | |
14293 | (not org-sparse-tree-open-archived-trees)) | |
14294 | (org-hide-archived-subtrees (point-min) (point-max))) | |
14295 | (nreverse rtn))) | |
891f4676 | 14296 | |
d3f4dbe8 | 14297 | (defvar todo-only) ;; dynamically scoped |
4b3a9ba7 | 14298 | |
d3f4dbe8 CD |
14299 | (defun org-tags-sparse-tree (&optional todo-only match) |
14300 | "Create a sparse tree according to tags string MATCH. | |
14301 | MATCH can contain positive and negative selection of tags, like | |
14302 | \"+WORK+URGENT-WITHBOSS\". | |
14303 | If optional argument TODO_ONLY is non-nil, only select lines that are | |
14304 | also TODO lines." | |
14305 | (interactive "P") | |
14306 | (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) | |
0fee8d6e | 14307 | |
38f8646b CD |
14308 | (defvar org-cached-props nil) |
14309 | (defun org-cached-entry-get (pom property) | |
03f3cf35 JW |
14310 | (if org-use-property-inheritance |
14311 | ;; Caching is not possible, check it directly | |
14312 | (org-entry-get pom property 'inherit) | |
14313 | ;; Get all properties, so that we can do complicated checks easily | |
14314 | (cdr (assoc property (or org-cached-props | |
14315 | (setq org-cached-props | |
14316 | (org-entry-properties pom))))))) | |
38f8646b CD |
14317 | |
14318 | (defun org-global-tags-completion-table (&optional files) | |
14319 | "Return the list of all tags in all agenda buffer/files." | |
14320 | (save-excursion | |
14321 | (org-uniquify | |
14322 | (apply 'append | |
14323 | (mapcar | |
14324 | (lambda (file) | |
14325 | (set-buffer (find-file-noselect file)) | |
14326 | (org-get-buffer-tags)) | |
14327 | (if (and files (car files)) | |
14328 | files | |
14329 | (org-agenda-files))))))) | |
14330 | ||
d3f4dbe8 CD |
14331 | (defun org-make-tags-matcher (match) |
14332 | "Create the TAGS//TODO matcher form for the selection string MATCH." | |
14333 | ;; todo-only is scoped dynamically into this function, and the function | |
14334 | ;; may change it it the matcher asksk for it. | |
14335 | (unless match | |
14336 | ;; Get a new match request, with completion | |
38f8646b CD |
14337 | (let ((org-last-tags-completion-table |
14338 | (org-global-tags-completion-table))) | |
14339 | (setq match (completing-read | |
14340 | "Match: " 'org-tags-completion-function nil nil nil | |
14341 | 'org-tags-history)))) | |
fbe6c10d | 14342 | |
d3f4dbe8 CD |
14343 | ;; Parse the string and create a lisp form |
14344 | (let ((match0 match) | |
03f3cf35 | 14345 | (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL=\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)=\\({[^}]+}\\|\"[^\"]+\"\\)\\|[[:alnum:]_@]+\\)")) |
d3f4dbe8 CD |
14346 | minus tag mm |
14347 | tagsmatch todomatch tagsmatcher todomatcher kwd matcher | |
38f8646b | 14348 | orterms term orlist re-p level-p prop-p pn pv) |
d3f4dbe8 CD |
14349 | (if (string-match "/+" match) |
14350 | ;; match contains also a todo-matching request | |
14351 | (progn | |
14352 | (setq tagsmatch (substring match 0 (match-beginning 0)) | |
14353 | todomatch (substring match (match-end 0))) | |
14354 | (if (string-match "^!" todomatch) | |
14355 | (setq todo-only t todomatch (substring todomatch 1))) | |
14356 | (if (string-match "^\\s-*$" todomatch) | |
14357 | (setq todomatch nil))) | |
14358 | ;; only matching tags | |
14359 | (setq tagsmatch match todomatch nil)) | |
f425a6ea | 14360 | |
d3f4dbe8 CD |
14361 | ;; Make the tags matcher |
14362 | (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) | |
14363 | (setq tagsmatcher t) | |
14364 | (setq orterms (org-split-string tagsmatch "|") orlist nil) | |
14365 | (while (setq term (pop orterms)) | |
14366 | (while (and (equal (substring term -1) "\\") orterms) | |
14367 | (setq term (concat term "|" (pop orterms)))) ; repair bad split | |
14368 | (while (string-match re term) | |
14369 | (setq minus (and (match-end 1) | |
14370 | (equal (match-string 1 term) "-")) | |
14371 | tag (match-string 2 term) | |
14372 | re-p (equal (string-to-char tag) ?{) | |
14373 | level-p (match-end 3) | |
38f8646b | 14374 | prop-p (match-end 4) |
d3f4dbe8 CD |
14375 | mm (cond |
14376 | (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) | |
14377 | (level-p `(= level ,(string-to-number | |
14378 | (match-string 3 term)))) | |
38f8646b CD |
14379 | (prop-p |
14380 | (setq pn (match-string 4 term) | |
14381 | pv (match-string 5 term) | |
14382 | re-p (equal (string-to-char pv) ?{) | |
14383 | pv (substring pv 1 -1)) | |
14384 | (if re-p | |
03f3cf35 | 14385 | `(string-match ,pv (or (org-cached-entry-get nil ,pn) "")) |
38f8646b | 14386 | `(equal ,pv (org-cached-entry-get nil ,pn)))) |
d3f4dbe8 CD |
14387 | (t `(member ,(downcase tag) tags-list))) |
14388 | mm (if minus (list 'not mm) mm) | |
14389 | term (substring term (match-end 0))) | |
14390 | (push mm tagsmatcher)) | |
14391 | (push (if (> (length tagsmatcher) 1) | |
14392 | (cons 'and tagsmatcher) | |
14393 | (car tagsmatcher)) | |
14394 | orlist) | |
14395 | (setq tagsmatcher nil)) | |
38f8646b CD |
14396 | (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) |
14397 | (setq tagsmatcher | |
14398 | (list 'progn '(setq org-cached-props nil) tagsmatcher))) | |
30313b90 | 14399 | |
d3f4dbe8 CD |
14400 | ;; Make the todo matcher |
14401 | (if (or (not todomatch) (not (string-match "\\S-" todomatch))) | |
14402 | (setq todomatcher t) | |
14403 | (setq orterms (org-split-string todomatch "|") orlist nil) | |
14404 | (while (setq term (pop orterms)) | |
14405 | (while (string-match re term) | |
14406 | (setq minus (and (match-end 1) | |
14407 | (equal (match-string 1 term) "-")) | |
14408 | kwd (match-string 2 term) | |
14409 | re-p (equal (string-to-char kwd) ?{) | |
14410 | term (substring term (match-end 0)) | |
14411 | mm (if re-p | |
14412 | `(string-match ,(substring kwd 1 -1) todo) | |
14413 | (list 'equal 'todo kwd)) | |
14414 | mm (if minus (list 'not mm) mm)) | |
14415 | (push mm todomatcher)) | |
14416 | (push (if (> (length todomatcher) 1) | |
14417 | (cons 'and todomatcher) | |
14418 | (car todomatcher)) | |
14419 | orlist) | |
14420 | (setq todomatcher nil)) | |
14421 | (setq todomatcher (if (> (length orlist) 1) | |
14422 | (cons 'or orlist) (car orlist)))) | |
30313b90 | 14423 | |
d3f4dbe8 CD |
14424 | ;; Return the string and lisp forms of the matcher |
14425 | (setq matcher (if todomatcher | |
14426 | (list 'and tagsmatcher todomatcher) | |
14427 | tagsmatcher)) | |
14428 | (cons match0 matcher))) | |
35402b98 | 14429 | |
d3f4dbe8 CD |
14430 | (defun org-match-any-p (re list) |
14431 | "Does re match any element of list?" | |
14432 | (setq list (mapcar (lambda (x) (string-match re x)) list)) | |
14433 | (delq nil list)) | |
ab27a4a0 | 14434 | |
d3f4dbe8 CD |
14435 | (defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param |
14436 | (defvar org-tags-overlay (org-make-overlay 1 1)) | |
14437 | (org-detach-overlay org-tags-overlay) | |
891f4676 | 14438 | |
1e8fbb6d CD |
14439 | (defun org-align-tags-here (to-col) |
14440 | ;; Assumes that this is a headline | |
14441 | (let ((pos (point)) (col (current-column)) tags) | |
14442 | (beginning-of-line 1) | |
14443 | (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) | |
14444 | (< pos (match-beginning 2))) | |
14445 | (progn | |
14446 | (setq tags (match-string 2)) | |
14447 | (goto-char (match-beginning 1)) | |
14448 | (insert " ") | |
14449 | (delete-region (point) (1+ (match-end 0))) | |
14450 | (backward-char 1) | |
14451 | (move-to-column | |
14452 | (max (1+ (current-column)) | |
14453 | (1+ col) | |
14454 | (if (> to-col 0) | |
14455 | to-col | |
14456 | (- (abs to-col) (length tags)))) | |
14457 | t) | |
14458 | (insert tags) | |
14459 | (move-to-column (min (current-column) col) t)) | |
14460 | (goto-char pos)))) | |
14461 | ||
d3f4dbe8 CD |
14462 | (defun org-set-tags (&optional arg just-align) |
14463 | "Set the tags for the current headline. | |
14464 | With prefix ARG, realign all tags in headings in the current buffer." | |
14465 | (interactive "P") | |
14466 | (let* ((re (concat "^" outline-regexp)) | |
d5098885 | 14467 | (current (org-get-tags-string)) |
374585c9 CD |
14468 | (col (current-column)) |
14469 | (org-setting-tags t) | |
d3f4dbe8 CD |
14470 | table current-tags inherited-tags ; computed below when needed |
14471 | tags p0 c0 c1 rpl) | |
14472 | (if arg | |
14473 | (save-excursion | |
14474 | (goto-char (point-min)) | |
a3fbe8c4 | 14475 | (let ((buffer-invisibility-spec (org-inhibit-invisibility))) |
d3f4dbe8 CD |
14476 | (while (re-search-forward re nil t) |
14477 | (org-set-tags nil t) | |
14478 | (end-of-line 1))) | |
14479 | (message "All tags realigned to column %d" org-tags-column)) | |
14480 | (if just-align | |
14481 | (setq tags current) | |
14482 | ;; Get a new set of tags from the user | |
362bcf23 CD |
14483 | (save-excursion |
14484 | (setq table (or org-tag-alist (org-get-buffer-tags)) | |
14485 | org-last-tags-completion-table table | |
14486 | current-tags (org-split-string current ":") | |
14487 | inherited-tags (nreverse | |
14488 | (nthcdr (length current-tags) | |
14489 | (nreverse (org-get-tags-at)))) | |
14490 | tags | |
14491 | (if (or (eq t org-use-fast-tag-selection) | |
14492 | (and org-use-fast-tag-selection | |
14493 | (delq nil (mapcar 'cdr table)))) | |
0b8568f5 JW |
14494 | (org-fast-tag-selection |
14495 | current-tags inherited-tags table | |
14496 | (if org-fast-tag-selection-include-todo org-todo-key-alist)) | |
362bcf23 CD |
14497 | (let ((org-add-colon-after-tag-completion t)) |
14498 | (org-trim | |
15841868 JW |
14499 | (org-without-partial-completion |
14500 | (completing-read "Tags: " 'org-tags-completion-function | |
14501 | nil nil current 'org-tags-history))))))) | |
d3f4dbe8 CD |
14502 | (while (string-match "[-+&]+" tags) |
14503 | ;; No boolean logic, just a list | |
14504 | (setq tags (replace-match ":" t t tags)))) | |
fbe6c10d | 14505 | |
d3f4dbe8 CD |
14506 | (if (string-match "\\`[\t ]*\\'" tags) |
14507 | (setq tags "") | |
14508 | (unless (string-match ":$" tags) (setq tags (concat tags ":"))) | |
14509 | (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) | |
fbe6c10d | 14510 | |
d3f4dbe8 CD |
14511 | ;; Insert new tags at the correct column |
14512 | (beginning-of-line 1) | |
1e8fbb6d CD |
14513 | (cond |
14514 | ((and (equal current "") (equal tags ""))) | |
14515 | ((re-search-forward | |
14516 | (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") | |
14517 | (point-at-eol) t) | |
14518 | (if (equal tags "") | |
14519 | (setq rpl "") | |
14520 | (goto-char (match-beginning 0)) | |
14521 | (setq c0 (current-column) p0 (point) | |
14522 | c1 (max (1+ c0) (if (> org-tags-column 0) | |
14523 | org-tags-column | |
14524 | (- (- org-tags-column) (length tags)))) | |
14525 | rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) | |
14526 | (replace-match rpl t t) | |
14527 | (and (not (featurep 'xemacs)) c0 (tabify p0 (point))) | |
14528 | tags) | |
374585c9 | 14529 | (t (error "Tags alignment failed"))) |
d5098885 JW |
14530 | (move-to-column col) |
14531 | (unless just-align | |
14532 | (run-hooks 'org-after-tags-change-hook))))) | |
374585c9 CD |
14533 | |
14534 | (defun org-change-tag-in-region (beg end tag off) | |
14535 | "Add or remove TAG for each entry in the region. | |
14536 | This works in the agenda, and also in an org-mode buffer." | |
14537 | (interactive | |
14538 | (list (region-beginning) (region-end) | |
14539 | (let ((org-last-tags-completion-table | |
14540 | (if (org-mode-p) | |
14541 | (org-get-buffer-tags) | |
14542 | (org-global-tags-completion-table)))) | |
14543 | (completing-read | |
14544 | "Tag: " 'org-tags-completion-function nil nil nil | |
14545 | 'org-tags-history)) | |
14546 | (progn | |
14547 | (message "[s]et or [r]emove? ") | |
14548 | (equal (read-char-exclusive) ?r)))) | |
14549 | (if (fboundp 'deactivate-mark) (deactivate-mark)) | |
14550 | (let ((agendap (equal major-mode 'org-agenda-mode)) | |
14551 | l1 l2 m buf pos newhead (cnt 0)) | |
14552 | (goto-char end) | |
14553 | (setq l2 (1- (org-current-line))) | |
14554 | (goto-char beg) | |
14555 | (setq l1 (org-current-line)) | |
14556 | (loop for l from l1 to l2 do | |
14557 | (goto-line l) | |
14558 | (setq m (get-text-property (point) 'org-hd-marker)) | |
14559 | (when (or (and (org-mode-p) (org-on-heading-p)) | |
14560 | (and agendap m)) | |
14561 | (setq buf (if agendap (marker-buffer m) (current-buffer)) | |
14562 | pos (if agendap m (point))) | |
14563 | (with-current-buffer buf | |
14564 | (save-excursion | |
14565 | (save-restriction | |
14566 | (goto-char pos) | |
14567 | (setq cnt (1+ cnt)) | |
14568 | (org-toggle-tag tag (if off 'off 'on)) | |
14569 | (setq newhead (org-get-heading))))) | |
14570 | (and agendap (org-agenda-change-all-lines newhead m)))) | |
14571 | (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) | |
ab27a4a0 | 14572 | |
d3f4dbe8 CD |
14573 | (defun org-tags-completion-function (string predicate &optional flag) |
14574 | (let (s1 s2 rtn (ctable org-last-tags-completion-table) | |
14575 | (confirm (lambda (x) (stringp (car x))))) | |
14576 | (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) | |
14577 | (setq s1 (match-string 1 string) | |
14578 | s2 (match-string 2 string)) | |
14579 | (setq s1 "" s2 string)) | |
14580 | (cond | |
14581 | ((eq flag nil) | |
14582 | ;; try completion | |
14583 | (setq rtn (try-completion s2 ctable confirm)) | |
14584 | (if (stringp rtn) | |
7d58338e CD |
14585 | (setq rtn |
14586 | (concat s1 s2 (substring rtn (length s2)) | |
14587 | (if (and org-add-colon-after-tag-completion | |
14588 | (assoc rtn ctable)) | |
14589 | ":" "")))) | |
14590 | rtn) | |
d3f4dbe8 CD |
14591 | ((eq flag t) |
14592 | ;; all-completions | |
14593 | (all-completions s2 ctable confirm) | |
14594 | ) | |
14595 | ((eq flag 'lambda) | |
14596 | ;; exact match? | |
14597 | (assoc s2 ctable))) | |
14598 | )) | |
a96ee7df | 14599 | |
d3f4dbe8 CD |
14600 | (defun org-fast-tag-insert (kwd tags face &optional end) |
14601 | "Insert KDW, and the TAGS, the latter with face FACE. Also inser END." | |
14602 | (insert (format "%-12s" (concat kwd ":")) | |
14603 | (org-add-props (mapconcat 'identity tags " ") nil 'face face) | |
14604 | (or end ""))) | |
891f4676 | 14605 | |
d3f4dbe8 | 14606 | (defun org-fast-tag-show-exit (flag) |
891f4676 | 14607 | (save-excursion |
d3f4dbe8 CD |
14608 | (goto-line 3) |
14609 | (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) | |
14610 | (replace-match "")) | |
14611 | (when flag | |
14612 | (end-of-line 1) | |
14613 | (move-to-column (- (window-width) 19) t) | |
14614 | (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) | |
891f4676 | 14615 | |
d3f4dbe8 CD |
14616 | (defun org-set-current-tags-overlay (current prefix) |
14617 | (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) | |
14618 | (if (featurep 'xemacs) | |
14619 | (org-overlay-display org-tags-overlay (concat prefix s) | |
14620 | 'secondary-selection) | |
14621 | (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) | |
14622 | (org-overlay-display org-tags-overlay (concat prefix s))))) | |
ab27a4a0 | 14623 | |
374585c9 | 14624 | (defun org-fast-tag-selection (current inherited table &optional todo-table) |
d3f4dbe8 CD |
14625 | "Fast tag selection with single keys. |
14626 | CURRENT is the current list of tags in the headline, INHERITED is the | |
14627 | list of inherited tags, and TABLE is an alist of tags and corresponding keys, | |
374585c9 CD |
14628 | possibly with grouping information. TODO-TABLE is a similar table with |
14629 | TODO keywords, should these have keys assigned to them. | |
d3f4dbe8 CD |
14630 | If the keys are nil, a-z are automatically assigned. |
14631 | Returns the new tags string, or nil to not change the current settings." | |
374585c9 CD |
14632 | (let* ((fulltable (append table todo-table)) |
14633 | (maxlen (apply 'max (mapcar | |
d3f4dbe8 CD |
14634 | (lambda (x) |
14635 | (if (stringp (car x)) (string-width (car x)) 0)) | |
374585c9 | 14636 | fulltable))) |
d3f4dbe8 CD |
14637 | (buf (current-buffer)) |
14638 | (expert (eq org-fast-tag-selection-single-key 'expert)) | |
14639 | (buffer-tags nil) | |
14640 | (fwidth (+ maxlen 3 1 3)) | |
14641 | (ncol (/ (- (window-width) 4) fwidth)) | |
14642 | (i-face 'org-done) | |
a3fbe8c4 | 14643 | (c-face 'org-todo) |
d3f4dbe8 CD |
14644 | tg cnt e c char c1 c2 ntable tbl rtn |
14645 | ov-start ov-end ov-prefix | |
14646 | (exit-after-next org-fast-tag-selection-single-key) | |
0b8568f5 | 14647 | (done-keywords org-done-keywords) |
d3f4dbe8 CD |
14648 | groups ingroup) |
14649 | (save-excursion | |
14650 | (beginning-of-line 1) | |
5152b597 | 14651 | (if (looking-at |
7d58338e | 14652 | (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) |
d3f4dbe8 CD |
14653 | (setq ov-start (match-beginning 1) |
14654 | ov-end (match-end 1) | |
14655 | ov-prefix "") | |
14656 | (setq ov-start (1- (point-at-eol)) | |
14657 | ov-end (1+ ov-start)) | |
14658 | (skip-chars-forward "^\n\r") | |
14659 | (setq ov-prefix | |
14660 | (concat | |
14661 | (buffer-substring (1- (point)) (point)) | |
14662 | (if (> (current-column) org-tags-column) | |
14663 | " " | |
14664 | (make-string (- org-tags-column (current-column)) ?\ )))))) | |
14665 | (org-move-overlay org-tags-overlay ov-start ov-end) | |
14666 | (save-window-excursion | |
14667 | (if expert | |
14668 | (set-buffer (get-buffer-create " *Org tags*")) | |
14669 | (delete-other-windows) | |
14670 | (split-window-vertically) | |
374585c9 | 14671 | (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) |
d3f4dbe8 | 14672 | (erase-buffer) |
0b8568f5 | 14673 | (org-set-local 'org-done-keywords done-keywords) |
d3f4dbe8 CD |
14674 | (org-fast-tag-insert "Inherited" inherited i-face "\n") |
14675 | (org-fast-tag-insert "Current" current c-face "\n\n") | |
14676 | (org-fast-tag-show-exit exit-after-next) | |
14677 | (org-set-current-tags-overlay current ov-prefix) | |
374585c9 | 14678 | (setq tbl fulltable char ?a cnt 0) |
d3f4dbe8 | 14679 | (while (setq e (pop tbl)) |
4b3a9ba7 | 14680 | (cond |
d3f4dbe8 CD |
14681 | ((equal e '(:startgroup)) |
14682 | (push '() groups) (setq ingroup t) | |
14683 | (when (not (= cnt 0)) | |
14684 | (setq cnt 0) | |
14685 | (insert "\n")) | |
14686 | (insert "{ ")) | |
14687 | ((equal e '(:endgroup)) | |
14688 | (setq ingroup nil cnt 0) | |
14689 | (insert "}\n")) | |
4b3a9ba7 | 14690 | (t |
d3f4dbe8 CD |
14691 | (setq tg (car e) c2 nil) |
14692 | (if (cdr e) | |
14693 | (setq c (cdr e)) | |
14694 | ;; automatically assign a character. | |
14695 | (setq c1 (string-to-char | |
14696 | (downcase (substring | |
14697 | tg (if (= (string-to-char tg) ?@) 1 0))))) | |
14698 | (if (or (rassoc c1 ntable) (rassoc c1 table)) | |
14699 | (while (or (rassoc char ntable) (rassoc char table)) | |
14700 | (setq char (1+ char))) | |
14701 | (setq c2 c1)) | |
14702 | (setq c (or c2 char))) | |
14703 | (if ingroup (push tg (car groups))) | |
14704 | (setq tg (org-add-props tg nil 'face | |
14705 | (cond | |
0b8568f5 JW |
14706 | ((not (assoc tg table)) |
14707 | (org-get-todo-face tg)) | |
d3f4dbe8 CD |
14708 | ((member tg current) c-face) |
14709 | ((member tg inherited) i-face) | |
14710 | (t nil)))) | |
14711 | (if (and (= cnt 0) (not ingroup)) (insert " ")) | |
14712 | (insert "[" c "] " tg (make-string | |
14713 | (- fwidth 4 (length tg)) ?\ )) | |
14714 | (push (cons tg c) ntable) | |
14715 | (when (= (setq cnt (1+ cnt)) ncol) | |
14716 | (insert "\n") | |
14717 | (if ingroup (insert " ")) | |
14718 | (setq cnt 0))))) | |
14719 | (setq ntable (nreverse ntable)) | |
14720 | (insert "\n") | |
14721 | (goto-char (point-min)) | |
14722 | (if (and (not expert) (fboundp 'fit-window-to-buffer)) | |
14723 | (fit-window-to-buffer)) | |
14724 | (setq rtn | |
14725 | (catch 'exit | |
14726 | (while t | |
14727 | (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s" | |
14728 | (if groups " [!] no groups" " [!]groups") | |
14729 | (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) | |
14730 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
14731 | (cond | |
14732 | ((= c ?\r) (throw 'exit t)) | |
14733 | ((= c ?!) | |
14734 | (setq groups (not groups)) | |
14735 | (goto-char (point-min)) | |
14736 | (while (re-search-forward "[{}]" nil t) (replace-match " "))) | |
14737 | ((= c ?\C-c) | |
14738 | (if (not expert) | |
14739 | (org-fast-tag-show-exit | |
14740 | (setq exit-after-next (not exit-after-next))) | |
14741 | (setq expert nil) | |
14742 | (delete-other-windows) | |
14743 | (split-window-vertically) | |
374585c9 | 14744 | (org-switch-to-buffer-other-window " *Org tags*") |
d3f4dbe8 CD |
14745 | (and (fboundp 'fit-window-to-buffer) |
14746 | (fit-window-to-buffer)))) | |
14747 | ((or (= c ?\C-g) | |
14748 | (and (= c ?q) (not (rassoc c ntable)))) | |
14749 | (org-detach-overlay org-tags-overlay) | |
14750 | (setq quit-flag t)) | |
14751 | ((= c ?\ ) | |
14752 | (setq current nil) | |
14753 | (if exit-after-next (setq exit-after-next 'now))) | |
14754 | ((= c ?\t) | |
14755 | (condition-case nil | |
14756 | (setq tg (completing-read | |
14757 | "Tag: " | |
14758 | (or buffer-tags | |
14759 | (with-current-buffer buf | |
14760 | (org-get-buffer-tags))))) | |
14761 | (quit (setq tg ""))) | |
14762 | (when (string-match "\\S-" tg) | |
14763 | (add-to-list 'buffer-tags (list tg)) | |
14764 | (if (member tg current) | |
14765 | (setq current (delete tg current)) | |
14766 | (push tg current))) | |
14767 | (if exit-after-next (setq exit-after-next 'now))) | |
374585c9 CD |
14768 | ((setq e (rassoc c todo-table) tg (car e)) |
14769 | (with-current-buffer buf | |
14770 | (save-excursion (org-todo tg))) | |
14771 | (if exit-after-next (setq exit-after-next 'now))) | |
d3f4dbe8 CD |
14772 | ((setq e (rassoc c ntable) tg (car e)) |
14773 | (if (member tg current) | |
14774 | (setq current (delete tg current)) | |
14775 | (loop for g in groups do | |
14776 | (if (member tg g) | |
fbe6c10d CD |
14777 | (mapc (lambda (x) |
14778 | (setq current (delete x current))) | |
14779 | g))) | |
d3f4dbe8 CD |
14780 | (push tg current)) |
14781 | (if exit-after-next (setq exit-after-next 'now)))) | |
891f4676 | 14782 | |
d3f4dbe8 CD |
14783 | ;; Create a sorted list |
14784 | (setq current | |
14785 | (sort current | |
14786 | (lambda (a b) | |
14787 | (assoc b (cdr (memq (assoc a ntable) ntable)))))) | |
14788 | (if (eq exit-after-next 'now) (throw 'exit t)) | |
14789 | (goto-char (point-min)) | |
14790 | (beginning-of-line 2) | |
14791 | (delete-region (point) (point-at-eol)) | |
14792 | (org-fast-tag-insert "Current" current c-face) | |
14793 | (org-set-current-tags-overlay current ov-prefix) | |
5152b597 CD |
14794 | (while (re-search-forward |
14795 | (org-re "\\[.\\] \\([[:alnum:]_@]+\\)") nil t) | |
d3f4dbe8 | 14796 | (setq tg (match-string 1)) |
0b8568f5 JW |
14797 | (add-text-properties |
14798 | (match-beginning 1) (match-end 1) | |
14799 | (list 'face | |
14800 | (cond | |
14801 | ((member tg current) c-face) | |
14802 | ((member tg inherited) i-face) | |
14803 | (t (get-text-property (match-beginning 1) 'face)))))) | |
d3f4dbe8 CD |
14804 | (goto-char (point-min))))) |
14805 | (org-detach-overlay org-tags-overlay) | |
14806 | (if rtn | |
14807 | (mapconcat 'identity current ":") | |
14808 | nil)))) | |
ab27a4a0 | 14809 | |
d5098885 | 14810 | (defun org-get-tags-string () |
d3f4dbe8 CD |
14811 | "Get the TAGS string in the current headline." |
14812 | (unless (org-on-heading-p t) | |
14813 | (error "Not on a heading")) | |
14814 | (save-excursion | |
14815 | (beginning-of-line 1) | |
7d58338e | 14816 | (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) |
d3f4dbe8 CD |
14817 | (org-match-string-no-properties 1) |
14818 | ""))) | |
ab27a4a0 | 14819 | |
d5098885 JW |
14820 | (defun org-get-tags () |
14821 | "Get the list of tags specified in the current headline." | |
14822 | (org-split-string (org-get-tags-string) ":")) | |
14823 | ||
d3f4dbe8 CD |
14824 | (defun org-get-buffer-tags () |
14825 | "Get a table of all tags used in the buffer, for completion." | |
14826 | (let (tags) | |
14827 | (save-excursion | |
14828 | (goto-char (point-min)) | |
fbe6c10d | 14829 | (while (re-search-forward |
5152b597 | 14830 | (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t\r\n]") nil t) |
38f8646b CD |
14831 | (when (equal (char-after (point-at-bol 0)) ?*) |
14832 | (mapc (lambda (x) (add-to-list 'tags x)) | |
14833 | (org-split-string (org-match-string-no-properties 1) ":"))))) | |
d3f4dbe8 | 14834 | (mapcar 'list tags))) |
891f4676 | 14835 | |
38f8646b CD |
14836 | |
14837 | ;;;; Properties | |
14838 | ||
14839 | ;;; Setting and retrieving properties | |
14840 | ||
14841 | (defconst org-special-properties | |
15841868 | 14842 | '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "PRIORITY") |
38f8646b CD |
14843 | "The special properties valid in Org-mode. |
14844 | ||
14845 | These are properties that are not defined in the property drawer, | |
14846 | but in some other way.") | |
14847 | ||
03f3cf35 JW |
14848 | (defconst org-default-properties |
14849 | '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" | |
14850 | "LOCATION" "LOGGING" "COLUMNS") | |
14851 | "Some properties that are used by Org-mode for various purposes. | |
14852 | Being in this list makes sure that they are offered for completion.") | |
14853 | ||
38f8646b CD |
14854 | (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" |
14855 | "Regular expression matching the first line of a property drawer.") | |
14856 | ||
14857 | (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" | |
14858 | "Regular expression matching the first line of a property drawer.") | |
14859 | ||
7d58338e CD |
14860 | (defun org-property-action () |
14861 | "Do an action on properties." | |
14862 | (interactive) | |
03f3cf35 | 14863 | (let (c) |
7d58338e | 14864 | (org-at-property-p) |
48aaad2d | 14865 | (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") |
7d58338e CD |
14866 | (setq c (read-char-exclusive)) |
14867 | (cond | |
14868 | ((equal c ?s) | |
14869 | (call-interactively 'org-set-property)) | |
14870 | ((equal c ?d) | |
14871 | (call-interactively 'org-delete-property)) | |
14872 | ((equal c ?D) | |
14873 | (call-interactively 'org-delete-property-globally)) | |
48aaad2d CD |
14874 | ((equal c ?c) |
14875 | (call-interactively 'org-compute-property-at-point)) | |
7d58338e CD |
14876 | (t (error "No such property action %c" c))))) |
14877 | ||
14878 | (defun org-at-property-p () | |
14879 | "Is the cursor in a property line?" | |
14880 | ;; FIXME: Does not check if we are actually in the drawer. | |
14881 | ;; FIXME: also returns true on any drawers..... | |
14882 | ;; This is used by C-c C-c for property action. | |
14883 | (save-excursion | |
14884 | (beginning-of-line 1) | |
0b8568f5 | 14885 | (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")))) |
7d58338e | 14886 | |
38f8646b CD |
14887 | (defmacro org-with-point-at (pom &rest body) |
14888 | "Move to buffer and point of point-or-marker POM for the duration of BODY." | |
14889 | (declare (indent 1) (debug t)) | |
14890 | `(save-excursion | |
14891 | (if (markerp pom) (set-buffer (marker-buffer pom))) | |
14892 | (save-excursion | |
14893 | (goto-char (or pom (point))) | |
14894 | ,@body))) | |
14895 | ||
14896 | (defun org-get-property-block (&optional beg end force) | |
14897 | "Return the (beg . end) range of the body of the property drawer. | |
14898 | BEG and END can be beginning and end of subtree, if not given | |
14899 | they will be found. | |
7d58338e | 14900 | If the drawer does not exist and FORCE is non-nil, create the drawer." |
38f8646b CD |
14901 | (catch 'exit |
14902 | (save-excursion | |
14903 | (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) | |
14904 | (end (or end (progn (outline-next-heading) (point))))) | |
14905 | (goto-char beg) | |
14906 | (if (re-search-forward org-property-start-re end t) | |
14907 | (setq beg (1+ (match-end 0))) | |
7d58338e CD |
14908 | (if force |
14909 | (save-excursion | |
14910 | (org-insert-property-drawer) | |
14911 | (setq end (progn (outline-next-heading) (point)))) | |
14912 | (throw 'exit nil)) | |
14913 | (goto-char beg) | |
14914 | (if (re-search-forward org-property-start-re end t) | |
14915 | (setq beg (1+ (match-end 0))))) | |
38f8646b CD |
14916 | (if (re-search-forward org-property-end-re end t) |
14917 | (setq end (match-beginning 0)) | |
14918 | (or force (throw 'exit nil)) | |
14919 | (goto-char beg) | |
14920 | (setq end beg) | |
14921 | (org-indent-line-function) | |
14922 | (insert ":END:\n")) | |
14923 | (cons beg end))))) | |
14924 | ||
14925 | (defun org-entry-properties (&optional pom which) | |
14926 | "Get all properties of the entry at point-or-marker POM. | |
14927 | This includes the TODO keyword, the tags, time strings for deadline, | |
14928 | scheduled, and clocking, and any additional properties defined in the | |
14929 | entry. The return value is an alist, keys may occur multiple times | |
14930 | if the property key was used several times. | |
14931 | POM may also be nil, in which case the current entry is used. | |
14932 | If WHICH is nil or `all', get all properties. If WHICH is | |
14933 | `special' or `standard', only get that subclass." | |
14934 | (setq which (or which 'all)) | |
14935 | (org-with-point-at pom | |
14936 | (let ((clockstr (substring org-clock-string 0 -1)) | |
14937 | (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) | |
7d58338e | 14938 | beg end range props sum-props key value) |
38f8646b CD |
14939 | (save-excursion |
14940 | (when (condition-case nil (org-back-to-heading t) (error nil)) | |
14941 | (setq beg (point)) | |
7d58338e | 14942 | (setq sum-props (get-text-property (point) 'org-summaries)) |
38f8646b CD |
14943 | (outline-next-heading) |
14944 | (setq end (point)) | |
14945 | (when (memq which '(all special)) | |
14946 | ;; Get the special properties, like TODO and tags | |
14947 | (goto-char beg) | |
14948 | (when (and (looking-at org-todo-line-regexp) (match-end 2)) | |
14949 | (push (cons "TODO" (org-match-string-no-properties 2)) props)) | |
14950 | (when (looking-at org-priority-regexp) | |
14951 | (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) | |
d5098885 JW |
14952 | (when (and (setq value (org-get-tags-string)) |
14953 | (string-match "\\S-" value)) | |
38f8646b CD |
14954 | (push (cons "TAGS" value) props)) |
14955 | (when (setq value (org-get-tags-at)) | |
14956 | (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) | |
14957 | props)) | |
14958 | (while (re-search-forward org-keyword-time-regexp end t) | |
14959 | (setq key (substring (org-match-string-no-properties 1) 0 -1)) | |
14960 | (unless (member key excluded) (push key excluded)) | |
14961 | (push (cons key | |
14962 | (if (equal key clockstr) | |
14963 | (org-no-properties | |
14964 | (org-trim | |
14965 | (buffer-substring | |
14966 | (match-beginning 2) (point-at-eol)))) | |
14967 | (org-match-string-no-properties 2))) | |
14968 | props))) | |
14969 | (when (memq which '(all standard)) | |
14970 | ;; Get the standard properties, like :PORP: ... | |
14971 | (setq range (org-get-property-block beg end)) | |
14972 | (when range | |
14973 | (goto-char (car range)) | |
14974 | (while (re-search-forward | |
0b8568f5 | 14975 | (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?") |
38f8646b CD |
14976 | (cdr range) t) |
14977 | (setq key (org-match-string-no-properties 1) | |
7d58338e | 14978 | value (org-trim (or (org-match-string-no-properties 2) ""))) |
38f8646b | 14979 | (unless (member key excluded) |
7d58338e CD |
14980 | (push (cons key (or value "")) props))))) |
14981 | (append sum-props (nreverse props))))))) | |
fbe6c10d | 14982 | |
38f8646b CD |
14983 | (defun org-entry-get (pom property &optional inherit) |
14984 | "Get value of PROPERTY for entry at point-or-marker POM. | |
14985 | If INHERIT is non-nil and the entry does not have the property, | |
7d58338e CD |
14986 | then also check higher levels of the hierarchy. |
14987 | If the property is present but empty, the return value is the empty string. | |
14988 | If the property is not present at all, nil is returned." | |
38f8646b CD |
14989 | (org-with-point-at pom |
14990 | (if inherit | |
14991 | (org-entry-get-with-inheritance property) | |
14992 | (if (member property org-special-properties) | |
14993 | ;; We need a special property. Use brute force, get all properties. | |
14994 | (cdr (assoc property (org-entry-properties nil 'special))) | |
14995 | (let ((range (org-get-property-block))) | |
14996 | (if (and range | |
14997 | (goto-char (car range)) | |
14998 | (re-search-forward | |
7d58338e | 14999 | (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)?") |
38f8646b CD |
15000 | (cdr range) t)) |
15001 | ;; Found the property, return it. | |
7d58338e CD |
15002 | (if (match-end 1) |
15003 | (org-match-string-no-properties 1) | |
15004 | ""))))))) | |
38f8646b CD |
15005 | |
15006 | (defun org-entry-delete (pom property) | |
15007 | "Delete the property PROPERTY from entry at point-or-marker POM." | |
15008 | (org-with-point-at pom | |
15009 | (if (member property org-special-properties) | |
15010 | nil ; cannot delete these properties. | |
15011 | (let ((range (org-get-property-block))) | |
15012 | (if (and range | |
15013 | (goto-char (car range)) | |
15014 | (re-search-forward | |
15015 | (concat "^[ \t]*:" property ":[ \t]*\\(.*\\S-\\)") | |
15016 | (cdr range) t)) | |
7d58338e CD |
15017 | (progn |
15018 | (delete-region (match-beginning 0) (1+ (point-at-eol))) | |
15019 | t) | |
15020 | nil))))) | |
38f8646b | 15021 | |
03f3cf35 JW |
15022 | ;; Multi-values properties are properties that contain multiple values |
15023 | ;; These values are assumed to be single words, separated by whitespace. | |
15024 | (defun org-entry-add-to-multivalued-property (pom property value) | |
15025 | "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." | |
15026 | (let* ((old (org-entry-get pom property)) | |
15027 | (values (and old (org-split-string old "[ \t]")))) | |
15028 | (unless (member value values) | |
15029 | (setq values (cons value values)) | |
15030 | (org-entry-put pom property | |
15031 | (mapconcat 'identity values " "))))) | |
15032 | ||
15033 | (defun org-entry-remove-from-multivalued-property (pom property value) | |
15034 | "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." | |
15035 | (let* ((old (org-entry-get pom property)) | |
15036 | (values (and old (org-split-string old "[ \t]")))) | |
15037 | (when (member value values) | |
15038 | (setq values (delete value values)) | |
15039 | (org-entry-put pom property | |
15040 | (mapconcat 'identity values " "))))) | |
15041 | ||
15042 | (defun org-entry-member-in-multivalued-property (pom property value) | |
15043 | "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" | |
15044 | (let* ((old (org-entry-get pom property)) | |
15045 | (values (and old (org-split-string old "[ \t]")))) | |
15046 | (member value values))) | |
15047 | ||
38f8646b CD |
15048 | (defvar org-entry-property-inherited-from (make-marker)) |
15049 | ||
15050 | (defun org-entry-get-with-inheritance (property) | |
15051 | "Get entry property, and search higher levels if not present." | |
15052 | (let (tmp) | |
15053 | (save-excursion | |
03f3cf35 JW |
15054 | (save-restriction |
15055 | (widen) | |
15056 | (catch 'ex | |
15057 | (while t | |
15058 | (when (setq tmp (org-entry-get nil property)) | |
15059 | (org-back-to-heading t) | |
15060 | (move-marker org-entry-property-inherited-from (point)) | |
15061 | (throw 'ex tmp)) | |
15062 | (or (org-up-heading-safe) (throw 'ex nil))))) | |
15063 | (or tmp (cdr (assoc property org-local-properties)) | |
15064 | (cdr (assoc property org-global-properties)))))) | |
fbe6c10d | 15065 | |
38f8646b CD |
15066 | (defun org-entry-put (pom property value) |
15067 | "Set PROPERTY to VALUE for entry at point-or-marker POM." | |
15068 | (org-with-point-at pom | |
15069 | (org-back-to-heading t) | |
15070 | (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) | |
15071 | range) | |
15072 | (cond | |
15073 | ((equal property "TODO") | |
15074 | (when (and (stringp value) (string-match "\\S-" value) | |
15075 | (not (member value org-todo-keywords-1))) | |
15076 | (error "\"%s\" is not a valid TODO state" value)) | |
15077 | (if (or (not value) | |
15078 | (not (string-match "\\S-" value))) | |
15079 | (setq value 'none)) | |
15080 | (org-todo value) | |
15081 | (org-set-tags nil 'align)) | |
15082 | ((equal property "PRIORITY") | |
15083 | (org-priority (if (and value (stringp value) (string-match "\\S-" value)) | |
15084 | (string-to-char value) ?\ )) | |
15085 | (org-set-tags nil 'align)) | |
48aaad2d CD |
15086 | ((equal property "SCHEDULED") |
15087 | (if (re-search-forward org-scheduled-time-regexp end t) | |
15088 | (cond | |
15089 | ((eq value 'earlier) (org-timestamp-change -1 'day)) | |
15090 | ((eq value 'later) (org-timestamp-change 1 'day)) | |
15091 | (t (call-interactively 'org-schedule))) | |
15092 | (call-interactively 'org-schedule))) | |
15093 | ((equal property "DEADLINE") | |
15094 | (if (re-search-forward org-deadline-time-regexp end t) | |
15095 | (cond | |
15096 | ((eq value 'earlier) (org-timestamp-change -1 'day)) | |
15097 | ((eq value 'later) (org-timestamp-change 1 'day)) | |
15098 | (t (call-interactively 'org-deadline))) | |
15099 | (call-interactively 'org-deadline))) | |
38f8646b CD |
15100 | ((member property org-special-properties) |
15101 | (error "The %s property can not yet be set with `org-entry-put'" | |
15102 | property)) | |
15103 | (t ; a non-special property | |
15841868 JW |
15104 | (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21 |
15105 | (setq range (org-get-property-block beg end 'force)) | |
15106 | (goto-char (car range)) | |
15107 | (if (re-search-forward | |
15108 | (concat "^[ \t]*:" property ":\\(.*\\)") (cdr range) t) | |
15109 | (progn | |
15110 | (delete-region (match-beginning 1) (match-end 1)) | |
15111 | (goto-char (match-beginning 1))) | |
15112 | (goto-char (cdr range)) | |
15113 | (insert "\n") | |
15114 | (backward-char 1) | |
15115 | (org-indent-line-function) | |
15116 | (insert ":" property ":")) | |
15117 | (and value (insert " " value)) | |
15118 | (org-indent-line-function))))))) | |
15119 | ||
15120 | (defun org-buffer-property-keys (&optional include-specials include-defaults) | |
15121 | "Get all property keys in the current buffer. | |
15122 | With INCLUDE-SPECIALS, also list the special properties that relect things | |
15123 | like tags and TODO state. | |
15124 | With INCLUDE-DEFAULTS, also include properties that has special meaning | |
15125 | internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING." | |
38f8646b CD |
15126 | (let (rtn range) |
15127 | (save-excursion | |
15128 | (save-restriction | |
15129 | (widen) | |
15130 | (goto-char (point-min)) | |
15131 | (while (re-search-forward org-property-start-re nil t) | |
15132 | (setq range (org-get-property-block)) | |
15133 | (goto-char (car range)) | |
0b8568f5 JW |
15134 | (while (re-search-forward |
15135 | (org-re "^[ \t]*:\\([[:alnum:]_-]+\\):") | |
15136 | (cdr range) t) | |
38f8646b CD |
15137 | (add-to-list 'rtn (org-match-string-no-properties 1))) |
15138 | (outline-next-heading)))) | |
03f3cf35 | 15139 | |
38f8646b CD |
15140 | (when include-specials |
15141 | (setq rtn (append org-special-properties rtn))) | |
fbe6c10d | 15142 | |
15841868 | 15143 | (when include-defaults |
03f3cf35 | 15144 | (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)) |
fbe6c10d | 15145 | |
38f8646b CD |
15146 | (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) |
15147 | ||
03f3cf35 JW |
15148 | (defun org-property-values (key) |
15149 | "Return a list of all values of property KEY." | |
15150 | (save-excursion | |
15151 | (save-restriction | |
15152 | (widen) | |
15153 | (goto-char (point-min)) | |
15154 | (let ((re (concat "^[ \t]*:" key ":[ \t]*\\(\\S-.*\\)")) | |
15155 | values) | |
15156 | (while (re-search-forward re nil t) | |
15157 | (add-to-list 'values (org-trim (match-string 1)))) | |
15158 | (delete "" values))))) | |
15159 | ||
38f8646b | 15160 | (defun org-insert-property-drawer () |
7d58338e | 15161 | "Insert a property drawer into the current entry." |
38f8646b | 15162 | (interactive) |
7d58338e | 15163 | (org-back-to-heading t) |
03f3cf35 JW |
15164 | (looking-at outline-regexp) |
15165 | (let ((indent (- (match-end 0)(match-beginning 0))) | |
15166 | (beg (point)) | |
7d58338e CD |
15167 | (re (concat "^[ \t]*" org-keyword-time-regexp)) |
15168 | end hiddenp) | |
15169 | (outline-next-heading) | |
15170 | (setq end (point)) | |
15171 | (goto-char beg) | |
15172 | (while (re-search-forward re end t)) | |
15173 | (setq hiddenp (org-invisible-p)) | |
15174 | (end-of-line 1) | |
03f3cf35 | 15175 | (and (equal (char-after) ?\n) (forward-char 1)) |
374585c9 | 15176 | (org-skip-over-state-notes) |
03f3cf35 JW |
15177 | (skip-chars-backward " \t\n\r") |
15178 | (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) | |
7d58338e | 15179 | (beginning-of-line 0) |
03f3cf35 | 15180 | (indent-to-column indent) |
7d58338e | 15181 | (beginning-of-line 2) |
03f3cf35 | 15182 | (indent-to-column indent) |
7d58338e CD |
15183 | (beginning-of-line 0) |
15184 | (if hiddenp | |
15185 | (save-excursion | |
15186 | (org-back-to-heading t) | |
15187 | (hide-entry)) | |
15188 | (org-flag-drawer t)))) | |
15189 | ||
15190 | (defun org-set-property (property value) | |
03f3cf35 JW |
15191 | "In the current entry, set PROPERTY to VALUE. |
15192 | When called interactively, this will prompt for a property name, offering | |
15193 | completion on existing and default properties. And then it will prompt | |
15194 | for a value, offering competion either on allowed values (via an inherited | |
15195 | xxx_ALL property) or on existing values in other instances of this property | |
15196 | in the current file." | |
7d58338e | 15197 | (interactive |
03f3cf35 JW |
15198 | (let* ((prop (completing-read |
15199 | "Property: " (mapcar 'list (org-buffer-property-keys nil t)))) | |
7d58338e CD |
15200 | (cur (org-entry-get nil prop)) |
15201 | (allowed (org-property-get-allowed-values nil prop 'table)) | |
03f3cf35 | 15202 | (existing (mapcar 'list (org-property-values prop))) |
7d58338e CD |
15203 | (val (if allowed |
15204 | (completing-read "Value: " allowed nil 'req-match) | |
03f3cf35 | 15205 | (completing-read |
7d58338e CD |
15206 | (concat "Value" (if (and cur (string-match "\\S-" cur)) |
15207 | (concat "[" cur "]") "") | |
15208 | ": ") | |
03f3cf35 | 15209 | existing nil nil "" nil cur)))) |
7d58338e CD |
15210 | (list prop (if (equal val "") cur val)))) |
15211 | (unless (equal (org-entry-get nil property) value) | |
15212 | (org-entry-put nil property value))) | |
15213 | ||
15214 | (defun org-delete-property (property) | |
15215 | "In the current entry, delete PROPERTY." | |
15216 | (interactive | |
15217 | (let* ((prop (completing-read | |
15218 | "Property: " (org-entry-properties nil 'standard)))) | |
15219 | (list prop))) | |
274f1353 DK |
15220 | (message "Property %s %s" property |
15221 | (if (org-entry-delete nil property) | |
15222 | "deleted" | |
15223 | "was not present in the entry"))) | |
7d58338e CD |
15224 | |
15225 | (defun org-delete-property-globally (property) | |
15226 | "Remove PROPERTY globally, from all entries." | |
15227 | (interactive | |
15228 | (let* ((prop (completing-read | |
fbe6c10d | 15229 | "Globally remove property: " |
7d58338e CD |
15230 | (mapcar 'list (org-buffer-property-keys))))) |
15231 | (list prop))) | |
15232 | (save-excursion | |
15233 | (save-restriction | |
15234 | (widen) | |
15235 | (goto-char (point-min)) | |
15236 | (let ((cnt 0)) | |
15237 | (while (re-search-forward | |
15238 | (concat "^[ \t]*:" (regexp-quote property) ":.*\n?") | |
15239 | nil t) | |
15240 | (setq cnt (1+ cnt)) | |
15241 | (replace-match "")) | |
15242 | (message "Property \"%s\" removed from %d entries" property cnt))))) | |
15243 | ||
48aaad2d CD |
15244 | (defvar org-columns-current-fmt-compiled) ; defined below |
15245 | ||
15246 | (defun org-compute-property-at-point () | |
15841868 JW |
15247 | "Compute the property at point. |
15248 | This looks for an enclosing column format, extracts the operator and | |
15249 | then applies it to the proerty in the column format's scope." | |
48aaad2d CD |
15250 | (interactive) |
15251 | (unless (org-at-property-p) | |
15252 | (error "Not at a property")) | |
15253 | (let ((prop (org-match-string-no-properties 2))) | |
15254 | (org-columns-get-format-and-top-level) | |
15255 | (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) | |
15256 | (error "No operator defined for property %s" prop)) | |
15257 | (org-columns-compute prop))) | |
15258 | ||
7d58338e CD |
15259 | (defun org-property-get-allowed-values (pom property &optional table) |
15260 | "Get allowed values for the property PROPERTY. | |
15261 | When TABLE is non-nil, return an alist that can directly be used for | |
15262 | completion." | |
15263 | (let (vals) | |
15264 | (cond | |
15265 | ((equal property "TODO") | |
fbe6c10d | 15266 | (setq vals (org-with-point-at pom |
7d58338e CD |
15267 | (append org-todo-keywords-1 '(""))))) |
15268 | ((equal property "PRIORITY") | |
15269 | (let ((n org-lowest-priority)) | |
15270 | (while (>= n org-highest-priority) | |
15271 | (push (char-to-string n) vals) | |
15272 | (setq n (1- n))))) | |
15273 | ((member property org-special-properties)) | |
15274 | (t | |
15275 | (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) | |
fbe6c10d | 15276 | |
7d58338e CD |
15277 | (when (and vals (string-match "\\S-" vals)) |
15278 | (setq vals (car (read-from-string (concat "(" vals ")")))) | |
15279 | (setq vals (mapcar (lambda (x) | |
15280 | (cond ((stringp x) x) | |
15281 | ((numberp x) (number-to-string x)) | |
15282 | ((symbolp x) (symbol-name x)) | |
15283 | (t "???"))) | |
15284 | vals))))) | |
15285 | (if table (mapcar 'list vals) vals))) | |
15286 | ||
48aaad2d CD |
15287 | (defun org-property-previous-allowed-value (&optional previous) |
15288 | "Switch to the next allowed value for this property." | |
15289 | (interactive) | |
15290 | (org-property-next-allowed-value t)) | |
15291 | ||
15292 | (defun org-property-next-allowed-value (&optional previous) | |
15293 | "Switch to the next allowed value for this property." | |
15294 | (interactive) | |
15295 | (unless (org-at-property-p) | |
15296 | (error "Not at a property")) | |
15297 | (let* ((key (match-string 2)) | |
15298 | (value (match-string 3)) | |
15299 | (allowed (or (org-property-get-allowed-values (point) key) | |
15300 | (and (member value '("[ ]" "[-]" "[X]")) | |
15301 | '("[ ]" "[X]")))) | |
15302 | nval) | |
15303 | (unless allowed | |
15304 | (error "Allowed values for this property have not been defined")) | |
15305 | (if previous (setq allowed (reverse allowed))) | |
15306 | (if (member value allowed) | |
15307 | (setq nval (car (cdr (member value allowed))))) | |
15308 | (setq nval (or nval (car allowed))) | |
15309 | (if (equal nval value) | |
15310 | (error "Only one allowed value for this property")) | |
15311 | (org-at-property-p) | |
15312 | (replace-match (concat " :" key ": " nval) t t) | |
15313 | (org-indent-line-function) | |
15314 | (beginning-of-line 1) | |
15315 | (skip-chars-forward " \t"))) | |
15316 | ||
03f3cf35 JW |
15317 | (defun org-find-entry-with-id (ident) |
15318 | "Locate the entry that contains the ID property with exact value IDENT. | |
15319 | IDENT can be a string, a symbol or a number, this function will search for | |
15320 | the string representation of it. | |
15321 | Return the position where this entry starts, or nil if there is no such entry." | |
15322 | (let ((id (cond | |
15323 | ((stringp ident) ident) | |
15324 | ((symbol-name ident) (symbol-name ident)) | |
15325 | ((numberp ident) (number-to-string ident)) | |
15326 | (t (error "IDENT %s must be a string, symbol or number" ident)))) | |
15327 | (case-fold-search nil)) | |
15328 | (save-excursion | |
15329 | (save-restriction | |
15330 | (goto-char (point-min)) | |
15331 | (when (re-search-forward | |
15332 | (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") | |
15333 | nil t) | |
15334 | (org-back-to-heading) | |
15335 | (point)))))) | |
15336 | ||
7d58338e CD |
15337 | ;;; Column View |
15338 | ||
15339 | (defvar org-columns-overlays nil | |
38f8646b CD |
15340 | "Holds the list of current column overlays.") |
15341 | ||
7d58338e CD |
15342 | (defvar org-columns-current-fmt nil |
15343 | "Local variable, holds the currently active column format.") | |
15344 | (defvar org-columns-current-fmt-compiled nil | |
15345 | "Local variable, holds the currently active column format. | |
15346 | This is the compiled version of the format.") | |
03f3cf35 JW |
15347 | (defvar org-columns-current-widths nil |
15348 | "Loval variable, holds the currently widths of fields.") | |
7d58338e | 15349 | (defvar org-columns-current-maxwidths nil |
38f8646b | 15350 | "Loval variable, holds the currently active maximum column widths.") |
7d58338e CD |
15351 | (defvar org-columns-begin-marker (make-marker) |
15352 | "Points to the position where last a column creation command was called.") | |
15353 | (defvar org-columns-top-level-marker (make-marker) | |
15354 | "Points to the position where current columns region starts.") | |
38f8646b | 15355 | |
7d58338e | 15356 | (defvar org-columns-map (make-sparse-keymap) |
38f8646b CD |
15357 | "The keymap valid in column display.") |
15358 | ||
7d58338e CD |
15359 | (defun org-columns-content () |
15360 | "Switch to contents view while in columns view." | |
15361 | (interactive) | |
15362 | (org-overview) | |
15363 | (org-content)) | |
15364 | ||
15365 | (org-defkey org-columns-map "c" 'org-columns-content) | |
15366 | (org-defkey org-columns-map "o" 'org-overview) | |
15367 | (org-defkey org-columns-map "e" 'org-columns-edit-value) | |
03f3cf35 JW |
15368 | (org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo) |
15369 | (org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle) | |
fbe6c10d | 15370 | (org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link) |
7d58338e CD |
15371 | (org-defkey org-columns-map "v" 'org-columns-show-value) |
15372 | (org-defkey org-columns-map "q" 'org-columns-quit) | |
15373 | (org-defkey org-columns-map "r" 'org-columns-redo) | |
15374 | (org-defkey org-columns-map [left] 'backward-char) | |
03f3cf35 | 15375 | (org-defkey org-columns-map "\M-b" 'backward-char) |
7d58338e CD |
15376 | (org-defkey org-columns-map "a" 'org-columns-edit-allowed) |
15377 | (org-defkey org-columns-map "s" 'org-columns-edit-attributes) | |
03f3cf35 | 15378 | (org-defkey org-columns-map "\M-f" (lambda () (interactive) (goto-char (1+ (point))))) |
48aaad2d | 15379 | (org-defkey org-columns-map [right] (lambda () (interactive) (goto-char (1+ (point))))) |
7d58338e | 15380 | (org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) |
7d58338e CD |
15381 | (org-defkey org-columns-map "n" 'org-columns-next-allowed-value) |
15382 | (org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value) | |
15383 | (org-defkey org-columns-map "p" 'org-columns-previous-allowed-value) | |
15384 | (org-defkey org-columns-map "<" 'org-columns-narrow) | |
15385 | (org-defkey org-columns-map ">" 'org-columns-widen) | |
15386 | (org-defkey org-columns-map [(meta right)] 'org-columns-move-right) | |
15387 | (org-defkey org-columns-map [(meta left)] 'org-columns-move-left) | |
15388 | (org-defkey org-columns-map [(shift meta right)] 'org-columns-new) | |
15389 | (org-defkey org-columns-map [(shift meta left)] 'org-columns-delete) | |
15390 | ||
15391 | (easy-menu-define org-columns-menu org-columns-map "Org Column Menu" | |
38f8646b | 15392 | '("Column" |
7d58338e CD |
15393 | ["Edit property" org-columns-edit-value t] |
15394 | ["Next allowed value" org-columns-next-allowed-value t] | |
15395 | ["Previous allowed value" org-columns-previous-allowed-value t] | |
15396 | ["Show full value" org-columns-show-value t] | |
fbe6c10d | 15397 | ["Edit allowed values" org-columns-edit-allowed t] |
7d58338e CD |
15398 | "--" |
15399 | ["Edit column attributes" org-columns-edit-attributes t] | |
15400 | ["Increase column width" org-columns-widen t] | |
15401 | ["Decrease column width" org-columns-narrow t] | |
15402 | "--" | |
15403 | ["Move column right" org-columns-move-right t] | |
15404 | ["Move column left" org-columns-move-left t] | |
15405 | ["Add column" org-columns-new t] | |
15406 | ["Delete column" org-columns-delete t] | |
15407 | "--" | |
15408 | ["CONTENTS" org-columns-content t] | |
15409 | ["OVERVIEW" org-overview t] | |
15410 | ["Refresh columns display" org-columns-redo t] | |
15411 | "--" | |
fbe6c10d CD |
15412 | ["Open link" org-columns-open-link t] |
15413 | "--" | |
7d58338e | 15414 | ["Quit" org-columns-quit t])) |
38f8646b | 15415 | |
7d58338e CD |
15416 | (defun org-columns-new-overlay (beg end &optional string face) |
15417 | "Create a new column overlay and add it to the list." | |
38f8646b CD |
15418 | (let ((ov (org-make-overlay beg end))) |
15419 | (org-overlay-put ov 'face (or face 'secondary-selection)) | |
15420 | (org-overlay-display ov string face) | |
7d58338e | 15421 | (push ov org-columns-overlays) |
38f8646b CD |
15422 | ov)) |
15423 | ||
7d58338e | 15424 | (defun org-columns-display-here (&optional props) |
38f8646b CD |
15425 | "Overlay the current line with column display." |
15426 | (interactive) | |
7d58338e CD |
15427 | (let* ((fmt org-columns-current-fmt-compiled) |
15428 | (beg (point-at-bol)) | |
1e8fbb6d CD |
15429 | (level-face (save-excursion |
15430 | (beginning-of-line 1) | |
0b8568f5 JW |
15431 | (and (looking-at "\\(\\**\\)\\(\\* \\)") |
15432 | (org-get-level-face 2)))) | |
fbe6c10d | 15433 | (color (list :foreground |
1e8fbb6d | 15434 | (face-attribute (or level-face 'default) :foreground))) |
03f3cf35 | 15435 | props pom property ass width f string ov column val modval) |
38f8646b CD |
15436 | ;; Check if the entry is in another buffer. |
15437 | (unless props | |
15438 | (if (eq major-mode 'org-agenda-mode) | |
15439 | (setq pom (or (get-text-property (point) 'org-hd-marker) | |
15440 | (get-text-property (point) 'org-marker)) | |
15441 | props (if pom (org-entry-properties pom) nil)) | |
15442 | (setq props (org-entry-properties nil)))) | |
7d58338e CD |
15443 | ;; Walk the format |
15444 | (while (setq column (pop fmt)) | |
15445 | (setq property (car column) | |
38f8646b CD |
15446 | ass (if (equal property "ITEM") |
15447 | (cons "ITEM" | |
15448 | (save-match-data | |
15449 | (org-no-properties | |
15450 | (org-remove-tabs | |
15451 | (buffer-substring-no-properties | |
15452 | (point-at-bol) (point-at-eol)))))) | |
15453 | (assoc property props)) | |
7d58338e | 15454 | width (or (cdr (assoc property org-columns-current-maxwidths)) |
03f3cf35 JW |
15455 | (nth 2 column) |
15456 | (length property)) | |
38f8646b | 15457 | f (format "%%-%d.%ds | " width width) |
03f3cf35 JW |
15458 | val (or (cdr ass) "") |
15459 | modval (if (equal property "ITEM") | |
15460 | (org-columns-cleanup-item val org-columns-current-fmt-compiled)) | |
15461 | string (format f (or modval val))) | |
38f8646b CD |
15462 | ;; Create the overlay |
15463 | (org-unmodified | |
7d58338e CD |
15464 | (setq ov (org-columns-new-overlay |
15465 | beg (setq beg (1+ beg)) string | |
15466 | (list color 'org-column))) | |
15467 | ;;; (list (get-text-property (point-at-bol) 'face) 'org-column))) | |
15468 | (org-overlay-put ov 'keymap org-columns-map) | |
15469 | (org-overlay-put ov 'org-columns-key property) | |
15470 | (org-overlay-put ov 'org-columns-value (cdr ass)) | |
03f3cf35 | 15471 | (org-overlay-put ov 'org-columns-value-modified modval) |
7d58338e CD |
15472 | (org-overlay-put ov 'org-columns-pom pom) |
15473 | (org-overlay-put ov 'org-columns-format f)) | |
38f8646b CD |
15474 | (if (or (not (char-after beg)) |
15475 | (equal (char-after beg) ?\n)) | |
15476 | (let ((inhibit-read-only t)) | |
15477 | (save-excursion | |
15478 | (goto-char beg) | |
03f3cf35 | 15479 | (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later? |
38f8646b | 15480 | ;; Make the rest of the line disappear. |
38f8646b | 15481 | (org-unmodified |
7d58338e | 15482 | (setq ov (org-columns-new-overlay beg (point-at-eol))) |
38f8646b | 15483 | (org-overlay-put ov 'invisible t) |
7d58338e | 15484 | (org-overlay-put ov 'keymap org-columns-map) |
48aaad2d | 15485 | (org-overlay-put ov 'intangible t) |
7d58338e | 15486 | (push ov org-columns-overlays) |
38f8646b | 15487 | (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) |
7d58338e CD |
15488 | (org-overlay-put ov 'keymap org-columns-map) |
15489 | (push ov org-columns-overlays) | |
38f8646b | 15490 | (let ((inhibit-read-only t)) |
48aaad2d | 15491 | (put-text-property (max (point-min) (1- (point-at-bol))) |
38f8646b CD |
15492 | (min (point-max) (1+ (point-at-eol))) |
15493 | 'read-only "Type `e' to edit property"))))) | |
15494 | ||
7d58338e CD |
15495 | (defvar org-previous-header-line-format nil |
15496 | "The header line format before column view was turned on.") | |
15497 | (defvar org-columns-inhibit-recalculation nil | |
15498 | "Inhibit recomputing of columns on column view startup.") | |
15499 | ||
03f3cf35 | 15500 | |
7d58338e CD |
15501 | (defvar header-line-format) |
15502 | (defun org-columns-display-here-title () | |
38f8646b CD |
15503 | "Overlay the newline before the current line with the table title." |
15504 | (interactive) | |
7d58338e | 15505 | (let ((fmt org-columns-current-fmt-compiled) |
38f8646b | 15506 | string (title "") |
03f3cf35 | 15507 | property width f column str widths) |
7d58338e CD |
15508 | (while (setq column (pop fmt)) |
15509 | (setq property (car column) | |
15510 | str (or (nth 1 column) property) | |
15511 | width (or (cdr (assoc property org-columns-current-maxwidths)) | |
03f3cf35 JW |
15512 | (nth 2 column) |
15513 | (length str)) | |
15514 | widths (push width widths) | |
38f8646b | 15515 | f (format "%%-%d.%ds | " width width) |
7d58338e | 15516 | string (format f str) |
38f8646b | 15517 | title (concat title string))) |
7d58338e CD |
15518 | (setq title (concat |
15519 | (org-add-props " " nil 'display '(space :align-to 0)) | |
15520 | (org-add-props title nil 'face '(:weight bold :underline t)))) | |
15521 | (org-set-local 'org-previous-header-line-format header-line-format) | |
03f3cf35 | 15522 | (org-set-local 'org-columns-current-widths (nreverse widths)) |
7d58338e CD |
15523 | (setq header-line-format title))) |
15524 | ||
15525 | (defun org-columns-remove-overlays () | |
38f8646b CD |
15526 | "Remove all currently active column overlays." |
15527 | (interactive) | |
7d58338e CD |
15528 | (when (marker-buffer org-columns-begin-marker) |
15529 | (with-current-buffer (marker-buffer org-columns-begin-marker) | |
15530 | (when (local-variable-p 'org-previous-header-line-format) | |
15531 | (setq header-line-format org-previous-header-line-format) | |
15532 | (kill-local-variable 'org-previous-header-line-format)) | |
15533 | (move-marker org-columns-begin-marker nil) | |
15534 | (move-marker org-columns-top-level-marker nil) | |
15535 | (org-unmodified | |
15536 | (mapc 'org-delete-overlay org-columns-overlays) | |
15537 | (setq org-columns-overlays nil) | |
15538 | (let ((inhibit-read-only t)) | |
15539 | (remove-text-properties (point-min) (point-max) '(read-only t))))))) | |
38f8646b | 15540 | |
03f3cf35 JW |
15541 | (defun org-columns-cleanup-item (item fmt) |
15542 | "Remove from ITEM what is a column in the format FMT." | |
15543 | (if (not org-complex-heading-regexp) | |
15544 | item | |
15545 | (when (string-match org-complex-heading-regexp item) | |
15546 | (concat | |
15547 | (org-add-props (concat (match-string 1 item) " ") nil | |
15548 | 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1)))))) | |
15549 | (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item))) | |
15550 | (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item))) | |
15551 | " " (match-string 4 item) | |
15552 | (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item))))))) | |
fbe6c10d | 15553 | |
7d58338e | 15554 | (defun org-columns-show-value () |
38f8646b CD |
15555 | "Show the full value of the property." |
15556 | (interactive) | |
7d58338e | 15557 | (let ((value (get-char-property (point) 'org-columns-value))) |
38f8646b CD |
15558 | (message "Value is: %s" (or value "")))) |
15559 | ||
7d58338e | 15560 | (defun org-columns-quit () |
38f8646b CD |
15561 | "Remove the column overlays and in this way exit column editing." |
15562 | (interactive) | |
15563 | (org-unmodified | |
7d58338e | 15564 | (org-columns-remove-overlays) |
38f8646b | 15565 | (let ((inhibit-read-only t)) |
38f8646b CD |
15566 | (remove-text-properties (point-min) (point-max) '(read-only t)))) |
15567 | (when (eq major-mode 'org-agenda-mode) | |
15841868 JW |
15568 | (message |
15569 | "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) | |
15570 | ||
15571 | (defun org-columns-check-computed () | |
15572 | "Check if this column value is computed. | |
15573 | If yes, throw an error indicating that changing it does not make sense." | |
15574 | (let ((val (get-char-property (point) 'org-columns-value))) | |
15575 | (when (and (stringp val) | |
15576 | (get-char-property 0 'org-computed val)) | |
15577 | (error "This value is computed from the entry's children")))) | |
38f8646b | 15578 | |
03f3cf35 JW |
15579 | (defun org-columns-todo (&optional arg) |
15580 | "Change the TODO state during column view." | |
15581 | (interactive "P") | |
15582 | (org-columns-edit-value "TODO")) | |
15583 | ||
15584 | (defun org-columns-set-tags-or-toggle (&optional arg) | |
15585 | "Toggle checkbox at point, or set tags for current headline." | |
15586 | (interactive "P") | |
15587 | (if (string-match "\\`\\[[ xX-]\\]\\'" | |
15588 | (get-char-property (point) 'org-columns-value)) | |
15589 | (org-columns-next-allowed-value) | |
15590 | (org-columns-edit-value "TAGS"))) | |
15591 | ||
15592 | (defun org-columns-edit-value (&optional key) | |
38f8646b CD |
15593 | "Edit the value of the property at point in column view. |
15594 | Where possible, use the standard interface for changing this line." | |
15595 | (interactive) | |
15841868 | 15596 | (org-columns-check-computed) |
03f3cf35 JW |
15597 | (let* ((external-key key) |
15598 | (col (current-column)) | |
15599 | (key (or key (get-char-property (point) 'org-columns-key))) | |
7d58338e | 15600 | (value (get-char-property (point) 'org-columns-value)) |
38f8646b CD |
15601 | (bol (point-at-bol)) (eol (point-at-eol)) |
15602 | (pom (or (get-text-property bol 'org-hd-marker) | |
15603 | (point))) ; keep despite of compiler waring | |
15604 | (line-overlays | |
15605 | (delq nil (mapcar (lambda (x) | |
15606 | (and (eq (overlay-buffer x) (current-buffer)) | |
15607 | (>= (overlay-start x) bol) | |
15608 | (<= (overlay-start x) eol) | |
15609 | x)) | |
7d58338e CD |
15610 | org-columns-overlays))) |
15611 | nval eval allowed) | |
38f8646b | 15612 | (cond |
03f3cf35 JW |
15613 | ((equal key "ITEM") |
15614 | (setq eval '(org-with-point-at pom | |
15615 | (org-edit-headline)))) | |
38f8646b CD |
15616 | ((equal key "TODO") |
15617 | (setq eval '(org-with-point-at pom | |
03f3cf35 JW |
15618 | (let ((current-prefix-arg |
15619 | (if external-key current-prefix-arg '(4)))) | |
15620 | (call-interactively 'org-todo))))) | |
38f8646b CD |
15621 | ((equal key "PRIORITY") |
15622 | (setq eval '(org-with-point-at pom | |
15623 | (call-interactively 'org-priority)))) | |
15624 | ((equal key "TAGS") | |
15625 | (setq eval '(org-with-point-at pom | |
15626 | (let ((org-fast-tag-selection-single-key | |
15627 | (if (eq org-fast-tag-selection-single-key 'expert) | |
15628 | t org-fast-tag-selection-single-key))) | |
15629 | (call-interactively 'org-set-tags))))) | |
15630 | ((equal key "DEADLINE") | |
15631 | (setq eval '(org-with-point-at pom | |
15632 | (call-interactively 'org-deadline)))) | |
15633 | ((equal key "SCHEDULED") | |
15634 | (setq eval '(org-with-point-at pom | |
48aaad2d | 15635 | (call-interactively 'org-schedule)))) |
38f8646b | 15636 | (t |
7d58338e CD |
15637 | (setq allowed (org-property-get-allowed-values pom key 'table)) |
15638 | (if allowed | |
15639 | (setq nval (completing-read "Value: " allowed nil t)) | |
15640 | (setq nval (read-string "Edit: " value))) | |
38f8646b CD |
15641 | (setq nval (org-trim nval)) |
15642 | (when (not (equal nval value)) | |
15643 | (setq eval '(org-entry-put pom key nval))))) | |
15644 | (when eval | |
15645 | (let ((inhibit-read-only t)) | |
03f3cf35 | 15646 | (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)) |
38f8646b CD |
15647 | (unwind-protect |
15648 | (progn | |
fbe6c10d | 15649 | (setq org-columns-overlays |
7d58338e | 15650 | (org-delete-all line-overlays org-columns-overlays)) |
38f8646b | 15651 | (mapc 'org-delete-overlay line-overlays) |
7d58338e CD |
15652 | (org-columns-eval eval)) |
15653 | (org-columns-display-here)))) | |
15654 | (move-to-column col) | |
15655 | (if (nth 3 (assoc key org-columns-current-fmt-compiled)) | |
15656 | (org-columns-update key)))) | |
15657 | ||
03f3cf35 JW |
15658 | (defun org-edit-headline () ; FIXME: this is not columns specific |
15659 | "Edit the current headline, the part without TODO keyword, TAGS." | |
15660 | (org-back-to-heading) | |
15661 | (when (looking-at org-todo-line-regexp) | |
15662 | (let ((pre (buffer-substring (match-beginning 0) (match-beginning 3))) | |
15663 | (txt (match-string 3)) | |
15664 | (post "") | |
fbe6c10d | 15665 | txt2) |
03f3cf35 JW |
15666 | (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt) |
15667 | (setq post (match-string 0 txt) | |
15668 | txt (substring txt 0 (match-beginning 0)))) | |
15669 | (setq txt2 (read-string "Edit: " txt)) | |
15670 | (when (not (equal txt txt2)) | |
15671 | (beginning-of-line 1) | |
15672 | (insert pre txt2 post) | |
15673 | (delete-region (point) (point-at-eol)) | |
15674 | (org-set-tags nil t))))) | |
15675 | ||
7d58338e CD |
15676 | (defun org-columns-edit-allowed () |
15677 | "Edit the list of allowed values for the current property." | |
15678 | (interactive) | |
03f3cf35 | 15679 | (let* ((key (get-char-property (point) 'org-columns-key)) |
7d58338e | 15680 | (key1 (concat key "_ALL")) |
7d58338e CD |
15681 | (allowed (org-entry-get (point) key1 t)) |
15682 | nval) | |
257b8401 | 15683 | ;; FIXME: Cover editing TODO, TAGS etc inbiffer settings.???? |
7d58338e | 15684 | (setq nval (read-string "Allowed: " allowed)) |
fbe6c10d | 15685 | (org-entry-put |
7d58338e CD |
15686 | (cond ((marker-position org-entry-property-inherited-from) |
15687 | org-entry-property-inherited-from) | |
15688 | ((marker-position org-columns-top-level-marker) | |
15689 | org-columns-top-level-marker)) | |
15690 | key1 nval))) | |
15691 | ||
557f46f0 CD |
15692 | (defmacro org-no-warnings (&rest body) |
15693 | (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) | |
15694 | ||
7d58338e CD |
15695 | (defun org-columns-eval (form) |
15696 | (let (hidep) | |
15697 | (save-excursion | |
03f3cf35 | 15698 | (beginning-of-line 1) |
fbe6c10d | 15699 | ;; `next-line' is needed here, because it skips invisible line. |
557f46f0 | 15700 | (condition-case nil (org-no-warnings (next-line 1)) (error nil)) |
7d58338e CD |
15701 | (setq hidep (org-on-heading-p 1))) |
15702 | (eval form) | |
15703 | (and hidep (hide-entry)))) | |
15704 | ||
15705 | (defun org-columns-previous-allowed-value () | |
15706 | "Switch to the previous allowed value for this column." | |
15707 | (interactive) | |
15708 | (org-columns-next-allowed-value t)) | |
15709 | ||
15710 | (defun org-columns-next-allowed-value (&optional previous) | |
15711 | "Switch to the next allowed value for this column." | |
15712 | (interactive) | |
15841868 | 15713 | (org-columns-check-computed) |
7d58338e CD |
15714 | (let* ((col (current-column)) |
15715 | (key (get-char-property (point) 'org-columns-key)) | |
15716 | (value (get-char-property (point) 'org-columns-value)) | |
15717 | (bol (point-at-bol)) (eol (point-at-eol)) | |
15718 | (pom (or (get-text-property bol 'org-hd-marker) | |
15719 | (point))) ; keep despite of compiler waring | |
15720 | (line-overlays | |
15721 | (delq nil (mapcar (lambda (x) | |
15722 | (and (eq (overlay-buffer x) (current-buffer)) | |
15723 | (>= (overlay-start x) bol) | |
15724 | (<= (overlay-start x) eol) | |
15725 | x)) | |
15726 | org-columns-overlays))) | |
15727 | (allowed (or (org-property-get-allowed-values pom key) | |
15728 | (and (equal | |
15729 | (nth 4 (assoc key org-columns-current-fmt-compiled)) | |
15730 | 'checkbox) '("[ ]" "[X]")))) | |
15731 | nval) | |
15732 | (when (equal key "ITEM") | |
15733 | (error "Cannot edit item headline from here")) | |
48aaad2d | 15734 | (unless (or allowed (member key '("SCHEDULED" "DEADLINE"))) |
7d58338e | 15735 | (error "Allowed values for this property have not been defined")) |
48aaad2d CD |
15736 | (if (member key '("SCHEDULED" "DEADLINE")) |
15737 | (setq nval (if previous 'earlier 'later)) | |
15738 | (if previous (setq allowed (reverse allowed))) | |
15739 | (if (member value allowed) | |
15740 | (setq nval (car (cdr (member value allowed))))) | |
15741 | (setq nval (or nval (car allowed))) | |
15742 | (if (equal nval value) | |
15743 | (error "Only one allowed value for this property"))) | |
7d58338e CD |
15744 | (let ((inhibit-read-only t)) |
15745 | (remove-text-properties (1- bol) eol '(read-only t)) | |
15746 | (unwind-protect | |
15747 | (progn | |
fbe6c10d | 15748 | (setq org-columns-overlays |
7d58338e CD |
15749 | (org-delete-all line-overlays org-columns-overlays)) |
15750 | (mapc 'org-delete-overlay line-overlays) | |
15751 | (org-columns-eval '(org-entry-put pom key nval))) | |
15752 | (org-columns-display-here))) | |
15753 | (move-to-column col) | |
15754 | (if (nth 3 (assoc key org-columns-current-fmt-compiled)) | |
15755 | (org-columns-update key)))) | |
15756 | ||
15757 | (defun org-verify-version (task) | |
15758 | (cond | |
15759 | ((eq task 'columns) | |
15760 | (if (or (featurep 'xemacs) | |
15761 | (< emacs-major-version 22)) | |
15762 | (error "Emacs 22 is required for the columns feature"))))) | |
38f8646b | 15763 | |
fbe6c10d CD |
15764 | (defun org-columns-open-link (&optional arg) |
15765 | (interactive "P") | |
03f3cf35 JW |
15766 | (let ((key (get-char-property (point) 'org-columns-key)) |
15767 | (value (get-char-property (point) 'org-columns-value))) | |
fbe6c10d CD |
15768 | (org-open-link-from-string arg))) |
15769 | ||
15770 | (defun org-open-link-from-string (s &optional arg) | |
15771 | "Open a link in the string S, as if it was in Org-mode." | |
15772 | (interactive) | |
15773 | (with-temp-buffer | |
15774 | (let ((org-inhibit-startup t)) | |
15775 | (org-mode) | |
15776 | (insert s) | |
15777 | (goto-char (point-min)) | |
15778 | (org-open-at-point arg)))) | |
03f3cf35 | 15779 | |
48aaad2d CD |
15780 | (defun org-columns-get-format-and-top-level () |
15781 | (let (fmt) | |
15782 | (when (condition-case nil (org-back-to-heading) (error nil)) | |
15783 | (move-marker org-entry-property-inherited-from nil) | |
15784 | (setq fmt (org-entry-get nil "COLUMNS" t))) | |
15785 | (setq fmt (or fmt org-columns-default-format)) | |
15786 | (org-set-local 'org-columns-current-fmt fmt) | |
15787 | (org-columns-compile-format fmt) | |
15788 | (if (marker-position org-entry-property-inherited-from) | |
15789 | (move-marker org-columns-top-level-marker | |
15790 | org-entry-property-inherited-from) | |
15791 | (move-marker org-columns-top-level-marker (point))) | |
15792 | fmt)) | |
15793 | ||
38f8646b CD |
15794 | (defun org-columns () |
15795 | "Turn on column view on an org-mode file." | |
15796 | (interactive) | |
7d58338e CD |
15797 | (org-verify-version 'columns) |
15798 | (org-columns-remove-overlays) | |
15799 | (move-marker org-columns-begin-marker (point)) | |
38f8646b | 15800 | (let (beg end fmt cache maxwidths) |
48aaad2d | 15801 | (setq fmt (org-columns-get-format-and-top-level)) |
38f8646b | 15802 | (save-excursion |
48aaad2d | 15803 | (goto-char org-columns-top-level-marker) |
7d58338e | 15804 | (setq beg (point)) |
7d58338e CD |
15805 | (unless org-columns-inhibit-recalculation |
15806 | (org-columns-compute-all)) | |
15807 | (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) | |
15808 | (point-max))) | |
38f8646b CD |
15809 | (goto-char beg) |
15810 | ;; Get and cache the properties | |
15811 | (while (re-search-forward (concat "^" outline-regexp) end t) | |
15812 | (push (cons (org-current-line) (org-entry-properties)) cache)) | |
15813 | (when cache | |
7d58338e CD |
15814 | (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) |
15815 | (org-set-local 'org-columns-current-maxwidths maxwidths) | |
7d58338e | 15816 | (org-columns-display-here-title) |
38f8646b CD |
15817 | (mapc (lambda (x) |
15818 | (goto-line (car x)) | |
7d58338e | 15819 | (org-columns-display-here (cdr x))) |
38f8646b CD |
15820 | cache))))) |
15821 | ||
7d58338e CD |
15822 | (defun org-columns-new (&optional prop title width op fmt) |
15823 | "Insert a new column, to the leeft o the current column." | |
15824 | (interactive) | |
15825 | (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) | |
15826 | cell) | |
15827 | (setq prop (completing-read | |
15828 | "Property: " (mapcar 'list (org-buffer-property-keys t)) | |
15829 | nil nil prop)) | |
15830 | (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) | |
15831 | (setq width (read-string "Column width: " (if width (number-to-string width)))) | |
15832 | (if (string-match "\\S-" width) | |
15833 | (setq width (string-to-number width)) | |
15834 | (setq width nil)) | |
15835 | (setq fmt (completing-read "Summary [none]: " | |
15836 | '(("none") ("add_numbers") ("add_times") ("checkbox")) | |
15837 | nil t)) | |
15838 | (if (string-match "\\S-" fmt) | |
15839 | (setq fmt (intern fmt)) | |
15840 | (setq fmt nil)) | |
15841 | (if (eq fmt 'none) (setq fmt nil)) | |
15842 | (if editp | |
15843 | (progn | |
15844 | (setcar editp prop) | |
15845 | (setcdr editp (list title width nil fmt))) | |
15846 | (setq cell (nthcdr (1- (current-column)) | |
15847 | org-columns-current-fmt-compiled)) | |
15848 | (setcdr cell (cons (list prop title width nil fmt) | |
15849 | (cdr cell)))) | |
15850 | (org-columns-store-format) | |
15851 | (org-columns-redo))) | |
15852 | ||
15853 | (defun org-columns-delete () | |
15854 | "Delete the column at point from columns view." | |
15855 | (interactive) | |
15856 | (let* ((n (current-column)) | |
15857 | (title (nth 1 (nth n org-columns-current-fmt-compiled)))) | |
15858 | (when (y-or-n-p | |
15859 | (format "Are you sure you want to remove column \"%s\"? " title)) | |
15860 | (setq org-columns-current-fmt-compiled | |
15861 | (delq (nth n org-columns-current-fmt-compiled) | |
15862 | org-columns-current-fmt-compiled)) | |
15863 | (org-columns-store-format) | |
15864 | (org-columns-redo) | |
15865 | (if (>= (current-column) (length org-columns-current-fmt-compiled)) | |
15866 | (backward-char 1))))) | |
15867 | ||
15868 | (defun org-columns-edit-attributes () | |
15869 | "Edit the attributes of the current column." | |
15870 | (interactive) | |
15871 | (let* ((n (current-column)) | |
15872 | (info (nth n org-columns-current-fmt-compiled))) | |
15873 | (apply 'org-columns-new info))) | |
15874 | ||
15875 | (defun org-columns-widen (arg) | |
15876 | "Make the column wider by ARG characters." | |
15877 | (interactive "p") | |
15878 | (let* ((n (current-column)) | |
15879 | (entry (nth n org-columns-current-fmt-compiled)) | |
15880 | (width (or (nth 2 entry) | |
15881 | (cdr (assoc (car entry) org-columns-current-maxwidths))))) | |
15882 | (setq width (max 1 (+ width arg))) | |
15883 | (setcar (nthcdr 2 entry) width) | |
15884 | (org-columns-store-format) | |
15885 | (org-columns-redo))) | |
15886 | ||
15887 | (defun org-columns-narrow (arg) | |
15888 | "Make the column nrrower by ARG characters." | |
15889 | (interactive "p") | |
15890 | (org-columns-widen (- arg))) | |
15891 | ||
15892 | (defun org-columns-move-right () | |
15893 | "Swap this column with the one to the right." | |
15894 | (interactive) | |
15895 | (let* ((n (current-column)) | |
15896 | (cell (nthcdr n org-columns-current-fmt-compiled)) | |
15897 | e) | |
15898 | (when (>= n (1- (length org-columns-current-fmt-compiled))) | |
15899 | (error "Cannot shift this column further to the right")) | |
15900 | (setq e (car cell)) | |
15901 | (setcar cell (car (cdr cell))) | |
15902 | (setcdr cell (cons e (cdr (cdr cell)))) | |
15903 | (org-columns-store-format) | |
15904 | (org-columns-redo) | |
15905 | (forward-char 1))) | |
15906 | ||
15907 | (defun org-columns-move-left () | |
15908 | "Swap this column with the one to the left." | |
15909 | (interactive) | |
15910 | (let* ((n (current-column))) | |
15911 | (when (= n 0) | |
15912 | (error "Cannot shift this column further to the left")) | |
15913 | (backward-char 1) | |
15914 | (org-columns-move-right) | |
fbe6c10d | 15915 | (backward-char 1))) |
7d58338e CD |
15916 | |
15917 | (defun org-columns-store-format () | |
15918 | "Store the text version of the current columns format in appropriate place. | |
15919 | This is either in the COLUMNS property of the node starting the current column | |
15920 | display, or in the #+COLUMNS line of the current buffer." | |
03f3cf35 | 15921 | (let (fmt (cnt 0)) |
7d58338e | 15922 | (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)) |
03f3cf35 | 15923 | (org-set-local 'org-columns-current-fmt fmt) |
7d58338e CD |
15924 | (if (marker-position org-columns-top-level-marker) |
15925 | (save-excursion | |
15926 | (goto-char org-columns-top-level-marker) | |
03f3cf35 JW |
15927 | (if (and (org-at-heading-p) |
15928 | (org-entry-get nil "COLUMNS")) | |
7d58338e CD |
15929 | (org-entry-put nil "COLUMNS" fmt) |
15930 | (goto-char (point-min)) | |
03f3cf35 | 15931 | ;; Overwrite all #+COLUMNS lines.... |
7d58338e | 15932 | (while (re-search-forward "^#\\+COLUMNS:.*" nil t) |
03f3cf35 JW |
15933 | (setq cnt (1+ cnt)) |
15934 | (replace-match (concat "#+COLUMNS: " fmt) t t)) | |
15935 | (unless (> cnt 0) | |
15936 | (goto-char (point-min)) | |
15937 | (or (org-on-heading-p t) (outline-next-heading)) | |
15938 | (let ((inhibit-read-only t)) | |
15939 | (insert-before-markers "#+COLUMNS: " fmt "\n"))) | |
15940 | (org-set-local 'org-columns-default-format fmt)))))) | |
7d58338e | 15941 | |
38f8646b | 15942 | (defvar org-overriding-columns-format nil |
7d58338e | 15943 | "When set, overrides any other definition.") |
38f8646b | 15944 | (defvar org-agenda-view-columns-initially nil |
7d58338e | 15945 | "When set, switch to columns view immediately after creating the agenda.") |
38f8646b CD |
15946 | |
15947 | (defun org-agenda-columns () | |
15948 | "Turn on column view in the agenda." | |
15949 | (interactive) | |
7d58338e CD |
15950 | (org-verify-version 'columns) |
15951 | (org-columns-remove-overlays) | |
15952 | (move-marker org-columns-begin-marker (point)) | |
15953 | (let (fmt cache maxwidths m) | |
38f8646b CD |
15954 | (cond |
15955 | ((and (local-variable-p 'org-overriding-columns-format) | |
15956 | org-overriding-columns-format) | |
15957 | (setq fmt org-overriding-columns-format)) | |
15958 | ((setq m (get-text-property (point-at-bol) 'org-hd-marker)) | |
15959 | (setq fmt (org-entry-get m "COLUMNS" t))) | |
7d58338e CD |
15960 | ((and (boundp 'org-columns-current-fmt) |
15961 | (local-variable-p 'org-columns-current-fmt) | |
15962 | org-columns-current-fmt) | |
15963 | (setq fmt org-columns-current-fmt)) | |
38f8646b CD |
15964 | ((setq m (next-single-property-change (point-min) 'org-hd-marker)) |
15965 | (setq m (get-text-property m 'org-hd-marker)) | |
15966 | (setq fmt (org-entry-get m "COLUMNS" t)))) | |
7d58338e CD |
15967 | (setq fmt (or fmt org-columns-default-format)) |
15968 | (org-set-local 'org-columns-current-fmt fmt) | |
15969 | (org-columns-compile-format fmt) | |
38f8646b CD |
15970 | (save-excursion |
15971 | ;; Get and cache the properties | |
15972 | (goto-char (point-min)) | |
15973 | (while (not (eobp)) | |
15974 | (when (setq m (or (get-text-property (point) 'org-hd-marker) | |
15975 | (get-text-property (point) 'org-marker))) | |
15976 | (push (cons (org-current-line) (org-entry-properties m)) cache)) | |
15977 | (beginning-of-line 2)) | |
15978 | (when cache | |
7d58338e CD |
15979 | (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) |
15980 | (org-set-local 'org-columns-current-maxwidths maxwidths) | |
7d58338e | 15981 | (org-columns-display-here-title) |
38f8646b CD |
15982 | (mapc (lambda (x) |
15983 | (goto-line (car x)) | |
7d58338e | 15984 | (org-columns-display-here (cdr x))) |
38f8646b CD |
15985 | cache))))) |
15986 | ||
7d58338e | 15987 | (defun org-columns-get-autowidth-alist (s cache) |
38f8646b CD |
15988 | "Derive the maximum column widths from the format and the cache." |
15989 | (let ((start 0) rtn) | |
0b8568f5 | 15990 | (while (string-match (org-re "%\\([[:alpha:]]\\S-*\\)") s start) |
38f8646b CD |
15991 | (push (cons (match-string 1 s) 1) rtn) |
15992 | (setq start (match-end 0))) | |
15993 | (mapc (lambda (x) | |
15994 | (setcdr x (apply 'max | |
15995 | (mapcar | |
15996 | (lambda (y) | |
15997 | (length (or (cdr (assoc (car x) (cdr y))) " "))) | |
15998 | cache)))) | |
15999 | rtn) | |
16000 | rtn)) | |
16001 | ||
7d58338e CD |
16002 | (defun org-columns-compute-all () |
16003 | "Compute all columns that have operators defined." | |
48aaad2d CD |
16004 | (org-unmodified |
16005 | (remove-text-properties (point-min) (point-max) '(org-summaries t))) | |
7d58338e CD |
16006 | (let ((columns org-columns-current-fmt-compiled) col) |
16007 | (while (setq col (pop columns)) | |
16008 | (when (nth 3 col) | |
16009 | (save-excursion | |
16010 | (org-columns-compute (car col))))))) | |
16011 | ||
16012 | (defun org-columns-update (property) | |
16013 | "Recompute PROPERTY, and update the columns display for it." | |
16014 | (org-columns-compute property) | |
16015 | (let (fmt val pos) | |
16016 | (save-excursion | |
16017 | (mapc (lambda (ov) | |
16018 | (when (equal (org-overlay-get ov 'org-columns-key) property) | |
16019 | (setq pos (org-overlay-start ov)) | |
16020 | (goto-char pos) | |
16021 | (when (setq val (cdr (assoc property | |
fbe6c10d | 16022 | (get-text-property |
15841868 | 16023 | (point-at-bol) 'org-summaries)))) |
7d58338e | 16024 | (setq fmt (org-overlay-get ov 'org-columns-format)) |
15841868 | 16025 | (org-overlay-put ov 'org-columns-value val) |
7d58338e CD |
16026 | (org-overlay-put ov 'display (format fmt val))))) |
16027 | org-columns-overlays)))) | |
16028 | ||
16029 | (defun org-columns-compute (property) | |
16030 | "Sum the values of property PROPERTY hierarchically, for the entire buffer." | |
16031 | (interactive) | |
16032 | (let* ((re (concat "^" outline-regexp)) | |
16033 | (lmax 30) ; Does anyone use deeper levels??? | |
16034 | (lsum (make-vector lmax 0)) | |
15841868 | 16035 | (lflag (make-vector lmax nil)) |
7d58338e CD |
16036 | (level 0) |
16037 | (ass (assoc property org-columns-current-fmt-compiled)) | |
16038 | (format (nth 4 ass)) | |
16039 | (beg org-columns-top-level-marker) | |
15841868 | 16040 | last-level val valflag flag end sumpos sum-alist sum str str1 useval) |
7d58338e CD |
16041 | (save-excursion |
16042 | ;; Find the region to compute | |
16043 | (goto-char beg) | |
16044 | (setq end (condition-case nil (org-end-of-subtree t) (error (point-max)))) | |
16045 | (goto-char end) | |
16046 | ;; Walk the tree from the back and do the computations | |
16047 | (while (re-search-backward re beg t) | |
16048 | (setq sumpos (match-beginning 0) | |
16049 | last-level level | |
16050 | level (org-outline-level) | |
15841868 JW |
16051 | val (org-entry-get nil property) |
16052 | valflag (and val (string-match "\\S-" val))) | |
7d58338e CD |
16053 | (cond |
16054 | ((< level last-level) | |
16055 | ;; put the sum of lower levels here as a property | |
15841868 JW |
16056 | (setq sum (aref lsum last-level) ; current sum |
16057 | flag (aref lflag last-level) ; any valid entries from children? | |
7d58338e | 16058 | str (org-column-number-to-string sum format) |
15841868 JW |
16059 | str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) |
16060 | useval (if flag str1 (if valflag val "")) | |
7d58338e CD |
16061 | sum-alist (get-text-property sumpos 'org-summaries)) |
16062 | (if (assoc property sum-alist) | |
15841868 JW |
16063 | (setcdr (assoc property sum-alist) useval) |
16064 | (push (cons property useval) sum-alist) | |
48aaad2d CD |
16065 | (org-unmodified |
16066 | (add-text-properties sumpos (1+ sumpos) | |
16067 | (list 'org-summaries sum-alist)))) | |
15841868 JW |
16068 | (when val |
16069 | (org-entry-put nil property (if flag str val))) | |
7d58338e | 16070 | ;; add current to current level accumulator |
15841868 JW |
16071 | (when (or flag valflag) |
16072 | ;; FIXME: is this ok????????? | |
16073 | (aset lsum level (+ (aref lsum level) | |
16074 | (if flag sum (org-column-string-to-number | |
16075 | (if flag str val) format)))) | |
16076 | (aset lflag level t)) | |
7d58338e | 16077 | ;; clear accumulators for deeper levels |
fbe6c10d | 16078 | (loop for l from (1+ level) to (1- lmax) do |
15841868 JW |
16079 | (aset lsum l 0) |
16080 | (aset lflag l nil))) | |
7d58338e CD |
16081 | ((>= level last-level) |
16082 | ;; add what we have here to the accumulator for this level | |
16083 | (aset lsum level (+ (aref lsum level) | |
15841868 JW |
16084 | (org-column-string-to-number (or val "0") format))) |
16085 | (and valflag (aset lflag level t))) | |
7d58338e CD |
16086 | (t (error "This should not happen"))))))) |
16087 | ||
16088 | (defun org-columns-redo () | |
16089 | "Construct the column display again." | |
16090 | (interactive) | |
16091 | (message "Recomputing columns...") | |
16092 | (save-excursion | |
16093 | (if (marker-position org-columns-begin-marker) | |
16094 | (goto-char org-columns-begin-marker)) | |
16095 | (org-columns-remove-overlays) | |
16096 | (if (org-mode-p) | |
16097 | (call-interactively 'org-columns) | |
16098 | (call-interactively 'org-agenda-columns))) | |
16099 | (message "Recomputing columns...done")) | |
16100 | ||
16101 | (defun org-columns-not-in-agenda () | |
16102 | (if (eq major-mode 'org-agenda-mode) | |
16103 | (error "This command is only allowed in Org-mode buffers"))) | |
16104 | ||
16105 | ||
16106 | (defun org-string-to-number (s) | |
16107 | "Convert string to number, and interpret hh:mm:ss." | |
16108 | (if (not (string-match ":" s)) | |
16109 | (string-to-number s) | |
16110 | (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) | |
16111 | (while l | |
16112 | (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) | |
16113 | sum))) | |
16114 | ||
16115 | (defun org-column-number-to-string (n fmt) | |
16116 | "Convert a computed column number to a string value, according to FMT." | |
16117 | (cond | |
16118 | ((eq fmt 'add_times) | |
16119 | (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) | |
16120 | (format "%d:%02d" h m))) | |
16121 | ((eq fmt 'checkbox) | |
16122 | (cond ((= n (floor n)) "[X]") | |
16123 | ((> n 1.) "[-]") | |
16124 | (t "[ ]"))) | |
16125 | (t (number-to-string n)))) | |
16126 | ||
16127 | (defun org-column-string-to-number (s fmt) | |
16128 | "Convert a column value to a number that can be used for column computing." | |
16129 | (cond | |
16130 | ((string-match ":" s) | |
16131 | (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) | |
16132 | (while l | |
16133 | (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) | |
16134 | sum)) | |
16135 | ((eq fmt 'checkbox) | |
16136 | (if (equal s "[X]") 1. 0.000001)) | |
16137 | (t (string-to-number s)))) | |
16138 | ||
16139 | (defun org-columns-uncompile-format (cfmt) | |
16140 | "Turn the compiled columns format back into a string representation." | |
16141 | (let ((rtn "") e s prop title op width fmt) | |
16142 | (while (setq e (pop cfmt)) | |
16143 | (setq prop (car e) | |
16144 | title (nth 1 e) | |
16145 | width (nth 2 e) | |
16146 | op (nth 3 e) | |
16147 | fmt (nth 4 e)) | |
16148 | (cond | |
16149 | ((eq fmt 'add_times) (setq op ":")) | |
16150 | ((eq fmt 'checkbox) (setq op "X")) | |
16151 | ((eq fmt 'add_numbers) (setq op "+"))) | |
16152 | (if (equal title prop) (setq title nil)) | |
16153 | (setq s (concat "%" (if width (number-to-string width)) | |
16154 | prop | |
16155 | (if title (concat "(" title ")")) | |
16156 | (if op (concat "{" op "}")))) | |
16157 | (setq rtn (concat rtn " " s))) | |
16158 | (org-trim rtn))) | |
16159 | ||
16160 | (defun org-columns-compile-format (fmt) | |
15841868 JW |
16161 | "Turn a column format string into an alist of specifications. |
16162 | The alist has one entry for each column in the format. The elements of | |
16163 | that list are: | |
16164 | property the property | |
16165 | title the title field for the columns | |
16166 | width the column width in characters, can be nil for automatic | |
16167 | operator the operator if any | |
16168 | format the output format for computed results, derived from operator" | |
7d58338e CD |
16169 | (let ((start 0) width prop title op f) |
16170 | (setq org-columns-current-fmt-compiled nil) | |
0b8568f5 JW |
16171 | (while (string-match |
16172 | (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") | |
16173 | fmt start) | |
7d58338e CD |
16174 | (setq start (match-end 0) |
16175 | width (match-string 1 fmt) | |
16176 | prop (match-string 2 fmt) | |
16177 | title (or (match-string 3 fmt) prop) | |
16178 | op (match-string 4 fmt) | |
16179 | f nil) | |
16180 | (if width (setq width (string-to-number width))) | |
16181 | (cond | |
16182 | ((equal op "+") (setq f 'add_numbers)) | |
16183 | ((equal op ":") (setq f 'add_times)) | |
16184 | ((equal op "X") (setq f 'checkbox))) | |
16185 | (push (list prop title width op f) org-columns-current-fmt-compiled)) | |
16186 | (setq org-columns-current-fmt-compiled | |
16187 | (nreverse org-columns-current-fmt-compiled)))) | |
38f8646b | 16188 | |
03f3cf35 JW |
16189 | |
16190 | ;;; Dynamic block for Column view | |
16191 | ||
16192 | (defun org-columns-capture-view () | |
16193 | "Get the column view of the current buffer and return it as a list. | |
16194 | The list will contains the title row and all other rows. Each row is | |
16195 | a list of fields." | |
16196 | (save-excursion | |
16197 | (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) | |
16198 | (n (length title)) row tbl) | |
16199 | (goto-char (point-min)) | |
16200 | (while (re-search-forward "^\\*+ " nil t) | |
16201 | (when (get-char-property (match-beginning 0) 'org-columns-key) | |
16202 | (setq row nil) | |
16203 | (loop for i from 0 to (1- n) do | |
16204 | (push (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) | |
16205 | (get-char-property (+ (match-beginning 0) i) 'org-columns-value) | |
16206 | "") | |
16207 | row)) | |
16208 | (setq row (nreverse row)) | |
16209 | (push row tbl))) | |
16210 | (append (list title 'hline) (nreverse tbl))))) | |
16211 | ||
16212 | (defun org-dblock-write:columnview (params) | |
16213 | "Write the column view table. | |
16214 | PARAMS is a property list of parameters: | |
16215 | ||
16216 | :width enforce same column widths with <N> specifiers. | |
16217 | :id the :ID: property of the entry where the columns view | |
16218 | should be built, as a string. When `local', call locally. | |
16219 | When `global' call column view with the cursor at the beginning | |
16220 | of the buffer (usually this means that the whole buffer switches | |
16221 | to column view). | |
16222 | :hlines When t, insert a hline before each item. When a number, insert | |
16223 | a hline before each level <= that number. | |
16224 | :vlines When t, make each column a colgroup to enforce vertical lines." | |
16225 | (let ((pos (move-marker (make-marker) (point))) | |
16226 | (hlines (plist-get params :hlines)) | |
16227 | (vlines (plist-get params :vlines)) | |
16228 | tbl id idpos nfields tmp) | |
16229 | (save-excursion | |
16230 | (save-restriction | |
16231 | (when (setq id (plist-get params :id)) | |
16232 | (cond ((not id) nil) | |
16233 | ((eq id 'global) (goto-char (point-min))) | |
16234 | ((eq id 'local) nil) | |
16235 | ((setq idpos (org-find-entry-with-id id)) | |
16236 | (goto-char idpos)) | |
16237 | (t (error "Cannot find entry with :ID: %s" id)))) | |
16238 | (org-columns) | |
16239 | (setq tbl (org-columns-capture-view)) | |
16240 | (setq nfields (length (car tbl))) | |
16241 | (org-columns-quit))) | |
16242 | (goto-char pos) | |
16243 | (move-marker pos nil) | |
16244 | (when tbl | |
16245 | (when (plist-get params :hlines) | |
16246 | (setq tmp nil) | |
16247 | (while tbl | |
16248 | (if (eq (car tbl) 'hline) | |
16249 | (push (pop tbl) tmp) | |
16250 | (if (string-match "\\` *\\(\\*+\\)" (caar tbl)) | |
16251 | (if (and (not (eq (car tmp) 'hline)) | |
16252 | (or (eq hlines t) | |
16253 | (and (numberp hlines) (<= (- (match-end 1) (match-beginning 1)) hlines)))) | |
16254 | (push 'hline tmp))) | |
16255 | (push (pop tbl) tmp))) | |
16256 | (setq tbl (nreverse tmp))) | |
16257 | (when vlines | |
16258 | (setq tbl (mapcar (lambda (x) | |
16259 | (if (eq 'hline x) x (cons "" x))) | |
16260 | tbl)) | |
16261 | (setq tbl (append tbl (list (cons "/" (make-list nfields "<>")))))) | |
16262 | (setq pos (point)) | |
16263 | (insert (org-listtable-to-string tbl)) | |
16264 | (when (plist-get params :width) | |
16265 | (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) | |
16266 | org-columns-current-widths "|"))) | |
16267 | (goto-char pos) | |
16268 | (org-table-align)))) | |
16269 | ||
16270 | (defun org-listtable-to-string (tbl) | |
16271 | "Convert a listtable TBL to a string that contains the Org-mode table. | |
16272 | The table still need to be alligned. The resulting string has no leading | |
16273 | and tailing newline characters." | |
16274 | (mapconcat | |
16275 | (lambda (x) | |
16276 | (cond | |
16277 | ((listp x) | |
16278 | (concat "|" (mapconcat 'identity x "|") "|")) | |
16279 | ((eq x 'hline) "|-|") | |
16280 | (t (error "Garbage in listtable: %s" x)))) | |
16281 | tbl "\n")) | |
16282 | ||
16283 | (defun org-insert-columns-dblock () | |
16284 | "Create a dynamic block capturing a column view table." | |
16285 | (interactive) | |
16286 | (let ((defaults '(:name "columnview" :hlines 1)) | |
fbe6c10d | 16287 | (id (completing-read |
03f3cf35 JW |
16288 | "Capture columns (local, global, entry with :ID: property) [local]: " |
16289 | (append '(("global") ("local")) | |
16290 | (mapcar 'list (org-property-values "ID")))))) | |
16291 | (if (equal id "") (setq id 'local)) | |
fbe6c10d | 16292 | (if (equal id "global") (setq id 'global)) |
03f3cf35 JW |
16293 | (setq defaults (append defaults (list :id id))) |
16294 | (org-create-dblock defaults) | |
16295 | (org-update-dblock))) | |
16296 | ||
d3f4dbe8 | 16297 | ;;;; Timestamps |
891f4676 | 16298 | |
d3f4dbe8 CD |
16299 | (defvar org-last-changed-timestamp nil) |
16300 | (defvar org-time-was-given) ; dynamically scoped parameter | |
b38c6895 | 16301 | (defvar org-end-time-was-given) ; dynamically scoped parameter |
d3f4dbe8 | 16302 | (defvar org-ts-what) ; dynamically scoped parameter |
4b3a9ba7 | 16303 | |
d3f4dbe8 CD |
16304 | (defun org-time-stamp (arg) |
16305 | "Prompt for a date/time and insert a time stamp. | |
16306 | If the user specifies a time like HH:MM, or if this command is called | |
16307 | with a prefix argument, the time stamp will contain date and time. | |
16308 | Otherwise, only the date will be included. All parts of a date not | |
16309 | specified by the user will be filled in from the current date/time. | |
16310 | So if you press just return without typing anything, the time stamp | |
16311 | will represent the current date/time. If there is already a timestamp | |
16312 | at the cursor, it will be modified." | |
16313 | (interactive "P") | |
15841868 JW |
16314 | (let ((default-time |
16315 | ;; Default time is either today, or, when entering a range, | |
16316 | ;; the range start. | |
16317 | (if (or (org-at-timestamp-p t) | |
16318 | (save-excursion | |
16319 | (re-search-backward | |
16320 | (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses | |
16321 | (- (point) 20) t))) | |
16322 | (apply 'encode-time (org-parse-time-string (match-string 1))) | |
16323 | (current-time))) | |
16324 | org-time-was-given org-end-time-was-given time) | |
d3f4dbe8 CD |
16325 | (cond |
16326 | ((and (org-at-timestamp-p) | |
16327 | (eq last-command 'org-time-stamp) | |
16328 | (eq this-command 'org-time-stamp)) | |
16329 | (insert "--") | |
16330 | (setq time (let ((this-command this-command)) | |
15841868 | 16331 | (org-read-date arg 'totime nil nil default-time))) |
d3f4dbe8 CD |
16332 | (org-insert-time-stamp time (or org-time-was-given arg))) |
16333 | ((org-at-timestamp-p) | |
16334 | (setq time (let ((this-command this-command)) | |
15841868 | 16335 | (org-read-date arg 'totime nil nil default-time))) |
d3f4dbe8 CD |
16336 | (when (org-at-timestamp-p) ; just to get the match data |
16337 | (replace-match "") | |
16338 | (setq org-last-changed-timestamp | |
b38c6895 CD |
16339 | (org-insert-time-stamp |
16340 | time (or org-time-was-given arg) | |
16341 | nil nil nil (list org-end-time-was-given)))) | |
d3f4dbe8 CD |
16342 | (message "Timestamp updated")) |
16343 | (t | |
16344 | (setq time (let ((this-command this-command)) | |
15841868 | 16345 | (org-read-date arg 'totime nil nil default-time))) |
b38c6895 | 16346 | (org-insert-time-stamp time (or org-time-was-given arg) |
15841868 | 16347 | nil nil nil (list org-end-time-was-given)))))) |
891f4676 | 16348 | |
d3f4dbe8 CD |
16349 | (defun org-time-stamp-inactive (&optional arg) |
16350 | "Insert an inactive time stamp. | |
16351 | An inactive time stamp is enclosed in square brackets instead of angle | |
16352 | brackets. It is inactive in the sense that it does not trigger agenda entries, | |
16353 | does not link to the calendar and cannot be changed with the S-cursor keys. | |
16354 | So these are more for recording a certain time/date." | |
16355 | (interactive "P") | |
b38c6895 | 16356 | (let (org-time-was-given org-end-time-was-given time) |
d3f4dbe8 | 16357 | (setq time (org-read-date arg 'totime)) |
b38c6895 CD |
16358 | (org-insert-time-stamp time (or org-time-was-given arg) 'inactive |
16359 | nil nil (list org-end-time-was-given)))) | |
891f4676 | 16360 | |
d3f4dbe8 CD |
16361 | (defvar org-date-ovl (org-make-overlay 1 1)) |
16362 | (org-overlay-put org-date-ovl 'face 'org-warning) | |
16363 | (org-detach-overlay org-date-ovl) | |
891f4676 | 16364 | |
d3f4dbe8 CD |
16365 | (defvar org-ans1) ; dynamically scoped parameter |
16366 | (defvar org-ans2) ; dynamically scoped parameter | |
891f4676 | 16367 | |
b38c6895 | 16368 | (defvar org-plain-time-of-day-regexp) ; defined below |
15841868 JW |
16369 | (defun org-read-date (&optional with-time to-time from-string prompt |
16370 | default-time) | |
d3f4dbe8 CD |
16371 | "Read a date and make things smooth for the user. |
16372 | The prompt will suggest to enter an ISO date, but you can also enter anything | |
16373 | which will at least partially be understood by `parse-time-string'. | |
16374 | Unrecognized parts of the date will default to the current day, month, year, | |
15841868 JW |
16375 | hour and minute. If this command is called to replace a timestamp at point, |
16376 | of to enter the second timestamp of a range, the default time is taken from the | |
16377 | existing stamp. For example, | |
d3f4dbe8 CD |
16378 | 3-2-5 --> 2003-02-05 |
16379 | feb 15 --> currentyear-02-15 | |
16380 | sep 12 9 --> 2009-09-12 | |
16381 | 12:45 --> today 12:45 | |
16382 | 22 sept 0:34 --> currentyear-09-22 0:34 | |
16383 | 12 --> currentyear-currentmonth-12 | |
16384 | Fri --> nearest Friday (today or later) | |
d3f4dbe8 | 16385 | etc. |
03f3cf35 JW |
16386 | |
16387 | Furthermore you can specify a relative date by giving, as the *first* thing | |
16388 | in the input: a plus/minus sign, a number and a letter [dwmy] to indicate | |
16389 | change in days weeks, months, years. | |
16390 | With a single plus or minus, the date is relative to today. With a double | |
16391 | plus or minus, it is relative to the date in DEFAULT-TIME. E.g. | |
16392 | +4d --> four days from today | |
16393 | +4 --> same as above | |
16394 | +2w --> two weeks from today | |
16395 | ++5 --> five days from default date | |
16396 | ||
d3f4dbe8 CD |
16397 | The function understands only English month and weekday abbreviations, |
16398 | but this can be configured with the variables `parse-time-months' and | |
16399 | `parse-time-weekdays'. | |
891f4676 | 16400 | |
d3f4dbe8 CD |
16401 | While prompting, a calendar is popped up - you can also select the |
16402 | date with the mouse (button 1). The calendar shows a period of three | |
16403 | months. To scroll it to other months, use the keys `>' and `<'. | |
16404 | If you don't like the calendar, turn it off with | |
16405 | \(setq org-popup-calendar-for-date-prompt nil) | |
891f4676 | 16406 | |
d3f4dbe8 CD |
16407 | With optional argument TO-TIME, the date will immediately be converted |
16408 | to an internal time. | |
16409 | With an optional argument WITH-TIME, the prompt will suggest to also | |
16410 | insert a time. Note that when WITH-TIME is not set, you can still | |
16411 | enter a time, and this function will inform the calling routine about | |
16412 | this change. The calling routine may then choose to change the format | |
15841868 JW |
16413 | used to insert the time stamp into the buffer to include the time. |
16414 | With optional argument FROM-STRING, read fomr this string instead from | |
16415 | the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is | |
16416 | the time/date that is used for everything that is not specified by the | |
16417 | user." | |
d3f4dbe8 CD |
16418 | (require 'parse-time) |
16419 | (let* ((org-time-stamp-rounding-minutes | |
16420 | (if (equal with-time '(16)) 0 org-time-stamp-rounding-minutes)) | |
16421 | (ct (org-current-time)) | |
15841868 | 16422 | (def (or default-time ct)) |
fbe6c10d | 16423 | ; (defdecode (decode-time def)) |
d3f4dbe8 CD |
16424 | (calendar-move-hook nil) |
16425 | (view-diary-entries-initially nil) | |
16426 | (view-calendar-holidays-initially nil) | |
16427 | (timestr (format-time-string | |
15841868 | 16428 | (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) |
d3f4dbe8 | 16429 | (prompt (concat (if prompt (concat prompt " ") "") |
a3fbe8c4 | 16430 | (format "Date and/or time (default [%s]): " timestr))) |
03f3cf35 | 16431 | ans (org-ans0 "") org-ans1 org-ans2 delta deltan deltaw deltadef |
15841868 | 16432 | second minute hour day month year tl wday wday1 pm h2 m2) |
891f4676 | 16433 | |
d3f4dbe8 CD |
16434 | (cond |
16435 | (from-string (setq ans from-string)) | |
16436 | (org-popup-calendar-for-date-prompt | |
16437 | (save-excursion | |
16438 | (save-window-excursion | |
16439 | (calendar) | |
15841868 | 16440 | (calendar-forward-day (- (time-to-days def) |
d3f4dbe8 CD |
16441 | (calendar-absolute-from-gregorian |
16442 | (calendar-current-date)))) | |
a3fbe8c4 | 16443 | (org-eval-in-calendar nil t) |
d3f4dbe8 CD |
16444 | (let* ((old-map (current-local-map)) |
16445 | (map (copy-keymap calendar-mode-map)) | |
16446 | (minibuffer-local-map (copy-keymap minibuffer-local-map))) | |
a3fbe8c4 CD |
16447 | (org-defkey map (kbd "RET") 'org-calendar-select) |
16448 | (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) | |
d3f4dbe8 | 16449 | 'org-calendar-select-mouse) |
a3fbe8c4 | 16450 | (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) |
d3f4dbe8 | 16451 | 'org-calendar-select-mouse) |
a3fbe8c4 | 16452 | (org-defkey minibuffer-local-map [(meta shift left)] |
d3f4dbe8 CD |
16453 | (lambda () (interactive) |
16454 | (org-eval-in-calendar '(calendar-backward-month 1)))) | |
a3fbe8c4 | 16455 | (org-defkey minibuffer-local-map [(meta shift right)] |
d3f4dbe8 CD |
16456 | (lambda () (interactive) |
16457 | (org-eval-in-calendar '(calendar-forward-month 1)))) | |
a3fbe8c4 | 16458 | (org-defkey minibuffer-local-map [(shift up)] |
d3f4dbe8 CD |
16459 | (lambda () (interactive) |
16460 | (org-eval-in-calendar '(calendar-backward-week 1)))) | |
a3fbe8c4 | 16461 | (org-defkey minibuffer-local-map [(shift down)] |
d3f4dbe8 CD |
16462 | (lambda () (interactive) |
16463 | (org-eval-in-calendar '(calendar-forward-week 1)))) | |
a3fbe8c4 | 16464 | (org-defkey minibuffer-local-map [(shift left)] |
d3f4dbe8 CD |
16465 | (lambda () (interactive) |
16466 | (org-eval-in-calendar '(calendar-backward-day 1)))) | |
a3fbe8c4 | 16467 | (org-defkey minibuffer-local-map [(shift right)] |
d3f4dbe8 CD |
16468 | (lambda () (interactive) |
16469 | (org-eval-in-calendar '(calendar-forward-day 1)))) | |
a3fbe8c4 | 16470 | (org-defkey minibuffer-local-map ">" |
d3f4dbe8 CD |
16471 | (lambda () (interactive) |
16472 | (org-eval-in-calendar '(scroll-calendar-left 1)))) | |
a3fbe8c4 | 16473 | (org-defkey minibuffer-local-map "<" |
d3f4dbe8 CD |
16474 | (lambda () (interactive) |
16475 | (org-eval-in-calendar '(scroll-calendar-right 1)))) | |
16476 | (unwind-protect | |
16477 | (progn | |
16478 | (use-local-map map) | |
16479 | (setq org-ans0 (read-string prompt "" nil nil)) | |
d3f4dbe8 CD |
16480 | ;; org-ans0: from prompt |
16481 | ;; org-ans1: from mouse click | |
16482 | ;; org-ans2: from calendar motion | |
16483 | (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) | |
16484 | (use-local-map old-map)))))) | |
16485 | (t ; Naked prompt only | |
16486 | (setq ans (read-string prompt "" nil timestr)))) | |
16487 | (org-detach-overlay org-date-ovl) | |
891f4676 | 16488 | |
03f3cf35 JW |
16489 | (when (setq delta (org-read-date-get-relative ans (current-time) def)) |
16490 | (setq ans (replace-match "" t t ans) | |
16491 | deltan (car delta) | |
16492 | deltaw (nth 1 delta) | |
16493 | deltadef (nth 2 delta))) | |
891f4676 | 16494 | |
a3fbe8c4 CD |
16495 | ;; Help matching ISO dates with single digit month ot day, like 2006-8-11. |
16496 | (when (string-match | |
16497 | "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) | |
16498 | (setq year (if (match-end 2) | |
16499 | (string-to-number (match-string 2 ans)) | |
16500 | (string-to-number (format-time-string "%Y"))) | |
16501 | month (string-to-number (match-string 3 ans)) | |
16502 | day (string-to-number (match-string 4 ans))) | |
16503 | (if (< year 100) (setq year (+ 2000 year))) | |
16504 | (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) | |
16505 | t nil ans))) | |
16506 | ;; Help matching am/pm times, because `parse-time-string' does not do that. | |
16507 | ;; If there is a time with am/pm, and *no* time without it, we convert | |
b38c6895 | 16508 | ;; so that matching will be successful. |
15841868 JW |
16509 | (loop for i from 1 to 2 do ; twice, for end time as well |
16510 | (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) | |
16511 | (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) | |
16512 | (setq hour (string-to-number (match-string 1 ans)) | |
16513 | minute (if (match-end 3) | |
16514 | (string-to-number (match-string 3 ans)) | |
16515 | 0) | |
fbe6c10d | 16516 | pm (equal ?p |
15841868 JW |
16517 | (string-to-char (downcase (match-string 4 ans))))) |
16518 | (if (and (= hour 12) (not pm)) | |
16519 | (setq hour 0) | |
16520 | (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) | |
16521 | (setq ans (replace-match (format "%02d:%02d" hour minute) | |
16522 | t t ans)))) | |
16523 | ||
16524 | ;; Check if a time range is given as a duration | |
16525 | (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) | |
a3fbe8c4 | 16526 | (setq hour (string-to-number (match-string 1 ans)) |
15841868 JW |
16527 | h2 (+ hour (string-to-number (match-string 3 ans))) |
16528 | minute (string-to-number (match-string 2 ans)) | |
16529 | m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) | |
16530 | (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) | |
a3fbe8c4 | 16531 | |
b38c6895 CD |
16532 | ;; Check if there is a time range |
16533 | (when (and (boundp 'org-end-time-was-given) | |
16534 | (string-match org-plain-time-of-day-regexp ans) | |
16535 | (match-end 8)) | |
16536 | (setq org-end-time-was-given (match-string 8 ans)) | |
16537 | (setq ans (concat (substring ans 0 (match-beginning 7)) | |
16538 | (substring ans (match-end 7))))) | |
16539 | ||
d3f4dbe8 | 16540 | (setq tl (parse-time-string ans) |
15841868 | 16541 | day (or (nth 3 tl) (string-to-number (format-time-string "%d" def))) |
fbe6c10d CD |
16542 | month (or (nth 4 tl) (string-to-number (format-time-string "%m" def))) |
16543 | year (or (nth 5 tl) (string-to-number (format-time-string "%Y" def))) | |
15841868 JW |
16544 | hour (or (nth 2 tl) (string-to-number (format-time-string "%H" def))) |
16545 | minute (or (nth 1 tl) (string-to-number (format-time-string "%M" def))) | |
d3f4dbe8 CD |
16546 | second (or (nth 0 tl) 0) |
16547 | wday (nth 6 tl)) | |
03f3cf35 JW |
16548 | (when deltan |
16549 | (unless deltadef | |
16550 | (let ((now (decode-time (current-time)))) | |
16551 | (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) | |
16552 | (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) | |
16553 | ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) | |
16554 | ((equal deltaw "m") (setq month (+ month deltan))) | |
16555 | ((equal deltaw "y") (setq year (+ year deltan))))) | |
d3f4dbe8 CD |
16556 | (when (and wday (not (nth 3 tl))) |
16557 | ;; Weekday was given, but no day, so pick that day in the week | |
16558 | ;; on or after the derived date. | |
16559 | (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) | |
16560 | (unless (equal wday wday1) | |
16561 | (setq day (+ day (% (- wday wday1 -7) 7))))) | |
16562 | (if (and (boundp 'org-time-was-given) | |
16563 | (nth 2 tl)) | |
16564 | (setq org-time-was-given t)) | |
16565 | (if (< year 100) (setq year (+ 2000 year))) | |
16566 | (if to-time | |
16567 | (encode-time 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))))) | |
891f4676 | 16571 | |
fbe6c10d CD |
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 | ||
03f3cf35 JW |
16586 | (defvar parse-time-weekdays) |
16587 | ||
16588 | (defun org-read-date-get-relative (s today default) | |
16589 | "Check string S for special relative date string. | |
fbe6c10d | 16590 | TODAY and DEFAULT are internal times, for today and for a default. |
03f3cf35 JW |
16591 | Return shift list (N what def-flag) |
16592 | WHAT is \"d\", \"w\", \"m\", or \"y\" for day. week, month, year. | |
16593 | N is the number if WHATs to shift | |
16594 | DEF-FLAG is t when a double ++ or -- indicates shift relative to | |
16595 | the DEFAULT date rather than TODAY." | |
16596 | (when (string-match | |
16597 | (concat | |
fbe6c10d | 16598 | "\\`[ \t]*\\([-+]\\{1,2\\}\\)" |
03f3cf35 JW |
16599 | "\\([0-9]+\\)?" |
16600 | "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" | |
16601 | "\\([ \t]\\|$\\)") s) | |
16602 | (let* ((dir (if (match-end 1) | |
16603 | (string-to-char (substring (match-string 1 s) -1)) | |
16604 | ?+)) | |
16605 | (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1))))) | |
16606 | (n (if (match-end 2) (string-to-number (match-string 2 s)) 1)) | |
16607 | (what (if (match-end 3) (match-string 3 s) "d")) | |
16608 | (wday1 (cdr (assoc (downcase what) parse-time-weekdays))) | |
16609 | (date (if rel default today)) | |
16610 | (wday (nth 6 (decode-time date))) | |
16611 | delta) | |
16612 | (if wday1 | |
16613 | (progn | |
16614 | (setq delta (mod (+ 7 (- wday1 wday)) 7)) | |
16615 | (if (= dir ?-) (setq delta (- delta 7))) | |
16616 | (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) | |
16617 | (list delta "d" rel)) | |
16618 | (list (* n (if (= dir ?-) -1 1)) what rel))))) | |
16619 | ||
a3fbe8c4 | 16620 | (defun org-eval-in-calendar (form &optional keepdate) |
d3f4dbe8 CD |
16621 | "Eval FORM in the calendar window and return to current window. |
16622 | Also, store the cursor date in variable org-ans2." | |
16623 | (let ((sw (selected-window))) | |
16624 | (select-window (get-buffer-window "*Calendar*")) | |
16625 | (eval form) | |
a3fbe8c4 | 16626 | (when (and (not keepdate) (calendar-cursor-to-date)) |
d3f4dbe8 CD |
16627 | (let* ((date (calendar-cursor-to-date)) |
16628 | (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)))) | |
16630 | (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) | |
a3fbe8c4 CD |
16631 | (select-window sw) |
16632 | ;; Update the prompt to show new default date | |
16633 | (save-excursion | |
16634 | (goto-char (point-min)) | |
16635 | (when (and org-ans2 | |
16636 | (re-search-forward "\\[[-0-9]+\\]" nil t) | |
16637 | (get-text-property (match-end 0) 'field)) | |
16638 | (let ((inhibit-read-only t)) | |
16639 | (replace-match (concat "[" org-ans2 "]") t t) | |
16640 | (add-text-properties (point-min) (1+ (match-end 0)) | |
16641 | (text-properties-at (1+ (point-min))))))))) | |
891f4676 | 16642 | |
d3f4dbe8 CD |
16643 | (defun org-calendar-select () |
16644 | "Return to `org-read-date' with the date currently selected. | |
16645 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
891f4676 | 16646 | (interactive) |
d3f4dbe8 CD |
16647 | (when (calendar-cursor-to-date) |
16648 | (let* ((date (calendar-cursor-to-date)) | |
16649 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
16650 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
16651 | (if (active-minibuffer-window) (exit-minibuffer)))) | |
891f4676 | 16652 | |
a3fbe8c4 | 16653 | (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) |
d3f4dbe8 CD |
16654 | "Insert a date stamp for the date given by the internal TIME. |
16655 | WITH-HM means, use the stamp format that includes the time of the day. | |
16656 | INACTIVE means use square brackets instead of angular ones, so that the | |
16657 | stamp will not contribute to the agenda. | |
16658 | PRE and POST are optional strings to be inserted before and after the | |
16659 | stamp. | |
16660 | The command returns the inserted time stamp." | |
16661 | (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) | |
16662 | stamp) | |
16663 | (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) | |
03f3cf35 JW |
16664 | (insert-before-markers (or pre "")) |
16665 | (insert-before-markers (setq stamp (format-time-string fmt time))) | |
b38c6895 CD |
16666 | (when (listp extra) |
16667 | (setq extra (car extra)) | |
16668 | (if (and (stringp extra) | |
16669 | (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) | |
16670 | (setq extra (format "-%02d:%02d" | |
16671 | (string-to-number (match-string 1 extra)) | |
16672 | (string-to-number (match-string 2 extra)))) | |
16673 | (setq extra nil))) | |
a3fbe8c4 CD |
16674 | (when extra |
16675 | (backward-char 1) | |
03f3cf35 | 16676 | (insert-before-markers extra) |
a3fbe8c4 | 16677 | (forward-char 1)) |
03f3cf35 | 16678 | (insert-before-markers (or post "")) |
d3f4dbe8 | 16679 | stamp)) |
ab27a4a0 | 16680 | |
d3f4dbe8 CD |
16681 | (defun org-toggle-time-stamp-overlays () |
16682 | "Toggle the use of custom time stamp formats." | |
16683 | (interactive) | |
16684 | (setq org-display-custom-times (not org-display-custom-times)) | |
16685 | (unless org-display-custom-times | |
16686 | (let ((p (point-min)) (bmp (buffer-modified-p))) | |
16687 | (while (setq p (next-single-property-change p 'display)) | |
16688 | (if (and (get-text-property p 'display) | |
16689 | (eq (get-text-property p 'face) 'org-date)) | |
16690 | (remove-text-properties | |
16691 | p (setq p (next-single-property-change p 'display)) | |
16692 | '(display t)))) | |
16693 | (set-buffer-modified-p bmp))) | |
16694 | (if (featurep 'xemacs) | |
16695 | (remove-text-properties (point-min) (point-max) '(end-glyph t))) | |
16696 | (org-restart-font-lock) | |
16697 | (setq org-table-may-need-update t) | |
16698 | (if org-display-custom-times | |
16699 | (message "Time stamps are overlayed with custom format") | |
16700 | (message "Time stamp overlays removed"))) | |
891f4676 | 16701 | |
d3f4dbe8 CD |
16702 | (defun org-display-custom-time (beg end) |
16703 | "Overlay modified time stamp format over timestamp between BED and END." | |
a3fbe8c4 CD |
16704 | (let* ((ts (buffer-substring beg end)) |
16705 | t1 w1 with-hm tf time str w2 (off 0)) | |
16706 | (save-match-data | |
16707 | (setq t1 (org-parse-time-string ts t)) | |
b38c6895 | 16708 | (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( \\+[0-9]+[dwmy]\\)?\\'" ts) |
a3fbe8c4 CD |
16709 | (setq off (- (match-end 0) (match-beginning 0))))) |
16710 | (setq end (- end off)) | |
16711 | (setq w1 (- end beg) | |
16712 | with-hm (and (nth 1 t1) (nth 2 t1)) | |
16713 | tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) | |
16714 | time (org-fix-decoded-time t1) | |
16715 | str (org-add-props | |
d3f4dbe8 CD |
16716 | (format-time-string |
16717 | (substring tf 1 -1) (apply 'encode-time time)) | |
a3fbe8c4 CD |
16718 | nil 'mouse-face 'highlight) |
16719 | w2 (length str)) | |
d3f4dbe8 CD |
16720 | (if (not (= w2 w1)) |
16721 | (add-text-properties (1+ beg) (+ 2 beg) | |
16722 | (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) | |
16723 | (if (featurep 'xemacs) | |
c8d16429 | 16724 | (progn |
d3f4dbe8 CD |
16725 | (put-text-property beg end 'invisible t) |
16726 | (put-text-property beg end 'end-glyph (make-glyph str))) | |
16727 | (put-text-property beg end 'display str)))) | |
891f4676 | 16728 | |
d3f4dbe8 CD |
16729 | (defun org-translate-time (string) |
16730 | "Translate all timestamps in STRING to custom format. | |
16731 | But do this only if the variable `org-display-custom-times' is set." | |
16732 | (when org-display-custom-times | |
16733 | (save-match-data | |
16734 | (let* ((start 0) | |
16735 | (re org-ts-regexp-both) | |
16736 | t1 with-hm inactive tf time str beg end) | |
16737 | (while (setq start (string-match re string start)) | |
16738 | (setq beg (match-beginning 0) | |
16739 | end (match-end 0) | |
16740 | t1 (save-match-data | |
16741 | (org-parse-time-string (substring string beg end) t)) | |
16742 | with-hm (and (nth 1 t1) (nth 2 t1)) | |
16743 | inactive (equal (substring string beg (1+ beg)) "[") | |
16744 | tf (funcall (if with-hm 'cdr 'car) | |
16745 | org-time-stamp-custom-formats) | |
16746 | time (org-fix-decoded-time t1) | |
16747 | str (format-time-string | |
16748 | (concat | |
16749 | (if inactive "[" "<") (substring tf 1 -1) | |
16750 | (if inactive "]" ">")) | |
16751 | (apply 'encode-time time)) | |
16752 | string (replace-match str t t string) | |
16753 | start (+ start (length str))))))) | |
16754 | string) | |
891f4676 | 16755 | |
d3f4dbe8 CD |
16756 | (defun org-fix-decoded-time (time) |
16757 | "Set 0 instead of nil for the first 6 elements of time. | |
16758 | Don't touch the rest." | |
16759 | (let ((n 0)) | |
16760 | (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) | |
891f4676 | 16761 | |
d3f4dbe8 CD |
16762 | (defun org-days-to-time (timestamp-string) |
16763 | "Difference between TIMESTAMP-STRING and now in days." | |
16764 | (- (time-to-days (org-time-string-to-time timestamp-string)) | |
16765 | (time-to-days (current-time)))) | |
791d856f | 16766 | |
d3f4dbe8 CD |
16767 | (defun org-deadline-close (timestamp-string &optional ndays) |
16768 | "Is the time in TIMESTAMP-STRING close to the current date?" | |
0b8568f5 JW |
16769 | (setq ndays (or ndays (org-get-wdays timestamp-string))) |
16770 | (and (< (org-days-to-time timestamp-string) ndays) | |
d3f4dbe8 | 16771 | (not (org-entry-is-done-p)))) |
3278a016 | 16772 | |
0b8568f5 JW |
16773 | (defun org-get-wdays (ts) |
16774 | "Get the deadline lead time appropriate for timestring TS." | |
16775 | (cond | |
16776 | ((<= org-deadline-warning-days 0) | |
16777 | ;; 0 or negative, enforce this value no matter what | |
16778 | (- org-deadline-warning-days)) | |
16779 | ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\)" ts) | |
16780 | ;; lead time is specified. | |
16781 | (floor (* (string-to-number (match-string 1 ts)) | |
16782 | (cdr (assoc (match-string 2 ts) | |
16783 | '(("d" . 1) ("w" . 7) | |
16784 | ("m" . 30.4) ("y" . 365.25))))))) | |
16785 | ;; go for the default. | |
16786 | (t org-deadline-warning-days))) | |
16787 | ||
d3f4dbe8 CD |
16788 | (defun org-calendar-select-mouse (ev) |
16789 | "Return to `org-read-date' with the date currently selected. | |
16790 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
16791 | (interactive "e") | |
16792 | (mouse-set-point ev) | |
16793 | (when (calendar-cursor-to-date) | |
16794 | (let* ((date (calendar-cursor-to-date)) | |
16795 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
16796 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
16797 | (if (active-minibuffer-window) (exit-minibuffer)))) | |
ab27a4a0 | 16798 | |
d3f4dbe8 CD |
16799 | (defun org-check-deadlines (ndays) |
16800 | "Check if there are any deadlines due or past due. | |
16801 | A deadline is considered due if it happens within `org-deadline-warning-days' | |
16802 | days from today's date. If the deadline appears in an entry marked DONE, | |
16803 | it is not shown. The prefix arg NDAYS can be used to test that many | |
16804 | days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." | |
16805 | (interactive "P") | |
16806 | (let* ((org-warn-days | |
16807 | (cond | |
16808 | ((equal ndays '(4)) 100000) | |
16809 | (ndays (prefix-numeric-value ndays)) | |
0b8568f5 | 16810 | (t (abs org-deadline-warning-days)))) |
d3f4dbe8 CD |
16811 | (case-fold-search nil) |
16812 | (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) | |
16813 | (callback | |
16814 | (lambda () (org-deadline-close (match-string 1) org-warn-days)))) | |
ab27a4a0 | 16815 | |
d3f4dbe8 CD |
16816 | (message "%d deadlines past-due or due within %d days" |
16817 | (org-occur regexp nil callback) | |
16818 | org-warn-days))) | |
ab27a4a0 | 16819 | |
d3f4dbe8 CD |
16820 | (defun org-evaluate-time-range (&optional to-buffer) |
16821 | "Evaluate a time range by computing the difference between start and end. | |
16822 | Normally the result is just printed in the echo area, but with prefix arg | |
16823 | TO-BUFFER, the result is inserted just after the date stamp into the buffer. | |
16824 | If the time range is actually in a table, the result is inserted into the | |
16825 | next column. | |
16826 | For time difference computation, a year is assumed to be exactly 365 | |
16827 | days in order to avoid rounding problems." | |
16828 | (interactive "P") | |
16829 | (or | |
16830 | (org-clock-update-time-maybe) | |
16831 | (save-excursion | |
15841868 | 16832 | (unless (org-at-date-range-p t) |
d3f4dbe8 | 16833 | (goto-char (point-at-bol)) |
15841868 JW |
16834 | (re-search-forward org-tr-regexp-both (point-at-eol) t)) |
16835 | (if (not (org-at-date-range-p t)) | |
d3f4dbe8 CD |
16836 | (error "Not at a time-stamp range, and none found in current line"))) |
16837 | (let* ((ts1 (match-string 1)) | |
16838 | (ts2 (match-string 2)) | |
16839 | (havetime (or (> (length ts1) 15) (> (length ts2) 15))) | |
16840 | (match-end (match-end 0)) | |
16841 | (time1 (org-time-string-to-time ts1)) | |
16842 | (time2 (org-time-string-to-time ts2)) | |
16843 | (t1 (time-to-seconds time1)) | |
16844 | (t2 (time-to-seconds time2)) | |
16845 | (diff (abs (- t2 t1))) | |
16846 | (negative (< (- t2 t1) 0)) | |
16847 | ;; (ys (floor (* 365 24 60 60))) | |
16848 | (ds (* 24 60 60)) | |
16849 | (hs (* 60 60)) | |
16850 | (fy "%dy %dd %02d:%02d") | |
16851 | (fy1 "%dy %dd") | |
16852 | (fd "%dd %02d:%02d") | |
16853 | (fd1 "%dd") | |
16854 | (fh "%02d:%02d") | |
16855 | y d h m align) | |
16856 | (if havetime | |
16857 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
16858 | y 0 | |
16859 | d (floor (/ diff ds)) diff (mod diff ds) | |
16860 | h (floor (/ diff hs)) diff (mod diff hs) | |
16861 | m (floor (/ diff 60))) | |
16862 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
16863 | y 0 | |
16864 | d (floor (+ (/ diff ds) 0.5)) | |
16865 | h 0 m 0)) | |
16866 | (if (not to-buffer) | |
274f1353 | 16867 | (message "%s" (org-make-tdiff-string y d h m)) |
d3f4dbe8 CD |
16868 | (when (org-at-table-p) |
16869 | (goto-char match-end) | |
16870 | (setq align t) | |
16871 | (and (looking-at " *|") (goto-char (match-end 0)))) | |
16872 | (if (looking-at | |
16873 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | |
16874 | (replace-match "")) | |
16875 | (if negative (insert " -")) | |
16876 | (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) | |
16877 | (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) | |
16878 | (insert " " (format fh h m)))) | |
16879 | (if align (org-table-align)) | |
16880 | (message "Time difference inserted"))))) | |
ab27a4a0 | 16881 | |
d3f4dbe8 CD |
16882 | (defun org-make-tdiff-string (y d h m) |
16883 | (let ((fmt "") | |
16884 | (l nil)) | |
16885 | (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") | |
16886 | l (push y l))) | |
16887 | (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") | |
16888 | l (push d l))) | |
16889 | (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") | |
16890 | l (push h l))) | |
16891 | (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") | |
16892 | l (push m l))) | |
16893 | (apply 'format fmt (nreverse l)))) | |
891f4676 | 16894 | |
d3f4dbe8 CD |
16895 | (defun org-time-string-to-time (s) |
16896 | (apply 'encode-time (org-parse-time-string s))) | |
ab27a4a0 | 16897 | |
a3fbe8c4 CD |
16898 | (defun org-time-string-to-absolute (s &optional daynr) |
16899 | "Convert a time stamp to an absolute day number. | |
16900 | If there is a specifyer for a cyclic time stamp, get the closest date to | |
48aaad2d | 16901 | DAYNR." |
a3fbe8c4 CD |
16902 | (cond |
16903 | ((and daynr (string-match "\\`%%\\((.*)\\)" s)) | |
16904 | (if (org-diary-sexp-entry (match-string 1 s) "" date) | |
16905 | daynr | |
16906 | (+ daynr 1000))) | |
16907 | ((and daynr (string-match "\\+[0-9]+[dwmy]" s)) | |
16908 | (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr | |
16909 | (time-to-days (current-time))) (match-string 0 s))) | |
16910 | (t (time-to-days (apply 'encode-time (org-parse-time-string s)))))) | |
16911 | ||
d5098885 JW |
16912 | (defun org-time-from-absolute (d) |
16913 | "Return the time corresponding to date D. | |
16914 | D may be an absolute day number, or a calendar-type list (month day year)." | |
16915 | (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) | |
16916 | (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) | |
16917 | ||
a3fbe8c4 CD |
16918 | (defun org-calendar-holiday () |
16919 | "List of holidays, for Diary display in Org-mode." | |
182aef95 | 16920 | (let ((hl (calendar-check-holidays date))) |
a3fbe8c4 CD |
16921 | (if hl (mapconcat 'identity hl "; ")))) |
16922 | ||
16923 | (defun org-diary-sexp-entry (sexp entry date) | |
16924 | "Process a SEXP diary ENTRY for DATE." | |
48aaad2d | 16925 | (require 'diary-lib) |
a3fbe8c4 CD |
16926 | (let ((result (if calendar-debug-sexp |
16927 | (let ((stack-trace-on-error t)) | |
16928 | (eval (car (read-from-string sexp)))) | |
16929 | (condition-case nil | |
16930 | (eval (car (read-from-string sexp))) | |
16931 | (error | |
16932 | (beep) | |
16933 | (message "Bad sexp at line %d in %s: %s" | |
16934 | (org-current-line) | |
16935 | (buffer-file-name) sexp) | |
16936 | (sleep-for 2)))))) | |
16937 | (cond ((stringp result) result) | |
16938 | ((and (consp result) | |
16939 | (stringp (cdr result))) (cdr result)) | |
16940 | (result entry) | |
16941 | (t nil)))) | |
16942 | ||
16943 | (defun org-diary-to-ical-string (frombuf) | |
15841868 JW |
16944 | "Get iCalendar entreis from diary entries in buffer FROMBUF. |
16945 | This uses the icalendar.el library." | |
a3fbe8c4 CD |
16946 | (let* ((tmpdir (if (featurep 'xemacs) |
16947 | (temp-directory) | |
16948 | temporary-file-directory)) | |
16949 | (tmpfile (make-temp-name | |
16950 | (expand-file-name "orgics" tmpdir))) | |
16951 | buf rtn b e) | |
16952 | (save-excursion | |
16953 | (set-buffer frombuf) | |
16954 | (icalendar-export-region (point-min) (point-max) tmpfile) | |
16955 | (setq buf (find-buffer-visiting tmpfile)) | |
16956 | (set-buffer buf) | |
16957 | (goto-char (point-min)) | |
16958 | (if (re-search-forward "^BEGIN:VEVENT" nil t) | |
16959 | (setq b (match-beginning 0))) | |
16960 | (goto-char (point-max)) | |
16961 | (if (re-search-backward "^END:VEVENT" nil t) | |
16962 | (setq e (match-end 0))) | |
16963 | (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) | |
16964 | (kill-buffer buf) | |
16965 | (kill-buffer frombuf) | |
16966 | (delete-file tmpfile) | |
16967 | rtn)) | |
16968 | ||
16969 | (defun org-closest-date (start current change) | |
16970 | "Find the date closest to CURRENT that is consistent with START and CHANGE." | |
16971 | ;; Make the proper lists from the dates | |
16972 | (catch 'exit | |
16973 | (let ((a1 '(("d" . day) ("w" . week) ("m" . month) ("y" . year))) | |
16974 | dn dw sday cday n1 n2 | |
16975 | d m y y1 y2 date1 date2 nmonths nm ny m2) | |
16976 | ||
16977 | (setq start (org-date-to-gregorian start) | |
48aaad2d CD |
16978 | current (org-date-to-gregorian |
16979 | (if org-agenda-repeating-timestamp-show-all | |
16980 | current | |
16981 | (time-to-days (current-time)))) | |
a3fbe8c4 CD |
16982 | sday (calendar-absolute-from-gregorian start) |
16983 | cday (calendar-absolute-from-gregorian current)) | |
16984 | ||
16985 | (if (<= cday sday) (throw 'exit sday)) | |
16986 | ||
16987 | (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) | |
16988 | (setq dn (string-to-number (match-string 1 change)) | |
16989 | dw (cdr (assoc (match-string 2 change) a1))) | |
16990 | (error "Invalid change specifyer: %s" change)) | |
16991 | (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) | |
16992 | (cond | |
16993 | ((eq dw 'day) | |
16994 | (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn)))) | |
16995 | n2 (+ n1 dn))) | |
16996 | ((eq dw 'year) | |
16997 | (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current)) | |
16998 | (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1)) | |
16999 | (setq date1 (list m d y1) | |
17000 | n1 (calendar-absolute-from-gregorian date1) | |
17001 | date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) | |
17002 | n2 (calendar-absolute-from-gregorian date2))) | |
17003 | ((eq dw 'month) | |
17004 | ;; approx number of month between the tow dates | |
17005 | (setq nmonths (floor (/ (- cday sday) 30.436875))) | |
17006 | ;; How often does dn fit in there? | |
17007 | (setq d (nth 1 start) m (car start) y (nth 2 start) | |
17008 | nm (* dn (max 0 (1- (floor (/ nmonths dn))))) | |
17009 | m (+ m nm) | |
17010 | ny (floor (/ m 12)) | |
17011 | y (+ y ny) | |
17012 | m (- m (* ny 12))) | |
17013 | (while (> m 12) (setq m (- m 12) y (1+ y))) | |
17014 | (setq n1 (calendar-absolute-from-gregorian (list m d y))) | |
17015 | (setq m2 (+ m dn) y2 y) | |
17016 | (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) | |
17017 | (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) | |
17018 | (while (< n2 cday) | |
17019 | (setq n1 n2 m m2 y y2) | |
17020 | (setq m2 (+ m dn) y2 y) | |
17021 | (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) | |
17022 | (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) | |
17023 | ||
48aaad2d CD |
17024 | (if org-agenda-repeating-timestamp-show-all |
17025 | (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1) | |
17026 | (if (= cday n1) n1 n2))))) | |
a3fbe8c4 CD |
17027 | |
17028 | (defun org-date-to-gregorian (date) | |
17029 | "Turn any specification of DATE into a gregorian date for the calendar." | |
17030 | (cond ((integerp date) (calendar-gregorian-from-absolute date)) | |
17031 | ((and (listp date) (= (length date) 3)) date) | |
17032 | ((stringp date) | |
17033 | (setq date (org-parse-time-string date)) | |
17034 | (list (nth 4 date) (nth 3 date) (nth 5 date))) | |
17035 | ((listp date) | |
17036 | (list (nth 4 date) (nth 3 date) (nth 5 date))))) | |
17037 | ||
d3f4dbe8 CD |
17038 | (defun org-parse-time-string (s &optional nodefault) |
17039 | "Parse the standard Org-mode time string. | |
17040 | This should be a lot faster than the normal `parse-time-string'. | |
17041 | If time is not given, defaults to 0:00. However, with optional NODEFAULT, | |
17042 | hour and minute fields will be nil if not given." | |
b38c6895 | 17043 | (if (string-match org-ts-regexp0 s) |
d3f4dbe8 CD |
17044 | (list 0 |
17045 | (if (or (match-beginning 8) (not nodefault)) | |
17046 | (string-to-number (or (match-string 8 s) "0"))) | |
17047 | (if (or (match-beginning 7) (not nodefault)) | |
17048 | (string-to-number (or (match-string 7 s) "0"))) | |
17049 | (string-to-number (match-string 4 s)) | |
17050 | (string-to-number (match-string 3 s)) | |
17051 | (string-to-number (match-string 2 s)) | |
17052 | nil nil nil) | |
17053 | (make-list 9 0))) | |
891f4676 | 17054 | |
d3f4dbe8 CD |
17055 | (defun org-timestamp-up (&optional arg) |
17056 | "Increase the date item at the cursor by one. | |
17057 | If the cursor is on the year, change the year. If it is on the month or | |
17058 | the day, change that. | |
17059 | With prefix ARG, change by that many units." | |
17060 | (interactive "p") | |
17061 | (org-timestamp-change (prefix-numeric-value arg))) | |
891f4676 | 17062 | |
d3f4dbe8 CD |
17063 | (defun org-timestamp-down (&optional arg) |
17064 | "Decrease the date item at the cursor by one. | |
17065 | If the cursor is on the year, change the year. If it is on the month or | |
17066 | the day, change that. | |
17067 | With prefix ARG, change by that many units." | |
17068 | (interactive "p") | |
17069 | (org-timestamp-change (- (prefix-numeric-value arg)))) | |
791d856f | 17070 | |
d3f4dbe8 CD |
17071 | (defun org-timestamp-up-day (&optional arg) |
17072 | "Increase the date in the time stamp by one day. | |
17073 | With prefix ARG, change that many days." | |
17074 | (interactive "p") | |
17075 | (if (and (not (org-at-timestamp-p t)) | |
17076 | (org-on-heading-p)) | |
17077 | (org-todo 'up) | |
17078 | (org-timestamp-change (prefix-numeric-value arg) 'day))) | |
891f4676 | 17079 | |
d3f4dbe8 CD |
17080 | (defun org-timestamp-down-day (&optional arg) |
17081 | "Decrease the date in the time stamp by one day. | |
17082 | With prefix ARG, change that many days." | |
17083 | (interactive "p") | |
17084 | (if (and (not (org-at-timestamp-p t)) | |
17085 | (org-on-heading-p)) | |
17086 | (org-todo 'down) | |
17087 | (org-timestamp-change (- (prefix-numeric-value arg)) 'day))) | |
891f4676 | 17088 | |
d3f4dbe8 CD |
17089 | (defsubst org-pos-in-match-range (pos n) |
17090 | (and (match-beginning n) | |
17091 | (<= (match-beginning n) pos) | |
17092 | (>= (match-end n) pos))) | |
17093 | ||
17094 | (defun org-at-timestamp-p (&optional inactive-ok) | |
17095 | "Determine if the cursor is in or at a timestamp." | |
634a7d0b | 17096 | (interactive) |
d3f4dbe8 CD |
17097 | (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) |
17098 | (pos (point)) | |
17099 | (ans (or (looking-at tsr) | |
17100 | (save-excursion | |
17101 | (skip-chars-backward "^[<\n\r\t") | |
15841868 | 17102 | (if (> (point) (point-min)) (backward-char 1)) |
d3f4dbe8 CD |
17103 | (and (looking-at tsr) |
17104 | (> (- (match-end 0) pos) -1)))))) | |
03f3cf35 JW |
17105 | (and ans |
17106 | (boundp 'org-ts-what) | |
d3f4dbe8 CD |
17107 | (setq org-ts-what |
17108 | (cond | |
03f3cf35 JW |
17109 | ((= pos (match-beginning 0)) 'bracket) |
17110 | ((= pos (1- (match-end 0))) 'bracket) | |
d3f4dbe8 CD |
17111 | ((org-pos-in-match-range pos 2) 'year) |
17112 | ((org-pos-in-match-range pos 3) 'month) | |
17113 | ((org-pos-in-match-range pos 7) 'hour) | |
17114 | ((org-pos-in-match-range pos 8) 'minute) | |
17115 | ((or (org-pos-in-match-range pos 4) | |
17116 | (org-pos-in-match-range pos 5)) 'day) | |
5152b597 CD |
17117 | ((and (> pos (or (match-end 8) (match-end 5))) |
17118 | (< pos (match-end 0))) | |
17119 | (- pos (or (match-end 8) (match-end 5)))) | |
d3f4dbe8 CD |
17120 | (t 'day)))) |
17121 | ans)) | |
891f4676 | 17122 | |
03f3cf35 JW |
17123 | (defun org-toggle-timestamp-type () |
17124 | "" | |
17125 | (interactive) | |
17126 | (when (org-at-timestamp-p t) | |
17127 | (save-excursion | |
17128 | (goto-char (match-beginning 0)) | |
17129 | (insert (if (equal (char-after) ?<) "[" "<")) (delete-char 1) | |
17130 | (goto-char (1- (match-end 0))) | |
17131 | (insert (if (equal (char-after) ?>) "]" ">")) (delete-char 1)) | |
17132 | (message "Timestamp is now %sactive" | |
17133 | (if (equal (char-before) ?>) "in" "")))) | |
17134 | ||
d3f4dbe8 CD |
17135 | (defun org-timestamp-change (n &optional what) |
17136 | "Change the date in the time stamp at point. | |
17137 | The date will be changed by N times WHAT. WHAT can be `day', `month', | |
17138 | `year', `minute', `second'. If WHAT is not given, the cursor position | |
17139 | in the timestamp determines what will be changed." | |
17140 | (let ((pos (point)) | |
17141 | with-hm inactive | |
17142 | org-ts-what | |
a3fbe8c4 | 17143 | extra |
d3f4dbe8 CD |
17144 | ts time time0) |
17145 | (if (not (org-at-timestamp-p t)) | |
17146 | (error "Not at a timestamp")) | |
03f3cf35 JW |
17147 | (if (and (not what) (eq org-ts-what 'bracket)) |
17148 | (org-toggle-timestamp-type) | |
17149 | (if (and (not what) (not (eq org-ts-what 'day)) | |
17150 | org-display-custom-times | |
17151 | (get-text-property (point) 'display) | |
17152 | (not (get-text-property (1- (point)) 'display))) | |
17153 | (setq org-ts-what 'day)) | |
17154 | (setq org-ts-what (or what org-ts-what) | |
17155 | inactive (= (char-after (match-beginning 0)) ?\[) | |
17156 | ts (match-string 0)) | |
17157 | (replace-match "") | |
17158 | (if (string-match | |
17159 | "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( [-+][0-9]+[dwmy]\\)*\\)[]>]" | |
17160 | ts) | |
17161 | (setq extra (match-string 1 ts))) | |
17162 | (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) | |
17163 | (setq with-hm t)) | |
17164 | (setq time0 (org-parse-time-string ts)) | |
17165 | (setq time | |
17166 | (encode-time (or (car time0) 0) | |
17167 | (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) | |
17168 | (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) | |
17169 | (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) | |
17170 | (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) | |
17171 | (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) | |
17172 | (nthcdr 6 time0))) | |
17173 | (when (integerp org-ts-what) | |
17174 | (setq extra (org-modify-ts-extra extra org-ts-what n))) | |
17175 | (if (eq what 'calendar) | |
17176 | (let ((cal-date (org-get-date-from-calendar))) | |
17177 | (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month | |
17178 | (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day | |
17179 | (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year | |
17180 | (setcar time0 (or (car time0) 0)) | |
17181 | (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) | |
17182 | (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) | |
17183 | (setq time (apply 'encode-time time0)))) | |
17184 | (setq org-last-changed-timestamp | |
17185 | (org-insert-time-stamp time with-hm inactive nil nil extra)) | |
17186 | (org-clock-update-time-maybe) | |
17187 | (goto-char pos) | |
17188 | ;; Try to recenter the calendar window, if any | |
17189 | (if (and org-calendar-follow-timestamp-change | |
17190 | (get-buffer-window "*Calendar*" t) | |
17191 | (memq org-ts-what '(day month year))) | |
17192 | (org-recenter-calendar (time-to-days time)))))) | |
891f4676 | 17193 | |
15841868 | 17194 | ;; FIXME: does not yet work for lead times |
b38c6895 | 17195 | (defun org-modify-ts-extra (s pos n) |
15841868 | 17196 | "Change the different parts of the lead-time and repeat fields in timestamp." |
b38c6895 CD |
17197 | (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) |
17198 | ng h m new) | |
17199 | (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( \\+\\([0-9]+\\)\\([dmwy]\\)\\)?" s) | |
17200 | (cond | |
17201 | ((or (org-pos-in-match-range pos 2) | |
17202 | (org-pos-in-match-range pos 3)) | |
17203 | (setq m (string-to-number (match-string 3 s)) | |
17204 | h (string-to-number (match-string 2 s))) | |
17205 | (if (org-pos-in-match-range pos 2) | |
17206 | (setq h (+ h n)) | |
17207 | (setq m (+ m n))) | |
17208 | (if (< m 0) (setq m (+ m 60) h (1- h))) | |
17209 | (if (> m 59) (setq m (- m 60) h (1+ h))) | |
17210 | (setq h (min 24 (max 0 h))) | |
17211 | (setq ng 1 new (format "-%02d:%02d" h m))) | |
17212 | ((org-pos-in-match-range pos 6) | |
17213 | (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) | |
17214 | ((org-pos-in-match-range pos 5) | |
17215 | (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))) | |
fbe6c10d | 17216 | |
b38c6895 CD |
17217 | (when ng |
17218 | (setq s (concat | |
17219 | (substring s 0 (match-beginning ng)) | |
17220 | new | |
17221 | (substring s (match-end ng)))))) | |
17222 | s)) | |
17223 | ||
d3f4dbe8 CD |
17224 | (defun org-recenter-calendar (date) |
17225 | "If the calendar is visible, recenter it to DATE." | |
17226 | (let* ((win (selected-window)) | |
17227 | (cwin (get-buffer-window "*Calendar*" t)) | |
17228 | (calendar-move-hook nil)) | |
17229 | (when cwin | |
17230 | (select-window cwin) | |
17231 | (calendar-goto-date (if (listp date) date | |
17232 | (calendar-gregorian-from-absolute date))) | |
17233 | (select-window win)))) | |
891f4676 | 17234 | |
d3f4dbe8 CD |
17235 | (defun org-goto-calendar (&optional arg) |
17236 | "Go to the Emacs calendar at the current date. | |
17237 | If there is a time stamp in the current line, go to that date. | |
17238 | A prefix ARG can be used to force the current date." | |
17239 | (interactive "P") | |
17240 | (let ((tsr org-ts-regexp) diff | |
17241 | (calendar-move-hook nil) | |
17242 | (view-calendar-holidays-initially nil) | |
17243 | (view-diary-entries-initially nil)) | |
17244 | (if (or (org-at-timestamp-p) | |
17245 | (save-excursion | |
17246 | (beginning-of-line 1) | |
17247 | (looking-at (concat ".*" tsr)))) | |
17248 | (let ((d1 (time-to-days (current-time))) | |
17249 | (d2 (time-to-days | |
17250 | (org-time-string-to-time (match-string 1))))) | |
17251 | (setq diff (- d2 d1)))) | |
17252 | (calendar) | |
17253 | (calendar-goto-today) | |
17254 | (if (and diff (not arg)) (calendar-forward-day diff)))) | |
634a7d0b | 17255 | |
03f3cf35 JW |
17256 | (defun org-get-date-from-calendar () |
17257 | "Return a list (month day year) of date at point in calendar." | |
17258 | (with-current-buffer "*Calendar*" | |
17259 | (save-match-data | |
17260 | (calendar-cursor-to-date)))) | |
17261 | ||
d3f4dbe8 CD |
17262 | (defun org-date-from-calendar () |
17263 | "Insert time stamp corresponding to cursor date in *Calendar* buffer. | |
17264 | If there is already a time stamp at the cursor position, update it." | |
891f4676 | 17265 | (interactive) |
03f3cf35 JW |
17266 | (if (org-at-timestamp-p t) |
17267 | (org-timestamp-change 0 'calendar) | |
17268 | (let ((cal-date (org-get-date-from-calendar))) | |
17269 | (org-insert-time-stamp | |
17270 | (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) | |
891f4676 | 17271 | |
15841868 | 17272 | ;; Make appt aware of appointments from the agenda |
03f3cf35 | 17273 | ;;;###autoload |
15841868 JW |
17274 | (defun org-agenda-to-appt (&optional filter) |
17275 | "Activate appointments found in `org-agenda-files'. | |
17276 | When prefixed, prompt for a regular expression and use it as a | |
17277 | filter: only add entries if they match this regular expression. | |
17278 | ||
17279 | FILTER can be a string. In this case, use this string as a | |
17280 | regular expression to filter results. | |
17281 | ||
17282 | FILTER can also be an alist, with the car of each cell being | |
17283 | either 'headline or 'category. For example: | |
17284 | ||
17285 | '((headline \"IMPORTANT\") | |
17286 | (category \"Work\")) | |
17287 | ||
17288 | will only add headlines containing IMPORTANT or headlines | |
17289 | belonging to the category \"Work\"." | |
17290 | (interactive "P") | |
03f3cf35 | 17291 | (require 'calendar) |
15841868 JW |
17292 | (if (equal filter '(4)) |
17293 | (setq filter (read-from-minibuffer "Regexp filter: "))) | |
03f3cf35 | 17294 | (let* ((cnt 0) ; count added events |
fbe6c10d | 17295 | (today (org-date-to-gregorian |
15841868 | 17296 | (time-to-days (current-time)))) |
03f3cf35 JW |
17297 | (files (org-agenda-files)) entries file) |
17298 | ;; Get all entries which may contain an appt | |
15841868 | 17299 | (while (setq file (pop files)) |
fbe6c10d CD |
17300 | (setq entries |
17301 | (append entries | |
17302 | (org-agenda-get-day-entries | |
17303 | file today | |
03f3cf35 | 17304 | :timestamp :scheduled :deadline)))) |
15841868 | 17305 | (setq entries (delq nil entries)) |
03f3cf35 | 17306 | ;; Map thru entries and find if they pass thru the filter |
fbe6c10d | 17307 | (mapc |
15841868 JW |
17308 | (lambda(x) |
17309 | (let* ((evt (org-trim (get-text-property 1 'txt x))) | |
17310 | (cat (get-text-property 1 'org-category x)) | |
17311 | (tod (get-text-property 1 'time-of-day x)) | |
03f3cf35 JW |
17312 | (ok (or (null filter) |
17313 | (and (stringp filter) (string-match filter evt)) | |
17314 | (and (listp filter) | |
fbe6c10d | 17315 | (or (string-match |
15841868 | 17316 | (cadr (assoc 'category filter)) cat) |
fbe6c10d | 17317 | (string-match |
15841868 | 17318 | (cadr (assoc 'headline filter)) evt)))))) |
03f3cf35 JW |
17319 | ;; FIXME Shall we remove text-properties for the appt text? |
17320 | ;; (setq evt (set-text-properties 0 (length evt) nil evt)) | |
15841868 JW |
17321 | (when (and ok tod) |
17322 | (setq tod (number-to-string tod) | |
fbe6c10d | 17323 | tod (when (string-match |
15841868 JW |
17324 | "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)" tod) |
17325 | (concat (match-string 1 tod) ":" | |
17326 | (match-string 2 tod)))) | |
03f3cf35 JW |
17327 | (appt-add tod evt) |
17328 | (setq cnt (1+ cnt))))) entries) | |
17329 | (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))) | |
15841868 | 17330 | |
d3f4dbe8 | 17331 | ;;; The clock for measuring work time. |
891f4676 | 17332 | |
a3fbe8c4 CD |
17333 | (defvar org-mode-line-string "") |
17334 | (put 'org-mode-line-string 'risky-local-variable t) | |
17335 | ||
17336 | (defvar org-mode-line-timer nil) | |
17337 | (defvar org-clock-heading "") | |
17338 | (defvar org-clock-start-time "") | |
17339 | ||
17340 | (defun org-update-mode-line () | |
17341 | (let* ((delta (- (time-to-seconds (current-time)) | |
17342 | (time-to-seconds org-clock-start-time))) | |
17343 | (h (floor delta 3600)) | |
17344 | (m (floor (- delta (* 3600 h)) 60))) | |
17345 | (setq org-mode-line-string | |
17346 | (propertize (format "-[%d:%02d (%s)]" h m org-clock-heading) | |
17347 | 'help-echo "Org-mode clock is running")) | |
17348 | (force-mode-line-update))) | |
17349 | ||
d3f4dbe8 CD |
17350 | (defvar org-clock-marker (make-marker) |
17351 | "Marker recording the last clock-in.") | |
a3fbe8c4 CD |
17352 | (defvar org-clock-mode-line-entry nil |
17353 | "Information for the modeline about the running clock.") | |
d3f4dbe8 CD |
17354 | |
17355 | (defun org-clock-in () | |
17356 | "Start the clock on the current item. | |
17357 | If necessary, clock-out of the currently active clock." | |
891f4676 | 17358 | (interactive) |
d3f4dbe8 CD |
17359 | (org-clock-out t) |
17360 | (let (ts) | |
17361 | (save-excursion | |
17362 | (org-back-to-heading t) | |
a3fbe8c4 CD |
17363 | (if (looking-at org-todo-line-regexp) |
17364 | (setq org-clock-heading (match-string 3)) | |
17365 | (setq org-clock-heading "???")) | |
17366 | (setq org-clock-heading (propertize org-clock-heading 'face nil)) | |
15841868 JW |
17367 | (org-clock-find-position) |
17368 | ||
d3f4dbe8 CD |
17369 | (insert "\n") (backward-char 1) |
17370 | (indent-relative) | |
17371 | (insert org-clock-string " ") | |
a3fbe8c4 | 17372 | (setq org-clock-start-time (current-time)) |
d3f4dbe8 CD |
17373 | (setq ts (org-insert-time-stamp (current-time) 'with-hm 'inactive)) |
17374 | (move-marker org-clock-marker (point) (buffer-base-buffer)) | |
a3fbe8c4 CD |
17375 | (or global-mode-string (setq global-mode-string '(""))) |
17376 | (or (memq 'org-mode-line-string global-mode-string) | |
17377 | (setq global-mode-string | |
17378 | (append global-mode-string '(org-mode-line-string)))) | |
17379 | (org-update-mode-line) | |
17380 | (setq org-mode-line-timer (run-with-timer 60 60 'org-update-mode-line)) | |
d3f4dbe8 | 17381 | (message "Clock started at %s" ts)))) |
891f4676 | 17382 | |
15841868 JW |
17383 | (defun org-clock-find-position () |
17384 | "Find the location where the next clock line should be inserted." | |
17385 | (org-back-to-heading t) | |
17386 | (catch 'exit | |
17387 | (let ((beg (point-at-bol 2)) (end (progn (outline-next-heading) (point))) | |
17388 | (re (concat "^[ \t]*" org-clock-string)) | |
17389 | (cnt 0) | |
17390 | first last) | |
17391 | (goto-char beg) | |
17392 | (when (eobp) (newline) (setq end (max (point) end))) | |
17393 | (when (re-search-forward "^[ \t]*:CLOCK:" end t) | |
17394 | ;; we seem to have a CLOCK drawer, so go there. | |
17395 | (beginning-of-line 2) | |
17396 | (throw 'exit t)) | |
17397 | ;; Lets count the CLOCK lines | |
17398 | (goto-char beg) | |
17399 | (while (re-search-forward re end t) | |
17400 | (setq first (or first (match-beginning 0)) | |
17401 | last (match-beginning 0) | |
17402 | cnt (1+ cnt))) | |
17403 | (when (and (integerp org-clock-into-drawer) | |
17404 | (>= (1+ cnt) org-clock-into-drawer)) | |
17405 | ;; Wrap current entries into a new drawer | |
17406 | (goto-char last) | |
17407 | (beginning-of-line 2) | |
17408 | (if (org-at-item-p) (org-end-of-item)) | |
17409 | (insert ":END:\n") | |
17410 | (beginning-of-line 0) | |
17411 | (org-indent-line-function) | |
17412 | (goto-char first) | |
17413 | (insert ":CLOCK:\n") | |
17414 | (beginning-of-line 0) | |
17415 | (org-indent-line-function) | |
17416 | (org-flag-drawer t) | |
17417 | (beginning-of-line 2) | |
17418 | (throw 'exit nil)) | |
17419 | ||
17420 | (goto-char beg) | |
17421 | (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) | |
17422 | (not (equal (match-string 1) org-clock-string))) | |
17423 | ;; Planning info, skip to after it | |
17424 | (beginning-of-line 2) | |
17425 | (or (bolp) (newline))) | |
17426 | (when (eq t org-clock-into-drawer) | |
17427 | (insert ":CLOCK:\n:END:\n") | |
17428 | (beginning-of-line -1) | |
17429 | (org-indent-line-function) | |
17430 | (org-flag-drawer t) | |
17431 | (beginning-of-line 2) | |
17432 | (org-indent-line-function))))) | |
17433 | ||
d3f4dbe8 CD |
17434 | (defun org-clock-out (&optional fail-quietly) |
17435 | "Stop the currently running clock. | |
17436 | If there is no running clock, throw an error, unless FAIL-QUIETLY is set." | |
17437 | (interactive) | |
17438 | (catch 'exit | |
17439 | (if (not (marker-buffer org-clock-marker)) | |
17440 | (if fail-quietly (throw 'exit t) (error "No active clock"))) | |
17441 | (let (ts te s h m) | |
17442 | (save-excursion | |
17443 | (set-buffer (marker-buffer org-clock-marker)) | |
17444 | (goto-char org-clock-marker) | |
17445 | (beginning-of-line 1) | |
17446 | (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) | |
17447 | (equal (match-string 1) org-clock-string)) | |
17448 | (setq ts (match-string 2)) | |
17449 | (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) | |
b38c6895 CD |
17450 | (goto-char (match-end 0)) |
17451 | (delete-region (point) (point-at-eol)) | |
d3f4dbe8 CD |
17452 | (insert "--") |
17453 | (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive)) | |
17454 | (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te))) | |
17455 | (time-to-seconds (apply 'encode-time (org-parse-time-string ts)))) | |
17456 | h (floor (/ s 3600)) | |
17457 | s (- s (* 3600 h)) | |
17458 | m (floor (/ s 60)) | |
17459 | s (- s (* 60 s))) | |
17460 | (insert " => " (format "%2d:%02d" h m)) | |
17461 | (move-marker org-clock-marker nil) | |
15841868 JW |
17462 | (let* ((logging (save-match-data (org-entry-get nil "LOGGING" t))) |
17463 | (org-log-done (org-parse-local-options logging 'org-log-done)) | |
17464 | (org-log-repeat (org-parse-local-options logging 'org-log-repeat))) | |
17465 | (org-add-log-maybe 'clock-out)) | |
a3fbe8c4 CD |
17466 | (when org-mode-line-timer |
17467 | (cancel-timer org-mode-line-timer) | |
17468 | (setq org-mode-line-timer nil)) | |
17469 | (setq global-mode-string | |
17470 | (delq 'org-mode-line-string global-mode-string)) | |
17471 | (force-mode-line-update) | |
d3f4dbe8 | 17472 | (message "Clock stopped at %s after HH:MM = %d:%02d" te h m))))) |
891f4676 | 17473 | |
d3f4dbe8 CD |
17474 | (defun org-clock-cancel () |
17475 | "Cancel the running clock be removing the start timestamp." | |
17476 | (interactive) | |
17477 | (if (not (marker-buffer org-clock-marker)) | |
17478 | (error "No active clock")) | |
17479 | (save-excursion | |
17480 | (set-buffer (marker-buffer org-clock-marker)) | |
17481 | (goto-char org-clock-marker) | |
17482 | (delete-region (1- (point-at-bol)) (point-at-eol))) | |
17483 | (message "Clock canceled")) | |
891f4676 | 17484 | |
15841868 JW |
17485 | (defun org-clock-goto (&optional delete-windows) |
17486 | "Go to the currently clocked-in entry." | |
17487 | (interactive "P") | |
17488 | (if (not (marker-buffer org-clock-marker)) | |
17489 | (error "No active clock")) | |
17490 | (switch-to-buffer-other-window | |
17491 | (marker-buffer org-clock-marker)) | |
17492 | (if delete-windows (delete-other-windows)) | |
17493 | (goto-char org-clock-marker) | |
17494 | (org-show-entry) | |
17495 | (org-back-to-heading) | |
17496 | (recenter)) | |
17497 | ||
d3f4dbe8 CD |
17498 | (defvar org-clock-file-total-minutes nil |
17499 | "Holds the file total time in minutes, after a call to `org-clock-sum'.") | |
17500 | (make-variable-buffer-local 'org-clock-file-total-minutes) | |
e0e66b8e | 17501 | |
d3f4dbe8 CD |
17502 | (defun org-clock-sum (&optional tstart tend) |
17503 | "Sum the times for each subtree. | |
17504 | Puts the resulting times in minutes as a text property on each headline." | |
17505 | (interactive) | |
17506 | (let* ((bmp (buffer-modified-p)) | |
17507 | (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" | |
17508 | org-clock-string | |
b38c6895 | 17509 | "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) |
d3f4dbe8 CD |
17510 | (lmax 30) |
17511 | (ltimes (make-vector lmax 0)) | |
17512 | (t1 0) | |
17513 | (level 0) | |
17514 | ts te dt | |
17515 | time) | |
17516 | (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) | |
17517 | (save-excursion | |
17518 | (goto-char (point-max)) | |
17519 | (while (re-search-backward re nil t) | |
b38c6895 CD |
17520 | (cond |
17521 | ((match-end 2) | |
17522 | ;; Two time stamps | |
17523 | (setq ts (match-string 2) | |
17524 | te (match-string 3) | |
17525 | ts (time-to-seconds | |
17526 | (apply 'encode-time (org-parse-time-string ts))) | |
17527 | te (time-to-seconds | |
17528 | (apply 'encode-time (org-parse-time-string te))) | |
17529 | ts (if tstart (max ts tstart) ts) | |
17530 | te (if tend (min te tend) te) | |
17531 | dt (- te ts) | |
17532 | t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1))) | |
17533 | ((match-end 4) | |
17534 | ;; A naket time | |
17535 | (setq t1 (+ t1 (string-to-number (match-string 5)) | |
17536 | (* 60 (string-to-number (match-string 4)))))) | |
17537 | (t ;; A headline | |
d3f4dbe8 CD |
17538 | (setq level (- (match-end 1) (match-beginning 1))) |
17539 | (when (or (> t1 0) (> (aref ltimes level) 0)) | |
17540 | (loop for l from 0 to level do | |
17541 | (aset ltimes l (+ (aref ltimes l) t1))) | |
17542 | (setq t1 0 time (aref ltimes level)) | |
17543 | (loop for l from level to (1- lmax) do | |
17544 | (aset ltimes l 0)) | |
17545 | (goto-char (match-beginning 0)) | |
b38c6895 | 17546 | (put-text-property (point) (point-at-eol) :org-clock-minutes time))))) |
d3f4dbe8 CD |
17547 | (setq org-clock-file-total-minutes (aref ltimes 0))) |
17548 | (set-buffer-modified-p bmp))) | |
891f4676 | 17549 | |
d3f4dbe8 CD |
17550 | (defun org-clock-display (&optional total-only) |
17551 | "Show subtree times in the entire buffer. | |
17552 | If TOTAL-ONLY is non-nil, only show the total time for the entire file | |
17553 | in the echo area." | |
17554 | (interactive) | |
17555 | (org-remove-clock-overlays) | |
17556 | (let (time h m p) | |
17557 | (org-clock-sum) | |
17558 | (unless total-only | |
891f4676 | 17559 | (save-excursion |
d3f4dbe8 | 17560 | (goto-char (point-min)) |
15841868 JW |
17561 | (while (or (and (equal (setq p (point)) (point-min)) |
17562 | (get-text-property p :org-clock-minutes)) | |
17563 | (setq p (next-single-property-change | |
17564 | (point) :org-clock-minutes))) | |
d3f4dbe8 CD |
17565 | (goto-char p) |
17566 | (when (setq time (get-text-property p :org-clock-minutes)) | |
17567 | (org-put-clock-overlay time (funcall outline-level)))) | |
17568 | (setq h (/ org-clock-file-total-minutes 60) | |
17569 | m (- org-clock-file-total-minutes (* 60 h))) | |
17570 | ;; Arrange to remove the overlays upon next change. | |
17571 | (when org-remove-highlights-with-change | |
17572 | (org-add-hook 'before-change-functions 'org-remove-clock-overlays | |
17573 | nil 'local)))) | |
17574 | (message "Total file time: %d:%02d (%d hours and %d minutes)" h m h m))) | |
891f4676 | 17575 | |
d3f4dbe8 CD |
17576 | (defvar org-clock-overlays nil) |
17577 | (make-variable-buffer-local 'org-clock-overlays) | |
891f4676 | 17578 | |
d3f4dbe8 CD |
17579 | (defun org-put-clock-overlay (time &optional level) |
17580 | "Put an overlays on the current line, displaying TIME. | |
17581 | If LEVEL is given, prefix time with a corresponding number of stars. | |
17582 | This creates a new overlay and stores it in `org-clock-overlays', so that it | |
17583 | will be easy to remove." | |
17584 | (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h))) | |
17585 | (l (if level (org-get-legal-level level 0) 0)) | |
17586 | (off 0) | |
17587 | ov tx) | |
17588 | (move-to-column c) | |
17589 | (unless (eolp) (skip-chars-backward "^ \t")) | |
17590 | (skip-chars-backward " \t") | |
17591 | (setq ov (org-make-overlay (1- (point)) (point-at-eol)) | |
17592 | tx (concat (buffer-substring (1- (point)) (point)) | |
17593 | (make-string (+ off (max 0 (- c (current-column)))) ?.) | |
17594 | (org-add-props (format "%s %2d:%02d%s" | |
17595 | (make-string l ?*) h m | |
17596 | (make-string (- 10 l) ?\ )) | |
17597 | '(face secondary-selection)) | |
17598 | "")) | |
17599 | (if (not (featurep 'xemacs)) | |
17600 | (org-overlay-put ov 'display tx) | |
17601 | (org-overlay-put ov 'invisible t) | |
17602 | (org-overlay-put ov 'end-glyph (make-glyph tx))) | |
17603 | (push ov org-clock-overlays))) | |
891f4676 | 17604 | |
d3f4dbe8 CD |
17605 | (defun org-remove-clock-overlays (&optional beg end noremove) |
17606 | "Remove the occur highlights from the buffer. | |
17607 | BEG and END are ignored. If NOREMOVE is nil, remove this function | |
17608 | from the `before-change-functions' in the current buffer." | |
634a7d0b | 17609 | (interactive) |
d3f4dbe8 CD |
17610 | (unless org-inhibit-highlight-removal |
17611 | (mapc 'org-delete-overlay org-clock-overlays) | |
17612 | (setq org-clock-overlays nil) | |
17613 | (unless noremove | |
17614 | (remove-hook 'before-change-functions | |
17615 | 'org-remove-clock-overlays 'local)))) | |
891f4676 | 17616 | |
d3f4dbe8 CD |
17617 | (defun org-clock-out-if-current () |
17618 | "Clock out if the current entry contains the running clock. | |
48aaad2d CD |
17619 | This is used to stop the clock after a TODO entry is marked DONE, |
17620 | and is only done if the variable `org-clock-out-when-done' is not nil." | |
17621 | (when (and org-clock-out-when-done | |
17622 | (member state org-done-keywords) | |
d3f4dbe8 CD |
17623 | (equal (marker-buffer org-clock-marker) (current-buffer)) |
17624 | (< (point) org-clock-marker) | |
17625 | (> (save-excursion (outline-next-heading) (point)) | |
17626 | org-clock-marker)) | |
17627 | ;; Clock out, but don't accept a logging message for this. | |
17628 | (let ((org-log-done (if (and (listp org-log-done) | |
17629 | (member 'clock-out org-log-done)) | |
17630 | '(done) | |
17631 | org-log-done))) | |
17632 | (org-clock-out)))) | |
791d856f | 17633 | |
d3f4dbe8 CD |
17634 | (add-hook 'org-after-todo-state-change-hook |
17635 | 'org-clock-out-if-current) | |
891f4676 | 17636 | |
d3f4dbe8 CD |
17637 | (defun org-check-running-clock () |
17638 | "Check if the current buffer contains the running clock. | |
17639 | If yes, offer to stop it and to save the buffer with the changes." | |
17640 | (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) | |
17641 | (y-or-n-p (format "Clock-out in buffer %s before killing it? " | |
17642 | (buffer-name)))) | |
17643 | (org-clock-out) | |
17644 | (when (y-or-n-p "Save changed buffer?") | |
17645 | (save-buffer)))) | |
17646 | ||
15841868 | 17647 | (defun org-clock-report (&optional arg) |
d3f4dbe8 | 17648 | "Create a table containing a report about clocked time. |
15841868 JW |
17649 | If the cursor is inside an existing clocktable block, then the table |
17650 | will be updated. If not, a new clocktable will be inserted. | |
17651 | When called with a prefix argument, move to the first clock table in the | |
17652 | buffer and update it." | |
17653 | (interactive "P") | |
d3f4dbe8 | 17654 | (org-remove-clock-overlays) |
15841868 JW |
17655 | (when arg (org-find-dblock "clocktable")) |
17656 | (if (org-in-clocktable-p) | |
17657 | (goto-char (org-in-clocktable-p)) | |
d3f4dbe8 | 17658 | (org-create-dblock (list :name "clocktable" |
15841868 | 17659 | :maxlevel 2 :scope 'file))) |
d3f4dbe8 | 17660 | (org-update-dblock)) |
791d856f | 17661 | |
15841868 JW |
17662 | (defun org-in-clocktable-p () |
17663 | "Check if the cursor is in a clocktable." | |
17664 | (let ((pos (point)) start) | |
17665 | (save-excursion | |
17666 | (end-of-line 1) | |
17667 | (and (re-search-backward "^#\\+BEGIN:[ \t]+clocktable" nil t) | |
17668 | (setq start (match-beginning 0)) | |
17669 | (re-search-forward "^#\\+END:.*" nil t) | |
17670 | (>= (match-end 0) pos) | |
17671 | start)))) | |
17672 | ||
d3f4dbe8 CD |
17673 | (defun org-clock-update-time-maybe () |
17674 | "If this is a CLOCK line, update it and return t. | |
17675 | Otherwise, return nil." | |
17676 | (interactive) | |
17677 | (save-excursion | |
891f4676 | 17678 | (beginning-of-line 1) |
d3f4dbe8 CD |
17679 | (skip-chars-forward " \t") |
17680 | (when (looking-at org-clock-string) | |
17681 | (let ((re (concat "[ \t]*" org-clock-string | |
17682 | " *[[<]\\([^]>]+\\)[]>]-+[[<]\\([^]>]+\\)[]>]" | |
17683 | "\\([ \t]*=>.*\\)?")) | |
17684 | ts te h m s) | |
17685 | (if (not (looking-at re)) | |
17686 | nil | |
17687 | (and (match-end 3) (delete-region (match-beginning 3) (match-end 3))) | |
17688 | (end-of-line 1) | |
17689 | (setq ts (match-string 1) | |
17690 | te (match-string 2)) | |
17691 | (setq s (- (time-to-seconds | |
17692 | (apply 'encode-time (org-parse-time-string te))) | |
17693 | (time-to-seconds | |
17694 | (apply 'encode-time (org-parse-time-string ts)))) | |
17695 | h (floor (/ s 3600)) | |
17696 | s (- s (* 3600 h)) | |
17697 | m (floor (/ s 60)) | |
17698 | s (- s (* 60 s))) | |
17699 | (insert " => " (format "%2d:%02d" h m)) | |
17700 | t))))) | |
891f4676 | 17701 | |
d3f4dbe8 CD |
17702 | (defun org-clock-special-range (key &optional time as-strings) |
17703 | "Return two times bordering a special time range. | |
17704 | Key is a symbol specifying the range and can be one of `today', `yesterday', | |
17705 | `thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. | |
17706 | A week starts Monday 0:00 and ends Sunday 24:00. | |
17707 | The range is determined relative to TIME. TIME defaults to the current time. | |
17708 | The return value is a cons cell with two internal times like the ones | |
17709 | returned by `current time' or `encode-time'. if AS-STRINGS is non-nil, | |
17710 | the returned times will be formatted strings." | |
17711 | (let* ((tm (decode-time (or time (current-time)))) | |
17712 | (s 0) (m (nth 1 tm)) (h (nth 2 tm)) | |
17713 | (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) | |
17714 | (dow (nth 6 tm)) | |
17715 | s1 m1 h1 d1 month1 y1 diff ts te fm) | |
17716 | (cond | |
17717 | ((eq key 'today) | |
17718 | (setq h 0 m 0 h1 24 m1 0)) | |
17719 | ((eq key 'yesterday) | |
17720 | (setq d (1- d) h 0 m 0 h1 24 m1 0)) | |
17721 | ((eq key 'thisweek) | |
17722 | (setq diff (if (= dow 0) 6 (1- dow)) | |
17723 | m 0 h 0 d (- d diff) d1 (+ 7 d))) | |
17724 | ((eq key 'lastweek) | |
17725 | (setq diff (+ 7 (if (= dow 0) 6 (1- dow))) | |
17726 | m 0 h 0 d (- d diff) d1 (+ 7 d))) | |
17727 | ((eq key 'thismonth) | |
17728 | (setq d 1 h 0 m 0 d1 1 month1 (1+ month) h1 0 m1 0)) | |
17729 | ((eq key 'lastmonth) | |
17730 | (setq d 1 h 0 m 0 d1 1 month (1- month) month1 (1+ month) h1 0 m1 0)) | |
17731 | ((eq key 'thisyear) | |
17732 | (setq m 0 h 0 d 1 month 1 y1 (1+ y))) | |
17733 | ((eq key 'lastyear) | |
17734 | (setq m 0 h 0 d 1 month 1 y (1- y) y1 (1+ y))) | |
17735 | (t (error "No such time block %s" key))) | |
17736 | (setq ts (encode-time s m h d month y) | |
17737 | te (encode-time (or s1 s) (or m1 m) (or h1 h) | |
17738 | (or d1 d) (or month1 month) (or y1 y))) | |
17739 | (setq fm (cdr org-time-stamp-formats)) | |
17740 | (if as-strings | |
17741 | (cons (format-time-string fm ts) (format-time-string fm te)) | |
17742 | (cons ts te)))) | |
891f4676 | 17743 | |
d3f4dbe8 CD |
17744 | (defun org-dblock-write:clocktable (params) |
17745 | "Write the standard clocktable." | |
15841868 | 17746 | (let ((hlchars '((1 . "*") (2 . "/"))) |
d3f4dbe8 CD |
17747 | (emph nil) |
17748 | (ins (make-marker)) | |
15841868 | 17749 | (total-time nil) |
d3f4dbe8 | 17750 | ipos time h m p level hlc hdl maxlevel |
15841868 JW |
17751 | ts te cc block beg end pos scope tbl tostring multifile) |
17752 | (setq scope (plist-get params :scope) | |
17753 | tostring (plist-get params :tostring) | |
17754 | multifile (plist-get params :multifile) | |
17755 | maxlevel (or (plist-get params :maxlevel) 3) | |
d3f4dbe8 CD |
17756 | emph (plist-get params :emphasize) |
17757 | ts (plist-get params :tstart) | |
17758 | te (plist-get params :tend) | |
17759 | block (plist-get params :block)) | |
17760 | (when block | |
17761 | (setq cc (org-clock-special-range block nil t) | |
17762 | ts (car cc) te (cdr cc))) | |
17763 | (if ts (setq ts (time-to-seconds | |
17764 | (apply 'encode-time (org-parse-time-string ts))))) | |
17765 | (if te (setq te (time-to-seconds | |
17766 | (apply 'encode-time (org-parse-time-string te))))) | |
17767 | (move-marker ins (point)) | |
17768 | (setq ipos (point)) | |
15841868 JW |
17769 | |
17770 | ;; Get the right scope | |
17771 | (setq pos (point)) | |
17772 | (save-restriction | |
17773 | (cond | |
17774 | ((not scope)) | |
17775 | ((eq scope 'file) (widen)) | |
17776 | ((eq scope 'subtree) (org-narrow-to-subtree)) | |
17777 | ((eq scope 'tree) | |
17778 | (while (org-up-heading-safe)) | |
17779 | (org-narrow-to-subtree)) | |
17780 | ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" | |
17781 | (symbol-name scope))) | |
17782 | (setq level (string-to-number (match-string 1 (symbol-name scope)))) | |
17783 | (catch 'exit | |
17784 | (while (org-up-heading-safe) | |
17785 | (looking-at outline-regexp) | |
17786 | (if (<= (org-reduced-level (funcall outline-level)) level) | |
17787 | (throw 'exit nil)))) | |
17788 | (org-narrow-to-subtree)) | |
17789 | ((or (listp scope) (eq scope 'agenda)) | |
17790 | (let* ((files (if (listp scope) scope (org-agenda-files))) | |
17791 | (scope 'agenda) | |
17792 | (p1 (copy-sequence params)) | |
17793 | file) | |
17794 | (plist-put p1 :tostring t) | |
17795 | (plist-put p1 :multifile t) | |
17796 | (plist-put p1 :scope 'file) | |
17797 | (org-prepare-agenda-buffers files) | |
17798 | (while (setq file (pop files)) | |
17799 | (with-current-buffer (find-buffer-visiting file) | |
17800 | (push (org-clocktable-add-file | |
17801 | file (org-dblock-write:clocktable p1)) tbl) | |
17802 | (setq total-time (+ (or total-time 0) | |
17803 | org-clock-file-total-minutes))))))) | |
17804 | (goto-char pos) | |
fbe6c10d | 17805 | |
15841868 JW |
17806 | (unless (eq scope 'agenda) |
17807 | (org-clock-sum ts te) | |
17808 | (goto-char (point-min)) | |
17809 | (while (setq p (next-single-property-change (point) :org-clock-minutes)) | |
17810 | (goto-char p) | |
17811 | (when (setq time (get-text-property p :org-clock-minutes)) | |
17812 | (save-excursion | |
17813 | (beginning-of-line 1) | |
17814 | (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$")) | |
17815 | (setq level (org-reduced-level | |
17816 | (- (match-end 1) (match-beginning 1)))) | |
17817 | (<= level maxlevel)) | |
17818 | (setq hlc (if emph (or (cdr (assoc level hlchars)) "") "") | |
17819 | hdl (match-string 2) | |
17820 | h (/ time 60) | |
17821 | m (- time (* 60 h))) | |
17822 | (if (and (not multifile) (= level 1)) (push "|-" tbl)) | |
17823 | (push (concat | |
17824 | "| " (int-to-string level) "|" hlc hdl hlc " |" | |
17825 | (make-string (1- level) ?|) | |
17826 | hlc (format "%d:%02d" h m) hlc | |
17827 | " |") tbl)))))) | |
17828 | (setq tbl (nreverse tbl)) | |
17829 | (if tostring | |
17830 | (if tbl (mapconcat 'identity tbl "\n") nil) | |
17831 | (goto-char ins) | |
17832 | (insert-before-markers | |
17833 | "Clock summary at [" | |
17834 | (substring | |
17835 | (format-time-string (cdr org-time-stamp-formats)) | |
17836 | 1 -1) | |
17837 | "]." | |
17838 | (if block | |
17839 | (format " Considered range is /%s/." block) | |
17840 | "") | |
17841 | "\n\n" | |
17842 | (if (eq scope 'agenda) "|File" "") | |
17843 | "|L|Headline|Time|\n") | |
17844 | (setq total-time (or total-time org-clock-file-total-minutes) | |
17845 | h (/ total-time 60) | |
17846 | m (- total-time (* 60 h))) | |
17847 | (insert-before-markers | |
17848 | "|-\n|" | |
17849 | (if (eq scope 'agenda) "|" "") | |
fbe6c10d | 17850 | "|" |
15841868 JW |
17851 | "*Total time*| " |
17852 | (format "*%d:%02d*" h m) | |
17853 | "|\n|-\n") | |
17854 | (setq tbl (delq nil tbl)) | |
17855 | (if (and (stringp (car tbl)) (> (length (car tbl)) 1) | |
17856 | (equal (substring (car tbl) 0 2) "|-")) | |
17857 | (pop tbl)) | |
17858 | (insert-before-markers (mapconcat | |
17859 | 'identity (delq nil tbl) | |
17860 | (if (eq scope 'agenda) "\n|-\n" "\n"))) | |
17861 | (backward-delete-char 1) | |
17862 | (goto-char ipos) | |
17863 | (skip-chars-forward "^|") | |
17864 | (org-table-align))))) | |
17865 | ||
17866 | (defun org-clocktable-add-file (file table) | |
17867 | (if table | |
17868 | (let ((lines (org-split-string table "\n")) | |
17869 | (ff (file-name-nondirectory file))) | |
17870 | (mapconcat 'identity | |
17871 | (mapcar (lambda (x) | |
17872 | (if (string-match org-table-dataline-regexp x) | |
17873 | (concat "|" ff x) | |
17874 | x)) | |
17875 | lines) | |
17876 | "\n")))) | |
70a539ca | 17877 | |
d3f4dbe8 CD |
17878 | ;; FIXME: I don't think anybody uses this, ask David |
17879 | (defun org-collect-clock-time-entries () | |
17880 | "Return an internal list with clocking information. | |
17881 | This list has one entry for each CLOCK interval. | |
17882 | FIXME: describe the elements." | |
634a7d0b | 17883 | (interactive) |
d3f4dbe8 CD |
17884 | (let ((re (concat "^[ \t]*" org-clock-string |
17885 | " *\\[\\(.*?\\)\\]--\\[\\(.*?\\)\\]")) | |
17886 | rtn beg end next cont level title total closedp leafp | |
17887 | clockpos titlepos h m donep) | |
17888 | (save-excursion | |
17889 | (org-clock-sum) | |
17890 | (goto-char (point-min)) | |
17891 | (while (re-search-forward re nil t) | |
17892 | (setq clockpos (match-beginning 0) | |
17893 | beg (match-string 1) end (match-string 2) | |
17894 | cont (match-end 0)) | |
17895 | (setq beg (apply 'encode-time (org-parse-time-string beg)) | |
17896 | end (apply 'encode-time (org-parse-time-string end))) | |
17897 | (org-back-to-heading t) | |
17898 | (setq donep (org-entry-is-done-p)) | |
17899 | (setq titlepos (point) | |
17900 | total (or (get-text-property (1+ (point)) :org-clock-minutes) 0) | |
17901 | h (/ total 60) m (- total (* 60 h)) | |
17902 | total (cons h m)) | |
17903 | (looking-at "\\(\\*+\\) +\\(.*\\)") | |
17904 | (setq level (- (match-end 1) (match-beginning 1)) | |
17905 | title (org-match-string-no-properties 2)) | |
17906 | (save-excursion (outline-next-heading) (setq next (point))) | |
17907 | (setq closedp (re-search-forward org-closed-time-regexp next t)) | |
17908 | (goto-char next) | |
17909 | (setq leafp (and (looking-at "^\\*+ ") | |
17910 | (<= (- (match-end 0) (point)) level))) | |
17911 | (push (list beg end clockpos closedp donep | |
17912 | total title titlepos level leafp) | |
17913 | rtn) | |
17914 | (goto-char cont))) | |
17915 | (nreverse rtn))) | |
891f4676 | 17916 | |
d3f4dbe8 | 17917 | ;;;; Agenda, and Diary Integration |
891f4676 | 17918 | |
d3f4dbe8 | 17919 | ;;; Define the Org-agenda-mode |
891f4676 | 17920 | |
d3f4dbe8 CD |
17921 | (defvar org-agenda-mode-map (make-sparse-keymap) |
17922 | "Keymap for `org-agenda-mode'.") | |
64f72ae1 | 17923 | |
d3f4dbe8 CD |
17924 | (defvar org-agenda-menu) ; defined later in this file. |
17925 | (defvar org-agenda-follow-mode nil) | |
17926 | (defvar org-agenda-show-log nil) | |
17927 | (defvar org-agenda-redo-command nil) | |
17928 | (defvar org-agenda-mode-hook nil) | |
17929 | (defvar org-agenda-type nil) | |
17930 | (defvar org-agenda-force-single-file nil) | |
891f4676 | 17931 | |
d3f4dbe8 CD |
17932 | (defun org-agenda-mode () |
17933 | "Mode for time-sorted view on action items in Org-mode files. | |
891f4676 | 17934 | |
d3f4dbe8 | 17935 | The following commands are available: |
891f4676 | 17936 | |
d3f4dbe8 CD |
17937 | \\{org-agenda-mode-map}" |
17938 | (interactive) | |
17939 | (kill-all-local-variables) | |
17940 | (setq org-agenda-undo-list nil | |
17941 | org-agenda-pending-undo-list nil) | |
17942 | (setq major-mode 'org-agenda-mode) | |
28a419dd CD |
17943 | ;; Keep global-font-lock-mode from turning on font-lock-mode |
17944 | (org-set-local 'font-lock-global-modes (list 'not major-mode)) | |
d3f4dbe8 CD |
17945 | (setq mode-name "Org-Agenda") |
17946 | (use-local-map org-agenda-mode-map) | |
17947 | (easy-menu-add org-agenda-menu) | |
17948 | (if org-startup-truncated (setq truncate-lines t)) | |
17949 | (org-add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) | |
17950 | (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) | |
17951 | ;; Make sure properties are removed when copying text | |
17952 | (when (boundp 'buffer-substring-filters) | |
17953 | (org-set-local 'buffer-substring-filters | |
17954 | (cons (lambda (x) | |
17955 | (set-text-properties 0 (length x) nil x) x) | |
17956 | buffer-substring-filters))) | |
17957 | (unless org-agenda-keep-modes | |
17958 | (setq org-agenda-follow-mode org-agenda-start-with-follow-mode | |
17959 | org-agenda-show-log nil)) | |
17960 | (easy-menu-change | |
17961 | '("Agenda") "Agenda Files" | |
17962 | (append | |
17963 | (list | |
17964 | (vector | |
17965 | (if (get 'org-agenda-files 'org-restrict) | |
17966 | "Restricted to single file" | |
17967 | "Edit File List") | |
17968 | '(org-edit-agenda-file-list) | |
17969 | (not (get 'org-agenda-files 'org-restrict))) | |
17970 | "--") | |
17971 | (mapcar 'org-file-menu-entry (org-agenda-files)))) | |
17972 | (org-agenda-set-mode-name) | |
17973 | (apply | |
17974 | (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) | |
17975 | (list 'org-agenda-mode-hook))) | |
891f4676 | 17976 | |
d3f4dbe8 CD |
17977 | (substitute-key-definition 'undo 'org-agenda-undo |
17978 | org-agenda-mode-map global-map) | |
a3fbe8c4 CD |
17979 | (org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto) |
17980 | (org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto) | |
17981 | (org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) | |
17982 | (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) | |
17983 | (org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) | |
17984 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) | |
17985 | (org-defkey org-agenda-mode-map "$" 'org-agenda-archive) | |
17986 | (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) | |
17987 | (org-defkey org-agenda-mode-map " " 'org-agenda-show) | |
17988 | (org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) | |
17989 | (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset) | |
17990 | (org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset) | |
17991 | (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) | |
17992 | (org-defkey org-agenda-mode-map "b" 'org-agenda-tree-to-indirect-buffer) | |
17993 | (org-defkey org-agenda-mode-map "o" 'delete-other-windows) | |
17994 | (org-defkey org-agenda-mode-map "L" 'org-agenda-recenter) | |
17995 | (org-defkey org-agenda-mode-map "t" 'org-agenda-todo) | |
17996 | (org-defkey org-agenda-mode-map "a" 'org-agenda-toggle-archive-tag) | |
17997 | (org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) | |
17998 | (org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) | |
48aaad2d | 17999 | (org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) |
a3fbe8c4 CD |
18000 | (org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) |
18001 | (org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) | |
38f8646b CD |
18002 | (org-defkey org-agenda-mode-map "m" 'org-agenda-month-view) |
18003 | (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) | |
a3fbe8c4 CD |
18004 | (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-date-later) |
18005 | (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) | |
18006 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later) | |
18007 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) | |
18008 | ||
18009 | (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) | |
18010 | (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) | |
18011 | (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) | |
d3f4dbe8 | 18012 | (let ((l '(1 2 3 4 5 6 7 8 9 0))) |
a3fbe8c4 | 18013 | (while l (org-defkey org-agenda-mode-map |
d3f4dbe8 | 18014 | (int-to-string (pop l)) 'digit-argument))) |
891f4676 | 18015 | |
a3fbe8c4 CD |
18016 | (org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) |
18017 | (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) | |
18018 | (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) | |
18019 | (org-defkey org-agenda-mode-map "g" 'org-agenda-toggle-time-grid) | |
18020 | (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) | |
18021 | (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) | |
18022 | (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) | |
18023 | (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) | |
18024 | (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) | |
15841868 | 18025 | (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) |
a3fbe8c4 CD |
18026 | (org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) |
18027 | (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) | |
18028 | (org-defkey org-agenda-mode-map "n" 'next-line) | |
18029 | (org-defkey org-agenda-mode-map "p" 'previous-line) | |
15841868 JW |
18030 | (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) |
18031 | (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) | |
a3fbe8c4 CD |
18032 | (org-defkey org-agenda-mode-map "," 'org-agenda-priority) |
18033 | (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) | |
18034 | (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) | |
18035 | (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) | |
d3f4dbe8 | 18036 | (eval-after-load "calendar" |
a3fbe8c4 | 18037 | '(org-defkey calendar-mode-map org-calendar-to-agenda-key |
d3f4dbe8 | 18038 | 'org-calendar-goto-agenda)) |
a3fbe8c4 | 18039 | (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) |
a3fbe8c4 CD |
18040 | (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon) |
18041 | (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) | |
18042 | (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays) | |
18043 | (org-defkey org-agenda-mode-map "H" 'org-agenda-holidays) | |
15841868 | 18044 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in) |
a3fbe8c4 | 18045 | (org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in) |
15841868 | 18046 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out) |
a3fbe8c4 | 18047 | (org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out) |
15841868 | 18048 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) |
a3fbe8c4 | 18049 | (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) |
15841868 JW |
18050 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) |
18051 | (org-defkey org-agenda-mode-map "J" 'org-clock-goto) | |
a3fbe8c4 CD |
18052 | (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) |
18053 | (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) | |
18054 | (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) | |
18055 | (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) | |
18056 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) | |
18057 | (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) | |
18058 | (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) | |
18059 | (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) | |
38f8646b | 18060 | (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) |
7d58338e | 18061 | |
d3f4dbe8 CD |
18062 | (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) |
18063 | "Local keymap for agenda entries from Org-mode.") | |
ab27a4a0 | 18064 | |
a3fbe8c4 | 18065 | (org-defkey org-agenda-keymap |
d3f4dbe8 | 18066 | (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) |
a3fbe8c4 | 18067 | (org-defkey org-agenda-keymap |
d3f4dbe8 CD |
18068 | (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) |
18069 | (when org-agenda-mouse-1-follows-link | |
a3fbe8c4 | 18070 | (org-defkey org-agenda-keymap [follow-link] 'mouse-face)) |
d3f4dbe8 CD |
18071 | (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" |
18072 | '("Agenda" | |
18073 | ("Agenda Files") | |
18074 | "--" | |
18075 | ["Show" org-agenda-show t] | |
18076 | ["Go To (other window)" org-agenda-goto t] | |
18077 | ["Go To (this window)" org-agenda-switch-to t] | |
18078 | ["Follow Mode" org-agenda-follow-mode | |
18079 | :style toggle :selected org-agenda-follow-mode :active t] | |
18080 | ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] | |
18081 | "--" | |
18082 | ["Cycle TODO" org-agenda-todo t] | |
18083 | ["Archive subtree" org-agenda-archive t] | |
18084 | ["Delete subtree" org-agenda-kill t] | |
18085 | "--" | |
18086 | ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] | |
18087 | ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] | |
18088 | ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] | |
48aaad2d | 18089 | ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)] |
d3f4dbe8 | 18090 | "--" |
38f8646b | 18091 | ("Tags and Properties" |
d3f4dbe8 | 18092 | ["Show all Tags" org-agenda-show-tags t] |
374585c9 CD |
18093 | ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] |
18094 | ["Change tag in region" org-agenda-set-tags (org-region-active-p)] | |
38f8646b CD |
18095 | "--" |
18096 | ["Column View" org-columns t]) | |
d3f4dbe8 CD |
18097 | ("Date/Schedule" |
18098 | ["Schedule" org-agenda-schedule t] | |
18099 | ["Set Deadline" org-agenda-deadline t] | |
18100 | "--" | |
38f8646b CD |
18101 | ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] |
18102 | ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] | |
18103 | ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) | |
15841868 JW |
18104 | ("Clock" |
18105 | ["Clock in" org-agenda-clock-in t] | |
18106 | ["Clock out" org-agenda-clock-out t] | |
18107 | ["Clock cancel" org-agenda-clock-cancel t] | |
18108 | ["Goto running clock" org-clock-goto t]) | |
d3f4dbe8 CD |
18109 | ("Priority" |
18110 | ["Set Priority" org-agenda-priority t] | |
18111 | ["Increase Priority" org-agenda-priority-up t] | |
18112 | ["Decrease Priority" org-agenda-priority-down t] | |
18113 | ["Show Priority" org-agenda-show-priority t]) | |
18114 | ("Calendar/Diary" | |
18115 | ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] | |
18116 | ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] | |
18117 | ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)] | |
18118 | ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)] | |
18119 | ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] | |
18120 | ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] | |
18121 | "--" | |
18122 | ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) | |
18123 | "--" | |
18124 | ("View" | |
18125 | ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) | |
18126 | :style radio :selected (equal org-agenda-ndays 1)] | |
18127 | ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) | |
18128 | :style radio :selected (equal org-agenda-ndays 7)] | |
38f8646b CD |
18129 | ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) |
18130 | :style radio :selected (member org-agenda-ndays '(28 29 30 31))] | |
18131 | ["Year View" org-agenda-year-view :active (org-agenda-check-type nil 'agenda) | |
18132 | :style radio :selected (member org-agenda-ndays '(365 366))] | |
d3f4dbe8 CD |
18133 | "--" |
18134 | ["Show Logbook entries" org-agenda-log-mode | |
18135 | :style toggle :selected org-agenda-show-log :active (org-agenda-check-type nil 'agenda 'timeline)] | |
18136 | ["Include Diary" org-agenda-toggle-diary | |
18137 | :style toggle :selected org-agenda-include-diary :active (org-agenda-check-type nil 'agenda)] | |
18138 | ["Use Time Grid" org-agenda-toggle-time-grid | |
18139 | :style toggle :selected org-agenda-use-time-grid :active (org-agenda-check-type nil 'agenda)]) | |
a3fbe8c4 | 18140 | ["Write view to file" org-write-agenda t] |
d3f4dbe8 CD |
18141 | ["Rebuild buffer" org-agenda-redo t] |
18142 | ["Save all Org-mode Buffers" org-save-all-org-buffers t] | |
18143 | "--" | |
18144 | ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] | |
18145 | "--" | |
18146 | ["Quit" org-agenda-quit t] | |
18147 | ["Exit and Release Buffers" org-agenda-exit t] | |
18148 | )) | |
ab27a4a0 | 18149 | |
d3f4dbe8 CD |
18150 | ;;; Agenda undo |
18151 | ||
18152 | (defvar org-agenda-allow-remote-undo t | |
18153 | "Non-nil means, allow remote undo from the agenda buffer.") | |
18154 | (defvar org-agenda-undo-list nil | |
18155 | "List of undoable operations in the agenda since last refresh.") | |
18156 | (defvar org-agenda-undo-has-started-in nil | |
18157 | "Buffers that have already seen `undo-start' in the current undo sequence.") | |
18158 | (defvar org-agenda-pending-undo-list nil | |
18159 | "In a series of undo commands, this is the list of remaning undo items.") | |
18160 | ||
18161 | (defmacro org-if-unprotected (&rest body) | |
48aaad2d | 18162 | "Execute BODY if there is no `org-protected' text property at point." |
d3f4dbe8 CD |
18163 | (declare (debug t)) |
18164 | `(unless (get-text-property (point) 'org-protected) | |
18165 | ,@body)) | |
18166 | ||
18167 | (defmacro org-with-remote-undo (_buffer &rest _body) | |
18168 | "Execute BODY while recording undo information in two buffers." | |
18169 | (declare (indent 1) (debug t)) | |
18170 | `(let ((_cline (org-current-line)) | |
18171 | (_cmd this-command) | |
18172 | (_buf1 (current-buffer)) | |
18173 | (_buf2 ,_buffer) | |
18174 | (_undo1 buffer-undo-list) | |
18175 | (_undo2 (with-current-buffer ,_buffer buffer-undo-list)) | |
18176 | _c1 _c2) | |
18177 | ,@_body | |
18178 | (when org-agenda-allow-remote-undo | |
18179 | (setq _c1 (org-verify-change-for-undo | |
18180 | _undo1 (with-current-buffer _buf1 buffer-undo-list)) | |
18181 | _c2 (org-verify-change-for-undo | |
18182 | _undo2 (with-current-buffer _buf2 buffer-undo-list))) | |
18183 | (when (or _c1 _c2) | |
18184 | ;; make sure there are undo boundaries | |
18185 | (and _c1 (with-current-buffer _buf1 (undo-boundary))) | |
18186 | (and _c2 (with-current-buffer _buf2 (undo-boundary))) | |
18187 | ;; remember which buffer to undo | |
18188 | (push (list _cmd _cline _buf1 _c1 _buf2 _c2) | |
18189 | org-agenda-undo-list))))) | |
18190 | ||
18191 | (defun org-agenda-undo () | |
18192 | "Undo a remote editing step in the agenda. | |
18193 | This undoes changes both in the agenda buffer and in the remote buffer | |
18194 | that have been changed along." | |
18195 | (interactive) | |
18196 | (or org-agenda-allow-remote-undo | |
18197 | (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo.")) | |
18198 | (if (not (eq this-command last-command)) | |
18199 | (setq org-agenda-undo-has-started-in nil | |
18200 | org-agenda-pending-undo-list org-agenda-undo-list)) | |
18201 | (if (not org-agenda-pending-undo-list) | |
18202 | (error "No further undo information")) | |
18203 | (let* ((entry (pop org-agenda-pending-undo-list)) | |
18204 | buf line cmd rembuf) | |
18205 | (setq cmd (pop entry) line (pop entry)) | |
18206 | (setq rembuf (nth 2 entry)) | |
18207 | (org-with-remote-undo rembuf | |
18208 | (while (bufferp (setq buf (pop entry))) | |
18209 | (if (pop entry) | |
18210 | (with-current-buffer buf | |
18211 | (let ((last-undo-buffer buf) | |
48aaad2d | 18212 | (inhibit-read-only t)) |
d3f4dbe8 CD |
18213 | (unless (memq buf org-agenda-undo-has-started-in) |
18214 | (push buf org-agenda-undo-has-started-in) | |
18215 | (make-local-variable 'pending-undo-list) | |
18216 | (undo-start)) | |
18217 | (while (and pending-undo-list | |
18218 | (listp pending-undo-list) | |
18219 | (not (car pending-undo-list))) | |
18220 | (pop pending-undo-list)) | |
18221 | (undo-more 1)))))) | |
18222 | (goto-line line) | |
18223 | (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) | |
ab27a4a0 | 18224 | |
d3f4dbe8 CD |
18225 | (defun org-verify-change-for-undo (l1 l2) |
18226 | "Verify that a real change occurred between the undo lists L1 and L2." | |
18227 | (while (and l1 (listp l1) (null (car l1))) (pop l1)) | |
18228 | (while (and l2 (listp l2) (null (car l2))) (pop l2)) | |
18229 | (not (eq l1 l2))) | |
891f4676 | 18230 | |
d3f4dbe8 | 18231 | ;;; Agenda dispatch |
64f72ae1 | 18232 | |
d3f4dbe8 CD |
18233 | (defvar org-agenda-restrict nil) |
18234 | (defvar org-agenda-restrict-begin (make-marker)) | |
18235 | (defvar org-agenda-restrict-end (make-marker)) | |
18236 | (defvar org-agenda-last-dispatch-buffer nil) | |
891f4676 | 18237 | |
d3f4dbe8 | 18238 | ;;;###autoload |
03f3cf35 | 18239 | (defun org-agenda (arg &optional keys restriction) |
d3f4dbe8 | 18240 | "Dispatch agenda commands to collect entries to the agenda buffer. |
03f3cf35 | 18241 | Prompts for a command to execute. Any prefix arg will be passed |
d3f4dbe8 | 18242 | on to the selected command. The default selections are: |
15841868 | 18243 | |
d3f4dbe8 CD |
18244 | a Call `org-agenda-list' to display the agenda for current day or week. |
18245 | t Call `org-todo-list' to display the global todo list. | |
18246 | T Call `org-todo-list' to display the global todo list, select only | |
18247 | entries with a specific TODO keyword (the user gets a prompt). | |
18248 | m Call `org-tags-view' to display headlines with tags matching | |
18249 | a condition (the user is prompted for the condition). | |
18250 | M Like `m', but select only TODO entries, no ordinary headlines. | |
48aaad2d | 18251 | L Create a timeline for the current buffer. |
a3fbe8c4 | 18252 | e Export views to associated files. |
891f4676 | 18253 | |
d3f4dbe8 CD |
18254 | More commands can be added by configuring the variable |
18255 | `org-agenda-custom-commands'. In particular, specific tags and TODO keyword | |
18256 | searches can be pre-defined in this way. | |
891f4676 | 18257 | |
d3f4dbe8 | 18258 | If the current buffer is in Org-mode and visiting a file, you can also |
03f3cf35 JW |
18259 | first press `<' once to indicate that the agenda should be temporarily |
18260 | \(until the next use of \\[org-agenda]) restricted to the current file. | |
18261 | Pressing `<' twice means to restrict to the current subtree or region | |
18262 | \(if active)." | |
d3f4dbe8 CD |
18263 | (interactive "P") |
18264 | (catch 'exit | |
03f3cf35 JW |
18265 | (let* ((prefix-descriptions nil) |
18266 | (org-agenda-custom-commands | |
18267 | ;; normalize different versions | |
18268 | (delq nil | |
18269 | (mapcar | |
18270 | (lambda (x) | |
18271 | (cond ((stringp (cdr x)) | |
18272 | (push x prefix-descriptions) | |
18273 | nil) | |
18274 | ((stringp (nth 1 x)) x) | |
18275 | ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) | |
18276 | (t (cons (car x) (cons "" (cdr x)))))) | |
18277 | org-agenda-custom-commands))) | |
18278 | (buf (current-buffer)) | |
d3f4dbe8 | 18279 | (bfn (buffer-file-name (buffer-base-buffer))) |
03f3cf35 | 18280 | entry key type match lprops ans) |
d3f4dbe8 CD |
18281 | ;; Turn off restriction |
18282 | (put 'org-agenda-files 'org-restrict nil) | |
18283 | (setq org-agenda-restrict nil) | |
18284 | (move-marker org-agenda-restrict-begin nil) | |
18285 | (move-marker org-agenda-restrict-end nil) | |
48aaad2d CD |
18286 | ;; Delete old local properties |
18287 | (put 'org-agenda-redo-command 'org-lprops nil) | |
d3f4dbe8 CD |
18288 | ;; Remember where this call originated |
18289 | (setq org-agenda-last-dispatch-buffer (current-buffer)) | |
03f3cf35 JW |
18290 | (unless keys |
18291 | (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) | |
18292 | keys (car ans) | |
18293 | restriction (cdr ans))) | |
18294 | ;; Estabish the restriction, if any | |
18295 | (when restriction | |
18296 | (put 'org-agenda-files 'org-restrict (list bfn)) | |
18297 | (cond | |
18298 | ((eq restriction 'region) | |
18299 | (setq org-agenda-restrict t) | |
18300 | (move-marker org-agenda-restrict-begin (region-beginning)) | |
18301 | (move-marker org-agenda-restrict-end (region-end))) | |
18302 | ((eq restriction 'subtree) | |
18303 | (save-excursion | |
d3f4dbe8 | 18304 | (setq org-agenda-restrict t) |
03f3cf35 JW |
18305 | (org-back-to-heading t) |
18306 | (move-marker org-agenda-restrict-begin (point)) | |
18307 | (move-marker org-agenda-restrict-end | |
18308 | (progn (org-end-of-subtree t))))))) | |
18309 | ||
d3f4dbe8 CD |
18310 | (require 'calendar) ; FIXME: can we avoid this for some commands? |
18311 | ;; For example the todo list should not need it (but does...) | |
18312 | (cond | |
03f3cf35 JW |
18313 | ((setq entry (assoc keys org-agenda-custom-commands)) |
18314 | (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) | |
d3f4dbe8 | 18315 | (progn |
03f3cf35 | 18316 | (setq type (nth 2 entry) match (nth 3 entry) lprops (nth 4 entry)) |
48aaad2d | 18317 | (put 'org-agenda-redo-command 'org-lprops lprops) |
d3f4dbe8 | 18318 | (cond |
a3fbe8c4 CD |
18319 | ((eq type 'agenda) |
18320 | (org-let lprops '(org-agenda-list current-prefix-arg))) | |
18321 | ((eq type 'alltodo) | |
18322 | (org-let lprops '(org-todo-list current-prefix-arg))) | |
18323 | ((eq type 'stuck) | |
18324 | (org-let lprops '(org-agenda-list-stuck-projects | |
18325 | current-prefix-arg))) | |
d3f4dbe8 CD |
18326 | ((eq type 'tags) |
18327 | (org-let lprops '(org-tags-view current-prefix-arg match))) | |
18328 | ((eq type 'tags-todo) | |
18329 | (org-let lprops '(org-tags-view '(4) match))) | |
18330 | ((eq type 'todo) | |
18331 | (org-let lprops '(org-todo-list match))) | |
18332 | ((eq type 'tags-tree) | |
18333 | (org-check-for-org-mode) | |
18334 | (org-let lprops '(org-tags-sparse-tree current-prefix-arg match))) | |
18335 | ((eq type 'todo-tree) | |
18336 | (org-check-for-org-mode) | |
18337 | (org-let lprops | |
18338 | '(org-occur (concat "^" outline-regexp "[ \t]*" | |
18339 | (regexp-quote match) "\\>")))) | |
18340 | ((eq type 'occur-tree) | |
18341 | (org-check-for-org-mode) | |
18342 | (org-let lprops '(org-occur match))) | |
03f3cf35 JW |
18343 | ((functionp type) |
18344 | (org-let lprops '(funcall type match))) | |
d3f4dbe8 CD |
18345 | ((fboundp type) |
18346 | (org-let lprops '(funcall type match))) | |
18347 | (t (error "Invalid custom agenda command type %s" type)))) | |
a3fbe8c4 | 18348 | (org-run-agenda-series (nth 1 entry) (cddr entry)))) |
03f3cf35 JW |
18349 | ((equal keys "C") (customize-variable 'org-agenda-custom-commands)) |
18350 | ((equal keys "a") (call-interactively 'org-agenda-list)) | |
18351 | ((equal keys "t") (call-interactively 'org-todo-list)) | |
18352 | ((equal keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) | |
18353 | ((equal keys "m") (call-interactively 'org-tags-view)) | |
18354 | ((equal keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) | |
18355 | ((equal keys "e") (call-interactively 'org-store-agenda-views)) | |
18356 | ((equal keys "L") | |
18357 | (unless (org-mode-p) | |
d3f4dbe8 | 18358 | (error "This is not an Org-mode file")) |
03f3cf35 JW |
18359 | (unless restriction |
18360 | (put 'org-agenda-files 'org-restrict (list bfn)) | |
18361 | (org-call-with-arg 'org-timeline arg))) | |
18362 | ((equal keys "#") (call-interactively 'org-agenda-list-stuck-projects)) | |
18363 | ((equal keys "/") (call-interactively 'org-occur-in-agenda-files)) | |
18364 | ((equal keys "!") (customize-variable 'org-stuck-projects)) | |
18365 | (t (error "Invalid agenda key")))))) | |
18366 | ||
18367 | (defun org-agenda-get-restriction-and-command (prefix-descriptions) | |
18368 | "The user interface for selecting an agenda command." | |
18369 | (catch 'exit | |
18370 | (let* ((bfn (buffer-file-name (buffer-base-buffer))) | |
18371 | (restrict-ok (and bfn (org-mode-p))) | |
18372 | (region-p (org-region-active-p)) | |
18373 | (custom org-agenda-custom-commands) | |
18374 | (selstring "") | |
fbe6c10d | 18375 | restriction second-time |
03f3cf35 JW |
18376 | c entry key type match prefixes rmheader header-end custom1 desc) |
18377 | (save-window-excursion | |
18378 | (delete-other-windows) | |
18379 | (org-switch-to-buffer-other-window " *Agenda Commands*") | |
18380 | (erase-buffer) | |
18381 | (insert (eval-when-compile | |
18382 | (let ((header | |
18383 | "Press key for an agenda command: < Buffer,subtree/region restriction | |
18384 | -------------------------------- C Configure custom agenda commands | |
18385 | a Agenda for current week or day e Export agenda views | |
18386 | t List of all TODO entries T Entries with special TODO kwd | |
18387 | m Match a TAGS query M Like m, but only TODO entries | |
18388 | L Timeline for current buffer # List stuck projects (!=configure) | |
18389 | / Multi-occur | |
18390 | ") | |
18391 | (start 0)) | |
18392 | (while (string-match | |
18393 | "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" | |
18394 | header start) | |
18395 | (setq start (match-end 0)) | |
18396 | (add-text-properties (match-beginning 2) (match-end 2) | |
18397 | '(face bold) header)) | |
18398 | header))) | |
18399 | (setq header-end (move-marker (make-marker) (point))) | |
18400 | (while t | |
18401 | (setq custom1 custom) | |
18402 | (when (eq rmheader t) | |
18403 | (goto-line 1) | |
18404 | (re-search-forward ":" nil t) | |
18405 | (delete-region (match-end 0) (line-end-position)) | |
18406 | (forward-char 1) | |
18407 | (looking-at "-+") | |
18408 | (delete-region (match-end 0) (line-end-position)) | |
18409 | (move-marker header-end (match-end 0))) | |
18410 | (goto-char header-end) | |
18411 | (delete-region (point) (point-max)) | |
18412 | (while (setq entry (pop custom1)) | |
fbe6c10d | 18413 | (setq key (car entry) desc (nth 1 entry) |
03f3cf35 JW |
18414 | type (nth 2 entry) match (nth 3 entry)) |
18415 | (if (> (length key) 1) | |
18416 | (add-to-list 'prefixes (string-to-char key)) | |
18417 | (insert | |
18418 | (format | |
18419 | "\n%-4s%-14s: %s" | |
18420 | (org-add-props (copy-sequence key) | |
18421 | '(face bold)) | |
18422 | (cond | |
18423 | ((string-match "\\S-" desc) desc) | |
18424 | ((eq type 'agenda) "Agenda for current week or day") | |
18425 | ((eq type 'alltodo) "List of all TODO entries") | |
18426 | ((eq type 'stuck) "List of stuck projects") | |
18427 | ((eq type 'todo) "TODO keyword") | |
18428 | ((eq type 'tags) "Tags query") | |
18429 | ((eq type 'tags-todo) "Tags (TODO)") | |
18430 | ((eq type 'tags-tree) "Tags tree") | |
18431 | ((eq type 'todo-tree) "TODO kwd tree") | |
18432 | ((eq type 'occur-tree) "Occur tree") | |
18433 | ((functionp type) (if (symbolp type) | |
18434 | (symbol-name type) | |
18435 | "Lambda expression")) | |
18436 | (t "???")) | |
18437 | (cond | |
18438 | ((stringp match) | |
18439 | (org-add-props match nil 'face 'org-warning)) | |
18440 | (match | |
18441 | (format "set of %d commands" (length match))) | |
18442 | (t "")))))) | |
18443 | (when prefixes | |
257b8401 CD |
18444 | (mapc (lambda (x) |
18445 | (insert | |
18446 | (format "\n%s %s" | |
18447 | (org-add-props (char-to-string x) | |
18448 | nil 'face 'bold) | |
18449 | (or (cdr (assoc (concat selstring (char-to-string x)) | |
18450 | prefix-descriptions)) | |
18451 | "Prefix key")))) | |
18452 | prefixes)) | |
03f3cf35 | 18453 | (goto-char (point-min)) |
fbe6c10d CD |
18454 | (when (fboundp 'fit-window-to-buffer) |
18455 | (if second-time | |
18456 | (if (not (pos-visible-in-window-p (point-max))) | |
18457 | (fit-window-to-buffer)) | |
18458 | (setq second-time t) | |
18459 | (fit-window-to-buffer))) | |
03f3cf35 JW |
18460 | (message "Press key for agenda command%s:" |
18461 | (if restrict-ok | |
18462 | (if restriction | |
18463 | (format " (restricted to %s)" restriction) | |
18464 | " (unrestricted)") | |
18465 | "")) | |
18466 | (setq c (read-char-exclusive)) | |
18467 | (message "") | |
18468 | (cond | |
18469 | ((assoc (char-to-string c) custom) | |
18470 | (setq selstring (concat selstring (char-to-string c))) | |
18471 | (throw 'exit (cons selstring restriction))) | |
18472 | ((memq c prefixes) | |
18473 | (setq selstring (concat selstring (char-to-string c)) | |
18474 | prefixes nil | |
18475 | rmheader (or rmheader t) | |
18476 | custom (delq nil (mapcar | |
18477 | (lambda (x) | |
18478 | (if (or (= (length (car x)) 1) | |
18479 | (/= (string-to-char (car x)) c)) | |
18480 | nil | |
18481 | (cons (substring (car x) 1) (cdr x)))) | |
18482 | custom)))) | |
18483 | ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) | |
18484 | (message "Restriction is only possible in Org-mode buffers") | |
18485 | (ding) (sit-for 1)) | |
18486 | ((eq c ?1) | |
18487 | (setq restriction 'buffer)) | |
18488 | ((eq c ?0) | |
18489 | (setq restriction (if region-p 'region 'subtree))) | |
18490 | ((eq c ?<) | |
18491 | (setq restriction | |
18492 | (cond | |
18493 | ((eq restriction 'buffer) | |
18494 | (if region-p 'region 'subtree)) | |
18495 | ((memq restriction '(subtree region)) | |
18496 | nil) | |
18497 | (t 'buffer)))) | |
18498 | ((and (equal selstring "") (memq c '(?a ?t ?m ?L ?C ?e ?T ?M ?# ?/))) | |
18499 | (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) | |
18500 | ((equal c ?q) (error "Abort")) | |
18501 | (t (error "Invalid key %c" c)))))))) | |
891f4676 | 18502 | |
a3fbe8c4 CD |
18503 | (defun org-run-agenda-series (name series) |
18504 | (org-prepare-agenda name) | |
d3f4dbe8 | 18505 | (let* ((org-agenda-multi t) |
a3fbe8c4 | 18506 | (redo (list 'org-run-agenda-series name (list 'quote series))) |
d3f4dbe8 CD |
18507 | (cmds (car series)) |
18508 | (gprops (nth 1 series)) | |
18509 | match ;; The byte compiler incorrectly complains about this. Keep it! | |
18510 | cmd type lprops) | |
18511 | (while (setq cmd (pop cmds)) | |
18512 | (setq type (car cmd) match (nth 1 cmd) lprops (nth 2 cmd)) | |
18513 | (cond | |
18514 | ((eq type 'agenda) | |
a3fbe8c4 CD |
18515 | (org-let2 gprops lprops |
18516 | '(call-interactively 'org-agenda-list))) | |
d3f4dbe8 | 18517 | ((eq type 'alltodo) |
a3fbe8c4 CD |
18518 | (org-let2 gprops lprops |
18519 | '(call-interactively 'org-todo-list))) | |
d3f4dbe8 | 18520 | ((eq type 'stuck) |
a3fbe8c4 CD |
18521 | (org-let2 gprops lprops |
18522 | '(call-interactively 'org-agenda-list-stuck-projects))) | |
d3f4dbe8 CD |
18523 | ((eq type 'tags) |
18524 | (org-let2 gprops lprops | |
18525 | '(org-tags-view current-prefix-arg match))) | |
18526 | ((eq type 'tags-todo) | |
18527 | (org-let2 gprops lprops | |
18528 | '(org-tags-view '(4) match))) | |
18529 | ((eq type 'todo) | |
18530 | (org-let2 gprops lprops | |
18531 | '(org-todo-list match))) | |
18532 | ((fboundp type) | |
18533 | (org-let2 gprops lprops | |
18534 | '(funcall type match))) | |
18535 | (t (error "Invalid type in command series")))) | |
18536 | (widen) | |
18537 | (setq org-agenda-redo-command redo) | |
18538 | (goto-char (point-min))) | |
18539 | (org-finalize-agenda)) | |
891f4676 | 18540 | |
d3f4dbe8 CD |
18541 | ;;;###autoload |
18542 | (defmacro org-batch-agenda (cmd-key &rest parameters) | |
a3fbe8c4 CD |
18543 | "Run an agenda command in batch mode and send the result to STDOUT. |
18544 | If 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 | |
b38c6895 | 18546 | longer string is is used as a tags/todo match string. |
d3f4dbe8 CD |
18547 | Paramters are alternating variable names and values that will be bound |
18548 | before running the agenda command." | |
18549 | (let (pars) | |
18550 | (while parameters | |
18551 | (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
03f3cf35 | 18552 | (if (> (length cmd-key) 2) |
a3fbe8c4 CD |
18553 | (eval (list 'let (nreverse pars) |
18554 | (list 'org-tags-view nil cmd-key))) | |
03f3cf35 | 18555 | (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) |
374585c9 | 18556 | (set-buffer org-agenda-buffer-name) |
a3fbe8c4 CD |
18557 | (princ (org-encode-for-stdout (buffer-string))))) |
18558 | ||
18559 | (defun org-encode-for-stdout (string) | |
18560 | (if (fboundp 'encode-coding-string) | |
18561 | (encode-coding-string string buffer-file-coding-system) | |
18562 | string)) | |
18563 | ||
18564 | (defvar org-agenda-info nil) | |
18565 | ||
18566 | ;;;###autoload | |
18567 | (defmacro org-batch-agenda-csv (cmd-key &rest parameters) | |
18568 | "Run an agenda command in batch mode and send the result to STDOUT. | |
18569 | If 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 | |
b38c6895 | 18571 | longer string is is used as a tags/todo match string. |
a3fbe8c4 CD |
18572 | Paramters are alternating variable names and values that will be bound |
18573 | before running the agenda command. | |
18574 | ||
18575 | The output gives a line for each selected agenda item. Each | |
18576 | item is a list of comma-separated values, like this: | |
18577 | ||
18578 | category,head,type,todo,tags,date,time,extra,priority-l,priority-n | |
18579 | ||
18580 | category The category of the item | |
18581 | head The headline, without TODO kwd, TAGS and PRIORITY | |
18582 | type The type of the agenda entry, can be | |
18583 | todo selected in TODO match | |
18584 | tagsmatch selected in tags match | |
18585 | diary imported from diary | |
18586 | deadline a deadline on given date | |
18587 | scheduled scheduled on given date | |
18588 | timestamp entry has timestamp on given date | |
18589 | closed entry was closed on given date | |
18590 | upcoming-deadline warning about deadline | |
18591 | past-scheduled forwarded scheduled item | |
18592 | block entry has date block including g. date | |
18593 | todo The todo keyword, if any | |
18594 | tags All tags including inherited ones, separated by colons | |
18595 | date The relevant date, like 2007-2-14 | |
18596 | time The time, like 15:00-16:50 | |
18597 | extra Sting with extra planning info | |
18598 | priority-l The priority letter if any was given | |
b38c6895 CD |
18599 | priority-n The computed numerical priority |
18600 | agenda-day The day in the agenda where this is listed" | |
a3fbe8c4 CD |
18601 | |
18602 | (let (pars) | |
18603 | (while parameters | |
18604 | (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
18605 | (push (list 'org-agenda-remove-tags t) pars) | |
03f3cf35 | 18606 | (if (> (length cmd-key) 2) |
a3fbe8c4 CD |
18607 | (eval (list 'let (nreverse pars) |
18608 | (list 'org-tags-view nil cmd-key))) | |
03f3cf35 | 18609 | (eval (list 'let (nreverse pars) (list 'org-agenda nil cmd-key)))) |
374585c9 | 18610 | (set-buffer org-agenda-buffer-name) |
a3fbe8c4 CD |
18611 | (let* ((lines (org-split-string (buffer-string) "\n")) |
18612 | line) | |
18613 | (while (setq line (pop lines)) | |
18614 | (catch 'next | |
18615 | (if (not (get-text-property 0 'org-category line)) (throw 'next nil)) | |
18616 | (setq org-agenda-info | |
18617 | (org-fix-agenda-info (text-properties-at 0 line))) | |
18618 | (princ | |
18619 | (org-encode-for-stdout | |
18620 | (mapconcat 'org-agenda-export-csv-mapper | |
18621 | '(org-category txt type todo tags date time-of-day extra | |
b38c6895 | 18622 | priority-letter priority agenda-day) |
a3fbe8c4 CD |
18623 | ","))) |
18624 | (princ "\n")))))) | |
18625 | ||
18626 | (defun org-fix-agenda-info (props) | |
15841868 JW |
18627 | "Make sure all properties on an agenda item have a canonical form, |
18628 | so the the export commands caneasily use it." | |
a3fbe8c4 CD |
18629 | (let (tmp re) |
18630 | (when (setq tmp (plist-get props 'tags)) | |
18631 | (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) | |
18632 | (when (setq tmp (plist-get props 'date)) | |
18633 | (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) | |
18634 | (let ((calendar-date-display-form '(year "-" month "-" day))) | |
18635 | '((format "%4d, %9s %2s, %4s" dayname monthname day year)) | |
18636 | ||
18637 | (setq tmp (calendar-date-string tmp))) | |
18638 | (setq props (plist-put props 'date tmp))) | |
18639 | (when (setq tmp (plist-get props 'day)) | |
18640 | (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) | |
18641 | (let ((calendar-date-display-form '(year "-" month "-" day))) | |
18642 | (setq tmp (calendar-date-string tmp))) | |
b38c6895 CD |
18643 | (setq props (plist-put props 'day tmp)) |
18644 | (setq props (plist-put props 'agenda-day tmp))) | |
a3fbe8c4 CD |
18645 | (when (setq tmp (plist-get props 'txt)) |
18646 | (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) | |
18647 | (plist-put props 'priority-letter (match-string 1 tmp)) | |
18648 | (setq tmp (replace-match "" t t tmp))) | |
18649 | (when (and (setq re (plist-get props 'org-todo-regexp)) | |
18650 | (setq re (concat "\\`\\.*" re " ?")) | |
18651 | (string-match re tmp)) | |
18652 | (plist-put props 'todo (match-string 1 tmp)) | |
18653 | (setq tmp (replace-match "" t t tmp))) | |
18654 | (plist-put props 'txt tmp))) | |
18655 | props) | |
18656 | ||
18657 | (defun org-agenda-export-csv-mapper (prop) | |
18658 | (let ((res (plist-get org-agenda-info prop))) | |
18659 | (setq res | |
18660 | (cond | |
18661 | ((not res) "") | |
18662 | ((stringp res) res) | |
18663 | (t (prin1-to-string res)))) | |
18664 | (while (string-match "," res) | |
18665 | (setq res (replace-match ";" t t res))) | |
18666 | (org-trim res))) | |
18667 | ||
18668 | ||
18669 | ;;;###autoload | |
18670 | (defun org-store-agenda-views (&rest parameters) | |
18671 | (interactive) | |
18672 | (eval (list 'org-batch-store-agenda-views))) | |
18673 | ||
a3fbe8c4 CD |
18674 | ;; FIXME, why is this a macro????? |
18675 | ;;;###autoload | |
18676 | (defmacro org-batch-store-agenda-views (&rest parameters) | |
18677 | "Run all custom agenda commands that have a file argument." | |
18678 | (let ((cmds org-agenda-custom-commands) | |
374585c9 | 18679 | (pop-up-frames nil) |
48aaad2d | 18680 | (dir default-directory) |
a3fbe8c4 CD |
18681 | pars cmd thiscmdkey files opts) |
18682 | (while parameters | |
18683 | (push (list (pop parameters) (if parameters (pop parameters))) pars)) | |
18684 | (setq pars (reverse pars)) | |
18685 | (save-window-excursion | |
18686 | (while cmds | |
18687 | (setq cmd (pop cmds) | |
18688 | thiscmdkey (car cmd) | |
18689 | opts (nth 3 cmd) | |
374585c9 | 18690 | files (nth 4 cmd)) |
a3fbe8c4 CD |
18691 | (if (stringp files) (setq files (list files))) |
18692 | (when files | |
03f3cf35 JW |
18693 | (eval (list 'let (append org-agenda-exporter-settings opts pars) |
18694 | (list 'org-agenda nil thiscmdkey))) | |
374585c9 | 18695 | (set-buffer org-agenda-buffer-name) |
a3fbe8c4 CD |
18696 | (while files |
18697 | (eval (list 'let (append org-agenda-exporter-settings opts pars) | |
c039ea1d | 18698 | (list 'org-write-agenda |
374585c9 CD |
18699 | (expand-file-name (pop files) dir) t)))) |
18700 | (and (get-buffer org-agenda-buffer-name) | |
18701 | (kill-buffer org-agenda-buffer-name))))))) | |
a3fbe8c4 CD |
18702 | |
18703 | (defun org-write-agenda (file &optional nosettings) | |
18704 | "Write the current buffer (an agenda view) as a file. | |
18705 | Depending on the extension of the file name, plain text (.txt), | |
18706 | HTML (.html or .htm) or Postscript (.ps) is produced. | |
18707 | If NOSETTINGS is given, do not scope the settings of | |
18708 | `org-agenda-exporter-settings' into the export commands. This is used when | |
18709 | the settings have already been scoped and we do not wish to overrule other, | |
18710 | higher priority settings." | |
18711 | (interactive "FWrite agenda to file: ") | |
18712 | (if (not (file-writable-p file)) | |
18713 | (error "Cannot write agenda to file %s" file)) | |
18714 | (cond | |
18715 | ((string-match "\\.html?\\'" file) (require 'htmlize)) | |
18716 | ((string-match "\\.ps\\'" file) (require 'ps-print))) | |
18717 | (org-let (if nosettings nil org-agenda-exporter-settings) | |
18718 | '(save-excursion | |
18719 | (save-window-excursion | |
18720 | (cond | |
18721 | ((string-match "\\.html?\\'" file) | |
18722 | (set-buffer (htmlize-buffer (current-buffer))) | |
18723 | ||
18724 | (when (and org-agenda-export-html-style | |
18725 | (string-match "<style>" org-agenda-export-html-style)) | |
18726 | ;; replace <style> section with org-agenda-export-html-style | |
18727 | (goto-char (point-min)) | |
18728 | (kill-region (- (search-forward "<style") 6) | |
18729 | (search-forward "</style>")) | |
18730 | (insert org-agenda-export-html-style)) | |
18731 | (write-file file) | |
18732 | (kill-buffer (current-buffer)) | |
18733 | (message "HTML written to %s" file)) | |
18734 | ((string-match "\\.ps\\'" file) | |
18735 | (ps-print-buffer-with-faces file) | |
18736 | (message "Postscript written to %s" file)) | |
18737 | (t | |
18738 | (let ((bs (buffer-string))) | |
18739 | (find-file file) | |
18740 | (insert bs) | |
18741 | (save-buffer 0) | |
18742 | (kill-buffer (current-buffer)) | |
18743 | (message "Plain text written to %s" file)))))) | |
18744 | (set-buffer org-agenda-buffer-name))) | |
891f4676 | 18745 | |
d3f4dbe8 CD |
18746 | (defmacro org-no-read-only (&rest body) |
18747 | "Inhibit read-only for BODY." | |
18748 | `(let ((inhibit-read-only t)) ,@body)) | |
9acdaa21 | 18749 | |
d3f4dbe8 CD |
18750 | (defun org-check-for-org-mode () |
18751 | "Make sure current buffer is in org-mode. Error if not." | |
18752 | (or (org-mode-p) | |
18753 | (error "Cannot execute org-mode agenda command on buffer in %s." | |
18754 | major-mode))) | |
891f4676 | 18755 | |
d3f4dbe8 CD |
18756 | (defun org-fit-agenda-window () |
18757 | "Fit the window to the buffer size." | |
18758 | (and (memq org-agenda-window-setup '(reorganize-frame)) | |
18759 | (fboundp 'fit-window-to-buffer) | |
03f3cf35 JW |
18760 | (fit-window-to-buffer |
18761 | nil | |
18762 | (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) | |
18763 | (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) | |
891f4676 | 18764 | |
d3f4dbe8 | 18765 | ;;; Agenda file list |
c4f9780e | 18766 | |
d3f4dbe8 CD |
18767 | (defun org-agenda-files (&optional unrestricted) |
18768 | "Get the list of agenda files. | |
18769 | Optional UNRESTRICTED means return the full list even if a restriction | |
18770 | is currently in place." | |
374585c9 CD |
18771 | (let ((files |
18772 | (cond | |
18773 | ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) | |
18774 | ((stringp org-agenda-files) (org-read-agenda-file-list)) | |
18775 | ((listp org-agenda-files) org-agenda-files) | |
18776 | (t (error "Invalid value of `org-agenda-files'"))))) | |
03f3cf35 JW |
18777 | (setq files (apply 'append |
18778 | (mapcar (lambda (f) | |
18779 | (if (file-directory-p f) | |
18780 | (directory-files f t "\\.org\\'") | |
18781 | (list f))) | |
18782 | files))) | |
374585c9 CD |
18783 | (if org-agenda-skip-unavailable-files |
18784 | (delq nil | |
18785 | (mapcar (function | |
18786 | (lambda (file) | |
18787 | (and (file-readable-p file) file))) | |
18788 | files)) | |
18789 | files))) ; `org-check-agenda-file' will remove them from the list | |
9acdaa21 | 18790 | |
d3f4dbe8 CD |
18791 | (defun org-edit-agenda-file-list () |
18792 | "Edit the list of agenda files. | |
18793 | Depending on setup, this either uses customize to edit the variable | |
18794 | `org-agenda-files', or it visits the file that is holding the list. In the | |
18795 | latter case, the buffer is set up in a way that saving it automatically kills | |
18796 | the buffer and restores the previous window configuration." | |
18797 | (interactive) | |
18798 | (if (stringp org-agenda-files) | |
18799 | (let ((cw (current-window-configuration))) | |
18800 | (find-file org-agenda-files) | |
18801 | (org-set-local 'org-window-configuration cw) | |
18802 | (org-add-hook 'after-save-hook | |
18803 | (lambda () | |
18804 | (set-window-configuration | |
18805 | (prog1 org-window-configuration | |
18806 | (kill-buffer (current-buffer)))) | |
18807 | (org-install-agenda-files-menu) | |
18808 | (message "New agenda file list installed")) | |
18809 | nil 'local) | |
274f1353 | 18810 | (message "%s" (substitute-command-keys |
d3f4dbe8 CD |
18811 | "Edit list and finish with \\[save-buffer]"))) |
18812 | (customize-variable 'org-agenda-files))) | |
c4f9780e | 18813 | |
d3f4dbe8 CD |
18814 | (defun org-store-new-agenda-file-list (list) |
18815 | "Set new value for the agenda file list and save it correcly." | |
18816 | (if (stringp org-agenda-files) | |
18817 | (let ((f org-agenda-files) b) | |
18818 | (while (setq b (find-buffer-visiting f)) (kill-buffer b)) | |
18819 | (with-temp-file f | |
18820 | (insert (mapconcat 'identity list "\n") "\n"))) | |
18821 | (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) | |
18822 | (setq org-agenda-files list) | |
18823 | (customize-save-variable 'org-agenda-files org-agenda-files)))) | |
9acdaa21 | 18824 | |
d3f4dbe8 CD |
18825 | (defun org-read-agenda-file-list () |
18826 | "Read the list of agenda files from a file." | |
18827 | (when (stringp org-agenda-files) | |
18828 | (with-temp-buffer | |
18829 | (insert-file-contents org-agenda-files) | |
18830 | (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))) | |
9acdaa21 | 18831 | |
9acdaa21 | 18832 | |
d3f4dbe8 CD |
18833 | ;;;###autoload |
18834 | (defun org-cycle-agenda-files () | |
18835 | "Cycle through the files in `org-agenda-files'. | |
18836 | If the current buffer visits an agenda file, find the next one in the list. | |
18837 | If the current buffer does not, find the first agenda file." | |
18838 | (interactive) | |
18839 | (let* ((fs (org-agenda-files t)) | |
18840 | (files (append fs (list (car fs)))) | |
18841 | (tcf (if buffer-file-name (file-truename buffer-file-name))) | |
18842 | file) | |
18843 | (unless files (error "No agenda files")) | |
18844 | (catch 'exit | |
18845 | (while (setq file (pop files)) | |
18846 | (if (equal (file-truename file) tcf) | |
18847 | (when (car files) | |
18848 | (find-file (car files)) | |
18849 | (throw 'exit t)))) | |
18850 | (find-file (car fs))) | |
18851 | (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer))))) | |
9acdaa21 | 18852 | |
d3f4dbe8 CD |
18853 | (defun org-agenda-file-to-front (&optional to-end) |
18854 | "Move/add the current file to the top of the agenda file list. | |
18855 | If the file is not present in the list, it is added to the front. If it is | |
18856 | present, it is moved there. With optional argument TO-END, add/move to the | |
18857 | end of the list." | |
18858 | (interactive "P") | |
374585c9 CD |
18859 | (let ((org-agenda-skip-unavailable-files nil) |
18860 | (file-alist (mapcar (lambda (x) | |
d3f4dbe8 CD |
18861 | (cons (file-truename x) x)) |
18862 | (org-agenda-files t))) | |
18863 | (ctf (file-truename buffer-file-name)) | |
18864 | x had) | |
18865 | (setq x (assoc ctf file-alist) had x) | |
891f4676 | 18866 | |
d3f4dbe8 CD |
18867 | (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) |
18868 | (if to-end | |
18869 | (setq file-alist (append (delq x file-alist) (list x))) | |
18870 | (setq file-alist (cons x (delq x file-alist)))) | |
18871 | (org-store-new-agenda-file-list (mapcar 'cdr file-alist)) | |
18872 | (org-install-agenda-files-menu) | |
18873 | (message "File %s to %s of agenda file list" | |
18874 | (if had "moved" "added") (if to-end "end" "front")))) | |
9acdaa21 | 18875 | |
d3f4dbe8 CD |
18876 | (defun org-remove-file (&optional file) |
18877 | "Remove current file from the list of files in variable `org-agenda-files'. | |
18878 | These are the files which are being checked for agenda entries. | |
18879 | Optional argument FILE means, use this file instead of the current." | |
18880 | (interactive) | |
374585c9 CD |
18881 | (let* ((org-agenda-skip-unavailable-files nil) |
18882 | (file (or file buffer-file-name)) | |
d3f4dbe8 CD |
18883 | (true-file (file-truename file)) |
18884 | (afile (abbreviate-file-name file)) | |
18885 | (files (delq nil (mapcar | |
18886 | (lambda (x) | |
18887 | (if (equal true-file | |
18888 | (file-truename x)) | |
18889 | nil x)) | |
18890 | (org-agenda-files t))))) | |
18891 | (if (not (= (length files) (length (org-agenda-files t)))) | |
18892 | (progn | |
18893 | (org-store-new-agenda-file-list files) | |
18894 | (org-install-agenda-files-menu) | |
18895 | (message "Removed file: %s" afile)) | |
18896 | (message "File was not in list: %s" afile)))) | |
9acdaa21 | 18897 | |
d3f4dbe8 CD |
18898 | (defun org-file-menu-entry (file) |
18899 | (vector file (list 'find-file file) t)) | |
9acdaa21 | 18900 | |
d3f4dbe8 CD |
18901 | (defun org-check-agenda-file (file) |
18902 | "Make sure FILE exists. If not, ask user what to do." | |
18903 | (when (not (file-exists-p file)) | |
18904 | (message "non-existent file %s. [R]emove from list or [A]bort?" | |
18905 | (abbreviate-file-name file)) | |
18906 | (let ((r (downcase (read-char-exclusive)))) | |
18907 | (cond | |
18908 | ((equal r ?r) | |
18909 | (org-remove-file file) | |
18910 | (throw 'nextfile t)) | |
18911 | (t (error "Abort")))))) | |
9acdaa21 | 18912 | |
d3f4dbe8 | 18913 | ;;; Agenda prepare and finalize |
9acdaa21 | 18914 | |
d3f4dbe8 CD |
18915 | (defvar org-agenda-multi nil) ; dynammically scoped |
18916 | (defvar org-agenda-buffer-name "*Org Agenda*") | |
18917 | (defvar org-pre-agenda-window-conf nil) | |
a3fbe8c4 CD |
18918 | (defvar org-agenda-name nil) |
18919 | (defun org-prepare-agenda (&optional name) | |
18920 | (setq org-todo-keywords-for-agenda nil) | |
18921 | (setq org-done-keywords-for-agenda nil) | |
d3f4dbe8 CD |
18922 | (if org-agenda-multi |
18923 | (progn | |
18924 | (setq buffer-read-only nil) | |
18925 | (goto-char (point-max)) | |
15841868 | 18926 | (unless (or (bobp) org-agenda-compact-blocks) |
d3f4dbe8 CD |
18927 | (insert "\n" (make-string (window-width) ?=) "\n")) |
18928 | (narrow-to-region (point) (point-max))) | |
18929 | (org-agenda-maybe-reset-markers 'force) | |
18930 | (org-prepare-agenda-buffers (org-agenda-files)) | |
a3fbe8c4 CD |
18931 | (setq org-todo-keywords-for-agenda |
18932 | (org-uniquify org-todo-keywords-for-agenda)) | |
18933 | (setq org-done-keywords-for-agenda | |
18934 | (org-uniquify org-done-keywords-for-agenda)) | |
d3f4dbe8 CD |
18935 | (let* ((abuf (get-buffer-create org-agenda-buffer-name)) |
18936 | (awin (get-buffer-window abuf))) | |
18937 | (cond | |
18938 | ((equal (current-buffer) abuf) nil) | |
18939 | (awin (select-window awin)) | |
18940 | ((not (setq org-pre-agenda-window-conf (current-window-configuration)))) | |
18941 | ((equal org-agenda-window-setup 'current-window) | |
18942 | (switch-to-buffer abuf)) | |
18943 | ((equal org-agenda-window-setup 'other-window) | |
374585c9 | 18944 | (org-switch-to-buffer-other-window abuf)) |
d3f4dbe8 CD |
18945 | ((equal org-agenda-window-setup 'other-frame) |
18946 | (switch-to-buffer-other-frame abuf)) | |
18947 | ((equal org-agenda-window-setup 'reorganize-frame) | |
18948 | (delete-other-windows) | |
374585c9 | 18949 | (org-switch-to-buffer-other-window abuf)))) |
d3f4dbe8 CD |
18950 | (setq buffer-read-only nil) |
18951 | (erase-buffer) | |
a3fbe8c4 CD |
18952 | (org-agenda-mode) |
18953 | (and name (not org-agenda-name) | |
18954 | (org-set-local 'org-agenda-name name))) | |
d3f4dbe8 | 18955 | (setq buffer-read-only nil)) |
9acdaa21 | 18956 | |
d3f4dbe8 CD |
18957 | (defun org-finalize-agenda () |
18958 | "Finishing touch for the agenda buffer, called just before displaying it." | |
18959 | (unless org-agenda-multi | |
d3f4dbe8 | 18960 | (save-excursion |
48aaad2d | 18961 | (let ((inhibit-read-only t)) |
d3f4dbe8 CD |
18962 | (goto-char (point-min)) |
18963 | (while (org-activate-bracket-links (point-max)) | |
18964 | (add-text-properties (match-beginning 0) (match-end 0) | |
a3fbe8c4 | 18965 | '(face org-link))) |
38f8646b | 18966 | (org-agenda-align-tags) |
a3fbe8c4 CD |
18967 | (unless org-agenda-with-colors |
18968 | (remove-text-properties (point-min) (point-max) '(face nil)))) | |
38f8646b CD |
18969 | (if (and (boundp 'org-overriding-columns-format) |
18970 | org-overriding-columns-format) | |
18971 | (org-set-local 'org-overriding-columns-format | |
18972 | org-overriding-columns-format)) | |
18973 | (if (and (boundp 'org-agenda-view-columns-initially) | |
18974 | org-agenda-view-columns-initially) | |
18975 | (org-agenda-columns)) | |
03f3cf35 JW |
18976 | (when org-agenda-fontify-priorities |
18977 | (org-fontify-priorities)) | |
d3f4dbe8 | 18978 | (run-hooks 'org-finalize-agenda-hook)))) |
9acdaa21 | 18979 | |
03f3cf35 JW |
18980 | (defun org-fontify-priorities () |
18981 | "Make highest priority lines bold, and lowest italic." | |
18982 | (interactive) | |
18983 | (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) | |
18984 | (org-delete-overlay o))) | |
18985 | (overlays-in (point-min) (point-max))) | |
18986 | (save-excursion | |
18987 | (let ((ovs (org-overlays-in (point-min) (point-max))) | |
18988 | (inhibit-read-only t) | |
18989 | b e p ov h l) | |
18990 | (goto-char (point-min)) | |
18991 | (while (re-search-forward "\\[#\\(.\\)\\]" nil t) | |
18992 | (setq h (or (get-char-property (point) 'org-highest-priority) | |
18993 | org-highest-priority) | |
18994 | l (or (get-char-property (point) 'org-lowest-priority) | |
18995 | org-lowest-priority) | |
18996 | p (string-to-char (match-string 1)) | |
18997 | b (match-beginning 0) e (line-end-position) | |
18998 | ov (org-make-overlay b e)) | |
18999 | (org-overlay-put | |
19000 | ov 'face | |
19001 | (cond ((listp org-agenda-fontify-priorities) | |
19002 | (cdr (assoc p org-agenda-fontify-priorities))) | |
19003 | ((equal p l) 'italic) | |
19004 | ((equal p h) 'bold))) | |
19005 | (org-overlay-put ov 'org-type 'org-priority))))) | |
19006 | ||
d3f4dbe8 CD |
19007 | (defun org-prepare-agenda-buffers (files) |
19008 | "Create buffers for all agenda files, protect archived trees and comments." | |
19009 | (interactive) | |
19010 | (let ((pa '(:org-archived t)) | |
19011 | (pc '(:org-comment t)) | |
19012 | (pall '(:org-archived t :org-comment t)) | |
48aaad2d | 19013 | (inhibit-read-only t) |
d3f4dbe8 CD |
19014 | (rea (concat ":" org-archive-tag ":")) |
19015 | bmp file re) | |
19016 | (save-excursion | |
19017 | (save-restriction | |
19018 | (while (setq file (pop files)) | |
19019 | (org-check-agenda-file file) | |
19020 | (set-buffer (org-get-agenda-file-buffer file)) | |
19021 | (widen) | |
19022 | (setq bmp (buffer-modified-p)) | |
15841868 | 19023 | (org-refresh-category-properties) |
a3fbe8c4 CD |
19024 | (setq org-todo-keywords-for-agenda |
19025 | (append org-todo-keywords-for-agenda org-todo-keywords-1)) | |
19026 | (setq org-done-keywords-for-agenda | |
19027 | (append org-done-keywords-for-agenda org-done-keywords)) | |
d3f4dbe8 CD |
19028 | (save-excursion |
19029 | (remove-text-properties (point-min) (point-max) pall) | |
19030 | (when org-agenda-skip-archived-trees | |
19031 | (goto-char (point-min)) | |
19032 | (while (re-search-forward rea nil t) | |
3cee1495 | 19033 | (if (org-on-heading-p t) |
d3f4dbe8 CD |
19034 | (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) |
19035 | (goto-char (point-min)) | |
19036 | (setq re (concat "^\\*+ +" org-comment-string "\\>")) | |
19037 | (while (re-search-forward re nil t) | |
19038 | (add-text-properties | |
19039 | (match-beginning 0) (org-end-of-subtree t) pc))) | |
19040 | (set-buffer-modified-p bmp)))))) | |
a3fbe8c4 | 19041 | |
d3f4dbe8 CD |
19042 | (defvar org-agenda-skip-function nil |
19043 | "Function to be called at each match during agenda construction. | |
48aaad2d | 19044 | If this function returns nil, the current match should not be skipped. |
d3f4dbe8 CD |
19045 | Otherwise, the function must return a position from where the search |
19046 | should be continued. | |
48aaad2d | 19047 | This may also be a Lisp form, it will be evaluated. |
d3f4dbe8 CD |
19048 | Never set this variable using `setq' or so, because then it will apply |
19049 | to all future agenda commands. Instead, bind it with `let' to scope | |
48aaad2d CD |
19050 | it dynamically into the agenda-constructing command. A good way to set |
19051 | it is through options in org-agenda-custom-commands.") | |
891f4676 | 19052 | |
d3f4dbe8 CD |
19053 | (defun org-agenda-skip () |
19054 | "Throw to `:skip' in places that should be skipped. | |
19055 | Also moves point to the end of the skipped region, so that search can | |
19056 | continue from there." | |
48aaad2d | 19057 | (let ((p (point-at-bol)) to fp) |
d3f4dbe8 CD |
19058 | (and org-agenda-skip-archived-trees |
19059 | (get-text-property p :org-archived) | |
19060 | (org-end-of-subtree t) | |
19061 | (throw :skip t)) | |
19062 | (and (get-text-property p :org-comment) | |
19063 | (org-end-of-subtree t) | |
19064 | (throw :skip t)) | |
19065 | (if (equal (char-after p) ?#) (throw :skip t)) | |
48aaad2d CD |
19066 | (when (and (or (setq fp (functionp org-agenda-skip-function)) |
19067 | (consp org-agenda-skip-function)) | |
d3f4dbe8 CD |
19068 | (setq to (save-excursion |
19069 | (save-match-data | |
48aaad2d CD |
19070 | (if fp |
19071 | (funcall org-agenda-skip-function) | |
19072 | (eval org-agenda-skip-function)))))) | |
d3f4dbe8 CD |
19073 | (goto-char to) |
19074 | (throw :skip t)))) | |
891f4676 | 19075 | |
d3f4dbe8 CD |
19076 | (defvar org-agenda-markers nil |
19077 | "List of all currently active markers created by `org-agenda'.") | |
19078 | (defvar org-agenda-last-marker-time (time-to-seconds (current-time)) | |
19079 | "Creation time of the last agenda marker.") | |
c4f9780e | 19080 | |
d3f4dbe8 CD |
19081 | (defun org-agenda-new-marker (&optional pos) |
19082 | "Return a new agenda marker. | |
19083 | Org-mode keeps a list of these markers and resets them when they are | |
19084 | no longer in use." | |
19085 | (let ((m (copy-marker (or pos (point))))) | |
19086 | (setq org-agenda-last-marker-time (time-to-seconds (current-time))) | |
19087 | (push m org-agenda-markers) | |
19088 | m)) | |
891f4676 | 19089 | |
d3f4dbe8 CD |
19090 | (defun org-agenda-maybe-reset-markers (&optional force) |
19091 | "Reset markers created by `org-agenda'. But only if they are old enough." | |
19092 | (if (or (and force (not org-agenda-multi)) | |
19093 | (> (- (time-to-seconds (current-time)) | |
19094 | org-agenda-last-marker-time) | |
19095 | 5)) | |
19096 | (while org-agenda-markers | |
19097 | (move-marker (pop org-agenda-markers) nil)))) | |
c4f9780e | 19098 | |
d3f4dbe8 CD |
19099 | (defvar org-agenda-new-buffers nil |
19100 | "Buffers created to visit agenda files.") | |
9acdaa21 | 19101 | |
d3f4dbe8 CD |
19102 | (defun org-get-agenda-file-buffer (file) |
19103 | "Get a buffer visiting FILE. If the buffer needs to be created, add | |
19104 | it to the list of buffers which might be released later." | |
19105 | (let ((buf (org-find-base-buffer-visiting file))) | |
19106 | (if buf | |
19107 | buf ; just return it | |
19108 | ;; Make a new buffer and remember it | |
19109 | (setq buf (find-file-noselect file)) | |
19110 | (if buf (push buf org-agenda-new-buffers)) | |
19111 | buf))) | |
9acdaa21 | 19112 | |
d3f4dbe8 CD |
19113 | (defun org-release-buffers (blist) |
19114 | "Release all buffers in list, asking the user for confirmation when needed. | |
19115 | When a buffer is unmodified, it is just killed. When modified, it is saved | |
19116 | \(if the user agrees) and then killed." | |
19117 | (let (buf file) | |
19118 | (while (setq buf (pop blist)) | |
19119 | (setq file (buffer-file-name buf)) | |
19120 | (when (and (buffer-modified-p buf) | |
19121 | file | |
19122 | (y-or-n-p (format "Save file %s? " file))) | |
19123 | (with-current-buffer buf (save-buffer))) | |
19124 | (kill-buffer buf)))) | |
9acdaa21 | 19125 | |
d3f4dbe8 CD |
19126 | (defun org-get-category (&optional pos) |
19127 | "Get the category applying to position POS." | |
15841868 JW |
19128 | (get-text-property (or pos (point)) 'org-category)) |
19129 | ||
d3f4dbe8 | 19130 | ;;; Agenda timeline |
c4f9780e | 19131 | |
03f3cf35 JW |
19132 | (defvar org-agenda-only-exact-dates nil) ; dynamically scoped |
19133 | ||
d3f4dbe8 CD |
19134 | (defun org-timeline (&optional include-all) |
19135 | "Show a time-sorted view of the entries in the current org file. | |
19136 | Only entries with a time stamp of today or later will be listed. With | |
19137 | \\[universal-argument] prefix, all unfinished TODO items will also be shown, | |
19138 | under the current date. | |
19139 | If the buffer contains an active region, only check the region for | |
19140 | dates." | |
c4f9780e | 19141 | (interactive "P") |
d3f4dbe8 CD |
19142 | (require 'calendar) |
19143 | (org-compile-prefix-format 'timeline) | |
19144 | (org-set-sorting-strategy 'timeline) | |
19145 | (let* ((dopast t) | |
19146 | (dotodo include-all) | |
19147 | (doclosed org-agenda-show-log) | |
19148 | (entry buffer-file-name) | |
19149 | (date (calendar-current-date)) | |
19150 | (beg (if (org-region-active-p) (region-beginning) (point-min))) | |
19151 | (end (if (org-region-active-p) (region-end) (point-max))) | |
19152 | (day-numbers (org-get-all-dates beg end 'no-ranges | |
19153 | t doclosed ; always include today | |
19154 | org-timeline-show-empty-dates)) | |
03f3cf35 JW |
19155 | (org-deadline-warning-days 0) |
19156 | (org-agenda-only-exact-dates t) | |
d3f4dbe8 CD |
19157 | (today (time-to-days (current-time))) |
19158 | (past t) | |
19159 | args | |
19160 | s e rtn d emptyp) | |
19161 | (setq org-agenda-redo-command | |
19162 | (list 'progn | |
374585c9 | 19163 | (list 'org-switch-to-buffer-other-window (current-buffer)) |
d3f4dbe8 CD |
19164 | (list 'org-timeline (list 'quote include-all)))) |
19165 | (if (not dopast) | |
19166 | ;; Remove past dates from the list of dates. | |
19167 | (setq day-numbers (delq nil (mapcar (lambda(x) | |
19168 | (if (>= x today) x nil)) | |
19169 | day-numbers)))) | |
c039ea1d | 19170 | (org-prepare-agenda (concat "Timeline " |
a3fbe8c4 | 19171 | (file-name-nondirectory buffer-file-name))) |
d3f4dbe8 CD |
19172 | (if doclosed (push :closed args)) |
19173 | (push :timestamp args) | |
03f3cf35 JW |
19174 | (push :deadline args) |
19175 | (push :scheduled args) | |
a3fbe8c4 | 19176 | (push :sexp args) |
d3f4dbe8 CD |
19177 | (if dotodo (push :todo args)) |
19178 | (while (setq d (pop day-numbers)) | |
19179 | (if (and (listp d) (eq (car d) :omitted)) | |
19180 | (progn | |
19181 | (setq s (point)) | |
19182 | (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) | |
a3fbe8c4 | 19183 | (put-text-property s (1- (point)) 'face 'org-agenda-structure)) |
d3f4dbe8 CD |
19184 | (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) |
19185 | (if (and (>= d today) | |
19186 | dopast | |
19187 | past) | |
19188 | (progn | |
19189 | (setq past nil) | |
19190 | (insert (make-string 79 ?-) "\n"))) | |
19191 | (setq date (calendar-gregorian-from-absolute d)) | |
19192 | (setq s (point)) | |
19193 | (setq rtn (and (not emptyp) | |
15841868 JW |
19194 | (apply 'org-agenda-get-day-entries entry |
19195 | date args))) | |
d3f4dbe8 CD |
19196 | (if (or rtn (equal d today) org-timeline-show-empty-dates) |
19197 | (progn | |
d5098885 JW |
19198 | (insert |
19199 | (if (stringp org-agenda-format-date) | |
19200 | (format-time-string org-agenda-format-date | |
19201 | (org-time-from-absolute date)) | |
19202 | (funcall org-agenda-format-date date)) | |
19203 | "\n") | |
a3fbe8c4 | 19204 | (put-text-property s (1- (point)) 'face 'org-agenda-structure) |
d3f4dbe8 CD |
19205 | (put-text-property s (1- (point)) 'org-date-line t) |
19206 | (if (equal d today) | |
19207 | (put-text-property s (1- (point)) 'org-today t)) | |
19208 | (and rtn (insert (org-finalize-agenda-entries rtn) "\n")) | |
19209 | (put-text-property s (1- (point)) 'day d))))) | |
c4f9780e | 19210 | (goto-char (point-min)) |
d3f4dbe8 CD |
19211 | (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) |
19212 | (point-min))) | |
19213 | (add-text-properties (point-min) (point-max) '(org-agenda-type timeline)) | |
19214 | (org-finalize-agenda) | |
19215 | (setq buffer-read-only t))) | |
791d856f | 19216 | |
d3f4dbe8 CD |
19217 | (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty) |
19218 | "Return a list of all relevant day numbers from BEG to END buffer positions. | |
19219 | If NO-RANGES is non-nil, include only the start and end dates of a range, | |
19220 | not every single day in the range. If FORCE-TODAY is non-nil, make | |
19221 | sure that TODAY is included in the list. If INACTIVE is non-nil, also | |
19222 | inactive time stamps (those in square brackets) are included. | |
19223 | When EMPTY is non-nil, also include days without any entries." | |
19224 | (let ((re (if inactive org-ts-regexp-both org-ts-regexp)) | |
19225 | dates dates1 date day day1 day2 ts1 ts2) | |
19226 | (if force-today | |
19227 | (setq dates (list (time-to-days (current-time))))) | |
19228 | (save-excursion | |
19229 | (goto-char beg) | |
19230 | (while (re-search-forward re end t) | |
19231 | (setq day (time-to-days (org-time-string-to-time | |
19232 | (substring (match-string 1) 0 10)))) | |
19233 | (or (memq day dates) (push day dates))) | |
19234 | (unless no-ranges | |
19235 | (goto-char beg) | |
19236 | (while (re-search-forward org-tr-regexp end t) | |
19237 | (setq ts1 (substring (match-string 1) 0 10) | |
19238 | ts2 (substring (match-string 2) 0 10) | |
19239 | day1 (time-to-days (org-time-string-to-time ts1)) | |
19240 | day2 (time-to-days (org-time-string-to-time ts2))) | |
19241 | (while (< (setq day1 (1+ day1)) day2) | |
19242 | (or (memq day1 dates) (push day1 dates))))) | |
19243 | (setq dates (sort dates '<)) | |
19244 | (when empty | |
19245 | (while (setq day (pop dates)) | |
19246 | (setq day2 (car dates)) | |
19247 | (push day dates1) | |
19248 | (when (and day2 empty) | |
19249 | (if (or (eq empty t) | |
19250 | (and (numberp empty) (<= (- day2 day) empty))) | |
19251 | (while (< (setq day (1+ day)) day2) | |
19252 | (push (list day) dates1)) | |
19253 | (push (cons :omitted (- day2 day)) dates1)))) | |
19254 | (setq dates (nreverse dates1))) | |
19255 | dates))) | |
791d856f | 19256 | |
d3f4dbe8 | 19257 | ;;; Agenda Daily/Weekly |
791d856f | 19258 | |
d3f4dbe8 | 19259 | (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter |
b38c6895 | 19260 | (defvar org-agenda-start-day nil) ; dynamically scoped parameter |
d3f4dbe8 CD |
19261 | (defvar org-agenda-last-arguments nil |
19262 | "The arguments of the previous call to org-agenda") | |
19263 | (defvar org-starting-day nil) ; local variable in the agenda buffer | |
38f8646b | 19264 | (defvar org-agenda-span nil) ; local variable in the agenda buffer |
d3f4dbe8 | 19265 | (defvar org-include-all-loc nil) ; local variable |
0b8568f5 | 19266 | (defvar org-agenda-remove-date nil) ; dynamically scoped |
791d856f CD |
19267 | |
19268 | ;;;###autoload | |
d3f4dbe8 | 19269 | (defun org-agenda-list (&optional include-all start-day ndays) |
257b8401 CD |
19270 | "Produce a daily/weekly view from all files in variable `org-agenda-files'. |
19271 | The view will be for the current day or week, but from the overview buffer | |
19272 | you will be able to go to other days/weeks. | |
19273 | ||
19274 | With one \\[universal-argument] prefix argument INCLUDE-ALL, | |
19275 | all unfinished TODO items will also be shown, before the agenda. | |
19276 | This feature is considered obsolete, please use the TODO list or a block | |
19277 | agenda instead. | |
19278 | ||
19279 | With a numeric prefix argument in an interactive call, the agenda will | |
19280 | span INCLUDE-ALL days. Lisp programs should instead specify NDAYS to change | |
19281 | the number of days. NDAYS defaults to `org-agenda-ndays'. | |
19282 | ||
d3f4dbe8 | 19283 | START-DAY defaults to TODAY, or to the most recent match for the weekday |
257b8401 | 19284 | given in `org-agenda-start-on-weekday'." |
d3f4dbe8 | 19285 | (interactive "P") |
257b8401 CD |
19286 | (if (and (integerp include-all) (> include-all 0)) |
19287 | (setq ndays include-all include-all nil)) | |
b38c6895 CD |
19288 | (setq ndays (or ndays org-agenda-ndays) |
19289 | start-day (or start-day org-agenda-start-day)) | |
d3f4dbe8 CD |
19290 | (if org-agenda-overriding-arguments |
19291 | (setq include-all (car org-agenda-overriding-arguments) | |
19292 | start-day (nth 1 org-agenda-overriding-arguments) | |
19293 | ndays (nth 2 org-agenda-overriding-arguments))) | |
b38c6895 CD |
19294 | (if (stringp start-day) |
19295 | ;; Convert to an absolute day number | |
19296 | (setq start-day (time-to-days (org-read-date nil t start-day)))) | |
d3f4dbe8 CD |
19297 | (setq org-agenda-last-arguments (list include-all start-day ndays)) |
19298 | (org-compile-prefix-format 'agenda) | |
19299 | (org-set-sorting-strategy 'agenda) | |
19300 | (require 'calendar) | |
19301 | (let* ((org-agenda-start-on-weekday | |
38f8646b CD |
19302 | (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays))) |
19303 | org-agenda-start-on-weekday nil)) | |
d3f4dbe8 CD |
19304 | (thefiles (org-agenda-files)) |
19305 | (files thefiles) | |
19306 | (today (time-to-days (current-time))) | |
19307 | (sd (or start-day today)) | |
19308 | (start (if (or (null org-agenda-start-on-weekday) | |
19309 | (< org-agenda-ndays 7)) | |
19310 | sd | |
19311 | (let* ((nt (calendar-day-of-week | |
19312 | (calendar-gregorian-from-absolute sd))) | |
19313 | (n1 org-agenda-start-on-weekday) | |
19314 | (d (- nt n1))) | |
19315 | (- sd (+ (if (< d 0) 7 0) d))))) | |
19316 | (day-numbers (list start)) | |
03f3cf35 | 19317 | (day-cnt 0) |
d3f4dbe8 CD |
19318 | (inhibit-redisplay (not debug-on-error)) |
19319 | s e rtn rtnall file date d start-pos end-pos todayp nd) | |
19320 | (setq org-agenda-redo-command | |
19321 | (list 'org-agenda-list (list 'quote include-all) start-day ndays)) | |
19322 | ;; Make the list of days | |
19323 | (setq ndays (or ndays org-agenda-ndays) | |
19324 | nd ndays) | |
19325 | (while (> ndays 1) | |
19326 | (push (1+ (car day-numbers)) day-numbers) | |
19327 | (setq ndays (1- ndays))) | |
19328 | (setq day-numbers (nreverse day-numbers)) | |
a3fbe8c4 | 19329 | (org-prepare-agenda "Day/Week") |
d3f4dbe8 CD |
19330 | (org-set-local 'org-starting-day (car day-numbers)) |
19331 | (org-set-local 'org-include-all-loc include-all) | |
38f8646b CD |
19332 | (org-set-local 'org-agenda-span |
19333 | (org-agenda-ndays-to-span nd)) | |
d3f4dbe8 CD |
19334 | (when (and (or include-all org-agenda-include-all-todo) |
19335 | (member today day-numbers)) | |
19336 | (setq files thefiles | |
19337 | rtnall nil) | |
19338 | (while (setq file (pop files)) | |
19339 | (catch 'nextfile | |
19340 | (org-check-agenda-file file) | |
19341 | (setq date (calendar-gregorian-from-absolute today) | |
19342 | rtn (org-agenda-get-day-entries | |
19343 | file date :todo)) | |
19344 | (setq rtnall (append rtnall rtn)))) | |
19345 | (when rtnall | |
19346 | (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") | |
19347 | (add-text-properties (point-min) (1- (point)) | |
a3fbe8c4 | 19348 | (list 'face 'org-agenda-structure)) |
d3f4dbe8 | 19349 | (insert (org-finalize-agenda-entries rtnall) "\n"))) |
15841868 JW |
19350 | (unless org-agenda-compact-blocks |
19351 | (setq s (point)) | |
19352 | (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) | |
19353 | "-agenda:\n") | |
19354 | (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure | |
19355 | 'org-date-line t))) | |
d3f4dbe8 CD |
19356 | (while (setq d (pop day-numbers)) |
19357 | (setq date (calendar-gregorian-from-absolute d) | |
19358 | s (point)) | |
19359 | (if (or (setq todayp (= d today)) | |
19360 | (and (not start-pos) (= d sd))) | |
19361 | (setq start-pos (point)) | |
19362 | (if (and start-pos (not end-pos)) | |
19363 | (setq end-pos (point)))) | |
19364 | (setq files thefiles | |
19365 | rtnall nil) | |
19366 | (while (setq file (pop files)) | |
19367 | (catch 'nextfile | |
19368 | (org-check-agenda-file file) | |
19369 | (if org-agenda-show-log | |
19370 | (setq rtn (org-agenda-get-day-entries | |
19371 | file date | |
a3fbe8c4 | 19372 | :deadline :scheduled :timestamp :sexp :closed)) |
d3f4dbe8 CD |
19373 | (setq rtn (org-agenda-get-day-entries |
19374 | file date | |
a3fbe8c4 | 19375 | :deadline :scheduled :sexp :timestamp))) |
d3f4dbe8 CD |
19376 | (setq rtnall (append rtnall rtn)))) |
19377 | (if org-agenda-include-diary | |
19378 | (progn | |
19379 | (require 'diary-lib) | |
19380 | (setq rtn (org-get-entries-from-diary date)) | |
19381 | (setq rtnall (append rtnall rtn)))) | |
19382 | (if (or rtnall org-agenda-show-all-dates) | |
19383 | (progn | |
03f3cf35 | 19384 | (setq day-cnt (1+ day-cnt)) |
d5098885 JW |
19385 | (insert |
19386 | (if (stringp org-agenda-format-date) | |
19387 | (format-time-string org-agenda-format-date | |
19388 | (org-time-from-absolute date)) | |
19389 | (funcall org-agenda-format-date date)) | |
19390 | "\n") | |
a3fbe8c4 | 19391 | (put-text-property s (1- (point)) 'face 'org-agenda-structure) |
d3f4dbe8 | 19392 | (put-text-property s (1- (point)) 'org-date-line t) |
03f3cf35 | 19393 | (put-text-property s (1- (point)) 'org-day-cnt day-cnt) |
d3f4dbe8 CD |
19394 | (if todayp (put-text-property s (1- (point)) 'org-today t)) |
19395 | (if rtnall (insert | |
19396 | (org-finalize-agenda-entries | |
19397 | (org-agenda-add-time-grid-maybe | |
19398 | rtnall nd todayp)) | |
19399 | "\n")) | |
03f3cf35 JW |
19400 | (put-text-property s (1- (point)) 'day d) |
19401 | (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) | |
d3f4dbe8 CD |
19402 | (goto-char (point-min)) |
19403 | (org-fit-agenda-window) | |
19404 | (unless (and (pos-visible-in-window-p (point-min)) | |
19405 | (pos-visible-in-window-p (point-max))) | |
19406 | (goto-char (1- (point-max))) | |
19407 | (recenter -1) | |
19408 | (if (not (pos-visible-in-window-p (or start-pos 1))) | |
19409 | (progn | |
19410 | (goto-char (or start-pos 1)) | |
19411 | (recenter 1)))) | |
19412 | (goto-char (or start-pos 1)) | |
19413 | (add-text-properties (point-min) (point-max) '(org-agenda-type agenda)) | |
19414 | (org-finalize-agenda) | |
19415 | (setq buffer-read-only t) | |
19416 | (message ""))) | |
19417 | ||
38f8646b CD |
19418 | (defun org-agenda-ndays-to-span (n) |
19419 | (cond ((< n 7) 'day) ((= n 7) 'week) ((< n 32) 'month) (t 'year))) | |
19420 | ||
d3f4dbe8 CD |
19421 | ;;; Agenda TODO list |
19422 | ||
19423 | (defvar org-select-this-todo-keyword nil) | |
19424 | (defvar org-last-arg nil) | |
791d856f CD |
19425 | |
19426 | ;;;###autoload | |
d3f4dbe8 CD |
19427 | (defun org-todo-list (arg) |
19428 | "Show all TODO entries from all agenda file in a single list. | |
19429 | The prefix arg can be used to select a specific TODO keyword and limit | |
19430 | the list to these. When using \\[universal-argument], you will be prompted | |
19431 | for a keyword. A numeric prefix directly selects the Nth keyword in | |
a3fbe8c4 | 19432 | `org-todo-keywords-1'." |
d3f4dbe8 CD |
19433 | (interactive "P") |
19434 | (require 'calendar) | |
19435 | (org-compile-prefix-format 'todo) | |
19436 | (org-set-sorting-strategy 'todo) | |
a3fbe8c4 | 19437 | (org-prepare-agenda "TODO") |
d3f4dbe8 CD |
19438 | (let* ((today (time-to-days (current-time))) |
19439 | (date (calendar-gregorian-from-absolute today)) | |
a3fbe8c4 | 19440 | (kwds org-todo-keywords-for-agenda) |
d3f4dbe8 CD |
19441 | (completion-ignore-case t) |
19442 | (org-select-this-todo-keyword | |
19443 | (if (stringp arg) arg | |
19444 | (and arg (integerp arg) (> arg 0) | |
a3fbe8c4 | 19445 | (nth (1- arg) kwds)))) |
d3f4dbe8 CD |
19446 | rtn rtnall files file pos) |
19447 | (when (equal arg '(4)) | |
19448 | (setq org-select-this-todo-keyword | |
a3fbe8c4 CD |
19449 | (completing-read "Keyword (or KWD1|K2D2|...): " |
19450 | (mapcar 'list kwds) nil nil))) | |
d3f4dbe8 | 19451 | (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) |
d3f4dbe8 | 19452 | (org-set-local 'org-last-arg arg) |
d3f4dbe8 CD |
19453 | (setq org-agenda-redo-command |
19454 | '(org-todo-list (or current-prefix-arg org-last-arg))) | |
19455 | (setq files (org-agenda-files) | |
19456 | rtnall nil) | |
19457 | (while (setq file (pop files)) | |
19458 | (catch 'nextfile | |
19459 | (org-check-agenda-file file) | |
19460 | (setq rtn (org-agenda-get-day-entries file date :todo)) | |
19461 | (setq rtnall (append rtnall rtn)))) | |
19462 | (if org-agenda-overriding-header | |
19463 | (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
a3fbe8c4 | 19464 | nil 'face 'org-agenda-structure) "\n") |
d3f4dbe8 CD |
19465 | (insert "Global list of TODO items of type: ") |
19466 | (add-text-properties (point-min) (1- (point)) | |
a3fbe8c4 | 19467 | (list 'face 'org-agenda-structure)) |
d3f4dbe8 CD |
19468 | (setq pos (point)) |
19469 | (insert (or org-select-this-todo-keyword "ALL") "\n") | |
19470 | (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
19471 | (setq pos (point)) | |
19472 | (unless org-agenda-multi | |
a3fbe8c4 CD |
19473 | (insert "Available with `N r': (0)ALL") |
19474 | (let ((n 0) s) | |
19475 | (mapc (lambda (x) | |
19476 | (setq s (format "(%d)%s" (setq n (1+ n)) x)) | |
19477 | (if (> (+ (current-column) (string-width s) 1) (frame-width)) | |
7d58338e | 19478 | (insert "\n ")) |
a3fbe8c4 CD |
19479 | (insert " " s)) |
19480 | kwds)) | |
19481 | (insert "\n")) | |
19482 | (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) | |
d3f4dbe8 CD |
19483 | (when rtnall |
19484 | (insert (org-finalize-agenda-entries rtnall) "\n")) | |
19485 | (goto-char (point-min)) | |
19486 | (org-fit-agenda-window) | |
19487 | (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) | |
19488 | (org-finalize-agenda) | |
19489 | (setq buffer-read-only t))) | |
19490 | ||
19491 | ;;; Agenda tags match | |
19492 | ||
19493 | ;;;###autoload | |
19494 | (defun org-tags-view (&optional todo-only match) | |
19495 | "Show all headlines for all `org-agenda-files' matching a TAGS criterion. | |
19496 | The prefix arg TODO-ONLY limits the search to TODO entries." | |
19497 | (interactive "P") | |
19498 | (org-compile-prefix-format 'tags) | |
19499 | (org-set-sorting-strategy 'tags) | |
19500 | (let* ((org-tags-match-list-sublevels | |
19501 | (if todo-only t org-tags-match-list-sublevels)) | |
19502 | (completion-ignore-case t) | |
19503 | rtn rtnall files file pos matcher | |
19504 | buffer) | |
19505 | (setq matcher (org-make-tags-matcher match) | |
19506 | match (car matcher) matcher (cdr matcher)) | |
a3fbe8c4 | 19507 | (org-prepare-agenda (concat "TAGS " match)) |
d3f4dbe8 CD |
19508 | (setq org-agenda-redo-command |
19509 | (list 'org-tags-view (list 'quote todo-only) | |
19510 | (list 'if 'current-prefix-arg nil match))) | |
19511 | (setq files (org-agenda-files) | |
19512 | rtnall nil) | |
19513 | (while (setq file (pop files)) | |
19514 | (catch 'nextfile | |
19515 | (org-check-agenda-file file) | |
19516 | (setq buffer (if (file-exists-p file) | |
19517 | (org-get-agenda-file-buffer file) | |
19518 | (error "No such file %s" file))) | |
19519 | (if (not buffer) | |
19520 | ;; If file does not exist, merror message to agenda | |
19521 | (setq rtn (list | |
19522 | (format "ORG-AGENDA-ERROR: No such org-file %s" file)) | |
19523 | rtnall (append rtnall rtn)) | |
19524 | (with-current-buffer buffer | |
19525 | (unless (org-mode-p) | |
19526 | (error "Agenda file %s is not in `org-mode'" file)) | |
d3f4dbe8 CD |
19527 | (save-excursion |
19528 | (save-restriction | |
19529 | (if org-agenda-restrict | |
19530 | (narrow-to-region org-agenda-restrict-begin | |
19531 | org-agenda-restrict-end) | |
19532 | (widen)) | |
19533 | (setq rtn (org-scan-tags 'agenda matcher todo-only)) | |
19534 | (setq rtnall (append rtnall rtn)))))))) | |
19535 | (if org-agenda-overriding-header | |
19536 | (insert (org-add-props (copy-sequence org-agenda-overriding-header) | |
a3fbe8c4 | 19537 | nil 'face 'org-agenda-structure) "\n") |
d3f4dbe8 CD |
19538 | (insert "Headlines with TAGS match: ") |
19539 | (add-text-properties (point-min) (1- (point)) | |
a3fbe8c4 | 19540 | (list 'face 'org-agenda-structure)) |
d3f4dbe8 CD |
19541 | (setq pos (point)) |
19542 | (insert match "\n") | |
19543 | (add-text-properties pos (1- (point)) (list 'face 'org-warning)) | |
19544 | (setq pos (point)) | |
19545 | (unless org-agenda-multi | |
19546 | (insert "Press `C-u r' to search again with new search string\n")) | |
a3fbe8c4 | 19547 | (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) |
d3f4dbe8 CD |
19548 | (when rtnall |
19549 | (insert (org-finalize-agenda-entries rtnall) "\n")) | |
19550 | (goto-char (point-min)) | |
19551 | (org-fit-agenda-window) | |
19552 | (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) | |
19553 | (org-finalize-agenda) | |
19554 | (setq buffer-read-only t))) | |
19555 | ||
19556 | ;;; Agenda Finding stuck projects | |
19557 | ||
19558 | (defvar org-agenda-skip-regexp nil | |
19559 | "Regular expression used in skipping subtrees for the agenda. | |
19560 | This is basically a temporary global variable that can be set and then | |
19561 | used by user-defined selections using `org-agenda-skip-function'.") | |
19562 | ||
19563 | (defvar org-agenda-overriding-header nil | |
19564 | "When this is set during todo and tags searches, will replace header.") | |
19565 | ||
19566 | (defun org-agenda-skip-subtree-when-regexp-matches () | |
19567 | "Checks if the current subtree contains match for `org-agenda-skip-regexp'. | |
19568 | If yes, it returns the end position of this tree, causing agenda commands | |
19569 | to skip this subtree. This is a function that can be put into | |
19570 | `org-agenda-skip-function' for the duration of a command." | |
48aaad2d CD |
19571 | (let ((end (save-excursion (org-end-of-subtree t))) |
19572 | skip) | |
19573 | (save-excursion | |
19574 | (setq skip (re-search-forward org-agenda-skip-regexp end t))) | |
19575 | (and skip end))) | |
19576 | ||
19577 | (defun org-agenda-skip-entry-if (&rest conditions) | |
15841868 | 19578 | "Skip entry if any of CONDITIONS is true. |
48aaad2d CD |
19579 | See `org-agenda-skip-if for details." |
19580 | (org-agenda-skip-if nil conditions)) | |
19581 | (defun org-agenda-skip-subtree-if (&rest conditions) | |
15841868 | 19582 | "Skip entry if any of CONDITIONS is true. |
48aaad2d CD |
19583 | See `org-agenda-skip-if for details." |
19584 | (org-agenda-skip-if t conditions)) | |
19585 | ||
19586 | (defun org-agenda-skip-if (subtree conditions) | |
19587 | "Checks current entity for CONDITIONS. | |
19588 | If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only | |
19589 | the entry, i.e. the text before the next heading is checked. | |
19590 | ||
19591 | CONDITIONS is a list of symbols, boolean OR is used to combine the results | |
19592 | from different tests. Valid conditions are: | |
19593 | ||
19594 | scheduled Check if there is a scheduled cookie | |
19595 | notscheduled Check if there is no scheduled cookie | |
19596 | deadline Check if there is a deadline | |
19597 | notdeadline Check if there is no deadline | |
19598 | regexp Check if regexp matches | |
19599 | notregexp Check if regexp does not match. | |
19600 | ||
19601 | The regexp is taken from the conditions list, it must com right after the | |
19602 | `regexp' of `notregexp' element. | |
19603 | ||
19604 | If any of these conditions is met, this function returns the end point of | |
19605 | the entity, causing the search to continue from there. This is a function | |
19606 | that can be put into `org-agenda-skip-function' for the duration of a command." | |
19607 | (let (beg end m r) | |
19608 | (org-back-to-heading t) | |
19609 | (setq beg (point) | |
19610 | end (if subtree | |
19611 | (progn (org-end-of-subtree t) (point)) | |
19612 | (progn (outline-next-heading) (1- (point))))) | |
19613 | (goto-char beg) | |
19614 | (and | |
19615 | (or | |
19616 | (and (memq 'scheduled conditions) | |
19617 | (re-search-forward org-scheduled-time-regexp end t)) | |
19618 | (and (memq 'notscheduled conditions) | |
19619 | (not (re-search-forward org-scheduled-time-regexp end t))) | |
19620 | (and (memq 'deadline conditions) | |
19621 | (re-search-forward org-deadline-time-regexp end t)) | |
19622 | (and (memq 'notdeadline conditions) | |
19623 | (not (re-search-forward org-deadline-time-regexp end t))) | |
19624 | (and (setq m (memq 'regexp conditions)) | |
19625 | (stringp (setq r (nth 1 m))) | |
374585c9 | 19626 | (re-search-forward (nth 1 m) end t)) |
48aaad2d CD |
19627 | (and (setq m (memq 'notregexp conditions)) |
19628 | (stringp (setq r (nth 1 m))) | |
374585c9 | 19629 | (not (re-search-forward (nth 1 m) end t)))) |
48aaad2d | 19630 | end))) |
d3f4dbe8 CD |
19631 | |
19632 | (defun org-agenda-list-stuck-projects (&rest ignore) | |
19633 | "Create agenda view for projects that are stuck. | |
19634 | Stuck projects are project that have no next actions. For the definitions | |
19635 | of what a project is and how to check if it stuck, customize the variable | |
19636 | `org-stuck-projects'. | |
19637 | MATCH is being ignored." | |
30313b90 | 19638 | (interactive) |
d3f4dbe8 | 19639 | (let* ((org-agenda-skip-function 'org-agenda-skip-subtree-when-regexp-matches) |
48aaad2d | 19640 | ;; FIXME: we could have used org-agenda-skip-if here. |
d3f4dbe8 CD |
19641 | (org-agenda-overriding-header "List of stuck projects: ") |
19642 | (matcher (nth 0 org-stuck-projects)) | |
19643 | (todo (nth 1 org-stuck-projects)) | |
a3fbe8c4 CD |
19644 | (todo-wds (if (member "*" todo) |
19645 | (progn | |
19646 | (org-prepare-agenda-buffers (org-agenda-files)) | |
19647 | (org-delete-all | |
19648 | org-done-keywords-for-agenda | |
19649 | (copy-sequence org-todo-keywords-for-agenda))) | |
19650 | todo)) | |
d3f4dbe8 | 19651 | (todo-re (concat "^\\*+[ \t]+\\(" |
a3fbe8c4 | 19652 | (mapconcat 'identity todo-wds "\\|") |
d3f4dbe8 | 19653 | "\\)\\>")) |
a3fbe8c4 CD |
19654 | (tags (nth 2 org-stuck-projects)) |
19655 | (tags-re (if (member "*" tags) | |
7d58338e CD |
19656 | (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") |
19657 | (concat "^\\*+ .*:\\(" | |
a3fbe8c4 | 19658 | (mapconcat 'identity tags "\\|") |
5152b597 | 19659 | (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) |
a3fbe8c4 CD |
19660 | (gen-re (nth 3 org-stuck-projects)) |
19661 | (re-list | |
19662 | (delq nil | |
19663 | (list | |
19664 | (if todo todo-re) | |
19665 | (if tags tags-re) | |
19666 | (and gen-re (stringp gen-re) (string-match "\\S-" gen-re) | |
19667 | gen-re))))) | |
d3f4dbe8 | 19668 | (setq org-agenda-skip-regexp |
a3fbe8c4 CD |
19669 | (if re-list |
19670 | (mapconcat 'identity re-list "\\|") | |
19671 | (error "No information how to identify unstuck projects"))) | |
d3f4dbe8 CD |
19672 | (org-tags-view nil matcher) |
19673 | (with-current-buffer org-agenda-buffer-name | |
19674 | (setq org-agenda-redo-command | |
19675 | '(org-agenda-list-stuck-projects | |
19676 | (or current-prefix-arg org-last-arg)))))) | |
19677 | ||
19678 | ;;; Diary integration | |
19679 | ||
19680 | (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. | |
19681 | ||
19682 | (defun org-get-entries-from-diary (date) | |
19683 | "Get the (Emacs Calendar) diary entries for DATE." | |
19684 | (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") | |
19685 | (diary-display-hook '(fancy-diary-display)) | |
374585c9 | 19686 | (pop-up-frames nil) |
d3f4dbe8 CD |
19687 | (list-diary-entries-hook |
19688 | (cons 'org-diary-default-entry list-diary-entries-hook)) | |
19689 | (diary-file-name-prefix-function nil) ; turn this feature off | |
19690 | (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) | |
19691 | entries | |
19692 | (org-disable-agenda-to-diary t)) | |
19693 | (save-excursion | |
19694 | (save-window-excursion | |
15841868 JW |
19695 | (funcall (if (fboundp 'diary-list-entries) |
19696 | 'diary-list-entries 'list-diary-entries) | |
19697 | date 1))) | |
d3f4dbe8 CD |
19698 | (if (not (get-buffer fancy-diary-buffer)) |
19699 | (setq entries nil) | |
19700 | (with-current-buffer fancy-diary-buffer | |
19701 | (setq buffer-read-only nil) | |
48aaad2d | 19702 | (if (zerop (buffer-size)) |
d3f4dbe8 CD |
19703 | ;; No entries |
19704 | (setq entries nil) | |
19705 | ;; Omit the date and other unnecessary stuff | |
19706 | (org-agenda-cleanup-fancy-diary) | |
19707 | ;; Add prefix to each line and extend the text properties | |
48aaad2d | 19708 | (if (zerop (buffer-size)) |
d3f4dbe8 CD |
19709 | (setq entries nil) |
19710 | (setq entries (buffer-substring (point-min) (- (point-max) 1))))) | |
19711 | (set-buffer-modified-p nil) | |
19712 | (kill-buffer fancy-diary-buffer))) | |
19713 | (when entries | |
19714 | (setq entries (org-split-string entries "\n")) | |
19715 | (setq entries | |
19716 | (mapcar | |
19717 | (lambda (x) | |
19718 | (setq x (org-format-agenda-item "" x "Diary" nil 'time)) | |
19719 | ;; Extend the text properties to the beginning of the line | |
a3fbe8c4 CD |
19720 | (org-add-props x (text-properties-at (1- (length x)) x) |
19721 | 'type "diary" 'date date)) | |
d3f4dbe8 CD |
19722 | entries))))) |
19723 | ||
19724 | (defun org-agenda-cleanup-fancy-diary () | |
19725 | "Remove unwanted stuff in buffer created by `fancy-diary-display'. | |
19726 | This gets rid of the date, the underline under the date, and | |
19727 | the dummy entry installed by `org-mode' to ensure non-empty diary for each | |
19728 | date. It also removes lines that contain only whitespace." | |
19729 | (goto-char (point-min)) | |
19730 | (if (looking-at ".*?:[ \t]*") | |
19731 | (progn | |
19732 | (replace-match "") | |
19733 | (re-search-forward "\n=+$" nil t) | |
19734 | (replace-match "") | |
19735 | (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) | |
19736 | (re-search-forward "\n=+$" nil t) | |
19737 | (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) | |
19738 | (goto-char (point-min)) | |
19739 | (while (re-search-forward "^ +\n" nil t) | |
19740 | (replace-match "")) | |
19741 | (goto-char (point-min)) | |
19742 | (if (re-search-forward "^Org-mode dummy\n?" nil t) | |
19743 | (replace-match ""))) | |
19744 | ||
19745 | ;; Make sure entries from the diary have the right text properties. | |
19746 | (eval-after-load "diary-lib" | |
19747 | '(if (boundp 'diary-modify-entry-list-string-function) | |
19748 | ;; We can rely on the hook, nothing to do | |
19749 | nil | |
19750 | ;; Hook not avaiable, must use advice to make this work | |
19751 | (defadvice add-to-diary-list (before org-mark-diary-entry activate) | |
19752 | "Make the position visible." | |
19753 | (if (and org-disable-agenda-to-diary ;; called from org-agenda | |
19754 | (stringp string) | |
19755 | buffer-file-name) | |
19756 | (setq string (org-modify-diary-entry-string string)))))) | |
19757 | ||
19758 | (defun org-modify-diary-entry-string (string) | |
19759 | "Add text properties to string, allowing org-mode to act on it." | |
19760 | (org-add-props string nil | |
19761 | 'mouse-face 'highlight | |
19762 | 'keymap org-agenda-keymap | |
b38c6895 CD |
19763 | 'help-echo (if buffer-file-name |
19764 | (format "mouse-2 or RET jump to diary file %s" | |
19765 | (abbreviate-file-name buffer-file-name)) | |
19766 | "") | |
d3f4dbe8 CD |
19767 | 'org-agenda-diary-link t |
19768 | 'org-marker (org-agenda-new-marker (point-at-bol)))) | |
19769 | ||
19770 | (defun org-diary-default-entry () | |
19771 | "Add a dummy entry to the diary. | |
19772 | Needed to avoid empty dates which mess up holiday display." | |
19773 | ;; Catch the error if dealing with the new add-to-diary-alist | |
19774 | (when org-disable-agenda-to-diary | |
19775 | (condition-case nil | |
19776 | (add-to-diary-list original-date "Org-mode dummy" "") | |
19777 | (error | |
19778 | (add-to-diary-list original-date "Org-mode dummy" "" nil))))) | |
19779 | ||
19780 | ;;;###autoload | |
19781 | (defun org-diary (&rest args) | |
19782 | "Return diary information from org-files. | |
19783 | This function can be used in a \"sexp\" diary entry in the Emacs calendar. | |
19784 | It accesses org files and extracts information from those files to be | |
19785 | listed in the diary. The function accepts arguments specifying what | |
19786 | items should be listed. The following arguments are allowed: | |
19787 | ||
19788 | :timestamp List the headlines of items containing a date stamp or | |
19789 | date range matching the selected date. Deadlines will | |
19790 | also be listed, on the expiration day. | |
19791 | ||
15841868 | 19792 | :sexp List entries resulting from diary-like sexps. |
a3fbe8c4 | 19793 | |
d3f4dbe8 CD |
19794 | :deadline List any deadlines past due, or due within |
19795 | `org-deadline-warning-days'. The listing occurs only | |
19796 | in the diary for *today*, not at any other date. If | |
19797 | an entry is marked DONE, it is no longer listed. | |
19798 | ||
19799 | :scheduled List all items which are scheduled for the given date. | |
19800 | The diary for *today* also contains items which were | |
19801 | scheduled earlier and are not yet marked DONE. | |
19802 | ||
19803 | :todo List all TODO items from the org-file. This may be a | |
19804 | long list - so this is not turned on by default. | |
19805 | Like deadlines, these entries only show up in the | |
19806 | diary for *today*, not at any other date. | |
19807 | ||
19808 | The call in the diary file should look like this: | |
19809 | ||
19810 | &%%(org-diary) ~/path/to/some/orgfile.org | |
19811 | ||
19812 | Use a separate line for each org file to check. Or, if you omit the file name, | |
19813 | all files listed in `org-agenda-files' will be checked automatically: | |
19814 | ||
19815 | &%%(org-diary) | |
19816 | ||
19817 | If you don't give any arguments (as in the example above), the default | |
a3fbe8c4 CD |
19818 | arguments (:deadline :scheduled :timestamp :sexp) are used. |
19819 | So the example above may also be written as | |
d3f4dbe8 | 19820 | |
a3fbe8c4 | 19821 | &%%(org-diary :deadline :timestamp :sexp :scheduled) |
d3f4dbe8 CD |
19822 | |
19823 | The function expects the lisp variables `entry' and `date' to be provided | |
19824 | by the caller, because this is how the calendar works. Don't use this | |
19825 | function from a program - use `org-agenda-get-day-entries' instead." | |
19826 | (org-agenda-maybe-reset-markers) | |
19827 | (org-compile-prefix-format 'agenda) | |
19828 | (org-set-sorting-strategy 'agenda) | |
a3fbe8c4 | 19829 | (setq args (or args '(:deadline :scheduled :timestamp :sexp))) |
d3f4dbe8 CD |
19830 | (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) |
19831 | (list entry) | |
19832 | (org-agenda-files t))) | |
19833 | file rtn results) | |
a3fbe8c4 | 19834 | (org-prepare-agenda-buffers files) |
d3f4dbe8 CD |
19835 | ;; If this is called during org-agenda, don't return any entries to |
19836 | ;; the calendar. Org Agenda will list these entries itself. | |
19837 | (if org-disable-agenda-to-diary (setq files nil)) | |
19838 | (while (setq file (pop files)) | |
19839 | (setq rtn (apply 'org-agenda-get-day-entries file date args)) | |
19840 | (setq results (append results rtn))) | |
19841 | (if results | |
19842 | (concat (org-finalize-agenda-entries results) "\n")))) | |
19843 | ||
19844 | ;;; Agenda entry finders | |
19845 | ||
19846 | (defun org-agenda-get-day-entries (file date &rest args) | |
19847 | "Does the work for `org-diary' and `org-agenda'. | |
19848 | FILE is the path to a file to be checked for entries. DATE is date like | |
19849 | the one returned by `calendar-current-date'. ARGS are symbols indicating | |
19850 | which kind of entries should be extracted. For details about these, see | |
19851 | the documentation of `org-diary'." | |
a3fbe8c4 | 19852 | (setq args (or args '(:deadline :scheduled :timestamp :sexp))) |
d3f4dbe8 CD |
19853 | (let* ((org-startup-folded nil) |
19854 | (org-startup-align-all-tables nil) | |
19855 | (buffer (if (file-exists-p file) | |
19856 | (org-get-agenda-file-buffer file) | |
19857 | (error "No such file %s" file))) | |
19858 | arg results rtn) | |
19859 | (if (not buffer) | |
19860 | ;; If file does not exist, make sure an error message ends up in diary | |
19861 | (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) | |
19862 | (with-current-buffer buffer | |
19863 | (unless (org-mode-p) | |
19864 | (error "Agenda file %s is not in `org-mode'" file)) | |
d3f4dbe8 CD |
19865 | (let ((case-fold-search nil)) |
19866 | (save-excursion | |
19867 | (save-restriction | |
19868 | (if org-agenda-restrict | |
19869 | (narrow-to-region org-agenda-restrict-begin | |
19870 | org-agenda-restrict-end) | |
19871 | (widen)) | |
19872 | ;; The way we repeatedly append to `results' makes it O(n^2) :-( | |
19873 | (while (setq arg (pop args)) | |
19874 | (cond | |
19875 | ((and (eq arg :todo) | |
19876 | (equal date (calendar-current-date))) | |
19877 | (setq rtn (org-agenda-get-todos)) | |
19878 | (setq results (append results rtn))) | |
19879 | ((eq arg :timestamp) | |
19880 | (setq rtn (org-agenda-get-blocks)) | |
19881 | (setq results (append results rtn)) | |
19882 | (setq rtn (org-agenda-get-timestamps)) | |
19883 | (setq results (append results rtn))) | |
a3fbe8c4 CD |
19884 | ((eq arg :sexp) |
19885 | (setq rtn (org-agenda-get-sexps)) | |
19886 | (setq results (append results rtn))) | |
d3f4dbe8 CD |
19887 | ((eq arg :scheduled) |
19888 | (setq rtn (org-agenda-get-scheduled)) | |
19889 | (setq results (append results rtn))) | |
19890 | ((eq arg :closed) | |
19891 | (setq rtn (org-agenda-get-closed)) | |
19892 | (setq results (append results rtn))) | |
48aaad2d | 19893 | ((eq arg :deadline) |
d3f4dbe8 CD |
19894 | (setq rtn (org-agenda-get-deadlines)) |
19895 | (setq results (append results rtn)))))))) | |
19896 | results)))) | |
19897 | ||
15841868 | 19898 | ;; FIXME: this works only if the cursor is *not* at the |
38f8646b | 19899 | ;; beginning of the entry |
03f3cf35 JW |
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 () | |
19907 | (member (org-get-todo-state) org-not-done-keywords)) | |
19908 | ||
d3f4dbe8 | 19909 | (defun org-entry-is-done-p () |
03f3cf35 JW |
19910 | (member (org-get-todo-state) org-done-keywords)) |
19911 | ||
19912 | (defun org-get-todo-state () | |
d3f4dbe8 | 19913 | (save-excursion |
03f3cf35 JW |
19914 | (org-back-to-heading t) |
19915 | (and (looking-at org-todo-line-regexp) | |
19916 | (match-end 2) | |
19917 | (match-string 2)))) | |
d3f4dbe8 CD |
19918 | |
19919 | (defun org-at-date-range-p (&optional inactive-ok) | |
19920 | "Is the cursor inside a date range?" | |
19921 | (interactive) | |
19922 | (save-excursion | |
19923 | (catch 'exit | |
19924 | (let ((pos (point))) | |
19925 | (skip-chars-backward "^[<\r\n") | |
19926 | (skip-chars-backward "<[") | |
19927 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
19928 | (>= (match-end 0) pos) | |
19929 | (throw 'exit t)) | |
19930 | (skip-chars-backward "^<[\r\n") | |
19931 | (skip-chars-backward "<[") | |
19932 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
19933 | (>= (match-end 0) pos) | |
19934 | (throw 'exit t))) | |
19935 | nil))) | |
19936 | ||
19937 | (defun org-agenda-get-todos () | |
19938 | "Return the TODO information for agenda display." | |
19939 | (let* ((props (list 'face nil | |
19940 | 'done-face 'org-done | |
19941 | 'org-not-done-regexp org-not-done-regexp | |
a3fbe8c4 | 19942 | 'org-todo-regexp org-todo-regexp |
d3f4dbe8 CD |
19943 | 'mouse-face 'highlight |
19944 | 'keymap org-agenda-keymap | |
19945 | 'help-echo | |
19946 | (format "mouse-2 or RET jump to org file %s" | |
19947 | (abbreviate-file-name buffer-file-name)))) | |
a3fbe8c4 | 19948 | ;; FIXME: get rid of the \n at some point but watch out |
48aaad2d | 19949 | (regexp (concat "^\\*+[ \t]+\\(" |
d3f4dbe8 | 19950 | (if org-select-this-todo-keyword |
a3fbe8c4 CD |
19951 | (if (equal org-select-this-todo-keyword "*") |
19952 | org-todo-regexp | |
19953 | (concat "\\<\\(" | |
19954 | (mapconcat 'identity (org-split-string org-select-this-todo-keyword "|") "\\|") | |
19955 | "\\)\\>")) | |
d3f4dbe8 CD |
19956 | org-not-done-regexp) |
19957 | "[^\n\r]*\\)")) | |
19958 | marker priority category tags | |
19959 | ee txt beg end) | |
19960 | (goto-char (point-min)) | |
19961 | (while (re-search-forward regexp nil t) | |
19962 | (catch :skip | |
19963 | (save-match-data | |
19964 | (beginning-of-line) | |
19965 | (setq beg (point) end (progn (outline-next-heading) (point))) | |
03f3cf35 JW |
19966 | (when (or (and org-agenda-todo-ignore-with-date (goto-char beg) |
19967 | (re-search-forward org-ts-regexp end t)) | |
19968 | (and org-agenda-todo-ignore-scheduled (goto-char beg) | |
d3f4dbe8 CD |
19969 | (re-search-forward org-scheduled-time-regexp end t)) |
19970 | (and org-agenda-todo-ignore-deadlines (goto-char beg) | |
19971 | (re-search-forward org-deadline-time-regexp end t) | |
19972 | (org-deadline-close (match-string 1)))) | |
374585c9 | 19973 | (goto-char (1+ beg)) |
d3f4dbe8 CD |
19974 | (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) |
19975 | (throw :skip nil))) | |
2198eb4e | 19976 | (goto-char beg) |
d3f4dbe8 CD |
19977 | (org-agenda-skip) |
19978 | (goto-char (match-beginning 1)) | |
48aaad2d | 19979 | (setq marker (org-agenda-new-marker (match-beginning 0)) |
d3f4dbe8 CD |
19980 | category (org-get-category) |
19981 | tags (org-get-tags-at (point)) | |
19982 | txt (org-format-agenda-item "" (match-string 1) category tags) | |
a3fbe8c4 | 19983 | priority (1+ (org-get-priority txt))) |
d3f4dbe8 CD |
19984 | (org-add-props txt props |
19985 | 'org-marker marker 'org-hd-marker marker | |
a3fbe8c4 CD |
19986 | 'priority priority 'org-category category |
19987 | 'type "todo") | |
d3f4dbe8 CD |
19988 | (push txt ee) |
19989 | (if org-agenda-todo-list-sublevels | |
19990 | (goto-char (match-end 1)) | |
19991 | (org-end-of-subtree 'invisible)))) | |
19992 | (nreverse ee))) | |
19993 | ||
19994 | (defconst org-agenda-no-heading-message | |
19995 | "No heading for this item in buffer or region.") | |
19996 | ||
19997 | (defun org-agenda-get-timestamps () | |
19998 | "Return the date stamp information for agenda display." | |
19999 | (let* ((props (list 'face nil | |
20000 | 'org-not-done-regexp org-not-done-regexp | |
a3fbe8c4 | 20001 | 'org-todo-regexp org-todo-regexp |
d3f4dbe8 CD |
20002 | 'mouse-face 'highlight |
20003 | 'keymap org-agenda-keymap | |
20004 | 'help-echo | |
20005 | (format "mouse-2 or RET jump to org file %s" | |
20006 | (abbreviate-file-name buffer-file-name)))) | |
a3fbe8c4 | 20007 | (d1 (calendar-absolute-from-gregorian date)) |
0b8568f5 JW |
20008 | (remove-re |
20009 | (concat | |
20010 | (regexp-quote | |
20011 | (format-time-string | |
20012 | "<%Y-%m-%d" | |
20013 | (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
20014 | ".*?>")) | |
a3fbe8c4 CD |
20015 | (regexp |
20016 | (concat | |
20017 | (regexp-quote | |
20018 | (substring | |
20019 | (format-time-string | |
20020 | (car org-time-stamp-formats) | |
20021 | (apply 'encode-time ; DATE bound by calendar | |
20022 | (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
20023 | 0 11)) | |
20024 | "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" | |
20025 | "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) | |
d3f4dbe8 | 20026 | marker hdmarker deadlinep scheduledp donep tmp priority category |
a3fbe8c4 | 20027 | ee txt timestr tags b0 b3 e3) |
d3f4dbe8 CD |
20028 | (goto-char (point-min)) |
20029 | (while (re-search-forward regexp nil t) | |
a3fbe8c4 CD |
20030 | (setq b0 (match-beginning 0) |
20031 | b3 (match-beginning 3) e3 (match-end 3)) | |
d3f4dbe8 | 20032 | (catch :skip |
a3fbe8c4 | 20033 | (and (org-at-date-range-p) (throw :skip nil)) |
d3f4dbe8 | 20034 | (org-agenda-skip) |
a3fbe8c4 CD |
20035 | (if (and (match-end 1) |
20036 | (not (= d1 (org-time-string-to-absolute (match-string 1) d1)))) | |
20037 | (throw :skip nil)) | |
20038 | (if (and e3 | |
20039 | (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) | |
20040 | (throw :skip nil)) | |
20041 | (setq marker (org-agenda-new-marker b0) | |
20042 | category (org-get-category b0) | |
d3f4dbe8 | 20043 | tmp (buffer-substring (max (point-min) |
a3fbe8c4 CD |
20044 | (- b0 org-ds-keyword-length)) |
20045 | b0) | |
20046 | timestr (if b3 "" (buffer-substring b0 (point-at-eol))) | |
d3f4dbe8 CD |
20047 | deadlinep (string-match org-deadline-regexp tmp) |
20048 | scheduledp (string-match org-scheduled-regexp tmp) | |
20049 | donep (org-entry-is-done-p)) | |
48aaad2d | 20050 | (if (or scheduledp deadlinep) (throw :skip t)) |
d3f4dbe8 CD |
20051 | (if (string-match ">" timestr) |
20052 | ;; substring should only run to end of time stamp | |
20053 | (setq timestr (substring timestr 0 (match-end 0)))) | |
20054 | (save-excursion | |
7d58338e | 20055 | (if (re-search-backward "^\\*+ " nil t) |
d3f4dbe8 | 20056 | (progn |
7d58338e | 20057 | (goto-char (match-beginning 0)) |
d3f4dbe8 CD |
20058 | (setq hdmarker (org-agenda-new-marker) |
20059 | tags (org-get-tags-at)) | |
7d58338e | 20060 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") |
d3f4dbe8 | 20061 | (setq txt (org-format-agenda-item |
0b8568f5 JW |
20062 | nil (match-string 1) category tags timestr nil |
20063 | remove-re))) | |
d3f4dbe8 CD |
20064 | (setq txt org-agenda-no-heading-message)) |
20065 | (setq priority (org-get-priority txt)) | |
20066 | (org-add-props txt props | |
20067 | 'org-marker marker 'org-hd-marker hdmarker) | |
48aaad2d CD |
20068 | (org-add-props txt nil 'priority priority |
20069 | 'org-category category 'date date | |
20070 | 'type "timestamp") | |
d3f4dbe8 CD |
20071 | (push txt ee)) |
20072 | (outline-next-heading))) | |
20073 | (nreverse ee))) | |
20074 | ||
a3fbe8c4 CD |
20075 | (defun org-agenda-get-sexps () |
20076 | "Return the sexp information for agenda display." | |
20077 | (require 'diary-lib) | |
20078 | (let* ((props (list 'face nil | |
20079 | 'mouse-face 'highlight | |
20080 | 'keymap org-agenda-keymap | |
20081 | 'help-echo | |
20082 | (format "mouse-2 or RET jump to org file %s" | |
20083 | (abbreviate-file-name buffer-file-name)))) | |
20084 | (regexp "^&?%%(") | |
20085 | marker category ee txt tags entry result beg b sexp sexp-entry) | |
20086 | (goto-char (point-min)) | |
20087 | (while (re-search-forward regexp nil t) | |
20088 | (catch :skip | |
20089 | (org-agenda-skip) | |
20090 | (setq beg (match-beginning 0)) | |
20091 | (goto-char (1- (match-end 0))) | |
20092 | (setq b (point)) | |
20093 | (forward-sexp 1) | |
20094 | (setq sexp (buffer-substring b (point))) | |
20095 | (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") | |
20096 | (org-trim (match-string 1)) | |
20097 | "")) | |
20098 | (setq result (org-diary-sexp-entry sexp sexp-entry date)) | |
20099 | (when result | |
20100 | (setq marker (org-agenda-new-marker beg) | |
20101 | category (org-get-category beg)) | |
20102 | ||
20103 | (if (string-match "\\S-" result) | |
20104 | (setq txt result) | |
20105 | (setq txt "SEXP entry returned empty string")) | |
20106 | ||
20107 | (setq txt (org-format-agenda-item | |
20108 | "" txt category tags 'time)) | |
20109 | (org-add-props txt props 'org-marker marker) | |
20110 | (org-add-props txt nil | |
20111 | 'org-category category 'date date | |
20112 | 'type "sexp") | |
20113 | (push txt ee)))) | |
20114 | (nreverse ee))) | |
20115 | ||
d3f4dbe8 CD |
20116 | (defun org-agenda-get-closed () |
20117 | "Return the logged TODO entries for agenda display." | |
20118 | (let* ((props (list 'mouse-face 'highlight | |
20119 | 'org-not-done-regexp org-not-done-regexp | |
a3fbe8c4 | 20120 | 'org-todo-regexp org-todo-regexp |
d3f4dbe8 CD |
20121 | 'keymap org-agenda-keymap |
20122 | 'help-echo | |
20123 | (format "mouse-2 or RET jump to org file %s" | |
20124 | (abbreviate-file-name buffer-file-name)))) | |
20125 | (regexp (concat | |
20126 | "\\<\\(" org-closed-string "\\|" org-clock-string "\\) *\\[" | |
20127 | (regexp-quote | |
20128 | (substring | |
20129 | (format-time-string | |
20130 | (car org-time-stamp-formats) | |
20131 | (apply 'encode-time ; DATE bound by calendar | |
20132 | (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) | |
20133 | 1 11)))) | |
20134 | marker hdmarker priority category tags closedp | |
20135 | ee txt timestr) | |
20136 | (goto-char (point-min)) | |
20137 | (while (re-search-forward regexp nil t) | |
20138 | (catch :skip | |
20139 | (org-agenda-skip) | |
20140 | (setq marker (org-agenda-new-marker (match-beginning 0)) | |
20141 | closedp (equal (match-string 1) org-closed-string) | |
20142 | category (org-get-category (match-beginning 0)) | |
20143 | timestr (buffer-substring (match-beginning 0) (point-at-eol)) | |
20144 | ;; donep (org-entry-is-done-p) | |
20145 | ) | |
20146 | (if (string-match "\\]" timestr) | |
20147 | ;; substring should only run to end of time stamp | |
20148 | (setq timestr (substring timestr 0 (match-end 0)))) | |
20149 | (save-excursion | |
7d58338e | 20150 | (if (re-search-backward "^\\*+ " nil t) |
d3f4dbe8 | 20151 | (progn |
7d58338e | 20152 | (goto-char (match-beginning 0)) |
d3f4dbe8 CD |
20153 | (setq hdmarker (org-agenda-new-marker) |
20154 | tags (org-get-tags-at)) | |
7d58338e | 20155 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") |
d3f4dbe8 CD |
20156 | (setq txt (org-format-agenda-item |
20157 | (if closedp "Closed: " "Clocked: ") | |
20158 | (match-string 1) category tags timestr))) | |
20159 | (setq txt org-agenda-no-heading-message)) | |
20160 | (setq priority 100000) | |
20161 | (org-add-props txt props | |
20162 | 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done | |
20163 | 'priority priority 'org-category category | |
a3fbe8c4 | 20164 | 'type "closed" 'date date |
d3f4dbe8 CD |
20165 | 'undone-face 'org-warning 'done-face 'org-done) |
20166 | (push txt ee)) | |
20167 | (outline-next-heading))) | |
20168 | (nreverse ee))) | |
20169 | ||
20170 | (defun org-agenda-get-deadlines () | |
20171 | "Return the deadline information for agenda display." | |
48aaad2d | 20172 | (let* ((props (list 'mouse-face 'highlight |
d3f4dbe8 | 20173 | 'org-not-done-regexp org-not-done-regexp |
a3fbe8c4 | 20174 | 'org-todo-regexp org-todo-regexp |
d3f4dbe8 CD |
20175 | 'keymap org-agenda-keymap |
20176 | 'help-echo | |
20177 | (format "mouse-2 or RET jump to org file %s" | |
20178 | (abbreviate-file-name buffer-file-name)))) | |
20179 | (regexp org-deadline-time-regexp) | |
20180 | (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
20181 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
48aaad2d | 20182 | d2 diff dfrac wdays pos pos1 category tags |
374585c9 | 20183 | ee txt head face s upcomingp donep timestr) |
d3f4dbe8 CD |
20184 | (goto-char (point-min)) |
20185 | (while (re-search-forward regexp nil t) | |
20186 | (catch :skip | |
20187 | (org-agenda-skip) | |
48aaad2d CD |
20188 | (setq s (match-string 1) |
20189 | pos (1- (match-beginning 1)) | |
a3fbe8c4 | 20190 | d2 (org-time-string-to-absolute (match-string 1) d1) |
0b8568f5 JW |
20191 | diff (- d2 d1) |
20192 | wdays (org-get-wdays s) | |
20193 | dfrac (/ (* 1.0 (- wdays diff)) wdays) | |
20194 | upcomingp (and todayp (> diff 0))) | |
d3f4dbe8 CD |
20195 | ;; When to show a deadline in the calendar: |
20196 | ;; If the expiration is within wdays warning time. | |
20197 | ;; Past-due deadlines are only shown on the current date | |
03f3cf35 JW |
20198 | (if (or (and (<= diff wdays) |
20199 | (and todayp (not org-agenda-only-exact-dates))) | |
48aaad2d | 20200 | (= diff 0)) |
d3f4dbe8 CD |
20201 | (save-excursion |
20202 | (setq category (org-get-category)) | |
7d58338e | 20203 | (if (re-search-backward "^\\*+[ \t]+" nil t) |
d3f4dbe8 CD |
20204 | (progn |
20205 | (goto-char (match-end 0)) | |
7d58338e | 20206 | (setq pos1 (match-beginning 0)) |
d3f4dbe8 CD |
20207 | (setq tags (org-get-tags-at pos1)) |
20208 | (setq head (buffer-substring-no-properties | |
20209 | (point) | |
20210 | (progn (skip-chars-forward "^\r\n") | |
20211 | (point)))) | |
374585c9 CD |
20212 | (setq donep (string-match org-looking-at-done-regexp head)) |
20213 | (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) | |
20214 | (setq timestr | |
20215 | (concat (substring s (match-beginning 1)) " ")) | |
20216 | (setq timestr 'time)) | |
20217 | (if (and donep | |
20218 | (or org-agenda-skip-deadline-if-done | |
20219 | (not (= diff 0)))) | |
d3f4dbe8 CD |
20220 | (setq txt nil) |
20221 | (setq txt (org-format-agenda-item | |
48aaad2d | 20222 | (if (= diff 0) |
03f3cf35 JW |
20223 | (car org-agenda-deadline-leaders) |
20224 | (format (nth 1 org-agenda-deadline-leaders) | |
20225 | diff)) | |
374585c9 | 20226 | head category tags timestr)))) |
d3f4dbe8 CD |
20227 | (setq txt org-agenda-no-heading-message)) |
20228 | (when txt | |
48aaad2d | 20229 | (setq face (org-agenda-deadline-face dfrac)) |
d3f4dbe8 CD |
20230 | (org-add-props txt props |
20231 | 'org-marker (org-agenda-new-marker pos) | |
20232 | 'org-hd-marker (org-agenda-new-marker pos1) | |
48aaad2d CD |
20233 | 'priority (+ (if upcomingp (floor (* dfrac 10.)) 100) |
20234 | (org-get-priority txt)) | |
d3f4dbe8 | 20235 | 'org-category category |
48aaad2d CD |
20236 | 'type (if upcomingp "upcoming-deadline" "deadline") |
20237 | 'date (if upcomingp date d2) | |
374585c9 CD |
20238 | 'face (if donep 'org-done face) |
20239 | 'undone-face face 'done-face 'org-done) | |
d3f4dbe8 | 20240 | (push txt ee)))))) |
0b8568f5 | 20241 | (nreverse ee))) |
d3f4dbe8 | 20242 | |
48aaad2d CD |
20243 | (defun org-agenda-deadline-face (fraction) |
20244 | "Return the face to displaying a deadline item. | |
20245 | FRACTION is what fraction of the head-warning time has passed." | |
20246 | (let ((faces org-agenda-deadline-faces) f) | |
20247 | (catch 'exit | |
20248 | (while (setq f (pop faces)) | |
20249 | (if (>= fraction (car f)) (throw 'exit (cdr f))))))) | |
20250 | ||
d3f4dbe8 CD |
20251 | (defun org-agenda-get-scheduled () |
20252 | "Return the scheduled information for agenda display." | |
48aaad2d | 20253 | (let* ((props (list 'org-not-done-regexp org-not-done-regexp |
a3fbe8c4 | 20254 | 'org-todo-regexp org-todo-regexp |
d3f4dbe8 CD |
20255 | 'done-face 'org-done |
20256 | 'mouse-face 'highlight | |
20257 | 'keymap org-agenda-keymap | |
20258 | 'help-echo | |
20259 | (format "mouse-2 or RET jump to org file %s" | |
20260 | (abbreviate-file-name buffer-file-name)))) | |
20261 | (regexp org-scheduled-time-regexp) | |
20262 | (todayp (equal date (calendar-current-date))) ; DATE bound by calendar | |
20263 | (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar | |
20264 | d2 diff pos pos1 category tags | |
374585c9 | 20265 | ee txt head pastschedp donep face timestr s) |
d3f4dbe8 CD |
20266 | (goto-char (point-min)) |
20267 | (while (re-search-forward regexp nil t) | |
20268 | (catch :skip | |
20269 | (org-agenda-skip) | |
374585c9 CD |
20270 | (setq s (match-string 1) |
20271 | pos (1- (match-beginning 1)) | |
a3fbe8c4 | 20272 | d2 (org-time-string-to-absolute (match-string 1) d1) |
d3f4dbe8 | 20273 | diff (- d2 d1)) |
374585c9 | 20274 | (setq pastschedp (and todayp (< diff 0))) |
d3f4dbe8 CD |
20275 | ;; When to show a scheduled item in the calendar: |
20276 | ;; If it is on or past the date. | |
03f3cf35 JW |
20277 | (if (or (and (< diff 0) |
20278 | (and todayp (not org-agenda-only-exact-dates))) | |
48aaad2d | 20279 | (= diff 0)) |
d3f4dbe8 CD |
20280 | (save-excursion |
20281 | (setq category (org-get-category)) | |
7d58338e | 20282 | (if (re-search-backward "^\\*+[ \t]+" nil t) |
d3f4dbe8 CD |
20283 | (progn |
20284 | (goto-char (match-end 0)) | |
7d58338e | 20285 | (setq pos1 (match-beginning 0)) |
d3f4dbe8 CD |
20286 | (setq tags (org-get-tags-at)) |
20287 | (setq head (buffer-substring-no-properties | |
20288 | (point) | |
20289 | (progn (skip-chars-forward "^\r\n") (point)))) | |
48aaad2d | 20290 | (setq donep (string-match org-looking-at-done-regexp head)) |
374585c9 CD |
20291 | (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) |
20292 | (setq timestr | |
20293 | (concat (substring s (match-beginning 1)) " ")) | |
20294 | (setq timestr 'time)) | |
20295 | (if (and donep | |
20296 | (or org-agenda-skip-scheduled-if-done | |
20297 | (not (= diff 0)))) | |
d3f4dbe8 CD |
20298 | (setq txt nil) |
20299 | (setq txt (org-format-agenda-item | |
48aaad2d | 20300 | (if (= diff 0) |
03f3cf35 JW |
20301 | (car org-agenda-scheduled-leaders) |
20302 | (format (nth 1 org-agenda-scheduled-leaders) | |
20303 | (- 1 diff))) | |
374585c9 | 20304 | head category tags timestr)))) |
d3f4dbe8 CD |
20305 | (setq txt org-agenda-no-heading-message)) |
20306 | (when txt | |
374585c9 | 20307 | (setq face (if pastschedp |
48aaad2d CD |
20308 | 'org-scheduled-previously |
20309 | 'org-scheduled-today)) | |
d3f4dbe8 | 20310 | (org-add-props txt props |
48aaad2d CD |
20311 | 'undone-face face |
20312 | 'face (if donep 'org-done face) | |
d3f4dbe8 CD |
20313 | 'org-marker (org-agenda-new-marker pos) |
20314 | 'org-hd-marker (org-agenda-new-marker pos1) | |
374585c9 CD |
20315 | 'type (if pastschedp "past-scheduled" "scheduled") |
20316 | 'date (if pastschedp d2 date) | |
15841868 | 20317 | 'priority (+ 94 (- 5 diff) (org-get-priority txt)) |
d3f4dbe8 CD |
20318 | 'org-category category) |
20319 | (push txt ee)))))) | |
0b8568f5 | 20320 | (nreverse ee))) |
d3f4dbe8 CD |
20321 | |
20322 | (defun org-agenda-get-blocks () | |
20323 | "Return the date-range information for agenda display." | |
20324 | (let* ((props (list 'face nil | |
20325 | 'org-not-done-regexp org-not-done-regexp | |
a3fbe8c4 | 20326 | 'org-todo-regexp org-todo-regexp |
d3f4dbe8 CD |
20327 | 'mouse-face 'highlight |
20328 | 'keymap org-agenda-keymap | |
20329 | 'help-echo | |
20330 | (format "mouse-2 or RET jump to org file %s" | |
20331 | (abbreviate-file-name buffer-file-name)))) | |
20332 | (regexp org-tr-regexp) | |
20333 | (d0 (calendar-absolute-from-gregorian date)) | |
20334 | marker hdmarker ee txt d1 d2 s1 s2 timestr category tags pos) | |
20335 | (goto-char (point-min)) | |
20336 | (while (re-search-forward regexp nil t) | |
20337 | (catch :skip | |
20338 | (org-agenda-skip) | |
20339 | (setq pos (point)) | |
20340 | (setq timestr (match-string 0) | |
20341 | s1 (match-string 1) | |
20342 | s2 (match-string 2) | |
20343 | d1 (time-to-days (org-time-string-to-time s1)) | |
20344 | d2 (time-to-days (org-time-string-to-time s2))) | |
20345 | (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) | |
20346 | ;; Only allow days between the limits, because the normal | |
20347 | ;; date stamps will catch the limits. | |
20348 | (save-excursion | |
20349 | (setq marker (org-agenda-new-marker (point))) | |
20350 | (setq category (org-get-category)) | |
7d58338e | 20351 | (if (re-search-backward "^\\*+ " nil t) |
d3f4dbe8 | 20352 | (progn |
7d58338e CD |
20353 | (goto-char (match-beginning 0)) |
20354 | (setq hdmarker (org-agenda-new-marker (point))) | |
d3f4dbe8 | 20355 | (setq tags (org-get-tags-at)) |
7d58338e | 20356 | (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") |
d3f4dbe8 CD |
20357 | (setq txt (org-format-agenda-item |
20358 | (format (if (= d1 d2) "" "(%d/%d): ") | |
20359 | (1+ (- d0 d1)) (1+ (- d2 d1))) | |
20360 | (match-string 1) category tags | |
20361 | (if (= d0 d1) timestr)))) | |
20362 | (setq txt org-agenda-no-heading-message)) | |
20363 | (org-add-props txt props | |
20364 | 'org-marker marker 'org-hd-marker hdmarker | |
a3fbe8c4 | 20365 | 'type "block" 'date date |
d3f4dbe8 CD |
20366 | 'priority (org-get-priority txt) 'org-category category) |
20367 | (push txt ee))) | |
20368 | (goto-char pos))) | |
20369 | ;; Sort the entries by expiration date. | |
20370 | (nreverse ee))) | |
20371 | ||
20372 | ;;; Agenda presentation and sorting | |
20373 | ||
d3f4dbe8 CD |
20374 | (defconst org-plain-time-of-day-regexp |
20375 | (concat | |
20376 | "\\(\\<[012]?[0-9]" | |
20377 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
20378 | "\\(--?" | |
20379 | "\\(\\<[012]?[0-9]" | |
20380 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
20381 | "\\)?") | |
20382 | "Regular expression to match a plain time or time range. | |
20383 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
20384 | groups carry important information: | |
20385 | 0 the full match | |
20386 | 1 the first time, range or not | |
20387 | 8 the second time, if it is a range.") | |
20388 | ||
15841868 JW |
20389 | (defconst org-plain-time-extension-regexp |
20390 | (concat | |
20391 | "\\(\\<[012]?[0-9]" | |
20392 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
20393 | "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?") | |
20394 | "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40. | |
20395 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
20396 | groups carry important information: | |
20397 | 0 the full match | |
20398 | 7 hours of duration | |
20399 | 9 minutes of duration") | |
20400 | ||
d3f4dbe8 CD |
20401 | (defconst org-stamp-time-of-day-regexp |
20402 | (concat | |
20403 | "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" | |
b38c6895 | 20404 | "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>" |
d3f4dbe8 CD |
20405 | "\\(--?" |
20406 | "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") | |
20407 | "Regular expression to match a timestamp time or time range. | |
20408 | After a match, the following groups carry important information: | |
20409 | 0 the full match | |
20410 | 1 date plus weekday, for backreferencing to make sure both times on same day | |
20411 | 2 the first time, range or not | |
20412 | 4 the second time, if it is a range.") | |
20413 | ||
20414 | (defvar org-prefix-has-time nil | |
20415 | "A flag, set by `org-compile-prefix-format'. | |
20416 | The flag is set if the currently compiled format contains a `%t'.") | |
20417 | (defvar org-prefix-has-tag nil | |
20418 | "A flag, set by `org-compile-prefix-format'. | |
20419 | The flag is set if the currently compiled format contains a `%T'.") | |
20420 | ||
20421 | (defun org-format-agenda-item (extra txt &optional category tags dotime | |
0b8568f5 | 20422 | noprefix remove-re) |
d3f4dbe8 CD |
20423 | "Format TXT to be inserted into the agenda buffer. |
20424 | In particular, it adds the prefix and corresponding text properties. EXTRA | |
20425 | must be a string and replaces the `%s' specifier in the prefix format. | |
20426 | CATEGORY (string, symbol or nil) may be used to overrule the default | |
20427 | category taken from local variable or file name. It will replace the `%c' | |
20428 | specifier in the format. DOTIME, when non-nil, indicates that a | |
20429 | time-of-day should be extracted from TXT for sorting of this entry, and for | |
20430 | the `%t' specifier in the format. When DOTIME is a string, this string is | |
20431 | searched for a time before TXT is. NOPREFIX is a flag and indicates that | |
20432 | only the correctly processes TXT should be returned - this is used by | |
0b8568f5 JW |
20433 | `org-agenda-change-all-lines'. TAGS can be the tags of the headline. |
20434 | Any match of REMOVE-RE will be removed from TXT." | |
d3f4dbe8 CD |
20435 | (save-match-data |
20436 | ;; Diary entries sometimes have extra whitespace at the beginning | |
20437 | (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) | |
20438 | (let* ((category (or category | |
20439 | org-category | |
20440 | (if buffer-file-name | |
20441 | (file-name-sans-extension | |
20442 | (file-name-nondirectory buffer-file-name)) | |
20443 | ""))) | |
20444 | (tag (if tags (nth (1- (length tags)) tags) "")) | |
20445 | time ; time and tag are needed for the eval of the prefix format | |
20446 | (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) | |
20447 | (time-of-day (and dotime (org-get-time-of-day ts))) | |
b38c6895 | 20448 | stamp plain s0 s1 s2 rtn srp) |
d3f4dbe8 CD |
20449 | (when (and dotime time-of-day org-prefix-has-time) |
20450 | ;; Extract starting and ending time and move them to prefix | |
20451 | (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) | |
20452 | (setq plain (string-match org-plain-time-of-day-regexp ts))) | |
20453 | (setq s0 (match-string 0 ts) | |
b38c6895 | 20454 | srp (and stamp (match-end 3)) |
d3f4dbe8 | 20455 | s1 (match-string (if plain 1 2) ts) |
b38c6895 | 20456 | s2 (match-string (if plain 8 (if srp 4 6)) ts)) |
d3f4dbe8 CD |
20457 | |
20458 | ;; If the times are in TXT (not in DOTIMES), and the prefix will list | |
20459 | ;; them, we might want to remove them there to avoid duplication. | |
20460 | ;; The user can turn this off with a variable. | |
20461 | (if (and org-agenda-remove-times-when-in-prefix (or stamp plain) | |
20462 | (string-match (concat (regexp-quote s0) " *") txt) | |
03f3cf35 | 20463 | (not (equal ?\] (string-to-char (substring txt (match-end 0))))) |
d3f4dbe8 CD |
20464 | (if (eq org-agenda-remove-times-when-in-prefix 'beg) |
20465 | (= (match-beginning 0) 0) | |
20466 | t)) | |
20467 | (setq txt (replace-match "" nil nil txt)))) | |
20468 | ;; Normalize the time(s) to 24 hour | |
20469 | (if s1 (setq s1 (org-get-time-of-day s1 'string t))) | |
20470 | (if s2 (setq s2 (org-get-time-of-day s2 'string t)))) | |
20471 | ||
5152b597 CD |
20472 | (when (and s1 (not s2) org-agenda-default-appointment-duration |
20473 | (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1)) | |
20474 | (let ((m (+ (string-to-number (match-string 2 s1)) | |
20475 | (* 60 (string-to-number (match-string 1 s1))) | |
20476 | org-agenda-default-appointment-duration)) | |
20477 | h) | |
20478 | (setq h (/ m 60) m (- m (* h 60))) | |
20479 | (setq s2 (format "%02d:%02d" h m)))) | |
20480 | ||
20481 | (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") | |
20482 | txt) | |
d3f4dbe8 | 20483 | ;; Tags are in the string |
a3fbe8c4 CD |
20484 | (if (or (eq org-agenda-remove-tags t) |
20485 | (and org-agenda-remove-tags | |
d3f4dbe8 CD |
20486 | org-prefix-has-tag)) |
20487 | (setq txt (replace-match "" t t txt)) | |
20488 | (setq txt (replace-match | |
20489 | (concat (make-string (max (- 50 (length txt)) 1) ?\ ) | |
20490 | (match-string 2 txt)) | |
20491 | t t txt)))) | |
20492 | ||
0b8568f5 JW |
20493 | (when remove-re |
20494 | (while (string-match remove-re txt) | |
20495 | (setq txt (replace-match "" t t txt)))) | |
20496 | ||
d3f4dbe8 CD |
20497 | ;; Create the final string |
20498 | (if noprefix | |
20499 | (setq rtn txt) | |
20500 | ;; Prepare the variables needed in the eval of the compiled format | |
20501 | (setq time (cond (s2 (concat s1 "-" s2)) | |
20502 | (s1 (concat s1 "......")) | |
20503 | (t "")) | |
20504 | extra (or extra "") | |
20505 | category (if (symbolp category) (symbol-name category) category)) | |
20506 | ;; Evaluate the compiled format | |
20507 | (setq rtn (concat (eval org-prefix-format-compiled) txt))) | |
20508 | ||
20509 | ;; And finally add the text properties | |
20510 | (org-add-props rtn nil | |
20511 | 'org-category (downcase category) 'tags tags | |
03f3cf35 JW |
20512 | 'org-highest-priority org-highest-priority |
20513 | 'org-lowest-priority org-lowest-priority | |
d3f4dbe8 CD |
20514 | 'prefix-length (- (length rtn) (length txt)) |
20515 | 'time-of-day time-of-day | |
a3fbe8c4 CD |
20516 | 'txt txt |
20517 | 'time time | |
20518 | 'extra extra | |
d3f4dbe8 CD |
20519 | 'dotime dotime)))) |
20520 | ||
a3fbe8c4 | 20521 | (defvar org-agenda-sorting-strategy) ;; FIXME: can be removed? |
d3f4dbe8 CD |
20522 | (defvar org-agenda-sorting-strategy-selected nil) |
20523 | ||
20524 | (defun org-agenda-add-time-grid-maybe (list ndays todayp) | |
20525 | (catch 'exit | |
20526 | (cond ((not org-agenda-use-time-grid) (throw 'exit list)) | |
20527 | ((and todayp (member 'today (car org-agenda-time-grid)))) | |
20528 | ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) | |
20529 | ((member 'weekly (car org-agenda-time-grid))) | |
20530 | (t (throw 'exit list))) | |
20531 | (let* ((have (delq nil (mapcar | |
20532 | (lambda (x) (get-text-property 1 'time-of-day x)) | |
20533 | list))) | |
20534 | (string (nth 1 org-agenda-time-grid)) | |
20535 | (gridtimes (nth 2 org-agenda-time-grid)) | |
20536 | (req (car org-agenda-time-grid)) | |
20537 | (remove (member 'remove-match req)) | |
20538 | new time) | |
20539 | (if (and (member 'require-timed req) (not have)) | |
20540 | ;; don't show empty grid | |
20541 | (throw 'exit list)) | |
20542 | (while (setq time (pop gridtimes)) | |
20543 | (unless (and remove (member time have)) | |
20544 | (setq time (int-to-string time)) | |
20545 | (push (org-format-agenda-item | |
20546 | nil string "" nil | |
20547 | (concat (substring time 0 -2) ":" (substring time -2))) | |
20548 | new) | |
20549 | (put-text-property | |
20550 | 1 (length (car new)) 'face 'org-time-grid (car new)))) | |
20551 | (if (member 'time-up org-agenda-sorting-strategy-selected) | |
20552 | (append new list) | |
20553 | (append list new))))) | |
20554 | ||
20555 | (defun org-compile-prefix-format (key) | |
20556 | "Compile the prefix format into a Lisp form that can be evaluated. | |
20557 | The resulting form is returned and stored in the variable | |
20558 | `org-prefix-format-compiled'." | |
20559 | (setq org-prefix-has-time nil org-prefix-has-tag nil) | |
20560 | (let ((s (cond | |
20561 | ((stringp org-agenda-prefix-format) | |
20562 | org-agenda-prefix-format) | |
20563 | ((assq key org-agenda-prefix-format) | |
20564 | (cdr (assq key org-agenda-prefix-format))) | |
20565 | (t " %-12:c%?-12t% s"))) | |
20566 | (start 0) | |
20567 | varform vars var e c f opt) | |
20568 | (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" | |
20569 | s start) | |
20570 | (setq var (cdr (assoc (match-string 4 s) | |
20571 | '(("c" . category) ("t" . time) ("s" . extra) | |
20572 | ("T" . tag)))) | |
20573 | c (or (match-string 3 s) "") | |
20574 | opt (match-beginning 1) | |
20575 | start (1+ (match-beginning 0))) | |
20576 | (if (equal var 'time) (setq org-prefix-has-time t)) | |
20577 | (if (equal var 'tag) (setq org-prefix-has-tag t)) | |
20578 | (setq f (concat "%" (match-string 2 s) "s")) | |
20579 | (if opt | |
20580 | (setq varform | |
20581 | `(if (equal "" ,var) | |
20582 | "" | |
20583 | (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) | |
20584 | (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c))))) | |
20585 | (setq s (replace-match "%s" t nil s)) | |
20586 | (push varform vars)) | |
20587 | (setq vars (nreverse vars)) | |
20588 | (setq org-prefix-format-compiled `(format ,s ,@vars)))) | |
20589 | ||
20590 | (defun org-set-sorting-strategy (key) | |
20591 | (if (symbolp (car org-agenda-sorting-strategy)) | |
20592 | ;; the old format | |
20593 | (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy) | |
20594 | (setq org-agenda-sorting-strategy-selected | |
20595 | (or (cdr (assq key org-agenda-sorting-strategy)) | |
20596 | (cdr (assq 'agenda org-agenda-sorting-strategy)) | |
20597 | '(time-up category-keep priority-down))))) | |
20598 | ||
20599 | (defun org-get-time-of-day (s &optional string mod24) | |
20600 | "Check string S for a time of day. | |
20601 | If found, return it as a military time number between 0 and 2400. | |
20602 | If not found, return nil. | |
20603 | The optional STRING argument forces conversion into a 5 character wide string | |
20604 | HH:MM." | |
20605 | (save-match-data | |
20606 | (when | |
03f3cf35 JW |
20607 | (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) |
20608 | (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) | |
d3f4dbe8 CD |
20609 | (let* ((h (string-to-number (match-string 1 s))) |
20610 | (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) | |
20611 | (ampm (if (match-end 4) (downcase (match-string 4 s)))) | |
20612 | (am-p (equal ampm "am")) | |
20613 | (h1 (cond ((not ampm) h) | |
20614 | ((= h 12) (if am-p 0 12)) | |
20615 | (t (+ h (if am-p 0 12))))) | |
20616 | (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) | |
20617 | (mod h1 24) h1)) | |
20618 | (t0 (+ (* 100 h2) m)) | |
20619 | (t1 (concat (if (>= h1 24) "+" " ") | |
20620 | (if (< t0 100) "0" "") | |
20621 | (if (< t0 10) "0" "") | |
20622 | (int-to-string t0)))) | |
20623 | (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) | |
20624 | ||
20625 | (defun org-finalize-agenda-entries (list &optional nosort) | |
20626 | "Sort and concatenate the agenda items." | |
20627 | (setq list (mapcar 'org-agenda-highlight-todo list)) | |
20628 | (if nosort | |
20629 | list | |
20630 | (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) | |
20631 | ||
20632 | (defun org-agenda-highlight-todo (x) | |
20633 | (let (re pl) | |
20634 | (if (eq x 'line) | |
20635 | (save-excursion | |
20636 | (beginning-of-line 1) | |
374585c9 | 20637 | (setq re (get-text-property (point) 'org-todo-regexp)) |
d3f4dbe8 CD |
20638 | (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) |
20639 | (and (looking-at (concat "[ \t]*\\.*" re)) | |
20640 | (add-text-properties (match-beginning 0) (match-end 0) | |
374585c9 CD |
20641 | (list 'face (org-get-todo-face 0))))) |
20642 | (setq re (concat (get-text-property 0 'org-todo-regexp x)) | |
d3f4dbe8 CD |
20643 | pl (get-text-property 0 'prefix-length x)) |
20644 | (and re (equal (string-match (concat "\\(\\.*\\)" re) x (or pl 0)) pl) | |
374585c9 CD |
20645 | (add-text-properties |
20646 | (or (match-end 1) (match-end 0)) (match-end 0) | |
20647 | (list 'face (org-get-todo-face (match-string 2 x))) | |
20648 | x)) | |
d3f4dbe8 CD |
20649 | x))) |
20650 | ||
20651 | (defsubst org-cmp-priority (a b) | |
20652 | "Compare the priorities of string A and B." | |
20653 | (let ((pa (or (get-text-property 1 'priority a) 0)) | |
20654 | (pb (or (get-text-property 1 'priority b) 0))) | |
20655 | (cond ((> pa pb) +1) | |
20656 | ((< pa pb) -1) | |
20657 | (t nil)))) | |
20658 | ||
20659 | (defsubst org-cmp-category (a b) | |
20660 | "Compare the string values of categories of strings A and B." | |
1e8fbb6d CD |
20661 | (let ((ca (or (get-text-property 1 'org-category a) "")) |
20662 | (cb (or (get-text-property 1 'org-category b) ""))) | |
d3f4dbe8 CD |
20663 | (cond ((string-lessp ca cb) -1) |
20664 | ((string-lessp cb ca) +1) | |
20665 | (t nil)))) | |
20666 | ||
20667 | (defsubst org-cmp-tag (a b) | |
20668 | "Compare the string values of categories of strings A and B." | |
20669 | (let ((ta (car (last (get-text-property 1 'tags a)))) | |
20670 | (tb (car (last (get-text-property 1 'tags b))))) | |
20671 | (cond ((not ta) +1) | |
20672 | ((not tb) -1) | |
20673 | ((string-lessp ta tb) -1) | |
20674 | ((string-lessp tb ta) +1) | |
20675 | (t nil)))) | |
20676 | ||
20677 | (defsubst org-cmp-time (a b) | |
20678 | "Compare the time-of-day values of strings A and B." | |
20679 | (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) | |
20680 | (ta (or (get-text-property 1 'time-of-day a) def)) | |
20681 | (tb (or (get-text-property 1 'time-of-day b) def))) | |
20682 | (cond ((< ta tb) -1) | |
20683 | ((< tb ta) +1) | |
20684 | (t nil)))) | |
20685 | ||
20686 | (defun org-entries-lessp (a b) | |
20687 | "Predicate for sorting agenda entries." | |
20688 | ;; The following variables will be used when the form is evaluated. | |
20689 | ;; So even though the compiler complains, keep them. | |
20690 | (let* ((time-up (org-cmp-time a b)) | |
20691 | (time-down (if time-up (- time-up) nil)) | |
20692 | (priority-up (org-cmp-priority a b)) | |
20693 | (priority-down (if priority-up (- priority-up) nil)) | |
20694 | (category-up (org-cmp-category a b)) | |
20695 | (category-down (if category-up (- category-up) nil)) | |
20696 | (category-keep (if category-up +1 nil)) | |
20697 | (tag-up (org-cmp-tag a b)) | |
20698 | (tag-down (if tag-up (- tag-up) nil))) | |
20699 | (cdr (assoc | |
20700 | (eval (cons 'or org-agenda-sorting-strategy-selected)) | |
20701 | '((-1 . t) (1 . nil) (nil . nil)))))) | |
20702 | ||
20703 | ;;; Agenda commands | |
20704 | ||
20705 | (defun org-agenda-check-type (error &rest types) | |
20706 | "Check if agenda buffer is of allowed type. | |
20707 | If ERROR is non-nil, throw an error, otherwise just return nil." | |
20708 | (if (memq org-agenda-type types) | |
20709 | t | |
20710 | (if error | |
20711 | (error "Not allowed in %s-type agenda buffers" org-agenda-type) | |
20712 | nil))) | |
20713 | ||
20714 | (defun org-agenda-quit () | |
20715 | "Exit agenda by removing the window or the buffer." | |
20716 | (interactive) | |
20717 | (let ((buf (current-buffer))) | |
20718 | (if (not (one-window-p)) (delete-window)) | |
20719 | (kill-buffer buf) | |
38f8646b | 20720 | (org-agenda-maybe-reset-markers 'force) |
7d58338e | 20721 | (org-columns-remove-overlays)) |
d3f4dbe8 CD |
20722 | ;; Maybe restore the pre-agenda window configuration. |
20723 | (and org-agenda-restore-windows-after-quit | |
20724 | (not (eq org-agenda-window-setup 'other-frame)) | |
20725 | org-pre-agenda-window-conf | |
20726 | (set-window-configuration org-pre-agenda-window-conf))) | |
20727 | ||
20728 | (defun org-agenda-exit () | |
20729 | "Exit agenda by removing the window or the buffer. | |
20730 | Also kill all Org-mode buffers which have been loaded by `org-agenda'. | |
20731 | Org-mode buffers visited directly by the user will not be touched." | |
20732 | (interactive) | |
20733 | (org-release-buffers org-agenda-new-buffers) | |
20734 | (setq org-agenda-new-buffers nil) | |
20735 | (org-agenda-quit)) | |
20736 | ||
20737 | (defun org-save-all-org-buffers () | |
20738 | "Save all Org-mode buffers without user confirmation." | |
20739 | (interactive) | |
20740 | (message "Saving all Org-mode buffers...") | |
20741 | (save-some-buffers t 'org-mode-p) | |
20742 | (message "Saving all Org-mode buffers... done")) | |
20743 | ||
20744 | (defun org-agenda-redo () | |
20745 | "Rebuild Agenda. | |
20746 | When this is the global TODO list, a prefix argument will be interpreted." | |
20747 | (interactive) | |
20748 | (let* ((org-agenda-keep-modes t) | |
20749 | (line (org-current-line)) | |
48aaad2d CD |
20750 | (window-line (- line (org-current-line (window-start)))) |
20751 | (lprops (get 'org-agenda-redo-command 'org-lprops))) | |
d3f4dbe8 | 20752 | (message "Rebuilding agenda buffer...") |
48aaad2d | 20753 | (org-let lprops '(eval org-agenda-redo-command)) |
d3f4dbe8 CD |
20754 | (setq org-agenda-undo-list nil |
20755 | org-agenda-pending-undo-list nil) | |
20756 | (message "Rebuilding agenda buffer...done") | |
20757 | (goto-line line) | |
20758 | (recenter window-line))) | |
20759 | ||
48aaad2d CD |
20760 | (defun org-agenda-goto-date (date) |
20761 | "Jump to DATE in agenda." | |
20762 | (interactive (list (org-read-date))) | |
20763 | (org-agenda-list nil date)) | |
20764 | ||
d3f4dbe8 CD |
20765 | (defun org-agenda-goto-today () |
20766 | "Go to today." | |
20767 | (interactive) | |
20768 | (org-agenda-check-type t 'timeline 'agenda) | |
20769 | (let ((tdpos (text-property-any (point-min) (point-max) 'org-today t))) | |
20770 | (cond | |
20771 | (tdpos (goto-char tdpos)) | |
20772 | ((eq org-agenda-type 'agenda) | |
38f8646b CD |
20773 | (let* ((sd (time-to-days (current-time))) |
20774 | (comp (org-agenda-compute-time-span sd org-agenda-span)) | |
20775 | (org-agenda-overriding-arguments org-agenda-last-arguments)) | |
20776 | (setf (nth 1 org-agenda-overriding-arguments) (car comp)) | |
20777 | (setf (nth 2 org-agenda-overriding-arguments) (cdr comp)) | |
d3f4dbe8 | 20778 | (org-agenda-redo) |
03f3cf35 | 20779 | (org-agenda-find-same-or-today-or-agenda))) |
d3f4dbe8 CD |
20780 | (t (error "Cannot find today"))))) |
20781 | ||
03f3cf35 | 20782 | (defun org-agenda-find-same-or-today-or-agenda (&optional cnt) |
d3f4dbe8 | 20783 | (goto-char |
03f3cf35 JW |
20784 | (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) |
20785 | (text-property-any (point-min) (point-max) 'org-today t) | |
d3f4dbe8 CD |
20786 | (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) |
20787 | (point-min)))) | |
20788 | ||
20789 | (defun org-agenda-later (arg) | |
38f8646b CD |
20790 | "Go forward in time by thee current span. |
20791 | With prefix ARG, go forward that many times the current span." | |
d3f4dbe8 CD |
20792 | (interactive "p") |
20793 | (org-agenda-check-type t 'agenda) | |
38f8646b CD |
20794 | (let* ((span org-agenda-span) |
20795 | (sd org-starting-day) | |
20796 | (greg (calendar-gregorian-from-absolute sd)) | |
03f3cf35 | 20797 | (cnt (get-text-property (point) 'org-day-cnt)) |
38f8646b CD |
20798 | greg2 nd) |
20799 | (cond | |
20800 | ((eq span 'day) | |
20801 | (setq sd (+ arg sd) nd 1)) | |
20802 | ((eq span 'week) | |
20803 | (setq sd (+ (* 7 arg) sd) nd 7)) | |
20804 | ((eq span 'month) | |
20805 | (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) | |
20806 | sd (calendar-absolute-from-gregorian greg2)) | |
20807 | (setcar greg2 (1+ (car greg2))) | |
20808 | (setq nd (- (calendar-absolute-from-gregorian greg2) sd))) | |
20809 | ((eq span 'year) | |
20810 | (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) | |
20811 | sd (calendar-absolute-from-gregorian greg2)) | |
20812 | (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))) | |
20813 | (setq nd (- (calendar-absolute-from-gregorian greg2) sd)))) | |
20814 | (let ((org-agenda-overriding-arguments | |
20815 | (list (car org-agenda-last-arguments) sd nd t))) | |
03f3cf35 JW |
20816 | (org-agenda-redo) |
20817 | (org-agenda-find-same-or-today-or-agenda cnt)))) | |
fbe6c10d | 20818 | |
d3f4dbe8 | 20819 | (defun org-agenda-earlier (arg) |
38f8646b CD |
20820 | "Go backward in time by the current span. |
20821 | With prefix ARG, go backward that many times the current span." | |
d3f4dbe8 | 20822 | (interactive "p") |
38f8646b | 20823 | (org-agenda-later (- arg))) |
d3f4dbe8 | 20824 | |
38f8646b CD |
20825 | (defun org-agenda-day-view () |
20826 | "Switch to daily view for agenda." | |
20827 | (interactive) | |
7d58338e | 20828 | (setq org-agenda-ndays 1) |
38f8646b | 20829 | (org-agenda-change-time-span 'day)) |
d3f4dbe8 | 20830 | (defun org-agenda-week-view () |
38f8646b | 20831 | "Switch to daily view for agenda." |
d3f4dbe8 | 20832 | (interactive) |
7d58338e | 20833 | (setq org-agenda-ndays 7) |
38f8646b CD |
20834 | (org-agenda-change-time-span 'week)) |
20835 | (defun org-agenda-month-view () | |
d3f4dbe8 CD |
20836 | "Switch to daily view for agenda." |
20837 | (interactive) | |
38f8646b CD |
20838 | (org-agenda-change-time-span 'month)) |
20839 | (defun org-agenda-year-view () | |
20840 | "Switch to daily view for agenda." | |
20841 | (interactive) | |
20842 | (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") | |
20843 | (org-agenda-change-time-span 'year) | |
20844 | (error "Abort"))) | |
20845 | ||
20846 | (defun org-agenda-change-time-span (span) | |
20847 | "Change the agenda view to SPAN. | |
20848 | SPAN may be `day', `week', `month', `year'." | |
d3f4dbe8 | 20849 | (org-agenda-check-type t 'agenda) |
38f8646b CD |
20850 | (if (equal org-agenda-span span) |
20851 | (error "Viewing span is already \"%s\"" span)) | |
20852 | (let* ((sd (or (get-text-property (point) 'day) | |
20853 | org-starting-day)) | |
20854 | (computed (org-agenda-compute-time-span sd span)) | |
20855 | (org-agenda-overriding-arguments | |
20856 | (list (car org-agenda-last-arguments) | |
20857 | (car computed) (cdr computed) t))) | |
d3f4dbe8 | 20858 | (org-agenda-redo) |
03f3cf35 | 20859 | (org-agenda-find-same-or-today-or-agenda)) |
d3f4dbe8 | 20860 | (org-agenda-set-mode-name) |
38f8646b CD |
20861 | (message "Switched to %s view" span)) |
20862 | ||
20863 | (defun org-agenda-compute-time-span (sd span) | |
20864 | "Compute starting date and number of days for agenda. | |
20865 | SPAN may be `day', `week', `month', `year'. The return value | |
20866 | is a cons cell with the starting date and the number of days, | |
20867 | so that the date SD will be in that range." | |
20868 | (let* ((greg (calendar-gregorian-from-absolute sd)) | |
20869 | nd) | |
20870 | (cond | |
20871 | ((eq span 'day) | |
20872 | (setq nd 1)) | |
20873 | ((eq span 'week) | |
20874 | (let* ((nt (calendar-day-of-week | |
20875 | (calendar-gregorian-from-absolute sd))) | |
7d58338e CD |
20876 | (d (if org-agenda-start-on-weekday |
20877 | (- nt org-agenda-start-on-weekday) | |
20878 | 0))) | |
38f8646b CD |
20879 | (setq sd (- sd (+ (if (< d 0) 7 0) d))) |
20880 | (setq nd 7))) | |
20881 | ((eq span 'month) | |
20882 | (setq sd (calendar-absolute-from-gregorian | |
20883 | (list (car greg) 1 (nth 2 greg))) | |
20884 | nd (- (calendar-absolute-from-gregorian | |
20885 | (list (1+ (car greg)) 1 (nth 2 greg))) | |
20886 | sd))) | |
20887 | ((eq span 'year) | |
20888 | (setq sd (calendar-absolute-from-gregorian | |
20889 | (list 1 1 (nth 2 greg))) | |
20890 | nd (- (calendar-absolute-from-gregorian | |
20891 | (list 1 1 (1+ (nth 2 greg)))) | |
20892 | sd)))) | |
20893 | (cons sd nd))) | |
d3f4dbe8 | 20894 | |
15841868 | 20895 | ;; FIXME: does not work if user makes date format that starts with a blank |
d3f4dbe8 CD |
20896 | (defun org-agenda-next-date-line (&optional arg) |
20897 | "Jump to the next line indicating a date in agenda buffer." | |
20898 | (interactive "p") | |
20899 | (org-agenda-check-type t 'agenda 'timeline) | |
20900 | (beginning-of-line 1) | |
20901 | (if (looking-at "^\\S-") (forward-char 1)) | |
20902 | (if (not (re-search-forward "^\\S-" nil t arg)) | |
20903 | (progn | |
20904 | (backward-char 1) | |
20905 | (error "No next date after this line in this buffer"))) | |
20906 | (goto-char (match-beginning 0))) | |
20907 | ||
20908 | (defun org-agenda-previous-date-line (&optional arg) | |
20909 | "Jump to the previous line indicating a date in agenda buffer." | |
20910 | (interactive "p") | |
20911 | (org-agenda-check-type t 'agenda 'timeline) | |
20912 | (beginning-of-line 1) | |
20913 | (if (not (re-search-backward "^\\S-" nil t arg)) | |
20914 | (error "No previous date before this line in this buffer"))) | |
20915 | ||
20916 | ;; Initialize the highlight | |
20917 | (defvar org-hl (org-make-overlay 1 1)) | |
20918 | (org-overlay-put org-hl 'face 'highlight) | |
20919 | ||
20920 | (defun org-highlight (begin end &optional buffer) | |
20921 | "Highlight a region with overlay." | |
20922 | (funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay) | |
20923 | org-hl begin end (or buffer (current-buffer)))) | |
20924 | ||
20925 | (defun org-unhighlight () | |
20926 | "Detach overlay INDEX." | |
20927 | (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl)) | |
20928 | ||
a3fbe8c4 | 20929 | ;; FIXME this is currently not used. |
d3f4dbe8 CD |
20930 | (defun org-highlight-until-next-command (beg end &optional buffer) |
20931 | (org-highlight beg end buffer) | |
20932 | (add-hook 'pre-command-hook 'org-unhighlight-once)) | |
d3f4dbe8 CD |
20933 | (defun org-unhighlight-once () |
20934 | (remove-hook 'pre-command-hook 'org-unhighlight-once) | |
20935 | (org-unhighlight)) | |
20936 | ||
20937 | (defun org-agenda-follow-mode () | |
20938 | "Toggle follow mode in an agenda buffer." | |
20939 | (interactive) | |
20940 | (setq org-agenda-follow-mode (not org-agenda-follow-mode)) | |
20941 | (org-agenda-set-mode-name) | |
20942 | (message "Follow mode is %s" | |
20943 | (if org-agenda-follow-mode "on" "off"))) | |
20944 | ||
20945 | (defun org-agenda-log-mode () | |
20946 | "Toggle log mode in an agenda buffer." | |
20947 | (interactive) | |
20948 | (org-agenda-check-type t 'agenda 'timeline) | |
20949 | (setq org-agenda-show-log (not org-agenda-show-log)) | |
20950 | (org-agenda-set-mode-name) | |
20951 | (org-agenda-redo) | |
20952 | (message "Log mode is %s" | |
20953 | (if org-agenda-show-log "on" "off"))) | |
20954 | ||
20955 | (defun org-agenda-toggle-diary () | |
20956 | "Toggle diary inclusion in an agenda buffer." | |
20957 | (interactive) | |
20958 | (org-agenda-check-type t 'agenda) | |
20959 | (setq org-agenda-include-diary (not org-agenda-include-diary)) | |
20960 | (org-agenda-redo) | |
20961 | (org-agenda-set-mode-name) | |
20962 | (message "Diary inclusion turned %s" | |
20963 | (if org-agenda-include-diary "on" "off"))) | |
20964 | ||
20965 | (defun org-agenda-toggle-time-grid () | |
20966 | "Toggle time grid in an agenda buffer." | |
20967 | (interactive) | |
20968 | (org-agenda-check-type t 'agenda) | |
20969 | (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) | |
20970 | (org-agenda-redo) | |
20971 | (org-agenda-set-mode-name) | |
20972 | (message "Time-grid turned %s" | |
20973 | (if org-agenda-use-time-grid "on" "off"))) | |
20974 | ||
20975 | (defun org-agenda-set-mode-name () | |
20976 | "Set the mode name to indicate all the small mode settings." | |
20977 | (setq mode-name | |
20978 | (concat "Org-Agenda" | |
20979 | (if (equal org-agenda-ndays 1) " Day" "") | |
20980 | (if (equal org-agenda-ndays 7) " Week" "") | |
20981 | (if org-agenda-follow-mode " Follow" "") | |
20982 | (if org-agenda-include-diary " Diary" "") | |
20983 | (if org-agenda-use-time-grid " Grid" "") | |
20984 | (if org-agenda-show-log " Log" ""))) | |
20985 | (force-mode-line-update)) | |
20986 | ||
20987 | (defun org-agenda-post-command-hook () | |
20988 | (and (eolp) (not (bolp)) (backward-char 1)) | |
20989 | (setq org-agenda-type (get-text-property (point) 'org-agenda-type)) | |
20990 | (if (and org-agenda-follow-mode | |
20991 | (get-text-property (point) 'org-marker)) | |
20992 | (org-agenda-show))) | |
20993 | ||
20994 | (defun org-agenda-show-priority () | |
20995 | "Show the priority of the current item. | |
20996 | This priority is composed of the main priority given with the [#A] cookies, | |
20997 | and by additional input from the age of a schedules or deadline entry." | |
20998 | (interactive) | |
20999 | (let* ((pri (get-text-property (point-at-bol) 'priority))) | |
21000 | (message "Priority is %d" (if pri pri -1000)))) | |
21001 | ||
21002 | (defun org-agenda-show-tags () | |
21003 | "Show the tags applicable to the current item." | |
21004 | (interactive) | |
21005 | (let* ((tags (get-text-property (point-at-bol) 'tags))) | |
21006 | (if tags | |
21007 | (message "Tags are :%s:" | |
21008 | (org-no-properties (mapconcat 'identity tags ":"))) | |
21009 | (message "No tags associated with this line")))) | |
21010 | ||
21011 | (defun org-agenda-goto (&optional highlight) | |
21012 | "Go to the Org-mode file which contains the item at point." | |
21013 | (interactive) | |
21014 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21015 | (org-agenda-error))) | |
21016 | (buffer (marker-buffer marker)) | |
21017 | (pos (marker-position marker))) | |
21018 | (switch-to-buffer-other-window buffer) | |
21019 | (widen) | |
21020 | (goto-char pos) | |
21021 | (when (org-mode-p) | |
21022 | (org-show-context 'agenda) | |
21023 | (save-excursion | |
21024 | (and (outline-next-heading) | |
21025 | (org-flag-heading nil)))) ; show the next heading | |
0b8568f5 | 21026 | (run-hooks 'org-agenda-after-show-hook) |
d3f4dbe8 CD |
21027 | (and highlight (org-highlight (point-at-bol) (point-at-eol))))) |
21028 | ||
0b8568f5 JW |
21029 | (defvar org-agenda-after-show-hook nil |
21030 | "Normal hook run after an item has been shown from the agenda. | |
21031 | Point is in the buffer where the item originated.") | |
21032 | ||
d3f4dbe8 CD |
21033 | (defun org-agenda-kill () |
21034 | "Kill the entry or subtree belonging to the current agenda entry." | |
21035 | (interactive) | |
21036 | (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
21037 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21038 | (org-agenda-error))) | |
21039 | (buffer (marker-buffer marker)) | |
21040 | (pos (marker-position marker)) | |
a3fbe8c4 | 21041 | (type (get-text-property (point) 'type)) |
d3f4dbe8 CD |
21042 | dbeg dend (n 0) conf) |
21043 | (org-with-remote-undo buffer | |
21044 | (with-current-buffer buffer | |
21045 | (save-excursion | |
21046 | (goto-char pos) | |
a3fbe8c4 | 21047 | (if (and (org-mode-p) (not (member type '("sexp")))) |
d3f4dbe8 | 21048 | (setq dbeg (progn (org-back-to-heading t) (point)) |
374585c9 | 21049 | dend (org-end-of-subtree t t)) |
d3f4dbe8 CD |
21050 | (setq dbeg (point-at-bol) |
21051 | dend (min (point-max) (1+ (point-at-eol))))) | |
21052 | (goto-char dbeg) | |
21053 | (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) | |
21054 | (setq conf (or (eq t org-agenda-confirm-kill) | |
21055 | (and (numberp org-agenda-confirm-kill) | |
21056 | (> n org-agenda-confirm-kill)))) | |
21057 | (and conf | |
21058 | (not (y-or-n-p | |
21059 | (format "Delete entry with %d lines in buffer \"%s\"? " | |
21060 | n (buffer-name buffer)))) | |
21061 | (error "Abort")) | |
21062 | (org-remove-subtree-entries-from-agenda buffer dbeg dend) | |
21063 | (with-current-buffer buffer (delete-region dbeg dend)) | |
21064 | (message "Agenda item and source killed")))) | |
21065 | ||
21066 | (defun org-agenda-archive () | |
21067 | "Kill the entry or subtree belonging to the current agenda entry." | |
21068 | (interactive) | |
21069 | (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) | |
21070 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21071 | (org-agenda-error))) | |
21072 | (buffer (marker-buffer marker)) | |
21073 | (pos (marker-position marker))) | |
21074 | (org-with-remote-undo buffer | |
21075 | (with-current-buffer buffer | |
21076 | (if (org-mode-p) | |
21077 | (save-excursion | |
21078 | (goto-char pos) | |
21079 | (org-remove-subtree-entries-from-agenda) | |
21080 | (org-back-to-heading t) | |
21081 | (org-archive-subtree)) | |
21082 | (error "Archiving works only in Org-mode files")))))) | |
21083 | ||
21084 | (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) | |
21085 | "Remove all lines in the agenda that correspond to a given subtree. | |
21086 | The subtree is the one in buffer BUF, starting at BEG and ending at END. | |
21087 | If this information is not given, the function uses the tree at point." | |
21088 | (let ((buf (or buf (current-buffer))) m p) | |
21089 | (save-excursion | |
21090 | (unless (and beg end) | |
21091 | (org-back-to-heading t) | |
21092 | (setq beg (point)) | |
21093 | (org-end-of-subtree t) | |
21094 | (setq end (point))) | |
21095 | (set-buffer (get-buffer org-agenda-buffer-name)) | |
21096 | (save-excursion | |
21097 | (goto-char (point-max)) | |
21098 | (beginning-of-line 1) | |
21099 | (while (not (bobp)) | |
21100 | (when (and (setq m (get-text-property (point) 'org-marker)) | |
21101 | (equal buf (marker-buffer m)) | |
21102 | (setq p (marker-position m)) | |
21103 | (>= p beg) | |
21104 | (<= p end)) | |
48aaad2d | 21105 | (let ((inhibit-read-only t)) |
d3f4dbe8 CD |
21106 | (delete-region (point-at-bol) (1+ (point-at-eol))))) |
21107 | (beginning-of-line 0)))))) | |
21108 | ||
21109 | (defun org-agenda-open-link () | |
21110 | "Follow the link in the current line, if any." | |
21111 | (interactive) | |
fbe6c10d | 21112 | (org-agenda-copy-local-variable 'org-link-abbrev-alist-local) |
03f3cf35 JW |
21113 | (save-excursion |
21114 | (save-restriction | |
21115 | (narrow-to-region (point-at-bol) (point-at-eol)) | |
21116 | (org-open-at-point)))) | |
d3f4dbe8 | 21117 | |
fbe6c10d CD |
21118 | (defun org-agenda-copy-local-variable (var) |
21119 | "Get a variable from a referenced buffer and install it here." | |
21120 | (let ((m (get-text-property (point) 'org-marker))) | |
21121 | (when (and m (buffer-live-p (marker-buffer m))) | |
21122 | (org-set-local var (with-current-buffer (marker-buffer m) | |
21123 | (symbol-value var)))))) | |
21124 | ||
d3f4dbe8 CD |
21125 | (defun org-agenda-switch-to (&optional delete-other-windows) |
21126 | "Go to the Org-mode file which contains the item at point." | |
21127 | (interactive) | |
21128 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21129 | (org-agenda-error))) | |
21130 | (buffer (marker-buffer marker)) | |
21131 | (pos (marker-position marker))) | |
21132 | (switch-to-buffer buffer) | |
21133 | (and delete-other-windows (delete-other-windows)) | |
21134 | (widen) | |
21135 | (goto-char pos) | |
21136 | (when (org-mode-p) | |
21137 | (org-show-context 'agenda) | |
21138 | (save-excursion | |
21139 | (and (outline-next-heading) | |
21140 | (org-flag-heading nil)))))) ; show the next heading | |
21141 | ||
21142 | (defun org-agenda-goto-mouse (ev) | |
21143 | "Go to the Org-mode file which contains the item at the mouse click." | |
21144 | (interactive "e") | |
21145 | (mouse-set-point ev) | |
21146 | (org-agenda-goto)) | |
21147 | ||
21148 | (defun org-agenda-show () | |
21149 | "Display the Org-mode file which contains the item at point." | |
21150 | (interactive) | |
21151 | (let ((win (selected-window))) | |
21152 | (org-agenda-goto t) | |
21153 | (select-window win))) | |
21154 | ||
21155 | (defun org-agenda-recenter (arg) | |
21156 | "Display the Org-mode file which contains the item at point and recenter." | |
21157 | (interactive "P") | |
21158 | (let ((win (selected-window))) | |
21159 | (org-agenda-goto t) | |
21160 | (recenter arg) | |
21161 | (select-window win))) | |
21162 | ||
21163 | (defun org-agenda-show-mouse (ev) | |
21164 | "Display the Org-mode file which contains the item at the mouse click." | |
21165 | (interactive "e") | |
21166 | (mouse-set-point ev) | |
21167 | (org-agenda-show)) | |
21168 | ||
21169 | (defun org-agenda-check-no-diary () | |
21170 | "Check if the entry is a diary link and abort if yes." | |
21171 | (if (get-text-property (point) 'org-agenda-diary-link) | |
21172 | (org-agenda-error))) | |
21173 | ||
21174 | (defun org-agenda-error () | |
21175 | (error "Command not allowed in this line")) | |
21176 | ||
21177 | (defun org-agenda-tree-to-indirect-buffer () | |
21178 | "Show the subtree corresponding to the current entry in an indirect buffer. | |
21179 | This calls the command `org-tree-to-indirect-buffer' from the original | |
21180 | Org-mode buffer. | |
21181 | With numerical prefix arg ARG, go up to this level and then take that tree. | |
21182 | With a C-u prefix, make a separate frame for this tree (i.e. don't use the | |
21183 | dedicated frame)." | |
21184 | (interactive) | |
21185 | (org-agenda-check-no-diary) | |
21186 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21187 | (org-agenda-error))) | |
21188 | (buffer (marker-buffer marker)) | |
21189 | (pos (marker-position marker))) | |
21190 | (with-current-buffer buffer | |
21191 | (save-excursion | |
21192 | (goto-char pos) | |
21193 | (call-interactively 'org-tree-to-indirect-buffer))))) | |
21194 | ||
21195 | (defvar org-last-heading-marker (make-marker) | |
21196 | "Marker pointing to the headline that last changed its TODO state | |
21197 | by a remote command from the agenda.") | |
21198 | ||
a3fbe8c4 CD |
21199 | (defun org-agenda-todo-nextset () |
21200 | "Switch TODO entry to next sequence." | |
21201 | (interactive) | |
21202 | (org-agenda-todo 'nextset)) | |
21203 | ||
21204 | (defun org-agenda-todo-previousset () | |
21205 | "Switch TODO entry to previous sequence." | |
21206 | (interactive) | |
21207 | (org-agenda-todo 'previousset)) | |
21208 | ||
d3f4dbe8 CD |
21209 | (defun org-agenda-todo (&optional arg) |
21210 | "Cycle TODO state of line at point, also in Org-mode file. | |
21211 | This changes the line at point, all other lines in the agenda referring to | |
21212 | the same tree node, and the headline of the tree node in the Org-mode file." | |
21213 | (interactive "P") | |
21214 | (org-agenda-check-no-diary) | |
21215 | (let* ((col (current-column)) | |
21216 | (marker (or (get-text-property (point) 'org-marker) | |
21217 | (org-agenda-error))) | |
21218 | (buffer (marker-buffer marker)) | |
21219 | (pos (marker-position marker)) | |
21220 | (hdmarker (get-text-property (point) 'org-hd-marker)) | |
48aaad2d | 21221 | (inhibit-read-only t) |
d3f4dbe8 CD |
21222 | newhead) |
21223 | (org-with-remote-undo buffer | |
21224 | (with-current-buffer buffer | |
21225 | (widen) | |
21226 | (goto-char pos) | |
21227 | (org-show-context 'agenda) | |
21228 | (save-excursion | |
21229 | (and (outline-next-heading) | |
21230 | (org-flag-heading nil))) ; show the next heading | |
21231 | (org-todo arg) | |
21232 | (and (bolp) (forward-char 1)) | |
21233 | (setq newhead (org-get-heading)) | |
21234 | (save-excursion | |
21235 | (org-back-to-heading) | |
21236 | (move-marker org-last-heading-marker (point)))) | |
21237 | (beginning-of-line 1) | |
21238 | (save-excursion | |
21239 | (org-agenda-change-all-lines newhead hdmarker 'fixface)) | |
21240 | (move-to-column col)))) | |
21241 | ||
21242 | (defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) | |
21243 | "Change all lines in the agenda buffer which match HDMARKER. | |
21244 | The new content of the line will be NEWHEAD (as modified by | |
21245 | `org-format-agenda-item'). HDMARKER is checked with | |
21246 | `equal' against all `org-hd-marker' text properties in the file. | |
21247 | If FIXFACE is non-nil, the face of each item is modified acording to | |
21248 | the new TODO state." | |
48aaad2d | 21249 | (let* ((inhibit-read-only t) |
d3f4dbe8 CD |
21250 | props m pl undone-face done-face finish new dotime cat tags) |
21251 | (save-excursion | |
21252 | (goto-char (point-max)) | |
21253 | (beginning-of-line 1) | |
21254 | (while (not finish) | |
21255 | (setq finish (bobp)) | |
21256 | (when (and (setq m (get-text-property (point) 'org-hd-marker)) | |
21257 | (equal m hdmarker)) | |
21258 | (setq props (text-properties-at (point)) | |
21259 | dotime (get-text-property (point) 'dotime) | |
21260 | cat (get-text-property (point) 'org-category) | |
21261 | tags (get-text-property (point) 'tags) | |
21262 | new (org-format-agenda-item "x" newhead cat tags dotime 'noprefix) | |
21263 | pl (get-text-property (point) 'prefix-length) | |
21264 | undone-face (get-text-property (point) 'undone-face) | |
21265 | done-face (get-text-property (point) 'done-face)) | |
21266 | (move-to-column pl) | |
21267 | (cond | |
21268 | ((equal new "") | |
21269 | (beginning-of-line 1) | |
21270 | (and (looking-at ".*\n?") (replace-match ""))) | |
21271 | ((looking-at ".*") | |
21272 | (replace-match new t t) | |
21273 | (beginning-of-line 1) | |
21274 | (add-text-properties (point-at-bol) (point-at-eol) props) | |
21275 | (when fixface | |
21276 | (add-text-properties | |
21277 | (point-at-bol) (point-at-eol) | |
21278 | (list 'face | |
21279 | (if org-last-todo-state-is-todo | |
21280 | undone-face done-face)))) | |
21281 | (org-agenda-highlight-todo 'line) | |
21282 | (beginning-of-line 1)) | |
21283 | (t (error "Line update did not work")))) | |
21284 | (beginning-of-line 0))) | |
21285 | (org-finalize-agenda))) | |
21286 | ||
d3f4dbe8 | 21287 | (defun org-agenda-align-tags (&optional line) |
15841868 JW |
21288 | "Align all tags in agenda items to `org-agenda-tags-column'." |
21289 | (let ((inhibit-read-only t) l c) | |
d3f4dbe8 CD |
21290 | (save-excursion |
21291 | (goto-char (if line (point-at-bol) (point-min))) | |
15841868 | 21292 | (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") |
d3f4dbe8 | 21293 | (if line (point-at-eol) nil) t) |
15841868 JW |
21294 | (add-text-properties |
21295 | (match-beginning 2) (match-end 2) | |
21296 | (list 'face (list 'org-tag (get-text-property | |
21297 | (match-beginning 2) 'face)))) | |
21298 | (setq l (- (match-end 2) (match-beginning 2)) | |
21299 | c (if (< org-agenda-tags-column 0) | |
21300 | (- (abs org-agenda-tags-column) l) | |
21301 | org-agenda-tags-column)) | |
d3f4dbe8 CD |
21302 | (delete-region (match-beginning 1) (match-end 1)) |
21303 | (goto-char (match-beginning 1)) | |
21304 | (insert (org-add-props | |
15841868 | 21305 | (make-string (max 1 (- c (current-column))) ?\ ) |
d3f4dbe8 CD |
21306 | (text-properties-at (point)))))))) |
21307 | ||
21308 | (defun org-agenda-priority-up () | |
21309 | "Increase the priority of line at point, also in Org-mode file." | |
21310 | (interactive) | |
21311 | (org-agenda-priority 'up)) | |
21312 | ||
21313 | (defun org-agenda-priority-down () | |
21314 | "Decrease the priority of line at point, also in Org-mode file." | |
21315 | (interactive) | |
21316 | (org-agenda-priority 'down)) | |
21317 | ||
21318 | (defun org-agenda-priority (&optional force-direction) | |
21319 | "Set the priority of line at point, also in Org-mode file. | |
21320 | This changes the line at point, all other lines in the agenda referring to | |
21321 | the same tree node, and the headline of the tree node in the Org-mode file." | |
21322 | (interactive) | |
21323 | (org-agenda-check-no-diary) | |
21324 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21325 | (org-agenda-error))) | |
d3f4dbe8 | 21326 | (hdmarker (get-text-property (point) 'org-hd-marker)) |
48aaad2d CD |
21327 | (buffer (marker-buffer hdmarker)) |
21328 | (pos (marker-position hdmarker)) | |
21329 | (inhibit-read-only t) | |
d3f4dbe8 CD |
21330 | newhead) |
21331 | (org-with-remote-undo buffer | |
21332 | (with-current-buffer buffer | |
21333 | (widen) | |
21334 | (goto-char pos) | |
21335 | (org-show-context 'agenda) | |
21336 | (save-excursion | |
21337 | (and (outline-next-heading) | |
21338 | (org-flag-heading nil))) ; show the next heading | |
21339 | (funcall 'org-priority force-direction) | |
21340 | (end-of-line 1) | |
21341 | (setq newhead (org-get-heading))) | |
21342 | (org-agenda-change-all-lines newhead hdmarker) | |
21343 | (beginning-of-line 1)))) | |
21344 | ||
21345 | (defun org-get-tags-at (&optional pos) | |
21346 | "Get a list of all headline tags applicable at POS. | |
21347 | POS defaults to point. If tags are inherited, the list contains | |
21348 | the targets in the same sequence as the headlines appear, i.e. | |
21349 | the tags of the current headline come last." | |
21350 | (interactive) | |
374585c9 | 21351 | (let (tags lastpos) |
d3f4dbe8 CD |
21352 | (save-excursion |
21353 | (save-restriction | |
21354 | (widen) | |
21355 | (goto-char (or pos (point))) | |
21356 | (save-match-data | |
21357 | (org-back-to-heading t) | |
21358 | (condition-case nil | |
374585c9 CD |
21359 | (while (not (equal lastpos (point))) |
21360 | (setq lastpos (point)) | |
7d58338e | 21361 | (if (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) |
d3f4dbe8 CD |
21362 | (setq tags (append (org-split-string |
21363 | (org-match-string-no-properties 1) ":") | |
21364 | tags))) | |
21365 | (or org-use-tag-inheritance (error "")) | |
21366 | (org-up-heading-all 1)) | |
21367 | (error nil)))) | |
21368 | tags))) | |
a3fbe8c4 | 21369 | |
d3f4dbe8 CD |
21370 | ;; FIXME: should fix the tags property of the agenda line. |
21371 | (defun org-agenda-set-tags () | |
21372 | "Set tags for the current headline." | |
21373 | (interactive) | |
21374 | (org-agenda-check-no-diary) | |
374585c9 CD |
21375 | (if (and (org-region-active-p) (interactive-p)) |
21376 | (call-interactively 'org-change-tag-in-region) | |
21377 | (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed | |
21378 | (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) | |
21379 | (org-agenda-error))) | |
21380 | (buffer (marker-buffer hdmarker)) | |
21381 | (pos (marker-position hdmarker)) | |
21382 | (inhibit-read-only t) | |
21383 | newhead) | |
21384 | (org-with-remote-undo buffer | |
21385 | (with-current-buffer buffer | |
21386 | (widen) | |
21387 | (goto-char pos) | |
21388 | (save-excursion | |
21389 | (org-show-context 'agenda)) | |
21390 | (save-excursion | |
21391 | (and (outline-next-heading) | |
21392 | (org-flag-heading nil))) ; show the next heading | |
21393 | (goto-char pos) | |
21394 | (call-interactively 'org-set-tags) | |
21395 | (end-of-line 1) | |
21396 | (setq newhead (org-get-heading))) | |
21397 | (org-agenda-change-all-lines newhead hdmarker) | |
21398 | (beginning-of-line 1))))) | |
d3f4dbe8 CD |
21399 | |
21400 | (defun org-agenda-toggle-archive-tag () | |
21401 | "Toggle the archive tag for the current entry." | |
21402 | (interactive) | |
21403 | (org-agenda-check-no-diary) | |
21404 | (org-agenda-show) ;;; FIXME This is a stupid hack and should not be needed | |
21405 | (let* ((hdmarker (or (get-text-property (point) 'org-hd-marker) | |
21406 | (org-agenda-error))) | |
21407 | (buffer (marker-buffer hdmarker)) | |
21408 | (pos (marker-position hdmarker)) | |
48aaad2d | 21409 | (inhibit-read-only t) |
d3f4dbe8 CD |
21410 | newhead) |
21411 | (org-with-remote-undo buffer | |
21412 | (with-current-buffer buffer | |
21413 | (widen) | |
21414 | (goto-char pos) | |
21415 | (org-show-context 'agenda) | |
21416 | (save-excursion | |
21417 | (and (outline-next-heading) | |
21418 | (org-flag-heading nil))) ; show the next heading | |
21419 | (call-interactively 'org-toggle-archive-tag) | |
21420 | (end-of-line 1) | |
21421 | (setq newhead (org-get-heading))) | |
21422 | (org-agenda-change-all-lines newhead hdmarker) | |
21423 | (beginning-of-line 1)))) | |
21424 | ||
21425 | (defun org-agenda-date-later (arg &optional what) | |
21426 | "Change the date of this item to one day later." | |
21427 | (interactive "p") | |
21428 | (org-agenda-check-type t 'agenda 'timeline) | |
21429 | (org-agenda-check-no-diary) | |
21430 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21431 | (org-agenda-error))) | |
21432 | (buffer (marker-buffer marker)) | |
21433 | (pos (marker-position marker))) | |
21434 | (org-with-remote-undo buffer | |
21435 | (with-current-buffer buffer | |
21436 | (widen) | |
21437 | (goto-char pos) | |
21438 | (if (not (org-at-timestamp-p)) | |
21439 | (error "Cannot find time stamp")) | |
21440 | (org-timestamp-change arg (or what 'day))) | |
21441 | (org-agenda-show-new-time marker org-last-changed-timestamp)) | |
21442 | (message "Time stamp changed to %s" org-last-changed-timestamp))) | |
21443 | ||
21444 | (defun org-agenda-date-earlier (arg &optional what) | |
21445 | "Change the date of this item to one day earlier." | |
21446 | (interactive "p") | |
21447 | (org-agenda-date-later (- arg) what)) | |
21448 | ||
15841868 | 21449 | (defun org-agenda-show-new-time (marker stamp &optional prefix) |
d3f4dbe8 CD |
21450 | "Show new date stamp via text properties." |
21451 | ;; We use text properties to make this undoable | |
48aaad2d | 21452 | (let ((inhibit-read-only t)) |
15841868 | 21453 | (setq stamp (concat " " prefix " => " stamp)) |
d3f4dbe8 CD |
21454 | (save-excursion |
21455 | (goto-char (point-max)) | |
21456 | (while (not (bobp)) | |
21457 | (when (equal marker (get-text-property (point) 'org-marker)) | |
21458 | (move-to-column (- (window-width) (length stamp)) t) | |
21459 | (if (featurep 'xemacs) | |
21460 | ;; Use `duplicable' property to trigger undo recording | |
21461 | (let ((ex (make-extent nil nil)) | |
21462 | (gl (make-glyph stamp))) | |
21463 | (set-glyph-face gl 'secondary-selection) | |
21464 | (set-extent-properties | |
21465 | ex (list 'invisible t 'end-glyph gl 'duplicable t)) | |
21466 | (insert-extent ex (1- (point)) (point-at-eol))) | |
21467 | (add-text-properties | |
21468 | (1- (point)) (point-at-eol) | |
21469 | (list 'display (org-add-props stamp nil | |
21470 | 'face 'secondary-selection)))) | |
21471 | (beginning-of-line 1)) | |
21472 | (beginning-of-line 0))))) | |
21473 | ||
21474 | (defun org-agenda-date-prompt (arg) | |
21475 | "Change the date of this item. Date is prompted for, with default today. | |
21476 | The prefix ARG is passed to the `org-time-stamp' command and can therefore | |
21477 | be used to request time specification in the time stamp." | |
21478 | (interactive "P") | |
21479 | (org-agenda-check-type t 'agenda 'timeline) | |
21480 | (org-agenda-check-no-diary) | |
21481 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21482 | (org-agenda-error))) | |
21483 | (buffer (marker-buffer marker)) | |
21484 | (pos (marker-position marker))) | |
21485 | (org-with-remote-undo buffer | |
21486 | (with-current-buffer buffer | |
21487 | (widen) | |
21488 | (goto-char pos) | |
21489 | (if (not (org-at-timestamp-p)) | |
21490 | (error "Cannot find time stamp")) | |
21491 | (org-time-stamp arg) | |
21492 | (message "Time stamp changed to %s" org-last-changed-timestamp))))) | |
21493 | ||
21494 | (defun org-agenda-schedule (arg) | |
21495 | "Schedule the item at point." | |
21496 | (interactive "P") | |
21497 | (org-agenda-check-type t 'agenda 'timeline 'todo 'tags) | |
21498 | (org-agenda-check-no-diary) | |
21499 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21500 | (org-agenda-error))) | |
21501 | (buffer (marker-buffer marker)) | |
21502 | (pos (marker-position marker)) | |
21503 | (org-insert-labeled-timestamps-at-point nil) | |
21504 | ts) | |
21505 | (org-with-remote-undo buffer | |
21506 | (with-current-buffer buffer | |
21507 | (widen) | |
21508 | (goto-char pos) | |
15841868 JW |
21509 | (setq ts (org-schedule arg))) |
21510 | (org-agenda-show-new-time marker ts "S")) | |
21511 | (message "Item scheduled for %s" ts))) | |
d3f4dbe8 CD |
21512 | |
21513 | (defun org-agenda-deadline (arg) | |
21514 | "Schedule the item at point." | |
21515 | (interactive "P") | |
21516 | (org-agenda-check-type t 'agenda 'timeline 'todo 'tags) | |
21517 | (org-agenda-check-no-diary) | |
21518 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21519 | (org-agenda-error))) | |
21520 | (buffer (marker-buffer marker)) | |
21521 | (pos (marker-position marker)) | |
21522 | (org-insert-labeled-timestamps-at-point nil) | |
21523 | ts) | |
21524 | (org-with-remote-undo buffer | |
21525 | (with-current-buffer buffer | |
21526 | (widen) | |
21527 | (goto-char pos) | |
15841868 JW |
21528 | (setq ts (org-deadline arg))) |
21529 | (org-agenda-show-new-time marker ts "S")) | |
21530 | (message "Deadline for this item set to %s" ts))) | |
d3f4dbe8 | 21531 | |
d5098885 | 21532 | (defun org-get-heading (&optional no-tags) |
d3f4dbe8 CD |
21533 | "Return the heading of the current entry, without the stars." |
21534 | (save-excursion | |
21535 | (org-back-to-heading t) | |
d5098885 | 21536 | (if (looking-at |
fbe6c10d | 21537 | (if no-tags |
d5098885 JW |
21538 | (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$") |
21539 | "\\*+[ \t]+\\([^\r\n]*\\)")) | |
21540 | (match-string 1) ""))) | |
d3f4dbe8 CD |
21541 | |
21542 | (defun org-agenda-clock-in (&optional arg) | |
21543 | "Start the clock on the currently selected item." | |
21544 | (interactive "P") | |
21545 | (org-agenda-check-no-diary) | |
21546 | (let* ((marker (or (get-text-property (point) 'org-marker) | |
21547 | (org-agenda-error))) | |
21548 | (pos (marker-position marker))) | |
21549 | (org-with-remote-undo (marker-buffer marker) | |
21550 | (with-current-buffer (marker-buffer marker) | |
21551 | (widen) | |
21552 | (goto-char pos) | |
21553 | (org-clock-in))))) | |
21554 | ||
21555 | (defun org-agenda-clock-out (&optional arg) | |
21556 | "Stop the currently running clock." | |
21557 | (interactive "P") | |
21558 | (unless (marker-buffer org-clock-marker) | |
21559 | (error "No running clock")) | |
21560 | (org-with-remote-undo (marker-buffer org-clock-marker) | |
21561 | (org-clock-out))) | |
21562 | ||
21563 | (defun org-agenda-clock-cancel (&optional arg) | |
21564 | "Cancel the currently running clock." | |
21565 | (interactive "P") | |
21566 | (unless (marker-buffer org-clock-marker) | |
21567 | (error "No running clock")) | |
21568 | (org-with-remote-undo (marker-buffer org-clock-marker) | |
21569 | (org-clock-cancel))) | |
21570 | ||
21571 | (defun org-agenda-diary-entry () | |
21572 | "Make a diary entry, like the `i' command from the calendar. | |
21573 | All the standard commands work: block, weekly etc." | |
21574 | (interactive) | |
21575 | (org-agenda-check-type t 'agenda 'timeline) | |
21576 | (require 'diary-lib) | |
21577 | (let* ((char (progn | |
21578 | (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") | |
21579 | (read-char-exclusive))) | |
21580 | (cmd (cdr (assoc char | |
21581 | '((?d . insert-diary-entry) | |
21582 | (?w . insert-weekly-diary-entry) | |
21583 | (?m . insert-monthly-diary-entry) | |
21584 | (?y . insert-yearly-diary-entry) | |
21585 | (?a . insert-anniversary-diary-entry) | |
21586 | (?b . insert-block-diary-entry) | |
21587 | (?c . insert-cyclic-diary-entry))))) | |
21588 | (oldf (symbol-function 'calendar-cursor-to-date)) | |
21589 | ; (buf (get-file-buffer (substitute-in-file-name diary-file))) | |
21590 | (point (point)) | |
21591 | (mark (or (mark t) (point)))) | |
21592 | (unless cmd | |
21593 | (error "No command associated with <%c>" char)) | |
21594 | (unless (and (get-text-property point 'day) | |
21595 | (or (not (equal ?b char)) | |
21596 | (get-text-property mark 'day))) | |
21597 | (error "Don't know which date to use for diary entry")) | |
21598 | ;; We implement this by hacking the `calendar-cursor-to-date' function | |
21599 | ;; and the `calendar-mark-ring' variable. Saves a lot of code. | |
21600 | (let ((calendar-mark-ring | |
21601 | (list (calendar-gregorian-from-absolute | |
21602 | (or (get-text-property mark 'day) | |
21603 | (get-text-property point 'day)))))) | |
21604 | (unwind-protect | |
21605 | (progn | |
21606 | (fset 'calendar-cursor-to-date | |
21607 | (lambda (&optional error) | |
21608 | (calendar-gregorian-from-absolute | |
21609 | (get-text-property point 'day)))) | |
21610 | (call-interactively cmd)) | |
21611 | (fset 'calendar-cursor-to-date oldf))))) | |
21612 | ||
21613 | ||
21614 | (defun org-agenda-execute-calendar-command (cmd) | |
21615 | "Execute a calendar command from the agenda, with the date associated to | |
21616 | the cursor position." | |
21617 | (org-agenda-check-type t 'agenda 'timeline) | |
21618 | (require 'diary-lib) | |
21619 | (unless (get-text-property (point) 'day) | |
21620 | (error "Don't know which date to use for calendar command")) | |
21621 | (let* ((oldf (symbol-function 'calendar-cursor-to-date)) | |
21622 | (point (point)) | |
21623 | (date (calendar-gregorian-from-absolute | |
21624 | (get-text-property point 'day))) | |
21625 | ;; the following 3 vars are needed in the calendar | |
21626 | (displayed-day (extract-calendar-day date)) | |
21627 | (displayed-month (extract-calendar-month date)) | |
21628 | (displayed-year (extract-calendar-year date))) | |
21629 | (unwind-protect | |
21630 | (progn | |
21631 | (fset 'calendar-cursor-to-date | |
21632 | (lambda (&optional error) | |
21633 | (calendar-gregorian-from-absolute | |
21634 | (get-text-property point 'day)))) | |
21635 | (call-interactively cmd)) | |
21636 | (fset 'calendar-cursor-to-date oldf)))) | |
21637 | ||
21638 | (defun org-agenda-phases-of-moon () | |
21639 | "Display the phases of the moon for the 3 months around the cursor date." | |
21640 | (interactive) | |
21641 | (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) | |
21642 | ||
21643 | (defun org-agenda-holidays () | |
21644 | "Display the holidays for the 3 months around the cursor date." | |
21645 | (interactive) | |
21646 | (org-agenda-execute-calendar-command 'list-calendar-holidays)) | |
21647 | ||
21648 | (defun org-agenda-sunrise-sunset (arg) | |
21649 | "Display sunrise and sunset for the cursor date. | |
21650 | Latitude and longitude can be specified with the variables | |
21651 | `calendar-latitude' and `calendar-longitude'. When called with prefix | |
21652 | argument, latitude and longitude will be prompted for." | |
21653 | (interactive "P") | |
21654 | (let ((calendar-longitude (if arg nil calendar-longitude)) | |
21655 | (calendar-latitude (if arg nil calendar-latitude)) | |
21656 | (calendar-location-name | |
21657 | (if arg "the given coordinates" calendar-location-name))) | |
21658 | (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) | |
21659 | ||
21660 | (defun org-agenda-goto-calendar () | |
21661 | "Open the Emacs calendar with the date at the cursor." | |
21662 | (interactive) | |
21663 | (org-agenda-check-type t 'agenda 'timeline) | |
21664 | (let* ((day (or (get-text-property (point) 'day) | |
21665 | (error "Don't know which date to open in calendar"))) | |
21666 | (date (calendar-gregorian-from-absolute day)) | |
21667 | (calendar-move-hook nil) | |
21668 | (view-calendar-holidays-initially nil) | |
21669 | (view-diary-entries-initially nil)) | |
21670 | (calendar) | |
21671 | (calendar-goto-date date))) | |
21672 | ||
21673 | (defun org-calendar-goto-agenda () | |
21674 | "Compute the Org-mode agenda for the calendar date displayed at the cursor. | |
21675 | This is a command that has to be installed in `calendar-mode-map'." | |
21676 | (interactive) | |
21677 | (org-agenda-list nil (calendar-absolute-from-gregorian | |
21678 | (calendar-cursor-to-date)) | |
21679 | nil)) | |
21680 | ||
21681 | (defun org-agenda-convert-date () | |
21682 | (interactive) | |
21683 | (org-agenda-check-type t 'agenda 'timeline) | |
21684 | (let ((day (get-text-property (point) 'day)) | |
21685 | date s) | |
21686 | (unless day | |
21687 | (error "Don't know which date to convert")) | |
21688 | (setq date (calendar-gregorian-from-absolute day)) | |
21689 | (setq s (concat | |
21690 | "Gregorian: " (calendar-date-string date) "\n" | |
21691 | "ISO: " (calendar-iso-date-string date) "\n" | |
21692 | "Day of Yr: " (calendar-day-of-year-string date) "\n" | |
21693 | "Julian: " (calendar-julian-date-string date) "\n" | |
21694 | "Astron. JD: " (calendar-astro-date-string date) | |
21695 | " (Julian date number at noon UTC)\n" | |
21696 | "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" | |
21697 | "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" | |
21698 | "French: " (calendar-french-date-string date) "\n" | |
0b8568f5 | 21699 | "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n" |
d3f4dbe8 CD |
21700 | "Mayan: " (calendar-mayan-date-string date) "\n" |
21701 | "Coptic: " (calendar-coptic-date-string date) "\n" | |
21702 | "Ethiopic: " (calendar-ethiopic-date-string date) "\n" | |
21703 | "Persian: " (calendar-persian-date-string date) "\n" | |
21704 | "Chinese: " (calendar-chinese-date-string date) "\n")) | |
21705 | (with-output-to-temp-buffer "*Dates*" | |
21706 | (princ s)) | |
21707 | (if (fboundp 'fit-window-to-buffer) | |
21708 | (fit-window-to-buffer (get-buffer-window "*Dates*"))))) | |
791d856f | 21709 | |
ab27a4a0 | 21710 | |
d3f4dbe8 | 21711 | ;;;; Embedded LaTeX |
791d856f | 21712 | |
d3f4dbe8 CD |
21713 | (defvar org-cdlatex-mode-map (make-sparse-keymap) |
21714 | "Keymap for the minor `org-cdlatex-mode'.") | |
791d856f | 21715 | |
a3fbe8c4 CD |
21716 | (org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) |
21717 | (org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) | |
21718 | (org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol) | |
21719 | (org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) | |
21720 | (org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) | |
791d856f | 21721 | |
d3f4dbe8 CD |
21722 | (defvar org-cdlatex-texmathp-advice-is-done nil |
21723 | "Flag remembering if we have applied the advice to texmathp already.") | |
21724 | ||
21725 | (define-minor-mode org-cdlatex-mode | |
21726 | "Toggle the minor `org-cdlatex-mode'. | |
21727 | This mode supports entering LaTeX environment and math in LaTeX fragments | |
21728 | in Org-mode. | |
21729 | \\{org-cdlatex-mode-map}" | |
21730 | nil " OCDL" nil | |
21731 | (when org-cdlatex-mode (require 'cdlatex)) | |
21732 | (unless org-cdlatex-texmathp-advice-is-done | |
21733 | (setq org-cdlatex-texmathp-advice-is-done t) | |
21734 | (defadvice texmathp (around org-math-always-on activate) | |
21735 | "Always return t in org-mode buffers. | |
21736 | This is because we want to insert math symbols without dollars even outside | |
21737 | the LaTeX math segments. If Orgmode thinks that point is actually inside | |
21738 | en embedded LaTeX fragement, let texmathp do its job. | |
21739 | \\[org-cdlatex-mode-map]" | |
21740 | (interactive) | |
21741 | (let (p) | |
21742 | (cond | |
21743 | ((not (org-mode-p)) ad-do-it) | |
21744 | ((eq this-command 'cdlatex-math-symbol) | |
21745 | (setq ad-return-value t | |
21746 | texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) | |
21747 | (t | |
21748 | (let ((p (org-inside-LaTeX-fragment-p))) | |
21749 | (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) | |
21750 | (setq ad-return-value t | |
21751 | texmathp-why '("Org-mode embedded math" . 0)) | |
21752 | (if p ad-do-it))))))))) | |
21753 | ||
21754 | (defun turn-on-org-cdlatex () | |
21755 | "Unconditionally turn on `org-cdlatex-mode'." | |
21756 | (org-cdlatex-mode 1)) | |
21757 | ||
21758 | (defun org-inside-LaTeX-fragment-p () | |
21759 | "Test if point is inside a LaTeX fragment. | |
21760 | I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing | |
21761 | sequence appearing also before point. | |
21762 | Even though the matchers for math are configurable, this function assumes | |
21763 | that \\begin, \\(, \\[, and $$ are always used. Only the single dollar | |
21764 | delimiters are skipped when they have been removed by customization. | |
21765 | The return value is nil, or a cons cell with the delimiter and | |
21766 | and the position of this delimiter. | |
21767 | ||
21768 | This function does a reasonably good job, but can locally be fooled by | |
21769 | for example currency specifications. For example it will assume being in | |
21770 | inline math after \"$22.34\". The LaTeX fragment formatter will only format | |
21771 | fragments that are properly closed, but during editing, we have to live | |
21772 | with the uncertainty caused by missing closing delimiters. This function | |
21773 | looks only before point, not after." | |
21774 | (catch 'exit | |
21775 | (let ((pos (point)) | |
21776 | (dodollar (member "$" (plist-get org-format-latex-options :matchers))) | |
21777 | (lim (progn | |
21778 | (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) | |
21779 | (point))) | |
21780 | dd-on str (start 0) m re) | |
21781 | (goto-char pos) | |
21782 | (when dodollar | |
21783 | (setq str (concat (buffer-substring lim (point)) "\000 X$.") | |
21784 | re (nth 1 (assoc "$" org-latex-regexps))) | |
21785 | (while (string-match re str start) | |
21786 | (cond | |
21787 | ((= (match-end 0) (length str)) | |
a3fbe8c4 | 21788 | (throw 'exit (cons "$" (+ lim (match-beginning 0) 1)))) |
d3f4dbe8 CD |
21789 | ((= (match-end 0) (- (length str) 5)) |
21790 | (throw 'exit nil)) | |
21791 | (t (setq start (match-end 0)))))) | |
21792 | (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t)) | |
21793 | (goto-char pos) | |
21794 | (and (match-beginning 1) (throw 'exit (cons (match-string 1) m))) | |
21795 | (and (match-beginning 2) (throw 'exit nil)) | |
21796 | ;; count $$ | |
21797 | (while (re-search-backward "\\$\\$" lim t) | |
21798 | (setq dd-on (not dd-on))) | |
21799 | (goto-char pos) | |
21800 | (if dd-on (cons "$$" m)))))) | |
21801 | ||
21802 | ||
21803 | (defun org-try-cdlatex-tab () | |
21804 | "Check if it makes sense to execute `cdlatex-tab', and do it if yes. | |
21805 | It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is | |
21806 | - inside a LaTeX fragment, or | |
21807 | - after the first word in a line, where an abbreviation expansion could | |
21808 | insert a LaTeX environment." | |
21809 | (when org-cdlatex-mode | |
21810 | (cond | |
21811 | ((save-excursion | |
21812 | (skip-chars-backward "a-zA-Z0-9*") | |
21813 | (skip-chars-backward " \t") | |
21814 | (bolp)) | |
21815 | (cdlatex-tab) t) | |
21816 | ((org-inside-LaTeX-fragment-p) | |
21817 | (cdlatex-tab) t) | |
21818 | (t nil)))) | |
791d856f | 21819 | |
d3f4dbe8 CD |
21820 | (defun org-cdlatex-underscore-caret (&optional arg) |
21821 | "Execute `cdlatex-sub-superscript' in LaTeX fragments. | |
21822 | Revert to the normal definition outside of these fragments." | |
ab27a4a0 | 21823 | (interactive "P") |
d3f4dbe8 CD |
21824 | (if (org-inside-LaTeX-fragment-p) |
21825 | (call-interactively 'cdlatex-sub-superscript) | |
21826 | (let (org-cdlatex-mode) | |
21827 | (call-interactively (key-binding (vector last-input-event)))))) | |
791d856f | 21828 | |
d3f4dbe8 CD |
21829 | (defun org-cdlatex-math-modify (&optional arg) |
21830 | "Execute `cdlatex-math-modify' in LaTeX fragments. | |
21831 | Revert to the normal definition outside of these fragments." | |
21832 | (interactive "P") | |
21833 | (if (org-inside-LaTeX-fragment-p) | |
21834 | (call-interactively 'cdlatex-math-modify) | |
21835 | (let (org-cdlatex-mode) | |
791d856f CD |
21836 | (call-interactively (key-binding (vector last-input-event)))))) |
21837 | ||
d3f4dbe8 CD |
21838 | (defvar org-latex-fragment-image-overlays nil |
21839 | "List of overlays carrying the images of latex fragments.") | |
21840 | (make-variable-buffer-local 'org-latex-fragment-image-overlays) | |
21841 | ||
21842 | (defun org-remove-latex-fragment-image-overlays () | |
21843 | "Remove all overlays with LaTeX fragment images in current buffer." | |
21844 | (mapc 'org-delete-overlay org-latex-fragment-image-overlays) | |
21845 | (setq org-latex-fragment-image-overlays nil)) | |
21846 | ||
21847 | (defun org-preview-latex-fragment (&optional subtree) | |
21848 | "Preview the LaTeX fragment at point, or all locally or globally. | |
21849 | If the cursor is in a LaTeX fragment, create the image and overlay | |
21850 | it over the source code. If there is no fragment at point, display | |
21851 | all fragments in the current text, from one headline to the next. With | |
21852 | prefix SUBTREE, display all fragments in the current subtree. With a | |
21853 | double prefix `C-u C-u', or when the cursor is before the first headline, | |
21854 | display all fragments in the buffer. | |
21855 | The images can be removed again with \\[org-ctrl-c-ctrl-c]." | |
21856 | (interactive "P") | |
21857 | (org-remove-latex-fragment-image-overlays) | |
21858 | (save-excursion | |
21859 | (save-restriction | |
21860 | (let (beg end at msg) | |
21861 | (cond | |
21862 | ((or (equal subtree '(16)) | |
21863 | (not (save-excursion | |
21864 | (re-search-backward (concat "^" outline-regexp) nil t)))) | |
21865 | (setq beg (point-min) end (point-max) | |
21866 | msg "Creating images for buffer...%s")) | |
21867 | ((equal subtree '(4)) | |
21868 | (org-back-to-heading) | |
21869 | (setq beg (point) end (org-end-of-subtree t) | |
21870 | msg "Creating images for subtree...%s")) | |
21871 | (t | |
21872 | (if (setq at (org-inside-LaTeX-fragment-p)) | |
21873 | (goto-char (max (point-min) (- (cdr at) 2))) | |
21874 | (org-back-to-heading)) | |
21875 | (setq beg (point) end (progn (outline-next-heading) (point)) | |
21876 | msg (if at "Creating image...%s" | |
21877 | "Creating images for entry...%s")))) | |
21878 | (message msg "") | |
21879 | (narrow-to-region beg end) | |
a3fbe8c4 | 21880 | (goto-char beg) |
d3f4dbe8 CD |
21881 | (org-format-latex |
21882 | (concat "ltxpng/" (file-name-sans-extension | |
21883 | (file-name-nondirectory | |
21884 | buffer-file-name))) | |
a3fbe8c4 | 21885 | default-directory 'overlays msg at 'forbuffer) |
d3f4dbe8 CD |
21886 | (message msg "done. Use `C-c C-c' to remove images."))))) |
21887 | ||
21888 | (defvar org-latex-regexps | |
21889 | '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) | |
21890 | ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) | |
21891 | ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p | |
21892 | ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([ .,?;:'\")\000]\\|$\\)" 2 nil) | |
21893 | ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) | |
21894 | ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 t) | |
21895 | ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t)) | |
21896 | "Regular expressions for matching embedded LaTeX.") | |
21897 | ||
a3fbe8c4 | 21898 | (defun org-format-latex (prefix &optional dir overlays msg at forbuffer) |
d3f4dbe8 CD |
21899 | "Replace LaTeX fragments with links to an image, and produce images." |
21900 | (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) | |
21901 | (let* ((prefixnodir (file-name-nondirectory prefix)) | |
21902 | (absprefix (expand-file-name prefix dir)) | |
21903 | (todir (file-name-directory absprefix)) | |
21904 | (opt org-format-latex-options) | |
21905 | (matchers (plist-get opt :matchers)) | |
21906 | (re-list org-latex-regexps) | |
21907 | (cnt 0) txt link beg end re e checkdir | |
21908 | m n block linkfile movefile ov) | |
21909 | ;; Check if there are old images files with this prefix, and remove them | |
21910 | (when (file-directory-p todir) | |
21911 | (mapc 'delete-file | |
21912 | (directory-files | |
21913 | todir 'full | |
21914 | (concat (regexp-quote prefixnodir) "_[0-9]+\\.png$")))) | |
21915 | ;; Check the different regular expressions | |
21916 | (while (setq e (pop re-list)) | |
21917 | (setq m (car e) re (nth 1 e) n (nth 2 e) | |
21918 | block (if (nth 3 e) "\n\n" "")) | |
21919 | (when (member m matchers) | |
21920 | (goto-char (point-min)) | |
21921 | (while (re-search-forward re nil t) | |
21922 | (when (or (not at) (equal (cdr at) (match-beginning n))) | |
21923 | (setq txt (match-string n) | |
21924 | beg (match-beginning n) end (match-end n) | |
21925 | cnt (1+ cnt) | |
21926 | linkfile (format "%s_%04d.png" prefix cnt) | |
21927 | movefile (format "%s_%04d.png" absprefix cnt) | |
21928 | link (concat block "[[file:" linkfile "]]" block)) | |
21929 | (if msg (message msg cnt)) | |
21930 | (goto-char beg) | |
21931 | (unless checkdir ; make sure the directory exists | |
21932 | (setq checkdir t) | |
21933 | (or (file-directory-p todir) (make-directory todir))) | |
21934 | (org-create-formula-image | |
a3fbe8c4 | 21935 | txt movefile opt forbuffer) |
d3f4dbe8 CD |
21936 | (if overlays |
21937 | (progn | |
21938 | (setq ov (org-make-overlay beg end)) | |
21939 | (if (featurep 'xemacs) | |
21940 | (progn | |
21941 | (org-overlay-put ov 'invisible t) | |
21942 | (org-overlay-put | |
21943 | ov 'end-glyph | |
21944 | (make-glyph (vector 'png :file movefile)))) | |
21945 | (org-overlay-put | |
21946 | ov 'display | |
21947 | (list 'image :type 'png :file movefile :ascent 'center))) | |
21948 | (push ov org-latex-fragment-image-overlays) | |
21949 | (goto-char end)) | |
21950 | (delete-region beg end) | |
21951 | (insert link)))))))) | |
21952 | ||
21953 | ;; This function borrows from Ganesh Swami's latex2png.el | |
a3fbe8c4 | 21954 | (defun org-create-formula-image (string tofile options buffer) |
d3f4dbe8 CD |
21955 | (let* ((tmpdir (if (featurep 'xemacs) |
21956 | (temp-directory) | |
21957 | temporary-file-directory)) | |
21958 | (texfilebase (make-temp-name | |
21959 | (expand-file-name "orgtex" tmpdir))) | |
d3f4dbe8 CD |
21960 | (texfile (concat texfilebase ".tex")) |
21961 | (dvifile (concat texfilebase ".dvi")) | |
21962 | (pngfile (concat texfilebase ".png")) | |
a3fbe8c4 CD |
21963 | (fnh (face-attribute 'default :height nil)) |
21964 | (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) | |
21965 | (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) | |
21966 | (fg (or (plist-get options (if buffer :foreground :html-foreground)) | |
21967 | "Black")) | |
21968 | (bg (or (plist-get options (if buffer :background :html-background)) | |
21969 | "Transparent"))) | |
21970 | (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))) | |
21971 | (if (eq bg 'default) (setq bg (org-dvipng-color :background))) | |
d3f4dbe8 | 21972 | (with-temp-file texfile |
a3fbe8c4 CD |
21973 | (insert org-format-latex-header |
21974 | "\n\\begin{document}\n" string "\n\\end{document}\n")) | |
d3f4dbe8 CD |
21975 | (let ((dir default-directory)) |
21976 | (condition-case nil | |
21977 | (progn | |
21978 | (cd tmpdir) | |
21979 | (call-process "latex" nil nil nil texfile)) | |
21980 | (error nil)) | |
21981 | (cd dir)) | |
21982 | (if (not (file-exists-p dvifile)) | |
21983 | (progn (message "Failed to create dvi file from %s" texfile) nil) | |
21984 | (call-process "dvipng" nil nil nil | |
21985 | "-E" "-fg" fg "-bg" bg | |
a3fbe8c4 CD |
21986 | "-D" dpi |
21987 | ;;"-x" scale "-y" scale | |
21988 | "-T" "tight" | |
d3f4dbe8 CD |
21989 | "-o" pngfile |
21990 | dvifile) | |
21991 | (if (not (file-exists-p pngfile)) | |
21992 | (progn (message "Failed to create png file from %s" texfile) nil) | |
21993 | ;; Use the requested file name and clean up | |
21994 | (copy-file pngfile tofile 'replace) | |
21995 | (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do | |
21996 | (delete-file (concat texfilebase e))) | |
21997 | pngfile)))) | |
21998 | ||
a3fbe8c4 CD |
21999 | (defun org-dvipng-color (attr) |
22000 | "Return an rgb color specification for dvipng." | |
22001 | (apply 'format "rgb %s %s %s" | |
22002 | (mapcar 'org-normalize-color | |
22003 | (color-values (face-attribute 'default attr nil))))) | |
22004 | ||
22005 | (defun org-normalize-color (value) | |
22006 | "Return string to be used as color value for an RGB component." | |
22007 | (format "%g" (/ value 65535.0))) | |
22008 | ||
d3f4dbe8 | 22009 | ;;;; Exporting |
28e5b051 | 22010 | |
d3f4dbe8 | 22011 | ;;; Variables, constants, and parameter plists |
891f4676 RS |
22012 | |
22013 | (defconst org-level-max 20) | |
22014 | ||
4b3a9ba7 CD |
22015 | (defvar org-export-html-preamble nil |
22016 | "Preamble, to be inserted just after <body>. Set by publishing functions.") | |
22017 | (defvar org-export-html-postamble nil | |
22018 | "Preamble, to be inserted just before </body>. Set by publishing functions.") | |
22019 | (defvar org-export-html-auto-preamble t | |
22020 | "Should default preamble be inserted? Set by publishing functions.") | |
22021 | (defvar org-export-html-auto-postamble t | |
22022 | "Should default postamble be inserted? Set by publishing functions.") | |
d3f4dbe8 CD |
22023 | (defvar org-current-export-file nil) ; dynamically scoped parameter |
22024 | (defvar org-current-export-dir nil) ; dynamically scoped parameter | |
22025 | ||
4b3a9ba7 CD |
22026 | |
22027 | (defconst org-export-plist-vars | |
22028 | '((:language . org-export-default-language) | |
d3f4dbe8 | 22029 | (:customtime . org-display-custom-times) |
4b3a9ba7 CD |
22030 | (:headline-levels . org-export-headline-levels) |
22031 | (:section-numbers . org-export-with-section-numbers) | |
22032 | (:table-of-contents . org-export-with-toc) | |
a3fbe8c4 | 22033 | (:preserve-breaks . org-export-preserve-breaks) |
6769c0dc | 22034 | (:archived-trees . org-export-with-archived-trees) |
4b3a9ba7 CD |
22035 | (:emphasize . org-export-with-emphasize) |
22036 | (:sub-superscript . org-export-with-sub-superscripts) | |
5152b597 | 22037 | (:footnotes . org-export-with-footnotes) |
03f3cf35 JW |
22038 | (:drawers . org-export-with-drawers) |
22039 | (:tags . org-export-with-tags) | |
4b3a9ba7 | 22040 | (:TeX-macros . org-export-with-TeX-macros) |
6769c0dc | 22041 | (:LaTeX-fragments . org-export-with-LaTeX-fragments) |
a3fbe8c4 | 22042 | (:skip-before-1st-heading . org-export-skip-text-before-1st-heading) |
4b3a9ba7 CD |
22043 | (:fixed-width . org-export-with-fixed-width) |
22044 | (:timestamps . org-export-with-timestamps) | |
48aaad2d CD |
22045 | (:author-info . org-export-author-info) |
22046 | (:time-stamp-file . org-export-time-stamp-file) | |
4b3a9ba7 CD |
22047 | (:tables . org-export-with-tables) |
22048 | (:table-auto-headline . org-export-highlight-first-table-line) | |
22049 | (:style . org-export-html-style) | |
a3fbe8c4 | 22050 | (:agenda-style . org-agenda-export-html-style) ;; FIXME: Does this work???? |
4b3a9ba7 CD |
22051 | (:convert-org-links . org-export-html-link-org-files-as-html) |
22052 | (:inline-images . org-export-html-inline-images) | |
15841868 | 22053 | (:html-extension . org-export-html-extension) |
4b3a9ba7 CD |
22054 | (:expand-quoted-html . org-export-html-expand) |
22055 | (:timestamp . org-export-html-with-timestamp) | |
22056 | (:publishing-directory . org-export-publishing-directory) | |
22057 | (:preamble . org-export-html-preamble) | |
22058 | (:postamble . org-export-html-postamble) | |
22059 | (:auto-preamble . org-export-html-auto-preamble) | |
22060 | (:auto-postamble . org-export-html-auto-postamble) | |
22061 | (:author . user-full-name) | |
22062 | (:email . user-mail-address))) | |
22063 | ||
22064 | (defun org-default-export-plist () | |
22065 | "Return the property list with default settings for the export variables." | |
22066 | (let ((l org-export-plist-vars) rtn e) | |
22067 | (while (setq e (pop l)) | |
22068 | (setq rtn (cons (car e) (cons (symbol-value (cdr e)) rtn)))) | |
22069 | rtn)) | |
22070 | ||
22071 | (defun org-infile-export-plist () | |
22072 | "Return the property list with file-local settings for export." | |
22073 | (save-excursion | |
22074 | (goto-char 0) | |
22075 | (let ((re (org-make-options-regexp | |
0b8568f5 | 22076 | '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))) |
4b3a9ba7 CD |
22077 | p key val text options) |
22078 | (while (re-search-forward re nil t) | |
22079 | (setq key (org-match-string-no-properties 1) | |
22080 | val (org-match-string-no-properties 2)) | |
edd21304 | 22081 | (cond |
4b3a9ba7 CD |
22082 | ((string-equal key "TITLE") (setq p (plist-put p :title val))) |
22083 | ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) | |
22084 | ((string-equal key "EMAIL") (setq p (plist-put p :email val))) | |
0b8568f5 | 22085 | ((string-equal key "DATE") (setq p (plist-put p :date val))) |
4b3a9ba7 CD |
22086 | ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) |
22087 | ((string-equal key "TEXT") | |
22088 | (setq text (if text (concat text "\n" val) val))) | |
22089 | ((string-equal key "OPTIONS") (setq options val)))) | |
22090 | (setq p (plist-put p :text text)) | |
22091 | (when options | |
22092 | (let ((op '(("H" . :headline-levels) | |
22093 | ("num" . :section-numbers) | |
22094 | ("toc" . :table-of-contents) | |
edd21304 | 22095 | ("\\n" . :preserve-breaks) |
4b3a9ba7 CD |
22096 | ("@" . :expand-quoted-html) |
22097 | (":" . :fixed-width) | |
22098 | ("|" . :tables) | |
22099 | ("^" . :sub-superscript) | |
5152b597 | 22100 | ("f" . :footnotes) |
03f3cf35 JW |
22101 | ("d" . :drawers) |
22102 | ("tags" . :tags) | |
4b3a9ba7 | 22103 | ("*" . :emphasize) |
6769c0dc | 22104 | ("TeX" . :TeX-macros) |
a3fbe8c4 | 22105 | ("LaTeX" . :LaTeX-fragments) |
48aaad2d CD |
22106 | ("skip" . :skip-before-1st-heading) |
22107 | ("author" . :author-info) | |
22108 | ("timestamp" . :time-stamp-file))) | |
4b3a9ba7 CD |
22109 | o) |
22110 | (while (setq o (pop op)) | |
edd21304 | 22111 | (if (string-match (concat (regexp-quote (car o)) |
4b3a9ba7 CD |
22112 | ":\\([^ \t\n\r;,.]*\\)") |
22113 | options) | |
22114 | (setq p (plist-put p (cdr o) | |
22115 | (car (read-from-string | |
22116 | (match-string 1 options))))))))) | |
22117 | p))) | |
22118 | ||
4b3a9ba7 CD |
22119 | (defun org-export-directory (type plist) |
22120 | (let* ((val (plist-get plist :publishing-directory)) | |
22121 | (dir (if (listp val) | |
22122 | (or (cdr (assoc type val)) ".") | |
22123 | val))) | |
22124 | dir)) | |
22125 | ||
891f4676 RS |
22126 | (defun org-skip-comments (lines) |
22127 | "Skip lines starting with \"#\" and subtrees starting with COMMENT." | |
22128 | (let ((re1 (concat "^\\(\\*+\\)[ \t]+" org-comment-string)) | |
c8d16429 | 22129 | (re2 "^\\(\\*+\\)[ \t\n\r]") |
a3fbe8c4 | 22130 | (case-fold-search nil) |
c8d16429 | 22131 | rtn line level) |
891f4676 RS |
22132 | (while (setq line (pop lines)) |
22133 | (cond | |
22134 | ((and (string-match re1 line) | |
c8d16429 CD |
22135 | (setq level (- (match-end 1) (match-beginning 1)))) |
22136 | ;; Beginning of a COMMENT subtree. Skip it. | |
22137 | (while (and (setq line (pop lines)) | |
22138 | (or (not (string-match re2 line)) | |
22139 | (> (- (match-end 1) (match-beginning 1)) level)))) | |
22140 | (setq lines (cons line lines))) | |
891f4676 | 22141 | ((string-match "^#" line) |
c8d16429 CD |
22142 | ;; an ordinary comment line |
22143 | ) | |
a96ee7df | 22144 | ((and org-export-table-remove-special-lines |
7d143c25 CD |
22145 | (string-match "^[ \t]*|" line) |
22146 | (or (string-match "^[ \t]*| *[!_^] *|" line) | |
22147 | (and (string-match "| *<[0-9]+> *|" line) | |
22148 | (not (string-match "| *[^ <|]" line))))) | |
a96ee7df CD |
22149 | ;; a special table line that should be removed |
22150 | ) | |
891f4676 RS |
22151 | (t (setq rtn (cons line rtn))))) |
22152 | (nreverse rtn))) | |
22153 | ||
edd21304 CD |
22154 | (defun org-export (&optional arg) |
22155 | (interactive) | |
22156 | (let ((help "[t] insert the export option template | |
22157 | \[v] limit export to visible part of outline tree | |
22158 | ||
22159 | \[a] export as ASCII | |
48aaad2d | 22160 | |
edd21304 | 22161 | \[h] export as HTML |
a3fbe8c4 | 22162 | \[H] export as HTML to temporary buffer |
48aaad2d | 22163 | \[R] export region as HTML |
edd21304 CD |
22164 | \[b] export as HTML and browse immediately |
22165 | \[x] export as XOXO | |
22166 | ||
48aaad2d CD |
22167 | \[l] export as LaTeX |
22168 | \[L] export as LaTeX to temporary buffer | |
22169 | ||
edd21304 CD |
22170 | \[i] export current file as iCalendar file |
22171 | \[I] export all agenda files as iCalendar files | |
22172 | \[c] export agenda files into combined iCalendar file | |
22173 | ||
22174 | \[F] publish current file | |
22175 | \[P] publish current project | |
22176 | \[X] publish... (project will be prompted for) | |
22177 | \[A] publish all projects") | |
22178 | (cmds | |
0fee8d6e CD |
22179 | '((?t . org-insert-export-options-template) |
22180 | (?v . org-export-visible) | |
edd21304 CD |
22181 | (?a . org-export-as-ascii) |
22182 | (?h . org-export-as-html) | |
22183 | (?b . org-export-as-html-and-open) | |
a3fbe8c4 CD |
22184 | (?H . org-export-as-html-to-buffer) |
22185 | (?R . org-export-region-as-html) | |
edd21304 | 22186 | (?x . org-export-as-xoxo) |
48aaad2d CD |
22187 | (?l . org-export-as-latex) |
22188 | (?L . org-export-as-latex-to-buffer) | |
edd21304 CD |
22189 | (?i . org-export-icalendar-this-file) |
22190 | (?I . org-export-icalendar-all-agenda-files) | |
22191 | (?c . org-export-icalendar-combine-agenda-files) | |
22192 | (?F . org-publish-current-file) | |
22193 | (?P . org-publish-current-project) | |
22194 | (?X . org-publish) | |
22195 | (?A . org-publish-all))) | |
22196 | r1 r2 ass) | |
22197 | (save-window-excursion | |
22198 | (delete-other-windows) | |
22199 | (with-output-to-temp-buffer "*Org Export/Publishing Help*" | |
22200 | (princ help)) | |
22201 | (message "Select command: ") | |
22202 | (setq r1 (read-char-exclusive))) | |
22203 | (setq r2 (if (< r1 27) (+ r1 96) r1)) | |
22204 | (if (setq ass (assq r2 cmds)) | |
22205 | (call-interactively (cdr ass)) | |
22206 | (error "No command associated with key %c" r1)))) | |
22207 | ||
891f4676 RS |
22208 | (defconst org-html-entities |
22209 | '(("nbsp") | |
22210 | ("iexcl") | |
22211 | ("cent") | |
22212 | ("pound") | |
22213 | ("curren") | |
22214 | ("yen") | |
22215 | ("brvbar") | |
a3fbe8c4 | 22216 | ("vert" . "|") |
891f4676 RS |
22217 | ("sect") |
22218 | ("uml") | |
22219 | ("copy") | |
22220 | ("ordf") | |
22221 | ("laquo") | |
22222 | ("not") | |
22223 | ("shy") | |
22224 | ("reg") | |
22225 | ("macr") | |
22226 | ("deg") | |
22227 | ("plusmn") | |
22228 | ("sup2") | |
22229 | ("sup3") | |
22230 | ("acute") | |
22231 | ("micro") | |
22232 | ("para") | |
22233 | ("middot") | |
22234 | ("odot"."o") | |
22235 | ("star"."*") | |
22236 | ("cedil") | |
22237 | ("sup1") | |
22238 | ("ordm") | |
22239 | ("raquo") | |
22240 | ("frac14") | |
22241 | ("frac12") | |
22242 | ("frac34") | |
22243 | ("iquest") | |
22244 | ("Agrave") | |
22245 | ("Aacute") | |
22246 | ("Acirc") | |
22247 | ("Atilde") | |
22248 | ("Auml") | |
22249 | ("Aring") ("AA"."Å") | |
22250 | ("AElig") | |
22251 | ("Ccedil") | |
22252 | ("Egrave") | |
22253 | ("Eacute") | |
22254 | ("Ecirc") | |
22255 | ("Euml") | |
22256 | ("Igrave") | |
22257 | ("Iacute") | |
22258 | ("Icirc") | |
22259 | ("Iuml") | |
22260 | ("ETH") | |
22261 | ("Ntilde") | |
22262 | ("Ograve") | |
22263 | ("Oacute") | |
22264 | ("Ocirc") | |
22265 | ("Otilde") | |
22266 | ("Ouml") | |
22267 | ("times") | |
22268 | ("Oslash") | |
22269 | ("Ugrave") | |
22270 | ("Uacute") | |
22271 | ("Ucirc") | |
22272 | ("Uuml") | |
22273 | ("Yacute") | |
22274 | ("THORN") | |
22275 | ("szlig") | |
22276 | ("agrave") | |
22277 | ("aacute") | |
22278 | ("acirc") | |
22279 | ("atilde") | |
22280 | ("auml") | |
22281 | ("aring") | |
22282 | ("aelig") | |
22283 | ("ccedil") | |
22284 | ("egrave") | |
22285 | ("eacute") | |
22286 | ("ecirc") | |
22287 | ("euml") | |
22288 | ("igrave") | |
22289 | ("iacute") | |
22290 | ("icirc") | |
22291 | ("iuml") | |
22292 | ("eth") | |
22293 | ("ntilde") | |
22294 | ("ograve") | |
22295 | ("oacute") | |
22296 | ("ocirc") | |
22297 | ("otilde") | |
22298 | ("ouml") | |
22299 | ("divide") | |
22300 | ("oslash") | |
22301 | ("ugrave") | |
22302 | ("uacute") | |
22303 | ("ucirc") | |
22304 | ("uuml") | |
22305 | ("yacute") | |
22306 | ("thorn") | |
22307 | ("yuml") | |
22308 | ("fnof") | |
22309 | ("Alpha") | |
22310 | ("Beta") | |
22311 | ("Gamma") | |
22312 | ("Delta") | |
22313 | ("Epsilon") | |
22314 | ("Zeta") | |
22315 | ("Eta") | |
22316 | ("Theta") | |
22317 | ("Iota") | |
22318 | ("Kappa") | |
22319 | ("Lambda") | |
22320 | ("Mu") | |
22321 | ("Nu") | |
22322 | ("Xi") | |
22323 | ("Omicron") | |
22324 | ("Pi") | |
22325 | ("Rho") | |
22326 | ("Sigma") | |
22327 | ("Tau") | |
22328 | ("Upsilon") | |
22329 | ("Phi") | |
22330 | ("Chi") | |
22331 | ("Psi") | |
22332 | ("Omega") | |
22333 | ("alpha") | |
22334 | ("beta") | |
22335 | ("gamma") | |
22336 | ("delta") | |
22337 | ("epsilon") | |
22338 | ("varepsilon"."ε") | |
22339 | ("zeta") | |
22340 | ("eta") | |
22341 | ("theta") | |
22342 | ("iota") | |
22343 | ("kappa") | |
22344 | ("lambda") | |
22345 | ("mu") | |
22346 | ("nu") | |
22347 | ("xi") | |
22348 | ("omicron") | |
22349 | ("pi") | |
22350 | ("rho") | |
22351 | ("sigmaf") ("varsigma"."ς") | |
22352 | ("sigma") | |
22353 | ("tau") | |
22354 | ("upsilon") | |
22355 | ("phi") | |
22356 | ("chi") | |
22357 | ("psi") | |
22358 | ("omega") | |
22359 | ("thetasym") ("vartheta"."ϑ") | |
22360 | ("upsih") | |
22361 | ("piv") | |
22362 | ("bull") ("bullet"."•") | |
22363 | ("hellip") ("dots"."…") | |
22364 | ("prime") | |
22365 | ("Prime") | |
22366 | ("oline") | |
22367 | ("frasl") | |
22368 | ("weierp") | |
22369 | ("image") | |
22370 | ("real") | |
22371 | ("trade") | |
22372 | ("alefsym") | |
22373 | ("larr") ("leftarrow"."←") ("gets"."←") | |
22374 | ("uarr") ("uparrow"."↑") | |
22375 | ("rarr") ("to"."→") ("rightarrow"."→") | |
22376 | ("darr")("downarrow"."↓") | |
22377 | ("harr") ("leftrightarrow"."↔") | |
22378 | ("crarr") ("hookleftarrow"."↵") ; has round hook, not quite CR | |
22379 | ("lArr") ("Leftarrow"."⇐") | |
22380 | ("uArr") ("Uparrow"."⇑") | |
22381 | ("rArr") ("Rightarrow"."⇒") | |
22382 | ("dArr") ("Downarrow"."⇓") | |
22383 | ("hArr") ("Leftrightarrow"."⇔") | |
22384 | ("forall") | |
22385 | ("part") ("partial"."∂") | |
22386 | ("exist") ("exists"."∃") | |
22387 | ("empty") ("emptyset"."∅") | |
22388 | ("nabla") | |
22389 | ("isin") ("in"."∈") | |
22390 | ("notin") | |
22391 | ("ni") | |
22392 | ("prod") | |
22393 | ("sum") | |
22394 | ("minus") | |
22395 | ("lowast") ("ast"."∗") | |
22396 | ("radic") | |
22397 | ("prop") ("proptp"."∝") | |
22398 | ("infin") ("infty"."∞") | |
22399 | ("ang") ("angle"."∠") | |
22400 | ("and") ("vee"."∧") | |
22401 | ("or") ("wedge"."∨") | |
22402 | ("cap") | |
22403 | ("cup") | |
22404 | ("int") | |
22405 | ("there4") | |
22406 | ("sim") | |
22407 | ("cong") ("simeq"."≅") | |
22408 | ("asymp")("approx"."≈") | |
22409 | ("ne") ("neq"."≠") | |
22410 | ("equiv") | |
22411 | ("le") | |
22412 | ("ge") | |
22413 | ("sub") ("subset"."⊂") | |
22414 | ("sup") ("supset"."⊃") | |
22415 | ("nsub") | |
22416 | ("sube") | |
22417 | ("supe") | |
22418 | ("oplus") | |
22419 | ("otimes") | |
22420 | ("perp") | |
22421 | ("sdot") ("cdot"."⋅") | |
22422 | ("lceil") | |
22423 | ("rceil") | |
22424 | ("lfloor") | |
22425 | ("rfloor") | |
22426 | ("lang") | |
22427 | ("rang") | |
22428 | ("loz") ("Diamond"."◊") | |
22429 | ("spades") ("spadesuit"."♠") | |
22430 | ("clubs") ("clubsuit"."♣") | |
22431 | ("hearts") ("diamondsuit"."♥") | |
22432 | ("diams") ("diamondsuit"."♦") | |
48aaad2d | 22433 | ("smile"."☺") ("blacksmile"."☻") ("sad"."☹") |
891f4676 RS |
22434 | ("quot") |
22435 | ("amp") | |
22436 | ("lt") | |
22437 | ("gt") | |
22438 | ("OElig") | |
22439 | ("oelig") | |
22440 | ("Scaron") | |
22441 | ("scaron") | |
22442 | ("Yuml") | |
22443 | ("circ") | |
22444 | ("tilde") | |
22445 | ("ensp") | |
22446 | ("emsp") | |
22447 | ("thinsp") | |
22448 | ("zwnj") | |
22449 | ("zwj") | |
22450 | ("lrm") | |
22451 | ("rlm") | |
22452 | ("ndash") | |
22453 | ("mdash") | |
22454 | ("lsquo") | |
22455 | ("rsquo") | |
22456 | ("sbquo") | |
22457 | ("ldquo") | |
22458 | ("rdquo") | |
22459 | ("bdquo") | |
22460 | ("dagger") | |
22461 | ("Dagger") | |
22462 | ("permil") | |
22463 | ("lsaquo") | |
22464 | ("rsaquo") | |
22465 | ("euro") | |
22466 | ||
22467 | ("arccos"."arccos") | |
22468 | ("arcsin"."arcsin") | |
22469 | ("arctan"."arctan") | |
22470 | ("arg"."arg") | |
22471 | ("cos"."cos") | |
22472 | ("cosh"."cosh") | |
22473 | ("cot"."cot") | |
22474 | ("coth"."coth") | |
22475 | ("csc"."csc") | |
22476 | ("deg"."deg") | |
22477 | ("det"."det") | |
22478 | ("dim"."dim") | |
22479 | ("exp"."exp") | |
22480 | ("gcd"."gcd") | |
22481 | ("hom"."hom") | |
22482 | ("inf"."inf") | |
22483 | ("ker"."ker") | |
22484 | ("lg"."lg") | |
22485 | ("lim"."lim") | |
22486 | ("liminf"."liminf") | |
22487 | ("limsup"."limsup") | |
22488 | ("ln"."ln") | |
22489 | ("log"."log") | |
22490 | ("max"."max") | |
22491 | ("min"."min") | |
22492 | ("Pr"."Pr") | |
22493 | ("sec"."sec") | |
22494 | ("sin"."sin") | |
22495 | ("sinh"."sinh") | |
22496 | ("sup"."sup") | |
22497 | ("tan"."tan") | |
22498 | ("tanh"."tanh") | |
22499 | ) | |
22500 | "Entities for TeX->HTML translation. | |
22501 | Entries can be like (\"ent\"), in which case \"\\ent\" will be translated to | |
22502 | \"&ent;\". An entry can also be a dotted pair like (\"ent\".\"&other;\"). | |
22503 | In that case, \"\\ent\" will be translated to \"&other;\". | |
22504 | The list contains HTML entities for Latin-1, Greek and other symbols. | |
22505 | It is supplemented by a number of commonly used TeX macros with appropriate | |
9acdaa21 | 22506 | translations. There is currently no way for users to extend this.") |
891f4676 | 22507 | |
d3f4dbe8 CD |
22508 | ;;; General functions for all backends |
22509 | ||
edd21304 | 22510 | (defun org-cleaned-string-for-export (string &rest parameters) |
48aaad2d | 22511 | "Cleanup a buffer STRING so that links can be created safely." |
272dfec2 | 22512 | (interactive) |
6769c0dc | 22513 | (let* ((re-radio (and org-target-link-regexp |
7204b00e | 22514 | (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))) |
ab27a4a0 CD |
22515 | (re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) |
22516 | (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) | |
6769c0dc | 22517 | (re-archive (concat ":" org-archive-tag ":")) |
d3f4dbe8 | 22518 | (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")) |
48aaad2d | 22519 | (re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>")) |
a3fbe8c4 | 22520 | (htmlp (plist-get parameters :for-html)) |
48aaad2d CD |
22521 | (asciip (plist-get parameters :for-ascii)) |
22522 | (latexp (plist-get parameters :for-LaTeX)) | |
22523 | (commentsp (plist-get parameters :comments)) | |
374585c9 | 22524 | (archived-trees (plist-get parameters :archived-trees)) |
7d58338e CD |
22525 | (inhibit-read-only t) |
22526 | (outline-regexp "\\*+ ") | |
48aaad2d | 22527 | a b xx |
a3fbe8c4 | 22528 | rtn p) |
48aaad2d | 22529 | (with-current-buffer (get-buffer-create " org-mode-tmp") |
272dfec2 CD |
22530 | (erase-buffer) |
22531 | (insert string) | |
a3fbe8c4 CD |
22532 | ;; Remove license-to-kill stuff |
22533 | (while (setq p (text-property-any (point-min) (point-max) | |
22534 | :org-license-to-kill t)) | |
22535 | (delete-region p (next-single-property-change p :org-license-to-kill))) | |
22536 | ||
6769c0dc | 22537 | (let ((org-inhibit-startup t)) (org-mode)) |
d3f4dbe8 | 22538 | (untabify (point-min) (point-max)) |
6769c0dc | 22539 | |
a3fbe8c4 CD |
22540 | ;; Get the correct stuff before the first headline |
22541 | (when (plist-get parameters :skip-before-1st-heading) | |
22542 | (goto-char (point-min)) | |
22543 | (when (re-search-forward "^\\*+[ \t]" nil t) | |
22544 | (delete-region (point-min) (match-beginning 0)) | |
22545 | (goto-char (point-min)) | |
22546 | (insert "\n"))) | |
22547 | (when (plist-get parameters :add-text) | |
22548 | (goto-char (point-min)) | |
22549 | (insert (plist-get parameters :add-text) "\n")) | |
22550 | ||
6769c0dc | 22551 | ;; Get rid of archived trees |
374585c9 | 22552 | (when (not (eq archived-trees t)) |
6769c0dc CD |
22553 | (goto-char (point-min)) |
22554 | (while (re-search-forward re-archive nil t) | |
a3fbe8c4 | 22555 | (if (not (org-on-heading-p t)) |
6769c0dc CD |
22556 | (org-end-of-subtree t) |
22557 | (beginning-of-line 1) | |
374585c9 | 22558 | (setq a (if archived-trees |
a3fbe8c4 CD |
22559 | (1+ (point-at-eol)) (point)) |
22560 | b (org-end-of-subtree t)) | |
22561 | (if (> b a) (delete-region a b))))) | |
6769c0dc | 22562 | |
03f3cf35 JW |
22563 | ;; Get rid of drawers |
22564 | (unless (eq t org-export-with-drawers) | |
38f8646b | 22565 | (goto-char (point-min)) |
03f3cf35 JW |
22566 | (let ((re (concat "^[ \t]*:\\(" |
22567 | (mapconcat 'identity | |
22568 | (if (listp org-export-with-drawers) | |
22569 | org-export-with-drawers | |
22570 | org-drawers) | |
22571 | "\\|") | |
22572 | "\\):[ \t]*\n\\([^@]*?\n\\)?[ \t]*:END:[ \t]*\n"))) | |
22573 | (while (re-search-forward re nil t) | |
22574 | (replace-match "")))) | |
38f8646b | 22575 | |
48aaad2d CD |
22576 | ;; Find targets in comments and move them out of comments, |
22577 | ;; but mark them as targets that should be invisible | |
d3f4dbe8 | 22578 | (goto-char (point-min)) |
48aaad2d CD |
22579 | (while (re-search-forward "^#.*?\\(<<<?[^>\r\n]+>>>?\\).*" nil t) |
22580 | (replace-match "\\1(INVISIBLE)")) | |
22581 | ||
22582 | ;; Protect backend specific stuff, throw away the others. | |
d3f4dbe8 | 22583 | (goto-char (point-min)) |
48aaad2d CD |
22584 | (let ((formatters |
22585 | `((,htmlp "HTML" "BEGIN_HTML" "END_HTML") | |
22586 | (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII") | |
22587 | (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) | |
22588 | fmt) | |
22589 | (while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t) | |
22590 | (add-text-properties (match-beginning 0) (match-end 0) | |
22591 | '(org-protected t))) | |
22592 | (while formatters | |
22593 | (setq fmt (pop formatters)) | |
22594 | (when (car fmt) | |
22595 | (goto-char (point-min)) | |
fbe6c10d | 22596 | (while (re-search-forward (concat "^#\\+" (cadr fmt) |
48aaad2d CD |
22597 | ":[ \t]*\\(.*\\)") nil t) |
22598 | (replace-match "\\1" t) | |
22599 | (add-text-properties | |
22600 | (point-at-bol) (min (1+ (point-at-eol)) (point-max)) | |
22601 | '(org-protected t)))) | |
22602 | (goto-char (point-min)) | |
22603 | (while (re-search-forward | |
fbe6c10d | 22604 | (concat "^#\\+" |
48aaad2d CD |
22605 | (caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+" |
22606 | (cadddr fmt) "\\>.*\n?") nil t) | |
22607 | (if (car fmt) | |
22608 | (add-text-properties (match-beginning 1) (1+ (match-end 1)) | |
22609 | '(org-protected t)) | |
22610 | (delete-region (match-beginning 0) (match-end 0)))))) | |
22611 | ||
374585c9 | 22612 | ;; Protect quoted subtrees |
d3f4dbe8 CD |
22613 | (goto-char (point-min)) |
22614 | (while (re-search-forward re-quote nil t) | |
22615 | (goto-char (match-beginning 0)) | |
22616 | (end-of-line 1) | |
22617 | (add-text-properties (point) (org-end-of-subtree t) | |
22618 | '(org-protected t))) | |
22619 | ||
48aaad2d | 22620 | ;; Remove subtrees that are commented |
272dfec2 | 22621 | (goto-char (point-min)) |
48aaad2d CD |
22622 | (while (re-search-forward re-commented nil t) |
22623 | (goto-char (match-beginning 0)) | |
22624 | (delete-region (point) (org-end-of-subtree t))) | |
6769c0dc | 22625 | |
48aaad2d CD |
22626 | ;; Remove special table lines |
22627 | (when org-export-table-remove-special-lines | |
22628 | (goto-char (point-min)) | |
22629 | (while (re-search-forward "^[ \t]*|" nil t) | |
22630 | (beginning-of-line 1) | |
22631 | (if (or (looking-at "[ \t]*| *[!_^] *|") | |
22632 | (and (looking-at ".*?| *<[0-9]+> *|") | |
22633 | (not (looking-at ".*?| *[^ <|]")))) | |
22634 | (delete-region (max (point-min) (1- (point-at-bol))) | |
22635 | (point-at-eol)) | |
22636 | (end-of-line 1)))) | |
22637 | ||
374585c9 | 22638 | ;; Specific LaTeX stuff |
48aaad2d | 22639 | (when latexp |
d5098885 JW |
22640 | (require 'org-export-latex nil) |
22641 | (org-export-latex-cleaned-string)) | |
48aaad2d | 22642 | |
374585c9 CD |
22643 | ;; Specific HTML stuff |
22644 | (when htmlp | |
22645 | ;; Convert LaTeX fragments to images | |
22646 | (when (plist-get parameters :LaTeX-fragments) | |
22647 | (org-format-latex | |
22648 | (concat "ltxpng/" (file-name-sans-extension | |
22649 | (file-name-nondirectory | |
22650 | org-current-export-file))) | |
22651 | org-current-export-dir nil "Creating LaTeX image %s")) | |
22652 | (message "Exporting...")) | |
22653 | ||
48aaad2d | 22654 | ;; Remove or replace comments |
3278a016 | 22655 | (goto-char (point-min)) |
48aaad2d CD |
22656 | (while (re-search-forward "^#\\(.*\n?\\)" nil t) |
22657 | (if commentsp | |
22658 | (progn (add-text-properties | |
22659 | (match-beginning 0) (match-end 0) '(org-protected t)) | |
22660 | (replace-match (format commentsp (match-string 1)) t t)) | |
22661 | (replace-match ""))) | |
3278a016 | 22662 | |
ab27a4a0 | 22663 | ;; Find matches for radio targets and turn them into internal links |
272dfec2 | 22664 | (goto-char (point-min)) |
7204b00e CD |
22665 | (when re-radio |
22666 | (while (re-search-forward re-radio nil t) | |
d3f4dbe8 CD |
22667 | (org-if-unprotected |
22668 | (replace-match "\\1[[\\2]]")))) | |
6769c0dc | 22669 | |
272dfec2 CD |
22670 | ;; Find all links that contain a newline and put them into a single line |
22671 | (goto-char (point-min)) | |
ab27a4a0 | 22672 | (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) |
d3f4dbe8 CD |
22673 | (org-if-unprotected |
22674 | (replace-match "\\1 \\3") | |
22675 | (goto-char (match-beginning 0)))) | |
6769c0dc | 22676 | |
6769c0dc | 22677 | |
ab27a4a0 | 22678 | ;; Normalize links: Convert angle and plain links into bracket links |
3278a016 | 22679 | ;; Expand link abbreviations |
ab27a4a0 CD |
22680 | (goto-char (point-min)) |
22681 | (while (re-search-forward re-plain-link nil t) | |
a3fbe8c4 | 22682 | (goto-char (1- (match-end 0))) |
d3f4dbe8 | 22683 | (org-if-unprotected |
48aaad2d CD |
22684 | (let* ((s (concat (match-string 1) "[[" (match-string 2) |
22685 | ":" (match-string 3) "]]"))) | |
22686 | ;; added 'org-link face to links | |
22687 | (put-text-property 0 (length s) 'face 'org-link s) | |
22688 | (replace-match s t t)))) | |
ab27a4a0 CD |
22689 | (goto-char (point-min)) |
22690 | (while (re-search-forward re-angle-link nil t) | |
a3fbe8c4 | 22691 | (goto-char (1- (match-end 0))) |
d3f4dbe8 | 22692 | (org-if-unprotected |
48aaad2d CD |
22693 | (let* ((s (concat (match-string 1) "[[" (match-string 2) |
22694 | ":" (match-string 3) "]]"))) | |
22695 | (put-text-property 0 (length s) 'face 'org-link s) | |
22696 | (replace-match s t t)))) | |
3278a016 CD |
22697 | (goto-char (point-min)) |
22698 | (while (re-search-forward org-bracket-link-regexp nil t) | |
d3f4dbe8 | 22699 | (org-if-unprotected |
48aaad2d CD |
22700 | (let* ((s (concat "[[" (setq xx (save-match-data |
22701 | (org-link-expand-abbrev (match-string 1)))) | |
22702 | "]" | |
22703 | (if (match-end 3) | |
22704 | (match-string 2) | |
22705 | (concat "[" xx "]")) | |
22706 | "]"))) | |
22707 | (put-text-property 0 (length s) 'face 'org-link s) | |
22708 | (replace-match s t t)))) | |
6769c0dc | 22709 | |
edd21304 | 22710 | ;; Find multiline emphasis and put them into single line |
a3fbe8c4 | 22711 | (when (plist-get parameters :emph-multiline) |
edd21304 CD |
22712 | (goto-char (point-min)) |
22713 | (while (re-search-forward org-emph-re nil t) | |
a3fbe8c4 CD |
22714 | (if (not (= (char-after (match-beginning 3)) |
22715 | (char-after (match-beginning 4)))) | |
22716 | (org-if-unprotected | |
22717 | (subst-char-in-region (match-beginning 0) (match-end 0) | |
22718 | ?\n ?\ t) | |
22719 | (goto-char (1- (match-end 0)))) | |
22720 | (goto-char (1+ (match-beginning 0)))))) | |
ab27a4a0 | 22721 | |
272dfec2 CD |
22722 | (setq rtn (buffer-string))) |
22723 | (kill-buffer " org-mode-tmp") | |
22724 | rtn)) | |
22725 | ||
a3fbe8c4 CD |
22726 | (defun org-export-grab-title-from-buffer () |
22727 | "Get a title for the current document, from looking at the buffer." | |
48aaad2d | 22728 | (let ((inhibit-read-only t)) |
a3fbe8c4 CD |
22729 | (save-excursion |
22730 | (goto-char (point-min)) | |
22731 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
b38c6895 | 22732 | (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t) |
a3fbe8c4 CD |
22733 | ;; Mark the line so that it will not be exported as normal text. |
22734 | (org-unmodified | |
22735 | (add-text-properties (match-beginning 0) (match-end 0) | |
22736 | (list :org-license-to-kill t))) | |
22737 | ;; Return the title string | |
22738 | (org-trim (match-string 0))))))) | |
22739 | ||
374585c9 CD |
22740 | (defun org-export-get-title-from-subtree () |
22741 | "Return subtree title and exclude it from export." | |
22742 | (let (title (m (mark))) | |
22743 | (save-excursion | |
22744 | (goto-char (region-beginning)) | |
22745 | (when (and (org-at-heading-p) | |
22746 | (>= (org-end-of-subtree t t) (region-end))) | |
22747 | ;; This is a subtree, we take the title from the first heading | |
22748 | (goto-char (region-beginning)) | |
22749 | (looking-at org-todo-line-regexp) | |
22750 | (setq title (match-string 3)) | |
22751 | (org-unmodified | |
22752 | (add-text-properties (point) (1+ (point-at-eol)) | |
22753 | (list :org-license-to-kill t))))) | |
22754 | title)) | |
fbe6c10d | 22755 | |
79c4be8e | 22756 | (defun org-solidify-link-text (s &optional alist) |
d3f4dbe8 CD |
22757 | "Take link text and make a safe target out of it." |
22758 | (save-match-data | |
22759 | (let* ((rtn | |
22760 | (mapconcat | |
22761 | 'identity | |
22762 | (org-split-string s "[ \t\r\n]+") "--")) | |
22763 | (a (assoc rtn alist))) | |
22764 | (or (cdr a) rtn)))) | |
79c4be8e | 22765 | |
0b8568f5 JW |
22766 | (defun org-get-min-level (lines) |
22767 | "Get the minimum level in LINES." | |
22768 | (let ((re "^\\(\\*+\\) ") l min) | |
22769 | (catch 'exit | |
22770 | (while (setq l (pop lines)) | |
22771 | (if (string-match re l) | |
22772 | (throw 'exit (org-tr-level (length (match-string 1 l)))))) | |
22773 | 1))) | |
22774 | ||
d3f4dbe8 CD |
22775 | ;; Variable holding the vector with section numbers |
22776 | (defvar org-section-numbers (make-vector org-level-max 0)) | |
4ed31842 | 22777 | |
d3f4dbe8 CD |
22778 | (defun org-init-section-numbers () |
22779 | "Initialize the vector for the section numbers." | |
22780 | (let* ((level -1) | |
22781 | (numbers (nreverse (org-split-string "" "\\."))) | |
22782 | (depth (1- (length org-section-numbers))) | |
22783 | (i depth) number-string) | |
22784 | (while (>= i 0) | |
22785 | (if (> i level) | |
22786 | (aset org-section-numbers i 0) | |
22787 | (setq number-string (or (car numbers) "0")) | |
22788 | (if (string-match "\\`[A-Z]\\'" number-string) | |
22789 | (aset org-section-numbers i | |
22790 | (- (string-to-char number-string) ?A -1)) | |
22791 | (aset org-section-numbers i (string-to-number number-string))) | |
22792 | (pop numbers)) | |
22793 | (setq i (1- i))))) | |
4ed31842 | 22794 | |
d3f4dbe8 CD |
22795 | (defun org-section-number (&optional level) |
22796 | "Return a string with the current section number. | |
22797 | When LEVEL is non-nil, increase section numbers on that level." | |
22798 | (let* ((depth (1- (length org-section-numbers))) idx n (string "")) | |
22799 | (when level | |
22800 | (when (> level -1) | |
22801 | (aset org-section-numbers | |
22802 | level (1+ (aref org-section-numbers level)))) | |
22803 | (setq idx (1+ level)) | |
22804 | (while (<= idx depth) | |
22805 | (if (not (= idx 1)) | |
22806 | (aset org-section-numbers idx 0)) | |
22807 | (setq idx (1+ idx)))) | |
22808 | (setq idx 0) | |
22809 | (while (<= idx depth) | |
22810 | (setq n (aref org-section-numbers idx)) | |
22811 | (setq string (concat string (if (not (string= string "")) "." "") | |
22812 | (int-to-string n))) | |
22813 | (setq idx (1+ idx))) | |
22814 | (save-match-data | |
22815 | (if (string-match "\\`\\([@0]\\.\\)+" string) | |
22816 | (setq string (replace-match "" t nil string))) | |
22817 | (if (string-match "\\(\\.0\\)+\\'" string) | |
22818 | (setq string (replace-match "" t nil string)))) | |
22819 | string)) | |
22820 | ||
22821 | ;;; ASCII export | |
272dfec2 | 22822 | |
634a7d0b | 22823 | (defvar org-last-level nil) ; dynamically scoped variable |
374585c9 | 22824 | (defvar org-min-level nil) ; dynamically scoped variable |
d3f4dbe8 | 22825 | (defvar org-levels-open nil) ; dynamically scoped parameter |
c4b5acde | 22826 | (defvar org-ascii-current-indentation nil) ; For communication |
634a7d0b | 22827 | |
891f4676 RS |
22828 | (defun org-export-as-ascii (arg) |
22829 | "Export the outline as a pretty ASCII file. | |
22830 | If there is an active region, export only the region. | |
22831 | The prefix ARG specifies how many levels of the outline should become | |
22832 | underlined headlines. The default is 3." | |
22833 | (interactive "P") | |
22834 | (setq-default org-todo-line-regexp org-todo-line-regexp) | |
4b3a9ba7 CD |
22835 | (let* ((opt-plist (org-combine-plists (org-default-export-plist) |
22836 | (org-infile-export-plist))) | |
374585c9 CD |
22837 | (region-p (org-region-active-p)) |
22838 | (subtree-p | |
22839 | (when region-p | |
22840 | (save-excursion | |
22841 | (goto-char (region-beginning)) | |
22842 | (and (org-at-heading-p) | |
22843 | (>= (org-end-of-subtree t t) (region-end)))))) | |
d3f4dbe8 | 22844 | (custom-times org-display-custom-times) |
7d143c25 | 22845 | (org-ascii-current-indentation '(0 . 0)) |
c8d16429 CD |
22846 | (level 0) line txt |
22847 | (umax nil) | |
d3f4dbe8 | 22848 | (umax-toc nil) |
c8d16429 | 22849 | (case-fold-search nil) |
4b3a9ba7 CD |
22850 | (filename (concat (file-name-as-directory |
22851 | (org-export-directory :ascii opt-plist)) | |
edd21304 | 22852 | (file-name-sans-extension |
374585c9 CD |
22853 | (or (and subtree-p |
22854 | (org-entry-get (region-beginning) | |
22855 | "EXPORT_FILE_NAME" t)) | |
22856 | (file-name-nondirectory buffer-file-name))) | |
c8d16429 | 22857 | ".txt")) |
48aaad2d CD |
22858 | (filename (if (equal (file-truename filename) |
22859 | (file-truename buffer-file-name)) | |
22860 | (concat filename ".txt") | |
22861 | filename)) | |
c8d16429 | 22862 | (buffer (find-file-noselect filename)) |
d3f4dbe8 | 22863 | (org-levels-open (make-vector org-level-max nil)) |
4b3a9ba7 | 22864 | (odd org-odd-levels-only) |
0b8568f5 | 22865 | (date (plist-get opt-plist :date)) |
4b3a9ba7 | 22866 | (author (plist-get opt-plist :author)) |
374585c9 CD |
22867 | (title (or (and subtree-p (org-export-get-title-from-subtree)) |
22868 | (plist-get opt-plist :title) | |
a3fbe8c4 CD |
22869 | (and (not |
22870 | (plist-get opt-plist :skip-before-1st-heading)) | |
22871 | (org-export-grab-title-from-buffer)) | |
4b3a9ba7 CD |
22872 | (file-name-sans-extension |
22873 | (file-name-nondirectory buffer-file-name)))) | |
4b3a9ba7 CD |
22874 | (email (plist-get opt-plist :email)) |
22875 | (language (plist-get opt-plist :language)) | |
3278a016 | 22876 | (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) |
d3f4dbe8 | 22877 | ; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) |
c8d16429 | 22878 | (todo nil) |
a3fbe8c4 CD |
22879 | (lang-words nil) |
22880 | (region | |
22881 | (buffer-substring | |
22882 | (if (org-region-active-p) (region-beginning) (point-min)) | |
22883 | (if (org-region-active-p) (region-end) (point-max)))) | |
48aaad2d CD |
22884 | (lines (org-split-string |
22885 | (org-cleaned-string-for-export | |
22886 | region | |
22887 | :for-ascii t | |
22888 | :skip-before-1st-heading | |
22889 | (plist-get opt-plist :skip-before-1st-heading) | |
374585c9 CD |
22890 | :archived-trees |
22891 | (plist-get opt-plist :archived-trees) | |
48aaad2d | 22892 | :add-text (plist-get opt-plist :text)) |
15841868 | 22893 | "\n")) |
a3fbe8c4 CD |
22894 | thetoc have-headings first-heading-pos |
22895 | table-open table-buffer) | |
22896 | ||
48aaad2d | 22897 | (let ((inhibit-read-only t)) |
a3fbe8c4 CD |
22898 | (org-unmodified |
22899 | (remove-text-properties (point-min) (point-max) | |
22900 | '(:org-license-to-kill t)))) | |
891f4676 | 22901 | |
374585c9 CD |
22902 | (setq org-min-level (org-get-min-level lines)) |
22903 | (setq org-last-level org-min-level) | |
891f4676 RS |
22904 | (org-init-section-numbers) |
22905 | ||
22906 | (find-file-noselect filename) | |
22907 | ||
891f4676 | 22908 | (setq lang-words (or (assoc language org-export-language-setup) |
c8d16429 | 22909 | (assoc "en" org-export-language-setup))) |
d3f4dbe8 | 22910 | (switch-to-buffer-other-window buffer) |
891f4676 RS |
22911 | (erase-buffer) |
22912 | (fundamental-mode) | |
4b3a9ba7 CD |
22913 | ;; create local variables for all options, to make sure all called |
22914 | ;; functions get the correct information | |
fbe6c10d CD |
22915 | (mapc (lambda (x) |
22916 | (set (make-local-variable (cdr x)) | |
22917 | (plist-get opt-plist (car x)))) | |
22918 | org-export-plist-vars) | |
5137195a | 22919 | (org-set-local 'org-odd-levels-only odd) |
891f4676 | 22920 | (setq umax (if arg (prefix-numeric-value arg) |
c8d16429 | 22921 | org-export-headline-levels)) |
d3f4dbe8 CD |
22922 | (setq umax-toc (if (integerp org-export-with-toc) |
22923 | (min org-export-with-toc umax) | |
22924 | umax)) | |
891f4676 RS |
22925 | |
22926 | ;; File header | |
22927 | (if title (org-insert-centered title ?=)) | |
22928 | (insert "\n") | |
48aaad2d CD |
22929 | (if (and (or author email) |
22930 | org-export-author-info) | |
c8d16429 CD |
22931 | (insert (concat (nth 1 lang-words) ": " (or author "") |
22932 | (if email (concat " <" email ">") "") | |
22933 | "\n"))) | |
0b8568f5 JW |
22934 | |
22935 | (cond | |
22936 | ((and date (string-match "%" date)) | |
22937 | (setq date (format-time-string date (current-time)))) | |
22938 | (date) | |
22939 | (t (setq date (format-time-string "%Y/%m/%d %X" (current-time))))) | |
22940 | ||
22941 | (if (and date org-export-time-stamp-file) | |
22942 | (insert (concat (nth 2 lang-words) ": " date"\n"))) | |
891f4676 RS |
22943 | |
22944 | (insert "\n\n") | |
22945 | ||
22946 | (if org-export-with-toc | |
c8d16429 | 22947 | (progn |
a3fbe8c4 CD |
22948 | (push (concat (nth 3 lang-words) "\n") thetoc) |
22949 | (push (concat (make-string (length (nth 3 lang-words)) ?=) "\n") thetoc) | |
fbe6c10d CD |
22950 | (mapc '(lambda (line) |
22951 | (if (string-match org-todo-line-regexp | |
22952 | line) | |
22953 | ;; This is a headline | |
22954 | (progn | |
22955 | (setq have-headings t) | |
22956 | (setq level (- (match-end 1) (match-beginning 1)) | |
22957 | level (org-tr-level level) | |
22958 | txt (match-string 3 line) | |
22959 | todo | |
22960 | (or (and org-export-mark-todo-in-toc | |
22961 | (match-beginning 2) | |
22962 | (not (member (match-string 2 line) | |
22963 | org-done-keywords))) | |
c8d16429 | 22964 | ; TODO, not DONE |
fbe6c10d CD |
22965 | (and org-export-mark-todo-in-toc |
22966 | (= level umax-toc) | |
22967 | (org-search-todo-below | |
22968 | line lines level)))) | |
22969 | (setq txt (org-html-expand-for-ascii txt)) | |
22970 | ||
22971 | (while (string-match org-bracket-link-regexp txt) | |
22972 | (setq txt | |
22973 | (replace-match | |
22974 | (match-string (if (match-end 2) 3 1) txt) | |
22975 | t t txt))) | |
22976 | ||
22977 | (if (and (memq org-export-with-tags '(not-in-toc nil)) | |
22978 | (string-match | |
22979 | (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") | |
22980 | txt)) | |
22981 | (setq txt (replace-match "" t t txt))) | |
22982 | (if (string-match quote-re0 txt) | |
22983 | (setq txt (replace-match "" t t txt))) | |
22984 | ||
22985 | (if org-export-with-section-numbers | |
22986 | (setq txt (concat (org-section-number level) | |
22987 | " " txt))) | |
22988 | (if (<= level umax-toc) | |
22989 | (progn | |
22990 | (push | |
22991 | (concat | |
22992 | (make-string | |
22993 | (* (max 0 (- level org-min-level)) 4) ?\ ) | |
22994 | (format (if todo "%s (*)\n" "%s\n") txt)) | |
22995 | thetoc) | |
22996 | (setq org-last-level level)) | |
22997 | )))) | |
22998 | lines) | |
a3fbe8c4 | 22999 | (setq thetoc (if have-headings (nreverse thetoc) nil)))) |
891f4676 RS |
23000 | |
23001 | (org-init-section-numbers) | |
23002 | (while (setq line (pop lines)) | |
23003 | ;; Remove the quoted HTML tags. | |
23004 | (setq line (org-html-expand-for-ascii line)) | |
272dfec2 CD |
23005 | ;; Remove targets |
23006 | (while (string-match "<<<?[^<>]*>>>?[ \t]*\n?" line) | |
23007 | (setq line (replace-match "" t t line))) | |
23008 | ;; Replace internal links | |
23009 | (while (string-match org-bracket-link-regexp line) | |
23010 | (setq line (replace-match | |
23011 | (if (match-end 3) "[\\3]" "[\\1]") | |
23012 | t nil line))) | |
d3f4dbe8 CD |
23013 | (when custom-times |
23014 | (setq line (org-translate-time line))) | |
891f4676 | 23015 | (cond |
7d58338e | 23016 | ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) |
c8d16429 | 23017 | ;; a Headline |
a3fbe8c4 | 23018 | (setq first-heading-pos (or first-heading-pos (point))) |
79c4be8e | 23019 | (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) |
c8d16429 | 23020 | txt (match-string 2 line)) |
c4b5acde | 23021 | (org-ascii-level-start level txt umax lines)) |
a3fbe8c4 CD |
23022 | |
23023 | ((and org-export-with-tables | |
23024 | (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) | |
23025 | (if (not table-open) | |
23026 | ;; New table starts | |
23027 | (setq table-open t table-buffer nil)) | |
23028 | ;; Accumulate lines | |
23029 | (setq table-buffer (cons line table-buffer)) | |
23030 | (when (or (not lines) | |
23031 | (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" | |
23032 | (car lines)))) | |
23033 | (setq table-open nil | |
23034 | table-buffer (nreverse table-buffer)) | |
23035 | (insert (mapconcat | |
23036 | (lambda (x) | |
23037 | (org-fix-indentation x org-ascii-current-indentation)) | |
23038 | (org-format-table-ascii table-buffer) | |
23039 | "\n") "\n"))) | |
edd21304 | 23040 | (t |
38f8646b CD |
23041 | (setq line (org-fix-indentation line org-ascii-current-indentation)) |
23042 | (if (and org-export-with-fixed-width | |
23043 | (string-match "^\\([ \t]*\\)\\(:\\)" line)) | |
23044 | (setq line (replace-match "\\1" nil nil line))) | |
23045 | (insert line "\n")))) | |
23046 | ||
891f4676 | 23047 | (normal-mode) |
a3fbe8c4 CD |
23048 | |
23049 | ;; insert the table of contents | |
23050 | (when thetoc | |
23051 | (goto-char (point-min)) | |
23052 | (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) | |
23053 | (progn | |
23054 | (goto-char (match-beginning 0)) | |
23055 | (replace-match "")) | |
23056 | (goto-char first-heading-pos)) | |
23057 | (mapc 'insert thetoc) | |
23058 | (or (looking-at "[ \t]*\n[ \t]*\n") | |
23059 | (insert "\n\n"))) | |
23060 | ||
03f3cf35 JW |
23061 | ;; Convert whitespace place holders |
23062 | (goto-char (point-min)) | |
23063 | (let (beg end) | |
23064 | (while (setq beg (next-single-property-change (point) 'org-whitespace)) | |
23065 | (setq end (next-single-property-change beg 'org-whitespace)) | |
23066 | (goto-char beg) | |
23067 | (delete-region beg end) | |
23068 | (insert (make-string (- end beg) ?\ )))) | |
23069 | ||
891f4676 | 23070 | (save-buffer) |
4b3a9ba7 | 23071 | ;; remove display and invisible chars |
6769c0dc | 23072 | (let (beg end) |
4b3a9ba7 CD |
23073 | (goto-char (point-min)) |
23074 | (while (setq beg (next-single-property-change (point) 'display)) | |
23075 | (setq end (next-single-property-change beg 'display)) | |
23076 | (delete-region beg end) | |
23077 | (goto-char beg) | |
23078 | (insert "=>")) | |
23079 | (goto-char (point-min)) | |
23080 | (while (setq beg (next-single-property-change (point) 'org-cwidth)) | |
23081 | (setq end (next-single-property-change beg 'org-cwidth)) | |
23082 | (delete-region beg end) | |
23083 | (goto-char beg))) | |
891f4676 RS |
23084 | (goto-char (point-min)))) |
23085 | ||
23086 | (defun org-search-todo-below (line lines level) | |
23087 | "Search the subtree below LINE for any TODO entries." | |
23088 | (let ((rest (cdr (memq line lines))) | |
c8d16429 CD |
23089 | (re org-todo-line-regexp) |
23090 | line lv todo) | |
891f4676 RS |
23091 | (catch 'exit |
23092 | (while (setq line (pop rest)) | |
c8d16429 CD |
23093 | (if (string-match re line) |
23094 | (progn | |
23095 | (setq lv (- (match-end 1) (match-beginning 1)) | |
23096 | todo (and (match-beginning 2) | |
a3fbe8c4 CD |
23097 | (not (member (match-string 2 line) |
23098 | org-done-keywords)))) | |
c8d16429 CD |
23099 | ; TODO, not DONE |
23100 | (if (<= lv level) (throw 'exit nil)) | |
23101 | (if todo (throw 'exit t)))))))) | |
891f4676 | 23102 | |
891f4676 RS |
23103 | (defun org-html-expand-for-ascii (line) |
23104 | "Handle quoted HTML for ASCII export." | |
23105 | (if org-export-html-expand | |
23106 | (while (string-match "@<[^<>\n]*>" line) | |
c8d16429 CD |
23107 | ;; We just remove the tags for now. |
23108 | (setq line (replace-match "" nil nil line)))) | |
891f4676 RS |
23109 | line) |
23110 | ||
23111 | (defun org-insert-centered (s &optional underline) | |
23112 | "Insert the string S centered and underline it with character UNDERLINE." | |
194aab4f | 23113 | (let ((ind (max (/ (- 80 (string-width s)) 2) 0))) |
891f4676 RS |
23114 | (insert (make-string ind ?\ ) s "\n") |
23115 | (if underline | |
c8d16429 | 23116 | (insert (make-string ind ?\ ) |
194aab4f | 23117 | (make-string (string-width s) underline) |
c8d16429 | 23118 | "\n")))) |
891f4676 | 23119 | |
c4b5acde | 23120 | (defun org-ascii-level-start (level title umax &optional lines) |
891f4676 | 23121 | "Insert a new level in ASCII export." |
c4b5acde | 23122 | (let (char (n (- level umax 1)) (ind 0)) |
891f4676 | 23123 | (if (> level umax) |
c4b5acde | 23124 | (progn |
edd21304 | 23125 | (insert (make-string (* 2 n) ?\ ) |
c4b5acde CD |
23126 | (char-to-string (nth (% n (length org-export-ascii-bullets)) |
23127 | org-export-ascii-bullets)) | |
23128 | " " title "\n") | |
23129 | ;; find the indentation of the next non-empty line | |
23130 | (catch 'stop | |
23131 | (while lines | |
7d58338e | 23132 | (if (string-match "^\\* " (car lines)) (throw 'stop nil)) |
c4b5acde | 23133 | (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) |
7d143c25 | 23134 | (throw 'stop (setq ind (org-get-indentation (car lines))))) |
c4b5acde | 23135 | (pop lines))) |
7d143c25 | 23136 | (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) |
891f4676 | 23137 | (if (or (not (equal (char-before) ?\n)) |
c8d16429 CD |
23138 | (not (equal (char-before (1- (point))) ?\n))) |
23139 | (insert "\n")) | |
c4b5acde | 23140 | (setq char (nth (- umax level) (reverse org-export-ascii-underline))) |
3278a016 | 23141 | (unless org-export-with-tags |
5152b597 | 23142 | (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) |
3278a016 | 23143 | (setq title (replace-match "" t t title)))) |
891f4676 | 23144 | (if org-export-with-section-numbers |
c8d16429 | 23145 | (setq title (concat (org-section-number level) " " title))) |
c4b5acde | 23146 | (insert title "\n" (make-string (string-width title) char) "\n") |
7d143c25 | 23147 | (setq org-ascii-current-indentation '(0 . 0))))) |
ef943dba | 23148 | |
4b3a9ba7 CD |
23149 | (defun org-export-visible (type arg) |
23150 | "Create a copy of the visible part of the current buffer, and export it. | |
23151 | The copy is created in a temporary buffer and removed after use. | |
6769c0dc CD |
23152 | TYPE is the final key (as a string) that also select the export command in |
23153 | the `C-c C-e' export dispatcher. | |
23154 | As a special case, if the you type SPC at the prompt, the temporary | |
4b3a9ba7 CD |
23155 | org-mode file will not be removed but presented to you so that you can |
23156 | continue to use it. The prefix arg ARG is passed through to the exporting | |
23157 | command." | |
edd21304 | 23158 | (interactive |
4b3a9ba7 | 23159 | (list (progn |
a3fbe8c4 | 23160 | (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]uffer with HTML [x]OXO [ ]keep buffer") |
0fee8d6e | 23161 | (read-char-exclusive)) |
4b3a9ba7 | 23162 | current-prefix-arg)) |
0fee8d6e | 23163 | (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?x ?\ ))) |
4b3a9ba7 | 23164 | (error "Invalid export key")) |
0fee8d6e CD |
23165 | (let* ((binding (cdr (assoc type |
23166 | '((?a . org-export-as-ascii) | |
23167 | (?\C-a . org-export-as-ascii) | |
23168 | (?b . org-export-as-html-and-open) | |
23169 | (?\C-b . org-export-as-html-and-open) | |
23170 | (?h . org-export-as-html) | |
a3fbe8c4 CD |
23171 | (?H . org-export-as-html-to-buffer) |
23172 | (?R . org-export-region-as-html) | |
0fee8d6e CD |
23173 | (?x . org-export-as-xoxo))))) |
23174 | (keepp (equal type ?\ )) | |
4b3a9ba7 CD |
23175 | (file buffer-file-name) |
23176 | (buffer (get-buffer-create "*Org Export Visible*")) | |
c8d16429 | 23177 | s e) |
374585c9 CD |
23178 | ;; Need to hack the drawers here. |
23179 | (save-excursion | |
23180 | (goto-char (point-min)) | |
23181 | (while (re-search-forward org-drawer-regexp nil t) | |
23182 | (goto-char (match-beginning 1)) | |
23183 | (or (org-invisible-p) (org-flag-drawer nil)))) | |
4b3a9ba7 | 23184 | (with-current-buffer buffer (erase-buffer)) |
ef943dba CD |
23185 | (save-excursion |
23186 | (setq s (goto-char (point-min))) | |
23187 | (while (not (= (point) (point-max))) | |
c8d16429 CD |
23188 | (goto-char (org-find-invisible)) |
23189 | (append-to-buffer buffer s (point)) | |
4b3a9ba7 | 23190 | (setq s (goto-char (org-find-visible)))) |
374585c9 | 23191 | (org-cycle-hide-drawers 'all) |
4b3a9ba7 CD |
23192 | (goto-char (point-min)) |
23193 | (unless keepp | |
23194 | ;; Copy all comment lines to the end, to make sure #+ settings are | |
23195 | ;; still available for the second export step. Kind of a hack, but | |
23196 | ;; does do the trick. | |
23197 | (if (looking-at "#[^\r\n]*") | |
23198 | (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0)))) | |
23199 | (while (re-search-forward "[\n\r]#[^\n\r]*" nil t) | |
23200 | (append-to-buffer buffer (1+ (match-beginning 0)) | |
23201 | (min (point-max) (1+ (match-end 0)))))) | |
23202 | (set-buffer buffer) | |
23203 | (let ((buffer-file-name file) | |
23204 | (org-inhibit-startup t)) | |
23205 | (org-mode) | |
23206 | (show-all) | |
23207 | (unless keepp (funcall binding arg)))) | |
23208 | (if (not keepp) | |
23209 | (kill-buffer buffer) | |
23210 | (switch-to-buffer-other-window buffer) | |
23211 | (goto-char (point-min))))) | |
ef943dba CD |
23212 | |
23213 | (defun org-find-visible () | |
5137195a CD |
23214 | (let ((s (point))) |
23215 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | |
23216 | (get-char-property s 'invisible))) | |
23217 | s)) | |
ef943dba | 23218 | (defun org-find-invisible () |
5137195a CD |
23219 | (let ((s (point))) |
23220 | (while (and (not (= (point-max) (setq s (next-overlay-change s)))) | |
23221 | (not (get-char-property s 'invisible)))) | |
23222 | s)) | |
7d143c25 | 23223 | |
d3f4dbe8 | 23224 | ;;; HTML export |
891f4676 RS |
23225 | |
23226 | (defun org-get-current-options () | |
23227 | "Return a string with current options as keyword options. | |
23228 | Does include HTML export options as well as TODO and CATEGORY stuff." | |
23229 | (format | |
23230 | "#+TITLE: %s | |
23231 | #+AUTHOR: %s | |
23232 | #+EMAIL: %s | |
23233 | #+LANGUAGE: %s | |
23234 | #+TEXT: Some descriptive text to be emitted. Several lines OK. | |
03f3cf35 | 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 |
891f4676 RS |
23236 | #+CATEGORY: %s |
23237 | #+SEQ_TODO: %s | |
23238 | #+TYP_TODO: %s | |
a3fbe8c4 | 23239 | #+PRIORITIES: %c %c %c |
03f3cf35 | 23240 | #+DRAWERS: %s |
d3f4dbe8 | 23241 | #+STARTUP: %s %s %s %s %s |
4b3a9ba7 | 23242 | #+TAGS: %s |
30313b90 | 23243 | #+ARCHIVE: %s |
3278a016 | 23244 | #+LINK: %s |
891f4676 RS |
23245 | " |
23246 | (buffer-name) (user-full-name) user-mail-address org-export-default-language | |
23247 | org-export-headline-levels | |
23248 | org-export-with-section-numbers | |
23249 | org-export-with-toc | |
23250 | org-export-preserve-breaks | |
23251 | org-export-html-expand | |
23252 | org-export-with-fixed-width | |
23253 | org-export-with-tables | |
23254 | org-export-with-sub-superscripts | |
5152b597 | 23255 | org-export-with-footnotes |
891f4676 RS |
23256 | org-export-with-emphasize |
23257 | org-export-with-TeX-macros | |
6769c0dc | 23258 | org-export-with-LaTeX-fragments |
a3fbe8c4 | 23259 | org-export-skip-text-before-1st-heading |
03f3cf35 JW |
23260 | org-export-with-drawers |
23261 | org-export-with-tags | |
7204b00e | 23262 | (file-name-nondirectory buffer-file-name) |
a3fbe8c4 CD |
23263 | "TODO FEEDBACK VERIFY DONE" |
23264 | "Me Jason Marie DONE" | |
23265 | org-highest-priority org-lowest-priority org-default-priority | |
03f3cf35 | 23266 | (mapconcat 'identity org-drawers " ") |
35fb9989 | 23267 | (cdr (assoc org-startup-folded |
2a94e282 | 23268 | '((nil . "showall") (t . "overview") (content . "content")))) |
4ed31842 CD |
23269 | (if org-odd-levels-only "odd" "oddeven") |
23270 | (if org-hide-leading-stars "hidestars" "showstars") | |
ab27a4a0 | 23271 | (if org-startup-align-all-tables "align" "noalign") |
d3f4dbe8 CD |
23272 | (cond ((eq t org-log-done) "logdone") |
23273 | ((not org-log-done) "nologging") | |
23274 | ((listp org-log-done) | |
23275 | (mapconcat (lambda (x) (concat "lognote" (symbol-name x))) | |
23276 | org-log-done " "))) | |
3278a016 CD |
23277 | (or (mapconcat (lambda (x) |
23278 | (cond | |
23279 | ((equal '(:startgroup) x) "{") | |
23280 | ((equal '(:endgroup) x) "}") | |
23281 | ((cdr x) (format "%s(%c)" (car x) (cdr x))) | |
23282 | (t (car x)))) | |
23283 | (or org-tag-alist (org-get-buffer-tags)) " ") "") | |
30313b90 | 23284 | org-archive-location |
3278a016 | 23285 | "org file:~/org/%s.org" |
791d856f | 23286 | )) |
891f4676 RS |
23287 | |
23288 | (defun org-insert-export-options-template () | |
23289 | "Insert into the buffer a template with information for exporting." | |
23290 | (interactive) | |
23291 | (if (not (bolp)) (newline)) | |
23292 | (let ((s (org-get-current-options))) | |
23293 | (and (string-match "#\\+CATEGORY" s) | |
c8d16429 | 23294 | (setq s (substring s 0 (match-beginning 0)))) |
891f4676 RS |
23295 | (insert s))) |
23296 | ||
23297 | (defun org-toggle-fixed-width-section (arg) | |
b9661543 CD |
23298 | "Toggle the fixed-width export. |
23299 | If there is no active region, the QUOTE keyword at the current headline is | |
23300 | inserted or removed. When present, it causes the text between this headline | |
23301 | and the next to be exported as fixed-width text, and unmodified. | |
23302 | If there is an active region, this command adds or removes a colon as the | |
23303 | first character of this line. If the first character of a line is a colon, | |
23304 | this line is also exported in fixed-width font." | |
891f4676 RS |
23305 | (interactive "P") |
23306 | (let* ((cc 0) | |
c8d16429 CD |
23307 | (regionp (org-region-active-p)) |
23308 | (beg (if regionp (region-beginning) (point))) | |
23309 | (end (if regionp (region-end))) | |
23310 | (nlines (or arg (if (and beg end) (count-lines beg end) 1))) | |
23311 | (re "[ \t]*\\(:\\)") | |
23312 | off) | |
b9661543 CD |
23313 | (if regionp |
23314 | (save-excursion | |
23315 | (goto-char beg) | |
23316 | (setq cc (current-column)) | |
23317 | (beginning-of-line 1) | |
23318 | (setq off (looking-at re)) | |
23319 | (while (> nlines 0) | |
23320 | (setq nlines (1- nlines)) | |
23321 | (beginning-of-line 1) | |
23322 | (cond | |
23323 | (arg | |
23324 | (move-to-column cc t) | |
23325 | (insert ":\n") | |
23326 | (forward-line -1)) | |
23327 | ((and off (looking-at re)) | |
23328 | (replace-match "" t t nil 1)) | |
23329 | ((not off) (move-to-column cc t) (insert ":"))) | |
23330 | (forward-line 1))) | |
23331 | (save-excursion | |
23332 | (org-back-to-heading) | |
23333 | (if (looking-at (concat outline-regexp | |
03f3cf35 | 23334 | "\\( *\\<" org-quote-string "\\>[ \t]*\\)")) |
b9661543 CD |
23335 | (replace-match "" t t nil 1) |
23336 | (if (looking-at outline-regexp) | |
23337 | (progn | |
23338 | (goto-char (match-end 0)) | |
7d58338e | 23339 | (insert org-quote-string " ")))))))) |
891f4676 RS |
23340 | |
23341 | (defun org-export-as-html-and-open (arg) | |
23342 | "Export the outline as HTML and immediately open it with a browser. | |
23343 | If there is an active region, export only the region. | |
23344 | The prefix ARG specifies how many levels of the outline should become | |
23345 | headlines. The default is 3. Lower levels will become bulleted lists." | |
23346 | (interactive "P") | |
23347 | (org-export-as-html arg 'hidden) | |
7204b00e | 23348 | (org-open-file buffer-file-name)) |
891f4676 RS |
23349 | |
23350 | (defun org-export-as-html-batch () | |
634a7d0b | 23351 | "Call `org-export-as-html', may be used in batch processing as |
891f4676 RS |
23352 | emacs --batch |
23353 | --load=$HOME/lib/emacs/org.el | |
23354 | --eval \"(setq org-export-headline-levels 2)\" | |
23355 | --visit=MyFile --funcall org-export-as-html-batch" | |
23356 | (org-export-as-html org-export-headline-levels 'hidden)) | |
23357 | ||
a3fbe8c4 CD |
23358 | (defun org-export-as-html-to-buffer (arg) |
23359 | "Call `org-exort-as-html` with output to a temporary buffer. | |
23360 | No file is created. The prefix ARG is passed through to `org-export-as-html'." | |
23361 | (interactive "P") | |
23362 | (org-export-as-html arg nil nil "*Org HTML Export*") | |
23363 | (switch-to-buffer-other-window "*Org HTML Export*")) | |
23364 | ||
23365 | (defun org-replace-region-by-html (beg end) | |
23366 | "Assume the current region has org-mode syntax, and convert it to HTML. | |
23367 | This can be used in any buffer. For example, you could write an | |
23368 | itemized list in org-mode syntax in an HTML buffer and then use this | |
23369 | command to convert it." | |
23370 | (interactive "r") | |
374585c9 | 23371 | (let (reg html buf pop-up-frames) |
48aaad2d CD |
23372 | (save-window-excursion |
23373 | (if (org-mode-p) | |
23374 | (setq html (org-export-region-as-html | |
23375 | beg end t 'string)) | |
23376 | (setq reg (buffer-substring beg end) | |
23377 | buf (get-buffer-create "*Org tmp*")) | |
23378 | (with-current-buffer buf | |
23379 | (erase-buffer) | |
23380 | (insert reg) | |
23381 | (org-mode) | |
23382 | (setq html (org-export-region-as-html | |
23383 | (point-min) (point-max) t 'string))) | |
23384 | (kill-buffer buf))) | |
a3fbe8c4 CD |
23385 | (delete-region beg end) |
23386 | (insert html))) | |
23387 | ||
23388 | (defun org-export-region-as-html (beg end &optional body-only buffer) | |
23389 | "Convert region from BEG to END in org-mode buffer to HTML. | |
23390 | If prefix arg BODY-ONLY is set, omit file header, footer, and table of | |
23391 | contents, and only produce the region of converted text, useful for | |
23392 | cut-and-paste operations. | |
23393 | If BUFFER is a buffer or a string, use/create that buffer as a target | |
23394 | of the converted HTML. If BUFFER is the symbol `string', return the | |
23395 | produced HTML as a string and leave not buffer behind. For example, | |
23396 | a Lisp program could call this function in the following way: | |
23397 | ||
23398 | (setq html (org-export-region-as-html beg end t 'string)) | |
23399 | ||
23400 | When called interactively, the output buffer is selected, and shown | |
23401 | in a window. A non-interactive call will only retunr the buffer." | |
23402 | (interactive "r\nP") | |
23403 | (when (interactive-p) | |
48aaad2d | 23404 | (setq buffer "*Org HTML Export*")) |
a3fbe8c4 CD |
23405 | (let ((transient-mark-mode t) (zmacs-regions t) |
23406 | rtn) | |
23407 | (goto-char end) | |
23408 | (set-mark (point)) ;; to activate the region | |
23409 | (goto-char beg) | |
23410 | (setq rtn (org-export-as-html | |
23411 | nil nil nil | |
23412 | buffer body-only)) | |
23413 | (if (fboundp 'deactivate-mark) (deactivate-mark)) | |
23414 | (if (and (interactive-p) (bufferp rtn)) | |
23415 | (switch-to-buffer-other-window rtn) | |
23416 | rtn))) | |
23417 | ||
23418 | (defun org-export-as-html (arg &optional hidden ext-plist | |
23419 | to-buffer body-only) | |
891f4676 | 23420 | "Export the outline as a pretty HTML file. |
a3fbe8c4 CD |
23421 | If there is an active region, export only the region. The prefix |
23422 | ARG specifies how many levels of the outline should become | |
23423 | headlines. The default is 3. Lower levels will become bulleted | |
23424 | lists. When HIDDEN is non-nil, don't display the HTML buffer. | |
4b3a9ba7 | 23425 | EXT-PLIST is a property list with external parameters overriding |
a3fbe8c4 CD |
23426 | org-mode's default settings, but still inferior to file-local |
23427 | settings. When TO-BUFFER is non-nil, create a buffer with that | |
23428 | name and export to that buffer. If TO-BUFFER is the symbol `string', | |
23429 | don't leave any buffer behind but just return the resulting HTML as | |
23430 | a string. When BODY-ONLY is set, don't produce the file header and footer, | |
23431 | simply return the content of <body>...</body>, without even | |
23432 | the body tags themselves." | |
891f4676 | 23433 | (interactive "P") |
a3fbe8c4 CD |
23434 | |
23435 | ;; Make sure we have a file name when we need it. | |
23436 | (when (and (not (or to-buffer body-only)) | |
23437 | (not buffer-file-name)) | |
23438 | (if (buffer-base-buffer) | |
23439 | (org-set-local 'buffer-file-name | |
23440 | (with-current-buffer (buffer-base-buffer) | |
23441 | buffer-file-name)) | |
23442 | (error "Need a file name to be able to export."))) | |
23443 | ||
6769c0dc | 23444 | (message "Exporting...") |
891f4676 RS |
23445 | (setq-default org-todo-line-regexp org-todo-line-regexp) |
23446 | (setq-default org-deadline-line-regexp org-deadline-line-regexp) | |
a3fbe8c4 | 23447 | (setq-default org-done-keywords org-done-keywords) |
d3f4dbe8 | 23448 | (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) |
4b3a9ba7 CD |
23449 | (let* ((opt-plist (org-combine-plists (org-default-export-plist) |
23450 | ext-plist | |
23451 | (org-infile-export-plist))) | |
edd21304 | 23452 | |
4b3a9ba7 | 23453 | (style (plist-get opt-plist :style)) |
0fee8d6e | 23454 | (link-validate (plist-get opt-plist :link-validation-function)) |
a3fbe8c4 | 23455 | valid thetoc have-headings first-heading-pos |
4ed31842 | 23456 | (odd org-odd-levels-only) |
e0e66b8e | 23457 | (region-p (org-region-active-p)) |
374585c9 CD |
23458 | (subtree-p |
23459 | (when region-p | |
23460 | (save-excursion | |
23461 | (goto-char (region-beginning)) | |
23462 | (and (org-at-heading-p) | |
23463 | (>= (org-end-of-subtree t t) (region-end)))))) | |
6769c0dc CD |
23464 | ;; The following two are dynamically scoped into other |
23465 | ;; routines below. | |
23466 | (org-current-export-dir (org-export-directory :html opt-plist)) | |
23467 | (org-current-export-file buffer-file-name) | |
b9661543 CD |
23468 | (level 0) (line "") (origline "") txt todo |
23469 | (umax nil) | |
d3f4dbe8 | 23470 | (umax-toc nil) |
a3fbe8c4 CD |
23471 | (filename (if to-buffer nil |
23472 | (concat (file-name-as-directory | |
23473 | (org-export-directory :html opt-plist)) | |
23474 | (file-name-sans-extension | |
374585c9 CD |
23475 | (or (and subtree-p |
23476 | (org-entry-get (region-beginning) | |
23477 | "EXPORT_FILE_NAME" t)) | |
23478 | (file-name-nondirectory buffer-file-name))) | |
15841868 | 23479 | "." org-export-html-extension))) |
a3fbe8c4 CD |
23480 | (current-dir (if buffer-file-name |
23481 | (file-name-directory buffer-file-name) | |
23482 | default-directory)) | |
23483 | (buffer (if to-buffer | |
23484 | (cond | |
23485 | ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) | |
48aaad2d | 23486 | (t (get-buffer-create to-buffer))) |
a3fbe8c4 | 23487 | (find-file-noselect filename))) |
d3f4dbe8 | 23488 | (org-levels-open (make-vector org-level-max nil)) |
0b8568f5 | 23489 | (date (plist-get opt-plist :date)) |
4b3a9ba7 | 23490 | (author (plist-get opt-plist :author)) |
374585c9 CD |
23491 | (title (or (and subtree-p (org-export-get-title-from-subtree)) |
23492 | (plist-get opt-plist :title) | |
a3fbe8c4 CD |
23493 | (and (not |
23494 | (plist-get opt-plist :skip-before-1st-heading)) | |
23495 | (org-export-grab-title-from-buffer)) | |
23496 | (and buffer-file-name | |
23497 | (file-name-sans-extension | |
23498 | (file-name-nondirectory buffer-file-name))) | |
23499 | "UNTITLED")) | |
4b3a9ba7 | 23500 | (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) |
7d58338e | 23501 | (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) |
b9661543 | 23502 | (inquote nil) |
e0e66b8e CD |
23503 | (infixed nil) |
23504 | (in-local-list nil) | |
23505 | (local-list-num nil) | |
23506 | (local-list-indent nil) | |
7a368970 | 23507 | (llt org-plain-list-ordered-item-terminator) |
4b3a9ba7 CD |
23508 | (email (plist-get opt-plist :email)) |
23509 | (language (plist-get opt-plist :language)) | |
4b3a9ba7 | 23510 | (lang-words nil) |
79c4be8e | 23511 | (target-alist nil) tg |
891f4676 | 23512 | (head-count 0) cnt |
c8d16429 | 23513 | (start 0) |
3278a016 | 23514 | (coding-system (and (boundp 'buffer-file-coding-system) |
1d676e9f | 23515 | buffer-file-coding-system)) |
b38c6895 CD |
23516 | (coding-system-for-write (or org-export-html-coding-system |
23517 | coding-system)) | |
23518 | (save-buffer-coding-system (or org-export-html-coding-system | |
23519 | coding-system)) | |
23520 | (charset (and coding-system-for-write | |
3278a016 | 23521 | (fboundp 'coding-system-get) |
b38c6895 CD |
23522 | (coding-system-get coding-system-for-write |
23523 | 'mime-charset))) | |
a3fbe8c4 CD |
23524 | (region |
23525 | (buffer-substring | |
23526 | (if region-p (region-beginning) (point-min)) | |
23527 | (if region-p (region-end) (point-max)))) | |
23528 | (lines | |
48aaad2d CD |
23529 | (org-split-string |
23530 | (org-cleaned-string-for-export | |
23531 | region | |
23532 | :emph-multiline t | |
23533 | :for-html t | |
23534 | :skip-before-1st-heading | |
23535 | (plist-get opt-plist :skip-before-1st-heading) | |
374585c9 CD |
23536 | :archived-trees |
23537 | (plist-get opt-plist :archived-trees) | |
48aaad2d CD |
23538 | :add-text |
23539 | (plist-get opt-plist :text) | |
23540 | :LaTeX-fragments | |
23541 | (plist-get opt-plist :LaTeX-fragments)) | |
23542 | "[\r\n]")) | |
c8d16429 CD |
23543 | table-open type |
23544 | table-buffer table-orig-buffer | |
a3fbe8c4 | 23545 | ind start-is-num starter didclose |
4b3a9ba7 | 23546 | rpl path desc descp desc1 desc2 link |
891f4676 | 23547 | ) |
a3fbe8c4 | 23548 | |
48aaad2d | 23549 | (let ((inhibit-read-only t)) |
a3fbe8c4 CD |
23550 | (org-unmodified |
23551 | (remove-text-properties (point-min) (point-max) | |
23552 | '(:org-license-to-kill t)))) | |
23553 | ||
891f4676 RS |
23554 | (message "Exporting...") |
23555 | ||
374585c9 CD |
23556 | (setq org-min-level (org-get-min-level lines)) |
23557 | (setq org-last-level org-min-level) | |
891f4676 RS |
23558 | (org-init-section-numbers) |
23559 | ||
0b8568f5 JW |
23560 | (cond |
23561 | ((and date (string-match "%" date)) | |
23562 | (setq date (format-time-string date (current-time)))) | |
23563 | (date) | |
23564 | (t (setq date (format-time-string "%Y/%m/%d %X" (current-time))))) | |
23565 | ||
4b3a9ba7 | 23566 | ;; Get the language-dependent settings |
891f4676 | 23567 | (setq lang-words (or (assoc language org-export-language-setup) |
b9661543 | 23568 | (assoc "en" org-export-language-setup))) |
891f4676 RS |
23569 | |
23570 | ;; Switch to the output buffer | |
a3fbe8c4 | 23571 | (set-buffer buffer) |
891f4676 RS |
23572 | (erase-buffer) |
23573 | (fundamental-mode) | |
48aaad2d CD |
23574 | |
23575 | (and (fboundp 'set-buffer-file-coding-system) | |
23576 | (set-buffer-file-coding-system coding-system-for-write)) | |
23577 | ||
4ed31842 CD |
23578 | (let ((case-fold-search nil) |
23579 | (org-odd-levels-only odd)) | |
4b3a9ba7 CD |
23580 | ;; create local variables for all options, to make sure all called |
23581 | ;; functions get the correct information | |
fbe6c10d CD |
23582 | (mapc (lambda (x) |
23583 | (set (make-local-variable (cdr x)) | |
23584 | (plist-get opt-plist (car x)))) | |
23585 | org-export-plist-vars) | |
891f4676 | 23586 | (setq umax (if arg (prefix-numeric-value arg) |
b9661543 | 23587 | org-export-headline-levels)) |
d3f4dbe8 CD |
23588 | (setq umax-toc (if (integerp org-export-with-toc) |
23589 | (min org-export-with-toc umax) | |
23590 | umax)) | |
a3fbe8c4 CD |
23591 | (unless body-only |
23592 | ;; File header | |
23593 | (insert (format | |
23594 | "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" | |
c4b5acde CD |
23595 | \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> |
23596 | <html xmlns=\"http://www.w3.org/1999/xhtml\" | |
23597 | lang=\"%s\" xml:lang=\"%s\"> | |
23598 | <head> | |
891f4676 | 23599 | <title>%s</title> |
c4b5acde CD |
23600 | <meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/> |
23601 | <meta name=\"generator\" content=\"Org-mode\"/> | |
0b8568f5 | 23602 | <meta name=\"generated\" content=\"%s\"/> |
c4b5acde | 23603 | <meta name=\"author\" content=\"%s\"/> |
e0e66b8e | 23604 | %s |
891f4676 RS |
23605 | </head><body> |
23606 | " | |
a3fbe8c4 | 23607 | language language (org-html-expand title) |
0b8568f5 | 23608 | (or charset "iso-8859-1") date author style)) |
c4b5acde | 23609 | |
a3fbe8c4 | 23610 | (insert (or (plist-get opt-plist :preamble) "")) |
4b3a9ba7 | 23611 | |
a3fbe8c4 CD |
23612 | (when (plist-get opt-plist :auto-preamble) |
23613 | (if title (insert (format org-export-html-title-format | |
23614 | (org-html-expand title)))))) | |
4b3a9ba7 | 23615 | |
a3fbe8c4 | 23616 | (if (and org-export-with-toc (not body-only)) |
c8d16429 | 23617 | (progn |
a3fbe8c4 CD |
23618 | (push (format "<h%d>%s</h%d>\n" |
23619 | org-export-html-toplevel-hlevel | |
23620 | (nth 3 lang-words) | |
23621 | org-export-html-toplevel-hlevel) | |
23622 | thetoc) | |
23623 | (push "<ul>\n<li>" thetoc) | |
79c4be8e | 23624 | (setq lines |
a3fbe8c4 CD |
23625 | (mapcar '(lambda (line) |
23626 | (if (string-match org-todo-line-regexp line) | |
23627 | ;; This is a headline | |
23628 | (progn | |
23629 | (setq have-headings t) | |
23630 | (setq level (- (match-end 1) (match-beginning 1)) | |
23631 | level (org-tr-level level) | |
23632 | txt (save-match-data | |
23633 | (org-html-expand | |
23634 | (org-export-cleanup-toc-line | |
23635 | (match-string 3 line)))) | |
23636 | todo | |
23637 | (or (and org-export-mark-todo-in-toc | |
23638 | (match-beginning 2) | |
23639 | (not (member (match-string 2 line) | |
23640 | org-done-keywords))) | |
c8d16429 | 23641 | ; TODO, not DONE |
a3fbe8c4 CD |
23642 | (and org-export-mark-todo-in-toc |
23643 | (= level umax-toc) | |
23644 | (org-search-todo-below | |
23645 | line lines level)))) | |
03f3cf35 JW |
23646 | (if (string-match |
23647 | (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) | |
23648 | (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) | |
a3fbe8c4 CD |
23649 | (if (string-match quote-re0 txt) |
23650 | (setq txt (replace-match "" t t txt))) | |
23651 | (if org-export-with-section-numbers | |
23652 | (setq txt (concat (org-section-number level) | |
23653 | " " txt))) | |
23654 | (if (<= level (max umax umax-toc)) | |
23655 | (setq head-count (+ head-count 1))) | |
23656 | (if (<= level umax-toc) | |
23657 | (progn | |
23658 | (if (> level org-last-level) | |
23659 | (progn | |
23660 | (setq cnt (- level org-last-level)) | |
23661 | (while (>= (setq cnt (1- cnt)) 0) | |
23662 | (push "\n<ul>\n<li>" thetoc)) | |
23663 | (push "\n" thetoc))) | |
23664 | (if (< level org-last-level) | |
23665 | (progn | |
23666 | (setq cnt (- org-last-level level)) | |
23667 | (while (>= (setq cnt (1- cnt)) 0) | |
23668 | (push "</li>\n</ul>" thetoc)) | |
23669 | (push "\n" thetoc))) | |
23670 | ;; Check for targets | |
23671 | (while (string-match org-target-regexp line) | |
23672 | (setq tg (match-string 1 line) | |
23673 | line (replace-match | |
23674 | (concat "@<span class=\"target\">" tg "@</span> ") | |
23675 | t t line)) | |
23676 | (push (cons (org-solidify-link-text tg) | |
23677 | (format "sec-%d" head-count)) | |
23678 | target-alist)) | |
23679 | (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) | |
23680 | (setq txt (replace-match "" t t txt))) | |
23681 | (push | |
23682 | (format | |
23683 | (if todo | |
23684 | "</li>\n<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>" | |
23685 | "</li>\n<li><a href=\"#sec-%d\">%s</a>") | |
23686 | head-count txt) thetoc) | |
23687 | ||
23688 | (setq org-last-level level)) | |
23689 | ))) | |
23690 | line) | |
23691 | lines)) | |
374585c9 | 23692 | (while (> org-last-level (1- org-min-level)) |
c8d16429 | 23693 | (setq org-last-level (1- org-last-level)) |
a3fbe8c4 CD |
23694 | (push "</li>\n</ul>\n" thetoc)) |
23695 | (setq thetoc (if have-headings (nreverse thetoc) nil)))) | |
23696 | ||
891f4676 RS |
23697 | (setq head-count 0) |
23698 | (org-init-section-numbers) | |
b9661543 | 23699 | |
891f4676 | 23700 | (while (setq line (pop lines) origline line) |
e0e66b8e CD |
23701 | (catch 'nextline |
23702 | ||
23703 | ;; end of quote section? | |
7d58338e | 23704 | (when (and inquote (string-match "^\\*+ " line)) |
e0e66b8e CD |
23705 | (insert "</pre>\n") |
23706 | (setq inquote nil)) | |
23707 | ;; inside a quote section? | |
23708 | (when inquote | |
23709 | (insert (org-html-protect line) "\n") | |
23710 | (throw 'nextline nil)) | |
23711 | ||
23712 | ;; verbatim lines | |
23713 | (when (and org-export-with-fixed-width | |
23714 | (string-match "^[ \t]*:\\(.*\\)" line)) | |
23715 | (when (not infixed) | |
23716 | (setq infixed t) | |
23717 | (insert "<pre>\n")) | |
23718 | (insert (org-html-protect (match-string 1 line)) "\n") | |
23719 | (when (and lines | |
7a368970 | 23720 | (not (string-match "^[ \t]*\\(:.*\\)" |
e0e66b8e CD |
23721 | (car lines)))) |
23722 | (setq infixed nil) | |
23723 | (insert "</pre>\n")) | |
23724 | (throw 'nextline nil)) | |
b9661543 | 23725 | |
d3f4dbe8 CD |
23726 | ;; Protected HTML |
23727 | (when (get-text-property 0 'org-protected line) | |
a3fbe8c4 CD |
23728 | (let (par) |
23729 | (when (re-search-backward | |
23730 | "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) | |
23731 | (setq par (match-string 1)) | |
23732 | (replace-match "\\2\n")) | |
23733 | (insert line "\n") | |
23734 | (while (and lines | |
23735 | (get-text-property 0 'org-protected (car lines))) | |
23736 | (insert (pop lines) "\n")) | |
23737 | (and par (insert "<p>\n"))) | |
d3f4dbe8 CD |
23738 | (throw 'nextline nil)) |
23739 | ||
23740 | ;; Horizontal line | |
23741 | (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) | |
23742 | (insert "\n<hr/>\n") | |
23743 | (throw 'nextline nil)) | |
272dfec2 CD |
23744 | |
23745 | ;; make targets to anchors | |
79c4be8e CD |
23746 | (while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line) |
23747 | (cond | |
23748 | ((match-end 2) | |
23749 | (setq line (replace-match | |
ab27a4a0 | 23750 | (concat "@<a name=\"" |
79c4be8e CD |
23751 | (org-solidify-link-text (match-string 1 line)) |
23752 | "\">\\nbsp@</a>") | |
23753 | t t line))) | |
23754 | ((and org-export-with-toc (equal (string-to-char line) ?*)) | |
23755 | (setq line (replace-match | |
23756 | (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") | |
23757 | ; (concat "@<i>" (match-string 1 line) "@</i> ") | |
23758 | t t line))) | |
23759 | (t | |
23760 | (setq line (replace-match | |
ab27a4a0 | 23761 | (concat "@<a name=\"" |
79c4be8e CD |
23762 | (org-solidify-link-text (match-string 1 line)) |
23763 | "\" class=\"target\">" (match-string 1 line) "@</a> ") | |
ab27a4a0 | 23764 | t t line))))) |
b9661543 | 23765 | |
4b3a9ba7 CD |
23766 | (setq line (org-html-handle-time-stamps line)) |
23767 | ||
e0e66b8e | 23768 | ;; replace "&" by "&", "<" and ">" by "<" and ">" |
b9661543 | 23769 | ;; handle @<..> HTML tags (replace "@>..<" by "<..>") |
f85d958a | 23770 | ;; Also handle sub_superscripts and checkboxes |
b9661543 CD |
23771 | (setq line (org-html-expand line)) |
23772 | ||
e0e66b8e CD |
23773 | ;; Format the links |
23774 | (setq start 0) | |
ab27a4a0 CD |
23775 | (while (string-match org-bracket-link-analytic-regexp line start) |
23776 | (setq start (match-beginning 0)) | |
23777 | (setq type (if (match-end 2) (match-string 2 line) "internal")) | |
23778 | (setq path (match-string 3 line)) | |
23779 | (setq desc1 (if (match-end 5) (match-string 5 line)) | |
23780 | desc2 (if (match-end 2) (concat type ":" path) path) | |
4b3a9ba7 | 23781 | descp (and desc1 (not (equal desc1 desc2))) |
ab27a4a0 | 23782 | desc (or desc1 desc2)) |
d3f4dbe8 CD |
23783 | ;; Make an image out of the description if that is so wanted |
23784 | (when (and descp (org-file-image-p desc)) | |
23785 | (save-match-data | |
23786 | (if (string-match "^file:" desc) | |
23787 | (setq desc (substring desc (match-end 0))))) | |
23788 | (setq desc (concat "<img src=\"" desc "\"/>"))) | |
4b3a9ba7 | 23789 | ;; FIXME: do we need to unescape here somewhere? |
e0e66b8e | 23790 | (cond |
ab27a4a0 CD |
23791 | ((equal type "internal") |
23792 | (setq rpl | |
23793 | (concat | |
23794 | "<a href=\"#" | |
a3fbe8c4 CD |
23795 | (org-solidify-link-text |
23796 | (save-match-data (org-link-unescape path)) target-alist) | |
ab27a4a0 | 23797 | "\">" desc "</a>"))) |
15841868 | 23798 | ((member type '("http" "https")) |
d3f4dbe8 CD |
23799 | ;; standard URL, just check if we need to inline an image |
23800 | (if (and (or (eq t org-export-html-inline-images) | |
23801 | (and org-export-html-inline-images (not descp))) | |
23802 | (org-file-image-p path)) | |
23803 | (setq rpl (concat "<img src=\"" type ":" path "\"/>")) | |
23804 | (setq link (concat type ":" path)) | |
23805 | (setq rpl (concat "<a href=\"" link "\">" desc "</a>")))) | |
23806 | ((member type '("ftp" "mailto" "news")) | |
e0e66b8e | 23807 | ;; standard URL |
ab27a4a0 CD |
23808 | (setq link (concat type ":" path)) |
23809 | (setq rpl (concat "<a href=\"" link "\">" desc "</a>"))) | |
e0e66b8e CD |
23810 | ((string= type "file") |
23811 | ;; FILE link | |
ab27a4a0 | 23812 | (let* ((filename path) |
e0e66b8e | 23813 | (abs-p (file-name-absolute-p filename)) |
d943b3c6 CD |
23814 | thefile file-is-image-p search) |
23815 | (save-match-data | |
23816 | (if (string-match "::\\(.*\\)" filename) | |
23817 | (setq search (match-string 1 filename) | |
c4b5acde | 23818 | filename (replace-match "" t nil filename))) |
0fee8d6e CD |
23819 | (setq valid |
23820 | (if (functionp link-validate) | |
23821 | (funcall link-validate filename current-dir) | |
c44f0d75 | 23822 | t)) |
d3f4dbe8 | 23823 | (setq file-is-image-p (org-file-image-p filename)) |
d943b3c6 CD |
23824 | (setq thefile (if abs-p (expand-file-name filename) filename)) |
23825 | (when (and org-export-html-link-org-files-as-html | |
23826 | (string-match "\\.org$" thefile)) | |
23827 | (setq thefile (concat (substring thefile 0 | |
23828 | (match-beginning 0)) | |
15841868 | 23829 | "." org-export-html-extension)) |
d943b3c6 CD |
23830 | (if (and search |
23831 | ;; make sure this is can be used as target search | |
23832 | (not (string-match "^[0-9]*$" search)) | |
23833 | (not (string-match "^\\*" search)) | |
23834 | (not (string-match "^/.*/$" search))) | |
edd21304 | 23835 | (setq thefile (concat thefile "#" |
d943b3c6 | 23836 | (org-solidify-link-text |
4b3a9ba7 CD |
23837 | (org-link-unescape search))))) |
23838 | (when (string-match "^file:" desc) | |
23839 | (setq desc (replace-match "" t t desc)) | |
23840 | (if (string-match "\\.org$" desc) | |
23841 | (setq desc (replace-match "" t t desc)))))) | |
23842 | (setq rpl (if (and file-is-image-p | |
23843 | (or (eq t org-export-html-inline-images) | |
23844 | (and org-export-html-inline-images | |
23845 | (not descp)))) | |
ab27a4a0 | 23846 | (concat "<img src=\"" thefile "\"/>") |
0fee8d6e CD |
23847 | (concat "<a href=\"" thefile "\">" desc "</a>"))) |
23848 | (if (not valid) (setq rpl desc)))) | |
4b3a9ba7 | 23849 | ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell" "info" "elisp")) |
4146eb16 CD |
23850 | (setq rpl (concat "<i><" type ":" |
23851 | (save-match-data (org-link-unescape path)) | |
23852 | "></i>")))) | |
ab27a4a0 CD |
23853 | (setq line (replace-match rpl t t line) |
23854 | start (+ start (length rpl)))) | |
b38c6895 | 23855 | |
e0e66b8e CD |
23856 | ;; TODO items |
23857 | (if (and (string-match org-todo-line-regexp line) | |
23858 | (match-beginning 2)) | |
5152b597 | 23859 | |
fbe6c10d | 23860 | (setq line |
5152b597 CD |
23861 | (concat (substring line 0 (match-beginning 2)) |
23862 | "<span class=\"" | |
23863 | (if (member (match-string 2 line) | |
23864 | org-done-keywords) | |
23865 | "done" "todo") | |
23866 | "\">" (match-string 2 line) | |
23867 | "</span>" (substring line (match-end 2))))) | |
a3fbe8c4 CD |
23868 | |
23869 | ;; Does this contain a reference to a footnote? | |
5152b597 CD |
23870 | (when org-export-with-footnotes |
23871 | (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line) | |
23872 | (let ((n (match-string 2 line))) | |
23873 | (setq line | |
23874 | (replace-match | |
23875 | (format | |
23876 | "%s<sup><a class=\"footref\" name=\"fnr.%s\" href=\"#fn.%s\">%s</a></sup>" | |
23877 | (match-string 1 line) n n n) | |
23878 | t t line))))) | |
c8d16429 | 23879 | |
e0e66b8e | 23880 | (cond |
7d58338e | 23881 | ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) |
e0e66b8e | 23882 | ;; This is a headline |
79c4be8e | 23883 | (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) |
e0e66b8e | 23884 | txt (match-string 2 line)) |
4b3a9ba7 CD |
23885 | (if (string-match quote-re0 txt) |
23886 | (setq txt (replace-match "" t t txt))) | |
a3fbe8c4 CD |
23887 | (if (<= level (max umax umax-toc)) |
23888 | (setq head-count (+ head-count 1))) | |
e0e66b8e CD |
23889 | (when in-local-list |
23890 | ;; Close any local lists before inserting a new header line | |
23891 | (while local-list-num | |
c4b5acde | 23892 | (org-close-li) |
e0e66b8e CD |
23893 | (insert (if (car local-list-num) "</ol>\n" "</ul>")) |
23894 | (pop local-list-num)) | |
23895 | (setq local-list-indent nil | |
23896 | in-local-list nil)) | |
a3fbe8c4 | 23897 | (setq first-heading-pos (or first-heading-pos (point))) |
e0e66b8e CD |
23898 | (org-html-level-start level txt umax |
23899 | (and org-export-with-toc (<= level umax)) | |
23900 | head-count) | |
23901 | ;; QUOTES | |
23902 | (when (string-match quote-re line) | |
23903 | (insert "<pre>") | |
23904 | (setq inquote t))) | |
23905 | ||
23906 | ((and org-export-with-tables | |
23907 | (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) | |
23908 | (if (not table-open) | |
23909 | ;; New table starts | |
23910 | (setq table-open t table-buffer nil table-orig-buffer nil)) | |
23911 | ;; Accumulate lines | |
23912 | (setq table-buffer (cons line table-buffer) | |
23913 | table-orig-buffer (cons origline table-orig-buffer)) | |
23914 | (when (or (not lines) | |
23915 | (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" | |
23916 | (car lines)))) | |
23917 | (setq table-open nil | |
23918 | table-buffer (nreverse table-buffer) | |
23919 | table-orig-buffer (nreverse table-orig-buffer)) | |
c4b5acde | 23920 | (org-close-par-maybe) |
e0e66b8e CD |
23921 | (insert (org-format-table-html table-buffer table-orig-buffer)))) |
23922 | (t | |
23923 | ;; Normal lines | |
4b3a9ba7 CD |
23924 | (when (string-match |
23925 | (cond | |
8df0de1c CD |
23926 | ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") |
23927 | ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") | |
23928 | ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") | |
4b3a9ba7 CD |
23929 | (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) |
23930 | line) | |
7a368970 | 23931 | (setq ind (org-get-string-indentation line) |
e0e66b8e | 23932 | start-is-num (match-beginning 4) |
edd21304 | 23933 | starter (if (match-beginning 2) |
4b3a9ba7 | 23934 | (substring (match-string 2 line) 0 -1)) |
7a368970 | 23935 | line (substring line (match-beginning 5))) |
b0a10108 | 23936 | (unless (string-match "[^ \t]" line) |
7a368970 | 23937 | ;; empty line. Pretend indentation is large. |
a3fbe8c4 CD |
23938 | (setq ind (if org-empty-line-terminates-plain-lists |
23939 | 0 | |
23940 | (1+ (or (car local-list-indent) 1))))) | |
23941 | (setq didclose nil) | |
e0e66b8e CD |
23942 | (while (and in-local-list |
23943 | (or (and (= ind (car local-list-indent)) | |
23944 | (not starter)) | |
23945 | (< ind (car local-list-indent)))) | |
a3fbe8c4 | 23946 | (setq didclose t) |
c4b5acde | 23947 | (org-close-li) |
e0e66b8e CD |
23948 | (insert (if (car local-list-num) "</ol>\n" "</ul>")) |
23949 | (pop local-list-num) (pop local-list-indent) | |
23950 | (setq in-local-list local-list-indent)) | |
e0e66b8e CD |
23951 | (cond |
23952 | ((and starter | |
23953 | (or (not in-local-list) | |
ab27a4a0 | 23954 | (> ind (car local-list-indent)))) |
a3fbe8c4 | 23955 | ;; Start new (level of) list |
c4b5acde | 23956 | (org-close-par-maybe) |
e0e66b8e CD |
23957 | (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n")) |
23958 | (push start-is-num local-list-num) | |
23959 | (push ind local-list-indent) | |
23960 | (setq in-local-list t)) | |
23961 | (starter | |
23962 | ;; continue current list | |
c4b5acde | 23963 | (org-close-li) |
a3fbe8c4 CD |
23964 | (insert "<li>\n")) |
23965 | (didclose | |
23966 | ;; we did close a list, normal text follows: need <p> | |
23967 | (org-open-par))) | |
4b3a9ba7 | 23968 | (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) |
edd21304 | 23969 | (setq line |
4b3a9ba7 CD |
23970 | (replace-match |
23971 | (if (equal (match-string 1 line) "X") | |
23972 | "<b>[X]</b>" | |
23973 | "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") | |
23974 | t t line)))) | |
23975 | ||
e0e66b8e CD |
23976 | ;; Empty lines start a new paragraph. If hand-formatted lists |
23977 | ;; are not fully interpreted, lines starting with "-", "+", "*" | |
23978 | ;; also start a new paragraph. | |
c4b5acde | 23979 | (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) |
4b3a9ba7 | 23980 | |
a3fbe8c4 | 23981 | ;; Is this the start of a footnote? |
5152b597 CD |
23982 | (when org-export-with-footnotes |
23983 | (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) | |
23984 | (org-close-par-maybe) | |
23985 | (let ((n (match-string 1 line))) | |
23986 | (setq line (replace-match | |
23987 | (format "<p class=\"footnote\"><sup><a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t line))))) | |
a3fbe8c4 | 23988 | |
c4b5acde | 23989 | ;; Check if the line break needs to be conserved |
c4b5acde CD |
23990 | (cond |
23991 | ((string-match "\\\\\\\\[ \t]*$" line) | |
23992 | (setq line (replace-match "<br/>" t t line))) | |
23993 | (org-export-preserve-breaks | |
23994 | (setq line (concat line "<br/>")))) | |
23995 | ||
23996 | (insert line "\n"))))) | |
edd21304 | 23997 | |
4b3a9ba7 CD |
23998 | ;; Properly close all local lists and other lists |
23999 | (when inquote (insert "</pre>\n")) | |
24000 | (when in-local-list | |
24001 | ;; Close any local lists before inserting a new header line | |
24002 | (while local-list-num | |
c4b5acde CD |
24003 | (org-close-li) |
24004 | (insert (if (car local-list-num) "</ol>\n" "</ul>\n")) | |
4b3a9ba7 CD |
24005 | (pop local-list-num)) |
24006 | (setq local-list-indent nil | |
24007 | in-local-list nil)) | |
03f3cf35 | 24008 | (org-html-level-start 0 nil umax |
4b3a9ba7 CD |
24009 | (and org-export-with-toc (<= level umax)) |
24010 | head-count) | |
24011 | ||
a3fbe8c4 CD |
24012 | (unless body-only |
24013 | (when (plist-get opt-plist :auto-postamble) | |
03f3cf35 | 24014 | (insert "<div id=\"postamble\">") |
48aaad2d | 24015 | (when (and org-export-author-info author) |
a3fbe8c4 CD |
24016 | (insert "<p class=\"author\"> " |
24017 | (nth 1 lang-words) ": " author "\n") | |
24018 | (when email | |
24019 | (insert "<a href=\"mailto:" email "\"><" | |
24020 | email "></a>\n")) | |
24021 | (insert "</p>\n")) | |
0b8568f5 | 24022 | (when (and date org-export-time-stamp-file) |
a3fbe8c4 CD |
24023 | (insert "<p class=\"date\"> " |
24024 | (nth 2 lang-words) ": " | |
03f3cf35 JW |
24025 | date "</p>\n")) |
24026 | (insert "</div>")) | |
a3fbe8c4 CD |
24027 | |
24028 | (if org-export-html-with-timestamp | |
24029 | (insert org-export-html-html-helper-timestamp)) | |
24030 | (insert (or (plist-get opt-plist :postamble) "")) | |
24031 | (insert "</body>\n</html>\n")) | |
24032 | ||
e0e66b8e | 24033 | (normal-mode) |
a3fbe8c4 CD |
24034 | (if (eq major-mode default-major-mode) (html-mode)) |
24035 | ||
24036 | ;; insert the table of contents | |
24037 | (goto-char (point-min)) | |
24038 | (when thetoc | |
24039 | (if (or (re-search-forward | |
24040 | "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t) | |
24041 | (re-search-forward | |
24042 | "\\[TABLE-OF-CONTENTS\\]" nil t)) | |
24043 | (progn | |
24044 | (goto-char (match-beginning 0)) | |
24045 | (replace-match "")) | |
24046 | (goto-char first-heading-pos) | |
24047 | (when (looking-at "\\s-*</p>") | |
24048 | (goto-char (match-end 0)) | |
24049 | (insert "\n"))) | |
03f3cf35 JW |
24050 | (insert "<div id=\"table-of-contents\">\n") |
24051 | (mapc 'insert thetoc) | |
24052 | (insert "</div>\n")) | |
c4b5acde CD |
24053 | ;; remove empty paragraphs and lists |
24054 | (goto-char (point-min)) | |
24055 | (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t) | |
24056 | (replace-match "")) | |
24057 | (goto-char (point-min)) | |
24058 | (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) | |
24059 | (replace-match "")) | |
03f3cf35 JW |
24060 | ;; Convert whitespace place holders |
24061 | (goto-char (point-min)) | |
24062 | (let (beg end n) | |
24063 | (while (setq beg (next-single-property-change (point) 'org-whitespace)) | |
24064 | (setq n (get-text-property beg 'org-whitespace) | |
24065 | end (next-single-property-change beg 'org-whitespace)) | |
24066 | (goto-char beg) | |
24067 | (delete-region beg end) | |
24068 | (insert (format "<span style=\"visibility:hidden;\">%s</span>" | |
24069 | (make-string n ?x))))) | |
fbe6c10d | 24070 | |
a3fbe8c4 | 24071 | (or to-buffer (save-buffer)) |
6769c0dc | 24072 | (goto-char (point-min)) |
a3fbe8c4 CD |
24073 | (message "Exporting... done") |
24074 | (if (eq to-buffer 'string) | |
24075 | (prog1 (buffer-substring (point-min) (point-max)) | |
24076 | (kill-buffer (current-buffer))) | |
24077 | (current-buffer))))) | |
24078 | ||
15841868 | 24079 | (defvar org-table-colgroup-info nil) |
a3fbe8c4 CD |
24080 | (defun org-format-table-ascii (lines) |
24081 | "Format a table for ascii export." | |
24082 | (if (stringp lines) | |
24083 | (setq lines (org-split-string lines "\n"))) | |
24084 | (if (not (string-match "^[ \t]*|" (car lines))) | |
24085 | ;; Table made by table.el - test for spanning | |
24086 | lines | |
24087 | ||
24088 | ;; A normal org table | |
24089 | ;; Get rid of hlines at beginning and end | |
24090 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | |
24091 | (setq lines (nreverse lines)) | |
24092 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | |
24093 | (setq lines (nreverse lines)) | |
24094 | (when org-export-table-remove-special-lines | |
24095 | ;; Check if the table has a marking column. If yes remove the | |
24096 | ;; column and the special lines | |
24097 | (setq lines (org-table-clean-before-export lines))) | |
24098 | ;; Get rid of the vertical lines except for grouping | |
24099 | (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) | |
24100 | rtn line vl1 start) | |
24101 | (while (setq line (pop lines)) | |
24102 | (if (string-match org-table-hline-regexp line) | |
24103 | (and (string-match "|\\(.*\\)|" line) | |
24104 | (setq line (replace-match " \\1" t nil line))) | |
24105 | (setq start 0 vl1 vl) | |
24106 | (while (string-match "|" line start) | |
24107 | (setq start (match-end 0)) | |
24108 | (or (pop vl1) (setq line (replace-match " " t t line))))) | |
24109 | (push line rtn)) | |
24110 | (nreverse rtn)))) | |
24111 | ||
24112 | (defun org-colgroup-info-to-vline-list (info) | |
38f8646b | 24113 | (let (vl new last) |
a3fbe8c4 CD |
24114 | (while info |
24115 | (setq last new new (pop info)) | |
24116 | (if (or (memq last '(:end :startend)) | |
24117 | (memq new '(:start :startend))) | |
24118 | (push t vl) | |
24119 | (push nil vl))) | |
15841868 JW |
24120 | (setq vl (nreverse vl)) |
24121 | (and vl (setcar vl nil)) | |
24122 | vl)) | |
891f4676 RS |
24123 | |
24124 | (defun org-format-table-html (lines olines) | |
24125 | "Find out which HTML converter to use and return the HTML code." | |
a3fbe8c4 CD |
24126 | (if (stringp lines) |
24127 | (setq lines (org-split-string lines "\n"))) | |
891f4676 RS |
24128 | (if (string-match "^[ \t]*|" (car lines)) |
24129 | ;; A normal org table | |
24130 | (org-format-org-table-html lines) | |
24131 | ;; Table made by table.el - test for spanning | |
24132 | (let* ((hlines (delq nil (mapcar | |
c8d16429 CD |
24133 | (lambda (x) |
24134 | (if (string-match "^[ \t]*\\+-" x) x | |
24135 | nil)) | |
24136 | lines))) | |
24137 | (first (car hlines)) | |
24138 | (ll (and (string-match "\\S-+" first) | |
24139 | (match-string 0 first))) | |
24140 | (re (concat "^[ \t]*" (regexp-quote ll))) | |
24141 | (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) | |
24142 | hlines)))) | |
891f4676 | 24143 | (if (and (not spanning) |
c8d16429 CD |
24144 | (not org-export-prefer-native-exporter-for-tables)) |
24145 | ;; We can use my own converter with HTML conversions | |
24146 | (org-format-table-table-html lines) | |
24147 | ;; Need to use the code generator in table.el, with the original text. | |
24148 | (org-format-table-table-html-using-table-generate-source olines))))) | |
891f4676 | 24149 | |
d3f4dbe8 | 24150 | (defun org-format-org-table-html (lines &optional splice) |
35402b98 | 24151 | "Format a table into HTML." |
d3f4dbe8 | 24152 | ;; Get rid of hlines at beginning and end |
891f4676 RS |
24153 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) |
24154 | (setq lines (nreverse lines)) | |
24155 | (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) | |
24156 | (setq lines (nreverse lines)) | |
a96ee7df CD |
24157 | (when org-export-table-remove-special-lines |
24158 | ;; Check if the table has a marking column. If yes remove the | |
24159 | ;; column and the special lines | |
d3f4dbe8 | 24160 | (setq lines (org-table-clean-before-export lines))) |
35402b98 | 24161 | |
891f4676 | 24162 | (let ((head (and org-export-highlight-first-table-line |
c8d16429 CD |
24163 | (delq nil (mapcar |
24164 | (lambda (x) (string-match "^[ \t]*|-" x)) | |
24165 | (cdr lines))))) | |
d3f4dbe8 | 24166 | (nlines 0) fnum i |
b38c6895 | 24167 | tbopen line fields html gr colgropen) |
d3f4dbe8 CD |
24168 | (if splice (setq head nil)) |
24169 | (unless splice (push (if head "<thead>" "<tbody>") html)) | |
24170 | (setq tbopen t) | |
30313b90 | 24171 | (while (setq line (pop lines)) |
891f4676 | 24172 | (catch 'next-line |
c8d16429 CD |
24173 | (if (string-match "^[ \t]*|-" line) |
24174 | (progn | |
a3fbe8c4 | 24175 | (unless splice |
d3f4dbe8 CD |
24176 | (push (if head "</thead>" "</tbody>") html) |
24177 | (if lines (push "<tbody>" html) (setq tbopen nil))) | |
c8d16429 CD |
24178 | (setq head nil) ;; head ends here, first time around |
24179 | ;; ignore this line | |
24180 | (throw 'next-line t))) | |
24181 | ;; Break the line into fields | |
24182 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) | |
d3f4dbe8 CD |
24183 | (unless fnum (setq fnum (make-vector (length fields) 0))) |
24184 | (setq nlines (1+ nlines) i -1) | |
24185 | (push (concat "<tr>" | |
24186 | (mapconcat | |
24187 | (lambda (x) | |
24188 | (setq i (1+ i)) | |
24189 | (if (and (< i nlines) | |
24190 | (string-match org-table-number-regexp x)) | |
24191 | (incf (aref fnum i))) | |
24192 | (if head | |
a3fbe8c4 CD |
24193 | (concat (car org-export-table-header-tags) x |
24194 | (cdr org-export-table-header-tags)) | |
24195 | (concat (car org-export-table-data-tags) x | |
24196 | (cdr org-export-table-data-tags)))) | |
d3f4dbe8 CD |
24197 | fields "") |
24198 | "</tr>") | |
24199 | html))) | |
24200 | (unless splice (if tbopen (push "</tbody>" html))) | |
24201 | (unless splice (push "</table>\n" html)) | |
24202 | (setq html (nreverse html)) | |
24203 | (unless splice | |
24204 | ;; Put in COL tags with the alignment (unfortuntely often ignored...) | |
24205 | (push (mapconcat | |
24206 | (lambda (x) | |
a3fbe8c4 | 24207 | (setq gr (pop org-table-colgroup-info)) |
b38c6895 | 24208 | (format "%s<COL align=\"%s\"></COL>%s" |
fbe6c10d | 24209 | (if (memq gr '(:start :startend)) |
b38c6895 CD |
24210 | (prog1 |
24211 | (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") | |
24212 | (setq colgropen t)) | |
24213 | "") | |
d3f4dbe8 | 24214 | (if (> (/ (float x) nlines) org-table-number-fraction) |
a3fbe8c4 | 24215 | "right" "left") |
fbe6c10d | 24216 | (if (memq gr '(:end :startend)) |
b38c6895 CD |
24217 | (progn (setq colgropen nil) "</colgroup>") |
24218 | ""))) | |
d3f4dbe8 CD |
24219 | fnum "") |
24220 | html) | |
b38c6895 | 24221 | (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) |
d3f4dbe8 CD |
24222 | (push org-export-html-table-tag html)) |
24223 | (concat (mapconcat 'identity html "\n") "\n"))) | |
24224 | ||
24225 | (defun org-table-clean-before-export (lines) | |
24226 | "Check if the table has a marking column. | |
24227 | If yes remove the column and the special lines." | |
a3fbe8c4 | 24228 | (setq org-table-colgroup-info nil) |
d3f4dbe8 CD |
24229 | (if (memq nil |
24230 | (mapcar | |
24231 | (lambda (x) (or (string-match "^[ \t]*|-" x) | |
24232 | (string-match "^[ \t]*| *\\([#!$*_^ /]\\) *|" x))) | |
24233 | lines)) | |
24234 | (progn | |
a3fbe8c4 CD |
24235 | (setq org-table-clean-did-remove-column nil) |
24236 | (delq nil | |
24237 | (mapcar | |
24238 | (lambda (x) | |
24239 | (cond | |
24240 | ((string-match "^[ \t]*| */ *|" x) | |
24241 | (setq org-table-colgroup-info | |
24242 | (mapcar (lambda (x) | |
24243 | (cond ((member x '("<" "<")) :start) | |
24244 | ((member x '(">" ">")) :end) | |
24245 | ((member x '("<>" "<>")) :startend) | |
24246 | (t nil))) | |
24247 | (org-split-string x "[ \t]*|[ \t]*"))) | |
24248 | nil) | |
24249 | (t x))) | |
24250 | lines))) | |
24251 | (setq org-table-clean-did-remove-column t) | |
d3f4dbe8 CD |
24252 | (delq nil |
24253 | (mapcar | |
a3fbe8c4 CD |
24254 | (lambda (x) |
24255 | (cond | |
24256 | ((string-match "^[ \t]*| */ *|" x) | |
24257 | (setq org-table-colgroup-info | |
24258 | (mapcar (lambda (x) | |
24259 | (cond ((member x '("<" "<")) :start) | |
24260 | ((member x '(">" ">")) :end) | |
24261 | ((member x '("<>" "<>")) :startend) | |
24262 | (t nil))) | |
24263 | (cdr (org-split-string x "[ \t]*|[ \t]*")))) | |
24264 | nil) | |
24265 | ((string-match "^[ \t]*| *[!_^/] *|" x) | |
24266 | nil) ; ignore this line | |
24267 | ((or (string-match "^\\([ \t]*\\)|-+\\+" x) | |
24268 | (string-match "^\\([ \t]*\\)|[^|]*|" x)) | |
24269 | ;; remove the first column | |
24270 | (replace-match "\\1|" t nil x)) | |
24271 | (t (error "This should not happen")))) | |
d3f4dbe8 | 24272 | lines)))) |
891f4676 | 24273 | |
891f4676 | 24274 | (defun org-format-table-table-html (lines) |
35402b98 | 24275 | "Format a table generated by table.el into HTML. |
891f4676 RS |
24276 | This conversion does *not* use `table-generate-source' from table.el. |
24277 | This has the advantage that Org-mode's HTML conversions can be used. | |
24278 | But it has the disadvantage, that no cell- or row-spanning is allowed." | |
24279 | (let (line field-buffer | |
c8d16429 CD |
24280 | (head org-export-highlight-first-table-line) |
24281 | fields html empty) | |
891f4676 RS |
24282 | (setq html (concat org-export-html-table-tag "\n")) |
24283 | (while (setq line (pop lines)) | |
7d143c25 | 24284 | (setq empty " ") |
891f4676 | 24285 | (catch 'next-line |
c8d16429 CD |
24286 | (if (string-match "^[ \t]*\\+-" line) |
24287 | (progn | |
24288 | (if field-buffer | |
24289 | (progn | |
a3fbe8c4 CD |
24290 | (setq |
24291 | html | |
24292 | (concat | |
24293 | html | |
24294 | "<tr>" | |
24295 | (mapconcat | |
24296 | (lambda (x) | |
24297 | (if (equal x "") (setq x empty)) | |
24298 | (if head | |
24299 | (concat (car org-export-table-header-tags) x | |
24300 | (cdr org-export-table-header-tags)) | |
24301 | (concat (car org-export-table-data-tags) x | |
24302 | (cdr org-export-table-data-tags)))) | |
24303 | field-buffer "\n") | |
24304 | "</tr>\n")) | |
c8d16429 CD |
24305 | (setq head nil) |
24306 | (setq field-buffer nil))) | |
24307 | ;; Ignore this line | |
24308 | (throw 'next-line t))) | |
24309 | ;; Break the line into fields and store the fields | |
24310 | (setq fields (org-split-string line "[ \t]*|[ \t]*")) | |
24311 | (if field-buffer | |
24312 | (setq field-buffer (mapcar | |
24313 | (lambda (x) | |
c4b5acde | 24314 | (concat x "<br/>" (pop fields))) |
c8d16429 CD |
24315 | field-buffer)) |
24316 | (setq field-buffer fields)))) | |
891f4676 RS |
24317 | (setq html (concat html "</table>\n")) |
24318 | html)) | |
24319 | ||
24320 | (defun org-format-table-table-html-using-table-generate-source (lines) | |
c8d16429 | 24321 | "Format a table into html, using `table-generate-source' from table.el. |
891f4676 RS |
24322 | This has the advantage that cell- or row-spanning is allowed. |
24323 | But it has the disadvantage, that Org-mode's HTML conversions cannot be used." | |
24324 | (require 'table) | |
634a7d0b | 24325 | (with-current-buffer (get-buffer-create " org-tmp1 ") |
891f4676 RS |
24326 | (erase-buffer) |
24327 | (insert (mapconcat 'identity lines "\n")) | |
24328 | (goto-char (point-min)) | |
24329 | (if (not (re-search-forward "|[^+]" nil t)) | |
c8d16429 | 24330 | (error "Error processing table")) |
891f4676 | 24331 | (table-recognize-table) |
634a7d0b | 24332 | (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) |
891f4676 RS |
24333 | (table-generate-source 'html " org-tmp2 ") |
24334 | (set-buffer " org-tmp2 ") | |
24335 | (buffer-substring (point-min) (point-max)))) | |
24336 | ||
4b3a9ba7 CD |
24337 | (defun org-html-handle-time-stamps (s) |
24338 | "Format time stamps in string S, or remove them." | |
0fee8d6e CD |
24339 | (catch 'exit |
24340 | (let (r b) | |
24341 | (while (string-match org-maybe-keyword-time-regexp s) | |
0fee8d6e | 24342 | (if (and (match-end 1) (equal (match-string 1 s) org-clock-string)) |
3278a016 | 24343 | ;; never export CLOCK |
0fee8d6e CD |
24344 | (throw 'exit "")) |
24345 | (or b (setq b (substring s 0 (match-beginning 0)))) | |
24346 | (if (not org-export-with-timestamps) | |
24347 | (setq r (concat r (substring s 0 (match-beginning 0))) | |
24348 | s (substring s (match-end 0))) | |
24349 | (setq r (concat | |
24350 | r (substring s 0 (match-beginning 0)) | |
24351 | (if (match-end 1) | |
24352 | (format "@<span class=\"timestamp-kwd\">%s @</span>" | |
24353 | (match-string 1 s))) | |
24354 | (format " @<span class=\"timestamp\">%s@</span>" | |
d3f4dbe8 CD |
24355 | (substring |
24356 | (org-translate-time (match-string 3 s)) 1 -1))) | |
0fee8d6e CD |
24357 | s (substring s (match-end 0))))) |
24358 | ;; Line break if line started and ended with time stamp stuff | |
24359 | (if (not r) | |
24360 | s | |
24361 | (setq r (concat r s)) | |
24362 | (unless (string-match "\\S-" (concat b s)) | |
24363 | (setq r (concat r "@<br/>"))) | |
24364 | r)))) | |
4b3a9ba7 | 24365 | |
e0e66b8e CD |
24366 | (defun org-html-protect (s) |
24367 | ;; convert & to &, < to < and > to > | |
24368 | (let ((start 0)) | |
24369 | (while (string-match "&" s start) | |
24370 | (setq s (replace-match "&" t t s) | |
24371 | start (1+ (match-beginning 0)))) | |
24372 | (while (string-match "<" s) | |
24373 | (setq s (replace-match "<" t t s))) | |
24374 | (while (string-match ">" s) | |
24375 | (setq s (replace-match ">" t t s)))) | |
24376 | s) | |
24377 | ||
8df0de1c | 24378 | (defun org-export-cleanup-toc-line (s) |
4b3a9ba7 | 24379 | "Remove tags and time staps from lines going into the toc." |
03f3cf35 JW |
24380 | (when (memq org-export-with-tags '(not-in-toc nil)) |
24381 | (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s) | |
24382 | (setq s (replace-match "" t t s)))) | |
8df0de1c CD |
24383 | (when org-export-remove-timestamps-from-toc |
24384 | (while (string-match org-maybe-keyword-time-regexp s) | |
24385 | (setq s (replace-match "" t t s)))) | |
a3fbe8c4 CD |
24386 | (while (string-match org-bracket-link-regexp s) |
24387 | (setq s (replace-match (match-string (if (match-end 3) 3 1) s) | |
24388 | t t s))) | |
4b3a9ba7 CD |
24389 | s) |
24390 | ||
891f4676 | 24391 | (defun org-html-expand (string) |
ab27a4a0 CD |
24392 | "Prepare STRING for HTML export. Applies all active conversions. |
24393 | If there are links in the string, don't modify these." | |
03f3cf35 JW |
24394 | (let* ((re (concat org-bracket-link-regexp "\\|" |
24395 | (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) | |
24396 | m s l res) | |
24397 | (while (setq m (string-match re string)) | |
ab27a4a0 CD |
24398 | (setq s (substring string 0 m) |
24399 | l (match-string 0 string) | |
24400 | string (substring string (match-end 0))) | |
24401 | (push (org-html-do-expand s) res) | |
24402 | (push l res)) | |
24403 | (push (org-html-do-expand string) res) | |
24404 | (apply 'concat (nreverse res)))) | |
24405 | ||
24406 | (defun org-html-do-expand (s) | |
24407 | "Apply all active conversions to translate special ASCII to HTML." | |
24408 | (setq s (org-html-protect s)) | |
24409 | (if org-export-html-expand | |
24410 | (while (string-match "@<\\([^&]*\\)>" s) | |
c4b5acde | 24411 | (setq s (replace-match "<\\1>" t nil s)))) |
ab27a4a0 CD |
24412 | (if org-export-with-emphasize |
24413 | (setq s (org-export-html-convert-emphasize s))) | |
24414 | (if org-export-with-sub-superscripts | |
24415 | (setq s (org-export-html-convert-sub-super s))) | |
24416 | (if org-export-with-TeX-macros | |
24417 | (let ((start 0) wd ass) | |
24418 | (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)" s start)) | |
24419 | (setq wd (match-string 1 s)) | |
24420 | (if (setq ass (assoc wd org-html-entities)) | |
24421 | (setq s (replace-match (or (cdr ass) | |
24422 | (concat "&" (car ass) ";")) | |
24423 | t t s)) | |
24424 | (setq start (+ start (length wd))))))) | |
24425 | s) | |
891f4676 RS |
24426 | |
24427 | (defun org-create-multibrace-regexp (left right n) | |
24428 | "Create a regular expression which will match a balanced sexp. | |
24429 | Opening delimiter is LEFT, and closing delimiter is RIGHT, both given | |
24430 | as single character strings. | |
24431 | The regexp returned will match the entire expression including the | |
24432 | delimiters. It will also define a single group which contains the | |
2dd9129f SM |
24433 | match except for the outermost delimiters. The maximum depth of |
24434 | stacked delimiters is N. Escaping delimiters is not possible." | |
891f4676 | 24435 | (let* ((nothing (concat "[^" "\\" left "\\" right "]*?")) |
c8d16429 CD |
24436 | (or "\\|") |
24437 | (re nothing) | |
24438 | (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) | |
891f4676 RS |
24439 | (while (> n 1) |
24440 | (setq n (1- n) | |
c8d16429 CD |
24441 | re (concat re or next) |
24442 | next (concat "\\(?:" nothing left next right "\\)+" nothing))) | |
891f4676 RS |
24443 | (concat left "\\(" re "\\)" right))) |
24444 | ||
24445 | (defvar org-match-substring-regexp | |
24446 | (concat | |
24447 | "\\([^\\]\\)\\([_^]\\)\\(" | |
24448 | "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" | |
24449 | "\\|" | |
24450 | "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" | |
24451 | "\\|" | |
24452 | "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") | |
24453 | "The regular expression matching a sub- or superscript.") | |
24454 | ||
a3fbe8c4 CD |
24455 | ;(let ((s "a\\_b")) |
24456 | ; (and (string-match org-match-substring-regexp s) | |
24457 | ; (conca t (match-string 1 s) ":::" (match-string 2 s)))) | |
24458 | ||
891f4676 RS |
24459 | (defun org-export-html-convert-sub-super (string) |
24460 | "Convert sub- and superscripts in STRING to HTML." | |
a3fbe8c4 CD |
24461 | (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) |
24462 | (while (string-match org-match-substring-regexp string s) | |
24463 | (if (and requireb (match-end 8)) | |
24464 | (setq s (match-end 2)) | |
24465 | (setq s (match-end 1) | |
24466 | key (if (string= (match-string 2 string) "_") "sub" "sup") | |
24467 | c (or (match-string 8 string) | |
24468 | (match-string 6 string) | |
24469 | (match-string 5 string)) | |
24470 | string (replace-match | |
24471 | (concat (match-string 1 string) | |
24472 | "<" key ">" c "</" key ">") | |
24473 | t t string)))) | |
891f4676 | 24474 | (while (string-match "\\\\\\([_^]\\)" string) |
a3fbe8c4 CD |
24475 | (setq string (replace-match (match-string 1 string) t t string))) |
24476 | string)) | |
891f4676 RS |
24477 | |
24478 | (defun org-export-html-convert-emphasize (string) | |
edd21304 | 24479 | "Apply emphasis." |
a3fbe8c4 CD |
24480 | (let ((s 0)) |
24481 | (while (string-match org-emph-re string s) | |
24482 | (if (not (equal | |
24483 | (substring string (match-beginning 3) (1+ (match-beginning 3))) | |
24484 | (substring string (match-beginning 4) (1+ (match-beginning 4))))) | |
24485 | (setq string (replace-match | |
24486 | (concat "\\1" (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) | |
24487 | "\\4" (nth 3 (assoc (match-string 3 string) org-emphasis-alist)) | |
24488 | "\\5") t nil string)) | |
24489 | (setq s (1+ s)))) | |
24490 | string)) | |
891f4676 | 24491 | |
c4b5acde CD |
24492 | (defvar org-par-open nil) |
24493 | (defun org-open-par () | |
24494 | "Insert <p>, but first close previous paragraph if any." | |
24495 | (org-close-par-maybe) | |
24496 | (insert "\n<p>") | |
24497 | (setq org-par-open t)) | |
24498 | (defun org-close-par-maybe () | |
24499 | "Close paragraph if there is one open." | |
24500 | (when org-par-open | |
24501 | (insert "</p>") | |
24502 | (setq org-par-open nil))) | |
24503 | (defun org-close-li () | |
24504 | "Close <li> if necessary." | |
24505 | (org-close-par-maybe) | |
d3f4dbe8 | 24506 | (insert "</li>\n")) |
2a94e282 | 24507 | |
b38c6895 | 24508 | (defvar body-only) ; dynamically scoped into this. |
d3f4dbe8 CD |
24509 | (defun org-html-level-start (level title umax with-toc head-count) |
24510 | "Insert a new level in HTML export. | |
24511 | When TITLE is nil, just close all open levels." | |
24512 | (org-close-par-maybe) | |
03f3cf35 JW |
24513 | (let ((l org-level-max)) |
24514 | (while (>= l (1+ level)) | |
d3f4dbe8 CD |
24515 | (if (aref org-levels-open (1- l)) |
24516 | (progn | |
03f3cf35 | 24517 | (org-html-level-close l umax) |
d3f4dbe8 | 24518 | (aset org-levels-open (1- l) nil))) |
03f3cf35 | 24519 | (setq l (1- l))) |
d3f4dbe8 CD |
24520 | (when title |
24521 | ;; If title is nil, this means this function is called to close | |
24522 | ;; all levels, so the rest is done only if title is given | |
5152b597 | 24523 | (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) |
d3f4dbe8 CD |
24524 | (setq title (replace-match |
24525 | (if org-export-with-tags | |
24526 | (save-match-data | |
24527 | (concat | |
24528 | " <span class=\"tag\">" | |
24529 | (mapconcat 'identity (org-split-string | |
24530 | (match-string 1 title) ":") | |
24531 | " ") | |
24532 | "</span>")) | |
24533 | "") | |
24534 | t t title))) | |
24535 | (if (> level umax) | |
24536 | (progn | |
24537 | (if (aref org-levels-open (1- level)) | |
24538 | (progn | |
24539 | (org-close-li) | |
24540 | (insert "<li>" title "<br/>\n")) | |
24541 | (aset org-levels-open (1- level) t) | |
24542 | (org-close-par-maybe) | |
24543 | (insert "<ul>\n<li>" title "<br/>\n"))) | |
03f3cf35 | 24544 | (aset org-levels-open (1- level) t) |
b38c6895 | 24545 | (if (and org-export-with-section-numbers (not body-only)) |
d3f4dbe8 CD |
24546 | (setq title (concat (org-section-number level) " " title))) |
24547 | (setq level (+ level org-export-html-toplevel-hlevel -1)) | |
24548 | (if with-toc | |
03f3cf35 JW |
24549 | (insert (format "\n<div class=\"outline-%d\">\n<h%d id=\"sec-%d\">%s</h%d>\n" |
24550 | level level head-count title level)) | |
24551 | (insert (format "\n<div class=\"outline-%d\">\n<h%d>%s</h%d>\n" level level title level))) | |
d3f4dbe8 | 24552 | (org-open-par))))) |
2a94e282 | 24553 | |
03f3cf35 | 24554 | (defun org-html-level-close (level max-outline-level) |
d3f4dbe8 | 24555 | "Terminate one level in HTML export." |
03f3cf35 JW |
24556 | (if (<= level max-outline-level) |
24557 | (insert "</div>\n") | |
24558 | (org-close-li) | |
24559 | (insert "</ul>\n"))) | |
2a94e282 | 24560 | |
d3f4dbe8 | 24561 | ;;; iCalendar export |
2a94e282 | 24562 | |
d3f4dbe8 CD |
24563 | ;;;###autoload |
24564 | (defun org-export-icalendar-this-file () | |
24565 | "Export current file as an iCalendar file. | |
24566 | The iCalendar file will be located in the same directory as the Org-mode | |
24567 | file, but with extension `.ics'." | |
24568 | (interactive) | |
24569 | (org-export-icalendar nil buffer-file-name)) | |
2a94e282 | 24570 | |
46177585 CD |
24571 | ;;;###autoload |
24572 | (defun org-export-icalendar-all-agenda-files () | |
24573 | "Export all files in `org-agenda-files' to iCalendar .ics files. | |
24574 | Each iCalendar file will be located in the same directory as the Org-mode | |
24575 | file, but with extension `.ics'." | |
24576 | (interactive) | |
ab27a4a0 | 24577 | (apply 'org-export-icalendar nil (org-agenda-files t))) |
46177585 CD |
24578 | |
24579 | ;;;###autoload | |
24580 | (defun org-export-icalendar-combine-agenda-files () | |
24581 | "Export all files in `org-agenda-files' to a single combined iCalendar file. | |
24582 | The file is stored under the name `org-combined-agenda-icalendar-file'." | |
24583 | (interactive) | |
ab27a4a0 | 24584 | (apply 'org-export-icalendar t (org-agenda-files t))) |
46177585 CD |
24585 | |
24586 | (defun org-export-icalendar (combine &rest files) | |
24587 | "Create iCalendar files for all elements of FILES. | |
24588 | If COMBINE is non-nil, combine all calendar entries into a single large | |
24589 | file and store it under the name `org-combined-agenda-icalendar-file'." | |
24590 | (save-excursion | |
a3fbe8c4 | 24591 | (org-prepare-agenda-buffers files) |
edd21304 | 24592 | (let* ((dir (org-export-directory |
4b3a9ba7 CD |
24593 | :ical (list :publishing-directory |
24594 | org-export-publishing-directory))) | |
24595 | file ical-file ical-buffer category started org-agenda-new-buffers) | |
edd21304 | 24596 | |
a3fbe8c4 | 24597 | (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) |
46177585 | 24598 | (when combine |
4b3a9ba7 CD |
24599 | (setq ical-file |
24600 | (if (file-name-absolute-p org-combined-agenda-icalendar-file) | |
24601 | org-combined-agenda-icalendar-file | |
24602 | (expand-file-name org-combined-agenda-icalendar-file dir)) | |
46177585 CD |
24603 | ical-buffer (org-get-agenda-file-buffer ical-file)) |
24604 | (set-buffer ical-buffer) (erase-buffer)) | |
24605 | (while (setq file (pop files)) | |
24606 | (catch 'nextfile | |
24607 | (org-check-agenda-file file) | |
4b3a9ba7 | 24608 | (set-buffer (org-get-agenda-file-buffer file)) |
46177585 | 24609 | (unless combine |
4b3a9ba7 | 24610 | (setq ical-file (concat (file-name-as-directory dir) |
edd21304 | 24611 | (file-name-sans-extension |
4b3a9ba7 CD |
24612 | (file-name-nondirectory buffer-file-name)) |
24613 | ".ics")) | |
46177585 | 24614 | (setq ical-buffer (org-get-agenda-file-buffer ical-file)) |
4b3a9ba7 | 24615 | (with-current-buffer ical-buffer (erase-buffer))) |
46177585 CD |
24616 | (setq category (or org-category |
24617 | (file-name-sans-extension | |
7204b00e | 24618 | (file-name-nondirectory buffer-file-name)))) |
46177585 CD |
24619 | (if (symbolp category) (setq category (symbol-name category))) |
24620 | (let ((standard-output ical-buffer)) | |
24621 | (if combine | |
24622 | (and (not started) (setq started t) | |
e0e66b8e | 24623 | (org-start-icalendar-file org-icalendar-combined-name)) |
46177585 | 24624 | (org-start-icalendar-file category)) |
d3f4dbe8 | 24625 | (org-print-icalendar-entries combine) |
46177585 CD |
24626 | (when (or (and combine (not files)) (not combine)) |
24627 | (org-finish-icalendar-file) | |
24628 | (set-buffer ical-buffer) | |
24629 | (save-buffer) | |
24630 | (run-hooks 'org-after-save-iCalendar-file-hook))))) | |
24631 | (org-release-buffers org-agenda-new-buffers)))) | |
24632 | ||
24633 | (defvar org-after-save-iCalendar-file-hook nil | |
24634 | "Hook run after an iCalendar file has been saved. | |
24635 | The iCalendar buffer is still current when this hook is run. | |
24636 | A good way to use this is to tell a desktop calenndar application to re-read | |
24637 | the iCalendar file.") | |
24638 | ||
d3f4dbe8 | 24639 | (defun org-print-icalendar-entries (&optional combine) |
46177585 CD |
24640 | "Print iCalendar entries for the current Org-mode file to `standard-output'. |
24641 | When COMBINE is non nil, add the category to each line." | |
a3fbe8c4 CD |
24642 | (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) |
24643 | (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) | |
46177585 CD |
24644 | (dts (org-ical-ts-to-string |
24645 | (format-time-string (cdr org-time-stamp-formats) (current-time)) | |
24646 | "DTSTART")) | |
a3fbe8c4 | 24647 | hd ts ts2 state status (inc t) pos b sexp rrule |
15841868 | 24648 | scheduledp deadlinep tmp pri category entry location summary desc |
a3fbe8c4 | 24649 | (sexp-buffer (get-buffer-create "*ical-tmp*"))) |
15841868 | 24650 | (org-refresh-category-properties) |
46177585 CD |
24651 | (save-excursion |
24652 | (goto-char (point-min)) | |
a3fbe8c4 CD |
24653 | (while (re-search-forward re1 nil t) |
24654 | (catch :skip | |
24655 | (org-agenda-skip) | |
24656 | (setq pos (match-beginning 0) | |
24657 | ts (match-string 0) | |
24658 | inc t | |
24659 | hd (org-get-heading) | |
15841868 JW |
24660 | summary (org-entry-get nil "SUMMARY") |
24661 | desc (or (org-entry-get nil "DESCRIPTION") | |
24662 | (org-get-cleaned-entry org-icalendar-include-body)) | |
24663 | location (org-entry-get nil "LOCATION") | |
a3fbe8c4 CD |
24664 | category (org-get-category)) |
24665 | (if (looking-at re2) | |
24666 | (progn | |
24667 | (goto-char (match-end 0)) | |
24668 | (setq ts2 (match-string 1) inc nil)) | |
38f8646b | 24669 | (setq tmp (buffer-substring (max (point-min) |
46177585 | 24670 | (- pos org-ds-keyword-length)) |
a3fbe8c4 | 24671 | pos) |
38f8646b CD |
24672 | ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) |
24673 | (progn | |
24674 | (setq inc nil) | |
24675 | (replace-match "\\1" t nil ts)) | |
24676 | ts) | |
a3fbe8c4 CD |
24677 | deadlinep (string-match org-deadline-regexp tmp) |
24678 | scheduledp (string-match org-scheduled-regexp tmp) | |
24679 | ;; donep (org-entry-is-done-p) | |
24680 | )) | |
24681 | (if (or (string-match org-tr-regexp hd) | |
24682 | (string-match org-ts-regexp hd)) | |
24683 | (setq hd (replace-match "" t t hd))) | |
24684 | (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) | |
24685 | (setq rrule | |
24686 | (concat "\nRRULE:FREQ=" | |
24687 | (cdr (assoc | |
24688 | (match-string 2 ts) | |
24689 | '(("d" . "DAILY")("w" . "WEEKLY") | |
24690 | ("m" . "MONTHLY")("y" . "YEARLY")))) | |
24691 | ";INTERVAL=" (match-string 1 ts))) | |
24692 | (setq rrule "")) | |
15841868 JW |
24693 | (setq summary (or summary hd)) |
24694 | (if (string-match org-bracket-link-regexp summary) | |
24695 | (setq summary | |
24696 | (replace-match (if (match-end 3) | |
24697 | (match-string 3 summary) | |
24698 | (match-string 1 summary)) | |
24699 | t t summary))) | |
24700 | (if deadlinep (setq summary (concat "DL: " summary))) | |
24701 | (if scheduledp (setq summary (concat "S: " summary))) | |
a3fbe8c4 CD |
24702 | (if (string-match "\\`<%%" ts) |
24703 | (with-current-buffer sexp-buffer | |
15841868 | 24704 | (insert (substring ts 1 -1) " " summary "\n")) |
a3fbe8c4 | 24705 | (princ (format "BEGIN:VEVENT |
46177585 | 24706 | %s |
a3fbe8c4 | 24707 | %s%s |
15841868 | 24708 | SUMMARY:%s%s%s |
d3f4dbe8 | 24709 | CATEGORIES:%s |
46177585 | 24710 | END:VEVENT\n" |
a3fbe8c4 CD |
24711 | (org-ical-ts-to-string ts "DTSTART") |
24712 | (org-ical-ts-to-string ts2 "DTEND" inc) | |
15841868 JW |
24713 | rrule summary |
24714 | (if (and desc (string-match "\\S-" desc)) | |
24715 | (concat "\nDESCRIPTION: " desc) "") | |
24716 | (if (and location (string-match "\\S-" location)) | |
24717 | (concat "\nLOCATION: " location) "") | |
24718 | category))))) | |
a3fbe8c4 CD |
24719 | |
24720 | (when (and org-icalendar-include-sexps | |
24721 | (condition-case nil (require 'icalendar) (error nil)) | |
24722 | (fboundp 'icalendar-export-region)) | |
24723 | ;; Get all the literal sexps | |
24724 | (goto-char (point-min)) | |
24725 | (while (re-search-forward "^&?%%(" nil t) | |
24726 | (catch :skip | |
24727 | (org-agenda-skip) | |
24728 | (setq b (match-beginning 0)) | |
24729 | (goto-char (1- (match-end 0))) | |
24730 | (forward-sexp 1) | |
24731 | (end-of-line 1) | |
24732 | (setq sexp (buffer-substring b (point))) | |
24733 | (with-current-buffer sexp-buffer | |
24734 | (insert sexp "\n")) | |
24735 | (princ (org-diary-to-ical-string sexp-buffer))))) | |
24736 | ||
46177585 CD |
24737 | (when org-icalendar-include-todo |
24738 | (goto-char (point-min)) | |
24739 | (while (re-search-forward org-todo-line-regexp nil t) | |
a3fbe8c4 CD |
24740 | (catch :skip |
24741 | (org-agenda-skip) | |
24742 | (setq state (match-string 2)) | |
24743 | (setq status (if (member state org-done-keywords) | |
24744 | "COMPLETED" "NEEDS-ACTION")) | |
24745 | (when (and state | |
24746 | (or (not (member state org-done-keywords)) | |
24747 | (eq org-icalendar-include-todo 'all)) | |
24748 | (not (member org-archive-tag (org-get-tags-at))) | |
24749 | ) | |
15841868 JW |
24750 | (setq hd (match-string 3) |
24751 | summary (org-entry-get nil "SUMMARY") | |
24752 | desc (or (org-entry-get nil "DESCRIPTION") | |
24753 | (org-get-cleaned-entry org-icalendar-include-body)) | |
24754 | location (org-entry-get nil "LOCATION")) | |
a3fbe8c4 CD |
24755 | (if (string-match org-bracket-link-regexp hd) |
24756 | (setq hd (replace-match (if (match-end 3) (match-string 3 hd) | |
24757 | (match-string 1 hd)) | |
24758 | t t hd))) | |
24759 | (if (string-match org-priority-regexp hd) | |
24760 | (setq pri (string-to-char (match-string 2 hd)) | |
24761 | hd (concat (substring hd 0 (match-beginning 1)) | |
24762 | (substring hd (match-end 1)))) | |
24763 | (setq pri org-default-priority)) | |
24764 | (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri)) | |
24765 | (- org-lowest-priority org-highest-priority)))))) | |
24766 | ||
24767 | (princ (format "BEGIN:VTODO | |
46177585 | 24768 | %s |
15841868 | 24769 | SUMMARY:%s%s%s |
d3f4dbe8 | 24770 | CATEGORIES:%s |
46177585 CD |
24771 | SEQUENCE:1 |
24772 | PRIORITY:%d | |
d3f4dbe8 | 24773 | STATUS:%s |
46177585 | 24774 | END:VTODO\n" |
15841868 JW |
24775 | dts |
24776 | (or summary hd) | |
24777 | (if (and location (string-match "\\S-" location)) | |
24778 | (concat "\nLOCATION: " location) "") | |
24779 | (if (and desc (string-match "\\S-" desc)) | |
24780 | (concat "\nDESCRIPTION: " desc) "") | |
24781 | category pri status))))))))) | |
24782 | ||
24783 | (defun org-get-cleaned-entry (what) | |
24784 | "Clean-up description string." | |
24785 | (when what | |
24786 | (save-excursion | |
24787 | (org-back-to-heading t) | |
24788 | (let ((s (buffer-substring (point-at-bol 2) (org-end-of-subtree t))) | |
24789 | (re (concat org-drawer-regexp "[^\000]*?:END:.*\n?")) | |
24790 | (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) | |
24791 | (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))) | |
24793 | (if (string-match "[ \t\r\n]+\\'" s) (setq s (replace-match "" t t s))) | |
24794 | (while (string-match "[ \t]*\n[ \t]*" s) | |
24795 | (setq s (replace-match "\\n" t t s))) | |
24796 | (setq s (org-trim s)) | |
24797 | (if (and (numberp what) | |
24798 | (> (length s) what)) | |
24799 | (substring s 0 what) | |
24800 | s))))) | |
46177585 CD |
24801 | |
24802 | (defun org-start-icalendar-file (name) | |
24803 | "Start an iCalendar file by inserting the header." | |
24804 | (let ((user user-full-name) | |
46177585 | 24805 | (name (or name "unknown")) |
4da1a99d | 24806 | (timezone (cadr (current-time-zone)))) |
46177585 CD |
24807 | (princ |
24808 | (format "BEGIN:VCALENDAR | |
24809 | VERSION:2.0 | |
24810 | X-WR-CALNAME:%s | |
24811 | PRODID:-//%s//Emacs with Org-mode//EN | |
f425a6ea | 24812 | X-WR-TIMEZONE:%s |
46177585 CD |
24813 | CALSCALE:GREGORIAN\n" name user timezone)))) |
24814 | ||
24815 | (defun org-finish-icalendar-file () | |
24816 | "Finish an iCalendar file by inserting the END statement." | |
24817 | (princ "END:VCALENDAR\n")) | |
24818 | ||
24819 | (defun org-ical-ts-to-string (s keyword &optional inc) | |
24820 | "Take a time string S and convert it to iCalendar format. | |
24821 | KEYWORD is added in front, to make a complete line like DTSTART.... | |
24822 | When INC is non-nil, increase the hour by two (if time string contains | |
24823 | a time), or the day by one (if it does not contain a time)." | |
24824 | (let ((t1 (org-parse-time-string s 'nodefault)) | |
24825 | t2 fmt have-time time) | |
24826 | (if (and (car t1) (nth 1 t1) (nth 2 t1)) | |
24827 | (setq t2 t1 have-time t) | |
24828 | (setq t2 (org-parse-time-string s))) | |
24829 | (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) | |
24830 | (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) | |
24831 | (when inc | |
48aaad2d CD |
24832 | (if have-time |
24833 | (if org-agenda-default-appointment-duration | |
24834 | (setq mi (+ org-agenda-default-appointment-duration mi)) | |
24835 | (setq h (+ 2 h))) | |
24836 | (setq d (1+ d)))) | |
46177585 CD |
24837 | (setq time (encode-time s mi h d m y))) |
24838 | (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) | |
24839 | (concat keyword (format-time-string fmt time)))) | |
24840 | ||
d3f4dbe8 | 24841 | ;;; XOXO export |
e39856be | 24842 | |
d3f4dbe8 CD |
24843 | (defun org-export-as-xoxo-insert-into (buffer &rest output) |
24844 | (with-current-buffer buffer | |
24845 | (apply 'insert output))) | |
24846 | (put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) | |
6769c0dc | 24847 | |
d3f4dbe8 CD |
24848 | (defun org-export-as-xoxo (&optional buffer) |
24849 | "Export the org buffer as XOXO. | |
24850 | The XOXO buffer is named *xoxo-<source buffer name>*" | |
24851 | (interactive (list (current-buffer))) | |
24852 | ;; A quickie abstraction | |
6769c0dc | 24853 | |
d3f4dbe8 CD |
24854 | ;; Output everything as XOXO |
24855 | (with-current-buffer (get-buffer buffer) | |
24856 | (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. | |
24857 | (let* ((opt-plist (org-combine-plists (org-default-export-plist) | |
24858 | (org-infile-export-plist))) | |
24859 | (filename (concat (file-name-as-directory | |
24860 | (org-export-directory :xoxo opt-plist)) | |
24861 | (file-name-sans-extension | |
24862 | (file-name-nondirectory buffer-file-name)) | |
24863 | ".html")) | |
24864 | (out (find-file-noselect filename)) | |
24865 | (last-level 1) | |
24866 | (hanging-li nil)) | |
24867 | ;; Check the output buffer is empty. | |
24868 | (with-current-buffer out (erase-buffer)) | |
24869 | ;; Kick off the output | |
24870 | (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") | |
7d58338e | 24871 | (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) |
d3f4dbe8 CD |
24872 | (let* ((hd (match-string-no-properties 1)) |
24873 | (level (length hd)) | |
24874 | (text (concat | |
24875 | (match-string-no-properties 2) | |
24876 | (save-excursion | |
24877 | (goto-char (match-end 0)) | |
24878 | (let ((str "")) | |
24879 | (catch 'loop | |
24880 | (while 't | |
24881 | (forward-line) | |
24882 | (if (looking-at "^[ \t]\\(.*\\)") | |
24883 | (setq str (concat str (match-string-no-properties 1))) | |
24884 | (throw 'loop str))))))))) | |
6769c0dc | 24885 | |
d3f4dbe8 CD |
24886 | ;; Handle level rendering |
24887 | (cond | |
24888 | ((> level last-level) | |
24889 | (org-export-as-xoxo-insert-into out "\n<ol>\n")) | |
6769c0dc | 24890 | |
d3f4dbe8 CD |
24891 | ((< level last-level) |
24892 | (dotimes (- (- last-level level) 1) | |
24893 | (if hanging-li | |
24894 | (org-export-as-xoxo-insert-into out "</li>\n")) | |
24895 | (org-export-as-xoxo-insert-into out "</ol>\n")) | |
24896 | (when hanging-li | |
24897 | (org-export-as-xoxo-insert-into out "</li>\n") | |
24898 | (setq hanging-li nil))) | |
6769c0dc | 24899 | |
d3f4dbe8 CD |
24900 | ((equal level last-level) |
24901 | (if hanging-li | |
24902 | (org-export-as-xoxo-insert-into out "</li>\n"))) | |
24903 | ) | |
6769c0dc | 24904 | |
d3f4dbe8 | 24905 | (setq last-level level) |
6769c0dc | 24906 | |
d3f4dbe8 CD |
24907 | ;; And output the new li |
24908 | (setq hanging-li 't) | |
24909 | (if (equal ?+ (elt text 0)) | |
24910 | (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>") | |
24911 | (org-export-as-xoxo-insert-into out "<li>" text)))) | |
e39856be | 24912 | |
d3f4dbe8 CD |
24913 | ;; Finally finish off the ol |
24914 | (dotimes (- last-level 1) | |
24915 | (if hanging-li | |
24916 | (org-export-as-xoxo-insert-into out "</li>\n")) | |
24917 | (org-export-as-xoxo-insert-into out "</ol>\n")) | |
c44f0d75 | 24918 | |
d3f4dbe8 CD |
24919 | ;; Finish the buffer off and clean it up. |
24920 | (switch-to-buffer-other-window out) | |
24921 | (indent-region (point-min) (point-max) nil) | |
24922 | (save-buffer) | |
24923 | (goto-char (point-min)) | |
24924 | ))) | |
6769c0dc | 24925 | |
46177585 | 24926 | |
d3f4dbe8 | 24927 | ;;;; Key bindings |
891f4676 | 24928 | |
1d676e9f | 24929 | ;; Make `C-c C-x' a prefix key |
a3fbe8c4 | 24930 | (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) |
1d676e9f | 24931 | |
28e5b051 | 24932 | ;; TAB key with modifiers |
a3fbe8c4 CD |
24933 | (org-defkey org-mode-map "\C-i" 'org-cycle) |
24934 | (org-defkey org-mode-map [(tab)] 'org-cycle) | |
24935 | (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) | |
24936 | (org-defkey org-mode-map [(meta tab)] 'org-complete) | |
24937 | (org-defkey org-mode-map "\M-\t" 'org-complete) | |
24938 | (org-defkey org-mode-map "\M-\C-i" 'org-complete) | |
28e5b051 | 24939 | ;; The following line is necessary under Suse GNU/Linux |
ab27a4a0 | 24940 | (unless (featurep 'xemacs) |
a3fbe8c4 CD |
24941 | (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) |
24942 | (org-defkey org-mode-map [(shift tab)] 'org-shifttab) | |
03f3cf35 | 24943 | (define-key org-mode-map [backtab] 'org-shifttab) |
28e5b051 | 24944 | |
a3fbe8c4 CD |
24945 | (org-defkey org-mode-map [(shift return)] 'org-table-copy-down) |
24946 | (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) | |
24947 | (org-defkey org-mode-map [(meta return)] 'org-meta-return) | |
28e5b051 CD |
24948 | |
24949 | ;; Cursor keys with modifiers | |
a3fbe8c4 CD |
24950 | (org-defkey org-mode-map [(meta left)] 'org-metaleft) |
24951 | (org-defkey org-mode-map [(meta right)] 'org-metaright) | |
24952 | (org-defkey org-mode-map [(meta up)] 'org-metaup) | |
24953 | (org-defkey org-mode-map [(meta down)] 'org-metadown) | |
24954 | ||
24955 | (org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) | |
24956 | (org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) | |
24957 | (org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) | |
24958 | (org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown) | |
3278a016 | 24959 | |
a3fbe8c4 CD |
24960 | (org-defkey org-mode-map [(shift up)] 'org-shiftup) |
24961 | (org-defkey org-mode-map [(shift down)] 'org-shiftdown) | |
24962 | (org-defkey org-mode-map [(shift left)] 'org-shiftleft) | |
24963 | (org-defkey org-mode-map [(shift right)] 'org-shiftright) | |
3278a016 | 24964 | |
a3fbe8c4 CD |
24965 | (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) |
24966 | (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) | |
28e5b051 | 24967 | |
d3f4dbe8 CD |
24968 | ;;; Extra keys for tty access. |
24969 | ;; We only set them when really needed because otherwise the | |
24970 | ;; menus don't show the simple keys | |
3278a016 CD |
24971 | |
24972 | (when (or (featurep 'xemacs) ;; because XEmacs supports multi-device stuff | |
24973 | (not window-system)) | |
a3fbe8c4 CD |
24974 | (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) |
24975 | (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) | |
24976 | (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) | |
24977 | (org-defkey org-mode-map [?\e (return)] 'org-meta-return) | |
24978 | (org-defkey org-mode-map [?\e (left)] 'org-metaleft) | |
24979 | (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft) | |
24980 | (org-defkey org-mode-map [?\e (right)] 'org-metaright) | |
24981 | (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright) | |
24982 | (org-defkey org-mode-map [?\e (up)] 'org-metaup) | |
24983 | (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup) | |
24984 | (org-defkey org-mode-map [?\e (down)] 'org-metadown) | |
24985 | (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown) | |
24986 | (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) | |
24987 | (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright) | |
24988 | (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup) | |
24989 | (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown) | |
24990 | (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup) | |
24991 | (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown) | |
24992 | (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) | |
24993 | (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) | |
24994 | (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) | |
24995 | (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)) | |
d3f4dbe8 | 24996 | |
3278a016 | 24997 | ;; All the other keys |
bea5b1ba | 24998 | |
a3fbe8c4 CD |
24999 | (org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. |
25000 | (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) | |
25001 | (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree) | |
25002 | (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) | |
25003 | (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) | |
25004 | (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) | |
25005 | (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) | |
25006 | (org-defkey org-mode-map "\C-c\C-j" 'org-goto) | |
25007 | (org-defkey org-mode-map "\C-c\C-t" 'org-todo) | |
25008 | (org-defkey org-mode-map "\C-c\C-s" 'org-schedule) | |
25009 | (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) | |
25010 | (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) | |
25011 | (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) | |
03f3cf35 | 25013 | (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved |
a3fbe8c4 CD |
25014 | (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) | |
25016 | (org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) | |
15841868 | 25017 | (org-defkey org-mode-map [(control return)] 'org-insert-heading-after-current) |
a3fbe8c4 CD |
25018 | (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) |
25019 | (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) | |
25020 | (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) | |
25021 | (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) | |
25022 | (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) | |
25023 | (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) | |
25024 | (org-defkey org-mode-map "\C-c\C-z" 'org-time-stamp) ; Alternative binding | |
25025 | (org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved | |
25026 | (org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. | |
25027 | (org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved | |
25028 | (org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range) | |
25029 | (org-defkey org-mode-map "\C-c>" 'org-goto-calendar) | |
25030 | (org-defkey org-mode-map "\C-c<" 'org-date-from-calendar) | |
25031 | (org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files) | |
25032 | (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) | |
25033 | (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) | |
25034 | (org-defkey org-mode-map "\C-c]" 'org-remove-file) | |
38f8646b | 25035 | (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) |
a3fbe8c4 CD |
25036 | (org-defkey org-mode-map "\C-c^" 'org-sort) |
25037 | (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | |
03f3cf35 | 25038 | (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) |
a3fbe8c4 CD |
25039 | (org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) |
25040 | (org-defkey org-mode-map "\C-m" 'org-return) | |
25041 | (org-defkey org-mode-map "\C-c?" 'org-table-field-info) | |
25042 | (org-defkey org-mode-map "\C-c " 'org-table-blank-field) | |
25043 | (org-defkey org-mode-map "\C-c+" 'org-table-sum) | |
25044 | (org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) | |
25045 | (org-defkey org-mode-map "\C-c'" 'org-table-edit-formulas) | |
25046 | (org-defkey org-mode-map "\C-c`" 'org-table-edit-field) | |
25047 | (org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) | |
25048 | (org-defkey org-mode-map "\C-c*" 'org-table-recalculate) | |
25049 | (org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) | |
25050 | (org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) | |
25051 | (org-defkey org-mode-map "\C-c\C-q" 'org-table-wrap-region) | |
25052 | (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) | |
25053 | (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) | |
25054 | (org-defkey org-mode-map "\C-c\C-e" 'org-export) | |
25055 | (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) | |
25056 | (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) | |
25057 | ||
25058 | (org-defkey org-mode-map "\C-c\C-x\C-k" 'org-cut-special) | |
25059 | (org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) | |
25060 | (org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special) | |
25061 | (org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special) | |
25062 | ||
25063 | (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) | |
25064 | (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) | |
25065 | (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) | |
15841868 | 25066 | (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) |
a3fbe8c4 CD |
25067 | (org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) |
25068 | (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) | |
25069 | (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) | |
25070 | (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) | |
25071 | (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) | |
25072 | (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) | |
03f3cf35 JW |
25073 | (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) |
25074 | (org-defkey org-mode-map "\C-c\C-xr" 'org-insert-columns-dblock) | |
edd21304 | 25075 | |
38f8646b CD |
25076 | (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) |
25077 | ||
edd21304 | 25078 | (when (featurep 'xemacs) |
a3fbe8c4 | 25079 | (org-defkey org-mode-map 'button3 'popup-mode-menu)) |
4b3a9ba7 | 25080 | |
9acdaa21 | 25081 | (defsubst org-table-p () (org-at-table-p)) |
791d856f CD |
25082 | |
25083 | (defun org-self-insert-command (N) | |
25084 | "Like `self-insert-command', use overwrite-mode for whitespace in tables. | |
25085 | If the cursor is in a table looking at whitespace, the whitespace is | |
25086 | overwritten, and the table is not marked as requiring realignment." | |
25087 | (interactive "p") | |
25088 | (if (and (org-table-p) | |
ab27a4a0 CD |
25089 | (progn |
25090 | ;; check if we blank the field, and if that triggers align | |
25091 | (and org-table-auto-blank-field | |
25092 | (member last-command | |
25093 | '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) | |
25094 | (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) | |
25095 | ;; got extra space, this field does not determine column width | |
25096 | (let (org-table-may-need-update) (org-table-blank-field)) | |
25097 | ;; no extra space, this field may determine column width | |
25098 | (org-table-blank-field))) | |
25099 | t) | |
c8d16429 | 25100 | (eq N 1) |
ab27a4a0 | 25101 | (looking-at "[^|\n]* |")) |
634a7d0b | 25102 | (let (org-table-may-need-update) |
c8d16429 CD |
25103 | (goto-char (1- (match-end 0))) |
25104 | (delete-backward-char 1) | |
25105 | (goto-char (match-beginning 0)) | |
25106 | (self-insert-command N)) | |
791d856f | 25107 | (setq org-table-may-need-update t) |
1e8fbb6d CD |
25108 | (self-insert-command N) |
25109 | (org-fix-tags-on-the-fly))) | |
25110 | ||
25111 | (defun org-fix-tags-on-the-fly () | |
25112 | (when (and (equal (char-after (point-at-bol)) ?*) | |
25113 | (org-on-heading-p)) | |
25114 | (org-align-tags-here org-tags-column))) | |
791d856f | 25115 | |
791d856f CD |
25116 | (defun org-delete-backward-char (N) |
25117 | "Like `delete-backward-char', insert whitespace at field end in tables. | |
25118 | When deleting backwards, in tables this function will insert whitespace in | |
25119 | front of the next \"|\" separator, to keep the table aligned. The table will | |
ab27a4a0 CD |
25120 | still be marked for re-alignment if the field did fill the entire column, |
25121 | because, in this case the deletion might narrow the column." | |
791d856f CD |
25122 | (interactive "p") |
25123 | (if (and (org-table-p) | |
c8d16429 CD |
25124 | (eq N 1) |
25125 | (string-match "|" (buffer-substring (point-at-bol) (point))) | |
25126 | (looking-at ".*?|")) | |
edd21304 | 25127 | (let ((pos (point)) |
ab27a4a0 CD |
25128 | (noalign (looking-at "[^|\n\r]* |")) |
25129 | (c org-table-may-need-update)) | |
c8d16429 CD |
25130 | (backward-delete-char N) |
25131 | (skip-chars-forward "^|") | |
25132 | (insert " ") | |
ab27a4a0 CD |
25133 | (goto-char (1- pos)) |
25134 | ;; noalign: if there were two spaces at the end, this field | |
25135 | ;; does not determine the width of the column. | |
25136 | (if noalign (setq org-table-may-need-update c))) | |
1e8fbb6d CD |
25137 | (backward-delete-char N) |
25138 | (org-fix-tags-on-the-fly))) | |
791d856f CD |
25139 | |
25140 | (defun org-delete-char (N) | |
25141 | "Like `delete-char', but insert whitespace at field end in tables. | |
25142 | When deleting characters, in tables this function will insert whitespace in | |
ab27a4a0 CD |
25143 | front of the next \"|\" separator, to keep the table aligned. The table will |
25144 | still be marked for re-alignment if the field did fill the entire column, | |
25145 | because, in this case the deletion might narrow the column." | |
791d856f CD |
25146 | (interactive "p") |
25147 | (if (and (org-table-p) | |
c8d16429 CD |
25148 | (not (bolp)) |
25149 | (not (= (char-after) ?|)) | |
25150 | (eq N 1)) | |
791d856f | 25151 | (if (looking-at ".*?|") |
ab27a4a0 CD |
25152 | (let ((pos (point)) |
25153 | (noalign (looking-at "[^|\n\r]* |")) | |
25154 | (c org-table-may-need-update)) | |
c8d16429 CD |
25155 | (replace-match (concat |
25156 | (substring (match-string 0) 1 -1) | |
25157 | " |")) | |
ab27a4a0 CD |
25158 | (goto-char pos) |
25159 | ;; noalign: if there were two spaces at the end, this field | |
25160 | ;; does not determine the width of the column. | |
4b3a9ba7 CD |
25161 | (if noalign (setq org-table-may-need-update c))) |
25162 | (delete-char N)) | |
1e8fbb6d CD |
25163 | (delete-char N) |
25164 | (org-fix-tags-on-the-fly))) | |
791d856f | 25165 | |
3278a016 CD |
25166 | ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode |
25167 | (put 'org-self-insert-command 'delete-selection t) | |
25168 | (put 'orgtbl-self-insert-command 'delete-selection t) | |
25169 | (put 'org-delete-char 'delete-selection 'supersede) | |
25170 | (put 'org-delete-backward-char 'delete-selection 'supersede) | |
25171 | ||
7373bc42 CD |
25172 | ;; Make `flyspell-mode' delay after some commands |
25173 | (put 'org-self-insert-command 'flyspell-delayed t) | |
25174 | (put 'orgtbl-self-insert-command 'flyspell-delayed t) | |
25175 | (put 'org-delete-char 'flyspell-delayed t) | |
25176 | (put 'org-delete-backward-char 'flyspell-delayed t) | |
25177 | ||
15841868 JW |
25178 | (eval-after-load "pabbrev" |
25179 | '(progn | |
25180 | (add-to-list 'pabbrev-expand-after-command-list | |
25181 | 'orgtbl-self-insert-command t) | |
25182 | (add-to-list 'pabbrev-expand-after-command-list | |
25183 | 'org-self-insert-command t))) | |
25184 | ||
791d856f CD |
25185 | ;; How to do this: Measure non-white length of current string |
25186 | ;; If equal to column width, we should realign. | |
25187 | ||
28e5b051 CD |
25188 | (defun org-remap (map &rest commands) |
25189 | "In MAP, remap the functions given in COMMANDS. | |
25190 | COMMANDS is a list of alternating OLDDEF NEWDEF command names." | |
25191 | (let (new old) | |
25192 | (while commands | |
25193 | (setq old (pop commands) new (pop commands)) | |
25194 | (if (fboundp 'command-remapping) | |
a3fbe8c4 | 25195 | (org-defkey map (vector 'remap old) new) |
28e5b051 | 25196 | (substitute-key-definition old new map global-map))))) |
e0e66b8e | 25197 | |
791d856f CD |
25198 | (when (eq org-enable-table-editor 'optimized) |
25199 | ;; If the user wants maximum table support, we need to hijack | |
25200 | ;; some standard editing functions | |
28e5b051 CD |
25201 | (org-remap org-mode-map |
25202 | 'self-insert-command 'org-self-insert-command | |
25203 | 'delete-char 'org-delete-char | |
25204 | 'delete-backward-char 'org-delete-backward-char) | |
a3fbe8c4 | 25205 | (org-defkey org-mode-map "|" 'org-force-self-insert)) |
791d856f | 25206 | |
891f4676 RS |
25207 | (defun org-shiftcursor-error () |
25208 | "Throw an error because Shift-Cursor command was applied in wrong context." | |
f425a6ea | 25209 | (error "This command is active in special context like tables, headlines or timestamps")) |
891f4676 | 25210 | |
edd21304 | 25211 | (defun org-shifttab (&optional arg) |
28e5b051 | 25212 | "Global visibility cycling or move to previous table field. |
4b3a9ba7 CD |
25213 | Calls `org-cycle' with argument t, or `org-table-previous-field', depending |
25214 | on context. | |
28e5b051 | 25215 | See the individual commands for more information." |
edd21304 | 25216 | (interactive "P") |
891f4676 | 25217 | (cond |
4b3a9ba7 | 25218 | ((org-at-table-p) (call-interactively 'org-table-previous-field)) |
d3f4dbe8 CD |
25219 | (arg (message "Content view to level: ") |
25220 | (org-content (prefix-numeric-value arg)) | |
25221 | (setq org-cycle-global-status 'overview)) | |
4b3a9ba7 | 25222 | (t (call-interactively 'org-global-cycle)))) |
891f4676 | 25223 | |
634a7d0b | 25224 | (defun org-shiftmetaleft () |
28e5b051 | 25225 | "Promote subtree or delete table column. |
a3fbe8c4 CD |
25226 | Calls `org-promote-subtree', `org-outdent-item', |
25227 | or `org-table-delete-column', depending on context. | |
28e5b051 | 25228 | See the individual commands for more information." |
634a7d0b | 25229 | (interactive) |
891f4676 | 25230 | (cond |
4b3a9ba7 CD |
25231 | ((org-at-table-p) (call-interactively 'org-table-delete-column)) |
25232 | ((org-on-heading-p) (call-interactively 'org-promote-subtree)) | |
7a368970 | 25233 | ((org-at-item-p) (call-interactively 'org-outdent-item)) |
891f4676 | 25234 | (t (org-shiftcursor-error)))) |
634a7d0b CD |
25235 | |
25236 | (defun org-shiftmetaright () | |
28e5b051 | 25237 | "Demote subtree or insert table column. |
a3fbe8c4 CD |
25238 | Calls `org-demote-subtree', `org-indent-item', |
25239 | or `org-table-insert-column', depending on context. | |
28e5b051 | 25240 | See the individual commands for more information." |
634a7d0b | 25241 | (interactive) |
891f4676 | 25242 | (cond |
4b3a9ba7 CD |
25243 | ((org-at-table-p) (call-interactively 'org-table-insert-column)) |
25244 | ((org-on-heading-p) (call-interactively 'org-demote-subtree)) | |
7a368970 | 25245 | ((org-at-item-p) (call-interactively 'org-indent-item)) |
891f4676 | 25246 | (t (org-shiftcursor-error)))) |
634a7d0b | 25247 | |
891f4676 | 25248 | (defun org-shiftmetaup (&optional arg) |
28e5b051 | 25249 | "Move subtree up or kill table row. |
7a368970 CD |
25250 | Calls `org-move-subtree-up' or `org-table-kill-row' or |
25251 | `org-move-item-up' depending on context. See the individual commands | |
25252 | for more information." | |
891f4676 RS |
25253 | (interactive "P") |
25254 | (cond | |
4b3a9ba7 CD |
25255 | ((org-at-table-p) (call-interactively 'org-table-kill-row)) |
25256 | ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) | |
25257 | ((org-at-item-p) (call-interactively 'org-move-item-up)) | |
891f4676 RS |
25258 | (t (org-shiftcursor-error)))) |
25259 | (defun org-shiftmetadown (&optional arg) | |
28e5b051 | 25260 | "Move subtree down or insert table row. |
7a368970 CD |
25261 | Calls `org-move-subtree-down' or `org-table-insert-row' or |
25262 | `org-move-item-down', depending on context. See the individual | |
25263 | commands for more information." | |
891f4676 RS |
25264 | (interactive "P") |
25265 | (cond | |
4b3a9ba7 CD |
25266 | ((org-at-table-p) (call-interactively 'org-table-insert-row)) |
25267 | ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) | |
25268 | ((org-at-item-p) (call-interactively 'org-move-item-down)) | |
891f4676 RS |
25269 | (t (org-shiftcursor-error)))) |
25270 | ||
25271 | (defun org-metaleft (&optional arg) | |
28e5b051 CD |
25272 | "Promote heading or move table column to left. |
25273 | Calls `org-do-promote' or `org-table-move-column', depending on context. | |
7a368970 | 25274 | With no specific context, calls the Emacs default `backward-word'. |
28e5b051 | 25275 | See the individual commands for more information." |
891f4676 RS |
25276 | (interactive "P") |
25277 | (cond | |
4b3a9ba7 CD |
25278 | ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) |
25279 | ((or (org-on-heading-p) (org-region-active-p)) | |
25280 | (call-interactively 'org-do-promote)) | |
761311e3 | 25281 | ((org-at-item-p) (call-interactively 'org-outdent-item)) |
4b3a9ba7 | 25282 | (t (call-interactively 'backward-word)))) |
634a7d0b | 25283 | |
891f4676 | 25284 | (defun org-metaright (&optional arg) |
28e5b051 CD |
25285 | "Demote subtree or move table column to right. |
25286 | Calls `org-do-demote' or `org-table-move-column', depending on context. | |
7a368970 | 25287 | With no specific context, calls the Emacs default `forward-word'. |
28e5b051 | 25288 | See the individual commands for more information." |
891f4676 RS |
25289 | (interactive "P") |
25290 | (cond | |
4b3a9ba7 CD |
25291 | ((org-at-table-p) (call-interactively 'org-table-move-column)) |
25292 | ((or (org-on-heading-p) (org-region-active-p)) | |
25293 | (call-interactively 'org-do-demote)) | |
761311e3 | 25294 | ((org-at-item-p) (call-interactively 'org-indent-item)) |
4b3a9ba7 | 25295 | (t (call-interactively 'forward-word)))) |
634a7d0b | 25296 | |
891f4676 | 25297 | (defun org-metaup (&optional arg) |
28e5b051 | 25298 | "Move subtree up or move table row up. |
7a368970 CD |
25299 | Calls `org-move-subtree-up' or `org-table-move-row' or |
25300 | `org-move-item-up', depending on context. See the individual commands | |
25301 | for more information." | |
891f4676 RS |
25302 | (interactive "P") |
25303 | (cond | |
4b3a9ba7 CD |
25304 | ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) |
25305 | ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) | |
25306 | ((org-at-item-p) (call-interactively 'org-move-item-up)) | |
03f3cf35 | 25307 | (t (transpose-lines 1) (beginning-of-line -1)))) |
634a7d0b | 25308 | |
891f4676 | 25309 | (defun org-metadown (&optional arg) |
28e5b051 | 25310 | "Move subtree down or move table row down. |
7a368970 CD |
25311 | Calls `org-move-subtree-down' or `org-table-move-row' or |
25312 | `org-move-item-down', depending on context. See the individual | |
25313 | commands for more information." | |
891f4676 RS |
25314 | (interactive "P") |
25315 | (cond | |
4b3a9ba7 CD |
25316 | ((org-at-table-p) (call-interactively 'org-table-move-row)) |
25317 | ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) | |
25318 | ((org-at-item-p) (call-interactively 'org-move-item-down)) | |
03f3cf35 | 25319 | (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) |
891f4676 RS |
25320 | |
25321 | (defun org-shiftup (&optional arg) | |
4b3a9ba7 | 25322 | "Increase item in timestamp or increase priority of current headline. |
a3fbe8c4 CD |
25323 | Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', |
25324 | depending on context. See the individual commands for more information." | |
891f4676 RS |
25325 | (interactive "P") |
25326 | (cond | |
0b8568f5 JW |
25327 | ((org-at-timestamp-p t) |
25328 | (call-interactively (if org-edit-timestamp-down-means-later | |
25329 | 'org-timestamp-down 'org-timestamp-up))) | |
4b3a9ba7 CD |
25330 | ((org-on-heading-p) (call-interactively 'org-priority-up)) |
25331 | ((org-at-item-p) (call-interactively 'org-previous-item)) | |
25332 | (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) | |
891f4676 RS |
25333 | |
25334 | (defun org-shiftdown (&optional arg) | |
4b3a9ba7 | 25335 | "Decrease item in timestamp or decrease priority of current headline. |
a3fbe8c4 CD |
25336 | Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' |
25337 | depending on context. See the individual commands for more information." | |
891f4676 RS |
25338 | (interactive "P") |
25339 | (cond | |
0b8568f5 JW |
25340 | ((org-at-timestamp-p t) |
25341 | (call-interactively (if org-edit-timestamp-down-means-later | |
25342 | 'org-timestamp-up 'org-timestamp-down))) | |
4b3a9ba7 CD |
25343 | ((org-on-heading-p) (call-interactively 'org-priority-down)) |
25344 | (t (call-interactively 'org-next-item)))) | |
891f4676 | 25345 | |
f425a6ea CD |
25346 | (defun org-shiftright () |
25347 | "Next TODO keyword or timestamp one day later, depending on context." | |
25348 | (interactive) | |
25349 | (cond | |
8df0de1c | 25350 | ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) |
4b3a9ba7 | 25351 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) |
03f3cf35 | 25352 | ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet nil)) |
7d58338e | 25353 | ((org-at-property-p) (call-interactively 'org-property-next-allowed-value)) |
f425a6ea CD |
25354 | (t (org-shiftcursor-error)))) |
25355 | ||
25356 | (defun org-shiftleft () | |
25357 | "Previous TODO keyword or timestamp one day earlier, depending on context." | |
25358 | (interactive) | |
25359 | (cond | |
8df0de1c | 25360 | ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) |
4b3a9ba7 | 25361 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) |
03f3cf35 | 25362 | ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet 'previous)) |
7d58338e CD |
25363 | ((org-at-property-p) |
25364 | (call-interactively 'org-property-previous-allowed-value)) | |
f425a6ea CD |
25365 | (t (org-shiftcursor-error)))) |
25366 | ||
a3fbe8c4 CD |
25367 | (defun org-shiftcontrolright () |
25368 | "Switch to next TODO set." | |
25369 | (interactive) | |
25370 | (cond | |
25371 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'nextset)) | |
25372 | (t (org-shiftcursor-error)))) | |
25373 | ||
25374 | (defun org-shiftcontrolleft () | |
25375 | "Switch to previous TODO set." | |
25376 | (interactive) | |
25377 | (cond | |
25378 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'previousset)) | |
25379 | (t (org-shiftcursor-error)))) | |
25380 | ||
25381 | (defun org-ctrl-c-ret () | |
25382 | "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." | |
25383 | (interactive) | |
25384 | (cond | |
25385 | ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) | |
25386 | (t (call-interactively 'org-insert-heading)))) | |
25387 | ||
634a7d0b | 25388 | (defun org-copy-special () |
28e5b051 CD |
25389 | "Copy region in table or copy current subtree. |
25390 | Calls `org-table-copy' or `org-copy-subtree', depending on context. | |
25391 | See the individual commands for more information." | |
634a7d0b | 25392 | (interactive) |
64f72ae1 | 25393 | (call-interactively |
9acdaa21 | 25394 | (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) |
891f4676 | 25395 | |
634a7d0b | 25396 | (defun org-cut-special () |
28e5b051 CD |
25397 | "Cut region in table or cut current subtree. |
25398 | Calls `org-table-copy' or `org-cut-subtree', depending on context. | |
25399 | See the individual commands for more information." | |
634a7d0b | 25400 | (interactive) |
9acdaa21 CD |
25401 | (call-interactively |
25402 | (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) | |
891f4676 RS |
25403 | |
25404 | (defun org-paste-special (arg) | |
28e5b051 CD |
25405 | "Paste rectangular region into table, or past subtree relative to level. |
25406 | Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. | |
25407 | See the individual commands for more information." | |
891f4676 RS |
25408 | (interactive "P") |
25409 | (if (org-at-table-p) | |
634a7d0b | 25410 | (org-table-paste-rectangle) |
891f4676 RS |
25411 | (org-paste-subtree arg))) |
25412 | ||
25413 | (defun org-ctrl-c-ctrl-c (&optional arg) | |
a4b39e39 CD |
25414 | "Set tags in headline, or update according to changed information at point. |
25415 | ||
25416 | This command does many different things, depending on context: | |
25417 | ||
25418 | - If the cursor is in a headline, prompt for tags and insert them | |
25419 | into the current line, aligned to `org-tags-column'. When called | |
25420 | with prefix arg, realign all tags in the current buffer. | |
25421 | ||
25422 | - If the cursor is in one of the special #+KEYWORD lines, this | |
25423 | triggers scanning the buffer for these lines and updating the | |
edd21304 | 25424 | information. |
a4b39e39 CD |
25425 | |
25426 | - If the cursor is inside a table, realign the table. This command | |
25427 | works even if the automatic table editor has been turned off. | |
25428 | ||
25429 | - If the cursor is on a #+TBLFM line, re-apply the formulas to | |
25430 | the entire table. | |
25431 | ||
15841868 JW |
25432 | - If the cursor is a the beginning of a dynamic block, update it. |
25433 | ||
a4b39e39 | 25434 | - If the cursor is inside a table created by the table.el package, |
2a94e282 | 25435 | activate that table. |
a4b39e39 CD |
25436 | |
25437 | - If the current buffer is a remember buffer, close note and file it. | |
25438 | with a prefix argument, file it without further interaction to the default | |
25439 | location. | |
25440 | ||
25441 | - If the cursor is on a <<<target>>>, update radio targets and corresponding | |
25442 | links in this buffer. | |
25443 | ||
25444 | - If the cursor is on a numbered item in a plain list, renumber the | |
25445 | ordered list." | |
891f4676 RS |
25446 | (interactive "P") |
25447 | (let ((org-enable-table-editor t)) | |
25448 | (cond | |
3278a016 CD |
25449 | ((or org-clock-overlays |
25450 | org-occur-highlights | |
6769c0dc | 25451 | org-latex-fragment-image-overlays) |
edd21304 | 25452 | (org-remove-clock-overlays) |
edd21304 | 25453 | (org-remove-occur-highlights) |
6769c0dc CD |
25454 | (org-remove-latex-fragment-image-overlays) |
25455 | (message "Temporary highlights/overlays removed from current buffer")) | |
ab27a4a0 CD |
25456 | ((and (local-variable-p 'org-finish-function (current-buffer)) |
25457 | (fboundp org-finish-function)) | |
25458 | (funcall org-finish-function)) | |
7d58338e CD |
25459 | ((org-at-property-p) |
25460 | (call-interactively 'org-property-action)) | |
4b3a9ba7 CD |
25461 | ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) |
25462 | ((org-on-heading-p) (call-interactively 'org-set-tags)) | |
891f4676 RS |
25463 | ((org-at-table.el-p) |
25464 | (require 'table) | |
25465 | (beginning-of-line 1) | |
9acdaa21 | 25466 | (re-search-forward "|" (save-excursion (end-of-line 2) (point))) |
4b3a9ba7 | 25467 | (call-interactively 'table-recognize-table)) |
891f4676 | 25468 | ((org-at-table-p) |
9acdaa21 CD |
25469 | (org-table-maybe-eval-formula) |
25470 | (if arg | |
4b3a9ba7 | 25471 | (call-interactively 'org-table-recalculate) |
c8d16429 | 25472 | (org-table-maybe-recalculate-line)) |
4b3a9ba7 CD |
25473 | (call-interactively 'org-table-align)) |
25474 | ((org-at-item-checkbox-p) | |
25475 | (call-interactively 'org-toggle-checkbox)) | |
7a368970 | 25476 | ((org-at-item-p) |
b38c6895 | 25477 | (call-interactively 'org-maybe-renumber-ordered-list)) |
15841868 JW |
25478 | ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:")) |
25479 | ;; Dynamic block | |
25480 | (beginning-of-line 1) | |
25481 | (org-update-dblock)) | |
9acdaa21 CD |
25482 | ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) |
25483 | (cond | |
25484 | ((equal (match-string 1) "TBLFM") | |
c8d16429 CD |
25485 | ;; Recalculate the table before this line |
25486 | (save-excursion | |
25487 | (beginning-of-line 1) | |
25488 | (skip-chars-backward " \r\n\t") | |
4b3a9ba7 CD |
25489 | (if (org-at-table-p) |
25490 | (org-call-with-arg 'org-table-recalculate t)))) | |
9acdaa21 | 25491 | (t |
4b3a9ba7 | 25492 | (call-interactively 'org-mode-restart)))) |
7a368970 | 25493 | (t (error "C-c C-c can do nothing useful at this location."))))) |
891f4676 | 25494 | |
28e5b051 CD |
25495 | (defun org-mode-restart () |
25496 | "Restart Org-mode, to scan again for special lines. | |
25497 | Also updates the keyword regular expressions." | |
25498 | (interactive) | |
25499 | (let ((org-inhibit-startup t)) (org-mode)) | |
25500 | (message "Org-mode restarted to refresh keyword and special line setup")) | |
25501 | ||
03f3cf35 JW |
25502 | (defun org-kill-note-or-show-branches () |
25503 | "If this is a Note buffer, abort storing the note. Else call `show-branches'." | |
25504 | (interactive) | |
25505 | (if (not org-finish-function) | |
25506 | (call-interactively 'show-branches) | |
25507 | (let ((org-note-abort t)) | |
25508 | (funcall org-finish-function)))) | |
25509 | ||
634a7d0b | 25510 | (defun org-return () |
28e5b051 CD |
25511 | "Goto next table row or insert a newline. |
25512 | Calls `org-table-next-row' or `newline', depending on context. | |
25513 | See the individual commands for more information." | |
634a7d0b | 25514 | (interactive) |
891f4676 | 25515 | (cond |
38f8646b | 25516 | ((bobp) (newline)) |
791d856f CD |
25517 | ((org-at-table-p) |
25518 | (org-table-justify-field-maybe) | |
4b3a9ba7 | 25519 | (call-interactively 'org-table-next-row)) |
891f4676 RS |
25520 | (t (newline)))) |
25521 | ||
03f3cf35 | 25522 | |
38f8646b CD |
25523 | (defun org-ctrl-c-minus () |
25524 | "Insert separator line in table or modify bullet type in list. | |
25525 | Calls `org-table-insert-hline' or `org-cycle-list-bullet', | |
25526 | depending on context." | |
25527 | (interactive) | |
25528 | (cond | |
25529 | ((org-at-table-p) | |
25530 | (call-interactively 'org-table-insert-hline)) | |
03f3cf35 JW |
25531 | ((org-on-heading-p) |
25532 | ;; Convert to item | |
25533 | (save-excursion | |
25534 | (beginning-of-line 1) | |
25535 | (if (looking-at "\\*+ ") | |
25536 | (replace-match (concat (make-string (- (match-end 0) (point)) ?\ ) "- "))))) | |
38f8646b CD |
25537 | ((org-in-item-p) |
25538 | (call-interactively 'org-cycle-list-bullet)) | |
25539 | (t (error "`C-c -' does have no function here.")))) | |
25540 | ||
791d856f | 25541 | (defun org-meta-return (&optional arg) |
28e5b051 CD |
25542 | "Insert a new heading or wrap a region in a table. |
25543 | Calls `org-insert-heading' or `org-table-wrap-region', depending on context. | |
25544 | See the individual commands for more information." | |
791d856f CD |
25545 | (interactive "P") |
25546 | (cond | |
25547 | ((org-at-table-p) | |
4b3a9ba7 CD |
25548 | (call-interactively 'org-table-wrap-region)) |
25549 | (t (call-interactively 'org-insert-heading)))) | |
891f4676 RS |
25550 | |
25551 | ;;; Menu entries | |
25552 | ||
891f4676 | 25553 | ;; Define the Org-mode menus |
9acdaa21 CD |
25554 | (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" |
25555 | '("Tbl" | |
25556 | ["Align" org-ctrl-c-ctrl-c (org-at-table-p)] | |
25557 | ["Next Field" org-cycle (org-at-table-p)] | |
25558 | ["Previous Field" org-shifttab (org-at-table-p)] | |
25559 | ["Next Row" org-return (org-at-table-p)] | |
25560 | "--" | |
25561 | ["Blank Field" org-table-blank-field (org-at-table-p)] | |
ab27a4a0 | 25562 | ["Edit Field" org-table-edit-field (org-at-table-p)] |
9acdaa21 CD |
25563 | ["Copy Field from Above" org-table-copy-down (org-at-table-p)] |
25564 | "--" | |
25565 | ("Column" | |
25566 | ["Move Column Left" org-metaleft (org-at-table-p)] | |
25567 | ["Move Column Right" org-metaright (org-at-table-p)] | |
25568 | ["Delete Column" org-shiftmetaleft (org-at-table-p)] | |
d3f4dbe8 | 25569 | ["Insert Column" org-shiftmetaright (org-at-table-p)]) |
9acdaa21 CD |
25570 | ("Row" |
25571 | ["Move Row Up" org-metaup (org-at-table-p)] | |
25572 | ["Move Row Down" org-metadown (org-at-table-p)] | |
25573 | ["Delete Row" org-shiftmetaup (org-at-table-p)] | |
25574 | ["Insert Row" org-shiftmetadown (org-at-table-p)] | |
e0e66b8e | 25575 | ["Sort lines in region" org-table-sort-lines (org-at-table-p)] |
9acdaa21 | 25576 | "--" |
38f8646b | 25577 | ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) |
9acdaa21 CD |
25578 | ("Rectangle" |
25579 | ["Copy Rectangle" org-copy-special (org-at-table-p)] | |
25580 | ["Cut Rectangle" org-cut-special (org-at-table-p)] | |
25581 | ["Paste Rectangle" org-paste-special (org-at-table-p)] | |
25582 | ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) | |
25583 | "--" | |
25584 | ("Calculate" | |
c4f9780e | 25585 | ["Set Column Formula" org-table-eval-formula (org-at-table-p)] |
d3f4dbe8 | 25586 | ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] |
c4f9780e CD |
25587 | ["Edit Formulas" org-table-edit-formulas (org-at-table-p)] |
25588 | "--" | |
9acdaa21 CD |
25589 | ["Recalculate line" org-table-recalculate (org-at-table-p)] |
25590 | ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] | |
d3f4dbe8 CD |
25591 | ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] |
25592 | "--" | |
9acdaa21 | 25593 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] |
c4f9780e | 25594 | "--" |
64f72ae1 | 25595 | ["Sum Column/Rectangle" org-table-sum |
9acdaa21 CD |
25596 | (or (org-at-table-p) (org-region-active-p))] |
25597 | ["Which Column?" org-table-current-column (org-at-table-p)]) | |
25598 | ["Debug Formulas" | |
d3f4dbe8 | 25599 | org-table-toggle-formula-debugger |
9acdaa21 | 25600 | :style toggle :selected org-table-formula-debug] |
d3f4dbe8 CD |
25601 | ["Show Col/Row Numbers" |
25602 | org-table-toggle-coordinate-overlays | |
25603 | :style toggle :selected org-table-overlay-coordinates] | |
9acdaa21 | 25604 | "--" |
9acdaa21 | 25605 | ["Create" org-table-create (and (not (org-at-table-p)) |
c8d16429 | 25606 | org-enable-table-editor)] |
ab27a4a0 | 25607 | ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] |
9acdaa21 CD |
25608 | ["Import from File" org-table-import (not (org-at-table-p))] |
25609 | ["Export to File" org-table-export (org-at-table-p)] | |
25610 | "--" | |
25611 | ["Create/Convert from/to table.el" org-table-create-with-table.el t])) | |
25612 | ||
891f4676 RS |
25613 | (easy-menu-define org-org-menu org-mode-map "Org menu" |
25614 | '("Org" | |
3278a016 CD |
25615 | ("Show/Hide" |
25616 | ["Cycle Visibility" org-cycle (or (bobp) (outline-on-heading-p))] | |
25617 | ["Cycle Global Visibility" org-shifttab (not (org-at-table-p))] | |
25618 | ["Sparse Tree" org-occur t] | |
25619 | ["Reveal Context" org-reveal t] | |
d3f4dbe8 CD |
25620 | ["Show All" show-all t] |
25621 | "--" | |
25622 | ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) | |
891f4676 RS |
25623 | "--" |
25624 | ["New Heading" org-insert-heading t] | |
25625 | ("Navigate Headings" | |
25626 | ["Up" outline-up-heading t] | |
25627 | ["Next" outline-next-visible-heading t] | |
25628 | ["Previous" outline-previous-visible-heading t] | |
25629 | ["Next Same Level" outline-forward-same-level t] | |
25630 | ["Previous Same Level" outline-backward-same-level t] | |
25631 | "--" | |
374585c9 | 25632 | ["Jump" org-goto t]) |
891f4676 | 25633 | ("Edit Structure" |
35fb9989 CD |
25634 | ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] |
25635 | ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] | |
891f4676 RS |
25636 | "--" |
25637 | ["Copy Subtree" org-copy-special (not (org-at-table-p))] | |
25638 | ["Cut Subtree" org-cut-special (not (org-at-table-p))] | |
25639 | ["Paste Subtree" org-paste-special (not (org-at-table-p))] | |
25640 | "--" | |
25641 | ["Promote Heading" org-metaleft (not (org-at-table-p))] | |
25642 | ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] | |
25643 | ["Demote Heading" org-metaright (not (org-at-table-p))] | |
30313b90 CD |
25644 | ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] |
25645 | "--" | |
d3f4dbe8 CD |
25646 | ["Sort Region/Children" org-sort (not (org-at-table-p))] |
25647 | "--" | |
4ed31842 CD |
25648 | ["Convert to odd levels" org-convert-to-odd-levels t] |
25649 | ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) | |
a3fbe8c4 CD |
25650 | ("Editing" |
25651 | ["Emphasis..." org-emphasize t]) | |
6769c0dc CD |
25652 | ("Archive" |
25653 | ["Toggle ARCHIVE tag" org-toggle-archive-tag t] | |
d3f4dbe8 CD |
25654 | ; ["Check and Tag Children" (org-toggle-archive-tag (4)) |
25655 | ; :active t :keys "C-u C-c C-x C-a"] | |
6769c0dc CD |
25656 | ["Sparse trees open ARCHIVE trees" |
25657 | (setq org-sparse-tree-open-archived-trees | |
25658 | (not org-sparse-tree-open-archived-trees)) | |
25659 | :style toggle :selected org-sparse-tree-open-archived-trees] | |
25660 | ["Cycling opens ARCHIVE trees" | |
25661 | (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) | |
25662 | :style toggle :selected org-cycle-open-archived-trees] | |
25663 | ["Agenda includes ARCHIVE trees" | |
25664 | (setq org-agenda-skip-archived-trees (not org-agenda-skip-archived-trees)) | |
25665 | :style toggle :selected (not org-agenda-skip-archived-trees)] | |
25666 | "--" | |
d3f4dbe8 CD |
25667 | ["Move Subtree to Archive" org-advertized-archive-subtree t] |
25668 | ; ["Check and Move Children" (org-archive-subtree '(4)) | |
25669 | ; :active t :keys "C-u C-c C-x C-s"] | |
25670 | ) | |
891f4676 | 25671 | "--" |
35fb9989 | 25672 | ("TODO Lists" |
891f4676 | 25673 | ["TODO/DONE/-" org-todo t] |
5137195a CD |
25674 | ("Select keyword" |
25675 | ["Next keyword" org-shiftright (org-on-heading-p)] | |
25676 | ["Previous keyword" org-shiftleft (org-on-heading-p)] | |
a3fbe8c4 CD |
25677 | ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] |
25678 | ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] | |
25679 | ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) | |
891f4676 | 25680 | ["Show TODO Tree" org-show-todo-tree t] |
f425a6ea | 25681 | ["Global TODO list" org-todo-list t] |
891f4676 | 25682 | "--" |
35fb9989 CD |
25683 | ["Set Priority" org-priority t] |
25684 | ["Priority Up" org-shiftup t] | |
7d58338e | 25685 | ["Priority Down" org-shiftdown t]) |
38f8646b CD |
25686 | ("TAGS and Properties" |
25687 | ["Set Tags" 'org-ctrl-c-ctrl-c (org-at-heading-p)] | |
15841868 | 25688 | ["Change tag in region" 'org-change-tag-in-region (org-region-active-p)] |
03f3cf35 JW |
25689 | "--" |
25690 | ["Set property" 'org-set-property t] | |
25691 | ["Column view of properties" org-columns t] | |
25692 | ["Insert Column View DBlock" org-insert-columns-dblock t]) | |
891f4676 RS |
25693 | ("Dates and Scheduling" |
25694 | ["Timestamp" org-time-stamp t] | |
28e5b051 | 25695 | ["Timestamp (inactive)" org-time-stamp-inactive t] |
891f4676 | 25696 | ("Change Date" |
3278a016 CD |
25697 | ["1 Day Later" org-shiftright t] |
25698 | ["1 Day Earlier" org-shiftleft t] | |
35fb9989 CD |
25699 | ["1 ... Later" org-shiftup t] |
25700 | ["1 ... Earlier" org-shiftdown t]) | |
891f4676 RS |
25701 | ["Compute Time Range" org-evaluate-time-range t] |
25702 | ["Schedule Item" org-schedule t] | |
25703 | ["Deadline" org-deadline t] | |
25704 | "--" | |
3278a016 CD |
25705 | ["Custom time format" org-toggle-time-stamp-overlays |
25706 | :style radio :selected org-display-custom-times] | |
25707 | "--" | |
891f4676 RS |
25708 | ["Goto Calendar" org-goto-calendar t] |
25709 | ["Date from Calendar" org-date-from-calendar t]) | |
edd21304 CD |
25710 | ("Logging work" |
25711 | ["Clock in" org-clock-in t] | |
25712 | ["Clock out" org-clock-out t] | |
25713 | ["Clock cancel" org-clock-cancel t] | |
15841868 | 25714 | ["Goto running clock" org-clock-goto t] |
edd21304 | 25715 | ["Display times" org-clock-display t] |
0fee8d6e | 25716 | ["Create clock table" org-clock-report t] |
edd21304 CD |
25717 | "--" |
25718 | ["Record DONE time" | |
25719 | (progn (setq org-log-done (not org-log-done)) | |
25720 | (message "Switching to %s will %s record a timestamp" | |
a3fbe8c4 | 25721 | (car org-done-keywords) |
edd21304 CD |
25722 | (if org-log-done "automatically" "not"))) |
25723 | :style toggle :selected org-log-done]) | |
891f4676 | 25724 | "--" |
3278a016 | 25725 | ["Agenda Command..." org-agenda t] |
d924f2e5 CD |
25726 | ("File List for Agenda") |
25727 | ("Special views current file" | |
4da1a99d CD |
25728 | ["TODO Tree" org-show-todo-tree t] |
25729 | ["Check Deadlines" org-check-deadlines t] | |
25730 | ["Timeline" org-timeline t] | |
d924f2e5 | 25731 | ["Tags Tree" org-tags-sparse-tree t]) |
891f4676 RS |
25732 | "--" |
25733 | ("Hyperlinks" | |
35fb9989 | 25734 | ["Store Link (Global)" org-store-link t] |
891f4676 | 25735 | ["Insert Link" org-insert-link t] |
ab27a4a0 CD |
25736 | ["Follow Link" org-open-at-point t] |
25737 | "--" | |
d3f4dbe8 CD |
25738 | ["Next link" org-next-link t] |
25739 | ["Previous link" org-previous-link t] | |
25740 | "--" | |
ab27a4a0 CD |
25741 | ["Descriptive Links" |
25742 | (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) | |
25743 | :style radio :selected (member '(org-link) buffer-invisibility-spec)] | |
25744 | ["Literal Links" | |
25745 | (progn | |
25746 | (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) | |
d3f4dbe8 | 25747 | :style radio :selected (not (member '(org-link) buffer-invisibility-spec))]) |
891f4676 | 25748 | "--" |
3278a016 | 25749 | ["Export/Publish..." org-export t] |
6769c0dc | 25750 | ("LaTeX" |
c44f0d75 | 25751 | ["Org CDLaTeX mode" org-cdlatex-mode :style toggle |
6769c0dc CD |
25752 | :selected org-cdlatex-mode] |
25753 | ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] | |
25754 | ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] | |
25755 | ["Modify math symbol" org-cdlatex-math-modify | |
25756 | (org-inside-LaTeX-fragment-p)] | |
25757 | ["Export LaTeX fragments as images" | |
c44f0d75 | 25758 | (setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments)) |
6769c0dc | 25759 | :style toggle :selected org-export-with-LaTeX-fragments]) |
891f4676 RS |
25760 | "--" |
25761 | ("Documentation" | |
25762 | ["Show Version" org-version t] | |
25763 | ["Info Documentation" org-info t]) | |
25764 | ("Customize" | |
25765 | ["Browse Org Group" org-customize t] | |
25766 | "--" | |
ab27a4a0 | 25767 | ["Expand This Menu" org-create-customize-menu |
891f4676 | 25768 | (fboundp 'customize-menu-create)]) |
28e5b051 CD |
25769 | "--" |
25770 | ["Refresh setup" org-mode-restart t] | |
891f4676 RS |
25771 | )) |
25772 | ||
891f4676 RS |
25773 | (defun org-info (&optional node) |
25774 | "Read documentation for Org-mode in the info system. | |
25775 | With optional NODE, go directly to that node." | |
25776 | (interactive) | |
25777 | (require 'info) | |
25778 | (Info-goto-node (format "(org)%s" (or node "")))) | |
25779 | ||
891f4676 | 25780 | (defun org-install-agenda-files-menu () |
ab27a4a0 CD |
25781 | (let ((bl (buffer-list))) |
25782 | (save-excursion | |
25783 | (while bl | |
25784 | (set-buffer (pop bl)) | |
b928f99a CD |
25785 | (if (org-mode-p) (setq bl nil))) |
25786 | (when (org-mode-p) | |
ab27a4a0 CD |
25787 | (easy-menu-change |
25788 | '("Org") "File List for Agenda" | |
25789 | (append | |
25790 | (list | |
25791 | ["Edit File List" (org-edit-agenda-file-list) t] | |
25792 | ["Add/Move Current File to Front of List" org-agenda-file-to-front t] | |
25793 | ["Remove Current File from List" org-remove-file t] | |
25794 | ["Cycle through agenda files" org-cycle-agenda-files t] | |
15841868 | 25795 | ["Occur in all agenda files" org-occur-in-agenda-files t] |
ab27a4a0 CD |
25796 | "--") |
25797 | (mapcar 'org-file-menu-entry (org-agenda-files t)))))))) | |
891f4676 | 25798 | |
d3f4dbe8 | 25799 | ;;;; Documentation |
891f4676 RS |
25800 | |
25801 | (defun org-customize () | |
c8d16429 | 25802 | "Call the customize function with org as argument." |
891f4676 RS |
25803 | (interactive) |
25804 | (customize-browse 'org)) | |
25805 | ||
25806 | (defun org-create-customize-menu () | |
25807 | "Create a full customization menu for Org-mode, insert it into the menu." | |
25808 | (interactive) | |
25809 | (if (fboundp 'customize-menu-create) | |
25810 | (progn | |
25811 | (easy-menu-change | |
25812 | '("Org") "Customize" | |
25813 | `(["Browse Org group" org-customize t] | |
25814 | "--" | |
25815 | ,(customize-menu-create 'org) | |
25816 | ["Set" Custom-set t] | |
25817 | ["Save" Custom-save t] | |
25818 | ["Reset to Current" Custom-reset-current t] | |
25819 | ["Reset to Saved" Custom-reset-saved t] | |
25820 | ["Reset to Standard Settings" Custom-reset-standard t])) | |
25821 | (message "\"Org\"-menu now contains full customization menu")) | |
25822 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
25823 | ||
d3f4dbe8 CD |
25824 | ;;;; Miscellaneous stuff |
25825 | ||
25826 | ||
25827 | ;;; Generally useful functions | |
891f4676 | 25828 | |
c4b5acde CD |
25829 | (defun org-context () |
25830 | "Return a list of contexts of the current cursor position. | |
25831 | If several contexts apply, all are returned. | |
25832 | Each context entry is a list with a symbol naming the context, and | |
25833 | two positions indicating start and end of the context. Possible | |
25834 | contexts are: | |
25835 | ||
25836 | :headline anywhere in a headline | |
25837 | :headline-stars on the leading stars in a headline | |
25838 | :todo-keyword on a TODO keyword (including DONE) in a headline | |
25839 | :tags on the TAGS in a headline | |
25840 | :priority on the priority cookie in a headline | |
25841 | :item on the first line of a plain list item | |
e39856be | 25842 | :item-bullet on the bullet/number of a plain list item |
c4b5acde CD |
25843 | :checkbox on the checkbox in a plain list item |
25844 | :table in an org-mode table | |
25845 | :table-special on a special filed in a table | |
25846 | :table-table in a table.el table | |
d3f4dbe8 | 25847 | :link on a hyperlink |
c4b5acde CD |
25848 | :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. |
25849 | :target on a <<target>> | |
25850 | :radio-target on a <<<radio-target>>> | |
e39856be CD |
25851 | :latex-fragment on a LaTeX fragment |
25852 | :latex-preview on a LaTeX fragment with overlayed preview image | |
c4b5acde CD |
25853 | |
25854 | This function expects the position to be visible because it uses font-lock | |
25855 | faces as a help to recognize the following contexts: :table-special, :link, | |
25856 | and :keyword." | |
25857 | (let* ((f (get-text-property (point) 'face)) | |
25858 | (faces (if (listp f) f (list f))) | |
e39856be | 25859 | (p (point)) clist o) |
c4b5acde CD |
25860 | ;; First the large context |
25861 | (cond | |
a3fbe8c4 | 25862 | ((org-on-heading-p t) |
c4b5acde CD |
25863 | (push (list :headline (point-at-bol) (point-at-eol)) clist) |
25864 | (when (progn | |
25865 | (beginning-of-line 1) | |
25866 | (looking-at org-todo-line-tags-regexp)) | |
25867 | (push (org-point-in-group p 1 :headline-stars) clist) | |
25868 | (push (org-point-in-group p 2 :todo-keyword) clist) | |
25869 | (push (org-point-in-group p 4 :tags) clist)) | |
25870 | (goto-char p) | |
25871 | (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1)) | |
a3fbe8c4 | 25872 | (if (looking-at "\\[#[A-Z0-9]\\]") |
c4b5acde CD |
25873 | (push (org-point-in-group p 0 :priority) clist))) |
25874 | ||
25875 | ((org-at-item-p) | |
e39856be | 25876 | (push (org-point-in-group p 2 :item-bullet) clist) |
c4b5acde CD |
25877 | (push (list :item (point-at-bol) |
25878 | (save-excursion (org-end-of-item) (point))) | |
25879 | clist) | |
25880 | (and (org-at-item-checkbox-p) | |
25881 | (push (org-point-in-group p 0 :checkbox) clist))) | |
25882 | ||
25883 | ((org-at-table-p) | |
25884 | (push (list :table (org-table-begin) (org-table-end)) clist) | |
25885 | (if (memq 'org-formula faces) | |
25886 | (push (list :table-special | |
25887 | (previous-single-property-change p 'face) | |
25888 | (next-single-property-change p 'face)) clist))) | |
25889 | ((org-at-table-p 'any) | |
25890 | (push (list :table-table) clist))) | |
25891 | (goto-char p) | |
25892 | ||
25893 | ;; Now the small context | |
25894 | (cond | |
25895 | ((org-at-timestamp-p) | |
25896 | (push (org-point-in-group p 0 :timestamp) clist)) | |
25897 | ((memq 'org-link faces) | |
25898 | (push (list :link | |
25899 | (previous-single-property-change p 'face) | |
25900 | (next-single-property-change p 'face)) clist)) | |
25901 | ((memq 'org-special-keyword faces) | |
25902 | (push (list :keyword | |
25903 | (previous-single-property-change p 'face) | |
25904 | (next-single-property-change p 'face)) clist)) | |
25905 | ((org-on-target-p) | |
25906 | (push (org-point-in-group p 0 :target) clist) | |
25907 | (goto-char (1- (match-beginning 0))) | |
25908 | (if (looking-at org-radio-target-regexp) | |
25909 | (push (org-point-in-group p 0 :radio-target) clist)) | |
e39856be CD |
25910 | (goto-char p)) |
25911 | ((setq o (car (delq nil | |
c44f0d75 | 25912 | (mapcar |
e39856be CD |
25913 | (lambda (x) |
25914 | (if (memq x org-latex-fragment-image-overlays) x)) | |
25915 | (org-overlays-at (point)))))) | |
c44f0d75 | 25916 | (push (list :latex-fragment |
e39856be | 25917 | (org-overlay-start o) (org-overlay-end o)) clist) |
c44f0d75 | 25918 | (push (list :latex-preview |
e39856be CD |
25919 | (org-overlay-start o) (org-overlay-end o)) clist)) |
25920 | ((org-inside-LaTeX-fragment-p) | |
3278a016 | 25921 | ;; FIXME: positions wrong. |
e39856be | 25922 | (push (list :latex-fragment (point) (point)) clist))) |
c4b5acde CD |
25923 | |
25924 | (setq clist (nreverse (delq nil clist))) | |
25925 | clist)) | |
25926 | ||
15841868 | 25927 | ;; FIXME: Compare with at-regexp-p Do we need both? |
d3f4dbe8 CD |
25928 | (defun org-in-regexp (re &optional nlines visually) |
25929 | "Check if point is inside a match of regexp. | |
25930 | Normally only the current line is checked, but you can include NLINES extra | |
25931 | lines both before and after point into the search. | |
25932 | If VISUALLY is set, require that the cursor is not after the match but | |
25933 | really on, so that the block visually is on the match." | |
25934 | (catch 'exit | |
25935 | (let ((pos (point)) | |
25936 | (eol (point-at-eol (+ 1 (or nlines 0)))) | |
25937 | (inc (if visually 1 0))) | |
25938 | (save-excursion | |
25939 | (beginning-of-line (- 1 (or nlines 0))) | |
25940 | (while (re-search-forward re eol t) | |
a3fbe8c4 | 25941 | (if (and (<= (match-beginning 0) pos) |
d3f4dbe8 CD |
25942 | (>= (+ inc (match-end 0)) pos)) |
25943 | (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) | |
25944 | ||
a3fbe8c4 CD |
25945 | (defun org-at-regexp-p (regexp) |
25946 | "Is point inside a match of REGEXP in the current line?" | |
25947 | (catch 'exit | |
25948 | (save-excursion | |
25949 | (let ((pos (point)) (end (point-at-eol))) | |
25950 | (beginning-of-line 1) | |
25951 | (while (re-search-forward regexp end t) | |
25952 | (if (and (<= (match-beginning 0) pos) | |
25953 | (>= (match-end 0) pos)) | |
25954 | (throw 'exit t))) | |
25955 | nil)))) | |
25956 | ||
03f3cf35 | 25957 | (defun org-occur-in-agenda-files (regexp &optional nlines) |
15841868 | 25958 | "Call `multi-occur' with buffers for all agenda files." |
03f3cf35 JW |
25959 | (interactive "sOrg-files matching: \np") |
25960 | (let* ((files (org-agenda-files)) | |
25961 | (tnames (mapcar 'file-truename files)) | |
25962 | (extra org-agenda-multi-occur-extra-files) | |
25963 | f) | |
25964 | (while (setq f (pop extra)) | |
25965 | (unless (member (file-truename f) tnames) | |
25966 | (add-to-list 'files f 'append) | |
25967 | (add-to-list 'tnames (file-truename f) 'append))) | |
25968 | (multi-occur | |
25969 | (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files) | |
25970 | regexp))) | |
15841868 | 25971 | |
a3fbe8c4 CD |
25972 | (defun org-uniquify (list) |
25973 | "Remove duplicate elements from LIST." | |
25974 | (let (res) | |
25975 | (mapc (lambda (x) (add-to-list 'res x 'append)) list) | |
25976 | res)) | |
25977 | ||
25978 | (defun org-delete-all (elts list) | |
25979 | "Remove all elements in ELTS from LIST." | |
25980 | (while elts | |
25981 | (setq list (delete (pop elts) list))) | |
25982 | list) | |
25983 | ||
c4b5acde CD |
25984 | (defun org-point-in-group (point group &optional context) |
25985 | "Check if POINT is in match-group GROUP. | |
25986 | If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the | |
25987 | match. If the match group does ot exist or point is not inside it, | |
25988 | return nil." | |
25989 | (and (match-beginning group) | |
25990 | (>= point (match-beginning group)) | |
25991 | (<= point (match-end group)) | |
25992 | (if context | |
25993 | (list context (match-beginning group) (match-end group)) | |
25994 | t))) | |
25995 | ||
374585c9 CD |
25996 | (defun org-switch-to-buffer-other-window (&rest args) |
25997 | "Switch to buffer in a second window on the current frame. | |
25998 | In particular, do not allow pop-up frames." | |
25999 | (let (pop-up-frames special-display-buffer-names special-display-regexps | |
26000 | special-display-function) | |
26001 | (apply 'switch-to-buffer-other-window args))) | |
26002 | ||
d3f4dbe8 CD |
26003 | (defun org-combine-plists (&rest plists) |
26004 | "Create a single property list from all plists in PLISTS. | |
26005 | The process starts by copying the first list, and then setting properties | |
26006 | from the other lists. Settings in the last list are the most significant | |
26007 | ones and overrule settings in the other lists." | |
26008 | (let ((rtn (copy-sequence (pop plists))) | |
26009 | p v ls) | |
26010 | (while plists | |
26011 | (setq ls (pop plists)) | |
26012 | (while ls | |
26013 | (setq p (pop ls) v (pop ls)) | |
26014 | (setq rtn (plist-put rtn p v)))) | |
26015 | rtn)) | |
26016 | ||
891f4676 | 26017 | (defun org-move-line-down (arg) |
634a7d0b | 26018 | "Move the current line down. With prefix argument, move it past ARG lines." |
891f4676 RS |
26019 | (interactive "p") |
26020 | (let ((col (current-column)) | |
26021 | beg end pos) | |
26022 | (beginning-of-line 1) (setq beg (point)) | |
26023 | (beginning-of-line 2) (setq end (point)) | |
26024 | (beginning-of-line (+ 1 arg)) | |
26025 | (setq pos (move-marker (make-marker) (point))) | |
26026 | (insert (delete-and-extract-region beg end)) | |
26027 | (goto-char pos) | |
26028 | (move-to-column col))) | |
26029 | ||
26030 | (defun org-move-line-up (arg) | |
634a7d0b | 26031 | "Move the current line up. With prefix argument, move it past ARG lines." |
891f4676 RS |
26032 | (interactive "p") |
26033 | (let ((col (current-column)) | |
26034 | beg end pos) | |
26035 | (beginning-of-line 1) (setq beg (point)) | |
26036 | (beginning-of-line 2) (setq end (point)) | |
634a7d0b | 26037 | (beginning-of-line (- arg)) |
891f4676 RS |
26038 | (setq pos (move-marker (make-marker) (point))) |
26039 | (insert (delete-and-extract-region beg end)) | |
26040 | (goto-char pos) | |
26041 | (move-to-column col))) | |
26042 | ||
d3f4dbe8 CD |
26043 | (defun org-replace-escapes (string table) |
26044 | "Replace %-escapes in STRING with values in TABLE. | |
15841868 | 26045 | TABLE is an association list with keys like \"%a\" and string values. |
d3f4dbe8 CD |
26046 | The sequences in STRING may contain normal field width and padding information, |
26047 | for example \"%-5s\". Replacements happen in the sequence given by TABLE, | |
26048 | so values can contain further %-escapes if they are define later in TABLE." | |
26049 | (let ((case-fold-search nil) | |
a3fbe8c4 | 26050 | e re rpl) |
d3f4dbe8 CD |
26051 | (while (setq e (pop table)) |
26052 | (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) | |
26053 | (while (string-match re string) | |
26054 | (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") | |
26055 | (cdr e))) | |
26056 | (setq string (replace-match rpl t t string)))) | |
26057 | string)) | |
26058 | ||
26059 | ||
26060 | (defun org-sublist (list start end) | |
26061 | "Return a section of LIST, from START to END. | |
26062 | Counting starts at 1." | |
26063 | (let (rtn (c start)) | |
26064 | (setq list (nthcdr (1- start) list)) | |
26065 | (while (and list (<= c end)) | |
26066 | (push (pop list) rtn) | |
26067 | (setq c (1+ c))) | |
26068 | (nreverse rtn))) | |
26069 | ||
d3f4dbe8 CD |
26070 | (defun org-find-base-buffer-visiting (file) |
26071 | "Like `find-buffer-visiting' but alway return the base buffer and | |
26072 | not an indirect buffer" | |
26073 | (let ((buf (find-buffer-visiting file))) | |
15841868 JW |
26074 | (if buf |
26075 | (or (buffer-base-buffer buf) buf) | |
26076 | nil))) | |
d3f4dbe8 | 26077 | |
a3fbe8c4 CD |
26078 | (defun org-image-file-name-regexp () |
26079 | "Return regexp matching the file names of images." | |
26080 | (if (fboundp 'image-file-name-regexp) | |
26081 | (image-file-name-regexp) | |
26082 | (let ((image-file-name-extensions | |
26083 | '("png" "jpeg" "jpg" "gif" "tiff" "tif" | |
26084 | "xbm" "xpm" "pbm" "pgm" "ppm"))) | |
26085 | (concat "\\." | |
26086 | (regexp-opt (nconc (mapcar 'upcase | |
26087 | image-file-name-extensions) | |
26088 | image-file-name-extensions) | |
26089 | t) | |
26090 | "\\'")))) | |
26091 | ||
26092 | (defun org-file-image-p (file) | |
26093 | "Return non-nil if FILE is an image." | |
26094 | (save-match-data | |
26095 | (string-match (org-image-file-name-regexp) file))) | |
26096 | ||
d3f4dbe8 | 26097 | ;;; Paragraph filling stuff. |
e0e66b8e | 26098 | ;; We want this to be just right, so use the full arsenal. |
a3fbe8c4 CD |
26099 | |
26100 | (defun org-indent-line-function () | |
26101 | "Indent line like previous, but further if previous was headline or item." | |
26102 | (interactive) | |
b38c6895 CD |
26103 | (let* ((pos (point)) |
26104 | (itemp (org-at-item-p)) | |
26105 | column bpos bcol tpos tcol bullet btype bullet-type) | |
26106 | ;; Find the previous relevant line | |
26107 | (beginning-of-line 1) | |
26108 | (cond | |
26109 | ((looking-at "#") (setq column 0)) | |
5152b597 | 26110 | ((looking-at "\\*+ ") (setq column 0)) |
b38c6895 CD |
26111 | (t |
26112 | (beginning-of-line 0) | |
26113 | (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) | |
26114 | (beginning-of-line 0)) | |
26115 | (cond | |
26116 | ((looking-at "\\*+[ \t]+") | |
26117 | (goto-char (match-end 0)) | |
26118 | (setq column (current-column))) | |
26119 | ((org-in-item-p) | |
26120 | (org-beginning-of-item) | |
48aaad2d CD |
26121 | ; (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") |
26122 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\)?") | |
b38c6895 CD |
26123 | (setq bpos (match-beginning 1) tpos (match-end 0) |
26124 | bcol (progn (goto-char bpos) (current-column)) | |
26125 | tcol (progn (goto-char tpos) (current-column)) | |
26126 | bullet (match-string 1) | |
26127 | bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) | |
26128 | (if (not itemp) | |
26129 | (setq column tcol) | |
26130 | (goto-char pos) | |
26131 | (beginning-of-line 1) | |
26132 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") | |
26133 | (setq bullet (match-string 1) | |
26134 | btype (if (string-match "[0-9]" bullet) "n" bullet)) | |
26135 | (setq column (if (equal btype bullet-type) bcol tcol)))) | |
26136 | (t (setq column (org-get-indentation)))))) | |
26137 | (goto-char pos) | |
a3fbe8c4 CD |
26138 | (if (<= (current-column) (current-indentation)) |
26139 | (indent-line-to column) | |
38f8646b CD |
26140 | (save-excursion (indent-line-to column))) |
26141 | (setq column (current-column)) | |
26142 | (beginning-of-line 1) | |
26143 | (if (looking-at | |
26144 | "\\([ \t]+\\)\\(:[0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") | |
26145 | (replace-match (concat "\\1" (format org-property-format | |
26146 | (match-string 2) (match-string 3))) | |
26147 | t nil)) | |
26148 | (move-to-column column))) | |
e0e66b8e CD |
26149 | |
26150 | (defun org-set-autofill-regexps () | |
26151 | (interactive) | |
26152 | ;; In the paragraph separator we include headlines, because filling | |
26153 | ;; text in a line directly attached to a headline would otherwise | |
26154 | ;; fill the headline as well. | |
5137195a | 26155 | (org-set-local 'comment-start-skip "^#+[ \t]*") |
7d58338e | 26156 | (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") |
e0e66b8e | 26157 | ;; The paragraph starter includes hand-formatted lists. |
5137195a | 26158 | (org-set-local 'paragraph-start |
7d58338e | 26159 | "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") |
e0e66b8e CD |
26160 | ;; Inhibit auto-fill for headers, tables and fixed-width lines. |
26161 | ;; But only if the user has not turned off tables or fixed-width regions | |
5137195a CD |
26162 | (org-set-local |
26163 | 'auto-fill-inhibit-regexp | |
7d58338e | 26164 | (concat "\\*+ \\|#\\+" |
5137195a CD |
26165 | "\\|[ \t]*" org-keyword-time-regexp |
26166 | (if (or org-enable-table-editor org-enable-fixed-width-editor) | |
26167 | (concat | |
26168 | "\\|[ \t]*[" | |
26169 | (if org-enable-table-editor "|" "") | |
26170 | (if org-enable-fixed-width-editor ":" "") | |
26171 | "]")))) | |
e0e66b8e CD |
26172 | ;; We use our own fill-paragraph function, to make sure that tables |
26173 | ;; and fixed-width regions are not wrapped. That function will pass | |
26174 | ;; through to `fill-paragraph' when appropriate. | |
5137195a CD |
26175 | (org-set-local 'fill-paragraph-function 'org-fill-paragraph) |
26176 | ; Adaptive filling: To get full control, first make sure that | |
6eff18ef | 26177 | ;; `adaptive-fill-regexp' never matches. Then install our own matcher. |
5137195a CD |
26178 | (org-set-local 'adaptive-fill-regexp "\000") |
26179 | (org-set-local 'adaptive-fill-function | |
26180 | 'org-adaptive-fill-function)) | |
e0e66b8e CD |
26181 | |
26182 | (defun org-fill-paragraph (&optional justify) | |
26183 | "Re-align a table, pass through to fill-paragraph if no table." | |
26184 | (let ((table-p (org-at-table-p)) | |
26185 | (table.el-p (org-at-table.el-p))) | |
26186 | (cond ((equal (char-after (point-at-bol)) ?*) t) ; skip headlines | |
26187 | (table.el-p t) ; skip table.el tables | |
26188 | (table-p (org-table-align) t) ; align org-mode tables | |
26189 | (t nil)))) ; call paragraph-fill | |
26190 | ||
26191 | ;; For reference, this is the default value of adaptive-fill-regexp | |
26192 | ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" | |
26193 | ||
26194 | (defun org-adaptive-fill-function () | |
26195 | "Return a fill prefix for org-mode files. | |
26196 | In particular, this makes sure hanging paragraphs for hand-formatted lists | |
26197 | work correctly." | |
d3f4dbe8 CD |
26198 | (cond ((looking-at "#[ \t]+") |
26199 | (match-string 0)) | |
a3fbe8c4 CD |
26200 | ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] \\)?") |
26201 | (save-excursion | |
26202 | (goto-char (match-end 0)) | |
26203 | (make-string (current-column) ?\ ))) | |
d3f4dbe8 | 26204 | (t nil))) |
891f4676 | 26205 | |
d3f4dbe8 | 26206 | ;;;; Functions extending outline functionality |
891f4676 | 26207 | |
1e8fbb6d | 26208 | (defun org-beginning-of-line (&optional arg) |
891f4676 | 26209 | "Go to the beginning of the current line. If that is invisible, continue |
1e8fbb6d CD |
26210 | to a visible line beginning. This makes the function of C-a more intuitive. |
26211 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
26212 | first attempt, and only move to after the tags when the cursor is already | |
26213 | beyond the end of the headline." | |
26214 | (interactive "P") | |
a3fbe8c4 CD |
26215 | (let ((pos (point))) |
26216 | (beginning-of-line 1) | |
26217 | (if (bobp) | |
26218 | nil | |
26219 | (backward-char 1) | |
26220 | (if (org-invisible-p) | |
26221 | (while (and (not (bobp)) (org-invisible-p)) | |
26222 | (backward-char 1) | |
26223 | (beginning-of-line 1)) | |
26224 | (forward-char 1))) | |
48aaad2d CD |
26225 | (when org-special-ctrl-a/e |
26226 | (cond | |
26227 | ((and (looking-at org-todo-line-regexp) | |
26228 | (= (char-after (match-end 1)) ?\ )) | |
26229 | (goto-char | |
374585c9 CD |
26230 | (if (eq org-special-ctrl-a/e t) |
26231 | (cond ((> pos (match-beginning 3)) (match-beginning 3)) | |
26232 | ((= pos (point)) (match-beginning 3)) | |
26233 | (t (point))) | |
26234 | (cond ((> pos (point)) (point)) | |
26235 | ((not (eq last-command this-command)) (point)) | |
26236 | (t (match-beginning 3)))))) | |
48aaad2d CD |
26237 | ((org-at-item-p) |
26238 | (goto-char | |
374585c9 CD |
26239 | (if (eq org-special-ctrl-a/e t) |
26240 | (cond ((> pos (match-end 4)) (match-end 4)) | |
26241 | ((= pos (point)) (match-end 4)) | |
26242 | (t (point))) | |
26243 | (cond ((> pos (point)) (point)) | |
26244 | ((not (eq last-command this-command)) (point)) | |
26245 | (t (match-end 4)))))))))) | |
04d18304 | 26246 | |
1e8fbb6d CD |
26247 | (defun org-end-of-line (&optional arg) |
26248 | "Go to the end of the line. | |
26249 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
26250 | first attempt, and only move to after the tags when the cursor is already | |
26251 | beyond the end of the headline." | |
26252 | (interactive "P") | |
26253 | (if (or (not org-special-ctrl-a/e) | |
26254 | (not (org-on-heading-p))) | |
26255 | (end-of-line arg) | |
26256 | (let ((pos (point))) | |
26257 | (beginning-of-line 1) | |
26258 | (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) | |
374585c9 CD |
26259 | (if (eq org-special-ctrl-a/e t) |
26260 | (if (or (< pos (match-beginning 1)) | |
26261 | (= pos (match-end 0))) | |
26262 | (goto-char (match-beginning 1)) | |
26263 | (goto-char (match-end 0))) | |
26264 | (if (or (< pos (match-end 0)) (not (eq this-command last-command))) | |
26265 | (goto-char (match-end 0)) | |
26266 | (goto-char (match-beginning 1)))) | |
8ca3a1ea | 26267 | (end-of-line arg))))) |
1e8fbb6d | 26268 | |
5137195a | 26269 | (define-key org-mode-map "\C-a" 'org-beginning-of-line) |
1e8fbb6d | 26270 | (define-key org-mode-map "\C-e" 'org-end-of-line) |
891f4676 RS |
26271 | |
26272 | (defun org-invisible-p () | |
26273 | "Check if point is at a character currently not visible." | |
5137195a CD |
26274 | ;; Early versions of noutline don't have `outline-invisible-p'. |
26275 | (if (fboundp 'outline-invisible-p) | |
26276 | (outline-invisible-p) | |
26277 | (get-char-property (point) 'invisible))) | |
891f4676 | 26278 | |
a96ee7df CD |
26279 | (defun org-invisible-p2 () |
26280 | "Check if point is at a character currently not visible." | |
26281 | (save-excursion | |
5137195a CD |
26282 | (if (and (eolp) (not (bobp))) (backward-char 1)) |
26283 | ;; Early versions of noutline don't have `outline-invisible-p'. | |
26284 | (if (fboundp 'outline-invisible-p) | |
26285 | (outline-invisible-p) | |
26286 | (get-char-property (point) 'invisible)))) | |
26287 | ||
26288 | (defalias 'org-back-to-heading 'outline-back-to-heading) | |
26289 | (defalias 'org-on-heading-p 'outline-on-heading-p) | |
a3fbe8c4 CD |
26290 | (defalias 'org-at-heading-p 'outline-on-heading-p) |
26291 | (defun org-at-heading-or-item-p () | |
26292 | (or (org-on-heading-p) (org-at-item-p))) | |
891f4676 | 26293 | |
a96ee7df | 26294 | (defun org-on-target-p () |
d3f4dbe8 CD |
26295 | (or (org-in-regexp org-radio-target-regexp) |
26296 | (org-in-regexp org-target-regexp))) | |
a96ee7df | 26297 | |
891f4676 RS |
26298 | (defun org-up-heading-all (arg) |
26299 | "Move to the heading line of which the present line is a subheading. | |
26300 | This function considers both visible and invisible heading lines. | |
26301 | With argument, move up ARG levels." | |
5137195a CD |
26302 | (if (fboundp 'outline-up-heading-all) |
26303 | (outline-up-heading-all arg) ; emacs 21 version of outline.el | |
26304 | (outline-up-heading arg t))) ; emacs 22 version of outline.el | |
891f4676 | 26305 | |
d5098885 JW |
26306 | (defun org-up-heading-safe () |
26307 | "Move to the heading line of which the present line is a subheading. | |
26308 | This version will not throw an error. It will return the level of the | |
26309 | headline found, or nil if no higher level is found." | |
26310 | (let ((pos (point)) start-level level | |
26311 | (re (concat "^" outline-regexp))) | |
26312 | (catch 'exit | |
26313 | (outline-back-to-heading t) | |
26314 | (setq start-level (funcall outline-level)) | |
26315 | (if (equal start-level 1) (throw 'exit nil)) | |
26316 | (while (re-search-backward re nil t) | |
26317 | (setq level (funcall outline-level)) | |
26318 | (if (< level start-level) (throw 'exit level))) | |
26319 | nil))) | |
26320 | ||
3278a016 CD |
26321 | (defun org-goto-sibling (&optional previous) |
26322 | "Goto the next sibling, even if it is invisible. | |
26323 | When PREVIOUS is set, go to the previous sibling instead. Returns t | |
26324 | when a sibling was found. When none is found, return nil and don't | |
26325 | move point." | |
26326 | (let ((fun (if previous 're-search-backward 're-search-forward)) | |
26327 | (pos (point)) | |
26328 | (re (concat "^" outline-regexp)) | |
26329 | level l) | |
5152b597 CD |
26330 | (when (condition-case nil (org-back-to-heading t) (error nil)) |
26331 | (setq level (funcall outline-level)) | |
26332 | (catch 'exit | |
26333 | (or previous (forward-char 1)) | |
26334 | (while (funcall fun re nil t) | |
26335 | (setq l (funcall outline-level)) | |
26336 | (when (< l level) (goto-char pos) (throw 'exit nil)) | |
26337 | (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) | |
26338 | (goto-char pos) | |
26339 | nil)))) | |
3278a016 | 26340 | |
d3f4dbe8 CD |
26341 | (defun org-show-siblings () |
26342 | "Show all siblings of the current headline." | |
26343 | (save-excursion | |
26344 | (while (org-goto-sibling) (org-flag-heading nil))) | |
26345 | (save-excursion | |
26346 | (while (org-goto-sibling 'previous) | |
26347 | (org-flag-heading nil)))) | |
26348 | ||
891f4676 RS |
26349 | (defun org-show-hidden-entry () |
26350 | "Show an entry where even the heading is hidden." | |
26351 | (save-excursion | |
634a7d0b | 26352 | (org-show-entry))) |
891f4676 | 26353 | |
891f4676 | 26354 | (defun org-flag-heading (flag &optional entry) |
2dd9129f | 26355 | "Flag the current heading. FLAG non-nil means make invisible. |
891f4676 RS |
26356 | When ENTRY is non-nil, show the entire entry." |
26357 | (save-excursion | |
26358 | (org-back-to-heading t) | |
891f4676 RS |
26359 | ;; Check if we should show the entire entry |
26360 | (if entry | |
c8d16429 CD |
26361 | (progn |
26362 | (org-show-entry) | |
4b3a9ba7 CD |
26363 | (save-excursion |
26364 | (and (outline-next-heading) | |
26365 | (org-flag-heading nil)))) | |
48aaad2d | 26366 | (outline-flag-region (max (point-min) (1- (point))) |
c8d16429 | 26367 | (save-excursion (outline-end-of-heading) (point)) |
5137195a | 26368 | flag)))) |
891f4676 | 26369 | |
a3fbe8c4 | 26370 | (defun org-end-of-subtree (&optional invisible-OK to-heading) |
04d18304 CD |
26371 | ;; This is an exact copy of the original function, but it uses |
26372 | ;; `org-back-to-heading', to make it work also in invisible | |
26373 | ;; trees. And is uses an invisible-OK argument. | |
26374 | ;; Under Emacs this is not needed, but the old outline.el needs this fix. | |
26375 | (org-back-to-heading invisible-OK) | |
f462ee2c | 26376 | (let ((first t) |
04d18304 CD |
26377 | (level (funcall outline-level))) |
26378 | (while (and (not (eobp)) | |
26379 | (or first (> (funcall outline-level) level))) | |
26380 | (setq first nil) | |
26381 | (outline-next-heading)) | |
a3fbe8c4 CD |
26382 | (unless to-heading |
26383 | (if (memq (preceding-char) '(?\n ?\^M)) | |
26384 | (progn | |
26385 | ;; Go to end of line before heading | |
26386 | (forward-char -1) | |
26387 | (if (memq (preceding-char) '(?\n ?\^M)) | |
26388 | ;; leave blank line before heading | |
26389 | (forward-char -1)))))) | |
0fee8d6e | 26390 | (point)) |
04d18304 | 26391 | |
634a7d0b CD |
26392 | (defun org-show-subtree () |
26393 | "Show everything after this heading at deeper levels." | |
64f72ae1 JB |
26394 | (outline-flag-region |
26395 | (point) | |
634a7d0b CD |
26396 | (save-excursion |
26397 | (outline-end-of-subtree) (outline-next-heading) (point)) | |
5137195a | 26398 | nil)) |
634a7d0b CD |
26399 | |
26400 | (defun org-show-entry () | |
26401 | "Show the body directly following this heading. | |
26402 | Show the heading too, if it is currently invisible." | |
26403 | (interactive) | |
26404 | (save-excursion | |
15841868 JW |
26405 | (condition-case nil |
26406 | (progn | |
26407 | (org-back-to-heading t) | |
26408 | (outline-flag-region | |
26409 | (max (point-min) (1- (point))) | |
26410 | (save-excursion | |
26411 | (re-search-forward | |
26412 | (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) | |
26413 | (or (match-beginning 1) (point-max))) | |
26414 | nil)) | |
26415 | (error nil)))) | |
634a7d0b | 26416 | |
891f4676 RS |
26417 | (defun org-make-options-regexp (kwds) |
26418 | "Make a regular expression for keyword lines." | |
26419 | (concat | |
5137195a | 26420 | "^" |
891f4676 RS |
26421 | "#?[ \t]*\\+\\(" |
26422 | (mapconcat 'regexp-quote kwds "\\|") | |
26423 | "\\):[ \t]*" | |
5137195a | 26424 | "\\(.+\\)")) |
891f4676 | 26425 | |
d3f4dbe8 CD |
26426 | ;; Make isearch reveal the necessary context |
26427 | (defun org-isearch-end () | |
26428 | "Reveal context after isearch exits." | |
26429 | (when isearch-success ; only if search was successful | |
26430 | (if (featurep 'xemacs) | |
26431 | ;; Under XEmacs, the hook is run in the correct place, | |
26432 | ;; we directly show the context. | |
26433 | (org-show-context 'isearch) | |
26434 | ;; In Emacs the hook runs *before* restoring the overlays. | |
26435 | ;; So we have to use a one-time post-command-hook to do this. | |
26436 | ;; (Emacs 22 has a special variable, see function `org-mode') | |
26437 | (unless (and (boundp 'isearch-mode-end-hook-quit) | |
26438 | isearch-mode-end-hook-quit) | |
26439 | ;; Only when the isearch was not quitted. | |
26440 | (org-add-hook 'post-command-hook 'org-isearch-post-command | |
26441 | 'append 'local))))) | |
26442 | ||
26443 | (defun org-isearch-post-command () | |
26444 | "Remove self from hook, and show context." | |
26445 | (remove-hook 'post-command-hook 'org-isearch-post-command 'local) | |
26446 | (org-show-context 'isearch)) | |
26447 | ||
a3fbe8c4 CD |
26448 | |
26449 | ;;;; Address problems with some other packages | |
26450 | ||
26451 | ;; Make flyspell not check words in links, to not mess up our keymap | |
26452 | (defun org-mode-flyspell-verify () | |
26453 | "Don't let flyspell put overlays at active buttons." | |
26454 | (not (get-text-property (point) 'keymap))) | |
d3f4dbe8 | 26455 | |
b9661543 | 26456 | ;; Make `bookmark-jump' show the jump location if it was hidden. |
891f4676 | 26457 | (eval-after-load "bookmark" |
b9661543 CD |
26458 | '(if (boundp 'bookmark-after-jump-hook) |
26459 | ;; We can use the hook | |
26460 | (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) | |
26461 | ;; Hook not available, use advice | |
26462 | (defadvice bookmark-jump (after org-make-visible activate) | |
26463 | "Make the position visible." | |
26464 | (org-bookmark-jump-unhide)))) | |
26465 | ||
26466 | (defun org-bookmark-jump-unhide () | |
26467 | "Unhide the current position, to show the bookmark location." | |
b928f99a | 26468 | (and (org-mode-p) |
b9661543 CD |
26469 | (or (org-invisible-p) |
26470 | (save-excursion (goto-char (max (point-min) (1- (point)))) | |
26471 | (org-invisible-p))) | |
3278a016 | 26472 | (org-show-context 'bookmark-jump))) |
891f4676 | 26473 | |
3278a016 CD |
26474 | ;; Make session.el ignore our circular variable |
26475 | (eval-after-load "session" | |
26476 | '(add-to-list 'session-globals-exclude 'org-mark-ring)) | |
0fee8d6e | 26477 | |
d3f4dbe8 | 26478 | ;;;; Experimental code |
b928f99a | 26479 | |
a3fbe8c4 CD |
26480 | (defun org-closed-in-range () |
26481 | "Sparse tree of items closed in a certain time range. | |
26482 | Still experimental, may disappear in the furture." | |
26483 | (interactive) | |
26484 | ;; Get the time interval from the user. | |
26485 | (let* ((time1 (time-to-seconds | |
26486 | (org-read-date nil 'to-time nil "Starting date: "))) | |
26487 | (time2 (time-to-seconds | |
26488 | (org-read-date nil 'to-time nil "End date:"))) | |
26489 | ;; callback function | |
26490 | (callback (lambda () | |
26491 | (let ((time | |
26492 | (time-to-seconds | |
26493 | (apply 'encode-time | |
26494 | (org-parse-time-string | |
26495 | (match-string 1)))))) | |
26496 | ;; check if time in interval | |
26497 | (and (>= time time1) (<= time time2)))))) | |
26498 | ;; make tree, check each match with the callback | |
26499 | (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) | |
d3f4dbe8 | 26500 | |
7d58338e CD |
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 | ||
d5098885 | 26519 | ;; FIXME: this needs a much better algorithm |
0b8568f5 JW |
26520 | (defun org-assign-fast-keys (alist) |
26521 | "Assign fast keys to a keyword-key alist. | |
26522 | Respect 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))) | |
38f8646b | 26543 | |
fbe6c10d CD |
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 | ||
d3f4dbe8 | 26559 | ;;;; Finish up |
c44f0d75 | 26560 | |
f462ee2c SM |
26561 | (provide 'org) |
26562 | ||
26563 | (run-hooks 'org-load-hook) | |
26564 | ||
26565 | ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd | |
26566 | ;;; org.el ends here | |
7d58338e | 26567 | |
557f46f0 | 26568 |