Commit | Line | Data |
---|---|---|
a3fbe8c4 | 1 | ;;; org.el --- Outline-based notes management and organizer |
791d856f | 2 | ;; Carstens outline-mode for keeping track of everything. |
12dc447f | 3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 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 |
ff4be292 | 8 | ;; Version: 6.14 |
ef943dba | 9 | ;; |
359ec616 | 10 | ;; This file is part of GNU Emacs. |
ef943dba | 11 | ;; |
b1fc2b50 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
359ec616 | 13 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
891f4676 | 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 | |
b1fc2b50 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
891f4676 | 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
891f4676 RS |
25 | ;; |
26 | ;;; Commentary: | |
27 | ;; | |
28 | ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing | |
29 | ;; project planning with a fast and effective plain-text system. | |
30 | ;; | |
f85d958a CD |
31 | ;; Org-mode develops organizational tasks around NOTES files that contain |
32 | ;; information about projects as plain text. Org-mode is implemented on | |
33 | ;; top of outline-mode, which makes it possible to keep the content of | |
34 | ;; large files well structured. Visibility cycling and structure editing | |
35 | ;; help to work with the tree. Tables are easily created with a built-in | |
36 | ;; table editor. Org-mode supports ToDo items, deadlines, time stamps, | |
37 | ;; and scheduling. It dynamically compiles entries into an agenda that | |
38 | ;; utilizes and smoothly integrates much of the Emacs calendar and diary. | |
39 | ;; Plain text URL-like links connect to websites, emails, Usenet | |
40 | ;; messages, BBDB entries, and any files related to the projects. For | |
41 | ;; printing and sharing of notes, an Org-mode file can be exported as a | |
42 | ;; structured ASCII file, as HTML, or (todo and agenda items only) as an | |
43 | ;; iCalendar file. It can also serve as a publishing tool for a set of | |
44 | ;; linked webpages. | |
45 | ;; | |
3278a016 CD |
46 | ;; Installation and Activation |
47 | ;; --------------------------- | |
48 | ;; See the corresponding sections in the manual at | |
891f4676 | 49 | ;; |
0b8568f5 | 50 | ;; http://orgmode.org/org.html#Installation |
891f4676 RS |
51 | ;; |
52 | ;; Documentation | |
53 | ;; ------------- | |
eb2f9c59 CD |
54 | ;; The documentation of Org-mode can be found in the TeXInfo file. The |
55 | ;; distribution also contains a PDF version of it. At the homepage of | |
56 | ;; Org-mode, you can read the same text online as HTML. There is also an | |
7a368970 CD |
57 | ;; excellent reference card made by Philip Rooke. This card can be found |
58 | ;; in the etc/ directory of Emacs 22. | |
891f4676 | 59 | ;; |
d3f4dbe8 | 60 | ;; A list of recent changes can be found at |
d5098885 | 61 | ;; http://orgmode.org/Changes.html |
0fee8d6e | 62 | ;; |
891f4676 RS |
63 | ;;; Code: |
64 | ||
20908596 CD |
65 | (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param |
66 | (defvar org-table-formula-constants-local nil | |
67 | "Local version of `org-table-formula-constants'.") | |
68 | (make-variable-buffer-local 'org-table-formula-constants-local) | |
69 | ||
d3f4dbe8 CD |
70 | ;;;; Require other packages |
71 | ||
edd21304 | 72 | (eval-when-compile |
ab27a4a0 | 73 | (require 'cl) |
e31ececb | 74 | (require 'gnus-sum) |
ab27a4a0 | 75 | (require 'calendar)) |
0fee8d6e CD |
76 | ;; For XEmacs, noutline is not yet provided by outline.el, so arrange for |
77 | ;; the file noutline.el being loaded. | |
78 | (if (featurep 'xemacs) (condition-case nil (require 'noutline))) | |
79 | ;; We require noutline, which might be provided in outline.el | |
80 | (require 'outline) (require 'noutline) | |
81 | ;; Other stuff we need. | |
891f4676 | 82 | (require 'time-date) |
8c6fb58b | 83 | (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) |
891f4676 RS |
84 | (require 'easymenu) |
85 | ||
20908596 CD |
86 | (require 'org-macs) |
87 | (require 'org-compat) | |
88 | (require 'org-faces) | |
621f83e4 | 89 | (require 'org-list) |
20908596 | 90 | |
d3f4dbe8 | 91 | ;;;; Customization variables |
891f4676 | 92 | |
d3f4dbe8 CD |
93 | ;;; Version |
94 | ||
ff4be292 | 95 | (defconst org-version "6.14" |
891f4676 | 96 | "The version number of the file org.el.") |
2a57416f CD |
97 | |
98 | (defun org-version (&optional here) | |
99 | "Show the org-mode version in the echo area. | |
100 | With prefix arg HERE, insert it at point." | |
101 | (interactive "P") | |
102 | (let ((version (format "Org-mode version %s" org-version))) | |
103 | (message version) | |
104 | (if here | |
105 | (insert version)))) | |
891f4676 | 106 | |
d3f4dbe8 | 107 | ;;; Compatibility constants |
38f8646b | 108 | |
d3f4dbe8 CD |
109 | ;;; The custom variables |
110 | ||
891f4676 | 111 | (defgroup org nil |
b0a10108 | 112 | "Outline-based notes management and organizer." |
891f4676 RS |
113 | :tag "Org" |
114 | :group 'outlines | |
115 | :group 'hypermedia | |
116 | :group 'calendar) | |
117 | ||
2a57416f CD |
118 | (defcustom org-load-hook nil |
119 | "Hook that is run after org.el has been loaded." | |
120 | :group 'org | |
121 | :type 'hook) | |
122 | ||
20908596 CD |
123 | (defvar org-modules) ; defined below |
124 | (defvar org-modules-loaded nil | |
125 | "Have the modules been loaded already?") | |
126 | ||
127 | (defun org-load-modules-maybe (&optional force) | |
ce4fdcb9 | 128 | "Load all extensions listed in `org-modules'." |
20908596 CD |
129 | (when (or force (not org-modules-loaded)) |
130 | (mapc (lambda (ext) | |
131 | (condition-case nil (require ext) | |
132 | (error (message "Problems while trying to load feature `%s'" ext)))) | |
133 | org-modules) | |
134 | (setq org-modules-loaded t))) | |
135 | ||
136 | (defun org-set-modules (var value) | |
137 | "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." | |
138 | (set var value) | |
139 | (when (featurep 'org) | |
140 | (org-load-modules-maybe 'force))) | |
141 | ||
6dc30f44 CD |
142 | (when (org-bound-and-true-p org-modules) |
143 | (let ((a (member 'org-infojs org-modules))) | |
144 | (and a (setcar a 'org-jsinfo)))) | |
145 | ||
ff4be292 | 146 | (defcustom org-modules '(org-bbdb org-bibtex org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl) |
20908596 | 147 | "Modules that should always be loaded together with org.el. |
efc054e6 | 148 | If a description starts with <C>, the file is not part of Emacs |
20908596 CD |
149 | and loading it will require that you have downloaded and properly installed |
150 | the org-mode distribution. | |
151 | ||
152 | You can also use this system to load external packages (i.e. neither Org | |
153 | core modules, not modules from the CONTRIB directory). Just add symbols | |
efc054e6 | 154 | to the end of the list. If the package is called org-xyz.el, then you need |
20908596 CD |
155 | to add the symbol `xyz', and the package must have a call to |
156 | ||
157 | (provide 'org-xyz)" | |
15841868 | 158 | :group 'org |
20908596 CD |
159 | :set 'org-set-modules |
160 | :type | |
161 | '(set :greedy t | |
162 | (const :tag " bbdb: Links to BBDB entries" org-bbdb) | |
163 | (const :tag " bibtex: Links to BibTeX entries" org-bibtex) | |
164 | (const :tag " gnus: Links to GNUS folders/messages" org-gnus) | |
b349f79f | 165 | (const :tag " id: Global id's for identifying entries" org-id) |
20908596 | 166 | (const :tag " info: Links to Info nodes" org-info) |
6dc30f44 | 167 | (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo) |
20908596 CD |
168 | (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) |
169 | (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message) | |
170 | (const :tag " mew Links to Mew folders/messages" org-mew) | |
171 | (const :tag " mhe: Links to MHE folders/messages" org-mhe) | |
172 | (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) | |
173 | (const :tag " vm: Links to VM folders/messages" org-vm) | |
174 | (const :tag " wl: Links to Wanderlust folders/messages" org-wl) | |
ff4be292 | 175 | (const :tag " w3m: Special cut/past from w3m to Org." org-w3m) |
20908596 CD |
176 | (const :tag " mouse: Additional mouse support" org-mouse) |
177 | ||
178 | (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) | |
b349f79f | 179 | (const :tag "C annotation-helper: Call Remeber directly from Browser" org-annotation-helper) |
20908596 CD |
180 | (const :tag "C bookmark: Org links to bookmarks" org-bookmark) |
181 | (const :tag "C depend: TODO dependencies for Org-mode" org-depend) | |
182 | (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol) | |
b349f79f | 183 | (const :tag "C eval: Include command output as text" org-eval) |
ce4fdcb9 | 184 | (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) |
20908596 | 185 | (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) |
ce4fdcb9 | 186 | (const :tag "C exp-blocks: Pre-process blocks for export" org-exp-blocks) |
20908596 CD |
187 | (const :tag "C id: Global id's for identifying entries" org-id) |
188 | (const :tag "C interactive-query: Interactive modification of tags query" org-interactive-query) | |
189 | (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix) | |
190 | (const :tag "C man: Support for links to manpages in Org-mode" org-man) | |
b349f79f | 191 | (const :tag "C mtags: Support for muse-like tags" org-mtags) |
20908596 CD |
192 | (const :tag "C panel: Simple routines for us with bad memory" org-panel) |
193 | (const :tag "C registry: A registry for Org links" org-registry) | |
194 | (const :tag "C org2rem: Convert org appointments into reminders" org2rem) | |
195 | (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) | |
196 | (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) | |
197 | (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) | |
198 | (repeat :tag "External packages" :inline t (symbol :tag "Package")))) | |
199 | ||
15841868 | 200 | |
891f4676 RS |
201 | (defgroup org-startup nil |
202 | "Options concerning startup of Org-mode." | |
203 | :tag "Org Startup" | |
204 | :group 'org) | |
205 | ||
206 | (defcustom org-startup-folded t | |
ef943dba CD |
207 | "Non-nil means, entering Org-mode will switch to OVERVIEW. |
208 | This can also be configured on a per-file basis by adding one of | |
209 | the following lines anywhere in the buffer: | |
210 | ||
211 | #+STARTUP: fold | |
212 | #+STARTUP: nofold | |
35fb9989 | 213 | #+STARTUP: content" |
891f4676 | 214 | :group 'org-startup |
35fb9989 | 215 | :type '(choice |
c8d16429 CD |
216 | (const :tag "nofold: show all" nil) |
217 | (const :tag "fold: overview" t) | |
218 | (const :tag "content: all headlines" content))) | |
891f4676 RS |
219 | |
220 | (defcustom org-startup-truncated t | |
221 | "Non-nil means, entering Org-mode will set `truncate-lines'. | |
222 | This is useful since some lines containing links can be very long and | |
223 | uninteresting. Also tables look terrible when wrapped." | |
224 | :group 'org-startup | |
225 | :type 'boolean) | |
226 | ||
ab27a4a0 CD |
227 | (defcustom org-startup-align-all-tables nil |
228 | "Non-nil means, align all tables when visiting a file. | |
229 | This is useful when the column width in tables is forced with <N> cookies | |
4146eb16 CD |
230 | in table fields. Such tables will look correct only after the first re-align. |
231 | This can also be configured on a per-file basis by adding one of | |
232 | the following lines anywhere in the buffer: | |
233 | #+STARTUP: align | |
234 | #+STARTUP: noalign" | |
ab27a4a0 CD |
235 | :group 'org-startup |
236 | :type 'boolean) | |
237 | ||
c52dbe8c | 238 | (defcustom org-insert-mode-line-in-empty-file nil |
891f4676 | 239 | "Non-nil means insert the first line setting Org-mode in empty files. |
35fb9989 | 240 | When the function `org-mode' is called interactively in an empty file, this |
891f4676 RS |
241 | normally means that the file name does not automatically trigger Org-mode. |
242 | To ensure that the file will always be in Org-mode in the future, a | |
35fb9989 CD |
243 | line enforcing Org-mode will be inserted into the buffer, if this option |
244 | has been set." | |
891f4676 RS |
245 | :group 'org-startup |
246 | :type 'boolean) | |
247 | ||
a3fbe8c4 CD |
248 | (defcustom org-replace-disputed-keys nil |
249 | "Non-nil means use alternative key bindings for some keys. | |
250 | Org-mode uses S-<cursor> keys for changing timestamps and priorities. | |
251 | These keys are also used by other packages like `CUA-mode' or `windmove.el'. | |
252 | If you want to use Org-mode together with one of these other modes, | |
253 | or more generally if you would like to move some Org-mode commands to | |
254 | other keys, set this variable and configure the keys with the variable | |
ab27a4a0 | 255 | `org-disputed-keys'. |
891f4676 | 256 | |
d3f4dbe8 CD |
257 | This option is only relevant at load-time of Org-mode, and must be set |
258 | *before* org.el is loaded. Changing it requires a restart of Emacs to | |
259 | become effective." | |
ab27a4a0 CD |
260 | :group 'org-startup |
261 | :type 'boolean) | |
891f4676 | 262 | |
621f83e4 CD |
263 | (defcustom org-use-extra-keys nil |
264 | "Non-nil means use extra key sequence definitions for certain | |
265 | commands. This happens automatically if you run XEmacs or if | |
266 | window-system is nil. This variable lets you do the same | |
267 | manually. You must set it before loading org. | |
268 | ||
269 | Example: on Carbon Emacs 22 running graphically, with an external | |
270 | keyboard on a Powerbook, the default way of setting M-left might | |
271 | not work for either Alt or ESC. Setting this variable will make | |
272 | it work for ESC." | |
273 | :group 'org-startup | |
274 | :type 'boolean) | |
275 | ||
a3fbe8c4 CD |
276 | (if (fboundp 'defvaralias) |
277 | (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)) | |
278 | ||
279 | (defcustom org-disputed-keys | |
280 | '(([(shift up)] . [(meta p)]) | |
281 | ([(shift down)] . [(meta n)]) | |
282 | ([(shift left)] . [(meta -)]) | |
283 | ([(shift right)] . [(meta +)]) | |
284 | ([(control shift right)] . [(meta shift +)]) | |
285 | ([(control shift left)] . [(meta shift -)])) | |
ab27a4a0 | 286 | "Keys for which Org-mode and other modes compete. |
a3fbe8c4 CD |
287 | This is an alist, cars are the default keys, second element specifies |
288 | the alternative to use when `org-replace-disputed-keys' is t. | |
289 | ||
290 | Keys can be specified in any syntax supported by `define-key'. | |
291 | The value of this option takes effect only at Org-mode's startup, | |
292 | therefore you'll have to restart Emacs to apply it after changing." | |
293 | :group 'org-startup | |
294 | :type 'alist) | |
ab27a4a0 CD |
295 | |
296 | (defun org-key (key) | |
a3fbe8c4 CD |
297 | "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. |
298 | Or return the original if not disputed." | |
299 | (if org-replace-disputed-keys | |
300 | (let* ((nkey (key-description key)) | |
301 | (x (org-find-if (lambda (x) | |
302 | (equal (key-description (car x)) nkey)) | |
303 | org-disputed-keys))) | |
304 | (if x (cdr x) key)) | |
305 | key)) | |
306 | ||
307 | (defun org-find-if (predicate seq) | |
308 | (catch 'exit | |
309 | (while seq | |
310 | (if (funcall predicate (car seq)) | |
311 | (throw 'exit (car seq)) | |
312 | (pop seq))))) | |
313 | ||
314 | (defun org-defkey (keymap key def) | |
315 | "Define a key, possibly translated, as returned by `org-key'." | |
316 | (define-key keymap (org-key key) def)) | |
ab27a4a0 | 317 | |
8c6fb58b | 318 | (defcustom org-ellipsis nil |
ab27a4a0 CD |
319 | "The ellipsis to use in the Org-mode outline. |
320 | When nil, just use the standard three dots. When a string, use that instead, | |
374585c9 CD |
321 | When a face, use the standart 3 dots, but with the specified face. |
322 | The change affects only Org-mode (which will then use its own display table). | |
ab27a4a0 CD |
323 | Changing this requires executing `M-x org-mode' in a buffer to become |
324 | effective." | |
325 | :group 'org-startup | |
326 | :type '(choice (const :tag "Default" nil) | |
374585c9 | 327 | (face :tag "Face" :value org-warning) |
ab27a4a0 CD |
328 | (string :tag "String" :value "...#"))) |
329 | ||
330 | (defvar org-display-table nil | |
331 | "The display table for org-mode, in case `org-ellipsis' is non-nil.") | |
332 | ||
333 | (defgroup org-keywords nil | |
334 | "Keywords in Org-mode." | |
335 | :tag "Org Keywords" | |
336 | :group 'org) | |
891f4676 RS |
337 | |
338 | (defcustom org-deadline-string "DEADLINE:" | |
339 | "String to mark deadline entries. | |
340 | A deadline is this string, followed by a time stamp. Should be a word, | |
341 | terminated by a colon. You can insert a schedule keyword and | |
342 | a timestamp with \\[org-deadline]. | |
343 | Changes become only effective after restarting Emacs." | |
344 | :group 'org-keywords | |
345 | :type 'string) | |
346 | ||
347 | (defcustom org-scheduled-string "SCHEDULED:" | |
348 | "String to mark scheduled TODO entries. | |
349 | A schedule is this string, followed by a time stamp. Should be a word, | |
350 | terminated by a colon. You can insert a schedule keyword and | |
351 | a timestamp with \\[org-schedule]. | |
352 | Changes become only effective after restarting Emacs." | |
353 | :group 'org-keywords | |
354 | :type 'string) | |
355 | ||
7ac93e3c | 356 | (defcustom org-closed-string "CLOSED:" |
b0a10108 | 357 | "String used as the prefix for timestamps logging closing a TODO entry." |
7ac93e3c CD |
358 | :group 'org-keywords |
359 | :type 'string) | |
360 | ||
edd21304 CD |
361 | (defcustom org-clock-string "CLOCK:" |
362 | "String used as prefix for timestamps clocking work hours on an item." | |
363 | :group 'org-keywords | |
364 | :type 'string) | |
365 | ||
891f4676 RS |
366 | (defcustom org-comment-string "COMMENT" |
367 | "Entries starting with this keyword will never be exported. | |
368 | An entry can be toggled between COMMENT and normal with | |
369 | \\[org-toggle-comment]. | |
370 | Changes become only effective after restarting Emacs." | |
371 | :group 'org-keywords | |
372 | :type 'string) | |
373 | ||
b9661543 CD |
374 | (defcustom org-quote-string "QUOTE" |
375 | "Entries starting with this keyword will be exported in fixed-width font. | |
376 | Quoting applies only to the text in the entry following the headline, and does | |
377 | not extend beyond the next headline, even if that is lower level. | |
378 | An entry can be toggled between QUOTE and normal with | |
b0a10108 | 379 | \\[org-toggle-fixed-width-section]." |
b9661543 CD |
380 | :group 'org-keywords |
381 | :type 'string) | |
382 | ||
a3fbe8c4 | 383 | (defconst org-repeat-re |
2a57416f | 384 | "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*\\([.+]?\\+[0-9]+[dwmy]\\)" |
d3f4dbe8 CD |
385 | "Regular expression for specifying repeated events. |
386 | After a match, group 1 contains the repeat expression.") | |
387 | ||
ab27a4a0 CD |
388 | (defgroup org-structure nil |
389 | "Options concerning the general structure of Org-mode files." | |
390 | :tag "Org Structure" | |
391 | :group 'org) | |
634a7d0b | 392 | |
d3f4dbe8 CD |
393 | (defgroup org-reveal-location nil |
394 | "Options about how to make context of a location visible." | |
395 | :tag "Org Reveal Location" | |
396 | :group 'org-structure) | |
397 | ||
8c6fb58b CD |
398 | (defconst org-context-choice |
399 | '(choice | |
400 | (const :tag "Always" t) | |
401 | (const :tag "Never" nil) | |
402 | (repeat :greedy t :tag "Individual contexts" | |
403 | (cons | |
404 | (choice :tag "Context" | |
405 | (const agenda) | |
406 | (const org-goto) | |
407 | (const occur-tree) | |
408 | (const tags-tree) | |
409 | (const link-search) | |
410 | (const mark-goto) | |
411 | (const bookmark-jump) | |
412 | (const isearch) | |
413 | (const default)) | |
414 | (boolean)))) | |
415 | "Contexts for the reveal options.") | |
416 | ||
d3f4dbe8 CD |
417 | (defcustom org-show-hierarchy-above '((default . t)) |
418 | "Non-nil means, show full hierarchy when revealing a location. | |
419 | Org-mode often shows locations in an org-mode file which might have | |
420 | been invisible before. When this is set, the hierarchy of headings | |
421 | above the exposed location is shown. | |
422 | Turning this off for example for sparse trees makes them very compact. | |
423 | Instead of t, this can also be an alist specifying this option for different | |
424 | contexts. Valid contexts are | |
425 | agenda when exposing an entry from the agenda | |
426 | org-goto when using the command `org-goto' on key C-c C-j | |
427 | occur-tree when using the command `org-occur' on key C-c / | |
428 | tags-tree when constructing a sparse tree based on tags matches | |
429 | link-search when exposing search matches associated with a link | |
430 | mark-goto when exposing the jump goal of a mark | |
431 | bookmark-jump when exposing a bookmark location | |
432 | isearch when exiting from an incremental search | |
433 | default default for all contexts not set explicitly" | |
434 | :group 'org-reveal-location | |
8c6fb58b | 435 | :type org-context-choice) |
d3f4dbe8 | 436 | |
a3fbe8c4 | 437 | (defcustom org-show-following-heading '((default . nil)) |
d3f4dbe8 CD |
438 | "Non-nil means, show following heading when revealing a location. |
439 | Org-mode often shows locations in an org-mode file which might have | |
440 | been invisible before. When this is set, the heading following the | |
441 | match is shown. | |
442 | Turning this off for example for sparse trees makes them very compact, | |
443 | but makes it harder to edit the location of the match. In such a case, | |
444 | use the command \\[org-reveal] to show more context. | |
445 | Instead of t, this can also be an alist specifying this option for different | |
446 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
447 | :group 'org-reveal-location | |
8c6fb58b | 448 | :type org-context-choice) |
d3f4dbe8 CD |
449 | |
450 | (defcustom org-show-siblings '((default . nil) (isearch t)) | |
451 | "Non-nil means, show all sibling heading when revealing a location. | |
452 | Org-mode often shows locations in an org-mode file which might have | |
453 | been invisible before. When this is set, the sibling of the current entry | |
454 | heading are all made visible. If `org-show-hierarchy-above' is t, | |
455 | the same happens on each level of the hierarchy above the current entry. | |
456 | ||
457 | By default this is on for the isearch context, off for all other contexts. | |
458 | Turning this off for example for sparse trees makes them very compact, | |
459 | but makes it harder to edit the location of the match. In such a case, | |
460 | use the command \\[org-reveal] to show more context. | |
461 | Instead of t, this can also be an alist specifying this option for different | |
462 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
463 | :group 'org-reveal-location | |
8c6fb58b CD |
464 | :type org-context-choice) |
465 | ||
466 | (defcustom org-show-entry-below '((default . nil)) | |
467 | "Non-nil means, show the entry below a headline when revealing a location. | |
468 | Org-mode often shows locations in an org-mode file which might have | |
469 | been invisible before. When this is set, the text below the headline that is | |
470 | exposed is also shown. | |
471 | ||
472 | By default this is off for all contexts. | |
473 | Instead of t, this can also be an alist specifying this option for different | |
474 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
475 | :group 'org-reveal-location | |
476 | :type org-context-choice) | |
d3f4dbe8 | 477 | |
20908596 CD |
478 | (defcustom org-indirect-buffer-display 'other-window |
479 | "How should indirect tree buffers be displayed? | |
480 | This applies to indirect buffers created with the commands | |
481 | \\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. | |
482 | Valid values are: | |
483 | current-window Display in the current window | |
484 | other-window Just display in another window. | |
485 | dedicated-frame Create one new frame, and re-use it each time. | |
486 | new-frame Make a new frame each time. Note that in this case | |
487 | previously-made indirect buffers are kept, and you need to | |
488 | kill these buffers yourself." | |
489 | :group 'org-structure | |
490 | :group 'org-agenda-windows | |
491 | :type '(choice | |
492 | (const :tag "In current window" current-window) | |
493 | (const :tag "In current frame, other window" other-window) | |
494 | (const :tag "Each time a new frame" new-frame) | |
495 | (const :tag "One dedicated frame" dedicated-frame))) | |
496 | ||
ab27a4a0 CD |
497 | (defgroup org-cycle nil |
498 | "Options concerning visibility cycling in Org-mode." | |
499 | :tag "Org Cycle" | |
500 | :group 'org-structure) | |
634a7d0b | 501 | |
15841868 | 502 | (defcustom org-drawers '("PROPERTIES" "CLOCK") |
5152b597 CD |
503 | "Names of drawers. Drawers are not opened by cycling on the headline above. |
504 | Drawers only open with a TAB on the drawer line itself. A drawer looks like | |
505 | this: | |
506 | :DRAWERNAME: | |
507 | ..... | |
38f8646b CD |
508 | :END: |
509 | The drawer \"PROPERTIES\" is special for capturing properties through | |
03f3cf35 JW |
510 | the property API. |
511 | ||
512 | Drawers can be defined on the per-file basis with a line like: | |
513 | ||
514 | #+DRAWERS: HIDDEN STATE PROPERTIES" | |
5152b597 CD |
515 | :group 'org-structure |
516 | :type '(repeat (string :tag "Drawer Name"))) | |
517 | ||
374585c9 | 518 | (defcustom org-cycle-global-at-bob nil |
4b3a9ba7 CD |
519 | "Cycle globally if cursor is at beginning of buffer and not at a headline. |
520 | This makes it possible to do global cycling without having to use S-TAB or | |
521 | C-u TAB. For this special case to work, the first line of the buffer | |
522 | must not be a headline - it may be empty ot some other text. When used in | |
523 | this way, `org-cycle-hook' is disables temporarily, to make sure the | |
524 | cursor stays at the beginning of the buffer. | |
525 | When this option is nil, don't do anything special at the beginning | |
526 | of the buffer." | |
527 | :group 'org-cycle | |
528 | :type 'boolean) | |
529 | ||
ab27a4a0 CD |
530 | (defcustom org-cycle-emulate-tab t |
531 | "Where should `org-cycle' emulate TAB. | |
7d143c25 CD |
532 | nil Never |
533 | white Only in completely white lines | |
a0d892d4 | 534 | whitestart Only at the beginning of lines, before the first non-white char |
7d143c25 | 535 | t Everywhere except in headlines |
a3fbe8c4 | 536 | exc-hl-bol Everywhere except at the start of a headline |
7d143c25 CD |
537 | If TAB is used in a place where it does not emulate TAB, the current subtree |
538 | visibility is cycled." | |
ab27a4a0 CD |
539 | :group 'org-cycle |
540 | :type '(choice (const :tag "Never" nil) | |
541 | (const :tag "Only in completely white lines" white) | |
7d143c25 | 542 | (const :tag "Before first char in a line" whitestart) |
ab27a4a0 | 543 | (const :tag "Everywhere except in headlines" t) |
a3fbe8c4 | 544 | (const :tag "Everywhere except at bol in headlines" exc-hl-bol) |
ab27a4a0 | 545 | )) |
094f65d4 | 546 | |
a3fbe8c4 CD |
547 | (defcustom org-cycle-separator-lines 2 |
548 | "Number of empty lines needed to keep an empty line between collapsed trees. | |
549 | If you leave an empty line between the end of a subtree and the following | |
550 | headline, this empty line is hidden when the subtree is folded. | |
551 | Org-mode will leave (exactly) one empty line visible if the number of | |
552 | empty lines is equal or larger to the number given in this variable. | |
553 | So the default 2 means, at least 2 empty lines after the end of a subtree | |
554 | are needed to produce free space between a collapsed subtree and the | |
555 | following headline. | |
556 | ||
557 | Special case: when 0, never leave empty lines in collapsed view." | |
558 | :group 'org-cycle | |
559 | :type 'integer) | |
621f83e4 | 560 | (put 'org-cycle-separator-lines 'safe-local-variable 'integerp) |
a3fbe8c4 | 561 | |
6769c0dc | 562 | (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees |
5152b597 | 563 | org-cycle-hide-drawers |
a3fbe8c4 | 564 | org-cycle-show-empty-lines |
6769c0dc | 565 | org-optimize-window-after-visibility-change) |
ab27a4a0 CD |
566 | "Hook that is run after `org-cycle' has changed the buffer visibility. |
567 | The function(s) in this hook must accept a single argument which indicates | |
568 | the new state that was set by the most recent `org-cycle' command. The | |
569 | argument is a symbol. After a global state change, it can have the values | |
570 | `overview', `content', or `all'. After a local state change, it can have | |
571 | the values `folded', `children', or `subtree'." | |
572 | :group 'org-cycle | |
573 | :type 'hook) | |
094f65d4 | 574 | |
ab27a4a0 CD |
575 | (defgroup org-edit-structure nil |
576 | "Options concerning structure editing in Org-mode." | |
577 | :tag "Org Edit Structure" | |
578 | :group 'org-structure) | |
634a7d0b | 579 | |
2a57416f CD |
580 | (defcustom org-odd-levels-only nil |
581 | "Non-nil means, skip even levels and only use odd levels for the outline. | |
582 | This has the effect that two stars are being added/taken away in | |
583 | promotion/demotion commands. It also influences how levels are | |
584 | handled by the exporters. | |
585 | Changing it requires restart of `font-lock-mode' to become effective | |
586 | for fontification also in regions already fontified. | |
587 | You may also set this on a per-file basis by adding one of the following | |
588 | lines to the buffer: | |
589 | ||
590 | #+STARTUP: odd | |
591 | #+STARTUP: oddeven" | |
592 | :group 'org-edit-structure | |
593 | :group 'org-font-lock | |
594 | :type 'boolean) | |
595 | ||
596 | (defcustom org-adapt-indentation t | |
597 | "Non-nil means, adapt indentation when promoting and demoting. | |
598 | When this is set and the *entire* text in an entry is indented, the | |
599 | indentation is increased by one space in a demotion command, and | |
600 | decreased by one in a promotion command. If any line in the entry | |
601 | body starts at column 0, indentation is not changed at all." | |
602 | :group 'org-edit-structure | |
603 | :type 'boolean) | |
604 | ||
1e8fbb6d | 605 | (defcustom org-special-ctrl-a/e nil |
48aaad2d | 606 | "Non-nil means `C-a' and `C-e' behave specially in headlines and items. |
374585c9 | 607 | When t, `C-a' will bring back the cursor to the beginning of the |
a3fbe8c4 | 608 | headline text, i.e. after the stars and after a possible TODO keyword. |
48aaad2d | 609 | In an item, this will be the position after the bullet. |
a3fbe8c4 | 610 | When the cursor is already at that position, another `C-a' will bring |
1e8fbb6d CD |
611 | it to the beginning of the line. |
612 | `C-e' will jump to the end of the headline, ignoring the presence of tags | |
613 | in the headline. A second `C-e' will then jump to the true end of the | |
374585c9 CD |
614 | line, after any tags. |
615 | When set to the symbol `reversed', the first `C-a' or `C-e' works normally, | |
616 | and only a directly following, identical keypress will bring the cursor | |
617 | to the special positions." | |
a3fbe8c4 | 618 | :group 'org-edit-structure |
374585c9 CD |
619 | :type '(choice |
620 | (const :tag "off" nil) | |
621 | (const :tag "after bullet first" t) | |
622 | (const :tag "border first" reversed))) | |
a3fbe8c4 | 623 | |
1e8fbb6d CD |
624 | (if (fboundp 'defvaralias) |
625 | (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) | |
626 | ||
2a57416f CD |
627 | (defcustom org-special-ctrl-k nil |
628 | "Non-nil means `C-k' will behave specially in headlines. | |
629 | When nil, `C-k' will call the default `kill-line' command. | |
630 | When t, the following will happen while the cursor is in the headline: | |
4146eb16 | 631 | |
2a57416f CD |
632 | - When the cursor is at the beginning of a headline, kill the entire |
633 | line and possible the folded subtree below the line. | |
634 | - When in the middle of the headline text, kill the headline up to the tags. | |
635 | - When after the headline text, kill the tags." | |
ab27a4a0 | 636 | :group 'org-edit-structure |
ab27a4a0 | 637 | :type 'boolean) |
891f4676 | 638 | |
621f83e4 CD |
639 | (defcustom org-yank-folded-subtrees t |
640 | "Non-nil means, when yanking subtrees, fold them. | |
641 | If the kill is a single subtree, or a sequence of subtrees, i.e. if | |
642 | it starts with a heading and all other headings in it are either children | |
93b62de8 CD |
643 | or siblings, then fold all the subtrees. However, do this only if no |
644 | text after the yank would be swallowed into a folded tree by this action." | |
645 | :group 'org-edit-structure | |
646 | :type 'boolean) | |
647 | ||
648 | (defcustom org-yank-adjusted-subtrees t | |
649 | "Non-nil means, when yanking subtrees, adjust the level. | |
650 | With this setting, `org-paste-subtree' is used to insert the subtree, see | |
651 | this function for details." | |
621f83e4 CD |
652 | :group 'org-edit-structure |
653 | :type 'boolean) | |
654 | ||
2a57416f CD |
655 | (defcustom org-M-RET-may-split-line '((default . t)) |
656 | "Non-nil means, M-RET will split the line at the cursor position. | |
657 | When nil, it will go to the end of the line before making a | |
658 | new line. | |
659 | You may also set this option in a different way for different | |
660 | contexts. Valid contexts are: | |
661 | ||
662 | headline when creating a new headline | |
663 | item when creating a new item | |
664 | table in a table field | |
665 | default the value to be used for all contexts not explicitly | |
666 | customized" | |
667 | :group 'org-structure | |
668 | :group 'org-table | |
669 | :type '(choice | |
670 | (const :tag "Always" t) | |
671 | (const :tag "Never" nil) | |
672 | (repeat :greedy t :tag "Individual contexts" | |
673 | (cons | |
674 | (choice :tag "Context" | |
675 | (const headline) | |
676 | (const item) | |
677 | (const table) | |
678 | (const default)) | |
679 | (boolean))))) | |
680 | ||
30313b90 | 681 | |
621f83e4 CD |
682 | (defcustom org-insert-heading-respect-content nil |
683 | "Non-nil means, insert new headings after the current subtree. | |
684 | When nil, the new heading is created directly after the current line. | |
685 | The commands \\[org-insert-heading-respect-content] and | |
686 | \\[org-insert-todo-heading-respect-content] turn this variable on | |
687 | for the duration of the command." | |
688 | :group 'org-structure | |
689 | :type 'boolean) | |
690 | ||
3278a016 CD |
691 | (defcustom org-blank-before-new-entry '((heading . nil) |
692 | (plain-list-item . nil)) | |
693 | "Should `org-insert-heading' leave a blank line before new heading/item? | |
694 | The value is an alist, with `heading' and `plain-list-item' as car, | |
695 | and a boolean flag as cdr." | |
696 | :group 'org-edit-structure | |
697 | :type '(list | |
698 | (cons (const heading) (boolean)) | |
699 | (cons (const plain-list-item) (boolean)))) | |
700 | ||
4b3a9ba7 CD |
701 | (defcustom org-insert-heading-hook nil |
702 | "Hook being run after inserting a new heading." | |
703 | :group 'org-edit-structure | |
8c6fb58b | 704 | :type 'hook) |
4b3a9ba7 | 705 | |
ab27a4a0 CD |
706 | (defcustom org-enable-fixed-width-editor t |
707 | "Non-nil means, lines starting with \":\" are treated as fixed-width. | |
708 | This currently only means, they are never auto-wrapped. | |
709 | When nil, such lines will be treated like ordinary lines. | |
710 | See also the QUOTE keyword." | |
711 | :group 'org-edit-structure | |
712 | :type 'boolean) | |
30313b90 | 713 | |
621f83e4 CD |
714 | (defcustom org-edit-src-region-extra nil |
715 | "Additional regexps to identify regions for editing with `org-edit-src-code'. | |
716 | For examples see the function `org-edit-src-find-region-and-lang'. | |
717 | The regular expression identifying the begin marker should end with a newline, | |
718 | and the regexp marking the end line should start with a newline, to make sure | |
719 | there are kept outside the narrowed region." | |
720 | :group 'org-edit-structure | |
721 | :type '(repeat | |
722 | (list | |
723 | (regexp :tag "begin regexp") | |
724 | (regexp :tag "end regexp") | |
725 | (choice :tag "language" | |
726 | (string :tag "specify") | |
727 | (integer :tag "from match group") | |
728 | (const :tag "from `lang' element") | |
729 | (const :tag "from `style' element"))))) | |
730 | ||
731 | (defcustom org-edit-fixed-width-region-mode 'artist-mode | |
732 | "The mode that should be used to edit fixed-width regions. | |
733 | These are the regions where each line starts with a colon." | |
734 | :group 'org-edit-structure | |
735 | :type '(choice | |
736 | (const artist-mode) | |
737 | (const picture-mode) | |
738 | (const fundamental-mode) | |
739 | (function :tag "Other (specify)"))) | |
740 | ||
2a57416f CD |
741 | (defcustom org-goto-auto-isearch t |
742 | "Non-nil means, typing characters in org-goto starts incremental search." | |
743 | :group 'org-edit-structure | |
744 | :type 'boolean) | |
745 | ||
ab27a4a0 CD |
746 | (defgroup org-sparse-trees nil |
747 | "Options concerning sparse trees in Org-mode." | |
748 | :tag "Org Sparse Trees" | |
749 | :group 'org-structure) | |
891f4676 | 750 | |
ab27a4a0 CD |
751 | (defcustom org-highlight-sparse-tree-matches t |
752 | "Non-nil means, highlight all matches that define a sparse tree. | |
753 | The highlights will automatically disappear the next time the buffer is | |
754 | changed by an edit command." | |
755 | :group 'org-sparse-trees | |
15f43010 | 756 | :type 'boolean) |
891f4676 | 757 | |
3278a016 CD |
758 | (defcustom org-remove-highlights-with-change t |
759 | "Non-nil means, any change to the buffer will remove temporary highlights. | |
760 | Such highlights are created by `org-occur' and `org-clock-display'. | |
761 | When nil, `C-c C-c needs to be used to get rid of the highlights. | |
762 | The highlights created by `org-preview-latex-fragment' always need | |
763 | `C-c C-c' to be removed." | |
ab27a4a0 | 764 | :group 'org-sparse-trees |
3278a016 | 765 | :group 'org-time |
891f4676 RS |
766 | :type 'boolean) |
767 | ||
7ac93e3c | 768 | |
ab27a4a0 CD |
769 | (defcustom org-occur-hook '(org-first-headline-recenter) |
770 | "Hook that is run after `org-occur' has constructed a sparse tree. | |
771 | This can be used to recenter the window to show as much of the structure | |
772 | as possible." | |
773 | :group 'org-sparse-trees | |
774 | :type 'hook) | |
d924f2e5 | 775 | |
8c6fb58b CD |
776 | (defgroup org-imenu-and-speedbar nil |
777 | "Options concerning imenu and speedbar in Org-mode." | |
778 | :tag "Org Imenu and Speedbar" | |
779 | :group 'org-structure) | |
780 | ||
781 | (defcustom org-imenu-depth 2 | |
782 | "The maximum level for Imenu access to Org-mode headlines. | |
783 | This also applied for speedbar access." | |
784 | :group 'org-imenu-and-speedbar | |
785 | :type 'number) | |
786 | ||
ab27a4a0 CD |
787 | (defgroup org-table nil |
788 | "Options concerning tables in Org-mode." | |
789 | :tag "Org Table" | |
790 | :group 'org) | |
eb2f9c59 | 791 | |
ab27a4a0 CD |
792 | (defcustom org-enable-table-editor 'optimized |
793 | "Non-nil means, lines starting with \"|\" are handled by the table editor. | |
794 | When nil, such lines will be treated like ordinary lines. | |
eb2f9c59 | 795 | |
ab27a4a0 CD |
796 | When equal to the symbol `optimized', the table editor will be optimized to |
797 | do the following: | |
3278a016 CD |
798 | - Automatic overwrite mode in front of whitespace in table fields. |
799 | This makes the structure of the table stay in tact as long as the edited | |
ab27a4a0 CD |
800 | field does not exceed the column width. |
801 | - Minimize the number of realigns. Normally, the table is aligned each time | |
802 | TAB or RET are pressed to move to another field. With optimization this | |
803 | happens only if changes to a field might have changed the column width. | |
804 | Optimization requires replacing the functions `self-insert-command', | |
805 | `delete-char', and `backward-delete-char' in Org-mode buffers, with a | |
806 | slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is | |
807 | very good at guessing when a re-align will be necessary, but you can always | |
808 | force one with \\[org-ctrl-c-ctrl-c]. | |
eb2f9c59 | 809 | |
ab27a4a0 CD |
810 | If you would like to use the optimized version in Org-mode, but the |
811 | un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. | |
eb2f9c59 | 812 | |
ab27a4a0 CD |
813 | This variable can be used to turn on and off the table editor during a session, |
814 | but in order to toggle optimization, a restart is required. | |
634a7d0b | 815 | |
ab27a4a0 CD |
816 | See also the variable `org-table-auto-blank-field'." |
817 | :group 'org-table | |
818 | :type '(choice | |
819 | (const :tag "off" nil) | |
820 | (const :tag "on" t) | |
821 | (const :tag "on, optimized" optimized))) | |
634a7d0b | 822 | |
ab27a4a0 CD |
823 | (defcustom org-table-tab-recognizes-table.el t |
824 | "Non-nil means, TAB will automatically notice a table.el table. | |
825 | When it sees such a table, it moves point into it and - if necessary - | |
826 | calls `table-recognize-table'." | |
827 | :group 'org-table-editing | |
79c4be8e CD |
828 | :type 'boolean) |
829 | ||
891f4676 RS |
830 | (defgroup org-link nil |
831 | "Options concerning links in Org-mode." | |
832 | :tag "Org Link" | |
833 | :group 'org) | |
834 | ||
3278a016 | 835 | (defvar org-link-abbrev-alist-local nil |
a3fbe8c4 | 836 | "Buffer-local version of `org-link-abbrev-alist', which see. |
3278a016 CD |
837 | The value of this is taken from the #+LINK lines.") |
838 | (make-variable-buffer-local 'org-link-abbrev-alist-local) | |
839 | ||
840 | (defcustom org-link-abbrev-alist nil | |
841 | "Alist of link abbreviations. | |
842 | The car of each element is a string, to be replaced at the start of a link. | |
843 | The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated | |
844 | links in Org-mode buffers can have an optional tag after a double colon, e.g. | |
845 | ||
d3f4dbe8 | 846 | [[linkkey:tag][description]] |
3278a016 CD |
847 | |
848 | If REPLACE is a string, the tag will simply be appended to create the link. | |
ce4fdcb9 CD |
849 | If the string contains \"%s\", the tag will be inserted there. Alternatively, |
850 | the placeholder \"%h\" will cause a url-encoded version of the tag to | |
851 | be inserted at that point (see the function `url-hexify-string'). | |
8c6fb58b CD |
852 | |
853 | REPLACE may also be a function that will be called with the tag as the | |
854 | only argument to create the link, which should be returned as a string. | |
855 | ||
856 | See the manual for examples." | |
3278a016 | 857 | :group 'org-link |
93b62de8 CD |
858 | :type '(repeat |
859 | (cons | |
860 | (string :tag "Protocol") | |
861 | (choice | |
862 | (string :tag "Format") | |
863 | (function))))) | |
3278a016 | 864 | |
ab27a4a0 CD |
865 | (defcustom org-descriptive-links t |
866 | "Non-nil means, hide link part and only show description of bracket links. | |
a0d892d4 | 867 | Bracket links are like [[link][descritpion]]. This variable sets the initial |
ab27a4a0 CD |
868 | state in new org-mode buffers. The setting can then be toggled on a |
869 | per-buffer basis from the Org->Hyperlinks menu." | |
4da1a99d CD |
870 | :group 'org-link |
871 | :type 'boolean) | |
872 | ||
4b3a9ba7 CD |
873 | (defcustom org-link-file-path-type 'adaptive |
874 | "How the path name in file links should be stored. | |
875 | Valid values are: | |
876 | ||
a0d892d4 | 877 | relative Relative to the current directory, i.e. the directory of the file |
4b3a9ba7 | 878 | into which the link is being inserted. |
a0d892d4 JB |
879 | absolute Absolute path, if possible with ~ for home directory. |
880 | noabbrev Absolute path, no abbreviation of home directory. | |
4b3a9ba7 CD |
881 | adaptive Use relative path for files in the current directory and sub- |
882 | directories of it. For other files, use an absolute path." | |
883 | :group 'org-link | |
884 | :type '(choice | |
885 | (const relative) | |
886 | (const absolute) | |
887 | (const noabbrev) | |
888 | (const adaptive))) | |
889 | ||
ab27a4a0 CD |
890 | (defcustom org-activate-links '(bracket angle plain radio tag date) |
891 | "Types of links that should be activated in Org-mode files. | |
892 | This is a list of symbols, each leading to the activation of a certain link | |
893 | type. In principle, it does not hurt to turn on most link types - there may | |
894 | be a small gain when turning off unused link types. The types are: | |
895 | ||
896 | bracket The recommended [[link][description]] or [[link]] links with hiding. | |
897 | angular Links in angular brackes that may contain whitespace like | |
898 | <bbdb:Carsten Dominik>. | |
899 | plain Plain links in normal text, no whitespace, like http://google.com. | |
900 | radio Text that is matched by a radio target, see manual for details. | |
901 | tag Tag settings in a headline (link to tag search). | |
902 | date Time stamps (link to calendar). | |
ab27a4a0 CD |
903 | |
904 | Changing this variable requires a restart of Emacs to become effective." | |
a96ee7df | 905 | :group 'org-link |
ab27a4a0 CD |
906 | :type '(set (const :tag "Double bracket links (new style)" bracket) |
907 | (const :tag "Angular bracket links (old style)" angular) | |
2a57416f | 908 | (const :tag "Plain text links" plain) |
ab27a4a0 CD |
909 | (const :tag "Radio target matches" radio) |
910 | (const :tag "Tags" tag) | |
d3f4dbe8 | 911 | (const :tag "Timestamps" date))) |
ab27a4a0 | 912 | |
20908596 CD |
913 | (defcustom org-make-link-description-function nil |
914 | "Function to use to generate link descriptions from links. If | |
915 | nil the link location will be used. This function must take two | |
916 | parameters; the first is the link and the second the description | |
917 | org-insert-link has generated, and should return the description | |
918 | to use." | |
919 | :group 'org-link | |
920 | :type 'function) | |
921 | ||
ab27a4a0 | 922 | (defgroup org-link-store nil |
5bf7807a | 923 | "Options concerning storing links in Org-mode." |
ab27a4a0 CD |
924 | :tag "Org Store Link" |
925 | :group 'org-link) | |
891f4676 | 926 | |
d3f4dbe8 CD |
927 | (defcustom org-email-link-description-format "Email %c: %.30s" |
928 | "Format of the description part of a link to an email or usenet message. | |
929 | The following %-excapes will be replaced by corresponding information: | |
930 | ||
931 | %F full \"From\" field | |
932 | %f name, taken from \"From\" field, address if no name | |
933 | %T full \"To\" field | |
934 | %t first name in \"To\" field, address if no name | |
935 | %c correspondent. Unually \"from NAME\", but if you sent it yourself, it | |
936 | will be \"to NAME\". See also the variable `org-from-is-user-regexp'. | |
937 | %s subject | |
938 | %m message-id. | |
939 | ||
940 | You may use normal field width specification between the % and the letter. | |
941 | This is for example useful to limit the length of the subject. | |
942 | ||
943 | Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" | |
944 | :group 'org-link-store | |
945 | :type 'string) | |
946 | ||
947 | (defcustom org-from-is-user-regexp | |
948 | (let (r1 r2) | |
949 | (when (and user-mail-address (not (string= user-mail-address ""))) | |
950 | (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) | |
951 | (when (and user-full-name (not (string= user-full-name ""))) | |
952 | (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) | |
953 | (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) | |
954 | "Regexp mached against the \"From:\" header of an email or usenet message. | |
955 | It should match if the message is from the user him/herself." | |
956 | :group 'org-link-store | |
957 | :type 'regexp) | |
958 | ||
ff4be292 CD |
959 | (defcustom org-link-to-org-use-id 'create-if-interactive |
960 | "Non-nil means, storing a link to an Org file will use entry ID's. | |
961 | ||
962 | Note that before this variable is even considered, org-id must be loaded, | |
963 | to please customize `org-modules' and turn it on. | |
964 | ||
965 | The variable can have the following values: | |
966 | ||
967 | t Create an ID if needed to make a link to the current entry. | |
968 | ||
969 | create-if-interactive | |
970 | If `org-store-link' is called directly (interactively, as a user | |
971 | command), do create an ID to support the link. But when doing the | |
972 | job for remember, only use the ID if it already exists. The | |
973 | purpose of this setting is to avoid proliferation of unwanted | |
974 | ID's, just because you happen to be in an Org file when you | |
975 | call `org-remember' that automatically and preemptively | |
976 | creates a link. If you do want to get an ID link in a remember | |
977 | template to an entry not having an ID, create it first by | |
978 | explicitly creating a link to it, using `C-c C-l' first. | |
979 | ||
980 | use-existing | |
981 | Use existing ID, do not create one. | |
982 | ||
983 | nil Never use an ID to make a link, instead link using a text search for | |
984 | the headline text." | |
985 | :group 'org-link-store | |
986 | :type '(choice | |
987 | (const :tag "Create ID to make link" t) | |
988 | (const :tag "Create if string link interactively" | |
989 | 'create-if-interactive) | |
990 | (const :tag "Only use existing" 'use-existing) | |
991 | (const :tag "Do not use ID to create link" nil))) | |
992 | ||
f425a6ea CD |
993 | (defcustom org-context-in-file-links t |
994 | "Non-nil means, file links from `org-store-link' contain context. | |
a96ee7df | 995 | A search string will be added to the file name with :: as separator and |
f425a6ea CD |
996 | used to find the context when the link is activated by the command |
997 | `org-open-at-point'. | |
891f4676 RS |
998 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') |
999 | negates this setting for the duration of the command." | |
ab27a4a0 | 1000 | :group 'org-link-store |
891f4676 RS |
1001 | :type 'boolean) |
1002 | ||
1003 | (defcustom org-keep-stored-link-after-insertion nil | |
1004 | "Non-nil means, keep link in list for entire session. | |
1005 | ||
1006 | The command `org-store-link' adds a link pointing to the current | |
2dd9129f | 1007 | location to an internal list. These links accumulate during a session. |
891f4676 RS |
1008 | The command `org-insert-link' can be used to insert links into any |
1009 | Org-mode file (offering completion for all stored links). When this | |
634a7d0b | 1010 | option is nil, every link which has been inserted once using \\[org-insert-link] |
891f4676 RS |
1011 | will be removed from the list, to make completing the unused links |
1012 | more efficient." | |
ab27a4a0 CD |
1013 | :group 'org-link-store |
1014 | :type 'boolean) | |
1015 | ||
ab27a4a0 | 1016 | (defgroup org-link-follow nil |
5bf7807a | 1017 | "Options concerning following links in Org-mode." |
ab27a4a0 CD |
1018 | :tag "Org Follow Link" |
1019 | :group 'org-link) | |
1020 | ||
ce4fdcb9 CD |
1021 | (defcustom org-link-translation-function nil |
1022 | "Function to translate links with different syntax to Org syntax. | |
1023 | This can be used to translate links created for example by the Planner | |
1024 | or emacs-wiki packages to Org syntax. | |
1025 | The function must accept two parameters, a TYPE containing the link | |
1026 | protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, | |
1027 | which is everything after the link protocol. It should return a cons | |
1028 | with possibly modifed values of type and path. | |
1029 | Org contains a function for this, so if you set this variable to | |
1030 | `org-translate-link-from-planner', you should be able follow many | |
1031 | links created by planner." | |
1032 | :group 'org-link-follow | |
1033 | :type 'function) | |
1034 | ||
2a57416f CD |
1035 | (defcustom org-follow-link-hook nil |
1036 | "Hook that is run after a link has been followed." | |
1037 | :group 'org-link-follow | |
1038 | :type 'hook) | |
1039 | ||
ab27a4a0 CD |
1040 | (defcustom org-tab-follows-link nil |
1041 | "Non-nil means, on links TAB will follow the link. | |
1042 | Needs to be set before org.el is loaded." | |
1043 | :group 'org-link-follow | |
1044 | :type 'boolean) | |
1045 | ||
1046 | (defcustom org-return-follows-link nil | |
1047 | "Non-nil means, on links RET will follow the link. | |
1048 | Needs to be set before org.el is loaded." | |
1049 | :group 'org-link-follow | |
891f4676 RS |
1050 | :type 'boolean) |
1051 | ||
2a57416f CD |
1052 | (defcustom org-mouse-1-follows-link |
1053 | (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) | |
a4b39e39 | 1054 | "Non-nil means, mouse-1 on a link will follow the link. |
2a57416f | 1055 | A longer mouse click will still set point. Does not work on XEmacs. |
a4b39e39 CD |
1056 | Needs to be set before org.el is loaded." |
1057 | :group 'org-link-follow | |
1058 | :type 'boolean) | |
1059 | ||
ab27a4a0 CD |
1060 | (defcustom org-mark-ring-length 4 |
1061 | "Number of different positions to be recorded in the ring | |
1062 | Changing this requires a restart of Emacs to work correctly." | |
1063 | :group 'org-link-follow | |
1064 | :type 'interger) | |
1065 | ||
891f4676 RS |
1066 | (defcustom org-link-frame-setup |
1067 | '((vm . vm-visit-folder-other-frame) | |
1068 | (gnus . gnus-other-frame) | |
1069 | (file . find-file-other-window)) | |
1070 | "Setup the frame configuration for following links. | |
1071 | When following a link with Emacs, it may often be useful to display | |
1072 | this link in another window or frame. This variable can be used to | |
1073 | set this up for the different types of links. | |
1074 | For VM, use any of | |
634a7d0b CD |
1075 | `vm-visit-folder' |
1076 | `vm-visit-folder-other-frame' | |
891f4676 | 1077 | For Gnus, use any of |
634a7d0b CD |
1078 | `gnus' |
1079 | `gnus-other-frame' | |
93b62de8 | 1080 | `org-gnus-no-new-news' |
891f4676 | 1081 | For FILE, use any of |
634a7d0b CD |
1082 | `find-file' |
1083 | `find-file-other-window' | |
1084 | `find-file-other-frame' | |
891f4676 RS |
1085 | For the calendar, use the variable `calendar-setup'. |
1086 | For BBDB, it is currently only possible to display the matches in | |
1087 | another window." | |
ab27a4a0 | 1088 | :group 'org-link-follow |
891f4676 | 1089 | :type '(list |
c8d16429 CD |
1090 | (cons (const vm) |
1091 | (choice | |
1092 | (const vm-visit-folder) | |
1093 | (const vm-visit-folder-other-window) | |
1094 | (const vm-visit-folder-other-frame))) | |
1095 | (cons (const gnus) | |
1096 | (choice | |
1097 | (const gnus) | |
93b62de8 CD |
1098 | (const gnus-other-frame) |
1099 | (const org-gnus-no-new-news))) | |
c8d16429 CD |
1100 | (cons (const file) |
1101 | (choice | |
1102 | (const find-file) | |
1103 | (const find-file-other-window) | |
1104 | (const find-file-other-frame))))) | |
891f4676 | 1105 | |
3278a016 CD |
1106 | (defcustom org-display-internal-link-with-indirect-buffer nil |
1107 | "Non-nil means, use indirect buffer to display infile links. | |
1108 | Activating internal links (from one location in a file to another location | |
1109 | in the same file) normally just jumps to the location. When the link is | |
1110 | activated with a C-u prefix (or with mouse-3), the link is displayed in | |
1111 | another window. When this option is set, the other window actually displays | |
1112 | an indirect buffer clone of the current buffer, to avoid any visibility | |
1113 | changes to the current buffer." | |
1114 | :group 'org-link-follow | |
1115 | :type 'boolean) | |
1116 | ||
891f4676 | 1117 | (defcustom org-open-non-existing-files nil |
d3f4dbe8 | 1118 | "Non-nil means, `org-open-file' will open non-existing files. |
891f4676 | 1119 | When nil, an error will be generated." |
ab27a4a0 | 1120 | :group 'org-link-follow |
891f4676 RS |
1121 | :type 'boolean) |
1122 | ||
2c3ad40d CD |
1123 | (defcustom org-open-directory-means-index-dot-org nil |
1124 | "Non-nil means, a link to a directory really means to index.org. | |
1125 | When nil, following a directory link will run dired or open a finder/explorer | |
1126 | window on that directory." | |
1127 | :group 'org-link-follow | |
1128 | :type 'boolean) | |
1129 | ||
3278a016 CD |
1130 | (defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") |
1131 | "Function and arguments to call for following mailto links. | |
1132 | This is a list with the first element being a lisp function, and the | |
1133 | remaining elements being arguments to the function. In string arguments, | |
1134 | %a will be replaced by the address, and %s will be replaced by the subject | |
1135 | if one was given like in <mailto:arthur@galaxy.org::this subject>." | |
1136 | :group 'org-link-follow | |
1137 | :type '(choice | |
1138 | (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) | |
1139 | (const :tag "compose-mail" (compose-mail "%a" "%s")) | |
1140 | (const :tag "message-mail" (message-mail "%a" "%s")) | |
1141 | (cons :tag "other" (function) (repeat :tag "argument" sexp)))) | |
1142 | ||
4b3a9ba7 | 1143 | (defcustom org-confirm-shell-link-function 'yes-or-no-p |
891f4676 | 1144 | "Non-nil means, ask for confirmation before executing shell links. |
03f3cf35 | 1145 | Shell links can be dangerous: just think about a link |
ab27a4a0 CD |
1146 | |
1147 | [[shell:rm -rf ~/*][Google Search]] | |
1148 | ||
03f3cf35 | 1149 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1150 | but really it would remove your entire home directory. |
03f3cf35 JW |
1151 | Therefore we advise against setting this variable to nil. |
1152 | Just change it to `y-or-n-p' of you want to confirm with a | |
1153 | single keystroke rather than having to type \"yes\"." | |
4b3a9ba7 CD |
1154 | :group 'org-link-follow |
1155 | :type '(choice | |
1156 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
1157 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
1158 | (const :tag "no confirmation (dangerous)" nil))) | |
1159 | ||
1160 | (defcustom org-confirm-elisp-link-function 'yes-or-no-p | |
03f3cf35 JW |
1161 | "Non-nil means, ask for confirmation before executing Emacs Lisp links. |
1162 | Elisp links can be dangerous: just think about a link | |
4b3a9ba7 CD |
1163 | |
1164 | [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] | |
1165 | ||
03f3cf35 | 1166 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1167 | but really it would remove your entire home directory. |
03f3cf35 JW |
1168 | Therefore we advise against setting this variable to nil. |
1169 | Just change it to `y-or-n-p' of you want to confirm with a | |
1170 | single keystroke rather than having to type \"yes\"." | |
ab27a4a0 CD |
1171 | :group 'org-link-follow |
1172 | :type '(choice | |
1173 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
1174 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
1175 | (const :tag "no confirmation (dangerous)" nil))) | |
891f4676 | 1176 | |
ee53c9b7 | 1177 | (defconst org-file-apps-defaults-gnu |
6769c0dc | 1178 | '((remote . emacs) |
93b62de8 | 1179 | (system . mailcap) |
6769c0dc | 1180 | (t . mailcap)) |
b0a10108 | 1181 | "Default file applications on a UNIX or GNU/Linux system. |
891f4676 RS |
1182 | See `org-file-apps'.") |
1183 | ||
1184 | (defconst org-file-apps-defaults-macosx | |
6769c0dc | 1185 | '((remote . emacs) |
3278a016 | 1186 | (t . "open %s") |
93b62de8 | 1187 | (system . "open %s") |
891f4676 | 1188 | ("ps.gz" . "gv %s") |
891f4676 RS |
1189 | ("eps.gz" . "gv %s") |
1190 | ("dvi" . "xdvi %s") | |
1191 | ("fig" . "xfig %s")) | |
1192 | "Default file applications on a MacOS X system. | |
1193 | The system \"open\" is known as a default, but we use X11 applications | |
1194 | for some files for which the OS does not have a good default. | |
1195 | See `org-file-apps'.") | |
1196 | ||
1197 | (defconst org-file-apps-defaults-windowsnt | |
c44f0d75 | 1198 | (list |
6769c0dc CD |
1199 | '(remote . emacs) |
1200 | (cons t | |
93b62de8 CD |
1201 | (list (if (featurep 'xemacs) |
1202 | 'mswindows-shell-execute | |
1203 | 'w32-shell-execute) | |
1204 | "open" 'file)) | |
1205 | (cons 'system | |
6769c0dc CD |
1206 | (list (if (featurep 'xemacs) |
1207 | 'mswindows-shell-execute | |
1208 | 'w32-shell-execute) | |
1209 | "open" 'file))) | |
891f4676 RS |
1210 | "Default file applications on a Windows NT system. |
1211 | The system \"open\" is used for most files. | |
1212 | See `org-file-apps'.") | |
1213 | ||
1214 | (defcustom org-file-apps | |
1215 | '( | |
621f83e4 CD |
1216 | (auto-mode . emacs) |
1217 | ("\\.x?html?\\'" . default) | |
71d35b24 | 1218 | ("\\.pdf\\'" . default) |
891f4676 RS |
1219 | ) |
1220 | "External applications for opening `file:path' items in a document. | |
1221 | Org-mode uses system defaults for different file types, but | |
1222 | you can use this variable to set the application for a given file | |
4b3a9ba7 CD |
1223 | extension. The entries in this list are cons cells where the car identifies |
1224 | files and the cdr the corresponding command. Possible values for the | |
1225 | file identifier are | |
621f83e4 CD |
1226 | \"regex\" Regular expression matched against the file name. For backward |
1227 | compatibility, this can also be a string with only alphanumeric | |
1228 | characters, which is then interpreted as an extension. | |
4b3a9ba7 | 1229 | `directory' Matches a directory |
5137195a | 1230 | `remote' Matches a remote file, accessible through tramp or efs. |
c44f0d75 | 1231 | Remote files most likely should be visited through Emacs |
6769c0dc | 1232 | because external applications cannot handle such paths. |
621f83e4 | 1233 | `auto-mode' Matches files that are mached by any entry in `auto-mode-alist', |
93b62de8 | 1234 | so all files Emacs knows how to handle. Using this with |
621f83e4 CD |
1235 | command `emacs' will open most files in Emacs. Beware that this |
1236 | will also open html files insite Emacs, unless you add | |
1237 | (\"html\" . default) to the list as well. | |
1238 | t Default for files not matched by any of the other options. | |
93b62de8 CD |
1239 | `system' The system command to open files, like `open' on Windows |
1240 | and Mac OS X, and mailcap under GNU/Linux. This is the command | |
1241 | that will be selected if you call `C-c C-o' with a double | |
1242 | `C-u C-u' prefix. | |
4b3a9ba7 CD |
1243 | |
1244 | Possible values for the command are: | |
1245 | `emacs' The file will be visited by the current Emacs process. | |
621f83e4 CD |
1246 | `default' Use the default application for this file type, which is the |
1247 | association for t in the list, most likely in the system-specific | |
1248 | part. | |
1249 | This can be used to overrule an unwanted seting in the | |
1250 | system-specific variable. | |
93b62de8 CD |
1251 | `system' Use the system command for opening files, like \"open\". |
1252 | This command is specified by the entry whose car is `system'. | |
1253 | Most likely, the system-specific version of this variable | |
1254 | does define this command, but you can overrule/replace it | |
1255 | here. | |
4b3a9ba7 CD |
1256 | string A command to be executed by a shell; %s will be replaced |
1257 | by the path to the file. | |
1258 | sexp A Lisp form which will be evaluated. The file path will | |
1259 | be available in the Lisp variable `file'. | |
891f4676 RS |
1260 | For more examples, see the system specific constants |
1261 | `org-file-apps-defaults-macosx' | |
1262 | `org-file-apps-defaults-windowsnt' | |
ee53c9b7 | 1263 | `org-file-apps-defaults-gnu'." |
ab27a4a0 | 1264 | :group 'org-link-follow |
891f4676 | 1265 | :type '(repeat |
a96ee7df CD |
1266 | (cons (choice :value "" |
1267 | (string :tag "Extension") | |
93b62de8 | 1268 | (const :tag "System command to open files" system) |
a96ee7df | 1269 | (const :tag "Default for unrecognized files" t) |
6769c0dc | 1270 | (const :tag "Remote file" remote) |
621f83e4 CD |
1271 | (const :tag "Links to a directory" directory) |
1272 | (const :tag "Any files that have Emacs modes" | |
1273 | auto-mode)) | |
c8d16429 | 1274 | (choice :value "" |
a96ee7df | 1275 | (const :tag "Visit with Emacs" emacs) |
93b62de8 CD |
1276 | (const :tag "Use default" default) |
1277 | (const :tag "Use the system command" system) | |
a96ee7df CD |
1278 | (string :tag "Command") |
1279 | (sexp :tag "Lisp form"))))) | |
891f4676 | 1280 | |
20908596 CD |
1281 | (defgroup org-refile nil |
1282 | "Options concerning refiling entries in Org-mode." | |
d60b1ba1 | 1283 | :tag "Org Refile" |
891f4676 RS |
1284 | :group 'org) |
1285 | ||
1286 | (defcustom org-directory "~/org" | |
1287 | "Directory with org files. | |
1288 | This directory will be used as default to prompt for org files. | |
1289 | Used by the hooks for remember.el." | |
20908596 | 1290 | :group 'org-refile |
891f4676 RS |
1291 | :group 'org-remember |
1292 | :type 'directory) | |
1293 | ||
0a505855 | 1294 | (defcustom org-default-notes-file (convert-standard-filename "~/.notes") |
891f4676 RS |
1295 | "Default target for storing notes. |
1296 | Used by the hooks for remember.el. This can be a string, or nil to mean | |
d3f4dbe8 CD |
1297 | the value of `remember-data-file'. |
1298 | You can set this on a per-template basis with the variable | |
1299 | `org-remember-templates'." | |
20908596 | 1300 | :group 'org-refile |
891f4676 RS |
1301 | :group 'org-remember |
1302 | :type '(choice | |
c8d16429 CD |
1303 | (const :tag "Default from remember-data-file" nil) |
1304 | file)) | |
891f4676 | 1305 | |
2a57416f CD |
1306 | (defcustom org-goto-interface 'outline |
1307 | "The default interface to be used for `org-goto'. | |
1308 | Allowed vaues are: | |
1309 | outline The interface shows an outline of the relevant file | |
1310 | and the correct heading is found by moving through | |
1311 | the outline or by searching with incremental search. | |
1312 | outline-path-completion Headlines in the current buffer are offered via | |
d60b1ba1 CD |
1313 | completion. This is the interface also used by |
1314 | the refile command." | |
20908596 | 1315 | :group 'org-refile |
2a57416f CD |
1316 | :type '(choice |
1317 | (const :tag "Outline" outline) | |
1318 | (const :tag "Outline-path-completion" outline-path-completion))) | |
8c6fb58b | 1319 | |
891f4676 RS |
1320 | (defcustom org-reverse-note-order nil |
1321 | "Non-nil means, store new notes at the beginning of a file or entry. | |
8c6fb58b CD |
1322 | When nil, new notes will be filed to the end of a file or entry. |
1323 | This can also be a list with cons cells of regular expressions that | |
1324 | are matched against file names, and values." | |
891f4676 | 1325 | :group 'org-remember |
d60b1ba1 | 1326 | :group 'org-refile |
891f4676 | 1327 | :type '(choice |
c8d16429 CD |
1328 | (const :tag "Reverse always" t) |
1329 | (const :tag "Reverse never" nil) | |
1330 | (repeat :tag "By file name regexp" | |
1331 | (cons regexp boolean)))) | |
891f4676 | 1332 | |
8c6fb58b CD |
1333 | (defcustom org-refile-targets nil |
1334 | "Targets for refiling entries with \\[org-refile]. | |
1335 | This is list of cons cells. Each cell contains: | |
1336 | - a specification of the files to be considered, either a list of files, | |
20908596 | 1337 | or a symbol whose function or variable value will be used to retrieve |
8c6fb58b CD |
1338 | a file name or a list of file names. Nil means, refile to a different |
1339 | heading in the current buffer. | |
1340 | - A specification of how to find candidate refile targets. This may be | |
1341 | any of | |
1342 | - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. | |
1343 | This tag has to be present in all target headlines, inheritance will | |
1344 | not be considered. | |
1345 | - a cons cell (:todo . \"KEYWORD\") to identify refile targets by | |
1346 | todo keyword. | |
1347 | - a cons cell (:regexp . \"REGEXP\") with a regular expression matching | |
1348 | headlines that are refiling targets. | |
1349 | - a cons cell (:level . N). Any headline of level N is considered a target. | |
621f83e4 CD |
1350 | - a cons cell (:maxlevel . N). Any headline with level <= N is a target. |
1351 | ||
1352 | When this variable is nil, all top-level headlines in the current buffer | |
93b62de8 | 1353 | are used, equivalent to the value `((nil . (:level . 1))'." |
d60b1ba1 | 1354 | :group 'org-refile |
8c6fb58b CD |
1355 | :type '(repeat |
1356 | (cons | |
1357 | (choice :value org-agenda-files | |
1358 | (const :tag "All agenda files" org-agenda-files) | |
1359 | (const :tag "Current buffer" nil) | |
1360 | (function) (variable) (file)) | |
1361 | (choice :tag "Identify target headline by" | |
ce4fdcb9 CD |
1362 | (cons :tag "Specific tag" (const :value :tag) (string)) |
1363 | (cons :tag "TODO keyword" (const :value :todo) (string)) | |
1364 | (cons :tag "Regular expression" (const :value :regexp) (regexp)) | |
1365 | (cons :tag "Level number" (const :value :level) (integer)) | |
1366 | (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) | |
8c6fb58b CD |
1367 | |
1368 | (defcustom org-refile-use-outline-path nil | |
1369 | "Non-nil means, provide refile targets as paths. | |
1370 | So a level 3 headline will be available as level1/level2/level3. | |
1371 | When the value is `file', also include the file name (without directory) | |
1372 | into the path. When `full-file-path', include the full file path." | |
d60b1ba1 | 1373 | :group 'org-refile |
8c6fb58b CD |
1374 | :type '(choice |
1375 | (const :tag "Not" nil) | |
1376 | (const :tag "Yes" t) | |
1377 | (const :tag "Start with file name" file) | |
1378 | (const :tag "Start with full file path" full-file-path))) | |
1379 | ||
d60b1ba1 CD |
1380 | (defcustom org-outline-path-complete-in-steps t |
1381 | "Non-nil means, complete the outline path in hierarchical steps. | |
1382 | When Org-mode uses the refile interface to select an outline path | |
1383 | \(see variable `org-refile-use-outline-path'), the completion of | |
1384 | the path can be done is a single go, or if can be done in steps down | |
1385 | the headline hierarchy. Going in steps is probably the best if you | |
1386 | do not use a special completion package like `ido' or `icicles'. | |
1387 | However, when using these packages, going in one step can be very | |
1388 | fast, while still showing the whole path to the entry." | |
1389 | :group 'org-refile | |
1390 | :type 'boolean) | |
1391 | ||
ab27a4a0 CD |
1392 | (defgroup org-todo nil |
1393 | "Options concerning TODO items in Org-mode." | |
1394 | :tag "Org TODO" | |
891f4676 RS |
1395 | :group 'org) |
1396 | ||
d3f4dbe8 CD |
1397 | (defgroup org-progress nil |
1398 | "Options concerning Progress logging in Org-mode." | |
1399 | :tag "Org Progress" | |
1400 | :group 'org-time) | |
1401 | ||
a3fbe8c4 CD |
1402 | (defcustom org-todo-keywords '((sequence "TODO" "DONE")) |
1403 | "List of TODO entry keyword sequences and their interpretation. | |
1404 | \\<org-mode-map>This is a list of sequences. | |
1405 | ||
1406 | Each sequence starts with a symbol, either `sequence' or `type', | |
1407 | indicating if the keywords should be interpreted as a sequence of | |
1408 | action steps, or as different types of TODO items. The first | |
1409 | keywords are states requiring action - these states will select a headline | |
1410 | for inclusion into the global TODO list Org-mode produces. If one of | |
1411 | the \"keywords\" is the vertical bat \"|\" the remaining keywords | |
1412 | signify that no further action is necessary. If \"|\" is not found, | |
1413 | the last keyword is treated as the only DONE state of the sequence. | |
1414 | ||
1415 | The command \\[org-todo] cycles an entry through these states, and one | |
ab27a4a0 | 1416 | additional state where no keyword is present. For details about this |
a3fbe8c4 CD |
1417 | cycling, see the manual. |
1418 | ||
1419 | TODO keywords and interpretation can also be set on a per-file basis with | |
1420 | the special #+SEQ_TODO and #+TYP_TODO lines. | |
1421 | ||
2a57416f CD |
1422 | Each keyword can optionally specify a character for fast state selection |
1423 | \(in combination with the variable `org-use-fast-todo-selection') | |
1424 | and specifiers for state change logging, using the same syntax | |
1425 | that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says | |
1426 | that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" | |
1427 | indicates to record a time stamp each time this state is selected. | |
1428 | ||
1429 | Each keyword may also specify if a timestamp or a note should be | |
1430 | recorded when entering or leaving the state, by adding additional | |
1431 | characters in the parenthesis after the keyword. This looks like this: | |
1432 | \"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to | |
1433 | record only the time of the state change. With X and Y being either | |
1434 | \"@\" or \"!\", \"X/Y\" means use X when entering the state, and use | |
1435 | Y when leaving the state if and only if the *target* state does not | |
1436 | define X. You may omit any of the fast-selection key or X or /Y, | |
1437 | so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. | |
1438 | ||
a3fbe8c4 CD |
1439 | For backward compatibility, this variable may also be just a list |
1440 | of keywords - in this case the interptetation (sequence or type) will be | |
1441 | taken from the (otherwise obsolete) variable `org-todo-interpretation'." | |
ab27a4a0 CD |
1442 | :group 'org-todo |
1443 | :group 'org-keywords | |
a3fbe8c4 CD |
1444 | :type '(choice |
1445 | (repeat :tag "Old syntax, just keywords" | |
1446 | (string :tag "Keyword")) | |
1447 | (repeat :tag "New syntax" | |
1448 | (cons | |
1449 | (choice | |
1450 | :tag "Interpretation" | |
1451 | (const :tag "Sequence (cycling hits every state)" sequence) | |
1452 | (const :tag "Type (cycling directly to DONE)" type)) | |
1453 | (repeat | |
1454 | (string :tag "Keyword")))))) | |
1455 | ||
2a57416f CD |
1456 | (defvar org-todo-keywords-1 nil |
1457 | "All TODO and DONE keywords active in a buffer.") | |
a3fbe8c4 CD |
1458 | (make-variable-buffer-local 'org-todo-keywords-1) |
1459 | (defvar org-todo-keywords-for-agenda nil) | |
1460 | (defvar org-done-keywords-for-agenda nil) | |
621f83e4 CD |
1461 | (defvar org-todo-keyword-alist-for-agenda nil) |
1462 | (defvar org-tag-alist-for-agenda nil) | |
20908596 | 1463 | (defvar org-agenda-contributing-files nil) |
a3fbe8c4 CD |
1464 | (defvar org-not-done-keywords nil) |
1465 | (make-variable-buffer-local 'org-not-done-keywords) | |
1466 | (defvar org-done-keywords nil) | |
1467 | (make-variable-buffer-local 'org-done-keywords) | |
1468 | (defvar org-todo-heads nil) | |
1469 | (make-variable-buffer-local 'org-todo-heads) | |
1470 | (defvar org-todo-sets nil) | |
1471 | (make-variable-buffer-local 'org-todo-sets) | |
d5098885 JW |
1472 | (defvar org-todo-log-states nil) |
1473 | (make-variable-buffer-local 'org-todo-log-states) | |
a3fbe8c4 CD |
1474 | (defvar org-todo-kwd-alist nil) |
1475 | (make-variable-buffer-local 'org-todo-kwd-alist) | |
0b8568f5 JW |
1476 | (defvar org-todo-key-alist nil) |
1477 | (make-variable-buffer-local 'org-todo-key-alist) | |
1478 | (defvar org-todo-key-trigger nil) | |
1479 | (make-variable-buffer-local 'org-todo-key-trigger) | |
791d856f | 1480 | |
ab27a4a0 CD |
1481 | (defcustom org-todo-interpretation 'sequence |
1482 | "Controls how TODO keywords are interpreted. | |
a3fbe8c4 CD |
1483 | This variable is in principle obsolete and is only used for |
1484 | backward compatibility, if the interpretation of todo keywords is | |
1485 | not given already in `org-todo-keywords'. See that variable for | |
1486 | more information." | |
ab27a4a0 CD |
1487 | :group 'org-todo |
1488 | :group 'org-keywords | |
1489 | :type '(choice (const sequence) | |
1490 | (const type))) | |
28e5b051 | 1491 | |
0b8568f5 JW |
1492 | (defcustom org-use-fast-todo-selection 'prefix |
1493 | "Non-nil means, use the fast todo selection scheme with C-c C-t. | |
1494 | This variable describes if and under what circumstances the cycling | |
1495 | mechanism for TODO keywords will be replaced by a single-key, direct | |
1496 | selection scheme. | |
1497 | ||
1498 | When nil, fast selection is never used. | |
1499 | ||
1500 | When the symbol `prefix', it will be used when `org-todo' is called with | |
1501 | a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' | |
1502 | in an agenda buffer. | |
1503 | ||
1504 | When t, fast selection is used by default. In this case, the prefix | |
1505 | argument forces cycling instead. | |
1506 | ||
1507 | In all cases, the special interface is only used if access keys have actually | |
1508 | been assigned by the user, i.e. if keywords in the configuration are followed | |
1509 | by a letter in parenthesis, like TODO(t)." | |
1510 | :group 'org-todo | |
1511 | :type '(choice | |
1512 | (const :tag "Never" nil) | |
1513 | (const :tag "By default" t) | |
1514 | (const :tag "Only with C-u C-c C-t" prefix))) | |
1515 | ||
b349f79f CD |
1516 | (defcustom org-provide-todo-statistics t |
1517 | "Non-nil means, update todo statistics after insert and toggle. | |
1518 | When this is set, todo statistics is updated in the parent of the current | |
1519 | entry each time a todo state is changed." | |
1520 | :group 'org-todo | |
1521 | :type 'boolean) | |
1522 | ||
ab27a4a0 CD |
1523 | (defcustom org-after-todo-state-change-hook nil |
1524 | "Hook which is run after the state of a TODO item was changed. | |
1525 | The new state (a string with a TODO keyword, or nil) is available in the | |
1526 | Lisp variable `state'." | |
1527 | :group 'org-todo | |
1528 | :type 'hook) | |
891f4676 | 1529 | |
71d35b24 CD |
1530 | (defcustom org-todo-state-tags-triggers nil |
1531 | "Tag changes that should be triggered by TODO state changes. | |
1532 | This is a list. Each entry is | |
1533 | ||
1534 | (state-change (tag . flag) .......) | |
1535 | ||
1536 | State-change can be a string with a state, and empty string to indicate the | |
1537 | state that has no TODO keyword, or it can be one of the symbols `todo' | |
1538 | or `done', meaning any not-done or done state, respectively." | |
1539 | :group 'org-todo | |
1540 | :group 'org-tags | |
1541 | :type '(repeat | |
1542 | (cons (choice :tag "When changing to" | |
1543 | (const :tag "Not-done state" todo) | |
1544 | (const :tag "Done state" done) | |
1545 | (string :tag "State")) | |
1546 | (repeat | |
1547 | (cons :tag "Tag action" | |
1548 | (string :tag "Tag") | |
1549 | (choice (const :tag "Add" t) (const :tag "Remove" nil))))))) | |
1550 | ||
ab27a4a0 | 1551 | (defcustom org-log-done nil |
2a57416f CD |
1552 | "Non-nil means, record a CLOSED timestamp when moving an entry to DONE. |
1553 | When equal to the list (done), also prompt for a closing note. | |
1554 | This can also be configured on a per-file basis by adding one of | |
4b3a9ba7 CD |
1555 | the following lines anywhere in the buffer: |
1556 | ||
d3f4dbe8 | 1557 | #+STARTUP: logdone |
d3f4dbe8 | 1558 | #+STARTUP: lognotedone |
2a57416f | 1559 | #+STARTUP: nologdone" |
ab27a4a0 | 1560 | :group 'org-todo |
d3f4dbe8 | 1561 | :group 'org-progress |
3278a016 | 1562 | :type '(choice |
2a57416f CD |
1563 | (const :tag "No logging" nil) |
1564 | (const :tag "Record CLOSED timestamp" time) | |
1565 | (const :tag "Record CLOSED timestamp with closing note." note))) | |
1566 | ||
1567 | ;; Normalize old uses of org-log-done. | |
1568 | (cond | |
1569 | ((eq org-log-done t) (setq org-log-done 'time)) | |
1570 | ((and (listp org-log-done) (memq 'done org-log-done)) | |
1571 | (setq org-log-done 'note))) | |
1572 | ||
2a57416f | 1573 | (defcustom org-log-note-clock-out nil |
621f83e4 | 1574 | "Non-nil means, record a note when clocking out of an item. |
2a57416f CD |
1575 | This can also be configured on a per-file basis by adding one of |
1576 | the following lines anywhere in the buffer: | |
1577 | ||
1578 | #+STARTUP: lognoteclock-out | |
1579 | #+STARTUP: nolognoteclock-out" | |
1580 | :group 'org-todo | |
1581 | :group 'org-progress | |
1582 | :type 'boolean) | |
d3f4dbe8 | 1583 | |
a3fbe8c4 CD |
1584 | (defcustom org-log-done-with-time t |
1585 | "Non-nil means, the CLOSED time stamp will contain date and time. | |
1586 | When nil, only the date will be recorded." | |
1587 | :group 'org-progress | |
1588 | :type 'boolean) | |
1589 | ||
d3f4dbe8 | 1590 | (defcustom org-log-note-headings |
20908596 | 1591 | '((done . "CLOSING NOTE %t") |
d3f4dbe8 | 1592 | (state . "State %-12s %t") |
20908596 | 1593 | (note . "Note taken on %t") |
d3f4dbe8 | 1594 | (clock-out . "")) |
20908596 | 1595 | "Headings for notes added to entries. |
48aaad2d | 1596 | The value is an alist, with the car being a symbol indicating the note |
3278a016 | 1597 | context, and the cdr is the heading to be used. The heading may also be the |
d3f4dbe8 CD |
1598 | empty string. |
1599 | %t in the heading will be replaced by a time stamp. | |
1600 | %s will be replaced by the new TODO state, in double quotes. | |
1601 | %u will be replaced by the user name. | |
1602 | %U will be replaced by the full user name." | |
3278a016 | 1603 | :group 'org-todo |
d3f4dbe8 | 1604 | :group 'org-progress |
3278a016 CD |
1605 | :type '(list :greedy t |
1606 | (cons (const :tag "Heading when closing an item" done) string) | |
d3f4dbe8 CD |
1607 | (cons (const :tag |
1608 | "Heading when changing todo state (todo sequence only)" | |
1609 | state) string) | |
20908596 | 1610 | (cons (const :tag "Heading when just taking a note" note) string) |
3278a016 | 1611 | (cons (const :tag "Heading when clocking out" clock-out) string))) |
e0e66b8e | 1612 | |
20908596 CD |
1613 | (unless (assq 'note org-log-note-headings) |
1614 | (push '(note . "%t") org-log-note-headings)) | |
1615 | ||
71d35b24 CD |
1616 | (defcustom org-log-state-notes-insert-after-drawers nil |
1617 | "Non-nil means, insert state change notes after any drawers in entry. | |
1618 | Only the drawers that *immediately* follow the headline and the | |
1619 | deadline/scheduled line are skipped. | |
1620 | When nil, insert notes right after the heading and perhaps the line | |
1621 | with deadline/scheduling if present." | |
1622 | :group 'org-todo | |
1623 | :group 'org-progress | |
1624 | :type 'boolean) | |
1625 | ||
48aaad2d CD |
1626 | (defcustom org-log-states-order-reversed t |
1627 | "Non-nil means, the latest state change note will be directly after heading. | |
1628 | When nil, the notes will be orderer according to time." | |
1629 | :group 'org-todo | |
1630 | :group 'org-progress | |
1631 | :type 'boolean) | |
1632 | ||
2a57416f CD |
1633 | (defcustom org-log-repeat 'time |
1634 | "Non-nil means, record moving through the DONE state when triggering repeat. | |
1635 | An auto-repeating tasks is immediately switched back to TODO when marked | |
1636 | done. If you are not logging state changes (by adding \"@\" or \"!\" to | |
b349f79f CD |
1637 | the TODO keyword definition, or recording a closing note by setting |
1638 | `org-log-done', there will be no record of the task moving through DONE. | |
2a57416f CD |
1639 | This variable forces taking a note anyway. Possible values are: |
1640 | ||
1641 | nil Don't force a record | |
1642 | time Record a time stamp | |
1643 | note Record a note | |
1644 | ||
15841868 JW |
1645 | This option can also be set with on a per-file-basis with |
1646 | ||
1647 | #+STARTUP: logrepeat | |
2a57416f | 1648 | #+STARTUP: lognoterepeat |
15841868 JW |
1649 | #+STARTUP: nologrepeat |
1650 | ||
1651 | You can have local logging settings for a subtree by setting the LOGGING | |
1652 | property to one or more of these keywords." | |
d3f4dbe8 CD |
1653 | :group 'org-todo |
1654 | :group 'org-progress | |
2a57416f CD |
1655 | :type '(choice |
1656 | (const :tag "Don't force a record" nil) | |
1657 | (const :tag "Force recording the DONE state" time) | |
1658 | (const :tag "Force recording a note with the DONE state" note))) | |
d3f4dbe8 | 1659 | |
8c6fb58b | 1660 | |
ab27a4a0 | 1661 | (defgroup org-priorities nil |
4146eb16 | 1662 | "Priorities in Org-mode." |
ab27a4a0 CD |
1663 | :tag "Org Priorities" |
1664 | :group 'org-todo) | |
28e5b051 | 1665 | |
a3fbe8c4 CD |
1666 | (defcustom org-highest-priority ?A |
1667 | "The highest priority of TODO items. A character like ?A, ?B etc. | |
1668 | Must have a smaller ASCII number than `org-lowest-priority'." | |
ab27a4a0 CD |
1669 | :group 'org-priorities |
1670 | :type 'character) | |
891f4676 | 1671 | |
ab27a4a0 | 1672 | (defcustom org-lowest-priority ?C |
a3fbe8c4 CD |
1673 | "The lowest priority of TODO items. A character like ?A, ?B etc. |
1674 | Must have a larger ASCII number than `org-highest-priority'." | |
1675 | :group 'org-priorities | |
1676 | :type 'character) | |
1677 | ||
1678 | (defcustom org-default-priority ?B | |
1679 | "The default priority of TODO items. | |
1680 | This is the priority an item get if no explicit priority is given." | |
ab27a4a0 CD |
1681 | :group 'org-priorities |
1682 | :type 'character) | |
1683 | ||
15841868 JW |
1684 | (defcustom org-priority-start-cycle-with-default t |
1685 | "Non-nil means, start with default priority when starting to cycle. | |
1686 | When this is nil, the first step in the cycle will be (depending on the | |
1687 | command used) one higher or lower that the default priority." | |
1688 | :group 'org-priorities | |
1689 | :type 'boolean) | |
1690 | ||
ab27a4a0 CD |
1691 | (defgroup org-time nil |
1692 | "Options concerning time stamps and deadlines in Org-mode." | |
1693 | :tag "Org Time" | |
1694 | :group 'org) | |
1695 | ||
4b3a9ba7 CD |
1696 | (defcustom org-insert-labeled-timestamps-at-point nil |
1697 | "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. | |
1698 | When nil, these labeled time stamps are forces into the second line of an | |
1699 | entry, just after the headline. When scheduling from the global TODO list, | |
1700 | the time stamp will always be forced into the second line." | |
1701 | :group 'org-time | |
1702 | :type 'boolean) | |
1703 | ||
ab27a4a0 CD |
1704 | (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") |
1705 | "Formats for `format-time-string' which are used for time stamps. | |
1706 | It is not recommended to change this constant.") | |
1707 | ||
2a57416f CD |
1708 | (defcustom org-time-stamp-rounding-minutes '(0 5) |
1709 | "Number of minutes to round time stamps to. | |
1710 | These are two values, the first applies when first creating a time stamp. | |
1711 | The second applies when changing it with the commands `S-up' and `S-down'. | |
1712 | When changing the time stamp, this means that it will change in steps | |
5bf7807a | 1713 | of N minutes, as given by the second value. |
2a57416f CD |
1714 | |
1715 | When a setting is 0 or 1, insert the time unmodified. Useful rounding | |
1716 | numbers should be factors of 60, so for example 5, 10, 15. | |
1717 | ||
1718 | When this is larger than 1, you can still force an exact time-stamp by using | |
1719 | a double prefix argument to a time-stamp command like `C-c .' or `C-c !', | |
1720 | and by using a prefix arg to `S-up/down' to specify the exact number | |
1721 | of minutes to shift." | |
ab27a4a0 | 1722 | :group 'org-time |
2a57416f CD |
1723 | :get '(lambda (var) ; Make sure all entries have 5 elements |
1724 | (if (integerp (default-value var)) | |
1725 | (list (default-value var) 5) | |
1726 | (default-value var))) | |
1727 | :type '(list | |
1728 | (integer :tag "when inserting times") | |
1729 | (integer :tag "when modifying times"))) | |
1730 | ||
20908596 | 1731 | ;; Normalize old customizations of this variable. |
2a57416f CD |
1732 | (when (integerp org-time-stamp-rounding-minutes) |
1733 | (setq org-time-stamp-rounding-minutes | |
1734 | (list org-time-stamp-rounding-minutes | |
1735 | org-time-stamp-rounding-minutes))) | |
ab27a4a0 | 1736 | |
3278a016 CD |
1737 | (defcustom org-display-custom-times nil |
1738 | "Non-nil means, overlay custom formats over all time stamps. | |
1739 | The formats are defined through the variable `org-time-stamp-custom-formats'. | |
1740 | To turn this on on a per-file basis, insert anywhere in the file: | |
1741 | #+STARTUP: customtime" | |
1742 | :group 'org-time | |
1743 | :set 'set-default | |
1744 | :type 'sexp) | |
1745 | (make-variable-buffer-local 'org-display-custom-times) | |
1746 | ||
1747 | (defcustom org-time-stamp-custom-formats | |
1748 | '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american | |
1749 | "Custom formats for time stamps. See `format-time-string' for the syntax. | |
1750 | These are overlayed over the default ISO format if the variable | |
b38c6895 CD |
1751 | `org-display-custom-times' is set. Time like %H:%M should be at the |
1752 | end of the second format." | |
3278a016 CD |
1753 | :group 'org-time |
1754 | :type 'sexp) | |
1755 | ||
d3f4dbe8 CD |
1756 | (defun org-time-stamp-format (&optional long inactive) |
1757 | "Get the right format for a time string." | |
1758 | (let ((f (if long (cdr org-time-stamp-formats) | |
1759 | (car org-time-stamp-formats)))) | |
1760 | (if inactive | |
1761 | (concat "[" (substring f 1 -1) "]") | |
1762 | f))) | |
1763 | ||
b349f79f CD |
1764 | (defcustom org-time-clocksum-format "%d:%02d" |
1765 | "The format string used when creating CLOCKSUM lines, or when | |
1766 | org-mode generates a time duration." | |
1767 | :group 'org-time | |
1768 | :type 'string) | |
ce4fdcb9 | 1769 | |
20908596 CD |
1770 | (defcustom org-deadline-warning-days 14 |
1771 | "No. of days before expiration during which a deadline becomes active. | |
1772 | This variable governs the display in sparse trees and in the agenda. | |
1773 | When 0 or negative, it means use this number (the absolute value of it) | |
1774 | even if a deadline has a different individual lead time specified." | |
1775 | :group 'org-time | |
1776 | :group 'org-agenda-daily/weekly | |
1777 | :type 'number) | |
1778 | ||
8c6fb58b CD |
1779 | (defcustom org-read-date-prefer-future t |
1780 | "Non-nil means, assume future for incomplete date input from user. | |
1781 | This affects the following situations: | |
1782 | 1. The user gives a day, but no month. | |
1783 | For example, if today is the 15th, and you enter \"3\", Org-mode will | |
1784 | read this as the third of *next* month. However, if you enter \"17\", | |
1785 | it will be considered as *this* month. | |
1786 | 2. The user gives a month but not a year. | |
1787 | For example, if it is april and you enter \"feb 2\", this will be read | |
1788 | as feb 2, *next* year. \"May 5\", however, will be this year. | |
1789 | ||
20908596 CD |
1790 | Currently this does not work for ISO week specifications. |
1791 | ||
8c6fb58b CD |
1792 | When this option is nil, the current month and year will always be used |
1793 | as defaults." | |
1794 | :group 'org-time | |
1795 | :type 'boolean) | |
1796 | ||
1797 | (defcustom org-read-date-display-live t | |
1798 | "Non-nil means, display current interpretation of date prompt live. | |
1799 | This display will be in an overlay, in the minibuffer." | |
1800 | :group 'org-time | |
1801 | :type 'boolean) | |
1802 | ||
1803 | (defcustom org-read-date-popup-calendar t | |
ab27a4a0 CD |
1804 | "Non-nil means, pop up a calendar when prompting for a date. |
1805 | In the calendar, the date can be selected with mouse-1. However, the | |
1806 | minibuffer will also be active, and you can simply enter the date as well. | |
1807 | When nil, only the minibuffer will be available." | |
1808 | :group 'org-time | |
891f4676 | 1809 | :type 'boolean) |
8c6fb58b CD |
1810 | (if (fboundp 'defvaralias) |
1811 | (defvaralias 'org-popup-calendar-for-date-prompt | |
1812 | 'org-read-date-popup-calendar)) | |
1813 | ||
1814 | (defcustom org-extend-today-until 0 | |
621f83e4 | 1815 | "The hour when your day really ends. Must be an integer. |
8c6fb58b CD |
1816 | This has influence for the following applications: |
1817 | - When switching the agenda to \"today\". It it is still earlier than | |
1818 | the time given here, the day recognized as TODAY is actually yesterday. | |
1819 | - When a date is read from the user and it is still before the time given | |
1820 | here, the current date and time will be assumed to be yesterday, 23:59. | |
621f83e4 | 1821 | Also, timestamps inserted in remember templates follow this rule. |
8c6fb58b | 1822 | |
621f83e4 CD |
1823 | IMPORTANT: This is a feature whose implementation is and likely will |
1824 | remain incomplete. Really, it is only here because past midnight seems to | |
71d35b24 | 1825 | be the favorite working time of John Wiegley :-)" |
8c6fb58b CD |
1826 | :group 'org-time |
1827 | :type 'number) | |
891f4676 | 1828 | |
0b8568f5 JW |
1829 | (defcustom org-edit-timestamp-down-means-later nil |
1830 | "Non-nil means, S-down will increase the time in a time stamp. | |
1831 | When nil, S-up will increase." | |
1832 | :group 'org-time | |
1833 | :type 'boolean) | |
1834 | ||
ab27a4a0 CD |
1835 | (defcustom org-calendar-follow-timestamp-change t |
1836 | "Non-nil means, make the calendar window follow timestamp changes. | |
1837 | When a timestamp is modified and the calendar window is visible, it will be | |
1838 | moved to the new date." | |
1839 | :group 'org-time | |
1840 | :type 'boolean) | |
891f4676 | 1841 | |
ab27a4a0 | 1842 | (defgroup org-tags nil |
4146eb16 | 1843 | "Options concerning tags in Org-mode." |
ab27a4a0 CD |
1844 | :tag "Org Tags" |
1845 | :group 'org) | |
891f4676 | 1846 | |
4b3a9ba7 CD |
1847 | (defcustom org-tag-alist nil |
1848 | "List of tags allowed in Org-mode files. | |
1849 | When this list is nil, Org-mode will base TAG input on what is already in the | |
1850 | buffer. | |
0b8568f5 JW |
1851 | The value of this variable is an alist, the car of each entry must be a |
1852 | keyword as a string, the cdr may be a character that is used to select | |
1853 | that tag through the fast-tag-selection interface. | |
1854 | See the manual for details." | |
4b3a9ba7 CD |
1855 | :group 'org-tags |
1856 | :type '(repeat | |
7d143c25 CD |
1857 | (choice |
1858 | (cons (string :tag "Tag name") | |
1859 | (character :tag "Access char")) | |
1860 | (const :tag "Start radio group" (:startgroup)) | |
1861 | (const :tag "End radio group" (:endgroup))))) | |
4b3a9ba7 | 1862 | |
b349f79f CD |
1863 | (defvar org-file-tags nil |
1864 | "List of tags that can be inherited by all entries in the file. | |
1865 | The tags will be inherited if the variable `org-use-tag-inheritance' | |
1866 | says they should be. | |
1867 | This variable is populated from #+TAG lines.") | |
1868 | ||
4b3a9ba7 CD |
1869 | (defcustom org-use-fast-tag-selection 'auto |
1870 | "Non-nil means, use fast tag selection scheme. | |
1871 | This is a special interface to select and deselect tags with single keys. | |
1872 | When nil, fast selection is never used. | |
1873 | When the symbol `auto', fast selection is used if and only if selection | |
1874 | characters for tags have been configured, either through the variable | |
1875 | `org-tag-alist' or through a #+TAGS line in the buffer. | |
1876 | When t, fast selection is always used and selection keys are assigned | |
1877 | automatically if necessary." | |
1878 | :group 'org-tags | |
1879 | :type '(choice | |
1880 | (const :tag "Always" t) | |
1881 | (const :tag "Never" nil) | |
1882 | (const :tag "When selection characters are configured" 'auto))) | |
1883 | ||
3278a016 CD |
1884 | (defcustom org-fast-tag-selection-single-key nil |
1885 | "Non-nil means, fast tag selection exits after first change. | |
1886 | When nil, you have to press RET to exit it. | |
d3f4dbe8 CD |
1887 | During fast tag selection, you can toggle this flag with `C-c'. |
1888 | This variable can also have the value `expert'. In this case, the window | |
1889 | displaying the tags menu is not even shown, until you press C-c again." | |
3278a016 | 1890 | :group 'org-tags |
d3f4dbe8 CD |
1891 | :type '(choice |
1892 | (const :tag "No" nil) | |
1893 | (const :tag "Yes" t) | |
1894 | (const :tag "Expert" expert))) | |
3278a016 | 1895 | |
d5098885 JW |
1896 | (defvar org-fast-tag-selection-include-todo nil |
1897 | "Non-nil means, fast tags selection interface will also offer TODO states. | |
1898 | This is an undocumented feature, you should not rely on it.") | |
0b8568f5 | 1899 | |
20908596 | 1900 | (defcustom org-tags-column (if (featurep 'xemacs) -79 -80) |
ab27a4a0 CD |
1901 | "The column to which tags should be indented in a headline. |
1902 | If this number is positive, it specifies the column. If it is negative, | |
1903 | it means that the tags should be flushright to that column. For example, | |
15841868 | 1904 | -80 works well for a normal 80 character screen." |
ab27a4a0 CD |
1905 | :group 'org-tags |
1906 | :type 'integer) | |
891f4676 | 1907 | |
ab27a4a0 CD |
1908 | (defcustom org-auto-align-tags t |
1909 | "Non-nil means, realign tags after pro/demotion of TODO state change. | |
1910 | These operations change the length of a headline and therefore shift | |
1911 | the tags around. With this options turned on, after each such operation | |
1912 | the tags are again aligned to `org-tags-column'." | |
1913 | :group 'org-tags | |
1914 | :type 'boolean) | |
891f4676 | 1915 | |
ab27a4a0 CD |
1916 | (defcustom org-use-tag-inheritance t |
1917 | "Non-nil means, tags in levels apply also for sublevels. | |
1918 | When nil, only the tags directly given in a specific line apply there. | |
20908596 | 1919 | This may also be a list of tags that should be inherited, or a regexp that |
ff4be292 CD |
1920 | matches tags that should be inherited. Additional control is possible |
1921 | with the variable `org-tags-exclude-from-inheritance' which gives an | |
1922 | explicit list of tags to be excluded from inheritance., even if the value of | |
1923 | `org-use-tag-inheritance' would select it for inheritance. | |
1924 | ||
1925 | If this option is t, a match early-on in a tree can lead to a large | |
1926 | number of matches in the subtree when constructing the agenda or creating | |
1927 | a sparse tree. If you only want to see the first match in a tree during | |
1928 | a search, check out the variable `org-tags-match-list-sublevels'." | |
ab27a4a0 | 1929 | :group 'org-tags |
20908596 CD |
1930 | :type '(choice |
1931 | (const :tag "Not" nil) | |
1932 | (const :tag "Always" t) | |
1933 | (repeat :tag "Specific tags" (string :tag "Tag")) | |
1934 | (regexp :tag "Tags matched by regexp"))) | |
1935 | ||
ff4be292 CD |
1936 | (defcustom org-tags-exclude-from-inheritance nil |
1937 | "List of tags that should never be inherited. | |
1938 | This is a way to exclude a few tags from inheritance. For way to do | |
1939 | the opposite, to actively allow inheritance for selected tags, | |
1940 | see the variable `org-use-tag-inheritance'." | |
1941 | :group 'org-tags | |
1942 | :type '(repeat (string :tag "Tag"))) | |
1943 | ||
20908596 CD |
1944 | (defun org-tag-inherit-p (tag) |
1945 | "Check if TAG is one that should be inherited." | |
1946 | (cond | |
ff4be292 | 1947 | ((member tag org-tags-exclude-from-inheritance) nil) |
20908596 CD |
1948 | ((eq org-use-tag-inheritance t) t) |
1949 | ((not org-use-tag-inheritance) nil) | |
1950 | ((stringp org-use-tag-inheritance) | |
1951 | (string-match org-use-tag-inheritance tag)) | |
1952 | ((listp org-use-tag-inheritance) | |
1953 | (member tag org-use-tag-inheritance)) | |
1954 | (t (error "Invalid setting of `org-use-tag-inheritance'")))) | |
ab27a4a0 | 1955 | |
b349f79f | 1956 | (defcustom org-tags-match-list-sublevels t |
ab27a4a0 CD |
1957 | "Non-nil means list also sublevels of headlines matching tag search. |
1958 | Because of tag inheritance (see variable `org-use-tag-inheritance'), | |
1959 | the sublevels of a headline matching a tag search often also match | |
1960 | the same search. Listing all of them can create very long lists. | |
1961 | Setting this variable to nil causes subtrees of a match to be skipped. | |
1962 | This option is off by default, because inheritance in on. If you turn | |
1963 | inheritance off, you very likely want to turn this option on. | |
1964 | ||
1965 | As a special case, if the tag search is restricted to TODO items, the | |
1966 | value of this variable is ignored and sublevels are always checked, to | |
ff4be292 CD |
1967 | make sure all corresponding TODO items find their way into the list. |
1968 | ||
1969 | This variable is semi-obsolete and probably should always be true. It | |
1970 | is better to limit inheritance to certain tags using the variables | |
1971 | `org-use-tag-inheritanc'e and `org-tags-exclude-from-inheritance'." | |
ab27a4a0 CD |
1972 | :group 'org-tags |
1973 | :type 'boolean) | |
1974 | ||
1975 | (defvar org-tags-history nil | |
1976 | "History of minibuffer reads for tags.") | |
1977 | (defvar org-last-tags-completion-table nil | |
1978 | "The last used completion table for tags.") | |
d5098885 JW |
1979 | (defvar org-after-tags-change-hook nil |
1980 | "Hook that is run after the tags in a line have changed.") | |
ab27a4a0 | 1981 | |
38f8646b CD |
1982 | (defgroup org-properties nil |
1983 | "Options concerning properties in Org-mode." | |
1984 | :tag "Org Properties" | |
1985 | :group 'org) | |
1986 | ||
1987 | (defcustom org-property-format "%-10s %s" | |
1988 | "How property key/value pairs should be formatted by `indent-line'. | |
1989 | When `indent-line' hits a property definition, it will format the line | |
1990 | according to this format, mainly to make sure that the values are | |
1991 | lined-up with respect to each other." | |
1992 | :group 'org-properties | |
1993 | :type 'string) | |
1994 | ||
03f3cf35 JW |
1995 | (defcustom org-use-property-inheritance nil |
1996 | "Non-nil means, properties apply also for sublevels. | |
20908596 CD |
1997 | |
1998 | This setting is chiefly used during property searches. Turning it on can | |
1999 | cause significant overhead when doing a search, which is why it is not | |
2000 | on by default. | |
2001 | ||
03f3cf35 | 2002 | When nil, only the properties directly given in the current entry count. |
20908596 CD |
2003 | When t, every property is inherited. The value may also be a list of |
2004 | properties that should have inheritance, or a regular expression matching | |
2005 | properties that should be inherited. | |
03f3cf35 JW |
2006 | |
2007 | However, note that some special properties use inheritance under special | |
2008 | circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, | |
2009 | and the properties ending in \"_ALL\" when they are used as descriptor | |
20908596 CD |
2010 | for valid values of a property. |
2011 | ||
2012 | Note for programmers: | |
2013 | When querying an entry with `org-entry-get', you can control if inheritance | |
2014 | should be used. By default, `org-entry-get' looks only at the local | |
2015 | properties. You can request inheritance by setting the inherit argument | |
2016 | to t (to force inheritance) or to `selective' (to respect the setting | |
2017 | in this variable)." | |
03f3cf35 | 2018 | :group 'org-properties |
8c6fb58b CD |
2019 | :type '(choice |
2020 | (const :tag "Not" nil) | |
20908596 CD |
2021 | (const :tag "Always" t) |
2022 | (repeat :tag "Specific properties" (string :tag "Property")) | |
2023 | (regexp :tag "Properties matched by regexp"))) | |
2024 | ||
2025 | (defun org-property-inherit-p (property) | |
2026 | "Check if PROPERTY is one that should be inherited." | |
2027 | (cond | |
2028 | ((eq org-use-property-inheritance t) t) | |
2029 | ((not org-use-property-inheritance) nil) | |
2030 | ((stringp org-use-property-inheritance) | |
2031 | (string-match org-use-property-inheritance property)) | |
2032 | ((listp org-use-property-inheritance) | |
2033 | (member property org-use-property-inheritance)) | |
2034 | (t (error "Invalid setting of `org-use-property-inheritance'")))) | |
03f3cf35 | 2035 | |
7d58338e | 2036 | (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" |
38f8646b CD |
2037 | "The default column format, if no other format has been defined. |
2038 | This variable can be set on the per-file basis by inserting a line | |
2039 | ||
2040 | #+COLUMNS: %25ITEM ....." | |
2041 | :group 'org-properties | |
2042 | :type 'string) | |
2043 | ||
b349f79f CD |
2044 | (defcustom org-columns-ellipses ".." |
2045 | "The ellipses to be used when a field in column view is truncated. | |
2046 | When this is the empty string, as many characters as possible are shown, | |
2047 | but then there will be no visual indication that the field has been truncated. | |
2048 | When this is a string of length N, the last N characters of a truncated | |
2049 | field are replaced by this string. If the column is narrower than the | |
2050 | ellipses string, only part of the ellipses string will be shown." | |
2051 | :group 'org-properties | |
2052 | :type 'string) | |
2053 | ||
621f83e4 CD |
2054 | (defcustom org-columns-modify-value-for-display-function nil |
2055 | "Function that modifies values for display in column view. | |
2056 | For example, it can be used to cut out a certain part from a time stamp. | |
40ac2137 | 2057 | The function must take 2 arguments: |
621f83e4 CD |
2058 | |
2059 | column-title The tite of the column (*not* the property name) | |
2060 | value The value that should be modified. | |
2061 | ||
2062 | The function should return the value that should be displayed, | |
2063 | or nil if the normal value should be used." | |
2064 | :group 'org-properties | |
2065 | :type 'function) | |
b349f79f | 2066 | |
20908596 CD |
2067 | (defcustom org-effort-property "Effort" |
2068 | "The property that is being used to keep track of effort estimates. | |
2069 | Effort estimates given in this property need to have the format H:MM." | |
2070 | :group 'org-properties | |
2071 | :group 'org-progress | |
2072 | :type '(string :tag "Property")) | |
2073 | ||
b349f79f CD |
2074 | (defconst org-global-properties-fixed |
2075 | '(("VISIBILITY_ALL" . "folded children content all")) | |
2076 | "List of property/value pairs that can be inherited by any entry. | |
2077 | These are fixed values, for the preset properties.") | |
2078 | ||
2079 | ||
48aaad2d CD |
2080 | (defcustom org-global-properties nil |
2081 | "List of property/value pairs that can be inherited by any entry. | |
ce4fdcb9 CD |
2082 | You can set buffer-local values for the same purpose in the variable |
2083 | `org-file-properties' this by adding lines like | |
48aaad2d CD |
2084 | |
2085 | #+PROPERTY: NAME VALUE" | |
2086 | :group 'org-properties | |
2087 | :type '(repeat | |
2088 | (cons (string :tag "Property") | |
2089 | (string :tag "Value")))) | |
2090 | ||
b349f79f | 2091 | (defvar org-file-properties nil |
48aaad2d CD |
2092 | "List of property/value pairs that can be inherited by any entry. |
2093 | Valid for the current buffer. | |
2094 | This variable is populated from #+PROPERTY lines.") | |
b349f79f | 2095 | (make-variable-buffer-local 'org-file-properties) |
38f8646b | 2096 | |
ab27a4a0 | 2097 | (defgroup org-agenda nil |
d3f4dbe8 | 2098 | "Options concerning agenda views in Org-mode." |
ab27a4a0 CD |
2099 | :tag "Org Agenda" |
2100 | :group 'org) | |
2101 | ||
2102 | (defvar org-category nil | |
2103 | "Variable used by org files to set a category for agenda display. | |
2104 | Such files should use a file variable to set it, for example | |
2105 | ||
a3fbe8c4 | 2106 | # -*- mode: org; org-category: \"ELisp\" |
ab27a4a0 CD |
2107 | |
2108 | or contain a special line | |
2109 | ||
2110 | #+CATEGORY: ELisp | |
2111 | ||
2112 | If the file does not specify a category, then file's base name | |
2113 | is used instead.") | |
2114 | (make-variable-buffer-local 'org-category) | |
621f83e4 | 2115 | (put 'org-category 'safe-local-variable '(lambda (x) (or (symbolp x) (stringp x)))) |
ab27a4a0 CD |
2116 | |
2117 | (defcustom org-agenda-files nil | |
2118 | "The files to be used for agenda display. | |
2119 | Entries may be added to this list with \\[org-agenda-file-to-front] and removed with | |
2120 | \\[org-remove-file]. You can also use customize to edit the list. | |
2121 | ||
03f3cf35 JW |
2122 | If an entry is a directory, all files in that directory that are matched by |
2123 | `org-agenda-file-regexp' will be part of the file list. | |
2124 | ||
ab27a4a0 CD |
2125 | If the value of the variable is not a list but a single file name, then |
2126 | the list of agenda files is actually stored and maintained in that file, one | |
2127 | agenda file per line." | |
2128 | :group 'org-agenda | |
891f4676 | 2129 | :type '(choice |
03f3cf35 | 2130 | (repeat :tag "List of files and directories" file) |
ab27a4a0 | 2131 | (file :tag "Store list in a file\n" :value "~/.agenda_files"))) |
891f4676 | 2132 | |
8c6fb58b | 2133 | (defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" |
03f3cf35 | 2134 | "Regular expression to match files for `org-agenda-files'. |
fbe6c10d | 2135 | If any element in the list in that variable contains a directory instead |
03f3cf35 JW |
2136 | of a normal file, all files in that directory that are matched by this |
2137 | regular expression will be included." | |
2138 | :group 'org-agenda | |
2139 | :type 'regexp) | |
2140 | ||
2a57416f CD |
2141 | (defcustom org-agenda-text-search-extra-files nil |
2142 | "List of extra files to be searched by text search commands. | |
20908596 | 2143 | These files will be search in addition to the agenda files by the |
2a57416f CD |
2144 | commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'. |
2145 | Note that these files will only be searched for text search commands, | |
20908596 | 2146 | not for the other agenda views like todo lists, tag searches or the weekly |
2a57416f | 2147 | agenda. This variable is intended to list notes and possibly archive files |
20908596 CD |
2148 | that should also be searched by these two commands. |
2149 | In fact, if the first element in the list is the symbol `agenda-archives', | |
2150 | than all archive files of all agenda files will be added to the search | |
2151 | scope." | |
03f3cf35 | 2152 | :group 'org-agenda |
20908596 CD |
2153 | :type '(set :greedy t |
2154 | (const :tag "Agenda Archives" agenda-archives) | |
2155 | (repeat :inline t (file)))) | |
03f3cf35 | 2156 | |
2a57416f CD |
2157 | (if (fboundp 'defvaralias) |
2158 | (defvaralias 'org-agenda-multi-occur-extra-files | |
2159 | 'org-agenda-text-search-extra-files)) | |
2160 | ||
20908596 | 2161 | (defcustom org-agenda-skip-unavailable-files nil |
cf7241c8 JB |
2162 | "Non-nil means to just skip non-reachable files in `org-agenda-files'. |
2163 | A nil value means to remove them, after a query, from the list." | |
d3f4dbe8 | 2164 | :group 'org-agenda |
20908596 | 2165 | :type 'boolean) |
d3f4dbe8 CD |
2166 | |
2167 | (defcustom org-calendar-to-agenda-key [?c] | |
2168 | "The key to be installed in `calendar-mode-map' for switching to the agenda. | |
2169 | The command `org-calendar-goto-agenda' will be bound to this key. The | |
2170 | default is the character `c' because then `c' can be used to switch back and | |
2171 | forth between agenda and calendar." | |
2172 | :group 'org-agenda | |
2173 | :type 'sexp) | |
2174 | ||
b349f79f CD |
2175 | (defcustom org-calendar-agenda-action-key [?k] |
2176 | "The key to be installed in `calendar-mode-map' for agenda-action. | |
2177 | The command `org-agenda-action' will be bound to this key. The | |
2178 | default is the character `k' because we use the same key in the agenda." | |
2179 | :group 'org-agenda | |
2180 | :type 'sexp) | |
2181 | ||
20908596 | 2182 | (eval-after-load "calendar" |
b349f79f CD |
2183 | '(progn |
2184 | (org-defkey calendar-mode-map org-calendar-to-agenda-key | |
2185 | 'org-calendar-goto-agenda) | |
2186 | (org-defkey calendar-mode-map org-calendar-agenda-action-key | |
2187 | 'org-agenda-action))) | |
03f3cf35 | 2188 | |
6769c0dc | 2189 | (defgroup org-latex nil |
5bf7807a | 2190 | "Options for embedding LaTeX code into Org-mode." |
6769c0dc CD |
2191 | :tag "Org LaTeX" |
2192 | :group 'org) | |
2193 | ||
2194 | (defcustom org-format-latex-options | |
a3fbe8c4 CD |
2195 | '(:foreground default :background default :scale 1.0 |
2196 | :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 | |
2197 | :matchers ("begin" "$" "$$" "\\(" "\\[")) | |
6769c0dc CD |
2198 | "Options for creating images from LaTeX fragments. |
2199 | This is a property list with the following properties: | |
efc054e6 JB |
2200 | :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". |
2201 | `default' means use the foreground of the default face. | |
6769c0dc | 2202 | :background the background color, or \"Transparent\". |
a3fbe8c4 | 2203 | `default' means use the background of the default face. |
efc054e6 | 2204 | :scale a scaling factor for the size of the images. |
a3fbe8c4 | 2205 | :html-foreground, :html-background, :html-scale |
efc054e6 | 2206 | the same numbers for HTML export. |
6769c0dc CD |
2207 | :matchers a list indicating which matchers should be used to |
2208 | find LaTeX fragments. Valid members of this list are: | |
2209 | \"begin\" find environments | |
e39856be | 2210 | \"$\" find math expressions surrounded by $...$ |
6769c0dc | 2211 | \"$$\" find math expressions surrounded by $$....$$ |
e39856be CD |
2212 | \"\\(\" find math expressions surrounded by \\(...\\) |
2213 | \"\\ [\" find math expressions surrounded by \\ [...\\]" | |
15841868 | 2214 | :group 'org-latex |
6769c0dc CD |
2215 | :type 'plist) |
2216 | ||
a3fbe8c4 CD |
2217 | (defcustom org-format-latex-header "\\documentclass{article} |
2218 | \\usepackage{fullpage} % do not remove | |
2219 | \\usepackage{amssymb} | |
2220 | \\usepackage[usenames]{color} | |
2221 | \\usepackage{amsmath} | |
2222 | \\usepackage{latexsym} | |
2223 | \\usepackage[mathscr]{eucal} | |
2224 | \\pagestyle{empty} % do not remove" | |
2225 | "The document header used for processing LaTeX fragments." | |
15841868 | 2226 | :group 'org-latex |
a3fbe8c4 CD |
2227 | :type 'string) |
2228 | ||
5152b597 | 2229 | |
20908596 CD |
2230 | (defgroup org-font-lock nil |
2231 | "Font-lock settings for highlighting in Org-mode." | |
2232 | :tag "Org Font Lock" | |
2233 | :group 'org) | |
8c6fb58b | 2234 | |
20908596 CD |
2235 | (defcustom org-level-color-stars-only nil |
2236 | "Non-nil means fontify only the stars in each headline. | |
2237 | When nil, the entire headline is fontified. | |
2238 | Changing it requires restart of `font-lock-mode' to become effective | |
2239 | also in regions already fontified." | |
2240 | :group 'org-font-lock | |
6769c0dc CD |
2241 | :type 'boolean) |
2242 | ||
20908596 CD |
2243 | (defcustom org-hide-leading-stars nil |
2244 | "Non-nil means, hide the first N-1 stars in a headline. | |
2245 | This works by using the face `org-hide' for these stars. This | |
2246 | face is white for a light background, and black for a dark | |
2247 | background. You may have to customize the face `org-hide' to | |
2248 | make this work. | |
2249 | Changing it requires restart of `font-lock-mode' to become effective | |
2250 | also in regions already fontified. | |
2251 | You may also set this on a per-file basis by adding one of the following | |
2252 | lines to the buffer: | |
891f4676 | 2253 | |
20908596 CD |
2254 | #+STARTUP: hidestars |
2255 | #+STARTUP: showstars" | |
2256 | :group 'org-font-lock | |
891f4676 RS |
2257 | :type 'boolean) |
2258 | ||
20908596 CD |
2259 | (defcustom org-fontify-done-headline nil |
2260 | "Non-nil means, change the face of a headline if it is marked DONE. | |
2261 | Normally, only the TODO/DONE keyword indicates the state of a headline. | |
2262 | When this is non-nil, the headline after the keyword is set to the | |
2263 | `org-headline-done' as an additional indication." | |
2264 | :group 'org-font-lock | |
ab27a4a0 CD |
2265 | :type 'boolean) |
2266 | ||
20908596 CD |
2267 | (defcustom org-fontify-emphasized-text t |
2268 | "Non-nil means fontify *bold*, /italic/ and _underlined_ text. | |
2269 | Changing this variable requires a restart of Emacs to take effect." | |
2270 | :group 'org-font-lock | |
891f4676 RS |
2271 | :type 'boolean) |
2272 | ||
20908596 CD |
2273 | (defcustom org-highlight-latex-fragments-and-specials nil |
2274 | "Non-nil means, fontify what is treated specially by the exporters." | |
2275 | :group 'org-font-lock | |
a96ee7df CD |
2276 | :type 'boolean) |
2277 | ||
20908596 CD |
2278 | (defcustom org-hide-emphasis-markers nil |
2279 | "Non-nil mean font-lock should hide the emphasis marker characters." | |
2280 | :group 'org-font-lock | |
8c6fb58b CD |
2281 | :type 'boolean) |
2282 | ||
edd21304 CD |
2283 | (defvar org-emph-re nil |
2284 | "Regular expression for matching emphasis.") | |
8c6fb58b CD |
2285 | (defvar org-verbatim-re nil |
2286 | "Regular expression for matching verbatim text.") | |
edd21304 CD |
2287 | (defvar org-emphasis-regexp-components) ; defined just below |
2288 | (defvar org-emphasis-alist) ; defined just below | |
2289 | (defun org-set-emph-re (var val) | |
2290 | "Set variable and compute the emphasis regular expression." | |
2291 | (set var val) | |
2292 | (when (and (boundp 'org-emphasis-alist) | |
2293 | (boundp 'org-emphasis-regexp-components) | |
2294 | org-emphasis-alist org-emphasis-regexp-components) | |
2295 | (let* ((e org-emphasis-regexp-components) | |
2296 | (pre (car e)) | |
2297 | (post (nth 1 e)) | |
2298 | (border (nth 2 e)) | |
2299 | (body (nth 3 e)) | |
2300 | (nl (nth 4 e)) | |
8c6fb58b | 2301 | (stacked (and nil (nth 5 e))) ; stacked is no longer allowed, forced to nil |
edd21304 | 2302 | (body1 (concat body "*?")) |
8c6fb58b CD |
2303 | (markers (mapconcat 'car org-emphasis-alist "")) |
2304 | (vmarkers (mapconcat | |
2305 | (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) | |
2306 | org-emphasis-alist ""))) | |
edd21304 CD |
2307 | ;; make sure special characters appear at the right position in the class |
2308 | (if (string-match "\\^" markers) | |
2309 | (setq markers (concat (replace-match "" t t markers) "^"))) | |
2310 | (if (string-match "-" markers) | |
2311 | (setq markers (concat (replace-match "" t t markers) "-"))) | |
8c6fb58b CD |
2312 | (if (string-match "\\^" vmarkers) |
2313 | (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) | |
2314 | (if (string-match "-" vmarkers) | |
2315 | (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) | |
3278a016 CD |
2316 | (if (> nl 0) |
2317 | (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," | |
2318 | (int-to-string nl) "\\}"))) | |
edd21304 CD |
2319 | ;; Make the regexp |
2320 | (setq org-emph-re | |
8c6fb58b | 2321 | (concat "\\([" pre (if (and nil stacked) markers) "]\\|^\\)" |
edd21304 CD |
2322 | "\\(" |
2323 | "\\([" markers "]\\)" | |
2324 | "\\(" | |
8c6fb58b | 2325 | "[^" border "]\\|" |
a3fbe8c4 | 2326 | "[^" border (if (and nil stacked) markers) "]" |
edd21304 | 2327 | body1 |
a3fbe8c4 | 2328 | "[^" border (if (and nil stacked) markers) "]" |
edd21304 CD |
2329 | "\\)" |
2330 | "\\3\\)" | |
8c6fb58b CD |
2331 | "\\([" post (if (and nil stacked) markers) "]\\|$\\)")) |
2332 | (setq org-verbatim-re | |
2333 | (concat "\\([" pre "]\\|^\\)" | |
2334 | "\\(" | |
2335 | "\\([" vmarkers "]\\)" | |
2336 | "\\(" | |
2337 | "[^" border "]\\|" | |
2338 | "[^" border "]" | |
2339 | body1 | |
2340 | "[^" border "]" | |
2341 | "\\)" | |
2342 | "\\3\\)" | |
2343 | "\\([" post "]\\|$\\)"))))) | |
edd21304 CD |
2344 | |
2345 | (defcustom org-emphasis-regexp-components | |
8c6fb58b CD |
2346 | '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) |
2347 | "Components used to build the regular expression for emphasis. | |
edd21304 CD |
2348 | This is a list with 6 entries. Terminology: In an emphasis string |
2349 | like \" *strong word* \", we call the initial space PREMATCH, the final | |
2350 | space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters | |
2351 | and \"trong wor\" is the body. The different components in this variable | |
2352 | specify what is allowed/forbidden in each part: | |
2353 | ||
2354 | pre Chars allowed as prematch. Beginning of line will be allowed too. | |
2355 | post Chars allowed as postmatch. End of line will be allowed too. | |
a3fbe8c4 | 2356 | border The chars *forbidden* as border characters. |
edd21304 CD |
2357 | body-regexp A regexp like \".\" to match a body character. Don't use |
2358 | non-shy groups here, and don't allow newline here. | |
2359 | newline The maximum number of newlines allowed in an emphasis exp. | |
8c6fb58b | 2360 | |
c44f0d75 | 2361 | Use customize to modify this, or restart Emacs after changing it." |
0fee8d6e | 2362 | :group 'org-font-lock |
edd21304 CD |
2363 | :set 'org-set-emph-re |
2364 | :type '(list | |
2365 | (sexp :tag "Allowed chars in pre ") | |
2366 | (sexp :tag "Allowed chars in post ") | |
2367 | (sexp :tag "Forbidden chars in border ") | |
2368 | (sexp :tag "Regexp for body ") | |
2369 | (integer :tag "number of newlines allowed") | |
b349f79f | 2370 | (option (boolean :tag "Please ignore this button")))) |
edd21304 CD |
2371 | |
2372 | (defcustom org-emphasis-alist | |
20908596 | 2373 | `(("*" bold "<b>" "</b>") |
edd21304 | 2374 | ("/" italic "<i>" "</i>") |
93b62de8 | 2375 | ("_" underline "<span style=\"text-decoration:underline;\">" "</span>") |
8c6fb58b | 2376 | ("=" org-code "<code>" "</code>" verbatim) |
93b62de8 | 2377 | ("~" org-verbatim "<code>" "</code>" verbatim) |
20908596 CD |
2378 | ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)) |
2379 | "<del>" "</del>") | |
a3fbe8c4 | 2380 | ) |
8c6fb58b | 2381 | "Special syntax for emphasized text. |
edd21304 CD |
2382 | Text starting and ending with a special character will be emphasized, for |
2383 | example *bold*, _underlined_ and /italic/. This variable sets the marker | |
a3fbe8c4 | 2384 | characters, the face to be used by font-lock for highlighting in Org-mode |
c44f0d75 JB |
2385 | Emacs buffers, and the HTML tags to be used for this. |
2386 | Use customize to modify this, or restart Emacs after changing it." | |
0fee8d6e | 2387 | :group 'org-font-lock |
edd21304 CD |
2388 | :set 'org-set-emph-re |
2389 | :type '(repeat | |
2390 | (list | |
2391 | (string :tag "Marker character") | |
0fee8d6e CD |
2392 | (choice |
2393 | (face :tag "Font-lock-face") | |
2394 | (plist :tag "Face property list")) | |
edd21304 | 2395 | (string :tag "HTML start tag") |
8c6fb58b CD |
2396 | (string :tag "HTML end tag") |
2397 | (option (const verbatim))))) | |
edd21304 | 2398 | |
20908596 CD |
2399 | ;;; Miscellaneous options |
2400 | ||
2401 | (defgroup org-completion nil | |
2402 | "Completion in Org-mode." | |
2403 | :tag "Org Completion" | |
2404 | :group 'org) | |
891f4676 | 2405 | |
ce4fdcb9 | 2406 | (defcustom org-completion-use-ido nil |
ff4be292 | 2407 | "Non-nil means, use ido completion wherever possible." |
ce4fdcb9 | 2408 | :group 'org-completion |
ff4be292 | 2409 | :type 'boolean) |
ce4fdcb9 | 2410 | |
20908596 CD |
2411 | (defcustom org-completion-fallback-command 'hippie-expand |
2412 | "The expansion command called by \\[org-complete] in normal context. | |
2413 | Normal means, no org-mode-specific context." | |
2414 | :group 'org-completion | |
2415 | :type 'function) | |
ab27a4a0 | 2416 | |
8c6fb58b CD |
2417 | ;;; Functions and variables from ther packages |
2418 | ;; Declared here to avoid compiler warnings | |
2419 | ||
8c6fb58b CD |
2420 | ;; XEmacs only |
2421 | (defvar outline-mode-menu-heading) | |
2422 | (defvar outline-mode-menu-show) | |
2423 | (defvar outline-mode-menu-hide) | |
2424 | (defvar zmacs-regions) ; XEmacs regions | |
2425 | ||
2426 | ;; Emacs only | |
2427 | (defvar mark-active) | |
2428 | ||
2429 | ;; Various packages | |
bf9f6f03 | 2430 | (declare-function calendar-absolute-from-iso "cal-iso" (date)) |
f30cf46c | 2431 | (declare-function calendar-forward-day "cal-move" (arg)) |
f30cf46c GM |
2432 | (declare-function calendar-goto-date "cal-move" (date)) |
2433 | (declare-function calendar-goto-today "cal-move" ()) | |
bf9f6f03 | 2434 | (declare-function calendar-iso-from-absolute "cal-iso" (date)) |
20908596 CD |
2435 | (defvar calc-embedded-close-formula) |
2436 | (defvar calc-embedded-open-formula) | |
182aef95 DN |
2437 | (declare-function cdlatex-tab "ext:cdlatex" ()) |
2438 | (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) | |
8c6fb58b | 2439 | (defvar font-lock-unfontify-region-function) |
20908596 CD |
2440 | (declare-function iswitchb-mode "iswitchb" (&optional arg)) |
2441 | (declare-function iswitchb-read-buffer (prompt &optional default require-match start matches-set)) | |
2442 | (defvar iswitchb-temp-buflist) | |
2443 | (declare-function org-gnus-follow-link "org-gnus" (&optional group article)) | |
2444 | (declare-function org-agenda-skip "org-agenda" ()) | |
2445 | (declare-function org-format-agenda-item "org-agenda" | |
2446 | (extra txt &optional category tags dotime noprefix remove-re)) | |
2447 | (declare-function org-agenda-new-marker "org-agenda" (&optional pos)) | |
2448 | (declare-function org-agenda-change-all-lines "org-agenda" | |
d60b1ba1 | 2449 | (newhead hdmarker &optional fixface just-this)) |
20908596 CD |
2450 | (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) |
2451 | (declare-function org-agenda-maybe-redo "org-agenda" ()) | |
b349f79f CD |
2452 | (declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda" |
2453 | (beg end)) | |
ce4fdcb9 | 2454 | (declare-function org-agenda-copy-local-variable "org-agenda" (var)) |
f30cf46c | 2455 | (declare-function parse-time-string "parse-time" (string)) |
182aef95 DN |
2456 | (declare-function remember "remember" (&optional initial)) |
2457 | (declare-function remember-buffer-desc "remember" ()) | |
2a57416f | 2458 | (declare-function remember-finalize "remember" ()) |
8c6fb58b CD |
2459 | (defvar remember-save-after-remembering) |
2460 | (defvar remember-data-file) | |
2461 | (defvar remember-register) | |
2462 | (defvar remember-buffer) | |
2463 | (defvar remember-handler-functions) | |
2464 | (defvar remember-annotation-functions) | |
8c6fb58b | 2465 | (defvar texmathp-why) |
20908596 CD |
2466 | (declare-function speedbar-line-directory "speedbar" (&optional depth)) |
2467 | (declare-function table--at-cell-p "table" (position &optional object at-column)) | |
2468 | ||
8c6fb58b CD |
2469 | (defvar w3m-current-url) |
2470 | (defvar w3m-current-title) | |
8c6fb58b CD |
2471 | |
2472 | (defvar org-latex-regexps) | |
d3f4dbe8 | 2473 | |
20908596 | 2474 | ;;; Autoload and prepare some org modules |
4b3a9ba7 | 2475 | |
20908596 CD |
2476 | ;; Some table stuff that needs to be defined here, because it is used |
2477 | ;; by the functions setting up org-mode or checking for table context. | |
4b3a9ba7 | 2478 | |
20908596 CD |
2479 | (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" |
2480 | "Detects an org-type or table-type table.") | |
2481 | (defconst org-table-line-regexp "^[ \t]*|" | |
2482 | "Detects an org-type table line.") | |
2483 | (defconst org-table-dataline-regexp "^[ \t]*|[^-]" | |
2484 | "Detects an org-type table line.") | |
2485 | (defconst org-table-hline-regexp "^[ \t]*|-" | |
2486 | "Detects an org-type table hline.") | |
2487 | (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" | |
2488 | "Detects a table-type table hline.") | |
2489 | (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" | |
2490 | "Searching from within a table (any type) this finds the first line | |
2491 | outside the table.") | |
4b3a9ba7 | 2492 | |
20908596 | 2493 | ;; Autoload the functions in org-table.el that are needed by functions here. |
ab27a4a0 | 2494 | |
20908596 CD |
2495 | (eval-and-compile |
2496 | (org-autoload "org-table" | |
2497 | '(org-table-align org-table-begin org-table-blank-field | |
2498 | org-table-convert org-table-convert-region org-table-copy-down | |
2499 | org-table-copy-region org-table-create | |
2500 | org-table-create-or-convert-from-region | |
2501 | org-table-create-with-table.el org-table-current-dline | |
2502 | org-table-cut-region org-table-delete-column org-table-edit-field | |
2503 | org-table-edit-formulas org-table-end org-table-eval-formula | |
2504 | org-table-export org-table-field-info | |
2505 | org-table-get-stored-formulas org-table-goto-column | |
2506 | org-table-hline-and-move org-table-import org-table-insert-column | |
2507 | org-table-insert-hline org-table-insert-row org-table-iterate | |
2508 | org-table-justify-field-maybe org-table-kill-row | |
2509 | org-table-maybe-eval-formula org-table-maybe-recalculate-line | |
2510 | org-table-move-column org-table-move-column-left | |
2511 | org-table-move-column-right org-table-move-row | |
2512 | org-table-move-row-down org-table-move-row-up | |
2513 | org-table-next-field org-table-next-row org-table-paste-rectangle | |
2514 | org-table-previous-field org-table-recalculate | |
2515 | org-table-rotate-recalc-marks org-table-sort-lines org-table-sum | |
2516 | org-table-toggle-coordinate-overlays | |
2517 | org-table-toggle-formula-debugger org-table-wrap-region | |
621f83e4 | 2518 | orgtbl-mode turn-on-orgtbl org-table-to-lisp))) |
3278a016 | 2519 | |
20908596 CD |
2520 | (defun org-at-table-p (&optional table-type) |
2521 | "Return t if the cursor is inside an org-type table. | |
2522 | If TABLE-TYPE is non-nil, also check for table.el-type tables." | |
2523 | (if org-enable-table-editor | |
1d676e9f | 2524 | (save-excursion |
20908596 CD |
2525 | (beginning-of-line 1) |
2526 | (looking-at (if table-type org-table-any-line-regexp | |
2527 | org-table-line-regexp))) | |
2528 | nil)) | |
2529 | (defsubst org-table-p () (org-at-table-p)) | |
edd21304 | 2530 | |
20908596 CD |
2531 | (defun org-at-table.el-p () |
2532 | "Return t if and only if we are at a table.el table." | |
2533 | (and (org-at-table-p 'any) | |
2534 | (save-excursion | |
2535 | (goto-char (org-table-begin 'any)) | |
2536 | (looking-at org-table1-hline-regexp)))) | |
2537 | (defun org-table-recognize-table.el () | |
2538 | "If there is a table.el table nearby, recognize it and move into it." | |
2539 | (if org-table-tab-recognizes-table.el | |
2540 | (if (org-at-table.el-p) | |
2541 | (progn | |
2542 | (beginning-of-line 1) | |
2543 | (if (looking-at org-table-dataline-regexp) | |
2544 | nil | |
2545 | (if (looking-at org-table1-hline-regexp) | |
2546 | (progn | |
2547 | (beginning-of-line 2) | |
2548 | (if (looking-at org-table-any-border-regexp) | |
2549 | (beginning-of-line -1))))) | |
2550 | (if (re-search-forward "|" (org-table-end t) t) | |
2551 | (progn | |
2552 | (require 'table) | |
2553 | (if (table--at-cell-p (point)) | |
2554 | t | |
2555 | (message "recognizing table.el table...") | |
2556 | (table-recognize-table) | |
2557 | (message "recognizing table.el table...done"))) | |
2558 | (error "This should not happen...")) | |
2559 | t) | |
2560 | nil) | |
2561 | nil)) | |
edd21304 | 2562 | |
20908596 CD |
2563 | (defun org-at-table-hline-p () |
2564 | "Return t if the cursor is inside a hline in a table." | |
2565 | (if org-enable-table-editor | |
2566 | (save-excursion | |
2567 | (beginning-of-line 1) | |
2568 | (looking-at org-table-hline-regexp)) | |
2569 | nil)) | |
edd21304 | 2570 | |
20908596 | 2571 | (defvar org-table-clean-did-remove-column nil) |
6769c0dc | 2572 | |
d3f4dbe8 CD |
2573 | (defun org-table-map-tables (function) |
2574 | "Apply FUNCTION to the start of all tables in the buffer." | |
2575 | (save-excursion | |
2576 | (save-restriction | |
2577 | (widen) | |
2578 | (goto-char (point-min)) | |
2579 | (while (re-search-forward org-table-any-line-regexp nil t) | |
2580 | (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) | |
2581 | (beginning-of-line 1) | |
2582 | (if (looking-at org-table-line-regexp) | |
2583 | (save-excursion (funcall function))) | |
2584 | (re-search-forward org-table-any-border-regexp nil 1)))) | |
2585 | (message "Mapping tables: done")) | |
edd21304 | 2586 | |
20908596 | 2587 | ;; Declare and autoload functions from org-exp.el |
d3f4dbe8 | 2588 | |
20908596 CD |
2589 | (declare-function org-default-export-plist "org-exp") |
2590 | (declare-function org-infile-export-plist "org-exp") | |
2591 | (declare-function org-get-current-options "org-exp") | |
2592 | (eval-and-compile | |
2593 | (org-autoload "org-exp" | |
2594 | '(org-export org-export-as-ascii org-export-visible | |
2595 | org-insert-export-options-template org-export-as-html-and-open | |
2596 | org-export-as-html-batch org-export-as-html-to-buffer | |
2597 | org-replace-region-by-html org-export-region-as-html | |
2598 | org-export-as-html org-export-icalendar-this-file | |
2599 | org-export-icalendar-all-agenda-files | |
b349f79f | 2600 | org-table-clean-before-export |
20908596 | 2601 | org-export-icalendar-combine-agenda-files org-export-as-xoxo))) |
d3f4dbe8 | 2602 | |
621f83e4 | 2603 | ;; Declare and autoload functions from org-agenda.el |
d3f4dbe8 | 2604 | |
20908596 | 2605 | (eval-and-compile |
621f83e4 | 2606 | (org-autoload "org-agenda" |
20908596 CD |
2607 | '(org-agenda org-agenda-list org-search-view |
2608 | org-todo-list org-tags-view org-agenda-list-stuck-projects | |
2609 | org-diary org-agenda-to-appt))) | |
d3f4dbe8 | 2610 | |
20908596 CD |
2611 | ;; Autoload org-remember |
2612 | ||
2613 | (eval-and-compile | |
2614 | (org-autoload "org-remember" | |
2615 | '(org-remember-insinuate org-remember-annotation | |
2616 | org-remember-apply-template org-remember org-remember-handler))) | |
2617 | ||
2618 | ;; Autoload org-clock.el | |
2619 | ||
b349f79f CD |
2620 | |
2621 | (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" | |
2622 | (beg end)) | |
2623 | (declare-function org-update-mode-line "org-clock" ()) | |
2624 | (defvar org-clock-start-time) | |
20908596 CD |
2625 | (defvar org-clock-marker (make-marker) |
2626 | "Marker recording the last clock-in.") | |
2627 | ||
2628 | (eval-and-compile | |
2629 | (org-autoload | |
2630 | "org-clock" | |
2631 | '(org-clock-in org-clock-out org-clock-cancel | |
2632 | org-clock-goto org-clock-sum org-clock-display | |
2633 | org-remove-clock-overlays org-clock-report | |
2634 | org-clocktable-shift org-dblock-write:clocktable | |
2635 | org-get-clocktable))) | |
2636 | ||
2637 | (defun org-clock-update-time-maybe () | |
2638 | "If this is a CLOCK line, update it and return t. | |
2639 | Otherwise, return nil." | |
0fee8d6e | 2640 | (interactive) |
5137195a | 2641 | (save-excursion |
20908596 CD |
2642 | (beginning-of-line 1) |
2643 | (skip-chars-forward " \t") | |
2644 | (when (looking-at org-clock-string) | |
2645 | (let ((re (concat "[ \t]*" org-clock-string | |
b349f79f CD |
2646 | " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]" |
2647 | "\\([ \t]*=>.*\\)?\\)?")) | |
71d35b24 | 2648 | ts te h m s neg) |
b349f79f CD |
2649 | (cond |
2650 | ((not (looking-at re)) | |
2651 | nil) | |
2652 | ((not (match-end 2)) | |
2653 | (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) | |
2654 | (> org-clock-marker (point)) | |
2655 | (<= org-clock-marker (point-at-eol))) | |
2656 | ;; The clock is running here | |
2657 | (setq org-clock-start-time | |
ce4fdcb9 | 2658 | (apply 'encode-time |
b349f79f CD |
2659 | (org-parse-time-string (match-string 1)))) |
2660 | (org-update-mode-line))) | |
2661 | (t | |
2662 | (and (match-end 4) (delete-region (match-beginning 4) (match-end 4))) | |
20908596 CD |
2663 | (end-of-line 1) |
2664 | (setq ts (match-string 1) | |
b349f79f | 2665 | te (match-string 3)) |
20908596 CD |
2666 | (setq s (- (time-to-seconds |
2667 | (apply 'encode-time (org-parse-time-string te))) | |
2668 | (time-to-seconds | |
2669 | (apply 'encode-time (org-parse-time-string ts)))) | |
71d35b24 CD |
2670 | neg (< s 0) |
2671 | s (abs s) | |
20908596 CD |
2672 | h (floor (/ s 3600)) |
2673 | s (- s (* 3600 h)) | |
2674 | m (floor (/ s 60)) | |
2675 | s (- s (* 60 s))) | |
71d35b24 | 2676 | (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m)) |
b349f79f | 2677 | t)))))) |
5137195a | 2678 | |
20908596 CD |
2679 | (defun org-check-running-clock () |
2680 | "Check if the current buffer contains the running clock. | |
2681 | If yes, offer to stop it and to save the buffer with the changes." | |
2682 | (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) | |
2683 | (y-or-n-p (format "Clock-out in buffer %s before killing it? " | |
2684 | (buffer-name)))) | |
2685 | (org-clock-out) | |
2686 | (when (y-or-n-p "Save changed buffer?") | |
2687 | (save-buffer)))) | |
2688 | ||
2689 | (defun org-clocktable-try-shift (dir n) | |
2690 | "Check if this line starts a clock table, if yes, shift the time block." | |
2691 | (when (org-match-line "#\\+BEGIN: clocktable\\>") | |
2692 | (org-clocktable-shift dir n))) | |
2693 | ||
ff4be292 CD |
2694 | ;; Autoload org-timer.el |
2695 | ||
2696 | ;(declare-function org-timer "org-timer") | |
2697 | ||
2698 | (eval-and-compile | |
2699 | (org-autoload | |
2700 | "org-timer" | |
2701 | '(org-timer-start org-timer org-timer-item | |
2702 | org-timer-change-times-in-region))) | |
2703 | ||
2704 | ||
20908596 CD |
2705 | ;; Autoload archiving code |
2706 | ;; The stuff that is needed for cycling and tags has to be defined here. | |
2707 | ||
2708 | (defgroup org-archive nil | |
2709 | "Options concerning archiving in Org-mode." | |
2710 | :tag "Org Archive" | |
2711 | :group 'org-structure) | |
2712 | ||
2713 | (defcustom org-archive-location "%s_archive::" | |
2714 | "The location where subtrees should be archived. | |
2715 | ||
ce4fdcb9 CD |
2716 | The value of this variable is a string, consisting of two parts, |
2717 | separated by a double-colon. The first part is a filename and | |
2718 | the second part is a headline. | |
20908596 | 2719 | |
ce4fdcb9 CD |
2720 | When the filename is omitted, archiving happens in the same file. |
2721 | %s in the filename will be replaced by the current file | |
2722 | name (without the directory part). Archiving to a different file | |
2723 | is useful to keep archived entries from contributing to the | |
2724 | Org-mode Agenda. | |
20908596 | 2725 | |
ce4fdcb9 CD |
2726 | The archived entries will be filed as subtrees of the specified |
2727 | headline. When the headline is omitted, the subtrees are simply | |
2728 | filed away at the end of the file, as top-level entries. | |
20908596 CD |
2729 | |
2730 | Here are a few examples: | |
2731 | \"%s_archive::\" | |
2732 | If the current file is Projects.org, archive in file | |
2733 | Projects.org_archive, as top-level trees. This is the default. | |
2734 | ||
2735 | \"::* Archived Tasks\" | |
2736 | Archive in the current file, under the top-level headline | |
2737 | \"* Archived Tasks\". | |
2738 | ||
2739 | \"~/org/archive.org::\" | |
2740 | Archive in file ~/org/archive.org (absolute path), as top-level trees. | |
2741 | ||
2742 | \"basement::** Finished Tasks\" | |
2743 | Archive in file ./basement (relative path), as level 3 trees | |
2744 | below the level 2 heading \"** Finished Tasks\". | |
2745 | ||
2746 | You may set this option on a per-file basis by adding to the buffer a | |
2747 | line like | |
2748 | ||
2749 | #+ARCHIVE: basement::** Finished Tasks | |
2750 | ||
2751 | You may also define it locally for a subtree by setting an ARCHIVE property | |
2752 | in the entry. If such a property is found in an entry, or anywhere up | |
2753 | the hierarchy, it will be used." | |
2754 | :group 'org-archive | |
2755 | :type 'string) | |
2756 | ||
2757 | (defcustom org-archive-tag "ARCHIVE" | |
2758 | "The tag that marks a subtree as archived. | |
2759 | An archived subtree does not open during visibility cycling, and does | |
2760 | not contribute to the agenda listings. | |
2761 | After changing this, font-lock must be restarted in the relevant buffers to | |
2762 | get the proper fontification." | |
2763 | :group 'org-archive | |
2764 | :group 'org-keywords | |
2765 | :type 'string) | |
2766 | ||
2767 | (defcustom org-agenda-skip-archived-trees t | |
2768 | "Non-nil means, the agenda will skip any items located in archived trees. | |
2c3ad40d CD |
2769 | An archived tree is a tree marked with the tag ARCHIVE. The use of this |
2770 | variable is no longer recommended, you should leave it at the value t. | |
2771 | Instead, use the key `v' to cycle the archives-mode in the agenda." | |
20908596 CD |
2772 | :group 'org-archive |
2773 | :group 'org-agenda-skip | |
2774 | :type 'boolean) | |
2775 | ||
2776 | (defcustom org-cycle-open-archived-trees nil | |
2777 | "Non-nil means, `org-cycle' will open archived trees. | |
2778 | An archived tree is a tree marked with the tag ARCHIVE. | |
2779 | When nil, archived trees will stay folded. You can still open them with | |
2780 | normal outline commands like `show-all', but not with the cycling commands." | |
2781 | :group 'org-archive | |
2782 | :group 'org-cycle | |
2783 | :type 'boolean) | |
2784 | ||
2785 | (defcustom org-sparse-tree-open-archived-trees nil | |
2786 | "Non-nil means sparse tree construction shows matches in archived trees. | |
2787 | When nil, matches in these trees are highlighted, but the trees are kept in | |
2788 | collapsed state." | |
2789 | :group 'org-archive | |
2790 | :group 'org-sparse-trees | |
2791 | :type 'boolean) | |
2792 | ||
2793 | (defun org-cycle-hide-archived-subtrees (state) | |
2794 | "Re-hide all archived subtrees after a visibility state change." | |
2795 | (when (and (not org-cycle-open-archived-trees) | |
2796 | (not (memq state '(overview folded)))) | |
d3f4dbe8 | 2797 | (save-excursion |
20908596 CD |
2798 | (let* ((globalp (memq state '(contents all))) |
2799 | (beg (if globalp (point-min) (point))) | |
2800 | (end (if globalp (point-max) (org-end-of-subtree t)))) | |
2801 | (org-hide-archived-subtrees beg end) | |
2802 | (goto-char beg) | |
2803 | (if (looking-at (concat ".*:" org-archive-tag ":")) | |
2804 | (message "%s" (substitute-command-keys | |
2805 | "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) | |
2806 | ||
2807 | (defun org-force-cycle-archived () | |
2808 | "Cycle subtree even if it is archived." | |
d3f4dbe8 | 2809 | (interactive) |
20908596 CD |
2810 | (setq this-command 'org-cycle) |
2811 | (let ((org-cycle-open-archived-trees t)) | |
2812 | (call-interactively 'org-cycle))) | |
3278a016 | 2813 | |
20908596 CD |
2814 | (defun org-hide-archived-subtrees (beg end) |
2815 | "Re-hide all archived subtrees after a visibility state change." | |
2816 | (save-excursion | |
2817 | (let* ((re (concat ":" org-archive-tag ":"))) | |
38f8646b | 2818 | (goto-char beg) |
20908596 CD |
2819 | (while (re-search-forward re end t) |
2820 | (and (org-on-heading-p) (hide-subtree)) | |
2821 | (org-end-of-subtree t))))) | |
a3fbe8c4 | 2822 | |
20908596 | 2823 | (defalias 'org-advertized-archive-subtree 'org-archive-subtree) |
ab27a4a0 | 2824 | |
20908596 CD |
2825 | (eval-and-compile |
2826 | (org-autoload "org-archive" | |
2827 | '(org-add-archive-files org-archive-subtree | |
2828 | org-archive-to-archive-sibling org-toggle-archive-tag))) | |
ab27a4a0 | 2829 | |
20908596 | 2830 | ;; Autoload Column View Code |
a3fbe8c4 | 2831 | |
20908596 CD |
2832 | (declare-function org-columns-number-to-string "org-colview") |
2833 | (declare-function org-columns-get-format-and-top-level "org-colview") | |
2834 | (declare-function org-columns-compute "org-colview") | |
a3fbe8c4 | 2835 | |
20908596 CD |
2836 | (org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview") |
2837 | '(org-columns-number-to-string org-columns-get-format-and-top-level | |
2838 | org-columns-compute org-agenda-columns org-columns-remove-overlays | |
0627c265 | 2839 | org-columns org-insert-columns-dblock org-dblock-write:columnview)) |
a3fbe8c4 | 2840 | |
b349f79f CD |
2841 | ;; Autoload ID code |
2842 | ||
ff4be292 | 2843 | (declare-function org-id-store-link "org-id") |
b349f79f | 2844 | (org-autoload "org-id" |
ce4fdcb9 CD |
2845 | '(org-id-get-create org-id-new org-id-copy org-id-get |
2846 | org-id-get-with-outline-path-completion | |
b349f79f | 2847 | org-id-get-with-outline-drilling |
ff4be292 | 2848 | org-id-goto org-id-find org-id-store-link)) |
b349f79f | 2849 | |
20908596 | 2850 | ;;; Variables for pre-computed regular expressions, all buffer local |
a3fbe8c4 | 2851 | |
20908596 CD |
2852 | (defvar org-drawer-regexp nil |
2853 | "Matches first line of a hidden block.") | |
2854 | (make-variable-buffer-local 'org-drawer-regexp) | |
2855 | (defvar org-todo-regexp nil | |
2856 | "Matches any of the TODO state keywords.") | |
2857 | (make-variable-buffer-local 'org-todo-regexp) | |
2858 | (defvar org-not-done-regexp nil | |
2859 | "Matches any of the TODO state keywords except the last one.") | |
2860 | (make-variable-buffer-local 'org-not-done-regexp) | |
2861 | (defvar org-todo-line-regexp nil | |
2862 | "Matches a headline and puts TODO state into group 2 if present.") | |
2863 | (make-variable-buffer-local 'org-todo-line-regexp) | |
2864 | (defvar org-complex-heading-regexp nil | |
2865 | "Matches a headline and puts everything into groups: | |
2866 | group 1: the stars | |
2867 | group 2: The todo keyword, maybe | |
2868 | group 3: Priority cookie | |
2869 | group 4: True headline | |
2870 | group 5: Tags") | |
2871 | (make-variable-buffer-local 'org-complex-heading-regexp) | |
2872 | (defvar org-todo-line-tags-regexp nil | |
2873 | "Matches a headline and puts TODO state into group 2 if present. | |
2874 | Also put tags into group 4 if tags are present.") | |
2875 | (make-variable-buffer-local 'org-todo-line-tags-regexp) | |
2876 | (defvar org-nl-done-regexp nil | |
2877 | "Matches newline followed by a headline with the DONE keyword.") | |
2878 | (make-variable-buffer-local 'org-nl-done-regexp) | |
2879 | (defvar org-looking-at-done-regexp nil | |
2880 | "Matches the DONE keyword a point.") | |
2881 | (make-variable-buffer-local 'org-looking-at-done-regexp) | |
2882 | (defvar org-ds-keyword-length 12 | |
2883 | "Maximum length of the Deadline and SCHEDULED keywords.") | |
2884 | (make-variable-buffer-local 'org-ds-keyword-length) | |
2885 | (defvar org-deadline-regexp nil | |
2886 | "Matches the DEADLINE keyword.") | |
2887 | (make-variable-buffer-local 'org-deadline-regexp) | |
2888 | (defvar org-deadline-time-regexp nil | |
2889 | "Matches the DEADLINE keyword together with a time stamp.") | |
2890 | (make-variable-buffer-local 'org-deadline-time-regexp) | |
2891 | (defvar org-deadline-line-regexp nil | |
2892 | "Matches the DEADLINE keyword and the rest of the line.") | |
2893 | (make-variable-buffer-local 'org-deadline-line-regexp) | |
2894 | (defvar org-scheduled-regexp nil | |
2895 | "Matches the SCHEDULED keyword.") | |
2896 | (make-variable-buffer-local 'org-scheduled-regexp) | |
2897 | (defvar org-scheduled-time-regexp nil | |
2898 | "Matches the SCHEDULED keyword together with a time stamp.") | |
2899 | (make-variable-buffer-local 'org-scheduled-time-regexp) | |
2900 | (defvar org-closed-time-regexp nil | |
2901 | "Matches the CLOSED keyword together with a time stamp.") | |
2902 | (make-variable-buffer-local 'org-closed-time-regexp) | |
a3fbe8c4 | 2903 | |
20908596 CD |
2904 | (defvar org-keyword-time-regexp nil |
2905 | "Matches any of the 4 keywords, together with the time stamp.") | |
2906 | (make-variable-buffer-local 'org-keyword-time-regexp) | |
2907 | (defvar org-keyword-time-not-clock-regexp nil | |
2908 | "Matches any of the 3 keywords, together with the time stamp.") | |
2909 | (make-variable-buffer-local 'org-keyword-time-not-clock-regexp) | |
2910 | (defvar org-maybe-keyword-time-regexp nil | |
2911 | "Matches a timestamp, possibly preceeded by a keyword.") | |
2912 | (make-variable-buffer-local 'org-maybe-keyword-time-regexp) | |
2913 | (defvar org-planning-or-clock-line-re nil | |
2914 | "Matches a line with planning or clock info.") | |
2915 | (make-variable-buffer-local 'org-planning-or-clock-line-re) | |
a3fbe8c4 | 2916 | |
20908596 CD |
2917 | (defconst org-plain-time-of-day-regexp |
2918 | (concat | |
2919 | "\\(\\<[012]?[0-9]" | |
2920 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
2921 | "\\(--?" | |
2922 | "\\(\\<[012]?[0-9]" | |
2923 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
2924 | "\\)?") | |
2925 | "Regular expression to match a plain time or time range. | |
2926 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
2927 | groups carry important information: | |
2928 | 0 the full match | |
2929 | 1 the first time, range or not | |
2930 | 8 the second time, if it is a range.") | |
a3fbe8c4 | 2931 | |
20908596 CD |
2932 | (defconst org-plain-time-extension-regexp |
2933 | (concat | |
2934 | "\\(\\<[012]?[0-9]" | |
2935 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
2936 | "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?") | |
2937 | "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40. | |
2938 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
2939 | groups carry important information: | |
2940 | 0 the full match | |
2941 | 7 hours of duration | |
2942 | 9 minutes of duration") | |
2943 | ||
2944 | (defconst org-stamp-time-of-day-regexp | |
2945 | (concat | |
2946 | "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" | |
2947 | "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>" | |
2948 | "\\(--?" | |
2949 | "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") | |
2950 | "Regular expression to match a timestamp time or time range. | |
2951 | After a match, the following groups carry important information: | |
2952 | 0 the full match | |
2953 | 1 date plus weekday, for backreferencing to make sure both times on same day | |
2954 | 2 the first time, range or not | |
2955 | 4 the second time, if it is a range.") | |
2956 | ||
2957 | (defconst org-startup-options | |
2958 | '(("fold" org-startup-folded t) | |
2959 | ("overview" org-startup-folded t) | |
2960 | ("nofold" org-startup-folded nil) | |
2961 | ("showall" org-startup-folded nil) | |
2962 | ("content" org-startup-folded content) | |
2963 | ("hidestars" org-hide-leading-stars t) | |
2964 | ("showstars" org-hide-leading-stars nil) | |
2965 | ("odd" org-odd-levels-only t) | |
2966 | ("oddeven" org-odd-levels-only nil) | |
2967 | ("align" org-startup-align-all-tables t) | |
2968 | ("noalign" org-startup-align-all-tables nil) | |
2969 | ("customtime" org-display-custom-times t) | |
2970 | ("logdone" org-log-done time) | |
2971 | ("lognotedone" org-log-done note) | |
2972 | ("nologdone" org-log-done nil) | |
2973 | ("lognoteclock-out" org-log-note-clock-out t) | |
2974 | ("nolognoteclock-out" org-log-note-clock-out nil) | |
2975 | ("logrepeat" org-log-repeat state) | |
2976 | ("lognoterepeat" org-log-repeat note) | |
2977 | ("nologrepeat" org-log-repeat nil) | |
2978 | ("constcgs" constants-unit-system cgs) | |
2979 | ("constSI" constants-unit-system SI)) | |
2980 | "Variable associated with STARTUP options for org-mode. | |
2981 | Each element is a list of three items: The startup options as written | |
2982 | in the #+STARTUP line, the corresponding variable, and the value to | |
2983 | set this variable to if the option is found. An optional forth element PUSH | |
2984 | means to push this value onto the list in the variable.") | |
2985 | ||
2986 | (defun org-set-regexps-and-options () | |
2987 | "Precompute regular expressions for current buffer." | |
2988 | (when (org-mode-p) | |
2989 | (org-set-local 'org-todo-kwd-alist nil) | |
2990 | (org-set-local 'org-todo-key-alist nil) | |
2991 | (org-set-local 'org-todo-key-trigger nil) | |
2992 | (org-set-local 'org-todo-keywords-1 nil) | |
2993 | (org-set-local 'org-done-keywords nil) | |
2994 | (org-set-local 'org-todo-heads nil) | |
2995 | (org-set-local 'org-todo-sets nil) | |
2996 | (org-set-local 'org-todo-log-states nil) | |
b349f79f CD |
2997 | (org-set-local 'org-file-properties nil) |
2998 | (org-set-local 'org-file-tags nil) | |
20908596 CD |
2999 | (let ((re (org-make-options-regexp |
3000 | '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" | |
b349f79f CD |
3001 | "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" |
3002 | "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE"))) | |
20908596 CD |
3003 | (splitre "[ \t]+") |
3004 | kwds kws0 kwsa key log value cat arch tags const links hw dws | |
b349f79f CD |
3005 | tail sep kws1 prio props ftags drawers |
3006 | ext-setup-or-nil setup-contents (start 0)) | |
a3fbe8c4 | 3007 | (save-excursion |
20908596 CD |
3008 | (save-restriction |
3009 | (widen) | |
3010 | (goto-char (point-min)) | |
b349f79f CD |
3011 | (while (or (and ext-setup-or-nil |
3012 | (string-match re ext-setup-or-nil start) | |
3013 | (setq start (match-end 0))) | |
3014 | (and (setq ext-setup-or-nil nil start 0) | |
3015 | (re-search-forward re nil t))) | |
3016 | (setq key (upcase (match-string 1 ext-setup-or-nil)) | |
3017 | value (org-match-string-no-properties 2 ext-setup-or-nil)) | |
20908596 CD |
3018 | (cond |
3019 | ((equal key "CATEGORY") | |
3020 | (if (string-match "[ \t]+$" value) | |
3021 | (setq value (replace-match "" t t value))) | |
3022 | (setq cat value)) | |
3023 | ((member key '("SEQ_TODO" "TODO")) | |
3024 | (push (cons 'sequence (org-split-string value splitre)) kwds)) | |
3025 | ((equal key "TYP_TODO") | |
3026 | (push (cons 'type (org-split-string value splitre)) kwds)) | |
3027 | ((equal key "TAGS") | |
3028 | (setq tags (append tags (org-split-string value splitre)))) | |
3029 | ((equal key "COLUMNS") | |
3030 | (org-set-local 'org-columns-default-format value)) | |
3031 | ((equal key "LINK") | |
3032 | (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) | |
3033 | (push (cons (match-string 1 value) | |
3034 | (org-trim (match-string 2 value))) | |
3035 | links))) | |
3036 | ((equal key "PRIORITIES") | |
3037 | (setq prio (org-split-string value " +"))) | |
3038 | ((equal key "PROPERTY") | |
3039 | (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) | |
3040 | (push (cons (match-string 1 value) (match-string 2 value)) | |
3041 | props))) | |
b349f79f CD |
3042 | ((equal key "FILETAGS") |
3043 | (when (string-match "\\S-" value) | |
3044 | (setq ftags | |
3045 | (append | |
3046 | ftags | |
3047 | (apply 'append | |
3048 | (mapcar (lambda (x) (org-split-string x ":")) | |
3049 | (org-split-string value))))))) | |
20908596 CD |
3050 | ((equal key "DRAWERS") |
3051 | (setq drawers (org-split-string value splitre))) | |
3052 | ((equal key "CONSTANTS") | |
3053 | (setq const (append const (org-split-string value splitre)))) | |
3054 | ((equal key "STARTUP") | |
3055 | (let ((opts (org-split-string value splitre)) | |
3056 | l var val) | |
3057 | (while (setq l (pop opts)) | |
3058 | (when (setq l (assoc l org-startup-options)) | |
3059 | (setq var (nth 1 l) val (nth 2 l)) | |
3060 | (if (not (nth 3 l)) | |
3061 | (set (make-local-variable var) val) | |
3062 | (if (not (listp (symbol-value var))) | |
3063 | (set (make-local-variable var) nil)) | |
3064 | (set (make-local-variable var) (symbol-value var)) | |
3065 | (add-to-list var val)))))) | |
3066 | ((equal key "ARCHIVE") | |
3067 | (string-match " *$" value) | |
3068 | (setq arch (replace-match "" t t value)) | |
3069 | (remove-text-properties 0 (length arch) | |
b349f79f CD |
3070 | '(face t fontified t) arch)) |
3071 | ((equal key "SETUPFILE") | |
3072 | (setq setup-contents (org-file-contents | |
3073 | (expand-file-name | |
3074 | (org-remove-double-quotes value)) | |
3075 | 'noerror)) | |
3076 | (if (not ext-setup-or-nil) | |
3077 | (setq ext-setup-or-nil setup-contents start 0) | |
3078 | (setq ext-setup-or-nil | |
3079 | (concat (substring ext-setup-or-nil 0 start) | |
3080 | "\n" setup-contents "\n" | |
3081 | (substring ext-setup-or-nil start))))) | |
3082 | )))) | |
20908596 CD |
3083 | (when cat |
3084 | (org-set-local 'org-category (intern cat)) | |
3085 | (push (cons "CATEGORY" cat) props)) | |
3086 | (when prio | |
3087 | (if (< (length prio) 3) (setq prio '("A" "C" "B"))) | |
3088 | (setq prio (mapcar 'string-to-char prio)) | |
3089 | (org-set-local 'org-highest-priority (nth 0 prio)) | |
3090 | (org-set-local 'org-lowest-priority (nth 1 prio)) | |
3091 | (org-set-local 'org-default-priority (nth 2 prio))) | |
b349f79f CD |
3092 | (and props (org-set-local 'org-file-properties (nreverse props))) |
3093 | (and ftags (org-set-local 'org-file-tags ftags)) | |
20908596 CD |
3094 | (and drawers (org-set-local 'org-drawers drawers)) |
3095 | (and arch (org-set-local 'org-archive-location arch)) | |
3096 | (and links (setq org-link-abbrev-alist-local (nreverse links))) | |
3097 | ;; Process the TODO keywords | |
3098 | (unless kwds | |
3099 | ;; Use the global values as if they had been given locally. | |
3100 | (setq kwds (default-value 'org-todo-keywords)) | |
3101 | (if (stringp (car kwds)) | |
3102 | (setq kwds (list (cons org-todo-interpretation | |
3103 | (default-value 'org-todo-keywords))))) | |
3104 | (setq kwds (reverse kwds))) | |
3105 | (setq kwds (nreverse kwds)) | |
3106 | (let (inter kws kw) | |
3107 | (while (setq kws (pop kwds)) | |
3108 | (setq inter (pop kws) sep (member "|" kws) | |
3109 | kws0 (delete "|" (copy-sequence kws)) | |
3110 | kwsa nil | |
3111 | kws1 (mapcar | |
3112 | (lambda (x) | |
3113 | ;; 1 2 | |
3114 | (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) | |
3115 | (progn | |
3116 | (setq kw (match-string 1 x) | |
3117 | key (and (match-end 2) (match-string 2 x)) | |
3118 | log (org-extract-log-state-settings x)) | |
3119 | (push (cons kw (and key (string-to-char key))) kwsa) | |
3120 | (and log (push log org-todo-log-states)) | |
3121 | kw) | |
3122 | (error "Invalid TODO keyword %s" x))) | |
3123 | kws0) | |
3124 | kwsa (if kwsa (append '((:startgroup)) | |
3125 | (nreverse kwsa) | |
3126 | '((:endgroup)))) | |
3127 | hw (car kws1) | |
3128 | dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) | |
3129 | tail (list inter hw (car dws) (org-last dws))) | |
3130 | (add-to-list 'org-todo-heads hw 'append) | |
3131 | (push kws1 org-todo-sets) | |
3132 | (setq org-done-keywords (append org-done-keywords dws nil)) | |
3133 | (setq org-todo-key-alist (append org-todo-key-alist kwsa)) | |
3134 | (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) | |
3135 | (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) | |
3136 | (setq org-todo-sets (nreverse org-todo-sets) | |
3137 | org-todo-kwd-alist (nreverse org-todo-kwd-alist) | |
3138 | org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) | |
3139 | org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) | |
3140 | ;; Process the constants | |
3141 | (when const | |
3142 | (let (e cst) | |
3143 | (while (setq e (pop const)) | |
3144 | (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) | |
3145 | (push (cons (match-string 1 e) (match-string 2 e)) cst))) | |
3146 | (setq org-table-formula-constants-local cst))) | |
a3fbe8c4 | 3147 | |
20908596 CD |
3148 | ;; Process the tags. |
3149 | (when tags | |
3150 | (let (e tgs) | |
3151 | (while (setq e (pop tags)) | |
3152 | (cond | |
3153 | ((equal e "{") (push '(:startgroup) tgs)) | |
3154 | ((equal e "}") (push '(:endgroup) tgs)) | |
3155 | ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) | |
3156 | (push (cons (match-string 1 e) | |
3157 | (string-to-char (match-string 2 e))) | |
3158 | tgs)) | |
3159 | (t (push (list e) tgs)))) | |
3160 | (org-set-local 'org-tag-alist nil) | |
3161 | (while (setq e (pop tgs)) | |
3162 | (or (and (stringp (car e)) | |
3163 | (assoc (car e) org-tag-alist)) | |
b349f79f CD |
3164 | (push e org-tag-alist))))) |
3165 | ||
3166 | ;; Compute the regular expressions and other local variables | |
3167 | (if (not org-done-keywords) | |
3168 | (setq org-done-keywords (list (org-last org-todo-keywords-1)))) | |
3169 | (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) | |
3170 | (length org-scheduled-string) | |
3171 | (length org-clock-string) | |
3172 | (length org-closed-string))) | |
3173 | org-drawer-regexp | |
3174 | (concat "^[ \t]*:\\(" | |
3175 | (mapconcat 'regexp-quote org-drawers "\\|") | |
3176 | "\\):[ \t]*$") | |
3177 | org-not-done-keywords | |
3178 | (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) | |
3179 | org-todo-regexp | |
3180 | (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 | |
3181 | "\\|") "\\)\\>") | |
3182 | org-not-done-regexp | |
3183 | (concat "\\<\\(" | |
3184 | (mapconcat 'regexp-quote org-not-done-keywords "\\|") | |
3185 | "\\)\\>") | |
3186 | org-todo-line-regexp | |
3187 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" | |
3188 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
3189 | "\\)\\>\\)?[ \t]*\\(.*\\)") | |
3190 | org-complex-heading-regexp | |
3191 | (concat "^\\(\\*+\\)\\(?:[ \t]+\\(" | |
3192 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
3193 | "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" | |
3194 | "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") | |
3195 | org-nl-done-regexp | |
3196 | (concat "\n\\*+[ \t]+" | |
3197 | "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") | |
3198 | "\\)" "\\>") | |
3199 | org-todo-line-tags-regexp | |
3200 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" | |
3201 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
3202 | (org-re | |
3203 | "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) | |
3204 | org-looking-at-done-regexp | |
3205 | (concat "^" "\\(?:" | |
3206 | (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" | |
3207 | "\\>") | |
3208 | org-deadline-regexp (concat "\\<" org-deadline-string) | |
3209 | org-deadline-time-regexp | |
3210 | (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") | |
3211 | org-deadline-line-regexp | |
3212 | (concat "\\<\\(" org-deadline-string "\\).*") | |
3213 | org-scheduled-regexp | |
3214 | (concat "\\<" org-scheduled-string) | |
3215 | org-scheduled-time-regexp | |
3216 | (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") | |
3217 | org-closed-time-regexp | |
3218 | (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") | |
3219 | org-keyword-time-regexp | |
3220 | (concat "\\<\\(" org-scheduled-string | |
3221 | "\\|" org-deadline-string | |
3222 | "\\|" org-closed-string | |
3223 | "\\|" org-clock-string "\\)" | |
3224 | " *[[<]\\([^]>]+\\)[]>]") | |
3225 | org-keyword-time-not-clock-regexp | |
3226 | (concat "\\<\\(" org-scheduled-string | |
3227 | "\\|" org-deadline-string | |
3228 | "\\|" org-closed-string | |
3229 | "\\)" | |
3230 | " *[[<]\\([^]>]+\\)[]>]") | |
3231 | org-maybe-keyword-time-regexp | |
3232 | (concat "\\(\\<\\(" org-scheduled-string | |
3233 | "\\|" org-deadline-string | |
3234 | "\\|" org-closed-string | |
3235 | "\\|" org-clock-string "\\)\\)?" | |
3236 | " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") | |
3237 | org-planning-or-clock-line-re | |
3238 | (concat "\\(?:^[ \t]*\\(" org-scheduled-string | |
3239 | "\\|" org-deadline-string | |
3240 | "\\|" org-closed-string "\\|" org-clock-string | |
3241 | "\\)\\>\\)") | |
3242 | ) | |
3243 | (org-compute-latex-and-specials-regexp) | |
3244 | (org-set-font-lock-defaults)))) | |
3245 | ||
3246 | (defun org-file-contents (file &optional noerror) | |
3247 | "Return the contents of FILE, as a string." | |
3248 | (if (or (not file) | |
3249 | (not (file-readable-p file))) | |
3250 | (if noerror | |
3251 | (progn | |
3252 | (message "Cannot read file %s" file) | |
3253 | (ding) (sit-for 2) | |
3254 | "") | |
3255 | (error "Cannot read file %s" file)) | |
3256 | (with-temp-buffer | |
3257 | (insert-file-contents file) | |
3258 | (buffer-string)))) | |
891f4676 | 3259 | |
20908596 CD |
3260 | (defun org-extract-log-state-settings (x) |
3261 | "Extract the log state setting from a TODO keyword string. | |
3262 | This will extract info from a string like \"WAIT(w@/!)\"." | |
3263 | (let (kw key log1 log2) | |
3264 | (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) | |
3265 | (setq kw (match-string 1 x) | |
3266 | key (and (match-end 2) (match-string 2 x)) | |
3267 | log1 (and (match-end 3) (match-string 3 x)) | |
3268 | log2 (and (match-end 4) (match-string 4 x))) | |
3269 | (and (or log1 log2) | |
3270 | (list kw | |
3271 | (and log1 (if (equal log1 "!") 'time 'note)) | |
3272 | (and log2 (if (equal log2 "!") 'time 'note))))))) | |
891f4676 | 3273 | |
20908596 CD |
3274 | (defun org-remove-keyword-keys (list) |
3275 | "Remove a pair of parenthesis at the end of each string in LIST." | |
3276 | (mapcar (lambda (x) | |
3277 | (if (string-match "(.*)$" x) | |
3278 | (substring x 0 (match-beginning 0)) | |
3279 | x)) | |
3280 | list)) | |
891f4676 | 3281 | |
20908596 CD |
3282 | ;; FIXME: this could be done much better, using second characters etc. |
3283 | (defun org-assign-fast-keys (alist) | |
3284 | "Assign fast keys to a keyword-key alist. | |
3285 | Respect keys that are already there." | |
3286 | (let (new e k c c1 c2 (char ?a)) | |
3287 | (while (setq e (pop alist)) | |
d3f4dbe8 | 3288 | (cond |
20908596 CD |
3289 | ((equal e '(:startgroup)) (push e new)) |
3290 | ((equal e '(:endgroup)) (push e new)) | |
d3f4dbe8 | 3291 | (t |
20908596 CD |
3292 | (setq k (car e) c2 nil) |
3293 | (if (cdr e) | |
3294 | (setq c (cdr e)) | |
3295 | ;; automatically assign a character. | |
3296 | (setq c1 (string-to-char | |
3297 | (downcase (substring | |
3298 | k (if (= (string-to-char k) ?@) 1 0))))) | |
3299 | (if (or (rassoc c1 new) (rassoc c1 alist)) | |
3300 | (while (or (rassoc char new) (rassoc char alist)) | |
3301 | (setq char (1+ char))) | |
3302 | (setq c2 c1)) | |
3303 | (setq c (or c2 char))) | |
3304 | (push (cons k c) new)))) | |
3305 | (nreverse new))) | |
d3f4dbe8 | 3306 | |
20908596 | 3307 | ;;; Some variables used in various places |
d3f4dbe8 | 3308 | |
20908596 CD |
3309 | (defvar org-window-configuration nil |
3310 | "Used in various places to store a window configuration.") | |
3311 | (defvar org-finish-function nil | |
3312 | "Function to be called when `C-c C-c' is used. | |
3313 | This is for getting out of special buffers like remember.") | |
d3f4dbe8 | 3314 | |
d3f4dbe8 | 3315 | |
20908596 CD |
3316 | ;; FIXME: Occasionally check by commenting these, to make sure |
3317 | ;; no other functions uses these, forgetting to let-bind them. | |
3318 | (defvar entry) | |
3319 | (defvar state) | |
3320 | (defvar last-state) | |
3321 | (defvar date) | |
3322 | (defvar description) | |
d3f4dbe8 | 3323 | |
20908596 CD |
3324 | ;; Defined somewhere in this file, but used before definition. |
3325 | (defvar org-html-entities) | |
3326 | (defvar org-struct-menu) | |
3327 | (defvar org-org-menu) | |
3328 | (defvar org-tbl-menu) | |
3329 | (defvar org-agenda-keymap) | |
3278a016 | 3330 | |
20908596 | 3331 | ;;;; Define the Org-mode |
3278a016 | 3332 | |
20908596 CD |
3333 | (if (and (not (keymapp outline-mode-map)) (featurep 'allout)) |
3334 | (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 | 3335 | |
d3f4dbe8 | 3336 | |
20908596 CD |
3337 | ;; We use a before-change function to check if a table might need |
3338 | ;; an update. | |
3339 | (defvar org-table-may-need-update t | |
3340 | "Indicates that a table might need an update. | |
3341 | This variable is set by `org-before-change-function'. | |
3342 | `org-table-align' sets it back to nil.") | |
3343 | (defun org-before-change-function (beg end) | |
3344 | "Every change indicates that a table might need an update." | |
3345 | (setq org-table-may-need-update t)) | |
3346 | (defvar org-mode-map) | |
3347 | (defvar org-mode-hook nil) | |
3348 | (defvar org-inhibit-startup nil) ; Dynamically-scoped param. | |
3349 | (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. | |
3350 | (defvar org-table-buffer-is-an nil) | |
3351 | (defconst org-outline-regexp "\\*+ ") | |
f425a6ea CD |
3352 | |
3353 | ;;;###autoload | |
20908596 CD |
3354 | (define-derived-mode org-mode outline-mode "Org" |
3355 | "Outline-based notes management and organizer, alias | |
3356 | \"Carsten's outline-mode for keeping track of everything.\" | |
891f4676 | 3357 | |
20908596 CD |
3358 | Org-mode develops organizational tasks around a NOTES file which |
3359 | contains information about projects as plain text. Org-mode is | |
3360 | implemented on top of outline-mode, which is ideal to keep the content | |
3361 | of large files well structured. It supports ToDo items, deadlines and | |
3362 | time stamps, which magically appear in the diary listing of the Emacs | |
3363 | calendar. Tables are easily created with a built-in table editor. | |
3364 | Plain text URL-like links connect to websites, emails (VM), Usenet | |
3365 | messages (Gnus), BBDB entries, and any files related to the project. | |
3366 | For printing and sharing of notes, an Org-mode file (or a part of it) | |
3367 | can be exported as a structured ASCII or HTML file. | |
35fb9989 | 3368 | |
20908596 | 3369 | The following commands are available: |
35fb9989 | 3370 | |
20908596 | 3371 | \\{org-mode-map}" |
634a7d0b | 3372 | |
20908596 CD |
3373 | ;; Get rid of Outline menus, they are not needed |
3374 | ;; Need to do this here because define-derived-mode sets up | |
3375 | ;; the keymap so late. Still, it is a waste to call this each time | |
3376 | ;; we switch another buffer into org-mode. | |
3377 | (if (featurep 'xemacs) | |
3378 | (when (boundp 'outline-mode-menu-heading) | |
3379 | ;; Assume this is Greg's port, it used easymenu | |
3380 | (easy-menu-remove outline-mode-menu-heading) | |
3381 | (easy-menu-remove outline-mode-menu-show) | |
3382 | (easy-menu-remove outline-mode-menu-hide)) | |
3383 | (define-key org-mode-map [menu-bar headings] 'undefined) | |
3384 | (define-key org-mode-map [menu-bar hide] 'undefined) | |
3385 | (define-key org-mode-map [menu-bar show] 'undefined)) | |
a3fbe8c4 | 3386 | |
20908596 CD |
3387 | (org-load-modules-maybe) |
3388 | (easy-menu-add org-org-menu) | |
3389 | (easy-menu-add org-tbl-menu) | |
3390 | (org-install-agenda-files-menu) | |
3391 | (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) | |
3392 | (org-add-to-invisibility-spec '(org-cwidth)) | |
3393 | (when (featurep 'xemacs) | |
3394 | (org-set-local 'line-move-ignore-invisible t)) | |
3395 | (org-set-local 'outline-regexp org-outline-regexp) | |
3396 | (org-set-local 'outline-level 'org-outline-level) | |
3397 | (when (and org-ellipsis | |
3398 | (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) | |
3399 | (fboundp 'make-glyph-code)) | |
3400 | (unless org-display-table | |
3401 | (setq org-display-table (make-display-table))) | |
3402 | (set-display-table-slot | |
3403 | org-display-table 4 | |
3404 | (vconcat (mapcar | |
3405 | (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) | |
3406 | org-ellipsis))) | |
3407 | (if (stringp org-ellipsis) org-ellipsis "...")))) | |
3408 | (setq buffer-display-table org-display-table)) | |
3409 | (org-set-regexps-and-options) | |
3410 | ;; Calc embedded | |
3411 | (org-set-local 'calc-embedded-open-mode "# ") | |
3412 | (modify-syntax-entry ?# "<") | |
3413 | (modify-syntax-entry ?@ "w") | |
3414 | (if org-startup-truncated (setq truncate-lines t)) | |
3415 | (org-set-local 'font-lock-unfontify-region-function | |
3416 | 'org-unfontify-region) | |
3417 | ;; Activate before-change-function | |
3418 | (org-set-local 'org-table-may-need-update t) | |
3419 | (org-add-hook 'before-change-functions 'org-before-change-function nil | |
3420 | 'local) | |
3421 | ;; Check for running clock before killing a buffer | |
3422 | (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) | |
3423 | ;; Paragraphs and auto-filling | |
3424 | (org-set-autofill-regexps) | |
3425 | (setq indent-line-function 'org-indent-line-function) | |
3426 | (org-update-radio-target-regexp) | |
7ac93e3c | 3427 | |
20908596 CD |
3428 | ;; Comment characters |
3429 | ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping | |
3430 | (org-set-local 'comment-padding " ") | |
891f4676 | 3431 | |
20908596 CD |
3432 | ;; Align options lines |
3433 | (org-set-local | |
3434 | 'align-mode-rules-list | |
3435 | '((org-in-buffer-settings | |
3436 | (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") | |
3437 | (modes . '(org-mode))))) | |
891f4676 | 3438 | |
20908596 CD |
3439 | ;; Imenu |
3440 | (org-set-local 'imenu-create-index-function | |
3441 | 'org-imenu-get-tree) | |
891f4676 | 3442 | |
20908596 CD |
3443 | ;; Make isearch reveal context |
3444 | (if (or (featurep 'xemacs) | |
3445 | (not (boundp 'outline-isearch-open-invisible-function))) | |
3446 | ;; Emacs 21 and XEmacs make use of the hook | |
3447 | (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) | |
3448 | ;; Emacs 22 deals with this through a special variable | |
3449 | (org-set-local 'outline-isearch-open-invisible-function | |
3450 | (lambda (&rest ignore) (org-show-context 'isearch)))) | |
634a7d0b | 3451 | |
20908596 CD |
3452 | ;; If empty file that did not turn on org-mode automatically, make it to. |
3453 | (if (and org-insert-mode-line-in-empty-file | |
3454 | (interactive-p) | |
3455 | (= (point-min) (point-max))) | |
3456 | (insert "# -*- mode: org -*-\n\n")) | |
891f4676 | 3457 | |
20908596 CD |
3458 | (unless org-inhibit-startup |
3459 | (when org-startup-align-all-tables | |
3460 | (let ((bmp (buffer-modified-p))) | |
3461 | (org-table-map-tables 'org-table-align) | |
3462 | (set-buffer-modified-p bmp))) | |
b349f79f | 3463 | (org-set-startup-visibility))) |
ef943dba | 3464 | |
20908596 | 3465 | (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) |
b9661543 | 3466 | |
20908596 CD |
3467 | (defun org-current-time () |
3468 | "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." | |
3469 | (if (> (car org-time-stamp-rounding-minutes) 1) | |
3470 | (let ((r (car org-time-stamp-rounding-minutes)) | |
3471 | (time (decode-time))) | |
3472 | (apply 'encode-time | |
3473 | (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) | |
3474 | (nthcdr 2 time)))) | |
3475 | (current-time))) | |
ef943dba | 3476 | |
20908596 | 3477 | ;;;; Font-Lock stuff, including the activators |
ef943dba | 3478 | |
20908596 CD |
3479 | (defvar org-mouse-map (make-sparse-keymap)) |
3480 | (org-defkey org-mouse-map | |
3481 | (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) | |
3482 | (org-defkey org-mouse-map | |
3483 | (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) | |
3484 | (when org-mouse-1-follows-link | |
3485 | (org-defkey org-mouse-map [follow-link] 'mouse-face)) | |
3486 | (when org-tab-follows-link | |
3487 | (org-defkey org-mouse-map [(tab)] 'org-open-at-point) | |
3488 | (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) | |
3489 | (when org-return-follows-link | |
3490 | (org-defkey org-mouse-map [(return)] 'org-open-at-point) | |
3491 | (org-defkey org-mouse-map "\C-m" 'org-open-at-point)) | |
48aaad2d | 3492 | |
20908596 | 3493 | (require 'font-lock) |
48aaad2d | 3494 | |
20908596 CD |
3495 | (defconst org-non-link-chars "]\t\n\r<>") |
3496 | (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" | |
3497 | "shell" "elisp")) | |
3498 | (defvar org-link-types-re nil | |
3499 | "Matches a link that has a url-like prefix like \"http:\"") | |
3500 | (defvar org-link-re-with-space nil | |
3501 | "Matches a link with spaces, optional angular brackets around it.") | |
3502 | (defvar org-link-re-with-space2 nil | |
3503 | "Matches a link with spaces, optional angular brackets around it.") | |
ce4fdcb9 CD |
3504 | (defvar org-link-re-with-space3 nil |
3505 | "Matches a link with spaces, only for internal part in bracket links.") | |
20908596 CD |
3506 | (defvar org-angle-link-re nil |
3507 | "Matches link with angular brackets, spaces are allowed.") | |
3508 | (defvar org-plain-link-re nil | |
3509 | "Matches plain link, without spaces.") | |
3510 | (defvar org-bracket-link-regexp nil | |
3511 | "Matches a link in double brackets.") | |
3512 | (defvar org-bracket-link-analytic-regexp nil | |
3513 | "Regular expression used to analyze links. | |
3514 | Here is what the match groups contain after a match: | |
3515 | 1: http: | |
3516 | 2: http | |
3517 | 3: path | |
3518 | 4: [desc] | |
3519 | 5: desc") | |
3520 | (defvar org-any-link-re nil | |
3521 | "Regular expression matching any link.") | |
48aaad2d | 3522 | |
20908596 CD |
3523 | (defun org-make-link-regexps () |
3524 | "Update the link regular expressions. | |
3525 | This should be called after the variable `org-link-types' has changed." | |
3526 | (setq org-link-types-re | |
3527 | (concat | |
3528 | "\\`\\(" (mapconcat 'identity org-link-types "\\|") "\\):") | |
3529 | org-link-re-with-space | |
3530 | (concat | |
3531 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
3532 | "\\([^" org-non-link-chars " ]" | |
3533 | "[^" org-non-link-chars "]*" | |
3534 | "[^" org-non-link-chars " ]\\)>?") | |
3535 | org-link-re-with-space2 | |
3536 | (concat | |
3537 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
3538 | "\\([^" org-non-link-chars " ]" | |
93b62de8 | 3539 | "[^\t\n\r]*" |
20908596 | 3540 | "[^" org-non-link-chars " ]\\)>?") |
ce4fdcb9 CD |
3541 | org-link-re-with-space3 |
3542 | (concat | |
3543 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
3544 | "\\([^" org-non-link-chars " ]" | |
3545 | "[^\t\n\r]*\\)") | |
20908596 CD |
3546 | org-angle-link-re |
3547 | (concat | |
3548 | "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
3549 | "\\([^" org-non-link-chars " ]" | |
3550 | "[^" org-non-link-chars "]*" | |
3551 | "\\)>") | |
3552 | org-plain-link-re | |
3553 | (concat | |
3554 | "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
3555 | "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") | |
3556 | org-bracket-link-regexp | |
3557 | "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" | |
3558 | org-bracket-link-analytic-regexp | |
3559 | (concat | |
3560 | "\\[\\[" | |
3561 | "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" | |
3562 | "\\([^]]+\\)" | |
3563 | "\\]" | |
3564 | "\\(\\[" "\\([^]]+\\)" "\\]\\)?" | |
3565 | "\\]") | |
3566 | org-any-link-re | |
3567 | (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" | |
3568 | org-angle-link-re "\\)\\|\\(" | |
3569 | org-plain-link-re "\\)"))) | |
48aaad2d | 3570 | |
20908596 | 3571 | (org-make-link-regexps) |
8c6fb58b | 3572 | |
20908596 CD |
3573 | (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" |
3574 | "Regular expression for fast time stamp matching.") | |
3575 | (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" | |
3576 | "Regular expression for fast time stamp matching.") | |
3577 | (defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
3578 | "Regular expression matching time strings for analysis. | |
3579 | This one does not require the space after the date, so it can be used | |
3580 | on a string that terminates immediately after the date.") | |
3581 | (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
3582 | "Regular expression matching time strings for analysis.") | |
3583 | (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") | |
3584 | "Regular expression matching time stamps, with groups.") | |
3585 | (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") | |
3586 | "Regular expression matching time stamps (also [..]), with groups.") | |
3587 | (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) | |
3588 | "Regular expression matching a time stamp range.") | |
3589 | (defconst org-tr-regexp-both | |
3590 | (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) | |
3591 | "Regular expression matching a time stamp range.") | |
3592 | (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" | |
3593 | org-ts-regexp "\\)?") | |
3594 | "Regular expression matching a time stamp or time stamp range.") | |
3595 | (defconst org-tsr-regexp-both (concat org-ts-regexp-both "\\(--?-?" | |
3596 | org-ts-regexp-both "\\)?") | |
3597 | "Regular expression matching a time stamp or time stamp range. | |
3598 | The time stamps may be either active or inactive.") | |
48aaad2d | 3599 | |
20908596 | 3600 | (defvar org-emph-face nil) |
2a57416f | 3601 | |
20908596 CD |
3602 | (defun org-do-emphasis-faces (limit) |
3603 | "Run through the buffer and add overlays to links." | |
3604 | (let (rtn) | |
3605 | (while (and (not rtn) (re-search-forward org-emph-re limit t)) | |
3606 | (if (not (= (char-after (match-beginning 3)) | |
3607 | (char-after (match-beginning 4)))) | |
3608 | (progn | |
3609 | (setq rtn t) | |
3610 | (font-lock-prepend-text-property (match-beginning 2) (match-end 2) | |
3611 | 'face | |
3612 | (nth 1 (assoc (match-string 3) | |
3613 | org-emphasis-alist))) | |
3614 | (add-text-properties (match-beginning 2) (match-end 2) | |
3615 | '(font-lock-multiline t)) | |
3616 | (when org-hide-emphasis-markers | |
3617 | (add-text-properties (match-end 4) (match-beginning 5) | |
3618 | '(invisible org-link)) | |
3619 | (add-text-properties (match-beginning 3) (match-end 3) | |
3620 | '(invisible org-link))))) | |
3621 | (backward-char 1)) | |
3622 | rtn)) | |
891f4676 | 3623 | |
20908596 CD |
3624 | (defun org-emphasize (&optional char) |
3625 | "Insert or change an emphasis, i.e. a font like bold or italic. | |
3626 | If there is an active region, change that region to a new emphasis. | |
3627 | If there is no region, just insert the marker characters and position | |
3628 | the cursor between them. | |
3629 | CHAR should be either the marker character, or the first character of the | |
3630 | HTML tag associated with that emphasis. If CHAR is a space, the means | |
3631 | to remove the emphasis of the selected region. | |
3632 | If char is not given (for example in an interactive call) it | |
3633 | will be prompted for." | |
3634 | (interactive) | |
3635 | (let ((eal org-emphasis-alist) e det | |
3636 | (erc org-emphasis-regexp-components) | |
3637 | (prompt "") | |
3638 | (string "") beg end move tag c s) | |
3639 | (if (org-region-active-p) | |
3640 | (setq beg (region-beginning) end (region-end) | |
3641 | string (buffer-substring beg end)) | |
3642 | (setq move t)) | |
48aaad2d | 3643 | |
20908596 CD |
3644 | (while (setq e (pop eal)) |
3645 | (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) | |
3646 | c (aref tag 0)) | |
3647 | (push (cons c (string-to-char (car e))) det) | |
3648 | (setq prompt (concat prompt (format " [%s%c]%s" (car e) c | |
3649 | (substring tag 1))))) | |
93b62de8 | 3650 | (setq det (nreverse det)) |
20908596 CD |
3651 | (unless char |
3652 | (message "%s" (concat "Emphasis marker or tag:" prompt)) | |
3653 | (setq char (read-char-exclusive))) | |
3654 | (setq char (or (cdr (assoc char det)) char)) | |
3655 | (if (equal char ?\ ) | |
3656 | (setq s "" move nil) | |
3657 | (unless (assoc (char-to-string char) org-emphasis-alist) | |
3658 | (error "No such emphasis marker: \"%c\"" char)) | |
3659 | (setq s (char-to-string char))) | |
3660 | (while (and (> (length string) 1) | |
3661 | (equal (substring string 0 1) (substring string -1)) | |
3662 | (assoc (substring string 0 1) org-emphasis-alist)) | |
3663 | (setq string (substring string 1 -1))) | |
3664 | (setq string (concat s string s)) | |
3665 | (if beg (delete-region beg end)) | |
3666 | (unless (or (bolp) | |
3667 | (string-match (concat "[" (nth 0 erc) "\n]") | |
3668 | (char-to-string (char-before (point))))) | |
3669 | (insert " ")) | |
3670 | (unless (string-match (concat "[" (nth 1 erc) "\n]") | |
3671 | (char-to-string (char-after (point)))) | |
3672 | (insert " ") (backward-char 1)) | |
3673 | (insert string) | |
3674 | (and move (backward-char 1)))) | |
891f4676 | 3675 | |
20908596 CD |
3676 | (defconst org-nonsticky-props |
3677 | '(mouse-face highlight keymap invisible intangible help-echo org-linked-text)) | |
891f4676 | 3678 | |
891f4676 | 3679 | |
20908596 CD |
3680 | (defun org-activate-plain-links (limit) |
3681 | "Run through the buffer and add overlays to links." | |
3682 | (catch 'exit | |
3683 | (let (f) | |
3684 | (while (re-search-forward org-plain-link-re limit t) | |
3685 | (setq f (get-text-property (match-beginning 0) 'face)) | |
3686 | (if (or (eq f 'org-tag) | |
3687 | (and (listp f) (memq 'org-tag f))) | |
3688 | nil | |
3689 | (add-text-properties (match-beginning 0) (match-end 0) | |
3690 | (list 'mouse-face 'highlight | |
3691 | 'rear-nonsticky org-nonsticky-props | |
3692 | 'keymap org-mouse-map | |
3693 | )) | |
3694 | (throw 'exit t)))))) | |
891f4676 | 3695 | |
20908596 | 3696 | (defun org-activate-code (limit) |
621f83e4 CD |
3697 | (if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t) |
3698 | (progn | |
20908596 CD |
3699 | (remove-text-properties (match-beginning 0) (match-end 0) |
3700 | '(display t invisible t intangible t)) | |
3701 | t))) | |
891f4676 | 3702 | |
20908596 CD |
3703 | (defun org-activate-angle-links (limit) |
3704 | "Run through the buffer and add overlays to links." | |
3705 | (if (re-search-forward org-angle-link-re limit t) | |
3706 | (progn | |
3707 | (add-text-properties (match-beginning 0) (match-end 0) | |
3708 | (list 'mouse-face 'highlight | |
3709 | 'rear-nonsticky org-nonsticky-props | |
3710 | 'keymap org-mouse-map | |
3711 | )) | |
3712 | t))) | |
891f4676 | 3713 | |
20908596 CD |
3714 | (defun org-activate-bracket-links (limit) |
3715 | "Run through the buffer and add overlays to bracketed links." | |
3716 | (if (re-search-forward org-bracket-link-regexp limit t) | |
3717 | (let* ((help (concat "LINK: " | |
3718 | (org-match-string-no-properties 1))) | |
3719 | ;; FIXME: above we should remove the escapes. | |
3720 | ;; but that requires another match, protecting match data, | |
3721 | ;; a lot of overhead for font-lock. | |
3722 | (ip (org-maybe-intangible | |
3723 | (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props | |
3724 | 'keymap org-mouse-map 'mouse-face 'highlight | |
3725 | 'font-lock-multiline t 'help-echo help))) | |
3726 | (vp (list 'rear-nonsticky org-nonsticky-props | |
3727 | 'keymap org-mouse-map 'mouse-face 'highlight | |
3728 | ' font-lock-multiline t 'help-echo help))) | |
3729 | ;; We need to remove the invisible property here. Table narrowing | |
3730 | ;; may have made some of this invisible. | |
3731 | (remove-text-properties (match-beginning 0) (match-end 0) | |
3732 | '(invisible nil)) | |
3733 | (if (match-end 3) | |
3734 | (progn | |
3735 | (add-text-properties (match-beginning 0) (match-beginning 3) ip) | |
3736 | (add-text-properties (match-beginning 3) (match-end 3) vp) | |
3737 | (add-text-properties (match-end 3) (match-end 0) ip)) | |
3738 | (add-text-properties (match-beginning 0) (match-beginning 1) ip) | |
3739 | (add-text-properties (match-beginning 1) (match-end 1) vp) | |
3740 | (add-text-properties (match-end 1) (match-end 0) ip)) | |
3741 | t))) | |
891f4676 | 3742 | |
20908596 CD |
3743 | (defun org-activate-dates (limit) |
3744 | "Run through the buffer and add overlays to dates." | |
3745 | (if (re-search-forward org-tsr-regexp-both limit t) | |
3746 | (progn | |
3747 | (add-text-properties (match-beginning 0) (match-end 0) | |
3748 | (list 'mouse-face 'highlight | |
3749 | 'rear-nonsticky org-nonsticky-props | |
3750 | 'keymap org-mouse-map)) | |
3751 | (when org-display-custom-times | |
3752 | (if (match-end 3) | |
3753 | (org-display-custom-time (match-beginning 3) (match-end 3))) | |
3754 | (org-display-custom-time (match-beginning 1) (match-end 1))) | |
3755 | t))) | |
891f4676 | 3756 | |
20908596 CD |
3757 | (defvar org-target-link-regexp nil |
3758 | "Regular expression matching radio targets in plain text.") | |
ff4be292 | 3759 | (make-variable-buffer-local 'org-target-link-regexp) |
20908596 CD |
3760 | (defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" |
3761 | "Regular expression matching a link target.") | |
3762 | (defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" | |
3763 | "Regular expression matching a radio target.") | |
3764 | (defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target. | |
3765 | "Regular expression matching any target.") | |
a3fbe8c4 | 3766 | |
20908596 CD |
3767 | (defun org-activate-target-links (limit) |
3768 | "Run through the buffer and add overlays to target matches." | |
3769 | (when org-target-link-regexp | |
3770 | (let ((case-fold-search t)) | |
3771 | (if (re-search-forward org-target-link-regexp limit t) | |
3772 | (progn | |
3773 | (add-text-properties (match-beginning 0) (match-end 0) | |
3774 | (list 'mouse-face 'highlight | |
3775 | 'rear-nonsticky org-nonsticky-props | |
3776 | 'keymap org-mouse-map | |
3777 | 'help-echo "Radio target link" | |
3778 | 'org-linked-text t)) | |
3779 | t))))) | |
891f4676 | 3780 | |
20908596 CD |
3781 | (defun org-update-radio-target-regexp () |
3782 | "Find all radio targets in this file and update the regular expression." | |
3783 | (interactive) | |
3784 | (when (memq 'radio org-activate-links) | |
3785 | (setq org-target-link-regexp | |
3786 | (org-make-target-link-regexp (org-all-targets 'radio))) | |
3787 | (org-restart-font-lock))) | |
891f4676 | 3788 | |
20908596 CD |
3789 | (defun org-hide-wide-columns (limit) |
3790 | (let (s e) | |
3791 | (setq s (text-property-any (point) (or limit (point-max)) | |
3792 | 'org-cwidth t)) | |
3793 | (when s | |
3794 | (setq e (next-single-property-change s 'org-cwidth)) | |
3795 | (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) | |
3796 | (goto-char e) | |
3797 | t))) | |
891f4676 | 3798 | |
20908596 CD |
3799 | (defvar org-latex-and-specials-regexp nil |
3800 | "Regular expression for highlighting export special stuff.") | |
3801 | (defvar org-match-substring-regexp) | |
3802 | (defvar org-match-substring-with-braces-regexp) | |
3803 | (defvar org-export-html-special-string-regexps) | |
891f4676 | 3804 | |
20908596 CD |
3805 | (defun org-compute-latex-and-specials-regexp () |
3806 | "Compute regular expression for stuff treated specially by exporters." | |
3807 | (if (not org-highlight-latex-fragments-and-specials) | |
3808 | (org-set-local 'org-latex-and-specials-regexp nil) | |
3809 | (require 'org-exp) | |
3810 | (let* | |
3811 | ((matchers (plist-get org-format-latex-options :matchers)) | |
3812 | (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) | |
3813 | org-latex-regexps))) | |
3814 | (options (org-combine-plists (org-default-export-plist) | |
3815 | (org-infile-export-plist))) | |
3816 | (org-export-with-sub-superscripts (plist-get options :sub-superscript)) | |
3817 | (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) | |
3818 | (org-export-with-TeX-macros (plist-get options :TeX-macros)) | |
3819 | (org-export-html-expand (plist-get options :expand-quoted-html)) | |
3820 | (org-export-with-special-strings (plist-get options :special-strings)) | |
3821 | (re-sub | |
3822 | (cond | |
3823 | ((equal org-export-with-sub-superscripts '{}) | |
3824 | (list org-match-substring-with-braces-regexp)) | |
3825 | (org-export-with-sub-superscripts | |
3826 | (list org-match-substring-regexp)) | |
3827 | (t nil))) | |
3828 | (re-latex | |
3829 | (if org-export-with-LaTeX-fragments | |
3830 | (mapcar (lambda (x) (nth 1 x)) latexs))) | |
3831 | (re-macros | |
3832 | (if org-export-with-TeX-macros | |
3833 | (list (concat "\\\\" | |
3834 | (regexp-opt | |
3835 | (append (mapcar 'car org-html-entities) | |
3836 | (if (boundp 'org-latex-entities) | |
3837 | org-latex-entities nil)) | |
3838 | 'words))) ; FIXME | |
3839 | )) | |
3840 | ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) | |
3841 | (re-special (if org-export-with-special-strings | |
3842 | (mapcar (lambda (x) (car x)) | |
3843 | org-export-html-special-string-regexps))) | |
3844 | (re-rest | |
3845 | (delq nil | |
3846 | (list | |
3847 | (if org-export-html-expand "@<[^>\n]+>") | |
3848 | )))) | |
3849 | (org-set-local | |
3850 | 'org-latex-and-specials-regexp | |
3851 | (mapconcat 'identity (append re-latex re-sub re-macros re-special | |
3852 | re-rest) "\\|"))))) | |
d3f4dbe8 | 3853 | |
20908596 CD |
3854 | (defun org-do-latex-and-special-faces (limit) |
3855 | "Run through the buffer and add overlays to links." | |
3856 | (when org-latex-and-specials-regexp | |
3857 | (let (rtn d) | |
3858 | (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp | |
3859 | limit t)) | |
3860 | (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) | |
3861 | 'face)) | |
3862 | '(org-code org-verbatim underline))) | |
3863 | (progn | |
3864 | (setq rtn t | |
3865 | d (cond ((member (char-after (1+ (match-beginning 0))) | |
3866 | '(?_ ?^)) 1) | |
3867 | (t 0))) | |
3868 | (font-lock-prepend-text-property | |
3869 | (+ d (match-beginning 0)) (match-end 0) | |
3870 | 'face 'org-latex-and-export-specials) | |
3871 | (add-text-properties (+ d (match-beginning 0)) (match-end 0) | |
3872 | '(font-lock-multiline t))))) | |
3873 | rtn))) | |
d3f4dbe8 | 3874 | |
20908596 CD |
3875 | (defun org-restart-font-lock () |
3876 | "Restart font-lock-mode, to force refontification." | |
3877 | (when (and (boundp 'font-lock-mode) font-lock-mode) | |
3878 | (font-lock-mode -1) | |
3879 | (font-lock-mode 1))) | |
d3f4dbe8 | 3880 | |
20908596 CD |
3881 | (defun org-all-targets (&optional radio) |
3882 | "Return a list of all targets in this file. | |
3883 | With optional argument RADIO, only find radio targets." | |
3884 | (let ((re (if radio org-radio-target-regexp org-target-regexp)) | |
3885 | rtn) | |
3886 | (save-excursion | |
3887 | (goto-char (point-min)) | |
3888 | (while (re-search-forward re nil t) | |
3889 | (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) | |
3890 | rtn))) | |
891f4676 | 3891 | |
20908596 CD |
3892 | (defun org-make-target-link-regexp (targets) |
3893 | "Make regular expression matching all strings in TARGETS. | |
3894 | The regular expression finds the targets also if there is a line break | |
3895 | between words." | |
3896 | (and targets | |
3897 | (concat | |
3898 | "\\<\\(" | |
3899 | (mapconcat | |
3900 | (lambda (x) | |
3901 | (while (string-match " +" x) | |
3902 | (setq x (replace-match "\\s-+" t t x))) | |
3903 | x) | |
3904 | targets | |
3905 | "\\|") | |
3906 | "\\)\\>"))) | |
3278a016 | 3907 | |
20908596 CD |
3908 | (defun org-activate-tags (limit) |
3909 | (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) | |
3910 | (progn | |
3911 | (add-text-properties (match-beginning 1) (match-end 1) | |
3912 | (list 'mouse-face 'highlight | |
3913 | 'rear-nonsticky org-nonsticky-props | |
3914 | 'keymap org-mouse-map)) | |
3915 | t))) | |
891f4676 | 3916 | |
20908596 CD |
3917 | (defun org-outline-level () |
3918 | (save-excursion | |
3919 | (looking-at outline-regexp) | |
3920 | (if (match-beginning 1) | |
3921 | (+ (org-get-string-indentation (match-string 1)) 1000) | |
3922 | (1- (- (match-end 0) (match-beginning 0)))))) | |
15841868 | 3923 | |
20908596 | 3924 | (defvar org-font-lock-keywords nil) |
891f4676 | 3925 | |
b349f79f | 3926 | (defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\):\\)[ \t]*\\([^ \t\r\n].*\\)") |
20908596 | 3927 | "Regular expression matching a property line.") |
891f4676 | 3928 | |
b349f79f CD |
3929 | (defvar org-font-lock-hook nil |
3930 | "Functions to be called for special font lock stuff.") | |
3931 | ||
3932 | (defun org-font-lock-hook (limit) | |
3933 | (run-hook-with-args 'org-font-lock-hook limit)) | |
3934 | ||
20908596 CD |
3935 | (defun org-set-font-lock-defaults () |
3936 | (let* ((em org-fontify-emphasized-text) | |
3937 | (lk org-activate-links) | |
3938 | (org-font-lock-extra-keywords | |
3939 | (list | |
b349f79f CD |
3940 | ;; Call the hook |
3941 | '(org-font-lock-hook) | |
20908596 CD |
3942 | ;; Headlines |
3943 | '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1)) | |
3944 | (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) | |
3945 | ;; Table lines | |
3946 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | |
3947 | (1 'org-table t)) | |
3948 | ;; Table internals | |
3949 | '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) | |
3950 | '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) | |
3951 | '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) | |
3952 | ;; Drawers | |
3953 | (list org-drawer-regexp '(0 'org-special-keyword t)) | |
3954 | (list "^[ \t]*:END:" '(0 'org-special-keyword t)) | |
3955 | ;; Properties | |
3956 | (list org-property-re | |
3957 | '(1 'org-special-keyword t) | |
3958 | '(3 'org-property-value t)) | |
3959 | (if org-format-transports-properties-p | |
3960 | '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) | |
3961 | ;; Links | |
3962 | (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) | |
3963 | (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) | |
3964 | (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) | |
3965 | (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) | |
3966 | (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) | |
3967 | (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) | |
3968 | '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) | |
3969 | '(org-hide-wide-columns (0 nil append)) | |
3970 | ;; TODO lines | |
3971 | (list (concat "^\\*+[ \t]+" org-todo-regexp) | |
3972 | '(1 (org-get-todo-face 1) t)) | |
3973 | ;; DONE | |
3974 | (if org-fontify-done-headline | |
3975 | (list (concat "^[*]+ +\\<\\(" | |
3976 | (mapconcat 'regexp-quote org-done-keywords "\\|") | |
3977 | "\\)\\(.*\\)") | |
3978 | '(2 'org-headline-done t)) | |
3979 | nil) | |
3980 | ;; Priorities | |
3981 | (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) | |
ff4be292 CD |
3982 | ;; Tags |
3983 | '(org-font-lock-add-tag-faces) | |
20908596 CD |
3984 | ;; Special keywords |
3985 | (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) | |
3986 | (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) | |
3987 | (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) | |
3988 | (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) | |
3989 | ;; Emphasis | |
3990 | (if em | |
3991 | (if (featurep 'xemacs) | |
3992 | '(org-do-emphasis-faces (0 nil append)) | |
3993 | '(org-do-emphasis-faces))) | |
3994 | ;; Checkboxes | |
3995 | '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" | |
3996 | 2 'bold prepend) | |
3997 | (if org-provide-checkbox-statistics | |
3998 | '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" | |
3999 | (0 (org-get-checkbox-statistics-face) t))) | |
b349f79f CD |
4000 | ;; Description list items |
4001 | '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)" | |
4002 | 2 'bold prepend) | |
20908596 CD |
4003 | (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") |
4004 | '(1 'org-archived prepend)) | |
4005 | ;; Specials | |
4006 | '(org-do-latex-and-special-faces) | |
4007 | ;; Code | |
4008 | '(org-activate-code (1 'org-code t)) | |
4009 | ;; COMMENT | |
4010 | (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string | |
4011 | "\\|" org-quote-string "\\)\\>") | |
4012 | '(1 'org-special-keyword t)) | |
4013 | '("^#.*" (0 'font-lock-comment-face t)) | |
4014 | ))) | |
4015 | (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) | |
4016 | ;; Now set the full font-lock-keywords | |
4017 | (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) | |
4018 | (org-set-local 'font-lock-defaults | |
4019 | '(org-font-lock-keywords t nil nil backward-paragraph)) | |
4020 | (kill-local-variable 'font-lock-keywords) nil)) | |
4021 | ||
4022 | (defvar org-m nil) | |
4023 | (defvar org-l nil) | |
4024 | (defvar org-f nil) | |
4025 | (defun org-get-level-face (n) | |
4026 | "Get the right face for match N in font-lock matching of healdines." | |
4027 | (setq org-l (- (match-end 2) (match-beginning 1) 1)) | |
4028 | (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) | |
4029 | (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) | |
4030 | (cond | |
4031 | ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) | |
4032 | ((eq n 2) org-f) | |
4033 | (t (if org-level-color-stars-only nil org-f)))) | |
4034 | ||
4035 | (defun org-get-todo-face (kwd) | |
4036 | "Get the right face for a TODO keyword KWD. | |
4037 | If KWD is a number, get the corresponding match group." | |
4038 | (if (numberp kwd) (setq kwd (match-string kwd))) | |
4039 | (or (cdr (assoc kwd org-todo-keyword-faces)) | |
4040 | (and (member kwd org-done-keywords) 'org-done) | |
4041 | 'org-todo)) | |
d3f4dbe8 | 4042 | |
ff4be292 CD |
4043 | (defun org-font-lock-add-tag-faces (limit) |
4044 | "Add the special tag faces." | |
4045 | (when (and org-tag-faces org-tags-special-faces-re) | |
4046 | (while (re-search-forward org-tags-special-faces-re limit t) | |
4047 | (add-text-properties (match-beginning 1) (match-end 1) | |
4048 | (list 'face (org-get-tag-face 1) | |
4049 | 'font-lock-fontified t)) | |
4050 | (backward-char 1)))) | |
4051 | ||
4052 | (defun org-get-tag-face (kwd) | |
4053 | "Get the right face for a TODO keyword KWD. | |
4054 | If KWD is a number, get the corresponding match group." | |
4055 | (if (numberp kwd) (setq kwd (match-string kwd))) | |
4056 | (or (cdr (assoc kwd org-tag-faces)) | |
4057 | 'org-tag)) | |
4058 | ||
20908596 CD |
4059 | (defun org-unfontify-region (beg end &optional maybe_loudly) |
4060 | "Remove fontification and activation overlays from links." | |
4061 | (font-lock-default-unfontify-region beg end) | |
4062 | (let* ((buffer-undo-list t) | |
4063 | (inhibit-read-only t) (inhibit-point-motion-hooks t) | |
4064 | (inhibit-modification-hooks t) | |
4065 | deactivate-mark buffer-file-name buffer-file-truename) | |
4066 | (remove-text-properties beg end | |
4067 | '(mouse-face t keymap t org-linked-text t | |
4068 | invisible t intangible t)))) | |
d3f4dbe8 | 4069 | |
20908596 | 4070 | ;;;; Visibility cycling, including org-goto and indirect buffer |
7ac93e3c | 4071 | |
20908596 | 4072 | ;;; Cycling |
891f4676 | 4073 | |
20908596 CD |
4074 | (defvar org-cycle-global-status nil) |
4075 | (make-variable-buffer-local 'org-cycle-global-status) | |
4076 | (defvar org-cycle-subtree-status nil) | |
4077 | (make-variable-buffer-local 'org-cycle-subtree-status) | |
891f4676 | 4078 | |
48aaad2d | 4079 | ;;;###autoload |
20908596 CD |
4080 | (defun org-cycle (&optional arg) |
4081 | "Visibility cycling for Org-mode. | |
891f4676 | 4082 | |
20908596 CD |
4083 | - When this function is called with a prefix argument, rotate the entire |
4084 | buffer through 3 states (global cycling) | |
4085 | 1. OVERVIEW: Show only top-level headlines. | |
4086 | 2. CONTENTS: Show all headlines of all levels, but no body text. | |
4087 | 3. SHOW ALL: Show everything. | |
621f83e4 | 4088 | When called with two C-u C-u prefixes, switch to the startup visibility, |
b349f79f CD |
4089 | determined by the variable `org-startup-folded', and by any VISIBILITY |
4090 | properties in the buffer. | |
621f83e4 CD |
4091 | When called with three C-u C-u C-u prefixed, show the entire buffer, |
4092 | including drawers. | |
eb2f9c59 | 4093 | |
20908596 CD |
4094 | - When point is at the beginning of a headline, rotate the subtree started |
4095 | by this line through 3 different states (local cycling) | |
4096 | 1. FOLDED: Only the main headline is shown. | |
4097 | 2. CHILDREN: The main headline and the direct children are shown. | |
4098 | From this state, you can move to one of the children | |
4099 | and zoom in further. | |
4100 | 3. SUBTREE: Show the entire subtree, including body text. | |
eb2f9c59 | 4101 | |
20908596 CD |
4102 | - When there is a numeric prefix, go up to a heading with level ARG, do |
4103 | a `show-subtree' and return to the previous cursor position. If ARG | |
4104 | is negative, go up that many levels. | |
eb2f9c59 | 4105 | |
b349f79f CD |
4106 | - When point is not at the beginning of a headline, execute the global |
4107 | binding for TAB, which is re-indenting the line. See the option | |
20908596 | 4108 | `org-cycle-emulate-tab' for details. |
c8d16429 | 4109 | |
20908596 CD |
4110 | - Special case: if point is at the beginning of the buffer and there is |
4111 | no headline in line 1, this function will act as if called with prefix arg. | |
4112 | But only if also the variable `org-cycle-global-at-bob' is t." | |
d3f4dbe8 | 4113 | (interactive "P") |
20908596 CD |
4114 | (org-load-modules-maybe) |
4115 | (let* ((outline-regexp | |
4116 | (if (and (org-mode-p) org-cycle-include-plain-lists) | |
4117 | "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" | |
4118 | outline-regexp)) | |
4119 | (bob-special (and org-cycle-global-at-bob (bobp) | |
4120 | (not (looking-at outline-regexp)))) | |
4121 | (org-cycle-hook | |
4122 | (if bob-special | |
4123 | (delq 'org-optimize-window-after-visibility-change | |
4124 | (copy-sequence org-cycle-hook)) | |
4125 | org-cycle-hook)) | |
4126 | (pos (point))) | |
4127 | ||
4128 | (if (or bob-special (equal arg '(4))) | |
4129 | ;; special case: use global cycling | |
4130 | (setq arg t)) | |
4131 | ||
d3f4dbe8 | 4132 | (cond |
fbe6c10d | 4133 | |
b349f79f CD |
4134 | ((equal arg '(16)) |
4135 | (org-set-startup-visibility) | |
621f83e4 CD |
4136 | (message "Startup visibility, plus VISIBILITY properties")) |
4137 | ||
4138 | ((equal arg '(64)) | |
4139 | (show-all) | |
4140 | (message "Entire buffer visible, including drawers")) | |
b349f79f | 4141 | |
20908596 CD |
4142 | ((org-at-table-p 'any) |
4143 | ;; Enter the table or move to the next field in the table | |
4144 | (or (org-table-recognize-table.el) | |
4145 | (progn | |
4146 | (if arg (org-table-edit-field t) | |
4147 | (org-table-justify-field-maybe) | |
4148 | (call-interactively 'org-table-next-field))))) | |
6e2752e7 | 4149 | |
20908596 | 4150 | ((eq arg t) ;; Global cycling |
64f72ae1 | 4151 | |
20908596 CD |
4152 | (cond |
4153 | ((and (eq last-command this-command) | |
4154 | (eq org-cycle-global-status 'overview)) | |
4155 | ;; We just created the overview - now do table of contents | |
4156 | ;; This can be slow in very large buffers, so indicate action | |
4157 | (message "CONTENTS...") | |
4158 | (org-content) | |
4159 | (message "CONTENTS...done") | |
4160 | (setq org-cycle-global-status 'contents) | |
4161 | (run-hook-with-args 'org-cycle-hook 'contents)) | |
4162 | ||
4163 | ((and (eq last-command this-command) | |
4164 | (eq org-cycle-global-status 'contents)) | |
4165 | ;; We just showed the table of contents - now show everything | |
4166 | (show-all) | |
4167 | (message "SHOW ALL") | |
4168 | (setq org-cycle-global-status 'all) | |
4169 | (run-hook-with-args 'org-cycle-hook 'all)) | |
4170 | ||
4171 | (t | |
4172 | ;; Default action: go to overview | |
4173 | (org-overview) | |
4174 | (message "OVERVIEW") | |
4175 | (setq org-cycle-global-status 'overview) | |
4176 | (run-hook-with-args 'org-cycle-hook 'overview)))) | |
4177 | ||
4178 | ((and org-drawers org-drawer-regexp | |
4179 | (save-excursion | |
4180 | (beginning-of-line 1) | |
4181 | (looking-at org-drawer-regexp))) | |
4182 | ;; Toggle block visibility | |
4183 | (org-flag-drawer | |
4184 | (not (get-char-property (match-end 0) 'invisible)))) | |
4185 | ||
4186 | ((integerp arg) | |
4187 | ;; Show-subtree, ARG levels up from here. | |
4188 | (save-excursion | |
4189 | (org-back-to-heading) | |
4190 | (outline-up-heading (if (< arg 0) (- arg) | |
4191 | (- (funcall outline-level) arg))) | |
4192 | (org-show-subtree))) | |
4193 | ||
4194 | ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) | |
4195 | (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) | |
4196 | ;; At a heading: rotate between three different views | |
4197 | (org-back-to-heading) | |
4198 | (let ((goal-column 0) eoh eol eos) | |
4199 | ;; First, some boundaries | |
4200 | (save-excursion | |
4201 | (org-back-to-heading) | |
4202 | (save-excursion | |
4203 | (beginning-of-line 2) | |
4204 | (while (and (not (eobp)) ;; this is like `next-line' | |
4205 | (get-char-property (1- (point)) 'invisible)) | |
4206 | (beginning-of-line 2)) (setq eol (point))) | |
4207 | (outline-end-of-heading) (setq eoh (point)) | |
4208 | (org-end-of-subtree t) | |
4209 | (unless (eobp) | |
4210 | (skip-chars-forward " \t\n") | |
4211 | (beginning-of-line 1) ; in case this is an item | |
4212 | ) | |
4213 | (setq eos (1- (point)))) | |
4214 | ;; Find out what to do next and set `this-command' | |
d3f4dbe8 | 4215 | (cond |
20908596 CD |
4216 | ((= eos eoh) |
4217 | ;; Nothing is hidden behind this heading | |
4218 | (message "EMPTY ENTRY") | |
4219 | (setq org-cycle-subtree-status nil) | |
4220 | (save-excursion | |
4221 | (goto-char eos) | |
4222 | (outline-next-heading) | |
4223 | (if (org-invisible-p) (org-flag-heading nil)))) | |
4224 | ((or (>= eol eos) | |
4225 | (not (string-match "\\S-" (buffer-substring eol eos)))) | |
4226 | ;; Entire subtree is hidden in one line: open it | |
4227 | (org-show-entry) | |
4228 | (show-children) | |
4229 | (message "CHILDREN") | |
4230 | (save-excursion | |
4231 | (goto-char eos) | |
4232 | (outline-next-heading) | |
4233 | (if (org-invisible-p) (org-flag-heading nil))) | |
4234 | (setq org-cycle-subtree-status 'children) | |
4235 | (run-hook-with-args 'org-cycle-hook 'children)) | |
4236 | ((and (eq last-command this-command) | |
4237 | (eq org-cycle-subtree-status 'children)) | |
4238 | ;; We just showed the children, now show everything. | |
4239 | (org-show-subtree) | |
4240 | (message "SUBTREE") | |
4241 | (setq org-cycle-subtree-status 'subtree) | |
4242 | (run-hook-with-args 'org-cycle-hook 'subtree)) | |
d3f4dbe8 | 4243 | (t |
20908596 CD |
4244 | ;; Default action: hide the subtree. |
4245 | (hide-subtree) | |
4246 | (message "FOLDED") | |
4247 | (setq org-cycle-subtree-status 'folded) | |
4248 | (run-hook-with-args 'org-cycle-hook 'folded))))) | |
eb2f9c59 | 4249 | |
b349f79f | 4250 | ;; TAB emulation and template completion |
20908596 | 4251 | (buffer-read-only (org-back-to-heading)) |
3278a016 | 4252 | |
b349f79f CD |
4253 | ((org-try-structure-completion)) |
4254 | ||
20908596 | 4255 | ((org-try-cdlatex-tab)) |
eb2f9c59 | 4256 | |
20908596 CD |
4257 | ((and (eq org-cycle-emulate-tab 'exc-hl-bol) |
4258 | (or (not (bolp)) | |
4259 | (not (looking-at outline-regexp)))) | |
4260 | (call-interactively (global-key-binding "\t"))) | |
634a7d0b | 4261 | |
20908596 CD |
4262 | ((if (and (memq org-cycle-emulate-tab '(white whitestart)) |
4263 | (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) | |
4264 | (or (and (eq org-cycle-emulate-tab 'white) | |
4265 | (= (match-end 0) (point-at-eol))) | |
4266 | (and (eq org-cycle-emulate-tab 'whitestart) | |
4267 | (>= (match-end 0) pos)))) | |
4268 | t | |
4269 | (eq org-cycle-emulate-tab t)) | |
4270 | (call-interactively (global-key-binding "\t"))) | |
4271 | ||
4272 | (t (save-excursion | |
4273 | (org-back-to-heading) | |
4274 | (org-cycle)))))) | |
4275 | ||
4276 | ;;;###autoload | |
4277 | (defun org-global-cycle (&optional arg) | |
b349f79f CD |
4278 | "Cycle the global visibility. For details see `org-cycle'. |
4279 | With C-u prefix arg, switch to startup visibility. | |
4280 | With a numeric prefix, show all headlines up to that level." | |
20908596 CD |
4281 | (interactive "P") |
4282 | (let ((org-cycle-include-plain-lists | |
4283 | (if (org-mode-p) org-cycle-include-plain-lists nil))) | |
b349f79f CD |
4284 | (cond |
4285 | ((integerp arg) | |
4286 | (show-all) | |
4287 | (hide-sublevels arg) | |
4288 | (setq org-cycle-global-status 'contents)) | |
4289 | ((equal arg '(4)) | |
4290 | (org-set-startup-visibility) | |
4291 | (message "Startup visibility, plus VISIBILITY properties.")) | |
4292 | (t | |
4293 | (org-cycle '(4)))))) | |
4294 | ||
4295 | (defun org-set-startup-visibility () | |
4296 | "Set the visibility required by startup options and properties." | |
4297 | (cond | |
4298 | ((eq org-startup-folded t) | |
4299 | (org-cycle '(4))) | |
4300 | ((eq org-startup-folded 'content) | |
4301 | (let ((this-command 'org-cycle) (last-command 'org-cycle)) | |
4302 | (org-cycle '(4)) (org-cycle '(4))))) | |
4303 | (org-set-visibility-according-to-property 'no-cleanup) | |
4304 | (org-cycle-hide-archived-subtrees 'all) | |
4305 | (org-cycle-hide-drawers 'all) | |
4306 | (org-cycle-show-empty-lines 'all)) | |
4307 | ||
4308 | (defun org-set-visibility-according-to-property (&optional no-cleanup) | |
4309 | "Switch subtree visibilities according to :VISIBILITY: property." | |
4310 | (interactive) | |
4311 | (let (state) | |
4312 | (save-excursion | |
4313 | (goto-char (point-min)) | |
4314 | (while (re-search-forward | |
4315 | "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)" | |
4316 | nil t) | |
4317 | (setq state (match-string 1)) | |
4318 | (save-excursion | |
4319 | (org-back-to-heading t) | |
4320 | (hide-subtree) | |
4321 | (org-reveal) | |
4322 | (cond | |
4323 | ((equal state '("fold" "folded")) | |
4324 | (hide-subtree)) | |
4325 | ((equal state "children") | |
4326 | (org-show-hidden-entry) | |
4327 | (show-children)) | |
4328 | ((equal state "content") | |
4329 | (save-excursion | |
4330 | (save-restriction | |
4331 | (org-narrow-to-subtree) | |
4332 | (org-content)))) | |
4333 | ((member state '("all" "showall")) | |
4334 | (show-subtree))))) | |
4335 | (unless no-cleanup | |
4336 | (org-cycle-hide-archived-subtrees 'all) | |
4337 | (org-cycle-hide-drawers 'all) | |
4338 | (org-cycle-show-empty-lines 'all))))) | |
3278a016 | 4339 | |
20908596 CD |
4340 | (defun org-overview () |
4341 | "Switch to overview mode, shoing only top-level headlines. | |
4342 | Really, this shows all headlines with level equal or greater than the level | |
4343 | of the first headline in the buffer. This is important, because if the | |
4344 | first headline is not level one, then (hide-sublevels 1) gives confusing | |
4345 | results." | |
d3f4dbe8 | 4346 | (interactive) |
20908596 CD |
4347 | (let ((level (save-excursion |
4348 | (goto-char (point-min)) | |
4349 | (if (re-search-forward (concat "^" outline-regexp) nil t) | |
4350 | (progn | |
4351 | (goto-char (match-beginning 0)) | |
4352 | (funcall outline-level)))))) | |
4353 | (and level (hide-sublevels level)))) | |
891f4676 | 4354 | |
20908596 CD |
4355 | (defun org-content (&optional arg) |
4356 | "Show all headlines in the buffer, like a table of contents. | |
4357 | With numerical argument N, show content up to level N." | |
4358 | (interactive "P") | |
4359 | (save-excursion | |
4360 | ;; Visit all headings and show their offspring | |
4361 | (and (integerp arg) (org-overview)) | |
4362 | (goto-char (point-max)) | |
4363 | (catch 'exit | |
4364 | (while (and (progn (condition-case nil | |
4365 | (outline-previous-visible-heading 1) | |
4366 | (error (goto-char (point-min)))) | |
4367 | t) | |
4368 | (looking-at outline-regexp)) | |
4369 | (if (integerp arg) | |
4370 | (show-children (1- arg)) | |
4371 | (show-branches)) | |
4372 | (if (bobp) (throw 'exit nil)))))) | |
891f4676 | 4373 | |
d943b3c6 | 4374 | |
20908596 CD |
4375 | (defun org-optimize-window-after-visibility-change (state) |
4376 | "Adjust the window after a change in outline visibility. | |
4377 | This function is the default value of the hook `org-cycle-hook'." | |
4378 | (when (get-buffer-window (current-buffer)) | |
4379 | (cond | |
4380 | ; ((eq state 'overview) (org-first-headline-recenter 1)) | |
4381 | ; ((eq state 'overview) (org-beginning-of-line)) | |
4382 | ((eq state 'content) nil) | |
4383 | ((eq state 'all) nil) | |
4384 | ((eq state 'folded) nil) | |
4385 | ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) | |
4386 | ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) | |
891f4676 | 4387 | |
20908596 CD |
4388 | (defun org-compact-display-after-subtree-move () |
4389 | (let (beg end) | |
4390 | (save-excursion | |
4391 | (if (org-up-heading-safe) | |
4392 | (progn | |
4393 | (hide-subtree) | |
4394 | (show-entry) | |
4395 | (show-children) | |
4396 | (org-cycle-show-empty-lines 'children) | |
4397 | (org-cycle-hide-drawers 'children)) | |
4398 | (org-overview))))) | |
891f4676 | 4399 | |
20908596 CD |
4400 | (defun org-cycle-show-empty-lines (state) |
4401 | "Show empty lines above all visible headlines. | |
4402 | The region to be covered depends on STATE when called through | |
4403 | `org-cycle-hook'. Lisp program can use t for STATE to get the | |
4404 | entire buffer covered. Note that an empty line is only shown if there | |
4405 | are at least `org-cycle-separator-lines' empty lines before the headeline." | |
4406 | (when (> org-cycle-separator-lines 0) | |
4407 | (save-excursion | |
4408 | (let* ((n org-cycle-separator-lines) | |
4409 | (re (cond | |
4410 | ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") | |
4411 | ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") | |
4412 | (t (let ((ns (number-to-string (- n 2)))) | |
4413 | (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" | |
4414 | "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) | |
4415 | beg end) | |
4416 | (cond | |
4417 | ((memq state '(overview contents t)) | |
4418 | (setq beg (point-min) end (point-max))) | |
4419 | ((memq state '(children folded)) | |
4420 | (setq beg (point) end (progn (org-end-of-subtree t t) | |
4421 | (beginning-of-line 2) | |
4422 | (point))))) | |
4423 | (when beg | |
4424 | (goto-char beg) | |
4425 | (while (re-search-forward re end t) | |
4426 | (if (not (get-char-property (match-end 1) 'invisible)) | |
4427 | (outline-flag-region | |
4428 | (match-beginning 1) (match-end 1) nil))))))) | |
4429 | ;; Never hide empty lines at the end of the file. | |
4430 | (save-excursion | |
4431 | (goto-char (point-max)) | |
4432 | (outline-previous-heading) | |
4433 | (outline-end-of-heading) | |
4434 | (if (and (looking-at "[ \t\n]+") | |
4435 | (= (match-end 0) (point-max))) | |
4436 | (outline-flag-region (point) (match-end 0) nil)))) | |
48aaad2d | 4437 | |
2c3ad40d CD |
4438 | (defun org-show-empty-lines-in-parent () |
4439 | "Move to the parent and re-show empty lines before visible headlines." | |
4440 | (save-excursion | |
4441 | (let ((context (if (org-up-heading-safe) 'children 'overview))) | |
4442 | (org-cycle-show-empty-lines context)))) | |
4443 | ||
20908596 CD |
4444 | (defun org-cycle-hide-drawers (state) |
4445 | "Re-hide all drawers after a visibility state change." | |
4446 | (when (and (org-mode-p) | |
4447 | (not (memq state '(overview folded)))) | |
4448 | (save-excursion | |
4449 | (let* ((globalp (memq state '(contents all))) | |
4450 | (beg (if globalp (point-min) (point))) | |
4451 | (end (if globalp (point-max) (org-end-of-subtree t)))) | |
4452 | (goto-char beg) | |
4453 | (while (re-search-forward org-drawer-regexp end t) | |
4454 | (org-flag-drawer t)))))) | |
2a57416f | 4455 | |
20908596 CD |
4456 | (defun org-flag-drawer (flag) |
4457 | (save-excursion | |
4458 | (beginning-of-line 1) | |
4459 | (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") | |
4460 | (let ((b (match-end 0)) | |
4461 | (outline-regexp org-outline-regexp)) | |
4462 | (if (re-search-forward | |
4463 | "^[ \t]*:END:" | |
4464 | (save-excursion (outline-next-heading) (point)) t) | |
4465 | (outline-flag-region b (point-at-eol) flag) | |
4466 | (error ":END: line missing")))))) | |
891f4676 | 4467 | |
20908596 CD |
4468 | (defun org-subtree-end-visible-p () |
4469 | "Is the end of the current subtree visible?" | |
4470 | (pos-visible-in-window-p | |
4471 | (save-excursion (org-end-of-subtree t) (point)))) | |
2a57416f | 4472 | |
20908596 CD |
4473 | (defun org-first-headline-recenter (&optional N) |
4474 | "Move cursor to the first headline and recenter the headline. | |
4475 | Optional argument N means, put the headline into the Nth line of the window." | |
4476 | (goto-char (point-min)) | |
4477 | (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) | |
4478 | (beginning-of-line) | |
4479 | (recenter (prefix-numeric-value N)))) | |
2a57416f | 4480 | |
20908596 | 4481 | ;;; Org-goto |
2a57416f | 4482 | |
20908596 CD |
4483 | (defvar org-goto-window-configuration nil) |
4484 | (defvar org-goto-marker nil) | |
4485 | (defvar org-goto-map | |
4486 | (let ((map (make-sparse-keymap))) | |
4487 | (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd) | |
4488 | (while (setq cmd (pop cmds)) | |
4489 | (substitute-key-definition cmd cmd map global-map))) | |
4490 | (suppress-keymap map) | |
4491 | (org-defkey map "\C-m" 'org-goto-ret) | |
4492 | (org-defkey map [(return)] 'org-goto-ret) | |
4493 | (org-defkey map [(left)] 'org-goto-left) | |
4494 | (org-defkey map [(right)] 'org-goto-right) | |
4495 | (org-defkey map [(control ?g)] 'org-goto-quit) | |
4496 | (org-defkey map "\C-i" 'org-cycle) | |
4497 | (org-defkey map [(tab)] 'org-cycle) | |
4498 | (org-defkey map [(down)] 'outline-next-visible-heading) | |
4499 | (org-defkey map [(up)] 'outline-previous-visible-heading) | |
4500 | (if org-goto-auto-isearch | |
4501 | (if (fboundp 'define-key-after) | |
4502 | (define-key-after map [t] 'org-goto-local-auto-isearch) | |
4503 | nil) | |
4504 | (org-defkey map "q" 'org-goto-quit) | |
4505 | (org-defkey map "n" 'outline-next-visible-heading) | |
4506 | (org-defkey map "p" 'outline-previous-visible-heading) | |
4507 | (org-defkey map "f" 'outline-forward-same-level) | |
4508 | (org-defkey map "b" 'outline-backward-same-level) | |
4509 | (org-defkey map "u" 'outline-up-heading)) | |
4510 | (org-defkey map "/" 'org-occur) | |
4511 | (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) | |
4512 | (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) | |
4513 | (org-defkey map "\C-c\C-f" 'outline-forward-same-level) | |
4514 | (org-defkey map "\C-c\C-b" 'outline-backward-same-level) | |
4515 | (org-defkey map "\C-c\C-u" 'outline-up-heading) | |
4516 | map)) | |
2a57416f | 4517 | |
20908596 CD |
4518 | (defconst org-goto-help |
4519 | "Browse buffer copy, to find location or copy text. Just type for auto-isearch. | |
4520 | RET=jump to location [Q]uit and return to previous location | |
4521 | \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") | |
2a57416f | 4522 | |
20908596 | 4523 | (defvar org-goto-start-pos) ; dynamically scoped parameter |
2a57416f | 4524 | |
b349f79f | 4525 | ;; FIXME: Docstring doe not mention both interfaces |
20908596 CD |
4526 | (defun org-goto (&optional alternative-interface) |
4527 | "Look up a different location in the current file, keeping current visibility. | |
2a57416f | 4528 | |
20908596 CD |
4529 | When you want look-up or go to a different location in a document, the |
4530 | fastest way is often to fold the entire buffer and then dive into the tree. | |
4531 | This method has the disadvantage, that the previous location will be folded, | |
4532 | which may not be what you want. | |
2a57416f | 4533 | |
20908596 CD |
4534 | This command works around this by showing a copy of the current buffer |
4535 | in an indirect buffer, in overview mode. You can dive into the tree in | |
4536 | that copy, use org-occur and incremental search to find a location. | |
4537 | When pressing RET or `Q', the command returns to the original buffer in | |
4538 | which the visibility is still unchanged. After RET is will also jump to | |
4539 | the location selected in the indirect buffer and expose the | |
4540 | the headline hierarchy above." | |
4541 | (interactive "P") | |
4542 | (let* ((org-refile-targets '((nil . (:maxlevel . 10)))) | |
4543 | (org-refile-use-outline-path t) | |
4544 | (interface | |
4545 | (if (not alternative-interface) | |
4546 | org-goto-interface | |
4547 | (if (eq org-goto-interface 'outline) | |
4548 | 'outline-path-completion | |
4549 | 'outline))) | |
4550 | (org-goto-start-pos (point)) | |
4551 | (selected-point | |
4552 | (if (eq interface 'outline) | |
4553 | (car (org-get-location (current-buffer) org-goto-help)) | |
4554 | (nth 3 (org-refile-get-location "Goto: "))))) | |
4555 | (if selected-point | |
4556 | (progn | |
4557 | (org-mark-ring-push org-goto-start-pos) | |
4558 | (goto-char selected-point) | |
4559 | (if (or (org-invisible-p) (org-invisible-p2)) | |
4560 | (org-show-context 'org-goto))) | |
4561 | (message "Quit")))) | |
2a57416f | 4562 | |
20908596 CD |
4563 | (defvar org-goto-selected-point nil) ; dynamically scoped parameter |
4564 | (defvar org-goto-exit-command nil) ; dynamically scoped parameter | |
4565 | (defvar org-goto-local-auto-isearch-map) ; defined below | |
891f4676 | 4566 | |
20908596 CD |
4567 | (defun org-get-location (buf help) |
4568 | "Let the user select a location in the Org-mode buffer BUF. | |
4569 | This function uses a recursive edit. It returns the selected position | |
4570 | or nil." | |
4571 | (let ((isearch-mode-map org-goto-local-auto-isearch-map) | |
4572 | (isearch-hide-immediately nil) | |
4573 | (isearch-search-fun-function | |
621f83e4 | 4574 | (lambda () 'org-goto-local-search-headings)) |
20908596 CD |
4575 | (org-goto-selected-point org-goto-exit-command)) |
4576 | (save-excursion | |
4577 | (save-window-excursion | |
4578 | (delete-other-windows) | |
4579 | (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) | |
4580 | (switch-to-buffer | |
4581 | (condition-case nil | |
4582 | (make-indirect-buffer (current-buffer) "*org-goto*") | |
4583 | (error (make-indirect-buffer (current-buffer) "*org-goto*")))) | |
4584 | (with-output-to-temp-buffer "*Help*" | |
4585 | (princ help)) | |
93b62de8 | 4586 | (org-fit-window-to-buffer (get-buffer-window "*Help*")) |
20908596 CD |
4587 | (setq buffer-read-only nil) |
4588 | (let ((org-startup-truncated t) | |
4589 | (org-startup-folded nil) | |
4590 | (org-startup-align-all-tables nil)) | |
4591 | (org-mode) | |
4592 | (org-overview)) | |
4593 | (setq buffer-read-only t) | |
4594 | (if (and (boundp 'org-goto-start-pos) | |
4595 | (integer-or-marker-p org-goto-start-pos)) | |
4596 | (let ((org-show-hierarchy-above t) | |
4597 | (org-show-siblings t) | |
4598 | (org-show-following-heading t)) | |
4599 | (goto-char org-goto-start-pos) | |
4600 | (and (org-invisible-p) (org-show-context))) | |
4601 | (goto-char (point-min))) | |
4602 | (org-beginning-of-line) | |
4603 | (message "Select location and press RET") | |
4604 | (use-local-map org-goto-map) | |
4605 | (recursive-edit) | |
4606 | )) | |
4607 | (kill-buffer "*org-goto*") | |
4608 | (cons org-goto-selected-point org-goto-exit-command))) | |
891f4676 | 4609 | |
20908596 CD |
4610 | (defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) |
4611 | (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) | |
4612 | (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) | |
4613 | (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char) | |
891f4676 | 4614 | |
621f83e4 CD |
4615 | (defun org-goto-local-search-headings (string bound noerror) |
4616 | "Search and make sure that any matches are in headlines." | |
20908596 | 4617 | (catch 'return |
621f83e4 CD |
4618 | (while (if isearch-forward |
4619 | (search-forward string bound noerror) | |
4620 | (search-backward string bound noerror)) | |
20908596 CD |
4621 | (when (let ((context (mapcar 'car (save-match-data (org-context))))) |
4622 | (and (member :headline context) | |
4623 | (not (member :tags context)))) | |
4624 | (throw 'return (point)))))) | |
a96ee7df | 4625 | |
20908596 CD |
4626 | (defun org-goto-local-auto-isearch () |
4627 | "Start isearch." | |
4628 | (interactive) | |
4629 | (goto-char (point-min)) | |
4630 | (let ((keys (this-command-keys))) | |
4631 | (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) | |
4632 | (isearch-mode t) | |
4633 | (isearch-process-search-char (string-to-char keys))))) | |
d924f2e5 | 4634 | |
20908596 CD |
4635 | (defun org-goto-ret (&optional arg) |
4636 | "Finish `org-goto' by going to the new location." | |
4637 | (interactive "P") | |
4638 | (setq org-goto-selected-point (point) | |
4639 | org-goto-exit-command 'return) | |
4640 | (throw 'exit nil)) | |
891f4676 | 4641 | |
20908596 CD |
4642 | (defun org-goto-left () |
4643 | "Finish `org-goto' by going to the new location." | |
4644 | (interactive) | |
4645 | (if (org-on-heading-p) | |
4646 | (progn | |
4647 | (beginning-of-line 1) | |
4648 | (setq org-goto-selected-point (point) | |
4649 | org-goto-exit-command 'left) | |
4650 | (throw 'exit nil)) | |
4651 | (error "Not on a heading"))) | |
891f4676 | 4652 | |
20908596 CD |
4653 | (defun org-goto-right () |
4654 | "Finish `org-goto' by going to the new location." | |
4655 | (interactive) | |
4656 | (if (org-on-heading-p) | |
4657 | (progn | |
4658 | (setq org-goto-selected-point (point) | |
4659 | org-goto-exit-command 'right) | |
4660 | (throw 'exit nil)) | |
4661 | (error "Not on a heading"))) | |
891f4676 | 4662 | |
20908596 CD |
4663 | (defun org-goto-quit () |
4664 | "Finish `org-goto' without cursor motion." | |
4665 | (interactive) | |
4666 | (setq org-goto-selected-point nil) | |
4667 | (setq org-goto-exit-command 'quit) | |
4668 | (throw 'exit nil)) | |
4b3a9ba7 | 4669 | |
20908596 | 4670 | ;;; Indirect buffer display of subtrees |
4b3a9ba7 | 4671 | |
20908596 CD |
4672 | (defvar org-indirect-dedicated-frame nil |
4673 | "This is the frame being used for indirect tree display.") | |
4674 | (defvar org-last-indirect-buffer nil) | |
891f4676 | 4675 | |
20908596 CD |
4676 | (defun org-tree-to-indirect-buffer (&optional arg) |
4677 | "Create indirect buffer and narrow it to current subtree. | |
4678 | With numerical prefix ARG, go up to this level and then take that tree. | |
4679 | If ARG is negative, go up that many levels. | |
4680 | If `org-indirect-buffer-display' is not `new-frame', the command removes the | |
4681 | indirect buffer previously made with this command, to avoid proliferation of | |
4682 | indirect buffers. However, when you call the command with a `C-u' prefix, or | |
4683 | when `org-indirect-buffer-display' is `new-frame', the last buffer | |
4684 | is kept so that you can work with several indirect buffers at the same time. | |
4685 | If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also | |
4686 | requests that a new frame be made for the new buffer, so that the dedicated | |
4687 | frame is not changed." | |
4688 | (interactive "P") | |
4689 | (let ((cbuf (current-buffer)) | |
4690 | (cwin (selected-window)) | |
d3f4dbe8 | 4691 | (pos (point)) |
20908596 CD |
4692 | beg end level heading ibuf) |
4693 | (save-excursion | |
4694 | (org-back-to-heading t) | |
4695 | (when (numberp arg) | |
4696 | (setq level (org-outline-level)) | |
4697 | (if (< arg 0) (setq arg (+ level arg))) | |
4698 | (while (> (setq level (org-outline-level)) arg) | |
4699 | (outline-up-heading 1 t))) | |
4700 | (setq beg (point) | |
4701 | heading (org-get-heading)) | |
4702 | (org-end-of-subtree t) (setq end (point))) | |
4703 | (if (and (buffer-live-p org-last-indirect-buffer) | |
4704 | (not (eq org-indirect-buffer-display 'new-frame)) | |
4705 | (not arg)) | |
4706 | (kill-buffer org-last-indirect-buffer)) | |
4707 | (setq ibuf (org-get-indirect-buffer cbuf) | |
4708 | org-last-indirect-buffer ibuf) | |
d3f4dbe8 | 4709 | (cond |
20908596 CD |
4710 | ((or (eq org-indirect-buffer-display 'new-frame) |
4711 | (and arg (eq org-indirect-buffer-display 'dedicated-frame))) | |
4712 | (select-frame (make-frame)) | |
4713 | (delete-other-windows) | |
4714 | (switch-to-buffer ibuf) | |
4715 | (org-set-frame-title heading)) | |
4716 | ((eq org-indirect-buffer-display 'dedicated-frame) | |
4717 | (raise-frame | |
4718 | (select-frame (or (and org-indirect-dedicated-frame | |
4719 | (frame-live-p org-indirect-dedicated-frame) | |
4720 | org-indirect-dedicated-frame) | |
4721 | (setq org-indirect-dedicated-frame (make-frame))))) | |
4722 | (delete-other-windows) | |
4723 | (switch-to-buffer ibuf) | |
4724 | (org-set-frame-title (concat "Indirect: " heading))) | |
4725 | ((eq org-indirect-buffer-display 'current-window) | |
4726 | (switch-to-buffer ibuf)) | |
4727 | ((eq org-indirect-buffer-display 'other-window) | |
4728 | (pop-to-buffer ibuf)) | |
4729 | (t (error "Invalid value."))) | |
4730 | (if (featurep 'xemacs) | |
4731 | (save-excursion (org-mode) (turn-on-font-lock))) | |
4732 | (narrow-to-region beg end) | |
4733 | (show-all) | |
4734 | (goto-char pos) | |
4735 | (and (window-live-p cwin) (select-window cwin)))) | |
edd21304 | 4736 | |
20908596 CD |
4737 | (defun org-get-indirect-buffer (&optional buffer) |
4738 | (setq buffer (or buffer (current-buffer))) | |
4739 | (let ((n 1) (base (buffer-name buffer)) bname) | |
4740 | (while (buffer-live-p | |
4741 | (get-buffer (setq bname (concat base "-" (number-to-string n))))) | |
4742 | (setq n (1+ n))) | |
4743 | (condition-case nil | |
4744 | (make-indirect-buffer buffer bname 'clone) | |
4745 | (error (make-indirect-buffer buffer bname))))) | |
ef943dba | 4746 | |
20908596 CD |
4747 | (defun org-set-frame-title (title) |
4748 | "Set the title of the current frame to the string TITLE." | |
4749 | ;; FIXME: how to name a single frame in XEmacs??? | |
4750 | (unless (featurep 'xemacs) | |
4751 | (modify-frame-parameters (selected-frame) (list (cons 'name title))))) | |
ef943dba | 4752 | |
20908596 | 4753 | ;;;; Structure editing |
ef943dba | 4754 | |
20908596 | 4755 | ;;; Inserting headlines |
ef943dba | 4756 | |
20908596 CD |
4757 | (defun org-insert-heading (&optional force-heading) |
4758 | "Insert a new heading or item with same depth at point. | |
4759 | If point is in a plain list and FORCE-HEADING is nil, create a new list item. | |
4760 | If point is at the beginning of a headline, insert a sibling before the | |
4761 | current headline. If point is not at the beginning, do not split the line, | |
93b62de8 | 4762 | but create the new headline after the current line." |
20908596 CD |
4763 | (interactive "P") |
4764 | (if (= (buffer-size) 0) | |
4765 | (insert "\n* ") | |
4766 | (when (or force-heading (not (org-insert-item))) | |
4767 | (let* ((head (save-excursion | |
4768 | (condition-case nil | |
4769 | (progn | |
4770 | (org-back-to-heading) | |
4771 | (match-string 0)) | |
4772 | (error "*")))) | |
4773 | (blank (cdr (assq 'heading org-blank-before-new-entry))) | |
93b62de8 | 4774 | pos hide-previous previous-pos) |
20908596 CD |
4775 | (cond |
4776 | ((and (org-on-heading-p) (bolp) | |
4777 | (or (bobp) | |
4778 | (save-excursion (backward-char 1) (not (org-invisible-p))))) | |
4779 | ;; insert before the current line | |
4780 | (open-line (if blank 2 1))) | |
4781 | ((and (bolp) | |
4782 | (or (bobp) | |
4783 | (save-excursion | |
4784 | (backward-char 1) (not (org-invisible-p))))) | |
4785 | ;; insert right here | |
4786 | nil) | |
4787 | (t | |
93b62de8 | 4788 | ;; somewhere in the line |
71d35b24 | 4789 | (save-excursion |
93b62de8 | 4790 | (setq previous-pos (point-at-bol)) |
71d35b24 CD |
4791 | (end-of-line) |
4792 | (setq hide-previous (org-invisible-p))) | |
93b62de8 | 4793 | (and org-insert-heading-respect-content (org-show-subtree)) |
20908596 | 4794 | (let ((split |
93b62de8 CD |
4795 | (and (org-get-alist-option org-M-RET-may-split-line 'headline) |
4796 | (save-excursion | |
4797 | (let ((p (point))) | |
4798 | (goto-char (point-at-bol)) | |
4799 | (and (looking-at org-complex-heading-regexp) | |
4800 | (> p (match-beginning 4))))))) | |
20908596 | 4801 | tags pos) |
621f83e4 CD |
4802 | (cond |
4803 | (org-insert-heading-respect-content | |
4804 | (org-end-of-subtree nil t) | |
93b62de8 | 4805 | (or (bolp) (newline)) |
621f83e4 CD |
4806 | (open-line 1)) |
4807 | ((org-on-heading-p) | |
93b62de8 CD |
4808 | (when hide-previous |
4809 | (show-children) | |
4810 | (org-show-entry)) | |
621f83e4 CD |
4811 | (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") |
4812 | (setq tags (and (match-end 2) (match-string 2))) | |
4813 | (and (match-end 1) | |
4814 | (delete-region (match-beginning 1) (match-end 1))) | |
4815 | (setq pos (point-at-bol)) | |
20908596 | 4816 | (or split (end-of-line 1)) |
621f83e4 CD |
4817 | (delete-horizontal-space) |
4818 | (newline (if blank 2 1)) | |
4819 | (when tags | |
4820 | (save-excursion | |
4821 | (goto-char pos) | |
4822 | (end-of-line 1) | |
4823 | (insert " " tags) | |
4824 | (org-set-tags nil 'align)))) | |
4825 | (t | |
4826 | (or split (end-of-line 1)) | |
4827 | (newline (if blank 2 1))))))) | |
20908596 CD |
4828 | (insert head) (just-one-space) |
4829 | (setq pos (point)) | |
4830 | (end-of-line 1) | |
4831 | (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) | |
71d35b24 CD |
4832 | (when (and org-insert-heading-respect-content hide-previous) |
4833 | (save-excursion | |
93b62de8 CD |
4834 | (goto-char previous-pos) |
4835 | (hide-subtree))) | |
20908596 | 4836 | (run-hooks 'org-insert-heading-hook))))) |
ef943dba | 4837 | |
20908596 CD |
4838 | (defun org-get-heading (&optional no-tags) |
4839 | "Return the heading of the current entry, without the stars." | |
4840 | (save-excursion | |
4841 | (org-back-to-heading t) | |
4842 | (if (looking-at | |
4843 | (if no-tags | |
4844 | (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$") | |
4845 | "\\*+[ \t]+\\([^\r\n]*\\)")) | |
4846 | (match-string 1) ""))) | |
ef943dba | 4847 | |
20908596 CD |
4848 | (defun org-insert-heading-after-current () |
4849 | "Insert a new heading with same level as current, after current subtree." | |
4850 | (interactive) | |
4851 | (org-back-to-heading) | |
4852 | (org-insert-heading) | |
4853 | (org-move-subtree-down) | |
4854 | (end-of-line 1)) | |
35fb9989 | 4855 | |
621f83e4 CD |
4856 | (defun org-insert-heading-respect-content () |
4857 | (interactive) | |
4858 | (let ((org-insert-heading-respect-content t)) | |
71d35b24 | 4859 | (org-insert-heading t))) |
621f83e4 | 4860 | |
71d35b24 CD |
4861 | (defun org-insert-todo-heading-respect-content (&optional force-state) |
4862 | (interactive "P") | |
621f83e4 | 4863 | (let ((org-insert-heading-respect-content t)) |
71d35b24 | 4864 | (org-insert-todo-heading force-state t))) |
621f83e4 | 4865 | |
71d35b24 | 4866 | (defun org-insert-todo-heading (arg &optional force-heading) |
20908596 CD |
4867 | "Insert a new heading with the same level and TODO state as current heading. |
4868 | If the heading has no TODO state, or if the state is DONE, use the first | |
4869 | state (TODO by default). Also with prefix arg, force first state." | |
4870 | (interactive "P") | |
71d35b24 CD |
4871 | (when (or force-heading (not (org-insert-item 'checkbox))) |
4872 | (org-insert-heading force-heading) | |
20908596 CD |
4873 | (save-excursion |
4874 | (org-back-to-heading) | |
4875 | (outline-previous-heading) | |
4876 | (looking-at org-todo-line-regexp)) | |
4877 | (if (or arg | |
4878 | (not (match-beginning 2)) | |
4879 | (member (match-string 2) org-done-keywords)) | |
4880 | (insert (car org-todo-keywords-1) " ") | |
b349f79f CD |
4881 | (insert (match-string 2) " ")) |
4882 | (when org-provide-todo-statistics | |
4883 | (org-update-parent-todo-statistics)))) | |
ef943dba | 4884 | |
20908596 CD |
4885 | (defun org-insert-subheading (arg) |
4886 | "Insert a new subheading and demote it. | |
4887 | Works for outline headings and for plain lists alike." | |
4888 | (interactive "P") | |
4889 | (org-insert-heading arg) | |
4890 | (cond | |
4891 | ((org-on-heading-p) (org-do-demote)) | |
4892 | ((org-at-item-p) (org-indent-item 1)))) | |
4da1a99d | 4893 | |
20908596 CD |
4894 | (defun org-insert-todo-subheading (arg) |
4895 | "Insert a new subheading with TODO keyword or checkbox and demote it. | |
4896 | Works for outline headings and for plain lists alike." | |
4897 | (interactive "P") | |
4898 | (org-insert-todo-heading arg) | |
d3f4dbe8 | 4899 | (cond |
20908596 CD |
4900 | ((org-on-heading-p) (org-do-demote)) |
4901 | ((org-at-item-p) (org-indent-item 1)))) | |
4da1a99d | 4902 | |
20908596 | 4903 | ;;; Promotion and Demotion |
4da1a99d | 4904 | |
20908596 CD |
4905 | (defun org-promote-subtree () |
4906 | "Promote the entire subtree. | |
4907 | See also `org-promote'." | |
4908 | (interactive) | |
d3f4dbe8 | 4909 | (save-excursion |
20908596 CD |
4910 | (org-map-tree 'org-promote)) |
4911 | (org-fix-position-after-promote)) | |
4912 | ||
4913 | (defun org-demote-subtree () | |
4914 | "Demote the entire subtree. See `org-demote'. | |
4915 | See also `org-promote'." | |
4916 | (interactive) | |
d3f4dbe8 | 4917 | (save-excursion |
20908596 CD |
4918 | (org-map-tree 'org-demote)) |
4919 | (org-fix-position-after-promote)) | |
4b3a9ba7 | 4920 | |
20908596 CD |
4921 | |
4922 | (defun org-do-promote () | |
4923 | "Promote the current heading higher up the tree. | |
4924 | If the region is active in `transient-mark-mode', promote all headings | |
4925 | in the region." | |
4926 | (interactive) | |
3278a016 | 4927 | (save-excursion |
20908596 CD |
4928 | (if (org-region-active-p) |
4929 | (org-map-region 'org-promote (region-beginning) (region-end)) | |
4930 | (org-promote))) | |
4931 | (org-fix-position-after-promote)) | |
4932 | ||
4933 | (defun org-do-demote () | |
4934 | "Demote the current heading lower down the tree. | |
4935 | If the region is active in `transient-mark-mode', demote all headings | |
4936 | in the region." | |
4937 | (interactive) | |
4da1a99d | 4938 | (save-excursion |
20908596 CD |
4939 | (if (org-region-active-p) |
4940 | (org-map-region 'org-demote (region-beginning) (region-end)) | |
4941 | (org-demote))) | |
4942 | (org-fix-position-after-promote)) | |
4b3a9ba7 | 4943 | |
20908596 CD |
4944 | (defun org-fix-position-after-promote () |
4945 | "Make sure that after pro/demotion cursor position is right." | |
4946 | (let ((pos (point))) | |
4947 | (when (save-excursion | |
4948 | (beginning-of-line 1) | |
4949 | (looking-at org-todo-line-regexp) | |
4950 | (or (equal pos (match-end 1)) (equal pos (match-end 2)))) | |
4951 | (cond ((eobp) (insert " ")) | |
4952 | ((eolp) (insert " ")) | |
4953 | ((equal (char-after) ?\ ) (forward-char 1)))))) | |
4b3a9ba7 | 4954 | |
20908596 CD |
4955 | (defun org-reduced-level (l) |
4956 | (if org-odd-levels-only (1+ (floor (/ l 2))) l)) | |
4b3a9ba7 | 4957 | |
20908596 CD |
4958 | (defun org-get-valid-level (level &optional change) |
4959 | "Rectify a level change under the influence of `org-odd-levels-only' | |
4960 | LEVEL is a current level, CHANGE is by how much the level should be | |
4961 | modified. Even if CHANGE is nil, LEVEL may be returned modified because | |
4962 | even level numbers will become the next higher odd number." | |
4963 | (if org-odd-levels-only | |
4964 | (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) | |
4965 | ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) | |
4966 | ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) | |
4967 | (max 1 (+ level change)))) | |
4b3a9ba7 | 4968 | |
20908596 CD |
4969 | (if (boundp 'define-obsolete-function-alias) |
4970 | (if (or (featurep 'xemacs) (< emacs-major-version 23)) | |
4971 | (define-obsolete-function-alias 'org-get-legal-level | |
4972 | 'org-get-valid-level) | |
4973 | (define-obsolete-function-alias 'org-get-legal-level | |
4974 | 'org-get-valid-level "23.1"))) | |
4b3a9ba7 | 4975 | |
20908596 CD |
4976 | (defun org-promote () |
4977 | "Promote the current heading higher up the tree. | |
4978 | If the region is active in `transient-mark-mode', promote all headings | |
4979 | in the region." | |
4980 | (org-back-to-heading t) | |
4981 | (let* ((level (save-match-data (funcall outline-level))) | |
4982 | (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) | |
4983 | (diff (abs (- level (length up-head) -1)))) | |
4984 | (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) | |
4985 | (replace-match up-head nil t) | |
4986 | ;; Fixup tag positioning | |
4987 | (and org-auto-align-tags (org-set-tags nil t)) | |
4988 | (if org-adapt-indentation (org-fixup-indentation (- diff))))) | |
891f4676 | 4989 | |
20908596 CD |
4990 | (defun org-demote () |
4991 | "Demote the current heading lower down the tree. | |
4992 | If the region is active in `transient-mark-mode', demote all headings | |
4993 | in the region." | |
4994 | (org-back-to-heading t) | |
4995 | (let* ((level (save-match-data (funcall outline-level))) | |
4996 | (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) | |
4997 | (diff (abs (- level (length down-head) -1)))) | |
4998 | (replace-match down-head nil t) | |
4999 | ;; Fixup tag positioning | |
5000 | (and org-auto-align-tags (org-set-tags nil t)) | |
5001 | (if org-adapt-indentation (org-fixup-indentation diff)))) | |
5002 | ||
5003 | (defun org-map-tree (fun) | |
5004 | "Call FUN for every heading underneath the current one." | |
5005 | (org-back-to-heading) | |
5006 | (let ((level (funcall outline-level))) | |
5007 | (save-excursion | |
5008 | (funcall fun) | |
5009 | (while (and (progn | |
5010 | (outline-next-heading) | |
5011 | (> (funcall outline-level) level)) | |
5012 | (not (eobp))) | |
5013 | (funcall fun))))) | |
5014 | ||
5015 | (defun org-map-region (fun beg end) | |
5016 | "Call FUN for every heading between BEG and END." | |
5017 | (let ((org-ignore-region t)) | |
5018 | (save-excursion | |
5019 | (setq end (copy-marker end)) | |
5020 | (goto-char beg) | |
5021 | (if (and (re-search-forward (concat "^" outline-regexp) nil t) | |
5022 | (< (point) end)) | |
5023 | (funcall fun)) | |
5024 | (while (and (progn | |
5025 | (outline-next-heading) | |
5026 | (< (point) end)) | |
5027 | (not (eobp))) | |
5028 | (funcall fun))))) | |
5029 | ||
5030 | (defun org-fixup-indentation (diff) | |
5031 | "Change the indentation in the current entry by DIFF | |
5032 | However, if any line in the current entry has no indentation, or if it | |
5033 | would end up with no indentation after the change, nothing at all is done." | |
5034 | (save-excursion | |
5035 | (let ((end (save-excursion (outline-next-heading) | |
5036 | (point-marker))) | |
5037 | (prohibit (if (> diff 0) | |
5038 | "^\\S-" | |
5039 | (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) | |
5040 | col) | |
5041 | (unless (save-excursion (end-of-line 1) | |
5042 | (re-search-forward prohibit end t)) | |
5043 | (while (and (< (point) end) | |
5044 | (re-search-forward "^[ \t]+" end t)) | |
5045 | (goto-char (match-end 0)) | |
5046 | (setq col (current-column)) | |
5047 | (if (< diff 0) (replace-match "")) | |
ce4fdcb9 | 5048 | (org-indent-to-column (+ diff col)))) |
20908596 CD |
5049 | (move-marker end nil)))) |
5050 | ||
5051 | (defun org-convert-to-odd-levels () | |
5052 | "Convert an org-mode file with all levels allowed to one with odd levels. | |
5053 | This will leave level 1 alone, convert level 2 to level 3, level 3 to | |
5054 | level 5 etc." | |
5055 | (interactive) | |
5056 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") | |
5057 | (let ((org-odd-levels-only nil) n) | |
5058 | (save-excursion | |
5059 | (goto-char (point-min)) | |
5060 | (while (re-search-forward "^\\*\\*+ " nil t) | |
5061 | (setq n (- (length (match-string 0)) 2)) | |
5062 | (while (>= (setq n (1- n)) 0) | |
5063 | (org-demote)) | |
5064 | (end-of-line 1)))))) | |
4b3a9ba7 | 5065 | |
a96ee7df | 5066 | |
20908596 CD |
5067 | (defun org-convert-to-oddeven-levels () |
5068 | "Convert an org-mode file with only odd levels to one with odd and even levels. | |
5069 | This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a | |
5070 | section with an even level, conversion would destroy the structure of the file. An error | |
5071 | is signaled in this case." | |
5072 | (interactive) | |
5073 | (goto-char (point-min)) | |
5074 | ;; First check if there are no even levels | |
5075 | (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) | |
5076 | (org-show-context t) | |
5077 | (error "Not all levels are odd in this file. Conversion not possible.")) | |
5078 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") | |
5079 | (let ((org-odd-levels-only nil) n) | |
5080 | (save-excursion | |
5081 | (goto-char (point-min)) | |
5082 | (while (re-search-forward "^\\*\\*+ " nil t) | |
5083 | (setq n (/ (1- (length (match-string 0))) 2)) | |
5084 | (while (>= (setq n (1- n)) 0) | |
5085 | (org-promote)) | |
5086 | (end-of-line 1)))))) | |
a96ee7df | 5087 | |
20908596 CD |
5088 | (defun org-tr-level (n) |
5089 | "Make N odd if required." | |
5090 | (if org-odd-levels-only (1+ (/ n 2)) n)) | |
8c6fb58b | 5091 | |
20908596 | 5092 | ;;; Vertical tree motion, cutting and pasting of subtrees |
8c6fb58b | 5093 | |
20908596 CD |
5094 | (defun org-move-subtree-up (&optional arg) |
5095 | "Move the current subtree up past ARG headlines of the same level." | |
5096 | (interactive "p") | |
5097 | (org-move-subtree-down (- (prefix-numeric-value arg)))) | |
b0a10108 | 5098 | |
20908596 CD |
5099 | (defun org-move-subtree-down (&optional arg) |
5100 | "Move the current subtree down past ARG headlines of the same level." | |
5101 | (interactive "p") | |
5102 | (setq arg (prefix-numeric-value arg)) | |
5103 | (let ((movfunc (if (> arg 0) 'outline-get-next-sibling | |
5104 | 'outline-get-last-sibling)) | |
5105 | (ins-point (make-marker)) | |
5106 | (cnt (abs arg)) | |
5107 | beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) | |
5108 | ;; Select the tree | |
5109 | (org-back-to-heading) | |
5110 | (setq beg0 (point)) | |
5111 | (save-excursion | |
5112 | (setq ne-beg (org-back-over-empty-lines)) | |
5113 | (setq beg (point))) | |
5114 | (save-match-data | |
5115 | (save-excursion (outline-end-of-heading) | |
5116 | (setq folded (org-invisible-p))) | |
5117 | (outline-end-of-subtree)) | |
5118 | (outline-next-heading) | |
5119 | (setq ne-end (org-back-over-empty-lines)) | |
5120 | (setq end (point)) | |
5121 | (goto-char beg0) | |
5122 | (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) | |
5123 | ;; include less whitespace | |
5124 | (save-excursion | |
5125 | (goto-char beg) | |
5126 | (forward-line (- ne-beg ne-end)) | |
5127 | (setq beg (point)))) | |
5128 | ;; Find insertion point, with error handling | |
5129 | (while (> cnt 0) | |
5130 | (or (and (funcall movfunc) (looking-at outline-regexp)) | |
5131 | (progn (goto-char beg0) | |
5132 | (error "Cannot move past superior level or buffer limit"))) | |
5133 | (setq cnt (1- cnt))) | |
5134 | (if (> arg 0) | |
5135 | ;; Moving forward - still need to move over subtree | |
5136 | (progn (org-end-of-subtree t t) | |
5137 | (save-excursion | |
5138 | (org-back-over-empty-lines) | |
5139 | (or (bolp) (newline))))) | |
5140 | (setq ne-ins (org-back-over-empty-lines)) | |
5141 | (move-marker ins-point (point)) | |
5142 | (setq txt (buffer-substring beg end)) | |
b349f79f | 5143 | (org-save-markers-in-region beg end) |
20908596 | 5144 | (delete-region beg end) |
ff4be292 CD |
5145 | (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil)) |
5146 | (or (bobp) (outline-flag-region (1- (point)) (point) nil)) | |
b349f79f CD |
5147 | (let ((bbb (point))) |
5148 | (insert-before-markers txt) | |
5149 | (org-reinstall-markers-in-region bbb) | |
5150 | (move-marker ins-point bbb)) | |
20908596 CD |
5151 | (or (bolp) (insert "\n")) |
5152 | (setq ins-end (point)) | |
5153 | (goto-char ins-point) | |
5154 | (org-skip-whitespace) | |
5155 | (when (and (< arg 0) | |
5156 | (org-first-sibling-p) | |
5157 | (> ne-ins ne-beg)) | |
5158 | ;; Move whitespace back to beginning | |
5159 | (save-excursion | |
5160 | (goto-char ins-end) | |
5161 | (let ((kill-whole-line t)) | |
5162 | (kill-line (- ne-ins ne-beg)) (point))) | |
5163 | (insert (make-string (- ne-ins ne-beg) ?\n))) | |
5164 | (move-marker ins-point nil) | |
5165 | (org-compact-display-after-subtree-move) | |
2c3ad40d | 5166 | (org-show-empty-lines-in-parent) |
20908596 CD |
5167 | (unless folded |
5168 | (org-show-entry) | |
5169 | (show-children) | |
5170 | (org-cycle-hide-drawers 'children)))) | |
8c6fb58b | 5171 | |
20908596 CD |
5172 | (defvar org-subtree-clip "" |
5173 | "Clipboard for cut and paste of subtrees. | |
5174 | This is actually only a copy of the kill, because we use the normal kill | |
5175 | ring. We need it to check if the kill was created by `org-copy-subtree'.") | |
8c6fb58b | 5176 | |
20908596 CD |
5177 | (defvar org-subtree-clip-folded nil |
5178 | "Was the last copied subtree folded? | |
5179 | This is used to fold the tree back after pasting.") | |
b0a10108 | 5180 | |
20908596 CD |
5181 | (defun org-cut-subtree (&optional n) |
5182 | "Cut the current subtree into the clipboard. | |
5183 | With prefix arg N, cut this many sequential subtrees. | |
5184 | This is a short-hand for marking the subtree and then cutting it." | |
5185 | (interactive "p") | |
5186 | (org-copy-subtree n 'cut)) | |
8c6fb58b | 5187 | |
b349f79f | 5188 | (defun org-copy-subtree (&optional n cut force-store-markers) |
20908596 CD |
5189 | "Cut the current subtree into the clipboard. |
5190 | With prefix arg N, cut this many sequential subtrees. | |
5191 | This is a short-hand for marking the subtree and then copying it. | |
b349f79f CD |
5192 | If CUT is non-nil, actually cut the subtree. |
5193 | If FORCE-STORE-MARKERS is non-nil, store the relative locations | |
5194 | of some markers in the region, even if CUT is non-nil. This is | |
5195 | useful if the caller implements cut-and-paste as copy-then-paste-then-cut." | |
20908596 CD |
5196 | (interactive "p") |
5197 | (let (beg end folded (beg0 (point))) | |
5198 | (if (interactive-p) | |
5199 | (org-back-to-heading nil) ; take what looks like a subtree | |
5200 | (org-back-to-heading t)) ; take what is really there | |
5201 | (org-back-over-empty-lines) | |
5202 | (setq beg (point)) | |
5203 | (skip-chars-forward " \t\r\n") | |
5204 | (save-match-data | |
5205 | (save-excursion (outline-end-of-heading) | |
5206 | (setq folded (org-invisible-p))) | |
5207 | (condition-case nil | |
5208 | (outline-forward-same-level (1- n)) | |
5209 | (error nil)) | |
5210 | (org-end-of-subtree t t)) | |
5211 | (org-back-over-empty-lines) | |
5212 | (setq end (point)) | |
5213 | (goto-char beg0) | |
5214 | (when (> end beg) | |
5215 | (setq org-subtree-clip-folded folded) | |
b349f79f CD |
5216 | (when (or cut force-store-markers) |
5217 | (org-save-markers-in-region beg end)) | |
20908596 CD |
5218 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) |
5219 | (setq org-subtree-clip (current-kill 0)) | |
5220 | (message "%s: Subtree(s) with %d characters" | |
5221 | (if cut "Cut" "Copied") | |
5222 | (length org-subtree-clip))))) | |
b0a10108 | 5223 | |
93b62de8 | 5224 | (defun org-paste-subtree (&optional level tree for-yank) |
20908596 CD |
5225 | "Paste the clipboard as a subtree, with modification of headline level. |
5226 | The entire subtree is promoted or demoted in order to match a new headline | |
ce4fdcb9 | 5227 | level. |
93b62de8 CD |
5228 | |
5229 | If the cursor is at the beginning of a headline, the same level as | |
5230 | that headline is used to paste the tree | |
5231 | ||
5232 | If not, the new level is derived from the *visible* headings | |
20908596 CD |
5233 | before and after the insertion point, and taken to be the inferior headline |
5234 | level of the two. So if the previous visible heading is level 3 and the | |
5235 | next is level 4 (or vice versa), level 4 will be used for insertion. | |
5236 | This makes sure that the subtree remains an independent subtree and does | |
5237 | not swallow low level entries. | |
03f3cf35 | 5238 | |
20908596 CD |
5239 | You can also force a different level, either by using a numeric prefix |
5240 | argument, or by inserting the heading marker by hand. For example, if the | |
5241 | cursor is after \"*****\", then the tree will be shifted to level 5. | |
b0a10108 | 5242 | |
93b62de8 | 5243 | If optional TREE is given, use this text instead of the kill ring. |
b0a10108 | 5244 | |
93b62de8 CD |
5245 | When FOR-YANK is set, this is called by `org-yank'. In this case, do not |
5246 | move back over whitespace before inserting, and move point to the end of | |
5247 | the inserted text when done." | |
20908596 CD |
5248 | (interactive "P") |
5249 | (unless (org-kill-is-subtree-p tree) | |
5250 | (error "%s" | |
5251 | (substitute-command-keys | |
5252 | "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) | |
2c3ad40d CD |
5253 | (let* ((visp (not (org-invisible-p))) |
5254 | (txt (or tree (and kill-ring (current-kill 0)))) | |
20908596 CD |
5255 | (^re (concat "^\\(" outline-regexp "\\)")) |
5256 | (re (concat "\\(" outline-regexp "\\)")) | |
5257 | (^re_ (concat "\\(\\*+\\)[ \t]*")) | |
b0a10108 | 5258 | |
20908596 CD |
5259 | (old-level (if (string-match ^re txt) |
5260 | (- (match-end 0) (match-beginning 0) 1) | |
5261 | -1)) | |
5262 | (force-level (cond (level (prefix-numeric-value level)) | |
93b62de8 CD |
5263 | ((and (looking-at "[ \t]*$") |
5264 | (string-match | |
5265 | ^re_ (buffer-substring | |
5266 | (point-at-bol) (point)))) | |
20908596 | 5267 | (- (match-end 1) (match-beginning 1))) |
93b62de8 CD |
5268 | ((and (bolp) |
5269 | (looking-at org-outline-regexp)) | |
5270 | (- (match-end 0) (point) 1)) | |
20908596 CD |
5271 | (t nil))) |
5272 | (previous-level (save-excursion | |
5273 | (condition-case nil | |
5274 | (progn | |
5275 | (outline-previous-visible-heading 1) | |
5276 | (if (looking-at re) | |
5277 | (- (match-end 0) (match-beginning 0) 1) | |
5278 | 1)) | |
5279 | (error 1)))) | |
5280 | (next-level (save-excursion | |
5281 | (condition-case nil | |
5282 | (progn | |
5283 | (or (looking-at outline-regexp) | |
5284 | (outline-next-visible-heading 1)) | |
5285 | (if (looking-at re) | |
5286 | (- (match-end 0) (match-beginning 0) 1) | |
5287 | 1)) | |
5288 | (error 1)))) | |
5289 | (new-level (or force-level (max previous-level next-level))) | |
5290 | (shift (if (or (= old-level -1) | |
5291 | (= new-level -1) | |
5292 | (= old-level new-level)) | |
5293 | 0 | |
5294 | (- new-level old-level))) | |
5295 | (delta (if (> shift 0) -1 1)) | |
5296 | (func (if (> shift 0) 'org-demote 'org-promote)) | |
5297 | (org-odd-levels-only nil) | |
93b62de8 | 5298 | beg end newend) |
20908596 CD |
5299 | ;; Remove the forced level indicator |
5300 | (if force-level | |
5301 | (delete-region (point-at-bol) (point))) | |
5302 | ;; Paste | |
5303 | (beginning-of-line 1) | |
93b62de8 | 5304 | (unless for-yank (org-back-over-empty-lines)) |
20908596 | 5305 | (setq beg (point)) |
ff4be292 | 5306 | (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) |
20908596 CD |
5307 | (insert-before-markers txt) |
5308 | (unless (string-match "\n\\'" txt) (insert "\n")) | |
93b62de8 | 5309 | (setq newend (point)) |
b349f79f | 5310 | (org-reinstall-markers-in-region beg) |
20908596 CD |
5311 | (setq end (point)) |
5312 | (goto-char beg) | |
5313 | (skip-chars-forward " \t\n\r") | |
5314 | (setq beg (point)) | |
2c3ad40d CD |
5315 | (if (and (org-invisible-p) visp) |
5316 | (save-excursion (outline-show-heading))) | |
20908596 CD |
5317 | ;; Shift if necessary |
5318 | (unless (= shift 0) | |
5319 | (save-restriction | |
5320 | (narrow-to-region beg end) | |
5321 | (while (not (= shift 0)) | |
5322 | (org-map-region func (point-min) (point-max)) | |
5323 | (setq shift (+ delta shift))) | |
93b62de8 CD |
5324 | (goto-char (point-min)) |
5325 | (setq newend (point-max)))) | |
5326 | (when (or (interactive-p) for-yank) | |
20908596 | 5327 | (message "Clipboard pasted as level %d subtree" new-level)) |
93b62de8 CD |
5328 | (if (and (not for-yank) ; in this case, org-yank will decide about folding |
5329 | kill-ring | |
20908596 CD |
5330 | (eq org-subtree-clip (current-kill 0)) |
5331 | org-subtree-clip-folded) | |
5332 | ;; The tree was folded before it was killed/copied | |
93b62de8 CD |
5333 | (hide-subtree)) |
5334 | (and for-yank (goto-char newend)))) | |
4b3a9ba7 | 5335 | |
20908596 CD |
5336 | (defun org-kill-is-subtree-p (&optional txt) |
5337 | "Check if the current kill is an outline subtree, or a set of trees. | |
5338 | Returns nil if kill does not start with a headline, or if the first | |
5339 | headline level is not the largest headline level in the tree. | |
5340 | So this will actually accept several entries of equal levels as well, | |
5341 | which is OK for `org-paste-subtree'. | |
5342 | If optional TXT is given, check this string instead of the current kill." | |
5343 | (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) | |
5344 | (start-level (and kill | |
5345 | (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" | |
5346 | org-outline-regexp "\\)") | |
5347 | kill) | |
5348 | (- (match-end 2) (match-beginning 2) 1))) | |
5349 | (re (concat "^" org-outline-regexp)) | |
621f83e4 | 5350 | (start (1+ (or (match-beginning 2) -1)))) |
20908596 CD |
5351 | (if (not start-level) |
5352 | (progn | |
5353 | nil) ;; does not even start with a heading | |
5354 | (catch 'exit | |
5355 | (while (setq start (string-match re kill (1+ start))) | |
5356 | (when (< (- (match-end 0) (match-beginning 0) 1) start-level) | |
5357 | (throw 'exit nil))) | |
5358 | t)))) | |
8c6fb58b | 5359 | |
b349f79f CD |
5360 | (defvar org-markers-to-move nil |
5361 | "Markers that should be moved with a cut-and-paste operation. | |
5362 | Those markers are stored together with their positions relative to | |
5363 | the start of the region.") | |
5364 | ||
5365 | (defun org-save-markers-in-region (beg end) | |
5366 | "Check markers in region. | |
5367 | If these markers are between BEG and END, record their position relative | |
5368 | to BEG, so that after moving the block of text, we can put the markers back | |
5369 | into place. | |
5370 | This function gets called just before an entry or tree gets cut from the | |
5371 | buffer. After re-insertion, `org-reinstall-markers-in-region' must be | |
5372 | called immediately, to move the markers with the entries." | |
5373 | (setq org-markers-to-move nil) | |
5374 | (when (featurep 'org-clock) | |
5375 | (org-clock-save-markers-for-cut-and-paste beg end)) | |
5376 | (when (featurep 'org-agenda) | |
5377 | (org-agenda-save-markers-for-cut-and-paste beg end))) | |
5378 | ||
5379 | (defun org-check-and-save-marker (marker beg end) | |
5380 | "Check if MARKER is between BEG and END. | |
5381 | If yes, remember the marker and the distance to BEG." | |
5382 | (when (and (marker-buffer marker) | |
5383 | (equal (marker-buffer marker) (current-buffer))) | |
5384 | (if (and (>= marker beg) (< marker end)) | |
5385 | (push (cons marker (- marker beg)) org-markers-to-move)))) | |
5386 | ||
5387 | (defun org-reinstall-markers-in-region (beg) | |
5388 | "Move all remembered markers to their position relative to BEG." | |
5389 | (mapc (lambda (x) | |
5390 | (move-marker (car x) (+ beg (cdr x)))) | |
5391 | org-markers-to-move) | |
5392 | (setq org-markers-to-move nil)) | |
5393 | ||
20908596 CD |
5394 | (defun org-narrow-to-subtree () |
5395 | "Narrow buffer to the current subtree." | |
5396 | (interactive) | |
5397 | (save-excursion | |
5398 | (save-match-data | |
5399 | (narrow-to-region | |
5400 | (progn (org-back-to-heading) (point)) | |
2c3ad40d | 5401 | (progn (org-end-of-subtree t) (point)))))) |
8c6fb58b | 5402 | |
8c6fb58b | 5403 | |
20908596 | 5404 | ;;; Outline Sorting |
a0d892d4 | 5405 | |
20908596 CD |
5406 | (defun org-sort (with-case) |
5407 | "Call `org-sort-entries-or-items' or `org-table-sort-lines'. | |
5408 | Optional argument WITH-CASE means sort case-sensitively." | |
5409 | (interactive "P") | |
5410 | (if (org-at-table-p) | |
5411 | (org-call-with-arg 'org-table-sort-lines with-case) | |
5412 | (org-call-with-arg 'org-sort-entries-or-items with-case))) | |
8c6fb58b | 5413 | |
20908596 CD |
5414 | (defun org-sort-remove-invisible (s) |
5415 | (remove-text-properties 0 (length s) org-rm-props s) | |
5416 | (while (string-match org-bracket-link-regexp s) | |
5417 | (setq s (replace-match (if (match-end 2) | |
5418 | (match-string 3 s) | |
5419 | (match-string 1 s)) t t s))) | |
5420 | s) | |
8c6fb58b | 5421 | |
20908596 | 5422 | (defvar org-priority-regexp) ; defined later in the file |
8c6fb58b | 5423 | |
20908596 CD |
5424 | (defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func property) |
5425 | "Sort entries on a certain level of an outline tree. | |
5426 | If there is an active region, the entries in the region are sorted. | |
5427 | Else, if the cursor is before the first entry, sort the top-level items. | |
5428 | Else, the children of the entry at point are sorted. | |
2a57416f | 5429 | |
20908596 CD |
5430 | Sorting can be alphabetically, numerically, and by date/time as given by |
5431 | the first time stamp in the entry. The command prompts for the sorting | |
5432 | type unless it has been given to the function through the SORTING-TYPE | |
5433 | argument, which needs to a character, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F). | |
5434 | If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be | |
5435 | called with point at the beginning of the record. It must return either | |
5436 | a string or a number that should serve as the sorting key for that record. | |
2a57416f | 5437 | |
20908596 CD |
5438 | Comparing entries ignores case by default. However, with an optional argument |
5439 | WITH-CASE, the sorting considers case as well." | |
8c6fb58b | 5440 | (interactive "P") |
20908596 CD |
5441 | (let ((case-func (if with-case 'identity 'downcase)) |
5442 | start beg end stars re re2 | |
5443 | txt what tmp plain-list-p) | |
5444 | ;; Find beginning and end of region to sort | |
5445 | (cond | |
5446 | ((org-region-active-p) | |
5447 | ;; we will sort the region | |
5448 | (setq end (region-end) | |
5449 | what "region") | |
5450 | (goto-char (region-beginning)) | |
5451 | (if (not (org-on-heading-p)) (outline-next-heading)) | |
5452 | (setq start (point))) | |
5453 | ((org-at-item-p) | |
5454 | ;; we will sort this plain list | |
5455 | (org-beginning-of-item-list) (setq start (point)) | |
5456 | (org-end-of-item-list) (setq end (point)) | |
5457 | (goto-char start) | |
5458 | (setq plain-list-p t | |
5459 | what "plain list")) | |
5460 | ((or (org-on-heading-p) | |
5461 | (condition-case nil (progn (org-back-to-heading) t) (error nil))) | |
5462 | ;; we will sort the children of the current headline | |
5463 | (org-back-to-heading) | |
5464 | (setq start (point) | |
5465 | end (progn (org-end-of-subtree t t) | |
5466 | (org-back-over-empty-lines) | |
5467 | (point)) | |
5468 | what "children") | |
5469 | (goto-char start) | |
5470 | (show-subtree) | |
5471 | (outline-next-heading)) | |
5472 | (t | |
5473 | ;; we will sort the top-level entries in this file | |
5474 | (goto-char (point-min)) | |
5475 | (or (org-on-heading-p) (outline-next-heading)) | |
5476 | (setq start (point) end (point-max) what "top-level") | |
5477 | (goto-char start) | |
5478 | (show-all))) | |
2a57416f | 5479 | |
20908596 CD |
5480 | (setq beg (point)) |
5481 | (if (>= beg end) (error "Nothing to sort")) | |
8c6fb58b | 5482 | |
20908596 CD |
5483 | (unless plain-list-p |
5484 | (looking-at "\\(\\*+\\)") | |
5485 | (setq stars (match-string 1) | |
5486 | re (concat "^" (regexp-quote stars) " +") | |
5487 | re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") | |
5488 | txt (buffer-substring beg end)) | |
5489 | (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) | |
5490 | (if (and (not (equal stars "*")) (string-match re2 txt)) | |
5491 | (error "Region to sort contains a level above the first entry"))) | |
f425a6ea | 5492 | |
20908596 CD |
5493 | (unless sorting-type |
5494 | (message | |
5495 | (if plain-list-p | |
5496 | "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" | |
5497 | "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty todo[o]rder [f]unc A/N/T/P/O/F means reversed:") | |
5498 | what) | |
5499 | (setq sorting-type (read-char-exclusive)) | |
3278a016 | 5500 | |
20908596 CD |
5501 | (and (= (downcase sorting-type) ?f) |
5502 | (setq getkey-func | |
ce4fdcb9 | 5503 | (org-ido-completing-read "Sort using function: " |
20908596 CD |
5504 | obarray 'fboundp t nil nil)) |
5505 | (setq getkey-func (intern getkey-func))) | |
f425a6ea | 5506 | |
20908596 CD |
5507 | (and (= (downcase sorting-type) ?r) |
5508 | (setq property | |
ce4fdcb9 | 5509 | (org-ido-completing-read "Property: " |
20908596 CD |
5510 | (mapcar 'list (org-buffer-property-keys t)) |
5511 | nil t)))) | |
4ed31842 | 5512 | |
20908596 | 5513 | (message "Sorting entries...") |
3278a016 | 5514 | |
20908596 CD |
5515 | (save-restriction |
5516 | (narrow-to-region start end) | |
c8d16429 | 5517 | |
20908596 CD |
5518 | (let ((dcst (downcase sorting-type)) |
5519 | (now (current-time))) | |
5520 | (sort-subr | |
5521 | (/= dcst sorting-type) | |
5522 | ;; This function moves to the beginning character of the "record" to | |
5523 | ;; be sorted. | |
5524 | (if plain-list-p | |
5525 | (lambda nil | |
5526 | (if (org-at-item-p) t (goto-char (point-max)))) | |
5527 | (lambda nil | |
5528 | (if (re-search-forward re nil t) | |
5529 | (goto-char (match-beginning 0)) | |
5530 | (goto-char (point-max))))) | |
5531 | ;; This function moves to the last character of the "record" being | |
5532 | ;; sorted. | |
5533 | (if plain-list-p | |
5534 | 'org-end-of-item | |
5535 | (lambda nil | |
5536 | (save-match-data | |
5537 | (condition-case nil | |
5538 | (outline-forward-same-level 1) | |
5539 | (error | |
5540 | (goto-char (point-max))))))) | |
a96ee7df | 5541 | |
20908596 CD |
5542 | ;; This function returns the value that gets sorted against. |
5543 | (if plain-list-p | |
5544 | (lambda nil | |
5545 | (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") | |
5546 | (cond | |
5547 | ((= dcst ?n) | |
5548 | (string-to-number (buffer-substring (match-end 0) | |
5549 | (point-at-eol)))) | |
5550 | ((= dcst ?a) | |
5551 | (buffer-substring (match-end 0) (point-at-eol))) | |
5552 | ((= dcst ?t) | |
5553 | (if (re-search-forward org-ts-regexp | |
5554 | (point-at-eol) t) | |
5555 | (org-time-string-to-time (match-string 0)) | |
5556 | now)) | |
5557 | ((= dcst ?f) | |
5558 | (if getkey-func | |
5559 | (progn | |
5560 | (setq tmp (funcall getkey-func)) | |
5561 | (if (stringp tmp) (setq tmp (funcall case-func tmp))) | |
5562 | tmp) | |
5563 | (error "Invalid key function `%s'" getkey-func))) | |
5564 | (t (error "Invalid sorting type `%c'" sorting-type))))) | |
5565 | (lambda nil | |
5566 | (cond | |
5567 | ((= dcst ?n) | |
621f83e4 CD |
5568 | (if (looking-at org-complex-heading-regexp) |
5569 | (string-to-number (match-string 4)) | |
20908596 CD |
5570 | nil)) |
5571 | ((= dcst ?a) | |
621f83e4 CD |
5572 | (if (looking-at org-complex-heading-regexp) |
5573 | (funcall case-func (match-string 4)) | |
5574 | nil)) | |
20908596 CD |
5575 | ((= dcst ?t) |
5576 | (if (re-search-forward org-ts-regexp | |
5577 | (save-excursion | |
5578 | (forward-line 2) | |
5579 | (point)) t) | |
5580 | (org-time-string-to-time (match-string 0)) | |
5581 | now)) | |
5582 | ((= dcst ?p) | |
5583 | (if (re-search-forward org-priority-regexp (point-at-eol) t) | |
5584 | (string-to-char (match-string 2)) | |
5585 | org-default-priority)) | |
5586 | ((= dcst ?r) | |
5587 | (or (org-entry-get nil property) "")) | |
5588 | ((= dcst ?o) | |
5589 | (if (looking-at org-complex-heading-regexp) | |
5590 | (- 9999 (length (member (match-string 2) | |
5591 | org-todo-keywords-1))))) | |
5592 | ((= dcst ?f) | |
5593 | (if getkey-func | |
5594 | (progn | |
5595 | (setq tmp (funcall getkey-func)) | |
5596 | (if (stringp tmp) (setq tmp (funcall case-func tmp))) | |
5597 | tmp) | |
5598 | (error "Invalid key function `%s'" getkey-func))) | |
5599 | (t (error "Invalid sorting type `%c'" sorting-type))))) | |
5600 | nil | |
5601 | (cond | |
5602 | ((= dcst ?a) 'string<) | |
5603 | ((= dcst ?t) 'time-less-p) | |
5604 | (t nil))))) | |
5605 | (message "Sorting entries...done"))) | |
a96ee7df | 5606 | |
20908596 CD |
5607 | (defun org-do-sort (table what &optional with-case sorting-type) |
5608 | "Sort TABLE of WHAT according to SORTING-TYPE. | |
5609 | The user will be prompted for the SORTING-TYPE if the call to this | |
5610 | function does not specify it. WHAT is only for the prompt, to indicate | |
5611 | what is being sorted. The sorting key will be extracted from | |
5612 | the car of the elements of the table. | |
5613 | If WITH-CASE is non-nil, the sorting will be case-sensitive." | |
5614 | (unless sorting-type | |
5615 | (message | |
5616 | "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:" | |
5617 | what) | |
5618 | (setq sorting-type (read-char-exclusive))) | |
5619 | (let ((dcst (downcase sorting-type)) | |
5620 | extractfun comparefun) | |
5621 | ;; Define the appropriate functions | |
5622 | (cond | |
5623 | ((= dcst ?n) | |
5624 | (setq extractfun 'string-to-number | |
5625 | comparefun (if (= dcst sorting-type) '< '>))) | |
5626 | ((= dcst ?a) | |
5627 | (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) | |
5628 | (lambda(x) (downcase (org-sort-remove-invisible x)))) | |
5629 | comparefun (if (= dcst sorting-type) | |
5630 | 'string< | |
5631 | (lambda (a b) (and (not (string< a b)) | |
5632 | (not (string= a b))))))) | |
5633 | ((= dcst ?t) | |
5634 | (setq extractfun | |
5635 | (lambda (x) | |
5636 | (if (string-match org-ts-regexp x) | |
5637 | (time-to-seconds | |
5638 | (org-time-string-to-time (match-string 0 x))) | |
5639 | 0)) | |
5640 | comparefun (if (= dcst sorting-type) '< '>))) | |
5641 | (t (error "Invalid sorting type `%c'" sorting-type))) | |
a96ee7df | 5642 | |
20908596 CD |
5643 | (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) |
5644 | table) | |
5645 | (lambda (a b) (funcall comparefun (car a) (car b)))))) | |
891f4676 | 5646 | |
b349f79f CD |
5647 | ;;; Editing source examples |
5648 | ||
5649 | (defvar org-exit-edit-mode-map (make-sparse-keymap)) | |
5650 | (define-key org-exit-edit-mode-map "\C-c'" 'org-edit-src-exit) | |
5651 | (defvar org-edit-src-force-single-line nil) | |
5652 | (defvar org-edit-src-from-org-mode nil) | |
621f83e4 | 5653 | (defvar org-edit-src-picture nil) |
b349f79f CD |
5654 | |
5655 | (define-minor-mode org-exit-edit-mode | |
5656 | "Minor mode installing a single key binding, \"C-c '\" to exit special edit.") | |
5657 | ||
5658 | (defun org-edit-src-code () | |
5659 | "Edit the source code example at point. | |
5660 | An indirect buffer is created, and that buffer is then narrowed to the | |
5661 | example at point and switched to the correct language mode. When done, | |
5662 | exit by killing the buffer with \\[org-edit-src-exit]." | |
5663 | (interactive) | |
5664 | (let ((line (org-current-line)) | |
5665 | (case-fold-search t) | |
5666 | (msg (substitute-command-keys | |
5667 | "Edit, then exit with C-c ' (C-c and single quote)")) | |
5668 | (info (org-edit-src-find-region-and-lang)) | |
5669 | (org-mode-p (eq major-mode 'org-mode)) | |
5670 | beg end lang lang-f single) | |
5671 | (if (not info) | |
5672 | nil | |
5673 | (setq beg (nth 0 info) | |
5674 | end (nth 1 info) | |
5675 | lang (nth 2 info) | |
5676 | single (nth 3 info) | |
5677 | lang-f (intern (concat lang "-mode"))) | |
5678 | (unless (functionp lang-f) | |
5679 | (error "No such language mode: %s" lang-f)) | |
5680 | (goto-line line) | |
5681 | (if (get-buffer "*Org Edit Src Example*") | |
5682 | (kill-buffer "*Org Edit Src Example*")) | |
5683 | (switch-to-buffer (make-indirect-buffer (current-buffer) | |
5684 | "*Org Edit Src Example*")) | |
5685 | (narrow-to-region beg end) | |
5686 | (remove-text-properties beg end '(display nil invisible nil | |
5687 | intangible nil)) | |
5688 | (let ((org-inhibit-startup t)) | |
5689 | (funcall lang-f)) | |
5690 | (set (make-local-variable 'org-edit-src-force-single-line) single) | |
5691 | (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) | |
5692 | (when org-mode-p | |
5693 | (goto-char (point-min)) | |
5694 | (while (re-search-forward "^," nil t) | |
5695 | (replace-match ""))) | |
5696 | (goto-line line) | |
5697 | (org-exit-edit-mode) | |
5698 | (org-set-local 'header-line-format msg) | |
5699 | (message "%s" msg) | |
5700 | t))) | |
5701 | ||
621f83e4 CD |
5702 | (defun org-edit-fixed-width-region () |
5703 | "Edit the fixed-width ascii drawing at point. | |
5704 | This must be a region where each line starts with ca colon followed by | |
5705 | a space character. | |
5706 | An indirect buffer is created, and that buffer is then narrowed to the | |
5707 | example at point and switched to artist-mode. When done, | |
5708 | exit by killing the buffer with \\[org-edit-src-exit]." | |
5709 | (interactive) | |
5710 | (let ((line (org-current-line)) | |
5711 | (case-fold-search t) | |
5712 | (msg (substitute-command-keys | |
5713 | "Edit, then exit with C-c ' (C-c and single quote)")) | |
5714 | (org-mode-p (eq major-mode 'org-mode)) | |
5715 | beg end lang lang-f) | |
5716 | (beginning-of-line 1) | |
5717 | (if (looking-at "[ \t]*[^:\n \t]") | |
5718 | nil | |
ce4fdcb9 CD |
5719 | (if (looking-at "[ \t]*\\(\n\\|\\'\\)") |
5720 | (setq beg (point) end beg) | |
621f83e4 CD |
5721 | (save-excursion |
5722 | (if (re-search-backward "^[ \t]*[^:]" nil 'move) | |
5723 | (setq beg (point-at-bol 2)) | |
5724 | (setq beg (point)))) | |
5725 | (save-excursion | |
5726 | (if (re-search-forward "^[ \t]*[^:]" nil 'move) | |
5727 | (setq end (1- (match-beginning 0))) | |
5728 | (setq end (point)))) | |
ce4fdcb9 CD |
5729 | (goto-line line)) |
5730 | (if (get-buffer "*Org Edit Picture*") | |
5731 | (kill-buffer "*Org Edit Picture*")) | |
5732 | (switch-to-buffer (make-indirect-buffer (current-buffer) | |
5733 | "*Org Edit Picture*")) | |
5734 | (narrow-to-region beg end) | |
5735 | (remove-text-properties beg end '(display nil invisible nil | |
5736 | intangible nil)) | |
5737 | (when (fboundp 'font-lock-unfontify-region) | |
5738 | (font-lock-unfontify-region (point-min) (point-max))) | |
5739 | (cond | |
5740 | ((eq org-edit-fixed-width-region-mode 'artist-mode) | |
5741 | (fundamental-mode) | |
5742 | (artist-mode 1)) | |
5743 | (t (funcall org-edit-fixed-width-region-mode))) | |
5744 | (set (make-local-variable 'org-edit-src-force-single-line) nil) | |
5745 | (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) | |
5746 | (set (make-local-variable 'org-edit-src-picture) t) | |
5747 | (goto-char (point-min)) | |
5748 | (while (re-search-forward "^[ \t]*: ?" nil t) | |
5749 | (replace-match "")) | |
5750 | (goto-line line) | |
5751 | (org-exit-edit-mode) | |
5752 | (org-set-local 'header-line-format msg) | |
5753 | (message "%s" msg) | |
5754 | t))) | |
621f83e4 CD |
5755 | |
5756 | ||
b349f79f CD |
5757 | (defun org-edit-src-find-region-and-lang () |
5758 | "Find the region and language for a local edit. | |
5759 | Return a list with beginning and end of the region, a string representing | |
5760 | the language, a switch telling of the content should be in a single line." | |
5761 | (let ((re-list | |
621f83e4 CD |
5762 | (append |
5763 | org-edit-src-region-extra | |
5764 | '( | |
5765 | ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang) | |
5766 | ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style) | |
5767 | ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental") | |
5768 | ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp") | |
5769 | ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl") | |
5770 | ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python") | |
5771 | ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby") | |
5772 | ("^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n#\\+end_src" 2) | |
5773 | ("^#\\+begin_example.*\n" "\n#\\+end_example" "fundamental") | |
5774 | ("^#\\+html:" "\n" "html" single-line) | |
5775 | ("^#\\+begin_html.*\n" "\n#\\+end_html" "html") | |
5776 | ("^#\\+begin_latex.*\n" "\n#\\+end_latex" "latex") | |
5777 | ("^#\\+latex:" "\n" "latex" single-line) | |
5778 | ("^#\\+begin_ascii.*\n" "\n#\\+end_ascii" "fundamental") | |
5779 | ("^#\\+ascii:" "\n" "ascii" single-line) | |
5780 | ))) | |
b349f79f CD |
5781 | (pos (point)) |
5782 | re re1 re2 single beg end lang) | |
5783 | (catch 'exit | |
5784 | (while (setq entry (pop re-list)) | |
5785 | (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) | |
5786 | single (nth 3 entry)) | |
5787 | (save-excursion | |
5788 | (if (or (looking-at re1) | |
5789 | (re-search-backward re1 nil t)) | |
5790 | (progn | |
5791 | (setq beg (match-end 0) lang (org-edit-src-get-lang lang)) | |
5792 | (if (and (re-search-forward re2 nil t) | |
5793 | (>= (match-end 0) pos)) | |
5794 | (throw 'exit (list beg (match-beginning 0) lang single)))) | |
5795 | (if (or (looking-at re2) | |
5796 | (re-search-forward re2 nil t)) | |
5797 | (progn | |
5798 | (setq end (match-beginning 0)) | |
5799 | (if (and (re-search-backward re1 nil t) | |
5800 | (<= (match-beginning 0) pos)) | |
5801 | (throw 'exit | |
5802 | (list (match-end 0) end | |
5803 | (org-edit-src-get-lang lang) single))))))))))) | |
5804 | ||
5805 | (defun org-edit-src-get-lang (lang) | |
5806 | "Extract the src language." | |
5807 | (let ((m (match-string 0))) | |
5808 | (cond | |
5809 | ((stringp lang) lang) | |
5810 | ((integerp lang) (match-string lang)) | |
621f83e4 | 5811 | ((and (eq lang 'lang) |
b349f79f CD |
5812 | (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m)) |
5813 | (match-string 1 m)) | |
621f83e4 | 5814 | ((and (eq lang 'style) |
b349f79f CD |
5815 | (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m)) |
5816 | (match-string 1 m)) | |
5817 | (t "fundamental")))) | |
ce4fdcb9 | 5818 | |
b349f79f CD |
5819 | (defun org-edit-src-exit () |
5820 | "Exit special edit and protect problematic lines." | |
5821 | (interactive) | |
5822 | (unless (buffer-base-buffer (current-buffer)) | |
5823 | (error "This is not an indirect buffer, something is wrong...")) | |
5824 | (unless (> (point-min) 1) | |
5825 | (error "This buffer is not narrowed, something is wrong...")) | |
5826 | (goto-char (point-min)) | |
5827 | (if (looking-at "[ \t\n]*\n") (replace-match "")) | |
5828 | (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")) | |
5829 | (when (org-bound-and-true-p org-edit-src-force-single-line) | |
5830 | (goto-char (point-min)) | |
5831 | (while (re-search-forward "\n" nil t) | |
5832 | (replace-match " ")) | |
5833 | (goto-char (point-min)) | |
5834 | (if (looking-at "\\s-*") (replace-match " ")) | |
5835 | (if (re-search-forward "\\s-+\\'" nil t) | |
5836 | (replace-match ""))) | |
5837 | (when (org-bound-and-true-p org-edit-src-from-org-mode) | |
5838 | (goto-char (point-min)) | |
5839 | (while (re-search-forward (if (org-mode-p) "^\\(.\\)" "^\\([*#]\\)") nil t) | |
5840 | (replace-match ",\\1")) | |
5841 | (when font-lock-mode | |
5842 | (font-lock-unfontify-region (point-min) (point-max))) | |
5843 | (put-text-property (point-min) (point-max) 'font-lock-fontified t)) | |
621f83e4 | 5844 | (when (org-bound-and-true-p org-edit-src-picture) |
ce4fdcb9 | 5845 | (untabify (point-min) (point-max)) |
621f83e4 CD |
5846 | (goto-char (point-min)) |
5847 | (while (re-search-forward "^" nil t) | |
5848 | (replace-match ": ")) | |
5849 | (when font-lock-mode | |
5850 | (font-lock-unfontify-region (point-min) (point-max))) | |
5851 | (put-text-property (point-min) (point-max) 'font-lock-fontified t)) | |
0627c265 CD |
5852 | (kill-buffer (current-buffer)) |
5853 | (and (org-mode-p) (org-restart-font-lock))) | |
b349f79f | 5854 | |
4b3a9ba7 | 5855 | |
20908596 | 5856 | ;;; The orgstruct minor mode |
4b3a9ba7 | 5857 | |
20908596 CD |
5858 | ;; Define a minor mode which can be used in other modes in order to |
5859 | ;; integrate the org-mode structure editing commands. | |
374585c9 | 5860 | |
20908596 CD |
5861 | ;; This is really a hack, because the org-mode structure commands use |
5862 | ;; keys which normally belong to the major mode. Here is how it | |
5863 | ;; works: The minor mode defines all the keys necessary to operate the | |
5864 | ;; structure commands, but wraps the commands into a function which | |
5865 | ;; tests if the cursor is currently at a headline or a plain list | |
5866 | ;; item. If that is the case, the structure command is used, | |
5867 | ;; temporarily setting many Org-mode variables like regular | |
5868 | ;; expressions for filling etc. However, when any of those keys is | |
5869 | ;; used at a different location, function uses `key-binding' to look | |
5870 | ;; up if the key has an associated command in another currently active | |
5871 | ;; keymap (minor modes, major mode, global), and executes that | |
5872 | ;; command. There might be problems if any of the keys is otherwise | |
5873 | ;; used as a prefix key. | |
4b3a9ba7 | 5874 | |
20908596 CD |
5875 | ;; Another challenge is that the key binding for TAB can be tab or \C-i, |
5876 | ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode | |
5877 | ;; addresses this by checking explicitly for both bindings. | |
2a94e282 | 5878 | |
20908596 CD |
5879 | (defvar orgstruct-mode-map (make-sparse-keymap) |
5880 | "Keymap for the minor `orgstruct-mode'.") | |
03f3cf35 | 5881 | |
20908596 CD |
5882 | (defvar org-local-vars nil |
5883 | "List of local variables, for use by `orgstruct-mode'") | |
03f3cf35 | 5884 | |
20908596 CD |
5885 | ;;;###autoload |
5886 | (define-minor-mode orgstruct-mode | |
5887 | "Toggle the minor more `orgstruct-mode'. | |
5888 | This mode is for using Org-mode structure commands in other modes. | |
5889 | The following key behave as if Org-mode was active, if the cursor | |
5890 | is on a headline, or on a plain list item (both in the definition | |
5891 | of Org-mode). | |
03f3cf35 | 5892 | |
20908596 CD |
5893 | M-up Move entry/item up |
5894 | M-down Move entry/item down | |
5895 | M-left Promote | |
5896 | M-right Demote | |
5897 | M-S-up Move entry/item up | |
5898 | M-S-down Move entry/item down | |
5899 | M-S-left Promote subtree | |
5900 | M-S-right Demote subtree | |
5901 | M-q Fill paragraph and items like in Org-mode | |
5902 | C-c ^ Sort entries | |
5903 | C-c - Cycle list bullet | |
5904 | TAB Cycle item visibility | |
5905 | M-RET Insert new heading/item | |
5906 | S-M-RET Insert new TODO heading / Chekbox item | |
5907 | C-c C-c Set tags / toggle checkbox" | |
5908 | nil " OrgStruct" nil | |
5909 | (org-load-modules-maybe) | |
5910 | (and (orgstruct-setup) (defun orgstruct-setup () nil))) | |
891f4676 | 5911 | |
20908596 CD |
5912 | ;;;###autoload |
5913 | (defun turn-on-orgstruct () | |
5914 | "Unconditionally turn on `orgstruct-mode'." | |
5915 | (orgstruct-mode 1)) | |
5916 | ||
5917 | ;;;###autoload | |
5918 | (defun turn-on-orgstruct++ () | |
5919 | "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. | |
5920 | In addition to setting orgstruct-mode, this also exports all indentation and | |
5921 | autofilling variables from org-mode into the buffer. Note that turning | |
5922 | off orgstruct-mode will *not* remove these additional settings." | |
5923 | (orgstruct-mode 1) | |
5924 | (let (var val) | |
5925 | (mapc | |
5926 | (lambda (x) | |
5927 | (when (string-match | |
5928 | "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" | |
5929 | (symbol-name (car x))) | |
5930 | (setq var (car x) val (nth 1 x)) | |
5931 | (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) | |
5932 | org-local-vars))) | |
5933 | ||
5934 | (defun orgstruct-error () | |
5935 | "Error when there is no default binding for a structure key." | |
5936 | (interactive) | |
5937 | (error "This key has no function outside structure elements")) | |
891f4676 | 5938 | |
20908596 CD |
5939 | (defun orgstruct-setup () |
5940 | "Setup orgstruct keymaps." | |
5941 | (let ((nfunc 0) | |
5942 | (bindings | |
5943 | (list | |
5944 | '([(meta up)] org-metaup) | |
5945 | '([(meta down)] org-metadown) | |
5946 | '([(meta left)] org-metaleft) | |
5947 | '([(meta right)] org-metaright) | |
5948 | '([(meta shift up)] org-shiftmetaup) | |
5949 | '([(meta shift down)] org-shiftmetadown) | |
5950 | '([(meta shift left)] org-shiftmetaleft) | |
5951 | '([(meta shift right)] org-shiftmetaright) | |
5952 | '([(shift up)] org-shiftup) | |
5953 | '([(shift down)] org-shiftdown) | |
ce4fdcb9 CD |
5954 | '([(shift left)] org-shiftleft) |
5955 | '([(shift right)] org-shiftright) | |
20908596 CD |
5956 | '("\C-c\C-c" org-ctrl-c-ctrl-c) |
5957 | '("\M-q" fill-paragraph) | |
5958 | '("\C-c^" org-sort) | |
5959 | '("\C-c-" org-cycle-list-bullet))) | |
5960 | elt key fun cmd) | |
5961 | (while (setq elt (pop bindings)) | |
5962 | (setq nfunc (1+ nfunc)) | |
5963 | (setq key (org-key (car elt)) | |
5964 | fun (nth 1 elt) | |
5965 | cmd (orgstruct-make-binding fun nfunc key)) | |
5966 | (org-defkey orgstruct-mode-map key cmd)) | |
891f4676 | 5967 | |
20908596 CD |
5968 | ;; Special treatment needed for TAB and RET |
5969 | (org-defkey orgstruct-mode-map [(tab)] | |
5970 | (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) | |
5971 | (org-defkey orgstruct-mode-map "\C-i" | |
5972 | (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) | |
6769c0dc | 5973 | |
20908596 CD |
5974 | (org-defkey orgstruct-mode-map "\M-\C-m" |
5975 | (orgstruct-make-binding 'org-insert-heading 105 | |
5976 | "\M-\C-m" [(meta return)])) | |
5977 | (org-defkey orgstruct-mode-map [(meta return)] | |
5978 | (orgstruct-make-binding 'org-insert-heading 106 | |
5979 | [(meta return)] "\M-\C-m")) | |
891f4676 | 5980 | |
20908596 CD |
5981 | (org-defkey orgstruct-mode-map [(shift meta return)] |
5982 | (orgstruct-make-binding 'org-insert-todo-heading 107 | |
5983 | [(meta return)] "\M-\C-m")) | |
891f4676 | 5984 | |
20908596 CD |
5985 | (unless org-local-vars |
5986 | (setq org-local-vars (org-get-local-variables))) | |
891f4676 | 5987 | |
20908596 | 5988 | t)) |
891f4676 | 5989 | |
20908596 CD |
5990 | (defun orgstruct-make-binding (fun n &rest keys) |
5991 | "Create a function for binding in the structure minor mode. | |
5992 | FUN is the command to call inside a table. N is used to create a unique | |
5993 | command name. KEYS are keys that should be checked in for a command | |
5994 | to execute outside of tables." | |
5995 | (eval | |
5996 | (list 'defun | |
5997 | (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) | |
5998 | '(arg) | |
5999 | (concat "In Structure, run `" (symbol-name fun) "'.\n" | |
6000 | "Outside of structure, run the binding of `" | |
6001 | (mapconcat (lambda (x) (format "%s" x)) keys "' or `") | |
6002 | "'.") | |
6003 | '(interactive "p") | |
6004 | (list 'if | |
6005 | '(org-context-p 'headline 'item) | |
6006 | (list 'org-run-like-in-org-mode (list 'quote fun)) | |
6007 | (list 'let '(orgstruct-mode) | |
6008 | (list 'call-interactively | |
6009 | (append '(or) | |
6010 | (mapcar (lambda (k) | |
6011 | (list 'key-binding k)) | |
6012 | keys) | |
6013 | '('orgstruct-error)))))))) | |
64f72ae1 | 6014 | |
20908596 | 6015 | (defun org-context-p (&rest contexts) |
621f83e4 | 6016 | "Check if local context is any of CONTEXTS. |
20908596 CD |
6017 | Possible values in the list of contexts are `table', `headline', and `item'." |
6018 | (let ((pos (point))) | |
6019 | (goto-char (point-at-bol)) | |
6020 | (prog1 (or (and (memq 'table contexts) | |
6021 | (looking-at "[ \t]*|")) | |
6022 | (and (memq 'headline contexts) | |
621f83e4 CD |
6023 | ;;????????? (looking-at "\\*+")) |
6024 | (looking-at outline-regexp)) | |
20908596 CD |
6025 | (and (memq 'item contexts) |
6026 | (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) | |
6027 | (goto-char pos)))) | |
4b3a9ba7 | 6028 | |
20908596 CD |
6029 | (defun org-get-local-variables () |
6030 | "Return a list of all local variables in an org-mode buffer." | |
6031 | (let (varlist) | |
6032 | (with-current-buffer (get-buffer-create "*Org tmp*") | |
6033 | (erase-buffer) | |
6034 | (org-mode) | |
6035 | (setq varlist (buffer-local-variables))) | |
6036 | (kill-buffer "*Org tmp*") | |
6037 | (delq nil | |
6038 | (mapcar | |
6039 | (lambda (x) | |
6040 | (setq x | |
6041 | (if (symbolp x) | |
6042 | (list x) | |
6043 | (list (car x) (list 'quote (cdr x))))) | |
6044 | (if (string-match | |
6045 | "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" | |
6046 | (symbol-name (car x))) | |
6047 | x nil)) | |
6048 | varlist)))) | |
891f4676 | 6049 | |
20908596 CD |
6050 | ;;;###autoload |
6051 | (defun org-run-like-in-org-mode (cmd) | |
6052 | (org-load-modules-maybe) | |
6053 | (unless org-local-vars | |
6054 | (setq org-local-vars (org-get-local-variables))) | |
6055 | (eval (list 'let org-local-vars | |
6056 | (list 'call-interactively (list 'quote cmd))))) | |
891f4676 | 6057 | |
20908596 | 6058 | ;;;; Archiving |
891f4676 | 6059 | |
20908596 CD |
6060 | (defun org-get-category (&optional pos) |
6061 | "Get the category applying to position POS." | |
6062 | (get-text-property (or pos (point)) 'org-category)) | |
a96ee7df | 6063 | |
20908596 CD |
6064 | (defun org-refresh-category-properties () |
6065 | "Refresh category text properties in the buffer." | |
6066 | (let ((def-cat (cond | |
6067 | ((null org-category) | |
6068 | (if buffer-file-name | |
6069 | (file-name-sans-extension | |
6070 | (file-name-nondirectory buffer-file-name)) | |
6071 | "???")) | |
6072 | ((symbolp org-category) (symbol-name org-category)) | |
6073 | (t org-category))) | |
6074 | beg end cat pos optionp) | |
6075 | (org-unmodified | |
6076 | (save-excursion | |
6077 | (save-restriction | |
6078 | (widen) | |
6079 | (goto-char (point-min)) | |
6080 | (put-text-property (point) (point-max) 'org-category def-cat) | |
6081 | (while (re-search-forward | |
6082 | "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) | |
6083 | (setq pos (match-end 0) | |
6084 | optionp (equal (char-after (match-beginning 0)) ?#) | |
6085 | cat (org-trim (match-string 2))) | |
6086 | (if optionp | |
6087 | (setq beg (point-at-bol) end (point-max)) | |
6088 | (org-back-to-heading t) | |
6089 | (setq beg (point) end (org-end-of-subtree t t))) | |
6090 | (put-text-property beg end 'org-category cat) | |
6091 | (goto-char pos))))))) | |
891f4676 | 6092 | |
891f4676 | 6093 | |
20908596 | 6094 | ;;;; Link Stuff |
03f3cf35 | 6095 | |
20908596 | 6096 | ;;; Link abbreviations |
891f4676 | 6097 | |
20908596 CD |
6098 | (defun org-link-expand-abbrev (link) |
6099 | "Apply replacements as defined in `org-link-abbrev-alist." | |
6100 | (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link) | |
6101 | (let* ((key (match-string 1 link)) | |
6102 | (as (or (assoc key org-link-abbrev-alist-local) | |
6103 | (assoc key org-link-abbrev-alist))) | |
6104 | (tag (and (match-end 2) (match-string 3 link))) | |
6105 | rpl) | |
6106 | (if (not as) | |
6107 | link | |
6108 | (setq rpl (cdr as)) | |
6109 | (cond | |
6110 | ((symbolp rpl) (funcall rpl tag)) | |
6111 | ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) | |
ce4fdcb9 CD |
6112 | ((string-match "%h" rpl) |
6113 | (replace-match (url-hexify-string (or tag "")) t t rpl)) | |
20908596 CD |
6114 | (t (concat rpl tag))))) |
6115 | link)) | |
4b3a9ba7 | 6116 | |
20908596 | 6117 | ;;; Storing and inserting links |
0fee8d6e | 6118 | |
20908596 CD |
6119 | (defvar org-insert-link-history nil |
6120 | "Minibuffer history for links inserted with `org-insert-link'.") | |
38f8646b | 6121 | |
20908596 CD |
6122 | (defvar org-stored-links nil |
6123 | "Contains the links stored with `org-store-link'.") | |
38f8646b | 6124 | |
20908596 CD |
6125 | (defvar org-store-link-plist nil |
6126 | "Plist with info about the most recently link created with `org-store-link'.") | |
fbe6c10d | 6127 | |
20908596 CD |
6128 | (defvar org-link-protocols nil |
6129 | "Link protocols added to Org-mode using `org-add-link-type'.") | |
f425a6ea | 6130 | |
20908596 CD |
6131 | (defvar org-store-link-functions nil |
6132 | "List of functions that are called to create and store a link. | |
6133 | Each function will be called in turn until one returns a non-nil | |
6134 | value. Each function should check if it is responsible for creating | |
6135 | this link (for example by looking at the major mode). | |
6136 | If not, it must exit and return nil. | |
6137 | If yes, it should return a non-nil value after a calling | |
6138 | `org-store-link-props' with a list of properties and values. | |
6139 | Special properties are: | |
30313b90 | 6140 | |
20908596 CD |
6141 | :type The link prefix. like \"http\". This must be given. |
6142 | :link The link, like \"http://www.astro.uva.nl/~dominik\". | |
6143 | This is obligatory as well. | |
6144 | :description Optional default description for the second pair | |
6145 | of brackets in an Org-mode link. The user can still change | |
6146 | this when inserting this link into an Org-mode buffer. | |
30313b90 | 6147 | |
20908596 CD |
6148 | In addition to these, any additional properties can be specified |
6149 | and then used in remember templates.") | |
35402b98 | 6150 | |
20908596 CD |
6151 | (defun org-add-link-type (type &optional follow export) |
6152 | "Add TYPE to the list of `org-link-types'. | |
6153 | Re-compute all regular expressions depending on `org-link-types' | |
ab27a4a0 | 6154 | |
20908596 | 6155 | FOLLOW and EXPORT are two functions. |
891f4676 | 6156 | |
20908596 CD |
6157 | FOLLOW should take the link path as the single argument and do whatever |
6158 | is necessary to follow the link, for example find a file or display | |
6159 | a mail message. | |
1e8fbb6d | 6160 | |
20908596 CD |
6161 | EXPORT should format the link path for export to one of the export formats. |
6162 | It should be a function accepting three arguments: | |
fbe6c10d | 6163 | |
20908596 CD |
6164 | path the path of the link, the text after the prefix (like \"http:\") |
6165 | desc the description of the link, if any, nil if there was no descripton | |
6166 | format the export format, a symbol like `html' or `latex'. | |
fbe6c10d | 6167 | |
20908596 CD |
6168 | The function may use the FORMAT information to return different values |
6169 | depending on the format. The return value will be put literally into | |
6170 | the exported file. | |
6171 | Org-mode has a built-in default for exporting links. If you are happy with | |
6172 | this default, there is no need to define an export function for the link | |
6173 | type. For a simple example of an export function, see `org-bbdb.el'." | |
6174 | (add-to-list 'org-link-types type t) | |
6175 | (org-make-link-regexps) | |
6176 | (if (assoc type org-link-protocols) | |
6177 | (setcdr (assoc type org-link-protocols) (list follow export)) | |
6178 | (push (list type follow export) org-link-protocols))) | |
374585c9 | 6179 | |
20908596 CD |
6180 | ;;;###autoload |
6181 | (defun org-store-link (arg) | |
6182 | "\\<org-mode-map>Store an org-link to the current location. | |
6183 | This link is added to `org-stored-links' and can later be inserted | |
6184 | into an org-buffer with \\[org-insert-link]. | |
6185 | ||
6186 | For some link types, a prefix arg is interpreted: | |
ce4fdcb9 | 6187 | For links to usenet articles, arg negates `org-gnus-prefer-web-links'. |
20908596 CD |
6188 | For file links, arg negates `org-context-in-file-links'." |
6189 | (interactive "P") | |
6190 | (org-load-modules-maybe) | |
6191 | (setq org-store-link-plist nil) ; reset | |
6192 | (let (link cpltxt desc description search txt) | |
d3f4dbe8 | 6193 | (cond |
a96ee7df | 6194 | |
20908596 CD |
6195 | ((run-hook-with-args-until-success 'org-store-link-functions) |
6196 | (setq link (plist-get org-store-link-plist :link) | |
6197 | desc (or (plist-get org-store-link-plist :description) link))) | |
6198 | ||
6199 | ((eq major-mode 'calendar-mode) | |
6200 | (let ((cd (calendar-cursor-to-date))) | |
6201 | (setq link | |
6202 | (format-time-string | |
6203 | (car org-time-stamp-formats) | |
6204 | (apply 'encode-time | |
6205 | (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) | |
6206 | nil nil nil)))) | |
6207 | (org-store-link-props :type "calendar" :date cd))) | |
6208 | ||
6209 | ((eq major-mode 'w3-mode) | |
6210 | (setq cpltxt (url-view-url t) | |
6211 | link (org-make-link cpltxt)) | |
6212 | (org-store-link-props :type "w3" :url (url-view-url t))) | |
6213 | ||
6214 | ((eq major-mode 'w3m-mode) | |
6215 | (setq cpltxt (or w3m-current-title w3m-current-url) | |
6216 | link (org-make-link w3m-current-url)) | |
6217 | (org-store-link-props :type "w3m" :url (url-view-url t))) | |
6218 | ||
6219 | ((setq search (run-hook-with-args-until-success | |
6220 | 'org-create-file-search-functions)) | |
6221 | (setq link (concat "file:" (abbreviate-file-name buffer-file-name) | |
6222 | "::" search)) | |
6223 | (setq cpltxt (or description link))) | |
6224 | ||
6225 | ((eq major-mode 'image-mode) | |
6226 | (setq cpltxt (concat "file:" | |
6227 | (abbreviate-file-name buffer-file-name)) | |
6228 | link (org-make-link cpltxt)) | |
6229 | (org-store-link-props :type "image" :file buffer-file-name)) | |
6230 | ||
6231 | ((eq major-mode 'dired-mode) | |
6232 | ;; link to the file in the current line | |
6233 | (setq cpltxt (concat "file:" | |
6234 | (abbreviate-file-name | |
6235 | (expand-file-name | |
6236 | (dired-get-filename nil t)))) | |
6237 | link (org-make-link cpltxt))) | |
6238 | ||
6239 | ((and buffer-file-name (org-mode-p)) | |
ff4be292 CD |
6240 | (cond |
6241 | ((org-in-regexp "<<\\(.*?\\)>>") | |
6242 | (setq cpltxt | |
6243 | (concat "file:" | |
6244 | (abbreviate-file-name buffer-file-name) | |
6245 | "::" (match-string 1)) | |
6246 | link (org-make-link cpltxt))) | |
6247 | ((and (featurep 'org-id) | |
6248 | (or (eq org-link-to-org-use-id t) | |
6249 | (and (eq org-link-to-org-use-id 'create-if-interactive) | |
6250 | (interactive-p)) | |
6251 | (and org-link-to-org-use-id | |
6252 | (condition-case nil | |
6253 | (org-entry-get nil "ID") | |
6254 | (error nil))))) | |
6255 | ;; We can make a link using the ID. | |
6256 | (setq link (condition-case nil | |
6257 | (org-id-store-link) | |
6258 | (error | |
6259 | ;; probably before first headling, link to file only | |
6260 | (concat "file:" | |
6261 | (abbreviate-file-name buffer-file-name)))))) | |
6262 | (t | |
6263 | ;; Just link to current headline | |
6264 | (setq cpltxt (concat "file:" | |
6265 | (abbreviate-file-name buffer-file-name))) | |
6266 | ;; Add a context search string | |
6267 | (when (org-xor org-context-in-file-links arg) | |
20908596 CD |
6268 | (setq txt (cond |
6269 | ((org-on-heading-p) nil) | |
6270 | ((org-region-active-p) | |
6271 | (buffer-substring (region-beginning) (region-end))) | |
6272 | (t nil))) | |
6273 | (when (or (null txt) (string-match "\\S-" txt)) | |
6274 | (setq cpltxt | |
b349f79f CD |
6275 | (concat cpltxt "::" |
6276 | (condition-case nil | |
6277 | (org-make-org-heading-search-string txt) | |
6278 | (error ""))) | |
ff4be292 CD |
6279 | desc "NONE"))) |
6280 | (if (string-match "::\\'" cpltxt) | |
6281 | (setq cpltxt (substring cpltxt 0 -2))) | |
6282 | (setq link (org-make-link cpltxt))))) | |
20908596 CD |
6283 | |
6284 | ((buffer-file-name (buffer-base-buffer)) | |
6285 | ;; Just link to this file here. | |
6286 | (setq cpltxt (concat "file:" | |
6287 | (abbreviate-file-name | |
6288 | (buffer-file-name (buffer-base-buffer))))) | |
6289 | ;; Add a context string | |
6290 | (when (org-xor org-context-in-file-links arg) | |
6291 | (setq txt (if (org-region-active-p) | |
6292 | (buffer-substring (region-beginning) (region-end)) | |
6293 | (buffer-substring (point-at-bol) (point-at-eol)))) | |
6294 | ;; Only use search option if there is some text. | |
6295 | (when (string-match "\\S-" txt) | |
6296 | (setq cpltxt | |
6297 | (concat cpltxt "::" (org-make-org-heading-search-string txt)) | |
6298 | desc "NONE"))) | |
6299 | (setq link (org-make-link cpltxt))) | |
6300 | ||
6301 | ((interactive-p) | |
6302 | (error "Cannot link to a buffer which is not visiting a file")) | |
891f4676 | 6303 | |
20908596 | 6304 | (t (setq link nil))) |
891f4676 | 6305 | |
20908596 CD |
6306 | (if (consp link) (setq cpltxt (car link) link (cdr link))) |
6307 | (setq link (or link cpltxt) | |
6308 | desc (or desc cpltxt)) | |
6309 | (if (equal desc "NONE") (setq desc nil)) | |
ab27a4a0 | 6310 | |
20908596 CD |
6311 | (if (and (interactive-p) link) |
6312 | (progn | |
6313 | (setq org-stored-links | |
6314 | (cons (list link desc) org-stored-links)) | |
6315 | (message "Stored: %s" (or desc link))) | |
6316 | (and link (org-make-link-string link desc))))) | |
6317 | ||
6318 | (defun org-store-link-props (&rest plist) | |
6319 | "Store link properties, extract names and addresses." | |
6320 | (let (x adr) | |
6321 | (when (setq x (plist-get plist :from)) | |
6322 | (setq adr (mail-extract-address-components x)) | |
93b62de8 CD |
6323 | (setq plist (plist-put plist :fromname (car adr))) |
6324 | (setq plist (plist-put plist :fromaddress (nth 1 adr)))) | |
20908596 CD |
6325 | (when (setq x (plist-get plist :to)) |
6326 | (setq adr (mail-extract-address-components x)) | |
93b62de8 CD |
6327 | (setq plist (plist-put plist :toname (car adr))) |
6328 | (setq plist (plist-put plist :toaddress (nth 1 adr))))) | |
20908596 CD |
6329 | (let ((from (plist-get plist :from)) |
6330 | (to (plist-get plist :to))) | |
6331 | (when (and from to org-from-is-user-regexp) | |
93b62de8 CD |
6332 | (setq plist |
6333 | (plist-put plist :fromto | |
6334 | (if (string-match org-from-is-user-regexp from) | |
6335 | (concat "to %t") | |
6336 | (concat "from %f")))))) | |
20908596 CD |
6337 | (setq org-store-link-plist plist)) |
6338 | ||
6339 | (defun org-add-link-props (&rest plist) | |
6340 | "Add these properties to the link property list." | |
6341 | (let (key value) | |
6342 | (while plist | |
6343 | (setq key (pop plist) value (pop plist)) | |
6344 | (setq org-store-link-plist | |
6345 | (plist-put org-store-link-plist key value))))) | |
6346 | ||
6347 | (defun org-email-link-description (&optional fmt) | |
6348 | "Return the description part of an email link. | |
6349 | This takes information from `org-store-link-plist' and formats it | |
6350 | according to FMT (default from `org-email-link-description-format')." | |
6351 | (setq fmt (or fmt org-email-link-description-format)) | |
6352 | (let* ((p org-store-link-plist) | |
6353 | (to (plist-get p :toaddress)) | |
6354 | (from (plist-get p :fromaddress)) | |
6355 | (table | |
6356 | (list | |
6357 | (cons "%c" (plist-get p :fromto)) | |
6358 | (cons "%F" (plist-get p :from)) | |
6359 | (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) | |
6360 | (cons "%T" (plist-get p :to)) | |
6361 | (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) | |
6362 | (cons "%s" (plist-get p :subject)) | |
6363 | (cons "%m" (plist-get p :message-id))))) | |
6364 | (when (string-match "%c" fmt) | |
6365 | ;; Check if the user wrote this message | |
6366 | (if (and org-from-is-user-regexp from to | |
6367 | (save-match-data (string-match org-from-is-user-regexp from))) | |
6368 | (setq fmt (replace-match "to %t" t t fmt)) | |
6369 | (setq fmt (replace-match "from %f" t t fmt)))) | |
6370 | (org-replace-escapes fmt table))) | |
6371 | ||
6372 | (defun org-make-org-heading-search-string (&optional string heading) | |
6373 | "Make search string for STRING or current headline." | |
6374 | (interactive) | |
6375 | (let ((s (or string (org-get-heading)))) | |
6376 | (unless (and string (not heading)) | |
6377 | ;; We are using a headline, clean up garbage in there. | |
6378 | (if (string-match org-todo-regexp s) | |
6379 | (setq s (replace-match "" t t s))) | |
6380 | (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) | |
6381 | (setq s (replace-match "" t t s))) | |
6382 | (setq s (org-trim s)) | |
6383 | (if (string-match (concat "^\\(" org-quote-string "\\|" | |
6384 | org-comment-string "\\)") s) | |
6385 | (setq s (replace-match "" t t s))) | |
6386 | (while (string-match org-ts-regexp s) | |
6387 | (setq s (replace-match "" t t s)))) | |
6388 | (while (string-match "[^a-zA-Z_0-9 \t]+" s) | |
6389 | (setq s (replace-match " " t t s))) | |
6390 | (or string (setq s (concat "*" s))) ; Add * for headlines | |
6391 | (mapconcat 'identity (org-split-string s "[ \t]+") " "))) | |
891f4676 | 6392 | |
20908596 CD |
6393 | (defun org-make-link (&rest strings) |
6394 | "Concatenate STRINGS." | |
6395 | (apply 'concat strings)) | |
ab27a4a0 | 6396 | |
20908596 CD |
6397 | (defun org-make-link-string (link &optional description) |
6398 | "Make a link with brackets, consisting of LINK and DESCRIPTION." | |
6399 | (unless (string-match "\\S-" link) | |
6400 | (error "Empty link")) | |
6401 | (when (stringp description) | |
6402 | ;; Remove brackets from the description, they are fatal. | |
6403 | (while (string-match "\\[" description) | |
6404 | (setq description (replace-match "{" t t description))) | |
6405 | (while (string-match "\\]" description) | |
6406 | (setq description (replace-match "}" t t description)))) | |
6407 | (when (equal (org-link-escape link) description) | |
6408 | ;; No description needed, it is identical | |
6409 | (setq description nil)) | |
6410 | (when (and (not description) | |
6411 | (not (equal link (org-link-escape link)))) | |
2c3ad40d | 6412 | (setq description (org-extract-attributes link))) |
20908596 CD |
6413 | (concat "[[" (org-link-escape link) "]" |
6414 | (if description (concat "[" description "]") "") | |
6415 | "]")) | |
6416 | ||
6417 | (defconst org-link-escape-chars | |
6418 | '((?\ . "%20") | |
6419 | (?\[ . "%5B") | |
6420 | (?\] . "%5D") | |
6421 | (?\340 . "%E0") ; `a | |
6422 | (?\342 . "%E2") ; ^a | |
6423 | (?\347 . "%E7") ; ,c | |
6424 | (?\350 . "%E8") ; `e | |
6425 | (?\351 . "%E9") ; 'e | |
6426 | (?\352 . "%EA") ; ^e | |
6427 | (?\356 . "%EE") ; ^i | |
6428 | (?\364 . "%F4") ; ^o | |
6429 | (?\371 . "%F9") ; `u | |
6430 | (?\373 . "%FB") ; ^u | |
6431 | (?\; . "%3B") | |
6432 | (?? . "%3F") | |
6433 | (?= . "%3D") | |
6434 | (?+ . "%2B") | |
6435 | ) | |
6436 | "Association list of escapes for some characters problematic in links. | |
6437 | This is the list that is used for internal purposes.") | |
6438 | ||
6439 | (defconst org-link-escape-chars-browser | |
6440 | '((?\ . "%20")) ; 32 for the SPC char | |
6441 | "Association list of escapes for some characters problematic in links. | |
6442 | This is the list that is used before handing over to the browser.") | |
6443 | ||
6444 | (defun org-link-escape (text &optional table) | |
d60b1ba1 | 6445 | "Escape characters in TEXT that are problematic for links." |
20908596 CD |
6446 | (setq table (or table org-link-escape-chars)) |
6447 | (when text | |
6448 | (let ((re (mapconcat (lambda (x) (regexp-quote | |
6449 | (char-to-string (car x)))) | |
6450 | table "\\|"))) | |
6451 | (while (string-match re text) | |
6452 | (setq text | |
6453 | (replace-match | |
6454 | (cdr (assoc (string-to-char (match-string 0 text)) | |
6455 | table)) | |
6456 | t t text))) | |
6457 | text))) | |
6458 | ||
6459 | (defun org-link-unescape (text &optional table) | |
6460 | "Reverse the action of `org-link-escape'." | |
6461 | (setq table (or table org-link-escape-chars)) | |
6462 | (when text | |
6463 | (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) | |
6464 | table "\\|"))) | |
6465 | (while (string-match re text) | |
6466 | (setq text | |
6467 | (replace-match | |
6468 | (char-to-string (car (rassoc (match-string 0 text) table))) | |
6469 | t t text))) | |
6470 | text))) | |
6471 | ||
6472 | (defun org-xor (a b) | |
6473 | "Exclusive or." | |
6474 | (if a (not b) b)) | |
6475 | ||
6476 | (defun org-get-header (header) | |
6477 | "Find a header field in the current buffer." | |
d3f4dbe8 | 6478 | (save-excursion |
20908596 CD |
6479 | (goto-char (point-min)) |
6480 | (let ((case-fold-search t) s) | |
6481 | (cond | |
6482 | ((eq header 'from) | |
6483 | (if (re-search-forward "^From:\\s-+\\(.*\\)" nil t) | |
6484 | (setq s (match-string 1))) | |
6485 | (while (string-match "\"" s) | |
6486 | (setq s (replace-match "" t t s))) | |
6487 | (if (string-match "[<(].*" s) | |
6488 | (setq s (replace-match "" t t s)))) | |
6489 | ((eq header 'message-id) | |
6490 | (if (re-search-forward "^message-id:\\s-+\\(.*\\)" nil t) | |
6491 | (setq s (match-string 1)))) | |
6492 | ((eq header 'subject) | |
6493 | (if (re-search-forward "^subject:\\s-+\\(.*\\)" nil t) | |
6494 | (setq s (match-string 1))))) | |
6495 | (if (string-match "\\`[ \t\]+" s) (setq s (replace-match "" t t s))) | |
6496 | (if (string-match "[ \t\]+\\'" s) (setq s (replace-match "" t t s))) | |
6497 | s))) | |
ab27a4a0 | 6498 | |
d5098885 | 6499 | |
20908596 CD |
6500 | (defun org-fixup-message-id-for-http (s) |
6501 | "Replace special characters in a message id, so it can be used in an http query." | |
6502 | (while (string-match "<" s) | |
6503 | (setq s (replace-match "%3C" t t s))) | |
6504 | (while (string-match ">" s) | |
6505 | (setq s (replace-match "%3E" t t s))) | |
6506 | (while (string-match "@" s) | |
6507 | (setq s (replace-match "%40" t t s))) | |
6508 | s) | |
6509 | ||
6510 | ;;;###autoload | |
6511 | (defun org-insert-link-global () | |
6512 | "Insert a link like Org-mode does. | |
6513 | This command can be called in any mode to insert a link in Org-mode syntax." | |
6514 | (interactive) | |
6515 | (org-load-modules-maybe) | |
6516 | (org-run-like-in-org-mode 'org-insert-link)) | |
6517 | ||
6518 | (defun org-insert-link (&optional complete-file link-location) | |
6519 | "Insert a link. At the prompt, enter the link. | |
6520 | ||
93b62de8 CD |
6521 | Completion can be used to insert any of the link protocol prefixes like |
6522 | http or ftp in use. | |
6523 | ||
6524 | The history can be used to select a link previously stored with | |
20908596 CD |
6525 | `org-store-link'. When the empty string is entered (i.e. if you just |
6526 | press RET at the prompt), the link defaults to the most recently | |
6527 | stored link. As SPC triggers completion in the minibuffer, you need to | |
6528 | use M-SPC or C-q SPC to force the insertion of a space character. | |
6529 | ||
6530 | You will also be prompted for a description, and if one is given, it will | |
6531 | be displayed in the buffer instead of the link. | |
6532 | ||
6533 | If there is already a link at point, this command will allow you to edit link | |
6534 | and description parts. | |
6535 | ||
6536 | With a \\[universal-argument] prefix, prompts for a file to link to. The file name can | |
6537 | be selected using completion. The path to the file will be relative to the | |
6538 | current directory if the file is in the current directory or a subdirectory. | |
6539 | Otherwise, the link will be the absolute path as completed in the minibuffer | |
93b62de8 CD |
6540 | \(i.e. normally ~/path/to/file). You can configure this behavior using the |
6541 | option `org-link-file-path-type'. | |
20908596 CD |
6542 | |
6543 | With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in | |
93b62de8 CD |
6544 | the current directory or below. |
6545 | ||
6546 | With three \\[universal-argument] prefixes, negate the meaning of | |
6547 | `org-keep-stored-link-after-insertion'. | |
20908596 CD |
6548 | |
6549 | If `org-make-link-description-function' is non-nil, this function will be | |
6550 | called with the link target, and the result will be the default | |
6551 | link description. | |
6552 | ||
6553 | If the LINK-LOCATION parameter is non-nil, this value will be | |
6554 | used as the link location instead of reading one interactively." | |
6555 | (interactive "P") | |
6556 | (let* ((wcf (current-window-configuration)) | |
6557 | (region (if (org-region-active-p) | |
6558 | (buffer-substring (region-beginning) (region-end)))) | |
6559 | (remove (and region (list (region-beginning) (region-end)))) | |
6560 | (desc region) | |
6561 | tmphist ; byte-compile incorrectly complains about this | |
6562 | (link link-location) | |
6563 | entry file) | |
6564 | (cond | |
6565 | (link-location) ; specified by arg, just use it. | |
6566 | ((org-in-regexp org-bracket-link-regexp 1) | |
6567 | ;; We do have a link at point, and we are going to edit it. | |
6568 | (setq remove (list (match-beginning 0) (match-end 0))) | |
6569 | (setq desc (if (match-end 3) (org-match-string-no-properties 3))) | |
6570 | (setq link (read-string "Link: " | |
6571 | (org-link-unescape | |
6572 | (org-match-string-no-properties 1))))) | |
6573 | ((or (org-in-regexp org-angle-link-re) | |
6574 | (org-in-regexp org-plain-link-re)) | |
6575 | ;; Convert to bracket link | |
6576 | (setq remove (list (match-beginning 0) (match-end 0)) | |
6577 | link (read-string "Link: " | |
6578 | (org-remove-angle-brackets (match-string 0))))) | |
93b62de8 | 6579 | ((member complete-file '((4) (16))) |
20908596 CD |
6580 | ;; Completing read for file names. |
6581 | (setq file (read-file-name "File: ")) | |
6582 | (let ((pwd (file-name-as-directory (expand-file-name "."))) | |
6583 | (pwd1 (file-name-as-directory (abbreviate-file-name | |
6584 | (expand-file-name "."))))) | |
6585 | (cond | |
6586 | ((equal complete-file '(16)) | |
6587 | (setq link (org-make-link | |
6588 | "file:" | |
6589 | (abbreviate-file-name (expand-file-name file))))) | |
6590 | ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) | |
6591 | (setq link (org-make-link "file:" (match-string 1 file)))) | |
6592 | ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") | |
6593 | (expand-file-name file)) | |
6594 | (setq link (org-make-link | |
6595 | "file:" (match-string 1 (expand-file-name file))))) | |
6596 | (t (setq link (org-make-link "file:" file)))))) | |
6597 | (t | |
6598 | ;; Read link, with completion for stored links. | |
6599 | (with-output-to-temp-buffer "*Org Links*" | |
6600 | (princ "Insert a link. Use TAB to complete valid link prefixes.\n") | |
6601 | (when org-stored-links | |
6602 | (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") | |
6603 | (princ (mapconcat | |
6604 | (lambda (x) | |
6605 | (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) | |
6606 | (reverse org-stored-links) "\n")))) | |
6607 | (let ((cw (selected-window))) | |
6608 | (select-window (get-buffer-window "*Org Links*")) | |
93b62de8 | 6609 | (org-fit-window-to-buffer) |
20908596 CD |
6610 | (setq truncate-lines t) |
6611 | (select-window cw)) | |
6612 | ;; Fake a link history, containing the stored links. | |
6613 | (setq tmphist (append (mapcar 'car org-stored-links) | |
6614 | org-insert-link-history)) | |
6615 | (unwind-protect | |
6616 | (setq link (org-completing-read | |
6617 | "Link: " | |
6618 | (append | |
6619 | (mapcar (lambda (x) (list (concat (car x) ":"))) | |
6620 | (append org-link-abbrev-alist-local org-link-abbrev-alist)) | |
6621 | (mapcar (lambda (x) (list (concat x ":"))) | |
6622 | org-link-types)) | |
6623 | nil nil nil | |
6624 | 'tmphist | |
6625 | (or (car (car org-stored-links))))) | |
6626 | (set-window-configuration wcf) | |
6627 | (kill-buffer "*Org Links*")) | |
6628 | (setq entry (assoc link org-stored-links)) | |
6629 | (or entry (push link org-insert-link-history)) | |
6630 | (if (funcall (if (equal complete-file '(64)) 'not 'identity) | |
6631 | (not org-keep-stored-link-after-insertion)) | |
6632 | (setq org-stored-links (delq (assoc link org-stored-links) | |
6633 | org-stored-links))) | |
6634 | (setq desc (or desc (nth 1 entry))))) | |
6635 | ||
6636 | (if (string-match org-plain-link-re link) | |
6637 | ;; URL-like link, normalize the use of angular brackets. | |
6638 | (setq link (org-make-link (org-remove-angle-brackets link)))) | |
891f4676 | 6639 | |
20908596 CD |
6640 | ;; Check if we are linking to the current file with a search option |
6641 | ;; If yes, simplify the link by using only the search option. | |
6642 | (when (and buffer-file-name | |
ce4fdcb9 | 6643 | (string-match "^file:\\(.+?\\)::\\([^>]+\\)" link)) |
20908596 CD |
6644 | (let* ((path (match-string 1 link)) |
6645 | (case-fold-search nil) | |
6646 | (search (match-string 2 link))) | |
6647 | (save-match-data | |
6648 | (if (equal (file-truename buffer-file-name) (file-truename path)) | |
6649 | ;; We are linking to this same file, with a search option | |
6650 | (setq link search))))) | |
38f8646b | 6651 | |
20908596 | 6652 | ;; Check if we can/should use a relative path. If yes, simplify the link |
ce4fdcb9 | 6653 | (when (string-match "^file:\\(.*\\)" link) |
20908596 CD |
6654 | (let* ((path (match-string 1 link)) |
6655 | (origpath path) | |
6656 | (case-fold-search nil)) | |
6657 | (cond | |
93b62de8 CD |
6658 | ((or (eq org-link-file-path-type 'absolute) |
6659 | (equal complete-file '(16))) | |
20908596 CD |
6660 | (setq path (abbreviate-file-name (expand-file-name path)))) |
6661 | ((eq org-link-file-path-type 'noabbrev) | |
6662 | (setq path (expand-file-name path))) | |
6663 | ((eq org-link-file-path-type 'relative) | |
6664 | (setq path (file-relative-name path))) | |
6665 | (t | |
6666 | (save-match-data | |
6667 | (if (string-match (concat "^" (regexp-quote | |
6668 | (file-name-as-directory | |
6669 | (expand-file-name ".")))) | |
6670 | (expand-file-name path)) | |
6671 | ;; We are linking a file with relative path name. | |
6672 | (setq path (substring (expand-file-name path) | |
93b62de8 CD |
6673 | (match-end 0))) |
6674 | (setq path (abbreviate-file-name (expand-file-name path))))))) | |
20908596 CD |
6675 | (setq link (concat "file:" path)) |
6676 | (if (equal desc origpath) | |
6677 | (setq desc path)))) | |
38f8646b | 6678 | |
20908596 CD |
6679 | (if org-make-link-description-function |
6680 | (setq desc (funcall org-make-link-description-function link desc))) | |
38f8646b | 6681 | |
20908596 CD |
6682 | (setq desc (read-string "Description: " desc)) |
6683 | (unless (string-match "\\S-" desc) (setq desc nil)) | |
6684 | (if remove (apply 'delete-region remove)) | |
6685 | (insert (org-make-link-string link desc)))) | |
38f8646b | 6686 | |
20908596 | 6687 | (defun org-completing-read (&rest args) |
93b62de8 | 6688 | "Completing-read with SPACE being a normal character." |
20908596 CD |
6689 | (let ((minibuffer-local-completion-map |
6690 | (copy-keymap minibuffer-local-completion-map))) | |
6691 | (org-defkey minibuffer-local-completion-map " " 'self-insert-command) | |
ce4fdcb9 CD |
6692 | (apply 'org-ido-completing-read args))) |
6693 | ||
6694 | (defun org-ido-completing-read (&rest args) | |
6695 | "Completing-read using `ido-mode' speedups if available" | |
6696 | (if (and org-completion-use-ido | |
6697 | (fboundp 'ido-completing-read) | |
6698 | (boundp 'ido-mode) ido-mode | |
6699 | (listp (second args))) | |
6700 | (apply 'ido-completing-read (concat (car args)) (cdr args)) | |
20908596 | 6701 | (apply 'completing-read args))) |
38f8646b | 6702 | |
2c3ad40d CD |
6703 | (defun org-extract-attributes (s) |
6704 | "Extract the attributes cookie from a string and set as text property." | |
621f83e4 | 6705 | (let (a attr (start 0) key value) |
2c3ad40d CD |
6706 | (save-match-data |
6707 | (when (string-match "{{\\([^}]+\\)}}$" s) | |
6708 | (setq a (match-string 1 s) s (substring s 0 (match-beginning 0))) | |
6709 | (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start) | |
6710 | (setq key (match-string 1 a) value (match-string 2 a) | |
6711 | start (match-end 0) | |
6712 | attr (plist-put attr (intern key) value)))) | |
6713 | (org-add-props s nil 'org-attributes attr)) | |
6714 | s)) | |
6715 | ||
6716 | (defun org-attributes-to-string (plist) | |
6717 | "Format a property list into an HTML attribute list." | |
6718 | (let ((s "") key value) | |
6719 | (while plist | |
6720 | (setq key (pop plist) value (pop plist)) | |
6721 | (setq s (concat s " "(symbol-name key) "=\"" value "\""))) | |
6722 | s)) | |
6723 | ||
20908596 | 6724 | ;;; Opening/following a link |
03f3cf35 | 6725 | |
20908596 | 6726 | (defvar org-link-search-failed nil) |
38f8646b | 6727 | |
20908596 CD |
6728 | (defun org-next-link () |
6729 | "Move forward to the next link. | |
6730 | If the link is in hidden text, expose it." | |
6731 | (interactive) | |
6732 | (when (and org-link-search-failed (eq this-command last-command)) | |
6733 | (goto-char (point-min)) | |
6734 | (message "Link search wrapped back to beginning of buffer")) | |
6735 | (setq org-link-search-failed nil) | |
6736 | (let* ((pos (point)) | |
6737 | (ct (org-context)) | |
6738 | (a (assoc :link ct))) | |
6739 | (if a (goto-char (nth 2 a))) | |
6740 | (if (re-search-forward org-any-link-re nil t) | |
6741 | (progn | |
6742 | (goto-char (match-beginning 0)) | |
6743 | (if (org-invisible-p) (org-show-context))) | |
6744 | (goto-char pos) | |
6745 | (setq org-link-search-failed t) | |
6746 | (error "No further link found")))) | |
38f8646b | 6747 | |
20908596 CD |
6748 | (defun org-previous-link () |
6749 | "Move backward to the previous link. | |
6750 | If the link is in hidden text, expose it." | |
7d58338e | 6751 | (interactive) |
20908596 CD |
6752 | (when (and org-link-search-failed (eq this-command last-command)) |
6753 | (goto-char (point-max)) | |
6754 | (message "Link search wrapped back to end of buffer")) | |
6755 | (setq org-link-search-failed nil) | |
6756 | (let* ((pos (point)) | |
6757 | (ct (org-context)) | |
6758 | (a (assoc :link ct))) | |
6759 | (if a (goto-char (nth 1 a))) | |
6760 | (if (re-search-backward org-any-link-re nil t) | |
6761 | (progn | |
6762 | (goto-char (match-beginning 0)) | |
6763 | (if (org-invisible-p) (org-show-context))) | |
6764 | (goto-char pos) | |
6765 | (setq org-link-search-failed t) | |
6766 | (error "No further link found")))) | |
7d58338e | 6767 | |
ce4fdcb9 CD |
6768 | (defun org-translate-link (s) |
6769 | "Translate a link string if a translation function has been defined." | |
6770 | (if (and org-link-translation-function | |
6771 | (fboundp org-link-translation-function) | |
6772 | (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s)) | |
6773 | (progn | |
6774 | (setq s (funcall org-link-translation-function | |
6775 | (match-string 1) (match-string 2))) | |
6776 | (concat (car s) ":" (cdr s))) | |
6777 | s)) | |
6778 | ||
6779 | (defun org-translate-link-from-planner (type path) | |
6780 | "Translate a link from Emacs Planner syntax so that Org can follow it. | |
6781 | This is still an experimental function, your mileage may vary." | |
6782 | (cond | |
6783 | ((member type '("http" "https" "news" "ftp")) | |
6784 | ;; standard Internet links are the same. | |
6785 | nil) | |
6786 | ((and (equal type "irc") (string-match "^//" path)) | |
6787 | ;; Planner has two / at the beginning of an irc link, we have 1. | |
6788 | ;; We should have zero, actually.... | |
6789 | (setq path (substring path 1))) | |
6790 | ((and (equal type "lisp") (string-match "^/" path)) | |
6791 | ;; Planner has a slash, we do not. | |
6792 | (setq type "elisp" path (substring path 1))) | |
6793 | ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) | |
6794 | ;; A typical message link. Planner has the id after the fina slash, | |
6795 | ;; we separate it with a hash mark | |
6796 | (setq path (concat (match-string 1 path) "#" | |
6797 | (org-remove-angle-brackets (match-string 2 path))))) | |
6798 | ) | |
6799 | (cons type path)) | |
6800 | ||
20908596 CD |
6801 | (defun org-find-file-at-mouse (ev) |
6802 | "Open file link or URL at mouse." | |
6803 | (interactive "e") | |
6804 | (mouse-set-point ev) | |
6805 | (org-open-at-point 'in-emacs)) | |
7d58338e | 6806 | |
20908596 CD |
6807 | (defun org-open-at-mouse (ev) |
6808 | "Open file link or URL at mouse." | |
6809 | (interactive "e") | |
6810 | (mouse-set-point ev) | |
ce4fdcb9 CD |
6811 | (if (eq major-mode 'org-agenda-mode) |
6812 | (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) | |
20908596 | 6813 | (org-open-at-point)) |
38f8646b | 6814 | |
20908596 CD |
6815 | (defvar org-window-config-before-follow-link nil |
6816 | "The window configuration before following a link. | |
6817 | This is saved in case the need arises to restore it.") | |
38f8646b | 6818 | |
20908596 CD |
6819 | (defvar org-open-link-marker (make-marker) |
6820 | "Marker pointing to the location where `org-open-at-point; was called.") | |
6821 | ||
6822 | ;;;###autoload | |
6823 | (defun org-open-at-point-global () | |
6824 | "Follow a link like Org-mode does. | |
6825 | This command can be called in any mode to follow a link that has | |
6826 | Org-mode syntax." | |
6827 | (interactive) | |
6828 | (org-run-like-in-org-mode 'org-open-at-point)) | |
6829 | ||
6830 | ;;;###autoload | |
6831 | (defun org-open-link-from-string (s &optional arg) | |
6832 | "Open a link in the string S, as if it was in Org-mode." | |
6833 | (interactive "sLink: \nP") | |
6834 | (with-temp-buffer | |
6835 | (let ((org-inhibit-startup t)) | |
6836 | (org-mode) | |
6837 | (insert s) | |
6838 | (goto-char (point-min)) | |
6839 | (org-open-at-point arg)))) | |
6840 | ||
6841 | (defun org-open-at-point (&optional in-emacs) | |
6842 | "Open link at or after point. | |
6843 | If there is no link at point, this function will search forward up to | |
6844 | the end of the current subtree. | |
6845 | Normally, files will be opened by an appropriate application. If the | |
93b62de8 CD |
6846 | optional argument IN-EMACS is non-nil, Emacs will visit the file. |
6847 | With a double prefix argument, try to open outside of Emacs, in the | |
6848 | application the system uses for this file type." | |
20908596 CD |
6849 | (interactive "P") |
6850 | (org-load-modules-maybe) | |
6851 | (move-marker org-open-link-marker (point)) | |
6852 | (setq org-window-config-before-follow-link (current-window-configuration)) | |
6853 | (org-remove-occur-highlights nil nil t) | |
6854 | (if (org-at-timestamp-p t) | |
6855 | (org-follow-timestamp-link) | |
6856 | (let (type path link line search (pos (point))) | |
6857 | (catch 'match | |
6858 | (save-excursion | |
6859 | (skip-chars-forward "^]\n\r") | |
6860 | (when (org-in-regexp org-bracket-link-regexp) | |
2c3ad40d CD |
6861 | (setq link (org-extract-attributes |
6862 | (org-link-unescape (org-match-string-no-properties 1)))) | |
20908596 CD |
6863 | (while (string-match " *\n *" link) |
6864 | (setq link (replace-match " " t t link))) | |
6865 | (setq link (org-link-expand-abbrev link)) | |
2c3ad40d CD |
6866 | (cond |
6867 | ((or (file-name-absolute-p link) | |
6868 | (string-match "^\\.\\.?/" link)) | |
6869 | (setq type "file" path link)) | |
ce4fdcb9 | 6870 | ((string-match org-link-re-with-space3 link) |
2c3ad40d CD |
6871 | (setq type (match-string 1 link) path (match-string 2 link))) |
6872 | (t (setq type "thisfile" path link))) | |
20908596 | 6873 | (throw 'match t))) |
8c6fb58b | 6874 | |
20908596 CD |
6875 | (when (get-text-property (point) 'org-linked-text) |
6876 | (setq type "thisfile" | |
6877 | pos (if (get-text-property (1+ (point)) 'org-linked-text) | |
6878 | (1+ (point)) (point)) | |
6879 | path (buffer-substring | |
6880 | (previous-single-property-change pos 'org-linked-text) | |
6881 | (next-single-property-change pos 'org-linked-text))) | |
6882 | (throw 'match t)) | |
8c6fb58b | 6883 | |
20908596 CD |
6884 | (save-excursion |
6885 | (when (or (org-in-regexp org-angle-link-re) | |
6886 | (org-in-regexp org-plain-link-re)) | |
6887 | (setq type (match-string 1) path (match-string 2)) | |
6888 | (throw 'match t))) | |
6889 | (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") | |
6890 | (setq type "tree-match" | |
6891 | path (match-string 1)) | |
6892 | (throw 'match t)) | |
6893 | (save-excursion | |
6894 | (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) | |
6895 | (setq type "tags" | |
6896 | path (match-string 1)) | |
6897 | (while (string-match ":" path) | |
6898 | (setq path (replace-match "+" t t path))) | |
6899 | (throw 'match t)))) | |
6900 | (unless path | |
6901 | (error "No link found")) | |
6902 | ;; Remove any trailing spaces in path | |
6903 | (if (string-match " +\\'" path) | |
6904 | (setq path (replace-match "" t t path))) | |
ce4fdcb9 CD |
6905 | (if (and org-link-translation-function |
6906 | (fboundp org-link-translation-function)) | |
6907 | ;; Check if we need to translate the link | |
6908 | (let ((tmp (funcall org-link-translation-function type path))) | |
6909 | (setq type (car tmp) path (cdr tmp)))) | |
fbe6c10d | 6910 | |
20908596 | 6911 | (cond |
38f8646b | 6912 | |
20908596 CD |
6913 | ((assoc type org-link-protocols) |
6914 | (funcall (nth 1 (assoc type org-link-protocols)) path)) | |
38f8646b | 6915 | |
20908596 CD |
6916 | ((equal type "mailto") |
6917 | (let ((cmd (car org-link-mailto-program)) | |
6918 | (args (cdr org-link-mailto-program)) args1 | |
6919 | (address path) (subject "") a) | |
6920 | (if (string-match "\\(.*\\)::\\(.*\\)" path) | |
6921 | (setq address (match-string 1 path) | |
6922 | subject (org-link-escape (match-string 2 path)))) | |
6923 | (while args | |
6924 | (cond | |
6925 | ((not (stringp (car args))) (push (pop args) args1)) | |
6926 | (t (setq a (pop args)) | |
6927 | (if (string-match "%a" a) | |
6928 | (setq a (replace-match address t t a))) | |
6929 | (if (string-match "%s" a) | |
6930 | (setq a (replace-match subject t t a))) | |
6931 | (push a args1)))) | |
6932 | (apply cmd (nreverse args1)))) | |
03f3cf35 | 6933 | |
20908596 CD |
6934 | ((member type '("http" "https" "ftp" "news")) |
6935 | (browse-url (concat type ":" (org-link-escape | |
6936 | path org-link-escape-chars-browser)))) | |
03f3cf35 | 6937 | |
20908596 CD |
6938 | ((member type '("message")) |
6939 | (browse-url (concat type ":" path))) | |
03f3cf35 | 6940 | |
20908596 CD |
6941 | ((string= type "tags") |
6942 | (org-tags-view in-emacs path)) | |
6943 | ((string= type "thisfile") | |
6944 | (if in-emacs | |
6945 | (switch-to-buffer-other-window | |
6946 | (org-get-buffer-for-internal-link (current-buffer))) | |
6947 | (org-mark-ring-push)) | |
6948 | (let ((cmd `(org-link-search | |
6949 | ,path | |
6950 | ,(cond ((equal in-emacs '(4)) 'occur) | |
6951 | ((equal in-emacs '(16)) 'org-occur) | |
6952 | (t nil)) | |
6953 | ,pos))) | |
6954 | (condition-case nil (eval cmd) | |
6955 | (error (progn (widen) (eval cmd)))))) | |
38f8646b | 6956 | |
20908596 CD |
6957 | ((string= type "tree-match") |
6958 | (org-occur (concat "\\[" (regexp-quote path) "\\]"))) | |
fbe6c10d | 6959 | |
20908596 CD |
6960 | ((string= type "file") |
6961 | (if (string-match "::\\([0-9]+\\)\\'" path) | |
6962 | (setq line (string-to-number (match-string 1 path)) | |
6963 | path (substring path 0 (match-beginning 0))) | |
6964 | (if (string-match "::\\(.+\\)\\'" path) | |
6965 | (setq search (match-string 1 path) | |
6966 | path (substring path 0 (match-beginning 0))))) | |
6967 | (if (string-match "[*?{]" (file-name-nondirectory path)) | |
6968 | (dired path) | |
6969 | (org-open-file path in-emacs line search))) | |
6970 | ||
6971 | ((string= type "news") | |
6972 | (require 'org-gnus) | |
6973 | (org-gnus-follow-link path)) | |
6974 | ||
6975 | ((string= type "shell") | |
6976 | (let ((cmd path)) | |
6977 | (if (or (not org-confirm-shell-link-function) | |
6978 | (funcall org-confirm-shell-link-function | |
6979 | (format "Execute \"%s\" in shell? " | |
6980 | (org-add-props cmd nil | |
6981 | 'face 'org-warning)))) | |
15841868 | 6982 | (progn |
20908596 CD |
6983 | (message "Executing %s" cmd) |
6984 | (shell-command cmd)) | |
6985 | (error "Abort")))) | |
15841868 | 6986 | |
20908596 CD |
6987 | ((string= type "elisp") |
6988 | (let ((cmd path)) | |
6989 | (if (or (not org-confirm-elisp-link-function) | |
6990 | (funcall org-confirm-elisp-link-function | |
6991 | (format "Execute \"%s\" as elisp? " | |
6992 | (org-add-props cmd nil | |
6993 | 'face 'org-warning)))) | |
ff4be292 | 6994 | (message "%s => %s" cmd |
ce4fdcb9 CD |
6995 | (if (equal (string-to-char cmd) ?\() |
6996 | (eval (read cmd)) | |
6997 | (call-interactively (read cmd)))) | |
20908596 | 6998 | (error "Abort")))) |
03f3cf35 | 6999 | |
20908596 CD |
7000 | (t |
7001 | (browse-url-at-point))))) | |
7002 | (move-marker org-open-link-marker nil) | |
7003 | (run-hook-with-args 'org-follow-link-hook)) | |
fbe6c10d | 7004 | |
20908596 | 7005 | ;;;; Time estimates |
fbe6c10d | 7006 | |
20908596 CD |
7007 | (defun org-get-effort (&optional pom) |
7008 | "Get the effort estimate for the current entry." | |
7009 | (org-entry-get pom org-effort-property)) | |
2a57416f | 7010 | |
20908596 | 7011 | ;;; File search |
38f8646b | 7012 | |
20908596 CD |
7013 | (defvar org-create-file-search-functions nil |
7014 | "List of functions to construct the right search string for a file link. | |
7015 | These functions are called in turn with point at the location to | |
7016 | which the link should point. | |
03f3cf35 | 7017 | |
20908596 CD |
7018 | A function in the hook should first test if it would like to |
7019 | handle this file type, for example by checking the major-mode or | |
7020 | the file extension. If it decides not to handle this file, it | |
7021 | should just return nil to give other functions a chance. If it | |
7022 | does handle the file, it must return the search string to be used | |
7023 | when following the link. The search string will be part of the | |
7024 | file link, given after a double colon, and `org-open-at-point' | |
7025 | will automatically search for it. If special measures must be | |
7026 | taken to make the search successful, another function should be | |
7027 | added to the companion hook `org-execute-file-search-functions', | |
7028 | which see. | |
7d58338e | 7029 | |
20908596 CD |
7030 | A function in this hook may also use `setq' to set the variable |
7031 | `description' to provide a suggestion for the descriptive text to | |
7032 | be used for this link when it gets inserted into an Org-mode | |
7033 | buffer with \\[org-insert-link].") | |
7034 | ||
7035 | (defvar org-execute-file-search-functions nil | |
7036 | "List of functions to execute a file search triggered by a link. | |
7037 | ||
7038 | Functions added to this hook must accept a single argument, the | |
7039 | search string that was part of the file link, the part after the | |
7040 | double colon. The function must first check if it would like to | |
7041 | handle this search, for example by checking the major-mode or the | |
7042 | file extension. If it decides not to handle this search, it | |
7043 | should just return nil to give other functions a chance. If it | |
7044 | does handle the search, it must return a non-nil value to keep | |
7045 | other functions from trying. | |
7046 | ||
7047 | Each function can access the current prefix argument through the | |
7048 | variable `current-prefix-argument'. Note that a single prefix is | |
7049 | used to force opening a link in Emacs, so it may be good to only | |
7050 | use a numeric or double prefix to guide the search function. | |
7051 | ||
7052 | In case this is needed, a function in this hook can also restore | |
7053 | the window configuration before `org-open-at-point' was called using: | |
7054 | ||
7055 | (set-window-configuration org-window-config-before-follow-link)") | |
7056 | ||
7057 | (defun org-link-search (s &optional type avoid-pos) | |
7058 | "Search for a link search option. | |
7059 | If S is surrounded by forward slashes, it is interpreted as a | |
7060 | regular expression. In org-mode files, this will create an `org-occur' | |
7061 | sparse tree. In ordinary files, `occur' will be used to list matches. | |
7062 | If the current buffer is in `dired-mode', grep will be used to search | |
7063 | in all files. If AVOID-POS is given, ignore matches near that position." | |
7064 | (let ((case-fold-search t) | |
7065 | (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) | |
7066 | (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) | |
7067 | (append '(("") (" ") ("\t") ("\n")) | |
7068 | org-emphasis-alist) | |
7069 | "\\|") "\\)")) | |
7070 | (pos (point)) | |
7071 | (pre nil) (post nil) | |
7072 | words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall) | |
7073 | (cond | |
7074 | ;; First check if there are any special | |
7075 | ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) | |
7076 | ;; Now try the builtin stuff | |
7077 | ((save-excursion | |
7078 | (goto-char (point-min)) | |
7079 | (and | |
7080 | (re-search-forward | |
7081 | (concat "<<" (regexp-quote s0) ">>") nil t) | |
7082 | (setq type 'dedicated | |
7083 | pos (match-beginning 0)))) | |
7084 | ;; There is an exact target for this | |
7085 | (goto-char pos)) | |
7086 | ((string-match "^/\\(.*\\)/$" s) | |
7087 | ;; A regular expression | |
7088 | (cond | |
7089 | ((org-mode-p) | |
7090 | (org-occur (match-string 1 s))) | |
7091 | ;;((eq major-mode 'dired-mode) | |
7092 | ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) | |
7093 | (t (org-do-occur (match-string 1 s))))) | |
7094 | (t | |
7095 | ;; A normal search strings | |
7096 | (when (equal (string-to-char s) ?*) | |
7097 | ;; Anchor on headlines, post may include tags. | |
7098 | (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" | |
7099 | post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") | |
7100 | s (substring s 1))) | |
7101 | (remove-text-properties | |
7102 | 0 (length s) | |
7103 | '(face nil mouse-face nil keymap nil fontified nil) s) | |
7104 | ;; Make a series of regular expressions to find a match | |
7105 | (setq words (org-split-string s "[ \n\r\t]+") | |
7106 | ||
7107 | re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") | |
7108 | re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") | |
7109 | "\\)" markers) | |
7110 | re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") | |
7111 | re2a (concat "[ \t\r\n]" re2a_) | |
7112 | re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") | |
7113 | re4 (concat "[^a-zA-Z_]" re4_) | |
7114 | ||
7115 | re1 (concat pre re2 post) | |
7116 | re3 (concat pre (if pre re4_ re4) post) | |
7117 | re5 (concat pre ".*" re4) | |
7118 | re2 (concat pre re2) | |
7119 | re2a (concat pre (if pre re2a_ re2a)) | |
7120 | re4 (concat pre (if pre re4_ re4)) | |
7121 | reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 | |
7122 | "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" | |
7123 | re5 "\\)" | |
7124 | )) | |
7125 | (cond | |
7126 | ((eq type 'org-occur) (org-occur reall)) | |
7127 | ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) | |
7128 | (t (goto-char (point-min)) | |
7129 | (setq type 'fuzzy) | |
7130 | (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated)) | |
7131 | (org-search-not-self 1 re1 nil t) | |
7132 | (org-search-not-self 1 re2 nil t) | |
7133 | (org-search-not-self 1 re2a nil t) | |
7134 | (org-search-not-self 1 re3 nil t) | |
7135 | (org-search-not-self 1 re4 nil t) | |
7136 | (org-search-not-self 1 re5 nil t) | |
7137 | ) | |
7138 | (goto-char (match-beginning 1)) | |
7139 | (goto-char pos) | |
7140 | (error "No match"))))) | |
7141 | (t | |
7142 | ;; Normal string-search | |
7143 | (goto-char (point-min)) | |
7144 | (if (search-forward s nil t) | |
7145 | (goto-char (match-beginning 0)) | |
7146 | (error "No match")))) | |
7147 | (and (org-mode-p) (org-show-context 'link-search)) | |
7148 | type)) | |
7149 | ||
7150 | (defun org-search-not-self (group &rest args) | |
7151 | "Execute `re-search-forward', but only accept matches that do not | |
7152 | enclose the position of `org-open-link-marker'." | |
7153 | (let ((m org-open-link-marker)) | |
7154 | (catch 'exit | |
7155 | (while (apply 're-search-forward args) | |
7156 | (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 | |
7157 | (goto-char (match-end group)) | |
7158 | (if (and (or (not (eq (marker-buffer m) (current-buffer))) | |
7159 | (> (match-beginning 0) (marker-position m)) | |
7160 | (< (match-end 0) (marker-position m))) | |
7161 | (save-match-data | |
7162 | (or (not (org-in-regexp | |
7163 | org-bracket-link-analytic-regexp 1)) | |
7164 | (not (match-end 4)) ; no description | |
7165 | (and (<= (match-beginning 4) (point)) | |
7166 | (>= (match-end 4) (point)))))) | |
7167 | (throw 'exit (point)))))))) | |
7d58338e | 7168 | |
20908596 CD |
7169 | (defun org-get-buffer-for-internal-link (buffer) |
7170 | "Return a buffer to be used for displaying the link target of internal links." | |
7171 | (cond | |
7172 | ((not org-display-internal-link-with-indirect-buffer) | |
7173 | buffer) | |
7174 | ((string-match "(Clone)$" (buffer-name buffer)) | |
7175 | (message "Buffer is already a clone, not making another one") | |
7176 | ;; we also do not modify visibility in this case | |
7177 | buffer) | |
7178 | (t ; make a new indirect buffer for displaying the link | |
7179 | (let* ((bn (buffer-name buffer)) | |
7180 | (ibn (concat bn "(Clone)")) | |
7181 | (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone)))) | |
7182 | (with-current-buffer ib (org-overview)) | |
7183 | ib)))) | |
7d58338e | 7184 | |
20908596 CD |
7185 | (defun org-do-occur (regexp &optional cleanup) |
7186 | "Call the Emacs command `occur'. | |
7187 | If CLEANUP is non-nil, remove the printout of the regular expression | |
7188 | in the *Occur* buffer. This is useful if the regex is long and not useful | |
7189 | to read." | |
7190 | (occur regexp) | |
7191 | (when cleanup | |
7192 | (let ((cwin (selected-window)) win beg end) | |
7193 | (when (setq win (get-buffer-window "*Occur*")) | |
7194 | (select-window win)) | |
7d58338e | 7195 | (goto-char (point-min)) |
20908596 CD |
7196 | (when (re-search-forward "match[a-z]+" nil t) |
7197 | (setq beg (match-end 0)) | |
7198 | (if (re-search-forward "^[ \t]*[0-9]+" nil t) | |
7199 | (setq end (1- (match-beginning 0))))) | |
7200 | (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) | |
7201 | (goto-char (point-min)) | |
7202 | (select-window cwin)))) | |
7d58338e | 7203 | |
20908596 | 7204 | ;;; The mark ring for links jumps |
48aaad2d | 7205 | |
20908596 CD |
7206 | (defvar org-mark-ring nil |
7207 | "Mark ring for positions before jumps in Org-mode.") | |
7208 | (defvar org-mark-ring-last-goto nil | |
7209 | "Last position in the mark ring used to go back.") | |
7210 | ;; Fill and close the ring | |
7211 | (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded | |
7212 | (loop for i from 1 to org-mark-ring-length do | |
7213 | (push (make-marker) org-mark-ring)) | |
7214 | (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) | |
7215 | org-mark-ring) | |
7216 | ||
7217 | (defun org-mark-ring-push (&optional pos buffer) | |
7218 | "Put the current position or POS into the mark ring and rotate it." | |
48aaad2d | 7219 | (interactive) |
20908596 CD |
7220 | (setq pos (or pos (point))) |
7221 | (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring)) | |
7222 | (move-marker (car org-mark-ring) | |
7223 | (or pos (point)) | |
7224 | (or buffer (current-buffer))) | |
7225 | (message "%s" | |
7226 | (substitute-command-keys | |
7227 | "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) | |
48aaad2d | 7228 | |
20908596 CD |
7229 | (defun org-mark-ring-goto (&optional n) |
7230 | "Jump to the previous position in the mark ring. | |
7231 | With prefix arg N, jump back that many stored positions. When | |
7232 | called several times in succession, walk through the entire ring. | |
7233 | Org-mode commands jumping to a different position in the current file, | |
7234 | or to another Org-mode file, automatically push the old position | |
7235 | onto the ring." | |
7236 | (interactive "p") | |
7237 | (let (p m) | |
7238 | (if (eq last-command this-command) | |
7239 | (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring))) | |
7240 | (setq p org-mark-ring)) | |
7241 | (setq org-mark-ring-last-goto p) | |
7242 | (setq m (car p)) | |
7243 | (switch-to-buffer (marker-buffer m)) | |
7244 | (goto-char m) | |
7245 | (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) | |
fbe6c10d | 7246 | |
20908596 CD |
7247 | (defun org-remove-angle-brackets (s) |
7248 | (if (equal (substring s 0 1) "<") (setq s (substring s 1))) | |
7249 | (if (equal (substring s -1) ">") (setq s (substring s 0 -1))) | |
7250 | s) | |
7251 | (defun org-add-angle-brackets (s) | |
7252 | (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s))) | |
7253 | (if (equal (substring s -1) ">") nil (setq s (concat s ">"))) | |
7254 | s) | |
b349f79f CD |
7255 | (defun org-remove-double-quotes (s) |
7256 | (if (equal (substring s 0 1) "\"") (setq s (substring s 1))) | |
7257 | (if (equal (substring s -1) "\"") (setq s (substring s 0 -1))) | |
7258 | s) | |
7d58338e | 7259 | |
20908596 | 7260 | ;;; Following specific links |
48aaad2d | 7261 | |
20908596 CD |
7262 | (defun org-follow-timestamp-link () |
7263 | (cond | |
7264 | ((org-at-date-range-p t) | |
7265 | (let ((org-agenda-start-on-weekday) | |
7266 | (t1 (match-string 1)) | |
7267 | (t2 (match-string 2))) | |
7268 | (setq t1 (time-to-days (org-time-string-to-time t1)) | |
7269 | t2 (time-to-days (org-time-string-to-time t2))) | |
7270 | (org-agenda-list nil t1 (1+ (- t2 t1))))) | |
7271 | ((org-at-timestamp-p t) | |
7272 | (org-agenda-list nil (time-to-days (org-time-string-to-time | |
7273 | (substring (match-string 1) 0 10))) | |
7274 | 1)) | |
7275 | (t (error "This should not happen")))) | |
48aaad2d | 7276 | |
03f3cf35 | 7277 | |
20908596 CD |
7278 | ;;; Following file links |
7279 | (defvar org-wait nil) | |
7280 | (defun org-open-file (path &optional in-emacs line search) | |
7281 | "Open the file at PATH. | |
7282 | First, this expands any special file name abbreviations. Then the | |
7283 | configuration variable `org-file-apps' is checked if it contains an | |
7284 | entry for this file type, and if yes, the corresponding command is launched. | |
93b62de8 | 7285 | |
20908596 | 7286 | If no application is found, Emacs simply visits the file. |
93b62de8 CD |
7287 | |
7288 | With optional prefix argument IN-EMACS, Emacs will visit the file. | |
7289 | With a double C-c C-u prefix arg, Org tries to avoid opening in Emacs | |
7290 | and o use an external application to visit the file. | |
7291 | ||
20908596 CD |
7292 | Optional LINE specifies a line to go to, optional SEARCH a string to |
7293 | search for. If LINE or SEARCH is given, the file will always be | |
7294 | opened in Emacs. | |
7295 | If the file does not exist, an error is thrown." | |
7296 | (setq in-emacs (or in-emacs line search)) | |
7297 | (let* ((file (if (equal path "") | |
7298 | buffer-file-name | |
7299 | (substitute-in-file-name (expand-file-name path)))) | |
7300 | (apps (append org-file-apps (org-default-apps))) | |
7301 | (remp (and (assq 'remote apps) (org-file-remote-p file))) | |
7302 | (dirp (if remp nil (file-directory-p file))) | |
2c3ad40d CD |
7303 | (file (if (and dirp org-open-directory-means-index-dot-org) |
7304 | (concat (file-name-as-directory file) "index.org") | |
7305 | file)) | |
621f83e4 | 7306 | (a-m-a-p (assq 'auto-mode apps)) |
20908596 CD |
7307 | (dfile (downcase file)) |
7308 | (old-buffer (current-buffer)) | |
7309 | (old-pos (point)) | |
7310 | (old-mode major-mode) | |
7311 | ext cmd) | |
7312 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) | |
7313 | (setq ext (match-string 1 dfile)) | |
7314 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) | |
7315 | (setq ext (match-string 1 dfile)))) | |
93b62de8 CD |
7316 | (cond |
7317 | ((equal in-emacs '(16)) | |
7318 | (setq cmd (cdr (assoc 'system apps)))) | |
7319 | (in-emacs (setq cmd 'emacs)) | |
7320 | (t | |
20908596 CD |
7321 | (setq cmd (or (and remp (cdr (assoc 'remote apps))) |
7322 | (and dirp (cdr (assoc 'directory apps))) | |
621f83e4 CD |
7323 | (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) |
7324 | 'string-match) | |
20908596 | 7325 | (cdr (assoc ext apps)) |
93b62de8 CD |
7326 | (cdr (assoc t apps)))))) |
7327 | (when (eq cmd 'system) | |
7328 | (setq cmd (cdr (assoc 'system apps)))) | |
621f83e4 CD |
7329 | (when (eq cmd 'default) |
7330 | (setq cmd (cdr (assoc t apps)))) | |
20908596 CD |
7331 | (when (eq cmd 'mailcap) |
7332 | (require 'mailcap) | |
7333 | (mailcap-parse-mailcaps) | |
7334 | (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) | |
7335 | (command (mailcap-mime-info mime-type))) | |
7336 | (if (stringp command) | |
7337 | (setq cmd command) | |
7338 | (setq cmd 'emacs)))) | |
7339 | (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files | |
7340 | (not (file-exists-p file)) | |
7341 | (not org-open-non-existing-files)) | |
7342 | (error "No such file: %s" file)) | |
7343 | (cond | |
7344 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | |
7345 | ;; Remove quotes around the file name - we'll use shell-quote-argument. | |
7346 | (while (string-match "['\"]%s['\"]" cmd) | |
7347 | (setq cmd (replace-match "%s" t t cmd))) | |
7348 | (while (string-match "%s" cmd) | |
7349 | (setq cmd (replace-match | |
b349f79f CD |
7350 | (save-match-data |
7351 | (shell-quote-argument | |
7352 | (convert-standard-filename file))) | |
20908596 CD |
7353 | t t cmd))) |
7354 | (save-window-excursion | |
7355 | (start-process-shell-command cmd nil cmd) | |
7356 | (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) | |
7357 | )) | |
7358 | ((or (stringp cmd) | |
7359 | (eq cmd 'emacs)) | |
7360 | (funcall (cdr (assq 'file org-link-frame-setup)) file) | |
7361 | (widen) | |
7362 | (if line (goto-line line) | |
7363 | (if search (org-link-search search)))) | |
7364 | ((consp cmd) | |
b349f79f CD |
7365 | (let ((file (convert-standard-filename file))) |
7366 | (eval cmd))) | |
20908596 CD |
7367 | (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) |
7368 | (and (org-mode-p) (eq old-mode 'org-mode) | |
7369 | (or (not (equal old-buffer (current-buffer))) | |
7370 | (not (equal old-pos (point)))) | |
7371 | (org-mark-ring-push old-pos old-buffer)))) | |
38f8646b | 7372 | |
20908596 CD |
7373 | (defun org-default-apps () |
7374 | "Return the default applications for this operating system." | |
7375 | (cond | |
7376 | ((eq system-type 'darwin) | |
7377 | org-file-apps-defaults-macosx) | |
7378 | ((eq system-type 'windows-nt) | |
7379 | org-file-apps-defaults-windowsnt) | |
7380 | (t org-file-apps-defaults-gnu))) | |
38f8646b | 7381 | |
621f83e4 CD |
7382 | (defun org-apps-regexp-alist (list &optional add-auto-mode) |
7383 | "Convert extensions to regular expressions in the cars of LIST. | |
7384 | Also, weed out any non-string entries, because the return value is used | |
7385 | only for regexp matching. | |
7386 | When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist' | |
7387 | point to the symbol `emacs', indicating that the file should | |
7388 | be opened in Emacs." | |
7389 | (append | |
7390 | (delq nil | |
7391 | (mapcar (lambda (x) | |
7392 | (if (not (stringp (car x))) | |
7393 | nil | |
7394 | (if (string-match "\\W" (car x)) | |
7395 | x | |
7396 | (cons (concat "\\." (car x) "\\'") (cdr x))))) | |
7397 | list)) | |
7398 | (if add-auto-mode | |
7399 | (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) | |
7400 | ||
20908596 CD |
7401 | (defvar ange-ftp-name-format) ; to silence the XEmacs compiler. |
7402 | (defun org-file-remote-p (file) | |
7403 | "Test whether FILE specifies a location on a remote system. | |
7404 | Return non-nil if the location is indeed remote. | |
38f8646b | 7405 | |
20908596 CD |
7406 | For example, the filename \"/user@host:/foo\" specifies a location |
7407 | on the system \"/user@host:\"." | |
7408 | (cond ((fboundp 'file-remote-p) | |
7409 | (file-remote-p file)) | |
7410 | ((fboundp 'tramp-handle-file-remote-p) | |
7411 | (tramp-handle-file-remote-p file)) | |
7412 | ((and (boundp 'ange-ftp-name-format) | |
7413 | (string-match (car ange-ftp-name-format) file)) | |
7414 | t) | |
7415 | (t nil))) | |
03f3cf35 | 7416 | |
03f3cf35 | 7417 | |
20908596 | 7418 | ;;;; Refiling |
7d58338e | 7419 | |
20908596 CD |
7420 | (defun org-get-org-file () |
7421 | "Read a filename, with default directory `org-directory'." | |
7422 | (let ((default (or org-default-notes-file remember-data-file))) | |
7423 | (read-file-name (format "File name [%s]: " default) | |
7424 | (file-name-as-directory org-directory) | |
7425 | default))) | |
7d58338e | 7426 | |
20908596 CD |
7427 | (defun org-notes-order-reversed-p () |
7428 | "Check if the current file should receive notes in reversed order." | |
7d58338e | 7429 | (cond |
20908596 CD |
7430 | ((not org-reverse-note-order) nil) |
7431 | ((eq t org-reverse-note-order) t) | |
7432 | ((not (listp org-reverse-note-order)) nil) | |
7433 | (t (catch 'exit | |
7434 | (let ((all org-reverse-note-order) | |
7435 | entry) | |
7436 | (while (setq entry (pop all)) | |
7437 | (if (string-match (car entry) buffer-file-name) | |
7438 | (throw 'exit (cdr entry)))) | |
7439 | nil))))) | |
38f8646b | 7440 | |
20908596 CD |
7441 | (defvar org-refile-target-table nil |
7442 | "The list of refile targets, created by `org-refile'.") | |
fbe6c10d | 7443 | |
20908596 CD |
7444 | (defvar org-agenda-new-buffers nil |
7445 | "Buffers created to visit agenda files.") | |
03f3cf35 | 7446 | |
20908596 CD |
7447 | (defun org-get-refile-targets (&optional default-buffer) |
7448 | "Produce a table with refile targets." | |
7449 | (let ((entries (or org-refile-targets '((nil . (:level . 1))))) | |
7450 | targets txt re files f desc descre) | |
7451 | (with-current-buffer (or default-buffer (current-buffer)) | |
7452 | (while (setq entry (pop entries)) | |
7453 | (setq files (car entry) desc (cdr entry)) | |
7454 | (cond | |
7455 | ((null files) (setq files (list (current-buffer)))) | |
7456 | ((eq files 'org-agenda-files) | |
7457 | (setq files (org-agenda-files 'unrestricted))) | |
7458 | ((and (symbolp files) (fboundp files)) | |
7459 | (setq files (funcall files))) | |
7460 | ((and (symbolp files) (boundp files)) | |
7461 | (setq files (symbol-value files)))) | |
7462 | (if (stringp files) (setq files (list files))) | |
7463 | (cond | |
7464 | ((eq (car desc) :tag) | |
7465 | (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) | |
7466 | ((eq (car desc) :todo) | |
7467 | (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) | |
7468 | ((eq (car desc) :regexp) | |
7469 | (setq descre (cdr desc))) | |
7470 | ((eq (car desc) :level) | |
7471 | (setq descre (concat "^\\*\\{" (number-to-string | |
7472 | (if org-odd-levels-only | |
7473 | (1- (* 2 (cdr desc))) | |
7474 | (cdr desc))) | |
7475 | "\\}[ \t]"))) | |
7476 | ((eq (car desc) :maxlevel) | |
7477 | (setq descre (concat "^\\*\\{1," (number-to-string | |
7478 | (if org-odd-levels-only | |
7479 | (1- (* 2 (cdr desc))) | |
7480 | (cdr desc))) | |
7481 | "\\}[ \t]"))) | |
7482 | (t (error "Bad refiling target description %s" desc))) | |
7483 | (while (setq f (pop files)) | |
7484 | (save-excursion | |
7485 | (set-buffer (if (bufferp f) f (org-get-agenda-file-buffer f))) | |
7486 | (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) | |
7487 | (save-excursion | |
7488 | (save-restriction | |
7489 | (widen) | |
7490 | (goto-char (point-min)) | |
7491 | (while (re-search-forward descre nil t) | |
7492 | (goto-char (point-at-bol)) | |
7493 | (when (looking-at org-complex-heading-regexp) | |
621f83e4 | 7494 | (setq txt (org-link-display-format (match-string 4)) |
20908596 CD |
7495 | re (concat "^" (regexp-quote |
7496 | (buffer-substring (match-beginning 1) | |
7497 | (match-end 4))))) | |
7498 | (if (match-end 5) (setq re (concat re "[ \t]+" | |
7499 | (regexp-quote | |
7500 | (match-string 5))))) | |
7501 | (setq re (concat re "[ \t]*$")) | |
7502 | (when org-refile-use-outline-path | |
621f83e4 | 7503 | (setq txt (mapconcat 'org-protect-slash |
20908596 CD |
7504 | (append |
7505 | (if (eq org-refile-use-outline-path 'file) | |
7506 | (list (file-name-nondirectory | |
7507 | (buffer-file-name (buffer-base-buffer)))) | |
7508 | (if (eq org-refile-use-outline-path 'full-file-path) | |
7509 | (list (buffer-file-name (buffer-base-buffer))))) | |
7510 | (org-get-outline-path) | |
7511 | (list txt)) | |
7512 | "/"))) | |
7513 | (push (list txt f re (point)) targets)) | |
7514 | (goto-char (point-at-eol)))))))) | |
7515 | (nreverse targets)))) | |
7516 | ||
621f83e4 CD |
7517 | (defun org-protect-slash (s) |
7518 | (while (string-match "/" s) | |
7519 | (setq s (replace-match "\\" t t s))) | |
7520 | s) | |
ce4fdcb9 | 7521 | |
20908596 CD |
7522 | (defun org-get-outline-path () |
7523 | "Return the outline path to the current entry, as a list." | |
7524 | (let (rtn) | |
38f8646b | 7525 | (save-excursion |
20908596 CD |
7526 | (while (org-up-heading-safe) |
7527 | (when (looking-at org-complex-heading-regexp) | |
7528 | (push (org-match-string-no-properties 4) rtn))) | |
7529 | rtn))) | |
7d58338e | 7530 | |
20908596 CD |
7531 | (defvar org-refile-history nil |
7532 | "History for refiling operations.") | |
7d58338e | 7533 | |
20908596 CD |
7534 | (defun org-refile (&optional goto default-buffer) |
7535 | "Move the entry at point to another heading. | |
7536 | The list of target headings is compiled using the information in | |
7537 | `org-refile-targets', which see. This list is created before each use | |
7538 | and will therefore always be up-to-date. | |
7539 | ||
7540 | At the target location, the entry is filed as a subitem of the target heading. | |
7541 | Depending on `org-reverse-note-order', the new subitem will either be the | |
71d35b24 | 7542 | first or the last subitem. |
20908596 | 7543 | |
93b62de8 CD |
7544 | If there is an active region, all entries in that region will be moved. |
7545 | However, the region must fulfil the requirement that the first heading | |
7546 | is the first one sets the top-level of the moved text - at most siblings | |
7547 | below it are allowed. | |
7548 | ||
20908596 CD |
7549 | With prefix arg GOTO, the command will only visit the target location, |
7550 | not actually move anything. | |
621f83e4 | 7551 | With a double prefix `C-u C-u', go to the location where the last refiling |
20908596 CD |
7552 | operation has put the subtree." |
7553 | (interactive "P") | |
7554 | (let* ((cbuf (current-buffer)) | |
93b62de8 CD |
7555 | (regionp (org-region-active-p)) |
7556 | (region-start (and regionp (region-beginning))) | |
7557 | (region-end (and regionp (region-end))) | |
7558 | (region-length (and regionp (- region-end region-start))) | |
20908596 CD |
7559 | (filename (buffer-file-name (buffer-base-buffer cbuf))) |
7560 | pos it nbuf file re level reversed) | |
93b62de8 CD |
7561 | (when regionp (goto-char region-start) |
7562 | (unless (org-kill-is-subtree-p | |
7563 | (buffer-substring region-start region-end)) | |
7564 | (error "The region is not a (sequence of) subtree(s)"))) | |
20908596 CD |
7565 | (if (equal goto '(16)) |
7566 | (org-refile-goto-last-stored) | |
7567 | (when (setq it (org-refile-get-location | |
7568 | (if goto "Goto: " "Refile to: ") default-buffer)) | |
7569 | (setq file (nth 1 it) | |
7570 | re (nth 2 it) | |
7571 | pos (nth 3 it)) | |
7572 | (setq nbuf (or (find-buffer-visiting file) | |
7573 | (find-file-noselect file))) | |
7574 | (if goto | |
7575 | (progn | |
7576 | (switch-to-buffer nbuf) | |
7577 | (goto-char pos) | |
7578 | (org-show-context 'org-goto)) | |
93b62de8 CD |
7579 | (if regionp |
7580 | (progn | |
7581 | (kill-new (buffer-substring region-start region-end)) | |
7582 | (org-save-markers-in-region region-start region-end)) | |
7583 | (org-copy-subtree 1 nil t)) | |
20908596 CD |
7584 | (save-excursion |
7585 | (set-buffer (setq nbuf (or (find-buffer-visiting file) | |
7586 | (find-file-noselect file)))) | |
7587 | (setq reversed (org-notes-order-reversed-p)) | |
7588 | (save-excursion | |
7589 | (save-restriction | |
7590 | (widen) | |
7591 | (goto-char pos) | |
7592 | (looking-at outline-regexp) | |
7593 | (setq level (org-get-valid-level (funcall outline-level) 1)) | |
7594 | (goto-char | |
7595 | (if reversed | |
621f83e4 | 7596 | (or (outline-next-heading) (point-max)) |
20908596 CD |
7597 | (or (save-excursion (outline-get-next-sibling)) |
7598 | (org-end-of-subtree t t) | |
7599 | (point-max)))) | |
621f83e4 | 7600 | (if (not (bolp)) (newline)) |
20908596 CD |
7601 | (bookmark-set "org-refile-last-stored") |
7602 | (org-paste-subtree level)))) | |
93b62de8 CD |
7603 | (if regionp |
7604 | (delete-region (point) (+ (point) region-length)) | |
7605 | (org-cut-subtree)) | |
b349f79f | 7606 | (setq org-markers-to-move nil) |
93b62de8 | 7607 | (message "Refiled to \"%s\"" (car it))))))) |
20908596 CD |
7608 | |
7609 | (defun org-refile-goto-last-stored () | |
7610 | "Go to the location where the last refile was stored." | |
38f8646b | 7611 | (interactive) |
20908596 CD |
7612 | (bookmark-jump "org-refile-last-stored") |
7613 | (message "This is the location of the last refile")) | |
38f8646b | 7614 | |
20908596 CD |
7615 | (defun org-refile-get-location (&optional prompt default-buffer) |
7616 | "Prompt the user for a refile location, using PROMPT." | |
7617 | (let ((org-refile-targets org-refile-targets) | |
7618 | (org-refile-use-outline-path org-refile-use-outline-path)) | |
7619 | (setq org-refile-target-table (org-get-refile-targets default-buffer))) | |
7620 | (unless org-refile-target-table | |
7621 | (error "No refile targets")) | |
7622 | (let* ((cbuf (current-buffer)) | |
d60b1ba1 CD |
7623 | (cfunc (if (and org-refile-use-outline-path |
7624 | org-outline-path-complete-in-steps) | |
b349f79f | 7625 | 'org-olpath-completing-read |
ce4fdcb9 | 7626 | 'org-ido-completing-read)) |
b349f79f | 7627 | (extra (if org-refile-use-outline-path "/" "")) |
20908596 CD |
7628 | (filename (buffer-file-name (buffer-base-buffer cbuf))) |
7629 | (fname (and filename (file-truename filename))) | |
7630 | (tbl (mapcar | |
7631 | (lambda (x) | |
7632 | (if (not (equal fname (file-truename (nth 1 x)))) | |
b349f79f CD |
7633 | (cons (concat (car x) extra " (" |
7634 | (file-name-nondirectory (nth 1 x)) ")") | |
20908596 | 7635 | (cdr x)) |
b349f79f | 7636 | (cons (concat (car x) extra) (cdr x)))) |
20908596 CD |
7637 | org-refile-target-table)) |
7638 | (completion-ignore-case t)) | |
b349f79f | 7639 | (assoc (funcall cfunc prompt tbl nil t nil 'org-refile-history) |
20908596 | 7640 | tbl))) |
7d58338e | 7641 | |
b349f79f CD |
7642 | (defun org-olpath-completing-read (prompt collection &rest args) |
7643 | "Read an outline path like a file name." | |
7644 | (let ((thetable collection)) | |
ce4fdcb9 CD |
7645 | (apply |
7646 | 'org-ido-completing-read prompt | |
b349f79f CD |
7647 | (lambda (string predicate &optional flag) |
7648 | (let (rtn r s f (l (length string))) | |
7649 | (cond | |
7650 | ((eq flag nil) | |
7651 | ;; try completion | |
7652 | (try-completion string thetable)) | |
7653 | ((eq flag t) | |
7654 | ;; all-completions | |
7655 | (setq rtn (all-completions string thetable predicate)) | |
7656 | (mapcar | |
7657 | (lambda (x) | |
7658 | (setq r (substring x l)) | |
7659 | (if (string-match " ([^)]*)$" x) | |
7660 | (setq f (match-string 0 x)) | |
7661 | (setq f "")) | |
7662 | (if (string-match "/" r) | |
7663 | (concat string (substring r 0 (match-end 0)) f) | |
7664 | x)) | |
7665 | rtn)) | |
7666 | ((eq flag 'lambda) | |
7667 | ;; exact match? | |
7668 | (assoc string thetable))) | |
7669 | )) | |
7670 | args))) | |
7671 | ||
20908596 CD |
7672 | ;;;; Dynamic blocks |
7673 | ||
7674 | (defun org-find-dblock (name) | |
7675 | "Find the first dynamic block with name NAME in the buffer. | |
7676 | If not found, stay at current position and return nil." | |
7677 | (let (pos) | |
7d58338e | 7678 | (save-excursion |
03f3cf35 | 7679 | (goto-char (point-min)) |
20908596 CD |
7680 | (setq pos (and (re-search-forward (concat "^#\\+BEGIN:[ \t]+" name "\\>") |
7681 | nil t) | |
7682 | (match-beginning 0)))) | |
7683 | (if pos (goto-char pos)) | |
7684 | pos)) | |
4b3a9ba7 | 7685 | |
20908596 CD |
7686 | (defconst org-dblock-start-re |
7687 | "^#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" | |
7688 | "Matches the startline of a dynamic block, with parameters.") | |
891f4676 | 7689 | |
20908596 CD |
7690 | (defconst org-dblock-end-re "^#\\+END\\([: \t\r\n]\\|$\\)" |
7691 | "Matches the end of a dyhamic block.") | |
8c6fb58b | 7692 | |
20908596 CD |
7693 | (defun org-create-dblock (plist) |
7694 | "Create a dynamic block section, with parameters taken from PLIST. | |
7695 | PLIST must containe a :name entry which is used as name of the block." | |
7696 | (unless (bolp) (newline)) | |
7697 | (let ((name (plist-get plist :name))) | |
7698 | (insert "#+BEGIN: " name) | |
7699 | (while plist | |
7700 | (if (eq (car plist) :name) | |
7701 | (setq plist (cddr plist)) | |
7702 | (insert " " (prin1-to-string (pop plist))))) | |
7703 | (insert "\n\n#+END:\n") | |
7704 | (beginning-of-line -2))) | |
891f4676 | 7705 | |
20908596 CD |
7706 | (defun org-prepare-dblock () |
7707 | "Prepare dynamic block for refresh. | |
7708 | This empties the block, puts the cursor at the insert position and returns | |
7709 | the property list including an extra property :name with the block name." | |
7710 | (unless (looking-at org-dblock-start-re) | |
7711 | (error "Not at a dynamic block")) | |
7712 | (let* ((begdel (1+ (match-end 0))) | |
7713 | (name (org-no-properties (match-string 1))) | |
7714 | (params (append (list :name name) | |
7715 | (read (concat "(" (match-string 3) ")"))))) | |
7716 | (unless (re-search-forward org-dblock-end-re nil t) | |
7717 | (error "Dynamic block not terminated")) | |
7718 | (setq params | |
7719 | (append params | |
7720 | (list :content (buffer-substring | |
7721 | begdel (match-beginning 0))))) | |
7722 | (delete-region begdel (match-beginning 0)) | |
7723 | (goto-char begdel) | |
7724 | (open-line 1) | |
7725 | params)) | |
891f4676 | 7726 | |
20908596 CD |
7727 | (defun org-map-dblocks (&optional command) |
7728 | "Apply COMMAND to all dynamic blocks in the current buffer. | |
7729 | If COMMAND is not given, use `org-update-dblock'." | |
7730 | (let ((cmd (or command 'org-update-dblock)) | |
7731 | pos) | |
7732 | (save-excursion | |
7733 | (goto-char (point-min)) | |
7734 | (while (re-search-forward org-dblock-start-re nil t) | |
7735 | (goto-char (setq pos (match-beginning 0))) | |
7736 | (condition-case nil | |
7737 | (funcall cmd) | |
7738 | (error (message "Error during update of dynamic block"))) | |
7739 | (goto-char pos) | |
7740 | (unless (re-search-forward org-dblock-end-re nil t) | |
7741 | (error "Dynamic block not terminated")))))) | |
891f4676 | 7742 | |
20908596 CD |
7743 | (defun org-dblock-update (&optional arg) |
7744 | "User command for updating dynamic blocks. | |
7745 | Update the dynamic block at point. With prefix ARG, update all dynamic | |
7746 | blocks in the buffer." | |
7747 | (interactive "P") | |
7748 | (if arg | |
7749 | (org-update-all-dblocks) | |
7750 | (or (looking-at org-dblock-start-re) | |
7751 | (org-beginning-of-dblock)) | |
7752 | (org-update-dblock))) | |
8c6fb58b | 7753 | |
20908596 CD |
7754 | (defun org-update-dblock () |
7755 | "Update the dynamic block at point | |
7756 | This means to empty the block, parse for parameters and then call | |
7757 | the correct writing function." | |
7758 | (save-window-excursion | |
7759 | (let* ((pos (point)) | |
7760 | (line (org-current-line)) | |
7761 | (params (org-prepare-dblock)) | |
7762 | (name (plist-get params :name)) | |
7763 | (cmd (intern (concat "org-dblock-write:" name)))) | |
7764 | (message "Updating dynamic block `%s' at line %d..." name line) | |
7765 | (funcall cmd params) | |
7766 | (message "Updating dynamic block `%s' at line %d...done" name line) | |
7767 | (goto-char pos)))) | |
8c6fb58b | 7768 | |
20908596 CD |
7769 | (defun org-beginning-of-dblock () |
7770 | "Find the beginning of the dynamic block at point. | |
7771 | Error if there is no scuh block at point." | |
7772 | (let ((pos (point)) | |
7773 | beg) | |
7774 | (end-of-line 1) | |
7775 | (if (and (re-search-backward org-dblock-start-re nil t) | |
7776 | (setq beg (match-beginning 0)) | |
7777 | (re-search-forward org-dblock-end-re nil t) | |
7778 | (> (match-end 0) pos)) | |
7779 | (goto-char beg) | |
7780 | (goto-char pos) | |
7781 | (error "Not in a dynamic block")))) | |
03f3cf35 | 7782 | |
20908596 CD |
7783 | (defun org-update-all-dblocks () |
7784 | "Update all dynamic blocks in the buffer. | |
7785 | This function can be used in a hook." | |
7786 | (when (org-mode-p) | |
7787 | (org-map-dblocks 'org-update-dblock))) | |
03f3cf35 | 7788 | |
891f4676 | 7789 | |
20908596 | 7790 | ;;;; Completion |
891f4676 | 7791 | |
20908596 CD |
7792 | (defconst org-additional-option-like-keywords |
7793 | '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" | |
7794 | "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "TBLFM" | |
621f83e4 CD |
7795 | "BEGIN_EXAMPLE" "END_EXAMPLE" |
7796 | "BEGIN_QUOTE" "END_QUOTE" | |
7797 | "BEGIN_VERSE" "END_VERSE" | |
7798 | "BEGIN_SRC" "END_SRC")) | |
891f4676 | 7799 | |
b349f79f CD |
7800 | (defcustom org-structure-template-alist |
7801 | '( | |
ce4fdcb9 | 7802 | ("s" "#+begin_src ?\n\n#+end_src" |
b349f79f CD |
7803 | "<src lang=\"?\">\n\n</src>") |
7804 | ("e" "#+begin_example\n?\n#+end_example" | |
7805 | "<example>\n?\n</example>") | |
7806 | ("q" "#+begin_quote\n?\n#+end_quote" | |
7807 | "<quote>\n?\n</quote>") | |
7808 | ("v" "#+begin_verse\n?\n#+end_verse" | |
7809 | "<verse>\n?\n/verse>") | |
7810 | ("l" "#+begin_latex\n?\n#+end_latex" | |
7811 | "<literal style=\"latex\">\n?\n</literal>") | |
7812 | ("L" "#+latex: " | |
7813 | "<literal style=\"latex\">?</literal>") | |
7814 | ("h" "#+begin_html\n?\n#+end_html" | |
7815 | "<literal style=\"html\">\n?\n</literal>") | |
7816 | ("H" "#+html: " | |
7817 | "<literal style=\"html\">?</literal>") | |
7818 | ("a" "#+begin_ascii\n?\n#+end_ascii") | |
7819 | ("A" "#+ascii: ") | |
7820 | ("i" "#+include %file ?" | |
7821 | "<include file=%file markup=\"?\">") | |
7822 | ) | |
7823 | "Structure completion elements. | |
7824 | This is a list of abbreviation keys and values. The value gets inserted | |
7825 | it you type @samp{.} followed by the key and then the completion key, | |
7826 | usually `M-TAB'. %file will be replaced by a file name after prompting | |
7827 | for the file uning completion. | |
7828 | There are two templates for each key, the first uses the original Org syntax, | |
7829 | the second uses Emacs Muse-like syntax tags. These Muse-like tags become | |
7830 | the default when the /org-mtags.el/ module has been loaded. See also the | |
ce4fdcb9 | 7831 | variable `org-mtags-prefer-muse-templates'. |
b349f79f CD |
7832 | This is an experimental feature, it is undecided if it is going to stay in." |
7833 | :group 'org-completion | |
7834 | :type '(repeat | |
7835 | (string :tag "Key") | |
7836 | (string :tag "Template") | |
7837 | (string :tag "Muse Template"))) | |
7838 | ||
7839 | (defun org-try-structure-completion () | |
7840 | "Try to complete a structure template before point. | |
7841 | This looks for strings like \"<e\" on an otherwise empty line and | |
7842 | expands them." | |
7843 | (let ((l (buffer-substring (point-at-bol) (point))) | |
7844 | a) | |
7845 | (when (and (looking-at "[ \t]*$") | |
7846 | (string-match "^[ \t]*<\\([a-z]+\\)$"l) | |
7847 | (setq a (assoc (match-string 1 l) org-structure-template-alist))) | |
7848 | (org-complete-expand-structure-template (+ -1 (point-at-bol) | |
7849 | (match-beginning 1)) a) | |
7850 | t))) | |
7851 | ||
7852 | (defun org-complete-expand-structure-template (start cell) | |
7853 | "Expand a structure template." | |
ce4fdcb9 | 7854 | (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates)) |
b349f79f CD |
7855 | (rpl (nth (if musep 2 1) cell))) |
7856 | (delete-region start (point)) | |
7857 | (when (string-match "\\`#\\+" rpl) | |
7858 | (cond | |
7859 | ((bolp)) | |
7860 | ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) | |
7861 | (delete-region (point-at-bol) (point))) | |
7862 | (t (newline)))) | |
7863 | (setq start (point)) | |
7864 | (if (string-match "%file" rpl) | |
ce4fdcb9 | 7865 | (setq rpl (replace-match |
b349f79f CD |
7866 | (concat |
7867 | "\"" | |
7868 | (save-match-data | |
7869 | (abbreviate-file-name (read-file-name "Include file: "))) | |
7870 | "\"") | |
7871 | t t rpl))) | |
7872 | (insert rpl) | |
7873 | (if (re-search-backward "\\?" start t) (delete-char 1)))) | |
ce4fdcb9 | 7874 | |
b349f79f | 7875 | |
20908596 CD |
7876 | (defun org-complete (&optional arg) |
7877 | "Perform completion on word at point. | |
7878 | At the beginning of a headline, this completes TODO keywords as given in | |
7879 | `org-todo-keywords'. | |
7880 | If the current word is preceded by a backslash, completes the TeX symbols | |
7881 | that are supported for HTML support. | |
7882 | If the current word is preceded by \"#+\", completes special words for | |
7883 | setting file options. | |
7884 | In the line after \"#+STARTUP:, complete valid keywords.\" | |
7885 | At all other locations, this simply calls the value of | |
7886 | `org-completion-fallback-command'." | |
7887 | (interactive "P") | |
7888 | (org-without-partial-completion | |
7889 | (catch 'exit | |
b349f79f CD |
7890 | (let* ((a nil) |
7891 | (end (point)) | |
20908596 CD |
7892 | (beg1 (save-excursion |
7893 | (skip-chars-backward (org-re "[:alnum:]_@")) | |
7894 | (point))) | |
7895 | (beg (save-excursion | |
7896 | (skip-chars-backward "a-zA-Z0-9_:$") | |
7897 | (point))) | |
7898 | (confirm (lambda (x) (stringp (car x)))) | |
7899 | (searchhead (equal (char-before beg) ?*)) | |
b349f79f CD |
7900 | (struct |
7901 | (when (and (member (char-before beg1) '(?. ?<)) | |
7902 | (setq a (assoc (buffer-substring beg1 (point)) | |
7903 | org-structure-template-alist))) | |
7904 | (org-complete-expand-structure-template (1- beg1) a) | |
7905 | (throw 'exit t))) | |
20908596 CD |
7906 | (tag (and (equal (char-before beg1) ?:) |
7907 | (equal (char-after (point-at-bol)) ?*))) | |
7908 | (prop (and (equal (char-before beg1) ?:) | |
7909 | (not (equal (char-after (point-at-bol)) ?*)))) | |
7910 | (texp (equal (char-before beg) ?\\)) | |
7911 | (link (equal (char-before beg) ?\[)) | |
7912 | (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) | |
7913 | beg) | |
7914 | "#+")) | |
7915 | (startup (string-match "^#\\+STARTUP:.*" | |
7916 | (buffer-substring (point-at-bol) (point)))) | |
7917 | (completion-ignore-case opt) | |
7918 | (type nil) | |
7919 | (tbl nil) | |
7920 | (table (cond | |
7921 | (opt | |
7922 | (setq type :opt) | |
7923 | (require 'org-exp) | |
7924 | (append | |
7925 | (mapcar | |
7926 | (lambda (x) | |
7927 | (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) | |
7928 | (cons (match-string 2 x) (match-string 1 x))) | |
7929 | (org-split-string (org-get-current-options) "\n")) | |
7930 | (mapcar 'list org-additional-option-like-keywords))) | |
7931 | (startup | |
7932 | (setq type :startup) | |
7933 | org-startup-options) | |
7934 | (link (append org-link-abbrev-alist-local | |
7935 | org-link-abbrev-alist)) | |
7936 | (texp | |
7937 | (setq type :tex) | |
7938 | org-html-entities) | |
7939 | ((string-match "\\`\\*+[ \t]+\\'" | |
7940 | (buffer-substring (point-at-bol) beg)) | |
7941 | (setq type :todo) | |
7942 | (mapcar 'list org-todo-keywords-1)) | |
7943 | (searchhead | |
7944 | (setq type :searchhead) | |
7945 | (save-excursion | |
7946 | (goto-char (point-min)) | |
7947 | (while (re-search-forward org-todo-line-regexp nil t) | |
7948 | (push (list | |
7949 | (org-make-org-heading-search-string | |
7950 | (match-string 3) t)) | |
7951 | tbl))) | |
7952 | tbl) | |
7953 | (tag (setq type :tag beg beg1) | |
7954 | (or org-tag-alist (org-get-buffer-tags))) | |
7955 | (prop (setq type :prop beg beg1) | |
7956 | (mapcar 'list (org-buffer-property-keys nil t t))) | |
7957 | (t (progn | |
7958 | (call-interactively org-completion-fallback-command) | |
7959 | (throw 'exit nil))))) | |
7960 | (pattern (buffer-substring-no-properties beg end)) | |
7961 | (completion (try-completion pattern table confirm))) | |
7962 | (cond ((eq completion t) | |
7963 | (if (not (assoc (upcase pattern) table)) | |
7964 | (message "Already complete") | |
7965 | (if (and (equal type :opt) | |
7966 | (not (member (car (assoc (upcase pattern) table)) | |
7967 | org-additional-option-like-keywords))) | |
7968 | (insert (substring (cdr (assoc (upcase pattern) table)) | |
7969 | (length pattern))) | |
7970 | (if (memq type '(:tag :prop)) (insert ":"))))) | |
7971 | ((null completion) | |
7972 | (message "Can't find completion for \"%s\"" pattern) | |
7973 | (ding)) | |
7974 | ((not (string= pattern completion)) | |
7975 | (delete-region beg end) | |
7976 | (if (string-match " +$" completion) | |
7977 | (setq completion (replace-match "" t t completion))) | |
7978 | (insert completion) | |
7979 | (if (get-buffer-window "*Completions*") | |
7980 | (delete-window (get-buffer-window "*Completions*"))) | |
7981 | (if (assoc completion table) | |
7982 | (if (eq type :todo) (insert " ") | |
7983 | (if (memq type '(:tag :prop)) (insert ":")))) | |
7984 | (if (and (equal type :opt) (assoc completion table)) | |
7985 | (message "%s" (substitute-command-keys | |
7986 | "Press \\[org-complete] again to insert example settings")))) | |
7987 | (t | |
7988 | (message "Making completion list...") | |
7989 | (let ((list (sort (all-completions pattern table confirm) | |
7990 | 'string<))) | |
7991 | (with-output-to-temp-buffer "*Completions*" | |
7992 | (condition-case nil | |
7993 | ;; Protection needed for XEmacs and emacs 21 | |
7994 | (display-completion-list list pattern) | |
7995 | (error (display-completion-list list))))) | |
7996 | (message "Making completion list...%s" "done"))))))) | |
7997 | ||
7998 | ;;;; TODO, DEADLINE, Comments | |
7999 | ||
8000 | (defun org-toggle-comment () | |
8001 | "Change the COMMENT state of an entry." | |
8002 | (interactive) | |
8003 | (save-excursion | |
8004 | (org-back-to-heading) | |
8005 | (let (case-fold-search) | |
8006 | (if (looking-at (concat outline-regexp | |
8007 | "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) | |
8008 | (replace-match "" t t nil 1) | |
8009 | (if (looking-at outline-regexp) | |
8010 | (progn | |
8011 | (goto-char (match-end 0)) | |
8012 | (insert org-comment-string " "))))))) | |
8013 | ||
8014 | (defvar org-last-todo-state-is-todo nil | |
8015 | "This is non-nil when the last TODO state change led to a TODO state. | |
8016 | If the last change removed the TODO tag or switched to DONE, then | |
8017 | this is nil.") | |
8018 | ||
8019 | (defvar org-setting-tags nil) ; dynamically skiped | |
8c6fb58b | 8020 | |
20908596 CD |
8021 | (defun org-parse-local-options (string var) |
8022 | "Parse STRING for startup setting relevant for variable VAR." | |
8023 | (let ((rtn (symbol-value var)) | |
8024 | e opts) | |
8025 | (save-match-data | |
8026 | (if (or (not string) (not (string-match "\\S-" string))) | |
8027 | rtn | |
8028 | (setq opts (delq nil (mapcar (lambda (x) | |
8029 | (setq e (assoc x org-startup-options)) | |
8030 | (if (eq (nth 1 e) var) e nil)) | |
8031 | (org-split-string string "[ \t]+")))) | |
8032 | (if (not opts) | |
8033 | rtn | |
8034 | (setq rtn nil) | |
8035 | (while (setq e (pop opts)) | |
8036 | (if (not (nth 3 e)) | |
8037 | (setq rtn (nth 2 e)) | |
8038 | (if (not (listp rtn)) (setq rtn nil)) | |
8039 | (push (nth 2 e) rtn))) | |
8040 | rtn))))) | |
8c6fb58b | 8041 | |
20908596 CD |
8042 | (defvar org-blocker-hook nil |
8043 | "Hook for functions that are allowed to block a state change. | |
8c6fb58b | 8044 | |
20908596 CD |
8045 | Each function gets as its single argument a property list, see |
8046 | `org-trigger-hook' for more information about this list. | |
8c6fb58b | 8047 | |
20908596 CD |
8048 | If any of the functions in this hook returns nil, the state change |
8049 | is blocked.") | |
891f4676 | 8050 | |
20908596 CD |
8051 | (defvar org-trigger-hook nil |
8052 | "Hook for functions that are triggered by a state change. | |
891f4676 | 8053 | |
20908596 CD |
8054 | Each function gets as its single argument a property list with at least |
8055 | the following elements: | |
15841868 | 8056 | |
20908596 CD |
8057 | (:type type-of-change :position pos-at-entry-start |
8058 | :from old-state :to new-state) | |
a3fbe8c4 | 8059 | |
20908596 | 8060 | Depending on the type, more properties may be present. |
b38c6895 | 8061 | |
20908596 CD |
8062 | This mechanism is currently implemented for: |
8063 | ||
8064 | TODO state changes | |
8065 | ------------------ | |
8066 | :type todo-state-change | |
8067 | :from previous state (keyword as a string), or nil | |
8068 | :to new state (keyword as a string), or nil") | |
8069 | ||
93b62de8 | 8070 | (defvar org-agenda-headline-snapshot-before-repeat) |
20908596 CD |
8071 | (defun org-todo (&optional arg) |
8072 | "Change the TODO state of an item. | |
8073 | The state of an item is given by a keyword at the start of the heading, | |
8074 | like | |
8075 | *** TODO Write paper | |
8076 | *** DONE Call mom | |
8077 | ||
8078 | The different keywords are specified in the variable `org-todo-keywords'. | |
8079 | By default the available states are \"TODO\" and \"DONE\". | |
8080 | So for this example: when the item starts with TODO, it is changed to DONE. | |
8081 | When it starts with DONE, the DONE is removed. And when neither TODO nor | |
8082 | DONE are present, add TODO at the beginning of the heading. | |
8083 | ||
8084 | With C-u prefix arg, use completion to determine the new state. | |
8085 | With numeric prefix arg, switch to that state. | |
8086 | ||
8087 | For calling through lisp, arg is also interpreted in the following way: | |
8088 | 'none -> empty state | |
8089 | \"\"(empty string) -> switch to empty state | |
8090 | 'done -> switch to DONE | |
8091 | 'nextset -> switch to the next set of keywords | |
8092 | 'previousset -> switch to the previous set of keywords | |
8093 | \"WAITING\" -> switch to the specified keyword, but only if it | |
8094 | really is a member of `org-todo-keywords'." | |
8095 | (interactive "P") | |
8096 | (save-excursion | |
8097 | (catch 'exit | |
8098 | (org-back-to-heading) | |
8099 | (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) | |
8100 | (or (looking-at (concat " +" org-todo-regexp " *")) | |
8101 | (looking-at " *")) | |
8102 | (let* ((match-data (match-data)) | |
8103 | (startpos (point-at-bol)) | |
8104 | (logging (save-match-data (org-entry-get nil "LOGGING" t))) | |
8105 | (org-log-done org-log-done) | |
8106 | (org-log-repeat org-log-repeat) | |
8107 | (org-todo-log-states org-todo-log-states) | |
8108 | (this (match-string 1)) | |
8109 | (hl-pos (match-beginning 0)) | |
8110 | (head (org-get-todo-sequence-head this)) | |
8111 | (ass (assoc head org-todo-kwd-alist)) | |
8112 | (interpret (nth 1 ass)) | |
8113 | (done-word (nth 3 ass)) | |
8114 | (final-done-word (nth 4 ass)) | |
8115 | (last-state (or this "")) | |
8116 | (completion-ignore-case t) | |
8117 | (member (member this org-todo-keywords-1)) | |
8118 | (tail (cdr member)) | |
8119 | (state (cond | |
8120 | ((and org-todo-key-trigger | |
8121 | (or (and (equal arg '(4)) (eq org-use-fast-todo-selection 'prefix)) | |
8122 | (and (not arg) org-use-fast-todo-selection | |
8123 | (not (eq org-use-fast-todo-selection 'prefix))))) | |
8124 | ;; Use fast selection | |
8125 | (org-fast-todo-selection)) | |
8126 | ((and (equal arg '(4)) | |
8127 | (or (not org-use-fast-todo-selection) | |
8128 | (not org-todo-key-trigger))) | |
8129 | ;; Read a state with completion | |
ce4fdcb9 | 8130 | (org-ido-completing-read "State: " (mapcar (lambda(x) (list x)) |
20908596 CD |
8131 | org-todo-keywords-1) |
8132 | nil t)) | |
8133 | ((eq arg 'right) | |
8134 | (if this | |
8135 | (if tail (car tail) nil) | |
8136 | (car org-todo-keywords-1))) | |
8137 | ((eq arg 'left) | |
8138 | (if (equal member org-todo-keywords-1) | |
8139 | nil | |
8140 | (if this | |
8141 | (nth (- (length org-todo-keywords-1) (length tail) 2) | |
8142 | org-todo-keywords-1) | |
8143 | (org-last org-todo-keywords-1)))) | |
8144 | ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) | |
8145 | (setq arg nil))) ; hack to fall back to cycling | |
8146 | (arg | |
8147 | ;; user or caller requests a specific state | |
8148 | (cond | |
8149 | ((equal arg "") nil) | |
8150 | ((eq arg 'none) nil) | |
8151 | ((eq arg 'done) (or done-word (car org-done-keywords))) | |
8152 | ((eq arg 'nextset) | |
8153 | (or (car (cdr (member head org-todo-heads))) | |
8154 | (car org-todo-heads))) | |
8155 | ((eq arg 'previousset) | |
8156 | (let ((org-todo-heads (reverse org-todo-heads))) | |
8157 | (or (car (cdr (member head org-todo-heads))) | |
8158 | (car org-todo-heads)))) | |
8159 | ((car (member arg org-todo-keywords-1))) | |
8160 | ((nth (1- (prefix-numeric-value arg)) | |
8161 | org-todo-keywords-1)))) | |
8162 | ((null member) (or head (car org-todo-keywords-1))) | |
8163 | ((equal this final-done-word) nil) ;; -> make empty | |
8164 | ((null tail) nil) ;; -> first entry | |
8165 | ((eq interpret 'sequence) | |
8166 | (car tail)) | |
8167 | ((memq interpret '(type priority)) | |
8168 | (if (eq this-command last-command) | |
8169 | (car tail) | |
8170 | (if (> (length tail) 0) | |
8171 | (or done-word (car org-done-keywords)) | |
8172 | nil))) | |
8173 | (t nil))) | |
8174 | (next (if state (concat " " state " ") " ")) | |
8175 | (change-plist (list :type 'todo-state-change :from this :to state | |
8176 | :position startpos)) | |
8177 | dolog now-done-p) | |
8178 | (when org-blocker-hook | |
8179 | (unless (save-excursion | |
8180 | (save-match-data | |
8181 | (run-hook-with-args-until-failure | |
8182 | 'org-blocker-hook change-plist))) | |
8183 | (if (interactive-p) | |
8184 | (error "TODO state change from %s to %s blocked" this state) | |
8185 | ;; fail silently | |
8186 | (message "TODO state change from %s to %s blocked" this state) | |
8187 | (throw 'exit nil)))) | |
8188 | (store-match-data match-data) | |
8189 | (replace-match next t t) | |
8190 | (unless (pos-visible-in-window-p hl-pos) | |
8191 | (message "TODO state changed to %s" (org-trim next))) | |
8192 | (unless head | |
8193 | (setq head (org-get-todo-sequence-head state) | |
8194 | ass (assoc head org-todo-kwd-alist) | |
8195 | interpret (nth 1 ass) | |
8196 | done-word (nth 3 ass) | |
8197 | final-done-word (nth 4 ass))) | |
8198 | (when (memq arg '(nextset previousset)) | |
8199 | (message "Keyword-Set %d/%d: %s" | |
8200 | (- (length org-todo-sets) -1 | |
8201 | (length (memq (assoc state org-todo-sets) org-todo-sets))) | |
8202 | (length org-todo-sets) | |
8203 | (mapconcat 'identity (assoc state org-todo-sets) " "))) | |
8204 | (setq org-last-todo-state-is-todo | |
8205 | (not (member state org-done-keywords))) | |
8206 | (setq now-done-p (and (member state org-done-keywords) | |
8207 | (not (member this org-done-keywords)))) | |
8208 | (and logging (org-local-logging logging)) | |
8209 | (when (and (or org-todo-log-states org-log-done) | |
8210 | (not (memq arg '(nextset previousset)))) | |
8211 | ;; we need to look at recording a time and note | |
8212 | (setq dolog (or (nth 1 (assoc state org-todo-log-states)) | |
8213 | (nth 2 (assoc this org-todo-log-states)))) | |
8214 | (when (and state | |
8215 | (member state org-not-done-keywords) | |
8216 | (not (member this org-not-done-keywords))) | |
8217 | ;; This is now a todo state and was not one before | |
8218 | ;; If there was a CLOSED time stamp, get rid of it. | |
8219 | (org-add-planning-info nil nil 'closed)) | |
8220 | (when (and now-done-p org-log-done) | |
8221 | ;; It is now done, and it was not done before | |
8222 | (org-add-planning-info 'closed (org-current-time)) | |
8223 | (if (and (not dolog) (eq 'note org-log-done)) | |
8224 | (org-add-log-setup 'done state 'findpos 'note))) | |
8225 | (when (and state dolog) | |
8226 | ;; This is a non-nil state, and we need to log it | |
8227 | (org-add-log-setup 'state state 'findpos dolog))) | |
8228 | ;; Fixup tag positioning | |
71d35b24 | 8229 | (org-todo-trigger-tag-changes state) |
20908596 | 8230 | (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) |
b349f79f CD |
8231 | (when org-provide-todo-statistics |
8232 | (org-update-parent-todo-statistics)) | |
20908596 CD |
8233 | (run-hooks 'org-after-todo-state-change-hook) |
8234 | (if (and arg (not (member state org-done-keywords))) | |
8235 | (setq head (org-get-todo-sequence-head state))) | |
8236 | (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) | |
8237 | ;; Do we need to trigger a repeat? | |
93b62de8 CD |
8238 | (when now-done-p |
8239 | (when (boundp 'org-agenda-headline-snapshot-before-repeat) | |
8240 | ;; This is for the agenda, take a snapshot of the headline. | |
8241 | (save-match-data | |
8242 | (setq org-agenda-headline-snapshot-before-repeat | |
8243 | (org-get-heading)))) | |
8244 | (org-auto-repeat-maybe state)) | |
20908596 CD |
8245 | ;; Fixup cursor location if close to the keyword |
8246 | (if (and (outline-on-heading-p) | |
8247 | (not (bolp)) | |
8248 | (save-excursion (beginning-of-line 1) | |
8249 | (looking-at org-todo-line-regexp)) | |
8250 | (< (point) (+ 2 (or (match-end 2) (match-end 1))))) | |
8251 | (progn | |
8252 | (goto-char (or (match-end 2) (match-end 1))) | |
8253 | (just-one-space))) | |
8254 | (when org-trigger-hook | |
8255 | (save-excursion | |
8256 | (run-hook-with-args 'org-trigger-hook change-plist))))))) | |
fbe6c10d | 8257 | |
b349f79f CD |
8258 | (defun org-update-parent-todo-statistics () |
8259 | "Update any statistics cookie in the parent of the current headline." | |
8260 | (interactive) | |
8261 | (let ((box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") | |
8262 | level (cnt-all 0) (cnt-done 0) is-percent kwd) | |
8263 | (catch 'exit | |
8264 | (save-excursion | |
8265 | (setq level (org-up-heading-safe)) | |
8266 | (unless (and level | |
8267 | (re-search-forward box-re (point-at-eol) t)) | |
8268 | (throw 'exit nil)) | |
8269 | (setq is-percent (match-end 2)) | |
8270 | (save-match-data | |
8271 | (unless (outline-next-heading) (throw 'exit nil)) | |
8272 | (while (looking-at org-todo-line-regexp) | |
8273 | (setq kwd (match-string 2)) | |
8274 | (and kwd (setq cnt-all (1+ cnt-all))) | |
8275 | (and (member kwd org-done-keywords) | |
8276 | (setq cnt-done (1+ cnt-done))) | |
8277 | (condition-case nil | |
621f83e4 | 8278 | (org-forward-same-level 1) |
b349f79f | 8279 | (error (end-of-line 1))))) |
ce4fdcb9 | 8280 | (replace-match |
b349f79f CD |
8281 | (if is-percent |
8282 | (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) | |
8283 | (format "[%d/%d]" cnt-done cnt-all))) | |
8284 | (run-hook-with-args 'org-after-todo-statistics-hook | |
8285 | cnt-done (- cnt-all cnt-done)))))) | |
8286 | ||
8287 | (defvar org-after-todo-statistics-hook nil | |
8288 | "Hook that is called after a TODO statistics cookie has been updated. | |
8289 | Each function is called with two arguments: the number of not-done entries | |
8290 | and the number of done entries. | |
8291 | ||
8292 | For example, the following function, when added to this hook, will switch | |
8293 | an entry to DONE when all children are done, and back to TODO when new | |
8294 | entries are set to a TODO status. Note that this hook is only called | |
8295 | when there is a statistics cookie in the headline! | |
8296 | ||
8297 | (defun org-summary-todo (n-done n-not-done) | |
8298 | \"Switch entry to DONE when all subentries are done, to TODO otherwise.\" | |
8299 | (let (org-log-done org-log-states) ; turn off logging | |
8300 | (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\")))) | |
8301 | ") | |
71d35b24 CD |
8302 | |
8303 | (defun org-todo-trigger-tag-changes (state) | |
8304 | "Apply the changes defined in `org-todo-state-tags-triggers'." | |
8305 | (let ((l org-todo-state-tags-triggers) | |
8306 | changes) | |
8307 | (when (or (not state) (equal state "")) | |
8308 | (setq changes (append changes (cdr (assoc "" l))))) | |
8309 | (when (and (stringp state) (> (length state) 0)) | |
8310 | (setq changes (append changes (cdr (assoc state l))))) | |
8311 | (when (member state org-not-done-keywords) | |
8312 | (setq changes (append changes (cdr (assoc 'todo l))))) | |
8313 | (when (member state org-done-keywords) | |
8314 | (setq changes (append changes (cdr (assoc 'done l))))) | |
8315 | (dolist (c changes) | |
8316 | (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) | |
ce4fdcb9 | 8317 | |
20908596 CD |
8318 | (defun org-local-logging (value) |
8319 | "Get logging settings from a property VALUE." | |
8320 | (let* (words w a) | |
8321 | ;; directly set the variables, they are already local. | |
8322 | (setq org-log-done nil | |
8323 | org-log-repeat nil | |
8324 | org-todo-log-states nil) | |
8325 | (setq words (org-split-string value)) | |
8326 | (while (setq w (pop words)) | |
8327 | (cond | |
8328 | ((setq a (assoc w org-startup-options)) | |
8329 | (and (member (nth 1 a) '(org-log-done org-log-repeat)) | |
8330 | (set (nth 1 a) (nth 2 a)))) | |
8331 | ((setq a (org-extract-log-state-settings w)) | |
8332 | (and (member (car a) org-todo-keywords-1) | |
8333 | (push a org-todo-log-states))))))) | |
03f3cf35 | 8334 | |
20908596 CD |
8335 | (defun org-get-todo-sequence-head (kwd) |
8336 | "Return the head of the TODO sequence to which KWD belongs. | |
8337 | If KWD is not set, check if there is a text property remembering the | |
8338 | right sequence." | |
8339 | (let (p) | |
8340 | (cond | |
8341 | ((not kwd) | |
8342 | (or (get-text-property (point-at-bol) 'org-todo-head) | |
03f3cf35 | 8343 | (progn |
20908596 CD |
8344 | (setq p (next-single-property-change (point-at-bol) 'org-todo-head |
8345 | nil (point-at-eol))) | |
8346 | (get-text-property p 'org-todo-head)))) | |
8347 | ((not (member kwd org-todo-keywords-1)) | |
8348 | (car org-todo-keywords-1)) | |
8349 | (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) | |
891f4676 | 8350 | |
20908596 CD |
8351 | (defun org-fast-todo-selection () |
8352 | "Fast TODO keyword selection with single keys. | |
8353 | Returns the new TODO keyword, or nil if no state change should occur." | |
8354 | (let* ((fulltable org-todo-key-alist) | |
8355 | (done-keywords org-done-keywords) ;; needed for the faces. | |
8356 | (maxlen (apply 'max (mapcar | |
8357 | (lambda (x) | |
8358 | (if (stringp (car x)) (string-width (car x)) 0)) | |
8359 | fulltable))) | |
8360 | (expert nil) | |
8361 | (fwidth (+ maxlen 3 1 3)) | |
8362 | (ncol (/ (- (window-width) 4) fwidth)) | |
8363 | tg cnt e c tbl | |
8364 | groups ingroup) | |
8365 | (save-window-excursion | |
8366 | (if expert | |
8367 | (set-buffer (get-buffer-create " *Org todo*")) | |
8368 | (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) | |
8369 | (erase-buffer) | |
8370 | (org-set-local 'org-done-keywords done-keywords) | |
8371 | (setq tbl fulltable cnt 0) | |
8372 | (while (setq e (pop tbl)) | |
8373 | (cond | |
8374 | ((equal e '(:startgroup)) | |
8375 | (push '() groups) (setq ingroup t) | |
8376 | (when (not (= cnt 0)) | |
8377 | (setq cnt 0) | |
8378 | (insert "\n")) | |
8379 | (insert "{ ")) | |
8380 | ((equal e '(:endgroup)) | |
8381 | (setq ingroup nil cnt 0) | |
8382 | (insert "}\n")) | |
8383 | (t | |
8384 | (setq tg (car e) c (cdr e)) | |
8385 | (if ingroup (push tg (car groups))) | |
8386 | (setq tg (org-add-props tg nil 'face | |
8387 | (org-get-todo-face tg))) | |
8388 | (if (and (= cnt 0) (not ingroup)) (insert " ")) | |
8389 | (insert "[" c "] " tg (make-string | |
8390 | (- fwidth 4 (length tg)) ?\ )) | |
8391 | (when (= (setq cnt (1+ cnt)) ncol) | |
8392 | (insert "\n") | |
8393 | (if ingroup (insert " ")) | |
8394 | (setq cnt 0))))) | |
8395 | (insert "\n") | |
8396 | (goto-char (point-min)) | |
93b62de8 | 8397 | (if (not expert) (org-fit-window-to-buffer)) |
20908596 CD |
8398 | (message "[a-z..]:Set [SPC]:clear") |
8399 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
8400 | (cond | |
8401 | ((or (= c ?\C-g) | |
8402 | (and (= c ?q) (not (rassoc c fulltable)))) | |
8403 | (setq quit-flag t)) | |
8404 | ((= c ?\ ) nil) | |
8405 | ((setq e (rassoc c fulltable) tg (car e)) | |
8406 | tg) | |
8407 | (t (setq quit-flag t)))))) | |
ab27a4a0 | 8408 | |
20908596 CD |
8409 | (defun org-entry-is-todo-p () |
8410 | (member (org-get-todo-state) org-not-done-keywords)) | |
8411 | ||
8412 | (defun org-entry-is-done-p () | |
8413 | (member (org-get-todo-state) org-done-keywords)) | |
8414 | ||
8415 | (defun org-get-todo-state () | |
8416 | (save-excursion | |
8417 | (org-back-to-heading t) | |
8418 | (and (looking-at org-todo-line-regexp) | |
8419 | (match-end 2) | |
8420 | (match-string 2)))) | |
8421 | ||
8422 | (defun org-at-date-range-p (&optional inactive-ok) | |
8423 | "Is the cursor inside a date range?" | |
d3f4dbe8 | 8424 | (interactive) |
20908596 CD |
8425 | (save-excursion |
8426 | (catch 'exit | |
8427 | (let ((pos (point))) | |
8428 | (skip-chars-backward "^[<\r\n") | |
8429 | (skip-chars-backward "<[") | |
8430 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
8431 | (>= (match-end 0) pos) | |
8432 | (throw 'exit t)) | |
8433 | (skip-chars-backward "^<[\r\n") | |
8434 | (skip-chars-backward "<[") | |
8435 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
8436 | (>= (match-end 0) pos) | |
8437 | (throw 'exit t))) | |
8438 | nil))) | |
891f4676 | 8439 | |
20908596 | 8440 | (defun org-get-repeat () |
2c3ad40d | 8441 | "Check if there is a deadline/schedule with repeater in this entry." |
20908596 CD |
8442 | (save-match-data |
8443 | (save-excursion | |
8444 | (org-back-to-heading t) | |
8445 | (if (re-search-forward | |
8446 | org-repeat-re (save-excursion (outline-next-heading) (point)) t) | |
8447 | (match-string 1))))) | |
891f4676 | 8448 | |
20908596 | 8449 | (defvar org-last-changed-timestamp) |
b349f79f | 8450 | (defvar org-last-inserted-timestamp) |
20908596 CD |
8451 | (defvar org-log-post-message) |
8452 | (defvar org-log-note-purpose) | |
8453 | (defvar org-log-note-how) | |
621f83e4 | 8454 | (defvar org-log-note-extra) |
20908596 CD |
8455 | (defun org-auto-repeat-maybe (done-word) |
8456 | "Check if the current headline contains a repeated deadline/schedule. | |
8457 | If yes, set TODO state back to what it was and change the base date | |
8458 | of repeating deadline/scheduled time stamps to new date. | |
8459 | This function is run automatically after each state change to a DONE state." | |
8460 | ;; last-state is dynamically scoped into this function | |
8461 | (let* ((repeat (org-get-repeat)) | |
8462 | (aa (assoc last-state org-todo-kwd-alist)) | |
8463 | (interpret (nth 1 aa)) | |
8464 | (head (nth 2 aa)) | |
8465 | (whata '(("d" . day) ("m" . month) ("y" . year))) | |
8466 | (msg "Entry repeats: ") | |
8467 | (org-log-done nil) | |
8468 | (org-todo-log-states nil) | |
8469 | (nshiftmax 10) (nshift 0) | |
8470 | re type n what ts mb0 time) | |
8471 | (when repeat | |
8472 | (if (eq org-log-repeat t) (setq org-log-repeat 'state)) | |
8473 | (org-todo (if (eq interpret 'type) last-state head)) | |
8474 | (when org-log-repeat | |
8475 | (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) | |
8476 | (memq 'org-add-log-note post-command-hook)) | |
8477 | ;; OK, we are already setup for some record | |
8478 | (if (eq org-log-repeat 'note) | |
8479 | ;; make sure we take a note, not only a time stamp | |
8480 | (setq org-log-note-how 'note)) | |
8481 | ;; Set up for taking a record | |
8482 | (org-add-log-setup 'state (or done-word (car org-done-keywords)) | |
8483 | 'findpos org-log-repeat))) | |
8484 | (org-back-to-heading t) | |
8485 | (org-add-planning-info nil nil 'closed) | |
8486 | (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" | |
8487 | org-deadline-time-regexp "\\)\\|\\(" | |
8488 | org-ts-regexp "\\)")) | |
8489 | (while (re-search-forward | |
8490 | re (save-excursion (outline-next-heading) (point)) t) | |
8491 | (setq type (if (match-end 1) org-scheduled-string | |
8492 | (if (match-end 3) org-deadline-string "Plain:")) | |
8493 | ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))) | |
8494 | mb0 (match-beginning 0)) | |
8495 | (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts) | |
8496 | (setq n (string-to-number (match-string 2 ts)) | |
8497 | what (match-string 3 ts)) | |
8498 | (if (equal what "w") (setq n (* n 7) what "d")) | |
8499 | ;; Preparation, see if we need to modify the start date for the change | |
8500 | (when (match-end 1) | |
8501 | (setq time (save-match-data (org-time-string-to-time ts))) | |
8502 | (cond | |
8503 | ((equal (match-string 1 ts) ".") | |
8504 | ;; Shift starting date to today | |
8505 | (org-timestamp-change | |
8506 | (- (time-to-days (current-time)) (time-to-days time)) | |
8507 | 'day)) | |
8508 | ((equal (match-string 1 ts) "+") | |
8509 | (while (or (= nshift 0) | |
8510 | (<= (time-to-days time) (time-to-days (current-time)))) | |
8511 | (when (= (incf nshift) nshiftmax) | |
8512 | (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) | |
8513 | (error "Abort"))) | |
8514 | (org-timestamp-change n (cdr (assoc what whata))) | |
8515 | (org-at-timestamp-p t) | |
8516 | (setq ts (match-string 1)) | |
8517 | (setq time (save-match-data (org-time-string-to-time ts)))) | |
8518 | (org-timestamp-change (- n) (cdr (assoc what whata))) | |
8519 | ;; rematch, so that we have everything in place for the real shift | |
8520 | (org-at-timestamp-p t) | |
8521 | (setq ts (match-string 1)) | |
8522 | (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts)))) | |
8523 | (org-timestamp-change n (cdr (assoc what whata))) | |
621f83e4 | 8524 | (setq msg (concat msg type " " org-last-changed-timestamp " ")))) |
20908596 CD |
8525 | (setq org-log-post-message msg) |
8526 | (message "%s" msg)))) | |
891f4676 | 8527 | |
20908596 CD |
8528 | (defun org-show-todo-tree (arg) |
8529 | "Make a compact tree which shows all headlines marked with TODO. | |
8530 | The tree will show the lines where the regexp matches, and all higher | |
8531 | headlines above the match. | |
8532 | With a \\[universal-argument] prefix, also show the DONE entries. | |
8533 | With a numeric prefix N, construct a sparse tree for the Nth element | |
8534 | of `org-todo-keywords-1'." | |
8535 | (interactive "P") | |
8536 | (let ((case-fold-search nil) | |
8537 | (kwd-re | |
8538 | (cond ((null arg) org-not-done-regexp) | |
8539 | ((equal arg '(4)) | |
ce4fdcb9 | 8540 | (let ((kwd (org-ido-completing-read "Keyword (or KWD1|KWD2|...): " |
20908596 CD |
8541 | (mapcar 'list org-todo-keywords-1)))) |
8542 | (concat "\\(" | |
8543 | (mapconcat 'identity (org-split-string kwd "|") "\\|") | |
8544 | "\\)\\>"))) | |
8545 | ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) | |
8546 | (regexp-quote (nth (1- (prefix-numeric-value arg)) | |
8547 | org-todo-keywords-1))) | |
8548 | (t (error "Invalid prefix argument: %s" arg))))) | |
8549 | (message "%d TODO entries found" | |
8550 | (org-occur (concat "^" outline-regexp " *" kwd-re ))))) | |
891f4676 | 8551 | |
b349f79f | 8552 | (defun org-deadline (&optional remove time) |
20908596 | 8553 | "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. |
b349f79f CD |
8554 | With argument REMOVE, remove any deadline from the item. |
8555 | When TIME is set, it should be an internal time specification, and the | |
8556 | scheduling will use the corresponding date." | |
20908596 CD |
8557 | (interactive "P") |
8558 | (if remove | |
8559 | (progn | |
8560 | (org-remove-timestamp-with-keyword org-deadline-string) | |
8561 | (message "Item no longer has a deadline.")) | |
b349f79f CD |
8562 | (if (org-get-repeat) |
8563 | (error "Cannot change deadline on task with repeater, please do that by hand") | |
8564 | (org-add-planning-info 'deadline time 'closed) | |
8565 | (message "Deadline on %s" org-last-inserted-timestamp)))) | |
791d856f | 8566 | |
b349f79f | 8567 | (defun org-schedule (&optional remove time) |
20908596 | 8568 | "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. |
b349f79f CD |
8569 | With argument REMOVE, remove any scheduling date from the item. |
8570 | When TIME is set, it should be an internal time specification, and the | |
8571 | scheduling will use the corresponding date." | |
20908596 CD |
8572 | (interactive "P") |
8573 | (if remove | |
8574 | (progn | |
8575 | (org-remove-timestamp-with-keyword org-scheduled-string) | |
8576 | (message "Item is no longer scheduled.")) | |
b349f79f CD |
8577 | (if (org-get-repeat) |
8578 | (error "Cannot reschedule task with repeater, please do that by hand") | |
8579 | (org-add-planning-info 'scheduled time 'closed) | |
8580 | (message "Scheduled to %s" org-last-inserted-timestamp)))) | |
20908596 CD |
8581 | |
8582 | (defun org-remove-timestamp-with-keyword (keyword) | |
8583 | "Remove all time stamps with KEYWORD in the current entry." | |
8584 | (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) | |
8585 | beg) | |
8586 | (save-excursion | |
8587 | (org-back-to-heading t) | |
8588 | (setq beg (point)) | |
8589 | (org-end-of-subtree t t) | |
8590 | (while (re-search-backward re beg t) | |
8591 | (replace-match "") | |
b349f79f CD |
8592 | (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) |
8593 | (equal (char-before) ?\ )) | |
8594 | (backward-delete-char 1) | |
8595 | (if (string-match "^[ \t]*$" (buffer-substring | |
8596 | (point-at-bol) (point-at-eol))) | |
8597 | (delete-region (point-at-bol) | |
8598 | (min (point-max) (1+ (point-at-eol)))))))))) | |
3278a016 | 8599 | |
20908596 CD |
8600 | (defun org-add-planning-info (what &optional time &rest remove) |
8601 | "Insert new timestamp with keyword in the line directly after the headline. | |
8602 | WHAT indicates what kind of time stamp to add. TIME indicated the time to use. | |
8603 | If non is given, the user is prompted for a date. | |
8604 | REMOVE indicates what kind of entries to remove. An old WHAT entry will also | |
8605 | be removed." | |
8606 | (interactive) | |
8607 | (let (org-time-was-given org-end-time-was-given ts | |
8608 | end default-time default-input) | |
0b8568f5 | 8609 | |
20908596 CD |
8610 | (when (and (not time) (memq what '(scheduled deadline))) |
8611 | ;; Try to get a default date/time from existing timestamp | |
8612 | (save-excursion | |
8613 | (org-back-to-heading t) | |
8614 | (setq end (save-excursion (outline-next-heading) (point))) | |
8615 | (when (re-search-forward (if (eq what 'scheduled) | |
8616 | org-scheduled-time-regexp | |
8617 | org-deadline-time-regexp) | |
8618 | end t) | |
8619 | (setq ts (match-string 1) | |
8620 | default-time | |
8621 | (apply 'encode-time (org-parse-time-string ts)) | |
8622 | default-input (and ts (org-get-compact-tod ts)))))) | |
8623 | (when what | |
8624 | ;; If necessary, get the time from the user | |
8625 | (setq time (or time (org-read-date nil 'to-time nil nil | |
8626 | default-time default-input)))) | |
ab27a4a0 | 8627 | |
20908596 CD |
8628 | (when (and org-insert-labeled-timestamps-at-point |
8629 | (member what '(scheduled deadline))) | |
8630 | (insert | |
8631 | (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") | |
8632 | (org-insert-time-stamp time org-time-was-given | |
8633 | nil nil nil (list org-end-time-was-given)) | |
8634 | (setq what nil)) | |
8635 | (save-excursion | |
8636 | (save-restriction | |
8637 | (let (col list elt ts buffer-invisibility-spec) | |
8638 | (org-back-to-heading t) | |
8639 | (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) | |
8640 | (goto-char (match-end 1)) | |
8641 | (setq col (current-column)) | |
8642 | (goto-char (match-end 0)) | |
8643 | (if (eobp) (insert "\n") (forward-char 1)) | |
8644 | (if (and (not (looking-at outline-regexp)) | |
8645 | (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp | |
8646 | "[^\r\n]*")) | |
8647 | (not (equal (match-string 1) org-clock-string))) | |
8648 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
8649 | (insert-before-markers "\n") | |
8650 | (backward-char 1) | |
8651 | (narrow-to-region (point) (point)) | |
b349f79f | 8652 | (and org-adapt-indentation (org-indent-to-column col))) |
20908596 CD |
8653 | ;; Check if we have to remove something. |
8654 | (setq list (cons what remove)) | |
8655 | (while list | |
8656 | (setq elt (pop list)) | |
8657 | (goto-char (point-min)) | |
8658 | (when (or (and (eq elt 'scheduled) | |
8659 | (re-search-forward org-scheduled-time-regexp nil t)) | |
8660 | (and (eq elt 'deadline) | |
8661 | (re-search-forward org-deadline-time-regexp nil t)) | |
8662 | (and (eq elt 'closed) | |
8663 | (re-search-forward org-closed-time-regexp nil t))) | |
8664 | (replace-match "") | |
8665 | (if (looking-at "--+<[^>]+>") (replace-match "")) | |
8666 | (if (looking-at " +") (replace-match "")))) | |
8667 | (goto-char (point-max)) | |
8668 | (when what | |
8669 | (insert | |
b349f79f | 8670 | (if (not (or (bolp) (eq (char-before) ?\ ))) " " "") |
20908596 CD |
8671 | (cond ((eq what 'scheduled) org-scheduled-string) |
8672 | ((eq what 'deadline) org-deadline-string) | |
8673 | ((eq what 'closed) org-closed-string)) | |
8674 | " ") | |
8675 | (setq ts (org-insert-time-stamp | |
8676 | time | |
8677 | (or org-time-was-given | |
8678 | (and (eq what 'closed) org-log-done-with-time)) | |
8679 | (eq what 'closed) | |
8680 | nil nil (list org-end-time-was-given))) | |
8681 | (end-of-line 1)) | |
8682 | (goto-char (point-min)) | |
8683 | (widen) | |
8684 | (if (and (looking-at "[ \t]+\n") | |
8685 | (equal (char-before) ?\n)) | |
b349f79f | 8686 | (delete-region (1- (point)) (point-at-eol))) |
20908596 | 8687 | ts))))) |
ab27a4a0 | 8688 | |
20908596 CD |
8689 | (defvar org-log-note-marker (make-marker)) |
8690 | (defvar org-log-note-purpose nil) | |
8691 | (defvar org-log-note-state nil) | |
8692 | (defvar org-log-note-how nil) | |
621f83e4 | 8693 | (defvar org-log-note-extra nil) |
20908596 CD |
8694 | (defvar org-log-note-window-configuration nil) |
8695 | (defvar org-log-note-return-to (make-marker)) | |
8696 | (defvar org-log-post-message nil | |
8697 | "Message to be displayed after a log note has been stored. | |
8698 | The auto-repeater uses this.") | |
ab27a4a0 | 8699 | |
20908596 CD |
8700 | (defun org-add-note () |
8701 | "Add a note to the current entry. | |
8702 | This is done in the same way as adding a state change note." | |
8703 | (interactive) | |
621f83e4 | 8704 | (org-add-log-setup 'note nil 'findpos nil)) |
8c6fb58b | 8705 | |
621f83e4 CD |
8706 | (defvar org-property-end-re) |
8707 | (defun org-add-log-setup (&optional purpose state findpos how &optional extra) | |
20908596 CD |
8708 | "Set up the post command hook to take a note. |
8709 | If this is about to TODO state change, the new state is expected in STATE. | |
8710 | When FINDPOS is non-nil, find the correct position for the note in | |
621f83e4 CD |
8711 | the current entry. If not, assume that it can be inserted at point. |
8712 | HOW is an indicator what kind of note should be created. | |
8713 | EXTRA is additional text that will be inserted into the notes buffer." | |
8714 | (save-restriction | |
8715 | (save-excursion | |
8716 | (when findpos | |
8717 | (org-back-to-heading t) | |
ce4fdcb9 | 8718 | (narrow-to-region (point) (save-excursion |
621f83e4 | 8719 | (outline-next-heading) (point))) |
621f83e4 CD |
8720 | (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" |
8721 | "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp | |
8722 | "[^\r\n]*\\)?")) | |
8723 | (goto-char (match-end 0)) | |
71d35b24 CD |
8724 | (when (and org-log-state-notes-insert-after-drawers |
8725 | (save-excursion | |
8726 | (forward-line) (looking-at org-drawer-regexp))) | |
8727 | (progn (forward-line) | |
8728 | (while (looking-at org-drawer-regexp) | |
8729 | (goto-char (match-end 0)) | |
8730 | (re-search-forward org-property-end-re (point-max) t) | |
8731 | (forward-line)) | |
8732 | (forward-line -1))) | |
621f83e4 CD |
8733 | (unless org-log-states-order-reversed |
8734 | (and (= (char-after) ?\n) (forward-char 1)) | |
8735 | (org-skip-over-state-notes) | |
8736 | (skip-chars-backward " \t\n\r"))) | |
8737 | (move-marker org-log-note-marker (point)) | |
8738 | (setq org-log-note-purpose purpose | |
8739 | org-log-note-state state | |
8740 | org-log-note-how how | |
8741 | org-log-note-extra extra) | |
8742 | (add-hook 'post-command-hook 'org-add-log-note 'append)))) | |
ab27a4a0 | 8743 | |
20908596 CD |
8744 | (defun org-skip-over-state-notes () |
8745 | "Skip past the list of State notes in an entry." | |
8746 | (if (looking-at "\n[ \t]*- State") (forward-char 1)) | |
8747 | (while (looking-at "[ \t]*- State") | |
8748 | (condition-case nil | |
8749 | (org-next-item) | |
8750 | (error (org-end-of-item))))) | |
891f4676 | 8751 | |
20908596 CD |
8752 | (defun org-add-log-note (&optional purpose) |
8753 | "Pop up a window for taking a note, and add this note later at point." | |
8754 | (remove-hook 'post-command-hook 'org-add-log-note) | |
8755 | (setq org-log-note-window-configuration (current-window-configuration)) | |
8756 | (delete-other-windows) | |
8757 | (move-marker org-log-note-return-to (point)) | |
8758 | (switch-to-buffer (marker-buffer org-log-note-marker)) | |
8759 | (goto-char org-log-note-marker) | |
8760 | (org-switch-to-buffer-other-window "*Org Note*") | |
8761 | (erase-buffer) | |
8762 | (if (memq org-log-note-how '(time state)) | |
71d35b24 | 8763 | (let (current-prefix-arg) (org-store-log-note)) |
20908596 CD |
8764 | (let ((org-inhibit-startup t)) (org-mode)) |
8765 | (insert (format "# Insert note for %s. | |
8766 | # Finish with C-c C-c, or cancel with C-c C-k.\n\n" | |
8767 | (cond | |
8768 | ((eq org-log-note-purpose 'clock-out) "stopped clock") | |
8769 | ((eq org-log-note-purpose 'done) "closed todo item") | |
8770 | ((eq org-log-note-purpose 'state) | |
8771 | (format "state change to \"%s\"" org-log-note-state)) | |
8772 | ((eq org-log-note-purpose 'note) | |
8773 | "this entry") | |
8774 | (t (error "This should not happen"))))) | |
621f83e4 | 8775 | (if org-log-note-extra (insert org-log-note-extra)) |
20908596 | 8776 | (org-set-local 'org-finish-function 'org-store-log-note))) |
ab27a4a0 | 8777 | |
20908596 CD |
8778 | (defvar org-note-abort nil) ; dynamically scoped |
8779 | (defun org-store-log-note () | |
8780 | "Finish taking a log note, and insert it to where it belongs." | |
8781 | (let ((txt (buffer-string)) | |
8782 | (note (cdr (assq org-log-note-purpose org-log-note-headings))) | |
8783 | lines ind) | |
8784 | (kill-buffer (current-buffer)) | |
8785 | (while (string-match "\\`#.*\n[ \t\n]*" txt) | |
8786 | (setq txt (replace-match "" t t txt))) | |
8787 | (if (string-match "\\s-+\\'" txt) | |
8788 | (setq txt (replace-match "" t t txt))) | |
8789 | (setq lines (org-split-string txt "\n")) | |
8790 | (when (and note (string-match "\\S-" note)) | |
8791 | (setq note | |
8792 | (org-replace-escapes | |
8793 | note | |
8794 | (list (cons "%u" (user-login-name)) | |
8795 | (cons "%U" user-full-name) | |
8796 | (cons "%t" (format-time-string | |
8797 | (org-time-stamp-format 'long 'inactive) | |
8798 | (current-time))) | |
8799 | (cons "%s" (if org-log-note-state | |
8800 | (concat "\"" org-log-note-state "\"") | |
8801 | ""))))) | |
8802 | (if lines (setq note (concat note " \\\\"))) | |
8803 | (push note lines)) | |
8804 | (when (or current-prefix-arg org-note-abort) (setq lines nil)) | |
8805 | (when lines | |
8806 | (save-excursion | |
8807 | (set-buffer (marker-buffer org-log-note-marker)) | |
8808 | (save-excursion | |
8809 | (goto-char org-log-note-marker) | |
8810 | (move-marker org-log-note-marker nil) | |
8811 | (end-of-line 1) | |
8812 | (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) | |
8813 | (indent-relative nil) | |
8814 | (insert "- " (pop lines)) | |
8815 | (org-indent-line-function) | |
8816 | (beginning-of-line 1) | |
8817 | (looking-at "[ \t]*") | |
8818 | (setq ind (concat (match-string 0) " ")) | |
8819 | (end-of-line 1) | |
8820 | (while lines (insert "\n" ind (pop lines))))))) | |
8821 | (set-window-configuration org-log-note-window-configuration) | |
8822 | (with-current-buffer (marker-buffer org-log-note-return-to) | |
8823 | (goto-char org-log-note-return-to)) | |
8824 | (move-marker org-log-note-return-to nil) | |
8825 | (and org-log-post-message (message "%s" org-log-post-message))) | |
a3fbe8c4 | 8826 | |
20908596 CD |
8827 | (defun org-sparse-tree (&optional arg) |
8828 | "Create a sparse tree, prompt for the details. | |
8829 | This command can create sparse trees. You first need to select the type | |
8830 | of match used to create the tree: | |
d5098885 | 8831 | |
20908596 CD |
8832 | t Show entries with a specific TODO keyword. |
8833 | T Show entries selected by a tags match. | |
8834 | p Enter a property name and its value (both with completion on existing | |
8835 | names/values) and show entries with that property. | |
8836 | r Show entries matching a regular expression | |
8837 | d Show deadlines due within `org-deadline-warning-days'." | |
8838 | (interactive "P") | |
8839 | (let (ans kwd value) | |
8840 | (message "Sparse tree: [/]regexp [t]odo-kwd [T]ag [p]roperty [d]eadlines [b]efore-date") | |
8841 | (setq ans (read-char-exclusive)) | |
8842 | (cond | |
8843 | ((equal ans ?d) | |
8844 | (call-interactively 'org-check-deadlines)) | |
8845 | ((equal ans ?b) | |
8846 | (call-interactively 'org-check-before-date)) | |
8847 | ((equal ans ?t) | |
8848 | (org-show-todo-tree '(4))) | |
8849 | ((equal ans ?T) | |
8850 | (call-interactively 'org-tags-sparse-tree)) | |
8851 | ((member ans '(?p ?P)) | |
ce4fdcb9 | 8852 | (setq kwd (org-ido-completing-read "Property: " |
20908596 | 8853 | (mapcar 'list (org-buffer-property-keys)))) |
ce4fdcb9 | 8854 | (setq value (org-ido-completing-read "Value: " |
20908596 CD |
8855 | (mapcar 'list (org-property-values kwd)))) |
8856 | (unless (string-match "\\`{.*}\\'" value) | |
8857 | (setq value (concat "\"" value "\""))) | |
8858 | (org-tags-sparse-tree arg (concat kwd "=" value))) | |
8859 | ((member ans '(?r ?R ?/)) | |
8860 | (call-interactively 'org-occur)) | |
8861 | (t (error "No such sparse tree command \"%c\"" ans))))) | |
a3fbe8c4 | 8862 | |
20908596 CD |
8863 | (defvar org-occur-highlights nil |
8864 | "List of overlays used for occur matches.") | |
8865 | (make-variable-buffer-local 'org-occur-highlights) | |
8866 | (defvar org-occur-parameters nil | |
8867 | "Parameters of the active org-occur calls. | |
8868 | This is a list, each call to org-occur pushes as cons cell, | |
8869 | containing the regular expression and the callback, onto the list. | |
8870 | The list can contain several entries if `org-occur' has been called | |
8871 | several time with the KEEP-PREVIOUS argument. Otherwise, this list | |
8872 | will only contain one set of parameters. When the highlights are | |
8873 | removed (for example with `C-c C-c', or with the next edit (depending | |
8874 | on `org-remove-highlights-with-change'), this variable is emptied | |
8875 | as well.") | |
8876 | (make-variable-buffer-local 'org-occur-parameters) | |
a3fbe8c4 | 8877 | |
20908596 CD |
8878 | (defun org-occur (regexp &optional keep-previous callback) |
8879 | "Make a compact tree which shows all matches of REGEXP. | |
8880 | The tree will show the lines where the regexp matches, and all higher | |
8881 | headlines above the match. It will also show the heading after the match, | |
8882 | to make sure editing the matching entry is easy. | |
8883 | If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous | |
8884 | call to `org-occur' will be kept, to allow stacking of calls to this | |
8885 | command. | |
8886 | If CALLBACK is non-nil, it is a function which is called to confirm | |
8887 | that the match should indeed be shown." | |
8888 | (interactive "sRegexp: \nP") | |
8889 | (unless keep-previous | |
8890 | (org-remove-occur-highlights nil nil t)) | |
8891 | (push (cons regexp callback) org-occur-parameters) | |
8892 | (let ((cnt 0)) | |
a3fbe8c4 | 8893 | (save-excursion |
a3fbe8c4 | 8894 | (goto-char (point-min)) |
20908596 CD |
8895 | (if (or (not keep-previous) ; do not want to keep |
8896 | (not org-occur-highlights)) ; no previous matches | |
8897 | ;; hide everything | |
8898 | (org-overview)) | |
8899 | (while (re-search-forward regexp nil t) | |
8900 | (when (or (not callback) | |
8901 | (save-match-data (funcall callback))) | |
8902 | (setq cnt (1+ cnt)) | |
8903 | (when org-highlight-sparse-tree-matches | |
8904 | (org-highlight-new-match (match-beginning 0) (match-end 0))) | |
8905 | (org-show-context 'occur-tree)))) | |
8906 | (when org-remove-highlights-with-change | |
8907 | (org-add-hook 'before-change-functions 'org-remove-occur-highlights | |
8908 | nil 'local)) | |
8909 | (unless org-sparse-tree-open-archived-trees | |
8910 | (org-hide-archived-subtrees (point-min) (point-max))) | |
8911 | (run-hooks 'org-occur-hook) | |
8912 | (if (interactive-p) | |
8913 | (message "%d match(es) for regexp %s" cnt regexp)) | |
8914 | cnt)) | |
a3fbe8c4 | 8915 | |
20908596 CD |
8916 | (defun org-show-context (&optional key) |
8917 | "Make sure point and context and visible. | |
8918 | How much context is shown depends upon the variables | |
8919 | `org-show-hierarchy-above', `org-show-following-heading'. and | |
8920 | `org-show-siblings'." | |
8921 | (let ((heading-p (org-on-heading-p t)) | |
8922 | (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) | |
8923 | (following-p (org-get-alist-option org-show-following-heading key)) | |
8924 | (entry-p (org-get-alist-option org-show-entry-below key)) | |
8925 | (siblings-p (org-get-alist-option org-show-siblings key))) | |
8926 | (catch 'exit | |
8927 | ;; Show heading or entry text | |
8928 | (if (and heading-p (not entry-p)) | |
8929 | (org-flag-heading nil) ; only show the heading | |
8930 | (and (or entry-p (org-invisible-p) (org-invisible-p2)) | |
8931 | (org-show-hidden-entry))) ; show entire entry | |
8932 | (when following-p | |
8933 | ;; Show next sibling, or heading below text | |
8934 | (save-excursion | |
8935 | (and (if heading-p (org-goto-sibling) (outline-next-heading)) | |
8936 | (org-flag-heading nil)))) | |
8937 | (when siblings-p (org-show-siblings)) | |
8938 | (when hierarchy-p | |
8939 | ;; show all higher headings, possibly with siblings | |
8940 | (save-excursion | |
8941 | (while (and (condition-case nil | |
8942 | (progn (org-up-heading-all 1) t) | |
8943 | (error nil)) | |
8944 | (not (bobp))) | |
8945 | (org-flag-heading nil) | |
8946 | (when siblings-p (org-show-siblings)))))))) | |
a3fbe8c4 | 8947 | |
20908596 CD |
8948 | (defun org-reveal (&optional siblings) |
8949 | "Show current entry, hierarchy above it, and the following headline. | |
8950 | This can be used to show a consistent set of context around locations | |
8951 | exposed with `org-show-hierarchy-above' or `org-show-following-heading' | |
8952 | not t for the search context. | |
891f4676 | 8953 | |
20908596 CD |
8954 | With optional argument SIBLINGS, on each level of the hierarchy all |
8955 | siblings are shown. This repairs the tree structure to what it would | |
8956 | look like when opened with hierarchical calls to `org-cycle'." | |
8957 | (interactive "P") | |
8958 | (let ((org-show-hierarchy-above t) | |
8959 | (org-show-following-heading t) | |
8960 | (org-show-siblings (if siblings t org-show-siblings))) | |
8961 | (org-show-context nil))) | |
891f4676 | 8962 | |
20908596 CD |
8963 | (defun org-highlight-new-match (beg end) |
8964 | "Highlight from BEG to END and mark the highlight is an occur headline." | |
8965 | (let ((ov (org-make-overlay beg end))) | |
8966 | (org-overlay-put ov 'face 'secondary-selection) | |
8967 | (push ov org-occur-highlights))) | |
791d856f | 8968 | |
20908596 CD |
8969 | (defun org-remove-occur-highlights (&optional beg end noremove) |
8970 | "Remove the occur highlights from the buffer. | |
8971 | BEG and END are ignored. If NOREMOVE is nil, remove this function | |
8972 | from the `before-change-functions' in the current buffer." | |
8973 | (interactive) | |
8974 | (unless org-inhibit-highlight-removal | |
8975 | (mapc 'org-delete-overlay org-occur-highlights) | |
8976 | (setq org-occur-highlights nil) | |
8977 | (setq org-occur-parameters nil) | |
8978 | (unless noremove | |
8979 | (remove-hook 'before-change-functions | |
8980 | 'org-remove-occur-highlights 'local)))) | |
891f4676 | 8981 | |
20908596 | 8982 | ;;;; Priorities |
891f4676 | 8983 | |
20908596 CD |
8984 | (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)" |
8985 | "Regular expression matching the priority indicator.") | |
d3f4dbe8 | 8986 | |
20908596 | 8987 | (defvar org-remove-priority-next-time nil) |
891f4676 | 8988 | |
20908596 CD |
8989 | (defun org-priority-up () |
8990 | "Increase the priority of the current item." | |
03f3cf35 | 8991 | (interactive) |
20908596 | 8992 | (org-priority 'up)) |
891f4676 | 8993 | |
20908596 CD |
8994 | (defun org-priority-down () |
8995 | "Decrease the priority of the current item." | |
8996 | (interactive) | |
8997 | (org-priority 'down)) | |
5bf7807a | 8998 | |
20908596 CD |
8999 | (defun org-priority (&optional action) |
9000 | "Change the priority of an item by ARG. | |
9001 | ACTION can be `set', `up', `down', or a character." | |
9002 | (interactive) | |
9003 | (setq action (or action 'set)) | |
9004 | (let (current new news have remove) | |
9005 | (save-excursion | |
9006 | (org-back-to-heading) | |
9007 | (if (looking-at org-priority-regexp) | |
9008 | (setq current (string-to-char (match-string 2)) | |
9009 | have t) | |
9010 | (setq current org-default-priority)) | |
9011 | (cond | |
9012 | ((or (eq action 'set) | |
9013 | (if (featurep 'xemacs) (characterp action) (integerp action))) | |
9014 | (if (not (eq action 'set)) | |
9015 | (setq new action) | |
9016 | (message "Priority %c-%c, SPC to remove: " | |
9017 | org-highest-priority org-lowest-priority) | |
9018 | (setq new (read-char-exclusive))) | |
9019 | (if (and (= (upcase org-highest-priority) org-highest-priority) | |
9020 | (= (upcase org-lowest-priority) org-lowest-priority)) | |
9021 | (setq new (upcase new))) | |
9022 | (cond ((equal new ?\ ) (setq remove t)) | |
9023 | ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) | |
9024 | (error "Priority must be between `%c' and `%c'" | |
9025 | org-highest-priority org-lowest-priority)))) | |
9026 | ((eq action 'up) | |
9027 | (if (and (not have) (eq last-command this-command)) | |
9028 | (setq new org-lowest-priority) | |
9029 | (setq new (if (and org-priority-start-cycle-with-default (not have)) | |
9030 | org-default-priority (1- current))))) | |
9031 | ((eq action 'down) | |
9032 | (if (and (not have) (eq last-command this-command)) | |
9033 | (setq new org-highest-priority) | |
9034 | (setq new (if (and org-priority-start-cycle-with-default (not have)) | |
9035 | org-default-priority (1+ current))))) | |
9036 | (t (error "Invalid action"))) | |
9037 | (if (or (< (upcase new) org-highest-priority) | |
9038 | (> (upcase new) org-lowest-priority)) | |
9039 | (setq remove t)) | |
9040 | (setq news (format "%c" new)) | |
9041 | (if have | |
9042 | (if remove | |
9043 | (replace-match "" t t nil 1) | |
9044 | (replace-match news t t nil 2)) | |
9045 | (if remove | |
9046 | (error "No priority cookie found in line") | |
9047 | (looking-at org-todo-line-regexp) | |
9048 | (if (match-end 2) | |
9049 | (progn | |
9050 | (goto-char (match-end 2)) | |
9051 | (insert " [#" news "]")) | |
9052 | (goto-char (match-beginning 3)) | |
9053 | (insert "[#" news "] "))))) | |
9054 | (org-preserve-lc (org-set-tags nil 'align)) | |
9055 | (if remove | |
9056 | (message "Priority removed") | |
9057 | (message "Priority of current item set to %s" news)))) | |
5bf7807a | 9058 | |
b38c6895 | 9059 | |
20908596 CD |
9060 | (defun org-get-priority (s) |
9061 | "Find priority cookie and return priority." | |
9062 | (save-match-data | |
9063 | (if (not (string-match org-priority-regexp s)) | |
9064 | (* 1000 (- org-lowest-priority org-default-priority)) | |
9065 | (* 1000 (- org-lowest-priority | |
9066 | (string-to-char (match-string 2 s))))))) | |
891f4676 | 9067 | |
20908596 | 9068 | ;;;; Tags |
634a7d0b | 9069 | |
2c3ad40d | 9070 | (defvar org-agenda-archives-mode) |
20908596 CD |
9071 | (defun org-scan-tags (action matcher &optional todo-only) |
9072 | "Scan headline tags with inheritance and produce output ACTION. | |
b349f79f CD |
9073 | |
9074 | ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, | |
9075 | or `agenda' to produce an entry list for an agenda view. It can also be | |
9076 | a Lisp form or a function that should be called at each matched headline, in | |
9077 | this case the return value is a list of all return values from these calls. | |
9078 | ||
9079 | MATCHER is a Lisp form to be evaluated, testing if a given set of tags | |
9080 | qualifies a headline for inclusion. When TODO-ONLY is non-nil, | |
9081 | only lines with a TODO keyword are included in the output." | |
20908596 CD |
9082 | (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\(" |
9083 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
9084 | (org-re | |
9085 | "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) | |
2c3ad40d | 9086 | (props (list 'face 'default |
20908596 | 9087 | 'done-face 'org-done |
2c3ad40d | 9088 | 'undone-face 'default |
20908596 CD |
9089 | 'mouse-face 'highlight |
9090 | 'org-not-done-regexp org-not-done-regexp | |
9091 | 'org-todo-regexp org-todo-regexp | |
9092 | 'keymap org-agenda-keymap | |
9093 | 'help-echo | |
9094 | (format "mouse-2 or RET jump to org file %s" | |
9095 | (abbreviate-file-name | |
9096 | (or (buffer-file-name (buffer-base-buffer)) | |
9097 | (buffer-name (buffer-base-buffer))))))) | |
9098 | (case-fold-search nil) | |
b349f79f CD |
9099 | lspos tags tags-list |
9100 | (tags-alist (list (cons 0 (mapcar 'downcase org-file-tags)))) | |
9101 | (llast 0) rtn rtn1 level category i txt | |
20908596 | 9102 | todo marker entry priority) |
621f83e4 | 9103 | (when (not (or (member action '(agenda sparse-tree)) (functionp action))) |
b349f79f | 9104 | (setq action (list 'lambda nil action))) |
20908596 CD |
9105 | (save-excursion |
9106 | (goto-char (point-min)) | |
9107 | (when (eq action 'sparse-tree) | |
9108 | (org-overview) | |
9109 | (org-remove-occur-highlights)) | |
9110 | (while (re-search-forward re nil t) | |
9111 | (catch :skip | |
9112 | (setq todo (if (match-end 1) (match-string 2)) | |
9113 | tags (if (match-end 4) (match-string 4))) | |
9114 | (goto-char (setq lspos (1+ (match-beginning 0)))) | |
9115 | (setq level (org-reduced-level (funcall outline-level)) | |
9116 | category (org-get-category)) | |
9117 | (setq i llast llast level) | |
9118 | ;; remove tag lists from same and sublevels | |
9119 | (while (>= i level) | |
9120 | (when (setq entry (assoc i tags-alist)) | |
9121 | (setq tags-alist (delete entry tags-alist))) | |
9122 | (setq i (1- i))) | |
9123 | ;; add the next tags | |
9124 | (when tags | |
9125 | (setq tags (mapcar 'downcase (org-split-string tags ":")) | |
9126 | tags-alist | |
9127 | (cons (cons level tags) tags-alist))) | |
9128 | ;; compile tags for current headline | |
9129 | (setq tags-list | |
9130 | (if org-use-tag-inheritance | |
ff4be292 | 9131 | (apply 'append (mapcar 'cdr (reverse tags-alist))) |
20908596 | 9132 | tags)) |
ff4be292 CD |
9133 | (when org-use-tag-inheritance |
9134 | (setcdr (car tags-alist) | |
9135 | (mapcar (lambda (x) | |
9136 | (setq x (copy-sequence x)) | |
9137 | (org-add-prop-inherited x)) | |
9138 | (cdar tags-alist)))) | |
20908596 CD |
9139 | (when (and tags org-use-tag-inheritance |
9140 | (not (eq t org-use-tag-inheritance))) | |
9141 | ;; selective inheritance, remove uninherited ones | |
9142 | (setcdr (car tags-alist) | |
9143 | (org-remove-uniherited-tags (cdar tags-alist)))) | |
9144 | (when (and (or (not todo-only) (member todo org-not-done-keywords)) | |
621f83e4 | 9145 | (let ((case-fold-search t)) (eval matcher)) |
2c3ad40d CD |
9146 | (or |
9147 | (not (member org-archive-tag tags-list)) | |
9148 | ;; we have an archive tag, should we use this anyway? | |
9149 | (or (not org-agenda-skip-archived-trees) | |
9150 | (and (eq action 'agenda) org-agenda-archives-mode)))) | |
b349f79f | 9151 | (unless (eq action 'sparse-tree) (org-agenda-skip)) |
03f3cf35 | 9152 | |
b349f79f CD |
9153 | ;; select this headline |
9154 | ||
9155 | (cond | |
9156 | ((eq action 'sparse-tree) | |
9157 | (and org-highlight-sparse-tree-matches | |
9158 | (org-get-heading) (match-end 0) | |
9159 | (org-highlight-new-match | |
9160 | (match-beginning 0) (match-beginning 1))) | |
9161 | (org-show-context 'tags-tree)) | |
9162 | ((eq action 'agenda) | |
20908596 CD |
9163 | (setq txt (org-format-agenda-item |
9164 | "" | |
9165 | (concat | |
9166 | (if org-tags-match-list-sublevels | |
9167 | (make-string (1- level) ?.) "") | |
9168 | (org-get-heading)) | |
9169 | category tags-list) | |
9170 | priority (org-get-priority txt)) | |
9171 | (goto-char lspos) | |
9172 | (setq marker (org-agenda-new-marker)) | |
9173 | (org-add-props txt props | |
9174 | 'org-marker marker 'org-hd-marker marker 'org-category category | |
9175 | 'priority priority 'type "tagsmatch") | |
9176 | (push txt rtn)) | |
b349f79f CD |
9177 | ((functionp action) |
9178 | (save-excursion | |
9179 | (setq rtn1 (funcall action)) | |
9180 | (push rtn1 rtn)) | |
9181 | (goto-char (point-at-eol))) | |
9182 | (t (error "Invalid action"))) | |
9183 | ||
20908596 CD |
9184 | ;; if we are to skip sublevels, jump to end of subtree |
9185 | (or org-tags-match-list-sublevels (org-end-of-subtree t)))))) | |
9186 | (when (and (eq action 'sparse-tree) | |
9187 | (not org-sparse-tree-open-archived-trees)) | |
9188 | (org-hide-archived-subtrees (point-min) (point-max))) | |
9189 | (nreverse rtn))) | |
891f4676 | 9190 | |
20908596 CD |
9191 | (defun org-remove-uniherited-tags (tags) |
9192 | "Remove all tags that are not inherited from the list TAGS." | |
9193 | (cond | |
ff4be292 CD |
9194 | ((eq org-use-tag-inheritance t) |
9195 | (if org-tags-exclude-from-inheritance | |
9196 | (org-delete-all org-tags-exclude-from-inheritance tags) | |
9197 | tags)) | |
20908596 CD |
9198 | ((not org-use-tag-inheritance) nil) |
9199 | ((stringp org-use-tag-inheritance) | |
9200 | (delq nil (mapcar | |
ff4be292 CD |
9201 | (lambda (x) |
9202 | (if (and (string-match org-use-tag-inheritance x) | |
9203 | (not (member x org-tags-exclude-from-inheritance))) | |
9204 | x nil)) | |
20908596 CD |
9205 | tags))) |
9206 | ((listp org-use-tag-inheritance) | |
621f83e4 | 9207 | (delq nil (mapcar |
ff4be292 CD |
9208 | (lambda (x) |
9209 | (if (member x org-use-tag-inheritance) x nil)) | |
621f83e4 | 9210 | tags))))) |
2a57416f | 9211 | |
20908596 CD |
9212 | (defvar todo-only) ;; dynamically scoped |
9213 | ||
9214 | (defun org-tags-sparse-tree (&optional todo-only match) | |
d60b1ba1 | 9215 | "Create a sparse tree according to tags string MATCH. |
20908596 CD |
9216 | MATCH can contain positive and negative selection of tags, like |
9217 | \"+WORK+URGENT-WITHBOSS\". | |
d60b1ba1 | 9218 | If optional argument TODO-ONLY is non-nil, only select lines that are |
20908596 CD |
9219 | also TODO lines." |
9220 | (interactive "P") | |
9221 | (org-prepare-agenda-buffers (list (current-buffer))) | |
9222 | (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) | |
15841868 | 9223 | |
20908596 CD |
9224 | (defvar org-cached-props nil) |
9225 | (defun org-cached-entry-get (pom property) | |
9226 | (if (or (eq t org-use-property-inheritance) | |
9227 | (and (stringp org-use-property-inheritance) | |
9228 | (string-match org-use-property-inheritance property)) | |
9229 | (and (listp org-use-property-inheritance) | |
9230 | (member property org-use-property-inheritance))) | |
9231 | ;; Caching is not possible, check it directly | |
9232 | (org-entry-get pom property 'inherit) | |
9233 | ;; Get all properties, so that we can do complicated checks easily | |
9234 | (cdr (assoc property (or org-cached-props | |
9235 | (setq org-cached-props | |
9236 | (org-entry-properties pom))))))) | |
15841868 | 9237 | |
20908596 CD |
9238 | (defun org-global-tags-completion-table (&optional files) |
9239 | "Return the list of all tags in all agenda buffer/files." | |
9240 | (save-excursion | |
9241 | (org-uniquify | |
9242 | (delq nil | |
9243 | (apply 'append | |
9244 | (mapcar | |
9245 | (lambda (file) | |
9246 | (set-buffer (find-file-noselect file)) | |
9247 | (append (org-get-buffer-tags) | |
9248 | (mapcar (lambda (x) (if (stringp (car-safe x)) | |
9249 | (list (car-safe x)) nil)) | |
9250 | org-tag-alist))) | |
9251 | (if (and files (car files)) | |
9252 | files | |
9253 | (org-agenda-files)))))))) | |
2a57416f | 9254 | |
20908596 CD |
9255 | (defun org-make-tags-matcher (match) |
9256 | "Create the TAGS//TODO matcher form for the selection string MATCH." | |
9257 | ;; todo-only is scoped dynamically into this function, and the function | |
9258 | ;; may change it it the matcher asksk for it. | |
9259 | (unless match | |
9260 | ;; Get a new match request, with completion | |
9261 | (let ((org-last-tags-completion-table | |
9262 | (org-global-tags-completion-table))) | |
ce4fdcb9 | 9263 | (setq match (org-ido-completing-read |
20908596 CD |
9264 | "Match: " 'org-tags-completion-function nil nil nil |
9265 | 'org-tags-history)))) | |
15841868 | 9266 | |
20908596 CD |
9267 | ;; Parse the string and create a lisp form |
9268 | (let ((match0 match) | |
9269 | (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)")) | |
9270 | minus tag mm | |
9271 | tagsmatch todomatch tagsmatcher todomatcher kwd matcher | |
621f83e4 | 9272 | orterms term orlist re-p str-p level-p level-op time-p |
93b62de8 | 9273 | prop-p pn pv po cat-p gv rest) |
20908596 CD |
9274 | (if (string-match "/+" match) |
9275 | ;; match contains also a todo-matching request | |
9276 | (progn | |
9277 | (setq tagsmatch (substring match 0 (match-beginning 0)) | |
9278 | todomatch (substring match (match-end 0))) | |
9279 | (if (string-match "^!" todomatch) | |
9280 | (setq todo-only t todomatch (substring todomatch 1))) | |
9281 | (if (string-match "^\\s-*$" todomatch) | |
9282 | (setq todomatch nil))) | |
9283 | ;; only matching tags | |
9284 | (setq tagsmatch match todomatch nil)) | |
15841868 | 9285 | |
20908596 CD |
9286 | ;; Make the tags matcher |
9287 | (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) | |
9288 | (setq tagsmatcher t) | |
9289 | (setq orterms (org-split-string tagsmatch "|") orlist nil) | |
9290 | (while (setq term (pop orterms)) | |
9291 | (while (and (equal (substring term -1) "\\") orterms) | |
9292 | (setq term (concat term "|" (pop orterms)))) ; repair bad split | |
9293 | (while (string-match re term) | |
93b62de8 CD |
9294 | (setq rest (substring term (match-end 0)) |
9295 | minus (and (match-end 1) | |
20908596 CD |
9296 | (equal (match-string 1 term) "-")) |
9297 | tag (match-string 2 term) | |
9298 | re-p (equal (string-to-char tag) ?{) | |
9299 | level-p (match-end 4) | |
9300 | prop-p (match-end 5) | |
9301 | mm (cond | |
9302 | (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) | |
9303 | (level-p | |
9304 | (setq level-op (org-op-to-function (match-string 3 term))) | |
9305 | `(,level-op level ,(string-to-number | |
9306 | (match-string 4 term)))) | |
9307 | (prop-p | |
9308 | (setq pn (match-string 5 term) | |
9309 | po (match-string 6 term) | |
9310 | pv (match-string 7 term) | |
9311 | cat-p (equal pn "CATEGORY") | |
9312 | re-p (equal (string-to-char pv) ?{) | |
9313 | str-p (equal (string-to-char pv) ?\") | |
93b62de8 CD |
9314 | time-p (save-match-data |
9315 | (string-match "^\"[[<].*[]>]\"$" pv)) | |
20908596 | 9316 | pv (if (or re-p str-p) (substring pv 1 -1) pv)) |
2c3ad40d CD |
9317 | (if time-p (setq pv (org-matcher-time pv))) |
9318 | (setq po (org-op-to-function po (if time-p 'time str-p))) | |
93b62de8 CD |
9319 | (cond |
9320 | ((equal pn "CATEGORY") | |
9321 | (setq gv '(get-text-property (point) 'org-category))) | |
9322 | ((equal pn "TODO") | |
9323 | (setq gv 'todo)) | |
9324 | (t | |
9325 | (setq gv `(org-cached-entry-get nil ,pn)))) | |
20908596 CD |
9326 | (if re-p |
9327 | (if (eq po 'org<>) | |
9328 | `(not (string-match ,pv (or ,gv ""))) | |
9329 | `(string-match ,pv (or ,gv ""))) | |
9330 | (if str-p | |
9331 | `(,po (or ,gv "") ,pv) | |
9332 | `(,po (string-to-number (or ,gv "")) | |
9333 | ,(string-to-number pv) )))) | |
9334 | (t `(member ,(downcase tag) tags-list))) | |
9335 | mm (if minus (list 'not mm) mm) | |
93b62de8 | 9336 | term rest) |
20908596 CD |
9337 | (push mm tagsmatcher)) |
9338 | (push (if (> (length tagsmatcher) 1) | |
9339 | (cons 'and tagsmatcher) | |
9340 | (car tagsmatcher)) | |
9341 | orlist) | |
9342 | (setq tagsmatcher nil)) | |
9343 | (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) | |
9344 | (setq tagsmatcher | |
9345 | (list 'progn '(setq org-cached-props nil) tagsmatcher))) | |
9346 | ;; Make the todo matcher | |
9347 | (if (or (not todomatch) (not (string-match "\\S-" todomatch))) | |
9348 | (setq todomatcher t) | |
9349 | (setq orterms (org-split-string todomatch "|") orlist nil) | |
9350 | (while (setq term (pop orterms)) | |
9351 | (while (string-match re term) | |
9352 | (setq minus (and (match-end 1) | |
9353 | (equal (match-string 1 term) "-")) | |
9354 | kwd (match-string 2 term) | |
9355 | re-p (equal (string-to-char kwd) ?{) | |
9356 | term (substring term (match-end 0)) | |
9357 | mm (if re-p | |
9358 | `(string-match ,(substring kwd 1 -1) todo) | |
9359 | (list 'equal 'todo kwd)) | |
9360 | mm (if minus (list 'not mm) mm)) | |
9361 | (push mm todomatcher)) | |
9362 | (push (if (> (length todomatcher) 1) | |
9363 | (cons 'and todomatcher) | |
9364 | (car todomatcher)) | |
9365 | orlist) | |
9366 | (setq todomatcher nil)) | |
9367 | (setq todomatcher (if (> (length orlist) 1) | |
9368 | (cons 'or orlist) (car orlist)))) | |
a3fbe8c4 | 9369 | |
20908596 CD |
9370 | ;; Return the string and lisp forms of the matcher |
9371 | (setq matcher (if todomatcher | |
9372 | (list 'and tagsmatcher todomatcher) | |
9373 | tagsmatcher)) | |
9374 | (cons match0 matcher))) | |
d3f4dbe8 | 9375 | |
20908596 | 9376 | (defun org-op-to-function (op &optional stringp) |
2c3ad40d | 9377 | "Turn an operator into the appropriate function." |
20908596 CD |
9378 | (setq op |
9379 | (cond | |
2c3ad40d CD |
9380 | ((equal op "<" ) '(< string< org-time<)) |
9381 | ((equal op ">" ) '(> org-string> org-time>)) | |
9382 | ((member op '("<=" "=<")) '(<= org-string<= org-time<=)) | |
9383 | ((member op '(">=" "=>")) '(>= org-string>= org-time>=)) | |
9384 | ((member op '("=" "==")) '(= string= org-time=)) | |
9385 | ((member op '("<>" "!=")) '(org<> org-string<> org-time<>)))) | |
9386 | (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op)) | |
20908596 CD |
9387 | |
9388 | (defun org<> (a b) (not (= a b))) | |
9389 | (defun org-string<= (a b) (or (string= a b) (string< a b))) | |
9390 | (defun org-string>= (a b) (not (string< a b))) | |
9391 | (defun org-string> (a b) (and (not (string= a b)) (not (string< a b)))) | |
9392 | (defun org-string<> (a b) (not (string= a b))) | |
2c3ad40d CD |
9393 | (defun org-time= (a b) (= (org-2ft a) (org-2ft b))) |
9394 | (defun org-time< (a b) (< (org-2ft a) (org-2ft b))) | |
9395 | (defun org-time<= (a b) (<= (org-2ft a) (org-2ft b))) | |
9396 | (defun org-time> (a b) (> (org-2ft a) (org-2ft b))) | |
9397 | (defun org-time>= (a b) (>= (org-2ft a) (org-2ft b))) | |
9398 | (defun org-time<> (a b) (org<> (org-2ft a) (org-2ft b))) | |
9399 | (defun org-2ft (s) | |
9400 | "Convert S to a floating point time. | |
9401 | If S is already a number, just return it. If it is a string, parse | |
9402 | it as a time string and apply `float-time' to it. f S is nil, just return 0." | |
9403 | (cond | |
9404 | ((numberp s) s) | |
9405 | ((stringp s) | |
9406 | (condition-case nil | |
9407 | (float-time (apply 'encode-time (org-parse-time-string s))) | |
9408 | (error 0.))) | |
9409 | (t 0.))) | |
9410 | ||
ce4fdcb9 CD |
9411 | (defun org-time-today () |
9412 | "Time in seconds today at 0:00. | |
9413 | Returns the float number of seconds since the beginning of the | |
9414 | epoch to the beginning of today (00:00)." | |
9415 | (float-time (apply 'encode-time | |
9416 | (append '(0 0 0) (nthcdr 3 (decode-time)))))) | |
9417 | ||
2c3ad40d | 9418 | (defun org-matcher-time (s) |
ff4be292 CD |
9419 | "Interprete a time comparison value." |
9420 | (save-match-data | |
9421 | (cond | |
9422 | ((string= s "<now>") (float-time)) | |
9423 | ((string= s "<today>") (org-time-today)) | |
9424 | ((string= s "<tomorrow>") (+ 86400.0 (org-time-today))) | |
9425 | ((string= s "<yesterday>") (- (org-time-today) 86400.0)) | |
9426 | ((string-match "^<\\([-+][0-9]+\\)\\([dwmy]\\)>$" s) | |
9427 | (+ (org-time-today) | |
9428 | (* (string-to-number (match-string 1 s)) | |
9429 | (cdr (assoc (match-string 2 s) | |
9430 | '(("d" . 86400.0) ("w" . 604800.0) | |
9431 | ("m" . 2678400.0) ("y" . 31557600.0))))))) | |
9432 | (t (org-2ft s))))) | |
15841868 | 9433 | |
20908596 CD |
9434 | (defun org-match-any-p (re list) |
9435 | "Does re match any element of list?" | |
9436 | (setq list (mapcar (lambda (x) (string-match re x)) list)) | |
9437 | (delq nil list)) | |
15841868 | 9438 | |
20908596 CD |
9439 | (defvar org-add-colon-after-tag-completion nil) ;; dynamically skoped param |
9440 | (defvar org-tags-overlay (org-make-overlay 1 1)) | |
9441 | (org-detach-overlay org-tags-overlay) | |
e0e66b8e | 9442 | |
621f83e4 CD |
9443 | (defun org-get-local-tags-at (&optional pos) |
9444 | "Get a list of tags defined in the current headline." | |
9445 | (org-get-tags-at pos 'local)) | |
9446 | ||
9447 | (defun org-get-local-tags () | |
9448 | "Get a list of tags defined in the current headline." | |
9449 | (org-get-tags-at nil 'local)) | |
9450 | ||
9451 | (defun org-get-tags-at (&optional pos local) | |
20908596 CD |
9452 | "Get a list of all headline tags applicable at POS. |
9453 | POS defaults to point. If tags are inherited, the list contains | |
9454 | the targets in the same sequence as the headlines appear, i.e. | |
621f83e4 CD |
9455 | the tags of the current headline come last. |
9456 | When LOCAL is non-nil, only return tags from the current headline, | |
9457 | ignore inherited ones." | |
d3f4dbe8 | 9458 | (interactive) |
20908596 | 9459 | (let (tags ltags lastpos parent) |
d3f4dbe8 | 9460 | (save-excursion |
20908596 CD |
9461 | (save-restriction |
9462 | (widen) | |
9463 | (goto-char (or pos (point))) | |
9464 | (save-match-data | |
621f83e4 CD |
9465 | (catch 'done |
9466 | (condition-case nil | |
9467 | (progn | |
9468 | (org-back-to-heading t) | |
9469 | (while (not (equal lastpos (point))) | |
9470 | (setq lastpos (point)) | |
9471 | (when (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) | |
9472 | (setq ltags (org-split-string | |
9473 | (org-match-string-no-properties 1) ":")) | |
ff4be292 CD |
9474 | (when parent |
9475 | (setq ltags (mapcar 'org-add-prop-inherited ltags))) | |
621f83e4 CD |
9476 | (setq tags (append |
9477 | (if parent | |
9478 | (org-remove-uniherited-tags ltags) | |
9479 | ltags) | |
9480 | tags))) | |
9481 | (or org-use-tag-inheritance (throw 'done t)) | |
9482 | (if local (throw 'done t)) | |
9483 | (org-up-heading-all 1) | |
9484 | (setq parent t))) | |
9485 | (error nil))))) | |
b349f79f | 9486 | (append (org-remove-uniherited-tags org-file-tags) tags)))) |
d3f4dbe8 | 9487 | |
ff4be292 CD |
9488 | (defun org-add-prop-inherited (s) |
9489 | (add-text-properties 0 (length s) '(inherited t) s) | |
9490 | s) | |
9491 | ||
20908596 CD |
9492 | (defun org-toggle-tag (tag &optional onoff) |
9493 | "Toggle the tag TAG for the current line. | |
9494 | If ONOFF is `on' or `off', don't toggle but set to this state." | |
9495 | (unless (org-on-heading-p t) (error "Not on headling")) | |
9496 | (let (res current) | |
15841868 | 9497 | (save-excursion |
20908596 CD |
9498 | (beginning-of-line) |
9499 | (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") | |
9500 | (point-at-eol) t) | |
9501 | (progn | |
9502 | (setq current (match-string 1)) | |
9503 | (replace-match "")) | |
9504 | (setq current "")) | |
9505 | (setq current (nreverse (org-split-string current ":"))) | |
9506 | (cond | |
9507 | ((eq onoff 'on) | |
9508 | (setq res t) | |
9509 | (or (member tag current) (push tag current))) | |
9510 | ((eq onoff 'off) | |
9511 | (or (not (member tag current)) (setq current (delete tag current)))) | |
9512 | (t (if (member tag current) | |
9513 | (setq current (delete tag current)) | |
9514 | (setq res t) | |
9515 | (push tag current)))) | |
15841868 | 9516 | (end-of-line 1) |
20908596 CD |
9517 | (if current |
9518 | (progn | |
9519 | (insert " :" (mapconcat 'identity (nreverse current) ":") ":") | |
9520 | (org-set-tags nil t)) | |
9521 | (delete-horizontal-space)) | |
9522 | (run-hooks 'org-after-tags-change-hook)) | |
9523 | res)) | |
15841868 | 9524 | |
20908596 CD |
9525 | (defun org-align-tags-here (to-col) |
9526 | ;; Assumes that this is a headline | |
9527 | (let ((pos (point)) (col (current-column)) ncol tags-l p) | |
891f4676 | 9528 | (beginning-of-line 1) |
20908596 CD |
9529 | (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) |
9530 | (< pos (match-beginning 2))) | |
9531 | (progn | |
9532 | (setq tags-l (- (match-end 2) (match-beginning 2))) | |
9533 | (goto-char (match-beginning 1)) | |
9534 | (insert " ") | |
9535 | (delete-region (point) (1+ (match-beginning 2))) | |
9536 | (setq ncol (max (1+ (current-column)) | |
9537 | (1+ col) | |
9538 | (if (> to-col 0) | |
9539 | to-col | |
9540 | (- (abs to-col) tags-l)))) | |
9541 | (setq p (point)) | |
9542 | (insert (make-string (- ncol (current-column)) ?\ )) | |
9543 | (setq ncol (current-column)) | |
b349f79f | 9544 | (when indent-tabs-mode (tabify p (point-at-eol))) |
20908596 CD |
9545 | (org-move-to-column (min ncol col) t)) |
9546 | (goto-char pos)))) | |
2a57416f | 9547 | |
71d35b24 CD |
9548 | (defun org-set-tags-command (&optional arg just-align) |
9549 | "Call the set-tags command for the current entry." | |
9550 | (interactive "P") | |
9551 | (if (org-on-heading-p) | |
9552 | (org-set-tags arg just-align) | |
9553 | (save-excursion | |
9554 | (org-back-to-heading t) | |
9555 | (org-set-tags arg just-align)))) | |
9556 | ||
20908596 CD |
9557 | (defun org-set-tags (&optional arg just-align) |
9558 | "Set the tags for the current headline. | |
9559 | With prefix ARG, realign all tags in headings in the current buffer." | |
9560 | (interactive "P") | |
9561 | (let* ((re (concat "^" outline-regexp)) | |
9562 | (current (org-get-tags-string)) | |
9563 | (col (current-column)) | |
9564 | (org-setting-tags t) | |
9565 | table current-tags inherited-tags ; computed below when needed | |
9566 | tags p0 c0 c1 rpl) | |
9567 | (if arg | |
9568 | (save-excursion | |
2a57416f | 9569 | (goto-char (point-min)) |
20908596 CD |
9570 | (let ((buffer-invisibility-spec (org-inhibit-invisibility))) |
9571 | (while (re-search-forward re nil t) | |
9572 | (org-set-tags nil t) | |
9573 | (end-of-line 1))) | |
9574 | (message "All tags realigned to column %d" org-tags-column)) | |
9575 | (if just-align | |
9576 | (setq tags current) | |
9577 | ;; Get a new set of tags from the user | |
9578 | (save-excursion | |
9579 | (setq table (or org-tag-alist (org-get-buffer-tags)) | |
9580 | org-last-tags-completion-table table | |
9581 | current-tags (org-split-string current ":") | |
9582 | inherited-tags (nreverse | |
9583 | (nthcdr (length current-tags) | |
9584 | (nreverse (org-get-tags-at)))) | |
9585 | tags | |
9586 | (if (or (eq t org-use-fast-tag-selection) | |
9587 | (and org-use-fast-tag-selection | |
9588 | (delq nil (mapcar 'cdr table)))) | |
9589 | (org-fast-tag-selection | |
9590 | current-tags inherited-tags table | |
9591 | (if org-fast-tag-selection-include-todo org-todo-key-alist)) | |
9592 | (let ((org-add-colon-after-tag-completion t)) | |
9593 | (org-trim | |
9594 | (org-without-partial-completion | |
ce4fdcb9 | 9595 | (org-ido-completing-read "Tags: " 'org-tags-completion-function |
20908596 CD |
9596 | nil nil current 'org-tags-history))))))) |
9597 | (while (string-match "[-+&]+" tags) | |
9598 | ;; No boolean logic, just a list | |
9599 | (setq tags (replace-match ":" t t tags)))) | |
64f72ae1 | 9600 | |
20908596 CD |
9601 | (if (string-match "\\`[\t ]*\\'" tags) |
9602 | (setq tags "") | |
9603 | (unless (string-match ":$" tags) (setq tags (concat tags ":"))) | |
9604 | (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) | |
891f4676 | 9605 | |
20908596 CD |
9606 | ;; Insert new tags at the correct column |
9607 | (beginning-of-line 1) | |
9608 | (cond | |
9609 | ((and (equal current "") (equal tags ""))) | |
9610 | ((re-search-forward | |
9611 | (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") | |
9612 | (point-at-eol) t) | |
9613 | (if (equal tags "") | |
9614 | (setq rpl "") | |
9615 | (goto-char (match-beginning 0)) | |
9616 | (setq c0 (current-column) p0 (point) | |
9617 | c1 (max (1+ c0) (if (> org-tags-column 0) | |
9618 | org-tags-column | |
9619 | (- (- org-tags-column) (length tags)))) | |
9620 | rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) | |
9621 | (replace-match rpl t t) | |
9622 | (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) | |
9623 | tags) | |
9624 | (t (error "Tags alignment failed"))) | |
9625 | (org-move-to-column col) | |
9626 | (unless just-align | |
9627 | (run-hooks 'org-after-tags-change-hook))))) | |
891f4676 | 9628 | |
20908596 CD |
9629 | (defun org-change-tag-in-region (beg end tag off) |
9630 | "Add or remove TAG for each entry in the region. | |
9631 | This works in the agenda, and also in an org-mode buffer." | |
9632 | (interactive | |
9633 | (list (region-beginning) (region-end) | |
9634 | (let ((org-last-tags-completion-table | |
9635 | (if (org-mode-p) | |
9636 | (org-get-buffer-tags) | |
9637 | (org-global-tags-completion-table)))) | |
ce4fdcb9 | 9638 | (org-ido-completing-read |
20908596 CD |
9639 | "Tag: " 'org-tags-completion-function nil nil nil |
9640 | 'org-tags-history)) | |
9641 | (progn | |
9642 | (message "[s]et or [r]emove? ") | |
9643 | (equal (read-char-exclusive) ?r)))) | |
9644 | (if (fboundp 'deactivate-mark) (deactivate-mark)) | |
9645 | (let ((agendap (equal major-mode 'org-agenda-mode)) | |
9646 | l1 l2 m buf pos newhead (cnt 0)) | |
9647 | (goto-char end) | |
9648 | (setq l2 (1- (org-current-line))) | |
9649 | (goto-char beg) | |
9650 | (setq l1 (org-current-line)) | |
9651 | (loop for l from l1 to l2 do | |
9652 | (goto-line l) | |
9653 | (setq m (get-text-property (point) 'org-hd-marker)) | |
9654 | (when (or (and (org-mode-p) (org-on-heading-p)) | |
9655 | (and agendap m)) | |
9656 | (setq buf (if agendap (marker-buffer m) (current-buffer)) | |
9657 | pos (if agendap m (point))) | |
9658 | (with-current-buffer buf | |
9659 | (save-excursion | |
9660 | (save-restriction | |
9661 | (goto-char pos) | |
9662 | (setq cnt (1+ cnt)) | |
9663 | (org-toggle-tag tag (if off 'off 'on)) | |
9664 | (setq newhead (org-get-heading))))) | |
9665 | (and agendap (org-agenda-change-all-lines newhead m)))) | |
9666 | (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) | |
891f4676 | 9667 | |
20908596 CD |
9668 | (defun org-tags-completion-function (string predicate &optional flag) |
9669 | (let (s1 s2 rtn (ctable org-last-tags-completion-table) | |
9670 | (confirm (lambda (x) (stringp (car x))))) | |
9671 | (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) | |
9672 | (setq s1 (match-string 1 string) | |
9673 | s2 (match-string 2 string)) | |
9674 | (setq s1 "" s2 string)) | |
9675 | (cond | |
9676 | ((eq flag nil) | |
9677 | ;; try completion | |
9678 | (setq rtn (try-completion s2 ctable confirm)) | |
9679 | (if (stringp rtn) | |
9680 | (setq rtn | |
9681 | (concat s1 s2 (substring rtn (length s2)) | |
9682 | (if (and org-add-colon-after-tag-completion | |
9683 | (assoc rtn ctable)) | |
9684 | ":" "")))) | |
9685 | rtn) | |
9686 | ((eq flag t) | |
9687 | ;; all-completions | |
9688 | (all-completions s2 ctable confirm) | |
9689 | ) | |
9690 | ((eq flag 'lambda) | |
9691 | ;; exact match? | |
9692 | (assoc s2 ctable))) | |
d3f4dbe8 | 9693 | )) |
ab27a4a0 | 9694 | |
20908596 CD |
9695 | (defun org-fast-tag-insert (kwd tags face &optional end) |
9696 | "Insert KDW, and the TAGS, the latter with face FACE. Also inser END." | |
9697 | (insert (format "%-12s" (concat kwd ":")) | |
9698 | (org-add-props (mapconcat 'identity tags " ") nil 'face face) | |
9699 | (or end ""))) | |
891f4676 | 9700 | |
20908596 CD |
9701 | (defun org-fast-tag-show-exit (flag) |
9702 | (save-excursion | |
9703 | (goto-line 3) | |
9704 | (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) | |
9705 | (replace-match "")) | |
9706 | (when flag | |
9707 | (end-of-line 1) | |
9708 | (org-move-to-column (- (window-width) 19) t) | |
9709 | (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) | |
64f72ae1 | 9710 | |
20908596 CD |
9711 | (defun org-set-current-tags-overlay (current prefix) |
9712 | (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) | |
9713 | (if (featurep 'xemacs) | |
9714 | (org-overlay-display org-tags-overlay (concat prefix s) | |
9715 | 'secondary-selection) | |
9716 | (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) | |
9717 | (org-overlay-display org-tags-overlay (concat prefix s))))) | |
891f4676 | 9718 | |
20908596 CD |
9719 | (defun org-fast-tag-selection (current inherited table &optional todo-table) |
9720 | "Fast tag selection with single keys. | |
9721 | CURRENT is the current list of tags in the headline, INHERITED is the | |
9722 | list of inherited tags, and TABLE is an alist of tags and corresponding keys, | |
9723 | possibly with grouping information. TODO-TABLE is a similar table with | |
9724 | TODO keywords, should these have keys assigned to them. | |
9725 | If the keys are nil, a-z are automatically assigned. | |
9726 | Returns the new tags string, or nil to not change the current settings." | |
9727 | (let* ((fulltable (append table todo-table)) | |
9728 | (maxlen (apply 'max (mapcar | |
9729 | (lambda (x) | |
9730 | (if (stringp (car x)) (string-width (car x)) 0)) | |
9731 | fulltable))) | |
9732 | (buf (current-buffer)) | |
9733 | (expert (eq org-fast-tag-selection-single-key 'expert)) | |
9734 | (buffer-tags nil) | |
9735 | (fwidth (+ maxlen 3 1 3)) | |
9736 | (ncol (/ (- (window-width) 4) fwidth)) | |
9737 | (i-face 'org-done) | |
9738 | (c-face 'org-todo) | |
9739 | tg cnt e c char c1 c2 ntable tbl rtn | |
9740 | ov-start ov-end ov-prefix | |
9741 | (exit-after-next org-fast-tag-selection-single-key) | |
9742 | (done-keywords org-done-keywords) | |
9743 | groups ingroup) | |
9744 | (save-excursion | |
9745 | (beginning-of-line 1) | |
9746 | (if (looking-at | |
9747 | (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) | |
9748 | (setq ov-start (match-beginning 1) | |
9749 | ov-end (match-end 1) | |
9750 | ov-prefix "") | |
9751 | (setq ov-start (1- (point-at-eol)) | |
9752 | ov-end (1+ ov-start)) | |
9753 | (skip-chars-forward "^\n\r") | |
9754 | (setq ov-prefix | |
9755 | (concat | |
9756 | (buffer-substring (1- (point)) (point)) | |
9757 | (if (> (current-column) org-tags-column) | |
9758 | " " | |
9759 | (make-string (- org-tags-column (current-column)) ?\ )))))) | |
9760 | (org-move-overlay org-tags-overlay ov-start ov-end) | |
9761 | (save-window-excursion | |
9762 | (if expert | |
9763 | (set-buffer (get-buffer-create " *Org tags*")) | |
03f3cf35 | 9764 | (delete-other-windows) |
20908596 CD |
9765 | (split-window-vertically) |
9766 | (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) | |
9767 | (erase-buffer) | |
9768 | (org-set-local 'org-done-keywords done-keywords) | |
9769 | (org-fast-tag-insert "Inherited" inherited i-face "\n") | |
9770 | (org-fast-tag-insert "Current" current c-face "\n\n") | |
9771 | (org-fast-tag-show-exit exit-after-next) | |
9772 | (org-set-current-tags-overlay current ov-prefix) | |
9773 | (setq tbl fulltable char ?a cnt 0) | |
9774 | (while (setq e (pop tbl)) | |
9775 | (cond | |
9776 | ((equal e '(:startgroup)) | |
9777 | (push '() groups) (setq ingroup t) | |
9778 | (when (not (= cnt 0)) | |
9779 | (setq cnt 0) | |
9780 | (insert "\n")) | |
9781 | (insert "{ ")) | |
9782 | ((equal e '(:endgroup)) | |
9783 | (setq ingroup nil cnt 0) | |
9784 | (insert "}\n")) | |
9785 | (t | |
9786 | (setq tg (car e) c2 nil) | |
9787 | (if (cdr e) | |
9788 | (setq c (cdr e)) | |
9789 | ;; automatically assign a character. | |
9790 | (setq c1 (string-to-char | |
9791 | (downcase (substring | |
9792 | tg (if (= (string-to-char tg) ?@) 1 0))))) | |
9793 | (if (or (rassoc c1 ntable) (rassoc c1 table)) | |
9794 | (while (or (rassoc char ntable) (rassoc char table)) | |
9795 | (setq char (1+ char))) | |
9796 | (setq c2 c1)) | |
9797 | (setq c (or c2 char))) | |
9798 | (if ingroup (push tg (car groups))) | |
9799 | (setq tg (org-add-props tg nil 'face | |
9800 | (cond | |
9801 | ((not (assoc tg table)) | |
9802 | (org-get-todo-face tg)) | |
9803 | ((member tg current) c-face) | |
9804 | ((member tg inherited) i-face) | |
9805 | (t nil)))) | |
9806 | (if (and (= cnt 0) (not ingroup)) (insert " ")) | |
9807 | (insert "[" c "] " tg (make-string | |
9808 | (- fwidth 4 (length tg)) ?\ )) | |
9809 | (push (cons tg c) ntable) | |
9810 | (when (= (setq cnt (1+ cnt)) ncol) | |
9811 | (insert "\n") | |
9812 | (if ingroup (insert " ")) | |
9813 | (setq cnt 0))))) | |
9814 | (setq ntable (nreverse ntable)) | |
9815 | (insert "\n") | |
9816 | (goto-char (point-min)) | |
93b62de8 | 9817 | (if (not expert) (org-fit-window-to-buffer)) |
20908596 CD |
9818 | (setq rtn |
9819 | (catch 'exit | |
9820 | (while t | |
9821 | (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s" | |
9822 | (if groups " [!] no groups" " [!]groups") | |
9823 | (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) | |
9824 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
03f3cf35 | 9825 | (cond |
20908596 CD |
9826 | ((= c ?\r) (throw 'exit t)) |
9827 | ((= c ?!) | |
9828 | (setq groups (not groups)) | |
9829 | (goto-char (point-min)) | |
9830 | (while (re-search-forward "[{}]" nil t) (replace-match " "))) | |
9831 | ((= c ?\C-c) | |
9832 | (if (not expert) | |
9833 | (org-fast-tag-show-exit | |
9834 | (setq exit-after-next (not exit-after-next))) | |
9835 | (setq expert nil) | |
9836 | (delete-other-windows) | |
9837 | (split-window-vertically) | |
9838 | (org-switch-to-buffer-other-window " *Org tags*") | |
93b62de8 | 9839 | (org-fit-window-to-buffer))) |
20908596 CD |
9840 | ((or (= c ?\C-g) |
9841 | (and (= c ?q) (not (rassoc c ntable)))) | |
9842 | (org-detach-overlay org-tags-overlay) | |
9843 | (setq quit-flag t)) | |
9844 | ((= c ?\ ) | |
9845 | (setq current nil) | |
9846 | (if exit-after-next (setq exit-after-next 'now))) | |
9847 | ((= c ?\t) | |
9848 | (condition-case nil | |
ce4fdcb9 | 9849 | (setq tg (org-ido-completing-read |
20908596 CD |
9850 | "Tag: " |
9851 | (or buffer-tags | |
9852 | (with-current-buffer buf | |
9853 | (org-get-buffer-tags))))) | |
9854 | (quit (setq tg ""))) | |
9855 | (when (string-match "\\S-" tg) | |
9856 | (add-to-list 'buffer-tags (list tg)) | |
9857 | (if (member tg current) | |
9858 | (setq current (delete tg current)) | |
9859 | (push tg current))) | |
9860 | (if exit-after-next (setq exit-after-next 'now))) | |
9861 | ((setq e (rassoc c todo-table) tg (car e)) | |
9862 | (with-current-buffer buf | |
9863 | (save-excursion (org-todo tg))) | |
9864 | (if exit-after-next (setq exit-after-next 'now))) | |
9865 | ((setq e (rassoc c ntable) tg (car e)) | |
9866 | (if (member tg current) | |
9867 | (setq current (delete tg current)) | |
9868 | (loop for g in groups do | |
9869 | (if (member tg g) | |
9870 | (mapc (lambda (x) | |
9871 | (setq current (delete x current))) | |
9872 | g))) | |
9873 | (push tg current)) | |
9874 | (if exit-after-next (setq exit-after-next 'now)))) | |
a3fbe8c4 | 9875 | |
20908596 CD |
9876 | ;; Create a sorted list |
9877 | (setq current | |
9878 | (sort current | |
9879 | (lambda (a b) | |
9880 | (assoc b (cdr (memq (assoc a ntable) ntable)))))) | |
9881 | (if (eq exit-after-next 'now) (throw 'exit t)) | |
9882 | (goto-char (point-min)) | |
9883 | (beginning-of-line 2) | |
9884 | (delete-region (point) (point-at-eol)) | |
9885 | (org-fast-tag-insert "Current" current c-face) | |
9886 | (org-set-current-tags-overlay current ov-prefix) | |
9887 | (while (re-search-forward | |
9888 | (org-re "\\[.\\] \\([[:alnum:]_@]+\\)") nil t) | |
9889 | (setq tg (match-string 1)) | |
9890 | (add-text-properties | |
9891 | (match-beginning 1) (match-end 1) | |
9892 | (list 'face | |
9893 | (cond | |
9894 | ((member tg current) c-face) | |
9895 | ((member tg inherited) i-face) | |
9896 | (t (get-text-property (match-beginning 1) 'face)))))) | |
9897 | (goto-char (point-min))))) | |
9898 | (org-detach-overlay org-tags-overlay) | |
9899 | (if rtn | |
9900 | (mapconcat 'identity current ":") | |
9901 | nil)))) | |
a3fbe8c4 | 9902 | |
20908596 CD |
9903 | (defun org-get-tags-string () |
9904 | "Get the TAGS string in the current headline." | |
9905 | (unless (org-on-heading-p t) | |
9906 | (error "Not on a heading")) | |
9907 | (save-excursion | |
9908 | (beginning-of-line 1) | |
9909 | (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) | |
9910 | (org-match-string-no-properties 1) | |
9911 | ""))) | |
a3fbe8c4 | 9912 | |
20908596 CD |
9913 | (defun org-get-tags () |
9914 | "Get the list of tags specified in the current headline." | |
9915 | (org-split-string (org-get-tags-string) ":")) | |
a3fbe8c4 | 9916 | |
20908596 CD |
9917 | (defun org-get-buffer-tags () |
9918 | "Get a table of all tags used in the buffer, for completion." | |
9919 | (let (tags) | |
2a57416f CD |
9920 | (save-excursion |
9921 | (goto-char (point-min)) | |
20908596 CD |
9922 | (while (re-search-forward |
9923 | (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t\r\n]") nil t) | |
9924 | (when (equal (char-after (point-at-bol 0)) ?*) | |
9925 | (mapc (lambda (x) (add-to-list 'tags x)) | |
9926 | (org-split-string (org-match-string-no-properties 1) ":"))))) | |
9927 | (mapcar 'list tags))) | |
9acdaa21 | 9928 | |
b349f79f CD |
9929 | ;;;; The mapping API |
9930 | ||
9931 | ;;;###autoload | |
9932 | (defun org-map-entries (func &optional match scope &rest skip) | |
9933 | "Call FUNC at each headline selected by MATCH in SCOPE. | |
9934 | ||
9935 | FUNC is a function or a lisp form. The function will be called without | |
9936 | arguments, with the cursor positioned at the beginning of the headline. | |
9937 | The return values of all calls to the function will be collected and | |
9938 | returned as a list. | |
9939 | ||
9940 | MATCH is a tags/property/todo match as it is used in the agenda tags view. | |
9941 | Only headlines that are matched by this query will be considered during | |
9942 | the iteration. When MATCH is nil or t, all headlines will be | |
9943 | visited by the iteration. | |
9944 | ||
9945 | SCOPE determines the scope of this command. It can be any of: | |
9946 | ||
9947 | nil The current buffer, respecting the restriction if any | |
9948 | tree The subtree started with the entry at point | |
9949 | file The current buffer, without restriction | |
9950 | file-with-archives | |
9951 | The current buffer, and any archives associated with it | |
9952 | agenda All agenda files | |
9953 | agenda-with-archives | |
9954 | All agenda files with any archive files associated with them | |
9955 | \(file1 file2 ...) | |
9956 | If this is a list, all files in the list will be scanned | |
9957 | ||
9958 | The remaining args are treated as settings for the skipping facilities of | |
9959 | the scanner. The following items can be given here: | |
9960 | ||
9961 | archive skip trees with the archive tag. | |
9962 | comment skip trees with the COMMENT keyword | |
9963 | function or Emacs Lisp form: | |
9964 | will be used as value for `org-agenda-skip-function', so whenever | |
9965 | the the function returns t, FUNC will not be called for that | |
9966 | entry and search will continue from the point where the | |
9967 | function leaves it." | |
2c3ad40d CD |
9968 | (let* ((org-agenda-archives-mode nil) ; just to make sure |
9969 | (org-agenda-skip-archived-trees (memq 'archive skip)) | |
b349f79f CD |
9970 | (org-agenda-skip-comment-trees (memq 'comment skip)) |
9971 | (org-agenda-skip-function | |
9972 | (car (org-delete-all '(comment archive) skip))) | |
9973 | (org-tags-match-list-sublevels t) | |
ff4be292 | 9974 | matcher pos file res |
621f83e4 CD |
9975 | org-todo-keywords-for-agenda |
9976 | org-done-keywords-for-agenda | |
9977 | org-todo-keyword-alist-for-agenda | |
9978 | org-tag-alist-for-agenda) | |
b349f79f CD |
9979 | |
9980 | (cond | |
9981 | ((eq match t) (setq matcher t)) | |
9982 | ((eq match nil) (setq matcher t)) | |
ff4be292 | 9983 | (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) |
ce4fdcb9 | 9984 | |
b349f79f CD |
9985 | (when (eq scope 'tree) |
9986 | (org-back-to-heading t) | |
9987 | (org-narrow-to-subtree) | |
9988 | (setq scope nil)) | |
ce4fdcb9 | 9989 | |
b349f79f CD |
9990 | (if (not scope) |
9991 | (progn | |
9992 | (org-prepare-agenda-buffers | |
9993 | (list (buffer-file-name (current-buffer)))) | |
9994 | (org-scan-tags func matcher)) | |
9995 | ;; Get the right scope | |
9996 | (setq pos (point)) | |
9997 | (cond | |
9998 | ((and scope (listp scope) (symbolp (car scope))) | |
9999 | (setq scope (eval scope))) | |
10000 | ((eq scope 'agenda) | |
10001 | (setq scope (org-agenda-files t))) | |
10002 | ((eq scope 'agenda-with-archives) | |
10003 | (setq scope (org-agenda-files t)) | |
10004 | (setq scope (org-add-archive-files scope))) | |
10005 | ((eq scope 'file) | |
10006 | (setq scope (list (buffer-file-name)))) | |
10007 | ((eq scope 'file-with-archives) | |
10008 | (setq scope (org-add-archive-files (list (buffer-file-name)))))) | |
10009 | (org-prepare-agenda-buffers scope) | |
10010 | (while (setq file (pop scope)) | |
10011 | (with-current-buffer (org-find-base-buffer-visiting file) | |
10012 | (save-excursion | |
10013 | (save-restriction | |
10014 | (widen) | |
10015 | (goto-char (point-min)) | |
ff4be292 CD |
10016 | (setq res (append res (org-scan-tags func matcher))))))) |
10017 | res))) | |
9acdaa21 | 10018 | |
20908596 | 10019 | ;;;; Properties |
9acdaa21 | 10020 | |
20908596 | 10021 | ;;; Setting and retrieving properties |
891f4676 | 10022 | |
20908596 | 10023 | (defconst org-special-properties |
93b62de8 | 10024 | '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" |
20908596 CD |
10025 | "TIMESTAMP" "TIMESTAMP_IA") |
10026 | "The special properties valid in Org-mode. | |
9acdaa21 | 10027 | |
20908596 CD |
10028 | These are properties that are not defined in the property drawer, |
10029 | but in some other way.") | |
9acdaa21 | 10030 | |
20908596 CD |
10031 | (defconst org-default-properties |
10032 | '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" | |
b349f79f CD |
10033 | "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" |
10034 | "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" | |
10035 | "EXPORT_FILE_NAME" "EXPORT_TITLE") | |
20908596 CD |
10036 | "Some properties that are used by Org-mode for various purposes. |
10037 | Being in this list makes sure that they are offered for completion.") | |
9acdaa21 | 10038 | |
20908596 CD |
10039 | (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" |
10040 | "Regular expression matching the first line of a property drawer.") | |
9acdaa21 | 10041 | |
20908596 CD |
10042 | (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" |
10043 | "Regular expression matching the first line of a property drawer.") | |
9acdaa21 | 10044 | |
2c3ad40d CD |
10045 | (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" |
10046 | "Regular expression matching the first line of a property drawer.") | |
10047 | ||
10048 | (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" | |
10049 | "Regular expression matching the first line of a property drawer.") | |
10050 | ||
10051 | (defconst org-property-drawer-re | |
10052 | (concat "\\(" org-property-start-re "\\)[^\000]*\\(" | |
10053 | org-property-end-re "\\)\n?") | |
10054 | "Matches an entire property drawer.") | |
10055 | ||
10056 | (defconst org-clock-drawer-re | |
10057 | (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\(" | |
10058 | org-property-end-re "\\)\n?") | |
10059 | "Matches an entire clock drawer.") | |
10060 | ||
20908596 CD |
10061 | (defun org-property-action () |
10062 | "Do an action on properties." | |
03f3cf35 | 10063 | (interactive) |
20908596 CD |
10064 | (let (c) |
10065 | (org-at-property-p) | |
10066 | (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") | |
10067 | (setq c (read-char-exclusive)) | |
10068 | (cond | |
10069 | ((equal c ?s) | |
10070 | (call-interactively 'org-set-property)) | |
10071 | ((equal c ?d) | |
10072 | (call-interactively 'org-delete-property)) | |
10073 | ((equal c ?D) | |
10074 | (call-interactively 'org-delete-property-globally)) | |
10075 | ((equal c ?c) | |
10076 | (call-interactively 'org-compute-property-at-point)) | |
10077 | (t (error "No such property action %c" c))))) | |
10078 | ||
10079 | (defun org-at-property-p () | |
10080 | "Is the cursor in a property line?" | |
10081 | ;; FIXME: Does not check if we are actually in the drawer. | |
10082 | ;; FIXME: also returns true on any drawers..... | |
10083 | ;; This is used by C-c C-c for property action. | |
03f3cf35 | 10084 | (save-excursion |
20908596 CD |
10085 | (beginning-of-line 1) |
10086 | (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")))) | |
03f3cf35 | 10087 | |
20908596 CD |
10088 | (defun org-get-property-block (&optional beg end force) |
10089 | "Return the (beg . end) range of the body of the property drawer. | |
10090 | BEG and END can be beginning and end of subtree, if not given | |
10091 | they will be found. | |
10092 | If the drawer does not exist and FORCE is non-nil, create the drawer." | |
10093 | (catch 'exit | |
d3f4dbe8 | 10094 | (save-excursion |
20908596 CD |
10095 | (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) |
10096 | (end (or end (progn (outline-next-heading) (point))))) | |
10097 | (goto-char beg) | |
10098 | (if (re-search-forward org-property-start-re end t) | |
10099 | (setq beg (1+ (match-end 0))) | |
10100 | (if force | |
10101 | (save-excursion | |
10102 | (org-insert-property-drawer) | |
10103 | (setq end (progn (outline-next-heading) (point)))) | |
10104 | (throw 'exit nil)) | |
10105 | (goto-char beg) | |
10106 | (if (re-search-forward org-property-start-re end t) | |
10107 | (setq beg (1+ (match-end 0))))) | |
10108 | (if (re-search-forward org-property-end-re end t) | |
10109 | (setq end (match-beginning 0)) | |
10110 | (or force (throw 'exit nil)) | |
10111 | (goto-char beg) | |
10112 | (setq end beg) | |
10113 | (org-indent-line-function) | |
10114 | (insert ":END:\n")) | |
10115 | (cons beg end))))) | |
a3fbe8c4 | 10116 | |
20908596 CD |
10117 | (defun org-entry-properties (&optional pom which) |
10118 | "Get all properties of the entry at point-or-marker POM. | |
10119 | This includes the TODO keyword, the tags, time strings for deadline, | |
10120 | scheduled, and clocking, and any additional properties defined in the | |
10121 | entry. The return value is an alist, keys may occur multiple times | |
10122 | if the property key was used several times. | |
10123 | POM may also be nil, in which case the current entry is used. | |
10124 | If WHICH is nil or `all', get all properties. If WHICH is | |
10125 | `special' or `standard', only get that subclass." | |
10126 | (setq which (or which 'all)) | |
10127 | (org-with-point-at pom | |
10128 | (let ((clockstr (substring org-clock-string 0 -1)) | |
10129 | (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) | |
10130 | beg end range props sum-props key value string clocksum) | |
10131 | (save-excursion | |
10132 | (when (condition-case nil (org-back-to-heading t) (error nil)) | |
10133 | (setq beg (point)) | |
10134 | (setq sum-props (get-text-property (point) 'org-summaries)) | |
10135 | (setq clocksum (get-text-property (point) :org-clock-minutes)) | |
10136 | (outline-next-heading) | |
10137 | (setq end (point)) | |
10138 | (when (memq which '(all special)) | |
10139 | ;; Get the special properties, like TODO and tags | |
10140 | (goto-char beg) | |
10141 | (when (and (looking-at org-todo-line-regexp) (match-end 2)) | |
10142 | (push (cons "TODO" (org-match-string-no-properties 2)) props)) | |
10143 | (when (looking-at org-priority-regexp) | |
10144 | (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) | |
10145 | (when (and (setq value (org-get-tags-string)) | |
10146 | (string-match "\\S-" value)) | |
10147 | (push (cons "TAGS" value) props)) | |
10148 | (when (setq value (org-get-tags-at)) | |
10149 | (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) | |
10150 | props)) | |
10151 | (while (re-search-forward org-maybe-keyword-time-regexp end t) | |
10152 | (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1)) | |
10153 | string (if (equal key clockstr) | |
10154 | (org-no-properties | |
10155 | (org-trim | |
10156 | (buffer-substring | |
10157 | (match-beginning 3) (goto-char (point-at-eol))))) | |
10158 | (substring (org-match-string-no-properties 3) 1 -1))) | |
10159 | (unless key | |
10160 | (if (= (char-after (match-beginning 3)) ?\[) | |
10161 | (setq key "TIMESTAMP_IA") | |
10162 | (setq key "TIMESTAMP"))) | |
10163 | (when (or (equal key clockstr) (not (assoc key props))) | |
10164 | (push (cons key string) props))) | |
891f4676 | 10165 | |
20908596 | 10166 | ) |
c4f9780e | 10167 | |
20908596 CD |
10168 | (when (memq which '(all standard)) |
10169 | ;; Get the standard properties, like :PORP: ... | |
10170 | (setq range (org-get-property-block beg end)) | |
10171 | (when range | |
10172 | (goto-char (car range)) | |
10173 | (while (re-search-forward | |
10174 | (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?") | |
10175 | (cdr range) t) | |
10176 | (setq key (org-match-string-no-properties 1) | |
10177 | value (org-trim (or (org-match-string-no-properties 2) ""))) | |
10178 | (unless (member key excluded) | |
10179 | (push (cons key (or value "")) props))))) | |
10180 | (if clocksum | |
10181 | (push (cons "CLOCKSUM" | |
10182 | (org-columns-number-to-string (/ (float clocksum) 60.) | |
10183 | 'add_times)) | |
10184 | props)) | |
71d35b24 CD |
10185 | (unless (assoc "CATEGORY" props) |
10186 | (setq value (or (org-get-category) | |
10187 | (progn (org-refresh-category-properties) | |
10188 | (org-get-category)))) | |
10189 | (push (cons "CATEGORY" value) props)) | |
20908596 CD |
10190 | (append sum-props (nreverse props))))))) |
10191 | ||
10192 | (defun org-entry-get (pom property &optional inherit) | |
10193 | "Get value of PROPERTY for entry at point-or-marker POM. | |
10194 | If INHERIT is non-nil and the entry does not have the property, | |
10195 | then also check higher levels of the hierarchy. | |
10196 | If INHERIT is the symbol `selective', use inheritance only if the setting | |
10197 | in `org-use-property-inheritance' selects PROPERTY for inheritance. | |
10198 | If the property is present but empty, the return value is the empty string. | |
10199 | If the property is not present at all, nil is returned." | |
10200 | (org-with-point-at pom | |
10201 | (if (and inherit (if (eq inherit 'selective) | |
10202 | (org-property-inherit-p property) | |
10203 | t)) | |
10204 | (org-entry-get-with-inheritance property) | |
10205 | (if (member property org-special-properties) | |
10206 | ;; We need a special property. Use brute force, get all properties. | |
10207 | (cdr (assoc property (org-entry-properties nil 'special))) | |
10208 | (let ((range (org-get-property-block))) | |
10209 | (if (and range | |
10210 | (goto-char (car range)) | |
10211 | (re-search-forward | |
93b62de8 | 10212 | (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)?") |
20908596 CD |
10213 | (cdr range) t)) |
10214 | ;; Found the property, return it. | |
10215 | (if (match-end 1) | |
10216 | (org-match-string-no-properties 1) | |
10217 | ""))))))) | |
10218 | ||
10219 | (defun org-property-or-variable-value (var &optional inherit) | |
10220 | "Check if there is a property fixing the value of VAR. | |
10221 | If yes, return this value. If not, return the current value of the variable." | |
10222 | (let ((prop (org-entry-get nil (symbol-name var) inherit))) | |
10223 | (if (and prop (stringp prop) (string-match "\\S-" prop)) | |
10224 | (read prop) | |
10225 | (symbol-value var)))) | |
10226 | ||
10227 | (defun org-entry-delete (pom property) | |
10228 | "Delete the property PROPERTY from entry at point-or-marker POM." | |
10229 | (org-with-point-at pom | |
10230 | (if (member property org-special-properties) | |
10231 | nil ; cannot delete these properties. | |
10232 | (let ((range (org-get-property-block))) | |
10233 | (if (and range | |
10234 | (goto-char (car range)) | |
10235 | (re-search-forward | |
93b62de8 | 10236 | (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)") |
20908596 CD |
10237 | (cdr range) t)) |
10238 | (progn | |
10239 | (delete-region (match-beginning 0) (1+ (point-at-eol))) | |
10240 | t) | |
10241 | nil))))) | |
10242 | ||
10243 | ;; Multi-values properties are properties that contain multiple values | |
10244 | ;; These values are assumed to be single words, separated by whitespace. | |
10245 | (defun org-entry-add-to-multivalued-property (pom property value) | |
10246 | "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." | |
10247 | (let* ((old (org-entry-get pom property)) | |
10248 | (values (and old (org-split-string old "[ \t]")))) | |
621f83e4 | 10249 | (setq value (org-entry-protect-space value)) |
20908596 CD |
10250 | (unless (member value values) |
10251 | (setq values (cons value values)) | |
10252 | (org-entry-put pom property | |
10253 | (mapconcat 'identity values " "))))) | |
10254 | ||
10255 | (defun org-entry-remove-from-multivalued-property (pom property value) | |
10256 | "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." | |
10257 | (let* ((old (org-entry-get pom property)) | |
10258 | (values (and old (org-split-string old "[ \t]")))) | |
621f83e4 | 10259 | (setq value (org-entry-protect-space value)) |
20908596 CD |
10260 | (when (member value values) |
10261 | (setq values (delete value values)) | |
10262 | (org-entry-put pom property | |
10263 | (mapconcat 'identity values " "))))) | |
9acdaa21 | 10264 | |
20908596 CD |
10265 | (defun org-entry-member-in-multivalued-property (pom property value) |
10266 | "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" | |
10267 | (let* ((old (org-entry-get pom property)) | |
10268 | (values (and old (org-split-string old "[ \t]")))) | |
621f83e4 | 10269 | (setq value (org-entry-protect-space value)) |
20908596 | 10270 | (member value values))) |
9acdaa21 | 10271 | |
621f83e4 CD |
10272 | (defun org-entry-get-multivalued-property (pom property) |
10273 | "Return a list of values in a multivalued property." | |
10274 | (let* ((value (org-entry-get pom property)) | |
10275 | (values (and value (org-split-string value "[ \t]")))) | |
10276 | (mapcar 'org-entry-restore-space values))) | |
10277 | ||
10278 | (defun org-entry-put-multivalued-property (pom property &rest values) | |
10279 | "Set multivalued PROPERTY at point-or-marker POM to VALUES. | |
10280 | VALUES should be a list of strings. Spaces will be protected." | |
10281 | (org-entry-put pom property | |
10282 | (mapconcat 'org-entry-protect-space values " ")) | |
10283 | (let* ((value (org-entry-get pom property)) | |
10284 | (values (and value (org-split-string value "[ \t]")))) | |
10285 | (mapcar 'org-entry-restore-space values))) | |
10286 | ||
10287 | (defun org-entry-protect-space (s) | |
10288 | "Protect spaces and newline in string S." | |
10289 | (while (string-match " " s) | |
10290 | (setq s (replace-match "%20" t t s))) | |
10291 | (while (string-match "\n" s) | |
10292 | (setq s (replace-match "%0A" t t s))) | |
10293 | s) | |
10294 | ||
10295 | (defun org-entry-restore-space (s) | |
10296 | "Restore spaces and newline in string S." | |
10297 | (while (string-match "%20" s) | |
10298 | (setq s (replace-match " " t t s))) | |
10299 | (while (string-match "%0A" s) | |
10300 | (setq s (replace-match "\n" t t s))) | |
10301 | s) | |
10302 | ||
10303 | (defvar org-entry-property-inherited-from (make-marker) | |
10304 | "Marker pointing to the entry from where a proerty was inherited. | |
10305 | Each call to `org-entry-get-with-inheritance' will set this marker to the | |
10306 | location of the entry where the inheriance search matched. If there was | |
10307 | no match, the marker will point nowhere. | |
10308 | Note that also `org-entry-get' calls this function, if the INHERIT flag | |
10309 | is set.") | |
15841868 | 10310 | |
20908596 CD |
10311 | (defun org-entry-get-with-inheritance (property) |
10312 | "Get entry property, and search higher levels if not present." | |
621f83e4 | 10313 | (move-marker org-entry-property-inherited-from nil) |
20908596 CD |
10314 | (let (tmp) |
10315 | (save-excursion | |
10316 | (save-restriction | |
10317 | (widen) | |
10318 | (catch 'ex | |
10319 | (while t | |
10320 | (when (setq tmp (org-entry-get nil property)) | |
10321 | (org-back-to-heading t) | |
10322 | (move-marker org-entry-property-inherited-from (point)) | |
10323 | (throw 'ex tmp)) | |
10324 | (or (org-up-heading-safe) (throw 'ex nil))))) | |
ce4fdcb9 | 10325 | (or tmp |
b349f79f CD |
10326 | (cdr (assoc property org-file-properties)) |
10327 | (cdr (assoc property org-global-properties)) | |
10328 | (cdr (assoc property org-global-properties-fixed)))))) | |
c4f9780e | 10329 | |
20908596 CD |
10330 | (defun org-entry-put (pom property value) |
10331 | "Set PROPERTY to VALUE for entry at point-or-marker POM." | |
10332 | (org-with-point-at pom | |
10333 | (org-back-to-heading t) | |
10334 | (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) | |
10335 | range) | |
10336 | (cond | |
10337 | ((equal property "TODO") | |
10338 | (when (and (stringp value) (string-match "\\S-" value) | |
10339 | (not (member value org-todo-keywords-1))) | |
10340 | (error "\"%s\" is not a valid TODO state" value)) | |
10341 | (if (or (not value) | |
10342 | (not (string-match "\\S-" value))) | |
10343 | (setq value 'none)) | |
10344 | (org-todo value) | |
10345 | (org-set-tags nil 'align)) | |
10346 | ((equal property "PRIORITY") | |
10347 | (org-priority (if (and value (stringp value) (string-match "\\S-" value)) | |
10348 | (string-to-char value) ?\ )) | |
10349 | (org-set-tags nil 'align)) | |
10350 | ((equal property "SCHEDULED") | |
10351 | (if (re-search-forward org-scheduled-time-regexp end t) | |
10352 | (cond | |
10353 | ((eq value 'earlier) (org-timestamp-change -1 'day)) | |
10354 | ((eq value 'later) (org-timestamp-change 1 'day)) | |
10355 | (t (call-interactively 'org-schedule))) | |
10356 | (call-interactively 'org-schedule))) | |
10357 | ((equal property "DEADLINE") | |
10358 | (if (re-search-forward org-deadline-time-regexp end t) | |
10359 | (cond | |
10360 | ((eq value 'earlier) (org-timestamp-change -1 'day)) | |
10361 | ((eq value 'later) (org-timestamp-change 1 'day)) | |
10362 | (t (call-interactively 'org-deadline))) | |
10363 | (call-interactively 'org-deadline))) | |
10364 | ((member property org-special-properties) | |
10365 | (error "The %s property can not yet be set with `org-entry-put'" | |
10366 | property)) | |
10367 | (t ; a non-special property | |
10368 | (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21 | |
10369 | (setq range (org-get-property-block beg end 'force)) | |
10370 | (goto-char (car range)) | |
10371 | (if (re-search-forward | |
10372 | (concat "^[ \t]*:" property ":\\(.*\\)") (cdr range) t) | |
10373 | (progn | |
10374 | (delete-region (match-beginning 1) (match-end 1)) | |
10375 | (goto-char (match-beginning 1))) | |
10376 | (goto-char (cdr range)) | |
10377 | (insert "\n") | |
10378 | (backward-char 1) | |
10379 | (org-indent-line-function) | |
10380 | (insert ":" property ":")) | |
10381 | (and value (insert " " value)) | |
10382 | (org-indent-line-function))))))) | |
03f3cf35 | 10383 | |
20908596 CD |
10384 | (defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) |
10385 | "Get all property keys in the current buffer. | |
10386 | With INCLUDE-SPECIALS, also list the special properties that relect things | |
10387 | like tags and TODO state. | |
10388 | With INCLUDE-DEFAULTS, also include properties that has special meaning | |
10389 | internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING. | |
10390 | With INCLUDE-COLUMNS, also include property names given in COLUMN | |
10391 | formats in the current buffer." | |
10392 | (let (rtn range cfmt cols s p) | |
d3f4dbe8 | 10393 | (save-excursion |
20908596 CD |
10394 | (save-restriction |
10395 | (widen) | |
10396 | (goto-char (point-min)) | |
10397 | (while (re-search-forward org-property-start-re nil t) | |
10398 | (setq range (org-get-property-block)) | |
10399 | (goto-char (car range)) | |
10400 | (while (re-search-forward | |
10401 | (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):") | |
10402 | (cdr range) t) | |
10403 | (add-to-list 'rtn (org-match-string-no-properties 1))) | |
10404 | (outline-next-heading)))) | |
791d856f | 10405 | |
20908596 CD |
10406 | (when include-specials |
10407 | (setq rtn (append org-special-properties rtn))) | |
d3f4dbe8 | 10408 | |
20908596 CD |
10409 | (when include-defaults |
10410 | (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)) | |
38f8646b | 10411 | |
20908596 CD |
10412 | (when include-columns |
10413 | (save-excursion | |
10414 | (save-restriction | |
10415 | (widen) | |
10416 | (goto-char (point-min)) | |
10417 | (while (re-search-forward | |
10418 | "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)" | |
10419 | nil t) | |
10420 | (setq cfmt (match-string 2) s 0) | |
10421 | (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)") | |
10422 | cfmt s) | |
10423 | (setq s (match-end 0) | |
10424 | p (match-string 1 cfmt)) | |
10425 | (unless (or (equal p "ITEM") | |
10426 | (member p org-special-properties)) | |
10427 | (add-to-list 'rtn (match-string 1 cfmt)))))))) | |
2a57416f | 10428 | |
20908596 | 10429 | (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) |
2a57416f | 10430 | |
20908596 CD |
10431 | (defun org-property-values (key) |
10432 | "Return a list of all values of property KEY." | |
10433 | (save-excursion | |
10434 | (save-restriction | |
10435 | (widen) | |
10436 | (goto-char (point-min)) | |
10437 | (let ((re (concat "^[ \t]*:" key ":[ \t]*\\(\\S-.*\\)")) | |
10438 | values) | |
10439 | (while (re-search-forward re nil t) | |
10440 | (add-to-list 'values (org-trim (match-string 1)))) | |
10441 | (delete "" values))))) | |
2a57416f | 10442 | |
20908596 CD |
10443 | (defun org-insert-property-drawer () |
10444 | "Insert a property drawer into the current entry." | |
10445 | (interactive) | |
10446 | (org-back-to-heading t) | |
10447 | (looking-at outline-regexp) | |
10448 | (let ((indent (- (match-end 0)(match-beginning 0))) | |
10449 | (beg (point)) | |
10450 | (re (concat "^[ \t]*" org-keyword-time-regexp)) | |
10451 | end hiddenp) | |
10452 | (outline-next-heading) | |
10453 | (setq end (point)) | |
10454 | (goto-char beg) | |
10455 | (while (re-search-forward re end t)) | |
10456 | (setq hiddenp (org-invisible-p)) | |
10457 | (end-of-line 1) | |
10458 | (and (equal (char-after) ?\n) (forward-char 1)) | |
10459 | (while (looking-at "^[ \t]*\\(:CLOCK:\\|CLOCK\\|:END:\\)") | |
10460 | (beginning-of-line 2)) | |
10461 | (org-skip-over-state-notes) | |
10462 | (skip-chars-backward " \t\n\r") | |
10463 | (if (eq (char-before) ?*) (forward-char 1)) | |
10464 | (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) | |
10465 | (beginning-of-line 0) | |
10466 | (org-indent-to-column indent) | |
10467 | (beginning-of-line 2) | |
10468 | (org-indent-to-column indent) | |
10469 | (beginning-of-line 0) | |
10470 | (if hiddenp | |
10471 | (save-excursion | |
10472 | (org-back-to-heading t) | |
10473 | (hide-entry)) | |
10474 | (org-flag-drawer t)))) | |
d3f4dbe8 | 10475 | |
20908596 CD |
10476 | (defun org-set-property (property value) |
10477 | "In the current entry, set PROPERTY to VALUE. | |
10478 | When called interactively, this will prompt for a property name, offering | |
10479 | completion on existing and default properties. And then it will prompt | |
10480 | for a value, offering competion either on allowed values (via an inherited | |
10481 | xxx_ALL property) or on existing values in other instances of this property | |
10482 | in the current file." | |
10483 | (interactive | |
b349f79f CD |
10484 | (let* ((completion-ignore-case t) |
10485 | (keys (org-buffer-property-keys nil t t)) | |
ce4fdcb9 | 10486 | (prop0 (org-ido-completing-read "Property: " (mapcar 'list keys))) |
b349f79f CD |
10487 | (prop (if (member prop0 keys) |
10488 | prop0 | |
10489 | (or (cdr (assoc (downcase prop0) | |
10490 | (mapcar (lambda (x) (cons (downcase x) x)) | |
10491 | keys))) | |
10492 | prop0))) | |
20908596 CD |
10493 | (cur (org-entry-get nil prop)) |
10494 | (allowed (org-property-get-allowed-values nil prop 'table)) | |
10495 | (existing (mapcar 'list (org-property-values prop))) | |
10496 | (val (if allowed | |
b349f79f CD |
10497 | (org-completing-read "Value: " allowed nil 'req-match) |
10498 | (org-completing-read | |
20908596 CD |
10499 | (concat "Value" (if (and cur (string-match "\\S-" cur)) |
10500 | (concat "[" cur "]") "") | |
10501 | ": ") | |
10502 | existing nil nil "" nil cur)))) | |
10503 | (list prop (if (equal val "") cur val)))) | |
10504 | (unless (equal (org-entry-get nil property) value) | |
10505 | (org-entry-put nil property value))) | |
791d856f | 10506 | |
20908596 CD |
10507 | (defun org-delete-property (property) |
10508 | "In the current entry, delete PROPERTY." | |
10509 | (interactive | |
b349f79f | 10510 | (let* ((completion-ignore-case t) |
ce4fdcb9 | 10511 | (prop (org-ido-completing-read |
20908596 CD |
10512 | "Property: " (org-entry-properties nil 'standard)))) |
10513 | (list prop))) | |
10514 | (message "Property %s %s" property | |
10515 | (if (org-entry-delete nil property) | |
10516 | "deleted" | |
10517 | "was not present in the entry"))) | |
d3f4dbe8 | 10518 | |
20908596 CD |
10519 | (defun org-delete-property-globally (property) |
10520 | "Remove PROPERTY globally, from all entries." | |
10521 | (interactive | |
b349f79f | 10522 | (let* ((completion-ignore-case t) |
ce4fdcb9 | 10523 | (prop (org-ido-completing-read |
20908596 CD |
10524 | "Globally remove property: " |
10525 | (mapcar 'list (org-buffer-property-keys))))) | |
10526 | (list prop))) | |
10527 | (save-excursion | |
10528 | (save-restriction | |
10529 | (widen) | |
10530 | (goto-char (point-min)) | |
10531 | (let ((cnt 0)) | |
10532 | (while (re-search-forward | |
10533 | (concat "^[ \t]*:" (regexp-quote property) ":.*\n?") | |
10534 | nil t) | |
10535 | (setq cnt (1+ cnt)) | |
10536 | (replace-match "")) | |
10537 | (message "Property \"%s\" removed from %d entries" property cnt))))) | |
d3f4dbe8 | 10538 | |
20908596 | 10539 | (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el |
d3f4dbe8 | 10540 | |
20908596 CD |
10541 | (defun org-compute-property-at-point () |
10542 | "Compute the property at point. | |
10543 | This looks for an enclosing column format, extracts the operator and | |
10544 | then applies it to the proerty in the column format's scope." | |
30313b90 | 10545 | (interactive) |
20908596 CD |
10546 | (unless (org-at-property-p) |
10547 | (error "Not at a property")) | |
10548 | (let ((prop (org-match-string-no-properties 2))) | |
10549 | (org-columns-get-format-and-top-level) | |
10550 | (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) | |
10551 | (error "No operator defined for property %s" prop)) | |
10552 | (org-columns-compute prop))) | |
d3f4dbe8 | 10553 | |
20908596 CD |
10554 | (defun org-property-get-allowed-values (pom property &optional table) |
10555 | "Get allowed values for the property PROPERTY. | |
10556 | When TABLE is non-nil, return an alist that can directly be used for | |
10557 | completion." | |
10558 | (let (vals) | |
10559 | (cond | |
10560 | ((equal property "TODO") | |
10561 | (setq vals (org-with-point-at pom | |
10562 | (append org-todo-keywords-1 '(""))))) | |
10563 | ((equal property "PRIORITY") | |
10564 | (let ((n org-lowest-priority)) | |
10565 | (while (>= n org-highest-priority) | |
10566 | (push (char-to-string n) vals) | |
10567 | (setq n (1- n))))) | |
10568 | ((member property org-special-properties)) | |
10569 | (t | |
10570 | (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) | |
03f3cf35 | 10571 | |
20908596 CD |
10572 | (when (and vals (string-match "\\S-" vals)) |
10573 | (setq vals (car (read-from-string (concat "(" vals ")")))) | |
10574 | (setq vals (mapcar (lambda (x) | |
10575 | (cond ((stringp x) x) | |
10576 | ((numberp x) (number-to-string x)) | |
10577 | ((symbolp x) (symbol-name x)) | |
10578 | (t "???"))) | |
10579 | vals))))) | |
10580 | (if table (mapcar 'list vals) vals))) | |
03f3cf35 | 10581 | |
20908596 CD |
10582 | (defun org-property-previous-allowed-value (&optional previous) |
10583 | "Switch to the next allowed value for this property." | |
10584 | (interactive) | |
10585 | (org-property-next-allowed-value t)) | |
d3f4dbe8 | 10586 | |
20908596 CD |
10587 | (defun org-property-next-allowed-value (&optional previous) |
10588 | "Switch to the next allowed value for this property." | |
d3f4dbe8 | 10589 | (interactive) |
20908596 CD |
10590 | (unless (org-at-property-p) |
10591 | (error "Not at a property")) | |
10592 | (let* ((key (match-string 2)) | |
10593 | (value (match-string 3)) | |
10594 | (allowed (or (org-property-get-allowed-values (point) key) | |
10595 | (and (member value '("[ ]" "[-]" "[X]")) | |
10596 | '("[ ]" "[X]")))) | |
10597 | nval) | |
10598 | (unless allowed | |
10599 | (error "Allowed values for this property have not been defined")) | |
10600 | (if previous (setq allowed (reverse allowed))) | |
10601 | (if (member value allowed) | |
10602 | (setq nval (car (cdr (member value allowed))))) | |
10603 | (setq nval (or nval (car allowed))) | |
10604 | (if (equal nval value) | |
10605 | (error "Only one allowed value for this property")) | |
10606 | (org-at-property-p) | |
10607 | (replace-match (concat " :" key ": " nval) t t) | |
10608 | (org-indent-line-function) | |
10609 | (beginning-of-line 1) | |
10610 | (skip-chars-forward " \t"))) | |
d3f4dbe8 | 10611 | |
20908596 CD |
10612 | (defun org-find-entry-with-id (ident) |
10613 | "Locate the entry that contains the ID property with exact value IDENT. | |
10614 | IDENT can be a string, a symbol or a number, this function will search for | |
10615 | the string representation of it. | |
10616 | Return the position where this entry starts, or nil if there is no such entry." | |
ff4be292 | 10617 | (interactive "sID: ") |
20908596 CD |
10618 | (let ((id (cond |
10619 | ((stringp ident) ident) | |
10620 | ((symbol-name ident) (symbol-name ident)) | |
10621 | ((numberp ident) (number-to-string ident)) | |
10622 | (t (error "IDENT %s must be a string, symbol or number" ident)))) | |
10623 | (case-fold-search nil)) | |
10624 | (save-excursion | |
10625 | (save-restriction | |
10626 | (widen) | |
10627 | (goto-char (point-min)) | |
10628 | (when (re-search-forward | |
10629 | (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") | |
10630 | nil t) | |
10631 | (org-back-to-heading) | |
10632 | (point)))))) | |
48aaad2d | 10633 | |
20908596 | 10634 | ;;;; Timestamps |
d3f4dbe8 | 10635 | |
20908596 | 10636 | (defvar org-last-changed-timestamp nil) |
b349f79f CD |
10637 | (defvar org-last-inserted-timestamp nil |
10638 | "The last time stamp inserted with `org-insert-time-stamp'.") | |
20908596 CD |
10639 | (defvar org-time-was-given) ; dynamically scoped parameter |
10640 | (defvar org-end-time-was-given) ; dynamically scoped parameter | |
10641 | (defvar org-ts-what) ; dynamically scoped parameter | |
10642 | ||
621f83e4 | 10643 | (defun org-time-stamp (arg &optional inactive) |
20908596 CD |
10644 | "Prompt for a date/time and insert a time stamp. |
10645 | If the user specifies a time like HH:MM, or if this command is called | |
10646 | with a prefix argument, the time stamp will contain date and time. | |
10647 | Otherwise, only the date will be included. All parts of a date not | |
10648 | specified by the user will be filled in from the current date/time. | |
10649 | So if you press just return without typing anything, the time stamp | |
10650 | will represent the current date/time. If there is already a timestamp | |
10651 | at the cursor, it will be modified." | |
10652 | (interactive "P") | |
10653 | (let* ((ts nil) | |
10654 | (default-time | |
10655 | ;; Default time is either today, or, when entering a range, | |
10656 | ;; the range start. | |
10657 | (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0))) | |
10658 | (save-excursion | |
10659 | (re-search-backward | |
10660 | (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses | |
10661 | (- (point) 20) t))) | |
10662 | (apply 'encode-time (org-parse-time-string (match-string 1))) | |
10663 | (current-time))) | |
10664 | (default-input (and ts (org-get-compact-tod ts))) | |
10665 | org-time-was-given org-end-time-was-given time) | |
10666 | (cond | |
621f83e4 CD |
10667 | ((and (org-at-timestamp-p t) |
10668 | (memq last-command '(org-time-stamp org-time-stamp-inactive)) | |
10669 | (memq this-command '(org-time-stamp org-time-stamp-inactive))) | |
20908596 CD |
10670 | (insert "--") |
10671 | (setq time (let ((this-command this-command)) | |
621f83e4 CD |
10672 | (org-read-date arg 'totime nil nil |
10673 | default-time default-input))) | |
10674 | (org-insert-time-stamp time (or org-time-was-given arg) inactive)) | |
10675 | ((org-at-timestamp-p t) | |
20908596 CD |
10676 | (setq time (let ((this-command this-command)) |
10677 | (org-read-date arg 'totime nil nil default-time default-input))) | |
621f83e4 CD |
10678 | (when (org-at-timestamp-p t) ; just to get the match data |
10679 | ; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) | |
20908596 CD |
10680 | (replace-match "") |
10681 | (setq org-last-changed-timestamp | |
10682 | (org-insert-time-stamp | |
10683 | time (or org-time-was-given arg) | |
621f83e4 | 10684 | inactive nil nil (list org-end-time-was-given)))) |
20908596 CD |
10685 | (message "Timestamp updated")) |
10686 | (t | |
10687 | (setq time (let ((this-command this-command)) | |
10688 | (org-read-date arg 'totime nil nil default-time default-input))) | |
621f83e4 CD |
10689 | (org-insert-time-stamp time (or org-time-was-given arg) inactive |
10690 | nil nil (list org-end-time-was-given)))))) | |
d3f4dbe8 | 10691 | |
20908596 CD |
10692 | ;; FIXME: can we use this for something else, like computing time differences? |
10693 | (defun org-get-compact-tod (s) | |
10694 | (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) | |
10695 | (let* ((t1 (match-string 1 s)) | |
10696 | (h1 (string-to-number (match-string 2 s))) | |
10697 | (m1 (string-to-number (match-string 3 s))) | |
10698 | (t2 (and (match-end 4) (match-string 5 s))) | |
10699 | (h2 (and t2 (string-to-number (match-string 6 s)))) | |
10700 | (m2 (and t2 (string-to-number (match-string 7 s)))) | |
10701 | dh dm) | |
10702 | (if (not t2) | |
10703 | t1 | |
10704 | (setq dh (- h2 h1) dm (- m2 m1)) | |
10705 | (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) | |
10706 | (concat t1 "+" (number-to-string dh) | |
10707 | (if (/= 0 dm) (concat ":" (number-to-string dm)))))))) | |
d3f4dbe8 | 10708 | |
20908596 CD |
10709 | (defun org-time-stamp-inactive (&optional arg) |
10710 | "Insert an inactive time stamp. | |
10711 | An inactive time stamp is enclosed in square brackets instead of angle | |
10712 | brackets. It is inactive in the sense that it does not trigger agenda entries, | |
10713 | does not link to the calendar and cannot be changed with the S-cursor keys. | |
10714 | So these are more for recording a certain time/date." | |
10715 | (interactive "P") | |
621f83e4 | 10716 | (org-time-stamp arg 'inactive)) |
15841868 | 10717 | |
20908596 CD |
10718 | (defvar org-date-ovl (org-make-overlay 1 1)) |
10719 | (org-overlay-put org-date-ovl 'face 'org-warning) | |
10720 | (org-detach-overlay org-date-ovl) | |
d3f4dbe8 | 10721 | |
20908596 CD |
10722 | (defvar org-ans1) ; dynamically scoped parameter |
10723 | (defvar org-ans2) ; dynamically scoped parameter | |
8c6fb58b | 10724 | |
20908596 | 10725 | (defvar org-plain-time-of-day-regexp) ; defined below |
d3f4dbe8 | 10726 | |
b349f79f | 10727 | (defvar org-overriding-default-time nil) ; dynamically scoped |
20908596 CD |
10728 | (defvar org-read-date-overlay nil) |
10729 | (defvar org-dcst nil) ; dynamically scoped | |
d3f4dbe8 | 10730 | |
20908596 CD |
10731 | (defun org-read-date (&optional with-time to-time from-string prompt |
10732 | default-time default-input) | |
10733 | "Read a date, possibly a time, and make things smooth for the user. | |
10734 | The prompt will suggest to enter an ISO date, but you can also enter anything | |
10735 | which will at least partially be understood by `parse-time-string'. | |
10736 | Unrecognized parts of the date will default to the current day, month, year, | |
10737 | hour and minute. If this command is called to replace a timestamp at point, | |
10738 | of to enter the second timestamp of a range, the default time is taken from the | |
10739 | existing stamp. For example, | |
10740 | 3-2-5 --> 2003-02-05 | |
10741 | feb 15 --> currentyear-02-15 | |
10742 | sep 12 9 --> 2009-09-12 | |
10743 | 12:45 --> today 12:45 | |
10744 | 22 sept 0:34 --> currentyear-09-22 0:34 | |
10745 | 12 --> currentyear-currentmonth-12 | |
10746 | Fri --> nearest Friday (today or later) | |
10747 | etc. | |
8c6fb58b | 10748 | |
20908596 CD |
10749 | Furthermore you can specify a relative date by giving, as the *first* thing |
10750 | in the input: a plus/minus sign, a number and a letter [dwmy] to indicate | |
10751 | change in days weeks, months, years. | |
10752 | With a single plus or minus, the date is relative to today. With a double | |
10753 | plus or minus, it is relative to the date in DEFAULT-TIME. E.g. | |
10754 | +4d --> four days from today | |
10755 | +4 --> same as above | |
10756 | +2w --> two weeks from today | |
10757 | ++5 --> five days from default date | |
d3f4dbe8 | 10758 | |
20908596 CD |
10759 | The function understands only English month and weekday abbreviations, |
10760 | but this can be configured with the variables `parse-time-months' and | |
10761 | `parse-time-weekdays'. | |
d3f4dbe8 | 10762 | |
20908596 CD |
10763 | While prompting, a calendar is popped up - you can also select the |
10764 | date with the mouse (button 1). The calendar shows a period of three | |
10765 | months. To scroll it to other months, use the keys `>' and `<'. | |
10766 | If you don't like the calendar, turn it off with | |
10767 | \(setq org-read-date-popup-calendar nil) | |
48aaad2d | 10768 | |
20908596 CD |
10769 | With optional argument TO-TIME, the date will immediately be converted |
10770 | to an internal time. | |
10771 | With an optional argument WITH-TIME, the prompt will suggest to also | |
10772 | insert a time. Note that when WITH-TIME is not set, you can still | |
10773 | enter a time, and this function will inform the calling routine about | |
10774 | this change. The calling routine may then choose to change the format | |
10775 | used to insert the time stamp into the buffer to include the time. | |
10776 | With optional argument FROM-STRING, read from this string instead from | |
10777 | the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is | |
10778 | the time/date that is used for everything that is not specified by the | |
10779 | user." | |
10780 | (require 'parse-time) | |
10781 | (let* ((org-time-stamp-rounding-minutes | |
10782 | (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) | |
10783 | (org-dcst org-display-custom-times) | |
10784 | (ct (org-current-time)) | |
b349f79f | 10785 | (def (or org-overriding-default-time default-time ct)) |
20908596 CD |
10786 | (defdecode (decode-time def)) |
10787 | (dummy (progn | |
10788 | (when (< (nth 2 defdecode) org-extend-today-until) | |
10789 | (setcar (nthcdr 2 defdecode) -1) | |
10790 | (setcar (nthcdr 1 defdecode) 59) | |
10791 | (setq def (apply 'encode-time defdecode) | |
10792 | defdecode (decode-time def))))) | |
10793 | (calendar-move-hook nil) | |
10794 | (calendar-view-diary-initially-flag nil) | |
10795 | (view-diary-entries-initially nil) | |
10796 | (calendar-view-holidays-initially-flag nil) | |
10797 | (view-calendar-holidays-initially nil) | |
10798 | (timestr (format-time-string | |
10799 | (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) | |
10800 | (prompt (concat (if prompt (concat prompt " ") "") | |
10801 | (format "Date+time [%s]: " timestr))) | |
10802 | ans (org-ans0 "") org-ans1 org-ans2 final) | |
d3f4dbe8 | 10803 | |
38f8646b | 10804 | (cond |
20908596 CD |
10805 | (from-string (setq ans from-string)) |
10806 | (org-read-date-popup-calendar | |
10807 | (save-excursion | |
10808 | (save-window-excursion | |
10809 | (calendar) | |
10810 | (calendar-forward-day (- (time-to-days def) | |
10811 | (calendar-absolute-from-gregorian | |
10812 | (calendar-current-date)))) | |
10813 | (org-eval-in-calendar nil t) | |
10814 | (let* ((old-map (current-local-map)) | |
10815 | (map (copy-keymap calendar-mode-map)) | |
10816 | (minibuffer-local-map (copy-keymap minibuffer-local-map))) | |
10817 | (org-defkey map (kbd "RET") 'org-calendar-select) | |
10818 | (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) | |
10819 | 'org-calendar-select-mouse) | |
10820 | (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) | |
10821 | 'org-calendar-select-mouse) | |
10822 | (org-defkey minibuffer-local-map [(meta shift left)] | |
10823 | (lambda () (interactive) | |
10824 | (org-eval-in-calendar '(calendar-backward-month 1)))) | |
10825 | (org-defkey minibuffer-local-map [(meta shift right)] | |
10826 | (lambda () (interactive) | |
10827 | (org-eval-in-calendar '(calendar-forward-month 1)))) | |
10828 | (org-defkey minibuffer-local-map [(meta shift up)] | |
10829 | (lambda () (interactive) | |
10830 | (org-eval-in-calendar '(calendar-backward-year 1)))) | |
10831 | (org-defkey minibuffer-local-map [(meta shift down)] | |
10832 | (lambda () (interactive) | |
10833 | (org-eval-in-calendar '(calendar-forward-year 1)))) | |
10834 | (org-defkey minibuffer-local-map [(shift up)] | |
10835 | (lambda () (interactive) | |
10836 | (org-eval-in-calendar '(calendar-backward-week 1)))) | |
10837 | (org-defkey minibuffer-local-map [(shift down)] | |
10838 | (lambda () (interactive) | |
10839 | (org-eval-in-calendar '(calendar-forward-week 1)))) | |
10840 | (org-defkey minibuffer-local-map [(shift left)] | |
10841 | (lambda () (interactive) | |
10842 | (org-eval-in-calendar '(calendar-backward-day 1)))) | |
10843 | (org-defkey minibuffer-local-map [(shift right)] | |
10844 | (lambda () (interactive) | |
10845 | (org-eval-in-calendar '(calendar-forward-day 1)))) | |
10846 | (org-defkey minibuffer-local-map ">" | |
10847 | (lambda () (interactive) | |
10848 | (org-eval-in-calendar '(scroll-calendar-left 1)))) | |
10849 | (org-defkey minibuffer-local-map "<" | |
10850 | (lambda () (interactive) | |
10851 | (org-eval-in-calendar '(scroll-calendar-right 1)))) | |
10852 | (unwind-protect | |
10853 | (progn | |
10854 | (use-local-map map) | |
10855 | (add-hook 'post-command-hook 'org-read-date-display) | |
10856 | (setq org-ans0 (read-string prompt default-input nil nil)) | |
10857 | ;; org-ans0: from prompt | |
10858 | ;; org-ans1: from mouse click | |
10859 | ;; org-ans2: from calendar motion | |
10860 | (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) | |
10861 | (remove-hook 'post-command-hook 'org-read-date-display) | |
10862 | (use-local-map old-map) | |
10863 | (when org-read-date-overlay | |
10864 | (org-delete-overlay org-read-date-overlay) | |
10865 | (setq org-read-date-overlay nil))))))) | |
d3f4dbe8 | 10866 | |
20908596 CD |
10867 | (t ; Naked prompt only |
10868 | (unwind-protect | |
10869 | (setq ans (read-string prompt default-input nil timestr)) | |
10870 | (when org-read-date-overlay | |
10871 | (org-delete-overlay org-read-date-overlay) | |
10872 | (setq org-read-date-overlay nil))))) | |
d3f4dbe8 | 10873 | |
20908596 | 10874 | (setq final (org-read-date-analyze ans def defdecode)) |
d3f4dbe8 | 10875 | |
20908596 CD |
10876 | (if to-time |
10877 | (apply 'encode-time final) | |
10878 | (if (and (boundp 'org-time-was-given) org-time-was-given) | |
10879 | (format "%04d-%02d-%02d %02d:%02d" | |
10880 | (nth 5 final) (nth 4 final) (nth 3 final) | |
10881 | (nth 2 final) (nth 1 final)) | |
10882 | (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) | |
10883 | (defvar def) | |
10884 | (defvar defdecode) | |
10885 | (defvar with-time) | |
10886 | (defun org-read-date-display () | |
10887 | "Display the currrent date prompt interpretation in the minibuffer." | |
10888 | (when org-read-date-display-live | |
10889 | (when org-read-date-overlay | |
10890 | (org-delete-overlay org-read-date-overlay)) | |
10891 | (let ((p (point))) | |
10892 | (end-of-line 1) | |
10893 | (while (not (equal (buffer-substring | |
10894 | (max (point-min) (- (point) 4)) (point)) | |
10895 | " ")) | |
10896 | (insert " ")) | |
10897 | (goto-char p)) | |
10898 | (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) | |
10899 | " " (or org-ans1 org-ans2))) | |
10900 | (org-end-time-was-given nil) | |
10901 | (f (org-read-date-analyze ans def defdecode)) | |
10902 | (fmts (if org-dcst | |
10903 | org-time-stamp-custom-formats | |
10904 | org-time-stamp-formats)) | |
10905 | (fmt (if (or with-time | |
10906 | (and (boundp 'org-time-was-given) org-time-was-given)) | |
10907 | (cdr fmts) | |
10908 | (car fmts))) | |
10909 | (txt (concat "=> " (format-time-string fmt (apply 'encode-time f))))) | |
10910 | (when (and org-end-time-was-given | |
10911 | (string-match org-plain-time-of-day-regexp txt)) | |
10912 | (setq txt (concat (substring txt 0 (match-end 0)) "-" | |
10913 | org-end-time-was-given | |
10914 | (substring txt (match-end 0))))) | |
10915 | (setq org-read-date-overlay | |
621f83e4 | 10916 | (org-make-overlay (1- (point-at-eol)) (point-at-eol))) |
20908596 | 10917 | (org-overlay-display org-read-date-overlay txt 'secondary-selection)))) |
d3f4dbe8 | 10918 | |
20908596 CD |
10919 | (defun org-read-date-analyze (ans def defdecode) |
10920 | "Analyze the combined answer of the date prompt." | |
10921 | ;; FIXME: cleanup and comment | |
10922 | (let (delta deltan deltaw deltadef year month day | |
10923 | hour minute second wday pm h2 m2 tl wday1 | |
10924 | iso-year iso-weekday iso-week iso-year iso-date) | |
d3f4dbe8 | 10925 | |
b349f79f CD |
10926 | (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) |
10927 | (setq ans "+0")) | |
10928 | ||
20908596 CD |
10929 | (when (setq delta (org-read-date-get-relative ans (current-time) def)) |
10930 | (setq ans (replace-match "" t t ans) | |
10931 | deltan (car delta) | |
10932 | deltaw (nth 1 delta) | |
10933 | deltadef (nth 2 delta))) | |
d3f4dbe8 | 10934 | |
20908596 CD |
10935 | ;; Check if there is an iso week date in there |
10936 | ;; If yes, sore the info and ostpone interpreting it until the rest | |
10937 | ;; of the parsing is done | |
10938 | (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) | |
10939 | (setq iso-year (if (match-end 1) (org-small-year-to-year (string-to-number (match-string 1 ans)))) | |
10940 | iso-weekday (if (match-end 3) (string-to-number (match-string 3 ans))) | |
10941 | iso-week (string-to-number (match-string 2 ans))) | |
10942 | (setq ans (replace-match "" t t ans))) | |
d3f4dbe8 | 10943 | |
20908596 CD |
10944 | ;; Help matching ISO dates with single digit month ot day, like 2006-8-11. |
10945 | (when (string-match | |
10946 | "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) | |
10947 | (setq year (if (match-end 2) | |
10948 | (string-to-number (match-string 2 ans)) | |
10949 | (string-to-number (format-time-string "%Y"))) | |
10950 | month (string-to-number (match-string 3 ans)) | |
10951 | day (string-to-number (match-string 4 ans))) | |
10952 | (if (< year 100) (setq year (+ 2000 year))) | |
10953 | (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) | |
10954 | t nil ans))) | |
10955 | ;; Help matching am/pm times, because `parse-time-string' does not do that. | |
10956 | ;; If there is a time with am/pm, and *no* time without it, we convert | |
10957 | ;; so that matching will be successful. | |
10958 | (loop for i from 1 to 2 do ; twice, for end time as well | |
10959 | (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) | |
10960 | (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) | |
10961 | (setq hour (string-to-number (match-string 1 ans)) | |
10962 | minute (if (match-end 3) | |
10963 | (string-to-number (match-string 3 ans)) | |
10964 | 0) | |
10965 | pm (equal ?p | |
10966 | (string-to-char (downcase (match-string 4 ans))))) | |
10967 | (if (and (= hour 12) (not pm)) | |
10968 | (setq hour 0) | |
10969 | (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) | |
10970 | (setq ans (replace-match (format "%02d:%02d" hour minute) | |
10971 | t t ans)))) | |
d3f4dbe8 | 10972 | |
20908596 CD |
10973 | ;; Check if a time range is given as a duration |
10974 | (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) | |
10975 | (setq hour (string-to-number (match-string 1 ans)) | |
10976 | h2 (+ hour (string-to-number (match-string 3 ans))) | |
10977 | minute (string-to-number (match-string 2 ans)) | |
10978 | m2 (+ minute (if (match-end 5) (string-to-number | |
10979 | (match-string 5 ans))0))) | |
10980 | (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) | |
10981 | (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) | |
10982 | t t ans))) | |
d3f4dbe8 | 10983 | |
20908596 CD |
10984 | ;; Check if there is a time range |
10985 | (when (boundp 'org-end-time-was-given) | |
10986 | (setq org-time-was-given nil) | |
10987 | (when (and (string-match org-plain-time-of-day-regexp ans) | |
10988 | (match-end 8)) | |
10989 | (setq org-end-time-was-given (match-string 8 ans)) | |
10990 | (setq ans (concat (substring ans 0 (match-beginning 7)) | |
10991 | (substring ans (match-end 7)))))) | |
a3fbe8c4 | 10992 | |
20908596 CD |
10993 | (setq tl (parse-time-string ans) |
10994 | day (or (nth 3 tl) (nth 3 defdecode)) | |
10995 | month (or (nth 4 tl) | |
10996 | (if (and org-read-date-prefer-future | |
10997 | (nth 3 tl) (< (nth 3 tl) (nth 3 defdecode))) | |
10998 | (1+ (nth 4 defdecode)) | |
10999 | (nth 4 defdecode))) | |
11000 | year (or (nth 5 tl) | |
11001 | (if (and org-read-date-prefer-future | |
11002 | (nth 4 tl) (< (nth 4 tl) (nth 4 defdecode))) | |
11003 | (1+ (nth 5 defdecode)) | |
11004 | (nth 5 defdecode))) | |
11005 | hour (or (nth 2 tl) (nth 2 defdecode)) | |
11006 | minute (or (nth 1 tl) (nth 1 defdecode)) | |
11007 | second (or (nth 0 tl) 0) | |
11008 | wday (nth 6 tl)) | |
a3fbe8c4 | 11009 | |
20908596 CD |
11010 | ;; Special date definitions below |
11011 | (cond | |
11012 | (iso-week | |
11013 | ;; There was an iso week | |
11014 | (setq year (or iso-year year) | |
11015 | day (or iso-weekday wday 1) | |
11016 | wday nil ; to make sure that the trigger below does not match | |
11017 | iso-date (calendar-gregorian-from-absolute | |
11018 | (calendar-absolute-from-iso | |
11019 | (list iso-week day year)))) | |
11020 | ; FIXME: Should we also push ISO weeks into the future? | |
11021 | ; (when (and org-read-date-prefer-future | |
11022 | ; (not iso-year) | |
11023 | ; (< (calendar-absolute-from-gregorian iso-date) | |
11024 | ; (time-to-days (current-time)))) | |
11025 | ; (setq year (1+ year) | |
11026 | ; iso-date (calendar-gregorian-from-absolute | |
11027 | ; (calendar-absolute-from-iso | |
11028 | ; (list iso-week day year))))) | |
11029 | (setq month (car iso-date) | |
11030 | year (nth 2 iso-date) | |
11031 | day (nth 1 iso-date))) | |
11032 | (deltan | |
11033 | (unless deltadef | |
11034 | (let ((now (decode-time (current-time)))) | |
11035 | (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) | |
11036 | (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) | |
11037 | ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) | |
11038 | ((equal deltaw "m") (setq month (+ month deltan))) | |
11039 | ((equal deltaw "y") (setq year (+ year deltan))))) | |
11040 | ((and wday (not (nth 3 tl))) | |
11041 | ;; Weekday was given, but no day, so pick that day in the week | |
11042 | ;; on or after the derived date. | |
11043 | (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) | |
11044 | (unless (equal wday wday1) | |
11045 | (setq day (+ day (% (- wday wday1 -7) 7)))))) | |
11046 | (if (and (boundp 'org-time-was-given) | |
11047 | (nth 2 tl)) | |
11048 | (setq org-time-was-given t)) | |
11049 | (if (< year 100) (setq year (+ 2000 year))) | |
11050 | (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable | |
11051 | (list second minute hour day month year))) | |
d3f4dbe8 | 11052 | |
20908596 | 11053 | (defvar parse-time-weekdays) |
d3f4dbe8 | 11054 | |
20908596 CD |
11055 | (defun org-read-date-get-relative (s today default) |
11056 | "Check string S for special relative date string. | |
11057 | TODAY and DEFAULT are internal times, for today and for a default. | |
11058 | Return shift list (N what def-flag) | |
11059 | WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. | |
11060 | N is the number of WHATs to shift. | |
11061 | DEF-FLAG is t when a double ++ or -- indicates shift relative to | |
11062 | the DEFAULT date rather than TODAY." | |
7b1019e2 MB |
11063 | (when (and |
11064 | (string-match | |
11065 | (concat | |
11066 | "\\`[ \t]*\\([-+]\\{0,2\\}\\)" | |
11067 | "\\([0-9]+\\)?" | |
11068 | "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" | |
11069 | "\\([ \t]\\|$\\)") s) | |
11070 | (or (> (match-end 1) (match-beginning 1)) (match-end 4))) | |
11071 | (let* ((dir (if (> (match-end 1) (match-beginning 1)) | |
20908596 CD |
11072 | (string-to-char (substring (match-string 1 s) -1)) |
11073 | ?+)) | |
11074 | (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1))))) | |
11075 | (n (if (match-end 2) (string-to-number (match-string 2 s)) 1)) | |
11076 | (what (if (match-end 3) (match-string 3 s) "d")) | |
11077 | (wday1 (cdr (assoc (downcase what) parse-time-weekdays))) | |
11078 | (date (if rel default today)) | |
11079 | (wday (nth 6 (decode-time date))) | |
11080 | delta) | |
11081 | (if wday1 | |
11082 | (progn | |
11083 | (setq delta (mod (+ 7 (- wday1 wday)) 7)) | |
11084 | (if (= dir ?-) (setq delta (- delta 7))) | |
11085 | (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) | |
11086 | (list delta "d" rel)) | |
11087 | (list (* n (if (= dir ?-) -1 1)) what rel))))) | |
d3f4dbe8 | 11088 | |
20908596 CD |
11089 | (defun org-eval-in-calendar (form &optional keepdate) |
11090 | "Eval FORM in the calendar window and return to current window. | |
11091 | Also, store the cursor date in variable org-ans2." | |
11092 | (let ((sw (selected-window))) | |
11093 | (select-window (get-buffer-window "*Calendar*")) | |
11094 | (eval form) | |
11095 | (when (and (not keepdate) (calendar-cursor-to-date)) | |
11096 | (let* ((date (calendar-cursor-to-date)) | |
11097 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
11098 | (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) | |
11099 | (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) | |
11100 | (select-window sw))) | |
d3f4dbe8 | 11101 | |
20908596 CD |
11102 | (defun org-calendar-select () |
11103 | "Return to `org-read-date' with the date currently selected. | |
11104 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
d3f4dbe8 | 11105 | (interactive) |
20908596 CD |
11106 | (when (calendar-cursor-to-date) |
11107 | (let* ((date (calendar-cursor-to-date)) | |
11108 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
11109 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
11110 | (if (active-minibuffer-window) (exit-minibuffer)))) | |
11111 | ||
11112 | (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) | |
11113 | "Insert a date stamp for the date given by the internal TIME. | |
11114 | WITH-HM means, use the stamp format that includes the time of the day. | |
11115 | INACTIVE means use square brackets instead of angular ones, so that the | |
11116 | stamp will not contribute to the agenda. | |
11117 | PRE and POST are optional strings to be inserted before and after the | |
11118 | stamp. | |
11119 | The command returns the inserted time stamp." | |
11120 | (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) | |
11121 | stamp) | |
11122 | (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) | |
11123 | (insert-before-markers (or pre "")) | |
11124 | (insert-before-markers (setq stamp (format-time-string fmt time))) | |
11125 | (when (listp extra) | |
11126 | (setq extra (car extra)) | |
11127 | (if (and (stringp extra) | |
11128 | (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) | |
11129 | (setq extra (format "-%02d:%02d" | |
11130 | (string-to-number (match-string 1 extra)) | |
11131 | (string-to-number (match-string 2 extra)))) | |
11132 | (setq extra nil))) | |
11133 | (when extra | |
11134 | (backward-char 1) | |
11135 | (insert-before-markers extra) | |
11136 | (forward-char 1)) | |
11137 | (insert-before-markers (or post "")) | |
b349f79f | 11138 | (setq org-last-inserted-timestamp stamp))) |
d3f4dbe8 | 11139 | |
20908596 CD |
11140 | (defun org-toggle-time-stamp-overlays () |
11141 | "Toggle the use of custom time stamp formats." | |
d3f4dbe8 | 11142 | (interactive) |
20908596 CD |
11143 | (setq org-display-custom-times (not org-display-custom-times)) |
11144 | (unless org-display-custom-times | |
11145 | (let ((p (point-min)) (bmp (buffer-modified-p))) | |
11146 | (while (setq p (next-single-property-change p 'display)) | |
11147 | (if (and (get-text-property p 'display) | |
11148 | (eq (get-text-property p 'face) 'org-date)) | |
11149 | (remove-text-properties | |
11150 | p (setq p (next-single-property-change p 'display)) | |
11151 | '(display t)))) | |
11152 | (set-buffer-modified-p bmp))) | |
11153 | (if (featurep 'xemacs) | |
11154 | (remove-text-properties (point-min) (point-max) '(end-glyph t))) | |
11155 | (org-restart-font-lock) | |
11156 | (setq org-table-may-need-update t) | |
11157 | (if org-display-custom-times | |
11158 | (message "Time stamps are overlayed with custom format") | |
11159 | (message "Time stamp overlays removed"))) | |
d3f4dbe8 | 11160 | |
20908596 | 11161 | (defun org-display-custom-time (beg end) |
b349f79f | 11162 | "Overlay modified time stamp format over timestamp between BEG and END." |
20908596 CD |
11163 | (let* ((ts (buffer-substring beg end)) |
11164 | t1 w1 with-hm tf time str w2 (off 0)) | |
11165 | (save-match-data | |
11166 | (setq t1 (org-parse-time-string ts t)) | |
11167 | (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\)?\\'" ts) | |
11168 | (setq off (- (match-end 0) (match-beginning 0))))) | |
11169 | (setq end (- end off)) | |
11170 | (setq w1 (- end beg) | |
11171 | with-hm (and (nth 1 t1) (nth 2 t1)) | |
11172 | tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) | |
11173 | time (org-fix-decoded-time t1) | |
11174 | str (org-add-props | |
11175 | (format-time-string | |
11176 | (substring tf 1 -1) (apply 'encode-time time)) | |
11177 | nil 'mouse-face 'highlight) | |
11178 | w2 (length str)) | |
11179 | (if (not (= w2 w1)) | |
11180 | (add-text-properties (1+ beg) (+ 2 beg) | |
11181 | (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) | |
11182 | (if (featurep 'xemacs) | |
11183 | (progn | |
11184 | (put-text-property beg end 'invisible t) | |
11185 | (put-text-property beg end 'end-glyph (make-glyph str))) | |
11186 | (put-text-property beg end 'display str)))) | |
d3f4dbe8 | 11187 | |
20908596 CD |
11188 | (defun org-translate-time (string) |
11189 | "Translate all timestamps in STRING to custom format. | |
11190 | But do this only if the variable `org-display-custom-times' is set." | |
11191 | (when org-display-custom-times | |
11192 | (save-match-data | |
11193 | (let* ((start 0) | |
11194 | (re org-ts-regexp-both) | |
11195 | t1 with-hm inactive tf time str beg end) | |
11196 | (while (setq start (string-match re string start)) | |
11197 | (setq beg (match-beginning 0) | |
11198 | end (match-end 0) | |
11199 | t1 (save-match-data | |
11200 | (org-parse-time-string (substring string beg end) t)) | |
11201 | with-hm (and (nth 1 t1) (nth 2 t1)) | |
11202 | inactive (equal (substring string beg (1+ beg)) "[") | |
11203 | tf (funcall (if with-hm 'cdr 'car) | |
11204 | org-time-stamp-custom-formats) | |
11205 | time (org-fix-decoded-time t1) | |
11206 | str (format-time-string | |
11207 | (concat | |
11208 | (if inactive "[" "<") (substring tf 1 -1) | |
11209 | (if inactive "]" ">")) | |
11210 | (apply 'encode-time time)) | |
11211 | string (replace-match str t t string) | |
11212 | start (+ start (length str))))))) | |
11213 | string) | |
d3f4dbe8 | 11214 | |
20908596 CD |
11215 | (defun org-fix-decoded-time (time) |
11216 | "Set 0 instead of nil for the first 6 elements of time. | |
11217 | Don't touch the rest." | |
11218 | (let ((n 0)) | |
11219 | (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) | |
d3f4dbe8 | 11220 | |
20908596 CD |
11221 | (defun org-days-to-time (timestamp-string) |
11222 | "Difference between TIMESTAMP-STRING and now in days." | |
11223 | (- (time-to-days (org-time-string-to-time timestamp-string)) | |
11224 | (time-to-days (current-time)))) | |
d3f4dbe8 | 11225 | |
20908596 CD |
11226 | (defun org-deadline-close (timestamp-string &optional ndays) |
11227 | "Is the time in TIMESTAMP-STRING close to the current date?" | |
11228 | (setq ndays (or ndays (org-get-wdays timestamp-string))) | |
11229 | (and (< (org-days-to-time timestamp-string) ndays) | |
11230 | (not (org-entry-is-done-p)))) | |
d3f4dbe8 | 11231 | |
20908596 CD |
11232 | (defun org-get-wdays (ts) |
11233 | "Get the deadline lead time appropriate for timestring TS." | |
11234 | (cond | |
11235 | ((<= org-deadline-warning-days 0) | |
11236 | ;; 0 or negative, enforce this value no matter what | |
11237 | (- org-deadline-warning-days)) | |
11238 | ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\)" ts) | |
11239 | ;; lead time is specified. | |
11240 | (floor (* (string-to-number (match-string 1 ts)) | |
11241 | (cdr (assoc (match-string 2 ts) | |
11242 | '(("d" . 1) ("w" . 7) | |
11243 | ("m" . 30.4) ("y" . 365.25))))))) | |
11244 | ;; go for the default. | |
11245 | (t org-deadline-warning-days))) | |
d3f4dbe8 | 11246 | |
20908596 CD |
11247 | (defun org-calendar-select-mouse (ev) |
11248 | "Return to `org-read-date' with the date currently selected. | |
11249 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
11250 | (interactive "e") | |
11251 | (mouse-set-point ev) | |
11252 | (when (calendar-cursor-to-date) | |
11253 | (let* ((date (calendar-cursor-to-date)) | |
11254 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
11255 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
11256 | (if (active-minibuffer-window) (exit-minibuffer)))) | |
d3f4dbe8 | 11257 | |
20908596 CD |
11258 | (defun org-check-deadlines (ndays) |
11259 | "Check if there are any deadlines due or past due. | |
11260 | A deadline is considered due if it happens within `org-deadline-warning-days' | |
11261 | days from today's date. If the deadline appears in an entry marked DONE, | |
11262 | it is not shown. The prefix arg NDAYS can be used to test that many | |
11263 | days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." | |
d3f4dbe8 | 11264 | (interactive "P") |
20908596 CD |
11265 | (let* ((org-warn-days |
11266 | (cond | |
11267 | ((equal ndays '(4)) 100000) | |
11268 | (ndays (prefix-numeric-value ndays)) | |
11269 | (t (abs org-deadline-warning-days)))) | |
11270 | (case-fold-search nil) | |
11271 | (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) | |
11272 | (callback | |
11273 | (lambda () (org-deadline-close (match-string 1) org-warn-days)))) | |
d3f4dbe8 | 11274 | |
20908596 CD |
11275 | (message "%d deadlines past-due or due within %d days" |
11276 | (org-occur regexp nil callback) | |
11277 | org-warn-days))) | |
d3f4dbe8 | 11278 | |
20908596 CD |
11279 | (defun org-check-before-date (date) |
11280 | "Check if there are deadlines or scheduled entries before DATE." | |
11281 | (interactive (list (org-read-date))) | |
11282 | (let ((case-fold-search nil) | |
11283 | (regexp (concat "\\<\\(" org-deadline-string | |
11284 | "\\|" org-scheduled-string | |
11285 | "\\) *<\\([^>]+\\)>")) | |
11286 | (callback | |
11287 | (lambda () (time-less-p | |
11288 | (org-time-string-to-time (match-string 2)) | |
11289 | (org-time-string-to-time date))))) | |
11290 | (message "%d entries before %s" | |
11291 | (org-occur regexp nil callback) date))) | |
100a4141 | 11292 | |
20908596 CD |
11293 | (defun org-evaluate-time-range (&optional to-buffer) |
11294 | "Evaluate a time range by computing the difference between start and end. | |
11295 | Normally the result is just printed in the echo area, but with prefix arg | |
11296 | TO-BUFFER, the result is inserted just after the date stamp into the buffer. | |
11297 | If the time range is actually in a table, the result is inserted into the | |
11298 | next column. | |
11299 | For time difference computation, a year is assumed to be exactly 365 | |
11300 | days in order to avoid rounding problems." | |
d3f4dbe8 | 11301 | (interactive "P") |
20908596 CD |
11302 | (or |
11303 | (org-clock-update-time-maybe) | |
11304 | (save-excursion | |
11305 | (unless (org-at-date-range-p t) | |
11306 | (goto-char (point-at-bol)) | |
11307 | (re-search-forward org-tr-regexp-both (point-at-eol) t)) | |
11308 | (if (not (org-at-date-range-p t)) | |
11309 | (error "Not at a time-stamp range, and none found in current line"))) | |
11310 | (let* ((ts1 (match-string 1)) | |
11311 | (ts2 (match-string 2)) | |
11312 | (havetime (or (> (length ts1) 15) (> (length ts2) 15))) | |
11313 | (match-end (match-end 0)) | |
11314 | (time1 (org-time-string-to-time ts1)) | |
11315 | (time2 (org-time-string-to-time ts2)) | |
11316 | (t1 (time-to-seconds time1)) | |
11317 | (t2 (time-to-seconds time2)) | |
11318 | (diff (abs (- t2 t1))) | |
11319 | (negative (< (- t2 t1) 0)) | |
11320 | ;; (ys (floor (* 365 24 60 60))) | |
11321 | (ds (* 24 60 60)) | |
11322 | (hs (* 60 60)) | |
11323 | (fy "%dy %dd %02d:%02d") | |
11324 | (fy1 "%dy %dd") | |
11325 | (fd "%dd %02d:%02d") | |
11326 | (fd1 "%dd") | |
11327 | (fh "%02d:%02d") | |
11328 | y d h m align) | |
11329 | (if havetime | |
11330 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
11331 | y 0 | |
11332 | d (floor (/ diff ds)) diff (mod diff ds) | |
11333 | h (floor (/ diff hs)) diff (mod diff hs) | |
11334 | m (floor (/ diff 60))) | |
11335 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
11336 | y 0 | |
11337 | d (floor (+ (/ diff ds) 0.5)) | |
11338 | h 0 m 0)) | |
11339 | (if (not to-buffer) | |
11340 | (message "%s" (org-make-tdiff-string y d h m)) | |
11341 | (if (org-at-table-p) | |
11342 | (progn | |
11343 | (goto-char match-end) | |
11344 | (setq align t) | |
11345 | (and (looking-at " *|") (goto-char (match-end 0)))) | |
11346 | (goto-char match-end)) | |
11347 | (if (looking-at | |
11348 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | |
11349 | (replace-match "")) | |
11350 | (if negative (insert " -")) | |
11351 | (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) | |
11352 | (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) | |
11353 | (insert " " (format fh h m)))) | |
11354 | (if align (org-table-align)) | |
11355 | (message "Time difference inserted"))))) | |
791d856f | 11356 | |
20908596 CD |
11357 | (defun org-make-tdiff-string (y d h m) |
11358 | (let ((fmt "") | |
11359 | (l nil)) | |
11360 | (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") | |
11361 | l (push y l))) | |
11362 | (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") | |
11363 | l (push d l))) | |
11364 | (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") | |
11365 | l (push h l))) | |
11366 | (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") | |
11367 | l (push m l))) | |
11368 | (apply 'format fmt (nreverse l)))) | |
ab27a4a0 | 11369 | |
20908596 CD |
11370 | (defun org-time-string-to-time (s) |
11371 | (apply 'encode-time (org-parse-time-string s))) | |
791d856f | 11372 | |
20908596 CD |
11373 | (defun org-time-string-to-absolute (s &optional daynr prefer show-all) |
11374 | "Convert a time stamp to an absolute day number. | |
11375 | If there is a specifyer for a cyclic time stamp, get the closest date to | |
11376 | DAYNR. | |
d60b1ba1 | 11377 | PREFER and SHOW-ALL are passed through to `org-closest-date'." |
20908596 CD |
11378 | (cond |
11379 | ((and daynr (string-match "\\`%%\\((.*)\\)" s)) | |
11380 | (if (org-diary-sexp-entry (match-string 1 s) "" date) | |
11381 | daynr | |
11382 | (+ daynr 1000))) | |
11383 | ((and daynr (string-match "\\+[0-9]+[dwmy]" s)) | |
11384 | (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr | |
11385 | (time-to-days (current-time))) (match-string 0 s) | |
11386 | prefer show-all)) | |
11387 | (t (time-to-days (apply 'encode-time (org-parse-time-string s)))))) | |
791d856f | 11388 | |
20908596 CD |
11389 | (defun org-days-to-iso-week (days) |
11390 | "Return the iso week number." | |
11391 | (require 'cal-iso) | |
11392 | (car (calendar-iso-from-absolute days))) | |
11393 | ||
11394 | (defun org-small-year-to-year (year) | |
11395 | "Convert 2-digit years into 4-digit years. | |
11396 | 38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007. | |
d60b1ba1 CD |
11397 | The year 2000 cannot be abbreviated. Any year larger than 99 |
11398 | is returned unchanged." | |
20908596 CD |
11399 | (if (< year 38) |
11400 | (setq year (+ 2000 year)) | |
11401 | (if (< year 100) | |
11402 | (setq year (+ 1900 year)))) | |
11403 | year) | |
791d856f | 11404 | |
20908596 CD |
11405 | (defun org-time-from-absolute (d) |
11406 | "Return the time corresponding to date D. | |
11407 | D may be an absolute day number, or a calendar-type list (month day year)." | |
11408 | (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) | |
11409 | (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) | |
d3f4dbe8 | 11410 | |
20908596 CD |
11411 | (defun org-calendar-holiday () |
11412 | "List of holidays, for Diary display in Org-mode." | |
11413 | (require 'holidays) | |
11414 | (let ((hl (funcall | |
11415 | (if (fboundp 'calendar-check-holidays) | |
11416 | 'calendar-check-holidays 'check-calendar-holidays) date))) | |
11417 | (if hl (mapconcat 'identity hl "; ")))) | |
d3f4dbe8 | 11418 | |
20908596 CD |
11419 | (defun org-diary-sexp-entry (sexp entry date) |
11420 | "Process a SEXP diary ENTRY for DATE." | |
11421 | (require 'diary-lib) | |
11422 | (let ((result (if calendar-debug-sexp | |
11423 | (let ((stack-trace-on-error t)) | |
11424 | (eval (car (read-from-string sexp)))) | |
11425 | (condition-case nil | |
11426 | (eval (car (read-from-string sexp))) | |
11427 | (error | |
11428 | (beep) | |
11429 | (message "Bad sexp at line %d in %s: %s" | |
11430 | (org-current-line) | |
11431 | (buffer-file-name) sexp) | |
11432 | (sleep-for 2)))))) | |
11433 | (cond ((stringp result) result) | |
11434 | ((and (consp result) | |
11435 | (stringp (cdr result))) (cdr result)) | |
11436 | (result entry) | |
11437 | (t nil)))) | |
d3f4dbe8 | 11438 | |
20908596 CD |
11439 | (defun org-diary-to-ical-string (frombuf) |
11440 | "Get iCalendar entries from diary entries in buffer FROMBUF. | |
11441 | This uses the icalendar.el library." | |
11442 | (let* ((tmpdir (if (featurep 'xemacs) | |
11443 | (temp-directory) | |
11444 | temporary-file-directory)) | |
11445 | (tmpfile (make-temp-name | |
11446 | (expand-file-name "orgics" tmpdir))) | |
11447 | buf rtn b e) | |
11448 | (save-excursion | |
11449 | (set-buffer frombuf) | |
11450 | (icalendar-export-region (point-min) (point-max) tmpfile) | |
11451 | (setq buf (find-buffer-visiting tmpfile)) | |
11452 | (set-buffer buf) | |
11453 | (goto-char (point-min)) | |
11454 | (if (re-search-forward "^BEGIN:VEVENT" nil t) | |
11455 | (setq b (match-beginning 0))) | |
11456 | (goto-char (point-max)) | |
11457 | (if (re-search-backward "^END:VEVENT" nil t) | |
11458 | (setq e (match-end 0))) | |
11459 | (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) | |
11460 | (kill-buffer buf) | |
20908596 CD |
11461 | (delete-file tmpfile) |
11462 | rtn)) | |
d3f4dbe8 | 11463 | |
20908596 CD |
11464 | (defun org-closest-date (start current change prefer show-all) |
11465 | "Find the date closest to CURRENT that is consistent with START and CHANGE. | |
11466 | When PREFER is `past' return a date that is either CURRENT or past. | |
11467 | When PREFER is `future', return a date that is either CURRENT or future. | |
11468 | When SHOW-ALL is nil, only return the current occurence of a time stamp." | |
11469 | ;; Make the proper lists from the dates | |
d3f4dbe8 | 11470 | (catch 'exit |
20908596 CD |
11471 | (let ((a1 '(("d" . day) ("w" . week) ("m" . month) ("y" . year))) |
11472 | dn dw sday cday n1 n2 | |
11473 | d m y y1 y2 date1 date2 nmonths nm ny m2) | |
d3f4dbe8 | 11474 | |
20908596 CD |
11475 | (setq start (org-date-to-gregorian start) |
11476 | current (org-date-to-gregorian | |
11477 | (if show-all | |
11478 | current | |
11479 | (time-to-days (current-time)))) | |
11480 | sday (calendar-absolute-from-gregorian start) | |
11481 | cday (calendar-absolute-from-gregorian current)) | |
d3f4dbe8 | 11482 | |
20908596 | 11483 | (if (<= cday sday) (throw 'exit sday)) |
791d856f | 11484 | |
20908596 CD |
11485 | (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) |
11486 | (setq dn (string-to-number (match-string 1 change)) | |
11487 | dw (cdr (assoc (match-string 2 change) a1))) | |
11488 | (error "Invalid change specifyer: %s" change)) | |
11489 | (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) | |
11490 | (cond | |
11491 | ((eq dw 'day) | |
11492 | (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn)))) | |
11493 | n2 (+ n1 dn))) | |
11494 | ((eq dw 'year) | |
11495 | (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current)) | |
11496 | (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1)) | |
11497 | (setq date1 (list m d y1) | |
11498 | n1 (calendar-absolute-from-gregorian date1) | |
11499 | date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) | |
11500 | n2 (calendar-absolute-from-gregorian date2))) | |
11501 | ((eq dw 'month) | |
2c3ad40d | 11502 | ;; approx number of month between the two dates |
20908596 CD |
11503 | (setq nmonths (floor (/ (- cday sday) 30.436875))) |
11504 | ;; How often does dn fit in there? | |
11505 | (setq d (nth 1 start) m (car start) y (nth 2 start) | |
11506 | nm (* dn (max 0 (1- (floor (/ nmonths dn))))) | |
11507 | m (+ m nm) | |
11508 | ny (floor (/ m 12)) | |
11509 | y (+ y ny) | |
11510 | m (- m (* ny 12))) | |
11511 | (while (> m 12) (setq m (- m 12) y (1+ y))) | |
11512 | (setq n1 (calendar-absolute-from-gregorian (list m d y))) | |
11513 | (setq m2 (+ m dn) y2 y) | |
11514 | (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) | |
11515 | (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) | |
2c3ad40d | 11516 | (while (<= n2 cday) |
20908596 CD |
11517 | (setq n1 n2 m m2 y y2) |
11518 | (setq m2 (+ m dn) y2 y) | |
11519 | (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) | |
11520 | (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) | |
20908596 CD |
11521 | (if show-all |
11522 | (cond | |
11523 | ((eq prefer 'past) n1) | |
11524 | ((eq prefer 'future) (if (= cday n1) n1 n2)) | |
11525 | (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))) | |
11526 | (cond | |
11527 | ((eq prefer 'past) n1) | |
11528 | ((eq prefer 'future) (if (= cday n1) n1 n2)) | |
11529 | (t (if (= cday n1) n1 n2))))))) | |
791d856f | 11530 | |
20908596 CD |
11531 | (defun org-date-to-gregorian (date) |
11532 | "Turn any specification of DATE into a gregorian date for the calendar." | |
11533 | (cond ((integerp date) (calendar-gregorian-from-absolute date)) | |
11534 | ((and (listp date) (= (length date) 3)) date) | |
11535 | ((stringp date) | |
11536 | (setq date (org-parse-time-string date)) | |
11537 | (list (nth 4 date) (nth 3 date) (nth 5 date))) | |
11538 | ((listp date) | |
11539 | (list (nth 4 date) (nth 3 date) (nth 5 date))))) | |
d3f4dbe8 | 11540 | |
20908596 CD |
11541 | (defun org-parse-time-string (s &optional nodefault) |
11542 | "Parse the standard Org-mode time string. | |
11543 | This should be a lot faster than the normal `parse-time-string'. | |
11544 | If time is not given, defaults to 0:00. However, with optional NODEFAULT, | |
11545 | hour and minute fields will be nil if not given." | |
11546 | (if (string-match org-ts-regexp0 s) | |
11547 | (list 0 | |
11548 | (if (or (match-beginning 8) (not nodefault)) | |
11549 | (string-to-number (or (match-string 8 s) "0"))) | |
11550 | (if (or (match-beginning 7) (not nodefault)) | |
11551 | (string-to-number (or (match-string 7 s) "0"))) | |
11552 | (string-to-number (match-string 4 s)) | |
11553 | (string-to-number (match-string 3 s)) | |
11554 | (string-to-number (match-string 2 s)) | |
11555 | nil nil nil) | |
11556 | (make-list 9 0))) | |
d3f4dbe8 | 11557 | |
20908596 CD |
11558 | (defun org-timestamp-up (&optional arg) |
11559 | "Increase the date item at the cursor by one. | |
11560 | If the cursor is on the year, change the year. If it is on the month or | |
11561 | the day, change that. | |
11562 | With prefix ARG, change by that many units." | |
11563 | (interactive "p") | |
11564 | (org-timestamp-change (prefix-numeric-value arg))) | |
d3f4dbe8 | 11565 | |
20908596 CD |
11566 | (defun org-timestamp-down (&optional arg) |
11567 | "Decrease the date item at the cursor by one. | |
11568 | If the cursor is on the year, change the year. If it is on the month or | |
11569 | the day, change that. | |
11570 | With prefix ARG, change by that many units." | |
11571 | (interactive "p") | |
11572 | (org-timestamp-change (- (prefix-numeric-value arg)))) | |
d3f4dbe8 | 11573 | |
20908596 CD |
11574 | (defun org-timestamp-up-day (&optional arg) |
11575 | "Increase the date in the time stamp by one day. | |
11576 | With prefix ARG, change that many days." | |
11577 | (interactive "p") | |
11578 | (if (and (not (org-at-timestamp-p t)) | |
11579 | (org-on-heading-p)) | |
11580 | (org-todo 'up) | |
11581 | (org-timestamp-change (prefix-numeric-value arg) 'day))) | |
d3f4dbe8 | 11582 | |
20908596 CD |
11583 | (defun org-timestamp-down-day (&optional arg) |
11584 | "Decrease the date in the time stamp by one day. | |
11585 | With prefix ARG, change that many days." | |
11586 | (interactive "p") | |
11587 | (if (and (not (org-at-timestamp-p t)) | |
11588 | (org-on-heading-p)) | |
11589 | (org-todo 'down) | |
11590 | (org-timestamp-change (- (prefix-numeric-value arg)) 'day))) | |
d3f4dbe8 | 11591 | |
20908596 CD |
11592 | (defun org-at-timestamp-p (&optional inactive-ok) |
11593 | "Determine if the cursor is in or at a timestamp." | |
11594 | (interactive) | |
11595 | (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) | |
11596 | (pos (point)) | |
11597 | (ans (or (looking-at tsr) | |
11598 | (save-excursion | |
11599 | (skip-chars-backward "^[<\n\r\t") | |
11600 | (if (> (point) (point-min)) (backward-char 1)) | |
11601 | (and (looking-at tsr) | |
11602 | (> (- (match-end 0) pos) -1)))))) | |
11603 | (and ans | |
11604 | (boundp 'org-ts-what) | |
11605 | (setq org-ts-what | |
11606 | (cond | |
11607 | ((= pos (match-beginning 0)) 'bracket) | |
11608 | ((= pos (1- (match-end 0))) 'bracket) | |
11609 | ((org-pos-in-match-range pos 2) 'year) | |
11610 | ((org-pos-in-match-range pos 3) 'month) | |
11611 | ((org-pos-in-match-range pos 7) 'hour) | |
11612 | ((org-pos-in-match-range pos 8) 'minute) | |
11613 | ((or (org-pos-in-match-range pos 4) | |
11614 | (org-pos-in-match-range pos 5)) 'day) | |
11615 | ((and (> pos (or (match-end 8) (match-end 5))) | |
11616 | (< pos (match-end 0))) | |
11617 | (- pos (or (match-end 8) (match-end 5)))) | |
11618 | (t 'day)))) | |
11619 | ans)) | |
a3fbe8c4 | 11620 | |
20908596 CD |
11621 | (defun org-toggle-timestamp-type () |
11622 | "Toggle the type (<active> or [inactive]) of a time stamp." | |
11623 | (interactive) | |
11624 | (when (org-at-timestamp-p t) | |
93b62de8 CD |
11625 | (let ((beg (match-beginning 0)) (end (match-end 0)) |
11626 | (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) | |
11627 | (save-excursion | |
11628 | (goto-char beg) | |
11629 | (while (re-search-forward "[][<>]" end t) | |
11630 | (replace-match (cdr (assoc (char-after (match-beginning 0)) map)) | |
11631 | t t))) | |
11632 | (message "Timestamp is now %sactive" | |
11633 | (if (equal (char-after beg) ?<) "" "in"))))) | |
a3fbe8c4 | 11634 | |
20908596 CD |
11635 | (defun org-timestamp-change (n &optional what) |
11636 | "Change the date in the time stamp at point. | |
11637 | The date will be changed by N times WHAT. WHAT can be `day', `month', | |
11638 | `year', `minute', `second'. If WHAT is not given, the cursor position | |
11639 | in the timestamp determines what will be changed." | |
11640 | (let ((pos (point)) | |
11641 | with-hm inactive | |
11642 | (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) | |
11643 | org-ts-what | |
11644 | extra rem | |
11645 | ts time time0) | |
11646 | (if (not (org-at-timestamp-p t)) | |
11647 | (error "Not at a timestamp")) | |
11648 | (if (and (not what) (eq org-ts-what 'bracket)) | |
11649 | (org-toggle-timestamp-type) | |
11650 | (if (and (not what) (not (eq org-ts-what 'day)) | |
11651 | org-display-custom-times | |
11652 | (get-text-property (point) 'display) | |
11653 | (not (get-text-property (1- (point)) 'display))) | |
11654 | (setq org-ts-what 'day)) | |
11655 | (setq org-ts-what (or what org-ts-what) | |
11656 | inactive (= (char-after (match-beginning 0)) ?\[) | |
11657 | ts (match-string 0)) | |
11658 | (replace-match "") | |
11659 | (if (string-match | |
11660 | "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\)*\\)[]>]" | |
11661 | ts) | |
11662 | (setq extra (match-string 1 ts))) | |
11663 | (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) | |
11664 | (setq with-hm t)) | |
11665 | (setq time0 (org-parse-time-string ts)) | |
11666 | (when (and (eq org-ts-what 'minute) | |
11667 | (eq current-prefix-arg nil)) | |
11668 | (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) | |
11669 | (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) | |
11670 | (setcar (cdr time0) (+ (nth 1 time0) | |
11671 | (if (> n 0) (- rem) (- dm rem)))))) | |
11672 | (setq time | |
11673 | (encode-time (or (car time0) 0) | |
11674 | (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) | |
11675 | (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) | |
11676 | (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) | |
11677 | (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) | |
11678 | (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) | |
11679 | (nthcdr 6 time0))) | |
11680 | (when (integerp org-ts-what) | |
11681 | (setq extra (org-modify-ts-extra extra org-ts-what n dm))) | |
11682 | (if (eq what 'calendar) | |
11683 | (let ((cal-date (org-get-date-from-calendar))) | |
11684 | (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month | |
11685 | (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day | |
11686 | (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year | |
11687 | (setcar time0 (or (car time0) 0)) | |
11688 | (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) | |
11689 | (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) | |
11690 | (setq time (apply 'encode-time time0)))) | |
11691 | (setq org-last-changed-timestamp | |
11692 | (org-insert-time-stamp time with-hm inactive nil nil extra)) | |
11693 | (org-clock-update-time-maybe) | |
11694 | (goto-char pos) | |
11695 | ;; Try to recenter the calendar window, if any | |
11696 | (if (and org-calendar-follow-timestamp-change | |
11697 | (get-buffer-window "*Calendar*" t) | |
11698 | (memq org-ts-what '(day month year))) | |
11699 | (org-recenter-calendar (time-to-days time)))))) | |
4b3a9ba7 | 11700 | |
20908596 CD |
11701 | (defun org-modify-ts-extra (s pos n dm) |
11702 | "Change the different parts of the lead-time and repeat fields in timestamp." | |
11703 | (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) | |
11704 | ng h m new rem) | |
11705 | (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s) | |
891f4676 | 11706 | (cond |
20908596 CD |
11707 | ((or (org-pos-in-match-range pos 2) |
11708 | (org-pos-in-match-range pos 3)) | |
11709 | (setq m (string-to-number (match-string 3 s)) | |
11710 | h (string-to-number (match-string 2 s))) | |
11711 | (if (org-pos-in-match-range pos 2) | |
11712 | (setq h (+ h n)) | |
11713 | (setq n (* dm (org-no-warnings (signum n)))) | |
11714 | (when (not (= 0 (setq rem (% m dm)))) | |
11715 | (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) | |
11716 | (setq m (+ m n))) | |
11717 | (if (< m 0) (setq m (+ m 60) h (1- h))) | |
11718 | (if (> m 59) (setq m (- m 60) h (1+ h))) | |
11719 | (setq h (min 24 (max 0 h))) | |
11720 | (setq ng 1 new (format "-%02d:%02d" h m))) | |
11721 | ((org-pos-in-match-range pos 6) | |
11722 | (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) | |
11723 | ((org-pos-in-match-range pos 5) | |
11724 | (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s))))))) | |
891f4676 | 11725 | |
20908596 CD |
11726 | ((org-pos-in-match-range pos 9) |
11727 | (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx)))) | |
11728 | ((org-pos-in-match-range pos 8) | |
11729 | (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s)))))))) | |
a3fbe8c4 | 11730 | |
20908596 CD |
11731 | (when ng |
11732 | (setq s (concat | |
11733 | (substring s 0 (match-beginning ng)) | |
11734 | new | |
11735 | (substring s (match-end ng)))))) | |
11736 | s)) | |
6769c0dc | 11737 | |
20908596 CD |
11738 | (defun org-recenter-calendar (date) |
11739 | "If the calendar is visible, recenter it to DATE." | |
11740 | (let* ((win (selected-window)) | |
11741 | (cwin (get-buffer-window "*Calendar*" t)) | |
11742 | (calendar-move-hook nil)) | |
11743 | (when cwin | |
11744 | (select-window cwin) | |
11745 | (calendar-goto-date (if (listp date) date | |
11746 | (calendar-gregorian-from-absolute date))) | |
11747 | (select-window win)))) | |
2a57416f | 11748 | |
20908596 CD |
11749 | (defun org-goto-calendar (&optional arg) |
11750 | "Go to the Emacs calendar at the current date. | |
11751 | If there is a time stamp in the current line, go to that date. | |
11752 | A prefix ARG can be used to force the current date." | |
11753 | (interactive "P") | |
11754 | (let ((tsr org-ts-regexp) diff | |
11755 | (calendar-move-hook nil) | |
11756 | (calendar-view-holidays-initially-flag nil) | |
11757 | (view-calendar-holidays-initially nil) | |
11758 | (calendar-view-diary-initially-flag nil) | |
11759 | (view-diary-entries-initially nil)) | |
11760 | (if (or (org-at-timestamp-p) | |
11761 | (save-excursion | |
11762 | (beginning-of-line 1) | |
11763 | (looking-at (concat ".*" tsr)))) | |
11764 | (let ((d1 (time-to-days (current-time))) | |
11765 | (d2 (time-to-days | |
11766 | (org-time-string-to-time (match-string 1))))) | |
11767 | (setq diff (- d2 d1)))) | |
11768 | (calendar) | |
11769 | (calendar-goto-today) | |
11770 | (if (and diff (not arg)) (calendar-forward-day diff)))) | |
a3fbe8c4 | 11771 | |
20908596 CD |
11772 | (defun org-get-date-from-calendar () |
11773 | "Return a list (month day year) of date at point in calendar." | |
11774 | (with-current-buffer "*Calendar*" | |
11775 | (save-match-data | |
11776 | (calendar-cursor-to-date)))) | |
6769c0dc | 11777 | |
20908596 CD |
11778 | (defun org-date-from-calendar () |
11779 | "Insert time stamp corresponding to cursor date in *Calendar* buffer. | |
11780 | If there is already a time stamp at the cursor position, update it." | |
11781 | (interactive) | |
11782 | (if (org-at-timestamp-p t) | |
11783 | (org-timestamp-change 0 'calendar) | |
11784 | (let ((cal-date (org-get-date-from-calendar))) | |
11785 | (org-insert-time-stamp | |
11786 | (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) | |
d3f4dbe8 | 11787 | |
20908596 CD |
11788 | (defun org-minutes-to-hh:mm-string (m) |
11789 | "Compute H:MM from a number of minutes." | |
11790 | (let ((h (/ m 60))) | |
11791 | (setq m (- m (* 60 h))) | |
b349f79f | 11792 | (format org-time-clocksum-format h m))) |
8c6fb58b | 11793 | |
20908596 CD |
11794 | (defun org-hh:mm-string-to-minutes (s) |
11795 | "Convert a string H:MM to a number of minutes." | |
11796 | (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) | |
11797 | (+ (* (string-to-number (match-string 1 s)) 60) | |
11798 | (string-to-number (match-string 2 s))) | |
11799 | 0)) | |
6769c0dc | 11800 | |
20908596 CD |
11801 | ;;;; Agenda files |
11802 | ||
11803 | ;;;###autoload | |
11804 | (defun org-iswitchb (&optional arg) | |
11805 | "Use `iswitchb-read-buffer' to prompt for an Org buffer to switch to. | |
11806 | With a prefix argument, restrict available to files. | |
11807 | With two prefix arguments, restrict available buffers to agenda files. | |
11808 | ||
621f83e4 | 11809 | Due to some yet unresolved reason, the global function |
20908596 CD |
11810 | `iswitchb-mode' needs to be active for this function to work." |
11811 | (interactive "P") | |
11812 | (require 'iswitchb) | |
11813 | (let ((enabled iswitchb-mode) blist) | |
11814 | (or enabled (iswitchb-mode 1)) | |
11815 | (setq blist (cond ((equal arg '(4)) (org-buffer-list 'files)) | |
11816 | ((equal arg '(16)) (org-buffer-list 'agenda)) | |
11817 | (t (org-buffer-list)))) | |
11818 | (unwind-protect | |
11819 | (let ((iswitchb-make-buflist-hook | |
11820 | (lambda () | |
11821 | (setq iswitchb-temp-buflist | |
11822 | (mapcar 'buffer-name blist))))) | |
11823 | (switch-to-buffer | |
11824 | (iswitchb-read-buffer | |
11825 | "Switch-to: " nil t)) | |
11826 | (or enabled (iswitchb-mode -1)))))) | |
11827 | ||
621f83e4 | 11828 | (defun org-buffer-list (&optional predicate exclude-tmp) |
20908596 | 11829 | "Return a list of Org buffers. |
621f83e4 CD |
11830 | PREDICATE can be `export', `files' or `agenda'. |
11831 | ||
11832 | export restrict the list to Export buffers. | |
11833 | files restrict the list to buffers visiting Org files. | |
11834 | agenda restrict the list to buffers visiting agenda files. | |
11835 | ||
11836 | If EXCLUDE-TMP is non-nil, ignore temporary buffers." | |
11837 | (let* ((bfn nil) | |
11838 | (agenda-files (and (eq predicate 'agenda) | |
11839 | (mapcar 'file-truename (org-agenda-files t)))) | |
11840 | (filter | |
11841 | (cond | |
11842 | ((eq predicate 'files) | |
11843 | (lambda (b) (with-current-buffer b (eq major-mode 'org-mode)))) | |
11844 | ((eq predicate 'export) | |
11845 | (lambda (b) (string-match "\*Org .*Export" (buffer-name b)))) | |
11846 | ((eq predicate 'agenda) | |
11847 | (lambda (b) | |
ce4fdcb9 | 11848 | (with-current-buffer b |
621f83e4 CD |
11849 | (and (eq major-mode 'org-mode) |
11850 | (setq bfn (buffer-file-name b)) | |
11851 | (member (file-truename bfn) agenda-files))))) | |
ce4fdcb9 | 11852 | (t (lambda (b) (with-current-buffer b |
621f83e4 CD |
11853 | (or (eq major-mode 'org-mode) |
11854 | (string-match "\*Org .*Export" | |
11855 | (buffer-name b))))))))) | |
11856 | (delq nil | |
20908596 CD |
11857 | (mapcar |
11858 | (lambda(b) | |
621f83e4 CD |
11859 | (if (and (funcall filter b) |
11860 | (or (not exclude-tmp) | |
11861 | (not (string-match "tmp" (buffer-name b))))) | |
11862 | b | |
11863 | nil)) | |
11864 | (buffer-list))))) | |
20908596 | 11865 | |
2c3ad40d | 11866 | (defun org-agenda-files (&optional unrestricted archives) |
20908596 CD |
11867 | "Get the list of agenda files. |
11868 | Optional UNRESTRICTED means return the full list even if a restriction | |
11869 | is currently in place. | |
2c3ad40d CD |
11870 | When ARCHIVES is t, include all archive files hat are really being |
11871 | used by the agenda files. If ARCHIVE is `ifmode', do this only if | |
11872 | `org-agenda-archives-mode' is t." | |
20908596 CD |
11873 | (let ((files |
11874 | (cond | |
11875 | ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) | |
11876 | ((stringp org-agenda-files) (org-read-agenda-file-list)) | |
11877 | ((listp org-agenda-files) org-agenda-files) | |
11878 | (t (error "Invalid value of `org-agenda-files'"))))) | |
11879 | (setq files (apply 'append | |
11880 | (mapcar (lambda (f) | |
11881 | (if (file-directory-p f) | |
11882 | (directory-files | |
11883 | f t org-agenda-file-regexp) | |
11884 | (list f))) | |
11885 | files))) | |
11886 | (when org-agenda-skip-unavailable-files | |
11887 | (setq files (delq nil | |
11888 | (mapcar (function | |
11889 | (lambda (file) | |
11890 | (and (file-readable-p file) file))) | |
11891 | files)))) | |
2c3ad40d CD |
11892 | (when (or (eq archives t) |
11893 | (and (eq archives 'ifmode) (eq org-agenda-archives-mode t))) | |
11894 | (setq files (org-add-archive-files files))) | |
20908596 CD |
11895 | files)) |
11896 | ||
11897 | (defun org-edit-agenda-file-list () | |
11898 | "Edit the list of agenda files. | |
11899 | Depending on setup, this either uses customize to edit the variable | |
11900 | `org-agenda-files', or it visits the file that is holding the list. In the | |
11901 | latter case, the buffer is set up in a way that saving it automatically kills | |
11902 | the buffer and restores the previous window configuration." | |
11903 | (interactive) | |
11904 | (if (stringp org-agenda-files) | |
11905 | (let ((cw (current-window-configuration))) | |
11906 | (find-file org-agenda-files) | |
11907 | (org-set-local 'org-window-configuration cw) | |
11908 | (org-add-hook 'after-save-hook | |
11909 | (lambda () | |
11910 | (set-window-configuration | |
11911 | (prog1 org-window-configuration | |
11912 | (kill-buffer (current-buffer)))) | |
11913 | (org-install-agenda-files-menu) | |
11914 | (message "New agenda file list installed")) | |
11915 | nil 'local) | |
11916 | (message "%s" (substitute-command-keys | |
11917 | "Edit list and finish with \\[save-buffer]"))) | |
11918 | (customize-variable 'org-agenda-files))) | |
6769c0dc | 11919 | |
20908596 CD |
11920 | (defun org-store-new-agenda-file-list (list) |
11921 | "Set new value for the agenda file list and save it correcly." | |
11922 | (if (stringp org-agenda-files) | |
11923 | (let ((f org-agenda-files) b) | |
11924 | (while (setq b (find-buffer-visiting f)) (kill-buffer b)) | |
11925 | (with-temp-file f | |
11926 | (insert (mapconcat 'identity list "\n") "\n"))) | |
11927 | (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) | |
11928 | (setq org-agenda-files list) | |
11929 | (customize-save-variable 'org-agenda-files org-agenda-files)))) | |
6769c0dc | 11930 | |
20908596 CD |
11931 | (defun org-read-agenda-file-list () |
11932 | "Read the list of agenda files from a file." | |
11933 | (when (file-directory-p org-agenda-files) | |
11934 | (error "`org-agenda-files' cannot be a single directory")) | |
11935 | (when (stringp org-agenda-files) | |
11936 | (with-temp-buffer | |
11937 | (insert-file-contents org-agenda-files) | |
11938 | (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))) | |
6769c0dc | 11939 | |
272dfec2 | 11940 | |
20908596 CD |
11941 | ;;;###autoload |
11942 | (defun org-cycle-agenda-files () | |
11943 | "Cycle through the files in `org-agenda-files'. | |
11944 | If the current buffer visits an agenda file, find the next one in the list. | |
11945 | If the current buffer does not, find the first agenda file." | |
11946 | (interactive) | |
11947 | (let* ((fs (org-agenda-files t)) | |
11948 | (files (append fs (list (car fs)))) | |
11949 | (tcf (if buffer-file-name (file-truename buffer-file-name))) | |
11950 | file) | |
11951 | (unless files (error "No agenda files")) | |
0b8568f5 | 11952 | (catch 'exit |
20908596 CD |
11953 | (while (setq file (pop files)) |
11954 | (if (equal (file-truename file) tcf) | |
11955 | (when (car files) | |
11956 | (find-file (car files)) | |
11957 | (throw 'exit t)))) | |
11958 | (find-file (car fs))) | |
11959 | (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer))))) | |
634a7d0b | 11960 | |
20908596 CD |
11961 | (defun org-agenda-file-to-front (&optional to-end) |
11962 | "Move/add the current file to the top of the agenda file list. | |
11963 | If the file is not present in the list, it is added to the front. If it is | |
11964 | present, it is moved there. With optional argument TO-END, add/move to the | |
11965 | end of the list." | |
891f4676 | 11966 | (interactive "P") |
20908596 CD |
11967 | (let ((org-agenda-skip-unavailable-files nil) |
11968 | (file-alist (mapcar (lambda (x) | |
11969 | (cons (file-truename x) x)) | |
11970 | (org-agenda-files t))) | |
11971 | (ctf (file-truename buffer-file-name)) | |
11972 | x had) | |
11973 | (setq x (assoc ctf file-alist) had x) | |
0b8568f5 | 11974 | |
20908596 CD |
11975 | (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) |
11976 | (if to-end | |
11977 | (setq file-alist (append (delq x file-alist) (list x))) | |
11978 | (setq file-alist (cons x (delq x file-alist)))) | |
11979 | (org-store-new-agenda-file-list (mapcar 'cdr file-alist)) | |
11980 | (org-install-agenda-files-menu) | |
11981 | (message "File %s to %s of agenda file list" | |
11982 | (if had "moved" "added") (if to-end "end" "front")))) | |
0b8568f5 | 11983 | |
20908596 CD |
11984 | (defun org-remove-file (&optional file) |
11985 | "Remove current file from the list of files in variable `org-agenda-files'. | |
11986 | These are the files which are being checked for agenda entries. | |
11987 | Optional argument FILE means, use this file instead of the current." | |
11988 | (interactive) | |
11989 | (let* ((org-agenda-skip-unavailable-files nil) | |
11990 | (file (or file buffer-file-name)) | |
11991 | (true-file (file-truename file)) | |
11992 | (afile (abbreviate-file-name file)) | |
11993 | (files (delq nil (mapcar | |
11994 | (lambda (x) | |
11995 | (if (equal true-file | |
11996 | (file-truename x)) | |
11997 | nil x)) | |
11998 | (org-agenda-files t))))) | |
11999 | (if (not (= (length files) (length (org-agenda-files t)))) | |
12000 | (progn | |
12001 | (org-store-new-agenda-file-list files) | |
12002 | (org-install-agenda-files-menu) | |
12003 | (message "Removed file: %s" afile)) | |
12004 | (message "File was not in list: %s (not removed)" afile)))) | |
891f4676 | 12005 | |
20908596 CD |
12006 | (defun org-file-menu-entry (file) |
12007 | (vector file (list 'find-file file) t)) | |
891f4676 | 12008 | |
20908596 CD |
12009 | (defun org-check-agenda-file (file) |
12010 | "Make sure FILE exists. If not, ask user what to do." | |
12011 | (when (not (file-exists-p file)) | |
12012 | (message "non-existent file %s. [R]emove from list or [A]bort?" | |
12013 | (abbreviate-file-name file)) | |
12014 | (let ((r (downcase (read-char-exclusive)))) | |
891f4676 | 12015 | (cond |
20908596 CD |
12016 | ((equal r ?r) |
12017 | (org-remove-file file) | |
12018 | (throw 'nextfile t)) | |
12019 | (t (error "Abort")))))) | |
a3fbe8c4 | 12020 | |
20908596 CD |
12021 | (defun org-get-agenda-file-buffer (file) |
12022 | "Get a buffer visiting FILE. If the buffer needs to be created, add | |
12023 | it to the list of buffers which might be released later." | |
12024 | (let ((buf (org-find-base-buffer-visiting file))) | |
12025 | (if buf | |
12026 | buf ; just return it | |
12027 | ;; Make a new buffer and remember it | |
12028 | (setq buf (find-file-noselect file)) | |
12029 | (if buf (push buf org-agenda-new-buffers)) | |
12030 | buf))) | |
a3fbe8c4 | 12031 | |
20908596 CD |
12032 | (defun org-release-buffers (blist) |
12033 | "Release all buffers in list, asking the user for confirmation when needed. | |
12034 | When a buffer is unmodified, it is just killed. When modified, it is saved | |
12035 | \(if the user agrees) and then killed." | |
12036 | (let (buf file) | |
12037 | (while (setq buf (pop blist)) | |
12038 | (setq file (buffer-file-name buf)) | |
12039 | (when (and (buffer-modified-p buf) | |
12040 | file | |
12041 | (y-or-n-p (format "Save file %s? " file))) | |
12042 | (with-current-buffer buf (save-buffer))) | |
12043 | (kill-buffer buf)))) | |
03f3cf35 | 12044 | |
20908596 CD |
12045 | (defun org-prepare-agenda-buffers (files) |
12046 | "Create buffers for all agenda files, protect archived trees and comments." | |
12047 | (interactive) | |
12048 | (let ((pa '(:org-archived t)) | |
12049 | (pc '(:org-comment t)) | |
12050 | (pall '(:org-archived t :org-comment t)) | |
12051 | (inhibit-read-only t) | |
12052 | (rea (concat ":" org-archive-tag ":")) | |
12053 | bmp file re) | |
ef943dba | 12054 | (save-excursion |
20908596 CD |
12055 | (save-restriction |
12056 | (while (setq file (pop files)) | |
12057 | (if (bufferp file) | |
12058 | (set-buffer file) | |
12059 | (org-check-agenda-file file) | |
12060 | (set-buffer (org-get-agenda-file-buffer file))) | |
12061 | (widen) | |
12062 | (setq bmp (buffer-modified-p)) | |
12063 | (org-refresh-category-properties) | |
12064 | (setq org-todo-keywords-for-agenda | |
12065 | (append org-todo-keywords-for-agenda org-todo-keywords-1)) | |
12066 | (setq org-done-keywords-for-agenda | |
12067 | (append org-done-keywords-for-agenda org-done-keywords)) | |
621f83e4 CD |
12068 | (setq org-todo-keyword-alist-for-agenda |
12069 | (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) | |
ce4fdcb9 | 12070 | (setq org-tag-alist-for-agenda |
621f83e4 CD |
12071 | (append org-tag-alist-for-agenda org-tag-alist)) |
12072 | ||
20908596 CD |
12073 | (save-excursion |
12074 | (remove-text-properties (point-min) (point-max) pall) | |
12075 | (when org-agenda-skip-archived-trees | |
12076 | (goto-char (point-min)) | |
12077 | (while (re-search-forward rea nil t) | |
12078 | (if (org-on-heading-p t) | |
12079 | (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) | |
12080 | (goto-char (point-min)) | |
12081 | (setq re (concat "^\\*+ +" org-comment-string "\\>")) | |
12082 | (while (re-search-forward re nil t) | |
12083 | (add-text-properties | |
12084 | (match-beginning 0) (org-end-of-subtree t) pc))) | |
621f83e4 CD |
12085 | (set-buffer-modified-p bmp)))) |
12086 | (setq org-todo-keyword-alist-for-agenda | |
12087 | (org-uniquify org-todo-keyword-alist-for-agenda) | |
12088 | org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda)))) | |
7d143c25 | 12089 | |
20908596 | 12090 | ;;;; Embedded LaTeX |
891f4676 | 12091 | |
20908596 CD |
12092 | (defvar org-cdlatex-mode-map (make-sparse-keymap) |
12093 | "Keymap for the minor `org-cdlatex-mode'.") | |
12094 | ||
12095 | (org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) | |
12096 | (org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) | |
12097 | (org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol) | |
12098 | (org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) | |
12099 | (org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) | |
12100 | ||
12101 | (defvar org-cdlatex-texmathp-advice-is-done nil | |
12102 | "Flag remembering if we have applied the advice to texmathp already.") | |
12103 | ||
12104 | (define-minor-mode org-cdlatex-mode | |
12105 | "Toggle the minor `org-cdlatex-mode'. | |
12106 | This mode supports entering LaTeX environment and math in LaTeX fragments | |
12107 | in Org-mode. | |
12108 | \\{org-cdlatex-mode-map}" | |
12109 | nil " OCDL" nil | |
12110 | (when org-cdlatex-mode (require 'cdlatex)) | |
12111 | (unless org-cdlatex-texmathp-advice-is-done | |
12112 | (setq org-cdlatex-texmathp-advice-is-done t) | |
12113 | (defadvice texmathp (around org-math-always-on activate) | |
12114 | "Always return t in org-mode buffers. | |
12115 | This is because we want to insert math symbols without dollars even outside | |
12116 | the LaTeX math segments. If Orgmode thinks that point is actually inside | |
12117 | en embedded LaTeX fragement, let texmathp do its job. | |
12118 | \\[org-cdlatex-mode-map]" | |
12119 | (interactive) | |
12120 | (let (p) | |
12121 | (cond | |
12122 | ((not (org-mode-p)) ad-do-it) | |
12123 | ((eq this-command 'cdlatex-math-symbol) | |
12124 | (setq ad-return-value t | |
12125 | texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) | |
12126 | (t | |
12127 | (let ((p (org-inside-LaTeX-fragment-p))) | |
12128 | (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) | |
12129 | (setq ad-return-value t | |
12130 | texmathp-why '("Org-mode embedded math" . 0)) | |
12131 | (if p ad-do-it))))))))) | |
891f4676 | 12132 | |
20908596 CD |
12133 | (defun turn-on-org-cdlatex () |
12134 | "Unconditionally turn on `org-cdlatex-mode'." | |
12135 | (org-cdlatex-mode 1)) | |
a3fbe8c4 | 12136 | |
20908596 CD |
12137 | (defun org-inside-LaTeX-fragment-p () |
12138 | "Test if point is inside a LaTeX fragment. | |
12139 | I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing | |
12140 | sequence appearing also before point. | |
12141 | Even though the matchers for math are configurable, this function assumes | |
12142 | that \\begin, \\(, \\[, and $$ are always used. Only the single dollar | |
12143 | delimiters are skipped when they have been removed by customization. | |
12144 | The return value is nil, or a cons cell with the delimiter and | |
12145 | and the position of this delimiter. | |
12146 | ||
12147 | This function does a reasonably good job, but can locally be fooled by | |
12148 | for example currency specifications. For example it will assume being in | |
12149 | inline math after \"$22.34\". The LaTeX fragment formatter will only format | |
12150 | fragments that are properly closed, but during editing, we have to live | |
12151 | with the uncertainty caused by missing closing delimiters. This function | |
12152 | looks only before point, not after." | |
12153 | (catch 'exit | |
12154 | (let ((pos (point)) | |
12155 | (dodollar (member "$" (plist-get org-format-latex-options :matchers))) | |
12156 | (lim (progn | |
12157 | (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) | |
12158 | (point))) | |
12159 | dd-on str (start 0) m re) | |
12160 | (goto-char pos) | |
12161 | (when dodollar | |
12162 | (setq str (concat (buffer-substring lim (point)) "\000 X$.") | |
12163 | re (nth 1 (assoc "$" org-latex-regexps))) | |
12164 | (while (string-match re str start) | |
12165 | (cond | |
12166 | ((= (match-end 0) (length str)) | |
12167 | (throw 'exit (cons "$" (+ lim (match-beginning 0) 1)))) | |
12168 | ((= (match-end 0) (- (length str) 5)) | |
12169 | (throw 'exit nil)) | |
12170 | (t (setq start (match-end 0)))))) | |
12171 | (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t)) | |
12172 | (goto-char pos) | |
12173 | (and (match-beginning 1) (throw 'exit (cons (match-string 1) m))) | |
12174 | (and (match-beginning 2) (throw 'exit nil)) | |
12175 | ;; count $$ | |
12176 | (while (re-search-backward "\\$\\$" lim t) | |
12177 | (setq dd-on (not dd-on))) | |
12178 | (goto-char pos) | |
12179 | (if dd-on (cons "$$" m)))))) | |
a3fbe8c4 | 12180 | |
891f4676 | 12181 | |
20908596 CD |
12182 | (defun org-try-cdlatex-tab () |
12183 | "Check if it makes sense to execute `cdlatex-tab', and do it if yes. | |
12184 | It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is | |
12185 | - inside a LaTeX fragment, or | |
12186 | - after the first word in a line, where an abbreviation expansion could | |
12187 | insert a LaTeX environment." | |
12188 | (when org-cdlatex-mode | |
0b8568f5 | 12189 | (cond |
20908596 CD |
12190 | ((save-excursion |
12191 | (skip-chars-backward "a-zA-Z0-9*") | |
12192 | (skip-chars-backward " \t") | |
12193 | (bolp)) | |
12194 | (cdlatex-tab) t) | |
12195 | ((org-inside-LaTeX-fragment-p) | |
12196 | (cdlatex-tab) t) | |
12197 | (t nil)))) | |
c8d16429 | 12198 | |
20908596 CD |
12199 | (defun org-cdlatex-underscore-caret (&optional arg) |
12200 | "Execute `cdlatex-sub-superscript' in LaTeX fragments. | |
12201 | Revert to the normal definition outside of these fragments." | |
12202 | (interactive "P") | |
12203 | (if (org-inside-LaTeX-fragment-p) | |
12204 | (call-interactively 'cdlatex-sub-superscript) | |
12205 | (let (org-cdlatex-mode) | |
12206 | (call-interactively (key-binding (vector last-input-event)))))) | |
e0e66b8e | 12207 | |
20908596 CD |
12208 | (defun org-cdlatex-math-modify (&optional arg) |
12209 | "Execute `cdlatex-math-modify' in LaTeX fragments. | |
12210 | Revert to the normal definition outside of these fragments." | |
12211 | (interactive "P") | |
12212 | (if (org-inside-LaTeX-fragment-p) | |
12213 | (call-interactively 'cdlatex-math-modify) | |
12214 | (let (org-cdlatex-mode) | |
12215 | (call-interactively (key-binding (vector last-input-event)))))) | |
4b3a9ba7 | 12216 | |
20908596 CD |
12217 | (defvar org-latex-fragment-image-overlays nil |
12218 | "List of overlays carrying the images of latex fragments.") | |
12219 | (make-variable-buffer-local 'org-latex-fragment-image-overlays) | |
891f4676 | 12220 | |
20908596 CD |
12221 | (defun org-remove-latex-fragment-image-overlays () |
12222 | "Remove all overlays with LaTeX fragment images in current buffer." | |
12223 | (mapc 'org-delete-overlay org-latex-fragment-image-overlays) | |
12224 | (setq org-latex-fragment-image-overlays nil)) | |
a3fbe8c4 | 12225 | |
20908596 CD |
12226 | (defun org-preview-latex-fragment (&optional subtree) |
12227 | "Preview the LaTeX fragment at point, or all locally or globally. | |
12228 | If the cursor is in a LaTeX fragment, create the image and overlay | |
12229 | it over the source code. If there is no fragment at point, display | |
12230 | all fragments in the current text, from one headline to the next. With | |
12231 | prefix SUBTREE, display all fragments in the current subtree. With a | |
12232 | double prefix `C-u C-u', or when the cursor is before the first headline, | |
12233 | display all fragments in the buffer. | |
12234 | The images can be removed again with \\[org-ctrl-c-ctrl-c]." | |
12235 | (interactive "P") | |
12236 | (org-remove-latex-fragment-image-overlays) | |
12237 | (save-excursion | |
12238 | (save-restriction | |
12239 | (let (beg end at msg) | |
12240 | (cond | |
12241 | ((or (equal subtree '(16)) | |
12242 | (not (save-excursion | |
12243 | (re-search-backward (concat "^" outline-regexp) nil t)))) | |
12244 | (setq beg (point-min) end (point-max) | |
12245 | msg "Creating images for buffer...%s")) | |
12246 | ((equal subtree '(4)) | |
12247 | (org-back-to-heading) | |
12248 | (setq beg (point) end (org-end-of-subtree t) | |
12249 | msg "Creating images for subtree...%s")) | |
12250 | (t | |
12251 | (if (setq at (org-inside-LaTeX-fragment-p)) | |
12252 | (goto-char (max (point-min) (- (cdr at) 2))) | |
12253 | (org-back-to-heading)) | |
12254 | (setq beg (point) end (progn (outline-next-heading) (point)) | |
12255 | msg (if at "Creating image...%s" | |
12256 | "Creating images for entry...%s")))) | |
12257 | (message msg "") | |
12258 | (narrow-to-region beg end) | |
12259 | (goto-char beg) | |
12260 | (org-format-latex | |
12261 | (concat "ltxpng/" (file-name-sans-extension | |
12262 | (file-name-nondirectory | |
12263 | buffer-file-name))) | |
12264 | default-directory 'overlays msg at 'forbuffer) | |
12265 | (message msg "done. Use `C-c C-c' to remove images."))))) | |
891f4676 | 12266 | |
20908596 CD |
12267 | (defvar org-latex-regexps |
12268 | '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) | |
12269 | ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) | |
12270 | ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p | |
12271 | ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([ .,?;:'\")\000]\\|$\\)" 2 nil) | |
12272 | ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) | |
12273 | ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 t) | |
12274 | ("$$" "\\$\\$[^\000]*?\\$\\$" 0 t)) | |
12275 | "Regular expressions for matching embedded LaTeX.") | |
891f4676 | 12276 | |
20908596 CD |
12277 | (defun org-format-latex (prefix &optional dir overlays msg at forbuffer) |
12278 | "Replace LaTeX fragments with links to an image, and produce images." | |
12279 | (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) | |
12280 | (let* ((prefixnodir (file-name-nondirectory prefix)) | |
12281 | (absprefix (expand-file-name prefix dir)) | |
12282 | (todir (file-name-directory absprefix)) | |
12283 | (opt org-format-latex-options) | |
12284 | (matchers (plist-get opt :matchers)) | |
12285 | (re-list org-latex-regexps) | |
12286 | (cnt 0) txt link beg end re e checkdir | |
12287 | m n block linkfile movefile ov) | |
12288 | ;; Check if there are old images files with this prefix, and remove them | |
12289 | (when (file-directory-p todir) | |
12290 | (mapc 'delete-file | |
12291 | (directory-files | |
12292 | todir 'full | |
12293 | (concat (regexp-quote prefixnodir) "_[0-9]+\\.png$")))) | |
12294 | ;; Check the different regular expressions | |
12295 | (while (setq e (pop re-list)) | |
12296 | (setq m (car e) re (nth 1 e) n (nth 2 e) | |
12297 | block (if (nth 3 e) "\n\n" "")) | |
12298 | (when (member m matchers) | |
12299 | (goto-char (point-min)) | |
12300 | (while (re-search-forward re nil t) | |
12301 | (when (or (not at) (equal (cdr at) (match-beginning n))) | |
12302 | (setq txt (match-string n) | |
12303 | beg (match-beginning n) end (match-end n) | |
12304 | cnt (1+ cnt) | |
12305 | linkfile (format "%s_%04d.png" prefix cnt) | |
12306 | movefile (format "%s_%04d.png" absprefix cnt) | |
12307 | link (concat block "[[file:" linkfile "]]" block)) | |
12308 | (if msg (message msg cnt)) | |
12309 | (goto-char beg) | |
12310 | (unless checkdir ; make sure the directory exists | |
12311 | (setq checkdir t) | |
12312 | (or (file-directory-p todir) (make-directory todir))) | |
12313 | (org-create-formula-image | |
12314 | txt movefile opt forbuffer) | |
12315 | (if overlays | |
d3f4dbe8 | 12316 | (progn |
20908596 CD |
12317 | (setq ov (org-make-overlay beg end)) |
12318 | (if (featurep 'xemacs) | |
12319 | (progn | |
12320 | (org-overlay-put ov 'invisible t) | |
12321 | (org-overlay-put | |
12322 | ov 'end-glyph | |
12323 | (make-glyph (vector 'png :file movefile)))) | |
12324 | (org-overlay-put | |
12325 | ov 'display | |
12326 | (list 'image :type 'png :file movefile :ascent 'center))) | |
12327 | (push ov org-latex-fragment-image-overlays) | |
12328 | (goto-char end)) | |
12329 | (delete-region beg end) | |
12330 | (insert link)))))))) | |
46177585 | 12331 | |
20908596 CD |
12332 | ;; This function borrows from Ganesh Swami's latex2png.el |
12333 | (defun org-create-formula-image (string tofile options buffer) | |
12334 | (let* ((tmpdir (if (featurep 'xemacs) | |
12335 | (temp-directory) | |
12336 | temporary-file-directory)) | |
12337 | (texfilebase (make-temp-name | |
12338 | (expand-file-name "orgtex" tmpdir))) | |
12339 | (texfile (concat texfilebase ".tex")) | |
12340 | (dvifile (concat texfilebase ".dvi")) | |
12341 | (pngfile (concat texfilebase ".png")) | |
12342 | (fnh (if (featurep 'xemacs) | |
12343 | (font-height (get-face-font 'default)) | |
12344 | (face-attribute 'default :height nil))) | |
12345 | (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) | |
12346 | (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) | |
12347 | (fg (or (plist-get options (if buffer :foreground :html-foreground)) | |
12348 | "Black")) | |
12349 | (bg (or (plist-get options (if buffer :background :html-background)) | |
12350 | "Transparent"))) | |
12351 | (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))) | |
12352 | (if (eq bg 'default) (setq bg (org-dvipng-color :background))) | |
12353 | (with-temp-file texfile | |
12354 | (insert org-format-latex-header | |
12355 | "\n\\begin{document}\n" string "\n\\end{document}\n")) | |
12356 | (let ((dir default-directory)) | |
12357 | (condition-case nil | |
12358 | (progn | |
12359 | (cd tmpdir) | |
12360 | (call-process "latex" nil nil nil texfile)) | |
12361 | (error nil)) | |
12362 | (cd dir)) | |
12363 | (if (not (file-exists-p dvifile)) | |
12364 | (progn (message "Failed to create dvi file from %s" texfile) nil) | |
2c3ad40d CD |
12365 | (condition-case nil |
12366 | (call-process "dvipng" nil nil nil | |
12367 | "-E" "-fg" fg "-bg" bg | |
12368 | "-D" dpi | |
12369 | ;;"-x" scale "-y" scale | |
12370 | "-T" "tight" | |
12371 | "-o" pngfile | |
12372 | dvifile) | |
12373 | (error nil)) | |
20908596 CD |
12374 | (if (not (file-exists-p pngfile)) |
12375 | (progn (message "Failed to create png file from %s" texfile) nil) | |
12376 | ;; Use the requested file name and clean up | |
12377 | (copy-file pngfile tofile 'replace) | |
12378 | (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do | |
12379 | (delete-file (concat texfilebase e))) | |
12380 | pngfile)))) | |
8c6fb58b | 12381 | |
20908596 CD |
12382 | (defun org-dvipng-color (attr) |
12383 | "Return an rgb color specification for dvipng." | |
12384 | (apply 'format "rgb %s %s %s" | |
12385 | (mapcar 'org-normalize-color | |
12386 | (color-values (face-attribute 'default attr nil))))) | |
c44f0d75 | 12387 | |
20908596 CD |
12388 | (defun org-normalize-color (value) |
12389 | "Return string to be used as color value for an RGB component." | |
12390 | (format "%g" (/ value 65535.0))) | |
6769c0dc | 12391 | |
46177585 | 12392 | |
d3f4dbe8 | 12393 | ;;;; Key bindings |
891f4676 | 12394 | |
1d676e9f | 12395 | ;; Make `C-c C-x' a prefix key |
a3fbe8c4 | 12396 | (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) |
1d676e9f | 12397 | |
28e5b051 | 12398 | ;; TAB key with modifiers |
a3fbe8c4 CD |
12399 | (org-defkey org-mode-map "\C-i" 'org-cycle) |
12400 | (org-defkey org-mode-map [(tab)] 'org-cycle) | |
12401 | (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) | |
12402 | (org-defkey org-mode-map [(meta tab)] 'org-complete) | |
12403 | (org-defkey org-mode-map "\M-\t" 'org-complete) | |
12404 | (org-defkey org-mode-map "\M-\C-i" 'org-complete) | |
28e5b051 | 12405 | ;; The following line is necessary under Suse GNU/Linux |
ab27a4a0 | 12406 | (unless (featurep 'xemacs) |
a3fbe8c4 CD |
12407 | (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) |
12408 | (org-defkey org-mode-map [(shift tab)] 'org-shifttab) | |
03f3cf35 | 12409 | (define-key org-mode-map [backtab] 'org-shifttab) |
28e5b051 | 12410 | |
a3fbe8c4 CD |
12411 | (org-defkey org-mode-map [(shift return)] 'org-table-copy-down) |
12412 | (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) | |
12413 | (org-defkey org-mode-map [(meta return)] 'org-meta-return) | |
28e5b051 CD |
12414 | |
12415 | ;; Cursor keys with modifiers | |
a3fbe8c4 CD |
12416 | (org-defkey org-mode-map [(meta left)] 'org-metaleft) |
12417 | (org-defkey org-mode-map [(meta right)] 'org-metaright) | |
12418 | (org-defkey org-mode-map [(meta up)] 'org-metaup) | |
12419 | (org-defkey org-mode-map [(meta down)] 'org-metadown) | |
12420 | ||
12421 | (org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) | |
12422 | (org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) | |
12423 | (org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) | |
12424 | (org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown) | |
3278a016 | 12425 | |
a3fbe8c4 CD |
12426 | (org-defkey org-mode-map [(shift up)] 'org-shiftup) |
12427 | (org-defkey org-mode-map [(shift down)] 'org-shiftdown) | |
12428 | (org-defkey org-mode-map [(shift left)] 'org-shiftleft) | |
12429 | (org-defkey org-mode-map [(shift right)] 'org-shiftright) | |
3278a016 | 12430 | |
a3fbe8c4 CD |
12431 | (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) |
12432 | (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) | |
28e5b051 | 12433 | |
d3f4dbe8 CD |
12434 | ;;; Extra keys for tty access. |
12435 | ;; We only set them when really needed because otherwise the | |
12436 | ;; menus don't show the simple keys | |
3278a016 | 12437 | |
621f83e4 CD |
12438 | (when (or org-use-extra-keys |
12439 | (featurep 'xemacs) ;; because XEmacs supports multi-device stuff | |
3278a016 | 12440 | (not window-system)) |
a3fbe8c4 CD |
12441 | (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) |
12442 | (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) | |
12443 | (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) | |
12444 | (org-defkey org-mode-map [?\e (return)] 'org-meta-return) | |
12445 | (org-defkey org-mode-map [?\e (left)] 'org-metaleft) | |
12446 | (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft) | |
12447 | (org-defkey org-mode-map [?\e (right)] 'org-metaright) | |
12448 | (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright) | |
12449 | (org-defkey org-mode-map [?\e (up)] 'org-metaup) | |
12450 | (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup) | |
12451 | (org-defkey org-mode-map [?\e (down)] 'org-metadown) | |
12452 | (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown) | |
12453 | (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) | |
12454 | (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright) | |
12455 | (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup) | |
12456 | (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown) | |
12457 | (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup) | |
12458 | (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown) | |
12459 | (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) | |
12460 | (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) | |
12461 | (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) | |
12462 | (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)) | |
d3f4dbe8 | 12463 | |
3278a016 | 12464 | ;; All the other keys |
bea5b1ba | 12465 | |
a3fbe8c4 CD |
12466 | (org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. |
12467 | (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) | |
2c3ad40d CD |
12468 | (if (boundp 'narrow-map) |
12469 | (org-defkey narrow-map "s" 'org-narrow-to-subtree) | |
12470 | (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) | |
a3fbe8c4 CD |
12471 | (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) |
12472 | (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) | |
12473 | (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) | |
20908596 CD |
12474 | (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) |
12475 | (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) | |
a3fbe8c4 CD |
12476 | (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) |
12477 | (org-defkey org-mode-map "\C-c\C-j" 'org-goto) | |
12478 | (org-defkey org-mode-map "\C-c\C-t" 'org-todo) | |
71d35b24 | 12479 | (org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command) |
a3fbe8c4 CD |
12480 | (org-defkey org-mode-map "\C-c\C-s" 'org-schedule) |
12481 | (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) | |
12482 | (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) | |
12483 | (org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) | |
8c6fb58b | 12484 | (org-defkey org-mode-map "\C-c\C-w" 'org-refile) |
03f3cf35 | 12485 | (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved |
a3fbe8c4 CD |
12486 | (org-defkey org-mode-map "\C-c\\" 'org-tags-sparse-tree) ; Minor-mode res. |
12487 | (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) | |
12488 | (org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) | |
621f83e4 CD |
12489 | (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) |
12490 | (org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) | |
a3fbe8c4 CD |
12491 | (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) |
12492 | (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) | |
12493 | (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) | |
12494 | (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) | |
12495 | (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) | |
12496 | (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) | |
20908596 | 12497 | (org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding |
a3fbe8c4 CD |
12498 | (org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved |
12499 | (org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. | |
12500 | (org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved | |
12501 | (org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range) | |
12502 | (org-defkey org-mode-map "\C-c>" 'org-goto-calendar) | |
12503 | (org-defkey org-mode-map "\C-c<" 'org-date-from-calendar) | |
12504 | (org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files) | |
12505 | (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) | |
12506 | (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) | |
12507 | (org-defkey org-mode-map "\C-c]" 'org-remove-file) | |
8c6fb58b CD |
12508 | (org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) |
12509 | (org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | |
38f8646b | 12510 | (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) |
2a57416f | 12511 | (org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star) |
a3fbe8c4 CD |
12512 | (org-defkey org-mode-map "\C-c^" 'org-sort) |
12513 | (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | |
03f3cf35 | 12514 | (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) |
a3fbe8c4 CD |
12515 | (org-defkey org-mode-map "\C-c#" 'org-update-checkbox-count) |
12516 | (org-defkey org-mode-map "\C-m" 'org-return) | |
8c6fb58b | 12517 | (org-defkey org-mode-map "\C-j" 'org-return-indent) |
a3fbe8c4 CD |
12518 | (org-defkey org-mode-map "\C-c?" 'org-table-field-info) |
12519 | (org-defkey org-mode-map "\C-c " 'org-table-blank-field) | |
12520 | (org-defkey org-mode-map "\C-c+" 'org-table-sum) | |
12521 | (org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) | |
b349f79f | 12522 | (org-defkey org-mode-map "\C-c'" 'org-edit-special) |
a3fbe8c4 CD |
12523 | (org-defkey org-mode-map "\C-c`" 'org-table-edit-field) |
12524 | (org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) | |
a3fbe8c4 CD |
12525 | (org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) |
12526 | (org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) | |
621f83e4 | 12527 | (org-defkey org-mode-map "\C-c\C-a" 'org-attach) |
a3fbe8c4 CD |
12528 | (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) |
12529 | (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) | |
12530 | (org-defkey org-mode-map "\C-c\C-e" 'org-export) | |
12531 | (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) | |
12532 | (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) | |
12533 | ||
b349f79f | 12534 | (org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action) |
a3fbe8c4 CD |
12535 | (org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) |
12536 | (org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special) | |
12537 | (org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special) | |
12538 | ||
12539 | (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) | |
12540 | (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) | |
12541 | (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) | |
15841868 | 12542 | (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) |
a3fbe8c4 CD |
12543 | (org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) |
12544 | (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) | |
12545 | (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) | |
12546 | (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) | |
12547 | (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) | |
12548 | (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) | |
03f3cf35 | 12549 | (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) |
621f83e4 | 12550 | (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) |
edd21304 | 12551 | |
ff4be292 CD |
12552 | (org-defkey org-mode-map "\C-c\C-x." 'org-timer) |
12553 | (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) | |
12554 | (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) | |
12555 | ||
38f8646b CD |
12556 | (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) |
12557 | ||
edd21304 | 12558 | (when (featurep 'xemacs) |
a3fbe8c4 | 12559 | (org-defkey org-mode-map 'button3 'popup-mode-menu)) |
4b3a9ba7 | 12560 | |
20908596 | 12561 | (defvar org-table-auto-blank-field) ; defined in org-table.el |
791d856f CD |
12562 | (defun org-self-insert-command (N) |
12563 | "Like `self-insert-command', use overwrite-mode for whitespace in tables. | |
12564 | If the cursor is in a table looking at whitespace, the whitespace is | |
12565 | overwritten, and the table is not marked as requiring realignment." | |
12566 | (interactive "p") | |
12567 | (if (and (org-table-p) | |
ab27a4a0 CD |
12568 | (progn |
12569 | ;; check if we blank the field, and if that triggers align | |
20908596 | 12570 | (and (featurep 'org-table) org-table-auto-blank-field |
ab27a4a0 CD |
12571 | (member last-command |
12572 | '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) | |
12573 | (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) | |
12574 | ;; got extra space, this field does not determine column width | |
12575 | (let (org-table-may-need-update) (org-table-blank-field)) | |
12576 | ;; no extra space, this field may determine column width | |
12577 | (org-table-blank-field))) | |
12578 | t) | |
c8d16429 | 12579 | (eq N 1) |
ab27a4a0 | 12580 | (looking-at "[^|\n]* |")) |
634a7d0b | 12581 | (let (org-table-may-need-update) |
c8d16429 CD |
12582 | (goto-char (1- (match-end 0))) |
12583 | (delete-backward-char 1) | |
12584 | (goto-char (match-beginning 0)) | |
12585 | (self-insert-command N)) | |
791d856f | 12586 | (setq org-table-may-need-update t) |
1e8fbb6d CD |
12587 | (self-insert-command N) |
12588 | (org-fix-tags-on-the-fly))) | |
12589 | ||
12590 | (defun org-fix-tags-on-the-fly () | |
12591 | (when (and (equal (char-after (point-at-bol)) ?*) | |
12592 | (org-on-heading-p)) | |
12593 | (org-align-tags-here org-tags-column))) | |
791d856f | 12594 | |
791d856f CD |
12595 | (defun org-delete-backward-char (N) |
12596 | "Like `delete-backward-char', insert whitespace at field end in tables. | |
12597 | When deleting backwards, in tables this function will insert whitespace in | |
12598 | front of the next \"|\" separator, to keep the table aligned. The table will | |
ab27a4a0 CD |
12599 | still be marked for re-alignment if the field did fill the entire column, |
12600 | because, in this case the deletion might narrow the column." | |
791d856f CD |
12601 | (interactive "p") |
12602 | (if (and (org-table-p) | |
c8d16429 CD |
12603 | (eq N 1) |
12604 | (string-match "|" (buffer-substring (point-at-bol) (point))) | |
12605 | (looking-at ".*?|")) | |
edd21304 | 12606 | (let ((pos (point)) |
ab27a4a0 CD |
12607 | (noalign (looking-at "[^|\n\r]* |")) |
12608 | (c org-table-may-need-update)) | |
c8d16429 CD |
12609 | (backward-delete-char N) |
12610 | (skip-chars-forward "^|") | |
12611 | (insert " ") | |
ab27a4a0 CD |
12612 | (goto-char (1- pos)) |
12613 | ;; noalign: if there were two spaces at the end, this field | |
12614 | ;; does not determine the width of the column. | |
12615 | (if noalign (setq org-table-may-need-update c))) | |
1e8fbb6d CD |
12616 | (backward-delete-char N) |
12617 | (org-fix-tags-on-the-fly))) | |
791d856f CD |
12618 | |
12619 | (defun org-delete-char (N) | |
12620 | "Like `delete-char', but insert whitespace at field end in tables. | |
12621 | When deleting characters, in tables this function will insert whitespace in | |
ab27a4a0 CD |
12622 | front of the next \"|\" separator, to keep the table aligned. The table will |
12623 | still be marked for re-alignment if the field did fill the entire column, | |
12624 | because, in this case the deletion might narrow the column." | |
791d856f CD |
12625 | (interactive "p") |
12626 | (if (and (org-table-p) | |
c8d16429 CD |
12627 | (not (bolp)) |
12628 | (not (= (char-after) ?|)) | |
12629 | (eq N 1)) | |
791d856f | 12630 | (if (looking-at ".*?|") |
ab27a4a0 CD |
12631 | (let ((pos (point)) |
12632 | (noalign (looking-at "[^|\n\r]* |")) | |
12633 | (c org-table-may-need-update)) | |
c8d16429 CD |
12634 | (replace-match (concat |
12635 | (substring (match-string 0) 1 -1) | |
12636 | " |")) | |
ab27a4a0 CD |
12637 | (goto-char pos) |
12638 | ;; noalign: if there were two spaces at the end, this field | |
12639 | ;; does not determine the width of the column. | |
4b3a9ba7 CD |
12640 | (if noalign (setq org-table-may-need-update c))) |
12641 | (delete-char N)) | |
1e8fbb6d CD |
12642 | (delete-char N) |
12643 | (org-fix-tags-on-the-fly))) | |
791d856f | 12644 | |
3278a016 CD |
12645 | ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode |
12646 | (put 'org-self-insert-command 'delete-selection t) | |
12647 | (put 'orgtbl-self-insert-command 'delete-selection t) | |
12648 | (put 'org-delete-char 'delete-selection 'supersede) | |
12649 | (put 'org-delete-backward-char 'delete-selection 'supersede) | |
12650 | ||
7373bc42 CD |
12651 | ;; Make `flyspell-mode' delay after some commands |
12652 | (put 'org-self-insert-command 'flyspell-delayed t) | |
12653 | (put 'orgtbl-self-insert-command 'flyspell-delayed t) | |
12654 | (put 'org-delete-char 'flyspell-delayed t) | |
12655 | (put 'org-delete-backward-char 'flyspell-delayed t) | |
12656 | ||
8c6fb58b CD |
12657 | ;; Make pabbrev-mode expand after org-mode commands |
12658 | (put 'org-self-insert-command 'pabbrev-expand-after-command t) | |
12659 | (put 'orgybl-self-insert-command 'pabbrev-expand-after-command t) | |
15841868 | 12660 | |
791d856f CD |
12661 | ;; How to do this: Measure non-white length of current string |
12662 | ;; If equal to column width, we should realign. | |
12663 | ||
28e5b051 CD |
12664 | (defun org-remap (map &rest commands) |
12665 | "In MAP, remap the functions given in COMMANDS. | |
12666 | COMMANDS is a list of alternating OLDDEF NEWDEF command names." | |
12667 | (let (new old) | |
12668 | (while commands | |
12669 | (setq old (pop commands) new (pop commands)) | |
12670 | (if (fboundp 'command-remapping) | |
a3fbe8c4 | 12671 | (org-defkey map (vector 'remap old) new) |
28e5b051 | 12672 | (substitute-key-definition old new map global-map))))) |
e0e66b8e | 12673 | |
791d856f CD |
12674 | (when (eq org-enable-table-editor 'optimized) |
12675 | ;; If the user wants maximum table support, we need to hijack | |
12676 | ;; some standard editing functions | |
28e5b051 CD |
12677 | (org-remap org-mode-map |
12678 | 'self-insert-command 'org-self-insert-command | |
12679 | 'delete-char 'org-delete-char | |
12680 | 'delete-backward-char 'org-delete-backward-char) | |
a3fbe8c4 | 12681 | (org-defkey org-mode-map "|" 'org-force-self-insert)) |
791d856f | 12682 | |
891f4676 RS |
12683 | (defun org-shiftcursor-error () |
12684 | "Throw an error because Shift-Cursor command was applied in wrong context." | |
f425a6ea | 12685 | (error "This command is active in special context like tables, headlines or timestamps")) |
891f4676 | 12686 | |
edd21304 | 12687 | (defun org-shifttab (&optional arg) |
28e5b051 | 12688 | "Global visibility cycling or move to previous table field. |
4b3a9ba7 CD |
12689 | Calls `org-cycle' with argument t, or `org-table-previous-field', depending |
12690 | on context. | |
28e5b051 | 12691 | See the individual commands for more information." |
edd21304 | 12692 | (interactive "P") |
891f4676 | 12693 | (cond |
4b3a9ba7 | 12694 | ((org-at-table-p) (call-interactively 'org-table-previous-field)) |
b349f79f CD |
12695 | ((integerp arg) |
12696 | (message "Content view to level: %d" arg) | |
12697 | (org-content (prefix-numeric-value arg)) | |
12698 | (setq org-cycle-global-status 'overview)) | |
4b3a9ba7 | 12699 | (t (call-interactively 'org-global-cycle)))) |
891f4676 | 12700 | |
634a7d0b | 12701 | (defun org-shiftmetaleft () |
28e5b051 | 12702 | "Promote subtree or delete table column. |
a3fbe8c4 CD |
12703 | Calls `org-promote-subtree', `org-outdent-item', |
12704 | or `org-table-delete-column', depending on context. | |
28e5b051 | 12705 | See the individual commands for more information." |
634a7d0b | 12706 | (interactive) |
891f4676 | 12707 | (cond |
4b3a9ba7 CD |
12708 | ((org-at-table-p) (call-interactively 'org-table-delete-column)) |
12709 | ((org-on-heading-p) (call-interactively 'org-promote-subtree)) | |
7a368970 | 12710 | ((org-at-item-p) (call-interactively 'org-outdent-item)) |
891f4676 | 12711 | (t (org-shiftcursor-error)))) |
634a7d0b CD |
12712 | |
12713 | (defun org-shiftmetaright () | |
28e5b051 | 12714 | "Demote subtree or insert table column. |
a3fbe8c4 CD |
12715 | Calls `org-demote-subtree', `org-indent-item', |
12716 | or `org-table-insert-column', depending on context. | |
28e5b051 | 12717 | See the individual commands for more information." |
634a7d0b | 12718 | (interactive) |
891f4676 | 12719 | (cond |
4b3a9ba7 CD |
12720 | ((org-at-table-p) (call-interactively 'org-table-insert-column)) |
12721 | ((org-on-heading-p) (call-interactively 'org-demote-subtree)) | |
7a368970 | 12722 | ((org-at-item-p) (call-interactively 'org-indent-item)) |
891f4676 | 12723 | (t (org-shiftcursor-error)))) |
634a7d0b | 12724 | |
891f4676 | 12725 | (defun org-shiftmetaup (&optional arg) |
28e5b051 | 12726 | "Move subtree up or kill table row. |
7a368970 CD |
12727 | Calls `org-move-subtree-up' or `org-table-kill-row' or |
12728 | `org-move-item-up' depending on context. See the individual commands | |
12729 | for more information." | |
891f4676 RS |
12730 | (interactive "P") |
12731 | (cond | |
4b3a9ba7 CD |
12732 | ((org-at-table-p) (call-interactively 'org-table-kill-row)) |
12733 | ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) | |
12734 | ((org-at-item-p) (call-interactively 'org-move-item-up)) | |
891f4676 RS |
12735 | (t (org-shiftcursor-error)))) |
12736 | (defun org-shiftmetadown (&optional arg) | |
28e5b051 | 12737 | "Move subtree down or insert table row. |
7a368970 CD |
12738 | Calls `org-move-subtree-down' or `org-table-insert-row' or |
12739 | `org-move-item-down', depending on context. See the individual | |
12740 | commands for more information." | |
891f4676 RS |
12741 | (interactive "P") |
12742 | (cond | |
4b3a9ba7 CD |
12743 | ((org-at-table-p) (call-interactively 'org-table-insert-row)) |
12744 | ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) | |
12745 | ((org-at-item-p) (call-interactively 'org-move-item-down)) | |
891f4676 RS |
12746 | (t (org-shiftcursor-error)))) |
12747 | ||
12748 | (defun org-metaleft (&optional arg) | |
28e5b051 CD |
12749 | "Promote heading or move table column to left. |
12750 | Calls `org-do-promote' or `org-table-move-column', depending on context. | |
7a368970 | 12751 | With no specific context, calls the Emacs default `backward-word'. |
28e5b051 | 12752 | See the individual commands for more information." |
891f4676 RS |
12753 | (interactive "P") |
12754 | (cond | |
4b3a9ba7 CD |
12755 | ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) |
12756 | ((or (org-on-heading-p) (org-region-active-p)) | |
12757 | (call-interactively 'org-do-promote)) | |
761311e3 | 12758 | ((org-at-item-p) (call-interactively 'org-outdent-item)) |
4b3a9ba7 | 12759 | (t (call-interactively 'backward-word)))) |
634a7d0b | 12760 | |
891f4676 | 12761 | (defun org-metaright (&optional arg) |
28e5b051 CD |
12762 | "Demote subtree or move table column to right. |
12763 | Calls `org-do-demote' or `org-table-move-column', depending on context. | |
7a368970 | 12764 | With no specific context, calls the Emacs default `forward-word'. |
28e5b051 | 12765 | See the individual commands for more information." |
891f4676 RS |
12766 | (interactive "P") |
12767 | (cond | |
4b3a9ba7 CD |
12768 | ((org-at-table-p) (call-interactively 'org-table-move-column)) |
12769 | ((or (org-on-heading-p) (org-region-active-p)) | |
12770 | (call-interactively 'org-do-demote)) | |
761311e3 | 12771 | ((org-at-item-p) (call-interactively 'org-indent-item)) |
4b3a9ba7 | 12772 | (t (call-interactively 'forward-word)))) |
634a7d0b | 12773 | |
891f4676 | 12774 | (defun org-metaup (&optional arg) |
28e5b051 | 12775 | "Move subtree up or move table row up. |
7a368970 CD |
12776 | Calls `org-move-subtree-up' or `org-table-move-row' or |
12777 | `org-move-item-up', depending on context. See the individual commands | |
12778 | for more information." | |
891f4676 RS |
12779 | (interactive "P") |
12780 | (cond | |
4b3a9ba7 CD |
12781 | ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) |
12782 | ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) | |
12783 | ((org-at-item-p) (call-interactively 'org-move-item-up)) | |
03f3cf35 | 12784 | (t (transpose-lines 1) (beginning-of-line -1)))) |
634a7d0b | 12785 | |
891f4676 | 12786 | (defun org-metadown (&optional arg) |
28e5b051 | 12787 | "Move subtree down or move table row down. |
7a368970 CD |
12788 | Calls `org-move-subtree-down' or `org-table-move-row' or |
12789 | `org-move-item-down', depending on context. See the individual | |
12790 | commands for more information." | |
891f4676 RS |
12791 | (interactive "P") |
12792 | (cond | |
4b3a9ba7 CD |
12793 | ((org-at-table-p) (call-interactively 'org-table-move-row)) |
12794 | ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) | |
12795 | ((org-at-item-p) (call-interactively 'org-move-item-down)) | |
03f3cf35 | 12796 | (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) |
891f4676 RS |
12797 | |
12798 | (defun org-shiftup (&optional arg) | |
4b3a9ba7 | 12799 | "Increase item in timestamp or increase priority of current headline. |
a3fbe8c4 CD |
12800 | Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', |
12801 | depending on context. See the individual commands for more information." | |
891f4676 RS |
12802 | (interactive "P") |
12803 | (cond | |
0b8568f5 JW |
12804 | ((org-at-timestamp-p t) |
12805 | (call-interactively (if org-edit-timestamp-down-means-later | |
12806 | 'org-timestamp-down 'org-timestamp-up))) | |
4b3a9ba7 CD |
12807 | ((org-on-heading-p) (call-interactively 'org-priority-up)) |
12808 | ((org-at-item-p) (call-interactively 'org-previous-item)) | |
20908596 | 12809 | ((org-clocktable-try-shift 'up arg)) |
4b3a9ba7 | 12810 | (t (call-interactively 'org-beginning-of-item) (beginning-of-line 1)))) |
891f4676 RS |
12811 | |
12812 | (defun org-shiftdown (&optional arg) | |
4b3a9ba7 | 12813 | "Decrease item in timestamp or decrease priority of current headline. |
a3fbe8c4 CD |
12814 | Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' |
12815 | depending on context. See the individual commands for more information." | |
891f4676 RS |
12816 | (interactive "P") |
12817 | (cond | |
0b8568f5 JW |
12818 | ((org-at-timestamp-p t) |
12819 | (call-interactively (if org-edit-timestamp-down-means-later | |
12820 | 'org-timestamp-up 'org-timestamp-down))) | |
4b3a9ba7 | 12821 | ((org-on-heading-p) (call-interactively 'org-priority-down)) |
20908596 | 12822 | ((org-clocktable-try-shift 'down arg)) |
4b3a9ba7 | 12823 | (t (call-interactively 'org-next-item)))) |
891f4676 | 12824 | |
20908596 | 12825 | (defun org-shiftright (&optional arg) |
ce4fdcb9 CD |
12826 | "Cycle the thing at point or in the current line, depending on context. |
12827 | Depending on context, this does one of the following: | |
12828 | ||
12829 | - switch a timestamp at point one day into the future | |
12830 | - on a headline, switch to the next TODO keyword. | |
12831 | - on an item, switch entire list to the next bullet type | |
12832 | - on a property line, switch to the next allowed value | |
12833 | - on a clocktable definition line, move time block into the future" | |
20908596 | 12834 | (interactive "P") |
f425a6ea | 12835 | (cond |
8df0de1c | 12836 | ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) |
4b3a9ba7 | 12837 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'right)) |
03f3cf35 | 12838 | ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet nil)) |
7d58338e | 12839 | ((org-at-property-p) (call-interactively 'org-property-next-allowed-value)) |
20908596 | 12840 | ((org-clocktable-try-shift 'right arg)) |
f425a6ea CD |
12841 | (t (org-shiftcursor-error)))) |
12842 | ||
20908596 | 12843 | (defun org-shiftleft (&optional arg) |
ce4fdcb9 CD |
12844 | "Cycle the thing at point or in the current line, depending on context. |
12845 | Depending on context, this does one of the following: | |
12846 | ||
12847 | - switch a timestamp at point one day into the past | |
12848 | - on a headline, switch to the previous TODO keyword. | |
12849 | - on an item, switch entire list to the previous bullet type | |
12850 | - on a property line, switch to the previous allowed value | |
12851 | - on a clocktable definition line, move time block into the past" | |
20908596 | 12852 | (interactive "P") |
f425a6ea | 12853 | (cond |
8df0de1c | 12854 | ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) |
4b3a9ba7 | 12855 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'left)) |
03f3cf35 | 12856 | ((org-at-item-p) (org-call-with-arg 'org-cycle-list-bullet 'previous)) |
7d58338e CD |
12857 | ((org-at-property-p) |
12858 | (call-interactively 'org-property-previous-allowed-value)) | |
20908596 | 12859 | ((org-clocktable-try-shift 'left arg)) |
f425a6ea CD |
12860 | (t (org-shiftcursor-error)))) |
12861 | ||
a3fbe8c4 CD |
12862 | (defun org-shiftcontrolright () |
12863 | "Switch to next TODO set." | |
12864 | (interactive) | |
12865 | (cond | |
12866 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'nextset)) | |
12867 | (t (org-shiftcursor-error)))) | |
12868 | ||
12869 | (defun org-shiftcontrolleft () | |
12870 | "Switch to previous TODO set." | |
12871 | (interactive) | |
12872 | (cond | |
12873 | ((org-on-heading-p) (org-call-with-arg 'org-todo 'previousset)) | |
12874 | (t (org-shiftcursor-error)))) | |
12875 | ||
12876 | (defun org-ctrl-c-ret () | |
12877 | "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." | |
12878 | (interactive) | |
12879 | (cond | |
12880 | ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) | |
12881 | (t (call-interactively 'org-insert-heading)))) | |
12882 | ||
634a7d0b | 12883 | (defun org-copy-special () |
28e5b051 CD |
12884 | "Copy region in table or copy current subtree. |
12885 | Calls `org-table-copy' or `org-copy-subtree', depending on context. | |
12886 | See the individual commands for more information." | |
634a7d0b | 12887 | (interactive) |
64f72ae1 | 12888 | (call-interactively |
9acdaa21 | 12889 | (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) |
891f4676 | 12890 | |
634a7d0b | 12891 | (defun org-cut-special () |
28e5b051 CD |
12892 | "Cut region in table or cut current subtree. |
12893 | Calls `org-table-copy' or `org-cut-subtree', depending on context. | |
12894 | See the individual commands for more information." | |
634a7d0b | 12895 | (interactive) |
9acdaa21 CD |
12896 | (call-interactively |
12897 | (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) | |
891f4676 RS |
12898 | |
12899 | (defun org-paste-special (arg) | |
28e5b051 CD |
12900 | "Paste rectangular region into table, or past subtree relative to level. |
12901 | Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. | |
12902 | See the individual commands for more information." | |
891f4676 RS |
12903 | (interactive "P") |
12904 | (if (org-at-table-p) | |
634a7d0b | 12905 | (org-table-paste-rectangle) |
891f4676 RS |
12906 | (org-paste-subtree arg))) |
12907 | ||
b349f79f CD |
12908 | (defun org-edit-special () |
12909 | "Call a special editor for the stuff at point. | |
12910 | When at a table, call the formula editor with `org-table-edit-formulas'. | |
12911 | When at the first line of an src example, call `org-edit-src-code'. | |
12912 | When in an #+include line, visit the include file. Otherwise call | |
12913 | `ffap' to visit the file at point." | |
12914 | (interactive) | |
12915 | (cond | |
12916 | ((org-at-table-p) | |
12917 | (call-interactively 'org-table-edit-formulas)) | |
12918 | ((save-excursion | |
12919 | (beginning-of-line 1) | |
12920 | (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)")) | |
12921 | (find-file (org-trim (match-string 1)))) | |
12922 | ((org-edit-src-code)) | |
621f83e4 | 12923 | ((org-edit-fixed-width-region)) |
b349f79f CD |
12924 | (t (call-interactively 'ffap)))) |
12925 | ||
891f4676 | 12926 | (defun org-ctrl-c-ctrl-c (&optional arg) |
a4b39e39 CD |
12927 | "Set tags in headline, or update according to changed information at point. |
12928 | ||
12929 | This command does many different things, depending on context: | |
12930 | ||
12931 | - If the cursor is in a headline, prompt for tags and insert them | |
12932 | into the current line, aligned to `org-tags-column'. When called | |
12933 | with prefix arg, realign all tags in the current buffer. | |
12934 | ||
12935 | - If the cursor is in one of the special #+KEYWORD lines, this | |
12936 | triggers scanning the buffer for these lines and updating the | |
edd21304 | 12937 | information. |
a4b39e39 CD |
12938 | |
12939 | - If the cursor is inside a table, realign the table. This command | |
12940 | works even if the automatic table editor has been turned off. | |
12941 | ||
12942 | - If the cursor is on a #+TBLFM line, re-apply the formulas to | |
12943 | the entire table. | |
12944 | ||
15841868 JW |
12945 | - If the cursor is a the beginning of a dynamic block, update it. |
12946 | ||
a4b39e39 | 12947 | - If the cursor is inside a table created by the table.el package, |
2a94e282 | 12948 | activate that table. |
a4b39e39 | 12949 | |
93b62de8 CD |
12950 | - If the current buffer is a remember buffer, close note and file |
12951 | it. A prefix argument of 1 files to the default location | |
12952 | without further interaction. A prefix argument of 2 files to | |
12953 | the currently clocking task. | |
a4b39e39 CD |
12954 | |
12955 | - If the cursor is on a <<<target>>>, update radio targets and corresponding | |
12956 | links in this buffer. | |
12957 | ||
12958 | - If the cursor is on a numbered item in a plain list, renumber the | |
8c6fb58b CD |
12959 | ordered list. |
12960 | ||
12961 | - If the cursor is on a checkbox, toggle it." | |
891f4676 RS |
12962 | (interactive "P") |
12963 | (let ((org-enable-table-editor t)) | |
12964 | (cond | |
20908596 | 12965 | ((or (and (boundp 'org-clock-overlays) org-clock-overlays) |
3278a016 | 12966 | org-occur-highlights |
6769c0dc | 12967 | org-latex-fragment-image-overlays) |
20908596 | 12968 | (and (boundp 'org-clock-overlays) (org-remove-clock-overlays)) |
edd21304 | 12969 | (org-remove-occur-highlights) |
6769c0dc CD |
12970 | (org-remove-latex-fragment-image-overlays) |
12971 | (message "Temporary highlights/overlays removed from current buffer")) | |
ab27a4a0 CD |
12972 | ((and (local-variable-p 'org-finish-function (current-buffer)) |
12973 | (fboundp org-finish-function)) | |
12974 | (funcall org-finish-function)) | |
7d58338e CD |
12975 | ((org-at-property-p) |
12976 | (call-interactively 'org-property-action)) | |
4b3a9ba7 CD |
12977 | ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) |
12978 | ((org-on-heading-p) (call-interactively 'org-set-tags)) | |
891f4676 RS |
12979 | ((org-at-table.el-p) |
12980 | (require 'table) | |
12981 | (beginning-of-line 1) | |
9acdaa21 | 12982 | (re-search-forward "|" (save-excursion (end-of-line 2) (point))) |
4b3a9ba7 | 12983 | (call-interactively 'table-recognize-table)) |
891f4676 | 12984 | ((org-at-table-p) |
9acdaa21 CD |
12985 | (org-table-maybe-eval-formula) |
12986 | (if arg | |
4b3a9ba7 | 12987 | (call-interactively 'org-table-recalculate) |
c8d16429 | 12988 | (org-table-maybe-recalculate-line)) |
4b3a9ba7 CD |
12989 | (call-interactively 'org-table-align)) |
12990 | ((org-at-item-checkbox-p) | |
12991 | (call-interactively 'org-toggle-checkbox)) | |
7a368970 | 12992 | ((org-at-item-p) |
b38c6895 | 12993 | (call-interactively 'org-maybe-renumber-ordered-list)) |
15841868 JW |
12994 | ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:")) |
12995 | ;; Dynamic block | |
12996 | (beginning-of-line 1) | |
621f83e4 | 12997 | (save-excursion (org-update-dblock))) |
9acdaa21 CD |
12998 | ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) |
12999 | (cond | |
13000 | ((equal (match-string 1) "TBLFM") | |
c8d16429 CD |
13001 | ;; Recalculate the table before this line |
13002 | (save-excursion | |
13003 | (beginning-of-line 1) | |
13004 | (skip-chars-backward " \r\n\t") | |
4b3a9ba7 CD |
13005 | (if (org-at-table-p) |
13006 | (org-call-with-arg 'org-table-recalculate t)))) | |
9acdaa21 | 13007 | (t |
b349f79f CD |
13008 | ; (org-set-regexps-and-options) |
13009 | ; (org-restart-font-lock) | |
13010 | (let ((org-inhibit-startup t)) (org-mode-restart)) | |
13011 | (message "Local setup has been refreshed")))) | |
7a368970 | 13012 | (t (error "C-c C-c can do nothing useful at this location."))))) |
891f4676 | 13013 | |
28e5b051 CD |
13014 | (defun org-mode-restart () |
13015 | "Restart Org-mode, to scan again for special lines. | |
13016 | Also updates the keyword regular expressions." | |
13017 | (interactive) | |
b349f79f CD |
13018 | (org-mode) |
13019 | (message "Org-mode restarted")) | |
28e5b051 | 13020 | |
03f3cf35 | 13021 | (defun org-kill-note-or-show-branches () |
a0d892d4 | 13022 | "If this is a Note buffer, abort storing the note. Else call `show-branches'." |
03f3cf35 JW |
13023 | (interactive) |
13024 | (if (not org-finish-function) | |
13025 | (call-interactively 'show-branches) | |
13026 | (let ((org-note-abort t)) | |
13027 | (funcall org-finish-function)))) | |
13028 | ||
8c6fb58b | 13029 | (defun org-return (&optional indent) |
28e5b051 CD |
13030 | "Goto next table row or insert a newline. |
13031 | Calls `org-table-next-row' or `newline', depending on context. | |
13032 | See the individual commands for more information." | |
634a7d0b | 13033 | (interactive) |
891f4676 | 13034 | (cond |
8c6fb58b | 13035 | ((bobp) (if indent (newline-and-indent) (newline))) |
2a57416f CD |
13036 | ((and (org-at-heading-p) |
13037 | (looking-at | |
13038 | (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$"))) | |
13039 | (org-show-entry) | |
13040 | (end-of-line 1) | |
13041 | (newline)) | |
791d856f CD |
13042 | ((org-at-table-p) |
13043 | (org-table-justify-field-maybe) | |
4b3a9ba7 | 13044 | (call-interactively 'org-table-next-row)) |
8c6fb58b | 13045 | (t (if indent (newline-and-indent) (newline))))) |
891f4676 | 13046 | |
8c6fb58b | 13047 | (defun org-return-indent () |
8c6fb58b CD |
13048 | "Goto next table row or insert a newline and indent. |
13049 | Calls `org-table-next-row' or `newline-and-indent', depending on | |
13050 | context. See the individual commands for more information." | |
2a57416f | 13051 | (interactive) |
8c6fb58b | 13052 | (org-return t)) |
03f3cf35 | 13053 | |
2a57416f CD |
13054 | (defun org-ctrl-c-star () |
13055 | "Compute table, or change heading status of lines. | |
b349f79f | 13056 | Calls `org-table-recalculate' or `org-toggle-region-headings', |
2a57416f CD |
13057 | depending on context. This will also turn a plain list item or a normal |
13058 | line into a subheading." | |
13059 | (interactive) | |
13060 | (cond | |
13061 | ((org-at-table-p) | |
13062 | (call-interactively 'org-table-recalculate)) | |
13063 | ((org-region-active-p) | |
13064 | ;; Convert all lines in region to list items | |
13065 | (call-interactively 'org-toggle-region-headings)) | |
13066 | ((org-on-heading-p) | |
13067 | (org-toggle-region-headings (point-at-bol) | |
13068 | (min (1+ (point-at-eol)) (point-max)))) | |
13069 | ((org-at-item-p) | |
13070 | ;; Convert to heading | |
13071 | (let ((level (save-match-data | |
13072 | (save-excursion | |
13073 | (condition-case nil | |
13074 | (progn | |
13075 | (org-back-to-heading t) | |
13076 | (funcall outline-level)) | |
13077 | (error 0)))))) | |
13078 | (replace-match | |
13079 | (concat (make-string (org-get-valid-level level 1) ?*) " ") t t))) | |
13080 | (t (org-toggle-region-headings (point-at-bol) | |
13081 | (min (1+ (point-at-eol)) (point-max)))))) | |
13082 | ||
38f8646b | 13083 | (defun org-ctrl-c-minus () |
2a57416f CD |
13084 | "Insert separator line in table or modify bullet status of line. |
13085 | Also turns a plain line or a region of lines into list items. | |
13086 | Calls `org-table-insert-hline', `org-toggle-region-items', or | |
13087 | `org-cycle-list-bullet', depending on context." | |
38f8646b CD |
13088 | (interactive) |
13089 | (cond | |
13090 | ((org-at-table-p) | |
13091 | (call-interactively 'org-table-insert-hline)) | |
03f3cf35 JW |
13092 | ((org-on-heading-p) |
13093 | ;; Convert to item | |
13094 | (save-excursion | |
13095 | (beginning-of-line 1) | |
13096 | (if (looking-at "\\*+ ") | |
2a57416f CD |
13097 | (replace-match (concat (make-string (- (match-end 0) (point) 1) ?\ ) "- "))))) |
13098 | ((org-region-active-p) | |
13099 | ;; Convert all lines in region to list items | |
13100 | (call-interactively 'org-toggle-region-items)) | |
38f8646b CD |
13101 | ((org-in-item-p) |
13102 | (call-interactively 'org-cycle-list-bullet)) | |
2a57416f CD |
13103 | (t (org-toggle-region-items (point-at-bol) |
13104 | (min (1+ (point-at-eol)) (point-max)))))) | |
38f8646b | 13105 | |
2a57416f CD |
13106 | (defun org-toggle-region-items (beg end) |
13107 | "Convert all lines in region to list items. | |
13108 | If the first line is already an item, convert all list items in the region | |
13109 | to normal lines." | |
13110 | (interactive "r") | |
13111 | (let (l2 l) | |
13112 | (save-excursion | |
13113 | (goto-char end) | |
13114 | (setq l2 (org-current-line)) | |
13115 | (goto-char beg) | |
13116 | (beginning-of-line 1) | |
13117 | (setq l (1- (org-current-line))) | |
13118 | (if (org-at-item-p) | |
13119 | ;; We already have items, de-itemize | |
13120 | (while (< (setq l (1+ l)) l2) | |
13121 | (when (org-at-item-p) | |
13122 | (goto-char (match-beginning 2)) | |
13123 | (delete-region (match-beginning 2) (match-end 2)) | |
13124 | (and (looking-at "[ \t]+") (replace-match ""))) | |
13125 | (beginning-of-line 2)) | |
13126 | (while (< (setq l (1+ l)) l2) | |
13127 | (unless (org-at-item-p) | |
13128 | (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") | |
13129 | (replace-match "\\1- \\2"))) | |
13130 | (beginning-of-line 2)))))) | |
5bf7807a | 13131 | |
2a57416f CD |
13132 | (defun org-toggle-region-headings (beg end) |
13133 | "Convert all lines in region to list items. | |
13134 | If the first line is already an item, convert all list items in the region | |
13135 | to normal lines." | |
13136 | (interactive "r") | |
13137 | (let (l2 l) | |
13138 | (save-excursion | |
13139 | (goto-char end) | |
13140 | (setq l2 (org-current-line)) | |
13141 | (goto-char beg) | |
13142 | (beginning-of-line 1) | |
13143 | (setq l (1- (org-current-line))) | |
13144 | (if (org-on-heading-p) | |
13145 | ;; We already have headlines, de-star them | |
13146 | (while (< (setq l (1+ l)) l2) | |
13147 | (when (org-on-heading-p t) | |
13148 | (and (looking-at outline-regexp) (replace-match ""))) | |
13149 | (beginning-of-line 2)) | |
13150 | (let* ((stars (save-excursion | |
13151 | (re-search-backward org-complex-heading-regexp nil t) | |
13152 | (or (match-string 1) "*"))) | |
13153 | (add-stars (if org-odd-levels-only "**" "*")) | |
13154 | (rpl (concat stars add-stars " \\2"))) | |
13155 | (while (< (setq l (1+ l)) l2) | |
13156 | (unless (org-on-heading-p) | |
13157 | (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") | |
13158 | (replace-match rpl))) | |
13159 | (beginning-of-line 2))))))) | |
5bf7807a | 13160 | |
791d856f | 13161 | (defun org-meta-return (&optional arg) |
28e5b051 CD |
13162 | "Insert a new heading or wrap a region in a table. |
13163 | Calls `org-insert-heading' or `org-table-wrap-region', depending on context. | |
13164 | See the individual commands for more information." | |
791d856f CD |
13165 | (interactive "P") |
13166 | (cond | |
13167 | ((org-at-table-p) | |
4b3a9ba7 CD |
13168 | (call-interactively 'org-table-wrap-region)) |
13169 | (t (call-interactively 'org-insert-heading)))) | |
891f4676 RS |
13170 | |
13171 | ;;; Menu entries | |
13172 | ||
891f4676 | 13173 | ;; Define the Org-mode menus |
9acdaa21 CD |
13174 | (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" |
13175 | '("Tbl" | |
20908596 | 13176 | ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] |
9acdaa21 CD |
13177 | ["Next Field" org-cycle (org-at-table-p)] |
13178 | ["Previous Field" org-shifttab (org-at-table-p)] | |
13179 | ["Next Row" org-return (org-at-table-p)] | |
13180 | "--" | |
13181 | ["Blank Field" org-table-blank-field (org-at-table-p)] | |
ab27a4a0 | 13182 | ["Edit Field" org-table-edit-field (org-at-table-p)] |
9acdaa21 CD |
13183 | ["Copy Field from Above" org-table-copy-down (org-at-table-p)] |
13184 | "--" | |
13185 | ("Column" | |
13186 | ["Move Column Left" org-metaleft (org-at-table-p)] | |
13187 | ["Move Column Right" org-metaright (org-at-table-p)] | |
13188 | ["Delete Column" org-shiftmetaleft (org-at-table-p)] | |
d3f4dbe8 | 13189 | ["Insert Column" org-shiftmetaright (org-at-table-p)]) |
9acdaa21 CD |
13190 | ("Row" |
13191 | ["Move Row Up" org-metaup (org-at-table-p)] | |
13192 | ["Move Row Down" org-metadown (org-at-table-p)] | |
13193 | ["Delete Row" org-shiftmetaup (org-at-table-p)] | |
13194 | ["Insert Row" org-shiftmetadown (org-at-table-p)] | |
e0e66b8e | 13195 | ["Sort lines in region" org-table-sort-lines (org-at-table-p)] |
9acdaa21 | 13196 | "--" |
38f8646b | 13197 | ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) |
9acdaa21 CD |
13198 | ("Rectangle" |
13199 | ["Copy Rectangle" org-copy-special (org-at-table-p)] | |
13200 | ["Cut Rectangle" org-cut-special (org-at-table-p)] | |
13201 | ["Paste Rectangle" org-paste-special (org-at-table-p)] | |
13202 | ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) | |
13203 | "--" | |
13204 | ("Calculate" | |
c4f9780e | 13205 | ["Set Column Formula" org-table-eval-formula (org-at-table-p)] |
d3f4dbe8 | 13206 | ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] |
b349f79f | 13207 | ["Edit Formulas" org-edit-special (org-at-table-p)] |
c4f9780e | 13208 | "--" |
9acdaa21 CD |
13209 | ["Recalculate line" org-table-recalculate (org-at-table-p)] |
13210 | ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] | |
d3f4dbe8 CD |
13211 | ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] |
13212 | "--" | |
9acdaa21 | 13213 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] |
c4f9780e | 13214 | "--" |
64f72ae1 | 13215 | ["Sum Column/Rectangle" org-table-sum |
9acdaa21 CD |
13216 | (or (org-at-table-p) (org-region-active-p))] |
13217 | ["Which Column?" org-table-current-column (org-at-table-p)]) | |
13218 | ["Debug Formulas" | |
d3f4dbe8 | 13219 | org-table-toggle-formula-debugger |
20908596 | 13220 | :style toggle :selected (org-bound-and-true-p org-table-formula-debug)] |
d3f4dbe8 CD |
13221 | ["Show Col/Row Numbers" |
13222 | org-table-toggle-coordinate-overlays | |
20908596 CD |
13223 | :style toggle |
13224 | :selected (org-bound-and-true-p org-table-overlay-coordinates)] | |
9acdaa21 | 13225 | "--" |
9acdaa21 | 13226 | ["Create" org-table-create (and (not (org-at-table-p)) |
c8d16429 | 13227 | org-enable-table-editor)] |
ab27a4a0 | 13228 | ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] |
9acdaa21 CD |
13229 | ["Import from File" org-table-import (not (org-at-table-p))] |
13230 | ["Export to File" org-table-export (org-at-table-p)] | |
13231 | "--" | |
13232 | ["Create/Convert from/to table.el" org-table-create-with-table.el t])) | |
13233 | ||
891f4676 RS |
13234 | (easy-menu-define org-org-menu org-mode-map "Org menu" |
13235 | '("Org" | |
3278a016 | 13236 | ("Show/Hide" |
20908596 CD |
13237 | ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] |
13238 | ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] | |
13239 | ["Sparse Tree..." org-sparse-tree t] | |
3278a016 | 13240 | ["Reveal Context" org-reveal t] |
d3f4dbe8 CD |
13241 | ["Show All" show-all t] |
13242 | "--" | |
13243 | ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) | |
891f4676 RS |
13244 | "--" |
13245 | ["New Heading" org-insert-heading t] | |
13246 | ("Navigate Headings" | |
13247 | ["Up" outline-up-heading t] | |
13248 | ["Next" outline-next-visible-heading t] | |
13249 | ["Previous" outline-previous-visible-heading t] | |
13250 | ["Next Same Level" outline-forward-same-level t] | |
13251 | ["Previous Same Level" outline-backward-same-level t] | |
13252 | "--" | |
374585c9 | 13253 | ["Jump" org-goto t]) |
891f4676 | 13254 | ("Edit Structure" |
35fb9989 CD |
13255 | ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] |
13256 | ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] | |
891f4676 RS |
13257 | "--" |
13258 | ["Copy Subtree" org-copy-special (not (org-at-table-p))] | |
13259 | ["Cut Subtree" org-cut-special (not (org-at-table-p))] | |
13260 | ["Paste Subtree" org-paste-special (not (org-at-table-p))] | |
13261 | "--" | |
13262 | ["Promote Heading" org-metaleft (not (org-at-table-p))] | |
13263 | ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] | |
13264 | ["Demote Heading" org-metaright (not (org-at-table-p))] | |
30313b90 CD |
13265 | ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] |
13266 | "--" | |
d3f4dbe8 CD |
13267 | ["Sort Region/Children" org-sort (not (org-at-table-p))] |
13268 | "--" | |
4ed31842 CD |
13269 | ["Convert to odd levels" org-convert-to-odd-levels t] |
13270 | ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) | |
a3fbe8c4 | 13271 | ("Editing" |
b349f79f CD |
13272 | ["Emphasis..." org-emphasize t] |
13273 | ["Edit Source Example" org-edit-special t]) | |
6769c0dc CD |
13274 | ("Archive" |
13275 | ["Toggle ARCHIVE tag" org-toggle-archive-tag t] | |
d3f4dbe8 CD |
13276 | ; ["Check and Tag Children" (org-toggle-archive-tag (4)) |
13277 | ; :active t :keys "C-u C-c C-x C-a"] | |
6769c0dc CD |
13278 | ["Sparse trees open ARCHIVE trees" |
13279 | (setq org-sparse-tree-open-archived-trees | |
13280 | (not org-sparse-tree-open-archived-trees)) | |
13281 | :style toggle :selected org-sparse-tree-open-archived-trees] | |
13282 | ["Cycling opens ARCHIVE trees" | |
13283 | (setq org-cycle-open-archived-trees (not org-cycle-open-archived-trees)) | |
13284 | :style toggle :selected org-cycle-open-archived-trees] | |
6769c0dc | 13285 | "--" |
621f83e4 | 13286 | ["Move subtree to archive sibling" org-archive-to-archive-sibling t] |
d3f4dbe8 CD |
13287 | ["Move Subtree to Archive" org-advertized-archive-subtree t] |
13288 | ; ["Check and Move Children" (org-archive-subtree '(4)) | |
13289 | ; :active t :keys "C-u C-c C-x C-s"] | |
13290 | ) | |
891f4676 | 13291 | "--" |
35fb9989 | 13292 | ("TODO Lists" |
891f4676 | 13293 | ["TODO/DONE/-" org-todo t] |
5137195a CD |
13294 | ("Select keyword" |
13295 | ["Next keyword" org-shiftright (org-on-heading-p)] | |
13296 | ["Previous keyword" org-shiftleft (org-on-heading-p)] | |
a3fbe8c4 CD |
13297 | ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] |
13298 | ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] | |
13299 | ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) | |
891f4676 | 13300 | ["Show TODO Tree" org-show-todo-tree t] |
f425a6ea | 13301 | ["Global TODO list" org-todo-list t] |
891f4676 | 13302 | "--" |
35fb9989 CD |
13303 | ["Set Priority" org-priority t] |
13304 | ["Priority Up" org-shiftup t] | |
7d58338e | 13305 | ["Priority Down" org-shiftdown t]) |
38f8646b | 13306 | ("TAGS and Properties" |
71d35b24 | 13307 | ["Set Tags" 'org-set-tags-command t] |
15841868 | 13308 | ["Change tag in region" 'org-change-tag-in-region (org-region-active-p)] |
03f3cf35 JW |
13309 | "--" |
13310 | ["Set property" 'org-set-property t] | |
13311 | ["Column view of properties" org-columns t] | |
13312 | ["Insert Column View DBlock" org-insert-columns-dblock t]) | |
891f4676 RS |
13313 | ("Dates and Scheduling" |
13314 | ["Timestamp" org-time-stamp t] | |
28e5b051 | 13315 | ["Timestamp (inactive)" org-time-stamp-inactive t] |
891f4676 | 13316 | ("Change Date" |
3278a016 CD |
13317 | ["1 Day Later" org-shiftright t] |
13318 | ["1 Day Earlier" org-shiftleft t] | |
35fb9989 CD |
13319 | ["1 ... Later" org-shiftup t] |
13320 | ["1 ... Earlier" org-shiftdown t]) | |
891f4676 RS |
13321 | ["Compute Time Range" org-evaluate-time-range t] |
13322 | ["Schedule Item" org-schedule t] | |
13323 | ["Deadline" org-deadline t] | |
13324 | "--" | |
3278a016 CD |
13325 | ["Custom time format" org-toggle-time-stamp-overlays |
13326 | :style radio :selected org-display-custom-times] | |
13327 | "--" | |
891f4676 | 13328 | ["Goto Calendar" org-goto-calendar t] |
ff4be292 CD |
13329 | ["Date from Calendar" org-date-from-calendar t] |
13330 | "--" | |
13331 | ["Start/restart timer" org-timer-start t] | |
13332 | ["Insert timer string" org-timer t] | |
13333 | ["Insert timer item" org-timer-item t]) | |
edd21304 CD |
13334 | ("Logging work" |
13335 | ["Clock in" org-clock-in t] | |
13336 | ["Clock out" org-clock-out t] | |
13337 | ["Clock cancel" org-clock-cancel t] | |
15841868 | 13338 | ["Goto running clock" org-clock-goto t] |
edd21304 | 13339 | ["Display times" org-clock-display t] |
0fee8d6e | 13340 | ["Create clock table" org-clock-report t] |
edd21304 CD |
13341 | "--" |
13342 | ["Record DONE time" | |
13343 | (progn (setq org-log-done (not org-log-done)) | |
13344 | (message "Switching to %s will %s record a timestamp" | |
a3fbe8c4 | 13345 | (car org-done-keywords) |
edd21304 CD |
13346 | (if org-log-done "automatically" "not"))) |
13347 | :style toggle :selected org-log-done]) | |
891f4676 | 13348 | "--" |
3278a016 | 13349 | ["Agenda Command..." org-agenda t] |
8c6fb58b | 13350 | ["Set Restriction Lock" org-agenda-set-restriction-lock t] |
d924f2e5 CD |
13351 | ("File List for Agenda") |
13352 | ("Special views current file" | |
4da1a99d CD |
13353 | ["TODO Tree" org-show-todo-tree t] |
13354 | ["Check Deadlines" org-check-deadlines t] | |
13355 | ["Timeline" org-timeline t] | |
d924f2e5 | 13356 | ["Tags Tree" org-tags-sparse-tree t]) |
891f4676 RS |
13357 | "--" |
13358 | ("Hyperlinks" | |
35fb9989 | 13359 | ["Store Link (Global)" org-store-link t] |
891f4676 | 13360 | ["Insert Link" org-insert-link t] |
ab27a4a0 CD |
13361 | ["Follow Link" org-open-at-point t] |
13362 | "--" | |
d3f4dbe8 CD |
13363 | ["Next link" org-next-link t] |
13364 | ["Previous link" org-previous-link t] | |
13365 | "--" | |
ab27a4a0 CD |
13366 | ["Descriptive Links" |
13367 | (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) | |
20908596 CD |
13368 | :style radio |
13369 | :selected (member '(org-link) buffer-invisibility-spec)] | |
ab27a4a0 CD |
13370 | ["Literal Links" |
13371 | (progn | |
13372 | (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) | |
20908596 CD |
13373 | :style radio |
13374 | :selected (not (member '(org-link) buffer-invisibility-spec))]) | |
891f4676 | 13375 | "--" |
3278a016 | 13376 | ["Export/Publish..." org-export t] |
6769c0dc | 13377 | ("LaTeX" |
c44f0d75 | 13378 | ["Org CDLaTeX mode" org-cdlatex-mode :style toggle |
6769c0dc CD |
13379 | :selected org-cdlatex-mode] |
13380 | ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] | |
13381 | ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] | |
13382 | ["Modify math symbol" org-cdlatex-math-modify | |
13383 | (org-inside-LaTeX-fragment-p)] | |
13384 | ["Export LaTeX fragments as images" | |
20908596 CD |
13385 | (if (featurep 'org-exp) |
13386 | (setq org-export-with-LaTeX-fragments | |
13387 | (not org-export-with-LaTeX-fragments)) | |
13388 | (require 'org-exp)) | |
13389 | :style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments) | |
13390 | org-export-with-LaTeX-fragments)]) | |
891f4676 RS |
13391 | "--" |
13392 | ("Documentation" | |
13393 | ["Show Version" org-version t] | |
13394 | ["Info Documentation" org-info t]) | |
13395 | ("Customize" | |
13396 | ["Browse Org Group" org-customize t] | |
13397 | "--" | |
ab27a4a0 | 13398 | ["Expand This Menu" org-create-customize-menu |
891f4676 | 13399 | (fboundp 'customize-menu-create)]) |
28e5b051 CD |
13400 | "--" |
13401 | ["Refresh setup" org-mode-restart t] | |
891f4676 RS |
13402 | )) |
13403 | ||
891f4676 RS |
13404 | (defun org-info (&optional node) |
13405 | "Read documentation for Org-mode in the info system. | |
13406 | With optional NODE, go directly to that node." | |
13407 | (interactive) | |
74c52de1 | 13408 | (info (format "(org)%s" (or node "")))) |
891f4676 | 13409 | |
891f4676 | 13410 | (defun org-install-agenda-files-menu () |
ab27a4a0 CD |
13411 | (let ((bl (buffer-list))) |
13412 | (save-excursion | |
13413 | (while bl | |
13414 | (set-buffer (pop bl)) | |
b928f99a CD |
13415 | (if (org-mode-p) (setq bl nil))) |
13416 | (when (org-mode-p) | |
ab27a4a0 CD |
13417 | (easy-menu-change |
13418 | '("Org") "File List for Agenda" | |
13419 | (append | |
13420 | (list | |
13421 | ["Edit File List" (org-edit-agenda-file-list) t] | |
13422 | ["Add/Move Current File to Front of List" org-agenda-file-to-front t] | |
13423 | ["Remove Current File from List" org-remove-file t] | |
13424 | ["Cycle through agenda files" org-cycle-agenda-files t] | |
15841868 | 13425 | ["Occur in all agenda files" org-occur-in-agenda-files t] |
ab27a4a0 CD |
13426 | "--") |
13427 | (mapcar 'org-file-menu-entry (org-agenda-files t)))))))) | |
891f4676 | 13428 | |
d3f4dbe8 | 13429 | ;;;; Documentation |
891f4676 | 13430 | |
b349f79f | 13431 | ;;;###autoload |
20908596 CD |
13432 | (defun org-require-autoloaded-modules () |
13433 | (interactive) | |
13434 | (mapc 'require | |
13435 | '(org-agenda org-archive org-clock org-colview | |
b349f79f | 13436 | org-exp org-id org-export-latex org-publish |
20908596 CD |
13437 | org-remember org-table))) |
13438 | ||
b349f79f | 13439 | ;;;###autoload |
891f4676 | 13440 | (defun org-customize () |
c8d16429 | 13441 | "Call the customize function with org as argument." |
891f4676 | 13442 | (interactive) |
20908596 CD |
13443 | (org-load-modules-maybe) |
13444 | (org-require-autoloaded-modules) | |
891f4676 RS |
13445 | (customize-browse 'org)) |
13446 | ||
13447 | (defun org-create-customize-menu () | |
13448 | "Create a full customization menu for Org-mode, insert it into the menu." | |
13449 | (interactive) | |
20908596 CD |
13450 | (org-load-modules-maybe) |
13451 | (org-require-autoloaded-modules) | |
891f4676 RS |
13452 | (if (fboundp 'customize-menu-create) |
13453 | (progn | |
13454 | (easy-menu-change | |
13455 | '("Org") "Customize" | |
13456 | `(["Browse Org group" org-customize t] | |
13457 | "--" | |
13458 | ,(customize-menu-create 'org) | |
13459 | ["Set" Custom-set t] | |
13460 | ["Save" Custom-save t] | |
13461 | ["Reset to Current" Custom-reset-current t] | |
13462 | ["Reset to Saved" Custom-reset-saved t] | |
13463 | ["Reset to Standard Settings" Custom-reset-standard t])) | |
13464 | (message "\"Org\"-menu now contains full customization menu")) | |
13465 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
13466 | ||
d3f4dbe8 CD |
13467 | ;;;; Miscellaneous stuff |
13468 | ||
d3f4dbe8 | 13469 | ;;; Generally useful functions |
891f4676 | 13470 | |
b349f79f CD |
13471 | (defun org-display-warning (message) ;; Copied from Emacs-Muse |
13472 | "Display the given MESSAGE as a warning." | |
13473 | (if (fboundp 'display-warning) | |
13474 | (display-warning 'org message | |
13475 | (if (featurep 'xemacs) | |
13476 | 'warning | |
13477 | :warning)) | |
13478 | (let ((buf (get-buffer-create "*Org warnings*"))) | |
13479 | (with-current-buffer buf | |
13480 | (goto-char (point-max)) | |
13481 | (insert "Warning (Org): " message) | |
13482 | (unless (bolp) | |
13483 | (newline))) | |
13484 | (display-buffer buf) | |
13485 | (sit-for 0)))) | |
13486 | ||
13487 | (defun org-goto-marker-or-bmk (marker &optional bookmark) | |
621f83e4 | 13488 | "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." |
b349f79f CD |
13489 | (if (and marker (marker-buffer marker) |
13490 | (buffer-live-p (marker-buffer marker))) | |
13491 | (progn | |
13492 | (switch-to-buffer (marker-buffer marker)) | |
13493 | (if (or (> marker (point-max)) (< marker (point-min))) | |
13494 | (widen)) | |
13495 | (goto-char marker)) | |
13496 | (if bookmark | |
13497 | (bookmark-jump bookmark) | |
13498 | (error "Cannot find location")))) | |
13499 | ||
13500 | (defun org-quote-csv-field (s) | |
13501 | "Quote field for inclusion in CSV material." | |
13502 | (if (string-match "[\",]" s) | |
13503 | (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") | |
13504 | s)) | |
13505 | ||
20908596 CD |
13506 | (defun org-plist-delete (plist property) |
13507 | "Delete PROPERTY from PLIST. | |
13508 | This is in contrast to merely setting it to 0." | |
13509 | (let (p) | |
13510 | (while plist | |
13511 | (if (not (eq property (car plist))) | |
13512 | (setq p (plist-put p (car plist) (nth 1 plist)))) | |
13513 | (setq plist (cddr plist))) | |
13514 | p)) | |
13515 | ||
13516 | (defun org-force-self-insert (N) | |
13517 | "Needed to enforce self-insert under remapping." | |
13518 | (interactive "p") | |
13519 | (self-insert-command N)) | |
13520 | ||
13521 | (defun org-string-width (s) | |
13522 | "Compute width of string, ignoring invisible characters. | |
13523 | This ignores character with invisibility property `org-link', and also | |
13524 | characters with property `org-cwidth', because these will become invisible | |
13525 | upon the next fontification round." | |
13526 | (let (b l) | |
13527 | (when (or (eq t buffer-invisibility-spec) | |
13528 | (assq 'org-link buffer-invisibility-spec)) | |
13529 | (while (setq b (text-property-any 0 (length s) | |
13530 | 'invisible 'org-link s)) | |
13531 | (setq s (concat (substring s 0 b) | |
13532 | (substring s (or (next-single-property-change | |
13533 | b 'invisible s) (length s))))))) | |
13534 | (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) | |
13535 | (setq s (concat (substring s 0 b) | |
13536 | (substring s (or (next-single-property-change | |
13537 | b 'org-cwidth s) (length s)))))) | |
13538 | (setq l (string-width s) b -1) | |
13539 | (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) | |
13540 | (setq l (- l (get-text-property b 'org-dwidth-n s)))) | |
13541 | l)) | |
13542 | ||
621f83e4 CD |
13543 | (defun org-get-indentation (&optional line) |
13544 | "Get the indentation of the current line, interpreting tabs. | |
13545 | When LINE is given, assume it represents a line and compute its indentation." | |
13546 | (if line | |
13547 | (if (string-match "^ *" (org-remove-tabs line)) | |
13548 | (match-end 0)) | |
13549 | (save-excursion | |
13550 | (beginning-of-line 1) | |
13551 | (skip-chars-forward " \t") | |
13552 | (current-column)))) | |
13553 | ||
13554 | (defun org-remove-tabs (s &optional width) | |
13555 | "Replace tabulators in S with spaces. | |
13556 | Assumes that s is a single line, starting in column 0." | |
13557 | (setq width (or width tab-width)) | |
13558 | (while (string-match "\t" s) | |
13559 | (setq s (replace-match | |
13560 | (make-string | |
13561 | (- (* width (/ (+ (match-beginning 0) width) width)) | |
13562 | (match-beginning 0)) ?\ ) | |
13563 | t t s))) | |
13564 | s) | |
13565 | ||
13566 | (defun org-fix-indentation (line ind) | |
13567 | "Fix indentation in LINE. | |
13568 | IND is a cons cell with target and minimum indentation. | |
13569 | If the current indenation in LINE is smaller than the minimum, | |
13570 | leave it alone. If it is larger than ind, set it to the target." | |
13571 | (let* ((l (org-remove-tabs line)) | |
13572 | (i (org-get-indentation l)) | |
13573 | (i1 (car ind)) (i2 (cdr ind))) | |
13574 | (if (>= i i2) (setq l (substring line i2))) | |
13575 | (if (> i1 0) | |
13576 | (concat (make-string i1 ?\ ) l) | |
13577 | l))) | |
13578 | ||
b349f79f CD |
13579 | (defun org-base-buffer (buffer) |
13580 | "Return the base buffer of BUFFER, if it has one. Else return the buffer." | |
13581 | (if (not buffer) | |
13582 | buffer | |
13583 | (or (buffer-base-buffer buffer) | |
13584 | buffer))) | |
20908596 CD |
13585 | |
13586 | (defun org-trim (s) | |
13587 | "Remove whitespace at beginning and end of string." | |
13588 | (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) | |
13589 | (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) | |
13590 | s) | |
13591 | ||
13592 | (defun org-wrap (string &optional width lines) | |
13593 | "Wrap string to either a number of lines, or a width in characters. | |
13594 | If WIDTH is non-nil, the string is wrapped to that width, however many lines | |
13595 | that costs. If there is a word longer than WIDTH, the text is actually | |
13596 | wrapped to the length of that word. | |
13597 | IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | |
13598 | many lines, whatever width that takes. | |
13599 | The return value is a list of lines, without newlines at the end." | |
13600 | (let* ((words (org-split-string string "[ \t\n]+")) | |
13601 | (maxword (apply 'max (mapcar 'org-string-width words))) | |
13602 | w ll) | |
13603 | (cond (width | |
13604 | (org-do-wrap words (max maxword width))) | |
13605 | (lines | |
13606 | (setq w maxword) | |
13607 | (setq ll (org-do-wrap words maxword)) | |
13608 | (if (<= (length ll) lines) | |
13609 | ll | |
13610 | (setq ll words) | |
13611 | (while (> (length ll) lines) | |
13612 | (setq w (1+ w)) | |
13613 | (setq ll (org-do-wrap words w))) | |
13614 | ll)) | |
13615 | (t (error "Cannot wrap this"))))) | |
13616 | ||
13617 | (defun org-do-wrap (words width) | |
13618 | "Create lines of maximum width WIDTH (in characters) from word list WORDS." | |
13619 | (let (lines line) | |
13620 | (while words | |
13621 | (setq line (pop words)) | |
13622 | (while (and words (< (+ (length line) (length (car words))) width)) | |
13623 | (setq line (concat line " " (pop words)))) | |
13624 | (setq lines (push line lines))) | |
13625 | (nreverse lines))) | |
13626 | ||
13627 | (defun org-split-string (string &optional separators) | |
13628 | "Splits STRING into substrings at SEPARATORS. | |
13629 | No empty strings are returned if there are matches at the beginning | |
13630 | and end of string." | |
13631 | (let ((rexp (or separators "[ \f\t\n\r\v]+")) | |
13632 | (start 0) | |
13633 | notfirst | |
13634 | (list nil)) | |
13635 | (while (and (string-match rexp string | |
13636 | (if (and notfirst | |
13637 | (= start (match-beginning 0)) | |
13638 | (< start (length string))) | |
13639 | (1+ start) start)) | |
13640 | (< (match-beginning 0) (length string))) | |
13641 | (setq notfirst t) | |
13642 | (or (eq (match-beginning 0) 0) | |
13643 | (and (eq (match-beginning 0) (match-end 0)) | |
13644 | (eq (match-beginning 0) start)) | |
13645 | (setq list | |
13646 | (cons (substring string start (match-beginning 0)) | |
13647 | list))) | |
13648 | (setq start (match-end 0))) | |
13649 | (or (eq start (length string)) | |
13650 | (setq list | |
13651 | (cons (substring string start) | |
13652 | list))) | |
13653 | (nreverse list))) | |
13654 | ||
c4b5acde CD |
13655 | (defun org-context () |
13656 | "Return a list of contexts of the current cursor position. | |
13657 | If several contexts apply, all are returned. | |
13658 | Each context entry is a list with a symbol naming the context, and | |
13659 | two positions indicating start and end of the context. Possible | |
13660 | contexts are: | |
13661 | ||
13662 | :headline anywhere in a headline | |
13663 | :headline-stars on the leading stars in a headline | |
13664 | :todo-keyword on a TODO keyword (including DONE) in a headline | |
13665 | :tags on the TAGS in a headline | |
13666 | :priority on the priority cookie in a headline | |
13667 | :item on the first line of a plain list item | |
e39856be | 13668 | :item-bullet on the bullet/number of a plain list item |
c4b5acde CD |
13669 | :checkbox on the checkbox in a plain list item |
13670 | :table in an org-mode table | |
13671 | :table-special on a special filed in a table | |
13672 | :table-table in a table.el table | |
d3f4dbe8 | 13673 | :link on a hyperlink |
c4b5acde CD |
13674 | :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. |
13675 | :target on a <<target>> | |
13676 | :radio-target on a <<<radio-target>>> | |
e39856be CD |
13677 | :latex-fragment on a LaTeX fragment |
13678 | :latex-preview on a LaTeX fragment with overlayed preview image | |
c4b5acde CD |
13679 | |
13680 | This function expects the position to be visible because it uses font-lock | |
13681 | faces as a help to recognize the following contexts: :table-special, :link, | |
13682 | and :keyword." | |
13683 | (let* ((f (get-text-property (point) 'face)) | |
13684 | (faces (if (listp f) f (list f))) | |
e39856be | 13685 | (p (point)) clist o) |
c4b5acde CD |
13686 | ;; First the large context |
13687 | (cond | |
a3fbe8c4 | 13688 | ((org-on-heading-p t) |
c4b5acde CD |
13689 | (push (list :headline (point-at-bol) (point-at-eol)) clist) |
13690 | (when (progn | |
13691 | (beginning-of-line 1) | |
13692 | (looking-at org-todo-line-tags-regexp)) | |
13693 | (push (org-point-in-group p 1 :headline-stars) clist) | |
13694 | (push (org-point-in-group p 2 :todo-keyword) clist) | |
13695 | (push (org-point-in-group p 4 :tags) clist)) | |
13696 | (goto-char p) | |
13697 | (skip-chars-backward "^[\n\r \t") (or (eobp) (backward-char 1)) | |
a3fbe8c4 | 13698 | (if (looking-at "\\[#[A-Z0-9]\\]") |
c4b5acde CD |
13699 | (push (org-point-in-group p 0 :priority) clist))) |
13700 | ||
13701 | ((org-at-item-p) | |
e39856be | 13702 | (push (org-point-in-group p 2 :item-bullet) clist) |
c4b5acde CD |
13703 | (push (list :item (point-at-bol) |
13704 | (save-excursion (org-end-of-item) (point))) | |
13705 | clist) | |
13706 | (and (org-at-item-checkbox-p) | |
13707 | (push (org-point-in-group p 0 :checkbox) clist))) | |
13708 | ||
13709 | ((org-at-table-p) | |
13710 | (push (list :table (org-table-begin) (org-table-end)) clist) | |
13711 | (if (memq 'org-formula faces) | |
13712 | (push (list :table-special | |
13713 | (previous-single-property-change p 'face) | |
13714 | (next-single-property-change p 'face)) clist))) | |
13715 | ((org-at-table-p 'any) | |
13716 | (push (list :table-table) clist))) | |
13717 | (goto-char p) | |
13718 | ||
13719 | ;; Now the small context | |
13720 | (cond | |
13721 | ((org-at-timestamp-p) | |
13722 | (push (org-point-in-group p 0 :timestamp) clist)) | |
13723 | ((memq 'org-link faces) | |
13724 | (push (list :link | |
13725 | (previous-single-property-change p 'face) | |
13726 | (next-single-property-change p 'face)) clist)) | |
13727 | ((memq 'org-special-keyword faces) | |
13728 | (push (list :keyword | |
13729 | (previous-single-property-change p 'face) | |
13730 | (next-single-property-change p 'face)) clist)) | |
13731 | ((org-on-target-p) | |
13732 | (push (org-point-in-group p 0 :target) clist) | |
13733 | (goto-char (1- (match-beginning 0))) | |
13734 | (if (looking-at org-radio-target-regexp) | |
13735 | (push (org-point-in-group p 0 :radio-target) clist)) | |
e39856be CD |
13736 | (goto-char p)) |
13737 | ((setq o (car (delq nil | |
c44f0d75 | 13738 | (mapcar |
e39856be CD |
13739 | (lambda (x) |
13740 | (if (memq x org-latex-fragment-image-overlays) x)) | |
13741 | (org-overlays-at (point)))))) | |
c44f0d75 | 13742 | (push (list :latex-fragment |
e39856be | 13743 | (org-overlay-start o) (org-overlay-end o)) clist) |
c44f0d75 | 13744 | (push (list :latex-preview |
e39856be CD |
13745 | (org-overlay-start o) (org-overlay-end o)) clist)) |
13746 | ((org-inside-LaTeX-fragment-p) | |
3278a016 | 13747 | ;; FIXME: positions wrong. |
e39856be | 13748 | (push (list :latex-fragment (point) (point)) clist))) |
c4b5acde CD |
13749 | |
13750 | (setq clist (nreverse (delq nil clist))) | |
13751 | clist)) | |
13752 | ||
15841868 | 13753 | ;; FIXME: Compare with at-regexp-p Do we need both? |
d3f4dbe8 CD |
13754 | (defun org-in-regexp (re &optional nlines visually) |
13755 | "Check if point is inside a match of regexp. | |
13756 | Normally only the current line is checked, but you can include NLINES extra | |
13757 | lines both before and after point into the search. | |
13758 | If VISUALLY is set, require that the cursor is not after the match but | |
13759 | really on, so that the block visually is on the match." | |
13760 | (catch 'exit | |
13761 | (let ((pos (point)) | |
13762 | (eol (point-at-eol (+ 1 (or nlines 0)))) | |
13763 | (inc (if visually 1 0))) | |
13764 | (save-excursion | |
13765 | (beginning-of-line (- 1 (or nlines 0))) | |
13766 | (while (re-search-forward re eol t) | |
a3fbe8c4 | 13767 | (if (and (<= (match-beginning 0) pos) |
d3f4dbe8 CD |
13768 | (>= (+ inc (match-end 0)) pos)) |
13769 | (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) | |
13770 | ||
a3fbe8c4 CD |
13771 | (defun org-at-regexp-p (regexp) |
13772 | "Is point inside a match of REGEXP in the current line?" | |
13773 | (catch 'exit | |
13774 | (save-excursion | |
13775 | (let ((pos (point)) (end (point-at-eol))) | |
13776 | (beginning-of-line 1) | |
13777 | (while (re-search-forward regexp end t) | |
13778 | (if (and (<= (match-beginning 0) pos) | |
13779 | (>= (match-end 0) pos)) | |
13780 | (throw 'exit t))) | |
13781 | nil)))) | |
13782 | ||
03f3cf35 | 13783 | (defun org-occur-in-agenda-files (regexp &optional nlines) |
15841868 | 13784 | "Call `multi-occur' with buffers for all agenda files." |
03f3cf35 JW |
13785 | (interactive "sOrg-files matching: \np") |
13786 | (let* ((files (org-agenda-files)) | |
13787 | (tnames (mapcar 'file-truename files)) | |
2a57416f | 13788 | (extra org-agenda-text-search-extra-files) |
03f3cf35 | 13789 | f) |
20908596 CD |
13790 | (when (eq (car extra) 'agenda-archives) |
13791 | (setq extra (cdr extra)) | |
13792 | (setq files (org-add-archive-files files))) | |
03f3cf35 JW |
13793 | (while (setq f (pop extra)) |
13794 | (unless (member (file-truename f) tnames) | |
13795 | (add-to-list 'files f 'append) | |
13796 | (add-to-list 'tnames (file-truename f) 'append))) | |
13797 | (multi-occur | |
13798 | (mapcar (lambda (x) (or (get-file-buffer x) (find-file-noselect x))) files) | |
13799 | regexp))) | |
15841868 | 13800 | |
2a57416f CD |
13801 | (if (boundp 'occur-mode-find-occurrence-hook) |
13802 | ;; Emacs 23 | |
13803 | (add-hook 'occur-mode-find-occurrence-hook | |
13804 | (lambda () | |
13805 | (when (org-mode-p) | |
13806 | (org-reveal)))) | |
13807 | ;; Emacs 22 | |
13808 | (defadvice occur-mode-goto-occurrence | |
13809 | (after org-occur-reveal activate) | |
13810 | (and (org-mode-p) (org-reveal))) | |
13811 | (defadvice occur-mode-goto-occurrence-other-window | |
13812 | (after org-occur-reveal activate) | |
13813 | (and (org-mode-p) (org-reveal))) | |
13814 | (defadvice occur-mode-display-occurrence | |
13815 | (after org-occur-reveal activate) | |
13816 | (when (org-mode-p) | |
13817 | (let ((pos (occur-mode-find-occurrence))) | |
13818 | (with-current-buffer (marker-buffer pos) | |
13819 | (save-excursion | |
13820 | (goto-char pos) | |
13821 | (org-reveal))))))) | |
13822 | ||
a3fbe8c4 CD |
13823 | (defun org-uniquify (list) |
13824 | "Remove duplicate elements from LIST." | |
13825 | (let (res) | |
13826 | (mapc (lambda (x) (add-to-list 'res x 'append)) list) | |
13827 | res)) | |
13828 | ||
13829 | (defun org-delete-all (elts list) | |
13830 | "Remove all elements in ELTS from LIST." | |
13831 | (while elts | |
13832 | (setq list (delete (pop elts) list))) | |
13833 | list) | |
13834 | ||
8c6fb58b CD |
13835 | (defun org-back-over-empty-lines () |
13836 | "Move backwards over witespace, to the beginning of the first empty line. | |
5bf7807a | 13837 | Returns the number of empty lines passed." |
8c6fb58b CD |
13838 | (let ((pos (point))) |
13839 | (skip-chars-backward " \t\n\r") | |
13840 | (beginning-of-line 2) | |
13841 | (goto-char (min (point) pos)) | |
13842 | (count-lines (point) pos))) | |
13843 | ||
13844 | (defun org-skip-whitespace () | |
13845 | (skip-chars-forward " \t\n\r")) | |
13846 | ||
c4b5acde CD |
13847 | (defun org-point-in-group (point group &optional context) |
13848 | "Check if POINT is in match-group GROUP. | |
13849 | If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the | |
13850 | match. If the match group does ot exist or point is not inside it, | |
13851 | return nil." | |
13852 | (and (match-beginning group) | |
13853 | (>= point (match-beginning group)) | |
13854 | (<= point (match-end group)) | |
13855 | (if context | |
13856 | (list context (match-beginning group) (match-end group)) | |
13857 | t))) | |
13858 | ||
374585c9 CD |
13859 | (defun org-switch-to-buffer-other-window (&rest args) |
13860 | "Switch to buffer in a second window on the current frame. | |
13861 | In particular, do not allow pop-up frames." | |
13862 | (let (pop-up-frames special-display-buffer-names special-display-regexps | |
13863 | special-display-function) | |
13864 | (apply 'switch-to-buffer-other-window args))) | |
13865 | ||
d3f4dbe8 CD |
13866 | (defun org-combine-plists (&rest plists) |
13867 | "Create a single property list from all plists in PLISTS. | |
13868 | The process starts by copying the first list, and then setting properties | |
13869 | from the other lists. Settings in the last list are the most significant | |
13870 | ones and overrule settings in the other lists." | |
13871 | (let ((rtn (copy-sequence (pop plists))) | |
13872 | p v ls) | |
13873 | (while plists | |
13874 | (setq ls (pop plists)) | |
13875 | (while ls | |
13876 | (setq p (pop ls) v (pop ls)) | |
13877 | (setq rtn (plist-put rtn p v)))) | |
13878 | rtn)) | |
13879 | ||
891f4676 | 13880 | (defun org-move-line-down (arg) |
634a7d0b | 13881 | "Move the current line down. With prefix argument, move it past ARG lines." |
891f4676 RS |
13882 | (interactive "p") |
13883 | (let ((col (current-column)) | |
13884 | beg end pos) | |
13885 | (beginning-of-line 1) (setq beg (point)) | |
13886 | (beginning-of-line 2) (setq end (point)) | |
13887 | (beginning-of-line (+ 1 arg)) | |
13888 | (setq pos (move-marker (make-marker) (point))) | |
13889 | (insert (delete-and-extract-region beg end)) | |
13890 | (goto-char pos) | |
20908596 | 13891 | (org-move-to-column col))) |
891f4676 RS |
13892 | |
13893 | (defun org-move-line-up (arg) | |
634a7d0b | 13894 | "Move the current line up. With prefix argument, move it past ARG lines." |
891f4676 RS |
13895 | (interactive "p") |
13896 | (let ((col (current-column)) | |
13897 | beg end pos) | |
13898 | (beginning-of-line 1) (setq beg (point)) | |
13899 | (beginning-of-line 2) (setq end (point)) | |
634a7d0b | 13900 | (beginning-of-line (- arg)) |
891f4676 RS |
13901 | (setq pos (move-marker (make-marker) (point))) |
13902 | (insert (delete-and-extract-region beg end)) | |
13903 | (goto-char pos) | |
20908596 | 13904 | (org-move-to-column col))) |
891f4676 | 13905 | |
d3f4dbe8 CD |
13906 | (defun org-replace-escapes (string table) |
13907 | "Replace %-escapes in STRING with values in TABLE. | |
15841868 | 13908 | TABLE is an association list with keys like \"%a\" and string values. |
d3f4dbe8 CD |
13909 | The sequences in STRING may contain normal field width and padding information, |
13910 | for example \"%-5s\". Replacements happen in the sequence given by TABLE, | |
13911 | so values can contain further %-escapes if they are define later in TABLE." | |
13912 | (let ((case-fold-search nil) | |
a3fbe8c4 | 13913 | e re rpl) |
d3f4dbe8 CD |
13914 | (while (setq e (pop table)) |
13915 | (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) | |
13916 | (while (string-match re string) | |
13917 | (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") | |
13918 | (cdr e))) | |
13919 | (setq string (replace-match rpl t t string)))) | |
13920 | string)) | |
13921 | ||
13922 | ||
13923 | (defun org-sublist (list start end) | |
13924 | "Return a section of LIST, from START to END. | |
13925 | Counting starts at 1." | |
13926 | (let (rtn (c start)) | |
13927 | (setq list (nthcdr (1- start) list)) | |
13928 | (while (and list (<= c end)) | |
13929 | (push (pop list) rtn) | |
13930 | (setq c (1+ c))) | |
13931 | (nreverse rtn))) | |
13932 | ||
d3f4dbe8 CD |
13933 | (defun org-find-base-buffer-visiting (file) |
13934 | "Like `find-buffer-visiting' but alway return the base buffer and | |
5bf7807a | 13935 | not an indirect buffer." |
d3f4dbe8 | 13936 | (let ((buf (find-buffer-visiting file))) |
15841868 JW |
13937 | (if buf |
13938 | (or (buffer-base-buffer buf) buf) | |
13939 | nil))) | |
d3f4dbe8 | 13940 | |
a3fbe8c4 CD |
13941 | (defun org-image-file-name-regexp () |
13942 | "Return regexp matching the file names of images." | |
13943 | (if (fboundp 'image-file-name-regexp) | |
13944 | (image-file-name-regexp) | |
13945 | (let ((image-file-name-extensions | |
13946 | '("png" "jpeg" "jpg" "gif" "tiff" "tif" | |
13947 | "xbm" "xpm" "pbm" "pgm" "ppm"))) | |
13948 | (concat "\\." | |
13949 | (regexp-opt (nconc (mapcar 'upcase | |
13950 | image-file-name-extensions) | |
13951 | image-file-name-extensions) | |
13952 | t) | |
13953 | "\\'")))) | |
13954 | ||
13955 | (defun org-file-image-p (file) | |
13956 | "Return non-nil if FILE is an image." | |
13957 | (save-match-data | |
13958 | (string-match (org-image-file-name-regexp) file))) | |
13959 | ||
b349f79f CD |
13960 | (defun org-get-cursor-date () |
13961 | "Return the date at cursor in as a time. | |
13962 | This works in the calendar and in the agenda, anywhere else it just | |
13963 | returns the current time." | |
13964 | (let (date day defd) | |
13965 | (cond | |
13966 | ((eq major-mode 'calendar-mode) | |
13967 | (setq date (calendar-cursor-to-date) | |
13968 | defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
13969 | ((eq major-mode 'org-agenda-mode) | |
13970 | (setq day (get-text-property (point) 'day)) | |
13971 | (if day | |
13972 | (setq date (calendar-gregorian-from-absolute day) | |
13973 | defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) | |
13974 | (nth 2 date)))))) | |
13975 | (or defd (current-time)))) | |
13976 | ||
13977 | (defvar org-agenda-action-marker (make-marker) | |
13978 | "Marker pointing to the entry for the next agenda action.") | |
13979 | ||
13980 | (defun org-mark-entry-for-agenda-action () | |
13981 | "Mark the current entry as target of an agenda action. | |
13982 | Agenda actions are actions executed from the agenda with the key `k', | |
13983 | which make use of the date at the cursor." | |
13984 | (interactive) | |
13985 | (move-marker org-agenda-action-marker | |
13986 | (save-excursion (org-back-to-heading t) (point)) | |
13987 | (current-buffer)) | |
13988 | (message | |
13989 | "Entry marked for action; press `k' at desired date in agenda or calendar")) | |
13990 | ||
d3f4dbe8 | 13991 | ;;; Paragraph filling stuff. |
e0e66b8e | 13992 | ;; We want this to be just right, so use the full arsenal. |
a3fbe8c4 CD |
13993 | |
13994 | (defun org-indent-line-function () | |
13995 | "Indent line like previous, but further if previous was headline or item." | |
13996 | (interactive) | |
b38c6895 CD |
13997 | (let* ((pos (point)) |
13998 | (itemp (org-at-item-p)) | |
13999 | column bpos bcol tpos tcol bullet btype bullet-type) | |
14000 | ;; Find the previous relevant line | |
14001 | (beginning-of-line 1) | |
14002 | (cond | |
14003 | ((looking-at "#") (setq column 0)) | |
5152b597 | 14004 | ((looking-at "\\*+ ") (setq column 0)) |
b38c6895 CD |
14005 | (t |
14006 | (beginning-of-line 0) | |
14007 | (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) | |
14008 | (beginning-of-line 0)) | |
14009 | (cond | |
14010 | ((looking-at "\\*+[ \t]+") | |
b349f79f CD |
14011 | (if (not org-adapt-indentation) |
14012 | (setq column 0) | |
14013 | (goto-char (match-end 0)) | |
14014 | (setq column (current-column)))) | |
b38c6895 CD |
14015 | ((org-in-item-p) |
14016 | (org-beginning-of-item) | |
b349f79f | 14017 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") |
b38c6895 CD |
14018 | (setq bpos (match-beginning 1) tpos (match-end 0) |
14019 | bcol (progn (goto-char bpos) (current-column)) | |
14020 | tcol (progn (goto-char tpos) (current-column)) | |
14021 | bullet (match-string 1) | |
14022 | bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) | |
b349f79f CD |
14023 | (if (> tcol (+ bcol org-description-max-indent)) |
14024 | (setq tcol (+ bcol 5))) | |
b38c6895 CD |
14025 | (if (not itemp) |
14026 | (setq column tcol) | |
14027 | (goto-char pos) | |
14028 | (beginning-of-line 1) | |
8c6fb58b CD |
14029 | (if (looking-at "\\S-") |
14030 | (progn | |
14031 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") | |
14032 | (setq bullet (match-string 1) | |
14033 | btype (if (string-match "[0-9]" bullet) "n" bullet)) | |
14034 | (setq column (if (equal btype bullet-type) bcol tcol))) | |
14035 | (setq column (org-get-indentation))))) | |
b38c6895 CD |
14036 | (t (setq column (org-get-indentation)))))) |
14037 | (goto-char pos) | |
a3fbe8c4 | 14038 | (if (<= (current-column) (current-indentation)) |
20908596 CD |
14039 | (org-indent-line-to column) |
14040 | (save-excursion (org-indent-line-to column))) | |
38f8646b CD |
14041 | (setq column (current-column)) |
14042 | (beginning-of-line 1) | |
14043 | (if (looking-at | |
8c6fb58b | 14044 | "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") |
38f8646b CD |
14045 | (replace-match (concat "\\1" (format org-property-format |
14046 | (match-string 2) (match-string 3))) | |
14047 | t nil)) | |
20908596 | 14048 | (org-move-to-column column))) |
e0e66b8e CD |
14049 | |
14050 | (defun org-set-autofill-regexps () | |
14051 | (interactive) | |
14052 | ;; In the paragraph separator we include headlines, because filling | |
14053 | ;; text in a line directly attached to a headline would otherwise | |
14054 | ;; fill the headline as well. | |
5137195a | 14055 | (org-set-local 'comment-start-skip "^#+[ \t]*") |
7d58338e | 14056 | (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") |
e0e66b8e | 14057 | ;; The paragraph starter includes hand-formatted lists. |
5137195a | 14058 | (org-set-local 'paragraph-start |
7d58338e | 14059 | "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") |
e0e66b8e CD |
14060 | ;; Inhibit auto-fill for headers, tables and fixed-width lines. |
14061 | ;; But only if the user has not turned off tables or fixed-width regions | |
5137195a CD |
14062 | (org-set-local |
14063 | 'auto-fill-inhibit-regexp | |
7d58338e | 14064 | (concat "\\*+ \\|#\\+" |
5137195a CD |
14065 | "\\|[ \t]*" org-keyword-time-regexp |
14066 | (if (or org-enable-table-editor org-enable-fixed-width-editor) | |
14067 | (concat | |
14068 | "\\|[ \t]*[" | |
14069 | (if org-enable-table-editor "|" "") | |
14070 | (if org-enable-fixed-width-editor ":" "") | |
14071 | "]")))) | |
e0e66b8e CD |
14072 | ;; We use our own fill-paragraph function, to make sure that tables |
14073 | ;; and fixed-width regions are not wrapped. That function will pass | |
14074 | ;; through to `fill-paragraph' when appropriate. | |
5137195a CD |
14075 | (org-set-local 'fill-paragraph-function 'org-fill-paragraph) |
14076 | ; Adaptive filling: To get full control, first make sure that | |
6eff18ef | 14077 | ;; `adaptive-fill-regexp' never matches. Then install our own matcher. |
5137195a CD |
14078 | (org-set-local 'adaptive-fill-regexp "\000") |
14079 | (org-set-local 'adaptive-fill-function | |
2a57416f CD |
14080 | 'org-adaptive-fill-function) |
14081 | (org-set-local | |
14082 | 'align-mode-rules-list | |
14083 | '((org-in-buffer-settings | |
14084 | (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") | |
14085 | (modes . '(org-mode)))))) | |
e0e66b8e CD |
14086 | |
14087 | (defun org-fill-paragraph (&optional justify) | |
14088 | "Re-align a table, pass through to fill-paragraph if no table." | |
14089 | (let ((table-p (org-at-table-p)) | |
14090 | (table.el-p (org-at-table.el-p))) | |
8c6fb58b CD |
14091 | (cond ((and (equal (char-after (point-at-bol)) ?*) |
14092 | (save-excursion (goto-char (point-at-bol)) | |
14093 | (looking-at outline-regexp))) | |
14094 | t) ; skip headlines | |
14095 | (table.el-p t) ; skip table.el tables | |
14096 | (table-p (org-table-align) t) ; align org-mode tables | |
14097 | (t nil)))) ; call paragraph-fill | |
e0e66b8e CD |
14098 | |
14099 | ;; For reference, this is the default value of adaptive-fill-regexp | |
14100 | ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" | |
14101 | ||
14102 | (defun org-adaptive-fill-function () | |
14103 | "Return a fill prefix for org-mode files. | |
14104 | In particular, this makes sure hanging paragraphs for hand-formatted lists | |
14105 | work correctly." | |
d3f4dbe8 CD |
14106 | (cond ((looking-at "#[ \t]+") |
14107 | (match-string 0)) | |
b349f79f CD |
14108 | ((looking-at "[ \t]*\\([-*+] .*? :: \\)") |
14109 | (save-excursion | |
14110 | (if (> (match-end 1) (+ (match-beginning 1) | |
14111 | org-description-max-indent)) | |
14112 | (goto-char (+ (match-beginning 1) 5)) | |
14113 | (goto-char (match-end 0))) | |
14114 | (make-string (current-column) ?\ ))) | |
ce4fdcb9 | 14115 | ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] ?\\)?") |
a3fbe8c4 CD |
14116 | (save-excursion |
14117 | (goto-char (match-end 0)) | |
14118 | (make-string (current-column) ?\ ))) | |
d3f4dbe8 | 14119 | (t nil))) |
891f4676 | 14120 | |
20908596 CD |
14121 | ;;; Other stuff. |
14122 | ||
14123 | (defun org-toggle-fixed-width-section (arg) | |
14124 | "Toggle the fixed-width export. | |
14125 | If there is no active region, the QUOTE keyword at the current headline is | |
14126 | inserted or removed. When present, it causes the text between this headline | |
14127 | and the next to be exported as fixed-width text, and unmodified. | |
14128 | If there is an active region, this command adds or removes a colon as the | |
14129 | first character of this line. If the first character of a line is a colon, | |
14130 | this line is also exported in fixed-width font." | |
14131 | (interactive "P") | |
14132 | (let* ((cc 0) | |
14133 | (regionp (org-region-active-p)) | |
14134 | (beg (if regionp (region-beginning) (point))) | |
14135 | (end (if regionp (region-end))) | |
14136 | (nlines (or arg (if (and beg end) (count-lines beg end) 1))) | |
14137 | (case-fold-search nil) | |
14138 | (re "[ \t]*\\(:\\)") | |
14139 | off) | |
14140 | (if regionp | |
14141 | (save-excursion | |
14142 | (goto-char beg) | |
14143 | (setq cc (current-column)) | |
14144 | (beginning-of-line 1) | |
14145 | (setq off (looking-at re)) | |
14146 | (while (> nlines 0) | |
14147 | (setq nlines (1- nlines)) | |
14148 | (beginning-of-line 1) | |
14149 | (cond | |
14150 | (arg | |
14151 | (org-move-to-column cc t) | |
14152 | (insert ":\n") | |
14153 | (forward-line -1)) | |
14154 | ((and off (looking-at re)) | |
14155 | (replace-match "" t t nil 1)) | |
14156 | ((not off) (org-move-to-column cc t) (insert ":"))) | |
14157 | (forward-line 1))) | |
14158 | (save-excursion | |
14159 | (org-back-to-heading) | |
14160 | (if (looking-at (concat outline-regexp | |
14161 | "\\( *\\<" org-quote-string "\\>[ \t]*\\)")) | |
14162 | (replace-match "" t t nil 1) | |
14163 | (if (looking-at outline-regexp) | |
14164 | (progn | |
14165 | (goto-char (match-end 0)) | |
14166 | (insert org-quote-string " ")))))))) | |
891f4676 | 14167 | |
20908596 | 14168 | ;;;; Functions extending outline functionality |
2a57416f | 14169 | |
1e8fbb6d | 14170 | (defun org-beginning-of-line (&optional arg) |
891f4676 | 14171 | "Go to the beginning of the current line. If that is invisible, continue |
1e8fbb6d CD |
14172 | to a visible line beginning. This makes the function of C-a more intuitive. |
14173 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
14174 | first attempt, and only move to after the tags when the cursor is already | |
14175 | beyond the end of the headline." | |
14176 | (interactive "P") | |
b349f79f | 14177 | (let ((pos (point)) refpos) |
a3fbe8c4 CD |
14178 | (beginning-of-line 1) |
14179 | (if (bobp) | |
14180 | nil | |
14181 | (backward-char 1) | |
14182 | (if (org-invisible-p) | |
14183 | (while (and (not (bobp)) (org-invisible-p)) | |
14184 | (backward-char 1) | |
14185 | (beginning-of-line 1)) | |
14186 | (forward-char 1))) | |
48aaad2d CD |
14187 | (when org-special-ctrl-a/e |
14188 | (cond | |
b349f79f | 14189 | ((and (looking-at org-complex-heading-regexp) |
48aaad2d | 14190 | (= (char-after (match-end 1)) ?\ )) |
b349f79f CD |
14191 | (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) |
14192 | (point-at-eol))) | |
48aaad2d | 14193 | (goto-char |
374585c9 | 14194 | (if (eq org-special-ctrl-a/e t) |
b349f79f CD |
14195 | (cond ((> pos refpos) refpos) |
14196 | ((= pos (point)) refpos) | |
374585c9 CD |
14197 | (t (point))) |
14198 | (cond ((> pos (point)) (point)) | |
14199 | ((not (eq last-command this-command)) (point)) | |
b349f79f | 14200 | (t refpos))))) |
48aaad2d CD |
14201 | ((org-at-item-p) |
14202 | (goto-char | |
374585c9 CD |
14203 | (if (eq org-special-ctrl-a/e t) |
14204 | (cond ((> pos (match-end 4)) (match-end 4)) | |
14205 | ((= pos (point)) (match-end 4)) | |
14206 | (t (point))) | |
14207 | (cond ((> pos (point)) (point)) | |
14208 | ((not (eq last-command this-command)) (point)) | |
b349f79f CD |
14209 | (t (match-end 4)))))))) |
14210 | (org-no-warnings | |
14211 | (and (featurep 'xemacs) (setq zmacs-region-stays t))))) | |
04d18304 | 14212 | |
1e8fbb6d CD |
14213 | (defun org-end-of-line (&optional arg) |
14214 | "Go to the end of the line. | |
14215 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
14216 | first attempt, and only move to after the tags when the cursor is already | |
14217 | beyond the end of the headline." | |
14218 | (interactive "P") | |
14219 | (if (or (not org-special-ctrl-a/e) | |
14220 | (not (org-on-heading-p))) | |
14221 | (end-of-line arg) | |
14222 | (let ((pos (point))) | |
14223 | (beginning-of-line 1) | |
14224 | (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) | |
374585c9 CD |
14225 | (if (eq org-special-ctrl-a/e t) |
14226 | (if (or (< pos (match-beginning 1)) | |
14227 | (= pos (match-end 0))) | |
14228 | (goto-char (match-beginning 1)) | |
14229 | (goto-char (match-end 0))) | |
14230 | (if (or (< pos (match-end 0)) (not (eq this-command last-command))) | |
14231 | (goto-char (match-end 0)) | |
14232 | (goto-char (match-beginning 1)))) | |
b349f79f CD |
14233 | (end-of-line arg)))) |
14234 | (org-no-warnings | |
14235 | (and (featurep 'xemacs) (setq zmacs-region-stays t)))) | |
14236 | ||
1e8fbb6d | 14237 | |
5137195a | 14238 | (define-key org-mode-map "\C-a" 'org-beginning-of-line) |
1e8fbb6d | 14239 | (define-key org-mode-map "\C-e" 'org-end-of-line) |
891f4676 | 14240 | |
2a57416f CD |
14241 | (defun org-kill-line (&optional arg) |
14242 | "Kill line, to tags or end of line." | |
14243 | (interactive "P") | |
14244 | (cond | |
14245 | ((or (not org-special-ctrl-k) | |
14246 | (bolp) | |
14247 | (not (org-on-heading-p))) | |
14248 | (call-interactively 'kill-line)) | |
14249 | ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")) | |
14250 | (kill-region (point) (match-beginning 1)) | |
14251 | (org-set-tags nil t)) | |
14252 | (t (kill-region (point) (point-at-eol))))) | |
14253 | ||
14254 | (define-key org-mode-map "\C-k" 'org-kill-line) | |
14255 | ||
93b62de8 CD |
14256 | (defun org-yank (&optional arg) |
14257 | "Yank. If the kill is a subtree, treat it specially. | |
14258 | This command will look at the current kill and check if is a single | |
14259 | subtree, or a series of subtrees[1]. If it passes the test, and if the | |
14260 | cursor is at the beginning of a line or after the stars of a currently | |
14261 | empty headline, then the yank is handeled specially. How exactly depends | |
14262 | on the value of the following variables, both set by default. | |
14263 | ||
14264 | org-yank-folded-subtrees | |
14265 | When set, the subree(s) will be folded after insertion, but only | |
14266 | if doing so would now swallow text after the yanked text. | |
14267 | ||
14268 | org-yank-adjusted-subtrees | |
14269 | When set, the subtree will be promoted or demoted in order to | |
14270 | fit into the local outline tree structure, which means that the level | |
14271 | will be adjusted so that it becomes the smaller one of the two | |
14272 | *visible* surrounding headings. | |
14273 | ||
14274 | Any prefix to this command will cause `yank' to be called directly with | |
14275 | no special treatment. In particular, a simple `C-u' prefix will just | |
14276 | plainly yank the text as it is. | |
14277 | ||
14278 | \[1] Basically, the test checks if the first non-white line is a heading | |
14279 | and if there are no other headings with fewer stars." | |
14280 | (interactive "P") | |
ce4fdcb9 | 14281 | (setq this-command 'yank) |
93b62de8 CD |
14282 | (if arg |
14283 | (call-interactively 'yank) | |
14284 | (let ((subtreep ; is kill a subtree, and the yank position appropriate? | |
14285 | (and (org-kill-is-subtree-p) | |
14286 | (or (bolp) | |
14287 | (and (looking-at "[ \t]*$") | |
ce4fdcb9 | 14288 | (string-match |
93b62de8 CD |
14289 | "\\`\\*+\\'" |
14290 | (buffer-substring (point-at-bol) (point))))))) | |
14291 | swallowp) | |
14292 | (cond | |
14293 | ((and subtreep org-yank-folded-subtrees) | |
14294 | (let ((beg (point)) | |
14295 | end) | |
14296 | (if (and subtreep org-yank-adjusted-subtrees) | |
14297 | (org-paste-subtree nil nil 'for-yank) | |
14298 | (call-interactively 'yank)) | |
14299 | (setq end (point)) | |
14300 | (goto-char beg) | |
14301 | (when (and (bolp) subtreep | |
14302 | (not (setq swallowp | |
14303 | (org-yank-folding-would-swallow-text beg end)))) | |
14304 | (or (looking-at outline-regexp) | |
14305 | (re-search-forward (concat "^" outline-regexp) end t)) | |
14306 | (while (and (< (point) end) (looking-at outline-regexp)) | |
14307 | (hide-subtree) | |
14308 | (org-cycle-show-empty-lines 'folded) | |
14309 | (condition-case nil | |
14310 | (outline-forward-same-level 1) | |
14311 | (error (goto-char end))))) | |
14312 | (when swallowp | |
14313 | (message | |
14314 | "Yanked text not folded because that would swallow text")) | |
14315 | (goto-char end) | |
14316 | (skip-chars-forward " \t\n\r") | |
ce4fdcb9 CD |
14317 | (beginning-of-line 1) |
14318 | (push-mark beg 'nomsg))) | |
93b62de8 | 14319 | ((and subtreep org-yank-adjusted-subtrees) |
ce4fdcb9 CD |
14320 | (let ((beg (point-at-bol))) |
14321 | (org-paste-subtree nil nil 'for-yank) | |
14322 | (push-mark beg 'nomsg))) | |
93b62de8 CD |
14323 | (t |
14324 | (call-interactively 'yank)))))) | |
ce4fdcb9 | 14325 | |
93b62de8 CD |
14326 | (defun org-yank-folding-would-swallow-text (beg end) |
14327 | "Would hide-subtree at BEG swallow any text after END?" | |
14328 | (let (level) | |
14329 | (save-excursion | |
14330 | (goto-char beg) | |
14331 | (when (or (looking-at outline-regexp) | |
14332 | (re-search-forward (concat "^" outline-regexp) end t)) | |
14333 | (setq level (org-outline-level))) | |
14334 | (goto-char end) | |
14335 | (skip-chars-forward " \t\r\n\v\f") | |
14336 | (if (or (eobp) | |
14337 | (and (bolp) (looking-at org-outline-regexp) | |
14338 | (<= (org-outline-level) level))) | |
14339 | nil ; Nothing would be swallowed | |
14340 | t)))) ; something would swallow | |
621f83e4 CD |
14341 | |
14342 | (define-key org-mode-map "\C-y" 'org-yank) | |
14343 | ||
891f4676 RS |
14344 | (defun org-invisible-p () |
14345 | "Check if point is at a character currently not visible." | |
5137195a CD |
14346 | ;; Early versions of noutline don't have `outline-invisible-p'. |
14347 | (if (fboundp 'outline-invisible-p) | |
14348 | (outline-invisible-p) | |
14349 | (get-char-property (point) 'invisible))) | |
891f4676 | 14350 | |
a96ee7df CD |
14351 | (defun org-invisible-p2 () |
14352 | "Check if point is at a character currently not visible." | |
14353 | (save-excursion | |
5137195a CD |
14354 | (if (and (eolp) (not (bobp))) (backward-char 1)) |
14355 | ;; Early versions of noutline don't have `outline-invisible-p'. | |
14356 | (if (fboundp 'outline-invisible-p) | |
14357 | (outline-invisible-p) | |
14358 | (get-char-property (point) 'invisible)))) | |
14359 | ||
ce4fdcb9 CD |
14360 | (defun org-back-to-heading (&optional invisible-ok) |
14361 | "Call `outline-back-to-heading', but provide a better error message." | |
14362 | (condition-case nil | |
14363 | (outline-back-to-heading invisible-ok) | |
14364 | (error (error "Before first headline at position %d in buffer %s" | |
14365 | (point) (current-buffer))))) | |
14366 | ||
5137195a | 14367 | (defalias 'org-on-heading-p 'outline-on-heading-p) |
a3fbe8c4 CD |
14368 | (defalias 'org-at-heading-p 'outline-on-heading-p) |
14369 | (defun org-at-heading-or-item-p () | |
14370 | (or (org-on-heading-p) (org-at-item-p))) | |
891f4676 | 14371 | |
a96ee7df | 14372 | (defun org-on-target-p () |
d3f4dbe8 CD |
14373 | (or (org-in-regexp org-radio-target-regexp) |
14374 | (org-in-regexp org-target-regexp))) | |
a96ee7df | 14375 | |
891f4676 RS |
14376 | (defun org-up-heading-all (arg) |
14377 | "Move to the heading line of which the present line is a subheading. | |
14378 | This function considers both visible and invisible heading lines. | |
14379 | With argument, move up ARG levels." | |
5137195a CD |
14380 | (if (fboundp 'outline-up-heading-all) |
14381 | (outline-up-heading-all arg) ; emacs 21 version of outline.el | |
14382 | (outline-up-heading arg t))) ; emacs 22 version of outline.el | |
891f4676 | 14383 | |
d5098885 JW |
14384 | (defun org-up-heading-safe () |
14385 | "Move to the heading line of which the present line is a subheading. | |
14386 | This version will not throw an error. It will return the level of the | |
14387 | headline found, or nil if no higher level is found." | |
14388 | (let ((pos (point)) start-level level | |
14389 | (re (concat "^" outline-regexp))) | |
14390 | (catch 'exit | |
ce4fdcb9 | 14391 | (org-back-to-heading t) |
d5098885 JW |
14392 | (setq start-level (funcall outline-level)) |
14393 | (if (equal start-level 1) (throw 'exit nil)) | |
14394 | (while (re-search-backward re nil t) | |
14395 | (setq level (funcall outline-level)) | |
14396 | (if (< level start-level) (throw 'exit level))) | |
14397 | nil))) | |
14398 | ||
8c6fb58b CD |
14399 | (defun org-first-sibling-p () |
14400 | "Is this heading the first child of its parents?" | |
14401 | (interactive) | |
14402 | (let ((re (concat "^" outline-regexp)) | |
14403 | level l) | |
14404 | (unless (org-at-heading-p t) | |
14405 | (error "Not at a heading")) | |
14406 | (setq level (funcall outline-level)) | |
14407 | (save-excursion | |
14408 | (if (not (re-search-backward re nil t)) | |
14409 | t | |
14410 | (setq l (funcall outline-level)) | |
14411 | (< l level))))) | |
14412 | ||
3278a016 CD |
14413 | (defun org-goto-sibling (&optional previous) |
14414 | "Goto the next sibling, even if it is invisible. | |
14415 | When PREVIOUS is set, go to the previous sibling instead. Returns t | |
14416 | when a sibling was found. When none is found, return nil and don't | |
14417 | move point." | |
14418 | (let ((fun (if previous 're-search-backward 're-search-forward)) | |
14419 | (pos (point)) | |
14420 | (re (concat "^" outline-regexp)) | |
14421 | level l) | |
5152b597 CD |
14422 | (when (condition-case nil (org-back-to-heading t) (error nil)) |
14423 | (setq level (funcall outline-level)) | |
14424 | (catch 'exit | |
14425 | (or previous (forward-char 1)) | |
14426 | (while (funcall fun re nil t) | |
14427 | (setq l (funcall outline-level)) | |
14428 | (when (< l level) (goto-char pos) (throw 'exit nil)) | |
14429 | (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) | |
14430 | (goto-char pos) | |
14431 | nil)))) | |
3278a016 | 14432 | |
d3f4dbe8 CD |
14433 | (defun org-show-siblings () |
14434 | "Show all siblings of the current headline." | |
14435 | (save-excursion | |
14436 | (while (org-goto-sibling) (org-flag-heading nil))) | |
14437 | (save-excursion | |
14438 | (while (org-goto-sibling 'previous) | |
14439 | (org-flag-heading nil)))) | |
14440 | ||
891f4676 RS |
14441 | (defun org-show-hidden-entry () |
14442 | "Show an entry where even the heading is hidden." | |
14443 | (save-excursion | |
634a7d0b | 14444 | (org-show-entry))) |
891f4676 | 14445 | |
891f4676 | 14446 | (defun org-flag-heading (flag &optional entry) |
2dd9129f | 14447 | "Flag the current heading. FLAG non-nil means make invisible. |
891f4676 RS |
14448 | When ENTRY is non-nil, show the entire entry." |
14449 | (save-excursion | |
14450 | (org-back-to-heading t) | |
891f4676 RS |
14451 | ;; Check if we should show the entire entry |
14452 | (if entry | |
c8d16429 CD |
14453 | (progn |
14454 | (org-show-entry) | |
4b3a9ba7 CD |
14455 | (save-excursion |
14456 | (and (outline-next-heading) | |
14457 | (org-flag-heading nil)))) | |
48aaad2d | 14458 | (outline-flag-region (max (point-min) (1- (point))) |
c8d16429 | 14459 | (save-excursion (outline-end-of-heading) (point)) |
5137195a | 14460 | flag)))) |
891f4676 | 14461 | |
621f83e4 CD |
14462 | (defun org-forward-same-level (arg) |
14463 | "Move forward to the ARG'th subheading at same level as this one. | |
14464 | Stop at the first and last subheadings of a superior heading. | |
14465 | This is like outline-forward-same-level, but invisible headings are ok." | |
14466 | (interactive "p") | |
ce4fdcb9 | 14467 | (org-back-to-heading t) |
621f83e4 CD |
14468 | (while (> arg 0) |
14469 | (let ((point-to-move-to (save-excursion | |
14470 | (org-get-next-sibling)))) | |
14471 | (if point-to-move-to | |
14472 | (progn | |
14473 | (goto-char point-to-move-to) | |
14474 | (setq arg (1- arg))) | |
14475 | (progn | |
14476 | (setq arg 0) | |
14477 | (error "No following same-level heading")))))) | |
14478 | ||
14479 | (defun org-get-next-sibling () | |
14480 | "Move to next heading of the same level, and return point. | |
14481 | If there is no such heading, return nil. | |
14482 | This is like outline-next-sibling, but invisible headings are ok." | |
14483 | (let ((level (funcall outline-level))) | |
14484 | (outline-next-heading) | |
14485 | (while (and (not (eobp)) (> (funcall outline-level) level)) | |
14486 | (outline-next-heading)) | |
14487 | (if (or (eobp) (< (funcall outline-level) level)) | |
14488 | nil | |
14489 | (point)))) | |
14490 | ||
a3fbe8c4 | 14491 | (defun org-end-of-subtree (&optional invisible-OK to-heading) |
04d18304 CD |
14492 | ;; This is an exact copy of the original function, but it uses |
14493 | ;; `org-back-to-heading', to make it work also in invisible | |
14494 | ;; trees. And is uses an invisible-OK argument. | |
14495 | ;; Under Emacs this is not needed, but the old outline.el needs this fix. | |
14496 | (org-back-to-heading invisible-OK) | |
f462ee2c | 14497 | (let ((first t) |
04d18304 CD |
14498 | (level (funcall outline-level))) |
14499 | (while (and (not (eobp)) | |
14500 | (or first (> (funcall outline-level) level))) | |
14501 | (setq first nil) | |
14502 | (outline-next-heading)) | |
a3fbe8c4 CD |
14503 | (unless to-heading |
14504 | (if (memq (preceding-char) '(?\n ?\^M)) | |
14505 | (progn | |
14506 | ;; Go to end of line before heading | |
14507 | (forward-char -1) | |
14508 | (if (memq (preceding-char) '(?\n ?\^M)) | |
14509 | ;; leave blank line before heading | |
14510 | (forward-char -1)))))) | |
0fee8d6e | 14511 | (point)) |
04d18304 | 14512 | |
634a7d0b CD |
14513 | (defun org-show-subtree () |
14514 | "Show everything after this heading at deeper levels." | |
64f72ae1 JB |
14515 | (outline-flag-region |
14516 | (point) | |
634a7d0b CD |
14517 | (save-excursion |
14518 | (outline-end-of-subtree) (outline-next-heading) (point)) | |
5137195a | 14519 | nil)) |
634a7d0b CD |
14520 | |
14521 | (defun org-show-entry () | |
14522 | "Show the body directly following this heading. | |
14523 | Show the heading too, if it is currently invisible." | |
14524 | (interactive) | |
14525 | (save-excursion | |
15841868 JW |
14526 | (condition-case nil |
14527 | (progn | |
14528 | (org-back-to-heading t) | |
14529 | (outline-flag-region | |
14530 | (max (point-min) (1- (point))) | |
14531 | (save-excursion | |
14532 | (re-search-forward | |
14533 | (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) | |
14534 | (or (match-beginning 1) (point-max))) | |
14535 | nil)) | |
14536 | (error nil)))) | |
634a7d0b | 14537 | |
891f4676 RS |
14538 | (defun org-make-options-regexp (kwds) |
14539 | "Make a regular expression for keyword lines." | |
14540 | (concat | |
5137195a | 14541 | "^" |
891f4676 RS |
14542 | "#?[ \t]*\\+\\(" |
14543 | (mapconcat 'regexp-quote kwds "\\|") | |
14544 | "\\):[ \t]*" | |
5137195a | 14545 | "\\(.+\\)")) |
891f4676 | 14546 | |
d3f4dbe8 CD |
14547 | ;; Make isearch reveal the necessary context |
14548 | (defun org-isearch-end () | |
14549 | "Reveal context after isearch exits." | |
14550 | (when isearch-success ; only if search was successful | |
14551 | (if (featurep 'xemacs) | |
14552 | ;; Under XEmacs, the hook is run in the correct place, | |
14553 | ;; we directly show the context. | |
14554 | (org-show-context 'isearch) | |
14555 | ;; In Emacs the hook runs *before* restoring the overlays. | |
14556 | ;; So we have to use a one-time post-command-hook to do this. | |
14557 | ;; (Emacs 22 has a special variable, see function `org-mode') | |
14558 | (unless (and (boundp 'isearch-mode-end-hook-quit) | |
14559 | isearch-mode-end-hook-quit) | |
14560 | ;; Only when the isearch was not quitted. | |
14561 | (org-add-hook 'post-command-hook 'org-isearch-post-command | |
14562 | 'append 'local))))) | |
14563 | ||
14564 | (defun org-isearch-post-command () | |
14565 | "Remove self from hook, and show context." | |
14566 | (remove-hook 'post-command-hook 'org-isearch-post-command 'local) | |
14567 | (org-show-context 'isearch)) | |
14568 | ||
a3fbe8c4 | 14569 | |
8c6fb58b CD |
14570 | ;;;; Integration with and fixes for other packages |
14571 | ||
14572 | ;;; Imenu support | |
14573 | ||
14574 | (defvar org-imenu-markers nil | |
14575 | "All markers currently used by Imenu.") | |
14576 | (make-variable-buffer-local 'org-imenu-markers) | |
14577 | ||
14578 | (defun org-imenu-new-marker (&optional pos) | |
14579 | "Return a new marker for use by Imenu, and remember the marker." | |
14580 | (let ((m (make-marker))) | |
14581 | (move-marker m (or pos (point))) | |
14582 | (push m org-imenu-markers) | |
14583 | m)) | |
14584 | ||
14585 | (defun org-imenu-get-tree () | |
14586 | "Produce the index for Imenu." | |
14587 | (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) | |
14588 | (setq org-imenu-markers nil) | |
14589 | (let* ((n org-imenu-depth) | |
14590 | (re (concat "^" outline-regexp)) | |
14591 | (subs (make-vector (1+ n) nil)) | |
14592 | (last-level 0) | |
14593 | m tree level head) | |
14594 | (save-excursion | |
14595 | (save-restriction | |
14596 | (widen) | |
14597 | (goto-char (point-max)) | |
14598 | (while (re-search-backward re nil t) | |
14599 | (setq level (org-reduced-level (funcall outline-level))) | |
14600 | (when (<= level n) | |
14601 | (looking-at org-complex-heading-regexp) | |
621f83e4 CD |
14602 | (setq head (org-link-display-format |
14603 | (org-match-string-no-properties 4)) | |
8c6fb58b CD |
14604 | m (org-imenu-new-marker)) |
14605 | (org-add-props head nil 'org-imenu-marker m 'org-imenu t) | |
14606 | (if (>= level last-level) | |
14607 | (push (cons head m) (aref subs level)) | |
14608 | (push (cons head (aref subs (1+ level))) (aref subs level)) | |
14609 | (loop for i from (1+ level) to n do (aset subs i nil))) | |
14610 | (setq last-level level))))) | |
14611 | (aref subs 1))) | |
14612 | ||
14613 | (eval-after-load "imenu" | |
14614 | '(progn | |
14615 | (add-hook 'imenu-after-jump-hook | |
2c3ad40d CD |
14616 | (lambda () |
14617 | (if (eq major-mode 'org-mode) | |
14618 | (org-show-context 'org-goto)))))) | |
8c6fb58b | 14619 | |
621f83e4 CD |
14620 | (defun org-link-display-format (link) |
14621 | "Replace a link with either the description, or the link target | |
14622 | if no description is present" | |
14623 | (save-match-data | |
14624 | (if (string-match org-bracket-link-analytic-regexp link) | |
14625 | (replace-match (or (match-string 5 link) | |
14626 | (concat (match-string 1 link) | |
14627 | (match-string 3 link))) | |
14628 | nil nil link) | |
14629 | link))) | |
14630 | ||
8c6fb58b CD |
14631 | ;; Speedbar support |
14632 | ||
20908596 CD |
14633 | (defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1) |
14634 | "Overlay marking the agenda restriction line in speedbar.") | |
14635 | (org-overlay-put org-speedbar-restriction-lock-overlay | |
14636 | 'face 'org-agenda-restriction-lock) | |
14637 | (org-overlay-put org-speedbar-restriction-lock-overlay | |
14638 | 'help-echo "Agendas are currently limited to this item.") | |
14639 | (org-detach-overlay org-speedbar-restriction-lock-overlay) | |
14640 | ||
8c6fb58b CD |
14641 | (defun org-speedbar-set-agenda-restriction () |
14642 | "Restrict future agenda commands to the location at point in speedbar. | |
14643 | To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." | |
14644 | (interactive) | |
20908596 | 14645 | (require 'org-agenda) |
8c6fb58b CD |
14646 | (let (p m tp np dir txt w) |
14647 | (cond | |
14648 | ((setq p (text-property-any (point-at-bol) (point-at-eol) | |
14649 | 'org-imenu t)) | |
14650 | (setq m (get-text-property p 'org-imenu-marker)) | |
14651 | (save-excursion | |
14652 | (save-restriction | |
14653 | (set-buffer (marker-buffer m)) | |
14654 | (goto-char m) | |
14655 | (org-agenda-set-restriction-lock 'subtree)))) | |
14656 | ((setq p (text-property-any (point-at-bol) (point-at-eol) | |
14657 | 'speedbar-function 'speedbar-find-file)) | |
14658 | (setq tp (previous-single-property-change | |
14659 | (1+ p) 'speedbar-function) | |
14660 | np (next-single-property-change | |
14661 | tp 'speedbar-function) | |
14662 | dir (speedbar-line-directory) | |
14663 | txt (buffer-substring-no-properties (or tp (point-min)) | |
14664 | (or np (point-max)))) | |
14665 | (save-excursion | |
14666 | (save-restriction | |
14667 | (set-buffer (find-file-noselect | |
14668 | (let ((default-directory dir)) | |
14669 | (expand-file-name txt)))) | |
14670 | (unless (org-mode-p) | |
14671 | (error "Cannot restrict to non-Org-mode file")) | |
14672 | (org-agenda-set-restriction-lock 'file)))) | |
14673 | (t (error "Don't know how to restrict Org-mode's agenda"))) | |
14674 | (org-move-overlay org-speedbar-restriction-lock-overlay | |
14675 | (point-at-bol) (point-at-eol)) | |
14676 | (setq current-prefix-arg nil) | |
14677 | (org-agenda-maybe-redo))) | |
14678 | ||
14679 | (eval-after-load "speedbar" | |
14680 | '(progn | |
14681 | (speedbar-add-supported-extension ".org") | |
14682 | (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) | |
14683 | (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) | |
14684 | (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) | |
14685 | (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | |
14686 | (add-hook 'speedbar-visiting-tag-hook | |
1ba1f458 | 14687 | (lambda () (and (org-mode-p) (org-show-context 'org-goto)))))) |
8c6fb58b CD |
14688 | |
14689 | ||
20908596 | 14690 | ;;; Fixes and Hacks for problems with other packages |
a3fbe8c4 CD |
14691 | |
14692 | ;; Make flyspell not check words in links, to not mess up our keymap | |
14693 | (defun org-mode-flyspell-verify () | |
14694 | "Don't let flyspell put overlays at active buttons." | |
14695 | (not (get-text-property (point) 'keymap))) | |
d3f4dbe8 | 14696 | |
b9661543 | 14697 | ;; Make `bookmark-jump' show the jump location if it was hidden. |
891f4676 | 14698 | (eval-after-load "bookmark" |
b9661543 CD |
14699 | '(if (boundp 'bookmark-after-jump-hook) |
14700 | ;; We can use the hook | |
14701 | (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) | |
14702 | ;; Hook not available, use advice | |
14703 | (defadvice bookmark-jump (after org-make-visible activate) | |
14704 | "Make the position visible." | |
14705 | (org-bookmark-jump-unhide)))) | |
14706 | ||
93b62de8 CD |
14707 | ;; Make sure saveplace show the location if it was hidden |
14708 | (eval-after-load "saveplace" | |
14709 | '(defadvice save-place-find-file-hook (after org-make-visible activate) | |
14710 | "Make the position visible." | |
14711 | (org-bookmark-jump-unhide))) | |
14712 | ||
b9661543 CD |
14713 | (defun org-bookmark-jump-unhide () |
14714 | "Unhide the current position, to show the bookmark location." | |
b928f99a | 14715 | (and (org-mode-p) |
b9661543 CD |
14716 | (or (org-invisible-p) |
14717 | (save-excursion (goto-char (max (point-min) (1- (point)))) | |
14718 | (org-invisible-p))) | |
3278a016 | 14719 | (org-show-context 'bookmark-jump))) |
891f4676 | 14720 | |
3278a016 CD |
14721 | ;; Make session.el ignore our circular variable |
14722 | (eval-after-load "session" | |
14723 | '(add-to-list 'session-globals-exclude 'org-mark-ring)) | |
0fee8d6e | 14724 | |
d3f4dbe8 | 14725 | ;;;; Experimental code |
b928f99a | 14726 | |
a3fbe8c4 CD |
14727 | (defun org-closed-in-range () |
14728 | "Sparse tree of items closed in a certain time range. | |
8c6fb58b | 14729 | Still experimental, may disappear in the future." |
a3fbe8c4 CD |
14730 | (interactive) |
14731 | ;; Get the time interval from the user. | |
14732 | (let* ((time1 (time-to-seconds | |
14733 | (org-read-date nil 'to-time nil "Starting date: "))) | |
14734 | (time2 (time-to-seconds | |
14735 | (org-read-date nil 'to-time nil "End date:"))) | |
14736 | ;; callback function | |
14737 | (callback (lambda () | |
14738 | (let ((time | |
14739 | (time-to-seconds | |
14740 | (apply 'encode-time | |
14741 | (org-parse-time-string | |
14742 | (match-string 1)))))) | |
14743 | ;; check if time in interval | |
14744 | (and (>= time time1) (<= time time2)))))) | |
14745 | ;; make tree, check each match with the callback | |
14746 | (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) | |
d3f4dbe8 | 14747 | |
2a57416f | 14748 | |
d3f4dbe8 | 14749 | ;;;; Finish up |
c44f0d75 | 14750 | |
f462ee2c SM |
14751 | (provide 'org) |
14752 | ||
14753 | (run-hooks 'org-load-hook) | |
14754 | ||
14755 | ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd | |
7d58338e | 14756 | |
b349f79f | 14757 | ;;; org.el ends here |