Commit | Line | Data |
---|---|---|
a3fbe8c4 | 1 | ;;; org.el --- Outline-based notes management and organizer |
791d856f | 2 | ;; Carstens outline-mode for keeping track of everything. |
114f9c96 | 3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
1e4f816a | 4 | ;; Free Software Foundation, Inc. |
ef943dba | 5 | ;; |
0b8568f5 | 6 | ;; Author: Carsten Dominik <carsten at orgmode dot org> |
4da1a99d | 7 | ;; Keywords: outlines, hypermedia, calendar, wp |
0b8568f5 | 8 | ;; Homepage: http://orgmode.org |
5dec9555 | 9 | ;; Version: 6.33x |
ef943dba | 10 | ;; |
359ec616 | 11 | ;; This file is part of GNU Emacs. |
ef943dba | 12 | ;; |
b1fc2b50 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
359ec616 | 14 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
891f4676 | 17 | |
359ec616 RS |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
891f4676 RS |
22 | |
23 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
891f4676 | 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
891f4676 RS |
26 | ;; |
27 | ;;; Commentary: | |
28 | ;; | |
29 | ;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing | |
30 | ;; project planning with a fast and effective plain-text system. | |
31 | ;; | |
f85d958a CD |
32 | ;; Org-mode develops organizational tasks around NOTES files that contain |
33 | ;; information about projects as plain text. Org-mode is implemented on | |
34 | ;; top of outline-mode, which makes it possible to keep the content of | |
35 | ;; large files well structured. Visibility cycling and structure editing | |
36 | ;; help to work with the tree. Tables are easily created with a built-in | |
37 | ;; table editor. Org-mode supports ToDo items, deadlines, time stamps, | |
38 | ;; and scheduling. It dynamically compiles entries into an agenda that | |
39 | ;; utilizes and smoothly integrates much of the Emacs calendar and diary. | |
40 | ;; Plain text URL-like links connect to websites, emails, Usenet | |
41 | ;; messages, BBDB entries, and any files related to the projects. For | |
42 | ;; printing and sharing of notes, an Org-mode file can be exported as a | |
43 | ;; structured ASCII file, as HTML, or (todo and agenda items only) as an | |
44 | ;; iCalendar file. It can also serve as a publishing tool for a set of | |
45 | ;; linked webpages. | |
46 | ;; | |
3278a016 CD |
47 | ;; Installation and Activation |
48 | ;; --------------------------- | |
49 | ;; See the corresponding sections in the manual at | |
891f4676 | 50 | ;; |
0b8568f5 | 51 | ;; http://orgmode.org/org.html#Installation |
891f4676 RS |
52 | ;; |
53 | ;; Documentation | |
54 | ;; ------------- | |
eb2f9c59 CD |
55 | ;; The documentation of Org-mode can be found in the TeXInfo file. The |
56 | ;; distribution also contains a PDF version of it. At the homepage of | |
57 | ;; Org-mode, you can read the same text online as HTML. There is also an | |
7a368970 CD |
58 | ;; excellent reference card made by Philip Rooke. This card can be found |
59 | ;; in the etc/ directory of Emacs 22. | |
891f4676 | 60 | ;; |
d3f4dbe8 | 61 | ;; A list of recent changes can be found at |
d5098885 | 62 | ;; http://orgmode.org/Changes.html |
0fee8d6e | 63 | ;; |
891f4676 RS |
64 | ;;; Code: |
65 | ||
20908596 CD |
66 | (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param |
67 | (defvar org-table-formula-constants-local nil | |
68 | "Local version of `org-table-formula-constants'.") | |
69 | (make-variable-buffer-local 'org-table-formula-constants-local) | |
70 | ||
d3f4dbe8 CD |
71 | ;;;; Require other packages |
72 | ||
edd21304 | 73 | (eval-when-compile |
ab27a4a0 | 74 | (require 'cl) |
e31ececb | 75 | (require 'gnus-sum) |
ab27a4a0 | 76 | (require 'calendar)) |
0fee8d6e CD |
77 | ;; For XEmacs, noutline is not yet provided by outline.el, so arrange for |
78 | ;; the file noutline.el being loaded. | |
79 | (if (featurep 'xemacs) (condition-case nil (require 'noutline))) | |
80 | ;; We require noutline, which might be provided in outline.el | |
81 | (require 'outline) (require 'noutline) | |
82 | ;; Other stuff we need. | |
891f4676 | 83 | (require 'time-date) |
8c6fb58b | 84 | (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) |
891f4676 RS |
85 | (require 'easymenu) |
86 | ||
20908596 CD |
87 | (require 'org-macs) |
88 | (require 'org-compat) | |
89 | (require 'org-faces) | |
621f83e4 | 90 | (require 'org-list) |
c8d0cf5c | 91 | (require 'org-src) |
0bd48b37 | 92 | (require 'org-footnote) |
20908596 | 93 | |
d3f4dbe8 | 94 | ;;;; Customization variables |
891f4676 | 95 | |
d3f4dbe8 CD |
96 | ;;; Version |
97 | ||
5dec9555 | 98 | (defconst org-version "6.33x" |
891f4676 | 99 | "The version number of the file org.el.") |
2a57416f CD |
100 | |
101 | (defun org-version (&optional here) | |
102 | "Show the org-mode version in the echo area. | |
103 | With prefix arg HERE, insert it at point." | |
104 | (interactive "P") | |
8bfe682a CD |
105 | (let* ((origin default-directory) |
106 | (version org-version) | |
54a0dee5 CD |
107 | (git-version) |
108 | (dir (concat (file-name-directory (locate-library "org")) "../" ))) | |
8bfe682a CD |
109 | (when (and (file-exists-p (expand-file-name ".git" dir)) |
110 | (executable-find "git")) | |
111 | (unwind-protect | |
112 | (progn | |
113 | (cd dir) | |
114 | (when (eql 0 (shell-command "git describe --abbrev=4 HEAD")) | |
81ad75af | 115 | (with-current-buffer "*Shell Command Output*" |
54a0dee5 | 116 | (goto-char (point-min)) |
8bfe682a CD |
117 | (setq git-version (buffer-substring (point) (point-at-eol)))) |
118 | (subst-char-in-string ?- ?. git-version t) | |
119 | (when (string-match "\\S-" | |
120 | (shell-command-to-string | |
121 | "git diff-index --name-only HEAD --")) | |
122 | (setq git-version (concat git-version ".dirty"))) | |
123 | (setq version (concat version " (" git-version ")")))) | |
124 | (cd origin))) | |
54a0dee5 CD |
125 | (setq version (format "Org-mode version %s" version)) |
126 | (if here (insert version)) | |
8bfe682a | 127 | (message version))) |
891f4676 | 128 | |
d3f4dbe8 | 129 | ;;; Compatibility constants |
38f8646b | 130 | |
d3f4dbe8 CD |
131 | ;;; The custom variables |
132 | ||
891f4676 | 133 | (defgroup org nil |
b0a10108 | 134 | "Outline-based notes management and organizer." |
891f4676 RS |
135 | :tag "Org" |
136 | :group 'outlines | |
137 | :group 'hypermedia | |
138 | :group 'calendar) | |
139 | ||
8bfe682a CD |
140 | (defcustom org-mode-hook nil |
141 | "Mode hook for Org-mode, run after the mode was turned on." | |
142 | :group 'org | |
143 | :type 'hook) | |
144 | ||
2a57416f CD |
145 | (defcustom org-load-hook nil |
146 | "Hook that is run after org.el has been loaded." | |
147 | :group 'org | |
148 | :type 'hook) | |
149 | ||
20908596 CD |
150 | (defvar org-modules) ; defined below |
151 | (defvar org-modules-loaded nil | |
152 | "Have the modules been loaded already?") | |
153 | ||
154 | (defun org-load-modules-maybe (&optional force) | |
ce4fdcb9 | 155 | "Load all extensions listed in `org-modules'." |
20908596 CD |
156 | (when (or force (not org-modules-loaded)) |
157 | (mapc (lambda (ext) | |
158 | (condition-case nil (require ext) | |
159 | (error (message "Problems while trying to load feature `%s'" ext)))) | |
160 | org-modules) | |
161 | (setq org-modules-loaded t))) | |
162 | ||
163 | (defun org-set-modules (var value) | |
164 | "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." | |
165 | (set var value) | |
166 | (when (featurep 'org) | |
167 | (org-load-modules-maybe 'force))) | |
168 | ||
6dc30f44 CD |
169 | (when (org-bound-and-true-p org-modules) |
170 | (let ((a (member 'org-infojs org-modules))) | |
171 | (and a (setcar a 'org-jsinfo)))) | |
172 | ||
ff4be292 | 173 | (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 | 174 | "Modules that should always be loaded together with org.el. |
efc054e6 | 175 | If a description starts with <C>, the file is not part of Emacs |
20908596 CD |
176 | and loading it will require that you have downloaded and properly installed |
177 | the org-mode distribution. | |
178 | ||
179 | You can also use this system to load external packages (i.e. neither Org | |
8d642074 | 180 | core modules, nor modules from the CONTRIB directory). Just add symbols |
efc054e6 | 181 | to the end of the list. If the package is called org-xyz.el, then you need |
20908596 CD |
182 | to add the symbol `xyz', and the package must have a call to |
183 | ||
184 | (provide 'org-xyz)" | |
15841868 | 185 | :group 'org |
20908596 CD |
186 | :set 'org-set-modules |
187 | :type | |
188 | '(set :greedy t | |
189 | (const :tag " bbdb: Links to BBDB entries" org-bbdb) | |
190 | (const :tag " bibtex: Links to BibTeX entries" org-bibtex) | |
8d642074 | 191 | (const :tag " crypt: Encryption of subtrees" org-crypt) |
20908596 | 192 | (const :tag " gnus: Links to GNUS folders/messages" org-gnus) |
db55f368 | 193 | (const :tag " id: Global IDs for identifying entries" org-id) |
20908596 | 194 | (const :tag " info: Links to Info nodes" org-info) |
6dc30f44 | 195 | (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo) |
8bfe682a | 196 | (const :tag " habit: Track your consistency with habits" org-habit) |
c8d0cf5c | 197 | (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) |
20908596 CD |
198 | (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) |
199 | (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message) | |
200 | (const :tag " mew Links to Mew folders/messages" org-mew) | |
201 | (const :tag " mhe: Links to MHE folders/messages" org-mhe) | |
c8d0cf5c | 202 | (const :tag " protocol: Intercept calls from emacsclient" org-protocol) |
20908596 CD |
203 | (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) |
204 | (const :tag " vm: Links to VM folders/messages" org-vm) | |
205 | (const :tag " wl: Links to Wanderlust folders/messages" org-wl) | |
8bfe682a | 206 | (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) |
20908596 CD |
207 | (const :tag " mouse: Additional mouse support" org-mouse) |
208 | ||
209 | (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) | |
8bfe682a | 210 | (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) |
c8d0cf5c CD |
211 | (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) |
212 | (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) | |
213 | (const :tag "C collector: Collect properties into tables" org-collector) | |
8d642074 | 214 | (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) |
8bfe682a | 215 | (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) |
b349f79f | 216 | (const :tag "C eval: Include command output as text" org-eval) |
ce4fdcb9 | 217 | (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) |
8bfe682a | 218 | (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) |
c8d0cf5c | 219 | (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex) |
8bfe682a | 220 | (const :tag "C git-link: Provide org links to specific file version" org-git-link) |
8d642074 CD |
221 | (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) |
222 | ||
8bfe682a | 223 | (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice) |
8d642074 | 224 | |
8bfe682a CD |
225 | (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) |
226 | (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) | |
227 | (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) | |
c8d0cf5c | 228 | (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) |
20908596 | 229 | (const :tag "C man: Support for links to manpages in Org-mode" org-man) |
b349f79f | 230 | (const :tag "C mtags: Support for muse-like tags" org-mtags) |
20908596 | 231 | (const :tag "C panel: Simple routines for us with bad memory" org-panel) |
c8d0cf5c | 232 | (const :tag "C R: Computation using the R language" org-R) |
8bfe682a | 233 | (const :tag "C registry: A registry for Org-mode links" org-registry) |
20908596 CD |
234 | (const :tag "C org2rem: Convert org appointments into reminders" org2rem) |
235 | (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) | |
c8d0cf5c | 236 | (const :tag "C special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) |
20908596 | 237 | (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) |
c8d0cf5c | 238 | (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) |
8bfe682a | 239 | (const :tag "C track: Keep up with Org-mode development" org-track) |
20908596 CD |
240 | (repeat :tag "External packages" :inline t (symbol :tag "Package")))) |
241 | ||
65c439fd CD |
242 | (defcustom org-support-shift-select nil |
243 | "Non-nil means, make shift-cursor commands select text when possible. | |
244 | ||
245 | In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start | |
246 | selecting a region, or enlarge thusly regions started in this way. | |
247 | In Org-mode, in special contexts, these same keys are used for other | |
248 | purposes, important enough to compete with shift selection. Org tries | |
249 | to balance these needs by supporting `shift-select-mode' outside these | |
250 | special contexts, under control of this variable. | |
251 | ||
252 | The default of this variable is nil, to avoid confusing behavior. Shifted | |
253 | cursor keys will then execute Org commands in the following contexts: | |
254 | - on a headline, changing TODO state (left/right) and priority (up/down) | |
255 | - on a time stamp, changing the time | |
256 | - in a plain list item, changing the bullet type | |
257 | - in a property definition line, switching between allowed values | |
258 | - in the BEGIN line of a clock table (changing the time block). | |
259 | Outside these contexts, the commands will throw an error. | |
260 | ||
261 | When this variable is t and the cursor is not in a special context, | |
262 | Org-mode will support shift-selection for making and enlarging regions. | |
263 | To make this more effective, the bullet cycling will no longer happen | |
264 | anywhere in an item line, but only if the cursor is exactly on the bullet. | |
265 | ||
266 | If you set this variable to the symbol `always', then the keys | |
267 | will not be special in headlines, property lines, and item lines, to make | |
268 | shift selection work there as well. If this is what you want, you can | |
269 | use the following alternative commands: `C-c C-t' and `C-c ,' to | |
270 | change TODO state and priority, `C-u C-u C-c C-t' can be used to switch | |
271 | TODO sets, `C-c -' to cycle item bullet types, and properties can be | |
272 | edited by hand or in column view. | |
273 | ||
274 | However, when the cursor is on a timestamp, shift-cursor commands | |
275 | will still edit the time stamp - this is just too good to give up. | |
276 | ||
277 | XEmacs user should have this variable set to nil, because shift-select-mode | |
278 | is Emacs 23 only." | |
279 | :group 'org | |
280 | :type '(choice | |
281 | (const :tag "Never" nil) | |
282 | (const :tag "When outside special context" t) | |
283 | (const :tag "Everywhere except timestamps" always))) | |
15841868 | 284 | |
891f4676 RS |
285 | (defgroup org-startup nil |
286 | "Options concerning startup of Org-mode." | |
287 | :tag "Org Startup" | |
288 | :group 'org) | |
289 | ||
290 | (defcustom org-startup-folded t | |
ef943dba CD |
291 | "Non-nil means, entering Org-mode will switch to OVERVIEW. |
292 | This can also be configured on a per-file basis by adding one of | |
293 | the following lines anywhere in the buffer: | |
294 | ||
8d642074 CD |
295 | #+STARTUP: fold (or `overview', this is equivalent) |
296 | #+STARTUP: nofold (or `showall', this is equivalent) | |
297 | #+STARTUP: content | |
298 | #+STARTUP: showeverything" | |
891f4676 | 299 | :group 'org-startup |
35fb9989 | 300 | :type '(choice |
c8d16429 CD |
301 | (const :tag "nofold: show all" nil) |
302 | (const :tag "fold: overview" t) | |
8d642074 CD |
303 | (const :tag "content: all headlines" content) |
304 | (const :tag "show everything, even drawers" showeverything))) | |
891f4676 RS |
305 | |
306 | (defcustom org-startup-truncated t | |
307 | "Non-nil means, entering Org-mode will set `truncate-lines'. | |
308 | This is useful since some lines containing links can be very long and | |
309 | uninteresting. Also tables look terrible when wrapped." | |
310 | :group 'org-startup | |
311 | :type 'boolean) | |
312 | ||
c8d0cf5c CD |
313 | (defcustom org-startup-indented nil |
314 | "Non-nil means, turn on `org-indent-mode' on startup. | |
315 | This can also be configured on a per-file basis by adding one of | |
316 | the following lines anywhere in the buffer: | |
317 | ||
318 | #+STARTUP: indent | |
319 | #+STARTUP: noindent" | |
320 | :group 'org-structure | |
321 | :type '(choice | |
322 | (const :tag "Not" nil) | |
323 | (const :tag "Globally (slow on startup in large files)" t))) | |
324 | ||
ab27a4a0 CD |
325 | (defcustom org-startup-align-all-tables nil |
326 | "Non-nil means, align all tables when visiting a file. | |
327 | This is useful when the column width in tables is forced with <N> cookies | |
4146eb16 CD |
328 | in table fields. Such tables will look correct only after the first re-align. |
329 | This can also be configured on a per-file basis by adding one of | |
330 | the following lines anywhere in the buffer: | |
331 | #+STARTUP: align | |
332 | #+STARTUP: noalign" | |
ab27a4a0 CD |
333 | :group 'org-startup |
334 | :type 'boolean) | |
335 | ||
c52dbe8c | 336 | (defcustom org-insert-mode-line-in-empty-file nil |
891f4676 | 337 | "Non-nil means insert the first line setting Org-mode in empty files. |
35fb9989 | 338 | When the function `org-mode' is called interactively in an empty file, this |
891f4676 RS |
339 | normally means that the file name does not automatically trigger Org-mode. |
340 | To ensure that the file will always be in Org-mode in the future, a | |
35fb9989 CD |
341 | line enforcing Org-mode will be inserted into the buffer, if this option |
342 | has been set." | |
891f4676 RS |
343 | :group 'org-startup |
344 | :type 'boolean) | |
345 | ||
a3fbe8c4 CD |
346 | (defcustom org-replace-disputed-keys nil |
347 | "Non-nil means use alternative key bindings for some keys. | |
348 | Org-mode uses S-<cursor> keys for changing timestamps and priorities. | |
c8d0cf5c CD |
349 | These keys are also used by other packages like shift-selection-mode' |
350 | \(built into Emacs 23), `CUA-mode' or `windmove.el'. | |
a3fbe8c4 CD |
351 | If you want to use Org-mode together with one of these other modes, |
352 | or more generally if you would like to move some Org-mode commands to | |
353 | other keys, set this variable and configure the keys with the variable | |
ab27a4a0 | 354 | `org-disputed-keys'. |
891f4676 | 355 | |
d3f4dbe8 CD |
356 | This option is only relevant at load-time of Org-mode, and must be set |
357 | *before* org.el is loaded. Changing it requires a restart of Emacs to | |
358 | become effective." | |
ab27a4a0 CD |
359 | :group 'org-startup |
360 | :type 'boolean) | |
891f4676 | 361 | |
621f83e4 CD |
362 | (defcustom org-use-extra-keys nil |
363 | "Non-nil means use extra key sequence definitions for certain | |
364 | commands. This happens automatically if you run XEmacs or if | |
365 | window-system is nil. This variable lets you do the same | |
366 | manually. You must set it before loading org. | |
367 | ||
368 | Example: on Carbon Emacs 22 running graphically, with an external | |
369 | keyboard on a Powerbook, the default way of setting M-left might | |
370 | not work for either Alt or ESC. Setting this variable will make | |
371 | it work for ESC." | |
372 | :group 'org-startup | |
373 | :type 'boolean) | |
374 | ||
a3fbe8c4 CD |
375 | (if (fboundp 'defvaralias) |
376 | (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)) | |
377 | ||
378 | (defcustom org-disputed-keys | |
379 | '(([(shift up)] . [(meta p)]) | |
380 | ([(shift down)] . [(meta n)]) | |
381 | ([(shift left)] . [(meta -)]) | |
382 | ([(shift right)] . [(meta +)]) | |
383 | ([(control shift right)] . [(meta shift +)]) | |
384 | ([(control shift left)] . [(meta shift -)])) | |
ab27a4a0 | 385 | "Keys for which Org-mode and other modes compete. |
a3fbe8c4 CD |
386 | This is an alist, cars are the default keys, second element specifies |
387 | the alternative to use when `org-replace-disputed-keys' is t. | |
388 | ||
389 | Keys can be specified in any syntax supported by `define-key'. | |
390 | The value of this option takes effect only at Org-mode's startup, | |
391 | therefore you'll have to restart Emacs to apply it after changing." | |
392 | :group 'org-startup | |
393 | :type 'alist) | |
ab27a4a0 CD |
394 | |
395 | (defun org-key (key) | |
a3fbe8c4 CD |
396 | "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. |
397 | Or return the original if not disputed." | |
398 | (if org-replace-disputed-keys | |
399 | (let* ((nkey (key-description key)) | |
400 | (x (org-find-if (lambda (x) | |
401 | (equal (key-description (car x)) nkey)) | |
402 | org-disputed-keys))) | |
403 | (if x (cdr x) key)) | |
404 | key)) | |
405 | ||
406 | (defun org-find-if (predicate seq) | |
407 | (catch 'exit | |
408 | (while seq | |
409 | (if (funcall predicate (car seq)) | |
410 | (throw 'exit (car seq)) | |
411 | (pop seq))))) | |
412 | ||
413 | (defun org-defkey (keymap key def) | |
414 | "Define a key, possibly translated, as returned by `org-key'." | |
415 | (define-key keymap (org-key key) def)) | |
ab27a4a0 | 416 | |
8c6fb58b | 417 | (defcustom org-ellipsis nil |
ab27a4a0 CD |
418 | "The ellipsis to use in the Org-mode outline. |
419 | When nil, just use the standard three dots. When a string, use that instead, | |
33306645 | 420 | When a face, use the standard 3 dots, but with the specified face. |
374585c9 | 421 | The change affects only Org-mode (which will then use its own display table). |
ab27a4a0 CD |
422 | Changing this requires executing `M-x org-mode' in a buffer to become |
423 | effective." | |
424 | :group 'org-startup | |
425 | :type '(choice (const :tag "Default" nil) | |
374585c9 | 426 | (face :tag "Face" :value org-warning) |
ab27a4a0 CD |
427 | (string :tag "String" :value "...#"))) |
428 | ||
429 | (defvar org-display-table nil | |
430 | "The display table for org-mode, in case `org-ellipsis' is non-nil.") | |
431 | ||
432 | (defgroup org-keywords nil | |
433 | "Keywords in Org-mode." | |
434 | :tag "Org Keywords" | |
435 | :group 'org) | |
891f4676 RS |
436 | |
437 | (defcustom org-deadline-string "DEADLINE:" | |
438 | "String to mark deadline entries. | |
439 | A deadline is this string, followed by a time stamp. Should be a word, | |
440 | terminated by a colon. You can insert a schedule keyword and | |
441 | a timestamp with \\[org-deadline]. | |
442 | Changes become only effective after restarting Emacs." | |
443 | :group 'org-keywords | |
444 | :type 'string) | |
445 | ||
446 | (defcustom org-scheduled-string "SCHEDULED:" | |
447 | "String to mark scheduled TODO entries. | |
448 | A schedule is this string, followed by a time stamp. Should be a word, | |
449 | terminated by a colon. You can insert a schedule keyword and | |
450 | a timestamp with \\[org-schedule]. | |
451 | Changes become only effective after restarting Emacs." | |
452 | :group 'org-keywords | |
453 | :type 'string) | |
454 | ||
7ac93e3c | 455 | (defcustom org-closed-string "CLOSED:" |
b0a10108 | 456 | "String used as the prefix for timestamps logging closing a TODO entry." |
7ac93e3c CD |
457 | :group 'org-keywords |
458 | :type 'string) | |
459 | ||
edd21304 CD |
460 | (defcustom org-clock-string "CLOCK:" |
461 | "String used as prefix for timestamps clocking work hours on an item." | |
462 | :group 'org-keywords | |
463 | :type 'string) | |
464 | ||
891f4676 RS |
465 | (defcustom org-comment-string "COMMENT" |
466 | "Entries starting with this keyword will never be exported. | |
467 | An entry can be toggled between COMMENT and normal with | |
468 | \\[org-toggle-comment]. | |
469 | Changes become only effective after restarting Emacs." | |
470 | :group 'org-keywords | |
471 | :type 'string) | |
472 | ||
b9661543 CD |
473 | (defcustom org-quote-string "QUOTE" |
474 | "Entries starting with this keyword will be exported in fixed-width font. | |
475 | Quoting applies only to the text in the entry following the headline, and does | |
476 | not extend beyond the next headline, even if that is lower level. | |
477 | An entry can be toggled between QUOTE and normal with | |
b0a10108 | 478 | \\[org-toggle-fixed-width-section]." |
b9661543 CD |
479 | :group 'org-keywords |
480 | :type 'string) | |
481 | ||
a3fbe8c4 | 482 | (defconst org-repeat-re |
8bfe682a | 483 | "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)" |
d3f4dbe8 CD |
484 | "Regular expression for specifying repeated events. |
485 | After a match, group 1 contains the repeat expression.") | |
486 | ||
ab27a4a0 CD |
487 | (defgroup org-structure nil |
488 | "Options concerning the general structure of Org-mode files." | |
489 | :tag "Org Structure" | |
490 | :group 'org) | |
634a7d0b | 491 | |
d3f4dbe8 CD |
492 | (defgroup org-reveal-location nil |
493 | "Options about how to make context of a location visible." | |
494 | :tag "Org Reveal Location" | |
495 | :group 'org-structure) | |
496 | ||
8c6fb58b CD |
497 | (defconst org-context-choice |
498 | '(choice | |
499 | (const :tag "Always" t) | |
500 | (const :tag "Never" nil) | |
501 | (repeat :greedy t :tag "Individual contexts" | |
502 | (cons | |
503 | (choice :tag "Context" | |
504 | (const agenda) | |
505 | (const org-goto) | |
506 | (const occur-tree) | |
507 | (const tags-tree) | |
508 | (const link-search) | |
509 | (const mark-goto) | |
510 | (const bookmark-jump) | |
511 | (const isearch) | |
512 | (const default)) | |
513 | (boolean)))) | |
514 | "Contexts for the reveal options.") | |
515 | ||
d3f4dbe8 CD |
516 | (defcustom org-show-hierarchy-above '((default . t)) |
517 | "Non-nil means, show full hierarchy when revealing a location. | |
518 | Org-mode often shows locations in an org-mode file which might have | |
519 | been invisible before. When this is set, the hierarchy of headings | |
520 | above the exposed location is shown. | |
521 | Turning this off for example for sparse trees makes them very compact. | |
522 | Instead of t, this can also be an alist specifying this option for different | |
523 | contexts. Valid contexts are | |
524 | agenda when exposing an entry from the agenda | |
525 | org-goto when using the command `org-goto' on key C-c C-j | |
526 | occur-tree when using the command `org-occur' on key C-c / | |
527 | tags-tree when constructing a sparse tree based on tags matches | |
528 | link-search when exposing search matches associated with a link | |
529 | mark-goto when exposing the jump goal of a mark | |
530 | bookmark-jump when exposing a bookmark location | |
531 | isearch when exiting from an incremental search | |
532 | default default for all contexts not set explicitly" | |
533 | :group 'org-reveal-location | |
8c6fb58b | 534 | :type org-context-choice) |
d3f4dbe8 | 535 | |
a3fbe8c4 | 536 | (defcustom org-show-following-heading '((default . nil)) |
d3f4dbe8 CD |
537 | "Non-nil means, show following heading when revealing a location. |
538 | Org-mode often shows locations in an org-mode file which might have | |
539 | been invisible before. When this is set, the heading following the | |
540 | match is shown. | |
541 | Turning this off for example for sparse trees makes them very compact, | |
542 | but makes it harder to edit the location of the match. In such a case, | |
543 | use the command \\[org-reveal] to show more context. | |
544 | Instead of t, this can also be an alist specifying this option for different | |
545 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
546 | :group 'org-reveal-location | |
8c6fb58b | 547 | :type org-context-choice) |
d3f4dbe8 CD |
548 | |
549 | (defcustom org-show-siblings '((default . nil) (isearch t)) | |
550 | "Non-nil means, show all sibling heading when revealing a location. | |
551 | Org-mode often shows locations in an org-mode file which might have | |
552 | been invisible before. When this is set, the sibling of the current entry | |
553 | heading are all made visible. If `org-show-hierarchy-above' is t, | |
554 | the same happens on each level of the hierarchy above the current entry. | |
555 | ||
556 | By default this is on for the isearch context, off for all other contexts. | |
557 | Turning this off for example for sparse trees makes them very compact, | |
558 | but makes it harder to edit the location of the match. In such a case, | |
559 | use the command \\[org-reveal] to show more context. | |
560 | Instead of t, this can also be an alist specifying this option for different | |
561 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
562 | :group 'org-reveal-location | |
8c6fb58b CD |
563 | :type org-context-choice) |
564 | ||
565 | (defcustom org-show-entry-below '((default . nil)) | |
566 | "Non-nil means, show the entry below a headline when revealing a location. | |
567 | Org-mode often shows locations in an org-mode file which might have | |
568 | been invisible before. When this is set, the text below the headline that is | |
569 | exposed is also shown. | |
570 | ||
571 | By default this is off for all contexts. | |
572 | Instead of t, this can also be an alist specifying this option for different | |
573 | contexts. See `org-show-hierarchy-above' for valid contexts." | |
574 | :group 'org-reveal-location | |
575 | :type org-context-choice) | |
d3f4dbe8 | 576 | |
20908596 CD |
577 | (defcustom org-indirect-buffer-display 'other-window |
578 | "How should indirect tree buffers be displayed? | |
579 | This applies to indirect buffers created with the commands | |
580 | \\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. | |
581 | Valid values are: | |
582 | current-window Display in the current window | |
583 | other-window Just display in another window. | |
584 | dedicated-frame Create one new frame, and re-use it each time. | |
585 | new-frame Make a new frame each time. Note that in this case | |
586 | previously-made indirect buffers are kept, and you need to | |
587 | kill these buffers yourself." | |
588 | :group 'org-structure | |
589 | :group 'org-agenda-windows | |
590 | :type '(choice | |
591 | (const :tag "In current window" current-window) | |
592 | (const :tag "In current frame, other window" other-window) | |
593 | (const :tag "Each time a new frame" new-frame) | |
594 | (const :tag "One dedicated frame" dedicated-frame))) | |
595 | ||
8bfe682a | 596 | (defcustom org-use-speed-commands nil |
1bcdebed CD |
597 | "Non-nil means, activate single letter commands at beginning of a headline. |
598 | This may also be a function to test for appropriate locations where speed | |
599 | commands should be active." | |
8bfe682a | 600 | :group 'org-structure |
1bcdebed CD |
601 | :type '(choice |
602 | (const :tag "Never" nil) | |
603 | (const :tag "At beginning of headline stars" t) | |
604 | (function))) | |
8bfe682a CD |
605 | |
606 | (defcustom org-speed-commands-user nil | |
607 | "Alist of additional speed commands. | |
608 | This list will be checked before `org-speed-commands-default' | |
609 | when the variable `org-use-speed-commands' is non-nil | |
610 | and when the cursor is at the beginning of a headline. | |
611 | The car if each entry is a string with a single letter, which must | |
612 | be assigned to `self-insert-command' in the global map. | |
613 | The cdr is either a command to be called interactively, a function | |
1bcdebed CD |
614 | to be called, or a form to be evaluated. |
615 | An entry that is just a list with a single string will be interpreted | |
616 | as a descriptive headline that will be added when listing the speed | |
617 | copmmands in the Help buffer using the `?' speed command." | |
8bfe682a | 618 | :group 'org-structure |
1bcdebed CD |
619 | :type '(repeat :value ("k" . ignore) |
620 | (choice :value ("k" . ignore) | |
621 | (list :tag "Descriptive Headline" (string :tag "Headline")) | |
622 | (cons :tag "Letter and Command" | |
623 | (string :tag "Command letter") | |
624 | (choice | |
625 | (function) | |
626 | (sexp)))))) | |
8bfe682a | 627 | |
ab27a4a0 CD |
628 | (defgroup org-cycle nil |
629 | "Options concerning visibility cycling in Org-mode." | |
630 | :tag "Org Cycle" | |
631 | :group 'org-structure) | |
634a7d0b | 632 | |
c8d0cf5c CD |
633 | (defcustom org-cycle-skip-children-state-if-no-children t |
634 | "Non-nil means, skip CHILDREN state in entries that don't have any." | |
635 | :group 'org-cycle | |
636 | :type 'boolean) | |
637 | ||
638 | (defcustom org-cycle-max-level nil | |
639 | "Maximum level which should still be subject to visibility cycling. | |
640 | Levels higher than this will, for cycling, be treated as text, not a headline. | |
641 | When `org-odd-levels-only' is set, a value of N in this variable actually | |
642 | means 2N-1 stars as the limiting headline. | |
643 | When nil, cycle all levels. | |
644 | Note that the limiting level of cycling is also influenced by | |
645 | `org-inlinetask-min-level'. When `org-cycle-max-level' is not set but | |
646 | `org-inlinetask-min-level' is, cycling will be limited to levels one less | |
647 | than its value." | |
648 | :group 'org-cycle | |
649 | :type '(choice | |
650 | (const :tag "No limit" nil) | |
651 | (integer :tag "Maximum level"))) | |
652 | ||
653 | (defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK") | |
5152b597 CD |
654 | "Names of drawers. Drawers are not opened by cycling on the headline above. |
655 | Drawers only open with a TAB on the drawer line itself. A drawer looks like | |
656 | this: | |
657 | :DRAWERNAME: | |
658 | ..... | |
38f8646b CD |
659 | :END: |
660 | The drawer \"PROPERTIES\" is special for capturing properties through | |
03f3cf35 JW |
661 | the property API. |
662 | ||
663 | Drawers can be defined on the per-file basis with a line like: | |
664 | ||
665 | #+DRAWERS: HIDDEN STATE PROPERTIES" | |
5152b597 | 666 | :group 'org-structure |
c8d0cf5c | 667 | :group 'org-cycle |
5152b597 CD |
668 | :type '(repeat (string :tag "Drawer Name"))) |
669 | ||
c8d0cf5c CD |
670 | (defcustom org-hide-block-startup nil |
671 | "Non-nil means, , entering Org-mode will fold all blocks. | |
672 | This can also be set in on a per-file basis with | |
673 | ||
674 | #+STARTUP: hideblocks | |
675 | #+STARTUP: showblocks" | |
676 | :group 'org-startup | |
677 | :group 'org-cycle | |
678 | :type 'boolean) | |
679 | ||
374585c9 | 680 | (defcustom org-cycle-global-at-bob nil |
4b3a9ba7 CD |
681 | "Cycle globally if cursor is at beginning of buffer and not at a headline. |
682 | This makes it possible to do global cycling without having to use S-TAB or | |
683 | C-u TAB. For this special case to work, the first line of the buffer | |
20106e31 | 684 | must not be a headline - it may be empty or some other text. When used in |
4b3a9ba7 CD |
685 | this way, `org-cycle-hook' is disables temporarily, to make sure the |
686 | cursor stays at the beginning of the buffer. | |
687 | When this option is nil, don't do anything special at the beginning | |
688 | of the buffer." | |
689 | :group 'org-cycle | |
690 | :type 'boolean) | |
691 | ||
8bfe682a CD |
692 | (defcustom org-cycle-level-after-item/entry-creation t |
693 | "Non-nil means, cycle entry level or item indentation in new empty entries. | |
694 | ||
695 | When the cursor is at the end of an empty headline, i.e with only stars | |
696 | and maybe a TODO keyword, TAB will then switch the entry to become a child, | |
697 | and then all possible anchestor states, before returning to the original state. | |
698 | This makes data entry extremely fast: M-RET to create a new headline, | |
699 | on TAB to make it a child, two or more tabs to make it a (grand-)uncle. | |
700 | ||
701 | When the cursor is at the end of an empty plain list item, one TAB will | |
702 | make it a subitem, two or more tabs will back up to make this an item | |
703 | higher up in the item hierarchy." | |
704 | :group 'org-cycle | |
705 | :type 'boolean) | |
706 | ||
ab27a4a0 CD |
707 | (defcustom org-cycle-emulate-tab t |
708 | "Where should `org-cycle' emulate TAB. | |
7d143c25 CD |
709 | nil Never |
710 | white Only in completely white lines | |
a0d892d4 | 711 | whitestart Only at the beginning of lines, before the first non-white char |
7d143c25 | 712 | t Everywhere except in headlines |
a3fbe8c4 | 713 | exc-hl-bol Everywhere except at the start of a headline |
7d143c25 CD |
714 | If TAB is used in a place where it does not emulate TAB, the current subtree |
715 | visibility is cycled." | |
ab27a4a0 CD |
716 | :group 'org-cycle |
717 | :type '(choice (const :tag "Never" nil) | |
718 | (const :tag "Only in completely white lines" white) | |
7d143c25 | 719 | (const :tag "Before first char in a line" whitestart) |
ab27a4a0 | 720 | (const :tag "Everywhere except in headlines" t) |
a3fbe8c4 | 721 | (const :tag "Everywhere except at bol in headlines" exc-hl-bol) |
ab27a4a0 | 722 | )) |
094f65d4 | 723 | |
a3fbe8c4 CD |
724 | (defcustom org-cycle-separator-lines 2 |
725 | "Number of empty lines needed to keep an empty line between collapsed trees. | |
726 | If you leave an empty line between the end of a subtree and the following | |
727 | headline, this empty line is hidden when the subtree is folded. | |
728 | Org-mode will leave (exactly) one empty line visible if the number of | |
729 | empty lines is equal or larger to the number given in this variable. | |
730 | So the default 2 means, at least 2 empty lines after the end of a subtree | |
731 | are needed to produce free space between a collapsed subtree and the | |
732 | following headline. | |
733 | ||
54a0dee5 CD |
734 | If the number is negative, and the number of empty lines is at least -N, |
735 | all empty lines are shown. | |
736 | ||
a3fbe8c4 CD |
737 | Special case: when 0, never leave empty lines in collapsed view." |
738 | :group 'org-cycle | |
739 | :type 'integer) | |
621f83e4 | 740 | (put 'org-cycle-separator-lines 'safe-local-variable 'integerp) |
a3fbe8c4 | 741 | |
c8d0cf5c CD |
742 | (defcustom org-pre-cycle-hook nil |
743 | "Hook that is run before visibility cycling is happening. | |
744 | The function(s) in this hook must accept a single argument which indicates | |
745 | the new state that will be set right after running this hook. The | |
746 | argument is a symbol. Before a global state change, it can have the values | |
747 | `overview', `content', or `all'. Before a local state change, it can have | |
748 | the values `folded', `children', or `subtree'." | |
749 | :group 'org-cycle | |
750 | :type 'hook) | |
751 | ||
6769c0dc | 752 | (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees |
5152b597 | 753 | org-cycle-hide-drawers |
a3fbe8c4 | 754 | org-cycle-show-empty-lines |
6769c0dc | 755 | org-optimize-window-after-visibility-change) |
ab27a4a0 CD |
756 | "Hook that is run after `org-cycle' has changed the buffer visibility. |
757 | The function(s) in this hook must accept a single argument which indicates | |
758 | the new state that was set by the most recent `org-cycle' command. The | |
759 | argument is a symbol. After a global state change, it can have the values | |
760 | `overview', `content', or `all'. After a local state change, it can have | |
761 | the values `folded', `children', or `subtree'." | |
762 | :group 'org-cycle | |
763 | :type 'hook) | |
094f65d4 | 764 | |
ab27a4a0 CD |
765 | (defgroup org-edit-structure nil |
766 | "Options concerning structure editing in Org-mode." | |
767 | :tag "Org Edit Structure" | |
768 | :group 'org-structure) | |
634a7d0b | 769 | |
2a57416f CD |
770 | (defcustom org-odd-levels-only nil |
771 | "Non-nil means, skip even levels and only use odd levels for the outline. | |
772 | This has the effect that two stars are being added/taken away in | |
773 | promotion/demotion commands. It also influences how levels are | |
774 | handled by the exporters. | |
775 | Changing it requires restart of `font-lock-mode' to become effective | |
776 | for fontification also in regions already fontified. | |
777 | You may also set this on a per-file basis by adding one of the following | |
778 | lines to the buffer: | |
779 | ||
780 | #+STARTUP: odd | |
781 | #+STARTUP: oddeven" | |
782 | :group 'org-edit-structure | |
783 | :group 'org-font-lock | |
784 | :type 'boolean) | |
785 | ||
786 | (defcustom org-adapt-indentation t | |
c8d0cf5c CD |
787 | "Non-nil means, adapt indentation to outline node level. |
788 | ||
789 | When this variable is set, Org assumes that you write outlines by | |
790 | indenting text in each node to align with the headline (after the stars). | |
791 | The following issues are influenced by this variable: | |
792 | ||
793 | - When this is set and the *entire* text in an entry is indented, the | |
794 | indentation is increased by one space in a demotion command, and | |
795 | decreased by one in a promotion command. If any line in the entry | |
796 | body starts with text at column 0, indentation is not changed at all. | |
797 | ||
798 | - Property drawers and planning information is inserted indented when | |
799 | this variable s set. When nil, they will not be indented. | |
800 | ||
801 | - TAB indents a line relative to context. The lines below a headline | |
802 | will be indented when this variable is set. | |
803 | ||
804 | Note that this is all about true indentation, by adding and removing | |
805 | space characters. See also `org-indent.el' which does level-dependent | |
806 | indentation in a virtual way, i.e. at display time in Emacs." | |
2a57416f CD |
807 | :group 'org-edit-structure |
808 | :type 'boolean) | |
809 | ||
1e8fbb6d | 810 | (defcustom org-special-ctrl-a/e nil |
48aaad2d | 811 | "Non-nil means `C-a' and `C-e' behave specially in headlines and items. |
c8d0cf5c | 812 | |
374585c9 | 813 | When t, `C-a' will bring back the cursor to the beginning of the |
a3fbe8c4 | 814 | headline text, i.e. after the stars and after a possible TODO keyword. |
48aaad2d | 815 | In an item, this will be the position after the bullet. |
a3fbe8c4 | 816 | When the cursor is already at that position, another `C-a' will bring |
1e8fbb6d | 817 | it to the beginning of the line. |
c8d0cf5c | 818 | |
1e8fbb6d CD |
819 | `C-e' will jump to the end of the headline, ignoring the presence of tags |
820 | in the headline. A second `C-e' will then jump to the true end of the | |
8d642074 CD |
821 | line, after any tags. This also means that, when this variable is |
822 | non-nil, `C-e' also will never jump beyond the end of the heading of a | |
823 | folded section, i.e. not after the ellipses. | |
c8d0cf5c | 824 | |
374585c9 | 825 | When set to the symbol `reversed', the first `C-a' or `C-e' works normally, |
c8d0cf5c CD |
826 | going to the true line boundary first. Only a directly following, identical |
827 | keypress will bring the cursor to the special positions. | |
828 | ||
829 | This may also be a cons cell where the behavior for `C-a' and `C-e' is | |
830 | set separately." | |
a3fbe8c4 | 831 | :group 'org-edit-structure |
374585c9 CD |
832 | :type '(choice |
833 | (const :tag "off" nil) | |
8d642074 CD |
834 | (const :tag "on: after stars/bullet and before tags first" t) |
835 | (const :tag "reversed: true line boundary first" reversed) | |
c8d0cf5c CD |
836 | (cons :tag "Set C-a and C-e separately" |
837 | (choice :tag "Special C-a" | |
838 | (const :tag "off" nil) | |
8d642074 CD |
839 | (const :tag "on: after stars/bullet first" t) |
840 | (const :tag "reversed: before stars/bullet first" reversed)) | |
c8d0cf5c CD |
841 | (choice :tag "Special C-e" |
842 | (const :tag "off" nil) | |
8d642074 CD |
843 | (const :tag "on: before tags first" t) |
844 | (const :tag "reversed: after tags first" reversed))))) | |
1e8fbb6d CD |
845 | (if (fboundp 'defvaralias) |
846 | (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) | |
847 | ||
2a57416f CD |
848 | (defcustom org-special-ctrl-k nil |
849 | "Non-nil means `C-k' will behave specially in headlines. | |
850 | When nil, `C-k' will call the default `kill-line' command. | |
851 | When t, the following will happen while the cursor is in the headline: | |
4146eb16 | 852 | |
2a57416f CD |
853 | - When the cursor is at the beginning of a headline, kill the entire |
854 | line and possible the folded subtree below the line. | |
855 | - When in the middle of the headline text, kill the headline up to the tags. | |
856 | - When after the headline text, kill the tags." | |
ab27a4a0 | 857 | :group 'org-edit-structure |
ab27a4a0 | 858 | :type 'boolean) |
891f4676 | 859 | |
621f83e4 CD |
860 | (defcustom org-yank-folded-subtrees t |
861 | "Non-nil means, when yanking subtrees, fold them. | |
862 | If the kill is a single subtree, or a sequence of subtrees, i.e. if | |
863 | it starts with a heading and all other headings in it are either children | |
93b62de8 CD |
864 | or siblings, then fold all the subtrees. However, do this only if no |
865 | text after the yank would be swallowed into a folded tree by this action." | |
866 | :group 'org-edit-structure | |
867 | :type 'boolean) | |
868 | ||
5ace2fe5 | 869 | (defcustom org-yank-adjusted-subtrees nil |
93b62de8 CD |
870 | "Non-nil means, when yanking subtrees, adjust the level. |
871 | With this setting, `org-paste-subtree' is used to insert the subtree, see | |
872 | this function for details." | |
621f83e4 CD |
873 | :group 'org-edit-structure |
874 | :type 'boolean) | |
875 | ||
2a57416f CD |
876 | (defcustom org-M-RET-may-split-line '((default . t)) |
877 | "Non-nil means, M-RET will split the line at the cursor position. | |
878 | When nil, it will go to the end of the line before making a | |
879 | new line. | |
880 | You may also set this option in a different way for different | |
881 | contexts. Valid contexts are: | |
882 | ||
883 | headline when creating a new headline | |
884 | item when creating a new item | |
885 | table in a table field | |
886 | default the value to be used for all contexts not explicitly | |
887 | customized" | |
888 | :group 'org-structure | |
889 | :group 'org-table | |
890 | :type '(choice | |
891 | (const :tag "Always" t) | |
892 | (const :tag "Never" nil) | |
893 | (repeat :greedy t :tag "Individual contexts" | |
894 | (cons | |
895 | (choice :tag "Context" | |
896 | (const headline) | |
897 | (const item) | |
898 | (const table) | |
899 | (const default)) | |
900 | (boolean))))) | |
901 | ||
30313b90 | 902 | |
621f83e4 CD |
903 | (defcustom org-insert-heading-respect-content nil |
904 | "Non-nil means, insert new headings after the current subtree. | |
905 | When nil, the new heading is created directly after the current line. | |
906 | The commands \\[org-insert-heading-respect-content] and | |
907 | \\[org-insert-todo-heading-respect-content] turn this variable on | |
908 | for the duration of the command." | |
909 | :group 'org-structure | |
910 | :type 'boolean) | |
911 | ||
0bd48b37 CD |
912 | (defcustom org-blank-before-new-entry '((heading . auto) |
913 | (plain-list-item . auto)) | |
3278a016 CD |
914 | "Should `org-insert-heading' leave a blank line before new heading/item? |
915 | The value is an alist, with `heading' and `plain-list-item' as car, | |
c8d0cf5c CD |
916 | and a boolean flag as cdr. For plain lists, if the variable |
917 | `org-empty-line-terminates-plain-lists' is set, the setting here | |
918 | is ignored and no empty line is inserted, to keep the list in tact." | |
3278a016 CD |
919 | :group 'org-edit-structure |
920 | :type '(list | |
0bd48b37 CD |
921 | (cons (const heading) |
922 | (choice (const :tag "Never" nil) | |
923 | (const :tag "Always" t) | |
924 | (const :tag "Auto" auto))) | |
925 | (cons (const plain-list-item) | |
926 | (choice (const :tag "Never" nil) | |
927 | (const :tag "Always" t) | |
928 | (const :tag "Auto" auto))))) | |
3278a016 | 929 | |
4b3a9ba7 CD |
930 | (defcustom org-insert-heading-hook nil |
931 | "Hook being run after inserting a new heading." | |
932 | :group 'org-edit-structure | |
8c6fb58b | 933 | :type 'hook) |
4b3a9ba7 | 934 | |
ab27a4a0 CD |
935 | (defcustom org-enable-fixed-width-editor t |
936 | "Non-nil means, lines starting with \":\" are treated as fixed-width. | |
937 | This currently only means, they are never auto-wrapped. | |
938 | When nil, such lines will be treated like ordinary lines. | |
939 | See also the QUOTE keyword." | |
940 | :group 'org-edit-structure | |
941 | :type 'boolean) | |
30313b90 | 942 | |
621f83e4 | 943 | |
2a57416f CD |
944 | (defcustom org-goto-auto-isearch t |
945 | "Non-nil means, typing characters in org-goto starts incremental search." | |
946 | :group 'org-edit-structure | |
947 | :type 'boolean) | |
948 | ||
ab27a4a0 CD |
949 | (defgroup org-sparse-trees nil |
950 | "Options concerning sparse trees in Org-mode." | |
951 | :tag "Org Sparse Trees" | |
952 | :group 'org-structure) | |
891f4676 | 953 | |
ab27a4a0 CD |
954 | (defcustom org-highlight-sparse-tree-matches t |
955 | "Non-nil means, highlight all matches that define a sparse tree. | |
956 | The highlights will automatically disappear the next time the buffer is | |
957 | changed by an edit command." | |
958 | :group 'org-sparse-trees | |
15f43010 | 959 | :type 'boolean) |
891f4676 | 960 | |
3278a016 CD |
961 | (defcustom org-remove-highlights-with-change t |
962 | "Non-nil means, any change to the buffer will remove temporary highlights. | |
963 | Such highlights are created by `org-occur' and `org-clock-display'. | |
964 | When nil, `C-c C-c needs to be used to get rid of the highlights. | |
965 | The highlights created by `org-preview-latex-fragment' always need | |
966 | `C-c C-c' to be removed." | |
ab27a4a0 | 967 | :group 'org-sparse-trees |
3278a016 | 968 | :group 'org-time |
891f4676 RS |
969 | :type 'boolean) |
970 | ||
7ac93e3c | 971 | |
ab27a4a0 CD |
972 | (defcustom org-occur-hook '(org-first-headline-recenter) |
973 | "Hook that is run after `org-occur' has constructed a sparse tree. | |
974 | This can be used to recenter the window to show as much of the structure | |
975 | as possible." | |
976 | :group 'org-sparse-trees | |
977 | :type 'hook) | |
d924f2e5 | 978 | |
8c6fb58b CD |
979 | (defgroup org-imenu-and-speedbar nil |
980 | "Options concerning imenu and speedbar in Org-mode." | |
981 | :tag "Org Imenu and Speedbar" | |
982 | :group 'org-structure) | |
983 | ||
984 | (defcustom org-imenu-depth 2 | |
985 | "The maximum level for Imenu access to Org-mode headlines. | |
986 | This also applied for speedbar access." | |
987 | :group 'org-imenu-and-speedbar | |
c8d0cf5c | 988 | :type 'integer) |
8c6fb58b | 989 | |
ab27a4a0 CD |
990 | (defgroup org-table nil |
991 | "Options concerning tables in Org-mode." | |
992 | :tag "Org Table" | |
993 | :group 'org) | |
eb2f9c59 | 994 | |
ab27a4a0 CD |
995 | (defcustom org-enable-table-editor 'optimized |
996 | "Non-nil means, lines starting with \"|\" are handled by the table editor. | |
997 | When nil, such lines will be treated like ordinary lines. | |
eb2f9c59 | 998 | |
ab27a4a0 CD |
999 | When equal to the symbol `optimized', the table editor will be optimized to |
1000 | do the following: | |
3278a016 CD |
1001 | - Automatic overwrite mode in front of whitespace in table fields. |
1002 | This makes the structure of the table stay in tact as long as the edited | |
ab27a4a0 CD |
1003 | field does not exceed the column width. |
1004 | - Minimize the number of realigns. Normally, the table is aligned each time | |
1005 | TAB or RET are pressed to move to another field. With optimization this | |
1006 | happens only if changes to a field might have changed the column width. | |
1007 | Optimization requires replacing the functions `self-insert-command', | |
1008 | `delete-char', and `backward-delete-char' in Org-mode buffers, with a | |
1009 | slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is | |
1010 | very good at guessing when a re-align will be necessary, but you can always | |
1011 | force one with \\[org-ctrl-c-ctrl-c]. | |
eb2f9c59 | 1012 | |
ab27a4a0 CD |
1013 | If you would like to use the optimized version in Org-mode, but the |
1014 | un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. | |
eb2f9c59 | 1015 | |
ab27a4a0 CD |
1016 | This variable can be used to turn on and off the table editor during a session, |
1017 | but in order to toggle optimization, a restart is required. | |
634a7d0b | 1018 | |
ab27a4a0 CD |
1019 | See also the variable `org-table-auto-blank-field'." |
1020 | :group 'org-table | |
1021 | :type '(choice | |
1022 | (const :tag "off" nil) | |
1023 | (const :tag "on" t) | |
1024 | (const :tag "on, optimized" optimized))) | |
634a7d0b | 1025 | |
c8d0cf5c CD |
1026 | (defcustom org-self-insert-cluster-for-undo t |
1027 | "Non-nil means cluster self-insert commands for undo when possible. | |
8bfe682a | 1028 | If this is set, then, like in the Emacs command loop, 20 consecutive |
c8d0cf5c CD |
1029 | characters will be undone together. |
1030 | This is configurable, because there is some impact on typing performance." | |
1031 | :group 'org-table | |
1032 | :type 'boolean) | |
1033 | ||
ab27a4a0 CD |
1034 | (defcustom org-table-tab-recognizes-table.el t |
1035 | "Non-nil means, TAB will automatically notice a table.el table. | |
1036 | When it sees such a table, it moves point into it and - if necessary - | |
1037 | calls `table-recognize-table'." | |
1038 | :group 'org-table-editing | |
79c4be8e CD |
1039 | :type 'boolean) |
1040 | ||
891f4676 RS |
1041 | (defgroup org-link nil |
1042 | "Options concerning links in Org-mode." | |
1043 | :tag "Org Link" | |
1044 | :group 'org) | |
1045 | ||
3278a016 | 1046 | (defvar org-link-abbrev-alist-local nil |
a3fbe8c4 | 1047 | "Buffer-local version of `org-link-abbrev-alist', which see. |
3278a016 CD |
1048 | The value of this is taken from the #+LINK lines.") |
1049 | (make-variable-buffer-local 'org-link-abbrev-alist-local) | |
1050 | ||
1051 | (defcustom org-link-abbrev-alist nil | |
1052 | "Alist of link abbreviations. | |
1053 | The car of each element is a string, to be replaced at the start of a link. | |
1054 | The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated | |
1055 | links in Org-mode buffers can have an optional tag after a double colon, e.g. | |
1056 | ||
d3f4dbe8 | 1057 | [[linkkey:tag][description]] |
3278a016 | 1058 | |
c8d0cf5c CD |
1059 | The 'linkkey' must be a word word, starting with a letter, followed |
1060 | by letters, numbers, '-' or '_'. | |
1061 | ||
3278a016 | 1062 | If REPLACE is a string, the tag will simply be appended to create the link. |
ce4fdcb9 CD |
1063 | If the string contains \"%s\", the tag will be inserted there. Alternatively, |
1064 | the placeholder \"%h\" will cause a url-encoded version of the tag to | |
1065 | be inserted at that point (see the function `url-hexify-string'). | |
8c6fb58b CD |
1066 | |
1067 | REPLACE may also be a function that will be called with the tag as the | |
1068 | only argument to create the link, which should be returned as a string. | |
1069 | ||
1070 | See the manual for examples." | |
3278a016 | 1071 | :group 'org-link |
93b62de8 CD |
1072 | :type '(repeat |
1073 | (cons | |
1074 | (string :tag "Protocol") | |
1075 | (choice | |
1076 | (string :tag "Format") | |
1077 | (function))))) | |
3278a016 | 1078 | |
ab27a4a0 CD |
1079 | (defcustom org-descriptive-links t |
1080 | "Non-nil means, hide link part and only show description of bracket links. | |
33306645 | 1081 | Bracket links are like [[link][description]]. This variable sets the initial |
ab27a4a0 CD |
1082 | state in new org-mode buffers. The setting can then be toggled on a |
1083 | per-buffer basis from the Org->Hyperlinks menu." | |
4da1a99d CD |
1084 | :group 'org-link |
1085 | :type 'boolean) | |
1086 | ||
4b3a9ba7 CD |
1087 | (defcustom org-link-file-path-type 'adaptive |
1088 | "How the path name in file links should be stored. | |
1089 | Valid values are: | |
1090 | ||
a0d892d4 | 1091 | relative Relative to the current directory, i.e. the directory of the file |
4b3a9ba7 | 1092 | into which the link is being inserted. |
a0d892d4 JB |
1093 | absolute Absolute path, if possible with ~ for home directory. |
1094 | noabbrev Absolute path, no abbreviation of home directory. | |
4b3a9ba7 CD |
1095 | adaptive Use relative path for files in the current directory and sub- |
1096 | directories of it. For other files, use an absolute path." | |
1097 | :group 'org-link | |
1098 | :type '(choice | |
1099 | (const relative) | |
1100 | (const absolute) | |
1101 | (const noabbrev) | |
1102 | (const adaptive))) | |
1103 | ||
0bd48b37 | 1104 | (defcustom org-activate-links '(bracket angle plain radio tag date footnote) |
ab27a4a0 CD |
1105 | "Types of links that should be activated in Org-mode files. |
1106 | This is a list of symbols, each leading to the activation of a certain link | |
1107 | type. In principle, it does not hurt to turn on most link types - there may | |
1108 | be a small gain when turning off unused link types. The types are: | |
1109 | ||
1110 | bracket The recommended [[link][description]] or [[link]] links with hiding. | |
33306645 | 1111 | angular Links in angular brackets that may contain whitespace like |
ab27a4a0 CD |
1112 | <bbdb:Carsten Dominik>. |
1113 | plain Plain links in normal text, no whitespace, like http://google.com. | |
1114 | radio Text that is matched by a radio target, see manual for details. | |
1115 | tag Tag settings in a headline (link to tag search). | |
1116 | date Time stamps (link to calendar). | |
0bd48b37 | 1117 | footnote Footnote labels. |
ab27a4a0 CD |
1118 | |
1119 | Changing this variable requires a restart of Emacs to become effective." | |
a96ee7df | 1120 | :group 'org-link |
0bd48b37 CD |
1121 | :type '(set :greedy t |
1122 | (const :tag "Double bracket links (new style)" bracket) | |
ab27a4a0 | 1123 | (const :tag "Angular bracket links (old style)" angular) |
2a57416f | 1124 | (const :tag "Plain text links" plain) |
ab27a4a0 CD |
1125 | (const :tag "Radio target matches" radio) |
1126 | (const :tag "Tags" tag) | |
0bd48b37 CD |
1127 | (const :tag "Timestamps" date) |
1128 | (const :tag "Footnotes" footnote))) | |
ab27a4a0 | 1129 | |
20908596 CD |
1130 | (defcustom org-make-link-description-function nil |
1131 | "Function to use to generate link descriptions from links. If | |
1132 | nil the link location will be used. This function must take two | |
1133 | parameters; the first is the link and the second the description | |
1134 | org-insert-link has generated, and should return the description | |
1135 | to use." | |
1136 | :group 'org-link | |
1137 | :type 'function) | |
1138 | ||
ab27a4a0 | 1139 | (defgroup org-link-store nil |
5bf7807a | 1140 | "Options concerning storing links in Org-mode." |
ab27a4a0 CD |
1141 | :tag "Org Store Link" |
1142 | :group 'org-link) | |
891f4676 | 1143 | |
d3f4dbe8 CD |
1144 | (defcustom org-email-link-description-format "Email %c: %.30s" |
1145 | "Format of the description part of a link to an email or usenet message. | |
33306645 | 1146 | The following %-escapes will be replaced by corresponding information: |
d3f4dbe8 CD |
1147 | |
1148 | %F full \"From\" field | |
1149 | %f name, taken from \"From\" field, address if no name | |
1150 | %T full \"To\" field | |
1151 | %t first name in \"To\" field, address if no name | |
33306645 | 1152 | %c correspondent. Usually \"from NAME\", but if you sent it yourself, it |
d3f4dbe8 CD |
1153 | will be \"to NAME\". See also the variable `org-from-is-user-regexp'. |
1154 | %s subject | |
1155 | %m message-id. | |
1156 | ||
1157 | You may use normal field width specification between the % and the letter. | |
1158 | This is for example useful to limit the length of the subject. | |
1159 | ||
1160 | Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" | |
1161 | :group 'org-link-store | |
1162 | :type 'string) | |
1163 | ||
1164 | (defcustom org-from-is-user-regexp | |
1165 | (let (r1 r2) | |
1166 | (when (and user-mail-address (not (string= user-mail-address ""))) | |
1167 | (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) | |
1168 | (when (and user-full-name (not (string= user-full-name ""))) | |
1169 | (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) | |
1170 | (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) | |
33306645 | 1171 | "Regexp matched against the \"From:\" header of an email or usenet message. |
d3f4dbe8 CD |
1172 | It should match if the message is from the user him/herself." |
1173 | :group 'org-link-store | |
1174 | :type 'regexp) | |
1175 | ||
c8d0cf5c | 1176 | (defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id |
db55f368 CD |
1177 | "Non-nil means, storing a link to an Org file will use entry IDs. |
1178 | ||
1179 | Note that before this variable is even considered, org-id must be loaded, | |
c8d0cf5c | 1180 | so please customize `org-modules' and turn it on. |
db55f368 CD |
1181 | |
1182 | The variable can have the following values: | |
1183 | ||
1184 | t Create an ID if needed to make a link to the current entry. | |
1185 | ||
1186 | create-if-interactive | |
1187 | If `org-store-link' is called directly (interactively, as a user | |
1188 | command), do create an ID to support the link. But when doing the | |
1189 | job for remember, only use the ID if it already exists. The | |
1190 | purpose of this setting is to avoid proliferation of unwanted | |
1191 | IDs, just because you happen to be in an Org file when you | |
1192 | call `org-remember' that automatically and preemptively | |
1193 | creates a link. If you do want to get an ID link in a remember | |
1194 | template to an entry not having an ID, create it first by | |
1195 | explicitly creating a link to it, using `C-c C-l' first. | |
1196 | ||
c8d0cf5c CD |
1197 | create-if-interactive-and-no-custom-id |
1198 | Like create-if-interactive, but do not create an ID if there is | |
1199 | a CUSTOM_ID property defined in the entry. This is the default. | |
1200 | ||
db55f368 CD |
1201 | use-existing |
1202 | Use existing ID, do not create one. | |
1203 | ||
1204 | nil Never use an ID to make a link, instead link using a text search for | |
1205 | the headline text." | |
1206 | :group 'org-link-store | |
1207 | :type '(choice | |
1208 | (const :tag "Create ID to make link" t) | |
c8d0cf5c CD |
1209 | (const :tag "Create if storing link interactively" |
1210 | create-if-interactive) | |
1211 | (const :tag "Create if storing link interactively and no CUSTOM_ID is present" | |
1212 | create-if-interactive-and-no-custom-id) | |
1213 | (const :tag "Only use existing" use-existing) | |
db55f368 CD |
1214 | (const :tag "Do not use ID to create link" nil))) |
1215 | ||
f425a6ea CD |
1216 | (defcustom org-context-in-file-links t |
1217 | "Non-nil means, file links from `org-store-link' contain context. | |
a96ee7df | 1218 | A search string will be added to the file name with :: as separator and |
f425a6ea CD |
1219 | used to find the context when the link is activated by the command |
1220 | `org-open-at-point'. | |
891f4676 RS |
1221 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') |
1222 | negates this setting for the duration of the command." | |
ab27a4a0 | 1223 | :group 'org-link-store |
891f4676 RS |
1224 | :type 'boolean) |
1225 | ||
1226 | (defcustom org-keep-stored-link-after-insertion nil | |
1227 | "Non-nil means, keep link in list for entire session. | |
1228 | ||
1229 | The command `org-store-link' adds a link pointing to the current | |
2dd9129f | 1230 | location to an internal list. These links accumulate during a session. |
891f4676 RS |
1231 | The command `org-insert-link' can be used to insert links into any |
1232 | Org-mode file (offering completion for all stored links). When this | |
634a7d0b | 1233 | option is nil, every link which has been inserted once using \\[org-insert-link] |
891f4676 RS |
1234 | will be removed from the list, to make completing the unused links |
1235 | more efficient." | |
ab27a4a0 CD |
1236 | :group 'org-link-store |
1237 | :type 'boolean) | |
1238 | ||
ab27a4a0 | 1239 | (defgroup org-link-follow nil |
5bf7807a | 1240 | "Options concerning following links in Org-mode." |
ab27a4a0 CD |
1241 | :tag "Org Follow Link" |
1242 | :group 'org-link) | |
1243 | ||
ce4fdcb9 CD |
1244 | (defcustom org-link-translation-function nil |
1245 | "Function to translate links with different syntax to Org syntax. | |
1246 | This can be used to translate links created for example by the Planner | |
1247 | or emacs-wiki packages to Org syntax. | |
1248 | The function must accept two parameters, a TYPE containing the link | |
1249 | protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, | |
1250 | which is everything after the link protocol. It should return a cons | |
33306645 | 1251 | with possibly modified values of type and path. |
ce4fdcb9 CD |
1252 | Org contains a function for this, so if you set this variable to |
1253 | `org-translate-link-from-planner', you should be able follow many | |
1254 | links created by planner." | |
1255 | :group 'org-link-follow | |
1256 | :type 'function) | |
1257 | ||
2a57416f CD |
1258 | (defcustom org-follow-link-hook nil |
1259 | "Hook that is run after a link has been followed." | |
1260 | :group 'org-link-follow | |
1261 | :type 'hook) | |
1262 | ||
ab27a4a0 CD |
1263 | (defcustom org-tab-follows-link nil |
1264 | "Non-nil means, on links TAB will follow the link. | |
c8d0cf5c CD |
1265 | Needs to be set before org.el is loaded. |
1266 | This really should not be used, it does not make sense, and the | |
1267 | implementation is bad." | |
ab27a4a0 CD |
1268 | :group 'org-link-follow |
1269 | :type 'boolean) | |
1270 | ||
cc6dbcb7 | 1271 | (defcustom org-return-follows-link nil |
ab27a4a0 CD |
1272 | "Non-nil means, on links RET will follow the link. |
1273 | Needs to be set before org.el is loaded." | |
1274 | :group 'org-link-follow | |
891f4676 RS |
1275 | :type 'boolean) |
1276 | ||
2a57416f CD |
1277 | (defcustom org-mouse-1-follows-link |
1278 | (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) | |
a4b39e39 | 1279 | "Non-nil means, mouse-1 on a link will follow the link. |
2a57416f | 1280 | A longer mouse click will still set point. Does not work on XEmacs. |
a4b39e39 CD |
1281 | Needs to be set before org.el is loaded." |
1282 | :group 'org-link-follow | |
1283 | :type 'boolean) | |
1284 | ||
ab27a4a0 CD |
1285 | (defcustom org-mark-ring-length 4 |
1286 | "Number of different positions to be recorded in the ring | |
1287 | Changing this requires a restart of Emacs to work correctly." | |
1288 | :group 'org-link-follow | |
33306645 | 1289 | :type 'integer) |
ab27a4a0 | 1290 | |
891f4676 RS |
1291 | (defcustom org-link-frame-setup |
1292 | '((vm . vm-visit-folder-other-frame) | |
1293 | (gnus . gnus-other-frame) | |
1294 | (file . find-file-other-window)) | |
1295 | "Setup the frame configuration for following links. | |
1296 | When following a link with Emacs, it may often be useful to display | |
1297 | this link in another window or frame. This variable can be used to | |
1298 | set this up for the different types of links. | |
1299 | For VM, use any of | |
634a7d0b CD |
1300 | `vm-visit-folder' |
1301 | `vm-visit-folder-other-frame' | |
891f4676 | 1302 | For Gnus, use any of |
634a7d0b CD |
1303 | `gnus' |
1304 | `gnus-other-frame' | |
93b62de8 | 1305 | `org-gnus-no-new-news' |
891f4676 | 1306 | For FILE, use any of |
634a7d0b CD |
1307 | `find-file' |
1308 | `find-file-other-window' | |
1309 | `find-file-other-frame' | |
891f4676 RS |
1310 | For the calendar, use the variable `calendar-setup'. |
1311 | For BBDB, it is currently only possible to display the matches in | |
1312 | another window." | |
ab27a4a0 | 1313 | :group 'org-link-follow |
891f4676 | 1314 | :type '(list |
c8d16429 CD |
1315 | (cons (const vm) |
1316 | (choice | |
1317 | (const vm-visit-folder) | |
1318 | (const vm-visit-folder-other-window) | |
1319 | (const vm-visit-folder-other-frame))) | |
1320 | (cons (const gnus) | |
1321 | (choice | |
1322 | (const gnus) | |
93b62de8 CD |
1323 | (const gnus-other-frame) |
1324 | (const org-gnus-no-new-news))) | |
c8d16429 CD |
1325 | (cons (const file) |
1326 | (choice | |
1327 | (const find-file) | |
1328 | (const find-file-other-window) | |
1329 | (const find-file-other-frame))))) | |
891f4676 | 1330 | |
3278a016 CD |
1331 | (defcustom org-display-internal-link-with-indirect-buffer nil |
1332 | "Non-nil means, use indirect buffer to display infile links. | |
1333 | Activating internal links (from one location in a file to another location | |
1334 | in the same file) normally just jumps to the location. When the link is | |
1335 | activated with a C-u prefix (or with mouse-3), the link is displayed in | |
1336 | another window. When this option is set, the other window actually displays | |
1337 | an indirect buffer clone of the current buffer, to avoid any visibility | |
1338 | changes to the current buffer." | |
1339 | :group 'org-link-follow | |
1340 | :type 'boolean) | |
1341 | ||
891f4676 | 1342 | (defcustom org-open-non-existing-files nil |
d3f4dbe8 | 1343 | "Non-nil means, `org-open-file' will open non-existing files. |
c8d0cf5c CD |
1344 | When nil, an error will be generated. |
1345 | This variable applies only to external applications because they | |
1346 | might choke on non-existing files. If the link is to a file that | |
8bfe682a | 1347 | will be opened in Emacs, the variable is ignored." |
ab27a4a0 | 1348 | :group 'org-link-follow |
891f4676 RS |
1349 | :type 'boolean) |
1350 | ||
2c3ad40d CD |
1351 | (defcustom org-open-directory-means-index-dot-org nil |
1352 | "Non-nil means, a link to a directory really means to index.org. | |
1353 | When nil, following a directory link will run dired or open a finder/explorer | |
1354 | window on that directory." | |
1355 | :group 'org-link-follow | |
1356 | :type 'boolean) | |
1357 | ||
3278a016 CD |
1358 | (defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") |
1359 | "Function and arguments to call for following mailto links. | |
1360 | This is a list with the first element being a lisp function, and the | |
1361 | remaining elements being arguments to the function. In string arguments, | |
1362 | %a will be replaced by the address, and %s will be replaced by the subject | |
1363 | if one was given like in <mailto:arthur@galaxy.org::this subject>." | |
1364 | :group 'org-link-follow | |
1365 | :type '(choice | |
1366 | (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) | |
1367 | (const :tag "compose-mail" (compose-mail "%a" "%s")) | |
1368 | (const :tag "message-mail" (message-mail "%a" "%s")) | |
1369 | (cons :tag "other" (function) (repeat :tag "argument" sexp)))) | |
1370 | ||
4b3a9ba7 | 1371 | (defcustom org-confirm-shell-link-function 'yes-or-no-p |
891f4676 | 1372 | "Non-nil means, ask for confirmation before executing shell links. |
03f3cf35 | 1373 | Shell links can be dangerous: just think about a link |
ab27a4a0 CD |
1374 | |
1375 | [[shell:rm -rf ~/*][Google Search]] | |
1376 | ||
03f3cf35 | 1377 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1378 | but really it would remove your entire home directory. |
03f3cf35 | 1379 | Therefore we advise against setting this variable to nil. |
c8d0cf5c | 1380 | Just change it to `y-or-n-p' if you want to confirm with a |
03f3cf35 | 1381 | single keystroke rather than having to type \"yes\"." |
4b3a9ba7 CD |
1382 | :group 'org-link-follow |
1383 | :type '(choice | |
1384 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
1385 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
1386 | (const :tag "no confirmation (dangerous)" nil))) | |
1387 | ||
1388 | (defcustom org-confirm-elisp-link-function 'yes-or-no-p | |
03f3cf35 JW |
1389 | "Non-nil means, ask for confirmation before executing Emacs Lisp links. |
1390 | Elisp links can be dangerous: just think about a link | |
4b3a9ba7 CD |
1391 | |
1392 | [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] | |
1393 | ||
03f3cf35 | 1394 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1395 | but really it would remove your entire home directory. |
03f3cf35 | 1396 | Therefore we advise against setting this variable to nil. |
c8d0cf5c | 1397 | Just change it to `y-or-n-p' if you want to confirm with a |
03f3cf35 | 1398 | single keystroke rather than having to type \"yes\"." |
ab27a4a0 CD |
1399 | :group 'org-link-follow |
1400 | :type '(choice | |
1401 | (const :tag "with yes-or-no (safer)" yes-or-no-p) | |
1402 | (const :tag "with y-or-n (faster)" y-or-n-p) | |
1403 | (const :tag "no confirmation (dangerous)" nil))) | |
891f4676 | 1404 | |
ee53c9b7 | 1405 | (defconst org-file-apps-defaults-gnu |
6769c0dc | 1406 | '((remote . emacs) |
93b62de8 | 1407 | (system . mailcap) |
6769c0dc | 1408 | (t . mailcap)) |
b0a10108 | 1409 | "Default file applications on a UNIX or GNU/Linux system. |
891f4676 RS |
1410 | See `org-file-apps'.") |
1411 | ||
1412 | (defconst org-file-apps-defaults-macosx | |
6769c0dc | 1413 | '((remote . emacs) |
3278a016 | 1414 | (t . "open %s") |
93b62de8 | 1415 | (system . "open %s") |
891f4676 | 1416 | ("ps.gz" . "gv %s") |
891f4676 RS |
1417 | ("eps.gz" . "gv %s") |
1418 | ("dvi" . "xdvi %s") | |
1419 | ("fig" . "xfig %s")) | |
1420 | "Default file applications on a MacOS X system. | |
1421 | The system \"open\" is known as a default, but we use X11 applications | |
1422 | for some files for which the OS does not have a good default. | |
1423 | See `org-file-apps'.") | |
1424 | ||
1425 | (defconst org-file-apps-defaults-windowsnt | |
c44f0d75 | 1426 | (list |
6769c0dc CD |
1427 | '(remote . emacs) |
1428 | (cons t | |
93b62de8 CD |
1429 | (list (if (featurep 'xemacs) |
1430 | 'mswindows-shell-execute | |
1431 | 'w32-shell-execute) | |
1432 | "open" 'file)) | |
1433 | (cons 'system | |
6769c0dc CD |
1434 | (list (if (featurep 'xemacs) |
1435 | 'mswindows-shell-execute | |
1436 | 'w32-shell-execute) | |
1437 | "open" 'file))) | |
891f4676 RS |
1438 | "Default file applications on a Windows NT system. |
1439 | The system \"open\" is used for most files. | |
1440 | See `org-file-apps'.") | |
1441 | ||
1442 | (defcustom org-file-apps | |
1443 | '( | |
621f83e4 | 1444 | (auto-mode . emacs) |
8bfe682a | 1445 | ("\\.mm\\'" . default) |
621f83e4 | 1446 | ("\\.x?html?\\'" . default) |
71d35b24 | 1447 | ("\\.pdf\\'" . default) |
891f4676 RS |
1448 | ) |
1449 | "External applications for opening `file:path' items in a document. | |
1450 | Org-mode uses system defaults for different file types, but | |
1451 | you can use this variable to set the application for a given file | |
4b3a9ba7 CD |
1452 | extension. The entries in this list are cons cells where the car identifies |
1453 | files and the cdr the corresponding command. Possible values for the | |
1454 | file identifier are | |
621f83e4 CD |
1455 | \"regex\" Regular expression matched against the file name. For backward |
1456 | compatibility, this can also be a string with only alphanumeric | |
1457 | characters, which is then interpreted as an extension. | |
4b3a9ba7 | 1458 | `directory' Matches a directory |
5137195a | 1459 | `remote' Matches a remote file, accessible through tramp or efs. |
c44f0d75 | 1460 | Remote files most likely should be visited through Emacs |
6769c0dc | 1461 | because external applications cannot handle such paths. |
33306645 | 1462 | `auto-mode' Matches files that are matched by any entry in `auto-mode-alist', |
93b62de8 | 1463 | so all files Emacs knows how to handle. Using this with |
621f83e4 | 1464 | command `emacs' will open most files in Emacs. Beware that this |
33306645 | 1465 | will also open html files inside Emacs, unless you add |
621f83e4 CD |
1466 | (\"html\" . default) to the list as well. |
1467 | t Default for files not matched by any of the other options. | |
93b62de8 CD |
1468 | `system' The system command to open files, like `open' on Windows |
1469 | and Mac OS X, and mailcap under GNU/Linux. This is the command | |
1470 | that will be selected if you call `C-c C-o' with a double | |
1471 | `C-u C-u' prefix. | |
4b3a9ba7 CD |
1472 | |
1473 | Possible values for the command are: | |
1474 | `emacs' The file will be visited by the current Emacs process. | |
621f83e4 CD |
1475 | `default' Use the default application for this file type, which is the |
1476 | association for t in the list, most likely in the system-specific | |
1477 | part. | |
33306645 | 1478 | This can be used to overrule an unwanted setting in the |
621f83e4 | 1479 | system-specific variable. |
93b62de8 CD |
1480 | `system' Use the system command for opening files, like \"open\". |
1481 | This command is specified by the entry whose car is `system'. | |
1482 | Most likely, the system-specific version of this variable | |
1483 | does define this command, but you can overrule/replace it | |
1484 | here. | |
4b3a9ba7 | 1485 | string A command to be executed by a shell; %s will be replaced |
c8d0cf5c | 1486 | by the path to the file. |
4b3a9ba7 | 1487 | sexp A Lisp form which will be evaluated. The file path will |
c8d0cf5c | 1488 | be available in the Lisp variable `file'. |
891f4676 RS |
1489 | For more examples, see the system specific constants |
1490 | `org-file-apps-defaults-macosx' | |
1491 | `org-file-apps-defaults-windowsnt' | |
ee53c9b7 | 1492 | `org-file-apps-defaults-gnu'." |
ab27a4a0 | 1493 | :group 'org-link-follow |
891f4676 | 1494 | :type '(repeat |
a96ee7df CD |
1495 | (cons (choice :value "" |
1496 | (string :tag "Extension") | |
93b62de8 | 1497 | (const :tag "System command to open files" system) |
a96ee7df | 1498 | (const :tag "Default for unrecognized files" t) |
6769c0dc | 1499 | (const :tag "Remote file" remote) |
621f83e4 CD |
1500 | (const :tag "Links to a directory" directory) |
1501 | (const :tag "Any files that have Emacs modes" | |
1502 | auto-mode)) | |
c8d16429 | 1503 | (choice :value "" |
a96ee7df | 1504 | (const :tag "Visit with Emacs" emacs) |
93b62de8 CD |
1505 | (const :tag "Use default" default) |
1506 | (const :tag "Use the system command" system) | |
a96ee7df CD |
1507 | (string :tag "Command") |
1508 | (sexp :tag "Lisp form"))))) | |
891f4676 | 1509 | |
20908596 CD |
1510 | (defgroup org-refile nil |
1511 | "Options concerning refiling entries in Org-mode." | |
d60b1ba1 | 1512 | :tag "Org Refile" |
891f4676 RS |
1513 | :group 'org) |
1514 | ||
1515 | (defcustom org-directory "~/org" | |
1516 | "Directory with org files. | |
c8d0cf5c CD |
1517 | This is just a default location to look for Org files. There is no need |
1518 | at all to put your files into this directory. It is only used in the | |
1519 | following situations: | |
1520 | ||
1521 | 1. When a remember template specifies a target file that is not an | |
1522 | absolute path. The path will then be interpreted relative to | |
1523 | `org-directory' | |
1524 | 2. When a remember note is filed away in an interactive way (when exiting the | |
04e65fdb | 1525 | note buffer with `C-1 C-c C-c'. The user is prompted for an org file, |
c8d0cf5c | 1526 | with `org-directory' as the default path." |
20908596 | 1527 | :group 'org-refile |
891f4676 RS |
1528 | :group 'org-remember |
1529 | :type 'directory) | |
1530 | ||
0a505855 | 1531 | (defcustom org-default-notes-file (convert-standard-filename "~/.notes") |
891f4676 RS |
1532 | "Default target for storing notes. |
1533 | Used by the hooks for remember.el. This can be a string, or nil to mean | |
d3f4dbe8 CD |
1534 | the value of `remember-data-file'. |
1535 | You can set this on a per-template basis with the variable | |
1536 | `org-remember-templates'." | |
20908596 | 1537 | :group 'org-refile |
891f4676 RS |
1538 | :group 'org-remember |
1539 | :type '(choice | |
c8d16429 CD |
1540 | (const :tag "Default from remember-data-file" nil) |
1541 | file)) | |
891f4676 | 1542 | |
2a57416f CD |
1543 | (defcustom org-goto-interface 'outline |
1544 | "The default interface to be used for `org-goto'. | |
33306645 | 1545 | Allowed values are: |
2a57416f CD |
1546 | outline The interface shows an outline of the relevant file |
1547 | and the correct heading is found by moving through | |
1548 | the outline or by searching with incremental search. | |
1549 | outline-path-completion Headlines in the current buffer are offered via | |
d60b1ba1 CD |
1550 | completion. This is the interface also used by |
1551 | the refile command." | |
20908596 | 1552 | :group 'org-refile |
2a57416f CD |
1553 | :type '(choice |
1554 | (const :tag "Outline" outline) | |
1555 | (const :tag "Outline-path-completion" outline-path-completion))) | |
8c6fb58b | 1556 | |
db55f368 CD |
1557 | (defcustom org-goto-max-level 5 |
1558 | "Maximum level to be considered when running org-goto with refile interface." | |
1559 | :group 'org-refile | |
c8d0cf5c | 1560 | :type 'integer) |
db55f368 | 1561 | |
891f4676 RS |
1562 | (defcustom org-reverse-note-order nil |
1563 | "Non-nil means, store new notes at the beginning of a file or entry. | |
8c6fb58b CD |
1564 | When nil, new notes will be filed to the end of a file or entry. |
1565 | This can also be a list with cons cells of regular expressions that | |
1566 | are matched against file names, and values." | |
891f4676 | 1567 | :group 'org-remember |
d60b1ba1 | 1568 | :group 'org-refile |
891f4676 | 1569 | :type '(choice |
c8d16429 CD |
1570 | (const :tag "Reverse always" t) |
1571 | (const :tag "Reverse never" nil) | |
1572 | (repeat :tag "By file name regexp" | |
1573 | (cons regexp boolean)))) | |
891f4676 | 1574 | |
8c6fb58b CD |
1575 | (defcustom org-refile-targets nil |
1576 | "Targets for refiling entries with \\[org-refile]. | |
1577 | This is list of cons cells. Each cell contains: | |
1578 | - a specification of the files to be considered, either a list of files, | |
20908596 | 1579 | or a symbol whose function or variable value will be used to retrieve |
fdf730ed CD |
1580 | a file name or a list of file names. If you use `org-agenda-files' for |
1581 | that, all agenda files will be scanned for targets. Nil means, consider | |
1582 | headings in the current buffer. | |
c8d0cf5c CD |
1583 | - A specification of how to find candidate refile targets. This may be |
1584 | any of: | |
8c6fb58b CD |
1585 | - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. |
1586 | This tag has to be present in all target headlines, inheritance will | |
1587 | not be considered. | |
1588 | - a cons cell (:todo . \"KEYWORD\") to identify refile targets by | |
1589 | todo keyword. | |
1590 | - a cons cell (:regexp . \"REGEXP\") with a regular expression matching | |
1591 | headlines that are refiling targets. | |
1592 | - a cons cell (:level . N). Any headline of level N is considered a target. | |
c8d0cf5c CD |
1593 | Note that, when `org-odd-levels-only' is set, level corresponds to |
1594 | order in hierarchy, not to the number of stars. | |
621f83e4 | 1595 | - a cons cell (:maxlevel . N). Any headline with level <= N is a target. |
c8d0cf5c CD |
1596 | Note that, when `org-odd-levels-only' is set, level corresponds to |
1597 | order in hierarchy, not to the number of stars. | |
1598 | ||
1599 | You can set the variable `org-refile-target-verify-function' to a function | |
1600 | to verify each headline found by the simple critery above. | |
621f83e4 CD |
1601 | |
1602 | When this variable is nil, all top-level headlines in the current buffer | |
93b62de8 | 1603 | are used, equivalent to the value `((nil . (:level . 1))'." |
d60b1ba1 | 1604 | :group 'org-refile |
8c6fb58b CD |
1605 | :type '(repeat |
1606 | (cons | |
1607 | (choice :value org-agenda-files | |
1608 | (const :tag "All agenda files" org-agenda-files) | |
1609 | (const :tag "Current buffer" nil) | |
1610 | (function) (variable) (file)) | |
1611 | (choice :tag "Identify target headline by" | |
ce4fdcb9 CD |
1612 | (cons :tag "Specific tag" (const :value :tag) (string)) |
1613 | (cons :tag "TODO keyword" (const :value :todo) (string)) | |
1614 | (cons :tag "Regular expression" (const :value :regexp) (regexp)) | |
1615 | (cons :tag "Level number" (const :value :level) (integer)) | |
1616 | (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) | |
8c6fb58b | 1617 | |
c8d0cf5c CD |
1618 | (defcustom org-refile-target-verify-function nil |
1619 | "Function to verify if the headline at point should be a refile target. | |
1620 | The function will be called without arguments, with point at the | |
1621 | beginning of the headline. It should return t and leave point | |
1622 | where it is if the headline is a valid target for refiling. | |
1623 | ||
1624 | If the target should not be selected, the function must return nil. | |
1625 | In addition to this, it may move point to a place from where the search | |
1626 | should be continued. For example, the function may decide that the entire | |
1627 | subtree of the current entry should be excluded and move point to the end | |
1628 | of the subtree." | |
1629 | :group 'org-refile | |
1630 | :type 'function) | |
1631 | ||
8c6fb58b CD |
1632 | (defcustom org-refile-use-outline-path nil |
1633 | "Non-nil means, provide refile targets as paths. | |
1634 | So a level 3 headline will be available as level1/level2/level3. | |
c8d0cf5c | 1635 | |
8c6fb58b | 1636 | When the value is `file', also include the file name (without directory) |
c8d0cf5c CD |
1637 | into the path. In this case, you can also stop the completion after |
1638 | the file name, to get entries inserted as top level in the file. | |
1639 | ||
1640 | When `full-file-path', include the full file path." | |
d60b1ba1 | 1641 | :group 'org-refile |
8c6fb58b CD |
1642 | :type '(choice |
1643 | (const :tag "Not" nil) | |
1644 | (const :tag "Yes" t) | |
1645 | (const :tag "Start with file name" file) | |
1646 | (const :tag "Start with full file path" full-file-path))) | |
1647 | ||
d60b1ba1 CD |
1648 | (defcustom org-outline-path-complete-in-steps t |
1649 | "Non-nil means, complete the outline path in hierarchical steps. | |
1650 | When Org-mode uses the refile interface to select an outline path | |
1651 | \(see variable `org-refile-use-outline-path'), the completion of | |
1652 | the path can be done is a single go, or if can be done in steps down | |
1653 | the headline hierarchy. Going in steps is probably the best if you | |
1654 | do not use a special completion package like `ido' or `icicles'. | |
1655 | However, when using these packages, going in one step can be very | |
1656 | fast, while still showing the whole path to the entry." | |
1657 | :group 'org-refile | |
1658 | :type 'boolean) | |
1659 | ||
c8d0cf5c CD |
1660 | (defcustom org-refile-allow-creating-parent-nodes nil |
1661 | "Non-nil means, allow to create new nodes as refile targets. | |
1662 | New nodes are then created by adding \"/new node name\" to the completion | |
1663 | of an existing node. When the value of this variable is `confirm', | |
1664 | new node creation must be confirmed by the user (recommended) | |
1665 | When nil, the completion must match an existing entry. | |
1666 | ||
1667 | Note that, if the new heading is not seen by the criteria | |
1668 | listed in `org-refile-targets', multiple instances of the same | |
1669 | heading would be created by trying again to file under the new | |
1670 | heading." | |
1671 | :group 'org-refile | |
1672 | :type '(choice | |
1673 | (const :tag "Never" nil) | |
1674 | (const :tag "Always" t) | |
1675 | (const :tag "Prompt for confirmation" confirm))) | |
1676 | ||
ab27a4a0 CD |
1677 | (defgroup org-todo nil |
1678 | "Options concerning TODO items in Org-mode." | |
1679 | :tag "Org TODO" | |
891f4676 RS |
1680 | :group 'org) |
1681 | ||
d3f4dbe8 CD |
1682 | (defgroup org-progress nil |
1683 | "Options concerning Progress logging in Org-mode." | |
1684 | :tag "Org Progress" | |
1685 | :group 'org-time) | |
1686 | ||
c8d0cf5c CD |
1687 | (defvar org-todo-interpretation-widgets |
1688 | '( | |
1689 | (:tag "Sequence (cycling hits every state)" sequence) | |
1690 | (:tag "Type (cycling directly to DONE)" type)) | |
1691 | "The available interpretation symbols for customizing | |
1692 | `org-todo-keywords'. | |
1693 | Interested libraries should add to this list.") | |
1694 | ||
a3fbe8c4 CD |
1695 | (defcustom org-todo-keywords '((sequence "TODO" "DONE")) |
1696 | "List of TODO entry keyword sequences and their interpretation. | |
1697 | \\<org-mode-map>This is a list of sequences. | |
1698 | ||
1699 | Each sequence starts with a symbol, either `sequence' or `type', | |
1700 | indicating if the keywords should be interpreted as a sequence of | |
1701 | action steps, or as different types of TODO items. The first | |
1702 | keywords are states requiring action - these states will select a headline | |
1703 | for inclusion into the global TODO list Org-mode produces. If one of | |
1704 | the \"keywords\" is the vertical bat \"|\" the remaining keywords | |
1705 | signify that no further action is necessary. If \"|\" is not found, | |
1706 | the last keyword is treated as the only DONE state of the sequence. | |
1707 | ||
1708 | The command \\[org-todo] cycles an entry through these states, and one | |
ab27a4a0 | 1709 | additional state where no keyword is present. For details about this |
a3fbe8c4 CD |
1710 | cycling, see the manual. |
1711 | ||
1712 | TODO keywords and interpretation can also be set on a per-file basis with | |
1713 | the special #+SEQ_TODO and #+TYP_TODO lines. | |
1714 | ||
2a57416f CD |
1715 | Each keyword can optionally specify a character for fast state selection |
1716 | \(in combination with the variable `org-use-fast-todo-selection') | |
1717 | and specifiers for state change logging, using the same syntax | |
1718 | that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says | |
1719 | that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" | |
1720 | indicates to record a time stamp each time this state is selected. | |
1721 | ||
1722 | Each keyword may also specify if a timestamp or a note should be | |
1723 | recorded when entering or leaving the state, by adding additional | |
1724 | characters in the parenthesis after the keyword. This looks like this: | |
1725 | \"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to | |
1726 | record only the time of the state change. With X and Y being either | |
1727 | \"@\" or \"!\", \"X/Y\" means use X when entering the state, and use | |
1728 | Y when leaving the state if and only if the *target* state does not | |
1729 | define X. You may omit any of the fast-selection key or X or /Y, | |
1730 | so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. | |
1731 | ||
a3fbe8c4 | 1732 | For backward compatibility, this variable may also be just a list |
33306645 | 1733 | of keywords - in this case the interpretation (sequence or type) will be |
a3fbe8c4 | 1734 | taken from the (otherwise obsolete) variable `org-todo-interpretation'." |
ab27a4a0 CD |
1735 | :group 'org-todo |
1736 | :group 'org-keywords | |
a3fbe8c4 CD |
1737 | :type '(choice |
1738 | (repeat :tag "Old syntax, just keywords" | |
1739 | (string :tag "Keyword")) | |
1740 | (repeat :tag "New syntax" | |
1741 | (cons | |
1742 | (choice | |
1743 | :tag "Interpretation" | |
c8d0cf5c CD |
1744 | ;;Quick and dirty way to see |
1745 | ;;`org-todo-interpretations'. This takes the | |
1746 | ;;place of item arguments | |
1747 | :convert-widget | |
1748 | (lambda (widget) | |
1749 | (widget-put widget | |
1750 | :args (mapcar | |
1751 | #'(lambda (x) | |
1752 | (widget-convert | |
1753 | (cons 'const x))) | |
1754 | org-todo-interpretation-widgets)) | |
1755 | widget)) | |
a3fbe8c4 CD |
1756 | (repeat |
1757 | (string :tag "Keyword")))))) | |
1758 | ||
2a57416f CD |
1759 | (defvar org-todo-keywords-1 nil |
1760 | "All TODO and DONE keywords active in a buffer.") | |
a3fbe8c4 CD |
1761 | (make-variable-buffer-local 'org-todo-keywords-1) |
1762 | (defvar org-todo-keywords-for-agenda nil) | |
1763 | (defvar org-done-keywords-for-agenda nil) | |
8d642074 | 1764 | (defvar org-drawers-for-agenda nil) |
621f83e4 CD |
1765 | (defvar org-todo-keyword-alist-for-agenda nil) |
1766 | (defvar org-tag-alist-for-agenda nil) | |
20908596 | 1767 | (defvar org-agenda-contributing-files nil) |
a3fbe8c4 CD |
1768 | (defvar org-not-done-keywords nil) |
1769 | (make-variable-buffer-local 'org-not-done-keywords) | |
1770 | (defvar org-done-keywords nil) | |
1771 | (make-variable-buffer-local 'org-done-keywords) | |
1772 | (defvar org-todo-heads nil) | |
1773 | (make-variable-buffer-local 'org-todo-heads) | |
1774 | (defvar org-todo-sets nil) | |
1775 | (make-variable-buffer-local 'org-todo-sets) | |
d5098885 JW |
1776 | (defvar org-todo-log-states nil) |
1777 | (make-variable-buffer-local 'org-todo-log-states) | |
a3fbe8c4 CD |
1778 | (defvar org-todo-kwd-alist nil) |
1779 | (make-variable-buffer-local 'org-todo-kwd-alist) | |
0b8568f5 JW |
1780 | (defvar org-todo-key-alist nil) |
1781 | (make-variable-buffer-local 'org-todo-key-alist) | |
1782 | (defvar org-todo-key-trigger nil) | |
1783 | (make-variable-buffer-local 'org-todo-key-trigger) | |
791d856f | 1784 | |
ab27a4a0 CD |
1785 | (defcustom org-todo-interpretation 'sequence |
1786 | "Controls how TODO keywords are interpreted. | |
a3fbe8c4 CD |
1787 | This variable is in principle obsolete and is only used for |
1788 | backward compatibility, if the interpretation of todo keywords is | |
1789 | not given already in `org-todo-keywords'. See that variable for | |
1790 | more information." | |
ab27a4a0 CD |
1791 | :group 'org-todo |
1792 | :group 'org-keywords | |
1793 | :type '(choice (const sequence) | |
1794 | (const type))) | |
28e5b051 | 1795 | |
5ace2fe5 | 1796 | (defcustom org-use-fast-todo-selection t |
0b8568f5 JW |
1797 | "Non-nil means, use the fast todo selection scheme with C-c C-t. |
1798 | This variable describes if and under what circumstances the cycling | |
1799 | mechanism for TODO keywords will be replaced by a single-key, direct | |
1800 | selection scheme. | |
1801 | ||
1802 | When nil, fast selection is never used. | |
1803 | ||
1804 | When the symbol `prefix', it will be used when `org-todo' is called with | |
1805 | a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' | |
1806 | in an agenda buffer. | |
1807 | ||
1808 | When t, fast selection is used by default. In this case, the prefix | |
1809 | argument forces cycling instead. | |
1810 | ||
1811 | In all cases, the special interface is only used if access keys have actually | |
1812 | been assigned by the user, i.e. if keywords in the configuration are followed | |
1813 | by a letter in parenthesis, like TODO(t)." | |
1814 | :group 'org-todo | |
1815 | :type '(choice | |
1816 | (const :tag "Never" nil) | |
1817 | (const :tag "By default" t) | |
1818 | (const :tag "Only with C-u C-c C-t" prefix))) | |
1819 | ||
b349f79f CD |
1820 | (defcustom org-provide-todo-statistics t |
1821 | "Non-nil means, update todo statistics after insert and toggle. | |
c8d0cf5c CD |
1822 | ALL-HEADLINES means update todo statistics by including headlines |
1823 | with no TODO keyword as well, counting them as not done. | |
1824 | A list of TODO keywords means the same, but skip keywords that are | |
1825 | not in this list. | |
1826 | ||
1827 | When this is set, todo statistics is updated in the parent of the | |
1828 | current entry each time a todo state is changed." | |
1829 | :group 'org-todo | |
1830 | :type '(choice | |
1831 | (const :tag "Yes, only for TODO entries" t) | |
1832 | (const :tag "Yes, including all entries" 'all-headlines) | |
1833 | (repeat :tag "Yes, for TODOs in this list" | |
1834 | (string :tag "TODO keyword")) | |
1835 | (other :tag "No TODO statistics" nil))) | |
1836 | ||
1837 | (defcustom org-hierarchical-todo-statistics t | |
1838 | "Non-nil means, TODO statistics covers just direct children. | |
1839 | When nil, all entries in the subtree are considered. | |
54a0dee5 CD |
1840 | This has only an effect if `org-provide-todo-statistics' is set. |
1841 | To set this to nil for only a single subtree, use a COOKIE_DATA | |
1842 | property and include the word \"recursive\" into the value." | |
b349f79f CD |
1843 | :group 'org-todo |
1844 | :type 'boolean) | |
1845 | ||
ab27a4a0 CD |
1846 | (defcustom org-after-todo-state-change-hook nil |
1847 | "Hook which is run after the state of a TODO item was changed. | |
1848 | The new state (a string with a TODO keyword, or nil) is available in the | |
1849 | Lisp variable `state'." | |
1850 | :group 'org-todo | |
1851 | :type 'hook) | |
891f4676 | 1852 | |
d6685abc CD |
1853 | (defvar org-blocker-hook nil |
1854 | "Hook for functions that are allowed to block a state change. | |
1855 | ||
1856 | Each function gets as its single argument a property list, see | |
1857 | `org-trigger-hook' for more information about this list. | |
1858 | ||
1859 | If any of the functions in this hook returns nil, the state change | |
1860 | is blocked.") | |
1861 | ||
1862 | (defvar org-trigger-hook nil | |
1863 | "Hook for functions that are triggered by a state change. | |
1864 | ||
1865 | Each function gets as its single argument a property list with at least | |
1866 | the following elements: | |
1867 | ||
1868 | (:type type-of-change :position pos-at-entry-start | |
1869 | :from old-state :to new-state) | |
1870 | ||
1871 | Depending on the type, more properties may be present. | |
1872 | ||
1873 | This mechanism is currently implemented for: | |
1874 | ||
1875 | TODO state changes | |
1876 | ------------------ | |
1877 | :type todo-state-change | |
1878 | :from previous state (keyword as a string), or nil, or a symbol | |
1879 | 'todo' or 'done', to indicate the general type of state. | |
1880 | :to new state, like in :from") | |
1881 | ||
1882 | (defcustom org-enforce-todo-dependencies nil | |
1883 | "Non-nil means, undone TODO entries will block switching the parent to DONE. | |
1884 | Also, if a parent has an :ORDERED: property, switching an entry to DONE will | |
1885 | be blocked if any prior sibling is not yet done. | |
c8d0cf5c CD |
1886 | Finally, if the parent is blocked because of ordered siblings of its own, |
1887 | the child will also be blocked. | |
5ace2fe5 CD |
1888 | This variable needs to be set before org.el is loaded, and you need to |
1889 | restart Emacs after a change to make the change effective. The only way | |
1890 | to change is while Emacs is running is through the customize interface." | |
d6685abc CD |
1891 | :set (lambda (var val) |
1892 | (set var val) | |
1893 | (if val | |
6c817206 | 1894 | (add-hook 'org-blocker-hook |
c8d0cf5c | 1895 | 'org-block-todo-from-children-or-siblings-or-parent) |
6c817206 | 1896 | (remove-hook 'org-blocker-hook |
c8d0cf5c | 1897 | 'org-block-todo-from-children-or-siblings-or-parent))) |
6c817206 CD |
1898 | :group 'org-todo |
1899 | :type 'boolean) | |
1900 | ||
1901 | (defcustom org-enforce-todo-checkbox-dependencies nil | |
1902 | "Non-nil means, unchecked boxes will block switching the parent to DONE. | |
1903 | When this is nil, checkboxes have no influence on switching TODO states. | |
1904 | When non-nil, you first need to check off all check boxes before the TODO | |
1905 | entry can be switched to DONE. | |
5ace2fe5 CD |
1906 | This variable needs to be set before org.el is loaded, and you need to |
1907 | restart Emacs after a change to make the change effective. The only way | |
1908 | to change is while Emacs is running is through the customize interface." | |
6c817206 CD |
1909 | :set (lambda (var val) |
1910 | (set var val) | |
1911 | (if val | |
1912 | (add-hook 'org-blocker-hook | |
1913 | 'org-block-todo-from-checkboxes) | |
1914 | (remove-hook 'org-blocker-hook | |
1915 | 'org-block-todo-from-checkboxes))) | |
d6685abc CD |
1916 | :group 'org-todo |
1917 | :type 'boolean) | |
1918 | ||
c8d0cf5c CD |
1919 | (defcustom org-treat-insert-todo-heading-as-state-change nil |
1920 | "Non-nil means, inserting a TODO heading is treated as state change. | |
1921 | So when the command \\[org-insert-todo-heading] is used, state change | |
1922 | logging will apply if appropriate. When nil, the new TODO item will | |
1923 | be inserted directly, and no logging will take place." | |
1924 | :group 'org-todo | |
1925 | :type 'boolean) | |
1926 | ||
1927 | (defcustom org-treat-S-cursor-todo-selection-as-state-change t | |
1928 | "Non-nil means, switching TODO states with S-cursor counts as state change. | |
1929 | This is the default behavior. However, setting this to nil allows a | |
1930 | convenient way to select a TODO state and bypass any logging associated | |
1931 | with that." | |
1932 | :group 'org-todo | |
1933 | :type 'boolean) | |
1934 | ||
71d35b24 CD |
1935 | (defcustom org-todo-state-tags-triggers nil |
1936 | "Tag changes that should be triggered by TODO state changes. | |
1937 | This is a list. Each entry is | |
1938 | ||
1939 | (state-change (tag . flag) .......) | |
1940 | ||
1941 | State-change can be a string with a state, and empty string to indicate the | |
1942 | state that has no TODO keyword, or it can be one of the symbols `todo' | |
1943 | or `done', meaning any not-done or done state, respectively." | |
1944 | :group 'org-todo | |
1945 | :group 'org-tags | |
1946 | :type '(repeat | |
1947 | (cons (choice :tag "When changing to" | |
1948 | (const :tag "Not-done state" todo) | |
1949 | (const :tag "Done state" done) | |
1950 | (string :tag "State")) | |
1951 | (repeat | |
1952 | (cons :tag "Tag action" | |
1953 | (string :tag "Tag") | |
1954 | (choice (const :tag "Add" t) (const :tag "Remove" nil))))))) | |
1955 | ||
ab27a4a0 | 1956 | (defcustom org-log-done nil |
db55f368 CD |
1957 | "Information to record when a task moves to the DONE state. |
1958 | ||
1959 | Possible values are: | |
1960 | ||
1961 | nil Don't add anything, just change the keyword | |
1962 | time Add a time stamp to the task | |
8bfe682a | 1963 | note Prompt for a note and add it with template `org-log-note-headings' |
4b3a9ba7 | 1964 | |
db55f368 CD |
1965 | This option can also be set with on a per-file-basis with |
1966 | ||
1967 | #+STARTUP: nologdone | |
d3f4dbe8 | 1968 | #+STARTUP: logdone |
d3f4dbe8 | 1969 | #+STARTUP: lognotedone |
db55f368 CD |
1970 | |
1971 | You can have local logging settings for a subtree by setting the LOGGING | |
1972 | property to one or more of these keywords." | |
ab27a4a0 | 1973 | :group 'org-todo |
d3f4dbe8 | 1974 | :group 'org-progress |
3278a016 | 1975 | :type '(choice |
2a57416f CD |
1976 | (const :tag "No logging" nil) |
1977 | (const :tag "Record CLOSED timestamp" time) | |
8bfe682a | 1978 | (const :tag "Record CLOSED timestamp with note." note))) |
2a57416f CD |
1979 | |
1980 | ;; Normalize old uses of org-log-done. | |
1981 | (cond | |
1982 | ((eq org-log-done t) (setq org-log-done 'time)) | |
1983 | ((and (listp org-log-done) (memq 'done org-log-done)) | |
1984 | (setq org-log-done 'note))) | |
1985 | ||
8bfe682a CD |
1986 | (defcustom org-log-reschedule nil |
1987 | "Information to record when the scheduling date of a tasks is modified. | |
1988 | ||
1989 | Possible values are: | |
1990 | ||
1991 | nil Don't add anything, just change the date | |
1992 | time Add a time stamp to the task | |
1993 | note Prompt for a note and add it with template `org-log-note-headings' | |
1994 | ||
1995 | This option can also be set with on a per-file-basis with | |
1996 | ||
1997 | #+STARTUP: nologreschedule | |
1998 | #+STARTUP: logreschedule | |
1999 | #+STARTUP: lognotereschedule" | |
2000 | :group 'org-todo | |
2001 | :group 'org-progress | |
2002 | :type '(choice | |
2003 | (const :tag "No logging" nil) | |
2004 | (const :tag "Record timestamp" time) | |
2005 | (const :tag "Record timestamp with note." note))) | |
2006 | ||
2007 | (defcustom org-log-redeadline nil | |
2008 | "Information to record when the deadline date of a tasks is modified. | |
2009 | ||
2010 | Possible values are: | |
2011 | ||
2012 | nil Don't add anything, just change the date | |
2013 | time Add a time stamp to the task | |
2014 | note Prompt for a note and add it with template `org-log-note-headings' | |
2015 | ||
2016 | This option can also be set with on a per-file-basis with | |
2017 | ||
2018 | #+STARTUP: nologredeadline | |
2019 | #+STARTUP: logredeadline | |
2020 | #+STARTUP: lognoteredeadline | |
2021 | ||
2022 | You can have local logging settings for a subtree by setting the LOGGING | |
2023 | property to one or more of these keywords." | |
2024 | :group 'org-todo | |
2025 | :group 'org-progress | |
2026 | :type '(choice | |
2027 | (const :tag "No logging" nil) | |
2028 | (const :tag "Record timestamp" time) | |
2029 | (const :tag "Record timestamp with note." note))) | |
2030 | ||
2a57416f | 2031 | (defcustom org-log-note-clock-out nil |
621f83e4 | 2032 | "Non-nil means, record a note when clocking out of an item. |
2a57416f CD |
2033 | This can also be configured on a per-file basis by adding one of |
2034 | the following lines anywhere in the buffer: | |
2035 | ||
2036 | #+STARTUP: lognoteclock-out | |
2037 | #+STARTUP: nolognoteclock-out" | |
2038 | :group 'org-todo | |
2039 | :group 'org-progress | |
2040 | :type 'boolean) | |
d3f4dbe8 | 2041 | |
a3fbe8c4 CD |
2042 | (defcustom org-log-done-with-time t |
2043 | "Non-nil means, the CLOSED time stamp will contain date and time. | |
2044 | When nil, only the date will be recorded." | |
2045 | :group 'org-progress | |
2046 | :type 'boolean) | |
2047 | ||
d3f4dbe8 | 2048 | (defcustom org-log-note-headings |
20908596 | 2049 | '((done . "CLOSING NOTE %t") |
c8d0cf5c | 2050 | (state . "State %-12s from %-12S %t") |
20908596 | 2051 | (note . "Note taken on %t") |
8bfe682a CD |
2052 | (reschedule . "Rescheduled from %S on %t") |
2053 | (redeadline . "New deadline from %S on %t") | |
d3f4dbe8 | 2054 | (clock-out . "")) |
20908596 | 2055 | "Headings for notes added to entries. |
48aaad2d | 2056 | The value is an alist, with the car being a symbol indicating the note |
3278a016 | 2057 | context, and the cdr is the heading to be used. The heading may also be the |
d3f4dbe8 CD |
2058 | empty string. |
2059 | %t in the heading will be replaced by a time stamp. | |
2060 | %s will be replaced by the new TODO state, in double quotes. | |
c8d0cf5c | 2061 | %S will be replaced by the old TODO state, in double quotes. |
d3f4dbe8 CD |
2062 | %u will be replaced by the user name. |
2063 | %U will be replaced by the full user name." | |
3278a016 | 2064 | :group 'org-todo |
d3f4dbe8 | 2065 | :group 'org-progress |
3278a016 CD |
2066 | :type '(list :greedy t |
2067 | (cons (const :tag "Heading when closing an item" done) string) | |
d3f4dbe8 CD |
2068 | (cons (const :tag |
2069 | "Heading when changing todo state (todo sequence only)" | |
2070 | state) string) | |
20908596 | 2071 | (cons (const :tag "Heading when just taking a note" note) string) |
8bfe682a CD |
2072 | (cons (const :tag "Heading when clocking out" clock-out) string) |
2073 | (cons (const :tag "Heading when rescheduling" reschedule) string) | |
2074 | (cons (const :tag "Heading when changing deadline" redeadline) string))) | |
e0e66b8e | 2075 | |
20908596 CD |
2076 | (unless (assq 'note org-log-note-headings) |
2077 | (push '(note . "%t") org-log-note-headings)) | |
2078 | ||
c8d0cf5c CD |
2079 | (defcustom org-log-into-drawer nil |
2080 | "Non-nil means, insert state change notes and time stamps into a drawer. | |
2081 | When nil, state changes notes will be inserted after the headline and | |
2082 | any scheduling and clock lines, but not inside a drawer. | |
2083 | ||
2084 | The value of this variable should be the name of the drawer to use. | |
2085 | LOGBOOK is proposed at the default drawer for this purpose, you can | |
2086 | also set this to a string to define the drawer of your choice. | |
2087 | ||
2088 | A value of t is also allowed, representing \"LOGBOOK\". | |
2089 | ||
2090 | If this variable is set, `org-log-state-notes-insert-after-drawers' | |
2091 | will be ignored. | |
2092 | ||
2093 | You can set the property LOG_INTO_DRAWER to overrule this setting for | |
2094 | a subtree." | |
2095 | :group 'org-todo | |
2096 | :group 'org-progress | |
2097 | :type '(choice | |
2098 | (const :tag "Not into a drawer" nil) | |
2099 | (const :tag "LOGBOOK" t) | |
2100 | (string :tag "Other"))) | |
2101 | ||
2102 | (if (fboundp 'defvaralias) | |
2103 | (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)) | |
2104 | ||
2105 | (defun org-log-into-drawer () | |
2106 | "Return the value of `org-log-into-drawer', but let properties overrule. | |
2107 | If the current entry has or inherits a LOG_INTO_DRAWER property, it will be | |
2108 | used instead of the default value." | |
2109 | (let ((p (ignore-errors (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))) | |
2110 | (cond | |
2111 | ((or (not p) (equal p "nil")) org-log-into-drawer) | |
2112 | ((equal p "t") "LOGBOOK") | |
2113 | (t p)))) | |
2114 | ||
71d35b24 CD |
2115 | (defcustom org-log-state-notes-insert-after-drawers nil |
2116 | "Non-nil means, insert state change notes after any drawers in entry. | |
2117 | Only the drawers that *immediately* follow the headline and the | |
2118 | deadline/scheduled line are skipped. | |
2119 | When nil, insert notes right after the heading and perhaps the line | |
c8d0cf5c CD |
2120 | with deadline/scheduling if present. |
2121 | ||
2122 | This variable will have no effect if `org-log-into-drawer' is | |
2123 | set." | |
71d35b24 CD |
2124 | :group 'org-todo |
2125 | :group 'org-progress | |
2126 | :type 'boolean) | |
2127 | ||
48aaad2d CD |
2128 | (defcustom org-log-states-order-reversed t |
2129 | "Non-nil means, the latest state change note will be directly after heading. | |
2130 | When nil, the notes will be orderer according to time." | |
2131 | :group 'org-todo | |
2132 | :group 'org-progress | |
2133 | :type 'boolean) | |
2134 | ||
2a57416f CD |
2135 | (defcustom org-log-repeat 'time |
2136 | "Non-nil means, record moving through the DONE state when triggering repeat. | |
8d642074 CD |
2137 | An auto-repeating task is immediately switched back to TODO when |
2138 | marked DONE. If you are not logging state changes (by adding \"@\" | |
2139 | or \"!\" to the TODO keyword definition), or set `org-log-done' to | |
2140 | record a closing note, there will be no record of the task moving | |
2141 | through DONE. This variable forces taking a note anyway. | |
2a57416f CD |
2142 | |
2143 | nil Don't force a record | |
2144 | time Record a time stamp | |
2145 | note Record a note | |
2146 | ||
15841868 JW |
2147 | This option can also be set with on a per-file-basis with |
2148 | ||
2149 | #+STARTUP: logrepeat | |
2a57416f | 2150 | #+STARTUP: lognoterepeat |
15841868 JW |
2151 | #+STARTUP: nologrepeat |
2152 | ||
2153 | You can have local logging settings for a subtree by setting the LOGGING | |
2154 | property to one or more of these keywords." | |
d3f4dbe8 CD |
2155 | :group 'org-todo |
2156 | :group 'org-progress | |
2a57416f CD |
2157 | :type '(choice |
2158 | (const :tag "Don't force a record" nil) | |
2159 | (const :tag "Force recording the DONE state" time) | |
2160 | (const :tag "Force recording a note with the DONE state" note))) | |
d3f4dbe8 | 2161 | |
8c6fb58b | 2162 | |
ab27a4a0 | 2163 | (defgroup org-priorities nil |
4146eb16 | 2164 | "Priorities in Org-mode." |
ab27a4a0 CD |
2165 | :tag "Org Priorities" |
2166 | :group 'org-todo) | |
28e5b051 | 2167 | |
c8d0cf5c CD |
2168 | (defcustom org-enable-priority-commands t |
2169 | "Non-nil means, priority commands are active. | |
2170 | When nil, these commands will be disabled, so that you never accidentally | |
2171 | set a priority." | |
2172 | :group 'org-priorities | |
2173 | :type 'boolean) | |
2174 | ||
a3fbe8c4 CD |
2175 | (defcustom org-highest-priority ?A |
2176 | "The highest priority of TODO items. A character like ?A, ?B etc. | |
2177 | Must have a smaller ASCII number than `org-lowest-priority'." | |
ab27a4a0 CD |
2178 | :group 'org-priorities |
2179 | :type 'character) | |
891f4676 | 2180 | |
ab27a4a0 | 2181 | (defcustom org-lowest-priority ?C |
a3fbe8c4 CD |
2182 | "The lowest priority of TODO items. A character like ?A, ?B etc. |
2183 | Must have a larger ASCII number than `org-highest-priority'." | |
2184 | :group 'org-priorities | |
2185 | :type 'character) | |
2186 | ||
2187 | (defcustom org-default-priority ?B | |
2188 | "The default priority of TODO items. | |
2189 | This is the priority an item get if no explicit priority is given." | |
ab27a4a0 CD |
2190 | :group 'org-priorities |
2191 | :type 'character) | |
2192 | ||
15841868 JW |
2193 | (defcustom org-priority-start-cycle-with-default t |
2194 | "Non-nil means, start with default priority when starting to cycle. | |
2195 | When this is nil, the first step in the cycle will be (depending on the | |
2196 | command used) one higher or lower that the default priority." | |
2197 | :group 'org-priorities | |
2198 | :type 'boolean) | |
2199 | ||
ab27a4a0 CD |
2200 | (defgroup org-time nil |
2201 | "Options concerning time stamps and deadlines in Org-mode." | |
2202 | :tag "Org Time" | |
2203 | :group 'org) | |
2204 | ||
4b3a9ba7 CD |
2205 | (defcustom org-insert-labeled-timestamps-at-point nil |
2206 | "Non-nil means, SCHEDULED and DEADLINE timestamps are inserted at point. | |
2207 | When nil, these labeled time stamps are forces into the second line of an | |
2208 | entry, just after the headline. When scheduling from the global TODO list, | |
2209 | the time stamp will always be forced into the second line." | |
2210 | :group 'org-time | |
2211 | :type 'boolean) | |
2212 | ||
ab27a4a0 CD |
2213 | (defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") |
2214 | "Formats for `format-time-string' which are used for time stamps. | |
2215 | It is not recommended to change this constant.") | |
2216 | ||
2a57416f CD |
2217 | (defcustom org-time-stamp-rounding-minutes '(0 5) |
2218 | "Number of minutes to round time stamps to. | |
2219 | These are two values, the first applies when first creating a time stamp. | |
2220 | The second applies when changing it with the commands `S-up' and `S-down'. | |
2221 | When changing the time stamp, this means that it will change in steps | |
5bf7807a | 2222 | of N minutes, as given by the second value. |
2a57416f CD |
2223 | |
2224 | When a setting is 0 or 1, insert the time unmodified. Useful rounding | |
2225 | numbers should be factors of 60, so for example 5, 10, 15. | |
2226 | ||
2227 | When this is larger than 1, you can still force an exact time-stamp by using | |
2228 | a double prefix argument to a time-stamp command like `C-c .' or `C-c !', | |
2229 | and by using a prefix arg to `S-up/down' to specify the exact number | |
2230 | of minutes to shift." | |
ab27a4a0 | 2231 | :group 'org-time |
2a57416f CD |
2232 | :get '(lambda (var) ; Make sure all entries have 5 elements |
2233 | (if (integerp (default-value var)) | |
2234 | (list (default-value var) 5) | |
2235 | (default-value var))) | |
2236 | :type '(list | |
2237 | (integer :tag "when inserting times") | |
2238 | (integer :tag "when modifying times"))) | |
2239 | ||
20908596 | 2240 | ;; Normalize old customizations of this variable. |
2a57416f CD |
2241 | (when (integerp org-time-stamp-rounding-minutes) |
2242 | (setq org-time-stamp-rounding-minutes | |
2243 | (list org-time-stamp-rounding-minutes | |
2244 | org-time-stamp-rounding-minutes))) | |
ab27a4a0 | 2245 | |
3278a016 CD |
2246 | (defcustom org-display-custom-times nil |
2247 | "Non-nil means, overlay custom formats over all time stamps. | |
2248 | The formats are defined through the variable `org-time-stamp-custom-formats'. | |
2249 | To turn this on on a per-file basis, insert anywhere in the file: | |
2250 | #+STARTUP: customtime" | |
2251 | :group 'org-time | |
2252 | :set 'set-default | |
2253 | :type 'sexp) | |
2254 | (make-variable-buffer-local 'org-display-custom-times) | |
2255 | ||
2256 | (defcustom org-time-stamp-custom-formats | |
2257 | '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american | |
2258 | "Custom formats for time stamps. See `format-time-string' for the syntax. | |
2259 | These are overlayed over the default ISO format if the variable | |
b38c6895 | 2260 | `org-display-custom-times' is set. Time like %H:%M should be at the |
c8d0cf5c CD |
2261 | end of the second format. The custom formats are also honored by export |
2262 | commands, if custom time display is turned on at the time of export." | |
3278a016 CD |
2263 | :group 'org-time |
2264 | :type 'sexp) | |
2265 | ||
d3f4dbe8 CD |
2266 | (defun org-time-stamp-format (&optional long inactive) |
2267 | "Get the right format for a time string." | |
2268 | (let ((f (if long (cdr org-time-stamp-formats) | |
2269 | (car org-time-stamp-formats)))) | |
2270 | (if inactive | |
2271 | (concat "[" (substring f 1 -1) "]") | |
2272 | f))) | |
2273 | ||
b349f79f CD |
2274 | (defcustom org-time-clocksum-format "%d:%02d" |
2275 | "The format string used when creating CLOCKSUM lines, or when | |
2276 | org-mode generates a time duration." | |
2277 | :group 'org-time | |
2278 | :type 'string) | |
ce4fdcb9 | 2279 | |
8bfe682a CD |
2280 | (defcustom org-time-clocksum-use-fractional nil |
2281 | "If non-nil, \\[org-clock-display] uses fractional times. | |
2282 | org-mode generates a time duration." | |
2283 | :group 'org-time | |
2284 | :type 'boolean) | |
2285 | ||
2286 | (defcustom org-time-clocksum-fractional-format "%.2f" | |
2287 | "The format string used when creating CLOCKSUM lines, or when | |
2288 | org-mode generates a time duration." | |
2289 | :group 'org-time | |
2290 | :type 'string) | |
2291 | ||
20908596 CD |
2292 | (defcustom org-deadline-warning-days 14 |
2293 | "No. of days before expiration during which a deadline becomes active. | |
2294 | This variable governs the display in sparse trees and in the agenda. | |
2295 | When 0 or negative, it means use this number (the absolute value of it) | |
c8d0cf5c CD |
2296 | even if a deadline has a different individual lead time specified. |
2297 | ||
2298 | Custom commands can set this variable in the options section." | |
20908596 CD |
2299 | :group 'org-time |
2300 | :group 'org-agenda-daily/weekly | |
c8d0cf5c | 2301 | :type 'integer) |
20908596 | 2302 | |
8c6fb58b CD |
2303 | (defcustom org-read-date-prefer-future t |
2304 | "Non-nil means, assume future for incomplete date input from user. | |
2305 | This affects the following situations: | |
8bfe682a CD |
2306 | 1. The user gives a month but not a year. |
2307 | For example, if it is april and you enter \"feb 2\", this will be read | |
2308 | as feb 2, *next* year. \"May 5\", however, will be this year. | |
2309 | 2. The user gives a day, but no month. | |
8c6fb58b CD |
2310 | For example, if today is the 15th, and you enter \"3\", Org-mode will |
2311 | read this as the third of *next* month. However, if you enter \"17\", | |
2312 | it will be considered as *this* month. | |
8c6fb58b | 2313 | |
8bfe682a CD |
2314 | If you set this variable to the symbol `time', then also the following |
2315 | will work: | |
2316 | ||
2317 | 3. If the user gives a time, but no day. If the time is before now, | |
2318 | to will be interpreted as tomorrow. | |
20908596 | 2319 | |
8bfe682a CD |
2320 | Currently none of this works for ISO week specifications. |
2321 | ||
2322 | When this option is nil, the current day, month and year will always be | |
2323 | used as defaults." | |
8c6fb58b | 2324 | :group 'org-time |
8bfe682a CD |
2325 | :type '(choice |
2326 | (const :tag "Never" nil) | |
2327 | (const :tag "Check month and day" t) | |
2328 | (const :tag "Check month, day, and time" time))) | |
8c6fb58b CD |
2329 | |
2330 | (defcustom org-read-date-display-live t | |
2331 | "Non-nil means, display current interpretation of date prompt live. | |
2332 | This display will be in an overlay, in the minibuffer." | |
2333 | :group 'org-time | |
2334 | :type 'boolean) | |
2335 | ||
2336 | (defcustom org-read-date-popup-calendar t | |
ab27a4a0 CD |
2337 | "Non-nil means, pop up a calendar when prompting for a date. |
2338 | In the calendar, the date can be selected with mouse-1. However, the | |
2339 | minibuffer will also be active, and you can simply enter the date as well. | |
2340 | When nil, only the minibuffer will be available." | |
2341 | :group 'org-time | |
891f4676 | 2342 | :type 'boolean) |
8c6fb58b CD |
2343 | (if (fboundp 'defvaralias) |
2344 | (defvaralias 'org-popup-calendar-for-date-prompt | |
2345 | 'org-read-date-popup-calendar)) | |
2346 | ||
c8d0cf5c CD |
2347 | (defcustom org-read-date-minibuffer-setup-hook nil |
2348 | "Hook to be used to set up keys for the date/time interface. | |
2349 | Add key definitions to `minibuffer-local-map', which will be a temporary | |
2350 | copy." | |
2351 | :group 'org-time | |
2352 | :type 'hook) | |
2353 | ||
8c6fb58b | 2354 | (defcustom org-extend-today-until 0 |
621f83e4 | 2355 | "The hour when your day really ends. Must be an integer. |
8c6fb58b CD |
2356 | This has influence for the following applications: |
2357 | - When switching the agenda to \"today\". It it is still earlier than | |
2358 | the time given here, the day recognized as TODAY is actually yesterday. | |
2359 | - When a date is read from the user and it is still before the time given | |
2360 | here, the current date and time will be assumed to be yesterday, 23:59. | |
621f83e4 | 2361 | Also, timestamps inserted in remember templates follow this rule. |
8c6fb58b | 2362 | |
621f83e4 CD |
2363 | IMPORTANT: This is a feature whose implementation is and likely will |
2364 | remain incomplete. Really, it is only here because past midnight seems to | |
71d35b24 | 2365 | be the favorite working time of John Wiegley :-)" |
8c6fb58b | 2366 | :group 'org-time |
c8d0cf5c | 2367 | :type 'integer) |
891f4676 | 2368 | |
0b8568f5 JW |
2369 | (defcustom org-edit-timestamp-down-means-later nil |
2370 | "Non-nil means, S-down will increase the time in a time stamp. | |
2371 | When nil, S-up will increase." | |
2372 | :group 'org-time | |
2373 | :type 'boolean) | |
2374 | ||
ab27a4a0 CD |
2375 | (defcustom org-calendar-follow-timestamp-change t |
2376 | "Non-nil means, make the calendar window follow timestamp changes. | |
2377 | When a timestamp is modified and the calendar window is visible, it will be | |
2378 | moved to the new date." | |
2379 | :group 'org-time | |
2380 | :type 'boolean) | |
891f4676 | 2381 | |
ab27a4a0 | 2382 | (defgroup org-tags nil |
4146eb16 | 2383 | "Options concerning tags in Org-mode." |
ab27a4a0 CD |
2384 | :tag "Org Tags" |
2385 | :group 'org) | |
891f4676 | 2386 | |
4b3a9ba7 CD |
2387 | (defcustom org-tag-alist nil |
2388 | "List of tags allowed in Org-mode files. | |
2389 | When this list is nil, Org-mode will base TAG input on what is already in the | |
2390 | buffer. | |
0b8568f5 JW |
2391 | The value of this variable is an alist, the car of each entry must be a |
2392 | keyword as a string, the cdr may be a character that is used to select | |
2393 | that tag through the fast-tag-selection interface. | |
2394 | See the manual for details." | |
4b3a9ba7 CD |
2395 | :group 'org-tags |
2396 | :type '(repeat | |
7d143c25 CD |
2397 | (choice |
2398 | (cons (string :tag "Tag name") | |
2399 | (character :tag "Access char")) | |
8bfe682a CD |
2400 | (list :tag "Start radio group" |
2401 | (const :startgroup) | |
2402 | (option (string :tag "Group description"))) | |
2403 | (list :tag "End radio group" | |
2404 | (const :endgroup) | |
2405 | (option (string :tag "Group description"))) | |
c8d0cf5c CD |
2406 | (const :tag "New line" (:newline))))) |
2407 | ||
2408 | (defcustom org-tag-persistent-alist nil | |
2409 | "List of tags that will always appear in all Org-mode files. | |
2410 | This is in addition to any in buffer settings or customizations | |
2411 | of `org-tag-alist'. | |
2412 | When this list is nil, Org-mode will base TAG input on `org-tag-alist'. | |
2413 | The value of this variable is an alist, the car of each entry must be a | |
2414 | keyword as a string, the cdr may be a character that is used to select | |
2415 | that tag through the fast-tag-selection interface. | |
2416 | See the manual for details. | |
2417 | To disable these tags on a per-file basis, insert anywhere in the file: | |
2418 | #+STARTUP: noptag" | |
2419 | :group 'org-tags | |
2420 | :type '(repeat | |
2421 | (choice | |
2422 | (cons (string :tag "Tag name") | |
2423 | (character :tag "Access char")) | |
2424 | (const :tag "Start radio group" (:startgroup)) | |
2425 | (const :tag "End radio group" (:endgroup)) | |
2426 | (const :tag "New line" (:newline))))) | |
4b3a9ba7 | 2427 | |
b349f79f CD |
2428 | (defvar org-file-tags nil |
2429 | "List of tags that can be inherited by all entries in the file. | |
2430 | The tags will be inherited if the variable `org-use-tag-inheritance' | |
2431 | says they should be. | |
8bfe682a | 2432 | This variable is populated from #+FILETAGS lines.") |
b349f79f | 2433 | |
4b3a9ba7 CD |
2434 | (defcustom org-use-fast-tag-selection 'auto |
2435 | "Non-nil means, use fast tag selection scheme. | |
2436 | This is a special interface to select and deselect tags with single keys. | |
2437 | When nil, fast selection is never used. | |
2438 | When the symbol `auto', fast selection is used if and only if selection | |
2439 | characters for tags have been configured, either through the variable | |
2440 | `org-tag-alist' or through a #+TAGS line in the buffer. | |
2441 | When t, fast selection is always used and selection keys are assigned | |
2442 | automatically if necessary." | |
2443 | :group 'org-tags | |
2444 | :type '(choice | |
2445 | (const :tag "Always" t) | |
2446 | (const :tag "Never" nil) | |
2447 | (const :tag "When selection characters are configured" 'auto))) | |
2448 | ||
3278a016 CD |
2449 | (defcustom org-fast-tag-selection-single-key nil |
2450 | "Non-nil means, fast tag selection exits after first change. | |
2451 | When nil, you have to press RET to exit it. | |
d3f4dbe8 CD |
2452 | During fast tag selection, you can toggle this flag with `C-c'. |
2453 | This variable can also have the value `expert'. In this case, the window | |
2454 | displaying the tags menu is not even shown, until you press C-c again." | |
3278a016 | 2455 | :group 'org-tags |
d3f4dbe8 CD |
2456 | :type '(choice |
2457 | (const :tag "No" nil) | |
2458 | (const :tag "Yes" t) | |
2459 | (const :tag "Expert" expert))) | |
3278a016 | 2460 | |
d5098885 JW |
2461 | (defvar org-fast-tag-selection-include-todo nil |
2462 | "Non-nil means, fast tags selection interface will also offer TODO states. | |
2463 | This is an undocumented feature, you should not rely on it.") | |
0b8568f5 | 2464 | |
5ace2fe5 | 2465 | (defcustom org-tags-column (if (featurep 'xemacs) -76 -77) |
ab27a4a0 CD |
2466 | "The column to which tags should be indented in a headline. |
2467 | If this number is positive, it specifies the column. If it is negative, | |
2468 | it means that the tags should be flushright to that column. For example, | |
15841868 | 2469 | -80 works well for a normal 80 character screen." |
ab27a4a0 CD |
2470 | :group 'org-tags |
2471 | :type 'integer) | |
891f4676 | 2472 | |
ab27a4a0 CD |
2473 | (defcustom org-auto-align-tags t |
2474 | "Non-nil means, realign tags after pro/demotion of TODO state change. | |
2475 | These operations change the length of a headline and therefore shift | |
2476 | the tags around. With this options turned on, after each such operation | |
2477 | the tags are again aligned to `org-tags-column'." | |
2478 | :group 'org-tags | |
2479 | :type 'boolean) | |
891f4676 | 2480 | |
ab27a4a0 CD |
2481 | (defcustom org-use-tag-inheritance t |
2482 | "Non-nil means, tags in levels apply also for sublevels. | |
2483 | When nil, only the tags directly given in a specific line apply there. | |
20908596 | 2484 | This may also be a list of tags that should be inherited, or a regexp that |
ff4be292 CD |
2485 | matches tags that should be inherited. Additional control is possible |
2486 | with the variable `org-tags-exclude-from-inheritance' which gives an | |
2487 | explicit list of tags to be excluded from inheritance., even if the value of | |
2488 | `org-use-tag-inheritance' would select it for inheritance. | |
2489 | ||
2490 | If this option is t, a match early-on in a tree can lead to a large | |
2491 | number of matches in the subtree when constructing the agenda or creating | |
2492 | a sparse tree. If you only want to see the first match in a tree during | |
2493 | a search, check out the variable `org-tags-match-list-sublevels'." | |
ab27a4a0 | 2494 | :group 'org-tags |
20908596 CD |
2495 | :type '(choice |
2496 | (const :tag "Not" nil) | |
2497 | (const :tag "Always" t) | |
2498 | (repeat :tag "Specific tags" (string :tag "Tag")) | |
2499 | (regexp :tag "Tags matched by regexp"))) | |
2500 | ||
ff4be292 CD |
2501 | (defcustom org-tags-exclude-from-inheritance nil |
2502 | "List of tags that should never be inherited. | |
2503 | This is a way to exclude a few tags from inheritance. For way to do | |
2504 | the opposite, to actively allow inheritance for selected tags, | |
2505 | see the variable `org-use-tag-inheritance'." | |
2506 | :group 'org-tags | |
2507 | :type '(repeat (string :tag "Tag"))) | |
2508 | ||
20908596 CD |
2509 | (defun org-tag-inherit-p (tag) |
2510 | "Check if TAG is one that should be inherited." | |
2511 | (cond | |
ff4be292 | 2512 | ((member tag org-tags-exclude-from-inheritance) nil) |
20908596 CD |
2513 | ((eq org-use-tag-inheritance t) t) |
2514 | ((not org-use-tag-inheritance) nil) | |
2515 | ((stringp org-use-tag-inheritance) | |
2516 | (string-match org-use-tag-inheritance tag)) | |
2517 | ((listp org-use-tag-inheritance) | |
2518 | (member tag org-use-tag-inheritance)) | |
2519 | (t (error "Invalid setting of `org-use-tag-inheritance'")))) | |
ab27a4a0 | 2520 | |
b349f79f | 2521 | (defcustom org-tags-match-list-sublevels t |
c8d0cf5c CD |
2522 | "Non-nil means list also sublevels of headlines matching a search. |
2523 | This variable applies to tags/property searches, and also to stuck | |
2524 | projects because this search is based on a tags match as well. | |
2525 | ||
2526 | When set to the symbol `indented', sublevels are indented with | |
2527 | leading dots. | |
2528 | ||
ab27a4a0 CD |
2529 | Because of tag inheritance (see variable `org-use-tag-inheritance'), |
2530 | the sublevels of a headline matching a tag search often also match | |
2531 | the same search. Listing all of them can create very long lists. | |
2532 | Setting this variable to nil causes subtrees of a match to be skipped. | |
ff4be292 CD |
2533 | |
2534 | This variable is semi-obsolete and probably should always be true. It | |
2535 | is better to limit inheritance to certain tags using the variables | |
33306645 | 2536 | `org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'." |
ab27a4a0 | 2537 | :group 'org-tags |
c8d0cf5c CD |
2538 | :type '(choice |
2539 | (const :tag "No, don't list them" nil) | |
2540 | (const :tag "Yes, do list them" t) | |
2541 | (const :tag "List them, indented with leading dots" indented))) | |
2542 | ||
2543 | (defcustom org-tags-sort-function nil | |
2544 | "When set, tags are sorted using this function as a comparator" | |
2545 | :group 'org-tags | |
2546 | :type '(choice | |
2547 | (const :tag "No sorting" nil) | |
2548 | (const :tag "Alphabetical" string<) | |
2549 | (const :tag "Reverse alphabetical" string>) | |
2550 | (function :tag "Custom function" nil))) | |
ab27a4a0 CD |
2551 | |
2552 | (defvar org-tags-history nil | |
2553 | "History of minibuffer reads for tags.") | |
2554 | (defvar org-last-tags-completion-table nil | |
2555 | "The last used completion table for tags.") | |
d5098885 JW |
2556 | (defvar org-after-tags-change-hook nil |
2557 | "Hook that is run after the tags in a line have changed.") | |
ab27a4a0 | 2558 | |
38f8646b CD |
2559 | (defgroup org-properties nil |
2560 | "Options concerning properties in Org-mode." | |
2561 | :tag "Org Properties" | |
2562 | :group 'org) | |
2563 | ||
2564 | (defcustom org-property-format "%-10s %s" | |
2565 | "How property key/value pairs should be formatted by `indent-line'. | |
2566 | When `indent-line' hits a property definition, it will format the line | |
2567 | according to this format, mainly to make sure that the values are | |
2568 | lined-up with respect to each other." | |
2569 | :group 'org-properties | |
2570 | :type 'string) | |
2571 | ||
03f3cf35 JW |
2572 | (defcustom org-use-property-inheritance nil |
2573 | "Non-nil means, properties apply also for sublevels. | |
20908596 CD |
2574 | |
2575 | This setting is chiefly used during property searches. Turning it on can | |
2576 | cause significant overhead when doing a search, which is why it is not | |
2577 | on by default. | |
2578 | ||
03f3cf35 | 2579 | When nil, only the properties directly given in the current entry count. |
20908596 CD |
2580 | When t, every property is inherited. The value may also be a list of |
2581 | properties that should have inheritance, or a regular expression matching | |
2582 | properties that should be inherited. | |
03f3cf35 JW |
2583 | |
2584 | However, note that some special properties use inheritance under special | |
2585 | circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, | |
2586 | and the properties ending in \"_ALL\" when they are used as descriptor | |
20908596 CD |
2587 | for valid values of a property. |
2588 | ||
2589 | Note for programmers: | |
2590 | When querying an entry with `org-entry-get', you can control if inheritance | |
2591 | should be used. By default, `org-entry-get' looks only at the local | |
2592 | properties. You can request inheritance by setting the inherit argument | |
2593 | to t (to force inheritance) or to `selective' (to respect the setting | |
2594 | in this variable)." | |
03f3cf35 | 2595 | :group 'org-properties |
8c6fb58b CD |
2596 | :type '(choice |
2597 | (const :tag "Not" nil) | |
20908596 CD |
2598 | (const :tag "Always" t) |
2599 | (repeat :tag "Specific properties" (string :tag "Property")) | |
2600 | (regexp :tag "Properties matched by regexp"))) | |
2601 | ||
2602 | (defun org-property-inherit-p (property) | |
2603 | "Check if PROPERTY is one that should be inherited." | |
2604 | (cond | |
2605 | ((eq org-use-property-inheritance t) t) | |
2606 | ((not org-use-property-inheritance) nil) | |
2607 | ((stringp org-use-property-inheritance) | |
2608 | (string-match org-use-property-inheritance property)) | |
2609 | ((listp org-use-property-inheritance) | |
2610 | (member property org-use-property-inheritance)) | |
2611 | (t (error "Invalid setting of `org-use-property-inheritance'")))) | |
03f3cf35 | 2612 | |
7d58338e | 2613 | (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" |
38f8646b CD |
2614 | "The default column format, if no other format has been defined. |
2615 | This variable can be set on the per-file basis by inserting a line | |
2616 | ||
2617 | #+COLUMNS: %25ITEM ....." | |
2618 | :group 'org-properties | |
2619 | :type 'string) | |
2620 | ||
b349f79f CD |
2621 | (defcustom org-columns-ellipses ".." |
2622 | "The ellipses to be used when a field in column view is truncated. | |
2623 | When this is the empty string, as many characters as possible are shown, | |
2624 | but then there will be no visual indication that the field has been truncated. | |
2625 | When this is a string of length N, the last N characters of a truncated | |
2626 | field are replaced by this string. If the column is narrower than the | |
2627 | ellipses string, only part of the ellipses string will be shown." | |
2628 | :group 'org-properties | |
2629 | :type 'string) | |
2630 | ||
621f83e4 CD |
2631 | (defcustom org-columns-modify-value-for-display-function nil |
2632 | "Function that modifies values for display in column view. | |
2633 | For example, it can be used to cut out a certain part from a time stamp. | |
40ac2137 | 2634 | The function must take 2 arguments: |
621f83e4 | 2635 | |
33306645 | 2636 | column-title The title of the column (*not* the property name) |
621f83e4 CD |
2637 | value The value that should be modified. |
2638 | ||
2639 | The function should return the value that should be displayed, | |
2640 | or nil if the normal value should be used." | |
2641 | :group 'org-properties | |
2642 | :type 'function) | |
b349f79f | 2643 | |
20908596 CD |
2644 | (defcustom org-effort-property "Effort" |
2645 | "The property that is being used to keep track of effort estimates. | |
2646 | Effort estimates given in this property need to have the format H:MM." | |
2647 | :group 'org-properties | |
2648 | :group 'org-progress | |
2649 | :type '(string :tag "Property")) | |
2650 | ||
b349f79f | 2651 | (defconst org-global-properties-fixed |
c8d0cf5c CD |
2652 | '(("VISIBILITY_ALL" . "folded children content all") |
2653 | ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) | |
b349f79f | 2654 | "List of property/value pairs that can be inherited by any entry. |
b349f79f | 2655 | |
c8d0cf5c CD |
2656 | These are fixed values, for the preset properties. The user variable |
2657 | that can be used to add to this list is `org-global-properties'. | |
2658 | ||
2659 | The entries in this list are cons cells where the car is a property | |
2660 | name and cdr is a string with the value. If the value represents | |
2661 | multiple items like an \"_ALL\" property, separate the items by | |
2662 | spaces.") | |
b349f79f | 2663 | |
48aaad2d CD |
2664 | (defcustom org-global-properties nil |
2665 | "List of property/value pairs that can be inherited by any entry. | |
c8d0cf5c CD |
2666 | |
2667 | This list will be combined with the constant `org-global-properties-fixed'. | |
2668 | ||
2669 | The entries in this list are cons cells where the car is a property | |
2670 | name and cdr is a string with the value. | |
2671 | ||
ce4fdcb9 CD |
2672 | You can set buffer-local values for the same purpose in the variable |
2673 | `org-file-properties' this by adding lines like | |
48aaad2d CD |
2674 | |
2675 | #+PROPERTY: NAME VALUE" | |
2676 | :group 'org-properties | |
2677 | :type '(repeat | |
2678 | (cons (string :tag "Property") | |
2679 | (string :tag "Value")))) | |
2680 | ||
b349f79f | 2681 | (defvar org-file-properties nil |
48aaad2d CD |
2682 | "List of property/value pairs that can be inherited by any entry. |
2683 | Valid for the current buffer. | |
2684 | This variable is populated from #+PROPERTY lines.") | |
b349f79f | 2685 | (make-variable-buffer-local 'org-file-properties) |
38f8646b | 2686 | |
ab27a4a0 | 2687 | (defgroup org-agenda nil |
d3f4dbe8 | 2688 | "Options concerning agenda views in Org-mode." |
ab27a4a0 CD |
2689 | :tag "Org Agenda" |
2690 | :group 'org) | |
2691 | ||
2692 | (defvar org-category nil | |
2693 | "Variable used by org files to set a category for agenda display. | |
2694 | Such files should use a file variable to set it, for example | |
2695 | ||
a3fbe8c4 | 2696 | # -*- mode: org; org-category: \"ELisp\" |
ab27a4a0 CD |
2697 | |
2698 | or contain a special line | |
2699 | ||
2700 | #+CATEGORY: ELisp | |
2701 | ||
2702 | If the file does not specify a category, then file's base name | |
2703 | is used instead.") | |
2704 | (make-variable-buffer-local 'org-category) | |
621f83e4 | 2705 | (put 'org-category 'safe-local-variable '(lambda (x) (or (symbolp x) (stringp x)))) |
ab27a4a0 CD |
2706 | |
2707 | (defcustom org-agenda-files nil | |
2708 | "The files to be used for agenda display. | |
2709 | Entries may be added to this list with \\[org-agenda-file-to-front] and removed with | |
2710 | \\[org-remove-file]. You can also use customize to edit the list. | |
2711 | ||
03f3cf35 JW |
2712 | If an entry is a directory, all files in that directory that are matched by |
2713 | `org-agenda-file-regexp' will be part of the file list. | |
2714 | ||
ab27a4a0 CD |
2715 | If the value of the variable is not a list but a single file name, then |
2716 | the list of agenda files is actually stored and maintained in that file, one | |
2717 | agenda file per line." | |
2718 | :group 'org-agenda | |
891f4676 | 2719 | :type '(choice |
03f3cf35 | 2720 | (repeat :tag "List of files and directories" file) |
ab27a4a0 | 2721 | (file :tag "Store list in a file\n" :value "~/.agenda_files"))) |
891f4676 | 2722 | |
8c6fb58b | 2723 | (defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" |
03f3cf35 | 2724 | "Regular expression to match files for `org-agenda-files'. |
fbe6c10d | 2725 | If any element in the list in that variable contains a directory instead |
03f3cf35 JW |
2726 | of a normal file, all files in that directory that are matched by this |
2727 | regular expression will be included." | |
2728 | :group 'org-agenda | |
2729 | :type 'regexp) | |
2730 | ||
2a57416f CD |
2731 | (defcustom org-agenda-text-search-extra-files nil |
2732 | "List of extra files to be searched by text search commands. | |
20908596 | 2733 | These files will be search in addition to the agenda files by the |
2a57416f CD |
2734 | commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'. |
2735 | Note that these files will only be searched for text search commands, | |
20908596 | 2736 | not for the other agenda views like todo lists, tag searches or the weekly |
2a57416f | 2737 | agenda. This variable is intended to list notes and possibly archive files |
20908596 CD |
2738 | that should also be searched by these two commands. |
2739 | In fact, if the first element in the list is the symbol `agenda-archives', | |
2740 | than all archive files of all agenda files will be added to the search | |
2741 | scope." | |
03f3cf35 | 2742 | :group 'org-agenda |
20908596 CD |
2743 | :type '(set :greedy t |
2744 | (const :tag "Agenda Archives" agenda-archives) | |
2745 | (repeat :inline t (file)))) | |
03f3cf35 | 2746 | |
2a57416f CD |
2747 | (if (fboundp 'defvaralias) |
2748 | (defvaralias 'org-agenda-multi-occur-extra-files | |
2749 | 'org-agenda-text-search-extra-files)) | |
2750 | ||
20908596 | 2751 | (defcustom org-agenda-skip-unavailable-files nil |
cf7241c8 JB |
2752 | "Non-nil means to just skip non-reachable files in `org-agenda-files'. |
2753 | A nil value means to remove them, after a query, from the list." | |
d3f4dbe8 | 2754 | :group 'org-agenda |
20908596 | 2755 | :type 'boolean) |
d3f4dbe8 CD |
2756 | |
2757 | (defcustom org-calendar-to-agenda-key [?c] | |
2758 | "The key to be installed in `calendar-mode-map' for switching to the agenda. | |
2759 | The command `org-calendar-goto-agenda' will be bound to this key. The | |
2760 | default is the character `c' because then `c' can be used to switch back and | |
2761 | forth between agenda and calendar." | |
2762 | :group 'org-agenda | |
2763 | :type 'sexp) | |
2764 | ||
b349f79f CD |
2765 | (defcustom org-calendar-agenda-action-key [?k] |
2766 | "The key to be installed in `calendar-mode-map' for agenda-action. | |
2767 | The command `org-agenda-action' will be bound to this key. The | |
2768 | default is the character `k' because we use the same key in the agenda." | |
2769 | :group 'org-agenda | |
2770 | :type 'sexp) | |
2771 | ||
8bfe682a CD |
2772 | (defcustom org-calendar-insert-diary-entry-key [?i] |
2773 | "The key to be installed in `calendar-mode-map' for adding diary entries. | |
2774 | This option is irrelevant until `org-agenda-diary-file' has been configured | |
2775 | to point to an Org-mode file. When that is the case, the command | |
2776 | `org-agenda-diary-entry' will be bound to the key given here, by default | |
2777 | `i'. In the calendar, `i' normally adds entries to `diary-file'. So | |
2778 | if you want to continue doing this, you need to change this to a different | |
2779 | key." | |
2780 | :group 'org-agenda | |
2781 | :type 'sexp) | |
2782 | ||
2783 | (defcustom org-agenda-diary-file 'diary-file | |
2784 | "File to which to add new entries with the `i' key in agenda and calendar. | |
2785 | When this is the symbol `diary-file', the functionality in the Emacs | |
2786 | calendar will be used to add entries to the `diary-file'. But when this | |
2787 | points to a file, `org-agenda-diary-entry' will be used instead." | |
2788 | :group 'org-agenda | |
2789 | :type '(choice | |
2790 | (const :tag "The standard Emacs diary file" diary-file) | |
2791 | (file :tag "Special Org file diary entries"))) | |
2792 | ||
20908596 | 2793 | (eval-after-load "calendar" |
b349f79f CD |
2794 | '(progn |
2795 | (org-defkey calendar-mode-map org-calendar-to-agenda-key | |
2796 | 'org-calendar-goto-agenda) | |
2797 | (org-defkey calendar-mode-map org-calendar-agenda-action-key | |
8bfe682a CD |
2798 | 'org-agenda-action) |
2799 | (add-hook 'calendar-mode-hook | |
2800 | (lambda () | |
2801 | (unless (eq org-agenda-diary-file 'diary-file) | |
2802 | (define-key calendar-mode-map | |
2803 | org-calendar-insert-diary-entry-key | |
2804 | 'org-agenda-diary-entry)))))) | |
03f3cf35 | 2805 | |
6769c0dc | 2806 | (defgroup org-latex nil |
5bf7807a | 2807 | "Options for embedding LaTeX code into Org-mode." |
6769c0dc CD |
2808 | :tag "Org LaTeX" |
2809 | :group 'org) | |
2810 | ||
2811 | (defcustom org-format-latex-options | |
a3fbe8c4 CD |
2812 | '(:foreground default :background default :scale 1.0 |
2813 | :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 | |
0bd48b37 | 2814 | :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) |
6769c0dc CD |
2815 | "Options for creating images from LaTeX fragments. |
2816 | This is a property list with the following properties: | |
efc054e6 JB |
2817 | :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". |
2818 | `default' means use the foreground of the default face. | |
6769c0dc | 2819 | :background the background color, or \"Transparent\". |
a3fbe8c4 | 2820 | `default' means use the background of the default face. |
efc054e6 | 2821 | :scale a scaling factor for the size of the images. |
a3fbe8c4 | 2822 | :html-foreground, :html-background, :html-scale |
efc054e6 | 2823 | the same numbers for HTML export. |
6769c0dc CD |
2824 | :matchers a list indicating which matchers should be used to |
2825 | find LaTeX fragments. Valid members of this list are: | |
2826 | \"begin\" find environments | |
0bd48b37 | 2827 | \"$1\" find single characters surrounded by $.$ |
e39856be | 2828 | \"$\" find math expressions surrounded by $...$ |
6769c0dc | 2829 | \"$$\" find math expressions surrounded by $$....$$ |
e39856be CD |
2830 | \"\\(\" find math expressions surrounded by \\(...\\) |
2831 | \"\\ [\" find math expressions surrounded by \\ [...\\]" | |
15841868 | 2832 | :group 'org-latex |
6769c0dc CD |
2833 | :type 'plist) |
2834 | ||
a3fbe8c4 | 2835 | (defcustom org-format-latex-header "\\documentclass{article} |
a3fbe8c4 CD |
2836 | \\usepackage{amssymb} |
2837 | \\usepackage[usenames]{color} | |
2838 | \\usepackage{amsmath} | |
2839 | \\usepackage{latexsym} | |
2840 | \\usepackage[mathscr]{eucal} | |
8d642074 CD |
2841 | \\pagestyle{empty} % do not remove |
2842 | % The settings below are copied from fullpage.sty | |
2843 | \\setlength{\\textwidth}{\\paperwidth} | |
2844 | \\addtolength{\\textwidth}{-3cm} | |
2845 | \\setlength{\\oddsidemargin}{1.5cm} | |
2846 | \\addtolength{\\oddsidemargin}{-2.54cm} | |
2847 | \\setlength{\\evensidemargin}{\\oddsidemargin} | |
2848 | \\setlength{\\textheight}{\\paperheight} | |
2849 | \\addtolength{\\textheight}{-\\headheight} | |
2850 | \\addtolength{\\textheight}{-\\headsep} | |
2851 | \\addtolength{\\textheight}{-\\footskip} | |
2852 | \\addtolength{\\textheight}{-3cm} | |
2853 | \\setlength{\\topmargin}{1.5cm} | |
2854 | \\addtolength{\\topmargin}{-2.54cm}" | |
2855 | "The document header used for processing LaTeX fragments. | |
2856 | It is imperative that this header make sure that no page number | |
2857 | appears on the page." | |
15841868 | 2858 | :group 'org-latex |
a3fbe8c4 CD |
2859 | :type 'string) |
2860 | ||
5dec9555 CD |
2861 | ;; The following variable is defined here because is it also used |
2862 | ;; when formatting latex fragments. Originally it was part of the | |
2863 | ;; LaTeX exporter, which is why the name includes "export". | |
2864 | (defcustom org-export-latex-packages-alist nil | |
2865 | "Alist of packages to be inserted in the header. | |
2866 | Each cell is of the format \( \"option\" . \"package\" \)." | |
2867 | :group 'org-export-latex | |
2868 | :type '(repeat | |
2869 | (list | |
2870 | (string :tag "option") | |
2871 | (string :tag "package")))) | |
5152b597 | 2872 | |
20908596 CD |
2873 | (defgroup org-font-lock nil |
2874 | "Font-lock settings for highlighting in Org-mode." | |
2875 | :tag "Org Font Lock" | |
2876 | :group 'org) | |
8c6fb58b | 2877 | |
20908596 CD |
2878 | (defcustom org-level-color-stars-only nil |
2879 | "Non-nil means fontify only the stars in each headline. | |
2880 | When nil, the entire headline is fontified. | |
2881 | Changing it requires restart of `font-lock-mode' to become effective | |
2882 | also in regions already fontified." | |
2883 | :group 'org-font-lock | |
6769c0dc CD |
2884 | :type 'boolean) |
2885 | ||
20908596 CD |
2886 | (defcustom org-hide-leading-stars nil |
2887 | "Non-nil means, hide the first N-1 stars in a headline. | |
2888 | This works by using the face `org-hide' for these stars. This | |
2889 | face is white for a light background, and black for a dark | |
2890 | background. You may have to customize the face `org-hide' to | |
2891 | make this work. | |
2892 | Changing it requires restart of `font-lock-mode' to become effective | |
2893 | also in regions already fontified. | |
2894 | You may also set this on a per-file basis by adding one of the following | |
2895 | lines to the buffer: | |
891f4676 | 2896 | |
20908596 CD |
2897 | #+STARTUP: hidestars |
2898 | #+STARTUP: showstars" | |
2899 | :group 'org-font-lock | |
891f4676 RS |
2900 | :type 'boolean) |
2901 | ||
20908596 CD |
2902 | (defcustom org-fontify-done-headline nil |
2903 | "Non-nil means, change the face of a headline if it is marked DONE. | |
2904 | Normally, only the TODO/DONE keyword indicates the state of a headline. | |
2905 | When this is non-nil, the headline after the keyword is set to the | |
2906 | `org-headline-done' as an additional indication." | |
2907 | :group 'org-font-lock | |
ab27a4a0 CD |
2908 | :type 'boolean) |
2909 | ||
20908596 CD |
2910 | (defcustom org-fontify-emphasized-text t |
2911 | "Non-nil means fontify *bold*, /italic/ and _underlined_ text. | |
2912 | Changing this variable requires a restart of Emacs to take effect." | |
2913 | :group 'org-font-lock | |
891f4676 RS |
2914 | :type 'boolean) |
2915 | ||
c8d0cf5c CD |
2916 | (defcustom org-fontify-whole-heading-line nil |
2917 | "Non-nil means fontify the whole line for headings. | |
2918 | This is useful when setting a background color for the | |
8bfe682a | 2919 | org-level-* faces." |
c8d0cf5c CD |
2920 | :group 'org-font-lock |
2921 | :type 'boolean) | |
2922 | ||
20908596 CD |
2923 | (defcustom org-highlight-latex-fragments-and-specials nil |
2924 | "Non-nil means, fontify what is treated specially by the exporters." | |
2925 | :group 'org-font-lock | |
a96ee7df CD |
2926 | :type 'boolean) |
2927 | ||
20908596 CD |
2928 | (defcustom org-hide-emphasis-markers nil |
2929 | "Non-nil mean font-lock should hide the emphasis marker characters." | |
2930 | :group 'org-font-lock | |
8c6fb58b CD |
2931 | :type 'boolean) |
2932 | ||
edd21304 CD |
2933 | (defvar org-emph-re nil |
2934 | "Regular expression for matching emphasis.") | |
8c6fb58b CD |
2935 | (defvar org-verbatim-re nil |
2936 | "Regular expression for matching verbatim text.") | |
edd21304 CD |
2937 | (defvar org-emphasis-regexp-components) ; defined just below |
2938 | (defvar org-emphasis-alist) ; defined just below | |
2939 | (defun org-set-emph-re (var val) | |
2940 | "Set variable and compute the emphasis regular expression." | |
2941 | (set var val) | |
2942 | (when (and (boundp 'org-emphasis-alist) | |
2943 | (boundp 'org-emphasis-regexp-components) | |
2944 | org-emphasis-alist org-emphasis-regexp-components) | |
2945 | (let* ((e org-emphasis-regexp-components) | |
2946 | (pre (car e)) | |
2947 | (post (nth 1 e)) | |
2948 | (border (nth 2 e)) | |
2949 | (body (nth 3 e)) | |
2950 | (nl (nth 4 e)) | |
edd21304 | 2951 | (body1 (concat body "*?")) |
8c6fb58b CD |
2952 | (markers (mapconcat 'car org-emphasis-alist "")) |
2953 | (vmarkers (mapconcat | |
2954 | (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) | |
2955 | org-emphasis-alist ""))) | |
edd21304 CD |
2956 | ;; make sure special characters appear at the right position in the class |
2957 | (if (string-match "\\^" markers) | |
2958 | (setq markers (concat (replace-match "" t t markers) "^"))) | |
2959 | (if (string-match "-" markers) | |
2960 | (setq markers (concat (replace-match "" t t markers) "-"))) | |
8c6fb58b CD |
2961 | (if (string-match "\\^" vmarkers) |
2962 | (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) | |
2963 | (if (string-match "-" vmarkers) | |
2964 | (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) | |
3278a016 CD |
2965 | (if (> nl 0) |
2966 | (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," | |
2967 | (int-to-string nl) "\\}"))) | |
edd21304 CD |
2968 | ;; Make the regexp |
2969 | (setq org-emph-re | |
65c439fd | 2970 | (concat "\\([" pre "]\\|^\\)" |
edd21304 CD |
2971 | "\\(" |
2972 | "\\([" markers "]\\)" | |
2973 | "\\(" | |
8c6fb58b | 2974 | "[^" border "]\\|" |
65c439fd | 2975 | "[^" border "]" |
edd21304 | 2976 | body1 |
65c439fd | 2977 | "[^" border "]" |
edd21304 CD |
2978 | "\\)" |
2979 | "\\3\\)" | |
65c439fd | 2980 | "\\([" post "]\\|$\\)")) |
8c6fb58b CD |
2981 | (setq org-verbatim-re |
2982 | (concat "\\([" pre "]\\|^\\)" | |
2983 | "\\(" | |
2984 | "\\([" vmarkers "]\\)" | |
2985 | "\\(" | |
2986 | "[^" border "]\\|" | |
2987 | "[^" border "]" | |
2988 | body1 | |
2989 | "[^" border "]" | |
2990 | "\\)" | |
2991 | "\\3\\)" | |
2992 | "\\([" post "]\\|$\\)"))))) | |
edd21304 CD |
2993 | |
2994 | (defcustom org-emphasis-regexp-components | |
c8d0cf5c | 2995 | '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) |
8c6fb58b | 2996 | "Components used to build the regular expression for emphasis. |
edd21304 CD |
2997 | This is a list with 6 entries. Terminology: In an emphasis string |
2998 | like \" *strong word* \", we call the initial space PREMATCH, the final | |
2999 | space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters | |
3000 | and \"trong wor\" is the body. The different components in this variable | |
3001 | specify what is allowed/forbidden in each part: | |
3002 | ||
3003 | pre Chars allowed as prematch. Beginning of line will be allowed too. | |
3004 | post Chars allowed as postmatch. End of line will be allowed too. | |
a3fbe8c4 | 3005 | border The chars *forbidden* as border characters. |
edd21304 CD |
3006 | body-regexp A regexp like \".\" to match a body character. Don't use |
3007 | non-shy groups here, and don't allow newline here. | |
3008 | newline The maximum number of newlines allowed in an emphasis exp. | |
8c6fb58b | 3009 | |
c44f0d75 | 3010 | Use customize to modify this, or restart Emacs after changing it." |
0fee8d6e | 3011 | :group 'org-font-lock |
edd21304 CD |
3012 | :set 'org-set-emph-re |
3013 | :type '(list | |
3014 | (sexp :tag "Allowed chars in pre ") | |
3015 | (sexp :tag "Allowed chars in post ") | |
3016 | (sexp :tag "Forbidden chars in border ") | |
3017 | (sexp :tag "Regexp for body ") | |
3018 | (integer :tag "number of newlines allowed") | |
b349f79f | 3019 | (option (boolean :tag "Please ignore this button")))) |
edd21304 CD |
3020 | |
3021 | (defcustom org-emphasis-alist | |
20908596 | 3022 | `(("*" bold "<b>" "</b>") |
edd21304 | 3023 | ("/" italic "<i>" "</i>") |
93b62de8 | 3024 | ("_" underline "<span style=\"text-decoration:underline;\">" "</span>") |
8c6fb58b | 3025 | ("=" org-code "<code>" "</code>" verbatim) |
93b62de8 | 3026 | ("~" org-verbatim "<code>" "</code>" verbatim) |
20908596 CD |
3027 | ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)) |
3028 | "<del>" "</del>") | |
a3fbe8c4 | 3029 | ) |
8c6fb58b | 3030 | "Special syntax for emphasized text. |
edd21304 CD |
3031 | Text starting and ending with a special character will be emphasized, for |
3032 | example *bold*, _underlined_ and /italic/. This variable sets the marker | |
a3fbe8c4 | 3033 | characters, the face to be used by font-lock for highlighting in Org-mode |
c44f0d75 | 3034 | Emacs buffers, and the HTML tags to be used for this. |
c8d0cf5c | 3035 | For LaTeX export, see the variable `org-export-latex-emphasis-alist'. |
c44f0d75 | 3036 | Use customize to modify this, or restart Emacs after changing it." |
0fee8d6e | 3037 | :group 'org-font-lock |
edd21304 CD |
3038 | :set 'org-set-emph-re |
3039 | :type '(repeat | |
3040 | (list | |
3041 | (string :tag "Marker character") | |
0fee8d6e CD |
3042 | (choice |
3043 | (face :tag "Font-lock-face") | |
3044 | (plist :tag "Face property list")) | |
edd21304 | 3045 | (string :tag "HTML start tag") |
8c6fb58b CD |
3046 | (string :tag "HTML end tag") |
3047 | (option (const verbatim))))) | |
edd21304 | 3048 | |
c8d0cf5c CD |
3049 | (defvar org-protecting-blocks |
3050 | '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R") | |
3051 | "Blocks that contain text that is quoted, i.e. not processed as Org syntax. | |
3052 | This is needed for font-lock setup.") | |
3053 | ||
20908596 CD |
3054 | ;;; Miscellaneous options |
3055 | ||
3056 | (defgroup org-completion nil | |
3057 | "Completion in Org-mode." | |
3058 | :tag "Org Completion" | |
3059 | :group 'org) | |
891f4676 | 3060 | |
ce4fdcb9 | 3061 | (defcustom org-completion-use-ido nil |
0bd48b37 CD |
3062 | "Non-nil means, use ido completion wherever possible. |
3063 | Note that `ido-mode' must be active for this variable to be relevant. | |
3064 | If you decide to turn this variable on, you might well want to turn off | |
54a0dee5 CD |
3065 | `org-outline-path-complete-in-steps'. |
3066 | See also `org-completion-use-iswitchb'." | |
3067 | :group 'org-completion | |
3068 | :type 'boolean) | |
3069 | ||
3070 | (defcustom org-completion-use-iswitchb nil | |
3071 | "Non-nil means, use iswitchb completion wherever possible. | |
3072 | Note that `iswitchb-mode' must be active for this variable to be relevant. | |
3073 | If you decide to turn this variable on, you might well want to turn off | |
3074 | `org-outline-path-complete-in-steps'. | |
8bfe682a | 3075 | Note that this variable has only an effect if `org-completion-use-ido' is nil." |
ce4fdcb9 | 3076 | :group 'org-completion |
ff4be292 | 3077 | :type 'boolean) |
ce4fdcb9 | 3078 | |
20908596 CD |
3079 | (defcustom org-completion-fallback-command 'hippie-expand |
3080 | "The expansion command called by \\[org-complete] in normal context. | |
3081 | Normal means, no org-mode-specific context." | |
3082 | :group 'org-completion | |
3083 | :type 'function) | |
ab27a4a0 | 3084 | |
8bfe682a | 3085 | ;;; Functions and variables from their packages |
8c6fb58b CD |
3086 | ;; Declared here to avoid compiler warnings |
3087 | ||
8c6fb58b CD |
3088 | ;; XEmacs only |
3089 | (defvar outline-mode-menu-heading) | |
3090 | (defvar outline-mode-menu-show) | |
3091 | (defvar outline-mode-menu-hide) | |
3092 | (defvar zmacs-regions) ; XEmacs regions | |
3093 | ||
3094 | ;; Emacs only | |
3095 | (defvar mark-active) | |
3096 | ||
3097 | ;; Various packages | |
bf9f6f03 | 3098 | (declare-function calendar-absolute-from-iso "cal-iso" (date)) |
f30cf46c | 3099 | (declare-function calendar-forward-day "cal-move" (arg)) |
f30cf46c GM |
3100 | (declare-function calendar-goto-date "cal-move" (date)) |
3101 | (declare-function calendar-goto-today "cal-move" ()) | |
bf9f6f03 | 3102 | (declare-function calendar-iso-from-absolute "cal-iso" (date)) |
20908596 CD |
3103 | (defvar calc-embedded-close-formula) |
3104 | (defvar calc-embedded-open-formula) | |
182aef95 DN |
3105 | (declare-function cdlatex-tab "ext:cdlatex" ()) |
3106 | (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) | |
8c6fb58b | 3107 | (defvar font-lock-unfontify-region-function) |
64a51001 GM |
3108 | (declare-function iswitchb-read-buffer "iswitchb" |
3109 | (prompt &optional default require-match start matches-set)) | |
20908596 CD |
3110 | (defvar iswitchb-temp-buflist) |
3111 | (declare-function org-gnus-follow-link "org-gnus" (&optional group article)) | |
0bd48b37 | 3112 | (defvar org-agenda-tags-todo-honor-ignore-options) |
20908596 | 3113 | (declare-function org-agenda-skip "org-agenda" ()) |
1bcdebed CD |
3114 | (declare-function |
3115 | org-format-agenda-item "org-agenda" | |
3116 | (extra txt &optional category tags dotime noprefix remove-re habitp)) | |
20908596 CD |
3117 | (declare-function org-agenda-new-marker "org-agenda" (&optional pos)) |
3118 | (declare-function org-agenda-change-all-lines "org-agenda" | |
d60b1ba1 | 3119 | (newhead hdmarker &optional fixface just-this)) |
20908596 CD |
3120 | (declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) |
3121 | (declare-function org-agenda-maybe-redo "org-agenda" ()) | |
b349f79f CD |
3122 | (declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda" |
3123 | (beg end)) | |
ce4fdcb9 | 3124 | (declare-function org-agenda-copy-local-variable "org-agenda" (var)) |
0bd48b37 CD |
3125 | (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item |
3126 | "org-agenda" (&optional end)) | |
c8d0cf5c | 3127 | (declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) |
9d459fc5 | 3128 | (declare-function org-indent-mode "org-indent" (&optional arg)) |
f30cf46c | 3129 | (declare-function parse-time-string "parse-time" (string)) |
8bfe682a | 3130 | (declare-function org-attach-reveal "org-attach" (&optional if-exists)) |
8c6fb58b | 3131 | (defvar remember-data-file) |
8c6fb58b | 3132 | (defvar texmathp-why) |
20908596 CD |
3133 | (declare-function speedbar-line-directory "speedbar" (&optional depth)) |
3134 | (declare-function table--at-cell-p "table" (position &optional object at-column)) | |
3135 | ||
8c6fb58b CD |
3136 | (defvar w3m-current-url) |
3137 | (defvar w3m-current-title) | |
8c6fb58b CD |
3138 | |
3139 | (defvar org-latex-regexps) | |
d3f4dbe8 | 3140 | |
20908596 | 3141 | ;;; Autoload and prepare some org modules |
4b3a9ba7 | 3142 | |
20908596 CD |
3143 | ;; Some table stuff that needs to be defined here, because it is used |
3144 | ;; by the functions setting up org-mode or checking for table context. | |
4b3a9ba7 | 3145 | |
20908596 CD |
3146 | (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" |
3147 | "Detects an org-type or table-type table.") | |
3148 | (defconst org-table-line-regexp "^[ \t]*|" | |
3149 | "Detects an org-type table line.") | |
3150 | (defconst org-table-dataline-regexp "^[ \t]*|[^-]" | |
3151 | "Detects an org-type table line.") | |
3152 | (defconst org-table-hline-regexp "^[ \t]*|-" | |
3153 | "Detects an org-type table hline.") | |
3154 | (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" | |
3155 | "Detects a table-type table hline.") | |
3156 | (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" | |
3157 | "Searching from within a table (any type) this finds the first line | |
3158 | outside the table.") | |
4b3a9ba7 | 3159 | |
20908596 | 3160 | ;; Autoload the functions in org-table.el that are needed by functions here. |
ab27a4a0 | 3161 | |
20908596 CD |
3162 | (eval-and-compile |
3163 | (org-autoload "org-table" | |
3164 | '(org-table-align org-table-begin org-table-blank-field | |
3165 | org-table-convert org-table-convert-region org-table-copy-down | |
3166 | org-table-copy-region org-table-create | |
3167 | org-table-create-or-convert-from-region | |
3168 | org-table-create-with-table.el org-table-current-dline | |
3169 | org-table-cut-region org-table-delete-column org-table-edit-field | |
3170 | org-table-edit-formulas org-table-end org-table-eval-formula | |
3171 | org-table-export org-table-field-info | |
3172 | org-table-get-stored-formulas org-table-goto-column | |
3173 | org-table-hline-and-move org-table-import org-table-insert-column | |
3174 | org-table-insert-hline org-table-insert-row org-table-iterate | |
3175 | org-table-justify-field-maybe org-table-kill-row | |
3176 | org-table-maybe-eval-formula org-table-maybe-recalculate-line | |
3177 | org-table-move-column org-table-move-column-left | |
3178 | org-table-move-column-right org-table-move-row | |
3179 | org-table-move-row-down org-table-move-row-up | |
3180 | org-table-next-field org-table-next-row org-table-paste-rectangle | |
3181 | org-table-previous-field org-table-recalculate | |
3182 | org-table-rotate-recalc-marks org-table-sort-lines org-table-sum | |
3183 | org-table-toggle-coordinate-overlays | |
3184 | org-table-toggle-formula-debugger org-table-wrap-region | |
621f83e4 | 3185 | orgtbl-mode turn-on-orgtbl org-table-to-lisp))) |
3278a016 | 3186 | |
20908596 CD |
3187 | (defun org-at-table-p (&optional table-type) |
3188 | "Return t if the cursor is inside an org-type table. | |
3189 | If TABLE-TYPE is non-nil, also check for table.el-type tables." | |
3190 | (if org-enable-table-editor | |
1d676e9f | 3191 | (save-excursion |
20908596 CD |
3192 | (beginning-of-line 1) |
3193 | (looking-at (if table-type org-table-any-line-regexp | |
3194 | org-table-line-regexp))) | |
3195 | nil)) | |
3196 | (defsubst org-table-p () (org-at-table-p)) | |
edd21304 | 3197 | |
20908596 CD |
3198 | (defun org-at-table.el-p () |
3199 | "Return t if and only if we are at a table.el table." | |
3200 | (and (org-at-table-p 'any) | |
3201 | (save-excursion | |
3202 | (goto-char (org-table-begin 'any)) | |
3203 | (looking-at org-table1-hline-regexp)))) | |
3204 | (defun org-table-recognize-table.el () | |
3205 | "If there is a table.el table nearby, recognize it and move into it." | |
3206 | (if org-table-tab-recognizes-table.el | |
3207 | (if (org-at-table.el-p) | |
3208 | (progn | |
3209 | (beginning-of-line 1) | |
3210 | (if (looking-at org-table-dataline-regexp) | |
3211 | nil | |
3212 | (if (looking-at org-table1-hline-regexp) | |
3213 | (progn | |
3214 | (beginning-of-line 2) | |
3215 | (if (looking-at org-table-any-border-regexp) | |
3216 | (beginning-of-line -1))))) | |
3217 | (if (re-search-forward "|" (org-table-end t) t) | |
3218 | (progn | |
3219 | (require 'table) | |
3220 | (if (table--at-cell-p (point)) | |
3221 | t | |
3222 | (message "recognizing table.el table...") | |
3223 | (table-recognize-table) | |
3224 | (message "recognizing table.el table...done"))) | |
3225 | (error "This should not happen...")) | |
3226 | t) | |
3227 | nil) | |
3228 | nil)) | |
edd21304 | 3229 | |
20908596 CD |
3230 | (defun org-at-table-hline-p () |
3231 | "Return t if the cursor is inside a hline in a table." | |
3232 | (if org-enable-table-editor | |
3233 | (save-excursion | |
3234 | (beginning-of-line 1) | |
3235 | (looking-at org-table-hline-regexp)) | |
3236 | nil)) | |
edd21304 | 3237 | |
20908596 | 3238 | (defvar org-table-clean-did-remove-column nil) |
6769c0dc | 3239 | |
d3f4dbe8 CD |
3240 | (defun org-table-map-tables (function) |
3241 | "Apply FUNCTION to the start of all tables in the buffer." | |
3242 | (save-excursion | |
3243 | (save-restriction | |
3244 | (widen) | |
3245 | (goto-char (point-min)) | |
3246 | (while (re-search-forward org-table-any-line-regexp nil t) | |
3247 | (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) | |
3248 | (beginning-of-line 1) | |
c8d0cf5c CD |
3249 | (when (looking-at org-table-line-regexp) |
3250 | (save-excursion (funcall function)) | |
3251 | (or (looking-at org-table-line-regexp) | |
3252 | (forward-char 1))) | |
d3f4dbe8 CD |
3253 | (re-search-forward org-table-any-border-regexp nil 1)))) |
3254 | (message "Mapping tables: done")) | |
edd21304 | 3255 | |
c8d0cf5c | 3256 | ;; Declare and autoload functions from org-exp.el & Co |
d3f4dbe8 | 3257 | |
20908596 CD |
3258 | (declare-function org-default-export-plist "org-exp") |
3259 | (declare-function org-infile-export-plist "org-exp") | |
3260 | (declare-function org-get-current-options "org-exp") | |
3261 | (eval-and-compile | |
3262 | (org-autoload "org-exp" | |
c8d0cf5c CD |
3263 | '(org-export org-export-visible |
3264 | org-insert-export-options-template | |
3265 | org-table-clean-before-export)) | |
3266 | (org-autoload "org-ascii" | |
3267 | '(org-export-as-ascii org-export-ascii-preprocess | |
3268 | org-export-as-ascii-to-buffer org-replace-region-by-ascii | |
3269 | org-export-region-as-ascii)) | |
3270 | (org-autoload "org-html" | |
3271 | '(org-export-as-html-and-open | |
3272 | org-export-as-html-batch org-export-as-html-to-buffer | |
3273 | org-replace-region-by-html org-export-region-as-html | |
3274 | org-export-as-html)) | |
3275 | (org-autoload "org-icalendar" | |
3276 | '(org-export-icalendar-this-file | |
3277 | org-export-icalendar-all-agenda-files | |
3278 | org-export-icalendar-combine-agenda-files)) | |
3279 | (org-autoload "org-xoxo" '(org-export-as-xoxo))) | |
d3f4dbe8 | 3280 | |
621f83e4 | 3281 | ;; Declare and autoload functions from org-agenda.el |
d3f4dbe8 | 3282 | |
20908596 | 3283 | (eval-and-compile |
621f83e4 | 3284 | (org-autoload "org-agenda" |
20908596 CD |
3285 | '(org-agenda org-agenda-list org-search-view |
3286 | org-todo-list org-tags-view org-agenda-list-stuck-projects | |
0bd48b37 CD |
3287 | org-diary org-agenda-to-appt |
3288 | org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))) | |
d3f4dbe8 | 3289 | |
20908596 CD |
3290 | ;; Autoload org-remember |
3291 | ||
3292 | (eval-and-compile | |
3293 | (org-autoload "org-remember" | |
3294 | '(org-remember-insinuate org-remember-annotation | |
3295 | org-remember-apply-template org-remember org-remember-handler))) | |
3296 | ||
3297 | ;; Autoload org-clock.el | |
3298 | ||
b349f79f CD |
3299 | |
3300 | (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" | |
3301 | (beg end)) | |
0bd48b37 | 3302 | (declare-function org-clock-update-mode-line "org-clock" ()) |
8bfe682a CD |
3303 | (declare-function org-resolve-clocks "org-clock" |
3304 | (&optional also-non-dangling-p prompt last-valid)) | |
b349f79f | 3305 | (defvar org-clock-start-time) |
20908596 CD |
3306 | (defvar org-clock-marker (make-marker) |
3307 | "Marker recording the last clock-in.") | |
54a0dee5 CD |
3308 | (defvar org-clock-hd-marker (make-marker) |
3309 | "Marker recording the last clock-in, but the headline position.") | |
8bfe682a CD |
3310 | (defvar org-clock-heading "" |
3311 | "The heading of the current clock entry.") | |
c8d0cf5c CD |
3312 | (defun org-clock-is-active () |
3313 | "Return non-nil if clock is currently running. | |
3314 | The return value is actually the clock marker." | |
3315 | (marker-buffer org-clock-marker)) | |
20908596 CD |
3316 | |
3317 | (eval-and-compile | |
3318 | (org-autoload | |
3319 | "org-clock" | |
3320 | '(org-clock-in org-clock-out org-clock-cancel | |
3321 | org-clock-goto org-clock-sum org-clock-display | |
0bd48b37 | 3322 | org-clock-remove-overlays org-clock-report |
20908596 | 3323 | org-clocktable-shift org-dblock-write:clocktable |
8bfe682a | 3324 | org-get-clocktable org-resolve-clocks))) |
20908596 CD |
3325 | |
3326 | (defun org-clock-update-time-maybe () | |
3327 | "If this is a CLOCK line, update it and return t. | |
3328 | Otherwise, return nil." | |
0fee8d6e | 3329 | (interactive) |
5137195a | 3330 | (save-excursion |
20908596 CD |
3331 | (beginning-of-line 1) |
3332 | (skip-chars-forward " \t") | |
3333 | (when (looking-at org-clock-string) | |
3334 | (let ((re (concat "[ \t]*" org-clock-string | |
b349f79f CD |
3335 | " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]" |
3336 | "\\([ \t]*=>.*\\)?\\)?")) | |
71d35b24 | 3337 | ts te h m s neg) |
b349f79f CD |
3338 | (cond |
3339 | ((not (looking-at re)) | |
3340 | nil) | |
3341 | ((not (match-end 2)) | |
3342 | (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) | |
3343 | (> org-clock-marker (point)) | |
3344 | (<= org-clock-marker (point-at-eol))) | |
3345 | ;; The clock is running here | |
3346 | (setq org-clock-start-time | |
ce4fdcb9 | 3347 | (apply 'encode-time |
b349f79f | 3348 | (org-parse-time-string (match-string 1)))) |
0bd48b37 | 3349 | (org-clock-update-mode-line))) |
b349f79f CD |
3350 | (t |
3351 | (and (match-end 4) (delete-region (match-beginning 4) (match-end 4))) | |
20908596 CD |
3352 | (end-of-line 1) |
3353 | (setq ts (match-string 1) | |
b349f79f | 3354 | te (match-string 3)) |
54a0dee5 | 3355 | (setq s (- (org-float-time |
20908596 | 3356 | (apply 'encode-time (org-parse-time-string te))) |
54a0dee5 | 3357 | (org-float-time |
20908596 | 3358 | (apply 'encode-time (org-parse-time-string ts)))) |
71d35b24 CD |
3359 | neg (< s 0) |
3360 | s (abs s) | |
20908596 CD |
3361 | h (floor (/ s 3600)) |
3362 | s (- s (* 3600 h)) | |
3363 | m (floor (/ s 60)) | |
3364 | s (- s (* 60 s))) | |
71d35b24 | 3365 | (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m)) |
b349f79f | 3366 | t)))))) |
5137195a | 3367 | |
20908596 CD |
3368 | (defun org-check-running-clock () |
3369 | "Check if the current buffer contains the running clock. | |
3370 | If yes, offer to stop it and to save the buffer with the changes." | |
3371 | (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) | |
3372 | (y-or-n-p (format "Clock-out in buffer %s before killing it? " | |
3373 | (buffer-name)))) | |
3374 | (org-clock-out) | |
3375 | (when (y-or-n-p "Save changed buffer?") | |
3376 | (save-buffer)))) | |
3377 | ||
3378 | (defun org-clocktable-try-shift (dir n) | |
3379 | "Check if this line starts a clock table, if yes, shift the time block." | |
3380 | (when (org-match-line "#\\+BEGIN: clocktable\\>") | |
3381 | (org-clocktable-shift dir n))) | |
3382 | ||
ff4be292 CD |
3383 | ;; Autoload org-timer.el |
3384 | ||
ff4be292 CD |
3385 | (eval-and-compile |
3386 | (org-autoload | |
3387 | "org-timer" | |
3388 | '(org-timer-start org-timer org-timer-item | |
c8d0cf5c CD |
3389 | org-timer-change-times-in-region |
3390 | org-timer-set-timer | |
3391 | org-timer-reset-timers | |
3392 | org-timer-show-remaining-time))) | |
3393 | ||
3394 | ;; Autoload org-feed.el | |
3395 | ||
3396 | (eval-and-compile | |
3397 | (org-autoload | |
3398 | "org-feed" | |
3399 | '(org-feed-update org-feed-update-all org-feed-goto-inbox))) | |
3400 | ||
ff4be292 | 3401 | |
c8d0cf5c CD |
3402 | ;; Autoload org-indent.el |
3403 | ||
8bfe682a CD |
3404 | ;; Define the variable already here, to make sure we have it. |
3405 | (defvar org-indent-mode nil | |
3406 | "Non-nil if Org-Indent mode is enabled. | |
3407 | Use the command `org-indent-mode' to change this variable.") | |
3408 | ||
c8d0cf5c CD |
3409 | (eval-and-compile |
3410 | (org-autoload | |
3411 | "org-indent" | |
3412 | '(org-indent-mode))) | |
ff4be292 | 3413 | |
8d642074 CD |
3414 | ;; Autoload org-mobile.el |
3415 | ||
3416 | (eval-and-compile | |
3417 | (org-autoload | |
3418 | "org-mobile" | |
3419 | '(org-mobile-push org-mobile-pull org-mobile-create-sumo-agenda))) | |
3420 | ||
20908596 CD |
3421 | ;; Autoload archiving code |
3422 | ;; The stuff that is needed for cycling and tags has to be defined here. | |
3423 | ||
3424 | (defgroup org-archive nil | |
3425 | "Options concerning archiving in Org-mode." | |
3426 | :tag "Org Archive" | |
3427 | :group 'org-structure) | |
3428 | ||
3429 | (defcustom org-archive-location "%s_archive::" | |
3430 | "The location where subtrees should be archived. | |
3431 | ||
ce4fdcb9 CD |
3432 | The value of this variable is a string, consisting of two parts, |
3433 | separated by a double-colon. The first part is a filename and | |
3434 | the second part is a headline. | |
20908596 | 3435 | |
ce4fdcb9 CD |
3436 | When the filename is omitted, archiving happens in the same file. |
3437 | %s in the filename will be replaced by the current file | |
3438 | name (without the directory part). Archiving to a different file | |
3439 | is useful to keep archived entries from contributing to the | |
3440 | Org-mode Agenda. | |
20908596 | 3441 | |
ce4fdcb9 CD |
3442 | The archived entries will be filed as subtrees of the specified |
3443 | headline. When the headline is omitted, the subtrees are simply | |
0bd48b37 CD |
3444 | filed away at the end of the file, as top-level entries. Also in |
3445 | the heading you can use %s to represent the file name, this can be | |
3446 | useful when using the same archive for a number of different files. | |
20908596 CD |
3447 | |
3448 | Here are a few examples: | |
3449 | \"%s_archive::\" | |
3450 | If the current file is Projects.org, archive in file | |
3451 | Projects.org_archive, as top-level trees. This is the default. | |
3452 | ||
3453 | \"::* Archived Tasks\" | |
3454 | Archive in the current file, under the top-level headline | |
3455 | \"* Archived Tasks\". | |
3456 | ||
3457 | \"~/org/archive.org::\" | |
3458 | Archive in file ~/org/archive.org (absolute path), as top-level trees. | |
3459 | ||
0bd48b37 | 3460 | \"~/org/archive.org::From %s\" |
8bfe682a | 3461 | Archive in file ~/org/archive.org (absolute path), under headlines |
0bd48b37 CD |
3462 | \"From FILENAME\" where file name is the current file name. |
3463 | ||
20908596 CD |
3464 | \"basement::** Finished Tasks\" |
3465 | Archive in file ./basement (relative path), as level 3 trees | |
3466 | below the level 2 heading \"** Finished Tasks\". | |
3467 | ||
3468 | You may set this option on a per-file basis by adding to the buffer a | |
3469 | line like | |
3470 | ||
3471 | #+ARCHIVE: basement::** Finished Tasks | |
3472 | ||
3473 | You may also define it locally for a subtree by setting an ARCHIVE property | |
3474 | in the entry. If such a property is found in an entry, or anywhere up | |
3475 | the hierarchy, it will be used." | |
3476 | :group 'org-archive | |
3477 | :type 'string) | |
3478 | ||
3479 | (defcustom org-archive-tag "ARCHIVE" | |
3480 | "The tag that marks a subtree as archived. | |
3481 | An archived subtree does not open during visibility cycling, and does | |
3482 | not contribute to the agenda listings. | |
3483 | After changing this, font-lock must be restarted in the relevant buffers to | |
3484 | get the proper fontification." | |
3485 | :group 'org-archive | |
3486 | :group 'org-keywords | |
3487 | :type 'string) | |
3488 | ||
3489 | (defcustom org-agenda-skip-archived-trees t | |
3490 | "Non-nil means, the agenda will skip any items located in archived trees. | |
2c3ad40d CD |
3491 | An archived tree is a tree marked with the tag ARCHIVE. The use of this |
3492 | variable is no longer recommended, you should leave it at the value t. | |
3493 | Instead, use the key `v' to cycle the archives-mode in the agenda." | |
20908596 CD |
3494 | :group 'org-archive |
3495 | :group 'org-agenda-skip | |
3496 | :type 'boolean) | |
3497 | ||
8bfe682a CD |
3498 | (defcustom org-columns-skip-archived-trees t |
3499 | "Non-nil means, ignore archived trees when creating column view." | |
c8d0cf5c CD |
3500 | :group 'org-archive |
3501 | :group 'org-properties | |
3502 | :type 'boolean) | |
3503 | ||
20908596 CD |
3504 | (defcustom org-cycle-open-archived-trees nil |
3505 | "Non-nil means, `org-cycle' will open archived trees. | |
3506 | An archived tree is a tree marked with the tag ARCHIVE. | |
3507 | When nil, archived trees will stay folded. You can still open them with | |
3508 | normal outline commands like `show-all', but not with the cycling commands." | |
3509 | :group 'org-archive | |
3510 | :group 'org-cycle | |
3511 | :type 'boolean) | |
3512 | ||
3513 | (defcustom org-sparse-tree-open-archived-trees nil | |
3514 | "Non-nil means sparse tree construction shows matches in archived trees. | |
3515 | When nil, matches in these trees are highlighted, but the trees are kept in | |
3516 | collapsed state." | |
3517 | :group 'org-archive | |
3518 | :group 'org-sparse-trees | |
3519 | :type 'boolean) | |
3520 | ||
3521 | (defun org-cycle-hide-archived-subtrees (state) | |
3522 | "Re-hide all archived subtrees after a visibility state change." | |
3523 | (when (and (not org-cycle-open-archived-trees) | |
3524 | (not (memq state '(overview folded)))) | |
d3f4dbe8 | 3525 | (save-excursion |
20908596 CD |
3526 | (let* ((globalp (memq state '(contents all))) |
3527 | (beg (if globalp (point-min) (point))) | |
3528 | (end (if globalp (point-max) (org-end-of-subtree t)))) | |
3529 | (org-hide-archived-subtrees beg end) | |
3530 | (goto-char beg) | |
3531 | (if (looking-at (concat ".*:" org-archive-tag ":")) | |
3532 | (message "%s" (substitute-command-keys | |
3533 | "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) | |
3534 | ||
3535 | (defun org-force-cycle-archived () | |
3536 | "Cycle subtree even if it is archived." | |
d3f4dbe8 | 3537 | (interactive) |
20908596 CD |
3538 | (setq this-command 'org-cycle) |
3539 | (let ((org-cycle-open-archived-trees t)) | |
3540 | (call-interactively 'org-cycle))) | |
3278a016 | 3541 | |
20908596 CD |
3542 | (defun org-hide-archived-subtrees (beg end) |
3543 | "Re-hide all archived subtrees after a visibility state change." | |
3544 | (save-excursion | |
3545 | (let* ((re (concat ":" org-archive-tag ":"))) | |
38f8646b | 3546 | (goto-char beg) |
20908596 | 3547 | (while (re-search-forward re end t) |
8bfe682a | 3548 | (and (org-on-heading-p) (org-flag-subtree t)) |
20908596 | 3549 | (org-end-of-subtree t))))) |
a3fbe8c4 | 3550 | |
8bfe682a CD |
3551 | (defun org-flag-subtree (flag) |
3552 | (save-excursion | |
3553 | (org-back-to-heading t) | |
3554 | (outline-end-of-heading) | |
3555 | (outline-flag-region (point) | |
3556 | (progn (org-end-of-subtree t) (point)) | |
3557 | flag))) | |
3558 | ||
20908596 | 3559 | (defalias 'org-advertized-archive-subtree 'org-archive-subtree) |
ab27a4a0 | 3560 | |
20908596 CD |
3561 | (eval-and-compile |
3562 | (org-autoload "org-archive" | |
3563 | '(org-add-archive-files org-archive-subtree | |
5dec9555 CD |
3564 | org-archive-to-archive-sibling org-toggle-archive-tag |
3565 | org-archive-subtree-default | |
3566 | org-archive-subtree-default-with-confirmation))) | |
ab27a4a0 | 3567 | |
20908596 | 3568 | ;; Autoload Column View Code |
a3fbe8c4 | 3569 | |
20908596 CD |
3570 | (declare-function org-columns-number-to-string "org-colview") |
3571 | (declare-function org-columns-get-format-and-top-level "org-colview") | |
3572 | (declare-function org-columns-compute "org-colview") | |
a3fbe8c4 | 3573 | |
20908596 CD |
3574 | (org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview") |
3575 | '(org-columns-number-to-string org-columns-get-format-and-top-level | |
3576 | org-columns-compute org-agenda-columns org-columns-remove-overlays | |
0627c265 | 3577 | org-columns org-insert-columns-dblock org-dblock-write:columnview)) |
a3fbe8c4 | 3578 | |
b349f79f CD |
3579 | ;; Autoload ID code |
3580 | ||
db55f368 | 3581 | (declare-function org-id-store-link "org-id") |
c8d0cf5c CD |
3582 | (declare-function org-id-locations-load "org-id") |
3583 | (declare-function org-id-locations-save "org-id") | |
3584 | (defvar org-id-track-globally) | |
b349f79f | 3585 | (org-autoload "org-id" |
ce4fdcb9 CD |
3586 | '(org-id-get-create org-id-new org-id-copy org-id-get |
3587 | org-id-get-with-outline-path-completion | |
b349f79f | 3588 | org-id-get-with-outline-drilling |
db55f368 | 3589 | org-id-goto org-id-find org-id-store-link)) |
b349f79f | 3590 | |
c8d0cf5c CD |
3591 | ;; Autoload Plotting Code |
3592 | ||
3593 | (org-autoload "org-plot" | |
3594 | '(org-plot/gnuplot)) | |
3595 | ||
20908596 | 3596 | ;;; Variables for pre-computed regular expressions, all buffer local |
a3fbe8c4 | 3597 | |
20908596 CD |
3598 | (defvar org-drawer-regexp nil |
3599 | "Matches first line of a hidden block.") | |
3600 | (make-variable-buffer-local 'org-drawer-regexp) | |
3601 | (defvar org-todo-regexp nil | |
3602 | "Matches any of the TODO state keywords.") | |
3603 | (make-variable-buffer-local 'org-todo-regexp) | |
3604 | (defvar org-not-done-regexp nil | |
3605 | "Matches any of the TODO state keywords except the last one.") | |
3606 | (make-variable-buffer-local 'org-not-done-regexp) | |
c8d0cf5c CD |
3607 | (defvar org-not-done-heading-regexp nil |
3608 | "Matches a TODO headline that is not done.") | |
3609 | (make-variable-buffer-local 'org-not-done-regexp) | |
20908596 CD |
3610 | (defvar org-todo-line-regexp nil |
3611 | "Matches a headline and puts TODO state into group 2 if present.") | |
3612 | (make-variable-buffer-local 'org-todo-line-regexp) | |
3613 | (defvar org-complex-heading-regexp nil | |
3614 | "Matches a headline and puts everything into groups: | |
3615 | group 1: the stars | |
3616 | group 2: The todo keyword, maybe | |
3617 | group 3: Priority cookie | |
3618 | group 4: True headline | |
3619 | group 5: Tags") | |
3620 | (make-variable-buffer-local 'org-complex-heading-regexp) | |
8d642074 CD |
3621 | (defvar org-complex-heading-regexp-format nil) |
3622 | (make-variable-buffer-local 'org-complex-heading-regexp-format) | |
20908596 CD |
3623 | (defvar org-todo-line-tags-regexp nil |
3624 | "Matches a headline and puts TODO state into group 2 if present. | |
3625 | Also put tags into group 4 if tags are present.") | |
3626 | (make-variable-buffer-local 'org-todo-line-tags-regexp) | |
3627 | (defvar org-nl-done-regexp nil | |
3628 | "Matches newline followed by a headline with the DONE keyword.") | |
3629 | (make-variable-buffer-local 'org-nl-done-regexp) | |
3630 | (defvar org-looking-at-done-regexp nil | |
3631 | "Matches the DONE keyword a point.") | |
3632 | (make-variable-buffer-local 'org-looking-at-done-regexp) | |
3633 | (defvar org-ds-keyword-length 12 | |
3634 | "Maximum length of the Deadline and SCHEDULED keywords.") | |
3635 | (make-variable-buffer-local 'org-ds-keyword-length) | |
3636 | (defvar org-deadline-regexp nil | |
3637 | "Matches the DEADLINE keyword.") | |
3638 | (make-variable-buffer-local 'org-deadline-regexp) | |
3639 | (defvar org-deadline-time-regexp nil | |
3640 | "Matches the DEADLINE keyword together with a time stamp.") | |
3641 | (make-variable-buffer-local 'org-deadline-time-regexp) | |
3642 | (defvar org-deadline-line-regexp nil | |
3643 | "Matches the DEADLINE keyword and the rest of the line.") | |
3644 | (make-variable-buffer-local 'org-deadline-line-regexp) | |
3645 | (defvar org-scheduled-regexp nil | |
3646 | "Matches the SCHEDULED keyword.") | |
3647 | (make-variable-buffer-local 'org-scheduled-regexp) | |
3648 | (defvar org-scheduled-time-regexp nil | |
3649 | "Matches the SCHEDULED keyword together with a time stamp.") | |
3650 | (make-variable-buffer-local 'org-scheduled-time-regexp) | |
3651 | (defvar org-closed-time-regexp nil | |
3652 | "Matches the CLOSED keyword together with a time stamp.") | |
3653 | (make-variable-buffer-local 'org-closed-time-regexp) | |
a3fbe8c4 | 3654 | |
20908596 CD |
3655 | (defvar org-keyword-time-regexp nil |
3656 | "Matches any of the 4 keywords, together with the time stamp.") | |
3657 | (make-variable-buffer-local 'org-keyword-time-regexp) | |
3658 | (defvar org-keyword-time-not-clock-regexp nil | |
3659 | "Matches any of the 3 keywords, together with the time stamp.") | |
3660 | (make-variable-buffer-local 'org-keyword-time-not-clock-regexp) | |
3661 | (defvar org-maybe-keyword-time-regexp nil | |
3662 | "Matches a timestamp, possibly preceeded by a keyword.") | |
3663 | (make-variable-buffer-local 'org-maybe-keyword-time-regexp) | |
3664 | (defvar org-planning-or-clock-line-re nil | |
3665 | "Matches a line with planning or clock info.") | |
3666 | (make-variable-buffer-local 'org-planning-or-clock-line-re) | |
a3fbe8c4 | 3667 | |
20908596 CD |
3668 | (defconst org-plain-time-of-day-regexp |
3669 | (concat | |
3670 | "\\(\\<[012]?[0-9]" | |
3671 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
3672 | "\\(--?" | |
3673 | "\\(\\<[012]?[0-9]" | |
3674 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
3675 | "\\)?") | |
3676 | "Regular expression to match a plain time or time range. | |
3677 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
3678 | groups carry important information: | |
3679 | 0 the full match | |
3680 | 1 the first time, range or not | |
3681 | 8 the second time, if it is a range.") | |
a3fbe8c4 | 3682 | |
20908596 CD |
3683 | (defconst org-plain-time-extension-regexp |
3684 | (concat | |
3685 | "\\(\\<[012]?[0-9]" | |
3686 | "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" | |
3687 | "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?") | |
3688 | "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40. | |
3689 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
3690 | groups carry important information: | |
3691 | 0 the full match | |
3692 | 7 hours of duration | |
3693 | 9 minutes of duration") | |
3694 | ||
3695 | (defconst org-stamp-time-of-day-regexp | |
3696 | (concat | |
3697 | "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" | |
3698 | "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>" | |
3699 | "\\(--?" | |
3700 | "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") | |
3701 | "Regular expression to match a timestamp time or time range. | |
3702 | After a match, the following groups carry important information: | |
3703 | 0 the full match | |
8bfe682a | 3704 | 1 date plus weekday, for back referencing to make sure both times are on the same day |
20908596 CD |
3705 | 2 the first time, range or not |
3706 | 4 the second time, if it is a range.") | |
3707 | ||
3708 | (defconst org-startup-options | |
3709 | '(("fold" org-startup-folded t) | |
3710 | ("overview" org-startup-folded t) | |
3711 | ("nofold" org-startup-folded nil) | |
3712 | ("showall" org-startup-folded nil) | |
8d642074 | 3713 | ("showeverything" org-startup-folded showeverything) |
20908596 | 3714 | ("content" org-startup-folded content) |
c8d0cf5c CD |
3715 | ("indent" org-startup-indented t) |
3716 | ("noindent" org-startup-indented nil) | |
20908596 CD |
3717 | ("hidestars" org-hide-leading-stars t) |
3718 | ("showstars" org-hide-leading-stars nil) | |
3719 | ("odd" org-odd-levels-only t) | |
3720 | ("oddeven" org-odd-levels-only nil) | |
3721 | ("align" org-startup-align-all-tables t) | |
3722 | ("noalign" org-startup-align-all-tables nil) | |
3723 | ("customtime" org-display-custom-times t) | |
3724 | ("logdone" org-log-done time) | |
3725 | ("lognotedone" org-log-done note) | |
3726 | ("nologdone" org-log-done nil) | |
3727 | ("lognoteclock-out" org-log-note-clock-out t) | |
3728 | ("nolognoteclock-out" org-log-note-clock-out nil) | |
3729 | ("logrepeat" org-log-repeat state) | |
3730 | ("lognoterepeat" org-log-repeat note) | |
3731 | ("nologrepeat" org-log-repeat nil) | |
8bfe682a CD |
3732 | ("logreschedule" org-log-reschedule time) |
3733 | ("lognotereschedule" org-log-reschedule note) | |
3734 | ("nologreschedule" org-log-reschedule nil) | |
3735 | ("logredeadline" org-log-redeadline time) | |
3736 | ("lognoteredeadline" org-log-redeadline note) | |
3737 | ("nologredeadline" org-log-redeadline nil) | |
0bd48b37 CD |
3738 | ("fninline" org-footnote-define-inline t) |
3739 | ("nofninline" org-footnote-define-inline nil) | |
3740 | ("fnlocal" org-footnote-section nil) | |
3741 | ("fnauto" org-footnote-auto-label t) | |
3742 | ("fnprompt" org-footnote-auto-label nil) | |
3743 | ("fnconfirm" org-footnote-auto-label confirm) | |
3744 | ("fnplain" org-footnote-auto-label plain) | |
c8d0cf5c CD |
3745 | ("fnadjust" org-footnote-auto-adjust t) |
3746 | ("nofnadjust" org-footnote-auto-adjust nil) | |
20908596 | 3747 | ("constcgs" constants-unit-system cgs) |
c8d0cf5c CD |
3748 | ("constSI" constants-unit-system SI) |
3749 | ("noptag" org-tag-persistent-alist nil) | |
3750 | ("hideblocks" org-hide-block-startup t) | |
3751 | ("nohideblocks" org-hide-block-startup nil)) | |
20908596 CD |
3752 | "Variable associated with STARTUP options for org-mode. |
3753 | Each element is a list of three items: The startup options as written | |
3754 | in the #+STARTUP line, the corresponding variable, and the value to | |
3755 | set this variable to if the option is found. An optional forth element PUSH | |
3756 | means to push this value onto the list in the variable.") | |
3757 | ||
3758 | (defun org-set-regexps-and-options () | |
3759 | "Precompute regular expressions for current buffer." | |
3760 | (when (org-mode-p) | |
3761 | (org-set-local 'org-todo-kwd-alist nil) | |
3762 | (org-set-local 'org-todo-key-alist nil) | |
3763 | (org-set-local 'org-todo-key-trigger nil) | |
3764 | (org-set-local 'org-todo-keywords-1 nil) | |
3765 | (org-set-local 'org-done-keywords nil) | |
3766 | (org-set-local 'org-todo-heads nil) | |
3767 | (org-set-local 'org-todo-sets nil) | |
3768 | (org-set-local 'org-todo-log-states nil) | |
b349f79f CD |
3769 | (org-set-local 'org-file-properties nil) |
3770 | (org-set-local 'org-file-tags nil) | |
20908596 | 3771 | (let ((re (org-make-options-regexp |
c8d0cf5c | 3772 | '("CATEGORY" "TODO" "COLUMNS" |
b349f79f | 3773 | "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" |
c8d0cf5c CD |
3774 | "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE") |
3775 | "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) | |
20908596 CD |
3776 | (splitre "[ \t]+") |
3777 | kwds kws0 kwsa key log value cat arch tags const links hw dws | |
b349f79f CD |
3778 | tail sep kws1 prio props ftags drawers |
3779 | ext-setup-or-nil setup-contents (start 0)) | |
a3fbe8c4 | 3780 | (save-excursion |
20908596 CD |
3781 | (save-restriction |
3782 | (widen) | |
3783 | (goto-char (point-min)) | |
b349f79f CD |
3784 | (while (or (and ext-setup-or-nil |
3785 | (string-match re ext-setup-or-nil start) | |
3786 | (setq start (match-end 0))) | |
3787 | (and (setq ext-setup-or-nil nil start 0) | |
3788 | (re-search-forward re nil t))) | |
3789 | (setq key (upcase (match-string 1 ext-setup-or-nil)) | |
3790 | value (org-match-string-no-properties 2 ext-setup-or-nil)) | |
20908596 CD |
3791 | (cond |
3792 | ((equal key "CATEGORY") | |
3793 | (if (string-match "[ \t]+$" value) | |
3794 | (setq value (replace-match "" t t value))) | |
3795 | (setq cat value)) | |
3796 | ((member key '("SEQ_TODO" "TODO")) | |
3797 | (push (cons 'sequence (org-split-string value splitre)) kwds)) | |
3798 | ((equal key "TYP_TODO") | |
3799 | (push (cons 'type (org-split-string value splitre)) kwds)) | |
c8d0cf5c CD |
3800 | ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key) |
3801 | ;; general TODO-like setup | |
3802 | (push (cons (intern (downcase (match-string 1 key))) | |
3803 | (org-split-string value splitre)) kwds)) | |
20908596 | 3804 | ((equal key "TAGS") |
c8d0cf5c CD |
3805 | (setq tags (append tags (if tags '("\\n") nil) |
3806 | (org-split-string value splitre)))) | |
20908596 CD |
3807 | ((equal key "COLUMNS") |
3808 | (org-set-local 'org-columns-default-format value)) | |
3809 | ((equal key "LINK") | |
3810 | (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) | |
3811 | (push (cons (match-string 1 value) | |
3812 | (org-trim (match-string 2 value))) | |
3813 | links))) | |
3814 | ((equal key "PRIORITIES") | |
3815 | (setq prio (org-split-string value " +"))) | |
3816 | ((equal key "PROPERTY") | |
3817 | (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) | |
3818 | (push (cons (match-string 1 value) (match-string 2 value)) | |
3819 | props))) | |
b349f79f CD |
3820 | ((equal key "FILETAGS") |
3821 | (when (string-match "\\S-" value) | |
3822 | (setq ftags | |
3823 | (append | |
3824 | ftags | |
3825 | (apply 'append | |
3826 | (mapcar (lambda (x) (org-split-string x ":")) | |
3827 | (org-split-string value))))))) | |
20908596 CD |
3828 | ((equal key "DRAWERS") |
3829 | (setq drawers (org-split-string value splitre))) | |
3830 | ((equal key "CONSTANTS") | |
3831 | (setq const (append const (org-split-string value splitre)))) | |
3832 | ((equal key "STARTUP") | |
3833 | (let ((opts (org-split-string value splitre)) | |
3834 | l var val) | |
3835 | (while (setq l (pop opts)) | |
3836 | (when (setq l (assoc l org-startup-options)) | |
3837 | (setq var (nth 1 l) val (nth 2 l)) | |
3838 | (if (not (nth 3 l)) | |
3839 | (set (make-local-variable var) val) | |
3840 | (if (not (listp (symbol-value var))) | |
3841 | (set (make-local-variable var) nil)) | |
3842 | (set (make-local-variable var) (symbol-value var)) | |
3843 | (add-to-list var val)))))) | |
3844 | ((equal key "ARCHIVE") | |
3845 | (string-match " *$" value) | |
3846 | (setq arch (replace-match "" t t value)) | |
3847 | (remove-text-properties 0 (length arch) | |
b349f79f CD |
3848 | '(face t fontified t) arch)) |
3849 | ((equal key "SETUPFILE") | |
3850 | (setq setup-contents (org-file-contents | |
3851 | (expand-file-name | |
3852 | (org-remove-double-quotes value)) | |
3853 | 'noerror)) | |
3854 | (if (not ext-setup-or-nil) | |
3855 | (setq ext-setup-or-nil setup-contents start 0) | |
3856 | (setq ext-setup-or-nil | |
3857 | (concat (substring ext-setup-or-nil 0 start) | |
3858 | "\n" setup-contents "\n" | |
3859 | (substring ext-setup-or-nil start))))) | |
3860 | )))) | |
20908596 CD |
3861 | (when cat |
3862 | (org-set-local 'org-category (intern cat)) | |
3863 | (push (cons "CATEGORY" cat) props)) | |
3864 | (when prio | |
3865 | (if (< (length prio) 3) (setq prio '("A" "C" "B"))) | |
3866 | (setq prio (mapcar 'string-to-char prio)) | |
3867 | (org-set-local 'org-highest-priority (nth 0 prio)) | |
3868 | (org-set-local 'org-lowest-priority (nth 1 prio)) | |
3869 | (org-set-local 'org-default-priority (nth 2 prio))) | |
b349f79f | 3870 | (and props (org-set-local 'org-file-properties (nreverse props))) |
c8d0cf5c CD |
3871 | (and ftags (org-set-local 'org-file-tags |
3872 | (mapcar 'org-add-prop-inherited ftags))) | |
20908596 CD |
3873 | (and drawers (org-set-local 'org-drawers drawers)) |
3874 | (and arch (org-set-local 'org-archive-location arch)) | |
3875 | (and links (setq org-link-abbrev-alist-local (nreverse links))) | |
3876 | ;; Process the TODO keywords | |
3877 | (unless kwds | |
3878 | ;; Use the global values as if they had been given locally. | |
3879 | (setq kwds (default-value 'org-todo-keywords)) | |
3880 | (if (stringp (car kwds)) | |
3881 | (setq kwds (list (cons org-todo-interpretation | |
3882 | (default-value 'org-todo-keywords))))) | |
3883 | (setq kwds (reverse kwds))) | |
3884 | (setq kwds (nreverse kwds)) | |
3885 | (let (inter kws kw) | |
3886 | (while (setq kws (pop kwds)) | |
c8d0cf5c CD |
3887 | (let ((kws (or |
3888 | (run-hook-with-args-until-success | |
3889 | 'org-todo-setup-filter-hook kws) | |
3890 | kws))) | |
3891 | (setq inter (pop kws) sep (member "|" kws) | |
3892 | kws0 (delete "|" (copy-sequence kws)) | |
3893 | kwsa nil | |
3894 | kws1 (mapcar | |
3895 | (lambda (x) | |
3896 | ;; 1 2 | |
3897 | (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) | |
3898 | (progn | |
3899 | (setq kw (match-string 1 x) | |
3900 | key (and (match-end 2) (match-string 2 x)) | |
3901 | log (org-extract-log-state-settings x)) | |
3902 | (push (cons kw (and key (string-to-char key))) kwsa) | |
3903 | (and log (push log org-todo-log-states)) | |
3904 | kw) | |
3905 | (error "Invalid TODO keyword %s" x))) | |
3906 | kws0) | |
3907 | kwsa (if kwsa (append '((:startgroup)) | |
3908 | (nreverse kwsa) | |
3909 | '((:endgroup)))) | |
3910 | hw (car kws1) | |
3911 | dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) | |
3912 | tail (list inter hw (car dws) (org-last dws)))) | |
20908596 CD |
3913 | (add-to-list 'org-todo-heads hw 'append) |
3914 | (push kws1 org-todo-sets) | |
3915 | (setq org-done-keywords (append org-done-keywords dws nil)) | |
3916 | (setq org-todo-key-alist (append org-todo-key-alist kwsa)) | |
3917 | (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) | |
3918 | (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) | |
3919 | (setq org-todo-sets (nreverse org-todo-sets) | |
3920 | org-todo-kwd-alist (nreverse org-todo-kwd-alist) | |
3921 | org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) | |
3922 | org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) | |
3923 | ;; Process the constants | |
3924 | (when const | |
3925 | (let (e cst) | |
3926 | (while (setq e (pop const)) | |
3927 | (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) | |
3928 | (push (cons (match-string 1 e) (match-string 2 e)) cst))) | |
3929 | (setq org-table-formula-constants-local cst))) | |
a3fbe8c4 | 3930 | |
20908596 CD |
3931 | ;; Process the tags. |
3932 | (when tags | |
3933 | (let (e tgs) | |
3934 | (while (setq e (pop tags)) | |
3935 | (cond | |
3936 | ((equal e "{") (push '(:startgroup) tgs)) | |
3937 | ((equal e "}") (push '(:endgroup) tgs)) | |
c8d0cf5c | 3938 | ((equal e "\\n") (push '(:newline) tgs)) |
20908596 CD |
3939 | ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) |
3940 | (push (cons (match-string 1 e) | |
3941 | (string-to-char (match-string 2 e))) | |
3942 | tgs)) | |
3943 | (t (push (list e) tgs)))) | |
3944 | (org-set-local 'org-tag-alist nil) | |
3945 | (while (setq e (pop tgs)) | |
3946 | (or (and (stringp (car e)) | |
3947 | (assoc (car e) org-tag-alist)) | |
b349f79f CD |
3948 | (push e org-tag-alist))))) |
3949 | ||
3950 | ;; Compute the regular expressions and other local variables | |
3951 | (if (not org-done-keywords) | |
54a0dee5 CD |
3952 | (setq org-done-keywords (and org-todo-keywords-1 |
3953 | (list (org-last org-todo-keywords-1))))) | |
b349f79f CD |
3954 | (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) |
3955 | (length org-scheduled-string) | |
3956 | (length org-clock-string) | |
3957 | (length org-closed-string))) | |
3958 | org-drawer-regexp | |
3959 | (concat "^[ \t]*:\\(" | |
3960 | (mapconcat 'regexp-quote org-drawers "\\|") | |
3961 | "\\):[ \t]*$") | |
3962 | org-not-done-keywords | |
3963 | (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) | |
3964 | org-todo-regexp | |
3965 | (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 | |
3966 | "\\|") "\\)\\>") | |
3967 | org-not-done-regexp | |
3968 | (concat "\\<\\(" | |
3969 | (mapconcat 'regexp-quote org-not-done-keywords "\\|") | |
3970 | "\\)\\>") | |
c8d0cf5c CD |
3971 | org-not-done-heading-regexp |
3972 | (concat "^\\(\\*+\\)[ \t]+\\(" | |
3973 | (mapconcat 'regexp-quote org-not-done-keywords "\\|") | |
3974 | "\\)\\>") | |
b349f79f CD |
3975 | org-todo-line-regexp |
3976 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" | |
3977 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
3978 | "\\)\\>\\)?[ \t]*\\(.*\\)") | |
3979 | org-complex-heading-regexp | |
0bd48b37 | 3980 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" |
b349f79f CD |
3981 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") |
3982 | "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" | |
3983 | "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") | |
8d642074 CD |
3984 | org-complex-heading-regexp-format |
3985 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" | |
3986 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
3987 | "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(%s\\)" | |
3988 | "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") | |
b349f79f CD |
3989 | org-nl-done-regexp |
3990 | (concat "\n\\*+[ \t]+" | |
3991 | "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") | |
3992 | "\\)" "\\>") | |
3993 | org-todo-line-tags-regexp | |
3994 | (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" | |
3995 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") | |
3996 | (org-re | |
3997 | "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) | |
3998 | org-looking-at-done-regexp | |
3999 | (concat "^" "\\(?:" | |
4000 | (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" | |
4001 | "\\>") | |
4002 | org-deadline-regexp (concat "\\<" org-deadline-string) | |
4003 | org-deadline-time-regexp | |
4004 | (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") | |
4005 | org-deadline-line-regexp | |
4006 | (concat "\\<\\(" org-deadline-string "\\).*") | |
4007 | org-scheduled-regexp | |
4008 | (concat "\\<" org-scheduled-string) | |
4009 | org-scheduled-time-regexp | |
4010 | (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") | |
4011 | org-closed-time-regexp | |
4012 | (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") | |
4013 | org-keyword-time-regexp | |
4014 | (concat "\\<\\(" org-scheduled-string | |
4015 | "\\|" org-deadline-string | |
4016 | "\\|" org-closed-string | |
4017 | "\\|" org-clock-string "\\)" | |
4018 | " *[[<]\\([^]>]+\\)[]>]") | |
4019 | org-keyword-time-not-clock-regexp | |
4020 | (concat "\\<\\(" org-scheduled-string | |
4021 | "\\|" org-deadline-string | |
4022 | "\\|" org-closed-string | |
4023 | "\\)" | |
4024 | " *[[<]\\([^]>]+\\)[]>]") | |
4025 | org-maybe-keyword-time-regexp | |
4026 | (concat "\\(\\<\\(" org-scheduled-string | |
4027 | "\\|" org-deadline-string | |
4028 | "\\|" org-closed-string | |
4029 | "\\|" org-clock-string "\\)\\)?" | |
4030 | " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") | |
4031 | org-planning-or-clock-line-re | |
4032 | (concat "\\(?:^[ \t]*\\(" org-scheduled-string | |
4033 | "\\|" org-deadline-string | |
4034 | "\\|" org-closed-string "\\|" org-clock-string | |
4035 | "\\)\\>\\)") | |
4036 | ) | |
4037 | (org-compute-latex-and-specials-regexp) | |
4038 | (org-set-font-lock-defaults)))) | |
4039 | ||
4040 | (defun org-file-contents (file &optional noerror) | |
4041 | "Return the contents of FILE, as a string." | |
4042 | (if (or (not file) | |
4043 | (not (file-readable-p file))) | |
4044 | (if noerror | |
4045 | (progn | |
4046 | (message "Cannot read file %s" file) | |
4047 | (ding) (sit-for 2) | |
4048 | "") | |
4049 | (error "Cannot read file %s" file)) | |
4050 | (with-temp-buffer | |
4051 | (insert-file-contents file) | |
4052 | (buffer-string)))) | |
891f4676 | 4053 | |
20908596 CD |
4054 | (defun org-extract-log-state-settings (x) |
4055 | "Extract the log state setting from a TODO keyword string. | |
4056 | This will extract info from a string like \"WAIT(w@/!)\"." | |
4057 | (let (kw key log1 log2) | |
4058 | (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) | |
4059 | (setq kw (match-string 1 x) | |
4060 | key (and (match-end 2) (match-string 2 x)) | |
4061 | log1 (and (match-end 3) (match-string 3 x)) | |
4062 | log2 (and (match-end 4) (match-string 4 x))) | |
4063 | (and (or log1 log2) | |
4064 | (list kw | |
4065 | (and log1 (if (equal log1 "!") 'time 'note)) | |
4066 | (and log2 (if (equal log2 "!") 'time 'note))))))) | |
891f4676 | 4067 | |
20908596 CD |
4068 | (defun org-remove-keyword-keys (list) |
4069 | "Remove a pair of parenthesis at the end of each string in LIST." | |
4070 | (mapcar (lambda (x) | |
4071 | (if (string-match "(.*)$" x) | |
4072 | (substring x 0 (match-beginning 0)) | |
4073 | x)) | |
4074 | list)) | |
891f4676 | 4075 | |
20908596 CD |
4076 | ;; FIXME: this could be done much better, using second characters etc. |
4077 | (defun org-assign-fast-keys (alist) | |
4078 | "Assign fast keys to a keyword-key alist. | |
4079 | Respect keys that are already there." | |
4080 | (let (new e k c c1 c2 (char ?a)) | |
4081 | (while (setq e (pop alist)) | |
d3f4dbe8 | 4082 | (cond |
20908596 CD |
4083 | ((equal e '(:startgroup)) (push e new)) |
4084 | ((equal e '(:endgroup)) (push e new)) | |
c8d0cf5c | 4085 | ((equal e '(:newline)) (push e new)) |
d3f4dbe8 | 4086 | (t |
20908596 CD |
4087 | (setq k (car e) c2 nil) |
4088 | (if (cdr e) | |
4089 | (setq c (cdr e)) | |
4090 | ;; automatically assign a character. | |
4091 | (setq c1 (string-to-char | |
4092 | (downcase (substring | |
4093 | k (if (= (string-to-char k) ?@) 1 0))))) | |
4094 | (if (or (rassoc c1 new) (rassoc c1 alist)) | |
4095 | (while (or (rassoc char new) (rassoc char alist)) | |
4096 | (setq char (1+ char))) | |
4097 | (setq c2 c1)) | |
4098 | (setq c (or c2 char))) | |
4099 | (push (cons k c) new)))) | |
4100 | (nreverse new))) | |
d3f4dbe8 | 4101 | |
20908596 | 4102 | ;;; Some variables used in various places |
d3f4dbe8 | 4103 | |
20908596 CD |
4104 | (defvar org-window-configuration nil |
4105 | "Used in various places to store a window configuration.") | |
8d642074 CD |
4106 | (defvar org-selected-window nil |
4107 | "Used in various places to store a window configuration.") | |
20908596 CD |
4108 | (defvar org-finish-function nil |
4109 | "Function to be called when `C-c C-c' is used. | |
4110 | This is for getting out of special buffers like remember.") | |
d3f4dbe8 | 4111 | |
d3f4dbe8 | 4112 | |
20908596 CD |
4113 | ;; FIXME: Occasionally check by commenting these, to make sure |
4114 | ;; no other functions uses these, forgetting to let-bind them. | |
4115 | (defvar entry) | |
20908596 CD |
4116 | (defvar last-state) |
4117 | (defvar date) | |
d3f4dbe8 | 4118 | |
20908596 CD |
4119 | ;; Defined somewhere in this file, but used before definition. |
4120 | (defvar org-html-entities) | |
4121 | (defvar org-struct-menu) | |
4122 | (defvar org-org-menu) | |
4123 | (defvar org-tbl-menu) | |
3278a016 | 4124 | |
20908596 | 4125 | ;;;; Define the Org-mode |
3278a016 | 4126 | |
20908596 | 4127 | (if (and (not (keymapp outline-mode-map)) (featurep 'allout)) |
33306645 | 4128 | (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22.")) |
891f4676 | 4129 | |
d3f4dbe8 | 4130 | |
20908596 CD |
4131 | ;; We use a before-change function to check if a table might need |
4132 | ;; an update. | |
4133 | (defvar org-table-may-need-update t | |
4134 | "Indicates that a table might need an update. | |
4135 | This variable is set by `org-before-change-function'. | |
4136 | `org-table-align' sets it back to nil.") | |
4137 | (defun org-before-change-function (beg end) | |
4138 | "Every change indicates that a table might need an update." | |
4139 | (setq org-table-may-need-update t)) | |
4140 | (defvar org-mode-map) | |
20908596 CD |
4141 | (defvar org-inhibit-startup nil) ; Dynamically-scoped param. |
4142 | (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. | |
c8d0cf5c CD |
4143 | (defvar org-inhibit-logging nil) ; Dynamically-scoped param. |
4144 | (defvar org-inhibit-blocking nil) ; Dynamically-scoped param. | |
20908596 CD |
4145 | (defvar org-table-buffer-is-an nil) |
4146 | (defconst org-outline-regexp "\\*+ ") | |
f425a6ea CD |
4147 | |
4148 | ;;;###autoload | |
20908596 CD |
4149 | (define-derived-mode org-mode outline-mode "Org" |
4150 | "Outline-based notes management and organizer, alias | |
4151 | \"Carsten's outline-mode for keeping track of everything.\" | |
891f4676 | 4152 | |
20908596 CD |
4153 | Org-mode develops organizational tasks around a NOTES file which |
4154 | contains information about projects as plain text. Org-mode is | |
4155 | implemented on top of outline-mode, which is ideal to keep the content | |
4156 | of large files well structured. It supports ToDo items, deadlines and | |
4157 | time stamps, which magically appear in the diary listing of the Emacs | |
4158 | calendar. Tables are easily created with a built-in table editor. | |
4159 | Plain text URL-like links connect to websites, emails (VM), Usenet | |
4160 | messages (Gnus), BBDB entries, and any files related to the project. | |
4161 | For printing and sharing of notes, an Org-mode file (or a part of it) | |
4162 | can be exported as a structured ASCII or HTML file. | |
35fb9989 | 4163 | |
20908596 | 4164 | The following commands are available: |
35fb9989 | 4165 | |
20908596 | 4166 | \\{org-mode-map}" |
634a7d0b | 4167 | |
20908596 CD |
4168 | ;; Get rid of Outline menus, they are not needed |
4169 | ;; Need to do this here because define-derived-mode sets up | |
4170 | ;; the keymap so late. Still, it is a waste to call this each time | |
4171 | ;; we switch another buffer into org-mode. | |
4172 | (if (featurep 'xemacs) | |
4173 | (when (boundp 'outline-mode-menu-heading) | |
4174 | ;; Assume this is Greg's port, it used easymenu | |
4175 | (easy-menu-remove outline-mode-menu-heading) | |
4176 | (easy-menu-remove outline-mode-menu-show) | |
4177 | (easy-menu-remove outline-mode-menu-hide)) | |
4178 | (define-key org-mode-map [menu-bar headings] 'undefined) | |
4179 | (define-key org-mode-map [menu-bar hide] 'undefined) | |
4180 | (define-key org-mode-map [menu-bar show] 'undefined)) | |
a3fbe8c4 | 4181 | |
20908596 CD |
4182 | (org-load-modules-maybe) |
4183 | (easy-menu-add org-org-menu) | |
4184 | (easy-menu-add org-tbl-menu) | |
4185 | (org-install-agenda-files-menu) | |
4186 | (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) | |
4187 | (org-add-to-invisibility-spec '(org-cwidth)) | |
c8d0cf5c | 4188 | (org-add-to-invisibility-spec '(org-hide-block . t)) |
20908596 CD |
4189 | (when (featurep 'xemacs) |
4190 | (org-set-local 'line-move-ignore-invisible t)) | |
4191 | (org-set-local 'outline-regexp org-outline-regexp) | |
4192 | (org-set-local 'outline-level 'org-outline-level) | |
4193 | (when (and org-ellipsis | |
4194 | (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) | |
4195 | (fboundp 'make-glyph-code)) | |
4196 | (unless org-display-table | |
4197 | (setq org-display-table (make-display-table))) | |
4198 | (set-display-table-slot | |
4199 | org-display-table 4 | |
4200 | (vconcat (mapcar | |
4201 | (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) | |
4202 | org-ellipsis))) | |
4203 | (if (stringp org-ellipsis) org-ellipsis "...")))) | |
4204 | (setq buffer-display-table org-display-table)) | |
4205 | (org-set-regexps-and-options) | |
fdf730ed CD |
4206 | (when (and org-tag-faces (not org-tags-special-faces-re)) |
4207 | ;; tag faces set outside customize.... force initialization. | |
4208 | (org-set-tag-faces 'org-tag-faces org-tag-faces)) | |
20908596 CD |
4209 | ;; Calc embedded |
4210 | (org-set-local 'calc-embedded-open-mode "# ") | |
4211 | (modify-syntax-entry ?# "<") | |
4212 | (modify-syntax-entry ?@ "w") | |
4213 | (if org-startup-truncated (setq truncate-lines t)) | |
4214 | (org-set-local 'font-lock-unfontify-region-function | |
4215 | 'org-unfontify-region) | |
4216 | ;; Activate before-change-function | |
4217 | (org-set-local 'org-table-may-need-update t) | |
4218 | (org-add-hook 'before-change-functions 'org-before-change-function nil | |
4219 | 'local) | |
4220 | ;; Check for running clock before killing a buffer | |
4221 | (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) | |
4222 | ;; Paragraphs and auto-filling | |
4223 | (org-set-autofill-regexps) | |
4224 | (setq indent-line-function 'org-indent-line-function) | |
4225 | (org-update-radio-target-regexp) | |
5ace2fe5 CD |
4226 | ;; Make sure dependence stuff works reliably, even for users who set it |
4227 | ;; too late :-( | |
4228 | (if org-enforce-todo-dependencies | |
4229 | (add-hook 'org-blocker-hook | |
c8d0cf5c | 4230 | 'org-block-todo-from-children-or-siblings-or-parent) |
5ace2fe5 | 4231 | (remove-hook 'org-blocker-hook |
c8d0cf5c | 4232 | 'org-block-todo-from-children-or-siblings-or-parent)) |
5ace2fe5 CD |
4233 | (if org-enforce-todo-checkbox-dependencies |
4234 | (add-hook 'org-blocker-hook | |
4235 | 'org-block-todo-from-checkboxes) | |
4236 | (remove-hook 'org-blocker-hook | |
4237 | 'org-block-todo-from-checkboxes)) | |
7ac93e3c | 4238 | |
20908596 CD |
4239 | ;; Comment characters |
4240 | ; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping | |
4241 | (org-set-local 'comment-padding " ") | |
891f4676 | 4242 | |
20908596 CD |
4243 | ;; Align options lines |
4244 | (org-set-local | |
4245 | 'align-mode-rules-list | |
4246 | '((org-in-buffer-settings | |
4247 | (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") | |
4248 | (modes . '(org-mode))))) | |
891f4676 | 4249 | |
20908596 CD |
4250 | ;; Imenu |
4251 | (org-set-local 'imenu-create-index-function | |
4252 | 'org-imenu-get-tree) | |
891f4676 | 4253 | |
20908596 CD |
4254 | ;; Make isearch reveal context |
4255 | (if (or (featurep 'xemacs) | |
4256 | (not (boundp 'outline-isearch-open-invisible-function))) | |
4257 | ;; Emacs 21 and XEmacs make use of the hook | |
4258 | (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) | |
4259 | ;; Emacs 22 deals with this through a special variable | |
4260 | (org-set-local 'outline-isearch-open-invisible-function | |
4261 | (lambda (&rest ignore) (org-show-context 'isearch)))) | |
634a7d0b | 4262 | |
20908596 CD |
4263 | ;; If empty file that did not turn on org-mode automatically, make it to. |
4264 | (if (and org-insert-mode-line-in-empty-file | |
4265 | (interactive-p) | |
4266 | (= (point-min) (point-max))) | |
4267 | (insert "# -*- mode: org -*-\n\n")) | |
891f4676 | 4268 | |
20908596 CD |
4269 | (unless org-inhibit-startup |
4270 | (when org-startup-align-all-tables | |
4271 | (let ((bmp (buffer-modified-p))) | |
4272 | (org-table-map-tables 'org-table-align) | |
4273 | (set-buffer-modified-p bmp))) | |
c8d0cf5c CD |
4274 | (when org-startup-indented |
4275 | (require 'org-indent) | |
4276 | (org-indent-mode 1)) | |
b349f79f | 4277 | (org-set-startup-visibility))) |
ef943dba | 4278 | |
8bfe682a CD |
4279 | (when (fboundp 'abbrev-table-put) |
4280 | (abbrev-table-put org-mode-abbrev-table | |
4281 | :parents (list text-mode-abbrev-table))) | |
4282 | ||
20908596 | 4283 | (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) |
b9661543 | 4284 | |
20908596 CD |
4285 | (defun org-current-time () |
4286 | "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." | |
4287 | (if (> (car org-time-stamp-rounding-minutes) 1) | |
4288 | (let ((r (car org-time-stamp-rounding-minutes)) | |
4289 | (time (decode-time))) | |
4290 | (apply 'encode-time | |
4291 | (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) | |
4292 | (nthcdr 2 time)))) | |
4293 | (current-time))) | |
ef943dba | 4294 | |
20908596 | 4295 | ;;;; Font-Lock stuff, including the activators |
ef943dba | 4296 | |
20908596 CD |
4297 | (defvar org-mouse-map (make-sparse-keymap)) |
4298 | (org-defkey org-mouse-map | |
4299 | (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) | |
4300 | (org-defkey org-mouse-map | |
4301 | (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) | |
4302 | (when org-mouse-1-follows-link | |
4303 | (org-defkey org-mouse-map [follow-link] 'mouse-face)) | |
4304 | (when org-tab-follows-link | |
4305 | (org-defkey org-mouse-map [(tab)] 'org-open-at-point) | |
4306 | (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) | |
48aaad2d | 4307 | |
20908596 | 4308 | (require 'font-lock) |
48aaad2d | 4309 | |
20908596 CD |
4310 | (defconst org-non-link-chars "]\t\n\r<>") |
4311 | (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" | |
4312 | "shell" "elisp")) | |
4313 | (defvar org-link-types-re nil | |
4314 | "Matches a link that has a url-like prefix like \"http:\"") | |
4315 | (defvar org-link-re-with-space nil | |
4316 | "Matches a link with spaces, optional angular brackets around it.") | |
4317 | (defvar org-link-re-with-space2 nil | |
4318 | "Matches a link with spaces, optional angular brackets around it.") | |
ce4fdcb9 CD |
4319 | (defvar org-link-re-with-space3 nil |
4320 | "Matches a link with spaces, only for internal part in bracket links.") | |
20908596 CD |
4321 | (defvar org-angle-link-re nil |
4322 | "Matches link with angular brackets, spaces are allowed.") | |
4323 | (defvar org-plain-link-re nil | |
4324 | "Matches plain link, without spaces.") | |
4325 | (defvar org-bracket-link-regexp nil | |
4326 | "Matches a link in double brackets.") | |
4327 | (defvar org-bracket-link-analytic-regexp nil | |
4328 | "Regular expression used to analyze links. | |
4329 | Here is what the match groups contain after a match: | |
4330 | 1: http: | |
4331 | 2: http | |
4332 | 3: path | |
4333 | 4: [desc] | |
4334 | 5: desc") | |
0bd48b37 CD |
4335 | (defvar org-bracket-link-analytic-regexp++ nil |
4336 | "Like org-bracket-link-analytic-regexp, but include coderef internal type.") | |
20908596 CD |
4337 | (defvar org-any-link-re nil |
4338 | "Regular expression matching any link.") | |
48aaad2d | 4339 | |
20908596 CD |
4340 | (defun org-make-link-regexps () |
4341 | "Update the link regular expressions. | |
4342 | This should be called after the variable `org-link-types' has changed." | |
4343 | (setq org-link-types-re | |
4344 | (concat | |
4345 | "\\`\\(" (mapconcat 'identity org-link-types "\\|") "\\):") | |
4346 | org-link-re-with-space | |
4347 | (concat | |
4348 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4349 | "\\([^" org-non-link-chars " ]" | |
4350 | "[^" org-non-link-chars "]*" | |
4351 | "[^" org-non-link-chars " ]\\)>?") | |
4352 | org-link-re-with-space2 | |
4353 | (concat | |
4354 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4355 | "\\([^" org-non-link-chars " ]" | |
93b62de8 | 4356 | "[^\t\n\r]*" |
20908596 | 4357 | "[^" org-non-link-chars " ]\\)>?") |
ce4fdcb9 CD |
4358 | org-link-re-with-space3 |
4359 | (concat | |
4360 | "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4361 | "\\([^" org-non-link-chars " ]" | |
4362 | "[^\t\n\r]*\\)") | |
20908596 CD |
4363 | org-angle-link-re |
4364 | (concat | |
4365 | "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4366 | "\\([^" org-non-link-chars " ]" | |
4367 | "[^" org-non-link-chars "]*" | |
4368 | "\\)>") | |
4369 | org-plain-link-re | |
4370 | (concat | |
4371 | "\\<\\(" (mapconcat 'identity org-link-types "\\|") "\\):" | |
4372 | "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") | |
4373 | org-bracket-link-regexp | |
4374 | "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" | |
4375 | org-bracket-link-analytic-regexp | |
4376 | (concat | |
4377 | "\\[\\[" | |
4378 | "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?" | |
4379 | "\\([^]]+\\)" | |
4380 | "\\]" | |
4381 | "\\(\\[" "\\([^]]+\\)" "\\]\\)?" | |
4382 | "\\]") | |
0bd48b37 CD |
4383 | org-bracket-link-analytic-regexp++ |
4384 | (concat | |
4385 | "\\[\\[" | |
4386 | "\\(\\(" (mapconcat 'identity (cons "coderef" org-link-types) "\\|") "\\):\\)?" | |
4387 | "\\([^]]+\\)" | |
4388 | "\\]" | |
4389 | "\\(\\[" "\\([^]]+\\)" "\\]\\)?" | |
4390 | "\\]") | |
20908596 CD |
4391 | org-any-link-re |
4392 | (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" | |
4393 | org-angle-link-re "\\)\\|\\(" | |
4394 | org-plain-link-re "\\)"))) | |
48aaad2d | 4395 | |
20908596 | 4396 | (org-make-link-regexps) |
8c6fb58b | 4397 | |
20908596 CD |
4398 | (defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>" |
4399 | "Regular expression for fast time stamp matching.") | |
4400 | (defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)[]>]" | |
4401 | "Regular expression for fast time stamp matching.") | |
4402 | (defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
4403 | "Regular expression matching time strings for analysis. | |
4404 | This one does not require the space after the date, so it can be used | |
4405 | on a string that terminates immediately after the date.") | |
4406 | (defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]-+0-9>\r\n ]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" | |
4407 | "Regular expression matching time strings for analysis.") | |
4408 | (defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") | |
4409 | "Regular expression matching time stamps, with groups.") | |
4410 | (defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") | |
4411 | "Regular expression matching time stamps (also [..]), with groups.") | |
4412 | (defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) | |
4413 | "Regular expression matching a time stamp range.") | |
4414 | (defconst org-tr-regexp-both | |
4415 | (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) | |
4416 | "Regular expression matching a time stamp range.") | |
4417 | (defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" | |
4418 | org-ts-regexp "\\)?") | |
4419 | "Regular expression matching a time stamp or time stamp range.") | |
4420 | (defconst org-tsr-regexp-both (concat org-ts-regexp-both "\\(--?-?" | |
4421 | org-ts-regexp-both "\\)?") | |
4422 | "Regular expression matching a time stamp or time stamp range. | |
4423 | The time stamps may be either active or inactive.") | |
48aaad2d | 4424 | |
20908596 | 4425 | (defvar org-emph-face nil) |
2a57416f | 4426 | |
20908596 CD |
4427 | (defun org-do-emphasis-faces (limit) |
4428 | "Run through the buffer and add overlays to links." | |
c8d0cf5c | 4429 | (let (rtn a) |
20908596 CD |
4430 | (while (and (not rtn) (re-search-forward org-emph-re limit t)) |
4431 | (if (not (= (char-after (match-beginning 3)) | |
4432 | (char-after (match-beginning 4)))) | |
4433 | (progn | |
4434 | (setq rtn t) | |
c8d0cf5c | 4435 | (setq a (assoc (match-string 3) org-emphasis-alist)) |
20908596 CD |
4436 | (font-lock-prepend-text-property (match-beginning 2) (match-end 2) |
4437 | 'face | |
c8d0cf5c CD |
4438 | (nth 1 a)) |
4439 | (and (nth 4 a) | |
4440 | (org-remove-flyspell-overlays-in | |
4441 | (match-beginning 0) (match-end 0))) | |
20908596 CD |
4442 | (add-text-properties (match-beginning 2) (match-end 2) |
4443 | '(font-lock-multiline t)) | |
4444 | (when org-hide-emphasis-markers | |
4445 | (add-text-properties (match-end 4) (match-beginning 5) | |
4446 | '(invisible org-link)) | |
4447 | (add-text-properties (match-beginning 3) (match-end 3) | |
4448 | '(invisible org-link))))) | |
4449 | (backward-char 1)) | |
4450 | rtn)) | |
891f4676 | 4451 | |
20908596 CD |
4452 | (defun org-emphasize (&optional char) |
4453 | "Insert or change an emphasis, i.e. a font like bold or italic. | |
4454 | If there is an active region, change that region to a new emphasis. | |
4455 | If there is no region, just insert the marker characters and position | |
4456 | the cursor between them. | |
4457 | CHAR should be either the marker character, or the first character of the | |
4458 | HTML tag associated with that emphasis. If CHAR is a space, the means | |
4459 | to remove the emphasis of the selected region. | |
4460 | If char is not given (for example in an interactive call) it | |
4461 | will be prompted for." | |
4462 | (interactive) | |
4463 | (let ((eal org-emphasis-alist) e det | |
4464 | (erc org-emphasis-regexp-components) | |
4465 | (prompt "") | |
4466 | (string "") beg end move tag c s) | |
4467 | (if (org-region-active-p) | |
4468 | (setq beg (region-beginning) end (region-end) | |
4469 | string (buffer-substring beg end)) | |
4470 | (setq move t)) | |
48aaad2d | 4471 | |
20908596 CD |
4472 | (while (setq e (pop eal)) |
4473 | (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) | |
4474 | c (aref tag 0)) | |
4475 | (push (cons c (string-to-char (car e))) det) | |
4476 | (setq prompt (concat prompt (format " [%s%c]%s" (car e) c | |
4477 | (substring tag 1))))) | |
93b62de8 | 4478 | (setq det (nreverse det)) |
20908596 CD |
4479 | (unless char |
4480 | (message "%s" (concat "Emphasis marker or tag:" prompt)) | |
4481 | (setq char (read-char-exclusive))) | |
4482 | (setq char (or (cdr (assoc char det)) char)) | |
4483 | (if (equal char ?\ ) | |
4484 | (setq s "" move nil) | |
4485 | (unless (assoc (char-to-string char) org-emphasis-alist) | |
4486 | (error "No such emphasis marker: \"%c\"" char)) | |
4487 | (setq s (char-to-string char))) | |
4488 | (while (and (> (length string) 1) | |
4489 | (equal (substring string 0 1) (substring string -1)) | |
4490 | (assoc (substring string 0 1) org-emphasis-alist)) | |
4491 | (setq string (substring string 1 -1))) | |
4492 | (setq string (concat s string s)) | |
4493 | (if beg (delete-region beg end)) | |
4494 | (unless (or (bolp) | |
4495 | (string-match (concat "[" (nth 0 erc) "\n]") | |
4496 | (char-to-string (char-before (point))))) | |
4497 | (insert " ")) | |
4498 | (unless (string-match (concat "[" (nth 1 erc) "\n]") | |
4499 | (char-to-string (char-after (point)))) | |
4500 | (insert " ") (backward-char 1)) | |
4501 | (insert string) | |
4502 | (and move (backward-char 1)))) | |
891f4676 | 4503 | |
20908596 CD |
4504 | (defconst org-nonsticky-props |
4505 | '(mouse-face highlight keymap invisible intangible help-echo org-linked-text)) | |
891f4676 | 4506 | |
c8d0cf5c CD |
4507 | (defsubst org-rear-nonsticky-at (pos) |
4508 | (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) | |
891f4676 | 4509 | |
20908596 CD |
4510 | (defun org-activate-plain-links (limit) |
4511 | "Run through the buffer and add overlays to links." | |
4512 | (catch 'exit | |
4513 | (let (f) | |
c8d0cf5c CD |
4514 | (if (re-search-forward org-plain-link-re limit t) |
4515 | (progn | |
4516 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) | |
4517 | (setq f (get-text-property (match-beginning 0) 'face)) | |
4518 | (if (or (eq f 'org-tag) | |
4519 | (and (listp f) (memq 'org-tag f))) | |
4520 | nil | |
4521 | (add-text-properties (match-beginning 0) (match-end 0) | |
4522 | (list 'mouse-face 'highlight | |
5dec9555 | 4523 | 'face 'org-link |
c8d0cf5c CD |
4524 | 'keymap org-mouse-map)) |
4525 | (org-rear-nonsticky-at (match-end 0))) | |
4526 | t))))) | |
891f4676 | 4527 | |
20908596 | 4528 | (defun org-activate-code (limit) |
621f83e4 CD |
4529 | (if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t) |
4530 | (progn | |
c8d0cf5c | 4531 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) |
20908596 CD |
4532 | (remove-text-properties (match-beginning 0) (match-end 0) |
4533 | '(display t invisible t intangible t)) | |
4534 | t))) | |
891f4676 | 4535 | |
c8d0cf5c CD |
4536 | (defun org-fontify-meta-lines-and-blocks (limit) |
4537 | "Fontify #+ lines and blocks, in the correct ways." | |
4538 | (let ((case-fold-search t)) | |
4539 | (if (re-search-forward | |
8d642074 | 4540 | "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)" |
c8d0cf5c CD |
4541 | limit t) |
4542 | (let ((beg (match-beginning 0)) | |
4543 | (beg1 (line-beginning-position 2)) | |
4544 | (dc1 (downcase (match-string 2))) | |
4545 | (dc3 (downcase (match-string 3))) | |
5dec9555 | 4546 | end end1 quoting block-type) |
c8d0cf5c CD |
4547 | (cond |
4548 | ((member dc1 '("html:" "ascii:" "latex:" "docbook:")) | |
4549 | ;; a single line of backend-specific content | |
4550 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) | |
4551 | (remove-text-properties (match-beginning 0) (match-end 0) | |
4552 | '(display t invisible t intangible t)) | |
4553 | (add-text-properties (match-beginning 1) (match-end 3) | |
4554 | '(font-lock-fontified t face org-meta-line)) | |
4555 | (add-text-properties (match-beginning 6) (match-end 6) | |
4556 | '(font-lock-fontified t face org-block)) | |
4557 | t) | |
4558 | ((and (match-end 4) (equal dc3 "begin")) | |
4559 | ;; Truely a block | |
5dec9555 CD |
4560 | (setq block-type (downcase (match-string 5)) |
4561 | quoting (member block-type org-protecting-blocks)) | |
c8d0cf5c CD |
4562 | (when (re-search-forward |
4563 | (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") | |
4564 | nil t) ;; on purpose, we look further than LIMIT | |
4565 | (setq end (match-end 0) end1 (1- (match-beginning 0))) | |
4566 | (when quoting | |
4567 | (remove-text-properties beg end | |
4568 | '(display t invisible t intangible t))) | |
4569 | (add-text-properties | |
4570 | beg end | |
4571 | '(font-lock-fontified t font-lock-multiline t)) | |
4572 | (add-text-properties beg beg1 '(face org-meta-line)) | |
4573 | (add-text-properties end1 end '(face org-meta-line)) | |
5dec9555 CD |
4574 | (cond |
4575 | (quoting | |
c8d0cf5c | 4576 | (add-text-properties beg1 end1 '(face org-block))) |
5dec9555 CD |
4577 | ((string= block-type "quote") |
4578 | (add-text-properties beg1 end1 '(face org-quote))) | |
4579 | ((string= block-type "verse") | |
4580 | (add-text-properties beg1 end1 '(face org-verse)))) | |
c8d0cf5c CD |
4581 | t)) |
4582 | ((not (member (char-after beg) '(?\ ?\t))) | |
4583 | ;; just any other in-buffer setting, but not indented | |
4584 | (add-text-properties | |
4585 | beg (match-end 0) | |
4586 | '(font-lock-fontified t face org-meta-line)) | |
4587 | t) | |
8d642074 CD |
4588 | ((or (member dc1 '("begin:" "end:" "caption:" "label:" |
4589 | "orgtbl:" "tblfm:" "tblname:")) | |
c8d0cf5c CD |
4590 | (and (match-end 4) (equal dc3 "attr"))) |
4591 | (add-text-properties | |
4592 | beg (match-end 0) | |
4593 | '(font-lock-fontified t face org-meta-line)) | |
4594 | t) | |
8d642074 CD |
4595 | ((member dc3 '(" " "")) |
4596 | (add-text-properties | |
4597 | beg (match-end 0) | |
4598 | '(font-lock-fontified t face font-lock-comment-face))) | |
c8d0cf5c CD |
4599 | (t nil)))))) |
4600 | ||
20908596 CD |
4601 | (defun org-activate-angle-links (limit) |
4602 | "Run through the buffer and add overlays to links." | |
4603 | (if (re-search-forward org-angle-link-re limit t) | |
4604 | (progn | |
c8d0cf5c | 4605 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) |
20908596 CD |
4606 | (add-text-properties (match-beginning 0) (match-end 0) |
4607 | (list 'mouse-face 'highlight | |
c8d0cf5c CD |
4608 | 'keymap org-mouse-map)) |
4609 | (org-rear-nonsticky-at (match-end 0)) | |
20908596 | 4610 | t))) |
891f4676 | 4611 | |
0bd48b37 CD |
4612 | (defun org-activate-footnote-links (limit) |
4613 | "Run through the buffer and add overlays to links." | |
c8d0cf5c | 4614 | (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)" |
0bd48b37 CD |
4615 | limit t) |
4616 | (progn | |
c8d0cf5c | 4617 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) |
0bd48b37 CD |
4618 | (add-text-properties (match-beginning 2) (match-end 2) |
4619 | (list 'mouse-face 'highlight | |
0bd48b37 CD |
4620 | 'keymap org-mouse-map |
4621 | 'help-echo | |
4622 | (if (= (point-at-bol) (match-beginning 2)) | |
4623 | "Footnote definition" | |
4624 | "Footnote reference") | |
4625 | )) | |
c8d0cf5c | 4626 | (org-rear-nonsticky-at (match-end 2)) |
0bd48b37 CD |
4627 | t))) |
4628 | ||
20908596 CD |
4629 | (defun org-activate-bracket-links (limit) |
4630 | "Run through the buffer and add overlays to bracketed links." | |
4631 | (if (re-search-forward org-bracket-link-regexp limit t) | |
4632 | (let* ((help (concat "LINK: " | |
4633 | (org-match-string-no-properties 1))) | |
4634 | ;; FIXME: above we should remove the escapes. | |
4635 | ;; but that requires another match, protecting match data, | |
4636 | ;; a lot of overhead for font-lock. | |
4637 | (ip (org-maybe-intangible | |
c8d0cf5c | 4638 | (list 'invisible 'org-link |
20908596 CD |
4639 | 'keymap org-mouse-map 'mouse-face 'highlight |
4640 | 'font-lock-multiline t 'help-echo help))) | |
c8d0cf5c CD |
4641 | (vp (list 'keymap org-mouse-map 'mouse-face 'highlight |
4642 | 'font-lock-multiline t 'help-echo help))) | |
20908596 CD |
4643 | ;; We need to remove the invisible property here. Table narrowing |
4644 | ;; may have made some of this invisible. | |
c8d0cf5c | 4645 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) |
20908596 CD |
4646 | (remove-text-properties (match-beginning 0) (match-end 0) |
4647 | '(invisible nil)) | |
4648 | (if (match-end 3) | |
4649 | (progn | |
4650 | (add-text-properties (match-beginning 0) (match-beginning 3) ip) | |
c8d0cf5c | 4651 | (org-rear-nonsticky-at (match-beginning 3)) |
20908596 | 4652 | (add-text-properties (match-beginning 3) (match-end 3) vp) |
c8d0cf5c CD |
4653 | (org-rear-nonsticky-at (match-end 3)) |
4654 | (add-text-properties (match-end 3) (match-end 0) ip) | |
4655 | (org-rear-nonsticky-at (match-end 0))) | |
20908596 | 4656 | (add-text-properties (match-beginning 0) (match-beginning 1) ip) |
c8d0cf5c | 4657 | (org-rear-nonsticky-at (match-beginning 1)) |
20908596 | 4658 | (add-text-properties (match-beginning 1) (match-end 1) vp) |
c8d0cf5c CD |
4659 | (org-rear-nonsticky-at (match-end 1)) |
4660 | (add-text-properties (match-end 1) (match-end 0) ip) | |
4661 | (org-rear-nonsticky-at (match-end 0))) | |
20908596 | 4662 | t))) |
891f4676 | 4663 | |
20908596 CD |
4664 | (defun org-activate-dates (limit) |
4665 | "Run through the buffer and add overlays to dates." | |
4666 | (if (re-search-forward org-tsr-regexp-both limit t) | |
4667 | (progn | |
c8d0cf5c | 4668 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) |
20908596 CD |
4669 | (add-text-properties (match-beginning 0) (match-end 0) |
4670 | (list 'mouse-face 'highlight | |
20908596 | 4671 | 'keymap org-mouse-map)) |
c8d0cf5c | 4672 | (org-rear-nonsticky-at (match-end 0)) |
20908596 CD |
4673 | (when org-display-custom-times |
4674 | (if (match-end 3) | |
4675 | (org-display-custom-time (match-beginning 3) (match-end 3))) | |
4676 | (org-display-custom-time (match-beginning 1) (match-end 1))) | |
4677 | t))) | |
891f4676 | 4678 | |
20908596 CD |
4679 | (defvar org-target-link-regexp nil |
4680 | "Regular expression matching radio targets in plain text.") | |
ff4be292 | 4681 | (make-variable-buffer-local 'org-target-link-regexp) |
20908596 CD |
4682 | (defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" |
4683 | "Regular expression matching a link target.") | |
4684 | (defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" | |
4685 | "Regular expression matching a radio target.") | |
4686 | (defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target. | |
4687 | "Regular expression matching any target.") | |
a3fbe8c4 | 4688 | |
20908596 CD |
4689 | (defun org-activate-target-links (limit) |
4690 | "Run through the buffer and add overlays to target matches." | |
4691 | (when org-target-link-regexp | |
4692 | (let ((case-fold-search t)) | |
4693 | (if (re-search-forward org-target-link-regexp limit t) | |
4694 | (progn | |
c8d0cf5c | 4695 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) |
20908596 CD |
4696 | (add-text-properties (match-beginning 0) (match-end 0) |
4697 | (list 'mouse-face 'highlight | |
20908596 CD |
4698 | 'keymap org-mouse-map |
4699 | 'help-echo "Radio target link" | |
4700 | 'org-linked-text t)) | |
c8d0cf5c | 4701 | (org-rear-nonsticky-at (match-end 0)) |
20908596 | 4702 | t))))) |
891f4676 | 4703 | |
20908596 CD |
4704 | (defun org-update-radio-target-regexp () |
4705 | "Find all radio targets in this file and update the regular expression." | |
4706 | (interactive) | |
4707 | (when (memq 'radio org-activate-links) | |
4708 | (setq org-target-link-regexp | |
4709 | (org-make-target-link-regexp (org-all-targets 'radio))) | |
4710 | (org-restart-font-lock))) | |
891f4676 | 4711 | |
20908596 CD |
4712 | (defun org-hide-wide-columns (limit) |
4713 | (let (s e) | |
4714 | (setq s (text-property-any (point) (or limit (point-max)) | |
4715 | 'org-cwidth t)) | |
4716 | (when s | |
4717 | (setq e (next-single-property-change s 'org-cwidth)) | |
4718 | (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) | |
4719 | (goto-char e) | |
4720 | t))) | |
891f4676 | 4721 | |
20908596 CD |
4722 | (defvar org-latex-and-specials-regexp nil |
4723 | "Regular expression for highlighting export special stuff.") | |
4724 | (defvar org-match-substring-regexp) | |
4725 | (defvar org-match-substring-with-braces-regexp) | |
54a0dee5 CD |
4726 | |
4727 | ;; This should be with the exporter code, but we also use if for font-locking | |
4728 | (defconst org-export-html-special-string-regexps | |
4729 | '(("\\\\-" . "­") | |
4730 | ("---\\([^-]\\)" . "—\\1") | |
4731 | ("--\\([^-]\\)" . "–\\1") | |
4732 | ("\\.\\.\\." . "…")) | |
4733 | "Regular expressions for special string conversion.") | |
4734 | ||
891f4676 | 4735 | |
20908596 CD |
4736 | (defun org-compute-latex-and-specials-regexp () |
4737 | "Compute regular expression for stuff treated specially by exporters." | |
4738 | (if (not org-highlight-latex-fragments-and-specials) | |
4739 | (org-set-local 'org-latex-and-specials-regexp nil) | |
4740 | (require 'org-exp) | |
4741 | (let* | |
4742 | ((matchers (plist-get org-format-latex-options :matchers)) | |
4743 | (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) | |
4744 | org-latex-regexps))) | |
4745 | (options (org-combine-plists (org-default-export-plist) | |
4746 | (org-infile-export-plist))) | |
4747 | (org-export-with-sub-superscripts (plist-get options :sub-superscript)) | |
4748 | (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) | |
4749 | (org-export-with-TeX-macros (plist-get options :TeX-macros)) | |
4750 | (org-export-html-expand (plist-get options :expand-quoted-html)) | |
4751 | (org-export-with-special-strings (plist-get options :special-strings)) | |
4752 | (re-sub | |
4753 | (cond | |
4754 | ((equal org-export-with-sub-superscripts '{}) | |
4755 | (list org-match-substring-with-braces-regexp)) | |
4756 | (org-export-with-sub-superscripts | |
4757 | (list org-match-substring-regexp)) | |
4758 | (t nil))) | |
4759 | (re-latex | |
4760 | (if org-export-with-LaTeX-fragments | |
4761 | (mapcar (lambda (x) (nth 1 x)) latexs))) | |
4762 | (re-macros | |
4763 | (if org-export-with-TeX-macros | |
4764 | (list (concat "\\\\" | |
4765 | (regexp-opt | |
4766 | (append (mapcar 'car org-html-entities) | |
4767 | (if (boundp 'org-latex-entities) | |
c8d0cf5c CD |
4768 | (mapcar (lambda (x) |
4769 | (or (car-safe x) x)) | |
4770 | org-latex-entities) | |
4771 | nil)) | |
20908596 CD |
4772 | 'words))) ; FIXME |
4773 | )) | |
4774 | ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) | |
4775 | (re-special (if org-export-with-special-strings | |
4776 | (mapcar (lambda (x) (car x)) | |
4777 | org-export-html-special-string-regexps))) | |
4778 | (re-rest | |
4779 | (delq nil | |
4780 | (list | |
4781 | (if org-export-html-expand "@<[^>\n]+>") | |
4782 | )))) | |
4783 | (org-set-local | |
4784 | 'org-latex-and-specials-regexp | |
4785 | (mapconcat 'identity (append re-latex re-sub re-macros re-special | |
4786 | re-rest) "\\|"))))) | |
d3f4dbe8 | 4787 | |
20908596 CD |
4788 | (defun org-do-latex-and-special-faces (limit) |
4789 | "Run through the buffer and add overlays to links." | |
4790 | (when org-latex-and-specials-regexp | |
4791 | (let (rtn d) | |
4792 | (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp | |
4793 | limit t)) | |
4794 | (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) | |
4795 | 'face)) | |
4796 | '(org-code org-verbatim underline))) | |
4797 | (progn | |
4798 | (setq rtn t | |
4799 | d (cond ((member (char-after (1+ (match-beginning 0))) | |
4800 | '(?_ ?^)) 1) | |
4801 | (t 0))) | |
4802 | (font-lock-prepend-text-property | |
4803 | (+ d (match-beginning 0)) (match-end 0) | |
4804 | 'face 'org-latex-and-export-specials) | |
4805 | (add-text-properties (+ d (match-beginning 0)) (match-end 0) | |
4806 | '(font-lock-multiline t))))) | |
4807 | rtn))) | |
d3f4dbe8 | 4808 | |
20908596 CD |
4809 | (defun org-restart-font-lock () |
4810 | "Restart font-lock-mode, to force refontification." | |
4811 | (when (and (boundp 'font-lock-mode) font-lock-mode) | |
4812 | (font-lock-mode -1) | |
4813 | (font-lock-mode 1))) | |
d3f4dbe8 | 4814 | |
20908596 CD |
4815 | (defun org-all-targets (&optional radio) |
4816 | "Return a list of all targets in this file. | |
4817 | With optional argument RADIO, only find radio targets." | |
4818 | (let ((re (if radio org-radio-target-regexp org-target-regexp)) | |
4819 | rtn) | |
4820 | (save-excursion | |
4821 | (goto-char (point-min)) | |
4822 | (while (re-search-forward re nil t) | |
4823 | (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) | |
4824 | rtn))) | |
891f4676 | 4825 | |
20908596 CD |
4826 | (defun org-make-target-link-regexp (targets) |
4827 | "Make regular expression matching all strings in TARGETS. | |
4828 | The regular expression finds the targets also if there is a line break | |
4829 | between words." | |
4830 | (and targets | |
4831 | (concat | |
4832 | "\\<\\(" | |
4833 | (mapconcat | |
4834 | (lambda (x) | |
4835 | (while (string-match " +" x) | |
4836 | (setq x (replace-match "\\s-+" t t x))) | |
4837 | x) | |
4838 | targets | |
4839 | "\\|") | |
4840 | "\\)\\>"))) | |
3278a016 | 4841 | |
20908596 CD |
4842 | (defun org-activate-tags (limit) |
4843 | (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) | |
4844 | (progn | |
c8d0cf5c | 4845 | (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) |
20908596 CD |
4846 | (add-text-properties (match-beginning 1) (match-end 1) |
4847 | (list 'mouse-face 'highlight | |
20908596 | 4848 | 'keymap org-mouse-map)) |
c8d0cf5c | 4849 | (org-rear-nonsticky-at (match-end 1)) |
20908596 | 4850 | t))) |
891f4676 | 4851 | |
20908596 | 4852 | (defun org-outline-level () |
8bfe682a CD |
4853 | "Compute the outline level of the heading at point. |
4854 | This function assumes that the cursor is at the beginning of a line matched | |
4855 | by outline-regexp. Otherwise it returns garbage. | |
4856 | If this is called at a normal headline, the level is the number of stars. | |
4857 | Use `org-reduced-level' to remove the effect of `org-odd-levels'. | |
4858 | For plain list items, if they are matched by `outline-regexp', this returns | |
4859 | 1000 plus the line indentation." | |
20908596 CD |
4860 | (save-excursion |
4861 | (looking-at outline-regexp) | |
4862 | (if (match-beginning 1) | |
4863 | (+ (org-get-string-indentation (match-string 1)) 1000) | |
4864 | (1- (- (match-end 0) (match-beginning 0)))))) | |
15841868 | 4865 | |
20908596 | 4866 | (defvar org-font-lock-keywords nil) |
891f4676 | 4867 | |
b349f79f | 4868 | (defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\):\\)[ \t]*\\([^ \t\r\n].*\\)") |
20908596 | 4869 | "Regular expression matching a property line.") |
891f4676 | 4870 | |
b349f79f CD |
4871 | (defvar org-font-lock-hook nil |
4872 | "Functions to be called for special font lock stuff.") | |
4873 | ||
4874 | (defun org-font-lock-hook (limit) | |
4875 | (run-hook-with-args 'org-font-lock-hook limit)) | |
4876 | ||
20908596 CD |
4877 | (defun org-set-font-lock-defaults () |
4878 | (let* ((em org-fontify-emphasized-text) | |
4879 | (lk org-activate-links) | |
4880 | (org-font-lock-extra-keywords | |
4881 | (list | |
b349f79f CD |
4882 | ;; Call the hook |
4883 | '(org-font-lock-hook) | |
20908596 | 4884 | ;; Headlines |
c8d0cf5c CD |
4885 | `(,(if org-fontify-whole-heading-line |
4886 | "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" | |
4887 | "^\\(\\**\\)\\(\\* \\)\\(.*\\)") | |
4888 | (1 (org-get-level-face 1)) | |
4889 | (2 (org-get-level-face 2)) | |
4890 | (3 (org-get-level-face 3))) | |
20908596 CD |
4891 | ;; Table lines |
4892 | '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" | |
4893 | (1 'org-table t)) | |
4894 | ;; Table internals | |
4895 | '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) | |
4896 | '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) | |
4897 | '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) | |
c8d0cf5c | 4898 | '("| *\\(<[lr]?[0-9]*>\\)" (1 'org-formula t)) |
20908596 CD |
4899 | ;; Drawers |
4900 | (list org-drawer-regexp '(0 'org-special-keyword t)) | |
4901 | (list "^[ \t]*:END:" '(0 'org-special-keyword t)) | |
4902 | ;; Properties | |
4903 | (list org-property-re | |
4904 | '(1 'org-special-keyword t) | |
4905 | '(3 'org-property-value t)) | |
20908596 CD |
4906 | ;; Links |
4907 | (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) | |
4908 | (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) | |
5dec9555 | 4909 | (if (memq 'plain lk) '(org-activate-plain-links)) |
20908596 CD |
4910 | (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) |
4911 | (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) | |
4912 | (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) | |
0bd48b37 CD |
4913 | (if (memq 'footnote lk) '(org-activate-footnote-links |
4914 | (2 'org-footnote t))) | |
20908596 CD |
4915 | '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) |
4916 | '(org-hide-wide-columns (0 nil append)) | |
4917 | ;; TODO lines | |
c8d0cf5c | 4918 | (list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)") |
20908596 CD |
4919 | '(1 (org-get-todo-face 1) t)) |
4920 | ;; DONE | |
4921 | (if org-fontify-done-headline | |
4922 | (list (concat "^[*]+ +\\<\\(" | |
4923 | (mapconcat 'regexp-quote org-done-keywords "\\|") | |
4924 | "\\)\\(.*\\)") | |
4925 | '(2 'org-headline-done t)) | |
4926 | nil) | |
4927 | ;; Priorities | |
c8d0cf5c | 4928 | '(org-font-lock-add-priority-faces) |
ff4be292 CD |
4929 | ;; Tags |
4930 | '(org-font-lock-add-tag-faces) | |
20908596 CD |
4931 | ;; Special keywords |
4932 | (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) | |
4933 | (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) | |
4934 | (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) | |
4935 | (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) | |
4936 | ;; Emphasis | |
4937 | (if em | |
4938 | (if (featurep 'xemacs) | |
4939 | '(org-do-emphasis-faces (0 nil append)) | |
4940 | '(org-do-emphasis-faces))) | |
4941 | ;; Checkboxes | |
4942 | '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" | |
c8d0cf5c | 4943 | 2 'org-checkbox prepend) |
20908596 CD |
4944 | (if org-provide-checkbox-statistics |
4945 | '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" | |
4946 | (0 (org-get-checkbox-statistics-face) t))) | |
b349f79f CD |
4947 | ;; Description list items |
4948 | '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)" | |
4949 | 2 'bold prepend) | |
c8d0cf5c | 4950 | ;; ARCHIVEd headings |
20908596 CD |
4951 | (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") |
4952 | '(1 'org-archived prepend)) | |
4953 | ;; Specials | |
4954 | '(org-do-latex-and-special-faces) | |
4955 | ;; Code | |
4956 | '(org-activate-code (1 'org-code t)) | |
4957 | ;; COMMENT | |
4958 | (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string | |
4959 | "\\|" org-quote-string "\\)\\>") | |
4960 | '(1 'org-special-keyword t)) | |
4961 | '("^#.*" (0 'font-lock-comment-face t)) | |
c8d0cf5c CD |
4962 | ;; Blocks and meta lines |
4963 | '(org-fontify-meta-lines-and-blocks) | |
20908596 CD |
4964 | ))) |
4965 | (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) | |
4966 | ;; Now set the full font-lock-keywords | |
4967 | (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) | |
4968 | (org-set-local 'font-lock-defaults | |
4969 | '(org-font-lock-keywords t nil nil backward-paragraph)) | |
4970 | (kill-local-variable 'font-lock-keywords) nil)) | |
4971 | ||
c8d0cf5c CD |
4972 | (defun org-fontify-like-in-org-mode (s &optional odd-levels) |
4973 | "Fontify string S like in Org-mode" | |
4974 | (with-temp-buffer | |
4975 | (insert s) | |
4976 | (let ((org-odd-levels-only odd-levels)) | |
4977 | (org-mode) | |
4978 | (font-lock-fontify-buffer) | |
4979 | (buffer-string)))) | |
4980 | ||
20908596 CD |
4981 | (defvar org-m nil) |
4982 | (defvar org-l nil) | |
4983 | (defvar org-f nil) | |
4984 | (defun org-get-level-face (n) | |
33306645 | 4985 | "Get the right face for match N in font-lock matching of headlines." |
20908596 CD |
4986 | (setq org-l (- (match-end 2) (match-beginning 1) 1)) |
4987 | (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) | |
4988 | (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) | |
4989 | (cond | |
4990 | ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) | |
4991 | ((eq n 2) org-f) | |
4992 | (t (if org-level-color-stars-only nil org-f)))) | |
4993 | ||
4994 | (defun org-get-todo-face (kwd) | |
4995 | "Get the right face for a TODO keyword KWD. | |
4996 | If KWD is a number, get the corresponding match group." | |
4997 | (if (numberp kwd) (setq kwd (match-string kwd))) | |
4998 | (or (cdr (assoc kwd org-todo-keyword-faces)) | |
4999 | (and (member kwd org-done-keywords) 'org-done) | |
5000 | 'org-todo)) | |
d3f4dbe8 | 5001 | |
ff4be292 CD |
5002 | (defun org-font-lock-add-tag-faces (limit) |
5003 | "Add the special tag faces." | |
5004 | (when (and org-tag-faces org-tags-special-faces-re) | |
5005 | (while (re-search-forward org-tags-special-faces-re limit t) | |
5006 | (add-text-properties (match-beginning 1) (match-end 1) | |
5007 | (list 'face (org-get-tag-face 1) | |
5008 | 'font-lock-fontified t)) | |
5009 | (backward-char 1)))) | |
5010 | ||
c8d0cf5c CD |
5011 | (defun org-font-lock-add-priority-faces (limit) |
5012 | "Add the special priority faces." | |
5013 | (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t) | |
5014 | (add-text-properties | |
5015 | (match-beginning 0) (match-end 0) | |
5016 | (list 'face (or (cdr (assoc (char-after (match-beginning 1)) | |
5017 | org-priority-faces)) | |
5018 | 'org-special-keyword) | |
5019 | 'font-lock-fontified t)))) | |
5020 | ||
ff4be292 CD |
5021 | (defun org-get-tag-face (kwd) |
5022 | "Get the right face for a TODO keyword KWD. | |
5023 | If KWD is a number, get the corresponding match group." | |
5024 | (if (numberp kwd) (setq kwd (match-string kwd))) | |
5025 | (or (cdr (assoc kwd org-tag-faces)) | |
5026 | 'org-tag)) | |
5027 | ||
20908596 CD |
5028 | (defun org-unfontify-region (beg end &optional maybe_loudly) |
5029 | "Remove fontification and activation overlays from links." | |
5030 | (font-lock-default-unfontify-region beg end) | |
5031 | (let* ((buffer-undo-list t) | |
5032 | (inhibit-read-only t) (inhibit-point-motion-hooks t) | |
5033 | (inhibit-modification-hooks t) | |
5034 | deactivate-mark buffer-file-name buffer-file-truename) | |
8bfe682a CD |
5035 | (remove-text-properties |
5036 | beg end | |
5037 | (if org-indent-mode | |
5038 | ;; also remove line-prefix and wrap-prefix properties | |
5039 | '(mouse-face t keymap t org-linked-text t | |
5040 | invisible t intangible t | |
5041 | line-prefix t wrap-prefix t | |
5042 | org-no-flyspell t) | |
5043 | '(mouse-face t keymap t org-linked-text t | |
5044 | invisible t intangible t | |
5045 | org-no-flyspell t))))) | |
d3f4dbe8 | 5046 | |
20908596 | 5047 | ;;;; Visibility cycling, including org-goto and indirect buffer |
7ac93e3c | 5048 | |
20908596 | 5049 | ;;; Cycling |
891f4676 | 5050 | |
20908596 CD |
5051 | (defvar org-cycle-global-status nil) |
5052 | (make-variable-buffer-local 'org-cycle-global-status) | |
5053 | (defvar org-cycle-subtree-status nil) | |
5054 | (make-variable-buffer-local 'org-cycle-subtree-status) | |
891f4676 | 5055 | |
48aaad2d | 5056 | ;;;###autoload |
c8d0cf5c CD |
5057 | |
5058 | (defvar org-inlinetask-min-level) | |
5059 | ||
20908596 | 5060 | (defun org-cycle (&optional arg) |
c8d0cf5c CD |
5061 | "TAB-action and visibility cycling for Org-mode. |
5062 | ||
54a0dee5 | 5063 | This is the command invoked in Org-mode by the TAB key. Its main purpose |
8bfe682a | 5064 | is outline visibility cycling, but it also invokes other actions |
c8d0cf5c | 5065 | in special contexts. |
891f4676 | 5066 | |
20908596 CD |
5067 | - When this function is called with a prefix argument, rotate the entire |
5068 | buffer through 3 states (global cycling) | |
5069 | 1. OVERVIEW: Show only top-level headlines. | |
5070 | 2. CONTENTS: Show all headlines of all levels, but no body text. | |
5071 | 3. SHOW ALL: Show everything. | |
c8d0cf5c | 5072 | When called with two `C-u C-u' prefixes, switch to the startup visibility, |
b349f79f CD |
5073 | determined by the variable `org-startup-folded', and by any VISIBILITY |
5074 | properties in the buffer. | |
c8d0cf5c CD |
5075 | When called with three `C-u C-u C-u' prefixed, show the entire buffer, |
5076 | including any drawers. | |
5077 | ||
5078 | - When inside a table, re-align the table and move to the next field. | |
eb2f9c59 | 5079 | |
20908596 CD |
5080 | - When point is at the beginning of a headline, rotate the subtree started |
5081 | by this line through 3 different states (local cycling) | |
5082 | 1. FOLDED: Only the main headline is shown. | |
5083 | 2. CHILDREN: The main headline and the direct children are shown. | |
5084 | From this state, you can move to one of the children | |
5085 | and zoom in further. | |
5086 | 3. SUBTREE: Show the entire subtree, including body text. | |
c8d0cf5c | 5087 | If there is no subtree, switch directly from CHILDREN to FOLDED. |
eb2f9c59 | 5088 | |
20908596 CD |
5089 | - When there is a numeric prefix, go up to a heading with level ARG, do |
5090 | a `show-subtree' and return to the previous cursor position. If ARG | |
5091 | is negative, go up that many levels. | |
eb2f9c59 | 5092 | |
b349f79f CD |
5093 | - When point is not at the beginning of a headline, execute the global |
5094 | binding for TAB, which is re-indenting the line. See the option | |
20908596 | 5095 | `org-cycle-emulate-tab' for details. |
c8d16429 | 5096 | |
20908596 CD |
5097 | - Special case: if point is at the beginning of the buffer and there is |
5098 | no headline in line 1, this function will act as if called with prefix arg. | |
5099 | But only if also the variable `org-cycle-global-at-bob' is t." | |
d3f4dbe8 | 5100 | (interactive "P") |
20908596 | 5101 | (org-load-modules-maybe) |
8bfe682a CD |
5102 | (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) |
5103 | (and org-cycle-level-after-item/entry-creation | |
5104 | (or (org-cycle-level) | |
5105 | (org-cycle-item-indentation)))) | |
c8d0cf5c CD |
5106 | (let* ((limit-level |
5107 | (or org-cycle-max-level | |
5108 | (and (boundp 'org-inlinetask-min-level) | |
5109 | org-inlinetask-min-level | |
5110 | (1- org-inlinetask-min-level)))) | |
5111 | (nstars (and limit-level | |
5112 | (if org-odd-levels-only | |
5113 | (and limit-level (1- (* limit-level 2))) | |
5114 | limit-level))) | |
5115 | (outline-regexp | |
5116 | (cond | |
5117 | ((not (org-mode-p)) outline-regexp) | |
5118 | ((or (eq org-cycle-include-plain-lists 'integrate) | |
5119 | (and org-cycle-include-plain-lists (org-at-item-p))) | |
5120 | (concat "\\(?:\\*" | |
5121 | (if nstars (format "\\{1,%d\\}" nstars) "+") | |
5122 | " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)")) | |
5123 | (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))) | |
5124 | (bob-special (and org-cycle-global-at-bob (bobp) | |
5125 | (not (looking-at outline-regexp)))) | |
5126 | (org-cycle-hook | |
5127 | (if bob-special | |
5128 | (delq 'org-optimize-window-after-visibility-change | |
5129 | (copy-sequence org-cycle-hook)) | |
5130 | org-cycle-hook)) | |
5131 | (pos (point))) | |
5132 | ||
5133 | (if (or bob-special (equal arg '(4))) | |
5134 | ;; special case: use global cycling | |
5135 | (setq arg t)) | |
fbe6c10d | 5136 | |
c8d0cf5c | 5137 | (cond |
621f83e4 | 5138 | |
c8d0cf5c CD |
5139 | ((equal arg '(16)) |
5140 | (org-set-startup-visibility) | |
5141 | (message "Startup visibility, plus VISIBILITY properties")) | |
b349f79f | 5142 | |
c8d0cf5c CD |
5143 | ((equal arg '(64)) |
5144 | (show-all) | |
5145 | (message "Entire buffer visible, including drawers")) | |
6e2752e7 | 5146 | |
c8d0cf5c CD |
5147 | ((org-at-table-p 'any) |
5148 | ;; Enter the table or move to the next field in the table | |
5149 | (or (org-table-recognize-table.el) | |
5150 | (progn | |
5151 | (if arg (org-table-edit-field t) | |
5152 | (org-table-justify-field-maybe) | |
5153 | (call-interactively 'org-table-next-field))))) | |
5154 | ||
5155 | ((run-hook-with-args-until-success | |
5156 | 'org-tab-after-check-for-table-hook)) | |
5157 | ||
5158 | ((eq arg t) ;; Global cycling | |
5159 | (org-cycle-internal-global)) | |
5160 | ||
5161 | ((and org-drawers org-drawer-regexp | |
5162 | (save-excursion | |
5163 | (beginning-of-line 1) | |
5164 | (looking-at org-drawer-regexp))) | |
5165 | ;; Toggle block visibility | |
5166 | (org-flag-drawer | |
5167 | (not (get-char-property (match-end 0) 'invisible)))) | |
5168 | ||
5169 | ((integerp arg) | |
5170 | ;; Show-subtree, ARG levels up from here. | |
5171 | (save-excursion | |
5172 | (org-back-to-heading) | |
5173 | (outline-up-heading (if (< arg 0) (- arg) | |
5174 | (- (funcall outline-level) arg))) | |
5175 | (org-show-subtree))) | |
64f72ae1 | 5176 | |
c8d0cf5c CD |
5177 | ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) |
5178 | (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) | |
20908596 | 5179 | |
c8d0cf5c | 5180 | (org-cycle-internal-local)) |
20908596 | 5181 | |
c8d0cf5c CD |
5182 | ;; TAB emulation and template completion |
5183 | (buffer-read-only (org-back-to-heading)) | |
20908596 | 5184 | |
c8d0cf5c CD |
5185 | ((run-hook-with-args-until-success |
5186 | 'org-tab-after-check-for-cycling-hook)) | |
20908596 | 5187 | |
c8d0cf5c | 5188 | ((org-try-structure-completion)) |
eb2f9c59 | 5189 | |
c8d0cf5c | 5190 | ((org-try-cdlatex-tab)) |
3278a016 | 5191 | |
8bfe682a CD |
5192 | ((run-hook-with-args-until-success |
5193 | 'org-tab-before-tab-emulation-hook)) | |
5194 | ||
c8d0cf5c CD |
5195 | ((and (eq org-cycle-emulate-tab 'exc-hl-bol) |
5196 | (or (not (bolp)) | |
5197 | (not (looking-at outline-regexp)))) | |
5198 | (call-interactively (global-key-binding "\t"))) | |
b349f79f | 5199 | |
c8d0cf5c CD |
5200 | ((if (and (memq org-cycle-emulate-tab '(white whitestart)) |
5201 | (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) | |
5202 | (or (and (eq org-cycle-emulate-tab 'white) | |
5203 | (= (match-end 0) (point-at-eol))) | |
5204 | (and (eq org-cycle-emulate-tab 'whitestart) | |
5205 | (>= (match-end 0) pos)))) | |
5206 | t | |
5207 | (eq org-cycle-emulate-tab t)) | |
5208 | (call-interactively (global-key-binding "\t"))) | |
eb2f9c59 | 5209 | |
c8d0cf5c CD |
5210 | (t (save-excursion |
5211 | (org-back-to-heading) | |
5212 | (org-cycle))))))) | |
634a7d0b | 5213 | |
c8d0cf5c CD |
5214 | (defun org-cycle-internal-global () |
5215 | "Do the global cycling action." | |
5216 | (cond | |
5217 | ((and (eq last-command this-command) | |
5218 | (eq org-cycle-global-status 'overview)) | |
5219 | ;; We just created the overview - now do table of contents | |
5220 | ;; This can be slow in very large buffers, so indicate action | |
5221 | (run-hook-with-args 'org-pre-cycle-hook 'contents) | |
5222 | (message "CONTENTS...") | |
5223 | (org-content) | |
5224 | (message "CONTENTS...done") | |
5225 | (setq org-cycle-global-status 'contents) | |
5226 | (run-hook-with-args 'org-cycle-hook 'contents)) | |
5227 | ||
5228 | ((and (eq last-command this-command) | |
5229 | (eq org-cycle-global-status 'contents)) | |
5230 | ;; We just showed the table of contents - now show everything | |
5231 | (run-hook-with-args 'org-pre-cycle-hook 'all) | |
5232 | (show-all) | |
5233 | (message "SHOW ALL") | |
5234 | (setq org-cycle-global-status 'all) | |
5235 | (run-hook-with-args 'org-cycle-hook 'all)) | |
20908596 | 5236 | |
c8d0cf5c CD |
5237 | (t |
5238 | ;; Default action: go to overview | |
5239 | (run-hook-with-args 'org-pre-cycle-hook 'overview) | |
5240 | (org-overview) | |
5241 | (message "OVERVIEW") | |
5242 | (setq org-cycle-global-status 'overview) | |
5243 | (run-hook-with-args 'org-cycle-hook 'overview)))) | |
5244 | ||
5245 | (defun org-cycle-internal-local () | |
5246 | "Do the local cycling action." | |
5247 | (org-back-to-heading) | |
5248 | (let ((goal-column 0) eoh eol eos level has-children children-skipped) | |
5249 | ;; First, some boundaries | |
5250 | (save-excursion | |
5251 | (org-back-to-heading) | |
5252 | (setq level (funcall outline-level)) | |
5253 | (save-excursion | |
5254 | (beginning-of-line 2) | |
5255 | (if (or (featurep 'xemacs) (<= emacs-major-version 21)) | |
5256 | ; XEmacs does not have `next-single-char-property-change' | |
5257 | ; I'm not sure about Emacs 21. | |
5258 | (while (and (not (eobp)) ;; this is like `next-line' | |
5259 | (get-char-property (1- (point)) 'invisible)) | |
5260 | (beginning-of-line 2)) | |
5261 | (while (and (not (eobp)) ;; this is like `next-line' | |
5262 | (get-char-property (1- (point)) 'invisible)) | |
5263 | (goto-char (next-single-char-property-change (point) 'invisible)) | |
5264 | ;;;??? (or (bolp) (beginning-of-line 2)))) | |
5265 | (and (eolp) (beginning-of-line 2)))) | |
5266 | (setq eol (point))) | |
5267 | (outline-end-of-heading) (setq eoh (point)) | |
5268 | (save-excursion | |
5269 | (outline-next-heading) | |
5270 | (setq has-children (and (org-at-heading-p t) | |
5271 | (> (funcall outline-level) level)))) | |
5272 | (org-end-of-subtree t) | |
5273 | (unless (eobp) | |
5274 | (skip-chars-forward " \t\n") | |
5275 | (beginning-of-line 1) ; in case this is an item | |
5276 | ) | |
54a0dee5 | 5277 | (setq eos (if (eobp) (point) (1- (point))))) |
c8d0cf5c CD |
5278 | ;; Find out what to do next and set `this-command' |
5279 | (cond | |
5280 | ((= eos eoh) | |
5281 | ;; Nothing is hidden behind this heading | |
5282 | (run-hook-with-args 'org-pre-cycle-hook 'empty) | |
5283 | (message "EMPTY ENTRY") | |
5284 | (setq org-cycle-subtree-status nil) | |
5285 | (save-excursion | |
5286 | (goto-char eos) | |
5287 | (outline-next-heading) | |
5288 | (if (org-invisible-p) (org-flag-heading nil)))) | |
5289 | ((and (or (>= eol eos) | |
5290 | (not (string-match "\\S-" (buffer-substring eol eos)))) | |
5291 | (or has-children | |
5292 | (not (setq children-skipped | |
5293 | org-cycle-skip-children-state-if-no-children)))) | |
5294 | ;; Entire subtree is hidden in one line: children view | |
5295 | (run-hook-with-args 'org-pre-cycle-hook 'children) | |
5296 | (org-show-entry) | |
5297 | (show-children) | |
5298 | (message "CHILDREN") | |
5299 | (save-excursion | |
5300 | (goto-char eos) | |
5301 | (outline-next-heading) | |
5302 | (if (org-invisible-p) (org-flag-heading nil))) | |
5303 | (setq org-cycle-subtree-status 'children) | |
5304 | (run-hook-with-args 'org-cycle-hook 'children)) | |
5305 | ((or children-skipped | |
5306 | (and (eq last-command this-command) | |
5307 | (eq org-cycle-subtree-status 'children))) | |
5308 | ;; We just showed the children, or no children are there, | |
5309 | ;; now show everything. | |
5310 | (run-hook-with-args 'org-pre-cycle-hook 'subtree) | |
5311 | (org-show-subtree) | |
5312 | (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) | |
5313 | (setq org-cycle-subtree-status 'subtree) | |
5314 | (run-hook-with-args 'org-cycle-hook 'subtree)) | |
5315 | (t | |
5316 | ;; Default action: hide the subtree. | |
5317 | (run-hook-with-args 'org-pre-cycle-hook 'folded) | |
5318 | (hide-subtree) | |
5319 | (message "FOLDED") | |
5320 | (setq org-cycle-subtree-status 'folded) | |
5321 | (run-hook-with-args 'org-cycle-hook 'folded))))) | |
20908596 CD |
5322 | |
5323 | ;;;###autoload | |
5324 | (defun org-global-cycle (&optional arg) | |
b349f79f CD |
5325 | "Cycle the global visibility. For details see `org-cycle'. |
5326 | With C-u prefix arg, switch to startup visibility. | |
5327 | With a numeric prefix, show all headlines up to that level." | |
20908596 CD |
5328 | (interactive "P") |
5329 | (let ((org-cycle-include-plain-lists | |
5330 | (if (org-mode-p) org-cycle-include-plain-lists nil))) | |
b349f79f CD |
5331 | (cond |
5332 | ((integerp arg) | |
5333 | (show-all) | |
5334 | (hide-sublevels arg) | |
5335 | (setq org-cycle-global-status 'contents)) | |
5336 | ((equal arg '(4)) | |
5337 | (org-set-startup-visibility) | |
5338 | (message "Startup visibility, plus VISIBILITY properties.")) | |
5339 | (t | |
5340 | (org-cycle '(4)))))) | |
5341 | ||
5342 | (defun org-set-startup-visibility () | |
5343 | "Set the visibility required by startup options and properties." | |
5344 | (cond | |
5345 | ((eq org-startup-folded t) | |
5346 | (org-cycle '(4))) | |
5347 | ((eq org-startup-folded 'content) | |
5348 | (let ((this-command 'org-cycle) (last-command 'org-cycle)) | |
5349 | (org-cycle '(4)) (org-cycle '(4))))) | |
8d642074 CD |
5350 | (unless (eq org-startup-folded 'showeverything) |
5351 | (if org-hide-block-startup (org-hide-block-all)) | |
5352 | (org-set-visibility-according-to-property 'no-cleanup) | |
5353 | (org-cycle-hide-archived-subtrees 'all) | |
5354 | (org-cycle-hide-drawers 'all) | |
5355 | (org-cycle-show-empty-lines 'all))) | |
b349f79f CD |
5356 | |
5357 | (defun org-set-visibility-according-to-property (&optional no-cleanup) | |
5358 | "Switch subtree visibilities according to :VISIBILITY: property." | |
5359 | (interactive) | |
65c439fd | 5360 | (let (org-show-entry-below state) |
b349f79f CD |
5361 | (save-excursion |
5362 | (goto-char (point-min)) | |
5363 | (while (re-search-forward | |
5364 | "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)" | |
5365 | nil t) | |
5366 | (setq state (match-string 1)) | |
5367 | (save-excursion | |
5368 | (org-back-to-heading t) | |
5369 | (hide-subtree) | |
5370 | (org-reveal) | |
5371 | (cond | |
5372 | ((equal state '("fold" "folded")) | |
5373 | (hide-subtree)) | |
5374 | ((equal state "children") | |
5375 | (org-show-hidden-entry) | |
5376 | (show-children)) | |
5377 | ((equal state "content") | |
5378 | (save-excursion | |
5379 | (save-restriction | |
5380 | (org-narrow-to-subtree) | |
5381 | (org-content)))) | |
5382 | ((member state '("all" "showall")) | |
5383 | (show-subtree))))) | |
5384 | (unless no-cleanup | |
5385 | (org-cycle-hide-archived-subtrees 'all) | |
5386 | (org-cycle-hide-drawers 'all) | |
5387 | (org-cycle-show-empty-lines 'all))))) | |
3278a016 | 5388 | |
20908596 | 5389 | (defun org-overview () |
33306645 | 5390 | "Switch to overview mode, showing only top-level headlines. |
20908596 CD |
5391 | Really, this shows all headlines with level equal or greater than the level |
5392 | of the first headline in the buffer. This is important, because if the | |
5393 | first headline is not level one, then (hide-sublevels 1) gives confusing | |
5394 | results." | |
d3f4dbe8 | 5395 | (interactive) |
20908596 CD |
5396 | (let ((level (save-excursion |
5397 | (goto-char (point-min)) | |
5398 | (if (re-search-forward (concat "^" outline-regexp) nil t) | |
5399 | (progn | |
5400 | (goto-char (match-beginning 0)) | |
5401 | (funcall outline-level)))))) | |
5402 | (and level (hide-sublevels level)))) | |
891f4676 | 5403 | |
20908596 CD |
5404 | (defun org-content (&optional arg) |
5405 | "Show all headlines in the buffer, like a table of contents. | |
5406 | With numerical argument N, show content up to level N." | |
5407 | (interactive "P") | |
5408 | (save-excursion | |
5409 | ;; Visit all headings and show their offspring | |
5410 | (and (integerp arg) (org-overview)) | |
5411 | (goto-char (point-max)) | |
5412 | (catch 'exit | |
5413 | (while (and (progn (condition-case nil | |
5414 | (outline-previous-visible-heading 1) | |
5415 | (error (goto-char (point-min)))) | |
5416 | t) | |
5417 | (looking-at outline-regexp)) | |
5418 | (if (integerp arg) | |
5419 | (show-children (1- arg)) | |
5420 | (show-branches)) | |
5421 | (if (bobp) (throw 'exit nil)))))) | |
891f4676 | 5422 | |
d943b3c6 | 5423 | |
20908596 CD |
5424 | (defun org-optimize-window-after-visibility-change (state) |
5425 | "Adjust the window after a change in outline visibility. | |
5426 | This function is the default value of the hook `org-cycle-hook'." | |
5427 | (when (get-buffer-window (current-buffer)) | |
5428 | (cond | |
20908596 CD |
5429 | ((eq state 'content) nil) |
5430 | ((eq state 'all) nil) | |
5431 | ((eq state 'folded) nil) | |
5432 | ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) | |
5433 | ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) | |
891f4676 | 5434 | |
c8d0cf5c CD |
5435 | (defun org-remove-empty-overlays-at (pos) |
5436 | "Remove outline overlays that do not contain non-white stuff." | |
5437 | (mapc | |
5438 | (lambda (o) | |
5439 | (and (eq 'outline (org-overlay-get o 'invisible)) | |
5440 | (not (string-match "\\S-" (buffer-substring (org-overlay-start o) | |
5441 | (org-overlay-end o)))) | |
5442 | (org-delete-overlay o))) | |
5443 | (org-overlays-at pos))) | |
5444 | ||
5445 | (defun org-clean-visibility-after-subtree-move () | |
5446 | "Fix visibility issues after moving a subtree." | |
5447 | ;; First, find a reasonable region to look at: | |
5448 | ;; Start two siblings above, end three below | |
5449 | (let* ((beg (save-excursion | |
54a0dee5 CD |
5450 | (and (org-get-last-sibling) |
5451 | (org-get-last-sibling)) | |
c8d0cf5c CD |
5452 | (point))) |
5453 | (end (save-excursion | |
54a0dee5 CD |
5454 | (and (org-get-next-sibling) |
5455 | (org-get-next-sibling) | |
5456 | (org-get-next-sibling)) | |
c8d0cf5c CD |
5457 | (if (org-at-heading-p) |
5458 | (point-at-eol) | |
5459 | (point)))) | |
5460 | (level (looking-at "\\*+")) | |
5461 | (re (if level (concat "^" (regexp-quote (match-string 0)) " ")))) | |
5462 | (save-excursion | |
5463 | (save-restriction | |
5464 | (narrow-to-region beg end) | |
5465 | (when re | |
5466 | ;; Properly fold already folded siblings | |
5467 | (goto-char (point-min)) | |
5468 | (while (re-search-forward re nil t) | |
5469 | (if (save-excursion (goto-char (point-at-eol)) (org-invisible-p)) | |
5470 | (hide-entry)))) | |
5471 | (org-cycle-show-empty-lines 'overview) | |
5472 | (org-cycle-hide-drawers 'overview))))) | |
5473 | ||
20908596 CD |
5474 | (defun org-cycle-show-empty-lines (state) |
5475 | "Show empty lines above all visible headlines. | |
5476 | The region to be covered depends on STATE when called through | |
5477 | `org-cycle-hook'. Lisp program can use t for STATE to get the | |
5478 | entire buffer covered. Note that an empty line is only shown if there | |
33306645 | 5479 | are at least `org-cycle-separator-lines' empty lines before the headline." |
54a0dee5 | 5480 | (when (not (= org-cycle-separator-lines 0)) |
20908596 | 5481 | (save-excursion |
54a0dee5 | 5482 | (let* ((n (abs org-cycle-separator-lines)) |
20908596 CD |
5483 | (re (cond |
5484 | ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") | |
5485 | ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") | |
5486 | (t (let ((ns (number-to-string (- n 2)))) | |
5487 | (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" | |
5488 | "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) | |
54a0dee5 | 5489 | beg end b e) |
20908596 CD |
5490 | (cond |
5491 | ((memq state '(overview contents t)) | |
5492 | (setq beg (point-min) end (point-max))) | |
5493 | ((memq state '(children folded)) | |
5494 | (setq beg (point) end (progn (org-end-of-subtree t t) | |
5495 | (beginning-of-line 2) | |
5496 | (point))))) | |
5497 | (when beg | |
5498 | (goto-char beg) | |
5499 | (while (re-search-forward re end t) | |
54a0dee5 CD |
5500 | (unless (get-char-property (match-end 1) 'invisible) |
5501 | (setq e (match-end 1)) | |
5502 | (if (< org-cycle-separator-lines 0) | |
5503 | (setq b (save-excursion | |
5504 | (goto-char (match-beginning 0)) | |
5505 | (org-back-over-empty-lines) | |
8d642074 CD |
5506 | (if (save-excursion |
5507 | (goto-char (max (point-min) (1- (point)))) | |
5508 | (org-on-heading-p)) | |
5509 | (1- (point)) | |
5510 | (point)))) | |
54a0dee5 CD |
5511 | (setq b (match-beginning 1))) |
5512 | (outline-flag-region b e nil))))))) | |
20908596 CD |
5513 | ;; Never hide empty lines at the end of the file. |
5514 | (save-excursion | |
5515 | (goto-char (point-max)) | |
5516 | (outline-previous-heading) | |
5517 | (outline-end-of-heading) | |
5518 | (if (and (looking-at "[ \t\n]+") | |
5519 | (= (match-end 0) (point-max))) | |
5520 | (outline-flag-region (point) (match-end 0) nil)))) | |
48aaad2d | 5521 | |
2c3ad40d CD |
5522 | (defun org-show-empty-lines-in-parent () |
5523 | "Move to the parent and re-show empty lines before visible headlines." | |
5524 | (save-excursion | |
5525 | (let ((context (if (org-up-heading-safe) 'children 'overview))) | |
5526 | (org-cycle-show-empty-lines context)))) | |
5527 | ||
8bfe682a CD |
5528 | (defun org-files-list () |
5529 | "Return `org-agenda-files' list, plus all open org-mode files. | |
5530 | This is useful for operations that need to scan all of a user's | |
5531 | open and agenda-wise Org files." | |
5532 | (let ((files (mapcar 'expand-file-name (org-agenda-files)))) | |
5533 | (dolist (buf (buffer-list)) | |
5534 | (with-current-buffer buf | |
5535 | (if (and (eq major-mode 'org-mode) (buffer-file-name)) | |
5536 | (let ((file (expand-file-name (buffer-file-name)))) | |
5537 | (unless (member file files) | |
5538 | (push file files)))))) | |
5539 | files)) | |
5540 | ||
5541 | (defsubst org-entry-beginning-position () | |
5542 | "Return the beginning position of the current entry." | |
5543 | (save-excursion (outline-back-to-heading t) (point))) | |
5544 | ||
5545 | (defsubst org-entry-end-position () | |
5546 | "Return the end position of the current entry." | |
5547 | (save-excursion (outline-next-heading) (point))) | |
5548 | ||
20908596 CD |
5549 | (defun org-cycle-hide-drawers (state) |
5550 | "Re-hide all drawers after a visibility state change." | |
5551 | (when (and (org-mode-p) | |
c8d0cf5c | 5552 | (not (memq state '(overview folded contents)))) |
20908596 CD |
5553 | (save-excursion |
5554 | (let* ((globalp (memq state '(contents all))) | |
5555 | (beg (if globalp (point-min) (point))) | |
c8d0cf5c CD |
5556 | (end (if globalp (point-max) |
5557 | (if (eq state 'children) | |
5558 | (save-excursion (outline-next-heading) (point)) | |
5559 | (org-end-of-subtree t))))) | |
20908596 CD |
5560 | (goto-char beg) |
5561 | (while (re-search-forward org-drawer-regexp end t) | |
5562 | (org-flag-drawer t)))))) | |
2a57416f | 5563 | |
20908596 CD |
5564 | (defun org-flag-drawer (flag) |
5565 | (save-excursion | |
5566 | (beginning-of-line 1) | |
5567 | (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") | |
5568 | (let ((b (match-end 0)) | |
5569 | (outline-regexp org-outline-regexp)) | |
5570 | (if (re-search-forward | |
5571 | "^[ \t]*:END:" | |
5572 | (save-excursion (outline-next-heading) (point)) t) | |
5573 | (outline-flag-region b (point-at-eol) flag) | |
54a0dee5 | 5574 | (error ":END: line missing at position %s" b)))))) |
891f4676 | 5575 | |
20908596 CD |
5576 | (defun org-subtree-end-visible-p () |
5577 | "Is the end of the current subtree visible?" | |
5578 | (pos-visible-in-window-p | |
5579 | (save-excursion (org-end-of-subtree t) (point)))) | |
2a57416f | 5580 | |
20908596 CD |
5581 | (defun org-first-headline-recenter (&optional N) |
5582 | "Move cursor to the first headline and recenter the headline. | |
5583 | Optional argument N means, put the headline into the Nth line of the window." | |
5584 | (goto-char (point-min)) | |
5585 | (when (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t) | |
5586 | (beginning-of-line) | |
5587 | (recenter (prefix-numeric-value N)))) | |
2a57416f | 5588 | |
c8d0cf5c CD |
5589 | ;;; Folding of blocks |
5590 | ||
5591 | (defconst org-block-regexp | |
5592 | ||
5593 | "^[ \t]*#\\+begin_\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_\\1[ \t]*$" | |
5594 | "Regular expression for hiding blocks.") | |
5595 | ||
5596 | (defvar org-hide-block-overlays nil | |
8bfe682a | 5597 | "Overlays hiding blocks.") |
c8d0cf5c CD |
5598 | (make-variable-buffer-local 'org-hide-block-overlays) |
5599 | ||
5600 | (defun org-block-map (function &optional start end) | |
5601 | "Call func at the head of all source blocks in the current | |
5602 | buffer. Optional arguments START and END can be used to limit | |
5603 | the range." | |
5604 | (let ((start (or start (point-min))) | |
5605 | (end (or end (point-max)))) | |
5606 | (save-excursion | |
5607 | (goto-char start) | |
5608 | (while (and (< (point) end) (re-search-forward org-block-regexp end t)) | |
5609 | (save-excursion | |
5610 | (save-match-data | |
5611 | (goto-char (match-beginning 0)) | |
5612 | (funcall function))))))) | |
5613 | ||
5614 | (defun org-hide-block-toggle-all () | |
5615 | "Toggle the visibility of all blocks in the current buffer." | |
5616 | (org-block-map #'org-hide-block-toggle)) | |
5617 | ||
5618 | (defun org-hide-block-all () | |
5619 | "Fold all blocks in the current buffer." | |
5620 | (interactive) | |
5621 | (org-show-block-all) | |
5622 | (org-block-map #'org-hide-block-toggle-maybe)) | |
5623 | ||
5624 | (defun org-show-block-all () | |
5625 | "Unfold all blocks in the current buffer." | |
5626 | (mapc 'org-delete-overlay org-hide-block-overlays) | |
5627 | (setq org-hide-block-overlays nil)) | |
5628 | ||
5629 | (defun org-hide-block-toggle-maybe () | |
5630 | "Toggle visibility of block at point." | |
5631 | (interactive) | |
5632 | (let ((case-fold-search t)) | |
5633 | (if (save-excursion | |
5634 | (beginning-of-line 1) | |
5635 | (looking-at org-block-regexp)) | |
5636 | (progn (org-hide-block-toggle) | |
5637 | t) ;; to signal that we took action | |
5638 | nil))) ;; to signal that we did not | |
5639 | ||
5640 | (defun org-hide-block-toggle (&optional force) | |
5641 | "Toggle the visibility of the current block." | |
5642 | (interactive) | |
5643 | (save-excursion | |
5644 | (beginning-of-line) | |
5645 | (if (re-search-forward org-block-regexp nil t) | |
5646 | (let ((start (- (match-beginning 4) 1)) ;; beginning of body | |
54a0dee5 CD |
5647 | (end (match-end 0)) ;; end of entire body |
5648 | ov) | |
c8d0cf5c CD |
5649 | (if (memq t (mapcar (lambda (overlay) |
5650 | (eq (org-overlay-get overlay 'invisible) | |
5651 | 'org-hide-block)) | |
5652 | (org-overlays-at start))) | |
54a0dee5 CD |
5653 | (if (or (not force) (eq force 'off)) |
5654 | (mapc (lambda (ov) | |
5655 | (when (member ov org-hide-block-overlays) | |
5656 | (setq org-hide-block-overlays | |
5657 | (delq ov org-hide-block-overlays))) | |
5658 | (when (eq (org-overlay-get ov 'invisible) | |
5659 | 'org-hide-block) | |
5660 | (org-delete-overlay ov))) | |
5661 | (org-overlays-at start))) | |
5662 | (setq ov (org-make-overlay start end)) | |
c8d0cf5c | 5663 | (org-overlay-put ov 'invisible 'org-hide-block) |
54a0dee5 CD |
5664 | ;; make the block accessible to isearch |
5665 | (org-overlay-put | |
5666 | ov 'isearch-open-invisible | |
5667 | (lambda (ov) | |
5668 | (when (member ov org-hide-block-overlays) | |
5669 | (setq org-hide-block-overlays | |
5670 | (delq ov org-hide-block-overlays))) | |
5671 | (when (eq (org-overlay-get ov 'invisible) | |
5672 | 'org-hide-block) | |
5673 | (org-delete-overlay ov)))) | |
5674 | (push ov org-hide-block-overlays))) | |
c8d0cf5c CD |
5675 | (error "Not looking at a source block")))) |
5676 | ||
5677 | ;; org-tab-after-check-for-cycling-hook | |
5678 | (add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) | |
5679 | ;; Remove overlays when changing major mode | |
5680 | (add-hook 'org-mode-hook | |
5681 | (lambda () (org-add-hook 'change-major-mode-hook | |
5682 | 'org-show-block-all 'append 'local))) | |
5683 | ||
20908596 | 5684 | ;;; Org-goto |
2a57416f | 5685 | |
20908596 CD |
5686 | (defvar org-goto-window-configuration nil) |
5687 | (defvar org-goto-marker nil) | |
5688 | (defvar org-goto-map | |
5689 | (let ((map (make-sparse-keymap))) | |
5690 | (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd) | |
5691 | (while (setq cmd (pop cmds)) | |
5692 | (substitute-key-definition cmd cmd map global-map))) | |
5693 | (suppress-keymap map) | |
5694 | (org-defkey map "\C-m" 'org-goto-ret) | |
5695 | (org-defkey map [(return)] 'org-goto-ret) | |
5696 | (org-defkey map [(left)] 'org-goto-left) | |
5697 | (org-defkey map [(right)] 'org-goto-right) | |
5698 | (org-defkey map [(control ?g)] 'org-goto-quit) | |
5699 | (org-defkey map "\C-i" 'org-cycle) | |
5700 | (org-defkey map [(tab)] 'org-cycle) | |
5701 | (org-defkey map [(down)] 'outline-next-visible-heading) | |
5702 | (org-defkey map [(up)] 'outline-previous-visible-heading) | |
5703 | (if org-goto-auto-isearch | |
5704 | (if (fboundp 'define-key-after) | |
5705 | (define-key-after map [t] 'org-goto-local-auto-isearch) | |
5706 | nil) | |
5707 | (org-defkey map "q" 'org-goto-quit) | |
5708 | (org-defkey map "n" 'outline-next-visible-heading) | |
5709 | (org-defkey map "p" 'outline-previous-visible-heading) | |
5710 | (org-defkey map "f" 'outline-forward-same-level) | |
5711 | (org-defkey map "b" 'outline-backward-same-level) | |
5712 | (org-defkey map "u" 'outline-up-heading)) | |
5713 | (org-defkey map "/" 'org-occur) | |
5714 | (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) | |
5715 | (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) | |
5716 | (org-defkey map "\C-c\C-f" 'outline-forward-same-level) | |
5717 | (org-defkey map "\C-c\C-b" 'outline-backward-same-level) | |
5718 | (org-defkey map "\C-c\C-u" 'outline-up-heading) | |
5719 | map)) | |
2a57416f | 5720 | |
20908596 CD |
5721 | (defconst org-goto-help |
5722 | "Browse buffer copy, to find location or copy text. Just type for auto-isearch. | |
5723 | RET=jump to location [Q]uit and return to previous location | |
5724 | \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") | |
2a57416f | 5725 | |
20908596 | 5726 | (defvar org-goto-start-pos) ; dynamically scoped parameter |
2a57416f | 5727 | |
8bfe682a | 5728 | ;; FIXME: Docstring does not mention both interfaces |
20908596 CD |
5729 | (defun org-goto (&optional alternative-interface) |
5730 | "Look up a different location in the current file, keeping current visibility. | |
2a57416f | 5731 | |
20908596 CD |
5732 | When you want look-up or go to a different location in a document, the |
5733 | fastest way is often to fold the entire buffer and then dive into the tree. | |
5734 | This method has the disadvantage, that the previous location will be folded, | |
5735 | which may not be what you want. | |
2a57416f | 5736 | |
20908596 CD |
5737 | This command works around this by showing a copy of the current buffer |
5738 | in an indirect buffer, in overview mode. You can dive into the tree in | |
5739 | that copy, use org-occur and incremental search to find a location. | |
5740 | When pressing RET or `Q', the command returns to the original buffer in | |
5741 | which the visibility is still unchanged. After RET is will also jump to | |
5742 | the location selected in the indirect buffer and expose the | |
5743 | the headline hierarchy above." | |
5744 | (interactive "P") | |
db55f368 | 5745 | (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) |
20908596 | 5746 | (org-refile-use-outline-path t) |
c8d0cf5c | 5747 | (org-refile-target-verify-function nil) |
20908596 CD |
5748 | (interface |
5749 | (if (not alternative-interface) | |
5750 | org-goto-interface | |
5751 | (if (eq org-goto-interface 'outline) | |
5752 | 'outline-path-completion | |
5753 | 'outline))) | |
5754 | (org-goto-start-pos (point)) | |
5755 | (selected-point | |
5756 | (if (eq interface 'outline) | |
5757 | (car (org-get-location (current-buffer) org-goto-help)) | |
5758 | (nth 3 (org-refile-get-location "Goto: "))))) | |
5759 | (if selected-point | |
5760 | (progn | |
5761 | (org-mark-ring-push org-goto-start-pos) | |
5762 | (goto-char selected-point) | |
5763 | (if (or (org-invisible-p) (org-invisible-p2)) | |
5764 | (org-show-context 'org-goto))) | |
5765 | (message "Quit")))) | |
2a57416f | 5766 | |
20908596 CD |
5767 | (defvar org-goto-selected-point nil) ; dynamically scoped parameter |
5768 | (defvar org-goto-exit-command nil) ; dynamically scoped parameter | |
5769 | (defvar org-goto-local-auto-isearch-map) ; defined below | |
891f4676 | 5770 | |
20908596 CD |
5771 | (defun org-get-location (buf help) |
5772 | "Let the user select a location in the Org-mode buffer BUF. | |
5773 | This function uses a recursive edit. It returns the selected position | |
5774 | or nil." | |
5775 | (let ((isearch-mode-map org-goto-local-auto-isearch-map) | |
5776 | (isearch-hide-immediately nil) | |
5777 | (isearch-search-fun-function | |
621f83e4 | 5778 | (lambda () 'org-goto-local-search-headings)) |
20908596 CD |
5779 | (org-goto-selected-point org-goto-exit-command)) |
5780 | (save-excursion | |
5781 | (save-window-excursion | |
5782 | (delete-other-windows) | |
5783 | (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) | |
5784 | (switch-to-buffer | |
5785 | (condition-case nil | |
5786 | (make-indirect-buffer (current-buffer) "*org-goto*") | |
5787 | (error (make-indirect-buffer (current-buffer) "*org-goto*")))) | |
5788 | (with-output-to-temp-buffer "*Help*" | |
5789 | (princ help)) | |
93b62de8 | 5790 | (org-fit-window-to-buffer (get-buffer-window "*Help*")) |
20908596 CD |
5791 | (setq buffer-read-only nil) |
5792 | (let ((org-startup-truncated t) | |
5793 | (org-startup-folded nil) | |
5794 | (org-startup-align-all-tables nil)) | |
5795 | (org-mode) | |
5796 | (org-overview)) | |
5797 | (setq buffer-read-only t) | |
5798 | (if (and (boundp 'org-goto-start-pos) | |
5799 | (integer-or-marker-p org-goto-start-pos)) | |
5800 | (let ((org-show-hierarchy-above t) | |
5801 | (org-show-siblings t) | |
5802 | (org-show-following-heading t)) | |
5803 | (goto-char org-goto-start-pos) | |
5804 | (and (org-invisible-p) (org-show-context))) | |
5805 | (goto-char (point-min))) | |
7b96ff9a | 5806 | (let (org-special-ctrl-a/e) (org-beginning-of-line)) |
20908596 CD |
5807 | (message "Select location and press RET") |
5808 | (use-local-map org-goto-map) | |
5809 | (recursive-edit) | |
5810 | )) | |
5811 | (kill-buffer "*org-goto*") | |
5812 | (cons org-goto-selected-point org-goto-exit-command))) | |
891f4676 | 5813 | |
20908596 CD |
5814 | (defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) |
5815 | (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) | |
5816 | (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) | |
5817 | (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char) | |
891f4676 | 5818 | |
621f83e4 CD |
5819 | (defun org-goto-local-search-headings (string bound noerror) |
5820 | "Search and make sure that any matches are in headlines." | |
20908596 | 5821 | (catch 'return |
621f83e4 CD |
5822 | (while (if isearch-forward |
5823 | (search-forward string bound noerror) | |
5824 | (search-backward string bound noerror)) | |
20908596 CD |
5825 | (when (let ((context (mapcar 'car (save-match-data (org-context))))) |
5826 | (and (member :headline context) | |
5827 | (not (member :tags context)))) | |
5828 | (throw 'return (point)))))) | |
a96ee7df | 5829 | |
20908596 CD |
5830 | (defun org-goto-local-auto-isearch () |
5831 | "Start isearch." | |
5832 | (interactive) | |
5833 | (goto-char (point-min)) | |
5834 | (let ((keys (this-command-keys))) | |
5835 | (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) | |
5836 | (isearch-mode t) | |
5837 | (isearch-process-search-char (string-to-char keys))))) | |
d924f2e5 | 5838 | |
20908596 CD |
5839 | (defun org-goto-ret (&optional arg) |
5840 | "Finish `org-goto' by going to the new location." | |
5841 | (interactive "P") | |
5842 | (setq org-goto-selected-point (point) | |
5843 | org-goto-exit-command 'return) | |
5844 | (throw 'exit nil)) | |
891f4676 | 5845 | |
20908596 CD |
5846 | (defun org-goto-left () |
5847 | "Finish `org-goto' by going to the new location." | |
5848 | (interactive) | |
5849 | (if (org-on-heading-p) | |
5850 | (progn | |
5851 | (beginning-of-line 1) | |
5852 | (setq org-goto-selected-point (point) | |
5853 | org-goto-exit-command 'left) | |
5854 | (throw 'exit nil)) | |
5855 | (error "Not on a heading"))) | |
891f4676 | 5856 | |
20908596 CD |
5857 | (defun org-goto-right () |
5858 | "Finish `org-goto' by going to the new location." | |
5859 | (interactive) | |
5860 | (if (org-on-heading-p) | |
5861 | (progn | |
5862 | (setq org-goto-selected-point (point) | |
5863 | org-goto-exit-command 'right) | |
5864 | (throw 'exit nil)) | |
5865 | (error "Not on a heading"))) | |
891f4676 | 5866 | |
20908596 CD |
5867 | (defun org-goto-quit () |
5868 | "Finish `org-goto' without cursor motion." | |
5869 | (interactive) | |
5870 | (setq org-goto-selected-point nil) | |
5871 | (setq org-goto-exit-command 'quit) | |
5872 | (throw 'exit nil)) | |
4b3a9ba7 | 5873 | |
20908596 | 5874 | ;;; Indirect buffer display of subtrees |
4b3a9ba7 | 5875 | |
20908596 CD |
5876 | (defvar org-indirect-dedicated-frame nil |
5877 | "This is the frame being used for indirect tree display.") | |
5878 | (defvar org-last-indirect-buffer nil) | |
891f4676 | 5879 | |
20908596 CD |
5880 | (defun org-tree-to-indirect-buffer (&optional arg) |
5881 | "Create indirect buffer and narrow it to current subtree. | |
5882 | With numerical prefix ARG, go up to this level and then take that tree. | |
5883 | If ARG is negative, go up that many levels. | |
5884 | If `org-indirect-buffer-display' is not `new-frame', the command removes the | |
5885 | indirect buffer previously made with this command, to avoid proliferation of | |
5886 | indirect buffers. However, when you call the command with a `C-u' prefix, or | |
5887 | when `org-indirect-buffer-display' is `new-frame', the last buffer | |
5888 | is kept so that you can work with several indirect buffers at the same time. | |
5889 | If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also | |
5890 | requests that a new frame be made for the new buffer, so that the dedicated | |
5891 | frame is not changed." | |
5892 | (interactive "P") | |
5893 | (let ((cbuf (current-buffer)) | |
5894 | (cwin (selected-window)) | |
d3f4dbe8 | 5895 | (pos (point)) |
20908596 CD |
5896 | beg end level heading ibuf) |
5897 | (save-excursion | |
5898 | (org-back-to-heading t) | |
5899 | (when (numberp arg) | |
5900 | (setq level (org-outline-level)) | |
5901 | (if (< arg 0) (setq arg (+ level arg))) | |
5902 | (while (> (setq level (org-outline-level)) arg) | |
5903 | (outline-up-heading 1 t))) | |
5904 | (setq beg (point) | |
5905 | heading (org-get-heading)) | |
8d642074 | 5906 | (org-end-of-subtree t t) (setq end (point))) |
20908596 CD |
5907 | (if (and (buffer-live-p org-last-indirect-buffer) |
5908 | (not (eq org-indirect-buffer-display 'new-frame)) | |
5909 | (not arg)) | |
5910 | (kill-buffer org-last-indirect-buffer)) | |
5911 | (setq ibuf (org-get-indirect-buffer cbuf) | |
5912 | org-last-indirect-buffer ibuf) | |
d3f4dbe8 | 5913 | (cond |
20908596 CD |
5914 | ((or (eq org-indirect-buffer-display 'new-frame) |
5915 | (and arg (eq org-indirect-buffer-display 'dedicated-frame))) | |
5916 | (select-frame (make-frame)) | |
5917 | (delete-other-windows) | |
5918 | (switch-to-buffer ibuf) | |
5919 | (org-set-frame-title heading)) | |
5920 | ((eq org-indirect-buffer-display 'dedicated-frame) | |
5921 | (raise-frame | |
5922 | (select-frame (or (and org-indirect-dedicated-frame | |
5923 | (frame-live-p org-indirect-dedicated-frame) | |
5924 | org-indirect-dedicated-frame) | |
5925 | (setq org-indirect-dedicated-frame (make-frame))))) | |
5926 | (delete-other-windows) | |
5927 | (switch-to-buffer ibuf) | |
5928 | (org-set-frame-title (concat "Indirect: " heading))) | |
5929 | ((eq org-indirect-buffer-display 'current-window) | |
5930 | (switch-to-buffer ibuf)) | |
5931 | ((eq org-indirect-buffer-display 'other-window) | |
5932 | (pop-to-buffer ibuf)) | |
f924a367 | 5933 | (t (error "Invalid value"))) |
20908596 CD |
5934 | (if (featurep 'xemacs) |
5935 | (save-excursion (org-mode) (turn-on-font-lock))) | |
5936 | (narrow-to-region beg end) | |
5937 | (show-all) | |
5938 | (goto-char pos) | |
5939 | (and (window-live-p cwin) (select-window cwin)))) | |
edd21304 | 5940 | |
20908596 CD |
5941 | (defun org-get-indirect-buffer (&optional buffer) |
5942 | (setq buffer (or buffer (current-buffer))) | |
5943 | (let ((n 1) (base (buffer-name buffer)) bname) | |
5944 | (while (buffer-live-p | |
5945 | (get-buffer (setq bname (concat base "-" (number-to-string n))))) | |
5946 | (setq n (1+ n))) | |
5947 | (condition-case nil | |
5948 | (make-indirect-buffer buffer bname 'clone) | |
5949 | (error (make-indirect-buffer buffer bname))))) | |
ef943dba | 5950 | |
20908596 CD |
5951 | (defun org-set-frame-title (title) |
5952 | "Set the title of the current frame to the string TITLE." | |
5953 | ;; FIXME: how to name a single frame in XEmacs??? | |
5954 | (unless (featurep 'xemacs) | |
5955 | (modify-frame-parameters (selected-frame) (list (cons 'name title))))) | |
ef943dba | 5956 | |
20908596 | 5957 | ;;;; Structure editing |
ef943dba | 5958 | |
20908596 | 5959 | ;;; Inserting headlines |
ef943dba | 5960 | |
0bd48b37 CD |
5961 | (defun org-previous-line-empty-p () |
5962 | (save-excursion | |
5963 | (and (not (bobp)) | |
5964 | (or (beginning-of-line 0) t) | |
5965 | (save-match-data | |
5966 | (looking-at "[ \t]*$"))))) | |
c8d0cf5c | 5967 | |
20908596 CD |
5968 | (defun org-insert-heading (&optional force-heading) |
5969 | "Insert a new heading or item with same depth at point. | |
5970 | If point is in a plain list and FORCE-HEADING is nil, create a new list item. | |
5971 | If point is at the beginning of a headline, insert a sibling before the | |
5972 | current headline. If point is not at the beginning, do not split the line, | |
93b62de8 | 5973 | but create the new headline after the current line." |
20908596 CD |
5974 | (interactive "P") |
5975 | (if (= (buffer-size) 0) | |
5976 | (insert "\n* ") | |
5977 | (when (or force-heading (not (org-insert-item))) | |
0bd48b37 CD |
5978 | (let* ((empty-line-p nil) |
5979 | (head (save-excursion | |
20908596 CD |
5980 | (condition-case nil |
5981 | (progn | |
5982 | (org-back-to-heading) | |
0bd48b37 | 5983 | (setq empty-line-p (org-previous-line-empty-p)) |
20908596 CD |
5984 | (match-string 0)) |
5985 | (error "*")))) | |
0bd48b37 CD |
5986 | (blank-a (cdr (assq 'heading org-blank-before-new-entry))) |
5987 | (blank (if (eq blank-a 'auto) empty-line-p blank-a)) | |
93b62de8 | 5988 | pos hide-previous previous-pos) |
20908596 CD |
5989 | (cond |
5990 | ((and (org-on-heading-p) (bolp) | |
5991 | (or (bobp) | |
5992 | (save-excursion (backward-char 1) (not (org-invisible-p))))) | |
5993 | ;; insert before the current line | |
5994 | (open-line (if blank 2 1))) | |
5995 | ((and (bolp) | |
54a0dee5 | 5996 | (not org-insert-heading-respect-content) |
20908596 CD |
5997 | (or (bobp) |
5998 | (save-excursion | |
5999 | (backward-char 1) (not (org-invisible-p))))) | |
6000 | ;; insert right here | |
6001 | nil) | |
6002 | (t | |
93b62de8 | 6003 | ;; somewhere in the line |
71d35b24 | 6004 | (save-excursion |
93b62de8 | 6005 | (setq previous-pos (point-at-bol)) |
71d35b24 CD |
6006 | (end-of-line) |
6007 | (setq hide-previous (org-invisible-p))) | |
93b62de8 | 6008 | (and org-insert-heading-respect-content (org-show-subtree)) |
20908596 | 6009 | (let ((split |
93b62de8 CD |
6010 | (and (org-get-alist-option org-M-RET-may-split-line 'headline) |
6011 | (save-excursion | |
6012 | (let ((p (point))) | |
6013 | (goto-char (point-at-bol)) | |
6014 | (and (looking-at org-complex-heading-regexp) | |
6015 | (> p (match-beginning 4))))))) | |
20908596 | 6016 | tags pos) |
621f83e4 CD |
6017 | (cond |
6018 | (org-insert-heading-respect-content | |
6019 | (org-end-of-subtree nil t) | |
93b62de8 | 6020 | (or (bolp) (newline)) |
0bd48b37 CD |
6021 | (or (org-previous-line-empty-p) |
6022 | (and blank (newline))) | |
621f83e4 CD |
6023 | (open-line 1)) |
6024 | ((org-on-heading-p) | |
93b62de8 CD |
6025 | (when hide-previous |
6026 | (show-children) | |
6027 | (org-show-entry)) | |
621f83e4 CD |
6028 | (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") |
6029 | (setq tags (and (match-end 2) (match-string 2))) | |
6030 | (and (match-end 1) | |
6031 | (delete-region (match-beginning 1) (match-end 1))) | |
6032 | (setq pos (point-at-bol)) | |
20908596 | 6033 | (or split (end-of-line 1)) |
621f83e4 CD |
6034 | (delete-horizontal-space) |
6035 | (newline (if blank 2 1)) | |
6036 | (when tags | |
6037 | (save-excursion | |
6038 | (goto-char pos) | |
6039 | (end-of-line 1) | |
6040 | (insert " " tags) | |
6041 | (org-set-tags nil 'align)))) | |
6042 | (t | |
6043 | (or split (end-of-line 1)) | |
6044 | (newline (if blank 2 1))))))) | |
20908596 CD |
6045 | (insert head) (just-one-space) |
6046 | (setq pos (point)) | |
6047 | (end-of-line 1) | |
6048 | (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) | |
71d35b24 CD |
6049 | (when (and org-insert-heading-respect-content hide-previous) |
6050 | (save-excursion | |
93b62de8 CD |
6051 | (goto-char previous-pos) |
6052 | (hide-subtree))) | |
20908596 | 6053 | (run-hooks 'org-insert-heading-hook))))) |
ef943dba | 6054 | |
20908596 CD |
6055 | (defun org-get-heading (&optional no-tags) |
6056 | "Return the heading of the current entry, without the stars." | |
6057 | (save-excursion | |
6058 | (org-back-to-heading t) | |
6059 | (if (looking-at | |
6060 | (if no-tags | |
6061 | (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$") | |
6062 | "\\*+[ \t]+\\([^\r\n]*\\)")) | |
6063 | (match-string 1) ""))) | |
ef943dba | 6064 | |
0bd48b37 CD |
6065 | (defun org-heading-components () |
6066 | "Return the components of the current heading. | |
6067 | This is a list with the following elements: | |
6068 | - the level as an integer | |
6069 | - the reduced level, different if `org-odd-levels-only' is set. | |
6070 | - the TODO keyword, or nil | |
6071 | - the priority character, like ?A, or nil if no priority is given | |
6072 | - the headline text itself, or the tags string if no headline text | |
6073 | - the tags string, or nil." | |
6074 | (save-excursion | |
6075 | (org-back-to-heading t) | |
6076 | (if (looking-at org-complex-heading-regexp) | |
6077 | (list (length (match-string 1)) | |
6078 | (org-reduced-level (length (match-string 1))) | |
6079 | (org-match-string-no-properties 2) | |
6080 | (and (match-end 3) (aref (match-string 3) 2)) | |
6081 | (org-match-string-no-properties 4) | |
6082 | (org-match-string-no-properties 5))))) | |
6083 | ||
c8d0cf5c CD |
6084 | (defun org-get-entry () |
6085 | "Get the entry text, after heading, entire subtree." | |
6086 | (save-excursion | |
6087 | (org-back-to-heading t) | |
6088 | (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) | |
6089 | ||
20908596 CD |
6090 | (defun org-insert-heading-after-current () |
6091 | "Insert a new heading with same level as current, after current subtree." | |
6092 | (interactive) | |
6093 | (org-back-to-heading) | |
6094 | (org-insert-heading) | |
6095 | (org-move-subtree-down) | |
6096 | (end-of-line 1)) | |
35fb9989 | 6097 | |
621f83e4 CD |
6098 | (defun org-insert-heading-respect-content () |
6099 | (interactive) | |
6100 | (let ((org-insert-heading-respect-content t)) | |
71d35b24 | 6101 | (org-insert-heading t))) |
621f83e4 | 6102 | |
71d35b24 CD |
6103 | (defun org-insert-todo-heading-respect-content (&optional force-state) |
6104 | (interactive "P") | |
621f83e4 | 6105 | (let ((org-insert-heading-respect-content t)) |
71d35b24 | 6106 | (org-insert-todo-heading force-state t))) |
621f83e4 | 6107 | |
71d35b24 | 6108 | (defun org-insert-todo-heading (arg &optional force-heading) |
20908596 CD |
6109 | "Insert a new heading with the same level and TODO state as current heading. |
6110 | If the heading has no TODO state, or if the state is DONE, use the first | |
6111 | state (TODO by default). Also with prefix arg, force first state." | |
6112 | (interactive "P") | |
71d35b24 CD |
6113 | (when (or force-heading (not (org-insert-item 'checkbox))) |
6114 | (org-insert-heading force-heading) | |
20908596 CD |
6115 | (save-excursion |
6116 | (org-back-to-heading) | |
6117 | (outline-previous-heading) | |
6118 | (looking-at org-todo-line-regexp)) | |
c8d0cf5c CD |
6119 | (let* |
6120 | ((new-mark-x | |
6121 | (if (or arg | |
6122 | (not (match-beginning 2)) | |
6123 | (member (match-string 2) org-done-keywords)) | |
6124 | (car org-todo-keywords-1) | |
6125 | (match-string 2))) | |
6126 | (new-mark | |
6127 | (or | |
6128 | (run-hook-with-args-until-success | |
6129 | 'org-todo-get-default-hook new-mark-x nil) | |
6130 | new-mark-x))) | |
6131 | (beginning-of-line 1) | |
6132 | (and (looking-at "\\*+ ") (goto-char (match-end 0)) | |
6133 | (if org-treat-insert-todo-heading-as-state-change | |
6134 | (org-todo new-mark) | |
6135 | (insert new-mark " ")))) | |
b349f79f CD |
6136 | (when org-provide-todo-statistics |
6137 | (org-update-parent-todo-statistics)))) | |
ef943dba | 6138 | |
20908596 CD |
6139 | (defun org-insert-subheading (arg) |
6140 | "Insert a new subheading and demote it. | |
6141 | Works for outline headings and for plain lists alike." | |
6142 | (interactive "P") | |
6143 | (org-insert-heading arg) | |
6144 | (cond | |
6145 | ((org-on-heading-p) (org-do-demote)) | |
6146 | ((org-at-item-p) (org-indent-item 1)))) | |
4da1a99d | 6147 | |
20908596 CD |
6148 | (defun org-insert-todo-subheading (arg) |
6149 | "Insert a new subheading with TODO keyword or checkbox and demote it. | |
6150 | Works for outline headings and for plain lists alike." | |
6151 | (interactive "P") | |
6152 | (org-insert-todo-heading arg) | |
d3f4dbe8 | 6153 | (cond |
20908596 CD |
6154 | ((org-on-heading-p) (org-do-demote)) |
6155 | ((org-at-item-p) (org-indent-item 1)))) | |
4da1a99d | 6156 | |
20908596 | 6157 | ;;; Promotion and Demotion |
4da1a99d | 6158 | |
c8d0cf5c CD |
6159 | (defvar org-after-demote-entry-hook nil |
6160 | "Hook run after an entry has been demoted. | |
6161 | The cursor will be at the beginning of the entry. | |
6162 | When a subtree is being demoted, the hook will be called for each node.") | |
6163 | ||
6164 | (defvar org-after-promote-entry-hook nil | |
6165 | "Hook run after an entry has been promoted. | |
6166 | The cursor will be at the beginning of the entry. | |
6167 | When a subtree is being promoted, the hook will be called for each node.") | |
6168 | ||
20908596 CD |
6169 | (defun org-promote-subtree () |
6170 | "Promote the entire subtree. | |
6171 | See also `org-promote'." | |
6172 | (interactive) | |
d3f4dbe8 | 6173 | (save-excursion |
20908596 CD |
6174 | (org-map-tree 'org-promote)) |
6175 | (org-fix-position-after-promote)) | |
6176 | ||
6177 | (defun org-demote-subtree () | |
6178 | "Demote the entire subtree. See `org-demote'. | |
6179 | See also `org-promote'." | |
6180 | (interactive) | |
d3f4dbe8 | 6181 | (save-excursion |
20908596 CD |
6182 | (org-map-tree 'org-demote)) |
6183 | (org-fix-position-after-promote)) | |
4b3a9ba7 | 6184 | |
20908596 CD |
6185 | |
6186 | (defun org-do-promote () | |
6187 | "Promote the current heading higher up the tree. | |
6188 | If the region is active in `transient-mark-mode', promote all headings | |
6189 | in the region." | |
6190 | (interactive) | |
3278a016 | 6191 | (save-excursion |
20908596 CD |
6192 | (if (org-region-active-p) |
6193 | (org-map-region 'org-promote (region-beginning) (region-end)) | |
6194 | (org-promote))) | |
6195 | (org-fix-position-after-promote)) | |
6196 | ||
6197 | (defun org-do-demote () | |
6198 | "Demote the current heading lower down the tree. | |
6199 | If the region is active in `transient-mark-mode', demote all headings | |
6200 | in the region." | |
6201 | (interactive) | |
4da1a99d | 6202 | (save-excursion |
20908596 CD |
6203 | (if (org-region-active-p) |
6204 | (org-map-region 'org-demote (region-beginning) (region-end)) | |
6205 | (org-demote))) | |
6206 | (org-fix-position-after-promote)) | |
4b3a9ba7 | 6207 | |
20908596 CD |
6208 | (defun org-fix-position-after-promote () |
6209 | "Make sure that after pro/demotion cursor position is right." | |
6210 | (let ((pos (point))) | |
6211 | (when (save-excursion | |
6212 | (beginning-of-line 1) | |
6213 | (looking-at org-todo-line-regexp) | |
6214 | (or (equal pos (match-end 1)) (equal pos (match-end 2)))) | |
6215 | (cond ((eobp) (insert " ")) | |
6216 | ((eolp) (insert " ")) | |
6217 | ((equal (char-after) ?\ ) (forward-char 1)))))) | |
4b3a9ba7 | 6218 | |
8bfe682a CD |
6219 | (defun org-current-level () |
6220 | "Return the level of the current entry, or nil if before the first headline. | |
6221 | The level is the number of stars at the beginning of the headline." | |
6222 | (save-excursion | |
6223 | (condition-case nil | |
6224 | (progn | |
6225 | (org-back-to-heading t) | |
6226 | (funcall outline-level)) | |
6227 | (error nil)))) | |
6228 | ||
20908596 | 6229 | (defun org-reduced-level (l) |
0bd48b37 CD |
6230 | "Compute the effective level of a heading. |
6231 | This takes into account the setting of `org-odd-levels-only'." | |
20908596 | 6232 | (if org-odd-levels-only (1+ (floor (/ l 2))) l)) |
4b3a9ba7 | 6233 | |
20908596 CD |
6234 | (defun org-get-valid-level (level &optional change) |
6235 | "Rectify a level change under the influence of `org-odd-levels-only' | |
6236 | LEVEL is a current level, CHANGE is by how much the level should be | |
6237 | modified. Even if CHANGE is nil, LEVEL may be returned modified because | |
6238 | even level numbers will become the next higher odd number." | |
6239 | (if org-odd-levels-only | |
6240 | (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) | |
6241 | ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) | |
6242 | ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) | |
c8d0cf5c | 6243 | (max 1 (+ level (or change 0))))) |
4b3a9ba7 | 6244 | |
20908596 CD |
6245 | (if (boundp 'define-obsolete-function-alias) |
6246 | (if (or (featurep 'xemacs) (< emacs-major-version 23)) | |
6247 | (define-obsolete-function-alias 'org-get-legal-level | |
6248 | 'org-get-valid-level) | |
6249 | (define-obsolete-function-alias 'org-get-legal-level | |
6250 | 'org-get-valid-level "23.1"))) | |
4b3a9ba7 | 6251 | |
20908596 CD |
6252 | (defun org-promote () |
6253 | "Promote the current heading higher up the tree. | |
6254 | If the region is active in `transient-mark-mode', promote all headings | |
6255 | in the region." | |
6256 | (org-back-to-heading t) | |
6257 | (let* ((level (save-match-data (funcall outline-level))) | |
6258 | (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) | |
6259 | (diff (abs (- level (length up-head) -1)))) | |
6260 | (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) | |
6261 | (replace-match up-head nil t) | |
6262 | ;; Fixup tag positioning | |
6263 | (and org-auto-align-tags (org-set-tags nil t)) | |
c8d0cf5c CD |
6264 | (if org-adapt-indentation (org-fixup-indentation (- diff))) |
6265 | (run-hooks 'org-after-promote-entry-hook))) | |
891f4676 | 6266 | |
20908596 CD |
6267 | (defun org-demote () |
6268 | "Demote the current heading lower down the tree. | |
6269 | If the region is active in `transient-mark-mode', demote all headings | |
6270 | in the region." | |
6271 | (org-back-to-heading t) | |
6272 | (let* ((level (save-match-data (funcall outline-level))) | |
6273 | (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) | |
6274 | (diff (abs (- level (length down-head) -1)))) | |
6275 | (replace-match down-head nil t) | |
6276 | ;; Fixup tag positioning | |
6277 | (and org-auto-align-tags (org-set-tags nil t)) | |
c8d0cf5c CD |
6278 | (if org-adapt-indentation (org-fixup-indentation diff)) |
6279 | (run-hooks 'org-after-demote-entry-hook))) | |
20908596 | 6280 | |
8bfe682a CD |
6281 | (defvar org-tab-ind-state nil) |
6282 | ||
6283 | (defun org-cycle-level () | |
6284 | (let ((org-adapt-indentation nil)) | |
6285 | (when (and (looking-at "[ \t]*$") | |
6286 | (looking-back | |
6287 | (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp "\\)?[ \t]*"))) | |
6288 | (setq this-command 'org-cycle-level) | |
6289 | (if (eq last-command 'org-cycle-level) | |
6290 | (condition-case nil | |
6291 | (progn (org-do-promote) | |
6292 | (if (equal org-tab-ind-state (org-current-level)) | |
6293 | (org-do-promote))) | |
6294 | (error | |
6295 | (progn | |
6296 | (save-excursion | |
6297 | (beginning-of-line 1) | |
6298 | (and (looking-at "\\*+") | |
6299 | (replace-match | |
6300 | (make-string org-tab-ind-state ?*)))) | |
6301 | (setq this-command 'org-cycle)))) | |
6302 | (setq org-tab-ind-state (- (match-end 1) (match-beginning 1))) | |
6303 | (org-do-demote)) | |
6304 | t))) | |
6305 | ||
20908596 CD |
6306 | (defun org-map-tree (fun) |
6307 | "Call FUN for every heading underneath the current one." | |
6308 | (org-back-to-heading) | |
6309 | (let ((level (funcall outline-level))) | |
6310 | (save-excursion | |
6311 | (funcall fun) | |
6312 | (while (and (progn | |
6313 | (outline-next-heading) | |
6314 | (> (funcall outline-level) level)) | |
6315 | (not (eobp))) | |
6316 | (funcall fun))))) | |
6317 | ||
6318 | (defun org-map-region (fun beg end) | |
6319 | "Call FUN for every heading between BEG and END." | |
6320 | (let ((org-ignore-region t)) | |
6321 | (save-excursion | |
6322 | (setq end (copy-marker end)) | |
6323 | (goto-char beg) | |
6324 | (if (and (re-search-forward (concat "^" outline-regexp) nil t) | |
6325 | (< (point) end)) | |
6326 | (funcall fun)) | |
6327 | (while (and (progn | |
6328 | (outline-next-heading) | |
6329 | (< (point) end)) | |
6330 | (not (eobp))) | |
6331 | (funcall fun))))) | |
6332 | ||
6333 | (defun org-fixup-indentation (diff) | |
6334 | "Change the indentation in the current entry by DIFF | |
6335 | However, if any line in the current entry has no indentation, or if it | |
6336 | would end up with no indentation after the change, nothing at all is done." | |
6337 | (save-excursion | |
6338 | (let ((end (save-excursion (outline-next-heading) | |
6339 | (point-marker))) | |
6340 | (prohibit (if (> diff 0) | |
6341 | "^\\S-" | |
6342 | (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) | |
6343 | col) | |
6344 | (unless (save-excursion (end-of-line 1) | |
6345 | (re-search-forward prohibit end t)) | |
6346 | (while (and (< (point) end) | |
6347 | (re-search-forward "^[ \t]+" end t)) | |
6348 | (goto-char (match-end 0)) | |
6349 | (setq col (current-column)) | |
6350 | (if (< diff 0) (replace-match "")) | |
ce4fdcb9 | 6351 | (org-indent-to-column (+ diff col)))) |
20908596 CD |
6352 | (move-marker end nil)))) |
6353 | ||
6354 | (defun org-convert-to-odd-levels () | |
6355 | "Convert an org-mode file with all levels allowed to one with odd levels. | |
6356 | This will leave level 1 alone, convert level 2 to level 3, level 3 to | |
6357 | level 5 etc." | |
6358 | (interactive) | |
6359 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") | |
8d642074 CD |
6360 | (let ((outline-regexp org-outline-regexp) |
6361 | (outline-level 'org-outline-level) | |
6362 | (org-odd-levels-only nil) n) | |
20908596 CD |
6363 | (save-excursion |
6364 | (goto-char (point-min)) | |
6365 | (while (re-search-forward "^\\*\\*+ " nil t) | |
6366 | (setq n (- (length (match-string 0)) 2)) | |
6367 | (while (>= (setq n (1- n)) 0) | |
6368 | (org-demote)) | |
6369 | (end-of-line 1)))))) | |
4b3a9ba7 | 6370 | |
20908596 CD |
6371 | (defun org-convert-to-oddeven-levels () |
6372 | "Convert an org-mode file with only odd levels to one with odd and even levels. | |
6373 | This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a | |
6374 | section with an even level, conversion would destroy the structure of the file. An error | |
6375 | is signaled in this case." | |
6376 | (interactive) | |
6377 | (goto-char (point-min)) | |
6378 | ;; First check if there are no even levels | |
6379 | (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) | |
6380 | (org-show-context t) | |
f924a367 | 6381 | (error "Not all levels are odd in this file. Conversion not possible")) |
20908596 | 6382 | (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") |
8d642074 CD |
6383 | (let ((outline-regexp org-outline-regexp) |
6384 | (outline-level 'org-outline-level) | |
6385 | (org-odd-levels-only nil) n) | |
20908596 CD |
6386 | (save-excursion |
6387 | (goto-char (point-min)) | |
6388 | (while (re-search-forward "^\\*\\*+ " nil t) | |
6389 | (setq n (/ (1- (length (match-string 0))) 2)) | |
6390 | (while (>= (setq n (1- n)) 0) | |
6391 | (org-promote)) | |
6392 | (end-of-line 1)))))) | |
a96ee7df | 6393 | |
20908596 CD |
6394 | (defun org-tr-level (n) |
6395 | "Make N odd if required." | |
6396 | (if org-odd-levels-only (1+ (/ n 2)) n)) | |
8c6fb58b | 6397 | |
20908596 | 6398 | ;;; Vertical tree motion, cutting and pasting of subtrees |
8c6fb58b | 6399 | |
20908596 CD |
6400 | (defun org-move-subtree-up (&optional arg) |
6401 | "Move the current subtree up past ARG headlines of the same level." | |
6402 | (interactive "p") | |
6403 | (org-move-subtree-down (- (prefix-numeric-value arg)))) | |
b0a10108 | 6404 | |
20908596 CD |
6405 | (defun org-move-subtree-down (&optional arg) |
6406 | "Move the current subtree down past ARG headlines of the same level." | |
6407 | (interactive "p") | |
6408 | (setq arg (prefix-numeric-value arg)) | |
54a0dee5 CD |
6409 | (let ((movfunc (if (> arg 0) 'org-get-next-sibling |
6410 | 'org-get-last-sibling)) | |
20908596 CD |
6411 | (ins-point (make-marker)) |
6412 | (cnt (abs arg)) | |
6413 | beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) | |
6414 | ;; Select the tree | |
6415 | (org-back-to-heading) | |
6416 | (setq beg0 (point)) | |
6417 | (save-excursion | |
6418 | (setq ne-beg (org-back-over-empty-lines)) | |
6419 | (setq beg (point))) | |
6420 | (save-match-data | |
6421 | (save-excursion (outline-end-of-heading) | |
6422 | (setq folded (org-invisible-p))) | |
6423 | (outline-end-of-subtree)) | |
6424 | (outline-next-heading) | |
6425 | (setq ne-end (org-back-over-empty-lines)) | |
6426 | (setq end (point)) | |
6427 | (goto-char beg0) | |
6428 | (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) | |
6429 | ;; include less whitespace | |
6430 | (save-excursion | |
6431 | (goto-char beg) | |
6432 | (forward-line (- ne-beg ne-end)) | |
6433 | (setq beg (point)))) | |
6434 | ;; Find insertion point, with error handling | |
6435 | (while (> cnt 0) | |
6436 | (or (and (funcall movfunc) (looking-at outline-regexp)) | |
6437 | (progn (goto-char beg0) | |
6438 | (error "Cannot move past superior level or buffer limit"))) | |
6439 | (setq cnt (1- cnt))) | |
6440 | (if (> arg 0) | |
6441 | ;; Moving forward - still need to move over subtree | |
6442 | (progn (org-end-of-subtree t t) | |
6443 | (save-excursion | |
6444 | (org-back-over-empty-lines) | |
6445 | (or (bolp) (newline))))) | |
6446 | (setq ne-ins (org-back-over-empty-lines)) | |
6447 | (move-marker ins-point (point)) | |
6448 | (setq txt (buffer-substring beg end)) | |
b349f79f | 6449 | (org-save-markers-in-region beg end) |
20908596 | 6450 | (delete-region beg end) |
c8d0cf5c | 6451 | (org-remove-empty-overlays-at beg) |
ff4be292 CD |
6452 | (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil)) |
6453 | (or (bobp) (outline-flag-region (1- (point)) (point) nil)) | |
c8d0cf5c | 6454 | (and (not (bolp)) (looking-at "\n") (forward-char 1)) |
b349f79f CD |
6455 | (let ((bbb (point))) |
6456 | (insert-before-markers txt) | |
6457 | (org-reinstall-markers-in-region bbb) | |
6458 | (move-marker ins-point bbb)) | |
20908596 CD |
6459 | (or (bolp) (insert "\n")) |
6460 | (setq ins-end (point)) | |
6461 | (goto-char ins-point) | |
6462 | (org-skip-whitespace) | |
6463 | (when (and (< arg 0) | |
6464 | (org-first-sibling-p) | |
6465 | (> ne-ins ne-beg)) | |
6466 | ;; Move whitespace back to beginning | |
6467 | (save-excursion | |
6468 | (goto-char ins-end) | |
6469 | (let ((kill-whole-line t)) | |
6470 | (kill-line (- ne-ins ne-beg)) (point))) | |
6471 | (insert (make-string (- ne-ins ne-beg) ?\n))) | |
6472 | (move-marker ins-point nil) | |
c8d0cf5c CD |
6473 | (if folded |
6474 | (hide-subtree) | |
20908596 CD |
6475 | (org-show-entry) |
6476 | (show-children) | |
c8d0cf5c CD |
6477 | (org-cycle-hide-drawers 'children)) |
6478 | (org-clean-visibility-after-subtree-move))) | |
8c6fb58b | 6479 | |
20908596 CD |
6480 | (defvar org-subtree-clip "" |
6481 | "Clipboard for cut and paste of subtrees. | |
6482 | This is actually only a copy of the kill, because we use the normal kill | |
6483 | ring. We need it to check if the kill was created by `org-copy-subtree'.") | |
8c6fb58b | 6484 | |
20908596 CD |
6485 | (defvar org-subtree-clip-folded nil |
6486 | "Was the last copied subtree folded? | |
6487 | This is used to fold the tree back after pasting.") | |
b0a10108 | 6488 | |
20908596 CD |
6489 | (defun org-cut-subtree (&optional n) |
6490 | "Cut the current subtree into the clipboard. | |
6491 | With prefix arg N, cut this many sequential subtrees. | |
6492 | This is a short-hand for marking the subtree and then cutting it." | |
6493 | (interactive "p") | |
6494 | (org-copy-subtree n 'cut)) | |
8c6fb58b | 6495 | |
b349f79f | 6496 | (defun org-copy-subtree (&optional n cut force-store-markers) |
20908596 CD |
6497 | "Cut the current subtree into the clipboard. |
6498 | With prefix arg N, cut this many sequential subtrees. | |
6499 | This is a short-hand for marking the subtree and then copying it. | |
b349f79f CD |
6500 | If CUT is non-nil, actually cut the subtree. |
6501 | If FORCE-STORE-MARKERS is non-nil, store the relative locations | |
6502 | of some markers in the region, even if CUT is non-nil. This is | |
6503 | useful if the caller implements cut-and-paste as copy-then-paste-then-cut." | |
20908596 CD |
6504 | (interactive "p") |
6505 | (let (beg end folded (beg0 (point))) | |
6506 | (if (interactive-p) | |
6507 | (org-back-to-heading nil) ; take what looks like a subtree | |
6508 | (org-back-to-heading t)) ; take what is really there | |
6509 | (org-back-over-empty-lines) | |
6510 | (setq beg (point)) | |
6511 | (skip-chars-forward " \t\r\n") | |
6512 | (save-match-data | |
6513 | (save-excursion (outline-end-of-heading) | |
6514 | (setq folded (org-invisible-p))) | |
6515 | (condition-case nil | |
c8d0cf5c | 6516 | (org-forward-same-level (1- n) t) |
20908596 CD |
6517 | (error nil)) |
6518 | (org-end-of-subtree t t)) | |
6519 | (org-back-over-empty-lines) | |
6520 | (setq end (point)) | |
6521 | (goto-char beg0) | |
6522 | (when (> end beg) | |
6523 | (setq org-subtree-clip-folded folded) | |
b349f79f CD |
6524 | (when (or cut force-store-markers) |
6525 | (org-save-markers-in-region beg end)) | |
20908596 CD |
6526 | (if cut (kill-region beg end) (copy-region-as-kill beg end)) |
6527 | (setq org-subtree-clip (current-kill 0)) | |
6528 | (message "%s: Subtree(s) with %d characters" | |
6529 | (if cut "Cut" "Copied") | |
6530 | (length org-subtree-clip))))) | |
b0a10108 | 6531 | |
93b62de8 | 6532 | (defun org-paste-subtree (&optional level tree for-yank) |
20908596 CD |
6533 | "Paste the clipboard as a subtree, with modification of headline level. |
6534 | The entire subtree is promoted or demoted in order to match a new headline | |
ce4fdcb9 | 6535 | level. |
93b62de8 CD |
6536 | |
6537 | If the cursor is at the beginning of a headline, the same level as | |
6538 | that headline is used to paste the tree | |
6539 | ||
6540 | If not, the new level is derived from the *visible* headings | |
20908596 CD |
6541 | before and after the insertion point, and taken to be the inferior headline |
6542 | level of the two. So if the previous visible heading is level 3 and the | |
6543 | next is level 4 (or vice versa), level 4 will be used for insertion. | |
6544 | This makes sure that the subtree remains an independent subtree and does | |
6545 | not swallow low level entries. | |
03f3cf35 | 6546 | |
20908596 CD |
6547 | You can also force a different level, either by using a numeric prefix |
6548 | argument, or by inserting the heading marker by hand. For example, if the | |
6549 | cursor is after \"*****\", then the tree will be shifted to level 5. | |
b0a10108 | 6550 | |
93b62de8 | 6551 | If optional TREE is given, use this text instead of the kill ring. |
b0a10108 | 6552 | |
93b62de8 CD |
6553 | When FOR-YANK is set, this is called by `org-yank'. In this case, do not |
6554 | move back over whitespace before inserting, and move point to the end of | |
6555 | the inserted text when done." | |
20908596 | 6556 | (interactive "P") |
c8d0cf5c | 6557 | (setq tree (or tree (and kill-ring (current-kill 0)))) |
20908596 CD |
6558 | (unless (org-kill-is-subtree-p tree) |
6559 | (error "%s" | |
6560 | (substitute-command-keys | |
6561 | "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) | |
2c3ad40d | 6562 | (let* ((visp (not (org-invisible-p))) |
c8d0cf5c | 6563 | (txt tree) |
20908596 CD |
6564 | (^re (concat "^\\(" outline-regexp "\\)")) |
6565 | (re (concat "\\(" outline-regexp "\\)")) | |
6566 | (^re_ (concat "\\(\\*+\\)[ \t]*")) | |
b0a10108 | 6567 | |
20908596 CD |
6568 | (old-level (if (string-match ^re txt) |
6569 | (- (match-end 0) (match-beginning 0) 1) | |
6570 | -1)) | |
6571 | (force-level (cond (level (prefix-numeric-value level)) | |
93b62de8 CD |
6572 | ((and (looking-at "[ \t]*$") |
6573 | (string-match | |
6574 | ^re_ (buffer-substring | |
6575 | (point-at-bol) (point)))) | |
20908596 | 6576 | (- (match-end 1) (match-beginning 1))) |
93b62de8 CD |
6577 | ((and (bolp) |
6578 | (looking-at org-outline-regexp)) | |
6579 | (- (match-end 0) (point) 1)) | |
20908596 CD |
6580 | (t nil))) |
6581 | (previous-level (save-excursion | |
6582 | (condition-case nil | |
6583 | (progn | |
6584 | (outline-previous-visible-heading 1) | |
6585 | (if (looking-at re) | |
6586 | (- (match-end 0) (match-beginning 0) 1) | |
6587 | 1)) | |
6588 | (error 1)))) | |
6589 | (next-level (save-excursion | |
6590 | (condition-case nil | |
6591 | (progn | |
6592 | (or (looking-at outline-regexp) | |
6593 | (outline-next-visible-heading 1)) | |
6594 | (if (looking-at re) | |
6595 | (- (match-end 0) (match-beginning 0) 1) | |
6596 | 1)) | |
6597 | (error 1)))) | |
6598 | (new-level (or force-level (max previous-level next-level))) | |
6599 | (shift (if (or (= old-level -1) | |
6600 | (= new-level -1) | |
6601 | (= old-level new-level)) | |
6602 | 0 | |
6603 | (- new-level old-level))) | |
6604 | (delta (if (> shift 0) -1 1)) | |
6605 | (func (if (> shift 0) 'org-demote 'org-promote)) | |
6606 | (org-odd-levels-only nil) | |
93b62de8 | 6607 | beg end newend) |
20908596 CD |
6608 | ;; Remove the forced level indicator |
6609 | (if force-level | |
6610 | (delete-region (point-at-bol) (point))) | |
6611 | ;; Paste | |
6612 | (beginning-of-line 1) | |
93b62de8 | 6613 | (unless for-yank (org-back-over-empty-lines)) |
20908596 | 6614 | (setq beg (point)) |
db55f368 | 6615 | (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) |
20908596 CD |
6616 | (insert-before-markers txt) |
6617 | (unless (string-match "\n\\'" txt) (insert "\n")) | |
93b62de8 | 6618 | (setq newend (point)) |
b349f79f | 6619 | (org-reinstall-markers-in-region beg) |
20908596 CD |
6620 | (setq end (point)) |
6621 | (goto-char beg) | |
6622 | (skip-chars-forward " \t\n\r") | |
6623 | (setq beg (point)) | |
2c3ad40d CD |
6624 | (if (and (org-invisible-p) visp) |
6625 | (save-excursion (outline-show-heading))) | |
20908596 CD |
6626 | ;; Shift if necessary |
6627 | (unless (= shift 0) | |
6628 | (save-restriction | |
6629 | (narrow-to-region beg end) | |
6630 | (while (not (= shift 0)) | |
6631 | (org-map-region func (point-min) (point-max)) | |
6632 | (setq shift (+ delta shift))) | |
93b62de8 CD |
6633 | (goto-char (point-min)) |
6634 | (setq newend (point-max)))) | |
6635 | (when (or (interactive-p) for-yank) | |
20908596 | 6636 | (message "Clipboard pasted as level %d subtree" new-level)) |
93b62de8 CD |
6637 | (if (and (not for-yank) ; in this case, org-yank will decide about folding |
6638 | kill-ring | |
20908596 CD |
6639 | (eq org-subtree-clip (current-kill 0)) |
6640 | org-subtree-clip-folded) | |
6641 | ;; The tree was folded before it was killed/copied | |
93b62de8 CD |
6642 | (hide-subtree)) |
6643 | (and for-yank (goto-char newend)))) | |
4b3a9ba7 | 6644 | |
20908596 CD |
6645 | (defun org-kill-is-subtree-p (&optional txt) |
6646 | "Check if the current kill is an outline subtree, or a set of trees. | |
6647 | Returns nil if kill does not start with a headline, or if the first | |
6648 | headline level is not the largest headline level in the tree. | |
6649 | So this will actually accept several entries of equal levels as well, | |
6650 | which is OK for `org-paste-subtree'. | |
6651 | If optional TXT is given, check this string instead of the current kill." | |
6652 | (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) | |
6653 | (start-level (and kill | |
6654 | (string-match (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" | |
6655 | org-outline-regexp "\\)") | |
6656 | kill) | |
6657 | (- (match-end 2) (match-beginning 2) 1))) | |
6658 | (re (concat "^" org-outline-regexp)) | |
621f83e4 | 6659 | (start (1+ (or (match-beginning 2) -1)))) |
20908596 CD |
6660 | (if (not start-level) |
6661 | (progn | |
6662 | nil) ;; does not even start with a heading | |
6663 | (catch 'exit | |
6664 | (while (setq start (string-match re kill (1+ start))) | |
6665 | (when (< (- (match-end 0) (match-beginning 0) 1) start-level) | |
6666 | (throw 'exit nil))) | |
6667 | t)))) | |
8c6fb58b | 6668 | |
b349f79f CD |
6669 | (defvar org-markers-to-move nil |
6670 | "Markers that should be moved with a cut-and-paste operation. | |
6671 | Those markers are stored together with their positions relative to | |
6672 | the start of the region.") | |
6673 | ||
6674 | (defun org-save-markers-in-region (beg end) | |
6675 | "Check markers in region. | |
6676 | If these markers are between BEG and END, record their position relative | |
6677 | to BEG, so that after moving the block of text, we can put the markers back | |
6678 | into place. | |
6679 | This function gets called just before an entry or tree gets cut from the | |
6680 | buffer. After re-insertion, `org-reinstall-markers-in-region' must be | |
6681 | called immediately, to move the markers with the entries." | |
6682 | (setq org-markers-to-move nil) | |
6683 | (when (featurep 'org-clock) | |
6684 | (org-clock-save-markers-for-cut-and-paste beg end)) | |
6685 | (when (featurep 'org-agenda) | |
6686 | (org-agenda-save-markers-for-cut-and-paste beg end))) | |
6687 | ||
6688 | (defun org-check-and-save-marker (marker beg end) | |
6689 | "Check if MARKER is between BEG and END. | |
6690 | If yes, remember the marker and the distance to BEG." | |
6691 | (when (and (marker-buffer marker) | |
6692 | (equal (marker-buffer marker) (current-buffer))) | |
6693 | (if (and (>= marker beg) (< marker end)) | |
6694 | (push (cons marker (- marker beg)) org-markers-to-move)))) | |
6695 | ||
6696 | (defun org-reinstall-markers-in-region (beg) | |
6697 | "Move all remembered markers to their position relative to BEG." | |
6698 | (mapc (lambda (x) | |
6699 | (move-marker (car x) (+ beg (cdr x)))) | |
6700 | org-markers-to-move) | |
6701 | (setq org-markers-to-move nil)) | |
6702 | ||
20908596 CD |
6703 | (defun org-narrow-to-subtree () |
6704 | "Narrow buffer to the current subtree." | |
6705 | (interactive) | |
6706 | (save-excursion | |
6707 | (save-match-data | |
6708 | (narrow-to-region | |
c8d0cf5c | 6709 | (progn (org-back-to-heading t) (point)) |
8d642074 | 6710 | (progn (org-end-of-subtree t t) (point)))))) |
8c6fb58b | 6711 | |
c8d0cf5c CD |
6712 | (defun org-clone-subtree-with-time-shift (n &optional shift) |
6713 | "Clone the task (subtree) at point N times. | |
6714 | The clones will be inserted as siblings. | |
6715 | ||
6716 | In interactive use, the user will be prompted for the number of clones | |
6717 | to be produced, and for a time SHIFT, which may be a repeater as used | |
6718 | in time stamps, for example `+3d'. | |
6719 | ||
6720 | When a valid repeater is given and the entry contains any time stamps, | |
6721 | the clones will become a sequence in time, with time stamps in the | |
6722 | subtree shifted for each clone produced. If SHIFT is nil or the | |
6723 | empty string, time stamps will be left alone. | |
6724 | ||
6725 | If the original subtree did contain time stamps with a repeater, | |
6726 | the following will happen: | |
6727 | - the repeater will be removed in each clone | |
6728 | - an additional clone will be produced, with the current, unshifted | |
6729 | date(s) in the entry. | |
6730 | - the original entry will be placed *after* all the clones, with | |
6731 | repeater intact. | |
6732 | - the start days in the repeater in the original entry will be shifted | |
6733 | to past the last clone. | |
6734 | I this way you can spell out a number of instances of a repeating task, | |
6735 | and still retain the repeater to cover future instances of the task." | |
6736 | (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ") | |
6737 | (let (beg end template task | |
6738 | shift-n shift-what doshift nmin nmax (n-no-remove -1)) | |
6739 | (if (not (and (integerp n) (> n 0))) | |
6740 | (error "Invalid number of replications %s" n)) | |
6741 | (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) | |
6742 | (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'" | |
6743 | shift))) | |
6744 | (error "Invalid shift specification %s" shift)) | |
6745 | (when doshift | |
6746 | (setq shift-n (string-to-number (match-string 1 shift)) | |
6747 | shift-what (cdr (assoc (match-string 2 shift) | |
6748 | '(("d" . day) ("w" . week) | |
6749 | ("m" . month) ("y" . year)))))) | |
6750 | (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) | |
6751 | (setq nmin 1 nmax n) | |
6752 | (org-back-to-heading t) | |
6753 | (setq beg (point)) | |
6754 | (org-end-of-subtree t t) | |
8bfe682a | 6755 | (or (bolp) (insert "\n")) |
c8d0cf5c CD |
6756 | (setq end (point)) |
6757 | (setq template (buffer-substring beg end)) | |
6758 | (when (and doshift | |
6759 | (string-match "<[^<>\n]+ \\+[0-9]+[dwmy][^<>\n]*>" template)) | |
6760 | (delete-region beg end) | |
6761 | (setq end beg) | |
6762 | (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) | |
6763 | (goto-char end) | |
6764 | (loop for n from nmin to nmax do | |
6765 | (if (not doshift) | |
6766 | (setq task template) | |
6767 | (with-temp-buffer | |
6768 | (insert template) | |
6769 | (org-mode) | |
6770 | (goto-char (point-min)) | |
6771 | (while (re-search-forward org-ts-regexp-both nil t) | |
6772 | (org-timestamp-change (* n shift-n) shift-what)) | |
6773 | (unless (= n n-no-remove) | |
6774 | (goto-char (point-min)) | |
6775 | (while (re-search-forward org-ts-regexp nil t) | |
6776 | (save-excursion | |
6777 | (goto-char (match-beginning 0)) | |
6778 | (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)") | |
6779 | (delete-region (match-beginning 1) (match-end 1)))))) | |
6780 | (setq task (buffer-string)))) | |
6781 | (insert task)) | |
6782 | (goto-char beg))) | |
8c6fb58b | 6783 | |
20908596 | 6784 | ;;; Outline Sorting |
a0d892d4 | 6785 | |
20908596 CD |
6786 | (defun org-sort (with-case) |
6787 | "Call `org-sort-entries-or-items' or `org-table-sort-lines'. | |
c8d0cf5c CD |
6788 | Optional argument WITH-CASE means sort case-sensitively. |
6789 | With a double prefix argument, also remove duplicate entries." | |
20908596 CD |
6790 | (interactive "P") |
6791 | (if (org-at-table-p) | |
6792 | (org-call-with-arg 'org-table-sort-lines with-case) | |
6793 | (org-call-with-arg 'org-sort-entries-or-items with-case))) | |
8c6fb58b | 6794 | |
20908596 CD |
6795 | (defun org-sort-remove-invisible (s) |
6796 | (remove-text-properties 0 (length s) org-rm-props s) | |
6797 | (while (string-match org-bracket-link-regexp s) | |
6798 | (setq s (replace-match (if (match-end 2) | |
6799 | (match-string 3 s) | |
6800 | (match-string 1 s)) t t s))) | |
6801 | s) | |
8c6fb58b | 6802 | |
20908596 | 6803 | (defvar org-priority-regexp) ; defined later in the file |
8c6fb58b | 6804 | |
c8d0cf5c CD |
6805 | (defvar org-after-sorting-entries-or-items-hook nil |
6806 | "Hook that is run after a bunch of entries or items have been sorted. | |
6807 | When children are sorted, the cursor is in the parent line when this | |
6808 | hook gets called. When a region or a plain list is sorted, the cursor | |
6809 | will be in the first entry of the sorted region/list.") | |
6810 | ||
fdf730ed CD |
6811 | (defun org-sort-entries-or-items |
6812 | (&optional with-case sorting-type getkey-func compare-func property) | |
c8d0cf5c | 6813 | "Sort entries on a certain level of an outline tree, or plain list items. |
20908596 CD |
6814 | If there is an active region, the entries in the region are sorted. |
6815 | Else, if the cursor is before the first entry, sort the top-level items. | |
6816 | Else, the children of the entry at point are sorted. | |
c8d0cf5c CD |
6817 | If the cursor is at the first item in a plain list, the list items will be |
6818 | sorted. | |
6819 | ||
6820 | Sorting can be alphabetically, numerically, by date/time as given by | |
6821 | a time stamp, by a property or by priority. | |
6822 | ||
6823 | The command prompts for the sorting type unless it has been given to the | |
6824 | function through the SORTING-TYPE argument, which needs to a character, | |
6825 | \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the | |
6826 | precise meaning of each character: | |
6827 | ||
6828 | n Numerically, by converting the beginning of the entry/item to a number. | |
6829 | a Alphabetically, ignoring the TODO keyword and the priority, if any. | |
6830 | t By date/time, either the first active time stamp in the entry, or, if | |
6831 | none exist, by the first inactive one. | |
8bfe682a | 6832 | In items, only the first line will be checked. |
c8d0cf5c CD |
6833 | s By the scheduled date/time. |
6834 | d By deadline date/time. | |
6835 | c By creation time, which is assumed to be the first inactive time stamp | |
6836 | at the beginning of a line. | |
6837 | p By priority according to the cookie. | |
6838 | r By the value of a property. | |
6839 | ||
6840 | Capital letters will reverse the sort order. | |
2a57416f | 6841 | |
20908596 CD |
6842 | If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be |
6843 | called with point at the beginning of the record. It must return either | |
6844 | a string or a number that should serve as the sorting key for that record. | |
2a57416f | 6845 | |
20908596 CD |
6846 | Comparing entries ignores case by default. However, with an optional argument |
6847 | WITH-CASE, the sorting considers case as well." | |
8c6fb58b | 6848 | (interactive "P") |
20908596 CD |
6849 | (let ((case-func (if with-case 'identity 'downcase)) |
6850 | start beg end stars re re2 | |
6851 | txt what tmp plain-list-p) | |
6852 | ;; Find beginning and end of region to sort | |
6853 | (cond | |
6854 | ((org-region-active-p) | |
6855 | ;; we will sort the region | |
6856 | (setq end (region-end) | |
6857 | what "region") | |
6858 | (goto-char (region-beginning)) | |
6859 | (if (not (org-on-heading-p)) (outline-next-heading)) | |
6860 | (setq start (point))) | |
6861 | ((org-at-item-p) | |
6862 | ;; we will sort this plain list | |
6863 | (org-beginning-of-item-list) (setq start (point)) | |
5dec9555 CD |
6864 | (org-end-of-item-list) |
6865 | (or (bolp) (insert "\n")) | |
6866 | (setq end (point)) | |
20908596 CD |
6867 | (goto-char start) |
6868 | (setq plain-list-p t | |
6869 | what "plain list")) | |
6870 | ((or (org-on-heading-p) | |
6871 | (condition-case nil (progn (org-back-to-heading) t) (error nil))) | |
6872 | ;; we will sort the children of the current headline | |
6873 | (org-back-to-heading) | |
6874 | (setq start (point) | |
6875 | end (progn (org-end-of-subtree t t) | |
5dec9555 | 6876 | (or (bolp) (insert "\n")) |
20908596 CD |
6877 | (org-back-over-empty-lines) |
6878 | (point)) | |
6879 | what "children") | |
6880 | (goto-char start) | |
6881 | (show-subtree) | |
6882 | (outline-next-heading)) | |
6883 | (t | |
6884 | ;; we will sort the top-level entries in this file | |
6885 | (goto-char (point-min)) | |
6886 | (or (org-on-heading-p) (outline-next-heading)) | |
5dec9555 CD |
6887 | (setq start (point)) |
6888 | (goto-char (point-max)) | |
6889 | (beginning-of-line 1) | |
6890 | (when (looking-at ".*?\\S-") | |
6891 | ;; File ends in a non-white line | |
6892 | (end-of-line 1) | |
6893 | (insert "\n")) | |
6894 | (setq end (point-max)) | |
6895 | (setq what "top-level") | |
20908596 CD |
6896 | (goto-char start) |
6897 | (show-all))) | |
2a57416f | 6898 | |
20908596 CD |
6899 | (setq beg (point)) |
6900 | (if (>= beg end) (error "Nothing to sort")) | |
8c6fb58b | 6901 | |
20908596 CD |
6902 | (unless plain-list-p |
6903 | (looking-at "\\(\\*+\\)") | |
6904 | (setq stars (match-string 1) | |
6905 | re (concat "^" (regexp-quote stars) " +") | |
6906 | re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") | |
6907 | txt (buffer-substring beg end)) | |
6908 | (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) | |
6909 | (if (and (not (equal stars "*")) (string-match re2 txt)) | |
6910 | (error "Region to sort contains a level above the first entry"))) | |
f425a6ea | 6911 | |
20908596 CD |
6912 | (unless sorting-type |
6913 | (message | |
6914 | (if plain-list-p | |
c8d0cf5c CD |
6915 | "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" |
6916 | "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc | |
6917 | [t]ime [s]cheduled [d]eadline [c]reated | |
6918 | A/N/T/S/D/C/P/O/F means reversed:") | |
20908596 CD |
6919 | what) |
6920 | (setq sorting-type (read-char-exclusive)) | |
3278a016 | 6921 | |
20908596 CD |
6922 | (and (= (downcase sorting-type) ?f) |
6923 | (setq getkey-func | |
54a0dee5 | 6924 | (org-icompleting-read "Sort using function: " |
20908596 CD |
6925 | obarray 'fboundp t nil nil)) |
6926 | (setq getkey-func (intern getkey-func))) | |
f425a6ea | 6927 | |
20908596 CD |
6928 | (and (= (downcase sorting-type) ?r) |
6929 | (setq property | |
54a0dee5 | 6930 | (org-icompleting-read "Property: " |
20908596 CD |
6931 | (mapcar 'list (org-buffer-property-keys t)) |
6932 | nil t)))) | |
4ed31842 | 6933 | |
20908596 | 6934 | (message "Sorting entries...") |
3278a016 | 6935 | |
20908596 CD |
6936 | (save-restriction |
6937 | (narrow-to-region start end) | |
c8d16429 | 6938 | |
20908596 | 6939 | (let ((dcst (downcase sorting-type)) |
c8d0cf5c | 6940 | (case-fold-search nil) |
20908596 CD |
6941 | (now (current-time))) |
6942 | (sort-subr | |
6943 | (/= dcst sorting-type) | |
6944 | ;; This function moves to the beginning character of the "record" to | |
6945 | ;; be sorted. | |
6946 | (if plain-list-p | |
6947 | (lambda nil | |
6948 | (if (org-at-item-p) t (goto-char (point-max)))) | |
6949 | (lambda nil | |
6950 | (if (re-search-forward re nil t) | |
6951 | (goto-char (match-beginning 0)) | |
6952 | (goto-char (point-max))))) | |
6953 | ;; This function moves to the last character of the "record" being | |
6954 | ;; sorted. | |
6955 | (if plain-list-p | |
6956 | 'org-end-of-item | |
6957 | (lambda nil | |
6958 | (save-match-data | |
6959 | (condition-case nil | |
6960 | (outline-forward-same-level 1) | |
6961 | (error | |
6962 | (goto-char (point-max))))))) | |
a96ee7df | 6963 | |
20908596 CD |
6964 | ;; This function returns the value that gets sorted against. |
6965 | (if plain-list-p | |
6966 | (lambda nil | |
6967 | (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") | |
6968 | (cond | |
6969 | ((= dcst ?n) | |
6970 | (string-to-number (buffer-substring (match-end 0) | |
6971 | (point-at-eol)))) | |
6972 | ((= dcst ?a) | |
6973 | (buffer-substring (match-end 0) (point-at-eol))) | |
6974 | ((= dcst ?t) | |
c8d0cf5c CD |
6975 | (if (or (re-search-forward org-ts-regexp (point-at-eol) t) |
6976 | (re-search-forward org-ts-regexp-both | |
6977 | (point-at-eol) t)) | |
6978 | (org-time-string-to-seconds (match-string 0)) | |
54a0dee5 | 6979 | (org-float-time now))) |
20908596 CD |
6980 | ((= dcst ?f) |
6981 | (if getkey-func | |
6982 | (progn | |
6983 | (setq tmp (funcall getkey-func)) | |
6984 | (if (stringp tmp) (setq tmp (funcall case-func tmp))) | |
6985 | tmp) | |
6986 | (error "Invalid key function `%s'" getkey-func))) | |
6987 | (t (error "Invalid sorting type `%c'" sorting-type))))) | |
6988 | (lambda nil | |
6989 | (cond | |
6990 | ((= dcst ?n) | |
621f83e4 CD |
6991 | (if (looking-at org-complex-heading-regexp) |
6992 | (string-to-number (match-string 4)) | |
20908596 CD |
6993 | nil)) |
6994 | ((= dcst ?a) | |
621f83e4 CD |
6995 | (if (looking-at org-complex-heading-regexp) |
6996 | (funcall case-func (match-string 4)) | |
6997 | nil)) | |
20908596 | 6998 | ((= dcst ?t) |
c8d0cf5c CD |
6999 | (let ((end (save-excursion (outline-next-heading) (point)))) |
7000 | (if (or (re-search-forward org-ts-regexp end t) | |
7001 | (re-search-forward org-ts-regexp-both end t)) | |
7002 | (org-time-string-to-seconds (match-string 0)) | |
54a0dee5 | 7003 | (org-float-time now)))) |
c8d0cf5c CD |
7004 | ((= dcst ?c) |
7005 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
7006 | (if (re-search-forward | |
7007 | (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") | |
7008 | end t) | |
7009 | (org-time-string-to-seconds (match-string 0)) | |
54a0dee5 | 7010 | (org-float-time now)))) |
c8d0cf5c CD |
7011 | ((= dcst ?s) |
7012 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
7013 | (if (re-search-forward org-scheduled-time-regexp end t) | |
7014 | (org-time-string-to-seconds (match-string 1)) | |
54a0dee5 | 7015 | (org-float-time now)))) |
c8d0cf5c CD |
7016 | ((= dcst ?d) |
7017 | (let ((end (save-excursion (outline-next-heading) (point)))) | |
7018 | (if (re-search-forward org-deadline-time-regexp end t) | |
7019 | (org-time-string-to-seconds (match-string 1)) | |
54a0dee5 | 7020 | (org-float-time now)))) |
20908596 CD |
7021 | ((= dcst ?p) |
7022 | (if (re-search-forward org-priority-regexp (point-at-eol) t) | |
7023 | (string-to-char (match-string 2)) | |
7024 | org-default-priority)) | |
7025 | ((= dcst ?r) | |
7026 | (or (org-entry-get nil property) "")) | |
7027 | ((= dcst ?o) | |
7028 | (if (looking-at org-complex-heading-regexp) | |
7029 | (- 9999 (length (member (match-string 2) | |
7030 | org-todo-keywords-1))))) | |
7031 | ((= dcst ?f) | |
7032 | (if getkey-func | |
7033 | (progn | |
7034 | (setq tmp (funcall getkey-func)) | |
7035 | (if (stringp tmp) (setq tmp (funcall case-func tmp))) | |
7036 | tmp) | |
7037 | (error "Invalid key function `%s'" getkey-func))) | |
7038 | (t (error "Invalid sorting type `%c'" sorting-type))))) | |
7039 | nil | |
7040 | (cond | |
7041 | ((= dcst ?a) 'string<) | |
fdf730ed | 7042 | ((= dcst ?f) compare-func) |
c8d0cf5c | 7043 | ((member dcst '(?p ?t ?s ?d ?c)) '<) |
20908596 | 7044 | (t nil))))) |
c8d0cf5c | 7045 | (run-hooks 'org-after-sorting-entries-or-items-hook) |
20908596 | 7046 | (message "Sorting entries...done"))) |
a96ee7df | 7047 | |
20908596 CD |
7048 | (defun org-do-sort (table what &optional with-case sorting-type) |
7049 | "Sort TABLE of WHAT according to SORTING-TYPE. | |
7050 | The user will be prompted for the SORTING-TYPE if the call to this | |
7051 | function does not specify it. WHAT is only for the prompt, to indicate | |
7052 | what is being sorted. The sorting key will be extracted from | |
7053 | the car of the elements of the table. | |
7054 | If WITH-CASE is non-nil, the sorting will be case-sensitive." | |
7055 | (unless sorting-type | |
7056 | (message | |
7057 | "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:" | |
7058 | what) | |
7059 | (setq sorting-type (read-char-exclusive))) | |
7060 | (let ((dcst (downcase sorting-type)) | |
7061 | extractfun comparefun) | |
7062 | ;; Define the appropriate functions | |
7063 | (cond | |
7064 | ((= dcst ?n) | |
7065 | (setq extractfun 'string-to-number | |
7066 | comparefun (if (= dcst sorting-type) '< '>))) | |
7067 | ((= dcst ?a) | |
7068 | (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) | |
7069 | (lambda(x) (downcase (org-sort-remove-invisible x)))) | |
7070 | comparefun (if (= dcst sorting-type) | |
7071 | 'string< | |
7072 | (lambda (a b) (and (not (string< a b)) | |
7073 | (not (string= a b))))))) | |
7074 | ((= dcst ?t) | |
7075 | (setq extractfun | |
7076 | (lambda (x) | |
c8d0cf5c CD |
7077 | (if (or (string-match org-ts-regexp x) |
7078 | (string-match org-ts-regexp-both x)) | |
54a0dee5 | 7079 | (org-float-time |
20908596 CD |
7080 | (org-time-string-to-time (match-string 0 x))) |
7081 | 0)) | |
7082 | comparefun (if (= dcst sorting-type) '< '>))) | |
7083 | (t (error "Invalid sorting type `%c'" sorting-type))) | |
a96ee7df | 7084 | |
20908596 CD |
7085 | (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) |
7086 | table) | |
7087 | (lambda (a b) (funcall comparefun (car a) (car b)))))) | |
891f4676 | 7088 | |
4b3a9ba7 | 7089 | |
20908596 | 7090 | ;;; The orgstruct minor mode |
4b3a9ba7 | 7091 | |
20908596 CD |
7092 | ;; Define a minor mode which can be used in other modes in order to |
7093 | ;; integrate the org-mode structure editing commands. | |
374585c9 | 7094 | |
20908596 CD |
7095 | ;; This is really a hack, because the org-mode structure commands use |
7096 | ;; keys which normally belong to the major mode. Here is how it | |
7097 | ;; works: The minor mode defines all the keys necessary to operate the | |
7098 | ;; structure commands, but wraps the commands into a function which | |
7099 | ;; tests if the cursor is currently at a headline or a plain list | |
7100 | ;; item. If that is the case, the structure command is used, | |
7101 | ;; temporarily setting many Org-mode variables like regular | |
7102 | ;; expressions for filling etc. However, when any of those keys is | |
7103 | ;; used at a different location, function uses `key-binding' to look | |
7104 | ;; up if the key has an associated command in another currently active | |
7105 | ;; keymap (minor modes, major mode, global), and executes that | |
7106 | ;; command. There might be problems if any of the keys is otherwise | |
7107 | ;; used as a prefix key. | |
4b3a9ba7 | 7108 | |
20908596 CD |
7109 | ;; Another challenge is that the key binding for TAB can be tab or \C-i, |
7110 | ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode | |
7111 | ;; addresses this by checking explicitly for both bindings. | |
2a94e282 | 7112 | |
20908596 CD |
7113 | (defvar orgstruct-mode-map (make-sparse-keymap) |
7114 | "Keymap for the minor `orgstruct-mode'.") | |
03f3cf35 | 7115 | |
20908596 CD |
7116 | (defvar org-local-vars nil |
7117 | "List of local variables, for use by `orgstruct-mode'") | |
03f3cf35 | 7118 | |
20908596 CD |
7119 | ;;;###autoload |
7120 | (define-minor-mode orgstruct-mode | |
7121 | "Toggle the minor more `orgstruct-mode'. | |
7122 | This mode is for using Org-mode structure commands in other modes. | |
7123 | The following key behave as if Org-mode was active, if the cursor | |
7124 | is on a headline, or on a plain list item (both in the definition | |
7125 | of Org-mode). | |
03f3cf35 | 7126 | |
20908596 CD |
7127 | M-up Move entry/item up |
7128 | M-down Move entry/item down | |
7129 | M-left Promote | |
7130 | M-right Demote | |
7131 | M-S-up Move entry/item up | |
7132 | M-S-down Move entry/item down | |
7133 | M-S-left Promote subtree | |
7134 | M-S-right Demote subtree | |
7135 | M-q Fill paragraph and items like in Org-mode | |
7136 | C-c ^ Sort entries | |
7137 | C-c - Cycle list bullet | |
7138 | TAB Cycle item visibility | |
7139 | M-RET Insert new heading/item | |
33306645 | 7140 | S-M-RET Insert new TODO heading / Checkbox item |
20908596 CD |
7141 | C-c C-c Set tags / toggle checkbox" |
7142 | nil " OrgStruct" nil | |
7143 | (org-load-modules-maybe) | |
7144 | (and (orgstruct-setup) (defun orgstruct-setup () nil))) | |
891f4676 | 7145 | |
20908596 CD |
7146 | ;;;###autoload |
7147 | (defun turn-on-orgstruct () | |
7148 | "Unconditionally turn on `orgstruct-mode'." | |
7149 | (orgstruct-mode 1)) | |
7150 | ||
c8d0cf5c CD |
7151 | (defun orgstruct++-mode (&optional arg) |
7152 | "Toggle `orgstruct-mode', the enhanced version of it. | |
7153 | In addition to setting orgstruct-mode, this also exports all indentation | |
7154 | and autofilling variables from org-mode into the buffer. It will also | |
7155 | recognize item context in multiline items. | |
7156 | Note that turning off orgstruct-mode will *not* remove the | |
7157 | indentation/paragraph settings. This can only be done by refreshing the | |
7158 | major mode, for example with \\[normal-mode]." | |
7159 | (interactive "P") | |
7160 | (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) | |
7161 | (if (< arg 1) | |
7162 | (orgstruct-mode -1) | |
7163 | (orgstruct-mode 1) | |
7164 | (let (var val) | |
7165 | (mapc | |
7166 | (lambda (x) | |
7167 | (when (string-match | |
7168 | "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" | |
7169 | (symbol-name (car x))) | |
7170 | (setq var (car x) val (nth 1 x)) | |
7171 | (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) | |
7172 | org-local-vars) | |
7173 | (org-set-local 'orgstruct-is-++ t)))) | |
7174 | ||
7175 | (defvar orgstruct-is-++ nil | |
7176 | "Is orgstruct-mode in ++ version in the current-buffer?") | |
7177 | (make-variable-buffer-local 'orgstruct-is-++) | |
7178 | ||
20908596 CD |
7179 | ;;;###autoload |
7180 | (defun turn-on-orgstruct++ () | |
c8d0cf5c CD |
7181 | "Unconditionally turn on `orgstruct++-mode'." |
7182 | (orgstruct++-mode 1)) | |
20908596 CD |
7183 | |
7184 | (defun orgstruct-error () | |
7185 | "Error when there is no default binding for a structure key." | |
7186 | (interactive) | |
7187 | (error "This key has no function outside structure elements")) | |
891f4676 | 7188 | |
20908596 CD |
7189 | (defun orgstruct-setup () |
7190 | "Setup orgstruct keymaps." | |
7191 | (let ((nfunc 0) | |
7192 | (bindings | |
7193 | (list | |
7194 | '([(meta up)] org-metaup) | |
7195 | '([(meta down)] org-metadown) | |
7196 | '([(meta left)] org-metaleft) | |
7197 | '([(meta right)] org-metaright) | |
7198 | '([(meta shift up)] org-shiftmetaup) | |
7199 | '([(meta shift down)] org-shiftmetadown) | |
7200 | '([(meta shift left)] org-shiftmetaleft) | |
7201 | '([(meta shift right)] org-shiftmetaright) | |
c8d0cf5c CD |
7202 | '([?\e (up)] org-metaup) |
7203 | '([?\e (down)] org-metadown) | |
7204 | '([?\e (left)] org-metaleft) | |
7205 | '([?\e (right)] org-metaright) | |
7206 | '([?\e (shift up)] org-shiftmetaup) | |
7207 | '([?\e (shift down)] org-shiftmetadown) | |
7208 | '([?\e (shift left)] org-shiftmetaleft) | |
7209 | '([?\e (shift right)] org-shiftmetaright) | |
20908596 CD |
7210 | '([(shift up)] org-shiftup) |
7211 | '([(shift down)] org-shiftdown) | |
ce4fdcb9 CD |
7212 | '([(shift left)] org-shiftleft) |
7213 | '([(shift right)] org-shiftright) | |
20908596 CD |
7214 | '("\C-c\C-c" org-ctrl-c-ctrl-c) |
7215 | '("\M-q" fill-paragraph) | |
7216 | '("\C-c^" org-sort) | |
7217 | '("\C-c-" org-cycle-list-bullet))) | |
7218 | elt key fun cmd) | |
7219 | (while (setq elt (pop bindings)) | |
7220 | (setq nfunc (1+ nfunc)) | |
7221 | (setq key (org-key (car elt)) | |
7222 | fun (nth 1 elt) | |
7223 | cmd (orgstruct-make-binding fun nfunc key)) | |
7224 | (org-defkey orgstruct-mode-map key cmd)) | |
891f4676 | 7225 | |
20908596 CD |
7226 | ;; Special treatment needed for TAB and RET |
7227 | (org-defkey orgstruct-mode-map [(tab)] | |
7228 | (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) | |
7229 | (org-defkey orgstruct-mode-map "\C-i" | |
7230 | (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) | |
6769c0dc | 7231 | |
20908596 CD |
7232 | (org-defkey orgstruct-mode-map "\M-\C-m" |
7233 | (orgstruct-make-binding 'org-insert-heading 105 | |
7234 | "\M-\C-m" [(meta return)])) | |
7235 | (org-defkey orgstruct-mode-map [(meta return)] | |
7236 | (orgstruct-make-binding 'org-insert-heading 106 | |
7237 | [(meta return)] "\M-\C-m")) | |
891f4676 | 7238 | |
20908596 CD |
7239 | (org-defkey orgstruct-mode-map [(shift meta return)] |
7240 | (orgstruct-make-binding 'org-insert-todo-heading 107 | |
7241 | [(meta return)] "\M-\C-m")) | |
891f4676 | 7242 | |
c8d0cf5c CD |
7243 | (org-defkey orgstruct-mode-map "\e\C-m" |
7244 | (orgstruct-make-binding 'org-insert-heading 108 | |
7245 | "\e\C-m" [?\e (return)])) | |
7246 | (org-defkey orgstruct-mode-map [?\e (return)] | |
7247 | (orgstruct-make-binding 'org-insert-heading 109 | |
7248 | [?\e (return)] "\e\C-m")) | |
7249 | (org-defkey orgstruct-mode-map [?\e (shift return)] | |
7250 | (orgstruct-make-binding 'org-insert-todo-heading 110 | |
7251 | [?\e (return)] "\e\C-m")) | |
7252 | ||
20908596 CD |
7253 | (unless org-local-vars |
7254 | (setq org-local-vars (org-get-local-variables))) | |
891f4676 | 7255 | |
20908596 | 7256 | t)) |
891f4676 | 7257 | |
20908596 CD |
7258 | (defun orgstruct-make-binding (fun n &rest keys) |
7259 | "Create a function for binding in the structure minor mode. | |
7260 | FUN is the command to call inside a table. N is used to create a unique | |
7261 | command name. KEYS are keys that should be checked in for a command | |
7262 | to execute outside of tables." | |
7263 | (eval | |
7264 | (list 'defun | |
7265 | (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) | |
7266 | '(arg) | |
7267 | (concat "In Structure, run `" (symbol-name fun) "'.\n" | |
7268 | "Outside of structure, run the binding of `" | |
7269 | (mapconcat (lambda (x) (format "%s" x)) keys "' or `") | |
7270 | "'.") | |
7271 | '(interactive "p") | |
7272 | (list 'if | |
c8d0cf5c CD |
7273 | `(org-context-p 'headline 'item |
7274 | (and orgstruct-is-++ | |
7275 | ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t) | |
7276 | 'item-body)) | |
20908596 CD |
7277 | (list 'org-run-like-in-org-mode (list 'quote fun)) |
7278 | (list 'let '(orgstruct-mode) | |
7279 | (list 'call-interactively | |
7280 | (append '(or) | |
7281 | (mapcar (lambda (k) | |
7282 | (list 'key-binding k)) | |
7283 | keys) | |
7284 | '('orgstruct-error)))))))) | |
64f72ae1 | 7285 | |
20908596 | 7286 | (defun org-context-p (&rest contexts) |
621f83e4 | 7287 | "Check if local context is any of CONTEXTS. |
20908596 CD |
7288 | Possible values in the list of contexts are `table', `headline', and `item'." |
7289 | (let ((pos (point))) | |
7290 | (goto-char (point-at-bol)) | |
7291 | (prog1 (or (and (memq 'table contexts) | |
7292 | (looking-at "[ \t]*|")) | |
7293 | (and (memq 'headline contexts) | |
621f83e4 CD |
7294 | ;;????????? (looking-at "\\*+")) |
7295 | (looking-at outline-regexp)) | |
20908596 | 7296 | (and (memq 'item contexts) |
c8d0cf5c CD |
7297 | (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)")) |
7298 | (and (memq 'item-body contexts) | |
7299 | (org-in-item-p))) | |
20908596 | 7300 | (goto-char pos)))) |
4b3a9ba7 | 7301 | |
20908596 CD |
7302 | (defun org-get-local-variables () |
7303 | "Return a list of all local variables in an org-mode buffer." | |
7304 | (let (varlist) | |
7305 | (with-current-buffer (get-buffer-create "*Org tmp*") | |
7306 | (erase-buffer) | |
7307 | (org-mode) | |
7308 | (setq varlist (buffer-local-variables))) | |
7309 | (kill-buffer "*Org tmp*") | |
7310 | (delq nil | |
7311 | (mapcar | |
7312 | (lambda (x) | |
7313 | (setq x | |
7314 | (if (symbolp x) | |
7315 | (list x) | |
7316 | (list (car x) (list 'quote (cdr x))))) | |
7317 | (if (string-match | |
7318 | "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" | |
7319 | (symbol-name (car x))) | |
7320 | x nil)) | |
7321 | varlist)))) | |
891f4676 | 7322 | |
20908596 CD |
7323 | ;;;###autoload |
7324 | (defun org-run-like-in-org-mode (cmd) | |
c8d0cf5c CD |
7325 | "Run a command, pretending that the current buffer is in Org-mode. |
7326 | This will temporarily bind local variables that are typically bound in | |
7327 | Org-mode to the values they have in Org-mode, and then interactively | |
7328 | call CMD." | |
20908596 CD |
7329 | (org-load-modules-maybe) |
7330 | (unless org-local-vars | |
7331 | (setq org-local-vars (org-get-local-variables))) | |
7332 | (eval (list 'let org-local-vars | |
7333 | (list 'call-interactively (list 'quote cmd))))) | |
891f4676 | 7334 | |
20908596 | 7335 | ;;;; Archiving |
891f4676 | 7336 | |
20908596 CD |
7337 | (defun org-get-category (&optional pos) |
7338 | "Get the category applying to position POS." | |
7339 | (get-text-property (or pos (point)) 'org-category)) | |
a96ee7df | 7340 | |
20908596 CD |
7341 | (defun org-refresh-category-properties () |
7342 | "Refresh category text properties in the buffer." | |
7343 | (let ((def-cat (cond | |
7344 | ((null org-category) | |
7345 | (if buffer-file-name | |
7346 | (file-name-sans-extension | |
7347 | (file-name-nondirectory buffer-file-name)) | |
7348 | "???")) | |
7349 | ((symbolp org-category) (symbol-name org-category)) | |
7350 | (t org-category))) | |
7351 | beg end cat pos optionp) | |
7352 | (org-unmodified | |
7353 | (save-excursion | |
7354 | (save-restriction | |
7355 | (widen) | |
7356 | (goto-char (point-min)) | |
7357 | (put-text-property (point) (point-max) 'org-category def-cat) | |
7358 | (while (re-search-forward | |
7359 | "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) | |
7360 | (setq pos (match-end 0) | |
7361 | optionp (equal (char-after (match-beginning 0)) ?#) | |
7362 | cat (org-trim (match-string 2))) | |
7363 | (if optionp | |
7364 | (setq beg (point-at-bol) end (point-max)) | |
7365 | (org-back-to-heading t) | |
7366 | (setq beg (point) end (org-end-of-subtree t t))) | |
7367 | (put-text-property beg end 'org-category cat) | |
7368 | (goto-char pos))))))) | |
891f4676 | 7369 | |
891f4676 | 7370 | |
20908596 | 7371 | ;;;; Link Stuff |
03f3cf35 | 7372 | |
20908596 | 7373 | ;;; Link abbreviations |
891f4676 | 7374 | |
20908596 CD |
7375 | (defun org-link-expand-abbrev (link) |
7376 | "Apply replacements as defined in `org-link-abbrev-alist." | |
7377 | (if (string-match "^\\([a-zA-Z][-_a-zA-Z0-9]*\\)\\(::?\\(.*\\)\\)?$" link) | |
7378 | (let* ((key (match-string 1 link)) | |
7379 | (as (or (assoc key org-link-abbrev-alist-local) | |
7380 | (assoc key org-link-abbrev-alist))) | |
7381 | (tag (and (match-end 2) (match-string 3 link))) | |
7382 | rpl) | |
7383 | (if (not as) | |
7384 | link | |
7385 | (setq rpl (cdr as)) | |
7386 | (cond | |
7387 | ((symbolp rpl) (funcall rpl tag)) | |
7388 | ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) | |
ce4fdcb9 CD |
7389 | ((string-match "%h" rpl) |
7390 | (replace-match (url-hexify-string (or tag "")) t t rpl)) | |
20908596 CD |
7391 | (t (concat rpl tag))))) |
7392 | link)) | |
4b3a9ba7 | 7393 | |
20908596 | 7394 | ;;; Storing and inserting links |
0fee8d6e | 7395 | |
20908596 CD |
7396 | (defvar org-insert-link-history nil |
7397 | "Minibuffer history for links inserted with `org-insert-link'.") | |
38f8646b | 7398 | |
20908596 CD |
7399 | (defvar org-stored-links nil |
7400 | "Contains the links stored with `org-store-link'.") | |
38f8646b | 7401 | |
20908596 CD |
7402 | (defvar org-store-link-plist nil |
7403 | "Plist with info about the most recently link created with `org-store-link'.") | |
fbe6c10d | 7404 | |
20908596 CD |
7405 | (defvar org-link-protocols nil |
7406 | "Link protocols added to Org-mode using `org-add-link-type'.") | |
f425a6ea | 7407 | |
20908596 CD |
7408 | (defvar org-store-link-functions nil |
7409 | "List of functions that are called to create and store a link. | |
7410 | Each function will be called in turn until one returns a non-nil | |
7411 | value. Each function should check if it is responsible for creating | |
7412 | this link (for example by looking at the major mode). | |
7413 | If not, it must exit and return nil. | |
7414 | If yes, it should return a non-nil value after a calling | |
7415 | `org-store-link-props' with a list of properties and values. | |
7416 | Special properties are: | |
30313b90 | 7417 | |
20908596 CD |
7418 | :type The link prefix. like \"http\". This must be given. |
7419 | :link The link, like \"http://www.astro.uva.nl/~dominik\". | |
7420 | This is obligatory as well. | |
7421 | :description Optional default description for the second pair | |
7422 | of brackets in an Org-mode link. The user can still change | |
7423 | this when inserting this link into an Org-mode buffer. | |
30313b90 | 7424 | |
20908596 CD |
7425 | In addition to these, any additional properties can be specified |
7426 | and then used in remember templates.") | |
35402b98 | 7427 | |
20908596 CD |
7428 | (defun org-add-link-type (type &optional follow export) |
7429 | "Add TYPE to the list of `org-link-types'. | |
7430 | Re-compute all regular expressions depending on `org-link-types' | |
ab27a4a0 | 7431 | |
20908596 | 7432 | FOLLOW and EXPORT are two functions. |
891f4676 | 7433 | |
20908596 CD |
7434 | FOLLOW should take the link path as the single argument and do whatever |
7435 | is necessary to follow the link, for example find a file or display | |
7436 | a mail message. | |
1e8fbb6d | 7437 | |
20908596 CD |
7438 | EXPORT should format the link path for export to one of the export formats. |
7439 | It should be a function accepting three arguments: | |
fbe6c10d | 7440 | |
20908596 | 7441 | path the path of the link, the text after the prefix (like \"http:\") |
33306645 | 7442 | desc the description of the link, if any, nil if there was no description |
20908596 | 7443 | format the export format, a symbol like `html' or `latex'. |
fbe6c10d | 7444 | |
20908596 CD |
7445 | The function may use the FORMAT information to return different values |
7446 | depending on the format. The return value will be put literally into | |
7447 | the exported file. | |
7448 | Org-mode has a built-in default for exporting links. If you are happy with | |
7449 | this default, there is no need to define an export function for the link | |
7450 | type. For a simple example of an export function, see `org-bbdb.el'." | |
7451 | (add-to-list 'org-link-types type t) | |
7452 | (org-make-link-regexps) | |
7453 | (if (assoc type org-link-protocols) | |
7454 | (setcdr (assoc type org-link-protocols) (list follow export)) | |
7455 | (push (list type follow export) org-link-protocols))) | |
374585c9 | 7456 | |
8d642074 CD |
7457 | (defvar org-agenda-buffer-name) |
7458 | ||
20908596 CD |
7459 | ;;;###autoload |
7460 | (defun org-store-link (arg) | |
7461 | "\\<org-mode-map>Store an org-link to the current location. | |
7462 | This link is added to `org-stored-links' and can later be inserted | |
7463 | into an org-buffer with \\[org-insert-link]. | |
7464 | ||
7465 | For some link types, a prefix arg is interpreted: | |
ce4fdcb9 | 7466 | For links to usenet articles, arg negates `org-gnus-prefer-web-links'. |
20908596 CD |
7467 | For file links, arg negates `org-context-in-file-links'." |
7468 | (interactive "P") | |
7469 | (org-load-modules-maybe) | |
7470 | (setq org-store-link-plist nil) ; reset | |
c8d0cf5c CD |
7471 | (let ((outline-regexp (org-get-limited-outline-regexp)) |
7472 | link cpltxt desc description search txt custom-id) | |
d3f4dbe8 | 7473 | (cond |
a96ee7df | 7474 | |
20908596 CD |
7475 | ((run-hook-with-args-until-success 'org-store-link-functions) |
7476 | (setq link (plist-get org-store-link-plist :link) | |
7477 | desc (or (plist-get org-store-link-plist :description) link))) | |
7478 | ||
0bd48b37 CD |
7479 | ((equal (buffer-name) "*Org Edit Src Example*") |
7480 | (let (label gc) | |
7481 | (while (or (not label) | |
7482 | (save-excursion | |
7483 | (save-restriction | |
7484 | (widen) | |
7485 | (goto-char (point-min)) | |
7486 | (re-search-forward | |
7487 | (regexp-quote (format org-coderef-label-format label)) | |
7488 | nil t)))) | |
7489 | (when label (message "Label exists already") (sit-for 2)) | |
7490 | (setq label (read-string "Code line label: " label))) | |
7491 | (end-of-line 1) | |
7492 | (setq link (format org-coderef-label-format label)) | |
7493 | (setq gc (- 79 (length link))) | |
7494 | (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) | |
7495 | (insert link) | |
7496 | (setq link (concat "(" label ")") desc nil))) | |
7497 | ||
8d642074 CD |
7498 | ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) |
7499 | ;; We are in the agenda, link to referenced location | |
7500 | (let ((m (or (get-text-property (point) 'org-hd-marker) | |
7501 | (get-text-property (point) 'org-marker)))) | |
7502 | (when m | |
7503 | (org-with-point-at m | |
7504 | (call-interactively 'org-store-link))))) | |
7505 | ||
20908596 CD |
7506 | ((eq major-mode 'calendar-mode) |
7507 | (let ((cd (calendar-cursor-to-date))) | |
7508 | (setq link | |
7509 | (format-time-string | |
7510 | (car org-time-stamp-formats) | |
7511 | (apply 'encode-time | |
7512 | (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) | |
7513 | nil nil nil)))) | |
7514 | (org-store-link-props :type "calendar" :date cd))) | |
7515 | ||
7516 | ((eq major-mode 'w3-mode) | |
c8d0cf5c CD |
7517 | (setq cpltxt (if (and (buffer-name) |
7518 | (not (string-match "Untitled" (buffer-name)))) | |
7519 | (buffer-name) | |
7520 | (url-view-url t)) | |
7521 | link (org-make-link (url-view-url t))) | |
20908596 CD |
7522 | (org-store-link-props :type "w3" :url (url-view-url t))) |
7523 | ||
7524 | ((eq major-mode 'w3m-mode) | |
7525 | (setq cpltxt (or w3m-current-title w3m-current-url) | |
7526 | link (org-make-link w3m-current-url)) | |
7527 | (org-store-link-props :type "w3m" :url (url-view-url t))) | |
7528 | ||
7529 | ((setq search (run-hook-with-args-until-success | |
7530 | 'org-create-file-search-functions)) | |
7531 | (setq link (concat "file:" (abbreviate-file-name buffer-file-name) | |
7532 | "::" search)) | |
7533 | (setq cpltxt (or description link))) | |
7534 | ||
7535 | ((eq major-mode 'image-mode) | |
7536 | (setq cpltxt (concat "file:" | |
7537 | (abbreviate-file-name buffer-file-name)) | |
7538 | link (org-make-link cpltxt)) | |
7539 | (org-store-link-props :type "image" :file buffer-file-name)) | |
7540 | ||
7541 | ((eq major-mode 'dired-mode) | |
7542 | ;; link to the file in the current line | |
7543 | (setq cpltxt (concat "file:" | |
7544 | (abbreviate-file-name | |
7545 | (expand-file-name | |
7546 | (dired-get-filename nil t)))) | |
7547 | link (org-make-link cpltxt))) | |
7548 | ||
7549 | ((and buffer-file-name (org-mode-p)) | |
c8d0cf5c | 7550 | (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID"))) |
db55f368 CD |
7551 | (cond |
7552 | ((org-in-regexp "<<\\(.*?\\)>>") | |
7553 | (setq cpltxt | |
7554 | (concat "file:" | |
7555 | (abbreviate-file-name buffer-file-name) | |
7556 | "::" (match-string 1)) | |
7557 | link (org-make-link cpltxt))) | |
7558 | ((and (featurep 'org-id) | |
7559 | (or (eq org-link-to-org-use-id t) | |
7560 | (and (eq org-link-to-org-use-id 'create-if-interactive) | |
7561 | (interactive-p)) | |
c8d0cf5c CD |
7562 | (and (eq org-link-to-org-use-id 'create-if-interactive-and-no-custom-id) |
7563 | (interactive-p) | |
7564 | (not custom-id)) | |
db55f368 CD |
7565 | (and org-link-to-org-use-id |
7566 | (condition-case nil | |
7567 | (org-entry-get nil "ID") | |
7568 | (error nil))))) | |
7569 | ;; We can make a link using the ID. | |
7570 | (setq link (condition-case nil | |
fdf730ed CD |
7571 | (prog1 (org-id-store-link) |
7572 | (setq desc (plist-get org-store-link-plist | |
7573 | :description))) | |
db55f368 | 7574 | (error |
33306645 | 7575 | ;; probably before first headline, link to file only |
db55f368 CD |
7576 | (concat "file:" |
7577 | (abbreviate-file-name buffer-file-name)))))) | |
7578 | (t | |
7579 | ;; Just link to current headline | |
7580 | (setq cpltxt (concat "file:" | |
7581 | (abbreviate-file-name buffer-file-name))) | |
7582 | ;; Add a context search string | |
7583 | (when (org-xor org-context-in-file-links arg) | |
20908596 CD |
7584 | (setq txt (cond |
7585 | ((org-on-heading-p) nil) | |
7586 | ((org-region-active-p) | |
7587 | (buffer-substring (region-beginning) (region-end))) | |
7588 | (t nil))) | |
7589 | (when (or (null txt) (string-match "\\S-" txt)) | |
7590 | (setq cpltxt | |
b349f79f CD |
7591 | (concat cpltxt "::" |
7592 | (condition-case nil | |
7593 | (org-make-org-heading-search-string txt) | |
7594 | (error ""))) | |
8d642074 CD |
7595 | desc (or (nth 4 (ignore-errors |
7596 | (org-heading-components))) "NONE")))) | |
db55f368 CD |
7597 | (if (string-match "::\\'" cpltxt) |
7598 | (setq cpltxt (substring cpltxt 0 -2))) | |
7599 | (setq link (org-make-link cpltxt))))) | |
20908596 CD |
7600 | |
7601 | ((buffer-file-name (buffer-base-buffer)) | |
7602 | ;; Just link to this file here. | |
7603 | (setq cpltxt (concat "file:" | |
7604 | (abbreviate-file-name | |
7605 | (buffer-file-name (buffer-base-buffer))))) | |
7606 | ;; Add a context string | |
7607 | (when (org-xor org-context-in-file-links arg) | |
7608 | (setq txt (if (org-region-active-p) | |
7609 | (buffer-substring (region-beginning) (region-end)) | |
7610 | (buffer-substring (point-at-bol) (point-at-eol)))) | |
7611 | ;; Only use search option if there is some text. | |
7612 | (when (string-match "\\S-" txt) | |
7613 | (setq cpltxt | |
7614 | (concat cpltxt "::" (org-make-org-heading-search-string txt)) | |
7615 | desc "NONE"))) | |
7616 | (setq link (org-make-link cpltxt))) | |
7617 | ||
7618 | ((interactive-p) | |
7619 | (error "Cannot link to a buffer which is not visiting a file")) | |
891f4676 | 7620 | |
20908596 | 7621 | (t (setq link nil))) |
891f4676 | 7622 | |
20908596 CD |
7623 | (if (consp link) (setq cpltxt (car link) link (cdr link))) |
7624 | (setq link (or link cpltxt) | |
7625 | desc (or desc cpltxt)) | |
7626 | (if (equal desc "NONE") (setq desc nil)) | |
ab27a4a0 | 7627 | |
c8d0cf5c | 7628 | (if (and (or (interactive-p) executing-kbd-macro) link) |
20908596 CD |
7629 | (progn |
7630 | (setq org-stored-links | |
7631 | (cons (list link desc) org-stored-links)) | |
c8d0cf5c CD |
7632 | (message "Stored: %s" (or desc link)) |
7633 | (when custom-id | |
7634 | (setq link (concat "file:" (abbreviate-file-name (buffer-file-name)) | |
7635 | "::#" custom-id)) | |
7636 | (setq org-stored-links | |
7637 | (cons (list link desc) org-stored-links)))) | |
20908596 CD |
7638 | (and link (org-make-link-string link desc))))) |
7639 | ||
7640 | (defun org-store-link-props (&rest plist) | |
7641 | "Store link properties, extract names and addresses." | |
7642 | (let (x adr) | |
7643 | (when (setq x (plist-get plist :from)) | |
7644 | (setq adr (mail-extract-address-components x)) | |
93b62de8 CD |
7645 | (setq plist (plist-put plist :fromname (car adr))) |
7646 | (setq plist (plist-put plist :fromaddress (nth 1 adr)))) | |
20908596 CD |
7647 | (when (setq x (plist-get plist :to)) |
7648 | (setq adr (mail-extract-address-components x)) | |
93b62de8 CD |
7649 | (setq plist (plist-put plist :toname (car adr))) |
7650 | (setq plist (plist-put plist :toaddress (nth 1 adr))))) | |
20908596 CD |
7651 | (let ((from (plist-get plist :from)) |
7652 | (to (plist-get plist :to))) | |
7653 | (when (and from to org-from-is-user-regexp) | |
93b62de8 CD |
7654 | (setq plist |
7655 | (plist-put plist :fromto | |
7656 | (if (string-match org-from-is-user-regexp from) | |
7657 | (concat "to %t") | |
7658 | (concat "from %f")))))) | |
20908596 CD |
7659 | (setq org-store-link-plist plist)) |
7660 | ||
7661 | (defun org-add-link-props (&rest plist) | |
7662 | "Add these properties to the link property list." | |
7663 | (let (key value) | |
7664 | (while plist | |
7665 | (setq key (pop plist) value (pop plist)) | |
7666 | (setq org-store-link-plist | |
7667 | (plist-put org-store-link-plist key value))))) | |
7668 | ||
7669 | (defun org-email-link-description (&optional fmt) | |
7670 | "Return the description part of an email link. | |
7671 | This takes information from `org-store-link-plist' and formats it | |
7672 | according to FMT (default from `org-email-link-description-format')." | |
7673 | (setq fmt (or fmt org-email-link-description-format)) | |
7674 | (let* ((p org-store-link-plist) | |
7675 | (to (plist-get p :toaddress)) | |
7676 | (from (plist-get p :fromaddress)) | |
7677 | (table | |
7678 | (list | |
7679 | (cons "%c" (plist-get p :fromto)) | |
7680 | (cons "%F" (plist-get p :from)) | |
7681 | (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) | |
7682 | (cons "%T" (plist-get p :to)) | |
7683 | (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) | |
7684 | (cons "%s" (plist-get p :subject)) | |
7685 | (cons "%m" (plist-get p :message-id))))) | |
7686 | (when (string-match "%c" fmt) | |
7687 | ;; Check if the user wrote this message | |
7688 | (if (and org-from-is-user-regexp from to | |
7689 | (save-match-data (string-match org-from-is-user-regexp from))) | |
7690 | (setq fmt (replace-match "to %t" t t fmt)) | |
7691 | (setq fmt (replace-match "from %f" t t fmt)))) | |
7692 | (org-replace-escapes fmt table))) | |
7693 | ||
7694 | (defun org-make-org-heading-search-string (&optional string heading) | |
7695 | "Make search string for STRING or current headline." | |
7696 | (interactive) | |
7697 | (let ((s (or string (org-get-heading)))) | |
7698 | (unless (and string (not heading)) | |
7699 | ;; We are using a headline, clean up garbage in there. | |
7700 | (if (string-match org-todo-regexp s) | |
7701 | (setq s (replace-match "" t t s))) | |
7702 | (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) | |
7703 | (setq s (replace-match "" t t s))) | |
7704 | (setq s (org-trim s)) | |
7705 | (if (string-match (concat "^\\(" org-quote-string "\\|" | |
7706 | org-comment-string "\\)") s) | |
7707 | (setq s (replace-match "" t t s))) | |
7708 | (while (string-match org-ts-regexp s) | |
7709 | (setq s (replace-match "" t t s)))) | |
7710 | (while (string-match "[^a-zA-Z_0-9 \t]+" s) | |
7711 | (setq s (replace-match " " t t s))) | |
7712 | (or string (setq s (concat "*" s))) ; Add * for headlines | |
7713 | (mapconcat 'identity (org-split-string s "[ \t]+") " "))) | |
891f4676 | 7714 | |
20908596 CD |
7715 | (defun org-make-link (&rest strings) |
7716 | "Concatenate STRINGS." | |
7717 | (apply 'concat strings)) | |
ab27a4a0 | 7718 | |
20908596 CD |
7719 | (defun org-make-link-string (link &optional description) |
7720 | "Make a link with brackets, consisting of LINK and DESCRIPTION." | |
7721 | (unless (string-match "\\S-" link) | |
7722 | (error "Empty link")) | |
5dec9555 CD |
7723 | (when (and description |
7724 | (stringp description) | |
7725 | (not (string-match "\\S-" description))) | |
7726 | (setq description nil)) | |
20908596 CD |
7727 | (when (stringp description) |
7728 | ;; Remove brackets from the description, they are fatal. | |
7729 | (while (string-match "\\[" description) | |
7730 | (setq description (replace-match "{" t t description))) | |
7731 | (while (string-match "\\]" description) | |
7732 | (setq description (replace-match "}" t t description)))) | |
7733 | (when (equal (org-link-escape link) description) | |
7734 | ;; No description needed, it is identical | |
7735 | (setq description nil)) | |
7736 | (when (and (not description) | |
7737 | (not (equal link (org-link-escape link)))) | |
2c3ad40d | 7738 | (setq description (org-extract-attributes link))) |
20908596 CD |
7739 | (concat "[[" (org-link-escape link) "]" |
7740 | (if description (concat "[" description "]") "") | |
7741 | "]")) | |
7742 | ||
7743 | (defconst org-link-escape-chars | |
7744 | '((?\ . "%20") | |
7745 | (?\[ . "%5B") | |
7746 | (?\] . "%5D") | |
7747 | (?\340 . "%E0") ; `a | |
7748 | (?\342 . "%E2") ; ^a | |
7749 | (?\347 . "%E7") ; ,c | |
7750 | (?\350 . "%E8") ; `e | |
7751 | (?\351 . "%E9") ; 'e | |
7752 | (?\352 . "%EA") ; ^e | |
7753 | (?\356 . "%EE") ; ^i | |
7754 | (?\364 . "%F4") ; ^o | |
7755 | (?\371 . "%F9") ; `u | |
7756 | (?\373 . "%FB") ; ^u | |
7757 | (?\; . "%3B") | |
7758 | (?? . "%3F") | |
7759 | (?= . "%3D") | |
7760 | (?+ . "%2B") | |
7761 | ) | |
7762 | "Association list of escapes for some characters problematic in links. | |
7763 | This is the list that is used for internal purposes.") | |
7764 | ||
c8d0cf5c CD |
7765 | (defvar org-url-encoding-use-url-hexify nil) |
7766 | ||
20908596 CD |
7767 | (defconst org-link-escape-chars-browser |
7768 | '((?\ . "%20")) ; 32 for the SPC char | |
7769 | "Association list of escapes for some characters problematic in links. | |
7770 | This is the list that is used before handing over to the browser.") | |
7771 | ||
7772 | (defun org-link-escape (text &optional table) | |
d60b1ba1 | 7773 | "Escape characters in TEXT that are problematic for links." |
c8d0cf5c CD |
7774 | (if org-url-encoding-use-url-hexify |
7775 | (url-hexify-string text) | |
7776 | (setq table (or table org-link-escape-chars)) | |
7777 | (when text | |
7778 | (let ((re (mapconcat (lambda (x) (regexp-quote | |
7779 | (char-to-string (car x)))) | |
7780 | table "\\|"))) | |
7781 | (while (string-match re text) | |
7782 | (setq text | |
7783 | (replace-match | |
7784 | (cdr (assoc (string-to-char (match-string 0 text)) | |
7785 | table)) | |
20908596 | 7786 | t t text))) |
c8d0cf5c | 7787 | text)))) |
20908596 CD |
7788 | |
7789 | (defun org-link-unescape (text &optional table) | |
7790 | "Reverse the action of `org-link-escape'." | |
c8d0cf5c CD |
7791 | (if org-url-encoding-use-url-hexify |
7792 | (url-unhex-string text) | |
7793 | (setq table (or table org-link-escape-chars)) | |
7794 | (when text | |
7795 | (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) | |
7796 | table "\\|"))) | |
7797 | (while (string-match re text) | |
7798 | (setq text | |
7799 | (replace-match | |
7800 | (char-to-string (car (rassoc (match-string 0 text) table))) | |
7801 | t t text))) | |
7802 | text)))) | |
20908596 CD |
7803 | |
7804 | (defun org-xor (a b) | |
7805 | "Exclusive or." | |
7806 | (if a (not b) b)) | |
7807 | ||
20908596 CD |
7808 | (defun org-fixup-message-id-for-http (s) |
7809 | "Replace special characters in a message id, so it can be used in an http query." | |
7810 | (while (string-match "<" s) | |
7811 | (setq s (replace-match "%3C" t t s))) | |
7812 | (while (string-match ">" s) | |
7813 | (setq s (replace-match "%3E" t t s))) | |
7814 | (while (string-match "@" s) | |
7815 | (setq s (replace-match "%40" t t s))) | |
7816 | s) | |
7817 | ||
7818 | ;;;###autoload | |
7819 | (defun org-insert-link-global () | |
7820 | "Insert a link like Org-mode does. | |
7821 | This command can be called in any mode to insert a link in Org-mode syntax." | |
7822 | (interactive) | |
7823 | (org-load-modules-maybe) | |
7824 | (org-run-like-in-org-mode 'org-insert-link)) | |
7825 | ||
7826 | (defun org-insert-link (&optional complete-file link-location) | |
7827 | "Insert a link. At the prompt, enter the link. | |
7828 | ||
93b62de8 CD |
7829 | Completion can be used to insert any of the link protocol prefixes like |
7830 | http or ftp in use. | |
7831 | ||
7832 | The history can be used to select a link previously stored with | |
20908596 CD |
7833 | `org-store-link'. When the empty string is entered (i.e. if you just |
7834 | press RET at the prompt), the link defaults to the most recently | |
7835 | stored link. As SPC triggers completion in the minibuffer, you need to | |
7836 | use M-SPC or C-q SPC to force the insertion of a space character. | |
7837 | ||
7838 | You will also be prompted for a description, and if one is given, it will | |
7839 | be displayed in the buffer instead of the link. | |
7840 | ||
7841 | If there is already a link at point, this command will allow you to edit link | |
7842 | and description parts. | |
7843 | ||
7844 | With a \\[universal-argument] prefix, prompts for a file to link to. The file name can | |
7845 | be selected using completion. The path to the file will be relative to the | |
7846 | current directory if the file is in the current directory or a subdirectory. | |
7847 | Otherwise, the link will be the absolute path as completed in the minibuffer | |
93b62de8 CD |
7848 | \(i.e. normally ~/path/to/file). You can configure this behavior using the |
7849 | option `org-link-file-path-type'. | |
20908596 CD |
7850 | |
7851 | With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in | |
93b62de8 CD |
7852 | the current directory or below. |
7853 | ||
7854 | With three \\[universal-argument] prefixes, negate the meaning of | |
7855 | `org-keep-stored-link-after-insertion'. | |
20908596 CD |
7856 | |
7857 | If `org-make-link-description-function' is non-nil, this function will be | |
7858 | called with the link target, and the result will be the default | |
7859 | link description. | |
7860 | ||
7861 | If the LINK-LOCATION parameter is non-nil, this value will be | |
7862 | used as the link location instead of reading one interactively." | |
7863 | (interactive "P") | |
7864 | (let* ((wcf (current-window-configuration)) | |
7865 | (region (if (org-region-active-p) | |
7866 | (buffer-substring (region-beginning) (region-end)))) | |
7867 | (remove (and region (list (region-beginning) (region-end)))) | |
7868 | (desc region) | |
7869 | tmphist ; byte-compile incorrectly complains about this | |
7870 | (link link-location) | |
c8d0cf5c | 7871 | entry file all-prefixes) |
20908596 CD |
7872 | (cond |
7873 | (link-location) ; specified by arg, just use it. | |
7874 | ((org-in-regexp org-bracket-link-regexp 1) | |
7875 | ;; We do have a link at point, and we are going to edit it. | |
7876 | (setq remove (list (match-beginning 0) (match-end 0))) | |
7877 | (setq desc (if (match-end 3) (org-match-string-no-properties 3))) | |
7878 | (setq link (read-string "Link: " | |
7879 | (org-link-unescape | |
7880 | (org-match-string-no-properties 1))))) | |
7881 | ((or (org-in-regexp org-angle-link-re) | |
7882 | (org-in-regexp org-plain-link-re)) | |
7883 | ;; Convert to bracket link | |
7884 | (setq remove (list (match-beginning 0) (match-end 0)) | |
7885 | link (read-string "Link: " | |
7886 | (org-remove-angle-brackets (match-string 0))))) | |
93b62de8 | 7887 | ((member complete-file '((4) (16))) |
20908596 | 7888 | ;; Completing read for file names. |
c8d0cf5c | 7889 | (setq link (org-file-complete-link complete-file))) |
20908596 CD |
7890 | (t |
7891 | ;; Read link, with completion for stored links. | |
7892 | (with-output-to-temp-buffer "*Org Links*" | |
c8d0cf5c CD |
7893 | (princ "Insert a link. |
7894 | Use TAB to complete link prefixes, then RET for type-specific completion support\n") | |
20908596 CD |
7895 | (when org-stored-links |
7896 | (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") | |
7897 | (princ (mapconcat | |
7898 | (lambda (x) | |
7899 | (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x))) | |
7900 | (reverse org-stored-links) "\n")))) | |
7901 | (let ((cw (selected-window))) | |
7902 | (select-window (get-buffer-window "*Org Links*")) | |
20908596 | 7903 | (setq truncate-lines t) |
c8d0cf5c CD |
7904 | (unless (pos-visible-in-window-p (point-max)) |
7905 | (org-fit-window-to-buffer)) | |
7906 | (and (window-live-p cw) (select-window cw))) | |
20908596 CD |
7907 | ;; Fake a link history, containing the stored links. |
7908 | (setq tmphist (append (mapcar 'car org-stored-links) | |
7909 | org-insert-link-history)) | |
c8d0cf5c CD |
7910 | (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local) |
7911 | (mapcar 'car org-link-abbrev-alist) | |
7912 | org-link-types)) | |
20908596 | 7913 | (unwind-protect |
c8d0cf5c CD |
7914 | (progn |
7915 | (setq link | |
54a0dee5 CD |
7916 | (let ((org-completion-use-ido nil) |
7917 | (org-completion-use-iswitchb nil)) | |
c8d0cf5c CD |
7918 | (org-completing-read |
7919 | "Link: " | |
7920 | (append | |
7921 | (mapcar (lambda (x) (list (concat x ":"))) | |
7922 | all-prefixes) | |
7923 | (mapcar 'car org-stored-links)) | |
7924 | nil nil nil | |
7925 | 'tmphist | |
7926 | (car (car org-stored-links))))) | |
7927 | (if (or (member link all-prefixes) | |
7928 | (and (equal ":" (substring link -1)) | |
7929 | (member (substring link 0 -1) all-prefixes) | |
7930 | (setq link (substring link 0 -1)))) | |
7931 | (setq link (org-link-try-special-completion link)))) | |
20908596 CD |
7932 | (set-window-configuration wcf) |
7933 | (kill-buffer "*Org Links*")) | |
7934 | (setq entry (assoc link org-stored-links)) | |
7935 | (or entry (push link org-insert-link-history)) | |
7936 | (if (funcall (if (equal complete-file '(64)) 'not 'identity) | |
7937 | (not org-keep-stored-link-after-insertion)) | |
7938 | (setq org-stored-links (delq (assoc link org-stored-links) | |
7939 | org-stored-links))) | |
7940 | (setq desc (or desc (nth 1 entry))))) | |
7941 | ||
7942 | (if (string-match org-plain-link-re link) | |
7943 | ;; URL-like link, normalize the use of angular brackets. | |
7944 | (setq link (org-make-link (org-remove-angle-brackets link)))) | |
891f4676 | 7945 | |
20908596 CD |
7946 | ;; Check if we are linking to the current file with a search option |
7947 | ;; If yes, simplify the link by using only the search option. | |
7948 | (when (and buffer-file-name | |
ce4fdcb9 | 7949 | (string-match "^file:\\(.+?\\)::\\([^>]+\\)" link)) |
20908596 CD |
7950 | (let* ((path (match-string 1 link)) |
7951 | (case-fold-search nil) | |
7952 | (search (match-string 2 link))) | |
7953 | (save-match-data | |
7954 | (if (equal (file-truename buffer-file-name) (file-truename path)) | |
7955 | ;; We are linking to this same file, with a search option | |
7956 | (setq link search))))) | |
38f8646b | 7957 | |
20908596 | 7958 | ;; Check if we can/should use a relative path. If yes, simplify the link |
ce4fdcb9 | 7959 | (when (string-match "^file:\\(.*\\)" link) |
20908596 CD |
7960 | (let* ((path (match-string 1 link)) |
7961 | (origpath path) | |
7962 | (case-fold-search nil)) | |
7963 | (cond | |
93b62de8 CD |
7964 | ((or (eq org-link-file-path-type 'absolute) |
7965 | (equal complete-file '(16))) | |
20908596 CD |
7966 | (setq path (abbreviate-file-name (expand-file-name path)))) |
7967 | ((eq org-link-file-path-type 'noabbrev) | |
7968 | (setq path (expand-file-name path))) | |
7969 | ((eq org-link-file-path-type 'relative) | |
7970 | (setq path (file-relative-name path))) | |
7971 | (t | |
7972 | (save-match-data | |
7973 | (if (string-match (concat "^" (regexp-quote | |
7974 | (file-name-as-directory | |
7975 | (expand-file-name ".")))) | |
7976 | (expand-file-name path)) | |
7977 | ;; We are linking a file with relative path name. | |
7978 | (setq path (substring (expand-file-name path) | |
93b62de8 CD |
7979 | (match-end 0))) |
7980 | (setq path (abbreviate-file-name (expand-file-name path))))))) | |
20908596 CD |
7981 | (setq link (concat "file:" path)) |
7982 | (if (equal desc origpath) | |
7983 | (setq desc path)))) | |
38f8646b | 7984 | |
20908596 CD |
7985 | (if org-make-link-description-function |
7986 | (setq desc (funcall org-make-link-description-function link desc))) | |
38f8646b | 7987 | |
20908596 CD |
7988 | (setq desc (read-string "Description: " desc)) |
7989 | (unless (string-match "\\S-" desc) (setq desc nil)) | |
7990 | (if remove (apply 'delete-region remove)) | |
7991 | (insert (org-make-link-string link desc)))) | |
38f8646b | 7992 | |
c8d0cf5c CD |
7993 | (defun org-link-try-special-completion (type) |
7994 | "If there is completion support for link type TYPE, offer it." | |
7995 | (let ((fun (intern (concat "org-" type "-complete-link")))) | |
7996 | (if (functionp fun) | |
7997 | (funcall fun) | |
7998 | (read-string "Link (no completion support): " (concat type ":"))))) | |
7999 | ||
8000 | (defun org-file-complete-link (&optional arg) | |
8001 | "Create a file link using completion." | |
8002 | (let (file link) | |
8003 | (setq file (read-file-name "File: ")) | |
8004 | (let ((pwd (file-name-as-directory (expand-file-name "."))) | |
8005 | (pwd1 (file-name-as-directory (abbreviate-file-name | |
8006 | (expand-file-name "."))))) | |
8007 | (cond | |
8008 | ((equal arg '(16)) | |
8009 | (setq link (org-make-link | |
8010 | "file:" | |
8011 | (abbreviate-file-name (expand-file-name file))))) | |
8012 | ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) | |
8013 | (setq link (org-make-link "file:" (match-string 1 file)))) | |
8014 | ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") | |
8015 | (expand-file-name file)) | |
8016 | (setq link (org-make-link | |
8017 | "file:" (match-string 1 (expand-file-name file))))) | |
8018 | (t (setq link (org-make-link "file:" file))))) | |
8019 | link)) | |
8020 | ||
20908596 | 8021 | (defun org-completing-read (&rest args) |
93b62de8 | 8022 | "Completing-read with SPACE being a normal character." |
20908596 CD |
8023 | (let ((minibuffer-local-completion-map |
8024 | (copy-keymap minibuffer-local-completion-map))) | |
8025 | (org-defkey minibuffer-local-completion-map " " 'self-insert-command) | |
0bd48b37 | 8026 | (org-defkey minibuffer-local-completion-map "?" 'self-insert-command) |
54a0dee5 | 8027 | (apply 'org-icompleting-read args))) |
ce4fdcb9 | 8028 | |
54a0dee5 CD |
8029 | (defun org-completing-read-no-i (&rest args) |
8030 | (let (org-completion-use-ido org-completion-use-iswitchb) | |
9148fdd0 CD |
8031 | (apply 'org-completing-read args))) |
8032 | ||
54a0dee5 CD |
8033 | (defun org-iswitchb-completing-read (prompt choices &rest args) |
8034 | "Use iswitch as a completing-read replacement to choose from choices. | |
8035 | PROMPT is a string to prompt with. CHOICES is a list of strings to choose | |
8036 | from." | |
8d642074 CD |
8037 | (let* ((iswitchb-use-virtual-buffers nil) |
8038 | (iswitchb-make-buflist-hook | |
8039 | (lambda () | |
8040 | (setq iswitchb-temp-buflist choices)))) | |
54a0dee5 CD |
8041 | (iswitchb-read-buffer prompt))) |
8042 | ||
8043 | (defun org-icompleting-read (&rest args) | |
8bfe682a CD |
8044 | "Completing-read using `ido-mode' or `iswitchb' speedups if available." |
8045 | (org-without-partial-completion | |
8046 | (if (and org-completion-use-ido | |
8047 | (fboundp 'ido-completing-read) | |
8048 | (boundp 'ido-mode) ido-mode | |
8049 | (listp (second args))) | |
8050 | (let ((ido-enter-matching-directory nil)) | |
8051 | (apply 'ido-completing-read (concat (car args)) | |
8052 | (if (consp (car (nth 1 args))) | |
8053 | (mapcar (lambda (x) (car x)) (nth 1 args)) | |
8054 | (nth 1 args)) | |
8055 | (cddr args))) | |
8056 | (if (and org-completion-use-iswitchb | |
8057 | (boundp 'iswitchb-mode) iswitchb-mode | |
8058 | (listp (second args))) | |
8059 | (apply 'org-iswitchb-completing-read (concat (car args)) | |
8060 | (if (consp (car (nth 1 args))) | |
8061 | (mapcar (lambda (x) (car x)) (nth 1 args)) | |
8062 | (nth 1 args)) | |
8063 | (cddr args)) | |
8064 | (apply 'completing-read args))))) | |
38f8646b | 8065 | |
2c3ad40d CD |
8066 | (defun org-extract-attributes (s) |
8067 | "Extract the attributes cookie from a string and set as text property." | |
621f83e4 | 8068 | (let (a attr (start 0) key value) |
2c3ad40d CD |
8069 | (save-match-data |
8070 | (when (string-match "{{\\([^}]+\\)}}$" s) | |
8071 | (setq a (match-string 1 s) s (substring s 0 (match-beginning 0))) | |
8072 | (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start) | |
8073 | (setq key (match-string 1 a) value (match-string 2 a) | |
8074 | start (match-end 0) | |
8075 | attr (plist-put attr (intern key) value)))) | |
db55f368 | 8076 | (org-add-props s nil 'org-attr attr)) |
2c3ad40d CD |
8077 | s)) |
8078 | ||
c8d0cf5c CD |
8079 | (defun org-extract-attributes-from-string (tag) |
8080 | (let (key value attr) | |
8081 | (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag) | |
8082 | (setq key (match-string 1 tag) value (match-string 2 tag) | |
8083 | tag (replace-match "" t t tag) | |
8084 | attr (plist-put attr (intern key) value))) | |
8085 | (cons tag attr))) | |
8086 | ||
2c3ad40d CD |
8087 | (defun org-attributes-to-string (plist) |
8088 | "Format a property list into an HTML attribute list." | |
8089 | (let ((s "") key value) | |
8090 | (while plist | |
8091 | (setq key (pop plist) value (pop plist)) | |
db55f368 CD |
8092 | (and value |
8093 | (setq s (concat s " " (symbol-name key) "=\"" value "\"")))) | |
2c3ad40d CD |
8094 | s)) |
8095 | ||
20908596 | 8096 | ;;; Opening/following a link |
03f3cf35 | 8097 | |
20908596 | 8098 | (defvar org-link-search-failed nil) |
38f8646b | 8099 | |
20908596 CD |
8100 | (defun org-next-link () |
8101 | "Move forward to the next link. | |
8102 | If the link is in hidden text, expose it." | |
8103 | (interactive) | |
8104 | (when (and org-link-search-failed (eq this-command last-command)) | |
8105 | (goto-char (point-min)) | |
8106 | (message "Link search wrapped back to beginning of buffer")) | |
8107 | (setq org-link-search-failed nil) | |
8108 | (let* ((pos (point)) | |
8109 | (ct (org-context)) | |
8110 | (a (assoc :link ct))) | |
8111 | (if a (goto-char (nth 2 a))) | |
8112 | (if (re-search-forward org-any-link-re nil t) | |
8113 | (progn | |
8114 | (goto-char (match-beginning 0)) | |
8115 | (if (org-invisible-p) (org-show-context))) | |
8116 | (goto-char pos) | |
8117 | (setq org-link-search-failed t) | |
8118 | (error "No further link found")))) | |
38f8646b | 8119 | |
20908596 CD |
8120 | (defun org-previous-link () |
8121 | "Move backward to the previous link. | |
8122 | If the link is in hidden text, expose it." | |
7d58338e | 8123 | (interactive) |
20908596 CD |
8124 | (when (and org-link-search-failed (eq this-command last-command)) |
8125 | (goto-char (point-max)) | |
8126 | (message "Link search wrapped back to end of buffer")) | |
8127 | (setq org-link-search-failed nil) | |
8128 | (let* ((pos (point)) | |
8129 | (ct (org-context)) | |
8130 | (a (assoc :link ct))) | |
8131 | (if a (goto-char (nth 1 a))) | |
8132 | (if (re-search-backward org-any-link-re nil t) | |
8133 | (progn | |
8134 | (goto-char (match-beginning 0)) | |
8135 | (if (org-invisible-p) (org-show-context))) | |
8136 | (goto-char pos) | |
8137 | (setq org-link-search-failed t) | |
8138 | (error "No further link found")))) | |
7d58338e | 8139 | |
ce4fdcb9 CD |
8140 | (defun org-translate-link (s) |
8141 | "Translate a link string if a translation function has been defined." | |
8142 | (if (and org-link-translation-function | |
8143 | (fboundp org-link-translation-function) | |
8144 | (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s)) | |
8145 | (progn | |
8146 | (setq s (funcall org-link-translation-function | |
8147 | (match-string 1) (match-string 2))) | |
8148 | (concat (car s) ":" (cdr s))) | |
8149 | s)) | |
8150 | ||
8151 | (defun org-translate-link-from-planner (type path) | |
8152 | "Translate a link from Emacs Planner syntax so that Org can follow it. | |
8153 | This is still an experimental function, your mileage may vary." | |
8154 | (cond | |
8155 | ((member type '("http" "https" "news" "ftp")) | |
8156 | ;; standard Internet links are the same. | |
8157 | nil) | |
8158 | ((and (equal type "irc") (string-match "^//" path)) | |
8159 | ;; Planner has two / at the beginning of an irc link, we have 1. | |
8160 | ;; We should have zero, actually.... | |
8161 | (setq path (substring path 1))) | |
8162 | ((and (equal type "lisp") (string-match "^/" path)) | |
8163 | ;; Planner has a slash, we do not. | |
8164 | (setq type "elisp" path (substring path 1))) | |
8165 | ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) | |
8bfe682a | 8166 | ;; A typical message link. Planner has the id after the final slash, |
ce4fdcb9 CD |
8167 | ;; we separate it with a hash mark |
8168 | (setq path (concat (match-string 1 path) "#" | |
8169 | (org-remove-angle-brackets (match-string 2 path))))) | |
8170 | ) | |
8171 | (cons type path)) | |
8172 | ||
20908596 CD |
8173 | (defun org-find-file-at-mouse (ev) |
8174 | "Open file link or URL at mouse." | |
8175 | (interactive "e") | |
8176 | (mouse-set-point ev) | |
8177 | (org-open-at-point 'in-emacs)) | |
7d58338e | 8178 | |
20908596 CD |
8179 | (defun org-open-at-mouse (ev) |
8180 | "Open file link or URL at mouse." | |
8181 | (interactive "e") | |
8182 | (mouse-set-point ev) | |
ce4fdcb9 CD |
8183 | (if (eq major-mode 'org-agenda-mode) |
8184 | (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) | |
20908596 | 8185 | (org-open-at-point)) |
38f8646b | 8186 | |
20908596 CD |
8187 | (defvar org-window-config-before-follow-link nil |
8188 | "The window configuration before following a link. | |
8189 | This is saved in case the need arises to restore it.") | |
38f8646b | 8190 | |
20908596 CD |
8191 | (defvar org-open-link-marker (make-marker) |
8192 | "Marker pointing to the location where `org-open-at-point; was called.") | |
8193 | ||
8194 | ;;;###autoload | |
8195 | (defun org-open-at-point-global () | |
8196 | "Follow a link like Org-mode does. | |
8197 | This command can be called in any mode to follow a link that has | |
8198 | Org-mode syntax." | |
8199 | (interactive) | |
8200 | (org-run-like-in-org-mode 'org-open-at-point)) | |
8201 | ||
8202 | ;;;###autoload | |
54a0dee5 | 8203 | (defun org-open-link-from-string (s &optional arg reference-buffer) |
20908596 CD |
8204 | "Open a link in the string S, as if it was in Org-mode." |
8205 | (interactive "sLink: \nP") | |
54a0dee5 | 8206 | (let ((reference-buffer (or reference-buffer (current-buffer)))) |
c8d0cf5c CD |
8207 | (with-temp-buffer |
8208 | (let ((org-inhibit-startup t)) | |
8209 | (org-mode) | |
8210 | (insert s) | |
8211 | (goto-char (point-min)) | |
8212 | (org-open-at-point arg reference-buffer))))) | |
20908596 | 8213 | |
c8d0cf5c | 8214 | (defun org-open-at-point (&optional in-emacs reference-buffer) |
20908596 CD |
8215 | "Open link at or after point. |
8216 | If there is no link at point, this function will search forward up to | |
c8d0cf5c | 8217 | the end of the current line. |
20908596 | 8218 | Normally, files will be opened by an appropriate application. If the |
93b62de8 CD |
8219 | optional argument IN-EMACS is non-nil, Emacs will visit the file. |
8220 | With a double prefix argument, try to open outside of Emacs, in the | |
8221 | application the system uses for this file type." | |
20908596 CD |
8222 | (interactive "P") |
8223 | (org-load-modules-maybe) | |
8224 | (move-marker org-open-link-marker (point)) | |
8225 | (setq org-window-config-before-follow-link (current-window-configuration)) | |
8226 | (org-remove-occur-highlights nil nil t) | |
0bd48b37 | 8227 | (cond |
54a0dee5 CD |
8228 | ((and (org-on-heading-p) |
8229 | (not (org-in-regexp | |
f924a367 | 8230 | (concat org-plain-link-re "\\|" |
54a0dee5 CD |
8231 | org-bracket-link-regexp "\\|" |
8232 | org-angle-link-re "\\|" | |
8233 | "[ \t]:[^ \t\n]+:[ \t]*$")))) | |
8bfe682a CD |
8234 | (or (org-offer-links-in-entry in-emacs) |
8235 | (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) | |
0bd48b37 CD |
8236 | ((org-at-timestamp-p t) (org-follow-timestamp-link)) |
8237 | ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) | |
8238 | (org-footnote-action)) | |
c8d0cf5c | 8239 | (t |
20908596 CD |
8240 | (let (type path link line search (pos (point))) |
8241 | (catch 'match | |
8242 | (save-excursion | |
8243 | (skip-chars-forward "^]\n\r") | |
8244 | (when (org-in-regexp org-bracket-link-regexp) | |
2c3ad40d CD |
8245 | (setq link (org-extract-attributes |
8246 | (org-link-unescape (org-match-string-no-properties 1)))) | |
20908596 CD |
8247 | (while (string-match " *\n *" link) |
8248 | (setq link (replace-match " " t t link))) | |
8249 | (setq link (org-link-expand-abbrev link)) | |
2c3ad40d CD |
8250 | (cond |
8251 | ((or (file-name-absolute-p link) | |
8252 | (string-match "^\\.\\.?/" link)) | |
8253 | (setq type "file" path link)) | |
ce4fdcb9 | 8254 | ((string-match org-link-re-with-space3 link) |
2c3ad40d CD |
8255 | (setq type (match-string 1 link) path (match-string 2 link))) |
8256 | (t (setq type "thisfile" path link))) | |
20908596 | 8257 | (throw 'match t))) |
8c6fb58b | 8258 | |
20908596 CD |
8259 | (when (get-text-property (point) 'org-linked-text) |
8260 | (setq type "thisfile" | |
8261 | pos (if (get-text-property (1+ (point)) 'org-linked-text) | |
8262 | (1+ (point)) (point)) | |
8263 | path (buffer-substring | |
8264 | (previous-single-property-change pos 'org-linked-text) | |
8265 | (next-single-property-change pos 'org-linked-text))) | |
8266 | (throw 'match t)) | |
8c6fb58b | 8267 | |
20908596 CD |
8268 | (save-excursion |
8269 | (when (or (org-in-regexp org-angle-link-re) | |
8270 | (org-in-regexp org-plain-link-re)) | |
8271 | (setq type (match-string 1) path (match-string 2)) | |
8272 | (throw 'match t))) | |
20908596 CD |
8273 | (save-excursion |
8274 | (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) | |
8275 | (setq type "tags" | |
8276 | path (match-string 1)) | |
8277 | (while (string-match ":" path) | |
8278 | (setq path (replace-match "+" t t path))) | |
c8d0cf5c CD |
8279 | (throw 'match t))) |
8280 | (when (org-in-regexp "<\\([^><\n]+\\)>") | |
8281 | (setq type "tree-match" | |
8282 | path (match-string 1)) | |
8283 | (throw 'match t))) | |
20908596 CD |
8284 | (unless path |
8285 | (error "No link found")) | |
c8d0cf5c CD |
8286 | |
8287 | ;; switch back to reference buffer | |
8288 | ;; needed when if called in a temporary buffer through | |
8289 | ;; org-open-link-from-string | |
54a0dee5 CD |
8290 | (with-current-buffer (or reference-buffer (current-buffer)) |
8291 | ||
8292 | ;; Remove any trailing spaces in path | |
8293 | (if (string-match " +\\'" path) | |
8294 | (setq path (replace-match "" t t path))) | |
8295 | (if (and org-link-translation-function | |
8296 | (fboundp org-link-translation-function)) | |
8297 | ;; Check if we need to translate the link | |
8298 | (let ((tmp (funcall org-link-translation-function type path))) | |
8299 | (setq type (car tmp) path (cdr tmp)))) | |
f924a367 | 8300 | |
54a0dee5 | 8301 | (cond |
f924a367 | 8302 | |
54a0dee5 CD |
8303 | ((assoc type org-link-protocols) |
8304 | (funcall (nth 1 (assoc type org-link-protocols)) path)) | |
f924a367 | 8305 | |
54a0dee5 CD |
8306 | ((equal type "mailto") |
8307 | (let ((cmd (car org-link-mailto-program)) | |
8308 | (args (cdr org-link-mailto-program)) args1 | |
8309 | (address path) (subject "") a) | |
8310 | (if (string-match "\\(.*\\)::\\(.*\\)" path) | |
8311 | (setq address (match-string 1 path) | |
8312 | subject (org-link-escape (match-string 2 path)))) | |
8313 | (while args | |
8314 | (cond | |
8315 | ((not (stringp (car args))) (push (pop args) args1)) | |
8316 | (t (setq a (pop args)) | |
8317 | (if (string-match "%a" a) | |
8318 | (setq a (replace-match address t t a))) | |
8319 | (if (string-match "%s" a) | |
8320 | (setq a (replace-match subject t t a))) | |
8321 | (push a args1)))) | |
8322 | (apply cmd (nreverse args1)))) | |
f924a367 | 8323 | |
54a0dee5 CD |
8324 | ((member type '("http" "https" "ftp" "news")) |
8325 | (browse-url (concat type ":" (org-link-escape | |
8326 | path org-link-escape-chars-browser)))) | |
f924a367 | 8327 | |
54a0dee5 CD |
8328 | ((member type '("message")) |
8329 | (browse-url (concat type ":" path))) | |
f924a367 | 8330 | |
54a0dee5 CD |
8331 | ((string= type "tags") |
8332 | (org-tags-view in-emacs path)) | |
8333 | ((string= type "thisfile") | |
8334 | (if in-emacs | |
8335 | (switch-to-buffer-other-window | |
8336 | (org-get-buffer-for-internal-link (current-buffer))) | |
8337 | (org-mark-ring-push)) | |
8338 | (let ((cmd `(org-link-search | |
8339 | ,path | |
8340 | ,(cond ((equal in-emacs '(4)) 'occur) | |
8341 | ((equal in-emacs '(16)) 'org-occur) | |
8342 | (t nil)) | |
8343 | ,pos))) | |
8344 | (condition-case nil (eval cmd) | |
8345 | (error (progn (widen) (eval cmd)))))) | |
f924a367 | 8346 | |
54a0dee5 CD |
8347 | ((string= type "tree-match") |
8348 | (org-occur (concat "\\[" (regexp-quote path) "\\]"))) | |
f924a367 | 8349 | |
54a0dee5 CD |
8350 | ((string= type "file") |
8351 | (if (string-match "::\\([0-9]+\\)\\'" path) | |
8352 | (setq line (string-to-number (match-string 1 path)) | |
8353 | path (substring path 0 (match-beginning 0))) | |
8354 | (if (string-match "::\\(.+\\)\\'" path) | |
8355 | (setq search (match-string 1 path) | |
8356 | path (substring path 0 (match-beginning 0))))) | |
8357 | (if (string-match "[*?{]" (file-name-nondirectory path)) | |
8358 | (dired path) | |
8359 | (org-open-file path in-emacs line search))) | |
f924a367 | 8360 | |
54a0dee5 CD |
8361 | ((string= type "news") |
8362 | (require 'org-gnus) | |
8363 | (org-gnus-follow-link path)) | |
f924a367 | 8364 | |
54a0dee5 CD |
8365 | ((string= type "shell") |
8366 | (let ((cmd path)) | |
8367 | (if (or (not org-confirm-shell-link-function) | |
8368 | (funcall org-confirm-shell-link-function | |
8369 | (format "Execute \"%s\" in shell? " | |
8370 | (org-add-props cmd nil | |
8371 | 'face 'org-warning)))) | |
8372 | (progn | |
8373 | (message "Executing %s" cmd) | |
8374 | (shell-command cmd)) | |
8375 | (error "Abort")))) | |
f924a367 | 8376 | |
54a0dee5 CD |
8377 | ((string= type "elisp") |
8378 | (let ((cmd path)) | |
8379 | (if (or (not org-confirm-elisp-link-function) | |
8380 | (funcall org-confirm-elisp-link-function | |
8381 | (format "Execute \"%s\" as elisp? " | |
8382 | (org-add-props cmd nil | |
8383 | 'face 'org-warning)))) | |
8384 | (message "%s => %s" cmd | |
8385 | (if (equal (string-to-char cmd) ?\() | |
8386 | (eval (read cmd)) | |
8387 | (call-interactively (read cmd)))) | |
8388 | (error "Abort")))) | |
f924a367 | 8389 | |
54a0dee5 | 8390 | (t |
8d642074 CD |
8391 | (browse-url-at-point))))))) |
8392 | (move-marker org-open-link-marker nil) | |
8393 | (run-hook-with-args 'org-follow-link-hook)) | |
54a0dee5 | 8394 | |
8d642074 | 8395 | (defun org-offer-links-in-entry (&optional nth zero) |
8bfe682a | 8396 | "Offer links in the current entry and follow the selected link. |
54a0dee5 | 8397 | If there is only one link, follow it immediately as well. |
8d642074 CD |
8398 | If NTH is an integer, immediately pick the NTH link found. |
8399 | If ZERO is a string, check also this string for a link, and if | |
8400 | there is one, offer it as link number zero." | |
54a0dee5 CD |
8401 | (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|" |
8402 | "\\(" org-angle-link-re "\\)\\|" | |
8403 | "\\(" org-plain-link-re "\\)")) | |
8404 | (cnt ?0) | |
8405 | (in-emacs (if (integerp nth) nil nth)) | |
8d642074 CD |
8406 | have-zero end links link c) |
8407 | (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) | |
8408 | (push (match-string 0 zero) links) | |
8409 | (setq cnt (1- cnt) have-zero t)) | |
54a0dee5 CD |
8410 | (save-excursion |
8411 | (org-back-to-heading t) | |
8412 | (setq end (save-excursion (outline-next-heading) (point))) | |
8413 | (while (re-search-forward re end t) | |
8414 | (push (match-string 0) links)) | |
8415 | (setq links (org-uniquify (reverse links)))) | |
03f3cf35 | 8416 | |
54a0dee5 | 8417 | (cond |
8bfe682a CD |
8418 | ((null links) |
8419 | (message "No links")) | |
54a0dee5 CD |
8420 | ((equal (length links) 1) |
8421 | (setq link (car links))) | |
8d642074 CD |
8422 | ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) |
8423 | (setq link (nth (if have-zero nth (1- nth)) links))) | |
54a0dee5 CD |
8424 | (t ; we have to select a link |
8425 | (save-excursion | |
8426 | (save-window-excursion | |
8427 | (delete-other-windows) | |
8428 | (with-output-to-temp-buffer "*Select Link*" | |
54a0dee5 CD |
8429 | (mapc (lambda (l) |
8430 | (if (not (string-match org-bracket-link-regexp l)) | |
8431 | (princ (format "[%c] %s\n" (incf cnt) | |
8432 | (org-remove-angle-brackets l))) | |
8433 | (if (match-end 3) | |
8434 | (princ (format "[%c] %s (%s)\n" (incf cnt) | |
8435 | (match-string 3 l) (match-string 1 l))) | |
8436 | (princ (format "[%c] %s\n" (incf cnt) | |
8437 | (match-string 1 l)))))) | |
8438 | links)) | |
8439 | (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) | |
8440 | (message "Select link to open:") | |
8441 | (setq c (read-char-exclusive)) | |
8442 | (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) | |
8443 | (when (equal c ?q) (error "Abort")) | |
8444 | (setq nth (- c ?0)) | |
8d642074 | 8445 | (if have-zero (setq nth (1+ nth))) |
54a0dee5 CD |
8446 | (unless (and (integerp nth) (>= (length links) nth)) |
8447 | (error "Invalid link selection")) | |
8448 | (setq link (nth (1- nth) links)))) | |
8bfe682a CD |
8449 | (if link |
8450 | (progn (org-open-link-from-string link in-emacs (current-buffer)) t) | |
8451 | nil))) | |
fbe6c10d | 8452 | |
20908596 | 8453 | ;;;; Time estimates |
fbe6c10d | 8454 | |
20908596 CD |
8455 | (defun org-get-effort (&optional pom) |
8456 | "Get the effort estimate for the current entry." | |
8457 | (org-entry-get pom org-effort-property)) | |
2a57416f | 8458 | |
20908596 | 8459 | ;;; File search |
38f8646b | 8460 | |
20908596 CD |
8461 | (defvar org-create-file-search-functions nil |
8462 | "List of functions to construct the right search string for a file link. | |
8463 | These functions are called in turn with point at the location to | |
8464 | which the link should point. | |
03f3cf35 | 8465 | |
20908596 CD |
8466 | A function in the hook should first test if it would like to |
8467 | handle this file type, for example by checking the major-mode or | |
8468 | the file extension. If it decides not to handle this file, it | |
8469 | should just return nil to give other functions a chance. If it | |
8470 | does handle the file, it must return the search string to be used | |
8471 | when following the link. The search string will be part of the | |
8472 | file link, given after a double colon, and `org-open-at-point' | |
8473 | will automatically search for it. If special measures must be | |
8474 | taken to make the search successful, another function should be | |
8475 | added to the companion hook `org-execute-file-search-functions', | |
8476 | which see. | |
7d58338e | 8477 | |
20908596 CD |
8478 | A function in this hook may also use `setq' to set the variable |
8479 | `description' to provide a suggestion for the descriptive text to | |
8480 | be used for this link when it gets inserted into an Org-mode | |
8481 | buffer with \\[org-insert-link].") | |
8482 | ||
8483 | (defvar org-execute-file-search-functions nil | |
8484 | "List of functions to execute a file search triggered by a link. | |
8485 | ||
8486 | Functions added to this hook must accept a single argument, the | |
8487 | search string that was part of the file link, the part after the | |
8488 | double colon. The function must first check if it would like to | |
8489 | handle this search, for example by checking the major-mode or the | |
8490 | file extension. If it decides not to handle this search, it | |
8491 | should just return nil to give other functions a chance. If it | |
8492 | does handle the search, it must return a non-nil value to keep | |
8493 | other functions from trying. | |
8494 | ||
8495 | Each function can access the current prefix argument through the | |
8496 | variable `current-prefix-argument'. Note that a single prefix is | |
8497 | used to force opening a link in Emacs, so it may be good to only | |
8498 | use a numeric or double prefix to guide the search function. | |
8499 | ||
8500 | In case this is needed, a function in this hook can also restore | |
8501 | the window configuration before `org-open-at-point' was called using: | |
8502 | ||
8503 | (set-window-configuration org-window-config-before-follow-link)") | |
8504 | ||
8505 | (defun org-link-search (s &optional type avoid-pos) | |
8506 | "Search for a link search option. | |
8507 | If S is surrounded by forward slashes, it is interpreted as a | |
8508 | regular expression. In org-mode files, this will create an `org-occur' | |
8509 | sparse tree. In ordinary files, `occur' will be used to list matches. | |
8510 | If the current buffer is in `dired-mode', grep will be used to search | |
8511 | in all files. If AVOID-POS is given, ignore matches near that position." | |
8512 | (let ((case-fold-search t) | |
8513 | (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) | |
8514 | (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) | |
8515 | (append '(("") (" ") ("\t") ("\n")) | |
8516 | org-emphasis-alist) | |
8517 | "\\|") "\\)")) | |
8518 | (pos (point)) | |
8519 | (pre nil) (post nil) | |
8520 | words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall) | |
8521 | (cond | |
8522 | ;; First check if there are any special | |
8523 | ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) | |
8524 | ;; Now try the builtin stuff | |
c8d0cf5c CD |
8525 | ((and (equal (string-to-char s0) ?#) |
8526 | (> (length s0) 1) | |
8527 | (save-excursion | |
8528 | (goto-char (point-min)) | |
8529 | (and | |
8530 | (re-search-forward | |
8531 | (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t) | |
8532 | (setq type 'dedicated | |
8533 | pos (match-beginning 0)))) | |
8534 | ;; There is an exact target for this | |
8535 | (goto-char pos) | |
8536 | (org-back-to-heading t))) | |
20908596 CD |
8537 | ((save-excursion |
8538 | (goto-char (point-min)) | |
8539 | (and | |
8540 | (re-search-forward | |
8541 | (concat "<<" (regexp-quote s0) ">>") nil t) | |
8542 | (setq type 'dedicated | |
8543 | pos (match-beginning 0)))) | |
8544 | ;; There is an exact target for this | |
8545 | (goto-char pos)) | |
0bd48b37 CD |
8546 | ((and (string-match "^(\\(.*\\))$" s0) |
8547 | (save-excursion | |
8548 | (goto-char (point-min)) | |
8549 | (and | |
8550 | (re-search-forward | |
8551 | (concat "[^[]" (regexp-quote | |
8552 | (format org-coderef-label-format | |
8553 | (match-string 1 s0)))) | |
8554 | nil t) | |
8555 | (setq type 'dedicated | |
8556 | pos (1+ (match-beginning 0)))))) | |
8557 | ;; There is a coderef target for this | |
8558 | (goto-char pos)) | |
20908596 CD |
8559 | ((string-match "^/\\(.*\\)/$" s) |
8560 | ;; A regular expression | |
8561 | (cond | |
8562 | ((org-mode-p) | |
8563 | (org-occur (match-string 1 s))) | |
8564 | ;;((eq major-mode 'dired-mode) | |
8565 | ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *"))) | |
8566 | (t (org-do-occur (match-string 1 s))))) | |
8567 | (t | |
8568 | ;; A normal search strings | |
8569 | (when (equal (string-to-char s) ?*) | |
8570 | ;; Anchor on headlines, post may include tags. | |
8571 | (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" | |
8572 | post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") | |
8573 | s (substring s 1))) | |
8574 | (remove-text-properties | |
8575 | 0 (length s) | |
8576 | '(face nil mouse-face nil keymap nil fontified nil) s) | |
8577 | ;; Make a series of regular expressions to find a match | |
8578 | (setq words (org-split-string s "[ \n\r\t]+") | |
8579 | ||
8580 | re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") | |
8581 | re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") | |
8582 | "\\)" markers) | |
8583 | re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") | |
8584 | re2a (concat "[ \t\r\n]" re2a_) | |
8585 | re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") | |
8586 | re4 (concat "[^a-zA-Z_]" re4_) | |
8587 | ||
8588 | re1 (concat pre re2 post) | |
8589 | re3 (concat pre (if pre re4_ re4) post) | |
8590 | re5 (concat pre ".*" re4) | |
8591 | re2 (concat pre re2) | |
8592 | re2a (concat pre (if pre re2a_ re2a)) | |
8593 | re4 (concat pre (if pre re4_ re4)) | |
8594 | reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 | |
8595 | "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" | |
8596 | re5 "\\)" | |
8597 | )) | |
8598 | (cond | |
8599 | ((eq type 'org-occur) (org-occur reall)) | |
8600 | ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) | |
8601 | (t (goto-char (point-min)) | |
8602 | (setq type 'fuzzy) | |
8603 | (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated)) | |
8604 | (org-search-not-self 1 re1 nil t) | |
8605 | (org-search-not-self 1 re2 nil t) | |
8606 | (org-search-not-self 1 re2a nil t) | |
8607 | (org-search-not-self 1 re3 nil t) | |
8608 | (org-search-not-self 1 re4 nil t) | |
8609 | (org-search-not-self 1 re5 nil t) | |
8610 | ) | |
8611 | (goto-char (match-beginning 1)) | |
8612 | (goto-char pos) | |
8613 | (error "No match"))))) | |
8614 | (t | |
8615 | ;; Normal string-search | |
8616 | (goto-char (point-min)) | |
8617 | (if (search-forward s nil t) | |
8618 | (goto-char (match-beginning 0)) | |
8619 | (error "No match")))) | |
8620 | (and (org-mode-p) (org-show-context 'link-search)) | |
8621 | type)) | |
8622 | ||
8623 | (defun org-search-not-self (group &rest args) | |
8624 | "Execute `re-search-forward', but only accept matches that do not | |
8625 | enclose the position of `org-open-link-marker'." | |
8626 | (let ((m org-open-link-marker)) | |
8627 | (catch 'exit | |
8628 | (while (apply 're-search-forward args) | |
8629 | (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 | |
8630 | (goto-char (match-end group)) | |
8631 | (if (and (or (not (eq (marker-buffer m) (current-buffer))) | |
8632 | (> (match-beginning 0) (marker-position m)) | |
8633 | (< (match-end 0) (marker-position m))) | |
8634 | (save-match-data | |
8635 | (or (not (org-in-regexp | |
8636 | org-bracket-link-analytic-regexp 1)) | |
8637 | (not (match-end 4)) ; no description | |
8638 | (and (<= (match-beginning 4) (point)) | |
8639 | (>= (match-end 4) (point)))))) | |
8640 | (throw 'exit (point)))))))) | |
7d58338e | 8641 | |
20908596 CD |
8642 | (defun org-get-buffer-for-internal-link (buffer) |
8643 | "Return a buffer to be used for displaying the link target of internal links." | |
8644 | (cond | |
8645 | ((not org-display-internal-link-with-indirect-buffer) | |
8646 | buffer) | |
8647 | ((string-match "(Clone)$" (buffer-name buffer)) | |
8648 | (message "Buffer is already a clone, not making another one") | |
8649 | ;; we also do not modify visibility in this case | |
8650 | buffer) | |
8651 | (t ; make a new indirect buffer for displaying the link | |
8652 | (let* ((bn (buffer-name buffer)) | |
8653 | (ibn (concat bn "(Clone)")) | |
8654 | (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone)))) | |
8655 | (with-current-buffer ib (org-overview)) | |
8656 | ib)))) | |
7d58338e | 8657 | |
20908596 CD |
8658 | (defun org-do-occur (regexp &optional cleanup) |
8659 | "Call the Emacs command `occur'. | |
8660 | If CLEANUP is non-nil, remove the printout of the regular expression | |
8661 | in the *Occur* buffer. This is useful if the regex is long and not useful | |
8662 | to read." | |
8663 | (occur regexp) | |
8664 | (when cleanup | |
8665 | (let ((cwin (selected-window)) win beg end) | |
8666 | (when (setq win (get-buffer-window "*Occur*")) | |
8667 | (select-window win)) | |
7d58338e | 8668 | (goto-char (point-min)) |
20908596 CD |
8669 | (when (re-search-forward "match[a-z]+" nil t) |
8670 | (setq beg (match-end 0)) | |
8671 | (if (re-search-forward "^[ \t]*[0-9]+" nil t) | |
8672 | (setq end (1- (match-beginning 0))))) | |
8673 | (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) | |
8674 | (goto-char (point-min)) | |
8675 | (select-window cwin)))) | |
7d58338e | 8676 | |
20908596 | 8677 | ;;; The mark ring for links jumps |
48aaad2d | 8678 | |
20908596 CD |
8679 | (defvar org-mark-ring nil |
8680 | "Mark ring for positions before jumps in Org-mode.") | |
8681 | (defvar org-mark-ring-last-goto nil | |
8682 | "Last position in the mark ring used to go back.") | |
8683 | ;; Fill and close the ring | |
8684 | (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded | |
8685 | (loop for i from 1 to org-mark-ring-length do | |
8686 | (push (make-marker) org-mark-ring)) | |
8687 | (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) | |
8688 | org-mark-ring) | |
8689 | ||
8690 | (defun org-mark-ring-push (&optional pos buffer) | |
8691 | "Put the current position or POS into the mark ring and rotate it." | |
48aaad2d | 8692 | (interactive) |
20908596 CD |
8693 | (setq pos (or pos (point))) |
8694 | (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring)) | |
8695 | (move-marker (car org-mark-ring) | |
8696 | (or pos (point)) | |
8697 | (or buffer (current-buffer))) | |
8698 | (message "%s" | |
8699 | (substitute-command-keys | |
8700 | "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) | |
48aaad2d | 8701 | |
20908596 CD |
8702 | (defun org-mark-ring-goto (&optional n) |
8703 | "Jump to the previous position in the mark ring. | |
8704 | With prefix arg N, jump back that many stored positions. When | |
8705 | called several times in succession, walk through the entire ring. | |
8706 | Org-mode commands jumping to a different position in the current file, | |
8707 | or to another Org-mode file, automatically push the old position | |
8708 | onto the ring." | |
8709 | (interactive "p") | |
8710 | (let (p m) | |
8711 | (if (eq last-command this-command) | |
8712 | (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring))) | |
8713 | (setq p org-mark-ring)) | |
8714 | (setq org-mark-ring-last-goto p) | |
8715 | (setq m (car p)) | |
8716 | (switch-to-buffer (marker-buffer m)) | |
8717 | (goto-char m) | |
8718 | (if (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) | |
fbe6c10d | 8719 | |
20908596 CD |
8720 | (defun org-remove-angle-brackets (s) |
8721 | (if (equal (substring s 0 1) "<") (setq s (substring s 1))) | |
8722 | (if (equal (substring s -1) ">") (setq s (substring s 0 -1))) | |
8723 | s) | |
8724 | (defun org-add-angle-brackets (s) | |
8725 | (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s))) | |
8726 | (if (equal (substring s -1) ">") nil (setq s (concat s ">"))) | |
8727 | s) | |
b349f79f CD |
8728 | (defun org-remove-double-quotes (s) |
8729 | (if (equal (substring s 0 1) "\"") (setq s (substring s 1))) | |
8730 | (if (equal (substring s -1) "\"") (setq s (substring s 0 -1))) | |
8731 | s) | |
7d58338e | 8732 | |
20908596 | 8733 | ;;; Following specific links |
48aaad2d | 8734 | |
20908596 CD |
8735 | (defun org-follow-timestamp-link () |
8736 | (cond | |
8737 | ((org-at-date-range-p t) | |
8738 | (let ((org-agenda-start-on-weekday) | |
8739 | (t1 (match-string 1)) | |
8740 | (t2 (match-string 2))) | |
8741 | (setq t1 (time-to-days (org-time-string-to-time t1)) | |
8742 | t2 (time-to-days (org-time-string-to-time t2))) | |
8743 | (org-agenda-list nil t1 (1+ (- t2 t1))))) | |
8744 | ((org-at-timestamp-p t) | |
8745 | (org-agenda-list nil (time-to-days (org-time-string-to-time | |
8746 | (substring (match-string 1) 0 10))) | |
8747 | 1)) | |
8748 | (t (error "This should not happen")))) | |
48aaad2d | 8749 | |
03f3cf35 | 8750 | |
20908596 CD |
8751 | ;;; Following file links |
8752 | (defvar org-wait nil) | |
8753 | (defun org-open-file (path &optional in-emacs line search) | |
8754 | "Open the file at PATH. | |
8755 | First, this expands any special file name abbreviations. Then the | |
8756 | configuration variable `org-file-apps' is checked if it contains an | |
8757 | entry for this file type, and if yes, the corresponding command is launched. | |
93b62de8 | 8758 | |
20908596 | 8759 | If no application is found, Emacs simply visits the file. |
93b62de8 CD |
8760 | |
8761 | With optional prefix argument IN-EMACS, Emacs will visit the file. | |
8762 | With a double C-c C-u prefix arg, Org tries to avoid opening in Emacs | |
8763 | and o use an external application to visit the file. | |
8764 | ||
20908596 CD |
8765 | Optional LINE specifies a line to go to, optional SEARCH a string to |
8766 | search for. If LINE or SEARCH is given, the file will always be | |
8767 | opened in Emacs. | |
8768 | If the file does not exist, an error is thrown." | |
8769 | (setq in-emacs (or in-emacs line search)) | |
8770 | (let* ((file (if (equal path "") | |
8771 | buffer-file-name | |
8772 | (substitute-in-file-name (expand-file-name path)))) | |
8773 | (apps (append org-file-apps (org-default-apps))) | |
8774 | (remp (and (assq 'remote apps) (org-file-remote-p file))) | |
8775 | (dirp (if remp nil (file-directory-p file))) | |
2c3ad40d CD |
8776 | (file (if (and dirp org-open-directory-means-index-dot-org) |
8777 | (concat (file-name-as-directory file) "index.org") | |
8778 | file)) | |
621f83e4 | 8779 | (a-m-a-p (assq 'auto-mode apps)) |
20908596 CD |
8780 | (dfile (downcase file)) |
8781 | (old-buffer (current-buffer)) | |
8782 | (old-pos (point)) | |
8783 | (old-mode major-mode) | |
8784 | ext cmd) | |
8785 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) | |
8786 | (setq ext (match-string 1 dfile)) | |
8787 | (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) | |
8788 | (setq ext (match-string 1 dfile)))) | |
93b62de8 CD |
8789 | (cond |
8790 | ((equal in-emacs '(16)) | |
8791 | (setq cmd (cdr (assoc 'system apps)))) | |
8792 | (in-emacs (setq cmd 'emacs)) | |
8793 | (t | |
20908596 CD |
8794 | (setq cmd (or (and remp (cdr (assoc 'remote apps))) |
8795 | (and dirp (cdr (assoc 'directory apps))) | |
621f83e4 CD |
8796 | (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) |
8797 | 'string-match) | |
20908596 | 8798 | (cdr (assoc ext apps)) |
93b62de8 CD |
8799 | (cdr (assoc t apps)))))) |
8800 | (when (eq cmd 'system) | |
8801 | (setq cmd (cdr (assoc 'system apps)))) | |
621f83e4 CD |
8802 | (when (eq cmd 'default) |
8803 | (setq cmd (cdr (assoc t apps)))) | |
20908596 CD |
8804 | (when (eq cmd 'mailcap) |
8805 | (require 'mailcap) | |
8806 | (mailcap-parse-mailcaps) | |
8807 | (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) | |
8808 | (command (mailcap-mime-info mime-type))) | |
8809 | (if (stringp command) | |
8810 | (setq cmd command) | |
8811 | (setq cmd 'emacs)))) | |
8812 | (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files | |
8813 | (not (file-exists-p file)) | |
8814 | (not org-open-non-existing-files)) | |
8815 | (error "No such file: %s" file)) | |
8816 | (cond | |
8817 | ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) | |
8818 | ;; Remove quotes around the file name - we'll use shell-quote-argument. | |
8819 | (while (string-match "['\"]%s['\"]" cmd) | |
8820 | (setq cmd (replace-match "%s" t t cmd))) | |
8821 | (while (string-match "%s" cmd) | |
8822 | (setq cmd (replace-match | |
b349f79f CD |
8823 | (save-match-data |
8824 | (shell-quote-argument | |
8825 | (convert-standard-filename file))) | |
20908596 CD |
8826 | t t cmd))) |
8827 | (save-window-excursion | |
8828 | (start-process-shell-command cmd nil cmd) | |
8829 | (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) | |
8830 | )) | |
8831 | ((or (stringp cmd) | |
8832 | (eq cmd 'emacs)) | |
8833 | (funcall (cdr (assq 'file org-link-frame-setup)) file) | |
8834 | (widen) | |
54a0dee5 | 8835 | (if line (org-goto-line line) |
20908596 CD |
8836 | (if search (org-link-search search)))) |
8837 | ((consp cmd) | |
b349f79f CD |
8838 | (let ((file (convert-standard-filename file))) |
8839 | (eval cmd))) | |
20908596 CD |
8840 | (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) |
8841 | (and (org-mode-p) (eq old-mode 'org-mode) | |
8842 | (or (not (equal old-buffer (current-buffer))) | |
8843 | (not (equal old-pos (point)))) | |
8844 | (org-mark-ring-push old-pos old-buffer)))) | |
38f8646b | 8845 | |
20908596 CD |
8846 | (defun org-default-apps () |
8847 | "Return the default applications for this operating system." | |
8848 | (cond | |
8849 | ((eq system-type 'darwin) | |
8850 | org-file-apps-defaults-macosx) | |
8851 | ((eq system-type 'windows-nt) | |
8852 | org-file-apps-defaults-windowsnt) | |
8853 | (t org-file-apps-defaults-gnu))) | |
38f8646b | 8854 | |
621f83e4 CD |
8855 | (defun org-apps-regexp-alist (list &optional add-auto-mode) |
8856 | "Convert extensions to regular expressions in the cars of LIST. | |
8857 | Also, weed out any non-string entries, because the return value is used | |
8858 | only for regexp matching. | |
8859 | When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist' | |
8860 | point to the symbol `emacs', indicating that the file should | |
8861 | be opened in Emacs." | |
8862 | (append | |
8863 | (delq nil | |
8864 | (mapcar (lambda (x) | |
8865 | (if (not (stringp (car x))) | |
8866 | nil | |
8867 | (if (string-match "\\W" (car x)) | |
8868 | x | |
8869 | (cons (concat "\\." (car x) "\\'") (cdr x))))) | |
8870 | list)) | |
8871 | (if add-auto-mode | |
8872 | (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) | |
8873 | ||
20908596 CD |
8874 | (defvar ange-ftp-name-format) ; to silence the XEmacs compiler. |
8875 | (defun org-file-remote-p (file) | |
8876 | "Test whether FILE specifies a location on a remote system. | |
8877 | Return non-nil if the location is indeed remote. | |
38f8646b | 8878 | |
20908596 CD |
8879 | For example, the filename \"/user@host:/foo\" specifies a location |
8880 | on the system \"/user@host:\"." | |
8881 | (cond ((fboundp 'file-remote-p) | |
8882 | (file-remote-p file)) | |
8883 | ((fboundp 'tramp-handle-file-remote-p) | |
8884 | (tramp-handle-file-remote-p file)) | |
8885 | ((and (boundp 'ange-ftp-name-format) | |
8886 | (string-match (car ange-ftp-name-format) file)) | |
8887 | t) | |
8888 | (t nil))) | |
03f3cf35 | 8889 | |
03f3cf35 | 8890 | |
20908596 | 8891 | ;;;; Refiling |
7d58338e | 8892 | |
20908596 CD |
8893 | (defun org-get-org-file () |
8894 | "Read a filename, with default directory `org-directory'." | |
8895 | (let ((default (or org-default-notes-file remember-data-file))) | |
8896 | (read-file-name (format "File name [%s]: " default) | |
8897 | (file-name-as-directory org-directory) | |
8898 | default))) | |
7d58338e | 8899 | |
20908596 CD |
8900 | (defun org-notes-order-reversed-p () |
8901 | "Check if the current file should receive notes in reversed order." | |
7d58338e | 8902 | (cond |
20908596 CD |
8903 | ((not org-reverse-note-order) nil) |
8904 | ((eq t org-reverse-note-order) t) | |
8905 | ((not (listp org-reverse-note-order)) nil) | |
8906 | (t (catch 'exit | |
8907 | (let ((all org-reverse-note-order) | |
8908 | entry) | |
8909 | (while (setq entry (pop all)) | |
8910 | (if (string-match (car entry) buffer-file-name) | |
8911 | (throw 'exit (cdr entry)))) | |
8912 | nil))))) | |
38f8646b | 8913 | |
20908596 CD |
8914 | (defvar org-refile-target-table nil |
8915 | "The list of refile targets, created by `org-refile'.") | |
fbe6c10d | 8916 | |
20908596 CD |
8917 | (defvar org-agenda-new-buffers nil |
8918 | "Buffers created to visit agenda files.") | |
03f3cf35 | 8919 | |
20908596 CD |
8920 | (defun org-get-refile-targets (&optional default-buffer) |
8921 | "Produce a table with refile targets." | |
c8d0cf5c CD |
8922 | (let ((case-fold-search nil) |
8923 | ;; otherwise org confuses "TODO" as a kw and "Todo" as a word | |
8924 | (entries (or org-refile-targets '((nil . (:level . 1))))) | |
8925 | targets txt re files f desc descre fast-path-p level pos0) | |
db55f368 | 8926 | (message "Getting targets...") |
20908596 CD |
8927 | (with-current-buffer (or default-buffer (current-buffer)) |
8928 | (while (setq entry (pop entries)) | |
8929 | (setq files (car entry) desc (cdr entry)) | |
db55f368 | 8930 | (setq fast-path-p nil) |
20908596 CD |
8931 | (cond |
8932 | ((null files) (setq files (list (current-buffer)))) | |
8933 | ((eq files 'org-agenda-files) | |
8934 | (setq files (org-agenda-files 'unrestricted))) | |
8935 | ((and (symbolp files) (fboundp files)) | |
8936 | (setq files (funcall files))) | |
8937 | ((and (symbolp files) (boundp files)) | |
8938 | (setq files (symbol-value files)))) | |
8939 | (if (stringp files) (setq files (list files))) | |
8940 | (cond | |
8941 | ((eq (car desc) :tag) | |
8942 | (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) | |
8943 | ((eq (car desc) :todo) | |
8944 | (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) | |
8945 | ((eq (car desc) :regexp) | |
8946 | (setq descre (cdr desc))) | |
8947 | ((eq (car desc) :level) | |
8948 | (setq descre (concat "^\\*\\{" (number-to-string | |
8949 | (if org-odd-levels-only | |
8950 | (1- (* 2 (cdr desc))) | |
8951 | (cdr desc))) | |
8952 | "\\}[ \t]"))) | |
8953 | ((eq (car desc) :maxlevel) | |
db55f368 | 8954 | (setq fast-path-p t) |
20908596 CD |
8955 | (setq descre (concat "^\\*\\{1," (number-to-string |
8956 | (if org-odd-levels-only | |
8957 | (1- (* 2 (cdr desc))) | |
8958 | (cdr desc))) | |
8959 | "\\}[ \t]"))) | |
8960 | (t (error "Bad refiling target description %s" desc))) | |
8961 | (while (setq f (pop files)) | |
81ad75af | 8962 | (with-current-buffer |
8bfe682a | 8963 | (if (bufferp f) f (org-get-agenda-file-buffer f)) |
20908596 | 8964 | (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) |
fdf730ed | 8965 | (setq f (expand-file-name f)) |
c8d0cf5c CD |
8966 | (if (eq org-refile-use-outline-path 'file) |
8967 | (push (list (file-name-nondirectory f) f nil nil) targets)) | |
20908596 CD |
8968 | (save-excursion |
8969 | (save-restriction | |
8970 | (widen) | |
8971 | (goto-char (point-min)) | |
8972 | (while (re-search-forward descre nil t) | |
c8d0cf5c CD |
8973 | (goto-char (setq pos0 (point-at-bol))) |
8974 | (catch 'next | |
8975 | (when org-refile-target-verify-function | |
8976 | (save-match-data | |
8977 | (or (funcall org-refile-target-verify-function) | |
8978 | (throw 'next t)))) | |
8979 | (when (looking-at org-complex-heading-regexp) | |
8980 | (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) | |
8981 | txt (org-link-display-format (match-string 4)) | |
8982 | re (concat "^" (regexp-quote | |
8983 | (buffer-substring (match-beginning 1) | |
8984 | (match-end 4))))) | |
8985 | (if (match-end 5) (setq re (concat re "[ \t]+" | |
8986 | (regexp-quote | |
8987 | (match-string 5))))) | |
8988 | (setq re (concat re "[ \t]*$")) | |
8989 | (when org-refile-use-outline-path | |
8990 | (setq txt (mapconcat 'org-protect-slash | |
8991 | (append | |
8992 | (if (eq org-refile-use-outline-path 'file) | |
8993 | (list (file-name-nondirectory | |
8994 | (buffer-file-name (buffer-base-buffer)))) | |
8995 | (if (eq org-refile-use-outline-path 'full-file-path) | |
8996 | (list (buffer-file-name (buffer-base-buffer))))) | |
8997 | (org-get-outline-path fast-path-p level txt) | |
8998 | (list txt)) | |
8999 | "/"))) | |
9000 | (push (list txt f re (point)) targets))) | |
9001 | (when (= (point) pos0) | |
9002 | ;; verification function has not moved point | |
9003 | (goto-char (point-at-eol)))))))))) | |
db55f368 | 9004 | (message "Getting targets...done") |
c8d0cf5c | 9005 | (nreverse targets))) |
20908596 | 9006 | |
621f83e4 CD |
9007 | (defun org-protect-slash (s) |
9008 | (while (string-match "/" s) | |
9009 | (setq s (replace-match "\\" t t s))) | |
9010 | s) | |
ce4fdcb9 | 9011 | |
db55f368 CD |
9012 | (defvar org-olpa (make-vector 20 nil)) |
9013 | ||
9014 | (defun org-get-outline-path (&optional fastp level heading) | |
1bcdebed CD |
9015 | "Return the outline path to the current entry, as a list. |
9016 | The parameters FASTP, LEVEL, and HEADING are for use be a scanner | |
9017 | routine which makes outline path derivations for an entire file, | |
9018 | avoiding backtracing." | |
db55f368 CD |
9019 | (if fastp |
9020 | (progn | |
33306645 | 9021 | (if (> level 19) |
db4a7382 | 9022 | (error "Outline path failure, more than 19 levels")) |
db55f368 CD |
9023 | (loop for i from level upto 19 do |
9024 | (aset org-olpa i nil)) | |
9025 | (prog1 | |
9026 | (delq nil (append org-olpa nil)) | |
9027 | (aset org-olpa level heading))) | |
9028 | (let (rtn) | |
9029 | (save-excursion | |
5dec9555 CD |
9030 | (save-restriction |
9031 | (widen) | |
9032 | (while (org-up-heading-safe) | |
9033 | (when (looking-at org-complex-heading-regexp) | |
9034 | (push (org-match-string-no-properties 4) rtn))) | |
9035 | rtn))))) | |
7d58338e | 9036 | |
1bcdebed CD |
9037 | (defun org-format-outline-path (path &optional width prefix) |
9038 | "Format the outlie path PATH for display. | |
9039 | Width is the maximum number of characters that is available. | |
9040 | Prefix is a prefix to be included in the returned string, | |
9041 | such as the file name." | |
9042 | (setq width (or width 79)) | |
9043 | (if prefix (setq width (- width (length prefix)))) | |
9044 | (if (not path) | |
9045 | (or prefix "") | |
9046 | (let* ((nsteps (length path)) | |
9047 | (total-width (+ nsteps (apply '+ (mapcar 'length path)))) | |
9048 | (maxwidth (if (<= total-width width) | |
9049 | 10000 ;; everything fits | |
9050 | ;; we need to shorten the level headings | |
9051 | (/ (- width nsteps) nsteps))) | |
9052 | (org-odd-levels-only nil) | |
9053 | (n 0) | |
9054 | (total (1+ (length prefix)))) | |
9055 | (setq maxwidth (max maxwidth 10)) | |
9056 | (concat prefix | |
9057 | (mapconcat | |
9058 | (lambda (h) | |
9059 | (setq n (1+ n)) | |
9060 | (if (and (= n nsteps) (< maxwidth 10000)) | |
9061 | (setq maxwidth (- total-width total))) | |
9062 | (if (< (length h) maxwidth) | |
9063 | (progn (setq total (+ total (length h) 1)) h) | |
9064 | (setq h (substring h 0 (- maxwidth 2)) | |
9065 | total (+ total maxwidth 1)) | |
9066 | (if (string-match "[ \t]+\\'" h) | |
9067 | (setq h (substring h 0 (match-beginning 0)))) | |
9068 | (setq h (concat h ".."))) | |
9069 | (org-add-props h nil 'face | |
9070 | (nth (% (1- n) org-n-level-faces) | |
9071 | org-level-faces)) | |
9072 | h) | |
9073 | path "/"))))) | |
9074 | ||
9075 | (defun org-display-outline-path (&optional file current) | |
9076 | "Display the current outline path in the echo area." | |
9077 | (interactive "P") | |
9078 | (let ((bfn (buffer-file-name (buffer-base-buffer))) | |
9079 | (path (and (org-mode-p) (org-get-outline-path)))) | |
9080 | (if current (setq path (append path | |
9081 | (save-excursion | |
9082 | (org-back-to-heading t) | |
9083 | (if (looking-at org-complex-heading-regexp) | |
9084 | (list (match-string 4))))))) | |
5dec9555 CD |
9085 | (message "%s" |
9086 | (org-format-outline-path | |
1bcdebed CD |
9087 | path |
9088 | (1- (frame-width)) | |
9089 | (and file bfn (concat (file-name-nondirectory bfn) "/")))))) | |
9090 | ||
20908596 CD |
9091 | (defvar org-refile-history nil |
9092 | "History for refiling operations.") | |
7d58338e | 9093 | |
c8d0cf5c CD |
9094 | (defvar org-after-refile-insert-hook nil |
9095 | "Hook run after `org-refile' has inserted its stuff at the new location. | |
9096 | Note that this is still *before* the stuff will be removed from | |
9097 | the *old* location.") | |
9098 | ||
9099 | (defun org-refile (&optional goto default-buffer rfloc) | |
20908596 CD |
9100 | "Move the entry at point to another heading. |
9101 | The list of target headings is compiled using the information in | |
9102 | `org-refile-targets', which see. This list is created before each use | |
9103 | and will therefore always be up-to-date. | |
9104 | ||
9105 | At the target location, the entry is filed as a subitem of the target heading. | |
9106 | Depending on `org-reverse-note-order', the new subitem will either be the | |
71d35b24 | 9107 | first or the last subitem. |
20908596 | 9108 | |
93b62de8 CD |
9109 | If there is an active region, all entries in that region will be moved. |
9110 | However, the region must fulfil the requirement that the first heading | |
9111 | is the first one sets the top-level of the moved text - at most siblings | |
9112 | below it are allowed. | |
9113 | ||
20908596 CD |
9114 | With prefix arg GOTO, the command will only visit the target location, |
9115 | not actually move anything. | |
621f83e4 | 9116 | With a double prefix `C-u C-u', go to the location where the last refiling |
c8d0cf5c | 9117 | operation has put the subtree. |
8bfe682a | 9118 | With a prefix argument of `2', refile to the running clock. |
c8d0cf5c CD |
9119 | |
9120 | RFLOC can be a refile location obtained in a different way. | |
9121 | ||
9122 | See also `org-refile-use-outline-path' and `org-completion-use-ido'" | |
20908596 CD |
9123 | (interactive "P") |
9124 | (let* ((cbuf (current-buffer)) | |
93b62de8 CD |
9125 | (regionp (org-region-active-p)) |
9126 | (region-start (and regionp (region-beginning))) | |
9127 | (region-end (and regionp (region-end))) | |
9128 | (region-length (and regionp (- region-end region-start))) | |
20908596 CD |
9129 | (filename (buffer-file-name (buffer-base-buffer cbuf))) |
9130 | pos it nbuf file re level reversed) | |
1bcdebed | 9131 | (setq last-command nil) |
c8d0cf5c CD |
9132 | (when regionp |
9133 | (goto-char region-start) | |
9134 | (or (bolp) (goto-char (point-at-bol))) | |
9135 | (setq region-start (point)) | |
9136 | (unless (org-kill-is-subtree-p | |
9137 | (buffer-substring region-start region-end)) | |
9138 | (error "The region is not a (sequence of) subtree(s)"))) | |
20908596 CD |
9139 | (if (equal goto '(16)) |
9140 | (org-refile-goto-last-stored) | |
8bfe682a CD |
9141 | (when (or |
9142 | (and (equal goto 2) | |
9143 | org-clock-hd-marker (marker-buffer org-clock-hd-marker) | |
9144 | (prog1 | |
9145 | (setq it (list (or org-clock-heading "running clock") | |
9146 | (buffer-file-name | |
9147 | (marker-buffer org-clock-hd-marker)) | |
9148 | "" | |
9149 | (marker-position org-clock-hd-marker))) | |
9150 | (setq goto nil))) | |
9151 | (setq it (or rfloc | |
9152 | (save-excursion | |
9153 | (org-refile-get-location | |
9154 | (if goto "Goto: " "Refile to: ") default-buffer | |
9155 | org-refile-allow-creating-parent-nodes))))) | |
20908596 CD |
9156 | (setq file (nth 1 it) |
9157 | re (nth 2 it) | |
9158 | pos (nth 3 it)) | |
c8d0cf5c CD |
9159 | (if (and (not goto) |
9160 | pos | |
9161 | (equal (buffer-file-name) file) | |
db55f368 CD |
9162 | (if regionp |
9163 | (and (>= pos region-start) | |
9164 | (<= pos region-end)) | |
9165 | (and (>= pos (point)) | |
9166 | (< pos (save-excursion | |
9167 | (org-end-of-subtree t t)))))) | |
9168 | (error "Cannot refile to position inside the tree or region")) | |
c8d0cf5c | 9169 | |
20908596 CD |
9170 | (setq nbuf (or (find-buffer-visiting file) |
9171 | (find-file-noselect file))) | |
9172 | (if goto | |
9173 | (progn | |
9174 | (switch-to-buffer nbuf) | |
9175 | (goto-char pos) | |
9176 | (org-show-context 'org-goto)) | |
93b62de8 CD |
9177 | (if regionp |
9178 | (progn | |
c8d0cf5c | 9179 | (org-kill-new (buffer-substring region-start region-end)) |
93b62de8 CD |
9180 | (org-save-markers-in-region region-start region-end)) |
9181 | (org-copy-subtree 1 nil t)) | |
81ad75af | 9182 | (with-current-buffer (setq nbuf (or (find-buffer-visiting file) |
8bfe682a | 9183 | (find-file-noselect file))) |
20908596 CD |
9184 | (setq reversed (org-notes-order-reversed-p)) |
9185 | (save-excursion | |
9186 | (save-restriction | |
9187 | (widen) | |
c8d0cf5c CD |
9188 | (if pos |
9189 | (progn | |
9190 | (goto-char pos) | |
9191 | (looking-at outline-regexp) | |
9192 | (setq level (org-get-valid-level (funcall outline-level) 1)) | |
9193 | (goto-char | |
9194 | (if reversed | |
9195 | (or (outline-next-heading) (point-max)) | |
54a0dee5 | 9196 | (or (save-excursion (org-get-next-sibling)) |
c8d0cf5c CD |
9197 | (org-end-of-subtree t t) |
9198 | (point-max))))) | |
9199 | (setq level 1) | |
9200 | (if (not reversed) | |
9201 | (goto-char (point-max)) | |
9202 | (goto-char (point-min)) | |
9203 | (or (outline-next-heading) (goto-char (point-max))))) | |
621f83e4 | 9204 | (if (not (bolp)) (newline)) |
20908596 | 9205 | (bookmark-set "org-refile-last-stored") |
c8d0cf5c CD |
9206 | (org-paste-subtree level) |
9207 | (if (fboundp 'deactivate-mark) (deactivate-mark)) | |
9208 | (run-hooks 'org-after-refile-insert-hook)))) | |
93b62de8 CD |
9209 | (if regionp |
9210 | (delete-region (point) (+ (point) region-length)) | |
9211 | (org-cut-subtree)) | |
c8d0cf5c CD |
9212 | (when (featurep 'org-inlinetask) |
9213 | (org-inlinetask-remove-END-maybe)) | |
b349f79f | 9214 | (setq org-markers-to-move nil) |
c8d0cf5c CD |
9215 | (message "Refiled to \"%s\"" (car it)))))) |
9216 | (org-reveal)) | |
20908596 CD |
9217 | |
9218 | (defun org-refile-goto-last-stored () | |
9219 | "Go to the location where the last refile was stored." | |
38f8646b | 9220 | (interactive) |
20908596 CD |
9221 | (bookmark-jump "org-refile-last-stored") |
9222 | (message "This is the location of the last refile")) | |
38f8646b | 9223 | |
c8d0cf5c | 9224 | (defun org-refile-get-location (&optional prompt default-buffer new-nodes) |
20908596 CD |
9225 | "Prompt the user for a refile location, using PROMPT." |
9226 | (let ((org-refile-targets org-refile-targets) | |
9227 | (org-refile-use-outline-path org-refile-use-outline-path)) | |
9228 | (setq org-refile-target-table (org-get-refile-targets default-buffer))) | |
9229 | (unless org-refile-target-table | |
9230 | (error "No refile targets")) | |
9231 | (let* ((cbuf (current-buffer)) | |
c8d0cf5c | 9232 | (partial-completion-mode nil) |
bb31cb31 | 9233 | (cfn (buffer-file-name (buffer-base-buffer cbuf))) |
d60b1ba1 CD |
9234 | (cfunc (if (and org-refile-use-outline-path |
9235 | org-outline-path-complete-in-steps) | |
b349f79f | 9236 | 'org-olpath-completing-read |
54a0dee5 | 9237 | 'org-icompleting-read)) |
b349f79f | 9238 | (extra (if org-refile-use-outline-path "/" "")) |
bb31cb31 | 9239 | (filename (and cfn (expand-file-name cfn))) |
20908596 CD |
9240 | (tbl (mapcar |
9241 | (lambda (x) | |
c8d0cf5c CD |
9242 | (if (and (not (member org-refile-use-outline-path |
9243 | '(file full-file-path))) | |
9244 | (not (equal filename (nth 1 x)))) | |
b349f79f CD |
9245 | (cons (concat (car x) extra " (" |
9246 | (file-name-nondirectory (nth 1 x)) ")") | |
20908596 | 9247 | (cdr x)) |
b349f79f | 9248 | (cons (concat (car x) extra) (cdr x)))) |
20908596 | 9249 | org-refile-target-table)) |
c8d0cf5c CD |
9250 | (completion-ignore-case t) |
9251 | pa answ parent-target child parent old-hist) | |
9252 | (setq old-hist org-refile-history) | |
9253 | (setq answ (funcall cfunc prompt tbl nil (not new-nodes) | |
9254 | nil 'org-refile-history)) | |
9255 | (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) | |
f924a367 | 9256 | (if pa |
c8d0cf5c CD |
9257 | (progn |
9258 | (when (or (not org-refile-history) | |
9259 | (not (eq old-hist org-refile-history)) | |
9260 | (not (equal (car pa) (car org-refile-history)))) | |
9261 | (setq org-refile-history | |
9262 | (cons (car pa) (if (assoc (car org-refile-history) tbl) | |
9263 | org-refile-history | |
9264 | (cdr org-refile-history)))) | |
9265 | (if (equal (car org-refile-history) (nth 1 org-refile-history)) | |
9266 | (pop org-refile-history))) | |
9267 | pa) | |
9268 | (when (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) | |
9269 | (setq parent (match-string 1 answ) | |
9270 | child (match-string 2 answ)) | |
9271 | (setq parent-target (or (assoc parent tbl) (assoc (concat parent "/") tbl))) | |
9272 | (when (and parent-target | |
9273 | (or (eq new-nodes t) | |
9274 | (and (eq new-nodes 'confirm) | |
9275 | (y-or-n-p (format "Create new node \"%s\"? " child))))) | |
9276 | (org-refile-new-child parent-target child)))))) | |
9277 | ||
9278 | (defun org-refile-new-child (parent-target child) | |
9279 | "Use refile target PARENT-TARGET to add new CHILD below it." | |
9280 | (unless parent-target | |
9281 | (error "Cannot find parent for new node")) | |
9282 | (let ((file (nth 1 parent-target)) | |
9283 | (pos (nth 3 parent-target)) | |
9284 | level) | |
9285 | (with-current-buffer (or (find-buffer-visiting file) | |
9286 | (find-file-noselect file)) | |
9287 | (save-excursion | |
9288 | (save-restriction | |
9289 | (widen) | |
9290 | (if pos | |
9291 | (goto-char pos) | |
9292 | (goto-char (point-max)) | |
9293 | (if (not (bolp)) (newline))) | |
9294 | (when (looking-at outline-regexp) | |
9295 | (setq level (funcall outline-level)) | |
9296 | (org-end-of-subtree t t)) | |
9297 | (org-back-over-empty-lines) | |
9298 | (insert "\n" (make-string | |
9299 | (if pos (org-get-valid-level level 1) 1) ?*) | |
9300 | " " child "\n") | |
9301 | (beginning-of-line 0) | |
9302 | (list (concat (car parent-target) "/" child) file "" (point))))))) | |
7d58338e | 9303 | |
b349f79f CD |
9304 | (defun org-olpath-completing-read (prompt collection &rest args) |
9305 | "Read an outline path like a file name." | |
c8d0cf5c | 9306 | (let ((thetable collection) |
54a0dee5 | 9307 | (org-completion-use-ido nil) ; does not work with ido. |
f924a367 | 9308 | (org-completion-use-iswitchb nil)) ; or iswitchb |
ce4fdcb9 | 9309 | (apply |
54a0dee5 | 9310 | 'org-icompleting-read prompt |
b349f79f | 9311 | (lambda (string predicate &optional flag) |
65c439fd | 9312 | (let (rtn r f (l (length string))) |
b349f79f CD |
9313 | (cond |
9314 | ((eq flag nil) | |
9315 | ;; try completion | |
9316 | (try-completion string thetable)) | |
9317 | ((eq flag t) | |
9318 | ;; all-completions | |
9319 | (setq rtn (all-completions string thetable predicate)) | |
9320 | (mapcar | |
9321 | (lambda (x) | |
9322 | (setq r (substring x l)) | |
9323 | (if (string-match " ([^)]*)$" x) | |
9324 | (setq f (match-string 0 x)) | |
9325 | (setq f "")) | |
9326 | (if (string-match "/" r) | |
9327 | (concat string (substring r 0 (match-end 0)) f) | |
9328 | x)) | |
9329 | rtn)) | |
9330 | ((eq flag 'lambda) | |
9331 | ;; exact match? | |
9332 | (assoc string thetable))) | |
9333 | )) | |
9334 | args))) | |
9335 | ||
20908596 CD |
9336 | ;;;; Dynamic blocks |
9337 | ||
9338 | (defun org-find-dblock (name) | |
9339 | "Find the first dynamic block with name NAME in the buffer. | |
9340 | If not found, stay at current position and return nil." | |
9341 | (let (pos) | |
7d58338e | 9342 | (save-excursion |
03f3cf35 | 9343 | (goto-char (point-min)) |
20908596 CD |
9344 | (setq pos (and (re-search-forward (concat "^#\\+BEGIN:[ \t]+" name "\\>") |
9345 | nil t) | |
9346 | (match-beginning 0)))) | |
9347 | (if pos (goto-char pos)) | |
9348 | pos)) | |
4b3a9ba7 | 9349 | |
20908596 | 9350 | (defconst org-dblock-start-re |
8d642074 | 9351 | "^[ \t]*#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" |
8bfe682a | 9352 | "Matches the start line of a dynamic block, with parameters.") |
891f4676 | 9353 | |
8d642074 | 9354 | (defconst org-dblock-end-re "^[ \t]*#\\+END\\([: \t\r\n]\\|$\\)" |
33306645 | 9355 | "Matches the end of a dynamic block.") |
8c6fb58b | 9356 | |
20908596 CD |
9357 | (defun org-create-dblock (plist) |
9358 | "Create a dynamic block section, with parameters taken from PLIST. | |
33306645 | 9359 | PLIST must contain a :name entry which is used as name of the block." |
8d642074 CD |
9360 | (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol))) |
9361 | (end-of-line 1) | |
9362 | (newline)) | |
9363 | (let ((col (current-column)) | |
9364 | (name (plist-get plist :name))) | |
20908596 CD |
9365 | (insert "#+BEGIN: " name) |
9366 | (while plist | |
9367 | (if (eq (car plist) :name) | |
9368 | (setq plist (cddr plist)) | |
9369 | (insert " " (prin1-to-string (pop plist))))) | |
8d642074 | 9370 | (insert "\n\n" (make-string col ?\ ) "#+END:\n") |
20908596 | 9371 | (beginning-of-line -2))) |
891f4676 | 9372 | |
20908596 CD |
9373 | (defun org-prepare-dblock () |
9374 | "Prepare dynamic block for refresh. | |
9375 | This empties the block, puts the cursor at the insert position and returns | |
9376 | the property list including an extra property :name with the block name." | |
9377 | (unless (looking-at org-dblock-start-re) | |
9378 | (error "Not at a dynamic block")) | |
9379 | (let* ((begdel (1+ (match-end 0))) | |
9380 | (name (org-no-properties (match-string 1))) | |
9381 | (params (append (list :name name) | |
9382 | (read (concat "(" (match-string 3) ")"))))) | |
8d642074 CD |
9383 | (save-excursion |
9384 | (beginning-of-line 1) | |
9385 | (skip-chars-forward " \t") | |
9386 | (setq params (plist-put params :indentation-column (current-column)))) | |
20908596 CD |
9387 | (unless (re-search-forward org-dblock-end-re nil t) |
9388 | (error "Dynamic block not terminated")) | |
9389 | (setq params | |
9390 | (append params | |
9391 | (list :content (buffer-substring | |
9392 | begdel (match-beginning 0))))) | |
9393 | (delete-region begdel (match-beginning 0)) | |
9394 | (goto-char begdel) | |
9395 | (open-line 1) | |
9396 | params)) | |
891f4676 | 9397 | |
20908596 CD |
9398 | (defun org-map-dblocks (&optional command) |
9399 | "Apply COMMAND to all dynamic blocks in the current buffer. | |
9400 | If COMMAND is not given, use `org-update-dblock'." | |
9401 | (let ((cmd (or command 'org-update-dblock)) | |
9402 | pos) | |
9403 | (save-excursion | |
9404 | (goto-char (point-min)) | |
9405 | (while (re-search-forward org-dblock-start-re nil t) | |
9406 | (goto-char (setq pos (match-beginning 0))) | |
9407 | (condition-case nil | |
9408 | (funcall cmd) | |
9409 | (error (message "Error during update of dynamic block"))) | |
9410 | (goto-char pos) | |
9411 | (unless (re-search-forward org-dblock-end-re nil t) | |
9412 | (error "Dynamic block not terminated")))))) | |
891f4676 | 9413 | |
20908596 CD |
9414 | (defun org-dblock-update (&optional arg) |
9415 | "User command for updating dynamic blocks. | |
9416 | Update the dynamic block at point. With prefix ARG, update all dynamic | |
9417 | blocks in the buffer." | |
9418 | (interactive "P") | |
9419 | (if arg | |
9420 | (org-update-all-dblocks) | |
9421 | (or (looking-at org-dblock-start-re) | |
9422 | (org-beginning-of-dblock)) | |
9423 | (org-update-dblock))) | |
8c6fb58b | 9424 | |
20908596 CD |
9425 | (defun org-update-dblock () |
9426 | "Update the dynamic block at point | |
9427 | This means to empty the block, parse for parameters and then call | |
9428 | the correct writing function." | |
9429 | (save-window-excursion | |
9430 | (let* ((pos (point)) | |
9431 | (line (org-current-line)) | |
9432 | (params (org-prepare-dblock)) | |
9433 | (name (plist-get params :name)) | |
8d642074 | 9434 | (indent (plist-get params :indentation-column)) |
20908596 CD |
9435 | (cmd (intern (concat "org-dblock-write:" name)))) |
9436 | (message "Updating dynamic block `%s' at line %d..." name line) | |
9437 | (funcall cmd params) | |
9438 | (message "Updating dynamic block `%s' at line %d...done" name line) | |
8d642074 CD |
9439 | (goto-char pos) |
9440 | (when (and indent (> indent 0)) | |
9441 | (setq indent (make-string indent ?\ )) | |
9442 | (save-excursion | |
9443 | (org-beginning-of-dblock) | |
9444 | (forward-line 1) | |
9445 | (while (not (looking-at org-dblock-end-re)) | |
9446 | (insert indent) | |
9447 | (beginning-of-line 2)) | |
9448 | (when (looking-at org-dblock-end-re) | |
9449 | (and (looking-at "[ \t]+") | |
9450 | (replace-match "")) | |
9451 | (insert indent))))))) | |
8c6fb58b | 9452 | |
20908596 CD |
9453 | (defun org-beginning-of-dblock () |
9454 | "Find the beginning of the dynamic block at point. | |
33306645 | 9455 | Error if there is no such block at point." |
20908596 CD |
9456 | (let ((pos (point)) |
9457 | beg) | |
9458 | (end-of-line 1) | |
9459 | (if (and (re-search-backward org-dblock-start-re nil t) | |
9460 | (setq beg (match-beginning 0)) | |
9461 | (re-search-forward org-dblock-end-re nil t) | |
9462 | (> (match-end 0) pos)) | |
9463 | (goto-char beg) | |
9464 | (goto-char pos) | |
9465 | (error "Not in a dynamic block")))) | |
03f3cf35 | 9466 | |
20908596 CD |
9467 | (defun org-update-all-dblocks () |
9468 | "Update all dynamic blocks in the buffer. | |
9469 | This function can be used in a hook." | |
9470 | (when (org-mode-p) | |
9471 | (org-map-dblocks 'org-update-dblock))) | |
03f3cf35 | 9472 | |
891f4676 | 9473 | |
20908596 | 9474 | ;;;; Completion |
891f4676 | 9475 | |
20908596 | 9476 | (defconst org-additional-option-like-keywords |
c8d0cf5c CD |
9477 | '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML" |
9478 | "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook" | |
8d642074 | 9479 | "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" "LATEX_CLASS:" "ATTR_LaTeX" |
c8d0cf5c CD |
9480 | "BEGIN:" "END:" |
9481 | "ORGTBL" "TBLFM:" "TBLNAME:" | |
621f83e4 CD |
9482 | "BEGIN_EXAMPLE" "END_EXAMPLE" |
9483 | "BEGIN_QUOTE" "END_QUOTE" | |
9484 | "BEGIN_VERSE" "END_VERSE" | |
c8d0cf5c | 9485 | "BEGIN_CENTER" "END_CENTER" |
db55f368 | 9486 | "BEGIN_SRC" "END_SRC" |
c8d0cf5c CD |
9487 | "CATEGORY" "COLUMNS" |
9488 | "CAPTION" "LABEL" | |
8bfe682a | 9489 | "SETUPFILE" |
54a0dee5 CD |
9490 | "BIND" |
9491 | "MACRO")) | |
891f4676 | 9492 | |
b349f79f CD |
9493 | (defcustom org-structure-template-alist |
9494 | '( | |
ce4fdcb9 | 9495 | ("s" "#+begin_src ?\n\n#+end_src" |
b349f79f CD |
9496 | "<src lang=\"?\">\n\n</src>") |
9497 | ("e" "#+begin_example\n?\n#+end_example" | |
9498 | "<example>\n?\n</example>") | |
9499 | ("q" "#+begin_quote\n?\n#+end_quote" | |
9500 | "<quote>\n?\n</quote>") | |
9501 | ("v" "#+begin_verse\n?\n#+end_verse" | |
9502 | "<verse>\n?\n/verse>") | |
c8d0cf5c CD |
9503 | ("c" "#+begin_center\n?\n#+end_center" |
9504 | "<center>\n?\n/center>") | |
b349f79f CD |
9505 | ("l" "#+begin_latex\n?\n#+end_latex" |
9506 | "<literal style=\"latex\">\n?\n</literal>") | |
9507 | ("L" "#+latex: " | |
9508 | "<literal style=\"latex\">?</literal>") | |
9509 | ("h" "#+begin_html\n?\n#+end_html" | |
9510 | "<literal style=\"html\">\n?\n</literal>") | |
9511 | ("H" "#+html: " | |
9512 | "<literal style=\"html\">?</literal>") | |
9513 | ("a" "#+begin_ascii\n?\n#+end_ascii") | |
9514 | ("A" "#+ascii: ") | |
9515 | ("i" "#+include %file ?" | |
9516 | "<include file=%file markup=\"?\">") | |
9517 | ) | |
9518 | "Structure completion elements. | |
9519 | This is a list of abbreviation keys and values. The value gets inserted | |
9520 | it you type @samp{.} followed by the key and then the completion key, | |
9521 | usually `M-TAB'. %file will be replaced by a file name after prompting | |
33306645 | 9522 | for the file using completion. |
b349f79f CD |
9523 | There are two templates for each key, the first uses the original Org syntax, |
9524 | the second uses Emacs Muse-like syntax tags. These Muse-like tags become | |
9525 | the default when the /org-mtags.el/ module has been loaded. See also the | |
ce4fdcb9 | 9526 | variable `org-mtags-prefer-muse-templates'. |
b349f79f CD |
9527 | This is an experimental feature, it is undecided if it is going to stay in." |
9528 | :group 'org-completion | |
9529 | :type '(repeat | |
9530 | (string :tag "Key") | |
9531 | (string :tag "Template") | |
9532 | (string :tag "Muse Template"))) | |
9533 | ||
9534 | (defun org-try-structure-completion () | |
9535 | "Try to complete a structure template before point. | |
9536 | This looks for strings like \"<e\" on an otherwise empty line and | |
9537 | expands them." | |
9538 | (let ((l (buffer-substring (point-at-bol) (point))) | |
9539 | a) | |
9540 | (when (and (looking-at "[ \t]*$") | |
9541 | (string-match "^[ \t]*<\\([a-z]+\\)$"l) | |
9542 | (setq a (assoc (match-string 1 l) org-structure-template-alist))) | |
9543 | (org-complete-expand-structure-template (+ -1 (point-at-bol) | |
9544 | (match-beginning 1)) a) | |
9545 | t))) | |
9546 | ||
9547 | (defun org-complete-expand-structure-template (start cell) | |
9548 | "Expand a structure template." | |
ce4fdcb9 | 9549 | (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates)) |
c8d0cf5c CD |
9550 | (rpl (nth (if musep 2 1) cell)) |
9551 | (ind "")) | |
b349f79f CD |
9552 | (delete-region start (point)) |
9553 | (when (string-match "\\`#\\+" rpl) | |
9554 | (cond | |
9555 | ((bolp)) | |
9556 | ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) | |
c8d0cf5c | 9557 | (setq ind (buffer-substring (point-at-bol) (point)))) |
b349f79f CD |
9558 | (t (newline)))) |
9559 | (setq start (point)) | |
9560 | (if (string-match "%file" rpl) | |
ce4fdcb9 | 9561 | (setq rpl (replace-match |
b349f79f CD |
9562 | (concat |
9563 | "\"" | |
9564 | (save-match-data | |
9565 | (abbreviate-file-name (read-file-name "Include file: "))) | |
9566 | "\"") | |
9567 | t t rpl))) | |
c8d0cf5c CD |
9568 | (setq rpl (mapconcat 'identity (split-string rpl "\n") |
9569 | (concat "\n" ind))) | |
b349f79f CD |
9570 | (insert rpl) |
9571 | (if (re-search-backward "\\?" start t) (delete-char 1)))) | |
ce4fdcb9 | 9572 | |
b349f79f | 9573 | |
20908596 CD |
9574 | (defun org-complete (&optional arg) |
9575 | "Perform completion on word at point. | |
9576 | At the beginning of a headline, this completes TODO keywords as given in | |
9577 | `org-todo-keywords'. | |
9578 | If the current word is preceded by a backslash, completes the TeX symbols | |
9579 | that are supported for HTML support. | |
9580 | If the current word is preceded by \"#+\", completes special words for | |
9581 | setting file options. | |
9582 | In the line after \"#+STARTUP:, complete valid keywords.\" | |
9583 | At all other locations, this simply calls the value of | |
9584 | `org-completion-fallback-command'." | |
9585 | (interactive "P") | |
9586 | (org-without-partial-completion | |
9587 | (catch 'exit | |
b349f79f CD |
9588 | (let* ((a nil) |
9589 | (end (point)) | |
20908596 CD |
9590 | (beg1 (save-excursion |
9591 | (skip-chars-backward (org-re "[:alnum:]_@")) | |
9592 | (point))) | |
9593 | (beg (save-excursion | |
9594 | (skip-chars-backward "a-zA-Z0-9_:$") | |
9595 | (point))) | |
9596 | (confirm (lambda (x) (stringp (car x)))) | |
9597 | (searchhead (equal (char-before beg) ?*)) | |
b349f79f CD |
9598 | (struct |
9599 | (when (and (member (char-before beg1) '(?. ?<)) | |
9600 | (setq a (assoc (buffer-substring beg1 (point)) | |
9601 | org-structure-template-alist))) | |
9602 | (org-complete-expand-structure-template (1- beg1) a) | |
9603 | (throw 'exit t))) | |
20908596 CD |
9604 | (tag (and (equal (char-before beg1) ?:) |
9605 | (equal (char-after (point-at-bol)) ?*))) | |
9606 | (prop (and (equal (char-before beg1) ?:) | |
9607 | (not (equal (char-after (point-at-bol)) ?*)))) | |
9608 | (texp (equal (char-before beg) ?\\)) | |
9609 | (link (equal (char-before beg) ?\[)) | |
9610 | (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) | |
9611 | beg) | |
9612 | "#+")) | |
9613 | (startup (string-match "^#\\+STARTUP:.*" | |
9614 | (buffer-substring (point-at-bol) (point)))) | |
9615 | (completion-ignore-case opt) | |
9616 | (type nil) | |
9617 | (tbl nil) | |
9618 | (table (cond | |
9619 | (opt | |
9620 | (setq type :opt) | |
9621 | (require 'org-exp) | |
9622 | (append | |
54a0dee5 CD |
9623 | (delq nil |
9624 | (mapcar | |
9625 | (lambda (x) | |
9626 | (if (string-match | |
9627 | "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) | |
9628 | (cons (match-string 2 x) | |
9629 | (match-string 1 x)))) | |
9630 | (org-split-string (org-get-current-options) "\n"))) | |
20908596 CD |
9631 | (mapcar 'list org-additional-option-like-keywords))) |
9632 | (startup | |
9633 | (setq type :startup) | |
9634 | org-startup-options) | |
9635 | (link (append org-link-abbrev-alist-local | |
9636 | org-link-abbrev-alist)) | |
9637 | (texp | |
9638 | (setq type :tex) | |
9639 | org-html-entities) | |
9640 | ((string-match "\\`\\*+[ \t]+\\'" | |
9641 | (buffer-substring (point-at-bol) beg)) | |
9642 | (setq type :todo) | |
9643 | (mapcar 'list org-todo-keywords-1)) | |
9644 | (searchhead | |
9645 | (setq type :searchhead) | |
9646 | (save-excursion | |
9647 | (goto-char (point-min)) | |
9648 | (while (re-search-forward org-todo-line-regexp nil t) | |
9649 | (push (list | |
9650 | (org-make-org-heading-search-string | |
9651 | (match-string 3) t)) | |
9652 | tbl))) | |
9653 | tbl) | |
9654 | (tag (setq type :tag beg beg1) | |
9655 | (or org-tag-alist (org-get-buffer-tags))) | |
9656 | (prop (setq type :prop beg beg1) | |
9657 | (mapcar 'list (org-buffer-property-keys nil t t))) | |
9658 | (t (progn | |
9659 | (call-interactively org-completion-fallback-command) | |
9660 | (throw 'exit nil))))) | |
9661 | (pattern (buffer-substring-no-properties beg end)) | |
9662 | (completion (try-completion pattern table confirm))) | |
9663 | (cond ((eq completion t) | |
9664 | (if (not (assoc (upcase pattern) table)) | |
9665 | (message "Already complete") | |
9666 | (if (and (equal type :opt) | |
9667 | (not (member (car (assoc (upcase pattern) table)) | |
9668 | org-additional-option-like-keywords))) | |
9669 | (insert (substring (cdr (assoc (upcase pattern) table)) | |
9670 | (length pattern))) | |
9671 | (if (memq type '(:tag :prop)) (insert ":"))))) | |
9672 | ((null completion) | |
9673 | (message "Can't find completion for \"%s\"" pattern) | |
9674 | (ding)) | |
9675 | ((not (string= pattern completion)) | |
9676 | (delete-region beg end) | |
9677 | (if (string-match " +$" completion) | |
9678 | (setq completion (replace-match "" t t completion))) | |
9679 | (insert completion) | |
9680 | (if (get-buffer-window "*Completions*") | |
9681 | (delete-window (get-buffer-window "*Completions*"))) | |
9682 | (if (assoc completion table) | |
9683 | (if (eq type :todo) (insert " ") | |
9684 | (if (memq type '(:tag :prop)) (insert ":")))) | |
9685 | (if (and (equal type :opt) (assoc completion table)) | |
9686 | (message "%s" (substitute-command-keys | |
9687 | "Press \\[org-complete] again to insert example settings")))) | |
9688 | (t | |
9689 | (message "Making completion list...") | |
9690 | (let ((list (sort (all-completions pattern table confirm) | |
9691 | 'string<))) | |
9692 | (with-output-to-temp-buffer "*Completions*" | |
9693 | (condition-case nil | |
9694 | ;; Protection needed for XEmacs and emacs 21 | |
9695 | (display-completion-list list pattern) | |
9696 | (error (display-completion-list list))))) | |
9697 | (message "Making completion list...%s" "done"))))))) | |
9698 | ||
9699 | ;;;; TODO, DEADLINE, Comments | |
9700 | ||
9701 | (defun org-toggle-comment () | |
9702 | "Change the COMMENT state of an entry." | |
9703 | (interactive) | |
9704 | (save-excursion | |
9705 | (org-back-to-heading) | |
9706 | (let (case-fold-search) | |
9707 | (if (looking-at (concat outline-regexp | |
9708 | "\\( *\\<" org-comment-string "\\>[ \t]*\\)")) | |
9709 | (replace-match "" t t nil 1) | |
9710 | (if (looking-at outline-regexp) | |
9711 | (progn | |
9712 | (goto-char (match-end 0)) | |
9713 | (insert org-comment-string " "))))))) | |
9714 | ||
9715 | (defvar org-last-todo-state-is-todo nil | |
9716 | "This is non-nil when the last TODO state change led to a TODO state. | |
9717 | If the last change removed the TODO tag or switched to DONE, then | |
9718 | this is nil.") | |
9719 | ||
33306645 | 9720 | (defvar org-setting-tags nil) ; dynamically skipped |
8c6fb58b | 9721 | |
20908596 CD |
9722 | (defun org-parse-local-options (string var) |
9723 | "Parse STRING for startup setting relevant for variable VAR." | |
9724 | (let ((rtn (symbol-value var)) | |
9725 | e opts) | |
9726 | (save-match-data | |
9727 | (if (or (not string) (not (string-match "\\S-" string))) | |
9728 | rtn | |
9729 | (setq opts (delq nil (mapcar (lambda (x) | |
9730 | (setq e (assoc x org-startup-options)) | |
9731 | (if (eq (nth 1 e) var) e nil)) | |
9732 | (org-split-string string "[ \t]+")))) | |
9733 | (if (not opts) | |
9734 | rtn | |
9735 | (setq rtn nil) | |
9736 | (while (setq e (pop opts)) | |
9737 | (if (not (nth 3 e)) | |
9738 | (setq rtn (nth 2 e)) | |
9739 | (if (not (listp rtn)) (setq rtn nil)) | |
9740 | (push (nth 2 e) rtn))) | |
9741 | rtn))))) | |
8c6fb58b | 9742 | |
c8d0cf5c CD |
9743 | (defvar org-todo-setup-filter-hook nil |
9744 | "Hook for functions that pre-filter todo specs. | |
9745 | ||
9746 | Each function takes a todo spec and returns either `nil' or the spec | |
9747 | transformed into canonical form." ) | |
9748 | ||
9749 | (defvar org-todo-get-default-hook nil | |
9750 | "Hook for functions that get a default item for todo. | |
9751 | ||
9752 | Each function takes arguments (NEW-MARK OLD-MARK) and returns either | |
9753 | `nil' or a string to be used for the todo mark." ) | |
9754 | ||
93b62de8 | 9755 | (defvar org-agenda-headline-snapshot-before-repeat) |
c8d0cf5c | 9756 | |
20908596 CD |
9757 | (defun org-todo (&optional arg) |
9758 | "Change the TODO state of an item. | |
9759 | The state of an item is given by a keyword at the start of the heading, | |
9760 | like | |
9761 | *** TODO Write paper | |
9762 | *** DONE Call mom | |
9763 | ||
9764 | The different keywords are specified in the variable `org-todo-keywords'. | |
9765 | By default the available states are \"TODO\" and \"DONE\". | |
9766 | So for this example: when the item starts with TODO, it is changed to DONE. | |
9767 | When it starts with DONE, the DONE is removed. And when neither TODO nor | |
9768 | DONE are present, add TODO at the beginning of the heading. | |
9769 | ||
9770 | With C-u prefix arg, use completion to determine the new state. | |
9771 | With numeric prefix arg, switch to that state. | |
65c439fd | 9772 | With a double C-u prefix, switch to the next set of TODO keywords (nextset). |
8bfe682a | 9773 | With a triple C-u prefix, circumvent any state blocking. |
20908596 CD |
9774 | |
9775 | For calling through lisp, arg is also interpreted in the following way: | |
9776 | 'none -> empty state | |
9777 | \"\"(empty string) -> switch to empty state | |
9778 | 'done -> switch to DONE | |
9779 | 'nextset -> switch to the next set of keywords | |
9780 | 'previousset -> switch to the previous set of keywords | |
9781 | \"WAITING\" -> switch to the specified keyword, but only if it | |
9782 | really is a member of `org-todo-keywords'." | |
9783 | (interactive "P") | |
65c439fd | 9784 | (if (equal arg '(16)) (setq arg 'nextset)) |
c8d0cf5c CD |
9785 | (let ((org-blocker-hook org-blocker-hook) |
9786 | (case-fold-search nil)) | |
6c817206 CD |
9787 | (when (equal arg '(64)) |
9788 | (setq arg nil org-blocker-hook nil)) | |
c8d0cf5c CD |
9789 | (when (and org-blocker-hook |
9790 | (or org-inhibit-blocking | |
9791 | (org-entry-get nil "NOBLOCKING"))) | |
9792 | (setq org-blocker-hook nil)) | |
6c817206 CD |
9793 | (save-excursion |
9794 | (catch 'exit | |
8bfe682a | 9795 | (org-back-to-heading t) |
6c817206 | 9796 | (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) |
c8d0cf5c | 9797 | (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)")) |
6c817206 CD |
9798 | (looking-at " *")) |
9799 | (let* ((match-data (match-data)) | |
9800 | (startpos (point-at-bol)) | |
9801 | (logging (save-match-data (org-entry-get nil "LOGGING" t))) | |
9802 | (org-log-done org-log-done) | |
9803 | (org-log-repeat org-log-repeat) | |
9804 | (org-todo-log-states org-todo-log-states) | |
9805 | (this (match-string 1)) | |
9806 | (hl-pos (match-beginning 0)) | |
9807 | (head (org-get-todo-sequence-head this)) | |
9808 | (ass (assoc head org-todo-kwd-alist)) | |
9809 | (interpret (nth 1 ass)) | |
9810 | (done-word (nth 3 ass)) | |
9811 | (final-done-word (nth 4 ass)) | |
9812 | (last-state (or this "")) | |
9813 | (completion-ignore-case t) | |
9814 | (member (member this org-todo-keywords-1)) | |
9815 | (tail (cdr member)) | |
9816 | (state (cond | |
9817 | ((and org-todo-key-trigger | |
9818 | (or (and (equal arg '(4)) | |
9819 | (eq org-use-fast-todo-selection 'prefix)) | |
9820 | (and (not arg) org-use-fast-todo-selection | |
9821 | (not (eq org-use-fast-todo-selection | |
9822 | 'prefix))))) | |
9823 | ;; Use fast selection | |
9824 | (org-fast-todo-selection)) | |
9825 | ((and (equal arg '(4)) | |
9826 | (or (not org-use-fast-todo-selection) | |
9827 | (not org-todo-key-trigger))) | |
9828 | ;; Read a state with completion | |
54a0dee5 | 9829 | (org-icompleting-read |
6c817206 CD |
9830 | "State: " (mapcar (lambda(x) (list x)) |
9831 | org-todo-keywords-1) | |
9832 | nil t)) | |
9833 | ((eq arg 'right) | |
20908596 | 9834 | (if this |
6c817206 CD |
9835 | (if tail (car tail) nil) |
9836 | (car org-todo-keywords-1))) | |
9837 | ((eq arg 'left) | |
9838 | (if (equal member org-todo-keywords-1) | |
9839 | nil | |
9840 | (if this | |
9841 | (nth (- (length org-todo-keywords-1) | |
9842 | (length tail) 2) | |
9843 | org-todo-keywords-1) | |
9844 | (org-last org-todo-keywords-1)))) | |
9845 | ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) | |
9846 | (setq arg nil))) ; hack to fall back to cycling | |
9847 | (arg | |
9848 | ;; user or caller requests a specific state | |
9849 | (cond | |
9850 | ((equal arg "") nil) | |
9851 | ((eq arg 'none) nil) | |
9852 | ((eq arg 'done) (or done-word (car org-done-keywords))) | |
9853 | ((eq arg 'nextset) | |
20908596 | 9854 | (or (car (cdr (member head org-todo-heads))) |
6c817206 CD |
9855 | (car org-todo-heads))) |
9856 | ((eq arg 'previousset) | |
9857 | (let ((org-todo-heads (reverse org-todo-heads))) | |
9858 | (or (car (cdr (member head org-todo-heads))) | |
9859 | (car org-todo-heads)))) | |
9860 | ((car (member arg org-todo-keywords-1))) | |
8bfe682a CD |
9861 | ((stringp arg) |
9862 | (error "State `%s' not valid in this file" arg)) | |
6c817206 CD |
9863 | ((nth (1- (prefix-numeric-value arg)) |
9864 | org-todo-keywords-1)))) | |
9865 | ((null member) (or head (car org-todo-keywords-1))) | |
9866 | ((equal this final-done-word) nil) ;; -> make empty | |
9867 | ((null tail) nil) ;; -> first entry | |
6c817206 CD |
9868 | ((memq interpret '(type priority)) |
9869 | (if (eq this-command last-command) | |
9870 | (car tail) | |
9871 | (if (> (length tail) 0) | |
9872 | (or done-word (car org-done-keywords)) | |
9873 | nil))) | |
c8d0cf5c CD |
9874 | (t |
9875 | (car tail)))) | |
9876 | (state (or | |
9877 | (run-hook-with-args-until-success | |
9878 | 'org-todo-get-default-hook state last-state) | |
9879 | state)) | |
6c817206 CD |
9880 | (next (if state (concat " " state " ") " ")) |
9881 | (change-plist (list :type 'todo-state-change :from this :to state | |
9882 | :position startpos)) | |
9883 | dolog now-done-p) | |
9884 | (when org-blocker-hook | |
9885 | (setq org-last-todo-state-is-todo | |
9886 | (not (member this org-done-keywords))) | |
9887 | (unless (save-excursion | |
9888 | (save-match-data | |
9889 | (run-hook-with-args-until-failure | |
9890 | 'org-blocker-hook change-plist))) | |
9891 | (if (interactive-p) | |
9892 | (error "TODO state change from %s to %s blocked" this state) | |
9893 | ;; fail silently | |
9894 | (message "TODO state change from %s to %s blocked" this state) | |
9895 | (throw 'exit nil)))) | |
9896 | (store-match-data match-data) | |
9897 | (replace-match next t t) | |
9898 | (unless (pos-visible-in-window-p hl-pos) | |
9899 | (message "TODO state changed to %s" (org-trim next))) | |
9900 | (unless head | |
9901 | (setq head (org-get-todo-sequence-head state) | |
9902 | ass (assoc head org-todo-kwd-alist) | |
9903 | interpret (nth 1 ass) | |
9904 | done-word (nth 3 ass) | |
9905 | final-done-word (nth 4 ass))) | |
9906 | (when (memq arg '(nextset previousset)) | |
9907 | (message "Keyword-Set %d/%d: %s" | |
9908 | (- (length org-todo-sets) -1 | |
9909 | (length (memq (assoc state org-todo-sets) org-todo-sets))) | |
9910 | (length org-todo-sets) | |
9911 | (mapconcat 'identity (assoc state org-todo-sets) " "))) | |
65c439fd | 9912 | (setq org-last-todo-state-is-todo |
6c817206 CD |
9913 | (not (member state org-done-keywords))) |
9914 | (setq now-done-p (and (member state org-done-keywords) | |
9915 | (not (member this org-done-keywords)))) | |
9916 | (and logging (org-local-logging logging)) | |
9917 | (when (and (or org-todo-log-states org-log-done) | |
c8d0cf5c | 9918 | (not (eq org-inhibit-logging t)) |
6c817206 CD |
9919 | (not (memq arg '(nextset previousset)))) |
9920 | ;; we need to look at recording a time and note | |
9921 | (setq dolog (or (nth 1 (assoc state org-todo-log-states)) | |
9922 | (nth 2 (assoc this org-todo-log-states)))) | |
c8d0cf5c CD |
9923 | (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) |
9924 | (setq dolog 'time)) | |
6c817206 CD |
9925 | (when (and state |
9926 | (member state org-not-done-keywords) | |
9927 | (not (member this org-not-done-keywords))) | |
9928 | ;; This is now a todo state and was not one before | |
9929 | ;; If there was a CLOSED time stamp, get rid of it. | |
9930 | (org-add-planning-info nil nil 'closed)) | |
9931 | (when (and now-done-p org-log-done) | |
9932 | ;; It is now done, and it was not done before | |
9933 | (org-add-planning-info 'closed (org-current-time)) | |
9934 | (if (and (not dolog) (eq 'note org-log-done)) | |
c8d0cf5c | 9935 | (org-add-log-setup 'done state this 'findpos 'note))) |
6c817206 CD |
9936 | (when (and state dolog) |
9937 | ;; This is a non-nil state, and we need to log it | |
c8d0cf5c | 9938 | (org-add-log-setup 'state state this 'findpos dolog))) |
6c817206 CD |
9939 | ;; Fixup tag positioning |
9940 | (org-todo-trigger-tag-changes state) | |
9941 | (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) | |
9942 | (when org-provide-todo-statistics | |
9943 | (org-update-parent-todo-statistics)) | |
9944 | (run-hooks 'org-after-todo-state-change-hook) | |
9945 | (if (and arg (not (member state org-done-keywords))) | |
9946 | (setq head (org-get-todo-sequence-head state))) | |
9947 | (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) | |
9948 | ;; Do we need to trigger a repeat? | |
9949 | (when now-done-p | |
9950 | (when (boundp 'org-agenda-headline-snapshot-before-repeat) | |
9951 | ;; This is for the agenda, take a snapshot of the headline. | |
9952 | (save-match-data | |
9953 | (setq org-agenda-headline-snapshot-before-repeat | |
9954 | (org-get-heading)))) | |
9955 | (org-auto-repeat-maybe state)) | |
9956 | ;; Fixup cursor location if close to the keyword | |
9957 | (if (and (outline-on-heading-p) | |
9958 | (not (bolp)) | |
9959 | (save-excursion (beginning-of-line 1) | |
9960 | (looking-at org-todo-line-regexp)) | |
9961 | (< (point) (+ 2 (or (match-end 2) (match-end 1))))) | |
9962 | (progn | |
9963 | (goto-char (or (match-end 2) (match-end 1))) | |
c8d0cf5c | 9964 | (and (looking-at " ") (just-one-space)))) |
6c817206 CD |
9965 | (when org-trigger-hook |
9966 | (save-excursion | |
9967 | (run-hook-with-args 'org-trigger-hook change-plist)))))))) | |
fbe6c10d | 9968 | |
c8d0cf5c | 9969 | (defun org-block-todo-from-children-or-siblings-or-parent (change-plist) |
d6685abc CD |
9970 | "Block turning an entry into a TODO, using the hierarchy. |
9971 | This checks whether the current task should be blocked from state | |
9972 | changes. Such blocking occurs when: | |
9973 | ||
9974 | 1. The task has children which are not all in a completed state. | |
9975 | ||
9976 | 2. A task has a parent with the property :ORDERED:, and there | |
9977 | are siblings prior to the current task with incomplete | |
c8d0cf5c CD |
9978 | status. |
9979 | ||
9980 | 3. The parent of the task is blocked because it has siblings that should | |
9981 | be done first, or is child of a block grandparent TODO entry." | |
9982 | ||
d6685abc CD |
9983 | (catch 'dont-block |
9984 | ;; If this is not a todo state change, or if this entry is already DONE, | |
9985 | ;; do not block | |
9986 | (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) | |
9987 | (member (plist-get change-plist :from) | |
6c817206 CD |
9988 | (cons 'done org-done-keywords)) |
9989 | (member (plist-get change-plist :to) | |
8bfe682a CD |
9990 | (cons 'todo org-not-done-keywords)) |
9991 | (not (plist-get change-plist :to))) | |
d6685abc CD |
9992 | (throw 'dont-block t)) |
9993 | ;; If this task has children, and any are undone, it's blocked | |
9994 | (save-excursion | |
9995 | (org-back-to-heading t) | |
9996 | (let ((this-level (funcall outline-level))) | |
9997 | (outline-next-heading) | |
9998 | (let ((child-level (funcall outline-level))) | |
9999 | (while (and (not (eobp)) | |
10000 | (> child-level this-level)) | |
10001 | ;; this todo has children, check whether they are all | |
10002 | ;; completed | |
10003 | (if (and (not (org-entry-is-done-p)) | |
10004 | (org-entry-is-todo-p)) | |
10005 | (throw 'dont-block nil)) | |
10006 | (outline-next-heading) | |
10007 | (setq child-level (funcall outline-level)))))) | |
10008 | ;; Otherwise, if the task's parent has the :ORDERED: property, and | |
10009 | ;; any previous siblings are undone, it's blocked | |
10010 | (save-excursion | |
10011 | (org-back-to-heading t) | |
c8d0cf5c CD |
10012 | (let* ((pos (point)) |
10013 | (parent-pos (and (org-up-heading-safe) (point)))) | |
10014 | (if (not parent-pos) (throw 'dont-block t)) ; no parent | |
10015 | (when (and (org-entry-get (point) "ORDERED") | |
10016 | (forward-line 1) | |
10017 | (re-search-forward org-not-done-heading-regexp pos t)) | |
10018 | (throw 'dont-block nil)) ; block, there is an older sibling not done. | |
10019 | ;; Search further up the hierarchy, to see if an anchestor is blocked | |
10020 | (while t | |
10021 | (goto-char parent-pos) | |
10022 | (if (not (looking-at org-not-done-heading-regexp)) | |
10023 | (throw 'dont-block t)) ; do not block, parent is not a TODO | |
10024 | (setq pos (point)) | |
10025 | (setq parent-pos (and (org-up-heading-safe) (point))) | |
10026 | (if (not parent-pos) (throw 'dont-block t)) ; no parent | |
10027 | (when (and (org-entry-get (point) "ORDERED") | |
10028 | (forward-line 1) | |
10029 | (re-search-forward org-not-done-heading-regexp pos t)) | |
10030 | (throw 'dont-block nil))))))) ; block, older sibling not done. | |
10031 | ||
10032 | (defcustom org-track-ordered-property-with-tag nil | |
10033 | "Should the ORDERED property also be shown as a tag? | |
10034 | The ORDERED property decides if an entry should require subtasks to be | |
10035 | completed in sequence. Since a property is not very visible, setting | |
10036 | this option means that toggling the ORDERED property with the command | |
10037 | `org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is | |
10038 | not relevant for the behavior, but it makes things more visible. | |
10039 | ||
10040 | Note that toggling the tag with tags commands will not change the property | |
10041 | and therefore not influence behavior! | |
10042 | ||
10043 | This can be t, meaning the tag ORDERED should be used, It can also be a | |
10044 | string to select a different tag for this task." | |
10045 | :group 'org-todo | |
10046 | :type '(choice | |
10047 | (const :tag "No tracking" nil) | |
10048 | (const :tag "Track with ORDERED tag" t) | |
10049 | (string :tag "Use other tag"))) | |
d6685abc | 10050 | |
a2a2e7fb | 10051 | (defun org-toggle-ordered-property () |
c8d0cf5c CD |
10052 | "Toggle the ORDERED property of the current entry. |
10053 | For better visibility, you can track the value of this property with a tag. | |
10054 | See variable `org-track-ordered-property-with-tag'." | |
a2a2e7fb | 10055 | (interactive) |
c8d0cf5c CD |
10056 | (let* ((t1 org-track-ordered-property-with-tag) |
10057 | (tag (and t1 (if (stringp t1) t1 "ORDERED")))) | |
10058 | (save-excursion | |
10059 | (org-back-to-heading) | |
10060 | (if (org-entry-get nil "ORDERED") | |
10061 | (progn | |
10062 | (org-delete-property "ORDERED") | |
10063 | (and tag (org-toggle-tag tag 'off)) | |
10064 | (message "Subtasks can be completed in arbitrary order")) | |
10065 | (org-entry-put nil "ORDERED" "t") | |
10066 | (and tag (org-toggle-tag tag 'on)) | |
10067 | (message "Subtasks must be completed in sequence"))))) | |
10068 | ||
10069 | (defvar org-blocked-by-checkboxes) ; dynamically scoped | |
6c817206 CD |
10070 | (defun org-block-todo-from-checkboxes (change-plist) |
10071 | "Block turning an entry into a TODO, using checkboxes. | |
10072 | This checks whether the current task should be blocked from state | |
8bfe682a | 10073 | changes because there are unchecked boxes in this entry." |
6c817206 CD |
10074 | (catch 'dont-block |
10075 | ;; If this is not a todo state change, or if this entry is already DONE, | |
10076 | ;; do not block | |
10077 | (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) | |
10078 | (member (plist-get change-plist :from) | |
10079 | (cons 'done org-done-keywords)) | |
10080 | (member (plist-get change-plist :to) | |
8bfe682a CD |
10081 | (cons 'todo org-not-done-keywords)) |
10082 | (not (plist-get change-plist :to))) | |
6c817206 CD |
10083 | (throw 'dont-block t)) |
10084 | ;; If this task has checkboxes that are not checked, it's blocked | |
10085 | (save-excursion | |
10086 | (org-back-to-heading t) | |
10087 | (let ((beg (point)) end) | |
10088 | (outline-next-heading) | |
10089 | (setq end (point)) | |
10090 | (goto-char beg) | |
10091 | (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]" | |
10092 | end t) | |
c8d0cf5c CD |
10093 | (progn |
10094 | (if (boundp 'org-blocked-by-checkboxes) | |
10095 | (setq org-blocked-by-checkboxes t)) | |
10096 | (throw 'dont-block nil))))) | |
6c817206 CD |
10097 | t)) ; do not block |
10098 | ||
54a0dee5 CD |
10099 | (defun org-update-statistics-cookies (all) |
10100 | "Update the statistics cookie, either from TODO or from checkboxes. | |
10101 | This should be called with the cursor in a line with a statistics cookie." | |
10102 | (interactive "P") | |
10103 | (if all | |
10104 | (progn | |
10105 | (org-update-checkbox-count 'all) | |
10106 | (org-map-entries 'org-update-parent-todo-statistics)) | |
10107 | (if (not (org-on-heading-p)) | |
10108 | (org-update-checkbox-count) | |
10109 | (let ((pos (move-marker (make-marker) (point))) | |
10110 | end l1 l2) | |
10111 | (ignore-errors (org-back-to-heading t)) | |
10112 | (if (not (org-on-heading-p)) | |
10113 | (org-update-checkbox-count) | |
10114 | (setq l1 (org-outline-level)) | |
10115 | (setq end (save-excursion | |
10116 | (outline-next-heading) | |
10117 | (if (org-on-heading-p) (setq l2 (org-outline-level))) | |
10118 | (point))) | |
10119 | (if (and (save-excursion (re-search-forward | |
10120 | "^[ \t]*[-+*] \\[[- X]\\]" end t)) | |
10121 | (not (save-excursion (re-search-forward | |
10122 | ":COOKIE_DATA:.*\\<todo\\>" end t)))) | |
10123 | (org-update-checkbox-count) | |
10124 | (if (and l2 (> l2 l1)) | |
10125 | (progn | |
10126 | (goto-char end) | |
10127 | (org-update-parent-todo-statistics)) | |
10128 | (error "No data for statistics cookie")))) | |
10129 | (goto-char pos) | |
10130 | (move-marker pos nil))))) | |
f924a367 | 10131 | |
c8d0cf5c | 10132 | (defvar org-entry-property-inherited-from) ;; defined below |
b349f79f | 10133 | (defun org-update-parent-todo-statistics () |
c8d0cf5c CD |
10134 | "Update any statistics cookie in the parent of the current headline. |
10135 | When `org-hierarchical-todo-statistics' is nil, statistics will cover | |
10136 | the entire subtree and this will travel up the hierarchy and update | |
10137 | statistics everywhere." | |
b349f79f | 10138 | (interactive) |
c8d0cf5c CD |
10139 | (let* ((lim 0) prop |
10140 | (recursive (or (not org-hierarchical-todo-statistics) | |
10141 | (string-match | |
10142 | "\\<recursive\\>" | |
10143 | (or (setq prop (org-entry-get | |
10144 | nil "COOKIE_DATA" 'inherit)) "")))) | |
10145 | (lim (or (and prop (marker-position | |
10146 | org-entry-property-inherited-from)) | |
10147 | lim)) | |
10148 | (first t) | |
10149 | (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") | |
8d642074 | 10150 | level ltoggle l1 new ndel |
c8d0cf5c | 10151 | (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present) |
b349f79f CD |
10152 | (catch 'exit |
10153 | (save-excursion | |
c8d0cf5c CD |
10154 | (beginning-of-line 1) |
10155 | (if (org-at-heading-p) | |
10156 | (setq ltoggle (funcall outline-level)) | |
10157 | (error "This should not happen")) | |
10158 | (while (and (setq level (org-up-heading-safe)) | |
10159 | (or recursive first) | |
10160 | (>= (point) lim)) | |
8bfe682a | 10161 | (setq first nil cookie-present nil) |
c8d0cf5c CD |
10162 | (unless (and level |
10163 | (not (string-match | |
10164 | "\\<checkbox\\>" | |
10165 | (downcase | |
10166 | (or (org-entry-get | |
10167 | nil "COOKIE_DATA") | |
10168 | ""))))) | |
10169 | (throw 'exit nil)) | |
10170 | (while (re-search-forward box-re (point-at-eol) t) | |
10171 | (setq cnt-all 0 cnt-done 0 cookie-present t) | |
10172 | (setq is-percent (match-end 2)) | |
10173 | (save-match-data | |
10174 | (unless (outline-next-heading) (throw 'exit nil)) | |
10175 | (while (and (looking-at org-complex-heading-regexp) | |
10176 | (> (setq l1 (length (match-string 1))) level)) | |
10177 | (setq kwd (and (or recursive (= l1 ltoggle)) | |
10178 | (match-string 2))) | |
10179 | (if (or (eq org-provide-todo-statistics 'all-headlines) | |
10180 | (and (listp org-provide-todo-statistics) | |
10181 | (or (member kwd org-provide-todo-statistics) | |
10182 | (member kwd org-done-keywords)))) | |
10183 | (setq cnt-all (1+ cnt-all)) | |
10184 | (if (eq org-provide-todo-statistics t) | |
10185 | (and kwd (setq cnt-all (1+ cnt-all))))) | |
10186 | (and (member kwd org-done-keywords) | |
10187 | (setq cnt-done (1+ cnt-done))) | |
10188 | (outline-next-heading))) | |
8d642074 CD |
10189 | (setq new |
10190 | (if is-percent | |
10191 | (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) | |
10192 | (format "[%d/%d]" cnt-done cnt-all)) | |
10193 | ndel (- (match-end 0) (match-beginning 0))) | |
10194 | (goto-char (match-beginning 0)) | |
10195 | (insert new) | |
8bfe682a CD |
10196 | (delete-region (point) (+ (point) ndel))) |
10197 | (when cookie-present | |
10198 | (run-hook-with-args 'org-after-todo-statistics-hook | |
10199 | cnt-done (- cnt-all cnt-done)))))) | |
c8d0cf5c | 10200 | (run-hooks 'org-todo-statistics-hook))) |
b349f79f CD |
10201 | |
10202 | (defvar org-after-todo-statistics-hook nil | |
10203 | "Hook that is called after a TODO statistics cookie has been updated. | |
10204 | Each function is called with two arguments: the number of not-done entries | |
10205 | and the number of done entries. | |
10206 | ||
10207 | For example, the following function, when added to this hook, will switch | |
10208 | an entry to DONE when all children are done, and back to TODO when new | |
10209 | entries are set to a TODO status. Note that this hook is only called | |
10210 | when there is a statistics cookie in the headline! | |
10211 | ||
10212 | (defun org-summary-todo (n-done n-not-done) | |
10213 | \"Switch entry to DONE when all subentries are done, to TODO otherwise.\" | |
10214 | (let (org-log-done org-log-states) ; turn off logging | |
10215 | (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\")))) | |
10216 | ") | |
71d35b24 | 10217 | |
c8d0cf5c CD |
10218 | (defvar org-todo-statistics-hook nil |
10219 | "Hook that is run whenever Org thinks TODO statistics should be updated. | |
8bfe682a | 10220 | This hook runs even if there is no statistics cookie present, in which case |
c8d0cf5c CD |
10221 | `org-after-todo-statistics-hook' would not run.") |
10222 | ||
71d35b24 CD |
10223 | (defun org-todo-trigger-tag-changes (state) |
10224 | "Apply the changes defined in `org-todo-state-tags-triggers'." | |
10225 | (let ((l org-todo-state-tags-triggers) | |
10226 | changes) | |
10227 | (when (or (not state) (equal state "")) | |
10228 | (setq changes (append changes (cdr (assoc "" l))))) | |
10229 | (when (and (stringp state) (> (length state) 0)) | |
10230 | (setq changes (append changes (cdr (assoc state l))))) | |
10231 | (when (member state org-not-done-keywords) | |
10232 | (setq changes (append changes (cdr (assoc 'todo l))))) | |
10233 | (when (member state org-done-keywords) | |
10234 | (setq changes (append changes (cdr (assoc 'done l))))) | |
10235 | (dolist (c changes) | |
10236 | (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) | |
ce4fdcb9 | 10237 | |
20908596 CD |
10238 | (defun org-local-logging (value) |
10239 | "Get logging settings from a property VALUE." | |
10240 | (let* (words w a) | |
10241 | ;; directly set the variables, they are already local. | |
10242 | (setq org-log-done nil | |
10243 | org-log-repeat nil | |
10244 | org-todo-log-states nil) | |
10245 | (setq words (org-split-string value)) | |
10246 | (while (setq w (pop words)) | |
10247 | (cond | |
10248 | ((setq a (assoc w org-startup-options)) | |
10249 | (and (member (nth 1 a) '(org-log-done org-log-repeat)) | |
10250 | (set (nth 1 a) (nth 2 a)))) | |
10251 | ((setq a (org-extract-log-state-settings w)) | |
10252 | (and (member (car a) org-todo-keywords-1) | |
10253 | (push a org-todo-log-states))))))) | |
03f3cf35 | 10254 | |
20908596 CD |
10255 | (defun org-get-todo-sequence-head (kwd) |
10256 | "Return the head of the TODO sequence to which KWD belongs. | |
10257 | If KWD is not set, check if there is a text property remembering the | |
10258 | right sequence." | |
10259 | (let (p) | |
10260 | (cond | |
10261 | ((not kwd) | |
10262 | (or (get-text-property (point-at-bol) 'org-todo-head) | |
03f3cf35 | 10263 | (progn |
20908596 CD |
10264 | (setq p (next-single-property-change (point-at-bol) 'org-todo-head |
10265 | nil (point-at-eol))) | |
10266 | (get-text-property p 'org-todo-head)))) | |
10267 | ((not (member kwd org-todo-keywords-1)) | |
10268 | (car org-todo-keywords-1)) | |
10269 | (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) | |
891f4676 | 10270 | |
20908596 CD |
10271 | (defun org-fast-todo-selection () |
10272 | "Fast TODO keyword selection with single keys. | |
10273 | Returns the new TODO keyword, or nil if no state change should occur." | |
10274 | (let* ((fulltable org-todo-key-alist) | |
10275 | (done-keywords org-done-keywords) ;; needed for the faces. | |
10276 | (maxlen (apply 'max (mapcar | |
10277 | (lambda (x) | |
10278 | (if (stringp (car x)) (string-width (car x)) 0)) | |
10279 | fulltable))) | |
10280 | (expert nil) | |
10281 | (fwidth (+ maxlen 3 1 3)) | |
10282 | (ncol (/ (- (window-width) 4) fwidth)) | |
10283 | tg cnt e c tbl | |
10284 | groups ingroup) | |
d6685abc CD |
10285 | (save-excursion |
10286 | (save-window-excursion | |
10287 | (if expert | |
10288 | (set-buffer (get-buffer-create " *Org todo*")) | |
10289 | (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) | |
10290 | (erase-buffer) | |
10291 | (org-set-local 'org-done-keywords done-keywords) | |
10292 | (setq tbl fulltable cnt 0) | |
10293 | (while (setq e (pop tbl)) | |
10294 | (cond | |
10295 | ((equal e '(:startgroup)) | |
10296 | (push '() groups) (setq ingroup t) | |
10297 | (when (not (= cnt 0)) | |
10298 | (setq cnt 0) | |
10299 | (insert "\n")) | |
10300 | (insert "{ ")) | |
10301 | ((equal e '(:endgroup)) | |
10302 | (setq ingroup nil cnt 0) | |
10303 | (insert "}\n")) | |
c8d0cf5c CD |
10304 | ((equal e '(:newline)) |
10305 | (when (not (= cnt 0)) | |
10306 | (setq cnt 0) | |
10307 | (insert "\n") | |
10308 | (setq e (car tbl)) | |
10309 | (while (equal (car tbl) '(:newline)) | |
10310 | (insert "\n") | |
10311 | (setq tbl (cdr tbl))))) | |
d6685abc CD |
10312 | (t |
10313 | (setq tg (car e) c (cdr e)) | |
10314 | (if ingroup (push tg (car groups))) | |
10315 | (setq tg (org-add-props tg nil 'face | |
10316 | (org-get-todo-face tg))) | |
10317 | (if (and (= cnt 0) (not ingroup)) (insert " ")) | |
10318 | (insert "[" c "] " tg (make-string | |
10319 | (- fwidth 4 (length tg)) ?\ )) | |
10320 | (when (= (setq cnt (1+ cnt)) ncol) | |
10321 | (insert "\n") | |
10322 | (if ingroup (insert " ")) | |
10323 | (setq cnt 0))))) | |
10324 | (insert "\n") | |
10325 | (goto-char (point-min)) | |
10326 | (if (not expert) (org-fit-window-to-buffer)) | |
10327 | (message "[a-z..]:Set [SPC]:clear") | |
10328 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
20908596 | 10329 | (cond |
d6685abc CD |
10330 | ((or (= c ?\C-g) |
10331 | (and (= c ?q) (not (rassoc c fulltable)))) | |
10332 | (setq quit-flag t)) | |
10333 | ((= c ?\ ) nil) | |
10334 | ((setq e (rassoc c fulltable) tg (car e)) | |
10335 | tg) | |
10336 | (t (setq quit-flag t))))))) | |
ab27a4a0 | 10337 | |
20908596 CD |
10338 | (defun org-entry-is-todo-p () |
10339 | (member (org-get-todo-state) org-not-done-keywords)) | |
10340 | ||
10341 | (defun org-entry-is-done-p () | |
10342 | (member (org-get-todo-state) org-done-keywords)) | |
10343 | ||
10344 | (defun org-get-todo-state () | |
10345 | (save-excursion | |
10346 | (org-back-to-heading t) | |
10347 | (and (looking-at org-todo-line-regexp) | |
10348 | (match-end 2) | |
10349 | (match-string 2)))) | |
10350 | ||
10351 | (defun org-at-date-range-p (&optional inactive-ok) | |
10352 | "Is the cursor inside a date range?" | |
d3f4dbe8 | 10353 | (interactive) |
20908596 CD |
10354 | (save-excursion |
10355 | (catch 'exit | |
10356 | (let ((pos (point))) | |
10357 | (skip-chars-backward "^[<\r\n") | |
10358 | (skip-chars-backward "<[") | |
10359 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
10360 | (>= (match-end 0) pos) | |
10361 | (throw 'exit t)) | |
10362 | (skip-chars-backward "^<[\r\n") | |
10363 | (skip-chars-backward "<[") | |
10364 | (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) | |
10365 | (>= (match-end 0) pos) | |
10366 | (throw 'exit t))) | |
10367 | nil))) | |
891f4676 | 10368 | |
8bfe682a | 10369 | (defun org-get-repeat (&optional tagline) |
2c3ad40d | 10370 | "Check if there is a deadline/schedule with repeater in this entry." |
20908596 CD |
10371 | (save-match-data |
10372 | (save-excursion | |
10373 | (org-back-to-heading t) | |
8bfe682a CD |
10374 | (and (re-search-forward (if tagline |
10375 | (concat tagline "\\s-*" org-repeat-re) | |
10376 | org-repeat-re) | |
10377 | (org-entry-end-position) t) | |
10378 | (match-string-no-properties 1))))) | |
891f4676 | 10379 | |
20908596 | 10380 | (defvar org-last-changed-timestamp) |
b349f79f | 10381 | (defvar org-last-inserted-timestamp) |
20908596 CD |
10382 | (defvar org-log-post-message) |
10383 | (defvar org-log-note-purpose) | |
10384 | (defvar org-log-note-how) | |
621f83e4 | 10385 | (defvar org-log-note-extra) |
20908596 CD |
10386 | (defun org-auto-repeat-maybe (done-word) |
10387 | "Check if the current headline contains a repeated deadline/schedule. | |
10388 | If yes, set TODO state back to what it was and change the base date | |
10389 | of repeating deadline/scheduled time stamps to new date. | |
10390 | This function is run automatically after each state change to a DONE state." | |
10391 | ;; last-state is dynamically scoped into this function | |
10392 | (let* ((repeat (org-get-repeat)) | |
10393 | (aa (assoc last-state org-todo-kwd-alist)) | |
10394 | (interpret (nth 1 aa)) | |
10395 | (head (nth 2 aa)) | |
10396 | (whata '(("d" . day) ("m" . month) ("y" . year))) | |
10397 | (msg "Entry repeats: ") | |
10398 | (org-log-done nil) | |
10399 | (org-todo-log-states nil) | |
10400 | (nshiftmax 10) (nshift 0) | |
65c439fd | 10401 | re type n what ts time) |
20908596 CD |
10402 | (when repeat |
10403 | (if (eq org-log-repeat t) (setq org-log-repeat 'state)) | |
10404 | (org-todo (if (eq interpret 'type) last-state head)) | |
c8d0cf5c CD |
10405 | (org-entry-put nil "LAST_REPEAT" (format-time-string |
10406 | (org-time-stamp-format t t))) | |
20908596 CD |
10407 | (when org-log-repeat |
10408 | (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) | |
10409 | (memq 'org-add-log-note post-command-hook)) | |
10410 | ;; OK, we are already setup for some record | |
10411 | (if (eq org-log-repeat 'note) | |
10412 | ;; make sure we take a note, not only a time stamp | |
10413 | (setq org-log-note-how 'note)) | |
10414 | ;; Set up for taking a record | |
10415 | (org-add-log-setup 'state (or done-word (car org-done-keywords)) | |
c8d0cf5c | 10416 | last-state |
20908596 CD |
10417 | 'findpos org-log-repeat))) |
10418 | (org-back-to-heading t) | |
10419 | (org-add-planning-info nil nil 'closed) | |
10420 | (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" | |
10421 | org-deadline-time-regexp "\\)\\|\\(" | |
10422 | org-ts-regexp "\\)")) | |
10423 | (while (re-search-forward | |
10424 | re (save-excursion (outline-next-heading) (point)) t) | |
10425 | (setq type (if (match-end 1) org-scheduled-string | |
10426 | (if (match-end 3) org-deadline-string "Plain:")) | |
65c439fd | 10427 | ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0)))) |
20908596 CD |
10428 | (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts) |
10429 | (setq n (string-to-number (match-string 2 ts)) | |
10430 | what (match-string 3 ts)) | |
10431 | (if (equal what "w") (setq n (* n 7) what "d")) | |
10432 | ;; Preparation, see if we need to modify the start date for the change | |
10433 | (when (match-end 1) | |
10434 | (setq time (save-match-data (org-time-string-to-time ts))) | |
10435 | (cond | |
10436 | ((equal (match-string 1 ts) ".") | |
10437 | ;; Shift starting date to today | |
10438 | (org-timestamp-change | |
10439 | (- (time-to-days (current-time)) (time-to-days time)) | |
10440 | 'day)) | |
10441 | ((equal (match-string 1 ts) "+") | |
10442 | (while (or (= nshift 0) | |
10443 | (<= (time-to-days time) (time-to-days (current-time)))) | |
10444 | (when (= (incf nshift) nshiftmax) | |
10445 | (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) | |
10446 | (error "Abort"))) | |
10447 | (org-timestamp-change n (cdr (assoc what whata))) | |
10448 | (org-at-timestamp-p t) | |
10449 | (setq ts (match-string 1)) | |
10450 | (setq time (save-match-data (org-time-string-to-time ts)))) | |
10451 | (org-timestamp-change (- n) (cdr (assoc what whata))) | |
10452 | ;; rematch, so that we have everything in place for the real shift | |
10453 | (org-at-timestamp-p t) | |
10454 | (setq ts (match-string 1)) | |
10455 | (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts)))) | |
10456 | (org-timestamp-change n (cdr (assoc what whata))) | |
621f83e4 | 10457 | (setq msg (concat msg type " " org-last-changed-timestamp " ")))) |
20908596 CD |
10458 | (setq org-log-post-message msg) |
10459 | (message "%s" msg)))) | |
891f4676 | 10460 | |
20908596 CD |
10461 | (defun org-show-todo-tree (arg) |
10462 | "Make a compact tree which shows all headlines marked with TODO. | |
10463 | The tree will show the lines where the regexp matches, and all higher | |
10464 | headlines above the match. | |
c8d0cf5c | 10465 | With a \\[universal-argument] prefix, prompt for a regexp to match. |
20908596 CD |
10466 | With a numeric prefix N, construct a sparse tree for the Nth element |
10467 | of `org-todo-keywords-1'." | |
10468 | (interactive "P") | |
10469 | (let ((case-fold-search nil) | |
10470 | (kwd-re | |
10471 | (cond ((null arg) org-not-done-regexp) | |
10472 | ((equal arg '(4)) | |
54a0dee5 | 10473 | (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " |
20908596 CD |
10474 | (mapcar 'list org-todo-keywords-1)))) |
10475 | (concat "\\(" | |
10476 | (mapconcat 'identity (org-split-string kwd "|") "\\|") | |
10477 | "\\)\\>"))) | |
10478 | ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) | |
10479 | (regexp-quote (nth (1- (prefix-numeric-value arg)) | |
10480 | org-todo-keywords-1))) | |
10481 | (t (error "Invalid prefix argument: %s" arg))))) | |
10482 | (message "%d TODO entries found" | |
10483 | (org-occur (concat "^" outline-regexp " *" kwd-re ))))) | |
891f4676 | 10484 | |
b349f79f | 10485 | (defun org-deadline (&optional remove time) |
20908596 | 10486 | "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. |
b349f79f CD |
10487 | With argument REMOVE, remove any deadline from the item. |
10488 | When TIME is set, it should be an internal time specification, and the | |
10489 | scheduling will use the corresponding date." | |
20908596 | 10490 | (interactive "P") |
8bfe682a CD |
10491 | (let ((old-date (org-entry-get nil "DEADLINE"))) |
10492 | (if remove | |
10493 | (progn | |
10494 | (org-remove-timestamp-with-keyword org-deadline-string) | |
10495 | (message "Item no longer has a deadline.")) | |
10496 | (if (org-get-repeat) | |
10497 | (error "Cannot change deadline on task with repeater, please do that by hand") | |
10498 | (org-add-planning-info 'deadline time 'closed) | |
10499 | (when (and old-date org-log-redeadline | |
10500 | (not (equal old-date | |
10501 | (substring org-last-inserted-timestamp 1 -1)))) | |
10502 | (org-add-log-setup 'redeadline nil old-date 'findpos | |
10503 | org-log-redeadline)) | |
10504 | (message "Deadline on %s" org-last-inserted-timestamp))))) | |
db4a7382 | 10505 | |
b349f79f | 10506 | (defun org-schedule (&optional remove time) |
20908596 | 10507 | "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. |
b349f79f CD |
10508 | With argument REMOVE, remove any scheduling date from the item. |
10509 | When TIME is set, it should be an internal time specification, and the | |
10510 | scheduling will use the corresponding date." | |
20908596 | 10511 | (interactive "P") |
8bfe682a CD |
10512 | (let ((old-date (org-entry-get nil "SCHEDULED"))) |
10513 | (if remove | |
10514 | (progn | |
10515 | (org-remove-timestamp-with-keyword org-scheduled-string) | |
10516 | (message "Item is no longer scheduled.")) | |
10517 | (if (org-get-repeat) | |
10518 | (error "Cannot reschedule task with repeater, please do that by hand") | |
10519 | (org-add-planning-info 'scheduled time 'closed) | |
10520 | (when (and old-date org-log-reschedule | |
10521 | (not (equal old-date | |
10522 | (substring org-last-inserted-timestamp 1 -1)))) | |
10523 | (org-add-log-setup 'reschedule nil old-date 'findpos | |
10524 | org-log-reschedule)) | |
10525 | (message "Scheduled to %s" org-last-inserted-timestamp))))) | |
20908596 | 10526 | |
c8d0cf5c CD |
10527 | (defun org-get-scheduled-time (pom &optional inherit) |
10528 | "Get the scheduled time as a time tuple, of a format suitable | |
10529 | for calling org-schedule with, or if there is no scheduling, | |
10530 | returns nil." | |
10531 | (let ((time (org-entry-get pom "SCHEDULED" inherit))) | |
10532 | (when time | |
10533 | (apply 'encode-time (org-parse-time-string time))))) | |
10534 | ||
10535 | (defun org-get-deadline-time (pom &optional inherit) | |
10536 | "Get the deadine as a time tuple, of a format suitable for | |
8bfe682a | 10537 | calling org-deadline with, or if there is no scheduling, returns |
c8d0cf5c CD |
10538 | nil." |
10539 | (let ((time (org-entry-get pom "DEADLINE" inherit))) | |
10540 | (when time | |
10541 | (apply 'encode-time (org-parse-time-string time))))) | |
10542 | ||
20908596 CD |
10543 | (defun org-remove-timestamp-with-keyword (keyword) |
10544 | "Remove all time stamps with KEYWORD in the current entry." | |
10545 | (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) | |
10546 | beg) | |
10547 | (save-excursion | |
10548 | (org-back-to-heading t) | |
10549 | (setq beg (point)) | |
54a0dee5 | 10550 | (outline-next-heading) |
20908596 CD |
10551 | (while (re-search-backward re beg t) |
10552 | (replace-match "") | |
b349f79f CD |
10553 | (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) |
10554 | (equal (char-before) ?\ )) | |
10555 | (backward-delete-char 1) | |
10556 | (if (string-match "^[ \t]*$" (buffer-substring | |
10557 | (point-at-bol) (point-at-eol))) | |
10558 | (delete-region (point-at-bol) | |
10559 | (min (point-max) (1+ (point-at-eol)))))))))) | |
3278a016 | 10560 | |
20908596 CD |
10561 | (defun org-add-planning-info (what &optional time &rest remove) |
10562 | "Insert new timestamp with keyword in the line directly after the headline. | |
10563 | WHAT indicates what kind of time stamp to add. TIME indicated the time to use. | |
10564 | If non is given, the user is prompted for a date. | |
10565 | REMOVE indicates what kind of entries to remove. An old WHAT entry will also | |
10566 | be removed." | |
10567 | (interactive) | |
10568 | (let (org-time-was-given org-end-time-was-given ts | |
10569 | end default-time default-input) | |
0b8568f5 | 10570 | |
c8d0cf5c CD |
10571 | (catch 'exit |
10572 | (when (and (not time) (memq what '(scheduled deadline))) | |
10573 | ;; Try to get a default date/time from existing timestamp | |
10574 | (save-excursion | |
20908596 | 10575 | (org-back-to-heading t) |
c8d0cf5c CD |
10576 | (setq end (save-excursion (outline-next-heading) (point))) |
10577 | (when (re-search-forward (if (eq what 'scheduled) | |
10578 | org-scheduled-time-regexp | |
10579 | org-deadline-time-regexp) | |
10580 | end t) | |
10581 | (setq ts (match-string 1) | |
10582 | default-time | |
10583 | (apply 'encode-time (org-parse-time-string ts)) | |
10584 | default-input (and ts (org-get-compact-tod ts)))))) | |
10585 | (when what | |
10586 | ;; If necessary, get the time from the user | |
10587 | (setq time (or time (org-read-date nil 'to-time nil nil | |
10588 | default-time default-input)))) | |
10589 | ||
10590 | (when (and org-insert-labeled-timestamps-at-point | |
10591 | (member what '(scheduled deadline))) | |
10592 | (insert | |
10593 | (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") | |
10594 | (org-insert-time-stamp time org-time-was-given | |
10595 | nil nil nil (list org-end-time-was-given)) | |
10596 | (setq what nil)) | |
10597 | (save-excursion | |
10598 | (save-restriction | |
10599 | (let (col list elt ts buffer-invisibility-spec) | |
10600 | (org-back-to-heading t) | |
10601 | (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) | |
10602 | (goto-char (match-end 1)) | |
10603 | (setq col (current-column)) | |
10604 | (goto-char (match-end 0)) | |
10605 | (if (eobp) (insert "\n") (forward-char 1)) | |
10606 | (when (and (not what) | |
10607 | (not (looking-at | |
10608 | (concat "[ \t]*" | |
10609 | org-keyword-time-not-clock-regexp)))) | |
10610 | ;; Nothing to add, nothing to remove...... :-) | |
10611 | (throw 'exit nil)) | |
10612 | (if (and (not (looking-at outline-regexp)) | |
10613 | (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp | |
10614 | "[^\r\n]*")) | |
10615 | (not (equal (match-string 1) org-clock-string))) | |
10616 | (narrow-to-region (match-beginning 0) (match-end 0)) | |
10617 | (insert-before-markers "\n") | |
10618 | (backward-char 1) | |
10619 | (narrow-to-region (point) (point)) | |
10620 | (and org-adapt-indentation (org-indent-to-column col))) | |
10621 | ;; Check if we have to remove something. | |
10622 | (setq list (cons what remove)) | |
10623 | (while list | |
10624 | (setq elt (pop list)) | |
10625 | (goto-char (point-min)) | |
10626 | (when (or (and (eq elt 'scheduled) | |
10627 | (re-search-forward org-scheduled-time-regexp nil t)) | |
10628 | (and (eq elt 'deadline) | |
10629 | (re-search-forward org-deadline-time-regexp nil t)) | |
10630 | (and (eq elt 'closed) | |
10631 | (re-search-forward org-closed-time-regexp nil t))) | |
10632 | (replace-match "") | |
10633 | (if (looking-at "--+<[^>]+>") (replace-match "")) | |
8d642074 | 10634 | (skip-chars-backward " ") |
c8d0cf5c CD |
10635 | (if (looking-at " +") (replace-match "")))) |
10636 | (goto-char (point-max)) | |
8bfe682a | 10637 | (and org-adapt-indentation (bolp) (org-indent-to-column col)) |
c8d0cf5c CD |
10638 | (when what |
10639 | (insert | |
10640 | (if (not (or (bolp) (eq (char-before) ?\ ))) " " "") | |
10641 | (cond ((eq what 'scheduled) org-scheduled-string) | |
10642 | ((eq what 'deadline) org-deadline-string) | |
10643 | ((eq what 'closed) org-closed-string)) | |
10644 | " ") | |
10645 | (setq ts (org-insert-time-stamp | |
10646 | time | |
10647 | (or org-time-was-given | |
10648 | (and (eq what 'closed) org-log-done-with-time)) | |
10649 | (eq what 'closed) | |
10650 | nil nil (list org-end-time-was-given))) | |
10651 | (end-of-line 1)) | |
20908596 | 10652 | (goto-char (point-min)) |
c8d0cf5c CD |
10653 | (widen) |
10654 | (if (and (looking-at "[ \t]+\n") | |
10655 | (equal (char-before) ?\n)) | |
10656 | (delete-region (1- (point)) (point-at-eol))) | |
10657 | ts)))))) | |
ab27a4a0 | 10658 | |
20908596 CD |
10659 | (defvar org-log-note-marker (make-marker)) |
10660 | (defvar org-log-note-purpose nil) | |
10661 | (defvar org-log-note-state nil) | |
c8d0cf5c | 10662 | (defvar org-log-note-previous-state nil) |
20908596 | 10663 | (defvar org-log-note-how nil) |
621f83e4 | 10664 | (defvar org-log-note-extra nil) |
20908596 CD |
10665 | (defvar org-log-note-window-configuration nil) |
10666 | (defvar org-log-note-return-to (make-marker)) | |
10667 | (defvar org-log-post-message nil | |
10668 | "Message to be displayed after a log note has been stored. | |
10669 | The auto-repeater uses this.") | |
ab27a4a0 | 10670 | |
20908596 CD |
10671 | (defun org-add-note () |
10672 | "Add a note to the current entry. | |
10673 | This is done in the same way as adding a state change note." | |
10674 | (interactive) | |
c8d0cf5c | 10675 | (org-add-log-setup 'note nil nil 'findpos nil)) |
8c6fb58b | 10676 | |
621f83e4 | 10677 | (defvar org-property-end-re) |
c8d0cf5c CD |
10678 | (defun org-add-log-setup (&optional purpose state prev-state |
10679 | findpos how &optional extra) | |
20908596 CD |
10680 | "Set up the post command hook to take a note. |
10681 | If this is about to TODO state change, the new state is expected in STATE. | |
10682 | When FINDPOS is non-nil, find the correct position for the note in | |
621f83e4 CD |
10683 | the current entry. If not, assume that it can be inserted at point. |
10684 | HOW is an indicator what kind of note should be created. | |
10685 | EXTRA is additional text that will be inserted into the notes buffer." | |
c8d0cf5c CD |
10686 | (let* ((org-log-into-drawer (org-log-into-drawer)) |
10687 | (drawer (cond ((stringp org-log-into-drawer) | |
10688 | org-log-into-drawer) | |
10689 | (org-log-into-drawer "LOGBOOK") | |
10690 | (t nil)))) | |
10691 | (save-restriction | |
10692 | (save-excursion | |
10693 | (when findpos | |
10694 | (org-back-to-heading t) | |
10695 | (narrow-to-region (point) (save-excursion | |
10696 | (outline-next-heading) (point))) | |
10697 | (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" | |
10698 | "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp | |
10699 | "[^\r\n]*\\)?")) | |
10700 | (goto-char (match-end 0)) | |
10701 | (cond | |
10702 | (drawer | |
10703 | (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$") | |
10704 | nil t) | |
10705 | (progn | |
10706 | (goto-char (match-end 0)) | |
10707 | (or org-log-states-order-reversed | |
10708 | (and (re-search-forward org-property-end-re nil t) | |
10709 | (goto-char (1- (match-beginning 0)))))) | |
10710 | (insert "\n:" drawer ":\n:END:") | |
10711 | (beginning-of-line 0) | |
10712 | (org-indent-line-function) | |
10713 | (beginning-of-line 2) | |
10714 | (org-indent-line-function) | |
10715 | (end-of-line 0))) | |
10716 | ((and org-log-state-notes-insert-after-drawers | |
10717 | (save-excursion | |
10718 | (forward-line) (looking-at org-drawer-regexp))) | |
10719 | (forward-line) | |
10720 | (while (looking-at org-drawer-regexp) | |
10721 | (goto-char (match-end 0)) | |
10722 | (re-search-forward org-property-end-re (point-max) t) | |
10723 | (forward-line)) | |
10724 | (forward-line -1))) | |
10725 | (unless org-log-states-order-reversed | |
10726 | (and (= (char-after) ?\n) (forward-char 1)) | |
10727 | (org-skip-over-state-notes) | |
10728 | (skip-chars-backward " \t\n\r"))) | |
10729 | (move-marker org-log-note-marker (point)) | |
10730 | (setq org-log-note-purpose purpose | |
10731 | org-log-note-state state | |
10732 | org-log-note-previous-state prev-state | |
10733 | org-log-note-how how | |
10734 | org-log-note-extra extra) | |
10735 | (add-hook 'post-command-hook 'org-add-log-note 'append))))) | |
ab27a4a0 | 10736 | |
20908596 CD |
10737 | (defun org-skip-over-state-notes () |
10738 | "Skip past the list of State notes in an entry." | |
10739 | (if (looking-at "\n[ \t]*- State") (forward-char 1)) | |
10740 | (while (looking-at "[ \t]*- State") | |
10741 | (condition-case nil | |
10742 | (org-next-item) | |
10743 | (error (org-end-of-item))))) | |
891f4676 | 10744 | |
20908596 CD |
10745 | (defun org-add-log-note (&optional purpose) |
10746 | "Pop up a window for taking a note, and add this note later at point." | |
10747 | (remove-hook 'post-command-hook 'org-add-log-note) | |
10748 | (setq org-log-note-window-configuration (current-window-configuration)) | |
10749 | (delete-other-windows) | |
10750 | (move-marker org-log-note-return-to (point)) | |
10751 | (switch-to-buffer (marker-buffer org-log-note-marker)) | |
10752 | (goto-char org-log-note-marker) | |
10753 | (org-switch-to-buffer-other-window "*Org Note*") | |
10754 | (erase-buffer) | |
10755 | (if (memq org-log-note-how '(time state)) | |
71d35b24 | 10756 | (let (current-prefix-arg) (org-store-log-note)) |
20908596 CD |
10757 | (let ((org-inhibit-startup t)) (org-mode)) |
10758 | (insert (format "# Insert note for %s. | |
10759 | # Finish with C-c C-c, or cancel with C-c C-k.\n\n" | |
10760 | (cond | |
10761 | ((eq org-log-note-purpose 'clock-out) "stopped clock") | |
10762 | ((eq org-log-note-purpose 'done) "closed todo item") | |
10763 | ((eq org-log-note-purpose 'state) | |
c8d0cf5c CD |
10764 | (format "state change from \"%s\" to \"%s\"" |
10765 | (or org-log-note-previous-state "") | |
10766 | (or org-log-note-state ""))) | |
8bfe682a CD |
10767 | ((eq org-log-note-purpose 'reschedule) |
10768 | "rescheduling") | |
10769 | ((eq org-log-note-purpose 'redeadline) | |
10770 | "changing deadline") | |
20908596 CD |
10771 | ((eq org-log-note-purpose 'note) |
10772 | "this entry") | |
10773 | (t (error "This should not happen"))))) | |
621f83e4 | 10774 | (if org-log-note-extra (insert org-log-note-extra)) |
20908596 | 10775 | (org-set-local 'org-finish-function 'org-store-log-note))) |
ab27a4a0 | 10776 | |
20908596 CD |
10777 | (defvar org-note-abort nil) ; dynamically scoped |
10778 | (defun org-store-log-note () | |
10779 | "Finish taking a log note, and insert it to where it belongs." | |
10780 | (let ((txt (buffer-string)) | |
10781 | (note (cdr (assq org-log-note-purpose org-log-note-headings))) | |
10782 | lines ind) | |
10783 | (kill-buffer (current-buffer)) | |
10784 | (while (string-match "\\`#.*\n[ \t\n]*" txt) | |
10785 | (setq txt (replace-match "" t t txt))) | |
10786 | (if (string-match "\\s-+\\'" txt) | |
10787 | (setq txt (replace-match "" t t txt))) | |
10788 | (setq lines (org-split-string txt "\n")) | |
10789 | (when (and note (string-match "\\S-" note)) | |
10790 | (setq note | |
10791 | (org-replace-escapes | |
10792 | note | |
10793 | (list (cons "%u" (user-login-name)) | |
10794 | (cons "%U" user-full-name) | |
10795 | (cons "%t" (format-time-string | |
10796 | (org-time-stamp-format 'long 'inactive) | |
10797 | (current-time))) | |
10798 | (cons "%s" (if org-log-note-state | |
10799 | (concat "\"" org-log-note-state "\"") | |
c8d0cf5c CD |
10800 | "")) |
10801 | (cons "%S" (if org-log-note-previous-state | |
10802 | (concat "\"" org-log-note-previous-state "\"") | |
10803 | "\"\""))))) | |
20908596 CD |
10804 | (if lines (setq note (concat note " \\\\"))) |
10805 | (push note lines)) | |
c8d0cf5c CD |
10806 | (when (or current-prefix-arg org-note-abort) |
10807 | (when org-log-into-drawer | |
10808 | (org-remove-empty-drawer-at | |
10809 | (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK") | |
10810 | org-log-note-marker)) | |
10811 | (setq lines nil)) | |
20908596 | 10812 | (when lines |
81ad75af | 10813 | (with-current-buffer (marker-buffer org-log-note-marker) |
20908596 CD |
10814 | (save-excursion |
10815 | (goto-char org-log-note-marker) | |
10816 | (move-marker org-log-note-marker nil) | |
10817 | (end-of-line 1) | |
10818 | (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) | |
20908596 CD |
10819 | (insert "- " (pop lines)) |
10820 | (org-indent-line-function) | |
10821 | (beginning-of-line 1) | |
10822 | (looking-at "[ \t]*") | |
10823 | (setq ind (concat (match-string 0) " ")) | |
10824 | (end-of-line 1) | |
c8d0cf5c CD |
10825 | (while lines (insert "\n" ind (pop lines))) |
10826 | (message "Note stored") | |
10827 | (org-back-to-heading t) | |
10828 | (org-cycle-hide-drawers 'children))))) | |
20908596 CD |
10829 | (set-window-configuration org-log-note-window-configuration) |
10830 | (with-current-buffer (marker-buffer org-log-note-return-to) | |
10831 | (goto-char org-log-note-return-to)) | |
10832 | (move-marker org-log-note-return-to nil) | |
10833 | (and org-log-post-message (message "%s" org-log-post-message))) | |
a3fbe8c4 | 10834 | |
c8d0cf5c | 10835 | (defun org-remove-empty-drawer-at (drawer pos) |
8bfe682a | 10836 | "Remove an empty drawer DRAWER at position POS. |
c8d0cf5c CD |
10837 | POS may also be a marker." |
10838 | (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) | |
10839 | (save-excursion | |
10840 | (save-restriction | |
10841 | (widen) | |
10842 | (goto-char pos) | |
10843 | (if (org-in-regexp | |
10844 | (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) | |
10845 | (replace-match "")))))) | |
10846 | ||
20908596 CD |
10847 | (defun org-sparse-tree (&optional arg) |
10848 | "Create a sparse tree, prompt for the details. | |
10849 | This command can create sparse trees. You first need to select the type | |
10850 | of match used to create the tree: | |
d5098885 | 10851 | |
20908596 | 10852 | t Show entries with a specific TODO keyword. |
c8d0cf5c | 10853 | m Show entries selected by a tags/property match. |
20908596 CD |
10854 | p Enter a property name and its value (both with completion on existing |
10855 | names/values) and show entries with that property. | |
8bfe682a | 10856 | / Show entries matching a regular expression (`r' can be used as well) |
c8d0cf5c CD |
10857 | d Show deadlines due within `org-deadline-warning-days'. |
10858 | b Show deadlines and scheduled items before a date. | |
10859 | a Show deadlines and scheduled items after a date." | |
20908596 CD |
10860 | (interactive "P") |
10861 | (let (ans kwd value) | |
c8d0cf5c | 10862 | (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date [a]fter-date") |
20908596 CD |
10863 | (setq ans (read-char-exclusive)) |
10864 | (cond | |
10865 | ((equal ans ?d) | |
10866 | (call-interactively 'org-check-deadlines)) | |
10867 | ((equal ans ?b) | |
10868 | (call-interactively 'org-check-before-date)) | |
c8d0cf5c CD |
10869 | ((equal ans ?a) |
10870 | (call-interactively 'org-check-after-date)) | |
20908596 CD |
10871 | ((equal ans ?t) |
10872 | (org-show-todo-tree '(4))) | |
c8d0cf5c CD |
10873 | ((member ans '(?T ?m)) |
10874 | (call-interactively 'org-match-sparse-tree)) | |
20908596 | 10875 | ((member ans '(?p ?P)) |
54a0dee5 | 10876 | (setq kwd (org-icompleting-read "Property: " |
20908596 | 10877 | (mapcar 'list (org-buffer-property-keys)))) |
54a0dee5 | 10878 | (setq value (org-icompleting-read "Value: " |
20908596 CD |
10879 | (mapcar 'list (org-property-values kwd)))) |
10880 | (unless (string-match "\\`{.*}\\'" value) | |
10881 | (setq value (concat "\"" value "\""))) | |
c8d0cf5c | 10882 | (org-match-sparse-tree arg (concat kwd "=" value))) |
20908596 CD |
10883 | ((member ans '(?r ?R ?/)) |
10884 | (call-interactively 'org-occur)) | |
10885 | (t (error "No such sparse tree command \"%c\"" ans))))) | |
a3fbe8c4 | 10886 | |
20908596 CD |
10887 | (defvar org-occur-highlights nil |
10888 | "List of overlays used for occur matches.") | |
10889 | (make-variable-buffer-local 'org-occur-highlights) | |
10890 | (defvar org-occur-parameters nil | |
10891 | "Parameters of the active org-occur calls. | |
10892 | This is a list, each call to org-occur pushes as cons cell, | |
10893 | containing the regular expression and the callback, onto the list. | |
10894 | The list can contain several entries if `org-occur' has been called | |
10895 | several time with the KEEP-PREVIOUS argument. Otherwise, this list | |
10896 | will only contain one set of parameters. When the highlights are | |
10897 | removed (for example with `C-c C-c', or with the next edit (depending | |
10898 | on `org-remove-highlights-with-change'), this variable is emptied | |
10899 | as well.") | |
10900 | (make-variable-buffer-local 'org-occur-parameters) | |
a3fbe8c4 | 10901 | |
20908596 CD |
10902 | (defun org-occur (regexp &optional keep-previous callback) |
10903 | "Make a compact tree which shows all matches of REGEXP. | |
10904 | The tree will show the lines where the regexp matches, and all higher | |
10905 | headlines above the match. It will also show the heading after the match, | |
10906 | to make sure editing the matching entry is easy. | |
10907 | If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous | |
10908 | call to `org-occur' will be kept, to allow stacking of calls to this | |
10909 | command. | |
10910 | If CALLBACK is non-nil, it is a function which is called to confirm | |
10911 | that the match should indeed be shown." | |
10912 | (interactive "sRegexp: \nP") | |
c8d0cf5c CD |
10913 | (when (equal regexp "") |
10914 | (error "Regexp cannot be empty")) | |
20908596 CD |
10915 | (unless keep-previous |
10916 | (org-remove-occur-highlights nil nil t)) | |
10917 | (push (cons regexp callback) org-occur-parameters) | |
10918 | (let ((cnt 0)) | |
a3fbe8c4 | 10919 | (save-excursion |
a3fbe8c4 | 10920 | (goto-char (point-min)) |
20908596 CD |
10921 | (if (or (not keep-previous) ; do not want to keep |
10922 | (not org-occur-highlights)) ; no previous matches | |
10923 | ;; hide everything | |
10924 | (org-overview)) | |
10925 | (while (re-search-forward regexp nil t) | |
10926 | (when (or (not callback) | |
10927 | (save-match-data (funcall callback))) | |
10928 | (setq cnt (1+ cnt)) | |
10929 | (when org-highlight-sparse-tree-matches | |
10930 | (org-highlight-new-match (match-beginning 0) (match-end 0))) | |
10931 | (org-show-context 'occur-tree)))) | |
10932 | (when org-remove-highlights-with-change | |
10933 | (org-add-hook 'before-change-functions 'org-remove-occur-highlights | |
10934 | nil 'local)) | |
10935 | (unless org-sparse-tree-open-archived-trees | |
10936 | (org-hide-archived-subtrees (point-min) (point-max))) | |
10937 | (run-hooks 'org-occur-hook) | |
10938 | (if (interactive-p) | |
10939 | (message "%d match(es) for regexp %s" cnt regexp)) | |
10940 | cnt)) | |
a3fbe8c4 | 10941 | |
20908596 CD |
10942 | (defun org-show-context (&optional key) |
10943 | "Make sure point and context and visible. | |
10944 | How much context is shown depends upon the variables | |
10945 | `org-show-hierarchy-above', `org-show-following-heading'. and | |
10946 | `org-show-siblings'." | |
10947 | (let ((heading-p (org-on-heading-p t)) | |
10948 | (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) | |
10949 | (following-p (org-get-alist-option org-show-following-heading key)) | |
10950 | (entry-p (org-get-alist-option org-show-entry-below key)) | |
10951 | (siblings-p (org-get-alist-option org-show-siblings key))) | |
10952 | (catch 'exit | |
10953 | ;; Show heading or entry text | |
10954 | (if (and heading-p (not entry-p)) | |
10955 | (org-flag-heading nil) ; only show the heading | |
10956 | (and (or entry-p (org-invisible-p) (org-invisible-p2)) | |
10957 | (org-show-hidden-entry))) ; show entire entry | |
10958 | (when following-p | |
10959 | ;; Show next sibling, or heading below text | |
10960 | (save-excursion | |
10961 | (and (if heading-p (org-goto-sibling) (outline-next-heading)) | |
10962 | (org-flag-heading nil)))) | |
10963 | (when siblings-p (org-show-siblings)) | |
10964 | (when hierarchy-p | |
10965 | ;; show all higher headings, possibly with siblings | |
10966 | (save-excursion | |
10967 | (while (and (condition-case nil | |
10968 | (progn (org-up-heading-all 1) t) | |
10969 | (error nil)) | |
10970 | (not (bobp))) | |
10971 | (org-flag-heading nil) | |
10972 | (when siblings-p (org-show-siblings)))))))) | |
a3fbe8c4 | 10973 | |
20908596 CD |
10974 | (defun org-reveal (&optional siblings) |
10975 | "Show current entry, hierarchy above it, and the following headline. | |
10976 | This can be used to show a consistent set of context around locations | |
10977 | exposed with `org-show-hierarchy-above' or `org-show-following-heading' | |
10978 | not t for the search context. | |
891f4676 | 10979 | |
20908596 CD |
10980 | With optional argument SIBLINGS, on each level of the hierarchy all |
10981 | siblings are shown. This repairs the tree structure to what it would | |
10982 | look like when opened with hierarchical calls to `org-cycle'." | |
10983 | (interactive "P") | |
10984 | (let ((org-show-hierarchy-above t) | |
10985 | (org-show-following-heading t) | |
10986 | (org-show-siblings (if siblings t org-show-siblings))) | |
10987 | (org-show-context nil))) | |
891f4676 | 10988 | |
20908596 CD |
10989 | (defun org-highlight-new-match (beg end) |
10990 | "Highlight from BEG to END and mark the highlight is an occur headline." | |
10991 | (let ((ov (org-make-overlay beg end))) | |
10992 | (org-overlay-put ov 'face 'secondary-selection) | |
10993 | (push ov org-occur-highlights))) | |
791d856f | 10994 | |
20908596 CD |
10995 | (defun org-remove-occur-highlights (&optional beg end noremove) |
10996 | "Remove the occur highlights from the buffer. | |
10997 | BEG and END are ignored. If NOREMOVE is nil, remove this function | |
10998 | from the `before-change-functions' in the current buffer." | |
10999 | (interactive) | |
11000 | (unless org-inhibit-highlight-removal | |
11001 | (mapc 'org-delete-overlay org-occur-highlights) | |
11002 | (setq org-occur-highlights nil) | |
11003 | (setq org-occur-parameters nil) | |
11004 | (unless noremove | |
11005 | (remove-hook 'before-change-functions | |
11006 | 'org-remove-occur-highlights 'local)))) | |
891f4676 | 11007 | |
20908596 | 11008 | ;;;; Priorities |
891f4676 | 11009 | |
20908596 CD |
11010 | (defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)" |
11011 | "Regular expression matching the priority indicator.") | |
d3f4dbe8 | 11012 | |
20908596 | 11013 | (defvar org-remove-priority-next-time nil) |
891f4676 | 11014 | |
20908596 CD |
11015 | (defun org-priority-up () |
11016 | "Increase the priority of the current item." | |
03f3cf35 | 11017 | (interactive) |
20908596 | 11018 | (org-priority 'up)) |
891f4676 | 11019 | |
20908596 CD |
11020 | (defun org-priority-down () |
11021 | "Decrease the priority of the current item." | |
11022 | (interactive) | |
11023 | (org-priority 'down)) | |
5bf7807a | 11024 | |
20908596 CD |
11025 | (defun org-priority (&optional action) |
11026 | "Change the priority of an item by ARG. | |
11027 | ACTION can be `set', `up', `down', or a character." | |
11028 | (interactive) | |
c8d0cf5c CD |
11029 | (unless org-enable-priority-commands |
11030 | (error "Priority commands are disabled")) | |
20908596 CD |
11031 | (setq action (or action 'set)) |
11032 | (let (current new news have remove) | |
11033 | (save-excursion | |
9148fdd0 | 11034 | (org-back-to-heading t) |
20908596 CD |
11035 | (if (looking-at org-priority-regexp) |
11036 | (setq current (string-to-char (match-string 2)) | |
11037 | have t) | |
11038 | (setq current org-default-priority)) | |
11039 | (cond | |
8bfe682a CD |
11040 | ((eq action 'remove) |
11041 | (setq remove t new ?\ )) | |
20908596 CD |
11042 | ((or (eq action 'set) |
11043 | (if (featurep 'xemacs) (characterp action) (integerp action))) | |
11044 | (if (not (eq action 'set)) | |
11045 | (setq new action) | |
11046 | (message "Priority %c-%c, SPC to remove: " | |
11047 | org-highest-priority org-lowest-priority) | |
11048 | (setq new (read-char-exclusive))) | |
11049 | (if (and (= (upcase org-highest-priority) org-highest-priority) | |
11050 | (= (upcase org-lowest-priority) org-lowest-priority)) | |
11051 | (setq new (upcase new))) | |
11052 | (cond ((equal new ?\ ) (setq remove t)) | |
11053 | ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) | |
11054 | (error "Priority must be between `%c' and `%c'" | |
11055 | org-highest-priority org-lowest-priority)))) | |
11056 | ((eq action 'up) | |
11057 | (if (and (not have) (eq last-command this-command)) | |
11058 | (setq new org-lowest-priority) | |
11059 | (setq new (if (and org-priority-start-cycle-with-default (not have)) | |
11060 | org-default-priority (1- current))))) | |
11061 | ((eq action 'down) | |
11062 | (if (and (not have) (eq last-command this-command)) | |
11063 | (setq new org-highest-priority) | |
11064 | (setq new (if (and org-priority-start-cycle-with-default (not have)) | |
11065 | org-default-priority (1+ current))))) | |
11066 | (t (error "Invalid action"))) | |
11067 | (if (or (< (upcase new) org-highest-priority) | |
11068 | (> (upcase new) org-lowest-priority)) | |
11069 | (setq remove t)) | |
11070 | (setq news (format "%c" new)) | |
11071 | (if have | |
11072 | (if remove | |
11073 | (replace-match "" t t nil 1) | |
11074 | (replace-match news t t nil 2)) | |
11075 | (if remove | |
11076 | (error "No priority cookie found in line") | |
c8d0cf5c CD |
11077 | (let ((case-fold-search nil)) |
11078 | (looking-at org-todo-line-regexp)) | |
20908596 CD |
11079 | (if (match-end 2) |
11080 | (progn | |
11081 | (goto-char (match-end 2)) | |
11082 | (insert " [#" news "]")) | |
11083 | (goto-char (match-beginning 3)) | |
c8d0cf5c CD |
11084 | (insert "[#" news "] ")))) |
11085 | (org-preserve-lc (org-set-tags nil 'align))) | |
20908596 CD |
11086 | (if remove |
11087 | (message "Priority removed") | |
11088 | (message "Priority of current item set to %s" news)))) | |
5bf7807a | 11089 | |
20908596 CD |
11090 | (defun org-get-priority (s) |
11091 | "Find priority cookie and return priority." | |
11092 | (save-match-data | |
11093 | (if (not (string-match org-priority-regexp s)) | |
11094 | (* 1000 (- org-lowest-priority org-default-priority)) | |
11095 | (* 1000 (- org-lowest-priority | |
11096 | (string-to-char (match-string 2 s))))))) | |
891f4676 | 11097 | |
20908596 | 11098 | ;;;; Tags |
634a7d0b | 11099 | |
2c3ad40d | 11100 | (defvar org-agenda-archives-mode) |
c8d0cf5c CD |
11101 | (defvar org-map-continue-from nil |
11102 | "Position from where mapping should continue. | |
8bfe682a | 11103 | Can be set by the action argument to `org-scan-tag's and `org-map-entries'.") |
c8d0cf5c CD |
11104 | |
11105 | (defvar org-scanner-tags nil | |
11106 | "The current tag list while the tags scanner is running.") | |
11107 | (defvar org-trust-scanner-tags nil | |
11108 | "Should `org-get-tags-at' use the tags fro the scanner. | |
11109 | This is for internal dynamical scoping only. | |
11110 | When this is non-nil, the function `org-get-tags-at' will return the value | |
11111 | of `org-scanner-tags' instead of building the list by itself. This | |
11112 | can lead to large speed-ups when the tags scanner is used in a file with | |
11113 | many entries, and when the list of tags is retrieved, for example to | |
11114 | obtain a list of properties. Building the tags list for each entry in such | |
11115 | a file becomes an N^2 operation - but with this variable set, it scales | |
11116 | as N.") | |
11117 | ||
20908596 CD |
11118 | (defun org-scan-tags (action matcher &optional todo-only) |
11119 | "Scan headline tags with inheritance and produce output ACTION. | |
b349f79f CD |
11120 | |
11121 | ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, | |
11122 | or `agenda' to produce an entry list for an agenda view. It can also be | |
11123 | a Lisp form or a function that should be called at each matched headline, in | |
11124 | this case the return value is a list of all return values from these calls. | |
11125 | ||
11126 | MATCHER is a Lisp form to be evaluated, testing if a given set of tags | |
11127 | qualifies a headline for inclusion. When TODO-ONLY is non-nil, | |
11128 | only lines with a TODO keyword are included in the output." | |
0bd48b37 | 11129 | (require 'org-agenda) |
c8d0cf5c | 11130 | (let* ((re (concat "^" outline-regexp " *\\(\\<\\(" |
20908596 CD |
11131 | (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") |
11132 | (org-re | |
11133 | "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) | |
2c3ad40d | 11134 | (props (list 'face 'default |
c8d0cf5c | 11135 | 'done-face 'org-agenda-done |
2c3ad40d | 11136 | 'undone-face 'default |
20908596 CD |
11137 | 'mouse-face 'highlight |
11138 | 'org-not-done-regexp org-not-done-regexp | |
11139 | 'org-todo-regexp org-todo-regexp | |
20908596 CD |
11140 | 'help-echo |
11141 | (format "mouse-2 or RET jump to org file %s" | |
11142 | (abbreviate-file-name | |
11143 | (or (buffer-file-name (buffer-base-buffer)) | |
11144 | (buffer-name (buffer-base-buffer))))))) | |
11145 | (case-fold-search nil) | |
c8d0cf5c | 11146 | (org-map-continue-from nil) |
b349f79f | 11147 | lspos tags tags-list |
c8d0cf5c | 11148 | (tags-alist (list (cons 0 org-file-tags))) |
b349f79f | 11149 | (llast 0) rtn rtn1 level category i txt |
20908596 | 11150 | todo marker entry priority) |
621f83e4 | 11151 | (when (not (or (member action '(agenda sparse-tree)) (functionp action))) |
b349f79f | 11152 | (setq action (list 'lambda nil action))) |
20908596 CD |
11153 | (save-excursion |
11154 | (goto-char (point-min)) | |
11155 | (when (eq action 'sparse-tree) | |
11156 | (org-overview) | |
11157 | (org-remove-occur-highlights)) | |
11158 | (while (re-search-forward re nil t) | |
11159 | (catch :skip | |
c8d0cf5c CD |
11160 | (setq todo (if (match-end 1) (org-match-string-no-properties 2)) |
11161 | tags (if (match-end 4) (org-match-string-no-properties 4))) | |
11162 | (goto-char (setq lspos (match-beginning 0))) | |
20908596 CD |
11163 | (setq level (org-reduced-level (funcall outline-level)) |
11164 | category (org-get-category)) | |
11165 | (setq i llast llast level) | |
11166 | ;; remove tag lists from same and sublevels | |
11167 | (while (>= i level) | |
11168 | (when (setq entry (assoc i tags-alist)) | |
11169 | (setq tags-alist (delete entry tags-alist))) | |
11170 | (setq i (1- i))) | |
11171 | ;; add the next tags | |
11172 | (when tags | |
c8d0cf5c | 11173 | (setq tags (org-split-string tags ":") |
20908596 CD |
11174 | tags-alist |
11175 | (cons (cons level tags) tags-alist))) | |
11176 | ;; compile tags for current headline | |
11177 | (setq tags-list | |
11178 | (if org-use-tag-inheritance | |
ff4be292 | 11179 | (apply 'append (mapcar 'cdr (reverse tags-alist))) |
c8d0cf5c CD |
11180 | tags) |
11181 | org-scanner-tags tags-list) | |
ff4be292 CD |
11182 | (when org-use-tag-inheritance |
11183 | (setcdr (car tags-alist) | |
11184 | (mapcar (lambda (x) | |
11185 | (setq x (copy-sequence x)) | |
11186 | (org-add-prop-inherited x)) | |
11187 | (cdar tags-alist)))) | |
20908596 | 11188 | (when (and tags org-use-tag-inheritance |
c8d0cf5c CD |
11189 | (or (not (eq t org-use-tag-inheritance)) |
11190 | org-tags-exclude-from-inheritance)) | |
20908596 CD |
11191 | ;; selective inheritance, remove uninherited ones |
11192 | (setcdr (car tags-alist) | |
11193 | (org-remove-uniherited-tags (cdar tags-alist)))) | |
0bd48b37 CD |
11194 | (when (and (or (not todo-only) |
11195 | (and (member todo org-not-done-keywords) | |
11196 | (or (not org-agenda-tags-todo-honor-ignore-options) | |
11197 | (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))) | |
621f83e4 | 11198 | (let ((case-fold-search t)) (eval matcher)) |
2c3ad40d CD |
11199 | (or |
11200 | (not (member org-archive-tag tags-list)) | |
11201 | ;; we have an archive tag, should we use this anyway? | |
11202 | (or (not org-agenda-skip-archived-trees) | |
11203 | (and (eq action 'agenda) org-agenda-archives-mode)))) | |
b349f79f | 11204 | (unless (eq action 'sparse-tree) (org-agenda-skip)) |
03f3cf35 | 11205 | |
b349f79f CD |
11206 | ;; select this headline |
11207 | ||
11208 | (cond | |
11209 | ((eq action 'sparse-tree) | |
11210 | (and org-highlight-sparse-tree-matches | |
11211 | (org-get-heading) (match-end 0) | |
11212 | (org-highlight-new-match | |
11213 | (match-beginning 0) (match-beginning 1))) | |
11214 | (org-show-context 'tags-tree)) | |
11215 | ((eq action 'agenda) | |
20908596 CD |
11216 | (setq txt (org-format-agenda-item |
11217 | "" | |
11218 | (concat | |
c8d0cf5c | 11219 | (if (eq org-tags-match-list-sublevels 'indented) |
20908596 CD |
11220 | (make-string (1- level) ?.) "") |
11221 | (org-get-heading)) | |
c8d0cf5c CD |
11222 | category |
11223 | tags-list | |
11224 | ) | |
20908596 CD |
11225 | priority (org-get-priority txt)) |
11226 | (goto-char lspos) | |
11227 | (setq marker (org-agenda-new-marker)) | |
11228 | (org-add-props txt props | |
11229 | 'org-marker marker 'org-hd-marker marker 'org-category category | |
c8d0cf5c | 11230 | 'todo-state todo |
20908596 CD |
11231 | 'priority priority 'type "tagsmatch") |
11232 | (push txt rtn)) | |
b349f79f | 11233 | ((functionp action) |
c8d0cf5c | 11234 | (setq org-map-continue-from nil) |
b349f79f CD |
11235 | (save-excursion |
11236 | (setq rtn1 (funcall action)) | |
c8d0cf5c | 11237 | (push rtn1 rtn))) |
b349f79f CD |
11238 | (t (error "Invalid action"))) |
11239 | ||
20908596 | 11240 | ;; if we are to skip sublevels, jump to end of subtree |
c8d0cf5c CD |
11241 | (unless org-tags-match-list-sublevels |
11242 | (org-end-of-subtree t) | |
11243 | (backward-char 1)))) | |
11244 | ;; Get the correct position from where to continue | |
11245 | (if org-map-continue-from | |
11246 | (goto-char org-map-continue-from) | |
11247 | (and (= (point) lspos) (end-of-line 1))))) | |
20908596 CD |
11248 | (when (and (eq action 'sparse-tree) |
11249 | (not org-sparse-tree-open-archived-trees)) | |
11250 | (org-hide-archived-subtrees (point-min) (point-max))) | |
11251 | (nreverse rtn))) | |
891f4676 | 11252 | |
20908596 CD |
11253 | (defun org-remove-uniherited-tags (tags) |
11254 | "Remove all tags that are not inherited from the list TAGS." | |
11255 | (cond | |
ff4be292 CD |
11256 | ((eq org-use-tag-inheritance t) |
11257 | (if org-tags-exclude-from-inheritance | |
11258 | (org-delete-all org-tags-exclude-from-inheritance tags) | |
11259 | tags)) | |
20908596 CD |
11260 | ((not org-use-tag-inheritance) nil) |
11261 | ((stringp org-use-tag-inheritance) | |
11262 | (delq nil (mapcar | |
ff4be292 CD |
11263 | (lambda (x) |
11264 | (if (and (string-match org-use-tag-inheritance x) | |
11265 | (not (member x org-tags-exclude-from-inheritance))) | |
11266 | x nil)) | |
20908596 CD |
11267 | tags))) |
11268 | ((listp org-use-tag-inheritance) | |
621f83e4 | 11269 | (delq nil (mapcar |
ff4be292 CD |
11270 | (lambda (x) |
11271 | (if (member x org-use-tag-inheritance) x nil)) | |
621f83e4 | 11272 | tags))))) |
2a57416f | 11273 | |
20908596 CD |
11274 | (defvar todo-only) ;; dynamically scoped |
11275 | ||
c8d0cf5c | 11276 | (defun org-match-sparse-tree (&optional todo-only match) |
d60b1ba1 | 11277 | "Create a sparse tree according to tags string MATCH. |
20908596 CD |
11278 | MATCH can contain positive and negative selection of tags, like |
11279 | \"+WORK+URGENT-WITHBOSS\". | |
d60b1ba1 | 11280 | If optional argument TODO-ONLY is non-nil, only select lines that are |
20908596 CD |
11281 | also TODO lines." |
11282 | (interactive "P") | |
11283 | (org-prepare-agenda-buffers (list (current-buffer))) | |
11284 | (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) | |
15841868 | 11285 | |
c8d0cf5c CD |
11286 | (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) |
11287 | ||
20908596 CD |
11288 | (defvar org-cached-props nil) |
11289 | (defun org-cached-entry-get (pom property) | |
11290 | (if (or (eq t org-use-property-inheritance) | |
11291 | (and (stringp org-use-property-inheritance) | |
11292 | (string-match org-use-property-inheritance property)) | |
11293 | (and (listp org-use-property-inheritance) | |
11294 | (member property org-use-property-inheritance))) | |
11295 | ;; Caching is not possible, check it directly | |
11296 | (org-entry-get pom property 'inherit) | |
11297 | ;; Get all properties, so that we can do complicated checks easily | |
11298 | (cdr (assoc property (or org-cached-props | |
11299 | (setq org-cached-props | |
11300 | (org-entry-properties pom))))))) | |
15841868 | 11301 | |
20908596 CD |
11302 | (defun org-global-tags-completion-table (&optional files) |
11303 | "Return the list of all tags in all agenda buffer/files." | |
11304 | (save-excursion | |
11305 | (org-uniquify | |
11306 | (delq nil | |
11307 | (apply 'append | |
11308 | (mapcar | |
11309 | (lambda (file) | |
11310 | (set-buffer (find-file-noselect file)) | |
11311 | (append (org-get-buffer-tags) | |
11312 | (mapcar (lambda (x) (if (stringp (car-safe x)) | |
11313 | (list (car-safe x)) nil)) | |
11314 | org-tag-alist))) | |
11315 | (if (and files (car files)) | |
11316 | files | |
11317 | (org-agenda-files)))))))) | |
2a57416f | 11318 | |
20908596 CD |
11319 | (defun org-make-tags-matcher (match) |
11320 | "Create the TAGS//TODO matcher form for the selection string MATCH." | |
11321 | ;; todo-only is scoped dynamically into this function, and the function | |
33306645 | 11322 | ;; may change it if the matcher asks for it. |
20908596 CD |
11323 | (unless match |
11324 | ;; Get a new match request, with completion | |
11325 | (let ((org-last-tags-completion-table | |
11326 | (org-global-tags-completion-table))) | |
54a0dee5 | 11327 | (setq match (org-completing-read-no-i |
20908596 CD |
11328 | "Match: " 'org-tags-completion-function nil nil nil |
11329 | 'org-tags-history)))) | |
15841868 | 11330 | |
20908596 CD |
11331 | ;; Parse the string and create a lisp form |
11332 | (let ((match0 match) | |
11333 | (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)")) | |
11334 | minus tag mm | |
11335 | tagsmatch todomatch tagsmatcher todomatcher kwd matcher | |
621f83e4 | 11336 | orterms term orlist re-p str-p level-p level-op time-p |
93b62de8 | 11337 | prop-p pn pv po cat-p gv rest) |
20908596 CD |
11338 | (if (string-match "/+" match) |
11339 | ;; match contains also a todo-matching request | |
11340 | (progn | |
11341 | (setq tagsmatch (substring match 0 (match-beginning 0)) | |
11342 | todomatch (substring match (match-end 0))) | |
11343 | (if (string-match "^!" todomatch) | |
11344 | (setq todo-only t todomatch (substring todomatch 1))) | |
11345 | (if (string-match "^\\s-*$" todomatch) | |
11346 | (setq todomatch nil))) | |
11347 | ;; only matching tags | |
11348 | (setq tagsmatch match todomatch nil)) | |
15841868 | 11349 | |
20908596 CD |
11350 | ;; Make the tags matcher |
11351 | (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) | |
11352 | (setq tagsmatcher t) | |
11353 | (setq orterms (org-split-string tagsmatch "|") orlist nil) | |
11354 | (while (setq term (pop orterms)) | |
11355 | (while (and (equal (substring term -1) "\\") orterms) | |
11356 | (setq term (concat term "|" (pop orterms)))) ; repair bad split | |
11357 | (while (string-match re term) | |
93b62de8 CD |
11358 | (setq rest (substring term (match-end 0)) |
11359 | minus (and (match-end 1) | |
20908596 CD |
11360 | (equal (match-string 1 term) "-")) |
11361 | tag (match-string 2 term) | |
11362 | re-p (equal (string-to-char tag) ?{) | |
11363 | level-p (match-end 4) | |
11364 | prop-p (match-end 5) | |
11365 | mm (cond | |
11366 | (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) | |
11367 | (level-p | |
11368 | (setq level-op (org-op-to-function (match-string 3 term))) | |
11369 | `(,level-op level ,(string-to-number | |
11370 | (match-string 4 term)))) | |
11371 | (prop-p | |
11372 | (setq pn (match-string 5 term) | |
11373 | po (match-string 6 term) | |
11374 | pv (match-string 7 term) | |
11375 | cat-p (equal pn "CATEGORY") | |
11376 | re-p (equal (string-to-char pv) ?{) | |
11377 | str-p (equal (string-to-char pv) ?\") | |
93b62de8 CD |
11378 | time-p (save-match-data |
11379 | (string-match "^\"[[<].*[]>]\"$" pv)) | |
20908596 | 11380 | pv (if (or re-p str-p) (substring pv 1 -1) pv)) |
2c3ad40d CD |
11381 | (if time-p (setq pv (org-matcher-time pv))) |
11382 | (setq po (org-op-to-function po (if time-p 'time str-p))) | |
93b62de8 CD |
11383 | (cond |
11384 | ((equal pn "CATEGORY") | |
11385 | (setq gv '(get-text-property (point) 'org-category))) | |
11386 | ((equal pn "TODO") | |
11387 | (setq gv 'todo)) | |
11388 | (t | |
11389 | (setq gv `(org-cached-entry-get nil ,pn)))) | |
20908596 CD |
11390 | (if re-p |
11391 | (if (eq po 'org<>) | |
11392 | `(not (string-match ,pv (or ,gv ""))) | |
11393 | `(string-match ,pv (or ,gv ""))) | |
11394 | (if str-p | |
11395 | `(,po (or ,gv "") ,pv) | |
11396 | `(,po (string-to-number (or ,gv "")) | |
11397 | ,(string-to-number pv) )))) | |
c8d0cf5c | 11398 | (t `(member ,tag tags-list))) |
20908596 | 11399 | mm (if minus (list 'not mm) mm) |
93b62de8 | 11400 | term rest) |
20908596 CD |
11401 | (push mm tagsmatcher)) |
11402 | (push (if (> (length tagsmatcher) 1) | |
11403 | (cons 'and tagsmatcher) | |
11404 | (car tagsmatcher)) | |
11405 | orlist) | |
11406 | (setq tagsmatcher nil)) | |
11407 | (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) | |
11408 | (setq tagsmatcher | |
11409 | (list 'progn '(setq org-cached-props nil) tagsmatcher))) | |
11410 | ;; Make the todo matcher | |
11411 | (if (or (not todomatch) (not (string-match "\\S-" todomatch))) | |
11412 | (setq todomatcher t) | |
11413 | (setq orterms (org-split-string todomatch "|") orlist nil) | |
11414 | (while (setq term (pop orterms)) | |
11415 | (while (string-match re term) | |
11416 | (setq minus (and (match-end 1) | |
11417 | (equal (match-string 1 term) "-")) | |
11418 | kwd (match-string 2 term) | |
11419 | re-p (equal (string-to-char kwd) ?{) | |
11420 | term (substring term (match-end 0)) | |
11421 | mm (if re-p | |
11422 | `(string-match ,(substring kwd 1 -1) todo) | |
11423 | (list 'equal 'todo kwd)) | |
11424 | mm (if minus (list 'not mm) mm)) | |
11425 | (push mm todomatcher)) | |
11426 | (push (if (> (length todomatcher) 1) | |
11427 | (cons 'and todomatcher) | |
11428 | (car todomatcher)) | |
11429 | orlist) | |
11430 | (setq todomatcher nil)) | |
11431 | (setq todomatcher (if (> (length orlist) 1) | |
11432 | (cons 'or orlist) (car orlist)))) | |
a3fbe8c4 | 11433 | |
20908596 CD |
11434 | ;; Return the string and lisp forms of the matcher |
11435 | (setq matcher (if todomatcher | |
11436 | (list 'and tagsmatcher todomatcher) | |
11437 | tagsmatcher)) | |
11438 | (cons match0 matcher))) | |
d3f4dbe8 | 11439 | |
20908596 | 11440 | (defun org-op-to-function (op &optional stringp) |
2c3ad40d | 11441 | "Turn an operator into the appropriate function." |
20908596 CD |
11442 | (setq op |
11443 | (cond | |
2c3ad40d CD |
11444 | ((equal op "<" ) '(< string< org-time<)) |
11445 | ((equal op ">" ) '(> org-string> org-time>)) | |
11446 | ((member op '("<=" "=<")) '(<= org-string<= org-time<=)) | |
11447 | ((member op '(">=" "=>")) '(>= org-string>= org-time>=)) | |
11448 | ((member op '("=" "==")) '(= string= org-time=)) | |
11449 | ((member op '("<>" "!=")) '(org<> org-string<> org-time<>)))) | |
11450 | (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op)) | |
20908596 CD |
11451 | |
11452 | (defun org<> (a b) (not (= a b))) | |
11453 | (defun org-string<= (a b) (or (string= a b) (string< a b))) | |
11454 | (defun org-string>= (a b) (not (string< a b))) | |
11455 | (defun org-string> (a b) (and (not (string= a b)) (not (string< a b)))) | |
11456 | (defun org-string<> (a b) (not (string= a b))) | |
0bd48b37 CD |
11457 | (defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b))) |
11458 | (defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b))) | |
11459 | (defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b))) | |
11460 | (defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b))) | |
11461 | (defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b))) | |
11462 | (defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b))) | |
2c3ad40d CD |
11463 | (defun org-2ft (s) |
11464 | "Convert S to a floating point time. | |
11465 | If S is already a number, just return it. If it is a string, parse | |
0bd48b37 | 11466 | it as a time string and apply `float-time' to it. If S is nil, just return 0." |
2c3ad40d CD |
11467 | (cond |
11468 | ((numberp s) s) | |
11469 | ((stringp s) | |
11470 | (condition-case nil | |
11471 | (float-time (apply 'encode-time (org-parse-time-string s))) | |
11472 | (error 0.))) | |
11473 | (t 0.))) | |
11474 | ||
ce4fdcb9 CD |
11475 | (defun org-time-today () |
11476 | "Time in seconds today at 0:00. | |
11477 | Returns the float number of seconds since the beginning of the | |
11478 | epoch to the beginning of today (00:00)." | |
11479 | (float-time (apply 'encode-time | |
11480 | (append '(0 0 0) (nthcdr 3 (decode-time)))))) | |
11481 | ||
2c3ad40d | 11482 | (defun org-matcher-time (s) |
33306645 | 11483 | "Interpret a time comparison value." |
ff4be292 CD |
11484 | (save-match-data |
11485 | (cond | |
11486 | ((string= s "<now>") (float-time)) | |
11487 | ((string= s "<today>") (org-time-today)) | |
11488 | ((string= s "<tomorrow>") (+ 86400.0 (org-time-today))) | |
11489 | ((string= s "<yesterday>") (- (org-time-today) 86400.0)) | |
11490 | ((string-match "^<\\([-+][0-9]+\\)\\([dwmy]\\)>$" s) | |
11491 | (+ (org-time-today) | |
11492 | (* (string-to-number (match-string 1 s)) | |
11493 | (cdr (assoc (match-string 2 s) | |
11494 | '(("d" . 86400.0) ("w" . 604800.0) | |
11495 | ("m" . 2678400.0) ("y" . 31557600.0))))))) | |
11496 | (t (org-2ft s))))) | |
15841868 | 11497 | |
20908596 CD |
11498 | (defun org-match-any-p (re list) |
11499 | "Does re match any element of list?" | |
11500 | (setq list (mapcar (lambda (x) (string-match re x)) list)) | |
11501 | (delq nil list)) | |
15841868 | 11502 | |
33306645 | 11503 | (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param |
20908596 CD |
11504 | (defvar org-tags-overlay (org-make-overlay 1 1)) |
11505 | (org-detach-overlay org-tags-overlay) | |
e0e66b8e | 11506 | |
621f83e4 CD |
11507 | (defun org-get-local-tags-at (&optional pos) |
11508 | "Get a list of tags defined in the current headline." | |
11509 | (org-get-tags-at pos 'local)) | |
11510 | ||
11511 | (defun org-get-local-tags () | |
11512 | "Get a list of tags defined in the current headline." | |
11513 | (org-get-tags-at nil 'local)) | |
11514 | ||
11515 | (defun org-get-tags-at (&optional pos local) | |
20908596 CD |
11516 | "Get a list of all headline tags applicable at POS. |
11517 | POS defaults to point. If tags are inherited, the list contains | |
11518 | the targets in the same sequence as the headlines appear, i.e. | |
621f83e4 CD |
11519 | the tags of the current headline come last. |
11520 | When LOCAL is non-nil, only return tags from the current headline, | |
11521 | ignore inherited ones." | |
d3f4dbe8 | 11522 | (interactive) |
c8d0cf5c CD |
11523 | (if (and org-trust-scanner-tags |
11524 | (or (not pos) (equal pos (point))) | |
11525 | (not local)) | |
11526 | org-scanner-tags | |
11527 | (let (tags ltags lastpos parent) | |
11528 | (save-excursion | |
11529 | (save-restriction | |
11530 | (widen) | |
11531 | (goto-char (or pos (point))) | |
11532 | (save-match-data | |
11533 | (catch 'done | |
11534 | (condition-case nil | |
11535 | (progn | |
11536 | (org-back-to-heading t) | |
11537 | (while (not (equal lastpos (point))) | |
11538 | (setq lastpos (point)) | |
11539 | (when (looking-at | |
11540 | (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) | |
11541 | (setq ltags (org-split-string | |
11542 | (org-match-string-no-properties 1) ":")) | |
11543 | (when parent | |
11544 | (setq ltags (mapcar 'org-add-prop-inherited ltags))) | |
11545 | (setq tags (append | |
11546 | (if parent | |
11547 | (org-remove-uniherited-tags ltags) | |
11548 | ltags) | |
11549 | tags))) | |
11550 | (or org-use-tag-inheritance (throw 'done t)) | |
11551 | (if local (throw 'done t)) | |
11552 | (or (org-up-heading-safe) (error nil)) | |
11553 | (setq parent t))) | |
11554 | (error nil))))) | |
11555 | (append (org-remove-uniherited-tags org-file-tags) tags))))) | |
d3f4dbe8 | 11556 | |
ff4be292 CD |
11557 | (defun org-add-prop-inherited (s) |
11558 | (add-text-properties 0 (length s) '(inherited t) s) | |
11559 | s) | |
11560 | ||
20908596 CD |
11561 | (defun org-toggle-tag (tag &optional onoff) |
11562 | "Toggle the tag TAG for the current line. | |
11563 | If ONOFF is `on' or `off', don't toggle but set to this state." | |
20908596 | 11564 | (let (res current) |
15841868 | 11565 | (save-excursion |
db55f368 | 11566 | (org-back-to-heading t) |
20908596 CD |
11567 | (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") |
11568 | (point-at-eol) t) | |
11569 | (progn | |
11570 | (setq current (match-string 1)) | |
11571 | (replace-match "")) | |
11572 | (setq current "")) | |
11573 | (setq current (nreverse (org-split-string current ":"))) | |
11574 | (cond | |
11575 | ((eq onoff 'on) | |
11576 | (setq res t) | |
11577 | (or (member tag current) (push tag current))) | |
11578 | ((eq onoff 'off) | |
11579 | (or (not (member tag current)) (setq current (delete tag current)))) | |
11580 | (t (if (member tag current) | |
11581 | (setq current (delete tag current)) | |
11582 | (setq res t) | |
11583 | (push tag current)))) | |
15841868 | 11584 | (end-of-line 1) |
20908596 CD |
11585 | (if current |
11586 | (progn | |
11587 | (insert " :" (mapconcat 'identity (nreverse current) ":") ":") | |
11588 | (org-set-tags nil t)) | |
11589 | (delete-horizontal-space)) | |
11590 | (run-hooks 'org-after-tags-change-hook)) | |
11591 | res)) | |
15841868 | 11592 | |
20908596 CD |
11593 | (defun org-align-tags-here (to-col) |
11594 | ;; Assumes that this is a headline | |
11595 | (let ((pos (point)) (col (current-column)) ncol tags-l p) | |
891f4676 | 11596 | (beginning-of-line 1) |
20908596 CD |
11597 | (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) |
11598 | (< pos (match-beginning 2))) | |
11599 | (progn | |
11600 | (setq tags-l (- (match-end 2) (match-beginning 2))) | |
11601 | (goto-char (match-beginning 1)) | |
11602 | (insert " ") | |
11603 | (delete-region (point) (1+ (match-beginning 2))) | |
11604 | (setq ncol (max (1+ (current-column)) | |
11605 | (1+ col) | |
11606 | (if (> to-col 0) | |
11607 | to-col | |
11608 | (- (abs to-col) tags-l)))) | |
11609 | (setq p (point)) | |
11610 | (insert (make-string (- ncol (current-column)) ?\ )) | |
11611 | (setq ncol (current-column)) | |
b349f79f | 11612 | (when indent-tabs-mode (tabify p (point-at-eol))) |
20908596 CD |
11613 | (org-move-to-column (min ncol col) t)) |
11614 | (goto-char pos)))) | |
2a57416f | 11615 | |
71d35b24 CD |
11616 | (defun org-set-tags-command (&optional arg just-align) |
11617 | "Call the set-tags command for the current entry." | |
11618 | (interactive "P") | |
11619 | (if (org-on-heading-p) | |
11620 | (org-set-tags arg just-align) | |
11621 | (save-excursion | |
11622 | (org-back-to-heading t) | |
11623 | (org-set-tags arg just-align)))) | |
11624 | ||
8d642074 CD |
11625 | (defun org-set-tags-to (data) |
11626 | "Set the tags of the current entry to DATA, replacing the current tags. | |
11627 | DATA may be a tags string like :aa:bb:cc:, or a list of tags. | |
11628 | If DATA is nil or the empty string, any tags will be removed." | |
11629 | (interactive "sTags: ") | |
11630 | (setq data | |
11631 | (cond | |
11632 | ((eq data nil) "") | |
11633 | ((equal data "") "") | |
11634 | ((stringp data) | |
11635 | (concat ":" (mapconcat 'identity (org-split-string data ":+") ":") | |
11636 | ":")) | |
11637 | ((listp data) | |
11638 | (concat ":" (mapconcat 'identity data ":") ":")) | |
11639 | (t nil))) | |
11640 | (when data | |
11641 | (save-excursion | |
11642 | (org-back-to-heading t) | |
11643 | (when (looking-at org-complex-heading-regexp) | |
11644 | (if (match-end 5) | |
11645 | (progn | |
11646 | (goto-char (match-beginning 5)) | |
11647 | (insert data) | |
11648 | (delete-region (point) (point-at-eol)) | |
11649 | (org-set-tags nil 'align)) | |
11650 | (goto-char (point-at-eol)) | |
11651 | (insert " " data) | |
11652 | (org-set-tags nil 'align))) | |
11653 | (beginning-of-line 1) | |
11654 | (if (looking-at ".*?\\([ \t]+\\)$") | |
11655 | (delete-region (match-beginning 1) (match-end 1)))))) | |
11656 | ||
20908596 CD |
11657 | (defun org-set-tags (&optional arg just-align) |
11658 | "Set the tags for the current headline. | |
11659 | With prefix ARG, realign all tags in headings in the current buffer." | |
11660 | (interactive "P") | |
11661 | (let* ((re (concat "^" outline-regexp)) | |
11662 | (current (org-get-tags-string)) | |
11663 | (col (current-column)) | |
11664 | (org-setting-tags t) | |
11665 | table current-tags inherited-tags ; computed below when needed | |
11666 | tags p0 c0 c1 rpl) | |
11667 | (if arg | |
11668 | (save-excursion | |
2a57416f | 11669 | (goto-char (point-min)) |
20908596 CD |
11670 | (let ((buffer-invisibility-spec (org-inhibit-invisibility))) |
11671 | (while (re-search-forward re nil t) | |
11672 | (org-set-tags nil t) | |
11673 | (end-of-line 1))) | |
11674 | (message "All tags realigned to column %d" org-tags-column)) | |
11675 | (if just-align | |
11676 | (setq tags current) | |
11677 | ;; Get a new set of tags from the user | |
11678 | (save-excursion | |
c8d0cf5c CD |
11679 | (setq table (append org-tag-persistent-alist |
11680 | (or org-tag-alist (org-get-buffer-tags))) | |
20908596 CD |
11681 | org-last-tags-completion-table table |
11682 | current-tags (org-split-string current ":") | |
11683 | inherited-tags (nreverse | |
11684 | (nthcdr (length current-tags) | |
11685 | (nreverse (org-get-tags-at)))) | |
11686 | tags | |
11687 | (if (or (eq t org-use-fast-tag-selection) | |
11688 | (and org-use-fast-tag-selection | |
11689 | (delq nil (mapcar 'cdr table)))) | |
11690 | (org-fast-tag-selection | |
11691 | current-tags inherited-tags table | |
11692 | (if org-fast-tag-selection-include-todo org-todo-key-alist)) | |
11693 | (let ((org-add-colon-after-tag-completion t)) | |
11694 | (org-trim | |
11695 | (org-without-partial-completion | |
54a0dee5 | 11696 | (org-icompleting-read "Tags: " 'org-tags-completion-function |
20908596 CD |
11697 | nil nil current 'org-tags-history))))))) |
11698 | (while (string-match "[-+&]+" tags) | |
11699 | ;; No boolean logic, just a list | |
11700 | (setq tags (replace-match ":" t t tags)))) | |
64f72ae1 | 11701 | |
c8d0cf5c CD |
11702 | (if org-tags-sort-function |
11703 | (setq tags (mapconcat 'identity | |
11704 | (sort (org-split-string tags (org-re "[^[:alnum:]_@]+")) | |
11705 | org-tags-sort-function) ":"))) | |
11706 | ||
20908596 | 11707 | (if (string-match "\\`[\t ]*\\'" tags) |
c8d0cf5c | 11708 | (setq tags "") |
20908596 CD |
11709 | (unless (string-match ":$" tags) (setq tags (concat tags ":"))) |
11710 | (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) | |
891f4676 | 11711 | |
20908596 CD |
11712 | ;; Insert new tags at the correct column |
11713 | (beginning-of-line 1) | |
11714 | (cond | |
11715 | ((and (equal current "") (equal tags ""))) | |
11716 | ((re-search-forward | |
11717 | (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") | |
11718 | (point-at-eol) t) | |
11719 | (if (equal tags "") | |
11720 | (setq rpl "") | |
11721 | (goto-char (match-beginning 0)) | |
11722 | (setq c0 (current-column) p0 (point) | |
11723 | c1 (max (1+ c0) (if (> org-tags-column 0) | |
11724 | org-tags-column | |
11725 | (- (- org-tags-column) (length tags)))) | |
11726 | rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) | |
11727 | (replace-match rpl t t) | |
11728 | (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) | |
11729 | tags) | |
11730 | (t (error "Tags alignment failed"))) | |
11731 | (org-move-to-column col) | |
11732 | (unless just-align | |
11733 | (run-hooks 'org-after-tags-change-hook))))) | |
891f4676 | 11734 | |
20908596 CD |
11735 | (defun org-change-tag-in-region (beg end tag off) |
11736 | "Add or remove TAG for each entry in the region. | |
11737 | This works in the agenda, and also in an org-mode buffer." | |
11738 | (interactive | |
11739 | (list (region-beginning) (region-end) | |
11740 | (let ((org-last-tags-completion-table | |
11741 | (if (org-mode-p) | |
11742 | (org-get-buffer-tags) | |
11743 | (org-global-tags-completion-table)))) | |
54a0dee5 | 11744 | (org-icompleting-read |
20908596 CD |
11745 | "Tag: " 'org-tags-completion-function nil nil nil |
11746 | 'org-tags-history)) | |
11747 | (progn | |
11748 | (message "[s]et or [r]emove? ") | |
11749 | (equal (read-char-exclusive) ?r)))) | |
11750 | (if (fboundp 'deactivate-mark) (deactivate-mark)) | |
11751 | (let ((agendap (equal major-mode 'org-agenda-mode)) | |
11752 | l1 l2 m buf pos newhead (cnt 0)) | |
11753 | (goto-char end) | |
11754 | (setq l2 (1- (org-current-line))) | |
11755 | (goto-char beg) | |
11756 | (setq l1 (org-current-line)) | |
11757 | (loop for l from l1 to l2 do | |
54a0dee5 | 11758 | (org-goto-line l) |
20908596 CD |
11759 | (setq m (get-text-property (point) 'org-hd-marker)) |
11760 | (when (or (and (org-mode-p) (org-on-heading-p)) | |
11761 | (and agendap m)) | |
11762 | (setq buf (if agendap (marker-buffer m) (current-buffer)) | |
11763 | pos (if agendap m (point))) | |
11764 | (with-current-buffer buf | |
11765 | (save-excursion | |
11766 | (save-restriction | |
11767 | (goto-char pos) | |
11768 | (setq cnt (1+ cnt)) | |
11769 | (org-toggle-tag tag (if off 'off 'on)) | |
11770 | (setq newhead (org-get-heading))))) | |
11771 | (and agendap (org-agenda-change-all-lines newhead m)))) | |
11772 | (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) | |
891f4676 | 11773 | |
20908596 CD |
11774 | (defun org-tags-completion-function (string predicate &optional flag) |
11775 | (let (s1 s2 rtn (ctable org-last-tags-completion-table) | |
11776 | (confirm (lambda (x) (stringp (car x))))) | |
11777 | (if (string-match "^\\(.*[-+:&|]\\)\\([^-+:&|]*\\)$" string) | |
11778 | (setq s1 (match-string 1 string) | |
11779 | s2 (match-string 2 string)) | |
11780 | (setq s1 "" s2 string)) | |
11781 | (cond | |
11782 | ((eq flag nil) | |
11783 | ;; try completion | |
11784 | (setq rtn (try-completion s2 ctable confirm)) | |
11785 | (if (stringp rtn) | |
11786 | (setq rtn | |
11787 | (concat s1 s2 (substring rtn (length s2)) | |
11788 | (if (and org-add-colon-after-tag-completion | |
11789 | (assoc rtn ctable)) | |
11790 | ":" "")))) | |
11791 | rtn) | |
11792 | ((eq flag t) | |
11793 | ;; all-completions | |
11794 | (all-completions s2 ctable confirm) | |
11795 | ) | |
11796 | ((eq flag 'lambda) | |
11797 | ;; exact match? | |
11798 | (assoc s2 ctable))) | |
d3f4dbe8 | 11799 | )) |
ab27a4a0 | 11800 | |
20908596 | 11801 | (defun org-fast-tag-insert (kwd tags face &optional end) |
33306645 | 11802 | "Insert KDW, and the TAGS, the latter with face FACE. Also insert END." |
20908596 CD |
11803 | (insert (format "%-12s" (concat kwd ":")) |
11804 | (org-add-props (mapconcat 'identity tags " ") nil 'face face) | |
11805 | (or end ""))) | |
891f4676 | 11806 | |
20908596 CD |
11807 | (defun org-fast-tag-show-exit (flag) |
11808 | (save-excursion | |
54a0dee5 | 11809 | (org-goto-line 3) |
20908596 CD |
11810 | (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) |
11811 | (replace-match "")) | |
11812 | (when flag | |
11813 | (end-of-line 1) | |
11814 | (org-move-to-column (- (window-width) 19) t) | |
11815 | (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) | |
64f72ae1 | 11816 | |
20908596 CD |
11817 | (defun org-set-current-tags-overlay (current prefix) |
11818 | (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) | |
11819 | (if (featurep 'xemacs) | |
11820 | (org-overlay-display org-tags-overlay (concat prefix s) | |
11821 | 'secondary-selection) | |
11822 | (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) | |
11823 | (org-overlay-display org-tags-overlay (concat prefix s))))) | |
891f4676 | 11824 | |
20908596 CD |
11825 | (defun org-fast-tag-selection (current inherited table &optional todo-table) |
11826 | "Fast tag selection with single keys. | |
11827 | CURRENT is the current list of tags in the headline, INHERITED is the | |
11828 | list of inherited tags, and TABLE is an alist of tags and corresponding keys, | |
11829 | possibly with grouping information. TODO-TABLE is a similar table with | |
11830 | TODO keywords, should these have keys assigned to them. | |
11831 | If the keys are nil, a-z are automatically assigned. | |
11832 | Returns the new tags string, or nil to not change the current settings." | |
11833 | (let* ((fulltable (append table todo-table)) | |
11834 | (maxlen (apply 'max (mapcar | |
11835 | (lambda (x) | |
11836 | (if (stringp (car x)) (string-width (car x)) 0)) | |
11837 | fulltable))) | |
11838 | (buf (current-buffer)) | |
11839 | (expert (eq org-fast-tag-selection-single-key 'expert)) | |
11840 | (buffer-tags nil) | |
11841 | (fwidth (+ maxlen 3 1 3)) | |
11842 | (ncol (/ (- (window-width) 4) fwidth)) | |
11843 | (i-face 'org-done) | |
11844 | (c-face 'org-todo) | |
11845 | tg cnt e c char c1 c2 ntable tbl rtn | |
11846 | ov-start ov-end ov-prefix | |
11847 | (exit-after-next org-fast-tag-selection-single-key) | |
11848 | (done-keywords org-done-keywords) | |
11849 | groups ingroup) | |
11850 | (save-excursion | |
11851 | (beginning-of-line 1) | |
11852 | (if (looking-at | |
11853 | (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) | |
11854 | (setq ov-start (match-beginning 1) | |
11855 | ov-end (match-end 1) | |
11856 | ov-prefix "") | |
11857 | (setq ov-start (1- (point-at-eol)) | |
11858 | ov-end (1+ ov-start)) | |
11859 | (skip-chars-forward "^\n\r") | |
11860 | (setq ov-prefix | |
11861 | (concat | |
11862 | (buffer-substring (1- (point)) (point)) | |
11863 | (if (> (current-column) org-tags-column) | |
11864 | " " | |
11865 | (make-string (- org-tags-column (current-column)) ?\ )))))) | |
11866 | (org-move-overlay org-tags-overlay ov-start ov-end) | |
11867 | (save-window-excursion | |
11868 | (if expert | |
11869 | (set-buffer (get-buffer-create " *Org tags*")) | |
03f3cf35 | 11870 | (delete-other-windows) |
20908596 CD |
11871 | (split-window-vertically) |
11872 | (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) | |
11873 | (erase-buffer) | |
11874 | (org-set-local 'org-done-keywords done-keywords) | |
11875 | (org-fast-tag-insert "Inherited" inherited i-face "\n") | |
11876 | (org-fast-tag-insert "Current" current c-face "\n\n") | |
11877 | (org-fast-tag-show-exit exit-after-next) | |
11878 | (org-set-current-tags-overlay current ov-prefix) | |
11879 | (setq tbl fulltable char ?a cnt 0) | |
11880 | (while (setq e (pop tbl)) | |
11881 | (cond | |
8bfe682a | 11882 | ((equal (car e) :startgroup) |
20908596 CD |
11883 | (push '() groups) (setq ingroup t) |
11884 | (when (not (= cnt 0)) | |
11885 | (setq cnt 0) | |
11886 | (insert "\n")) | |
8bfe682a CD |
11887 | (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) |
11888 | ((equal (car e) :endgroup) | |
20908596 | 11889 | (setq ingroup nil cnt 0) |
8bfe682a | 11890 | (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) |
c8d0cf5c CD |
11891 | ((equal e '(:newline)) |
11892 | (when (not (= cnt 0)) | |
11893 | (setq cnt 0) | |
11894 | (insert "\n") | |
11895 | (setq e (car tbl)) | |
11896 | (while (equal (car tbl) '(:newline)) | |
11897 | (insert "\n") | |
11898 | (setq tbl (cdr tbl))))) | |
20908596 | 11899 | (t |
54a0dee5 | 11900 | (setq tg (copy-sequence (car e)) c2 nil) |
20908596 CD |
11901 | (if (cdr e) |
11902 | (setq c (cdr e)) | |
11903 | ;; automatically assign a character. | |
11904 | (setq c1 (string-to-char | |
11905 | (downcase (substring | |
11906 | tg (if (= (string-to-char tg) ?@) 1 0))))) | |
11907 | (if (or (rassoc c1 ntable) (rassoc c1 table)) | |
11908 | (while (or (rassoc char ntable) (rassoc char table)) | |
11909 | (setq char (1+ char))) | |
11910 | (setq c2 c1)) | |
11911 | (setq c (or c2 char))) | |
11912 | (if ingroup (push tg (car groups))) | |
11913 | (setq tg (org-add-props tg nil 'face | |
11914 | (cond | |
11915 | ((not (assoc tg table)) | |
11916 | (org-get-todo-face tg)) | |
11917 | ((member tg current) c-face) | |
11918 | ((member tg inherited) i-face) | |
11919 | (t nil)))) | |
11920 | (if (and (= cnt 0) (not ingroup)) (insert " ")) | |
11921 | (insert "[" c "] " tg (make-string | |
11922 | (- fwidth 4 (length tg)) ?\ )) | |
11923 | (push (cons tg c) ntable) | |
11924 | (when (= (setq cnt (1+ cnt)) ncol) | |
11925 | (insert "\n") | |
11926 | (if ingroup (insert " ")) | |
11927 | (setq cnt 0))))) | |
11928 | (setq ntable (nreverse ntable)) | |
11929 | (insert "\n") | |
11930 | (goto-char (point-min)) | |
93b62de8 | 11931 | (if (not expert) (org-fit-window-to-buffer)) |
20908596 CD |
11932 | (setq rtn |
11933 | (catch 'exit | |
11934 | (while t | |
8bfe682a CD |
11935 | (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" |
11936 | (if (not groups) "no " "") | |
20908596 CD |
11937 | (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) |
11938 | (setq c (let ((inhibit-quit t)) (read-char-exclusive))) | |
03f3cf35 | 11939 | (cond |
20908596 CD |
11940 | ((= c ?\r) (throw 'exit t)) |
11941 | ((= c ?!) | |
11942 | (setq groups (not groups)) | |
11943 | (goto-char (point-min)) | |
11944 | (while (re-search-forward "[{}]" nil t) (replace-match " "))) | |
11945 | ((= c ?\C-c) | |
11946 | (if (not expert) | |
11947 | (org-fast-tag-show-exit | |
11948 | (setq exit-after-next (not exit-after-next))) | |
11949 | (setq expert nil) | |
11950 | (delete-other-windows) | |
11951 | (split-window-vertically) | |
11952 | (org-switch-to-buffer-other-window " *Org tags*") | |
93b62de8 | 11953 | (org-fit-window-to-buffer))) |
20908596 CD |
11954 | ((or (= c ?\C-g) |
11955 | (and (= c ?q) (not (rassoc c ntable)))) | |
11956 | (org-detach-overlay org-tags-overlay) | |
11957 | (setq quit-flag t)) | |
11958 | ((= c ?\ ) | |
11959 | (setq current nil) | |
11960 | (if exit-after-next (setq exit-after-next 'now))) | |
11961 | ((= c ?\t) | |
11962 | (condition-case nil | |
54a0dee5 | 11963 | (setq tg (org-icompleting-read |
20908596 CD |
11964 | "Tag: " |
11965 | (or buffer-tags | |
11966 | (with-current-buffer buf | |
11967 | (org-get-buffer-tags))))) | |
11968 | (quit (setq tg ""))) | |
11969 | (when (string-match "\\S-" tg) | |
11970 | (add-to-list 'buffer-tags (list tg)) | |
11971 | (if (member tg current) | |
11972 | (setq current (delete tg current)) | |
11973 | (push tg current))) | |
11974 | (if exit-after-next (setq exit-after-next 'now))) | |
11975 | ((setq e (rassoc c todo-table) tg (car e)) | |
11976 | (with-current-buffer buf | |
11977 | (save-excursion (org-todo tg))) | |
11978 | (if exit-after-next (setq exit-after-next 'now))) | |
11979 | ((setq e (rassoc c ntable) tg (car e)) | |
11980 | (if (member tg current) | |
11981 | (setq current (delete tg current)) | |
11982 | (loop for g in groups do | |
11983 | (if (member tg g) | |
11984 | (mapc (lambda (x) | |
11985 | (setq current (delete x current))) | |
11986 | g))) | |
11987 | (push tg current)) | |
11988 | (if exit-after-next (setq exit-after-next 'now)))) | |
a3fbe8c4 | 11989 | |
20908596 CD |
11990 | ;; Create a sorted list |
11991 | (setq current | |
11992 | (sort current | |
11993 | (lambda (a b) | |
11994 | (assoc b (cdr (memq (assoc a ntable) ntable)))))) | |
11995 | (if (eq exit-after-next 'now) (throw 'exit t)) | |
11996 | (goto-char (point-min)) | |
11997 | (beginning-of-line 2) | |
11998 | (delete-region (point) (point-at-eol)) | |
11999 | (org-fast-tag-insert "Current" current c-face) | |
12000 | (org-set-current-tags-overlay current ov-prefix) | |
12001 | (while (re-search-forward | |
12002 | (org-re "\\[.\\] \\([[:alnum:]_@]+\\)") nil t) | |
12003 | (setq tg (match-string 1)) | |
12004 | (add-text-properties | |
12005 | (match-beginning 1) (match-end 1) | |
12006 | (list 'face | |
12007 | (cond | |
12008 | ((member tg current) c-face) | |
12009 | ((member tg inherited) i-face) | |
12010 | (t (get-text-property (match-beginning 1) 'face)))))) | |
12011 | (goto-char (point-min))))) | |
12012 | (org-detach-overlay org-tags-overlay) | |
12013 | (if rtn | |
12014 | (mapconcat 'identity current ":") | |
12015 | nil)))) | |
a3fbe8c4 | 12016 | |
20908596 CD |
12017 | (defun org-get-tags-string () |
12018 | "Get the TAGS string in the current headline." | |
12019 | (unless (org-on-heading-p t) | |
12020 | (error "Not on a heading")) | |
12021 | (save-excursion | |
12022 | (beginning-of-line 1) | |
12023 | (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) | |
12024 | (org-match-string-no-properties 1) | |
12025 | ""))) | |
a3fbe8c4 | 12026 | |
20908596 CD |
12027 | (defun org-get-tags () |
12028 | "Get the list of tags specified in the current headline." | |
12029 | (org-split-string (org-get-tags-string) ":")) | |
a3fbe8c4 | 12030 | |
20908596 CD |
12031 | (defun org-get-buffer-tags () |
12032 | "Get a table of all tags used in the buffer, for completion." | |
12033 | (let (tags) | |
2a57416f CD |
12034 | (save-excursion |
12035 | (goto-char (point-min)) | |
20908596 CD |
12036 | (while (re-search-forward |
12037 | (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t\r\n]") nil t) | |
12038 | (when (equal (char-after (point-at-bol 0)) ?*) | |
12039 | (mapc (lambda (x) (add-to-list 'tags x)) | |
12040 | (org-split-string (org-match-string-no-properties 1) ":"))))) | |
8bfe682a | 12041 | (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags) |
20908596 | 12042 | (mapcar 'list tags))) |
9acdaa21 | 12043 | |
b349f79f CD |
12044 | ;;;; The mapping API |
12045 | ||
12046 | ;;;###autoload | |
12047 | (defun org-map-entries (func &optional match scope &rest skip) | |
12048 | "Call FUNC at each headline selected by MATCH in SCOPE. | |
12049 | ||
12050 | FUNC is a function or a lisp form. The function will be called without | |
12051 | arguments, with the cursor positioned at the beginning of the headline. | |
12052 | The return values of all calls to the function will be collected and | |
12053 | returned as a list. | |
12054 | ||
c8d0cf5c CD |
12055 | The call to FUNC will be wrapped into a save-excursion form, so FUNC |
12056 | does not need to preserve point. After evaluation, the cursor will be | |
12057 | moved to the end of the line (presumably of the headline of the | |
12058 | processed entry) and search continues from there. Under some | |
12059 | circumstances, this may not produce the wanted results. For example, | |
12060 | if you have removed (e.g. archived) the current (sub)tree it could | |
12061 | mean that the next entry will be skipped entirely. In such cases, you | |
12062 | can specify the position from where search should continue by making | |
12063 | FUNC set the variable `org-map-continue-from' to the desired buffer | |
12064 | position. | |
12065 | ||
b349f79f CD |
12066 | MATCH is a tags/property/todo match as it is used in the agenda tags view. |
12067 | Only headlines that are matched by this query will be considered during | |
12068 | the iteration. When MATCH is nil or t, all headlines will be | |
12069 | visited by the iteration. | |
12070 | ||
12071 | SCOPE determines the scope of this command. It can be any of: | |
12072 | ||
12073 | nil The current buffer, respecting the restriction if any | |
12074 | tree The subtree started with the entry at point | |
12075 | file The current buffer, without restriction | |
12076 | file-with-archives | |
12077 | The current buffer, and any archives associated with it | |
12078 | agenda All agenda files | |
12079 | agenda-with-archives | |
12080 | All agenda files with any archive files associated with them | |
12081 | \(file1 file2 ...) | |
12082 | If this is a list, all files in the list will be scanned | |
12083 | ||
12084 | The remaining args are treated as settings for the skipping facilities of | |
12085 | the scanner. The following items can be given here: | |
12086 | ||
12087 | archive skip trees with the archive tag. | |
12088 | comment skip trees with the COMMENT keyword | |
12089 | function or Emacs Lisp form: | |
12090 | will be used as value for `org-agenda-skip-function', so whenever | |
04e65fdb | 12091 | the function returns t, FUNC will not be called for that |
b349f79f | 12092 | entry and search will continue from the point where the |
c8d0cf5c CD |
12093 | function leaves it. |
12094 | ||
12095 | If your function needs to retrieve the tags including inherited tags | |
12096 | at the *current* entry, you can use the value of the variable | |
12097 | `org-scanner-tags' which will be much faster than getting the value | |
12098 | with `org-get-tags-at'. If your function gets properties with | |
12099 | `org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags' | |
12100 | to t around the call to `org-entry-properties' to get the same speedup. | |
12101 | Note that if your function moves around to retrieve tags and properties at | |
12102 | a *different* entry, you cannot use these techniques." | |
2c3ad40d CD |
12103 | (let* ((org-agenda-archives-mode nil) ; just to make sure |
12104 | (org-agenda-skip-archived-trees (memq 'archive skip)) | |
b349f79f CD |
12105 | (org-agenda-skip-comment-trees (memq 'comment skip)) |
12106 | (org-agenda-skip-function | |
12107 | (car (org-delete-all '(comment archive) skip))) | |
12108 | (org-tags-match-list-sublevels t) | |
65c439fd | 12109 | matcher file res |
621f83e4 CD |
12110 | org-todo-keywords-for-agenda |
12111 | org-done-keywords-for-agenda | |
12112 | org-todo-keyword-alist-for-agenda | |
8d642074 | 12113 | org-drawers-for-agenda |
621f83e4 | 12114 | org-tag-alist-for-agenda) |
b349f79f CD |
12115 | |
12116 | (cond | |
12117 | ((eq match t) (setq matcher t)) | |
12118 | ((eq match nil) (setq matcher t)) | |
ff4be292 | 12119 | (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) |
ce4fdcb9 | 12120 | |
0bd48b37 CD |
12121 | (save-excursion |
12122 | (save-restriction | |
12123 | (when (eq scope 'tree) | |
12124 | (org-back-to-heading t) | |
12125 | (org-narrow-to-subtree) | |
12126 | (setq scope nil)) | |
ce4fdcb9 | 12127 | |
0bd48b37 CD |
12128 | (if (not scope) |
12129 | (progn | |
12130 | (org-prepare-agenda-buffers | |
12131 | (list (buffer-file-name (current-buffer)))) | |
12132 | (setq res (org-scan-tags func matcher))) | |
12133 | ;; Get the right scope | |
0bd48b37 CD |
12134 | (cond |
12135 | ((and scope (listp scope) (symbolp (car scope))) | |
12136 | (setq scope (eval scope))) | |
12137 | ((eq scope 'agenda) | |
12138 | (setq scope (org-agenda-files t))) | |
12139 | ((eq scope 'agenda-with-archives) | |
12140 | (setq scope (org-agenda-files t)) | |
12141 | (setq scope (org-add-archive-files scope))) | |
12142 | ((eq scope 'file) | |
12143 | (setq scope (list (buffer-file-name)))) | |
12144 | ((eq scope 'file-with-archives) | |
12145 | (setq scope (org-add-archive-files (list (buffer-file-name)))))) | |
12146 | (org-prepare-agenda-buffers scope) | |
12147 | (while (setq file (pop scope)) | |
12148 | (with-current-buffer (org-find-base-buffer-visiting file) | |
12149 | (save-excursion | |
12150 | (save-restriction | |
12151 | (widen) | |
12152 | (goto-char (point-min)) | |
12153 | (setq res (append res (org-scan-tags func matcher)))))))))) | |
12154 | res)) | |
9acdaa21 | 12155 | |
20908596 | 12156 | ;;;; Properties |
9acdaa21 | 12157 | |
20908596 | 12158 | ;;; Setting and retrieving properties |
891f4676 | 12159 | |
20908596 | 12160 | (defconst org-special-properties |
93b62de8 | 12161 | '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" |
20908596 CD |
12162 | "TIMESTAMP" "TIMESTAMP_IA") |
12163 | "The special properties valid in Org-mode. | |
9acdaa21 | 12164 | |
20908596 CD |
12165 | These are properties that are not defined in the property drawer, |
12166 | but in some other way.") | |
9acdaa21 | 12167 | |
20908596 | 12168 | (defconst org-default-properties |
c8d0cf5c | 12169 | '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID" |
b349f79f CD |
12170 | "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" |
12171 | "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" | |
c8d0cf5c CD |
12172 | "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" |
12173 | "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" | |
8bfe682a | 12174 | "CLOCK_MODELINE_TOTAL" "STYLE") |
20908596 CD |
12175 | "Some properties that are used by Org-mode for various purposes. |
12176 | Being in this list makes sure that they are offered for completion.") | |
9acdaa21 | 12177 | |
20908596 CD |
12178 | (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" |
12179 | "Regular expression matching the first line of a property drawer.") | |
9acdaa21 | 12180 | |
20908596 CD |
12181 | (defconst org-property-end-re "^[ \t]*:END:[ \t]*$" |
12182 | "Regular expression matching the first line of a property drawer.") | |
9acdaa21 | 12183 | |
2c3ad40d CD |
12184 | (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" |
12185 | "Regular expression matching the first line of a property drawer.") | |
12186 | ||
12187 | (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" | |
12188 | "Regular expression matching the first line of a property drawer.") | |
12189 | ||
12190 | (defconst org-property-drawer-re | |
12191 | (concat "\\(" org-property-start-re "\\)[^\000]*\\(" | |
12192 | org-property-end-re "\\)\n?") | |
12193 | "Matches an entire property drawer.") | |
12194 | ||
12195 | (defconst org-clock-drawer-re | |
12196 | (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\(" | |
12197 | org-property-end-re "\\)\n?") | |
12198 | "Matches an entire clock drawer.") | |
12199 | ||
20908596 CD |
12200 | (defun org-property-action () |
12201 | "Do an action on properties." | |
03f3cf35 | 12202 | (interactive) |
20908596 CD |
12203 | (let (c) |
12204 | (org-at-property-p) | |
12205 | (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") | |
12206 | (setq c (read-char-exclusive)) | |
12207 | (cond | |
12208 | ((equal c ?s) | |
12209 | (call-interactively 'org-set-property)) | |
12210 | ((equal c ?d) | |
12211 | (call-interactively 'org-delete-property)) | |
12212 | ((equal c ?D) | |
12213 | (call-interactively 'org-delete-property-globally)) | |
12214 | ((equal c ?c) | |
12215 | (call-interactively 'org-compute-property-at-point)) | |
12216 | (t (error "No such property action %c" c))))) | |
12217 | ||
54a0dee5 CD |
12218 | (defun org-set-effort (&optional value) |
12219 | "Set the effort property of the current entry. | |
12220 | With numerical prefix arg, use the nth allowed value, 0 stands for the 10th | |
12221 | allowed value." | |
12222 | (interactive "P") | |
12223 | (if (equal value 0) (setq value 10)) | |
12224 | (let* ((completion-ignore-case t) | |
12225 | (prop org-effort-property) | |
12226 | (cur (org-entry-get nil prop)) | |
12227 | (allowed (org-property-get-allowed-values nil prop 'table)) | |
12228 | (existing (mapcar 'list (org-property-values prop))) | |
8bfe682a | 12229 | rpl |
54a0dee5 CD |
12230 | (val (cond |
12231 | ((stringp value) value) | |
12232 | ((and allowed (integerp value)) | |
12233 | (or (car (nth (1- value) allowed)) | |
12234 | (car (org-last allowed)))) | |
12235 | (allowed | |
8bfe682a CD |
12236 | (message "Select 1-9,0, [RET%s]: %s" |
12237 | (if cur (concat "=" cur) "") | |
12238 | (mapconcat 'car allowed " ")) | |
12239 | (setq rpl (read-char-exclusive)) | |
12240 | (if (equal rpl ?\r) | |
12241 | cur | |
12242 | (setq rpl (- rpl ?0)) | |
12243 | (if (equal rpl 0) (setq rpl 10)) | |
12244 | (if (and (> rpl 0) (<= rpl (length allowed))) | |
12245 | (car (nth (1- rpl) allowed)) | |
5dec9555 | 12246 | (org-completing-read "Effort: " allowed nil)))) |
54a0dee5 CD |
12247 | (t |
12248 | (let (org-completion-use-ido org-completion-use-iswitchb) | |
12249 | (org-completing-read | |
5dec9555 | 12250 | (concat "Effort " (if (and cur (string-match "\\S-" cur)) |
54a0dee5 CD |
12251 | (concat "[" cur "]") "") |
12252 | ": ") | |
12253 | existing nil nil "" nil cur)))))) | |
12254 | (unless (equal (org-entry-get nil prop) val) | |
12255 | (org-entry-put nil prop val)) | |
12256 | (message "%s is now %s" prop val))) | |
12257 | ||
20908596 CD |
12258 | (defun org-at-property-p () |
12259 | "Is the cursor in a property line?" | |
12260 | ;; FIXME: Does not check if we are actually in the drawer. | |
12261 | ;; FIXME: also returns true on any drawers..... | |
12262 | ;; This is used by C-c C-c for property action. | |
03f3cf35 | 12263 | (save-excursion |
20908596 CD |
12264 | (beginning-of-line 1) |
12265 | (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")))) | |
03f3cf35 | 12266 | |
20908596 CD |
12267 | (defun org-get-property-block (&optional beg end force) |
12268 | "Return the (beg . end) range of the body of the property drawer. | |
12269 | BEG and END can be beginning and end of subtree, if not given | |
12270 | they will be found. | |
12271 | If the drawer does not exist and FORCE is non-nil, create the drawer." | |
12272 | (catch 'exit | |
d3f4dbe8 | 12273 | (save-excursion |
20908596 CD |
12274 | (let* ((beg (or beg (progn (org-back-to-heading t) (point)))) |
12275 | (end (or end (progn (outline-next-heading) (point))))) | |
12276 | (goto-char beg) | |
12277 | (if (re-search-forward org-property-start-re end t) | |
12278 | (setq beg (1+ (match-end 0))) | |
12279 | (if force | |
12280 | (save-excursion | |
12281 | (org-insert-property-drawer) | |
12282 | (setq end (progn (outline-next-heading) (point)))) | |
12283 | (throw 'exit nil)) | |
12284 | (goto-char beg) | |
12285 | (if (re-search-forward org-property-start-re end t) | |
12286 | (setq beg (1+ (match-end 0))))) | |
12287 | (if (re-search-forward org-property-end-re end t) | |
12288 | (setq end (match-beginning 0)) | |
12289 | (or force (throw 'exit nil)) | |
12290 | (goto-char beg) | |
12291 | (setq end beg) | |
12292 | (org-indent-line-function) | |
12293 | (insert ":END:\n")) | |
12294 | (cons beg end))))) | |
a3fbe8c4 | 12295 | |
20908596 CD |
12296 | (defun org-entry-properties (&optional pom which) |
12297 | "Get all properties of the entry at point-or-marker POM. | |
12298 | This includes the TODO keyword, the tags, time strings for deadline, | |
12299 | scheduled, and clocking, and any additional properties defined in the | |
12300 | entry. The return value is an alist, keys may occur multiple times | |
12301 | if the property key was used several times. | |
12302 | POM may also be nil, in which case the current entry is used. | |
12303 | If WHICH is nil or `all', get all properties. If WHICH is | |
12304 | `special' or `standard', only get that subclass." | |
12305 | (setq which (or which 'all)) | |
12306 | (org-with-point-at pom | |
12307 | (let ((clockstr (substring org-clock-string 0 -1)) | |
12308 | (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY")) | |
12309 | beg end range props sum-props key value string clocksum) | |
12310 | (save-excursion | |
0bd48b37 CD |
12311 | (when (condition-case nil |
12312 | (and (org-mode-p) (org-back-to-heading t)) | |
12313 | (error nil)) | |
20908596 CD |
12314 | (setq beg (point)) |
12315 | (setq sum-props (get-text-property (point) 'org-summaries)) | |
12316 | (setq clocksum (get-text-property (point) :org-clock-minutes)) | |
12317 | (outline-next-heading) | |
12318 | (setq end (point)) | |
12319 | (when (memq which '(all special)) | |
12320 | ;; Get the special properties, like TODO and tags | |
12321 | (goto-char beg) | |
12322 | (when (and (looking-at org-todo-line-regexp) (match-end 2)) | |
12323 | (push (cons "TODO" (org-match-string-no-properties 2)) props)) | |
12324 | (when (looking-at org-priority-regexp) | |
12325 | (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) | |
12326 | (when (and (setq value (org-get-tags-string)) | |
12327 | (string-match "\\S-" value)) | |
12328 | (push (cons "TAGS" value) props)) | |
12329 | (when (setq value (org-get-tags-at)) | |
12330 | (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") ":")) | |
12331 | props)) | |
12332 | (while (re-search-forward org-maybe-keyword-time-regexp end t) | |
12333 | (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1)) | |
12334 | string (if (equal key clockstr) | |
12335 | (org-no-properties | |
12336 | (org-trim | |
12337 | (buffer-substring | |
12338 | (match-beginning 3) (goto-char (point-at-eol))))) | |
12339 | (substring (org-match-string-no-properties 3) 1 -1))) | |
12340 | (unless key | |
12341 | (if (= (char-after (match-beginning 3)) ?\[) | |
12342 | (setq key "TIMESTAMP_IA") | |
12343 | (setq key "TIMESTAMP"))) | |
12344 | (when (or (equal key clockstr) (not (assoc key props))) | |
12345 | (push (cons key string) props))) | |
891f4676 | 12346 | |
20908596 | 12347 | ) |
c4f9780e | 12348 | |
20908596 | 12349 | (when (memq which '(all standard)) |
c8d0cf5c | 12350 | ;; Get the standard properties, like :PROP: ... |
20908596 CD |
12351 | (setq range (org-get-property-block beg end)) |
12352 | (when range | |
12353 | (goto-char (car range)) | |
12354 | (while (re-search-forward | |
12355 | (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?") | |
12356 | (cdr range) t) | |
12357 | (setq key (org-match-string-no-properties 1) | |
12358 | value (org-trim (or (org-match-string-no-properties 2) ""))) | |
12359 | (unless (member key excluded) | |
12360 | (push (cons key (or value "")) props))))) | |
12361 | (if clocksum | |
12362 | (push (cons "CLOCKSUM" | |
12363 | (org-columns-number-to-string (/ (float clocksum) 60.) | |
12364 | 'add_times)) | |
12365 | props)) | |
71d35b24 CD |
12366 | (unless (assoc "CATEGORY" props) |
12367 | (setq value (or (org-get-category) | |
12368 | (progn (org-refresh-category-properties) | |
12369 | (org-get-category)))) | |
12370 | (push (cons "CATEGORY" value) props)) | |
20908596 CD |
12371 | (append sum-props (nreverse props))))))) |
12372 | ||
12373 | (defun org-entry-get (pom property &optional inherit) | |
12374 | "Get value of PROPERTY for entry at point-or-marker POM. | |
12375 | If INHERIT is non-nil and the entry does not have the property, | |
12376 | then also check higher levels of the hierarchy. | |
12377 | If INHERIT is the symbol `selective', use inheritance only if the setting | |
12378 | in `org-use-property-inheritance' selects PROPERTY for inheritance. | |
12379 | If the property is present but empty, the return value is the empty string. | |
12380 | If the property is not present at all, nil is returned." | |
12381 | (org-with-point-at pom | |
12382 | (if (and inherit (if (eq inherit 'selective) | |
12383 | (org-property-inherit-p property) | |
12384 | t)) | |
12385 | (org-entry-get-with-inheritance property) | |
12386 | (if (member property org-special-properties) | |
12387 | ;; We need a special property. Use brute force, get all properties. | |
12388 | (cdr (assoc property (org-entry-properties nil 'special))) | |
12389 | (let ((range (org-get-property-block))) | |
12390 | (if (and range | |
12391 | (goto-char (car range)) | |
12392 | (re-search-forward | |
93b62de8 | 12393 | (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)?") |
20908596 CD |
12394 | (cdr range) t)) |
12395 | ;; Found the property, return it. | |
12396 | (if (match-end 1) | |
12397 | (org-match-string-no-properties 1) | |
12398 | ""))))))) | |
12399 | ||
12400 | (defun org-property-or-variable-value (var &optional inherit) | |
12401 | "Check if there is a property fixing the value of VAR. | |
12402 | If yes, return this value. If not, return the current value of the variable." | |
12403 | (let ((prop (org-entry-get nil (symbol-name var) inherit))) | |
12404 | (if (and prop (stringp prop) (string-match "\\S-" prop)) | |
12405 | (read prop) | |
12406 | (symbol-value var)))) | |
12407 | ||
12408 | (defun org-entry-delete (pom property) | |
12409 | "Delete the property PROPERTY from entry at point-or-marker POM." | |
12410 | (org-with-point-at pom | |
12411 | (if (member property org-special-properties) | |
12412 | nil ; cannot delete these properties. | |
12413 | (let ((range (org-get-property-block))) | |
12414 | (if (and range | |
12415 | (goto-char (car range)) | |
12416 | (re-search-forward | |
93b62de8 | 12417 | (concat "^[ \t]*:" property ":[ \t]*\\(.*[^ \t\r\n\f\v]\\)") |
20908596 CD |
12418 | (cdr range) t)) |
12419 | (progn | |
12420 | (delete-region (match-beginning 0) (1+ (point-at-eol))) | |
12421 | t) | |
12422 | nil))))) | |
12423 | ||
12424 | ;; Multi-values properties are properties that contain multiple values | |
12425 | ;; These values are assumed to be single words, separated by whitespace. | |
12426 | (defun org-entry-add-to-multivalued-property (pom property value) | |
12427 | "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." | |
12428 | (let* ((old (org-entry-get pom property)) | |
12429 | (values (and old (org-split-string old "[ \t]")))) | |
621f83e4 | 12430 | (setq value (org-entry-protect-space value)) |
20908596 CD |
12431 | (unless (member value values) |
12432 | (setq values (cons value values)) | |
12433 | (org-entry-put pom property | |
12434 | (mapconcat 'identity values " "))))) | |
12435 | ||
12436 | (defun org-entry-remove-from-multivalued-property (pom property value) | |
12437 | "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." | |
12438 | (let* ((old (org-entry-get pom property)) | |
12439 | (values (and old (org-split-string old "[ \t]")))) | |
621f83e4 | 12440 | (setq value (org-entry-protect-space value)) |
20908596 CD |
12441 | (when (member value values) |
12442 | (setq values (delete value values)) | |
12443 | (org-entry-put pom property | |
12444 | (mapconcat 'identity values " "))))) | |
9acdaa21 | 12445 | |
20908596 CD |
12446 | (defun org-entry-member-in-multivalued-property (pom property value) |
12447 | "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" | |
12448 | (let* ((old (org-entry-get pom property)) | |
12449 | (values (and old (org-split-string old "[ \t]")))) | |
621f83e4 | 12450 | (setq value (org-entry-protect-space value)) |
20908596 | 12451 | (member value values))) |
9acdaa21 | 12452 | |
621f83e4 CD |
12453 | (defun org-entry-get-multivalued-property (pom property) |
12454 | "Return a list of values in a multivalued property." | |
12455 | (let* ((value (org-entry-get pom property)) | |
12456 | (values (and value (org-split-string value "[ \t]")))) | |
12457 | (mapcar 'org-entry-restore-space values))) | |
12458 | ||
12459 | (defun org-entry-put-multivalued-property (pom property &rest values) | |
12460 | "Set multivalued PROPERTY at point-or-marker POM to VALUES. | |
12461 | VALUES should be a list of strings. Spaces will be protected." | |
12462 | (org-entry-put pom property | |
12463 | (mapconcat 'org-entry-protect-space values " ")) | |
12464 | (let* ((value (org-entry-get pom property)) | |
12465 | (values (and value (org-split-string value "[ \t]")))) | |
12466 | (mapcar 'org-entry-restore-space values))) | |
12467 | ||
12468 | (defun org-entry-protect-space (s) | |
12469 | "Protect spaces and newline in string S." | |
12470 | (while (string-match " " s) | |
12471 | (setq s (replace-match "%20" t t s))) | |
12472 | (while (string-match "\n" s) | |
12473 | (setq s (replace-match "%0A" t t s))) | |
12474 | s) | |
12475 | ||
12476 | (defun org-entry-restore-space (s) | |
12477 | "Restore spaces and newline in string S." | |
12478 | (while (string-match "%20" s) | |
12479 | (setq s (replace-match " " t t s))) | |
12480 | (while (string-match "%0A" s) | |
12481 | (setq s (replace-match "\n" t t s))) | |
12482 | s) | |
12483 | ||
12484 | (defvar org-entry-property-inherited-from (make-marker) | |
33306645 | 12485 | "Marker pointing to the entry from where a property was inherited. |
621f83e4 | 12486 | Each call to `org-entry-get-with-inheritance' will set this marker to the |
33306645 | 12487 | location of the entry where the inheritance search matched. If there was |
621f83e4 CD |
12488 | no match, the marker will point nowhere. |
12489 | Note that also `org-entry-get' calls this function, if the INHERIT flag | |
12490 | is set.") | |
15841868 | 12491 | |
20908596 CD |
12492 | (defun org-entry-get-with-inheritance (property) |
12493 | "Get entry property, and search higher levels if not present." | |
621f83e4 | 12494 | (move-marker org-entry-property-inherited-from nil) |
20908596 CD |
12495 | (let (tmp) |
12496 | (save-excursion | |
12497 | (save-restriction | |
12498 | (widen) | |
12499 | (catch 'ex | |
12500 | (while t | |
12501 | (when (setq tmp (org-entry-get nil property)) | |
12502 | (org-back-to-heading t) | |
12503 | (move-marker org-entry-property-inherited-from (point)) | |
12504 | (throw 'ex tmp)) | |
12505 | (or (org-up-heading-safe) (throw 'ex nil))))) | |
ce4fdcb9 | 12506 | (or tmp |
b349f79f CD |
12507 | (cdr (assoc property org-file-properties)) |
12508 | (cdr (assoc property org-global-properties)) | |
12509 | (cdr (assoc property org-global-properties-fixed)))))) | |
c4f9780e | 12510 | |
20908596 CD |
12511 | (defun org-entry-put (pom property value) |
12512 | "Set PROPERTY to VALUE for entry at point-or-marker POM." | |
12513 | (org-with-point-at pom | |
12514 | (org-back-to-heading t) | |
12515 | (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) | |
12516 | range) | |
12517 | (cond | |
12518 | ((equal property "TODO") | |
12519 | (when (and (stringp value) (string-match "\\S-" value) | |
12520 | (not (member value org-todo-keywords-1))) | |
12521 | (error "\"%s\" is not a valid TODO state" value)) | |
12522 | (if (or (not value) | |
12523 | (not (string-match "\\S-" value))) | |
12524 | (setq value 'none)) | |
12525 | (org-todo value) | |
12526 | (org-set-tags nil 'align)) | |
12527 | ((equal property "PRIORITY") | |
12528 | (org-priority (if (and value (stringp value) (string-match "\\S-" value)) | |
12529 | (string-to-char value) ?\ )) | |
12530 | (org-set-tags nil 'align)) | |
12531 | ((equal property "SCHEDULED") | |
12532 | (if (re-search-forward org-scheduled-time-regexp end t) | |
12533 | (cond | |
12534 | ((eq value 'earlier) (org-timestamp-change -1 'day)) | |
12535 | ((eq value 'later) (org-timestamp-change 1 'day)) | |
12536 | (t (call-interactively 'org-schedule))) | |
12537 | (call-interactively 'org-schedule))) | |
12538 | ((equal property "DEADLINE") | |
12539 | (if (re-search-forward org-deadline-time-regexp end t) | |
12540 | (cond | |
12541 | ((eq value 'earlier) (org-timestamp-change -1 'day)) | |
12542 | ((eq value 'later) (org-timestamp-change 1 'day)) | |
12543 | (t (call-interactively 'org-deadline))) | |
12544 | (call-interactively 'org-deadline))) | |
12545 | ((member property org-special-properties) | |
12546 | (error "The %s property can not yet be set with `org-entry-put'" | |
12547 | property)) | |
12548 | (t ; a non-special property | |
12549 | (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21 | |
12550 | (setq range (org-get-property-block beg end 'force)) | |
12551 | (goto-char (car range)) | |
12552 | (if (re-search-forward | |
12553 | (concat "^[ \t]*:" property ":\\(.*\\)") (cdr range) t) | |
12554 | (progn | |
12555 | (delete-region (match-beginning 1) (match-end 1)) | |
12556 | (goto-char (match-beginning 1))) | |
12557 | (goto-char (cdr range)) | |
12558 | (insert "\n") | |
12559 | (backward-char 1) | |
12560 | (org-indent-line-function) | |
12561 | (insert ":" property ":")) | |
12562 | (and value (insert " " value)) | |
12563 | (org-indent-line-function))))))) | |
03f3cf35 | 12564 | |
20908596 CD |
12565 | (defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) |
12566 | "Get all property keys in the current buffer. | |
33306645 | 12567 | With INCLUDE-SPECIALS, also list the special properties that reflect things |
20908596 CD |
12568 | like tags and TODO state. |
12569 | With INCLUDE-DEFAULTS, also include properties that has special meaning | |
12570 | internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING. | |
12571 | With INCLUDE-COLUMNS, also include property names given in COLUMN | |
12572 | formats in the current buffer." | |
65c439fd | 12573 | (let (rtn range cfmt s p) |
d3f4dbe8 | 12574 | (save-excursion |
20908596 CD |
12575 | (save-restriction |
12576 | (widen) | |
12577 | (goto-char (point-min)) | |
12578 | (while (re-search-forward org-property-start-re nil t) | |
12579 | (setq range (org-get-property-block)) | |
12580 | (goto-char (car range)) | |
12581 | (while (re-search-forward | |
12582 | (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):") | |
12583 | (cdr range) t) | |
12584 | (add-to-list 'rtn (org-match-string-no-properties 1))) | |
12585 | (outline-next-heading)))) | |
791d856f | 12586 | |
20908596 CD |
12587 | (when include-specials |
12588 | (setq rtn (append org-special-properties rtn))) | |
d3f4dbe8 | 12589 | |
20908596 | 12590 | (when include-defaults |
c8d0cf5c CD |
12591 | (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties) |
12592 | (add-to-list 'rtn org-effort-property)) | |
38f8646b | 12593 | |
20908596 CD |
12594 | (when include-columns |
12595 | (save-excursion | |
12596 | (save-restriction | |
12597 | (widen) | |
12598 | (goto-char (point-min)) | |
12599 | (while (re-search-forward | |
12600 | "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)" | |
12601 | nil t) | |
12602 | (setq cfmt (match-string 2) s 0) | |
12603 | (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)") | |
12604 | cfmt s) | |
12605 | (setq s (match-end 0) | |
12606 | p (match-string 1 cfmt)) | |
12607 | (unless (or (equal p "ITEM") | |
12608 | (member p org-special-properties)) | |
12609 | (add-to-list 'rtn (match-string 1 cfmt)))))))) | |
2a57416f | 12610 | |
20908596 | 12611 | (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) |
2a57416f | 12612 | |
20908596 CD |
12613 | (defun org-property-values (key) |
12614 | "Return a list of all values of property KEY." | |
12615 | (save-excursion | |
12616 | (save-restriction | |
12617 | (widen) | |
12618 | (goto-char (point-min)) | |
12619 | (let ((re (concat "^[ \t]*:" key ":[ \t]*\\(\\S-.*\\)")) | |
12620 | values) | |
12621 | (while (re-search-forward re nil t) | |
12622 | (add-to-list 'values (org-trim (match-string 1)))) | |
12623 | (delete "" values))))) | |
2a57416f | 12624 | |
20908596 CD |
12625 | (defun org-insert-property-drawer () |
12626 | "Insert a property drawer into the current entry." | |
12627 | (interactive) | |
12628 | (org-back-to-heading t) | |
12629 | (looking-at outline-regexp) | |
c8d0cf5c CD |
12630 | (let ((indent (if org-adapt-indentation |
12631 | (- (match-end 0)(match-beginning 0)) | |
12632 | 0)) | |
20908596 CD |
12633 | (beg (point)) |
12634 | (re (concat "^[ \t]*" org-keyword-time-regexp)) | |
12635 | end hiddenp) | |
12636 | (outline-next-heading) | |
12637 | (setq end (point)) | |
12638 | (goto-char beg) | |
12639 | (while (re-search-forward re end t)) | |
12640 | (setq hiddenp (org-invisible-p)) | |
12641 | (end-of-line 1) | |
12642 | (and (equal (char-after) ?\n) (forward-char 1)) | |
c8d0cf5c CD |
12643 | (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)") |
12644 | (if (member (match-string 1) '("CLOCK:" ":END:")) | |
12645 | ;; just skip this line | |
12646 | (beginning-of-line 2) | |
12647 | ;; Drawer start, find the end | |
12648 | (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t) | |
12649 | (beginning-of-line 1))) | |
20908596 CD |
12650 | (org-skip-over-state-notes) |
12651 | (skip-chars-backward " \t\n\r") | |
12652 | (if (eq (char-before) ?*) (forward-char 1)) | |
12653 | (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) | |
12654 | (beginning-of-line 0) | |
12655 | (org-indent-to-column indent) | |
12656 | (beginning-of-line 2) | |
12657 | (org-indent-to-column indent) | |
12658 | (beginning-of-line 0) | |
12659 | (if hiddenp | |
12660 | (save-excursion | |
12661 | (org-back-to-heading t) | |
12662 | (hide-entry)) | |
12663 | (org-flag-drawer t)))) | |
d3f4dbe8 | 12664 | |
20908596 CD |
12665 | (defun org-set-property (property value) |
12666 | "In the current entry, set PROPERTY to VALUE. | |
12667 | When called interactively, this will prompt for a property name, offering | |
12668 | completion on existing and default properties. And then it will prompt | |
33306645 | 12669 | for a value, offering completion either on allowed values (via an inherited |
20908596 CD |
12670 | xxx_ALL property) or on existing values in other instances of this property |
12671 | in the current file." | |
12672 | (interactive | |
b349f79f CD |
12673 | (let* ((completion-ignore-case t) |
12674 | (keys (org-buffer-property-keys nil t t)) | |
54a0dee5 | 12675 | (prop0 (org-icompleting-read "Property: " (mapcar 'list keys))) |
b349f79f CD |
12676 | (prop (if (member prop0 keys) |
12677 | prop0 | |
12678 | (or (cdr (assoc (downcase prop0) | |
12679 | (mapcar (lambda (x) (cons (downcase x) x)) | |
12680 | keys))) | |
12681 | prop0))) | |
20908596 CD |
12682 | (cur (org-entry-get nil prop)) |
12683 | (allowed (org-property-get-allowed-values nil prop 'table)) | |
12684 | (existing (mapcar 'list (org-property-values prop))) | |
12685 | (val (if allowed | |
b349f79f | 12686 | (org-completing-read "Value: " allowed nil 'req-match) |
54a0dee5 | 12687 | (let (org-completion-use-ido org-completion-use-iswitchb) |
c8d0cf5c | 12688 | (org-completing-read |
54a0dee5 | 12689 | (concat "Value " (if (and cur (string-match "\\S-" cur)) |
c8d0cf5c CD |
12690 | (concat "[" cur "]") "") |
12691 | ": ") | |
12692 | existing nil nil "" nil cur))))) | |
20908596 CD |
12693 | (list prop (if (equal val "") cur val)))) |
12694 | (unless (equal (org-entry-get nil property) value) | |
12695 | (org-entry-put nil property value))) | |
791d856f | 12696 | |
20908596 CD |
12697 | (defun org-delete-property (property) |
12698 | "In the current entry, delete PROPERTY." | |
12699 | (interactive | |
b349f79f | 12700 | (let* ((completion-ignore-case t) |
54a0dee5 | 12701 | (prop (org-icompleting-read |
20908596 CD |
12702 | "Property: " (org-entry-properties nil 'standard)))) |
12703 | (list prop))) | |
12704 | (message "Property %s %s" property | |
12705 | (if (org-entry-delete nil property) | |
12706 | "deleted" | |
12707 | "was not present in the entry"))) | |
d3f4dbe8 | 12708 | |
20908596 CD |
12709 | (defun org-delete-property-globally (property) |
12710 | "Remove PROPERTY globally, from all entries." | |
12711 | (interactive | |
b349f79f | 12712 | (let* ((completion-ignore-case t) |
54a0dee5 | 12713 | (prop (org-icompleting-read |
20908596 CD |
12714 | "Globally remove property: " |
12715 | (mapcar 'list (org-buffer-property-keys))))) | |
12716 | (list prop))) | |
12717 | (save-excursion | |
12718 | (save-restriction | |
12719 | (widen) | |
12720 | (goto-char (point-min)) | |
12721 | (let ((cnt 0)) | |
12722 | (while (re-search-forward | |
12723 | (concat "^[ \t]*:" (regexp-quote property) ":.*\n?") | |
12724 | nil t) | |
12725 | (setq cnt (1+ cnt)) | |
12726 | (replace-match "")) | |
12727 | (message "Property \"%s\" removed from %d entries" property cnt))))) | |
d3f4dbe8 | 12728 | |
20908596 | 12729 | (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el |
d3f4dbe8 | 12730 | |
20908596 CD |
12731 | (defun org-compute-property-at-point () |
12732 | "Compute the property at point. | |
12733 | This looks for an enclosing column format, extracts the operator and | |
33306645 | 12734 | then applies it to the property in the column format's scope." |
30313b90 | 12735 | (interactive) |
20908596 CD |
12736 | (unless (org-at-property-p) |
12737 | (error "Not at a property")) | |
12738 | (let ((prop (org-match-string-no-properties 2))) | |
12739 | (org-columns-get-format-and-top-level) | |
12740 | (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) | |
12741 | (error "No operator defined for property %s" prop)) | |
12742 | (org-columns-compute prop))) | |
d3f4dbe8 | 12743 | |
20908596 CD |
12744 | (defun org-property-get-allowed-values (pom property &optional table) |
12745 | "Get allowed values for the property PROPERTY. | |
12746 | When TABLE is non-nil, return an alist that can directly be used for | |
12747 | completion." | |
12748 | (let (vals) | |
12749 | (cond | |
12750 | ((equal property "TODO") | |
12751 | (setq vals (org-with-point-at pom | |
12752 | (append org-todo-keywords-1 '(""))))) | |
12753 | ((equal property "PRIORITY") | |
12754 | (let ((n org-lowest-priority)) | |
12755 | (while (>= n org-highest-priority) | |
12756 | (push (char-to-string n) vals) | |
12757 | (setq n (1- n))))) | |
12758 | ((member property org-special-properties)) | |
12759 | (t | |
12760 | (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) | |
03f3cf35 | 12761 | |
20908596 CD |
12762 | (when (and vals (string-match "\\S-" vals)) |
12763 | (setq vals (car (read-from-string (concat "(" vals ")")))) | |
12764 | (setq vals (mapcar (lambda (x) | |
12765 | (cond ((stringp x) x) | |
12766 | ((numberp x) (number-to-string x)) | |
12767 | ((symbolp x) (symbol-name x)) | |
12768 | (t "???"))) | |
12769 | vals))))) | |
12770 | (if table (mapcar 'list vals) vals))) | |
03f3cf35 | 12771 | |
20908596 CD |
12772 | (defun org-property-previous-allowed-value (&optional previous) |
12773 | "Switch to the next allowed value for this property." | |
12774 | (interactive) | |
12775 | (org-property-next-allowed-value t)) | |
d3f4dbe8 | 12776 | |
20908596 CD |
12777 | (defun org-property-next-allowed-value (&optional previous) |
12778 | "Switch to the next allowed value for this property." | |
d3f4dbe8 | 12779 | (interactive) |
20908596 CD |
12780 | (unless (org-at-property-p) |
12781 | (error "Not at a property")) | |
12782 | (let* ((key (match-string 2)) | |
12783 | (value (match-string 3)) | |
12784 | (allowed (or (org-property-get-allowed-values (point) key) | |
12785 | (and (member value '("[ ]" "[-]" "[X]")) | |
12786 | '("[ ]" "[X]")))) | |
12787 | nval) | |
12788 | (unless allowed | |
12789 | (error "Allowed values for this property have not been defined")) | |
12790 | (if previous (setq allowed (reverse allowed))) | |
12791 | (if (member value allowed) | |
12792 | (setq nval (car (cdr (member value allowed))))) | |
12793 | (setq nval (or nval (car allowed))) | |
12794 | (if (equal nval value) | |
12795 | (error "Only one allowed value for this property")) | |
12796 | (org-at-property-p) | |
12797 | (replace-match (concat " :" key ": " nval) t t) | |
12798 | (org-indent-line-function) | |
12799 | (beginning-of-line 1) | |
12800 | (skip-chars-forward " \t"))) | |
d3f4dbe8 | 12801 | |
20908596 CD |
12802 | (defun org-find-entry-with-id (ident) |
12803 | "Locate the entry that contains the ID property with exact value IDENT. | |
12804 | IDENT can be a string, a symbol or a number, this function will search for | |
12805 | the string representation of it. | |
12806 | Return the position where this entry starts, or nil if there is no such entry." | |
db55f368 | 12807 | (interactive "sID: ") |
20908596 CD |
12808 | (let ((id (cond |
12809 | ((stringp ident) ident) | |
12810 | ((symbol-name ident) (symbol-name ident)) | |
12811 | ((numberp ident) (number-to-string ident)) | |
12812 | (t (error "IDENT %s must be a string, symbol or number" ident)))) | |
12813 | (case-fold-search nil)) | |
12814 | (save-excursion | |
12815 | (save-restriction | |
12816 | (widen) | |
12817 | (goto-char (point-min)) | |
12818 | (when (re-search-forward | |
12819 | (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") | |
12820 | nil t) | |
c8d0cf5c | 12821 | (org-back-to-heading t) |
20908596 | 12822 | (point)))))) |
48aaad2d | 12823 | |
20908596 | 12824 | ;;;; Timestamps |
d3f4dbe8 | 12825 | |
20908596 | 12826 | (defvar org-last-changed-timestamp nil) |
b349f79f CD |
12827 | (defvar org-last-inserted-timestamp nil |
12828 | "The last time stamp inserted with `org-insert-time-stamp'.") | |
20908596 CD |
12829 | (defvar org-time-was-given) ; dynamically scoped parameter |
12830 | (defvar org-end-time-was-given) ; dynamically scoped parameter | |
12831 | (defvar org-ts-what) ; dynamically scoped parameter | |
12832 | ||
621f83e4 | 12833 | (defun org-time-stamp (arg &optional inactive) |
20908596 CD |
12834 | "Prompt for a date/time and insert a time stamp. |
12835 | If the user specifies a time like HH:MM, or if this command is called | |
12836 | with a prefix argument, the time stamp will contain date and time. | |
12837 | Otherwise, only the date will be included. All parts of a date not | |
12838 | specified by the user will be filled in from the current date/time. | |
12839 | So if you press just return without typing anything, the time stamp | |
12840 | will represent the current date/time. If there is already a timestamp | |
12841 | at the cursor, it will be modified." | |
12842 | (interactive "P") | |
12843 | (let* ((ts nil) | |
12844 | (default-time | |
12845 | ;; Default time is either today, or, when entering a range, | |
12846 | ;; the range start. | |
12847 | (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0))) | |
12848 | (save-excursion | |
12849 | (re-search-backward | |
12850 | (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses | |
12851 | (- (point) 20) t))) | |
12852 | (apply 'encode-time (org-parse-time-string (match-string 1))) | |
12853 | (current-time))) | |
12854 | (default-input (and ts (org-get-compact-tod ts))) | |
12855 | org-time-was-given org-end-time-was-given time) | |
12856 | (cond | |
621f83e4 CD |
12857 | ((and (org-at-timestamp-p t) |
12858 | (memq last-command '(org-time-stamp org-time-stamp-inactive)) | |
12859 | (memq this-command '(org-time-stamp org-time-stamp-inactive))) | |
20908596 CD |
12860 | (insert "--") |
12861 | (setq time (let ((this-command this-command)) | |
621f83e4 CD |
12862 | (org-read-date arg 'totime nil nil |
12863 | default-time default-input))) | |
12864 | (org-insert-time-stamp time (or org-time-was-given arg) inactive)) | |
12865 | ((org-at-timestamp-p t) | |
20908596 CD |
12866 | (setq time (let ((this-command this-command)) |
12867 | (org-read-date arg 'totime nil nil default-time default-input))) | |
621f83e4 CD |
12868 | (when (org-at-timestamp-p t) ; just to get the match data |
12869 | ; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) | |
20908596 CD |
12870 | (replace-match "") |
12871 | (setq org-last-changed-timestamp | |
12872 | (org-insert-time-stamp | |
12873 | time (or org-time-was-given arg) | |
621f83e4 | 12874 | inactive nil nil (list org-end-time-was-given)))) |
20908596 CD |
12875 | (message "Timestamp updated")) |
12876 | (t | |
12877 | (setq time (let ((this-command this-command)) | |
12878 | (org-read-date arg 'totime nil nil default-time default-input))) | |
621f83e4 CD |
12879 | (org-insert-time-stamp time (or org-time-was-given arg) inactive |
12880 | nil nil (list org-end-time-was-given)))))) | |
d3f4dbe8 | 12881 | |
20908596 CD |
12882 | ;; FIXME: can we use this for something else, like computing time differences? |
12883 | (defun org-get-compact-tod (s) | |
12884 | (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) | |
12885 | (let* ((t1 (match-string 1 s)) | |
12886 | (h1 (string-to-number (match-string 2 s))) | |
12887 | (m1 (string-to-number (match-string 3 s))) | |
12888 | (t2 (and (match-end 4) (match-string 5 s))) | |
12889 | (h2 (and t2 (string-to-number (match-string 6 s)))) | |
12890 | (m2 (and t2 (string-to-number (match-string 7 s)))) | |
12891 | dh dm) | |
12892 | (if (not t2) | |
12893 | t1 | |
12894 | (setq dh (- h2 h1) dm (- m2 m1)) | |
12895 | (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) | |
12896 | (concat t1 "+" (number-to-string dh) | |
12897 | (if (/= 0 dm) (concat ":" (number-to-string dm)))))))) | |
d3f4dbe8 | 12898 | |
20908596 CD |
12899 | (defun org-time-stamp-inactive (&optional arg) |
12900 | "Insert an inactive time stamp. | |
12901 | An inactive time stamp is enclosed in square brackets instead of angle | |
12902 | brackets. It is inactive in the sense that it does not trigger agenda entries, | |
12903 | does not link to the calendar and cannot be changed with the S-cursor keys. | |
12904 | So these are more for recording a certain time/date." | |
12905 | (interactive "P") | |
621f83e4 | 12906 | (org-time-stamp arg 'inactive)) |
15841868 | 12907 | |
20908596 CD |
12908 | (defvar org-date-ovl (org-make-overlay 1 1)) |
12909 | (org-overlay-put org-date-ovl 'face 'org-warning) | |
12910 | (org-detach-overlay org-date-ovl) | |
d3f4dbe8 | 12911 | |
20908596 CD |
12912 | (defvar org-ans1) ; dynamically scoped parameter |
12913 | (defvar org-ans2) ; dynamically scoped parameter | |
8c6fb58b | 12914 | |
20908596 | 12915 | (defvar org-plain-time-of-day-regexp) ; defined below |
d3f4dbe8 | 12916 | |
b349f79f | 12917 | (defvar org-overriding-default-time nil) ; dynamically scoped |
20908596 CD |
12918 | (defvar org-read-date-overlay nil) |
12919 | (defvar org-dcst nil) ; dynamically scoped | |
c8d0cf5c CD |
12920 | (defvar org-read-date-history nil) |
12921 | (defvar org-read-date-final-answer nil) | |
d3f4dbe8 | 12922 | |
20908596 CD |
12923 | (defun org-read-date (&optional with-time to-time from-string prompt |
12924 | default-time default-input) | |
12925 | "Read a date, possibly a time, and make things smooth for the user. | |
12926 | The prompt will suggest to enter an ISO date, but you can also enter anything | |
12927 | which will at least partially be understood by `parse-time-string'. | |
12928 | Unrecognized parts of the date will default to the current day, month, year, | |
12929 | hour and minute. If this command is called to replace a timestamp at point, | |
12930 | of to enter the second timestamp of a range, the default time is taken from the | |
12931 | existing stamp. For example, | |
12932 | 3-2-5 --> 2003-02-05 | |
12933 | feb 15 --> currentyear-02-15 | |
12934 | sep 12 9 --> 2009-09-12 | |
12935 | 12:45 --> today 12:45 | |
12936 | 22 sept 0:34 --> currentyear-09-22 0:34 | |
12937 | 12 --> currentyear-currentmonth-12 | |
12938 | Fri --> nearest Friday (today or later) | |
12939 | etc. | |
8c6fb58b | 12940 | |
20908596 CD |
12941 | Furthermore you can specify a relative date by giving, as the *first* thing |
12942 | in the input: a plus/minus sign, a number and a letter [dwmy] to indicate | |
12943 | change in days weeks, months, years. | |
12944 | With a single plus or minus, the date is relative to today. With a double | |
12945 | plus or minus, it is relative to the date in DEFAULT-TIME. E.g. | |
12946 | +4d --> four days from today | |
12947 | +4 --> same as above | |
12948 | +2w --> two weeks from today | |
12949 | ++5 --> five days from default date | |
d3f4dbe8 | 12950 | |
20908596 CD |
12951 | The function understands only English month and weekday abbreviations, |
12952 | but this can be configured with the variables `parse-time-months' and | |
12953 | `parse-time-weekdays'. | |
d3f4dbe8 | 12954 | |
20908596 CD |
12955 | While prompting, a calendar is popped up - you can also select the |
12956 | date with the mouse (button 1). The calendar shows a period of three | |
12957 | months. To scroll it to other months, use the keys `>' and `<'. | |
12958 | If you don't like the calendar, turn it off with | |
12959 | \(setq org-read-date-popup-calendar nil) | |
48aaad2d | 12960 | |
20908596 CD |
12961 | With optional argument TO-TIME, the date will immediately be converted |
12962 | to an internal time. | |
12963 | With an optional argument WITH-TIME, the prompt will suggest to also | |
12964 | insert a time. Note that when WITH-TIME is not set, you can still | |
12965 | enter a time, and this function will inform the calling routine about | |
12966 | this change. The calling routine may then choose to change the format | |
12967 | used to insert the time stamp into the buffer to include the time. | |
12968 | With optional argument FROM-STRING, read from this string instead from | |
12969 | the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is | |
12970 | the time/date that is used for everything that is not specified by the | |
12971 | user." | |
12972 | (require 'parse-time) | |
12973 | (let* ((org-time-stamp-rounding-minutes | |
12974 | (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) | |
12975 | (org-dcst org-display-custom-times) | |
12976 | (ct (org-current-time)) | |
b349f79f | 12977 | (def (or org-overriding-default-time default-time ct)) |
20908596 CD |
12978 | (defdecode (decode-time def)) |
12979 | (dummy (progn | |
12980 | (when (< (nth 2 defdecode) org-extend-today-until) | |
12981 | (setcar (nthcdr 2 defdecode) -1) | |
12982 | (setcar (nthcdr 1 defdecode) 59) | |
12983 | (setq def (apply 'encode-time defdecode) | |
12984 | defdecode (decode-time def))))) | |
c8d0cf5c | 12985 | (calendar-frame-setup nil) |
20908596 CD |
12986 | (calendar-move-hook nil) |
12987 | (calendar-view-diary-initially-flag nil) | |
12988 | (view-diary-entries-initially nil) | |
12989 | (calendar-view-holidays-initially-flag nil) | |
12990 | (view-calendar-holidays-initially nil) | |
12991 | (timestr (format-time-string | |
12992 | (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def)) | |
12993 | (prompt (concat (if prompt (concat prompt " ") "") | |
12994 | (format "Date+time [%s]: " timestr))) | |
12995 | ans (org-ans0 "") org-ans1 org-ans2 final) | |
d3f4dbe8 | 12996 | |
38f8646b | 12997 | (cond |
20908596 CD |
12998 | (from-string (setq ans from-string)) |
12999 | (org-read-date-popup-calendar | |
13000 | (save-excursion | |
13001 | (save-window-excursion | |
13002 | (calendar) | |
13003 | (calendar-forward-day (- (time-to-days def) | |
13004 | (calendar-absolute-from-gregorian | |
13005 | (calendar-current-date)))) | |
13006 | (org-eval-in-calendar nil t) | |
13007 | (let* ((old-map (current-local-map)) | |
13008 | (map (copy-keymap calendar-mode-map)) | |
13009 | (minibuffer-local-map (copy-keymap minibuffer-local-map))) | |
13010 | (org-defkey map (kbd "RET") 'org-calendar-select) | |
13011 | (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) | |
c8d0cf5c | 13012 | 'org-calendar-select-mouse) |
20908596 | 13013 | (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) |
c8d0cf5c | 13014 | 'org-calendar-select-mouse) |
20908596 | 13015 | (org-defkey minibuffer-local-map [(meta shift left)] |
c8d0cf5c CD |
13016 | (lambda () (interactive) |
13017 | (org-eval-in-calendar '(calendar-backward-month 1)))) | |
20908596 | 13018 | (org-defkey minibuffer-local-map [(meta shift right)] |
c8d0cf5c CD |
13019 | (lambda () (interactive) |
13020 | (org-eval-in-calendar '(calendar-forward-month 1)))) | |
20908596 | 13021 | (org-defkey minibuffer-local-map [(meta shift up)] |
c8d0cf5c CD |
13022 | (lambda () (interactive) |
13023 | (org-eval-in-calendar '(calendar-backward-year 1)))) | |
20908596 | 13024 | (org-defkey minibuffer-local-map [(meta shift down)] |
c8d0cf5c CD |
13025 | (lambda () (interactive) |
13026 | (org-eval-in-calendar '(calendar-forward-year 1)))) | |
13027 | (org-defkey minibuffer-local-map [?\e (shift left)] | |
13028 | (lambda () (interactive) | |
13029 | (org-eval-in-calendar '(calendar-backward-month 1)))) | |
13030 | (org-defkey minibuffer-local-map [?\e (shift right)] | |
13031 | (lambda () (interactive) | |
13032 | (org-eval-in-calendar '(calendar-forward-month 1)))) | |
13033 | (org-defkey minibuffer-local-map [?\e (shift up)] | |
13034 | (lambda () (interactive) | |
13035 | (org-eval-in-calendar '(calendar-backward-year 1)))) | |
13036 | (org-defkey minibuffer-local-map [?\e (shift down)] | |
13037 | (lambda () (interactive) | |
13038 | (org-eval-in-calendar '(calendar-forward-year 1)))) | |
20908596 | 13039 | (org-defkey minibuffer-local-map [(shift up)] |
c8d0cf5c CD |
13040 | (lambda () (interactive) |
13041 | (org-eval-in-calendar '(calendar-backward-week 1)))) | |
20908596 | 13042 | (org-defkey minibuffer-local-map [(shift down)] |
c8d0cf5c CD |
13043 | (lambda () (interactive) |
13044 | (org-eval-in-calendar '(calendar-forward-week 1)))) | |
20908596 | 13045 | (org-defkey minibuffer-local-map [(shift left)] |
c8d0cf5c CD |
13046 | (lambda () (interactive) |
13047 | (org-eval-in-calendar '(calendar-backward-day 1)))) | |
20908596 | 13048 | (org-defkey minibuffer-local-map [(shift right)] |
c8d0cf5c CD |
13049 | (lambda () (interactive) |
13050 | (org-eval-in-calendar '(calendar-forward-day 1)))) | |
20908596 | 13051 | (org-defkey minibuffer-local-map ">" |
c8d0cf5c CD |
13052 | (lambda () (interactive) |
13053 | (org-eval-in-calendar '(scroll-calendar-left 1)))) | |
20908596 | 13054 | (org-defkey minibuffer-local-map "<" |
c8d0cf5c CD |
13055 | (lambda () (interactive) |
13056 | (org-eval-in-calendar '(scroll-calendar-right 1)))) | |
13057 | (run-hooks 'org-read-date-minibuffer-setup-hook) | |
20908596 CD |
13058 | (unwind-protect |
13059 | (progn | |
13060 | (use-local-map map) | |
13061 | (add-hook 'post-command-hook 'org-read-date-display) | |
c8d0cf5c CD |
13062 | (setq org-ans0 (read-string prompt default-input |
13063 | 'org-read-date-history nil)) | |
20908596 CD |
13064 | ;; org-ans0: from prompt |
13065 | ;; org-ans1: from mouse click | |
13066 | ;; org-ans2: from calendar motion | |
13067 | (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) | |
13068 | (remove-hook 'post-command-hook 'org-read-date-display) | |
13069 | (use-local-map old-map) | |
13070 | (when org-read-date-overlay | |
13071 | (org-delete-overlay org-read-date-overlay) | |
13072 | (setq org-read-date-overlay nil))))))) | |
d3f4dbe8 | 13073 | |
20908596 CD |
13074 | (t ; Naked prompt only |
13075 | (unwind-protect | |
c8d0cf5c CD |
13076 | (setq ans (read-string prompt default-input |
13077 | 'org-read-date-history timestr)) | |
20908596 CD |
13078 | (when org-read-date-overlay |
13079 | (org-delete-overlay org-read-date-overlay) | |
13080 | (setq org-read-date-overlay nil))))) | |
d3f4dbe8 | 13081 | |
20908596 | 13082 | (setq final (org-read-date-analyze ans def defdecode)) |
c8d0cf5c | 13083 | (setq org-read-date-final-answer ans) |
d3f4dbe8 | 13084 | |
20908596 CD |
13085 | (if to-time |
13086 | (apply 'encode-time final) | |
13087 | (if (and (boundp 'org-time-was-given) org-time-was-given) | |
13088 | (format "%04d-%02d-%02d %02d:%02d" | |
13089 | (nth 5 final) (nth 4 final) (nth 3 final) | |
13090 | (nth 2 final) (nth 1 final)) | |
13091 | (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) | |
c8d0cf5c | 13092 | |
20908596 CD |
13093 | (defvar def) |
13094 | (defvar defdecode) | |
13095 | (defvar with-time) | |
8bfe682a | 13096 | (defvar org-read-date-analyze-futurep nil) |
20908596 | 13097 | (defun org-read-date-display () |
33306645 | 13098 | "Display the current date prompt interpretation in the minibuffer." |
20908596 CD |
13099 | (when org-read-date-display-live |
13100 | (when org-read-date-overlay | |
13101 | (org-delete-overlay org-read-date-overlay)) | |
13102 | (let ((p (point))) | |
13103 | (end-of-line 1) | |
13104 | (while (not (equal (buffer-substring | |
13105 | (max (point-min) (- (point) 4)) (point)) | |
13106 | " ")) | |
13107 | (insert " ")) | |
13108 | (goto-char p)) | |
13109 | (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) | |
13110 | " " (or org-ans1 org-ans2))) | |
13111 | (org-end-time-was-given nil) | |
13112 | (f (org-read-date-analyze ans def defdecode)) | |
13113 | (fmts (if org-dcst | |
13114 | org-time-stamp-custom-formats | |
13115 | org-time-stamp-formats)) | |
13116 | (fmt (if (or with-time | |
13117 | (and (boundp 'org-time-was-given) org-time-was-given)) | |
13118 | (cdr fmts) | |
13119 | (car fmts))) | |
13120 | (txt (concat "=> " (format-time-string fmt (apply 'encode-time f))))) | |
13121 | (when (and org-end-time-was-given | |
13122 | (string-match org-plain-time-of-day-regexp txt)) | |
13123 | (setq txt (concat (substring txt 0 (match-end 0)) "-" | |
13124 | org-end-time-was-given | |
13125 | (substring txt (match-end 0))))) | |
8bfe682a CD |
13126 | (when org-read-date-analyze-futurep |
13127 | (setq txt (concat txt " (=>F)"))) | |
20908596 | 13128 | (setq org-read-date-overlay |
621f83e4 | 13129 | (org-make-overlay (1- (point-at-eol)) (point-at-eol))) |
20908596 | 13130 | (org-overlay-display org-read-date-overlay txt 'secondary-selection)))) |
d3f4dbe8 | 13131 | |
20908596 | 13132 | (defun org-read-date-analyze (ans def defdecode) |
33306645 | 13133 | "Analyse the combined answer of the date prompt." |
20908596 CD |
13134 | ;; FIXME: cleanup and comment |
13135 | (let (delta deltan deltaw deltadef year month day | |
13136 | hour minute second wday pm h2 m2 tl wday1 | |
8bfe682a CD |
13137 | iso-year iso-weekday iso-week iso-year iso-date futurep) |
13138 | (setq org-read-date-analyze-futurep nil) | |
b349f79f CD |
13139 | (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) |
13140 | (setq ans "+0")) | |
13141 | ||
20908596 CD |
13142 | (when (setq delta (org-read-date-get-relative ans (current-time) def)) |
13143 | (setq ans (replace-match "" t t ans) | |
13144 | deltan (car delta) | |
13145 | deltaw (nth 1 delta) | |
13146 | deltadef (nth 2 delta))) | |
d3f4dbe8 | 13147 | |
20908596 | 13148 | ;; Check if there is an iso week date in there |
5dec9555 | 13149 | ;; If yes, store the info and postpone interpreting it until the rest |
20908596 CD |
13150 | ;; of the parsing is done |
13151 | (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) | |
13152 | (setq iso-year (if (match-end 1) (org-small-year-to-year (string-to-number (match-string 1 ans)))) | |
13153 | iso-weekday (if (match-end 3) (string-to-number (match-string 3 ans))) | |
13154 | iso-week (string-to-number (match-string 2 ans))) | |
13155 | (setq ans (replace-match "" t t ans))) | |
d3f4dbe8 | 13156 | |
20908596 CD |
13157 | ;; Help matching ISO dates with single digit month ot day, like 2006-8-11. |
13158 | (when (string-match | |
13159 | "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) | |
13160 | (setq year (if (match-end 2) | |
13161 | (string-to-number (match-string 2 ans)) | |
13162 | (string-to-number (format-time-string "%Y"))) | |
13163 | month (string-to-number (match-string 3 ans)) | |
13164 | day (string-to-number (match-string 4 ans))) | |
13165 | (if (< year 100) (setq year (+ 2000 year))) | |
13166 | (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) | |
13167 | t nil ans))) | |
13168 | ;; Help matching am/pm times, because `parse-time-string' does not do that. | |
13169 | ;; If there is a time with am/pm, and *no* time without it, we convert | |
13170 | ;; so that matching will be successful. | |
13171 | (loop for i from 1 to 2 do ; twice, for end time as well | |
13172 | (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) | |
13173 | (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) | |
13174 | (setq hour (string-to-number (match-string 1 ans)) | |
13175 | minute (if (match-end 3) | |
13176 | (string-to-number (match-string 3 ans)) | |
13177 | 0) | |
13178 | pm (equal ?p | |
13179 | (string-to-char (downcase (match-string 4 ans))))) | |
13180 | (if (and (= hour 12) (not pm)) | |
13181 | (setq hour 0) | |
13182 | (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) | |
13183 | (setq ans (replace-match (format "%02d:%02d" hour minute) | |
13184 | t t ans)))) | |
d3f4dbe8 | 13185 | |
20908596 CD |
13186 | ;; Check if a time range is given as a duration |
13187 | (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) | |
13188 | (setq hour (string-to-number (match-string 1 ans)) | |
13189 | h2 (+ hour (string-to-number (match-string 3 ans))) | |
13190 | minute (string-to-number (match-string 2 ans)) | |
13191 | m2 (+ minute (if (match-end 5) (string-to-number | |
13192 | (match-string 5 ans))0))) | |
13193 | (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) | |
13194 | (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) | |
13195 | t t ans))) | |
d3f4dbe8 | 13196 | |
20908596 CD |
13197 | ;; Check if there is a time range |
13198 | (when (boundp 'org-end-time-was-given) | |
13199 | (setq org-time-was-given nil) | |
13200 | (when (and (string-match org-plain-time-of-day-regexp ans) | |
13201 | (match-end 8)) | |
13202 | (setq org-end-time-was-given (match-string 8 ans)) | |
13203 | (setq ans (concat (substring ans 0 (match-beginning 7)) | |
13204 | (substring ans (match-end 7)))))) | |
a3fbe8c4 | 13205 | |
20908596 CD |
13206 | (setq tl (parse-time-string ans) |
13207 | day (or (nth 3 tl) (nth 3 defdecode)) | |
13208 | month (or (nth 4 tl) | |
13209 | (if (and org-read-date-prefer-future | |
13210 | (nth 3 tl) (< (nth 3 tl) (nth 3 defdecode))) | |
8bfe682a | 13211 | (prog1 (1+ (nth 4 defdecode)) (setq futurep t)) |
20908596 CD |
13212 | (nth 4 defdecode))) |
13213 | year (or (nth 5 tl) | |
13214 | (if (and org-read-date-prefer-future | |
13215 | (nth 4 tl) (< (nth 4 tl) (nth 4 defdecode))) | |
8bfe682a | 13216 | (prog1 (1+ (nth 5 defdecode)) (setq futurep t)) |
20908596 CD |
13217 | (nth 5 defdecode))) |
13218 | hour (or (nth 2 tl) (nth 2 defdecode)) | |
13219 | minute (or (nth 1 tl) (nth 1 defdecode)) | |
13220 | second (or (nth 0 tl) 0) | |
13221 | wday (nth 6 tl)) | |
a3fbe8c4 | 13222 | |
8bfe682a CD |
13223 | (when (and (eq org-read-date-prefer-future 'time) |
13224 | (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl)) | |
13225 | (equal day (nth 3 defdecode)) | |
13226 | (equal month (nth 4 defdecode)) | |
13227 | (equal year (nth 5 defdecode)) | |
13228 | (nth 2 tl) | |
13229 | (or (< (nth 2 tl) (nth 2 defdecode)) | |
13230 | (and (= (nth 2 tl) (nth 2 defdecode)) | |
13231 | (nth 1 tl) | |
13232 | (< (nth 1 tl) (nth 1 defdecode))))) | |
13233 | (setq day (1+ day) | |
13234 | futurep t)) | |
13235 | ||
20908596 CD |
13236 | ;; Special date definitions below |
13237 | (cond | |
13238 | (iso-week | |
13239 | ;; There was an iso week | |
8bfe682a | 13240 | (setq futurep nil) |
20908596 CD |
13241 | (setq year (or iso-year year) |
13242 | day (or iso-weekday wday 1) | |
13243 | wday nil ; to make sure that the trigger below does not match | |
13244 | iso-date (calendar-gregorian-from-absolute | |
13245 | (calendar-absolute-from-iso | |
13246 | (list iso-week day year)))) | |
13247 | ; FIXME: Should we also push ISO weeks into the future? | |
13248 | ; (when (and org-read-date-prefer-future | |
13249 | ; (not iso-year) | |
13250 | ; (< (calendar-absolute-from-gregorian iso-date) | |
13251 | ; (time-to-days (current-time)))) | |
13252 | ; (setq year (1+ year) | |
13253 | ; iso-date (calendar-gregorian-from-absolute | |
13254 | ; (calendar-absolute-from-iso | |
13255 | ; (list iso-week day year))))) | |
13256 | (setq month (car iso-date) | |
13257 | year (nth 2 iso-date) | |
13258 | day (nth 1 iso-date))) | |
13259 | (deltan | |
8bfe682a | 13260 | (setq futurep nil) |
20908596 CD |
13261 | (unless deltadef |
13262 | (let ((now (decode-time (current-time)))) | |
13263 | (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) | |
13264 | (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) | |
13265 | ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) | |
13266 | ((equal deltaw "m") (setq month (+ month deltan))) | |
13267 | ((equal deltaw "y") (setq year (+ year deltan))))) | |
13268 | ((and wday (not (nth 3 tl))) | |
8bfe682a | 13269 | (setq futurep nil) |
20908596 CD |
13270 | ;; Weekday was given, but no day, so pick that day in the week |
13271 | ;; on or after the derived date. | |
13272 | (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) | |
13273 | (unless (equal wday wday1) | |
13274 | (setq day (+ day (% (- wday wday1 -7) 7)))))) | |
13275 | (if (and (boundp 'org-time-was-given) | |
13276 | (nth 2 tl)) | |
13277 | (setq org-time-was-given t)) | |
13278 | (if (< year 100) (setq year (+ 2000 year))) | |
13279 | (if (< year 1970) (setq year (nth 5 defdecode))) ; not representable | |
8bfe682a | 13280 | (setq org-read-date-analyze-futurep futurep) |
20908596 | 13281 | (list second minute hour day month year))) |
d3f4dbe8 | 13282 | |
20908596 | 13283 | (defvar parse-time-weekdays) |
d3f4dbe8 | 13284 | |
20908596 CD |
13285 | (defun org-read-date-get-relative (s today default) |
13286 | "Check string S for special relative date string. | |
13287 | TODAY and DEFAULT are internal times, for today and for a default. | |
13288 | Return shift list (N what def-flag) | |
13289 | WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. | |
13290 | N is the number of WHATs to shift. | |
13291 | DEF-FLAG is t when a double ++ or -- indicates shift relative to | |
13292 | the DEFAULT date rather than TODAY." | |
7b1019e2 MB |
13293 | (when (and |
13294 | (string-match | |
13295 | (concat | |
13296 | "\\`[ \t]*\\([-+]\\{0,2\\}\\)" | |
13297 | "\\([0-9]+\\)?" | |
13298 | "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" | |
13299 | "\\([ \t]\\|$\\)") s) | |
13300 | (or (> (match-end 1) (match-beginning 1)) (match-end 4))) | |
13301 | (let* ((dir (if (> (match-end 1) (match-beginning 1)) | |
20908596 CD |
13302 | (string-to-char (substring (match-string 1 s) -1)) |
13303 | ?+)) | |
13304 | (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1))))) | |
13305 | (n (if (match-end 2) (string-to-number (match-string 2 s)) 1)) | |
13306 | (what (if (match-end 3) (match-string 3 s) "d")) | |
13307 | (wday1 (cdr (assoc (downcase what) parse-time-weekdays))) | |
13308 | (date (if rel default today)) | |
13309 | (wday (nth 6 (decode-time date))) | |
13310 | delta) | |
13311 | (if wday1 | |
13312 | (progn | |
13313 | (setq delta (mod (+ 7 (- wday1 wday)) 7)) | |
13314 | (if (= dir ?-) (setq delta (- delta 7))) | |
13315 | (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) | |
13316 | (list delta "d" rel)) | |
13317 | (list (* n (if (= dir ?-) -1 1)) what rel))))) | |
d3f4dbe8 | 13318 | |
20908596 CD |
13319 | (defun org-eval-in-calendar (form &optional keepdate) |
13320 | "Eval FORM in the calendar window and return to current window. | |
13321 | Also, store the cursor date in variable org-ans2." | |
c8d0cf5c CD |
13322 | (let ((sf (selected-frame)) |
13323 | (sw (selected-window))) | |
13324 | (select-window (get-buffer-window "*Calendar*" t)) | |
20908596 CD |
13325 | (eval form) |
13326 | (when (and (not keepdate) (calendar-cursor-to-date)) | |
13327 | (let* ((date (calendar-cursor-to-date)) | |
13328 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
13329 | (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) | |
13330 | (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) | |
c8d0cf5c | 13331 | (select-window sw) |
54a0dee5 | 13332 | (org-select-frame-set-input-focus sf))) |
d3f4dbe8 | 13333 | |
20908596 CD |
13334 | (defun org-calendar-select () |
13335 | "Return to `org-read-date' with the date currently selected. | |
13336 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
d3f4dbe8 | 13337 | (interactive) |
20908596 CD |
13338 | (when (calendar-cursor-to-date) |
13339 | (let* ((date (calendar-cursor-to-date)) | |
13340 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
13341 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
13342 | (if (active-minibuffer-window) (exit-minibuffer)))) | |
13343 | ||
13344 | (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) | |
13345 | "Insert a date stamp for the date given by the internal TIME. | |
13346 | WITH-HM means, use the stamp format that includes the time of the day. | |
13347 | INACTIVE means use square brackets instead of angular ones, so that the | |
13348 | stamp will not contribute to the agenda. | |
13349 | PRE and POST are optional strings to be inserted before and after the | |
13350 | stamp. | |
13351 | The command returns the inserted time stamp." | |
13352 | (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) | |
13353 | stamp) | |
13354 | (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) | |
13355 | (insert-before-markers (or pre "")) | |
13356 | (insert-before-markers (setq stamp (format-time-string fmt time))) | |
13357 | (when (listp extra) | |
13358 | (setq extra (car extra)) | |
13359 | (if (and (stringp extra) | |
13360 | (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) | |
13361 | (setq extra (format "-%02d:%02d" | |
13362 | (string-to-number (match-string 1 extra)) | |
13363 | (string-to-number (match-string 2 extra)))) | |
13364 | (setq extra nil))) | |
13365 | (when extra | |
13366 | (backward-char 1) | |
13367 | (insert-before-markers extra) | |
13368 | (forward-char 1)) | |
13369 | (insert-before-markers (or post "")) | |
b349f79f | 13370 | (setq org-last-inserted-timestamp stamp))) |
d3f4dbe8 | 13371 | |
20908596 CD |
13372 | (defun org-toggle-time-stamp-overlays () |
13373 | "Toggle the use of custom time stamp formats." | |
d3f4dbe8 | 13374 | (interactive) |
20908596 CD |
13375 | (setq org-display-custom-times (not org-display-custom-times)) |
13376 | (unless org-display-custom-times | |
13377 | (let ((p (point-min)) (bmp (buffer-modified-p))) | |
13378 | (while (setq p (next-single-property-change p 'display)) | |
13379 | (if (and (get-text-property p 'display) | |
13380 | (eq (get-text-property p 'face) 'org-date)) | |
13381 | (remove-text-properties | |
13382 | p (setq p (next-single-property-change p 'display)) | |
13383 | '(display t)))) | |
13384 | (set-buffer-modified-p bmp))) | |
13385 | (if (featurep 'xemacs) | |
13386 | (remove-text-properties (point-min) (point-max) '(end-glyph t))) | |
13387 | (org-restart-font-lock) | |
13388 | (setq org-table-may-need-update t) | |
13389 | (if org-display-custom-times | |
13390 | (message "Time stamps are overlayed with custom format") | |
13391 | (message "Time stamp overlays removed"))) | |
d3f4dbe8 | 13392 | |
20908596 | 13393 | (defun org-display-custom-time (beg end) |
b349f79f | 13394 | "Overlay modified time stamp format over timestamp between BEG and END." |
20908596 CD |
13395 | (let* ((ts (buffer-substring beg end)) |
13396 | t1 w1 with-hm tf time str w2 (off 0)) | |
13397 | (save-match-data | |
13398 | (setq t1 (org-parse-time-string ts t)) | |
8bfe682a | 13399 | (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)?\\'" ts) |
20908596 CD |
13400 | (setq off (- (match-end 0) (match-beginning 0))))) |
13401 | (setq end (- end off)) | |
13402 | (setq w1 (- end beg) | |
13403 | with-hm (and (nth 1 t1) (nth 2 t1)) | |
13404 | tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) | |
13405 | time (org-fix-decoded-time t1) | |
13406 | str (org-add-props | |
13407 | (format-time-string | |
13408 | (substring tf 1 -1) (apply 'encode-time time)) | |
13409 | nil 'mouse-face 'highlight) | |
13410 | w2 (length str)) | |
13411 | (if (not (= w2 w1)) | |
13412 | (add-text-properties (1+ beg) (+ 2 beg) | |
13413 | (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) | |
13414 | (if (featurep 'xemacs) | |
13415 | (progn | |
13416 | (put-text-property beg end 'invisible t) | |
13417 | (put-text-property beg end 'end-glyph (make-glyph str))) | |
13418 | (put-text-property beg end 'display str)))) | |
d3f4dbe8 | 13419 | |
20908596 CD |
13420 | (defun org-translate-time (string) |
13421 | "Translate all timestamps in STRING to custom format. | |
13422 | But do this only if the variable `org-display-custom-times' is set." | |
13423 | (when org-display-custom-times | |
13424 | (save-match-data | |
13425 | (let* ((start 0) | |
13426 | (re org-ts-regexp-both) | |
13427 | t1 with-hm inactive tf time str beg end) | |
13428 | (while (setq start (string-match re string start)) | |
13429 | (setq beg (match-beginning 0) | |
13430 | end (match-end 0) | |
13431 | t1 (save-match-data | |
13432 | (org-parse-time-string (substring string beg end) t)) | |
13433 | with-hm (and (nth 1 t1) (nth 2 t1)) | |
13434 | inactive (equal (substring string beg (1+ beg)) "[") | |
13435 | tf (funcall (if with-hm 'cdr 'car) | |
13436 | org-time-stamp-custom-formats) | |
13437 | time (org-fix-decoded-time t1) | |
13438 | str (format-time-string | |
13439 | (concat | |
13440 | (if inactive "[" "<") (substring tf 1 -1) | |
13441 | (if inactive "]" ">")) | |
13442 | (apply 'encode-time time)) | |
13443 | string (replace-match str t t string) | |
13444 | start (+ start (length str))))))) | |
13445 | string) | |
d3f4dbe8 | 13446 | |
20908596 CD |
13447 | (defun org-fix-decoded-time (time) |
13448 | "Set 0 instead of nil for the first 6 elements of time. | |
13449 | Don't touch the rest." | |
13450 | (let ((n 0)) | |
13451 | (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) | |
d3f4dbe8 | 13452 | |
20908596 CD |
13453 | (defun org-days-to-time (timestamp-string) |
13454 | "Difference between TIMESTAMP-STRING and now in days." | |
13455 | (- (time-to-days (org-time-string-to-time timestamp-string)) | |
13456 | (time-to-days (current-time)))) | |
d3f4dbe8 | 13457 | |
20908596 CD |
13458 | (defun org-deadline-close (timestamp-string &optional ndays) |
13459 | "Is the time in TIMESTAMP-STRING close to the current date?" | |
13460 | (setq ndays (or ndays (org-get-wdays timestamp-string))) | |
13461 | (and (< (org-days-to-time timestamp-string) ndays) | |
13462 | (not (org-entry-is-done-p)))) | |
d3f4dbe8 | 13463 | |
20908596 CD |
13464 | (defun org-get-wdays (ts) |
13465 | "Get the deadline lead time appropriate for timestring TS." | |
13466 | (cond | |
13467 | ((<= org-deadline-warning-days 0) | |
13468 | ;; 0 or negative, enforce this value no matter what | |
13469 | (- org-deadline-warning-days)) | |
c8d0cf5c | 13470 | ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts) |
20908596 CD |
13471 | ;; lead time is specified. |
13472 | (floor (* (string-to-number (match-string 1 ts)) | |
13473 | (cdr (assoc (match-string 2 ts) | |
13474 | '(("d" . 1) ("w" . 7) | |
13475 | ("m" . 30.4) ("y" . 365.25))))))) | |
13476 | ;; go for the default. | |
13477 | (t org-deadline-warning-days))) | |
d3f4dbe8 | 13478 | |
20908596 CD |
13479 | (defun org-calendar-select-mouse (ev) |
13480 | "Return to `org-read-date' with the date currently selected. | |
13481 | This is used by `org-read-date' in a temporary keymap for the calendar buffer." | |
13482 | (interactive "e") | |
13483 | (mouse-set-point ev) | |
13484 | (when (calendar-cursor-to-date) | |
13485 | (let* ((date (calendar-cursor-to-date)) | |
13486 | (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
13487 | (setq org-ans1 (format-time-string "%Y-%m-%d" time))) | |
13488 | (if (active-minibuffer-window) (exit-minibuffer)))) | |
d3f4dbe8 | 13489 | |
20908596 CD |
13490 | (defun org-check-deadlines (ndays) |
13491 | "Check if there are any deadlines due or past due. | |
13492 | A deadline is considered due if it happens within `org-deadline-warning-days' | |
13493 | days from today's date. If the deadline appears in an entry marked DONE, | |
13494 | it is not shown. The prefix arg NDAYS can be used to test that many | |
13495 | days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." | |
d3f4dbe8 | 13496 | (interactive "P") |
20908596 CD |
13497 | (let* ((org-warn-days |
13498 | (cond | |
13499 | ((equal ndays '(4)) 100000) | |
13500 | (ndays (prefix-numeric-value ndays)) | |
13501 | (t (abs org-deadline-warning-days)))) | |
13502 | (case-fold-search nil) | |
13503 | (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) | |
13504 | (callback | |
13505 | (lambda () (org-deadline-close (match-string 1) org-warn-days)))) | |
d3f4dbe8 | 13506 | |
20908596 CD |
13507 | (message "%d deadlines past-due or due within %d days" |
13508 | (org-occur regexp nil callback) | |
13509 | org-warn-days))) | |
d3f4dbe8 | 13510 | |
20908596 CD |
13511 | (defun org-check-before-date (date) |
13512 | "Check if there are deadlines or scheduled entries before DATE." | |
13513 | (interactive (list (org-read-date))) | |
13514 | (let ((case-fold-search nil) | |
13515 | (regexp (concat "\\<\\(" org-deadline-string | |
13516 | "\\|" org-scheduled-string | |
13517 | "\\) *<\\([^>]+\\)>")) | |
13518 | (callback | |
13519 | (lambda () (time-less-p | |
13520 | (org-time-string-to-time (match-string 2)) | |
13521 | (org-time-string-to-time date))))) | |
13522 | (message "%d entries before %s" | |
13523 | (org-occur regexp nil callback) date))) | |
100a4141 | 13524 | |
c8d0cf5c CD |
13525 | (defun org-check-after-date (date) |
13526 | "Check if there are deadlines or scheduled entries after DATE." | |
13527 | (interactive (list (org-read-date))) | |
13528 | (let ((case-fold-search nil) | |
13529 | (regexp (concat "\\<\\(" org-deadline-string | |
13530 | "\\|" org-scheduled-string | |
13531 | "\\) *<\\([^>]+\\)>")) | |
13532 | (callback | |
13533 | (lambda () (not | |
13534 | (time-less-p | |
13535 | (org-time-string-to-time (match-string 2)) | |
13536 | (org-time-string-to-time date)))))) | |
13537 | (message "%d entries after %s" | |
13538 | (org-occur regexp nil callback) date))) | |
13539 | ||
20908596 CD |
13540 | (defun org-evaluate-time-range (&optional to-buffer) |
13541 | "Evaluate a time range by computing the difference between start and end. | |
13542 | Normally the result is just printed in the echo area, but with prefix arg | |
13543 | TO-BUFFER, the result is inserted just after the date stamp into the buffer. | |
13544 | If the time range is actually in a table, the result is inserted into the | |
13545 | next column. | |
13546 | For time difference computation, a year is assumed to be exactly 365 | |
13547 | days in order to avoid rounding problems." | |
d3f4dbe8 | 13548 | (interactive "P") |
20908596 CD |
13549 | (or |
13550 | (org-clock-update-time-maybe) | |
13551 | (save-excursion | |
13552 | (unless (org-at-date-range-p t) | |
13553 | (goto-char (point-at-bol)) | |
13554 | (re-search-forward org-tr-regexp-both (point-at-eol) t)) | |
13555 | (if (not (org-at-date-range-p t)) | |
13556 | (error "Not at a time-stamp range, and none found in current line"))) | |
13557 | (let* ((ts1 (match-string 1)) | |
13558 | (ts2 (match-string 2)) | |
13559 | (havetime (or (> (length ts1) 15) (> (length ts2) 15))) | |
13560 | (match-end (match-end 0)) | |
13561 | (time1 (org-time-string-to-time ts1)) | |
13562 | (time2 (org-time-string-to-time ts2)) | |
54a0dee5 CD |
13563 | (t1 (org-float-time time1)) |
13564 | (t2 (org-float-time time2)) | |
20908596 CD |
13565 | (diff (abs (- t2 t1))) |
13566 | (negative (< (- t2 t1) 0)) | |
13567 | ;; (ys (floor (* 365 24 60 60))) | |
13568 | (ds (* 24 60 60)) | |
13569 | (hs (* 60 60)) | |
13570 | (fy "%dy %dd %02d:%02d") | |
13571 | (fy1 "%dy %dd") | |
13572 | (fd "%dd %02d:%02d") | |
13573 | (fd1 "%dd") | |
13574 | (fh "%02d:%02d") | |
13575 | y d h m align) | |
13576 | (if havetime | |
13577 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
13578 | y 0 | |
13579 | d (floor (/ diff ds)) diff (mod diff ds) | |
13580 | h (floor (/ diff hs)) diff (mod diff hs) | |
13581 | m (floor (/ diff 60))) | |
13582 | (setq ; y (floor (/ diff ys)) diff (mod diff ys) | |
13583 | y 0 | |
13584 | d (floor (+ (/ diff ds) 0.5)) | |
13585 | h 0 m 0)) | |
13586 | (if (not to-buffer) | |
13587 | (message "%s" (org-make-tdiff-string y d h m)) | |
13588 | (if (org-at-table-p) | |
13589 | (progn | |
13590 | (goto-char match-end) | |
13591 | (setq align t) | |
13592 | (and (looking-at " *|") (goto-char (match-end 0)))) | |
13593 | (goto-char match-end)) | |
13594 | (if (looking-at | |
13595 | "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") | |
13596 | (replace-match "")) | |
13597 | (if negative (insert " -")) | |
13598 | (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) | |
13599 | (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) | |
13600 | (insert " " (format fh h m)))) | |
13601 | (if align (org-table-align)) | |
13602 | (message "Time difference inserted"))))) | |
791d856f | 13603 | |
20908596 CD |
13604 | (defun org-make-tdiff-string (y d h m) |
13605 | (let ((fmt "") | |
13606 | (l nil)) | |
13607 | (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") | |
13608 | l (push y l))) | |
13609 | (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") | |
13610 | l (push d l))) | |
13611 | (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") | |
13612 | l (push h l))) | |
13613 | (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") | |
13614 | l (push m l))) | |
13615 | (apply 'format fmt (nreverse l)))) | |
ab27a4a0 | 13616 | |
20908596 CD |
13617 | (defun org-time-string-to-time (s) |
13618 | (apply 'encode-time (org-parse-time-string s))) | |
c8d0cf5c | 13619 | (defun org-time-string-to-seconds (s) |
54a0dee5 | 13620 | (org-float-time (org-time-string-to-time s))) |
791d856f | 13621 | |
20908596 CD |
13622 | (defun org-time-string-to-absolute (s &optional daynr prefer show-all) |
13623 | "Convert a time stamp to an absolute day number. | |
13624 | If there is a specifyer for a cyclic time stamp, get the closest date to | |
13625 | DAYNR. | |
c8d0cf5c CD |
13626 | PREFER and SHOW-ALL are passed through to `org-closest-date'. |
13627 | the variable date is bound by the calendar when this is called." | |
20908596 CD |
13628 | (cond |
13629 | ((and daynr (string-match "\\`%%\\((.*)\\)" s)) | |
13630 | (if (org-diary-sexp-entry (match-string 1 s) "" date) | |
13631 | daynr | |
13632 | (+ daynr 1000))) | |
13633 | ((and daynr (string-match "\\+[0-9]+[dwmy]" s)) | |
13634 | (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr | |
13635 | (time-to-days (current-time))) (match-string 0 s) | |
13636 | prefer show-all)) | |
13637 | (t (time-to-days (apply 'encode-time (org-parse-time-string s)))))) | |
791d856f | 13638 | |
20908596 CD |
13639 | (defun org-days-to-iso-week (days) |
13640 | "Return the iso week number." | |
13641 | (require 'cal-iso) | |
13642 | (car (calendar-iso-from-absolute days))) | |
13643 | ||
13644 | (defun org-small-year-to-year (year) | |
13645 | "Convert 2-digit years into 4-digit years. | |
13646 | 38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007. | |
d60b1ba1 CD |
13647 | The year 2000 cannot be abbreviated. Any year larger than 99 |
13648 | is returned unchanged." | |
20908596 CD |
13649 | (if (< year 38) |
13650 | (setq year (+ 2000 year)) | |
13651 | (if (< year 100) | |
13652 | (setq year (+ 1900 year)))) | |
13653 | year) | |
791d856f | 13654 | |
20908596 CD |
13655 | (defun org-time-from-absolute (d) |
13656 | "Return the time corresponding to date D. | |
13657 | D may be an absolute day number, or a calendar-type list (month day year)." | |
13658 | (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) | |
13659 | (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) | |
d3f4dbe8 | 13660 | |
20908596 CD |
13661 | (defun org-calendar-holiday () |
13662 | "List of holidays, for Diary display in Org-mode." | |
13663 | (require 'holidays) | |
13664 | (let ((hl (funcall | |
13665 | (if (fboundp 'calendar-check-holidays) | |
13666 | 'calendar-check-holidays 'check-calendar-holidays) date))) | |
13667 | (if hl (mapconcat 'identity hl "; ")))) | |
d3f4dbe8 | 13668 | |
20908596 CD |
13669 | (defun org-diary-sexp-entry (sexp entry date) |
13670 | "Process a SEXP diary ENTRY for DATE." | |
13671 | (require 'diary-lib) | |
13672 | (let ((result (if calendar-debug-sexp | |
13673 | (let ((stack-trace-on-error t)) | |
13674 | (eval (car (read-from-string sexp)))) | |
13675 | (condition-case nil | |
13676 | (eval (car (read-from-string sexp))) | |
13677 | (error | |
13678 | (beep) | |
13679 | (message "Bad sexp at line %d in %s: %s" | |
13680 | (org-current-line) | |
13681 | (buffer-file-name) sexp) | |
13682 | (sleep-for 2)))))) | |
13683 | (cond ((stringp result) result) | |
13684 | ((and (consp result) | |
13685 | (stringp (cdr result))) (cdr result)) | |
13686 | (result entry) | |
13687 | (t nil)))) | |
d3f4dbe8 | 13688 | |
20908596 CD |
13689 | (defun org-diary-to-ical-string (frombuf) |
13690 | "Get iCalendar entries from diary entries in buffer FROMBUF. | |
13691 | This uses the icalendar.el library." | |
13692 | (let* ((tmpdir (if (featurep 'xemacs) | |
13693 | (temp-directory) | |
13694 | temporary-file-directory)) | |
13695 | (tmpfile (make-temp-name | |
13696 | (expand-file-name "orgics" tmpdir))) | |
13697 | buf rtn b e) | |
81ad75af | 13698 | (with-current-buffer frombuf |
20908596 CD |
13699 | (icalendar-export-region (point-min) (point-max) tmpfile) |
13700 | (setq buf (find-buffer-visiting tmpfile)) | |
13701 | (set-buffer buf) | |
13702 | (goto-char (point-min)) | |
13703 | (if (re-search-forward "^BEGIN:VEVENT" nil t) | |
13704 | (setq b (match-beginning 0))) | |
13705 | (goto-char (point-max)) | |
13706 | (if (re-search-backward "^END:VEVENT" nil t) | |
13707 | (setq e (match-end 0))) | |
13708 | (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) | |
13709 | (kill-buffer buf) | |
20908596 CD |
13710 | (delete-file tmpfile) |
13711 | rtn)) | |
d3f4dbe8 | 13712 | |
20908596 CD |
13713 | (defun org-closest-date (start current change prefer show-all) |
13714 | "Find the date closest to CURRENT that is consistent with START and CHANGE. | |
13715 | When PREFER is `past' return a date that is either CURRENT or past. | |
13716 | When PREFER is `future', return a date that is either CURRENT or future. | |
33306645 | 13717 | When SHOW-ALL is nil, only return the current occurrence of a time stamp." |
20908596 | 13718 | ;; Make the proper lists from the dates |
d3f4dbe8 | 13719 | (catch 'exit |
20908596 | 13720 | (let ((a1 '(("d" . day) ("w" . week) ("m" . month) ("y" . year))) |
0bd48b37 | 13721 | dn dw sday cday n1 n2 n0 |
20908596 | 13722 | d m y y1 y2 date1 date2 nmonths nm ny m2) |
d3f4dbe8 | 13723 | |
20908596 CD |
13724 | (setq start (org-date-to-gregorian start) |
13725 | current (org-date-to-gregorian | |
13726 | (if show-all | |
13727 | current | |
13728 | (time-to-days (current-time)))) | |
13729 | sday (calendar-absolute-from-gregorian start) | |
13730 | cday (calendar-absolute-from-gregorian current)) | |
d3f4dbe8 | 13731 | |
20908596 | 13732 | (if (<= cday sday) (throw 'exit sday)) |
791d856f | 13733 | |
20908596 CD |
13734 | (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) |
13735 | (setq dn (string-to-number (match-string 1 change)) | |
13736 | dw (cdr (assoc (match-string 2 change) a1))) | |
13737 | (error "Invalid change specifyer: %s" change)) | |
13738 | (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) | |
13739 | (cond | |
13740 | ((eq dw 'day) | |
13741 | (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn)))) | |
13742 | n2 (+ n1 dn))) | |
13743 | ((eq dw 'year) | |
13744 | (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current)) | |
13745 | (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1)) | |
13746 | (setq date1 (list m d y1) | |
13747 | n1 (calendar-absolute-from-gregorian date1) | |
13748 | date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) | |
13749 | n2 (calendar-absolute-from-gregorian date2))) | |
13750 | ((eq dw 'month) | |
2c3ad40d | 13751 | ;; approx number of month between the two dates |
20908596 CD |
13752 | (setq nmonths (floor (/ (- cday sday) 30.436875))) |
13753 | ;; How often does dn fit in there? | |
13754 | (setq d (nth 1 start) m (car start) y (nth 2 start) | |
13755 | nm (* dn (max 0 (1- (floor (/ nmonths dn))))) | |
13756 | m (+ m nm) | |
13757 | ny (floor (/ m 12)) | |
13758 | y (+ y ny) | |
13759 | m (- m (* ny 12))) | |
13760 | (while (> m 12) (setq m (- m 12) y (1+ y))) | |
13761 | (setq n1 (calendar-absolute-from-gregorian (list m d y))) | |
13762 | (setq m2 (+ m dn) y2 y) | |
13763 | (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) | |
13764 | (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) | |
2c3ad40d | 13765 | (while (<= n2 cday) |
20908596 CD |
13766 | (setq n1 n2 m m2 y y2) |
13767 | (setq m2 (+ m dn) y2 y) | |
13768 | (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) | |
13769 | (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) | |
0bd48b37 CD |
13770 | ;; Make sure n1 is the earlier date |
13771 | (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2)) | |
20908596 CD |
13772 | (if show-all |
13773 | (cond | |
8d642074 | 13774 | ((eq prefer 'past) (if (= cday n2) n2 n1)) |
20908596 CD |
13775 | ((eq prefer 'future) (if (= cday n1) n1 n2)) |
13776 | (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))) | |
13777 | (cond | |
8d642074 | 13778 | ((eq prefer 'past) (if (= cday n2) n2 n1)) |
20908596 CD |
13779 | ((eq prefer 'future) (if (= cday n1) n1 n2)) |
13780 | (t (if (= cday n1) n1 n2))))))) | |
791d856f | 13781 | |
20908596 CD |
13782 | (defun org-date-to-gregorian (date) |
13783 | "Turn any specification of DATE into a gregorian date for the calendar." | |
13784 | (cond ((integerp date) (calendar-gregorian-from-absolute date)) | |
13785 | ((and (listp date) (= (length date) 3)) date) | |
13786 | ((stringp date) | |
13787 | (setq date (org-parse-time-string date)) | |
13788 | (list (nth 4 date) (nth 3 date) (nth 5 date))) | |
13789 | ((listp date) | |
13790 | (list (nth 4 date) (nth 3 date) (nth 5 date))))) | |
d3f4dbe8 | 13791 | |
20908596 CD |
13792 | (defun org-parse-time-string (s &optional nodefault) |
13793 | "Parse the standard Org-mode time string. | |
13794 | This should be a lot faster than the normal `parse-time-string'. | |
13795 | If time is not given, defaults to 0:00. However, with optional NODEFAULT, | |
13796 | hour and minute fields will be nil if not given." | |
13797 | (if (string-match org-ts-regexp0 s) | |
13798 | (list 0 | |
13799 | (if (or (match-beginning 8) (not nodefault)) | |
13800 | (string-to-number (or (match-string 8 s) "0"))) | |
13801 | (if (or (match-beginning 7) (not nodefault)) | |
13802 | (string-to-number (or (match-string 7 s) "0"))) | |
13803 | (string-to-number (match-string 4 s)) | |
13804 | (string-to-number (match-string 3 s)) | |
13805 | (string-to-number (match-string 2 s)) | |
13806 | nil nil nil) | |
54a0dee5 | 13807 | (error "Not a standard Org-mode time string: %s" s))) |
d3f4dbe8 | 13808 | |
20908596 CD |
13809 | (defun org-timestamp-up (&optional arg) |
13810 | "Increase the date item at the cursor by one. | |
13811 | If the cursor is on the year, change the year. If it is on the month or | |
13812 | the day, change that. | |
13813 | With prefix ARG, change by that many units." | |
13814 | (interactive "p") | |
13815 | (org-timestamp-change (prefix-numeric-value arg))) | |
d3f4dbe8 | 13816 | |
20908596 CD |
13817 | (defun org-timestamp-down (&optional arg) |
13818 | "Decrease the date item at the cursor by one. | |
13819 | If the cursor is on the year, change the year. If it is on the month or | |
13820 | the day, change that. | |
13821 | With prefix ARG, change by that many units." | |
13822 | (interactive "p") | |
13823 | (org-timestamp-change (- (prefix-numeric-value arg)))) | |
d3f4dbe8 | 13824 | |
20908596 CD |
13825 | (defun org-timestamp-up-day (&optional arg) |
13826 | "Increase the date in the time stamp by one day. | |
13827 | With prefix ARG, change that many days." | |
13828 | (interactive "p") | |
13829 | (if (and (not (org-at-timestamp-p t)) | |
13830 | (org-on-heading-p)) | |
13831 | (org-todo 'up) | |
13832 | (org-timestamp-change (prefix-numeric-value arg) 'day))) | |
d3f4dbe8 | 13833 | |
20908596 CD |
13834 | (defun org-timestamp-down-day (&optional arg) |
13835 | "Decrease the date in the time stamp by one day. | |
13836 | With prefix ARG, change that many days." | |
13837 | (interactive "p") | |
13838 | (if (and (not (org-at-timestamp-p t)) | |
13839 | (org-on-heading-p)) | |
13840 | (org-todo 'down) | |
13841 | (org-timestamp-change (- (prefix-numeric-value arg)) 'day))) | |
d3f4dbe8 | 13842 | |
20908596 CD |
13843 | (defun org-at-timestamp-p (&optional inactive-ok) |
13844 | "Determine if the cursor is in or at a timestamp." | |
13845 | (interactive) | |
13846 | (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) | |
13847 | (pos (point)) | |
13848 | (ans (or (looking-at tsr) | |
13849 | (save-excursion | |
13850 | (skip-chars-backward "^[<\n\r\t") | |
13851 | (if (> (point) (point-min)) (backward-char 1)) | |
13852 | (and (looking-at tsr) | |
13853 | (> (- (match-end 0) pos) -1)))))) | |
13854 | (and ans | |
13855 | (boundp 'org-ts-what) | |
13856 | (setq org-ts-what | |
13857 | (cond | |
13858 | ((= pos (match-beginning 0)) 'bracket) | |
13859 | ((= pos (1- (match-end 0))) 'bracket) | |
13860 | ((org-pos-in-match-range pos 2) 'year) | |
13861 | ((org-pos-in-match-range pos 3) 'month) | |
13862 | ((org-pos-in-match-range pos 7) 'hour) | |
13863 | ((org-pos-in-match-range pos 8) 'minute) | |
13864 | ((or (org-pos-in-match-range pos 4) | |
13865 | (org-pos-in-match-range pos 5)) 'day) | |
13866 | ((and (> pos (or (match-end 8) (match-end 5))) | |
13867 | (< pos (match-end 0))) | |
13868 | (- pos (or (match-end 8) (match-end 5)))) | |
13869 | (t 'day)))) | |
13870 | ans)) | |
a3fbe8c4 | 13871 | |
20908596 CD |
13872 | (defun org-toggle-timestamp-type () |
13873 | "Toggle the type (<active> or [inactive]) of a time stamp." | |
13874 | (interactive) | |
13875 | (when (org-at-timestamp-p t) | |
93b62de8 CD |
13876 | (let ((beg (match-beginning 0)) (end (match-end 0)) |
13877 | (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) | |
13878 | (save-excursion | |
13879 | (goto-char beg) | |
13880 | (while (re-search-forward "[][<>]" end t) | |
13881 | (replace-match (cdr (assoc (char-after (match-beginning 0)) map)) | |
13882 | t t))) | |
13883 | (message "Timestamp is now %sactive" | |
13884 | (if (equal (char-after beg) ?<) "" "in"))))) | |
a3fbe8c4 | 13885 | |
20908596 CD |
13886 | (defun org-timestamp-change (n &optional what) |
13887 | "Change the date in the time stamp at point. | |
13888 | The date will be changed by N times WHAT. WHAT can be `day', `month', | |
13889 | `year', `minute', `second'. If WHAT is not given, the cursor position | |
13890 | in the timestamp determines what will be changed." | |
13891 | (let ((pos (point)) | |
13892 | with-hm inactive | |
13893 | (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) | |
13894 | org-ts-what | |
13895 | extra rem | |
13896 | ts time time0) | |
13897 | (if (not (org-at-timestamp-p t)) | |
13898 | (error "Not at a timestamp")) | |
13899 | (if (and (not what) (eq org-ts-what 'bracket)) | |
13900 | (org-toggle-timestamp-type) | |
13901 | (if (and (not what) (not (eq org-ts-what 'day)) | |
13902 | org-display-custom-times | |
13903 | (get-text-property (point) 'display) | |
13904 | (not (get-text-property (1- (point)) 'display))) | |
13905 | (setq org-ts-what 'day)) | |
13906 | (setq org-ts-what (or what org-ts-what) | |
13907 | inactive (= (char-after (match-beginning 0)) ?\[) | |
13908 | ts (match-string 0)) | |
13909 | (replace-match "") | |
13910 | (if (string-match | |
8bfe682a | 13911 | "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)*\\)[]>]" |
20908596 CD |
13912 | ts) |
13913 | (setq extra (match-string 1 ts))) | |
13914 | (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) | |
13915 | (setq with-hm t)) | |
13916 | (setq time0 (org-parse-time-string ts)) | |
13917 | (when (and (eq org-ts-what 'minute) | |
13918 | (eq current-prefix-arg nil)) | |
13919 | (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) | |
13920 | (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) | |
13921 | (setcar (cdr time0) (+ (nth 1 time0) | |
13922 | (if (> n 0) (- rem) (- dm rem)))))) | |
13923 | (setq time | |
13924 | (encode-time (or (car time0) 0) | |
13925 | (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) | |
13926 | (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) | |
13927 | (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) | |
13928 | (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) | |
13929 | (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) | |
13930 | (nthcdr 6 time0))) | |
c8d0cf5c CD |
13931 | (when (and (member org-ts-what '(hour minute)) |
13932 | extra | |
13933 | (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) | |
13934 | (setq extra (org-modify-ts-extra | |
13935 | extra | |
13936 | (if (eq org-ts-what 'hour) 2 5) | |
13937 | n dm))) | |
20908596 CD |
13938 | (when (integerp org-ts-what) |
13939 | (setq extra (org-modify-ts-extra extra org-ts-what n dm))) | |
13940 | (if (eq what 'calendar) | |
13941 | (let ((cal-date (org-get-date-from-calendar))) | |
13942 | (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month | |
13943 | (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day | |
13944 | (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year | |
13945 | (setcar time0 (or (car time0) 0)) | |
13946 | (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) | |
13947 | (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) | |
13948 | (setq time (apply 'encode-time time0)))) | |
13949 | (setq org-last-changed-timestamp | |
13950 | (org-insert-time-stamp time with-hm inactive nil nil extra)) | |
13951 | (org-clock-update-time-maybe) | |
13952 | (goto-char pos) | |
13953 | ;; Try to recenter the calendar window, if any | |
13954 | (if (and org-calendar-follow-timestamp-change | |
13955 | (get-buffer-window "*Calendar*" t) | |
13956 | (memq org-ts-what '(day month year))) | |
13957 | (org-recenter-calendar (time-to-days time)))))) | |
4b3a9ba7 | 13958 | |
20908596 CD |
13959 | (defun org-modify-ts-extra (s pos n dm) |
13960 | "Change the different parts of the lead-time and repeat fields in timestamp." | |
13961 | (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) | |
13962 | ng h m new rem) | |
13963 | (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s) | |
891f4676 | 13964 | (cond |
20908596 CD |
13965 | ((or (org-pos-in-match-range pos 2) |
13966 | (org-pos-in-match-range pos 3)) | |
13967 | (setq m (string-to-number (match-string 3 s)) | |
13968 | h (string-to-number (match-string 2 s))) | |
13969 | (if (org-pos-in-match-range pos 2) | |
13970 | (setq h (+ h n)) | |
13971 | (setq n (* dm (org-no-warnings (signum n)))) | |
13972 | (when (not (= 0 (setq rem (% m dm)))) | |
13973 | (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) | |
13974 | (setq m (+ m n))) | |
13975 | (if (< m 0) (setq m (+ m 60) h (1- h))) | |
13976 | (if (> m 59) (setq m (- m 60) h (1+ h))) | |
13977 | (setq h (min 24 (max 0 h))) | |
13978 | (setq ng 1 new (format "-%02d:%02d" h m))) | |
13979 | ((org-pos-in-match-range pos 6) | |
13980 | (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) | |
13981 | ((org-pos-in-match-range pos 5) | |
13982 | (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s))))))) | |
891f4676 | 13983 | |
20908596 CD |
13984 | ((org-pos-in-match-range pos 9) |
13985 | (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx)))) | |
13986 | ((org-pos-in-match-range pos 8) | |
13987 | (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s)))))))) | |
a3fbe8c4 | 13988 | |
20908596 CD |
13989 | (when ng |
13990 | (setq s (concat | |
13991 | (substring s 0 (match-beginning ng)) | |
13992 | new | |
13993 | (substring s (match-end ng)))))) | |
13994 | s)) | |
6769c0dc | 13995 | |
20908596 CD |
13996 | (defun org-recenter-calendar (date) |
13997 | "If the calendar is visible, recenter it to DATE." | |
13998 | (let* ((win (selected-window)) | |
13999 | (cwin (get-buffer-window "*Calendar*" t)) | |
14000 | (calendar-move-hook nil)) | |
14001 | (when cwin | |
14002 | (select-window cwin) | |
14003 | (calendar-goto-date (if (listp date) date | |
14004 | (calendar-gregorian-from-absolute date))) | |
14005 | (select-window win)))) | |
2a57416f | 14006 | |
20908596 CD |
14007 | (defun org-goto-calendar (&optional arg) |
14008 | "Go to the Emacs calendar at the current date. | |
14009 | If there is a time stamp in the current line, go to that date. | |
14010 | A prefix ARG can be used to force the current date." | |
14011 | (interactive "P") | |
14012 | (let ((tsr org-ts-regexp) diff | |
14013 | (calendar-move-hook nil) | |
14014 | (calendar-view-holidays-initially-flag nil) | |
14015 | (view-calendar-holidays-initially nil) | |
14016 | (calendar-view-diary-initially-flag nil) | |
14017 | (view-diary-entries-initially nil)) | |
14018 | (if (or (org-at-timestamp-p) | |
14019 | (save-excursion | |
14020 | (beginning-of-line 1) | |
14021 | (looking-at (concat ".*" tsr)))) | |
14022 | (let ((d1 (time-to-days (current-time))) | |
14023 | (d2 (time-to-days | |
14024 | (org-time-string-to-time (match-string 1))))) | |
14025 | (setq diff (- d2 d1)))) | |
14026 | (calendar) | |
14027 | (calendar-goto-today) | |
14028 | (if (and diff (not arg)) (calendar-forward-day diff)))) | |
a3fbe8c4 | 14029 | |
20908596 CD |
14030 | (defun org-get-date-from-calendar () |
14031 | "Return a list (month day year) of date at point in calendar." | |
14032 | (with-current-buffer "*Calendar*" | |
14033 | (save-match-data | |
14034 | (calendar-cursor-to-date)))) | |
6769c0dc | 14035 | |
20908596 CD |
14036 | (defun org-date-from-calendar () |
14037 | "Insert time stamp corresponding to cursor date in *Calendar* buffer. | |
14038 | If there is already a time stamp at the cursor position, update it." | |
14039 | (interactive) | |
14040 | (if (org-at-timestamp-p t) | |
14041 | (org-timestamp-change 0 'calendar) | |
14042 | (let ((cal-date (org-get-date-from-calendar))) | |
14043 | (org-insert-time-stamp | |
14044 | (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) | |
d3f4dbe8 | 14045 | |
20908596 CD |
14046 | (defun org-minutes-to-hh:mm-string (m) |
14047 | "Compute H:MM from a number of minutes." | |
14048 | (let ((h (/ m 60))) | |
14049 | (setq m (- m (* 60 h))) | |
b349f79f | 14050 | (format org-time-clocksum-format h m))) |
8c6fb58b | 14051 | |
20908596 | 14052 | (defun org-hh:mm-string-to-minutes (s) |
c8d0cf5c | 14053 | "Convert a string H:MM to a number of minutes. |
8bfe682a | 14054 | If the string is just a number, interpret it as minutes. |
c8d0cf5c CD |
14055 | In fact, the first hh:mm or number in the string will be taken, |
14056 | there can be extra stuff in the string. | |
14057 | If no number is found, the return value is 0." | |
14058 | (cond | |
14059 | ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) | |
14060 | (+ (* (string-to-number (match-string 1 s)) 60) | |
14061 | (string-to-number (match-string 2 s)))) | |
14062 | ((string-match "\\([0-9]+\\)" s) | |
14063 | (string-to-number (match-string 1 s))) | |
14064 | (t 0))) | |
14065 | ||
14066 | ;;;; Files | |
14067 | ||
14068 | (defun org-save-all-org-buffers () | |
14069 | "Save all Org-mode buffers without user confirmation." | |
14070 | (interactive) | |
14071 | (message "Saving all Org-mode buffers...") | |
14072 | (save-some-buffers t 'org-mode-p) | |
14073 | (when (featurep 'org-id) (org-id-locations-save)) | |
14074 | (message "Saving all Org-mode buffers... done")) | |
14075 | ||
14076 | (defun org-revert-all-org-buffers () | |
14077 | "Revert all Org-mode buffers. | |
14078 | Prompt for confirmation when there are unsaved changes. | |
14079 | Be sure you know what you are doing before letting this function | |
14080 | overwrite your changes. | |
14081 | ||
14082 | This function is useful in a setup where one tracks org files | |
14083 | with a version control system, to revert on one machine after pulling | |
14084 | changes from another. I believe the procedure must be like this: | |
14085 | ||
14086 | 1. M-x org-save-all-org-buffers | |
14087 | 2. Pull changes from the other machine, resolve conflicts | |
14088 | 3. M-x org-revert-all-org-buffers" | |
14089 | (interactive) | |
14090 | (unless (yes-or-no-p "Revert all Org buffers from their files? ") | |
14091 | (error "Abort")) | |
14092 | (save-excursion | |
14093 | (save-window-excursion | |
14094 | (mapc | |
14095 | (lambda (b) | |
14096 | (when (and (with-current-buffer b (org-mode-p)) | |
14097 | (with-current-buffer b buffer-file-name)) | |
14098 | (switch-to-buffer b) | |
14099 | (revert-buffer t 'no-confirm))) | |
14100 | (buffer-list)) | |
14101 | (when (and (featurep 'org-id) org-id-track-globally) | |
14102 | (org-id-locations-load))))) | |
6769c0dc | 14103 | |
20908596 CD |
14104 | ;;;; Agenda files |
14105 | ||
14106 | ;;;###autoload | |
14107 | (defun org-iswitchb (&optional arg) | |
54a0dee5 | 14108 | "Use `org-icompleting-read' to prompt for an Org buffer to switch to. |
fdf730ed CD |
14109 | With a prefix argument, restrict available to files. |
14110 | With two prefix arguments, restrict available buffers to agenda files." | |
14111 | (interactive "P") | |
14112 | (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) | |
14113 | ((equal arg '(16)) (org-buffer-list 'agenda)) | |
14114 | (t (org-buffer-list))))) | |
14115 | (switch-to-buffer | |
54a0dee5 | 14116 | (org-icompleting-read "Org buffer: " |
c8d0cf5c | 14117 | (mapcar 'list (mapcar 'buffer-name blist)) |
fdf730ed CD |
14118 | nil t)))) |
14119 | ||
54a0dee5 CD |
14120 | ;;;###autoload |
14121 | (defalias 'org-ido-switchb 'org-iswitchb) | |
14122 | ||
621f83e4 | 14123 | (defun org-buffer-list (&optional predicate exclude-tmp) |
20908596 | 14124 | "Return a list of Org buffers. |
621f83e4 CD |
14125 | PREDICATE can be `export', `files' or `agenda'. |
14126 | ||
14127 | export restrict the list to Export buffers. | |
14128 | files restrict the list to buffers visiting Org files. | |
14129 | agenda restrict the list to buffers visiting agenda files. | |
14130 | ||
14131 | If EXCLUDE-TMP is non-nil, ignore temporary buffers." | |
14132 | (let* ((bfn nil) | |
14133 | (agenda-files (and (eq predicate 'agenda) | |
14134 | (mapcar 'file-truename (org-agenda-files t)))) | |
14135 | (filter | |
14136 | (cond | |
14137 | ((eq predicate 'files) | |
14138 | (lambda (b) (with-current-buffer b (eq major-mode 'org-mode)))) | |
14139 | ((eq predicate 'export) | |
14140 | (lambda (b) (string-match "\*Org .*Export" (buffer-name b)))) | |
14141 | ((eq predicate 'agenda) | |
14142 | (lambda (b) | |
ce4fdcb9 | 14143 | (with-current-buffer b |
621f83e4 CD |
14144 | (and (eq major-mode 'org-mode) |
14145 | (setq bfn (buffer-file-name b)) | |
14146 | (member (file-truename bfn) agenda-files))))) | |
ce4fdcb9 | 14147 | (t (lambda (b) (with-current-buffer b |
621f83e4 CD |
14148 | (or (eq major-mode 'org-mode) |
14149 | (string-match "\*Org .*Export" | |
14150 | (buffer-name b))))))))) | |
14151 | (delq nil | |
20908596 CD |
14152 | (mapcar |
14153 | (lambda(b) | |
621f83e4 CD |
14154 | (if (and (funcall filter b) |
14155 | (or (not exclude-tmp) | |
14156 | (not (string-match "tmp" (buffer-name b))))) | |
14157 | b | |
14158 | nil)) | |
14159 | (buffer-list))))) | |
20908596 | 14160 | |
2c3ad40d | 14161 | (defun org-agenda-files (&optional unrestricted archives) |
20908596 CD |
14162 | "Get the list of agenda files. |
14163 | Optional UNRESTRICTED means return the full list even if a restriction | |
14164 | is currently in place. | |
2c3ad40d CD |
14165 | When ARCHIVES is t, include all archive files hat are really being |
14166 | used by the agenda files. If ARCHIVE is `ifmode', do this only if | |
14167 | `org-agenda-archives-mode' is t." | |
20908596 CD |
14168 | (let ((files |
14169 | (cond | |
14170 | ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) | |
14171 | ((stringp org-agenda-files) (org-read-agenda-file-list)) | |
14172 | ((listp org-agenda-files) org-agenda-files) | |
14173 | (t (error "Invalid value of `org-agenda-files'"))))) | |
14174 | (setq files (apply 'append | |
14175 | (mapcar (lambda (f) | |
14176 | (if (file-directory-p f) | |
14177 | (directory-files | |
14178 | f t org-agenda-file-regexp) | |
14179 | (list f))) | |
14180 | files))) | |
14181 | (when org-agenda-skip-unavailable-files | |
14182 | (setq files (delq nil | |
14183 | (mapcar (function | |
14184 | (lambda (file) | |
14185 | (and (file-readable-p file) file))) | |
14186 | files)))) | |
2c3ad40d CD |
14187 | (when (or (eq archives t) |
14188 | (and (eq archives 'ifmode) (eq org-agenda-archives-mode t))) | |
14189 | (setq files (org-add-archive-files files))) | |
20908596 CD |
14190 | files)) |
14191 | ||
14192 | (defun org-edit-agenda-file-list () | |
14193 | "Edit the list of agenda files. | |
14194 | Depending on setup, this either uses customize to edit the variable | |
14195 | `org-agenda-files', or it visits the file that is holding the list. In the | |
14196 | latter case, the buffer is set up in a way that saving it automatically kills | |
14197 | the buffer and restores the previous window configuration." | |
14198 | (interactive) | |
14199 | (if (stringp org-agenda-files) | |
14200 | (let ((cw (current-window-configuration))) | |
14201 | (find-file org-agenda-files) | |
14202 | (org-set-local 'org-window-configuration cw) | |
14203 | (org-add-hook 'after-save-hook | |
14204 | (lambda () | |
14205 | (set-window-configuration | |
14206 | (prog1 org-window-configuration | |
14207 | (kill-buffer (current-buffer)))) | |
14208 | (org-install-agenda-files-menu) | |
14209 | (message "New agenda file list installed")) | |
14210 | nil 'local) | |
14211 | (message "%s" (substitute-command-keys | |
14212 | "Edit list and finish with \\[save-buffer]"))) | |
14213 | (customize-variable 'org-agenda-files))) | |
6769c0dc | 14214 | |
20908596 | 14215 | (defun org-store-new-agenda-file-list (list) |
33306645 | 14216 | "Set new value for the agenda file list and save it correctly." |
20908596 CD |
14217 | (if (stringp org-agenda-files) |
14218 | (let ((f org-agenda-files) b) | |
14219 | (while (setq b (find-buffer-visiting f)) (kill-buffer b)) | |
14220 | (with-temp-file f | |
14221 | (insert (mapconcat 'identity list "\n") "\n"))) | |
54a0dee5 CD |
14222 | (let ((org-mode-hook nil) (org-inhibit-startup t) |
14223 | (org-insert-mode-line-in-empty-file nil)) | |
20908596 CD |
14224 | (setq org-agenda-files list) |
14225 | (customize-save-variable 'org-agenda-files org-agenda-files)))) | |
6769c0dc | 14226 | |
20908596 CD |
14227 | (defun org-read-agenda-file-list () |
14228 | "Read the list of agenda files from a file." | |
14229 | (when (file-directory-p org-agenda-files) | |
14230 | (error "`org-agenda-files' cannot be a single directory")) | |
14231 | (when (stringp org-agenda-files) | |
14232 | (with-temp-buffer | |
14233 | (insert-file-contents org-agenda-files) | |
14234 | (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))) | |
6769c0dc | 14235 | |
272dfec2 | 14236 | |
20908596 CD |
14237 | ;;;###autoload |
14238 | (defun org-cycle-agenda-files () | |
14239 | "Cycle through the files in `org-agenda-files'. | |
14240 | If the current buffer visits an agenda file, find the next one in the list. | |
14241 | If the current buffer does not, find the first agenda file." | |
14242 | (interactive) | |
14243 | (let* ((fs (org-agenda-files t)) | |
14244 | (files (append fs (list (car fs)))) | |
14245 | (tcf (if buffer-file-name (file-truename buffer-file-name))) | |
14246 | file) | |
14247 | (unless files (error "No agenda files")) | |
0b8568f5 | 14248 | (catch 'exit |
20908596 CD |
14249 | (while (setq file (pop files)) |
14250 | (if (equal (file-truename file) tcf) | |
14251 | (when (car files) | |
14252 | (find-file (car files)) | |
14253 | (throw 'exit t)))) | |
14254 | (find-file (car fs))) | |
14255 | (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer))))) | |
634a7d0b | 14256 | |
20908596 CD |
14257 | (defun org-agenda-file-to-front (&optional to-end) |
14258 | "Move/add the current file to the top of the agenda file list. | |
14259 | If the file is not present in the list, it is added to the front. If it is | |
14260 | present, it is moved there. With optional argument TO-END, add/move to the | |
14261 | end of the list." | |
891f4676 | 14262 | (interactive "P") |
20908596 CD |
14263 | (let ((org-agenda-skip-unavailable-files nil) |
14264 | (file-alist (mapcar (lambda (x) | |
14265 | (cons (file-truename x) x)) | |
14266 | (org-agenda-files t))) | |
14267 | (ctf (file-truename buffer-file-name)) | |
14268 | x had) | |
14269 | (setq x (assoc ctf file-alist) had x) | |
0b8568f5 | 14270 | |
20908596 CD |
14271 | (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) |
14272 | (if to-end | |
14273 | (setq file-alist (append (delq x file-alist) (list x))) | |
14274 | (setq file-alist (cons x (delq x file-alist)))) | |
14275 | (org-store-new-agenda-file-list (mapcar 'cdr file-alist)) | |
14276 | (org-install-agenda-files-menu) | |
14277 | (message "File %s to %s of agenda file list" | |
14278 | (if had "moved" "added") (if to-end "end" "front")))) | |
0b8568f5 | 14279 | |
20908596 CD |
14280 | (defun org-remove-file (&optional file) |
14281 | "Remove current file from the list of files in variable `org-agenda-files'. | |
14282 | These are the files which are being checked for agenda entries. | |
14283 | Optional argument FILE means, use this file instead of the current." | |
14284 | (interactive) | |
14285 | (let* ((org-agenda-skip-unavailable-files nil) | |
14286 | (file (or file buffer-file-name)) | |
14287 | (true-file (file-truename file)) | |
14288 | (afile (abbreviate-file-name file)) | |
14289 | (files (delq nil (mapcar | |
14290 | (lambda (x) | |
14291 | (if (equal true-file | |
14292 | (file-truename x)) | |
14293 | nil x)) | |
14294 | (org-agenda-files t))))) | |
14295 | (if (not (= (length files) (length (org-agenda-files t)))) | |
14296 | (progn | |
14297 | (org-store-new-agenda-file-list files) | |
14298 | (org-install-agenda-files-menu) | |
14299 | (message "Removed file: %s" afile)) | |
14300 | (message "File was not in list: %s (not removed)" afile)))) | |
891f4676 | 14301 | |
20908596 CD |
14302 | (defun org-file-menu-entry (file) |
14303 | (vector file (list 'find-file file) t)) | |
891f4676 | 14304 | |
20908596 CD |
14305 | (defun org-check-agenda-file (file) |
14306 | "Make sure FILE exists. If not, ask user what to do." | |
14307 | (when (not (file-exists-p file)) | |
8d642074 | 14308 | (message "non-existent agenda file %s. [R]emove from list or [A]bort?" |
20908596 CD |
14309 | (abbreviate-file-name file)) |
14310 | (let ((r (downcase (read-char-exclusive)))) | |
891f4676 | 14311 | (cond |
20908596 CD |
14312 | ((equal r ?r) |
14313 | (org-remove-file file) | |
14314 | (throw 'nextfile t)) | |
14315 | (t (error "Abort")))))) | |
a3fbe8c4 | 14316 | |
20908596 CD |
14317 | (defun org-get-agenda-file-buffer (file) |
14318 | "Get a buffer visiting FILE. If the buffer needs to be created, add | |
14319 | it to the list of buffers which might be released later." | |
14320 | (let ((buf (org-find-base-buffer-visiting file))) | |
14321 | (if buf | |
14322 | buf ; just return it | |
14323 | ;; Make a new buffer and remember it | |
14324 | (setq buf (find-file-noselect file)) | |
14325 | (if buf (push buf org-agenda-new-buffers)) | |
14326 | buf))) | |
a3fbe8c4 | 14327 | |
20908596 CD |
14328 | (defun org-release-buffers (blist) |
14329 | "Release all buffers in list, asking the user for confirmation when needed. | |
14330 | When a buffer is unmodified, it is just killed. When modified, it is saved | |
14331 | \(if the user agrees) and then killed." | |
14332 | (let (buf file) | |
14333 | (while (setq buf (pop blist)) | |
14334 | (setq file (buffer-file-name buf)) | |
14335 | (when (and (buffer-modified-p buf) | |
14336 | file | |
14337 | (y-or-n-p (format "Save file %s? " file))) | |
14338 | (with-current-buffer buf (save-buffer))) | |
14339 | (kill-buffer buf)))) | |
03f3cf35 | 14340 | |
20908596 CD |
14341 | (defun org-prepare-agenda-buffers (files) |
14342 | "Create buffers for all agenda files, protect archived trees and comments." | |
14343 | (interactive) | |
14344 | (let ((pa '(:org-archived t)) | |
14345 | (pc '(:org-comment t)) | |
14346 | (pall '(:org-archived t :org-comment t)) | |
14347 | (inhibit-read-only t) | |
14348 | (rea (concat ":" org-archive-tag ":")) | |
14349 | bmp file re) | |
ef943dba | 14350 | (save-excursion |
20908596 CD |
14351 | (save-restriction |
14352 | (while (setq file (pop files)) | |
c8d0cf5c CD |
14353 | (catch 'nextfile |
14354 | (if (bufferp file) | |
14355 | (set-buffer file) | |
14356 | (org-check-agenda-file file) | |
14357 | (set-buffer (org-get-agenda-file-buffer file))) | |
14358 | (widen) | |
14359 | (setq bmp (buffer-modified-p)) | |
14360 | (org-refresh-category-properties) | |
14361 | (setq org-todo-keywords-for-agenda | |
14362 | (append org-todo-keywords-for-agenda org-todo-keywords-1)) | |
14363 | (setq org-done-keywords-for-agenda | |
14364 | (append org-done-keywords-for-agenda org-done-keywords)) | |
14365 | (setq org-todo-keyword-alist-for-agenda | |
14366 | (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) | |
8d642074 CD |
14367 | (setq org-drawers-for-agenda |
14368 | (append org-drawers-for-agenda org-drawers)) | |
c8d0cf5c CD |
14369 | (setq org-tag-alist-for-agenda |
14370 | (append org-tag-alist-for-agenda org-tag-alist)) | |
621f83e4 | 14371 | |
c8d0cf5c CD |
14372 | (save-excursion |
14373 | (remove-text-properties (point-min) (point-max) pall) | |
14374 | (when org-agenda-skip-archived-trees | |
14375 | (goto-char (point-min)) | |
14376 | (while (re-search-forward rea nil t) | |
14377 | (if (org-on-heading-p t) | |
14378 | (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) | |
20908596 | 14379 | (goto-char (point-min)) |
c8d0cf5c CD |
14380 | (setq re (concat "^\\*+ +" org-comment-string "\\>")) |
14381 | (while (re-search-forward re nil t) | |
14382 | (add-text-properties | |
14383 | (match-beginning 0) (org-end-of-subtree t) pc))) | |
14384 | (set-buffer-modified-p bmp))))) | |
621f83e4 CD |
14385 | (setq org-todo-keyword-alist-for-agenda |
14386 | (org-uniquify org-todo-keyword-alist-for-agenda) | |
14387 | org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda)))) | |
7d143c25 | 14388 | |
20908596 | 14389 | ;;;; Embedded LaTeX |
891f4676 | 14390 | |
20908596 CD |
14391 | (defvar org-cdlatex-mode-map (make-sparse-keymap) |
14392 | "Keymap for the minor `org-cdlatex-mode'.") | |
14393 | ||
14394 | (org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) | |
14395 | (org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) | |
14396 | (org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol) | |
14397 | (org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) | |
14398 | (org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) | |
14399 | ||
14400 | (defvar org-cdlatex-texmathp-advice-is-done nil | |
14401 | "Flag remembering if we have applied the advice to texmathp already.") | |
14402 | ||
14403 | (define-minor-mode org-cdlatex-mode | |
14404 | "Toggle the minor `org-cdlatex-mode'. | |
14405 | This mode supports entering LaTeX environment and math in LaTeX fragments | |
14406 | in Org-mode. | |
14407 | \\{org-cdlatex-mode-map}" | |
14408 | nil " OCDL" nil | |
14409 | (when org-cdlatex-mode (require 'cdlatex)) | |
14410 | (unless org-cdlatex-texmathp-advice-is-done | |
14411 | (setq org-cdlatex-texmathp-advice-is-done t) | |
14412 | (defadvice texmathp (around org-math-always-on activate) | |
14413 | "Always return t in org-mode buffers. | |
14414 | This is because we want to insert math symbols without dollars even outside | |
14415 | the LaTeX math segments. If Orgmode thinks that point is actually inside | |
33306645 | 14416 | an embedded LaTeX fragment, let texmathp do its job. |
20908596 CD |
14417 | \\[org-cdlatex-mode-map]" |
14418 | (interactive) | |
14419 | (let (p) | |
14420 | (cond | |
14421 | ((not (org-mode-p)) ad-do-it) | |
14422 | ((eq this-command 'cdlatex-math-symbol) | |
14423 | (setq ad-return-value t | |
14424 | texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) | |
14425 | (t | |
14426 | (let ((p (org-inside-LaTeX-fragment-p))) | |
14427 | (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) | |
14428 | (setq ad-return-value t | |
14429 | texmathp-why '("Org-mode embedded math" . 0)) | |
14430 | (if p ad-do-it))))))))) | |
891f4676 | 14431 | |
20908596 CD |
14432 | (defun turn-on-org-cdlatex () |
14433 | "Unconditionally turn on `org-cdlatex-mode'." | |
14434 | (org-cdlatex-mode 1)) | |
a3fbe8c4 | 14435 | |
20908596 CD |
14436 | (defun org-inside-LaTeX-fragment-p () |
14437 | "Test if point is inside a LaTeX fragment. | |
14438 | I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing | |
14439 | sequence appearing also before point. | |
14440 | Even though the matchers for math are configurable, this function assumes | |
14441 | that \\begin, \\(, \\[, and $$ are always used. Only the single dollar | |
14442 | delimiters are skipped when they have been removed by customization. | |
14443 | The return value is nil, or a cons cell with the delimiter and | |
14444 | and the position of this delimiter. | |
14445 | ||
14446 | This function does a reasonably good job, but can locally be fooled by | |
14447 | for example currency specifications. For example it will assume being in | |
14448 | inline math after \"$22.34\". The LaTeX fragment formatter will only format | |
14449 | fragments that are properly closed, but during editing, we have to live | |
14450 | with the uncertainty caused by missing closing delimiters. This function | |
14451 | looks only before point, not after." | |
14452 | (catch 'exit | |
14453 | (let ((pos (point)) | |
14454 | (dodollar (member "$" (plist-get org-format-latex-options :matchers))) | |
14455 | (lim (progn | |
14456 | (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) | |
14457 | (point))) | |
14458 | dd-on str (start 0) m re) | |
14459 | (goto-char pos) | |
14460 | (when dodollar | |
14461 | (setq str (concat (buffer-substring lim (point)) "\000 X$.") | |
14462 | re (nth 1 (assoc "$" org-latex-regexps))) | |
14463 | (while (string-match re str start) | |
14464 | (cond | |
14465 | ((= (match-end 0) (length str)) | |
14466 | (throw 'exit (cons "$" (+ lim (match-beginning 0) 1)))) | |
14467 | ((= (match-end 0) (- (length str) 5)) | |
14468 | (throw 'exit nil)) | |
14469 | (t (setq start (match-end 0)))))) | |
14470 | (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t)) | |
14471 | (goto-char pos) | |
14472 | (and (match-beginning 1) (throw 'exit (cons (match-string 1) m))) | |
14473 | (and (match-beginning 2) (throw 'exit nil)) | |
14474 | ;; count $$ | |
14475 | (while (re-search-backward "\\$\\$" lim t) | |
14476 | (setq dd-on (not dd-on))) | |
14477 | (goto-char pos) | |
14478 | (if dd-on (cons "$$" m)))))) | |
a3fbe8c4 | 14479 | |
891f4676 | 14480 | |
20908596 CD |
14481 | (defun org-try-cdlatex-tab () |
14482 | "Check if it makes sense to execute `cdlatex-tab', and do it if yes. | |
14483 | It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is | |
14484 | - inside a LaTeX fragment, or | |
14485 | - after the first word in a line, where an abbreviation expansion could | |
14486 | insert a LaTeX environment." | |
14487 | (when org-cdlatex-mode | |
0b8568f5 | 14488 | (cond |
20908596 CD |
14489 | ((save-excursion |
14490 | (skip-chars-backward "a-zA-Z0-9*") | |
14491 | (skip-chars-backward " \t") | |
14492 | (bolp)) | |
14493 | (cdlatex-tab) t) | |
14494 | ((org-inside-LaTeX-fragment-p) | |
14495 | (cdlatex-tab) t) | |
14496 | (t nil)))) | |
c8d16429 | 14497 | |
20908596 CD |
14498 | (defun org-cdlatex-underscore-caret (&optional arg) |
14499 | "Execute `cdlatex-sub-superscript' in LaTeX fragments. | |
14500 | Revert to the normal definition outside of these fragments." | |
14501 | (interactive "P") | |
14502 | (if (org-inside-LaTeX-fragment-p) | |
14503 | (call-interactively 'cdlatex-sub-superscript) | |
14504 | (let (org-cdlatex-mode) | |
14505 | (call-interactively (key-binding (vector last-input-event)))))) | |
e0e66b8e | 14506 | |
20908596 CD |
14507 | (defun org-cdlatex-math-modify (&optional arg) |
14508 | "Execute `cdlatex-math-modify' in LaTeX fragments. | |
14509 | Revert to the normal definition outside of these fragments." | |
14510 | (interactive "P") | |
14511 | (if (org-inside-LaTeX-fragment-p) | |
14512 | (call-interactively 'cdlatex-math-modify) | |
14513 | (let (org-cdlatex-mode) | |
14514 | (call-interactively (key-binding (vector last-input-event)))))) | |
4b3a9ba7 | 14515 | |
20908596 CD |
14516 | (defvar org-latex-fragment-image-overlays nil |
14517 | "List of overlays carrying the images of latex fragments.") | |
14518 | (make-variable-buffer-local 'org-latex-fragment-image-overlays) | |
891f4676 | 14519 | |
20908596 CD |
14520 | (defun org-remove-latex-fragment-image-overlays () |
14521 | "Remove all overlays with LaTeX fragment images in current buffer." | |
14522 | (mapc 'org-delete-overlay org-latex-fragment-image-overlays) | |
14523 | (setq org-latex-fragment-image-overlays nil)) | |
a3fbe8c4 | 14524 | |
20908596 CD |
14525 | (defun org-preview-latex-fragment (&optional subtree) |
14526 | "Preview the LaTeX fragment at point, or all locally or globally. | |
14527 | If the cursor is in a LaTeX fragment, create the image and overlay | |
14528 | it over the source code. If there is no fragment at point, display | |
14529 | all fragments in the current text, from one headline to the next. With | |
14530 | prefix SUBTREE, display all fragments in the current subtree. With a | |
14531 | double prefix `C-u C-u', or when the cursor is before the first headline, | |
14532 | display all fragments in the buffer. | |
14533 | The images can be removed again with \\[org-ctrl-c-ctrl-c]." | |
14534 | (interactive "P") | |
14535 | (org-remove-latex-fragment-image-overlays) | |
14536 | (save-excursion | |
14537 | (save-restriction | |
14538 | (let (beg end at msg) | |
14539 | (cond | |
14540 | ((or (equal subtree '(16)) | |
14541 | (not (save-excursion | |
14542 | (re-search-backward (concat "^" outline-regexp) nil t)))) | |
14543 | (setq beg (point-min) end (point-max) | |
14544 | msg "Creating images for buffer...%s")) | |
14545 | ((equal subtree '(4)) | |
14546 | (org-back-to-heading) | |
14547 | (setq beg (point) end (org-end-of-subtree t) | |
14548 | msg "Creating images for subtree...%s")) | |
14549 | (t | |
14550 | (if (setq at (org-inside-LaTeX-fragment-p)) | |
14551 | (goto-char (max (point-min) (- (cdr at) 2))) | |
14552 | (org-back-to-heading)) | |
14553 | (setq beg (point) end (progn (outline-next-heading) (point)) | |
14554 | msg (if at "Creating image...%s" | |
14555 | "Creating images for entry...%s")))) | |
14556 | (message msg "") | |
14557 | (narrow-to-region beg end) | |
14558 | (goto-char beg) | |
14559 | (org-format-latex | |
14560 | (concat "ltxpng/" (file-name-sans-extension | |
14561 | (file-name-nondirectory | |
14562 | buffer-file-name))) | |
14563 | default-directory 'overlays msg at 'forbuffer) | |
14564 | (message msg "done. Use `C-c C-c' to remove images."))))) | |
891f4676 | 14565 | |
20908596 CD |
14566 | (defvar org-latex-regexps |
14567 | '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) | |
14568 | ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) | |
14569 | ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p | |
0bd48b37 CD |
14570 | ("$1" "\\([^$]\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) |
14571 | ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) | |
20908596 | 14572 | ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) |
54a0dee5 CD |
14573 | ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) |
14574 | ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) | |
20908596 | 14575 | "Regular expressions for matching embedded LaTeX.") |
891f4676 | 14576 | |
20908596 | 14577 | (defun org-format-latex (prefix &optional dir overlays msg at forbuffer) |
8d642074 CD |
14578 | "Replace LaTeX fragments with links to an image, and produce images. |
14579 | Some of the options can be changed using the variable | |
14580 | `org-format-latex-options'." | |
20908596 CD |
14581 | (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) |
14582 | (let* ((prefixnodir (file-name-nondirectory prefix)) | |
14583 | (absprefix (expand-file-name prefix dir)) | |
14584 | (todir (file-name-directory absprefix)) | |
14585 | (opt org-format-latex-options) | |
14586 | (matchers (plist-get opt :matchers)) | |
14587 | (re-list org-latex-regexps) | |
5dec9555 | 14588 | (cnt 0) txt hash link beg end re e checkdir |
c8d0cf5c | 14589 | executables-checked |
20908596 | 14590 | m n block linkfile movefile ov) |
20908596 CD |
14591 | ;; Check the different regular expressions |
14592 | (while (setq e (pop re-list)) | |
14593 | (setq m (car e) re (nth 1 e) n (nth 2 e) | |
14594 | block (if (nth 3 e) "\n\n" "")) | |
14595 | (when (member m matchers) | |
14596 | (goto-char (point-min)) | |
14597 | (while (re-search-forward re nil t) | |
0b91aef0 CD |
14598 | (when (and (or (not at) (equal (cdr at) (match-beginning n))) |
14599 | (not (get-text-property (match-beginning n) | |
54a0dee5 CD |
14600 | 'org-protected)) |
14601 | (or (not overlays) | |
14602 | (not (eq (get-char-property (match-beginning n) | |
14603 | 'org-overlay-type) | |
14604 | 'org-latex-overlay)))) | |
20908596 CD |
14605 | (setq txt (match-string n) |
14606 | beg (match-beginning n) end (match-end n) | |
14607 | cnt (1+ cnt) | |
20908596 | 14608 | link (concat block "[[file:" linkfile "]]" block)) |
5dec9555 CD |
14609 | (let (print-length print-level) ; make sure full list is printed |
14610 | (setq hash (sha1 (prin1-to-string | |
14611 | (list org-format-latex-header | |
14612 | org-export-latex-packages-alist | |
14613 | org-format-latex-options | |
14614 | forbuffer txt))) | |
14615 | linkfile (format "%s_%s.png" prefix hash) | |
14616 | movefile (format "%s_%s.png" absprefix hash))) | |
20908596 CD |
14617 | (if msg (message msg cnt)) |
14618 | (goto-char beg) | |
14619 | (unless checkdir ; make sure the directory exists | |
14620 | (setq checkdir t) | |
14621 | (or (file-directory-p todir) (make-directory todir))) | |
c8d0cf5c CD |
14622 | |
14623 | (unless executables-checked | |
14624 | (org-check-external-command | |
14625 | "latex" "needed to convert LaTeX fragments to images") | |
14626 | (org-check-external-command | |
14627 | "dvipng" "needed to convert LaTeX fragments to images") | |
14628 | (setq executables-checked t)) | |
14629 | ||
5dec9555 CD |
14630 | (unless (file-exists-p movefile) |
14631 | (org-create-formula-image | |
14632 | txt movefile opt forbuffer)) | |
20908596 | 14633 | (if overlays |
d3f4dbe8 | 14634 | (progn |
54a0dee5 CD |
14635 | (mapc (lambda (o) |
14636 | (if (eq (org-overlay-get o 'org-overlay-type) | |
14637 | 'org-latex-overlay) | |
14638 | (org-delete-overlay o))) | |
14639 | (org-overlays-in beg end)) | |
20908596 | 14640 | (setq ov (org-make-overlay beg end)) |
54a0dee5 | 14641 | (org-overlay-put ov 'org-overlay-type 'org-latex-overlay) |
20908596 CD |
14642 | (if (featurep 'xemacs) |
14643 | (progn | |
14644 | (org-overlay-put ov 'invisible t) | |
14645 | (org-overlay-put | |
14646 | ov 'end-glyph | |
14647 | (make-glyph (vector 'png :file movefile)))) | |
14648 | (org-overlay-put | |
14649 | ov 'display | |
14650 | (list 'image :type 'png :file movefile :ascent 'center))) | |
14651 | (push ov org-latex-fragment-image-overlays) | |
14652 | (goto-char end)) | |
14653 | (delete-region beg end) | |
14654 | (insert link)))))))) | |
46177585 | 14655 | |
20908596 CD |
14656 | ;; This function borrows from Ganesh Swami's latex2png.el |
14657 | (defun org-create-formula-image (string tofile options buffer) | |
8d642074 | 14658 | "This calls dvipng." |
54a0dee5 | 14659 | (require 'org-latex) |
20908596 CD |
14660 | (let* ((tmpdir (if (featurep 'xemacs) |
14661 | (temp-directory) | |
14662 | temporary-file-directory)) | |
14663 | (texfilebase (make-temp-name | |
14664 | (expand-file-name "orgtex" tmpdir))) | |
14665 | (texfile (concat texfilebase ".tex")) | |
14666 | (dvifile (concat texfilebase ".dvi")) | |
14667 | (pngfile (concat texfilebase ".png")) | |
14668 | (fnh (if (featurep 'xemacs) | |
14669 | (font-height (get-face-font 'default)) | |
14670 | (face-attribute 'default :height nil))) | |
14671 | (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) | |
14672 | (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) | |
14673 | (fg (or (plist-get options (if buffer :foreground :html-foreground)) | |
14674 | "Black")) | |
14675 | (bg (or (plist-get options (if buffer :background :html-background)) | |
14676 | "Transparent"))) | |
14677 | (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))) | |
14678 | (if (eq bg 'default) (setq bg (org-dvipng-color :background))) | |
14679 | (with-temp-file texfile | |
14680 | (insert org-format-latex-header | |
54a0dee5 CD |
14681 | (if org-export-latex-packages-alist |
14682 | (concat "\n" | |
14683 | (mapconcat (lambda(p) | |
14684 | (if (equal "" (car p)) | |
14685 | (format "\\usepackage{%s}" (cadr p)) | |
14686 | (format "\\usepackage[%s]{%s}" | |
14687 | (car p) (cadr p)))) | |
14688 | org-export-latex-packages-alist "\n")) | |
14689 | "") | |
20908596 CD |
14690 | "\n\\begin{document}\n" string "\n\\end{document}\n")) |
14691 | (let ((dir default-directory)) | |
14692 | (condition-case nil | |
14693 | (progn | |
14694 | (cd tmpdir) | |
14695 | (call-process "latex" nil nil nil texfile)) | |
14696 | (error nil)) | |
14697 | (cd dir)) | |
14698 | (if (not (file-exists-p dvifile)) | |
14699 | (progn (message "Failed to create dvi file from %s" texfile) nil) | |
2c3ad40d CD |
14700 | (condition-case nil |
14701 | (call-process "dvipng" nil nil nil | |
c8d0cf5c | 14702 | "-fg" fg "-bg" bg |
2c3ad40d CD |
14703 | "-D" dpi |
14704 | ;;"-x" scale "-y" scale | |
14705 | "-T" "tight" | |
14706 | "-o" pngfile | |
14707 | dvifile) | |
14708 | (error nil)) | |
20908596 CD |
14709 | (if (not (file-exists-p pngfile)) |
14710 | (progn (message "Failed to create png file from %s" texfile) nil) | |
14711 | ;; Use the requested file name and clean up | |
14712 | (copy-file pngfile tofile 'replace) | |
14713 | (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do | |
14714 | (delete-file (concat texfilebase e))) | |
14715 | pngfile)))) | |
8c6fb58b | 14716 | |
20908596 CD |
14717 | (defun org-dvipng-color (attr) |
14718 | "Return an rgb color specification for dvipng." | |
14719 | (apply 'format "rgb %s %s %s" | |
14720 | (mapcar 'org-normalize-color | |
14721 | (color-values (face-attribute 'default attr nil))))) | |
c44f0d75 | 14722 | |
20908596 CD |
14723 | (defun org-normalize-color (value) |
14724 | "Return string to be used as color value for an RGB component." | |
14725 | (format "%g" (/ value 65535.0))) | |
6769c0dc | 14726 | |
d3f4dbe8 | 14727 | ;;;; Key bindings |
891f4676 | 14728 | |
1d676e9f | 14729 | ;; Make `C-c C-x' a prefix key |
a3fbe8c4 | 14730 | (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) |
1d676e9f | 14731 | |
28e5b051 | 14732 | ;; TAB key with modifiers |
a3fbe8c4 CD |
14733 | (org-defkey org-mode-map "\C-i" 'org-cycle) |
14734 | (org-defkey org-mode-map [(tab)] 'org-cycle) | |
14735 | (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) | |
14736 | (org-defkey org-mode-map [(meta tab)] 'org-complete) | |
14737 | (org-defkey org-mode-map "\M-\t" 'org-complete) | |
14738 | (org-defkey org-mode-map "\M-\C-i" 'org-complete) | |
28e5b051 | 14739 | ;; The following line is necessary under Suse GNU/Linux |
ab27a4a0 | 14740 | (unless (featurep 'xemacs) |
a3fbe8c4 CD |
14741 | (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) |
14742 | (org-defkey org-mode-map [(shift tab)] 'org-shifttab) | |
03f3cf35 | 14743 | (define-key org-mode-map [backtab] 'org-shifttab) |
28e5b051 | 14744 | |
a3fbe8c4 CD |
14745 | (org-defkey org-mode-map [(shift return)] 'org-table-copy-down) |
14746 | (org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) | |
14747 | (org-defkey org-mode-map [(meta return)] 'org-meta-return) | |
28e5b051 CD |
14748 | |
14749 | ;; Cursor keys with modifiers | |
a3fbe8c4 CD |
14750 | (org-defkey org-mode-map [(meta left)] 'org-metaleft) |
14751 | (org-defkey org-mode-map [(meta right)] 'org-metaright) | |
14752 | (org-defkey org-mode-map [(meta up)] 'org-metaup) | |
14753 | (org-defkey org-mode-map [(meta down)] 'org-metadown) | |
14754 | ||
14755 | (org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) | |
14756 | (org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) | |
14757 | (org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) | |
14758 | (org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown) | |
3278a016 | 14759 | |
a3fbe8c4 CD |
14760 | (org-defkey org-mode-map [(shift up)] 'org-shiftup) |
14761 | (org-defkey org-mode-map [(shift down)] 'org-shiftdown) | |
14762 | (org-defkey org-mode-map [(shift left)] 'org-shiftleft) | |
14763 | (org-defkey org-mode-map [(shift right)] 'org-shiftright) | |
3278a016 | 14764 | |
a3fbe8c4 CD |
14765 | (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) |
14766 | (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) | |
28e5b051 | 14767 | |
d3f4dbe8 CD |
14768 | ;;; Extra keys for tty access. |
14769 | ;; We only set them when really needed because otherwise the | |
14770 | ;; menus don't show the simple keys | |
3278a016 | 14771 | |
621f83e4 CD |
14772 | (when (or org-use-extra-keys |
14773 | (featurep 'xemacs) ;; because XEmacs supports multi-device stuff | |
3278a016 | 14774 | (not window-system)) |
a3fbe8c4 CD |
14775 | (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) |
14776 | (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) | |
14777 | (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) | |
14778 | (org-defkey org-mode-map [?\e (return)] 'org-meta-return) | |
14779 | (org-defkey org-mode-map [?\e (left)] 'org-metaleft) | |
14780 | (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft) | |
14781 | (org-defkey org-mode-map [?\e (right)] 'org-metaright) | |
14782 | (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright) | |
14783 | (org-defkey org-mode-map [?\e (up)] 'org-metaup) | |
14784 | (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup) | |
14785 | (org-defkey org-mode-map [?\e (down)] 'org-metadown) | |
14786 | (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown) | |
14787 | (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) | |
14788 | (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright) | |
14789 | (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup) | |
14790 | (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown) | |
14791 | (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup) | |
14792 | (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown) | |
14793 | (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) | |
14794 | (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) | |
14795 | (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) | |
c8d0cf5c CD |
14796 | (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) |
14797 | (org-defkey org-mode-map [?\e (tab)] 'org-complete) | |
14798 | (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) | |
14799 | (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) | |
14800 | (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) | |
14801 | (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup) | |
14802 | (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) | |
d3f4dbe8 | 14803 | |
3278a016 | 14804 | ;; All the other keys |
bea5b1ba | 14805 | |
a3fbe8c4 CD |
14806 | (org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. |
14807 | (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) | |
2c3ad40d CD |
14808 | (if (boundp 'narrow-map) |
14809 | (org-defkey narrow-map "s" 'org-narrow-to-subtree) | |
14810 | (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) | |
c8d0cf5c CD |
14811 | (org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level) |
14812 | (org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level) | |
a3fbe8c4 CD |
14813 | (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) |
14814 | (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) | |
8bfe682a | 14815 | (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) |
20908596 CD |
14816 | (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) |
14817 | (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) | |
a3fbe8c4 CD |
14818 | (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) |
14819 | (org-defkey org-mode-map "\C-c\C-j" 'org-goto) | |
14820 | (org-defkey org-mode-map "\C-c\C-t" 'org-todo) | |
71d35b24 | 14821 | (org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command) |
a3fbe8c4 CD |
14822 | (org-defkey org-mode-map "\C-c\C-s" 'org-schedule) |
14823 | (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) | |
14824 | (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) | |
14825 | (org-defkey org-mode-map "\C-c\C-v" 'org-show-todo-tree) | |
8c6fb58b | 14826 | (org-defkey org-mode-map "\C-c\C-w" 'org-refile) |
03f3cf35 | 14827 | (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved |
c8d0cf5c | 14828 | (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. |
a3fbe8c4 CD |
14829 | (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) |
14830 | (org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) | |
c8d0cf5c | 14831 | (org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) |
621f83e4 CD |
14832 | (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) |
14833 | (org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) | |
a3fbe8c4 CD |
14834 | (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) |
14835 | (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) | |
14836 | (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) | |
14837 | (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) | |
14838 | (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) | |
14839 | (org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) | |
20908596 | 14840 | (org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding |
a3fbe8c4 CD |
14841 | (org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved |
14842 | (org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. | |
14843 | (org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved | |
14844 | (org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range) | |
14845 | (org-defkey org-mode-map "\C-c>" 'org-goto-calendar) | |
14846 | (org-defkey org-mode-map "\C-c<" 'org-date-from-calendar) | |
14847 | (org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files) | |
14848 | (org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) | |
14849 | (org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) | |
14850 | (org-defkey org-mode-map "\C-c]" 'org-remove-file) | |
8c6fb58b CD |
14851 | (org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) |
14852 | (org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | |
38f8646b | 14853 | (org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) |
2a57416f | 14854 | (org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star) |
a3fbe8c4 CD |
14855 | (org-defkey org-mode-map "\C-c^" 'org-sort) |
14856 | (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) | |
03f3cf35 | 14857 | (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) |
54a0dee5 | 14858 | (org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) |
a3fbe8c4 | 14859 | (org-defkey org-mode-map "\C-m" 'org-return) |
8c6fb58b | 14860 | (org-defkey org-mode-map "\C-j" 'org-return-indent) |
a3fbe8c4 CD |
14861 | (org-defkey org-mode-map "\C-c?" 'org-table-field-info) |
14862 | (org-defkey org-mode-map "\C-c " 'org-table-blank-field) | |
14863 | (org-defkey org-mode-map "\C-c+" 'org-table-sum) | |
14864 | (org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) | |
b349f79f | 14865 | (org-defkey org-mode-map "\C-c'" 'org-edit-special) |
a3fbe8c4 CD |
14866 | (org-defkey org-mode-map "\C-c`" 'org-table-edit-field) |
14867 | (org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) | |
a3fbe8c4 CD |
14868 | (org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) |
14869 | (org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) | |
621f83e4 | 14870 | (org-defkey org-mode-map "\C-c\C-a" 'org-attach) |
a3fbe8c4 CD |
14871 | (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) |
14872 | (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) | |
14873 | (org-defkey org-mode-map "\C-c\C-e" 'org-export) | |
14874 | (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) | |
14875 | (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) | |
c8d0cf5c | 14876 | (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) |
8d642074 CD |
14877 | (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) |
14878 | (org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) | |
c8d0cf5c CD |
14879 | (org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) |
14880 | ;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) | |
a3fbe8c4 | 14881 | |
b349f79f | 14882 | (org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action) |
a3fbe8c4 CD |
14883 | (org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) |
14884 | (org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special) | |
14885 | (org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special) | |
14886 | ||
14887 | (org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) | |
14888 | (org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) | |
14889 | (org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) | |
15841868 | 14890 | (org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) |
a3fbe8c4 CD |
14891 | (org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel) |
14892 | (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) | |
14893 | (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) | |
14894 | (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) | |
14895 | (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) | |
14896 | (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) | |
03f3cf35 | 14897 | (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) |
54a0dee5 | 14898 | (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) |
a2a2e7fb | 14899 | (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) |
621f83e4 | 14900 | (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) |
c8d0cf5c | 14901 | (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) |
edd21304 | 14902 | |
ff4be292 CD |
14903 | (org-defkey org-mode-map "\C-c\C-x." 'org-timer) |
14904 | (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) | |
14905 | (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) | |
0bd48b37 | 14906 | (org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue) |
ff4be292 | 14907 | |
38f8646b CD |
14908 | (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) |
14909 | ||
c8d0cf5c CD |
14910 | (define-key org-mode-map "\C-c\C-x!" 'org-reload) |
14911 | ||
14912 | (define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all) | |
14913 | (define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox) | |
14914 | ||
14915 | (define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation) | |
14916 | ||
14917 | ||
edd21304 | 14918 | (when (featurep 'xemacs) |
a3fbe8c4 | 14919 | (org-defkey org-mode-map 'button3 'popup-mode-menu)) |
4b3a9ba7 | 14920 | |
c8d0cf5c | 14921 | |
8bfe682a CD |
14922 | (defconst org-speed-commands-default |
14923 | '( | |
1bcdebed CD |
14924 | ("Outline Navigation") |
14925 | ("n" . (org-speed-move-safe 'outline-next-visible-heading)) | |
14926 | ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) | |
14927 | ("f" . (org-speed-move-safe 'org-forward-same-level)) | |
14928 | ("b" . (org-speed-move-safe 'org-backward-same-level)) | |
14929 | ("u" . (org-speed-move-safe 'outline-up-heading)) | |
14930 | ("j" . org-goto) | |
14931 | ("g" . (org-refile t)) | |
14932 | ("Outline Visibility") | |
8bfe682a CD |
14933 | ("c" . org-cycle) |
14934 | ("C" . org-shifttab) | |
1bcdebed CD |
14935 | (" " . org-display-outline-path) |
14936 | ("Outline Structure Editing") | |
8bfe682a CD |
14937 | ("U" . org-shiftmetaup) |
14938 | ("D" . org-shiftmetadown) | |
14939 | ("r" . org-metaright) | |
14940 | ("l" . org-metaleft) | |
14941 | ("R" . org-shiftmetaright) | |
14942 | ("L" . org-shiftmetaleft) | |
14943 | ("i" . (progn (forward-char 1) (call-interactively | |
14944 | 'org-insert-heading-respect-content))) | |
1bcdebed CD |
14945 | ("^" . org-sort) |
14946 | ("w" . org-refile) | |
14947 | ("a" . org-archive-subtree-default-with-confirmation) | |
14948 | ("." . outline-mark-subtree) | |
14949 | ("Clock Commands") | |
8bfe682a CD |
14950 | ("I" . org-clock-in) |
14951 | ("O" . org-clock-out) | |
1bcdebed | 14952 | ("Meta Data Editing") |
8bfe682a | 14953 | ("t" . org-todo) |
8bfe682a CD |
14954 | ("0" . (org-priority ?\ )) |
14955 | ("1" . (org-priority ?A)) | |
14956 | ("2" . (org-priority ?B)) | |
14957 | ("3" . (org-priority ?C)) | |
1bcdebed CD |
14958 | (";" . org-set-tags-command) |
14959 | ("e" . org-set-effort) | |
14960 | ("Agenda Views etc") | |
14961 | ("v" . org-agenda) | |
14962 | ("/" . org-sparse-tree) | |
1bcdebed CD |
14963 | ("Misc") |
14964 | ("o" . org-open-at-point) | |
8bfe682a CD |
14965 | ("?" . org-speed-command-help) |
14966 | ) | |
14967 | "The default speed commands.") | |
14968 | ||
14969 | (defun org-print-speed-command (e) | |
1bcdebed CD |
14970 | (if (> (length (car e)) 1) |
14971 | (progn | |
14972 | (princ "\n") | |
14973 | (princ (car e)) | |
14974 | (princ "\n") | |
14975 | (princ (make-string (length (car e)) ?-)) | |
14976 | (princ "\n")) | |
14977 | (princ (car e)) | |
14978 | (princ " ") | |
14979 | (if (symbolp (cdr e)) | |
14980 | (princ (symbol-name (cdr e))) | |
14981 | (prin1 (cdr e))) | |
14982 | (princ "\n"))) | |
8bfe682a CD |
14983 | |
14984 | (defun org-speed-command-help () | |
14985 | "Show the available speed commands." | |
14986 | (interactive) | |
14987 | (if (not org-use-speed-commands) | |
db4a7382 | 14988 | (error "Speed commands are not activated, customize `org-use-speed-commands'") |
8bfe682a | 14989 | (with-output-to-temp-buffer "*Help*" |
1bcdebed | 14990 | (princ "User-defined Speed commands\n===========================\n") |
8bfe682a CD |
14991 | (mapc 'org-print-speed-command org-speed-commands-user) |
14992 | (princ "\n") | |
1bcdebed CD |
14993 | (princ "Built-in Speed commands\n=======================\n") |
14994 | (mapc 'org-print-speed-command org-speed-commands-default)) | |
14995 | (with-current-buffer "*Help*" | |
14996 | (setq truncate-lines t)))) | |
14997 | ||
14998 | (defun org-speed-move-safe (cmd) | |
14999 | "Execute CMD, but make sure that the cursor always ends up in a headline. | |
15000 | If not, return to the original position and throw an error." | |
15001 | (interactive) | |
15002 | (let ((pos (point))) | |
15003 | (call-interactively cmd) | |
15004 | (unless (and (bolp) (org-on-heading-p)) | |
15005 | (goto-char pos) | |
15006 | (error "Boundary reached while executing %s" cmd)))) | |
8bfe682a | 15007 | |
c8d0cf5c CD |
15008 | (defvar org-self-insert-command-undo-counter 0) |
15009 | ||
20908596 | 15010 | (defvar org-table-auto-blank-field) ; defined in org-table.el |
8bfe682a | 15011 | (defvar org-speed-command nil) |
791d856f CD |
15012 | (defun org-self-insert-command (N) |
15013 | "Like `self-insert-command', use overwrite-mode for whitespace in tables. | |
15014 | If the cursor is in a table looking at whitespace, the whitespace is | |
15015 | overwritten, and the table is not marked as requiring realignment." | |
15016 | (interactive "p") | |
8bfe682a CD |
15017 | (cond |
15018 | ((and org-use-speed-commands | |
1bcdebed CD |
15019 | (or (and (bolp) (looking-at outline-regexp)) |
15020 | (and (functionp org-use-speed-commands) | |
15021 | (funcall org-use-speed-commands))) | |
8bfe682a CD |
15022 | (setq |
15023 | org-speed-command | |
15024 | (or (cdr (assoc (this-command-keys) org-speed-commands-user)) | |
15025 | (cdr (assoc (this-command-keys) org-speed-commands-default))))) | |
15026 | (cond | |
15027 | ((commandp org-speed-command) | |
15028 | (setq this-command org-speed-command) | |
15029 | (call-interactively org-speed-command)) | |
15030 | ((functionp org-speed-command) | |
db4a7382 | 15031 | (funcall org-speed-command)) |
8bfe682a CD |
15032 | ((and org-speed-command (listp org-speed-command)) |
15033 | (eval org-speed-command)) | |
15034 | (t (let (org-use-speed-commands) | |
15035 | (call-interactively 'org-self-insert-command))))) | |
15036 | ((and | |
15037 | (org-table-p) | |
15038 | (progn | |
15039 | ;; check if we blank the field, and if that triggers align | |
15040 | (and (featurep 'org-table) org-table-auto-blank-field | |
15041 | (member last-command | |
15042 | '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand)) | |
15043 | (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) | |
15044 | ;; got extra space, this field does not determine column width | |
15045 | (let (org-table-may-need-update) (org-table-blank-field)) | |
c8d0cf5c | 15046 | ;; no extra space, this field may determine column width |
8bfe682a CD |
15047 | (org-table-blank-field))) |
15048 | t) | |
15049 | (eq N 1) | |
15050 | (looking-at "[^|\n]* |")) | |
15051 | (let (org-table-may-need-update) | |
15052 | (goto-char (1- (match-end 0))) | |
15053 | (delete-backward-char 1) | |
15054 | (goto-char (match-beginning 0)) | |
15055 | (self-insert-command N))) | |
15056 | (t | |
791d856f | 15057 | (setq org-table-may-need-update t) |
1e8fbb6d | 15058 | (self-insert-command N) |
c8d0cf5c CD |
15059 | (org-fix-tags-on-the-fly) |
15060 | (if org-self-insert-cluster-for-undo | |
15061 | (if (not (eq last-command 'org-self-insert-command)) | |
15062 | (setq org-self-insert-command-undo-counter 1) | |
15063 | (if (>= org-self-insert-command-undo-counter 20) | |
15064 | (setq org-self-insert-command-undo-counter 1) | |
15065 | (and (> org-self-insert-command-undo-counter 0) | |
15066 | buffer-undo-list | |
15067 | (not (cadr buffer-undo-list)) ; remove nil entry | |
15068 | (setcdr buffer-undo-list (cddr buffer-undo-list))) | |
15069 | (setq org-self-insert-command-undo-counter | |
8bfe682a | 15070 | (1+ org-self-insert-command-undo-counter)))))))) |
1e8fbb6d CD |
15071 | |
15072 | (defun org-fix-tags-on-the-fly () | |
15073 | (when (and (equal (char-after (point-at-bol)) ?*) | |
15074 | (org-on-heading-p)) | |
15075 | (org-align-tags-here org-tags-column))) | |
791d856f | 15076 | |
791d856f CD |
15077 | (defun org-delete-backward-char (N) |
15078 | "Like `delete-backward-char', insert whitespace at field end in tables. | |
15079 | When deleting backwards, in tables this function will insert whitespace in | |
15080 | front of the next \"|\" separator, to keep the table aligned. The table will | |
ab27a4a0 CD |
15081 | still be marked for re-alignment if the field did fill the entire column, |
15082 | because, in this case the deletion might narrow the column." | |
791d856f CD |
15083 | (interactive "p") |
15084 | (if (and (org-table-p) | |
c8d16429 CD |
15085 | (eq N 1) |
15086 | (string-match "|" (buffer-substring (point-at-bol) (point))) | |
15087 | (looking-at ".*?|")) | |
edd21304 | 15088 | (let ((pos (point)) |
ab27a4a0 CD |
15089 | (noalign (looking-at "[^|\n\r]* |")) |
15090 | (c org-table-may-need-update)) | |
c8d16429 CD |
15091 | (backward-delete-char N) |
15092 | (skip-chars-forward "^|") | |
15093 | (insert " ") | |
ab27a4a0 CD |
15094 | (goto-char (1- pos)) |
15095 | ;; noalign: if there were two spaces at the end, this field | |
15096 | ;; does not determine the width of the column. | |
15097 | (if noalign (setq org-table-may-need-update c))) | |
1e8fbb6d CD |
15098 | (backward-delete-char N) |
15099 | (org-fix-tags-on-the-fly))) | |
791d856f CD |
15100 | |
15101 | (defun org-delete-char (N) | |
15102 | "Like `delete-char', but insert whitespace at field end in tables. | |
15103 | When deleting characters, in tables this function will insert whitespace in | |
ab27a4a0 CD |
15104 | front of the next \"|\" separator, to keep the table aligned. The table will |
15105 | still be marked for re-alignment if the field did fill the entire column, | |
15106 | because, in this case the deletion might narrow the column." | |
791d856f CD |
15107 | (interactive "p") |
15108 | (if (and (org-table-p) | |
c8d16429 CD |
15109 | (not (bolp)) |
15110 | (not (= (char-after) ?|)) | |
15111 | (eq N 1)) | |
791d856f | 15112 | (if (looking-at ".*?|") |
ab27a4a0 CD |
15113 | (let ((pos (point)) |
15114 | (noalign (looking-at "[^|\n\r]* |")) | |
15115 | (c org-table-may-need-update)) | |
c8d16429 CD |
15116 | (replace-match (concat |
15117 | (substring (match-string 0) 1 -1) | |
15118 | " |")) | |
ab27a4a0 CD |
15119 | (goto-char pos) |
15120 | ;; noalign: if there were two spaces at the end, this field | |
15121 | ;; does not determine the width of the column. | |
4b3a9ba7 CD |
15122 | (if noalign (setq org-table-may-need-update c))) |
15123 | (delete-char N)) | |
1e8fbb6d CD |
15124 | (delete-char N) |
15125 | (org-fix-tags-on-the-fly))) | |
791d856f | 15126 | |
3278a016 CD |
15127 | ;; Make `delete-selection-mode' work with org-mode and orgtbl-mode |
15128 | (put 'org-self-insert-command 'delete-selection t) | |
15129 | (put 'orgtbl-self-insert-command 'delete-selection t) | |
15130 | (put 'org-delete-char 'delete-selection 'supersede) | |
15131 | (put 'org-delete-backward-char 'delete-selection 'supersede) | |
1e4f816a | 15132 | (put 'org-yank 'delete-selection 'yank) |
3278a016 | 15133 | |
7373bc42 CD |
15134 | ;; Make `flyspell-mode' delay after some commands |
15135 | (put 'org-self-insert-command 'flyspell-delayed t) | |
15136 | (put 'orgtbl-self-insert-command 'flyspell-delayed t) | |
15137 | (put 'org-delete-char 'flyspell-delayed t) | |
15138 | (put 'org-delete-backward-char 'flyspell-delayed t) | |
15139 | ||
8c6fb58b CD |
15140 | ;; Make pabbrev-mode expand after org-mode commands |
15141 | (put 'org-self-insert-command 'pabbrev-expand-after-command t) | |
33306645 | 15142 | (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) |
15841868 | 15143 | |
791d856f CD |
15144 | ;; How to do this: Measure non-white length of current string |
15145 | ;; If equal to column width, we should realign. | |
15146 | ||
28e5b051 CD |
15147 | (defun org-remap (map &rest commands) |
15148 | "In MAP, remap the functions given in COMMANDS. | |
15149 | COMMANDS is a list of alternating OLDDEF NEWDEF command names." | |
15150 | (let (new old) | |
15151 | (while commands | |
15152 | (setq old (pop commands) new (pop commands)) | |
15153 | (if (fboundp 'command-remapping) | |
a3fbe8c4 | 15154 | (org-defkey map (vector 'remap old) new) |
28e5b051 | 15155 | (substitute-key-definition old new map global-map))))) |
e0e66b8e | 15156 | |
791d856f CD |
15157 | (when (eq org-enable-table-editor 'optimized) |
15158 | ;; If the user wants maximum table support, we need to hijack | |
15159 | ;; some standard editing functions | |
28e5b051 CD |
15160 | (org-remap org-mode-map |
15161 | 'self-insert-command 'org-self-insert-command | |
15162 | 'delete-char 'org-delete-char | |
15163 | 'delete-backward-char 'org-delete-backward-char) | |
a3fbe8c4 | 15164 | (org-defkey org-mode-map "|" 'org-force-self-insert)) |
791d856f | 15165 | |
c8d0cf5c CD |
15166 | (defvar org-ctrl-c-ctrl-c-hook nil |
15167 | "Hook for functions attaching themselves to `C-c C-c'. | |
15168 | This can be used to add additional functionality to the C-c C-c key which | |
15169 | executes context-dependent commands. | |
15170 | Each function will be called with no arguments. The function must check | |
15171 | if the context is appropriate for it to act. If yes, it should do its | |
15172 | thing and then return a non-nil value. If the context is wrong, | |
15173 | just do nothing and return nil.") | |
15174 | ||
15175 | (defvar org-tab-first-hook nil | |
15176 | "Hook for functions to attach themselves to TAB. | |
15177 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
15178 | This hook runs as the first action when TAB is pressed, even before | |
15179 | `org-cycle' messes around with the `outline-regexp' to cater for | |
15180 | inline tasks and plain list item folding. | |
15181 | If any function in this hook returns t, not other actions like table | |
15182 | field motion visibility cycling will be done.") | |
15183 | ||
15184 | (defvar org-tab-after-check-for-table-hook nil | |
15185 | "Hook for functions to attach themselves to TAB. | |
15186 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
15187 | This hook runs after it has been established that the cursor is not in a | |
15188 | table, but before checking if the cursor is in a headline or if global cycling | |
15189 | should be done. | |
15190 | If any function in this hook returns t, not other actions like visibility | |
15191 | cycling will be done.") | |
15192 | ||
15193 | (defvar org-tab-after-check-for-cycling-hook nil | |
15194 | "Hook for functions to attach themselves to TAB. | |
15195 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
15196 | This hook runs after it has been established that not table field motion and | |
15197 | not visibility should be done because of current context. This is probably | |
15198 | the place where a package like yasnippets can hook in.") | |
15199 | ||
8bfe682a CD |
15200 | (defvar org-tab-before-tab-emulation-hook nil |
15201 | "Hook for functions to attach themselves to TAB. | |
15202 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
15203 | This hook runs after every other options for TAB have been exhausted, but | |
15204 | before indentation and \t insertion takes place.") | |
15205 | ||
c8d0cf5c CD |
15206 | (defvar org-metaleft-hook nil |
15207 | "Hook for functions attaching themselves to `M-left'. | |
15208 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15209 | (defvar org-metaright-hook nil | |
15210 | "Hook for functions attaching themselves to `M-right'. | |
15211 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15212 | (defvar org-metaup-hook nil | |
15213 | "Hook for functions attaching themselves to `M-up'. | |
15214 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15215 | (defvar org-metadown-hook nil | |
15216 | "Hook for functions attaching themselves to `M-down'. | |
15217 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15218 | (defvar org-shiftmetaleft-hook nil | |
15219 | "Hook for functions attaching themselves to `M-S-left'. | |
15220 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15221 | (defvar org-shiftmetaright-hook nil | |
15222 | "Hook for functions attaching themselves to `M-S-right'. | |
15223 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15224 | (defvar org-shiftmetaup-hook nil | |
15225 | "Hook for functions attaching themselves to `M-S-up'. | |
15226 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15227 | (defvar org-shiftmetadown-hook nil | |
15228 | "Hook for functions attaching themselves to `M-S-down'. | |
15229 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15230 | (defvar org-metareturn-hook nil | |
15231 | "Hook for functions attaching themselves to `M-RET'. | |
15232 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
15233 | ||
65c439fd CD |
15234 | (defun org-modifier-cursor-error () |
15235 | "Throw an error, a modified cursor command was applied in wrong context." | |
15236 | (error "This command is active in special context like tables, headlines or items")) | |
15237 | ||
15238 | (defun org-shiftselect-error () | |
891f4676 | 15239 | "Throw an error because Shift-Cursor command was applied in wrong context." |
65c439fd | 15240 | (if (and (boundp 'shift-select-mode) shift-select-mode) |
f924a367 JB |
15241 | (error "To use shift-selection with Org-mode, customize `org-support-shift-select'") |
15242 | (error "This command works only in special context like headlines or timestamps"))) | |
65c439fd CD |
15243 | |
15244 | (defun org-call-for-shift-select (cmd) | |
15245 | (let ((this-command-keys-shift-translated t)) | |
15246 | (call-interactively cmd))) | |
891f4676 | 15247 | |
edd21304 | 15248 | (defun org-shifttab (&optional arg) |
28e5b051 | 15249 | "Global visibility cycling or move to previous table field. |
4b3a9ba7 CD |
15250 | Calls `org-cycle' with argument t, or `org-table-previous-field', depending |
15251 | on context. | |
28e5b051 | 15252 | See the individual commands for more information." |
edd21304 | 15253 | (interactive "P") |
891f4676 | 15254 | (cond |
4b3a9ba7 | 15255 | ((org-at-table-p) (call-interactively 'org-table-previous-field)) |
b349f79f | 15256 | ((integerp arg) |
8d642074 CD |
15257 | (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) |
15258 | (message "Content view to level: %d" arg) | |
15259 | (org-content (prefix-numeric-value arg2)) | |
15260 | (setq org-cycle-global-status 'overview))) | |
4b3a9ba7 | 15261 | (t (call-interactively 'org-global-cycle)))) |
891f4676 | 15262 | |
634a7d0b | 15263 | (defun org-shiftmetaleft () |
28e5b051 | 15264 | "Promote subtree or delete table column. |
a3fbe8c4 CD |
15265 | Calls `org-promote-subtree', `org-outdent-item', |
15266 | or `org-table-delete-column', depending on context. | |
28e5b051 | 15267 | See the individual commands for more information." |
634a7d0b | 15268 | (interactive) |
891f4676 | 15269 | (cond |
c8d0cf5c | 15270 | ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) |
4b3a9ba7 CD |
15271 | ((org-at-table-p) (call-interactively 'org-table-delete-column)) |
15272 | ((org-on-heading-p) (call-interactively 'org-promote-subtree)) | |
7a368970 | 15273 | ((org-at-item-p) (call-interactively 'org-outdent-item)) |
65c439fd | 15274 | (t (org-modifier-cursor-error)))) |
634a7d0b CD |
15275 | |
15276 | (defun org-shiftmetaright () | |
28e5b051 | 15277 | "Demote subtree or insert table column. |
a3fbe8c4 CD |
15278 | Calls `org-demote-subtree', `org-indent-item', |
15279 | or `org-table-insert-column', depending on context. | |
28e5b051 | 15280 | See the individual commands for more information." |
634a7d0b | 15281 | (interactive) |
891f4676 | 15282 | (cond |
c8d0cf5c | 15283 | ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) |
4b3a9ba7 CD |
15284 | ((org-at-table-p) (call-interactively 'org-table-insert-column)) |
15285 | ((org-on-heading-p) (call-interactively 'org-demote-subtree)) | |
7a368970 | 15286 | ((org-at-item-p) (call-interactively 'org-indent-item)) |
65c439fd | 15287 | (t (org-modifier-cursor-error)))) |
634a7d0b | 15288 | |
891f4676 | 15289 | (defun org-shiftmetaup (&optional arg) |
28e5b051 | 15290 | "Move subtree up or kill table row. |
7a368970 CD |
15291 | Calls `org-move-subtree-up' or `org-table-kill-row' or |
15292 | `org-move-item-up' depending on context. See the individual commands | |
15293 | for more information." | |
891f4676 RS |
15294 | (interactive "P") |
15295 | (cond | |
c8d0cf5c | 15296 | ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) |
4b3a9ba7 CD |
15297 | ((org-at-table-p) (call-interactively 'org-table-kill-row)) |
15298 | ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) | |
15299 | ((org-at-item-p) (call-interactively 'org-move-item-up)) | |
65c439fd | 15300 | (t (org-modifier-cursor-error)))) |
c8d0cf5c | 15301 | |
891f4676 | 15302 | (defun org-shiftmetadown (&optional arg) |
28e5b051 | 15303 | "Move subtree down or insert table row. |
7a368970 CD |
15304 | Calls `org-move-subtree-down' or `org-table-insert-row' or |
15305 | `org-move-item-down', depending on context. See the individual | |
15306 | commands for more information." | |
891f4676 RS |
15307 | (interactive "P") |
15308 | (cond | |
c8d0cf5c | 15309 | ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) |
4b3a9ba7 CD |
15310 | ((org-at-table-p) (call-interactively 'org-table-insert-row)) |
15311 | ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) | |
15312 | ((org-at-item-p) (call-interactively 'org-move-item-down)) | |
65c439fd | 15313 | (t (org-modifier-cursor-error)))) |
891f4676 RS |
15314 | |
15315 | (defun org-metaleft (&optional arg) | |
28e5b051 CD |
15316 | "Promote heading or move table column to left. |
15317 | Calls `org-do-promote' or `org-table-move-column', depending on context. | |
7a368970 | 15318 | With no specific context, calls the Emacs default `backward-word'. |
28e5b051 | 15319 | See the individual commands for more information." |
891f4676 RS |
15320 | (interactive "P") |
15321 | (cond | |
c8d0cf5c | 15322 | ((run-hook-with-args-until-success 'org-metaleft-hook)) |
4b3a9ba7 | 15323 | ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) |
c8d0cf5c CD |
15324 | ((or (org-on-heading-p) |
15325 | (and (org-region-active-p) | |
15326 | (save-excursion | |
15327 | (goto-char (region-beginning)) | |
15328 | (org-on-heading-p)))) | |
4b3a9ba7 | 15329 | (call-interactively 'org-do-promote)) |
c8d0cf5c CD |
15330 | ((or (org-at-item-p) |
15331 | (and (org-region-active-p) | |
15332 | (save-excursion | |
15333 | (goto-char (region-beginning)) | |
15334 | (org-at-item-p)))) | |
15335 | (call-interactively 'org-outdent-item)) | |
4b3a9ba7 | 15336 | (t (call-interactively 'backward-word)))) |
634a7d0b | 15337 | |
891f4676 | 15338 | (defun org-metaright (&optional arg) |
28e5b051 CD |
15339 | "Demote subtree or move table column to right. |
15340 | Calls `org-do-demote' or `org-table-move-column', depending on context. | |
7a368970 | 15341 | With no specific context, calls the Emacs default `forward-word'. |
28e5b051 | 15342 | See the individual commands for more information." |
891f4676 RS |
15343 | (interactive "P") |
15344 | (cond | |
c8d0cf5c | 15345 | ((run-hook-with-args-until-success 'org-metaright-hook)) |
4b3a9ba7 | 15346 | ((org-at-table-p) (call-interactively 'org-table-move-column)) |
c8d0cf5c CD |
15347 | ((or (org-on-heading-p) |
15348 | (and (org-region-active-p) | |
15349 | (save-excursion | |
15350 | (goto-char (region-beginning)) | |
15351 | (org-on-heading-p)))) | |
4b3a9ba7 | 15352 | (call-interactively 'org-do-demote)) |
c8d0cf5c CD |
15353 | ((or (org-at-item-p) |
15354 | (and (org-region-active-p) | |
15355 | (save-excursion | |
15356 | (goto-char (region-beginning)) | |
15357 | (org-at-item-p)))) | |
15358 | (call-interactively 'org-indent-item)) | |
4b3a9ba7 | 15359 | (t (call-interactively 'forward-word)))) |
634a7d0b | 15360 | |
891f4676 | 15361 | (defun org-metaup (&optional arg) |
28e5b051 | 15362 | "Move subtree up or move table row up. |
7a368970 CD |
15363 | Calls `org-move-subtree-up' or `org-table-move-row' or |
15364 | `org-move-item-up', depending on context. See the individual commands | |
15365 | for more information." | |
891f4676 RS |
15366 | (interactive "P") |
15367 | (cond | |
c8d0cf5c | 15368 | ((run-hook-with-args-until-success 'org-metaup-hook)) |
4b3a9ba7 CD |
15369 | ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) |
15370 | ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) | |
15371 | ((org-at-item-p) (call-interactively 'org-move-item-up)) | |
03f3cf35 | 15372 | (t (transpose-lines 1) (beginning-of-line -1)))) |
634a7d0b | 15373 | |
891f4676 | 15374 | (defun org-metadown (&optional arg) |
28e5b051 | 15375 | "Move subtree down or move table row down. |
7a368970 CD |
15376 | Calls `org-move-subtree-down' or `org-table-move-row' or |
15377 | `org-move-item-down', depending on context. See the individual | |
15378 | commands for more information." | |
891f4676 RS |
15379 | (interactive "P") |
15380 | (cond | |
c8d0cf5c | 15381 | ((run-hook-with-args-until-success 'org-metadown-hook)) |
4b3a9ba7 CD |
15382 | ((org-at-table-p) (call-interactively 'org-table-move-row)) |
15383 | ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) | |
15384 | ((org-at-item-p) (call-interactively 'org-move-item-down)) | |
03f3cf35 | 15385 | (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0)))) |
891f4676 RS |
15386 | |
15387 | (defun org-shiftup (&optional arg) | |
4b3a9ba7 | 15388 | "Increase item in timestamp or increase priority of current headline. |
a3fbe8c4 CD |
15389 | Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', |
15390 | depending on context. See the individual commands for more information." | |
891f4676 RS |
15391 | (interactive "P") |
15392 | (cond | |
65c439fd CD |
15393 | ((and org-support-shift-select (org-region-active-p)) |
15394 | (org-call-for-shift-select 'previous-line)) | |
0b8568f5 JW |
15395 | ((org-at-timestamp-p t) |
15396 | (call-interactively (if org-edit-timestamp-down-means-later | |
15397 | 'org-timestamp-down 'org-timestamp-up))) | |
65c439fd | 15398 | ((and (not (eq org-support-shift-select 'always)) |
c8d0cf5c | 15399 | org-enable-priority-commands |
65c439fd CD |
15400 | (org-on-heading-p)) |
15401 | (call-interactively 'org-priority-up)) | |
15402 | ((and (not org-support-shift-select) (org-at-item-p)) | |
15403 | (call-interactively 'org-previous-item)) | |
20908596 | 15404 | ((org-clocktable-try-shift 'up arg)) |
65c439fd CD |
15405 | (org-support-shift-select |
15406 | (org-call-for-shift-select 'previous-line)) | |
15407 | (t (org-shiftselect-error)))) | |
891f4676 RS |
15408 | |
15409 | (defun org-shiftdown (&optional arg) | |
4b3a9ba7 | 15410 | "Decrease item in timestamp or decrease priority of current headline. |
a3fbe8c4 CD |
15411 | Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' |
15412 | depending on context. See the individual commands for more information." | |
891f4676 RS |
15413 | (interactive "P") |
15414 | (cond | |
65c439fd CD |
15415 | ((and org-support-shift-select (org-region-active-p)) |
15416 | (org-call-for-shift-select 'next-line)) | |
0b8568f5 JW |
15417 | ((org-at-timestamp-p t) |
15418 | (call-interactively (if org-edit-timestamp-down-means-later | |
15419 | 'org-timestamp-up 'org-timestamp-down))) | |
65c439fd | 15420 | ((and (not (eq org-support-shift-select 'always)) |
c8d0cf5c | 15421 | org-enable-priority-commands |
65c439fd CD |
15422 | (org-on-heading-p)) |
15423 | (call-interactively 'org-priority-down)) | |
15424 | ((and (not org-support-shift-select) (org-at-item-p)) | |
15425 | (call-interactively 'org-next-item)) | |
20908596 | 15426 | ((org-clocktable-try-shift 'down arg)) |
c8d0cf5c | 15427 | (org-support-shift-select |
65c439fd CD |
15428 | (org-call-for-shift-select 'next-line)) |
15429 | (t (org-shiftselect-error)))) | |
891f4676 | 15430 | |
20908596 | 15431 | (defun org-shiftright (&optional arg) |
ce4fdcb9 CD |
15432 | "Cycle the thing at point or in the current line, depending on context. |
15433 | Depending on context, this does one of the following: | |
15434 | ||
15435 | - switch a timestamp at point one day into the future | |
15436 | - on a headline, switch to the next TODO keyword. | |
15437 | - on an item, switch entire list to the next bullet type | |
15438 | - on a property line, switch to the next allowed value | |
15439 | - on a clocktable definition line, move time block into the future" | |
20908596 | 15440 | (interactive "P") |
f425a6ea | 15441 | (cond |
65c439fd CD |
15442 | ((and org-support-shift-select (org-region-active-p)) |
15443 | (org-call-for-shift-select 'forward-char)) | |
8df0de1c | 15444 | ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) |
65c439fd CD |
15445 | ((and (not (eq org-support-shift-select 'always)) |
15446 | (org-on-heading-p)) | |
c8d0cf5c CD |
15447 | (let ((org-inhibit-logging |
15448 | (not org-treat-S-cursor-todo-selection-as-state-change)) | |
15449 | (org-inhibit-blocking | |
15450 | (not org-treat-S-cursor-todo-selection-as-state-change))) | |
15451 | (org-call-with-arg 'org-todo 'right))) | |
65c439fd CD |
15452 | ((or (and org-support-shift-select |
15453 | (not (eq org-support-shift-select 'always)) | |
15454 | (org-at-item-bullet-p)) | |
15455 | (and (not org-support-shift-select) (org-at-item-p))) | |
15456 | (org-call-with-arg 'org-cycle-list-bullet nil)) | |
15457 | ((and (not (eq org-support-shift-select 'always)) | |
15458 | (org-at-property-p)) | |
15459 | (call-interactively 'org-property-next-allowed-value)) | |
20908596 | 15460 | ((org-clocktable-try-shift 'right arg)) |
c8d0cf5c | 15461 | (org-support-shift-select |
65c439fd CD |
15462 | (org-call-for-shift-select 'forward-char)) |
15463 | (t (org-shiftselect-error)))) | |
f425a6ea | 15464 | |
20908596 | 15465 | (defun org-shiftleft (&optional arg) |
ce4fdcb9 CD |
15466 | "Cycle the thing at point or in the current line, depending on context. |
15467 | Depending on context, this does one of the following: | |
15468 | ||
15469 | - switch a timestamp at point one day into the past | |
15470 | - on a headline, switch to the previous TODO keyword. | |
15471 | - on an item, switch entire list to the previous bullet type | |
15472 | - on a property line, switch to the previous allowed value | |
15473 | - on a clocktable definition line, move time block into the past" | |
20908596 | 15474 | (interactive "P") |
f425a6ea | 15475 | (cond |
65c439fd CD |
15476 | ((and org-support-shift-select (org-region-active-p)) |
15477 | (org-call-for-shift-select 'backward-char)) | |
8df0de1c | 15478 | ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) |
65c439fd CD |
15479 | ((and (not (eq org-support-shift-select 'always)) |
15480 | (org-on-heading-p)) | |
c8d0cf5c CD |
15481 | (let ((org-inhibit-logging |
15482 | (not org-treat-S-cursor-todo-selection-as-state-change)) | |
15483 | (org-inhibit-blocking | |
15484 | (not org-treat-S-cursor-todo-selection-as-state-change))) | |
15485 | (org-call-with-arg 'org-todo 'left))) | |
65c439fd CD |
15486 | ((or (and org-support-shift-select |
15487 | (not (eq org-support-shift-select 'always)) | |
15488 | (org-at-item-bullet-p)) | |
15489 | (and (not org-support-shift-select) (org-at-item-p))) | |
15490 | (org-call-with-arg 'org-cycle-list-bullet 'previous)) | |
15491 | ((and (not (eq org-support-shift-select 'always)) | |
15492 | (org-at-property-p)) | |
7d58338e | 15493 | (call-interactively 'org-property-previous-allowed-value)) |
20908596 | 15494 | ((org-clocktable-try-shift 'left arg)) |
c8d0cf5c | 15495 | (org-support-shift-select |
65c439fd CD |
15496 | (org-call-for-shift-select 'backward-char)) |
15497 | (t (org-shiftselect-error)))) | |
f425a6ea | 15498 | |
a3fbe8c4 CD |
15499 | (defun org-shiftcontrolright () |
15500 | "Switch to next TODO set." | |
15501 | (interactive) | |
15502 | (cond | |
65c439fd CD |
15503 | ((and org-support-shift-select (org-region-active-p)) |
15504 | (org-call-for-shift-select 'forward-word)) | |
15505 | ((and (not (eq org-support-shift-select 'always)) | |
15506 | (org-on-heading-p)) | |
15507 | (org-call-with-arg 'org-todo 'nextset)) | |
15508 | (org-support-shift-select | |
15509 | (org-call-for-shift-select 'forward-word)) | |
15510 | (t (org-shiftselect-error)))) | |
a3fbe8c4 CD |
15511 | |
15512 | (defun org-shiftcontrolleft () | |
15513 | "Switch to previous TODO set." | |
15514 | (interactive) | |
15515 | (cond | |
65c439fd CD |
15516 | ((and org-support-shift-select (org-region-active-p)) |
15517 | (org-call-for-shift-select 'backward-word)) | |
15518 | ((and (not (eq org-support-shift-select 'always)) | |
15519 | (org-on-heading-p)) | |
15520 | (org-call-with-arg 'org-todo 'previousset)) | |
15521 | (org-support-shift-select | |
15522 | (org-call-for-shift-select 'backward-word)) | |
15523 | (t (org-shiftselect-error)))) | |
a3fbe8c4 CD |
15524 | |
15525 | (defun org-ctrl-c-ret () | |
15526 | "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." | |
15527 | (interactive) | |
15528 | (cond | |
15529 | ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) | |
15530 | (t (call-interactively 'org-insert-heading)))) | |
15531 | ||
634a7d0b | 15532 | (defun org-copy-special () |
28e5b051 CD |
15533 | "Copy region in table or copy current subtree. |
15534 | Calls `org-table-copy' or `org-copy-subtree', depending on context. | |
15535 | See the individual commands for more information." | |
634a7d0b | 15536 | (interactive) |
64f72ae1 | 15537 | (call-interactively |
9acdaa21 | 15538 | (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) |
891f4676 | 15539 | |
634a7d0b | 15540 | (defun org-cut-special () |
28e5b051 CD |
15541 | "Cut region in table or cut current subtree. |
15542 | Calls `org-table-copy' or `org-cut-subtree', depending on context. | |
15543 | See the individual commands for more information." | |
634a7d0b | 15544 | (interactive) |
9acdaa21 CD |
15545 | (call-interactively |
15546 | (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) | |
891f4676 RS |
15547 | |
15548 | (defun org-paste-special (arg) | |
28e5b051 CD |
15549 | "Paste rectangular region into table, or past subtree relative to level. |
15550 | Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. | |
15551 | See the individual commands for more information." | |
891f4676 RS |
15552 | (interactive "P") |
15553 | (if (org-at-table-p) | |
634a7d0b | 15554 | (org-table-paste-rectangle) |
891f4676 RS |
15555 | (org-paste-subtree arg))) |
15556 | ||
b349f79f CD |
15557 | (defun org-edit-special () |
15558 | "Call a special editor for the stuff at point. | |
15559 | When at a table, call the formula editor with `org-table-edit-formulas'. | |
15560 | When at the first line of an src example, call `org-edit-src-code'. | |
15561 | When in an #+include line, visit the include file. Otherwise call | |
15562 | `ffap' to visit the file at point." | |
15563 | (interactive) | |
15564 | (cond | |
15565 | ((org-at-table-p) | |
15566 | (call-interactively 'org-table-edit-formulas)) | |
15567 | ((save-excursion | |
15568 | (beginning-of-line 1) | |
15569 | (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)")) | |
15570 | (find-file (org-trim (match-string 1)))) | |
15571 | ((org-edit-src-code)) | |
621f83e4 | 15572 | ((org-edit-fixed-width-region)) |
b349f79f CD |
15573 | (t (call-interactively 'ffap)))) |
15574 | ||
c8d0cf5c | 15575 | |
891f4676 | 15576 | (defun org-ctrl-c-ctrl-c (&optional arg) |
a4b39e39 CD |
15577 | "Set tags in headline, or update according to changed information at point. |
15578 | ||
15579 | This command does many different things, depending on context: | |
15580 | ||
c8d0cf5c CD |
15581 | - If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, |
15582 | this is what we do. | |
15583 | ||
54a0dee5 CD |
15584 | - If the cursor is on a statistics cookie, update it. |
15585 | ||
a4b39e39 CD |
15586 | - If the cursor is in a headline, prompt for tags and insert them |
15587 | into the current line, aligned to `org-tags-column'. When called | |
15588 | with prefix arg, realign all tags in the current buffer. | |
15589 | ||
15590 | - If the cursor is in one of the special #+KEYWORD lines, this | |
15591 | triggers scanning the buffer for these lines and updating the | |
edd21304 | 15592 | information. |
a4b39e39 CD |
15593 | |
15594 | - If the cursor is inside a table, realign the table. This command | |
15595 | works even if the automatic table editor has been turned off. | |
15596 | ||
15597 | - If the cursor is on a #+TBLFM line, re-apply the formulas to | |
15598 | the entire table. | |
15599 | ||
0bd48b37 CD |
15600 | - If the cursor is at a footnote reference or definition, jump to |
15601 | the corresponding definition or references, respectively. | |
15602 | ||
15841868 JW |
15603 | - If the cursor is a the beginning of a dynamic block, update it. |
15604 | ||
a4b39e39 | 15605 | - If the cursor is inside a table created by the table.el package, |
2a94e282 | 15606 | activate that table. |
a4b39e39 | 15607 | |
93b62de8 CD |
15608 | - If the current buffer is a remember buffer, close note and file |
15609 | it. A prefix argument of 1 files to the default location | |
15610 | without further interaction. A prefix argument of 2 files to | |
15611 | the currently clocking task. | |
a4b39e39 CD |
15612 | |
15613 | - If the cursor is on a <<<target>>>, update radio targets and corresponding | |
15614 | links in this buffer. | |
15615 | ||
15616 | - If the cursor is on a numbered item in a plain list, renumber the | |
8c6fb58b CD |
15617 | ordered list. |
15618 | ||
15619 | - If the cursor is on a checkbox, toggle it." | |
891f4676 RS |
15620 | (interactive "P") |
15621 | (let ((org-enable-table-editor t)) | |
15622 | (cond | |
20908596 | 15623 | ((or (and (boundp 'org-clock-overlays) org-clock-overlays) |
3278a016 | 15624 | org-occur-highlights |
6769c0dc | 15625 | org-latex-fragment-image-overlays) |
0bd48b37 | 15626 | (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) |
edd21304 | 15627 | (org-remove-occur-highlights) |
6769c0dc CD |
15628 | (org-remove-latex-fragment-image-overlays) |
15629 | (message "Temporary highlights/overlays removed from current buffer")) | |
ab27a4a0 CD |
15630 | ((and (local-variable-p 'org-finish-function (current-buffer)) |
15631 | (fboundp org-finish-function)) | |
15632 | (funcall org-finish-function)) | |
c8d0cf5c | 15633 | ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) |
7d58338e CD |
15634 | ((org-at-property-p) |
15635 | (call-interactively 'org-property-action)) | |
4b3a9ba7 | 15636 | ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) |
54a0dee5 CD |
15637 | ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]") |
15638 | (or (org-on-heading-p) (org-at-item-p))) | |
15639 | (call-interactively 'org-update-statistics-cookies)) | |
4b3a9ba7 | 15640 | ((org-on-heading-p) (call-interactively 'org-set-tags)) |
891f4676 RS |
15641 | ((org-at-table.el-p) |
15642 | (require 'table) | |
15643 | (beginning-of-line 1) | |
9acdaa21 | 15644 | (re-search-forward "|" (save-excursion (end-of-line 2) (point))) |
4b3a9ba7 | 15645 | (call-interactively 'table-recognize-table)) |
891f4676 | 15646 | ((org-at-table-p) |
9acdaa21 CD |
15647 | (org-table-maybe-eval-formula) |
15648 | (if arg | |
4b3a9ba7 | 15649 | (call-interactively 'org-table-recalculate) |
c8d16429 | 15650 | (org-table-maybe-recalculate-line)) |
4b3a9ba7 | 15651 | (call-interactively 'org-table-align)) |
0bd48b37 CD |
15652 | ((or (org-footnote-at-reference-p) |
15653 | (org-footnote-at-definition-p)) | |
15654 | (call-interactively 'org-footnote-action)) | |
4b3a9ba7 CD |
15655 | ((org-at-item-checkbox-p) |
15656 | (call-interactively 'org-toggle-checkbox)) | |
7a368970 | 15657 | ((org-at-item-p) |
c8d0cf5c CD |
15658 | (if arg |
15659 | (call-interactively 'org-toggle-checkbox) | |
15660 | (call-interactively 'org-maybe-renumber-ordered-list))) | |
8d642074 | 15661 | ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) |
15841868 JW |
15662 | ;; Dynamic block |
15663 | (beginning-of-line 1) | |
621f83e4 | 15664 | (save-excursion (org-update-dblock))) |
c8d0cf5c CD |
15665 | ((save-excursion |
15666 | (beginning-of-line 1) | |
15667 | (looking-at "[ \t]*#\\+\\([A-Z]+\\)")) | |
9acdaa21 CD |
15668 | (cond |
15669 | ((equal (match-string 1) "TBLFM") | |
c8d16429 CD |
15670 | ;; Recalculate the table before this line |
15671 | (save-excursion | |
15672 | (beginning-of-line 1) | |
15673 | (skip-chars-backward " \r\n\t") | |
4b3a9ba7 | 15674 | (if (org-at-table-p) |
8d642074 | 15675 | (org-call-with-arg 'org-table-recalculate (or arg t))))) |
9acdaa21 | 15676 | (t |
b349f79f CD |
15677 | ; (org-set-regexps-and-options) |
15678 | ; (org-restart-font-lock) | |
15679 | (let ((org-inhibit-startup t)) (org-mode-restart)) | |
15680 | (message "Local setup has been refreshed")))) | |
c8d0cf5c | 15681 | ((org-clock-update-time-maybe)) |
f924a367 | 15682 | (t (error "C-c C-c can do nothing useful at this location"))))) |
891f4676 | 15683 | |
28e5b051 CD |
15684 | (defun org-mode-restart () |
15685 | "Restart Org-mode, to scan again for special lines. | |
15686 | Also updates the keyword regular expressions." | |
15687 | (interactive) | |
b349f79f CD |
15688 | (org-mode) |
15689 | (message "Org-mode restarted")) | |
28e5b051 | 15690 | |
03f3cf35 | 15691 | (defun org-kill-note-or-show-branches () |
a0d892d4 | 15692 | "If this is a Note buffer, abort storing the note. Else call `show-branches'." |
03f3cf35 JW |
15693 | (interactive) |
15694 | (if (not org-finish-function) | |
15695 | (call-interactively 'show-branches) | |
15696 | (let ((org-note-abort t)) | |
15697 | (funcall org-finish-function)))) | |
15698 | ||
8c6fb58b | 15699 | (defun org-return (&optional indent) |
28e5b051 CD |
15700 | "Goto next table row or insert a newline. |
15701 | Calls `org-table-next-row' or `newline', depending on context. | |
15702 | See the individual commands for more information." | |
634a7d0b | 15703 | (interactive) |
891f4676 | 15704 | (cond |
8c6fb58b | 15705 | ((bobp) (if indent (newline-and-indent) (newline))) |
c8d0cf5c CD |
15706 | ((org-at-table-p) |
15707 | (org-table-justify-field-maybe) | |
15708 | (call-interactively 'org-table-next-row)) | |
15709 | ((and org-return-follows-link | |
15710 | (eq (get-text-property (point) 'face) 'org-link)) | |
15711 | (call-interactively 'org-open-at-point)) | |
2a57416f CD |
15712 | ((and (org-at-heading-p) |
15713 | (looking-at | |
15714 | (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$"))) | |
15715 | (org-show-entry) | |
15716 | (end-of-line 1) | |
15717 | (newline)) | |
8c6fb58b | 15718 | (t (if indent (newline-and-indent) (newline))))) |
891f4676 | 15719 | |
8c6fb58b | 15720 | (defun org-return-indent () |
8c6fb58b CD |
15721 | "Goto next table row or insert a newline and indent. |
15722 | Calls `org-table-next-row' or `newline-and-indent', depending on | |
15723 | context. See the individual commands for more information." | |
2a57416f | 15724 | (interactive) |
8c6fb58b | 15725 | (org-return t)) |
03f3cf35 | 15726 | |
2a57416f CD |
15727 | (defun org-ctrl-c-star () |
15728 | "Compute table, or change heading status of lines. | |
0bd48b37 CD |
15729 | Calls `org-table-recalculate' or `org-toggle-heading', |
15730 | depending on context." | |
2a57416f CD |
15731 | (interactive) |
15732 | (cond | |
15733 | ((org-at-table-p) | |
15734 | (call-interactively 'org-table-recalculate)) | |
0bd48b37 | 15735 | (t |
2a57416f | 15736 | ;; Convert all lines in region to list items |
0bd48b37 | 15737 | (call-interactively 'org-toggle-heading)))) |
2a57416f | 15738 | |
38f8646b | 15739 | (defun org-ctrl-c-minus () |
2a57416f CD |
15740 | "Insert separator line in table or modify bullet status of line. |
15741 | Also turns a plain line or a region of lines into list items. | |
0bd48b37 | 15742 | Calls `org-table-insert-hline', `org-toggle-item', or |
2a57416f | 15743 | `org-cycle-list-bullet', depending on context." |
38f8646b CD |
15744 | (interactive) |
15745 | (cond | |
15746 | ((org-at-table-p) | |
15747 | (call-interactively 'org-table-insert-hline)) | |
2a57416f | 15748 | ((org-region-active-p) |
0bd48b37 | 15749 | (call-interactively 'org-toggle-item)) |
38f8646b CD |
15750 | ((org-in-item-p) |
15751 | (call-interactively 'org-cycle-list-bullet)) | |
0bd48b37 CD |
15752 | (t |
15753 | (call-interactively 'org-toggle-item)))) | |
15754 | ||
15755 | (defun org-toggle-item () | |
15756 | "Convert headings or normal lines to items, items to normal lines. | |
15757 | If there is no active region, only the current line is considered. | |
15758 | ||
15759 | If the first line in the region is a headline, convert all headlines to items. | |
15760 | ||
15761 | If the first line in the region is an item, convert all items to normal lines. | |
15762 | ||
15763 | If the first line is normal text, add an item bullet to each line." | |
15764 | (interactive) | |
15765 | (let (l2 l beg end) | |
15766 | (if (org-region-active-p) | |
15767 | (setq beg (region-beginning) end (region-end)) | |
15768 | (setq beg (point-at-bol) | |
15769 | end (min (1+ (point-at-eol)) (point-max)))) | |
2a57416f CD |
15770 | (save-excursion |
15771 | (goto-char end) | |
15772 | (setq l2 (org-current-line)) | |
15773 | (goto-char beg) | |
15774 | (beginning-of-line 1) | |
15775 | (setq l (1- (org-current-line))) | |
15776 | (if (org-at-item-p) | |
15777 | ;; We already have items, de-itemize | |
15778 | (while (< (setq l (1+ l)) l2) | |
15779 | (when (org-at-item-p) | |
15780 | (goto-char (match-beginning 2)) | |
15781 | (delete-region (match-beginning 2) (match-end 2)) | |
15782 | (and (looking-at "[ \t]+") (replace-match ""))) | |
15783 | (beginning-of-line 2)) | |
0bd48b37 CD |
15784 | (if (org-on-heading-p) |
15785 | ;; Headings, convert to items | |
15786 | (while (< (setq l (1+ l)) l2) | |
15787 | (if (looking-at org-outline-regexp) | |
15788 | (replace-match "- " t t)) | |
15789 | (beginning-of-line 2)) | |
15790 | ;; normal lines, turn them into items | |
15791 | (while (< (setq l (1+ l)) l2) | |
15792 | (unless (org-at-item-p) | |
15793 | (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") | |
15794 | (replace-match "\\1- \\2"))) | |
15795 | (beginning-of-line 2))))))) | |
15796 | ||
15797 | (defun org-toggle-heading (&optional nstars) | |
15798 | "Convert headings to normal text, or items or text to headings. | |
15799 | If there is no active region, only the current line is considered. | |
15800 | ||
15801 | If the first line is a heading, remove the stars from all headlines | |
15802 | in the region. | |
15803 | ||
c8d0cf5c CD |
15804 | If the first line is a plain list item, turn all plain list items |
15805 | into headings. | |
0bd48b37 | 15806 | |
c8d0cf5c CD |
15807 | If the first line is a normal line, turn each and every line in the |
15808 | region into a heading. | |
0bd48b37 CD |
15809 | |
15810 | When converting a line into a heading, the number of stars is chosen | |
c8d0cf5c CD |
15811 | such that the lines become children of the current entry. However, |
15812 | when a prefix argument is given, its value determines the number of | |
15813 | stars to add." | |
0bd48b37 CD |
15814 | (interactive "P") |
15815 | (let (l2 l itemp beg end) | |
15816 | (if (org-region-active-p) | |
15817 | (setq beg (region-beginning) end (region-end)) | |
15818 | (setq beg (point-at-bol) | |
15819 | end (min (1+ (point-at-eol)) (point-max)))) | |
2a57416f CD |
15820 | (save-excursion |
15821 | (goto-char end) | |
15822 | (setq l2 (org-current-line)) | |
15823 | (goto-char beg) | |
15824 | (beginning-of-line 1) | |
15825 | (setq l (1- (org-current-line))) | |
15826 | (if (org-on-heading-p) | |
15827 | ;; We already have headlines, de-star them | |
15828 | (while (< (setq l (1+ l)) l2) | |
15829 | (when (org-on-heading-p t) | |
15830 | (and (looking-at outline-regexp) (replace-match ""))) | |
15831 | (beginning-of-line 2)) | |
0bd48b37 CD |
15832 | (setq itemp (org-at-item-p)) |
15833 | (let* ((stars | |
15834 | (if nstars | |
15835 | (make-string (prefix-numeric-value current-prefix-arg) | |
15836 | ?*) | |
15837 | (save-excursion | |
c8d0cf5c CD |
15838 | (if (re-search-backward org-complex-heading-regexp nil t) |
15839 | (match-string 1) "")))) | |
15840 | (add-stars (cond (nstars "") | |
15841 | ((equal stars "") "*") | |
15842 | (org-odd-levels-only "**") | |
15843 | (t "*"))) | |
0bd48b37 | 15844 | (rpl (concat stars add-stars " "))) |
2a57416f | 15845 | (while (< (setq l (1+ l)) l2) |
0bd48b37 CD |
15846 | (if itemp |
15847 | (and (org-at-item-p) (replace-match rpl t t)) | |
15848 | (unless (org-on-heading-p) | |
15849 | (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") | |
15850 | (replace-match (concat rpl (match-string 2)))))) | |
2a57416f | 15851 | (beginning-of-line 2))))))) |
5bf7807a | 15852 | |
791d856f | 15853 | (defun org-meta-return (&optional arg) |
28e5b051 CD |
15854 | "Insert a new heading or wrap a region in a table. |
15855 | Calls `org-insert-heading' or `org-table-wrap-region', depending on context. | |
15856 | See the individual commands for more information." | |
791d856f CD |
15857 | (interactive "P") |
15858 | (cond | |
c8d0cf5c | 15859 | ((run-hook-with-args-until-success 'org-metareturn-hook)) |
791d856f | 15860 | ((org-at-table-p) |
4b3a9ba7 CD |
15861 | (call-interactively 'org-table-wrap-region)) |
15862 | (t (call-interactively 'org-insert-heading)))) | |
891f4676 RS |
15863 | |
15864 | ;;; Menu entries | |
15865 | ||
891f4676 | 15866 | ;; Define the Org-mode menus |
9acdaa21 CD |
15867 | (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" |
15868 | '("Tbl" | |
20908596 | 15869 | ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] |
9acdaa21 CD |
15870 | ["Next Field" org-cycle (org-at-table-p)] |
15871 | ["Previous Field" org-shifttab (org-at-table-p)] | |
15872 | ["Next Row" org-return (org-at-table-p)] | |
15873 | "--" | |
15874 | ["Blank Field" org-table-blank-field (org-at-table-p)] | |
ab27a4a0 | 15875 | ["Edit Field" org-table-edit-field (org-at-table-p)] |
9acdaa21 CD |
15876 | ["Copy Field from Above" org-table-copy-down (org-at-table-p)] |
15877 | "--" | |
15878 | ("Column" | |
15879 | ["Move Column Left" org-metaleft (org-at-table-p)] | |
15880 | ["Move Column Right" org-metaright (org-at-table-p)] | |
15881 | ["Delete Column" org-shiftmetaleft (org-at-table-p)] | |
d3f4dbe8 | 15882 | ["Insert Column" org-shiftmetaright (org-at-table-p)]) |
9acdaa21 CD |
15883 | ("Row" |
15884 | ["Move Row Up" org-metaup (org-at-table-p)] | |
15885 | ["Move Row Down" org-metadown (org-at-table-p)] | |
15886 | ["Delete Row" org-shiftmetaup (org-at-table-p)] | |
15887 | ["Insert Row" org-shiftmetadown (org-at-table-p)] | |
e0e66b8e | 15888 | ["Sort lines in region" org-table-sort-lines (org-at-table-p)] |
9acdaa21 | 15889 | "--" |
38f8646b | 15890 | ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) |
9acdaa21 CD |
15891 | ("Rectangle" |
15892 | ["Copy Rectangle" org-copy-special (org-at-table-p)] | |
15893 | ["Cut Rectangle" org-cut-special (org-at-table-p)] | |
15894 | ["Paste Rectangle" org-paste-special (org-at-table-p)] | |
15895 | ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) | |
15896 | "--" | |
15897 | ("Calculate" | |
c4f9780e | 15898 | ["Set Column Formula" org-table-eval-formula (org-at-table-p)] |
d3f4dbe8 | 15899 | ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] |
b349f79f | 15900 | ["Edit Formulas" org-edit-special (org-at-table-p)] |
c4f9780e | 15901 | "--" |
9acdaa21 CD |
15902 | ["Recalculate line" org-table-recalculate (org-at-table-p)] |
15903 | ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] | |
d3f4dbe8 CD |
15904 | ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] |
15905 | "--" | |
9acdaa21 | 15906 | ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] |
c4f9780e | 15907 | "--" |
64f72ae1 | 15908 | ["Sum Column/Rectangle" org-table-sum |
9acdaa21 CD |
15909 | (or (org-at-table-p) (org-region-active-p))] |
15910 | ["Which Column?" org-table-current-column (org-at-table-p)]) | |
15911 | ["Debug Formulas" | |
d3f4dbe8 | 15912 | org-table-toggle-formula-debugger |
20908596 | 15913 | :style toggle :selected (org-bound-and-true-p org-table-formula-debug)] |
d3f4dbe8 CD |
15914 | ["Show Col/Row Numbers" |
15915 | org-table-toggle-coordinate-overlays | |
20908596 CD |
15916 | :style toggle |
15917 | :selected (org-bound-and-true-p org-table-overlay-coordinates)] | |
9acdaa21 | 15918 | "--" |
9acdaa21 | 15919 | ["Create" org-table-create (and (not (org-at-table-p)) |
c8d16429 | 15920 | org-enable-table-editor)] |
ab27a4a0 | 15921 | ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] |
9acdaa21 CD |
15922 | ["Import from File" org-table-import (not (org-at-table-p))] |
15923 | ["Export to File" org-table-export (org-at-table-p)] | |
15924 | "--" | |
15925 | ["Create/Convert from/to table.el" org-table-create-with-table.el t])) | |
15926 | ||
891f4676 RS |
15927 | (easy-menu-define org-org-menu org-mode-map "Org menu" |
15928 | '("Org" | |
3278a016 | 15929 | ("Show/Hide" |
20908596 CD |
15930 | ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] |
15931 | ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] | |
15932 | ["Sparse Tree..." org-sparse-tree t] | |
3278a016 | 15933 | ["Reveal Context" org-reveal t] |
d3f4dbe8 CD |
15934 | ["Show All" show-all t] |
15935 | "--" | |
15936 | ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) | |
891f4676 RS |
15937 | "--" |
15938 | ["New Heading" org-insert-heading t] | |
15939 | ("Navigate Headings" | |
15940 | ["Up" outline-up-heading t] | |
15941 | ["Next" outline-next-visible-heading t] | |
15942 | ["Previous" outline-previous-visible-heading t] | |
15943 | ["Next Same Level" outline-forward-same-level t] | |
15944 | ["Previous Same Level" outline-backward-same-level t] | |
15945 | "--" | |
374585c9 | 15946 | ["Jump" org-goto t]) |
891f4676 | 15947 | ("Edit Structure" |
35fb9989 CD |
15948 | ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))] |
15949 | ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))] | |
891f4676 RS |
15950 | "--" |
15951 | ["Copy Subtree" org-copy-special (not (org-at-table-p))] | |
15952 | ["Cut Subtree" org-cut-special (not (org-at-table-p))] | |
15953 | ["Paste Subtree" org-paste-special (not (org-at-table-p))] | |
15954 | "--" | |
c8d0cf5c CD |
15955 | ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] |
15956 | "--" | |
891f4676 RS |
15957 | ["Promote Heading" org-metaleft (not (org-at-table-p))] |
15958 | ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] | |
15959 | ["Demote Heading" org-metaright (not (org-at-table-p))] | |
30313b90 CD |
15960 | ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))] |
15961 | "--" | |
d3f4dbe8 CD |
15962 | ["Sort Region/Children" org-sort (not (org-at-table-p))] |
15963 | "--" | |
4ed31842 CD |
15964 | ["Convert to odd levels" org-convert-to-odd-levels t] |
15965 | ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) | |
a3fbe8c4 | 15966 | ("Editing" |
b349f79f | 15967 | ["Emphasis..." org-emphasize t] |
0bd48b37 CD |
15968 | ["Edit Source Example" org-edit-special t] |
15969 | "--" | |
15970 | ["Footnote new/jump" org-footnote-action t] | |
15971 | ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"]) | |
6769c0dc | 15972 | ("Archive" |
8bfe682a | 15973 | ["Archive (default method)" org-archive-subtree-default t] |
6769c0dc | 15974 | "--" |
8bfe682a CD |
15975 | ["Move Subtree to Archive file" org-advertized-archive-subtree t] |
15976 | ["Toggle ARCHIVE tag" org-toggle-archive-tag t] | |
15977 | ["Move subtree to Archive sibling" org-archive-to-archive-sibling t] | |
d3f4dbe8 | 15978 | ) |
891f4676 | 15979 | "--" |
c8d0cf5c CD |
15980 | ("Hyperlinks" |
15981 | ["Store Link (Global)" org-store-link t] | |
15982 | ["Find existing link to here" org-occur-link-in-agenda-files t] | |
15983 | ["Insert Link" org-insert-link t] | |
15984 | ["Follow Link" org-open-at-point t] | |
15985 | "--" | |
15986 | ["Next link" org-next-link t] | |
15987 | ["Previous link" org-previous-link t] | |
15988 | "--" | |
15989 | ["Descriptive Links" | |
15990 | (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) | |
15991 | :style radio | |
15992 | :selected (member '(org-link) buffer-invisibility-spec)] | |
15993 | ["Literal Links" | |
15994 | (progn | |
15995 | (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) | |
15996 | :style radio | |
15997 | :selected (not (member '(org-link) buffer-invisibility-spec))]) | |
15998 | "--" | |
35fb9989 | 15999 | ("TODO Lists" |
891f4676 | 16000 | ["TODO/DONE/-" org-todo t] |
5137195a CD |
16001 | ("Select keyword" |
16002 | ["Next keyword" org-shiftright (org-on-heading-p)] | |
16003 | ["Previous keyword" org-shiftleft (org-on-heading-p)] | |
a3fbe8c4 CD |
16004 | ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] |
16005 | ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] | |
16006 | ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) | |
891f4676 | 16007 | ["Show TODO Tree" org-show-todo-tree t] |
f425a6ea | 16008 | ["Global TODO list" org-todo-list t] |
891f4676 | 16009 | "--" |
a2a2e7fb CD |
16010 | ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) |
16011 | :selected org-enforce-todo-dependencies :style toggle :active t] | |
16012 | "Settings for tree at point" | |
16013 | ["Do Children sequentially" org-toggle-ordered-property :style radio | |
16014 | :selected (ignore-errors (org-entry-get nil "ORDERED")) | |
16015 | :active org-enforce-todo-dependencies :keys "C-c C-x o"] | |
16016 | ["Do Children parallel" org-toggle-ordered-property :style radio | |
16017 | :selected (ignore-errors (not (org-entry-get nil "ORDERED"))) | |
16018 | :active org-enforce-todo-dependencies :keys "C-c C-x o"] | |
16019 | "--" | |
35fb9989 CD |
16020 | ["Set Priority" org-priority t] |
16021 | ["Priority Up" org-shiftup t] | |
c8d0cf5c CD |
16022 | ["Priority Down" org-shiftdown t] |
16023 | "--" | |
16024 | ["Get news from all feeds" org-feed-update-all t] | |
16025 | ["Go to the inbox of a feed..." org-feed-goto-inbox t] | |
16026 | ["Customize feeds" (customize-variable 'org-feed-alist) t]) | |
38f8646b | 16027 | ("TAGS and Properties" |
579d2d62 | 16028 | ["Set Tags" org-set-tags-command t] |
fd8d5da9 | 16029 | ["Change tag in region" org-change-tag-in-region (org-region-active-p)] |
03f3cf35 | 16030 | "--" |
fd8d5da9 | 16031 | ["Set property" org-set-property t] |
03f3cf35 JW |
16032 | ["Column view of properties" org-columns t] |
16033 | ["Insert Column View DBlock" org-insert-columns-dblock t]) | |
891f4676 RS |
16034 | ("Dates and Scheduling" |
16035 | ["Timestamp" org-time-stamp t] | |
28e5b051 | 16036 | ["Timestamp (inactive)" org-time-stamp-inactive t] |
891f4676 | 16037 | ("Change Date" |
3278a016 CD |
16038 | ["1 Day Later" org-shiftright t] |
16039 | ["1 Day Earlier" org-shiftleft t] | |
35fb9989 CD |
16040 | ["1 ... Later" org-shiftup t] |
16041 | ["1 ... Earlier" org-shiftdown t]) | |
891f4676 RS |
16042 | ["Compute Time Range" org-evaluate-time-range t] |
16043 | ["Schedule Item" org-schedule t] | |
16044 | ["Deadline" org-deadline t] | |
16045 | "--" | |
3278a016 CD |
16046 | ["Custom time format" org-toggle-time-stamp-overlays |
16047 | :style radio :selected org-display-custom-times] | |
16048 | "--" | |
891f4676 | 16049 | ["Goto Calendar" org-goto-calendar t] |
ff4be292 CD |
16050 | ["Date from Calendar" org-date-from-calendar t] |
16051 | "--" | |
0bd48b37 CD |
16052 | ["Start/Restart Timer" org-timer-start t] |
16053 | ["Pause/Continue Timer" org-timer-pause-or-continue t] | |
16054 | ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"] | |
16055 | ["Insert Timer String" org-timer t] | |
16056 | ["Insert Timer Item" org-timer-item t]) | |
edd21304 | 16057 | ("Logging work" |
c8d0cf5c CD |
16058 | ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"] |
16059 | ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"] | |
edd21304 CD |
16060 | ["Clock out" org-clock-out t] |
16061 | ["Clock cancel" org-clock-cancel t] | |
c8d0cf5c CD |
16062 | "--" |
16063 | ["Mark as default task" org-clock-mark-default-task t] | |
16064 | ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"] | |
15841868 | 16065 | ["Goto running clock" org-clock-goto t] |
c8d0cf5c | 16066 | "--" |
edd21304 | 16067 | ["Display times" org-clock-display t] |
0fee8d6e | 16068 | ["Create clock table" org-clock-report t] |
edd21304 CD |
16069 | "--" |
16070 | ["Record DONE time" | |
16071 | (progn (setq org-log-done (not org-log-done)) | |
16072 | (message "Switching to %s will %s record a timestamp" | |
a3fbe8c4 | 16073 | (car org-done-keywords) |
edd21304 CD |
16074 | (if org-log-done "automatically" "not"))) |
16075 | :style toggle :selected org-log-done]) | |
891f4676 | 16076 | "--" |
3278a016 | 16077 | ["Agenda Command..." org-agenda t] |
8c6fb58b | 16078 | ["Set Restriction Lock" org-agenda-set-restriction-lock t] |
d924f2e5 CD |
16079 | ("File List for Agenda") |
16080 | ("Special views current file" | |
4da1a99d CD |
16081 | ["TODO Tree" org-show-todo-tree t] |
16082 | ["Check Deadlines" org-check-deadlines t] | |
16083 | ["Timeline" org-timeline t] | |
c8d0cf5c | 16084 | ["Tags/Property tree" org-match-sparse-tree t]) |
891f4676 | 16085 | "--" |
3278a016 | 16086 | ["Export/Publish..." org-export t] |
6769c0dc | 16087 | ("LaTeX" |
c44f0d75 | 16088 | ["Org CDLaTeX mode" org-cdlatex-mode :style toggle |
6769c0dc CD |
16089 | :selected org-cdlatex-mode] |
16090 | ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] | |
16091 | ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] | |
16092 | ["Modify math symbol" org-cdlatex-math-modify | |
16093 | (org-inside-LaTeX-fragment-p)] | |
c8d0cf5c CD |
16094 | ["Insert citation" org-reftex-citation t] |
16095 | "--" | |
6769c0dc | 16096 | ["Export LaTeX fragments as images" |
20908596 CD |
16097 | (if (featurep 'org-exp) |
16098 | (setq org-export-with-LaTeX-fragments | |
16099 | (not org-export-with-LaTeX-fragments)) | |
16100 | (require 'org-exp)) | |
16101 | :style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments) | |
16102 | org-export-with-LaTeX-fragments)]) | |
891f4676 | 16103 | "--" |
8d642074 CD |
16104 | ("MobileOrg" |
16105 | ["Push Files and Views" org-mobile-push t] | |
16106 | ["Get Captured and Flagged" org-mobile-pull t] | |
16107 | ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"] | |
16108 | "--" | |
16109 | ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) | |
16110 | "--" | |
891f4676 RS |
16111 | ("Documentation" |
16112 | ["Show Version" org-version t] | |
16113 | ["Info Documentation" org-info t]) | |
16114 | ("Customize" | |
16115 | ["Browse Org Group" org-customize t] | |
16116 | "--" | |
ab27a4a0 | 16117 | ["Expand This Menu" org-create-customize-menu |
891f4676 | 16118 | (fboundp 'customize-menu-create)]) |
54a0dee5 | 16119 | ["Send bug report" org-submit-bug-report t] |
28e5b051 | 16120 | "--" |
c8d0cf5c CD |
16121 | ("Refresh/Reload" |
16122 | ["Refresh setup current buffer" org-mode-restart t] | |
16123 | ["Reload Org (after update)" org-reload t] | |
16124 | ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x r"]) | |
891f4676 RS |
16125 | )) |
16126 | ||
891f4676 RS |
16127 | (defun org-info (&optional node) |
16128 | "Read documentation for Org-mode in the info system. | |
16129 | With optional NODE, go directly to that node." | |
16130 | (interactive) | |
74c52de1 | 16131 | (info (format "(org)%s" (or node "")))) |
891f4676 | 16132 | |
54a0dee5 CD |
16133 | ;;;###autoload |
16134 | (defun org-submit-bug-report () | |
16135 | "Submit a bug report on Org-mode via mail. | |
16136 | ||
16137 | Don't hesitate to report any problems or inaccurate documentation. | |
16138 | ||
16139 | If you don't have setup sending mail from (X)Emacs, please copy the | |
16140 | output buffer into your mail program, as it gives us important | |
16141 | information about your Org-mode version and configuration." | |
16142 | (interactive) | |
16143 | (require 'reporter) | |
16144 | (org-load-modules-maybe) | |
16145 | (org-require-autoloaded-modules) | |
16146 | (let ((reporter-prompt-for-summary-p "Bug report subject: ")) | |
16147 | (reporter-submit-bug-report | |
16148 | "emacs-orgmode@gnu.org" | |
16149 | (org-version) | |
16150 | (let (list) | |
16151 | (save-window-excursion | |
16152 | (switch-to-buffer (get-buffer-create "*Warn about privacy*")) | |
16153 | (delete-other-windows) | |
16154 | (erase-buffer) | |
16155 | (insert "You are about to submit a bug report to the Org-mode mailing list. | |
16156 | ||
16157 | We would like to add your full Org-mode and Outline configuration to the | |
16158 | bug report. This greatly simplifies the work of the maintainer and | |
16159 | other experts on the mailing list. | |
16160 | ||
16161 | HOWEVER, some variables you have customized may contain private | |
16162 | information. The names of customers, colleagues, or friends, might | |
16163 | appear in the form of file names, tags, todo states, or search strings. | |
16164 | If you answer yes to the prompt, you might want to check and remove | |
16165 | such private information before sending the email.") | |
16166 | (add-text-properties (point-min) (point-max) '(face org-warning)) | |
16167 | (when (yes-or-no-p "Include your Org-mode configuration ") | |
16168 | (mapatoms | |
16169 | (lambda (v) | |
16170 | (and (boundp v) | |
16171 | (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v)) | |
16172 | (or (and (symbol-value v) | |
16173 | (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v))) | |
16174 | (and | |
16175 | (get v 'custom-type) (get v 'standard-value) | |
16176 | (not (equal (symbol-value v) (eval (car (get v 'standard-value))))))) | |
16177 | (push v list))))) | |
16178 | (kill-buffer (get-buffer "*Warn about privacy*")) | |
16179 | list)) | |
16180 | nil nil | |
16181 | "Remember to cover the basics, that is, what you expected to happen and | |
16182 | what in fact did happen. You don't know how to make a good report? See | |
16183 | ||
16184 | http://orgmode.org/manual/Feedback.html#Feedback | |
16185 | ||
16186 | Your bug report will be posted to the Org-mode mailing list. | |
1bcdebed CD |
16187 | ------------------------------------------------------------------------") |
16188 | (save-excursion | |
16189 | (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) | |
16190 | (replace-match "\\1Bug: \\3 [\\2]"))))) | |
db4a7382 | 16191 | |
54a0dee5 | 16192 | |
891f4676 | 16193 | (defun org-install-agenda-files-menu () |
ab27a4a0 CD |
16194 | (let ((bl (buffer-list))) |
16195 | (save-excursion | |
16196 | (while bl | |
16197 | (set-buffer (pop bl)) | |
b928f99a CD |
16198 | (if (org-mode-p) (setq bl nil))) |
16199 | (when (org-mode-p) | |
ab27a4a0 CD |
16200 | (easy-menu-change |
16201 | '("Org") "File List for Agenda" | |
16202 | (append | |
16203 | (list | |
16204 | ["Edit File List" (org-edit-agenda-file-list) t] | |
16205 | ["Add/Move Current File to Front of List" org-agenda-file-to-front t] | |
16206 | ["Remove Current File from List" org-remove-file t] | |
16207 | ["Cycle through agenda files" org-cycle-agenda-files t] | |
15841868 | 16208 | ["Occur in all agenda files" org-occur-in-agenda-files t] |
ab27a4a0 CD |
16209 | "--") |
16210 | (mapcar 'org-file-menu-entry (org-agenda-files t)))))))) | |
891f4676 | 16211 | |
d3f4dbe8 | 16212 | ;;;; Documentation |
891f4676 | 16213 | |
b349f79f | 16214 | ;;;###autoload |
20908596 CD |
16215 | (defun org-require-autoloaded-modules () |
16216 | (interactive) | |
16217 | (mapc 'require | |
c8d0cf5c CD |
16218 | '(org-agenda org-archive org-ascii org-attach org-clock org-colview |
16219 | org-docbook org-exp org-html org-icalendar | |
16220 | org-id org-latex | |
16221 | org-publish org-remember org-table | |
16222 | org-timer org-xoxo))) | |
16223 | ||
16224 | ;;;###autoload | |
16225 | (defun org-reload (&optional uncompiled) | |
16226 | "Reload all org lisp files. | |
16227 | With prefix arg UNCOMPILED, load the uncompiled versions." | |
16228 | (interactive "P") | |
16229 | (require 'find-func) | |
16230 | (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)") | |
16231 | (dir-org (file-name-directory (org-find-library-name "org"))) | |
16232 | (dir-org-contrib (ignore-errors | |
16233 | (file-name-directory | |
16234 | (org-find-library-name "org-contribdir")))) | |
16235 | (files | |
16236 | (append (directory-files dir-org t file-re) | |
16237 | (and dir-org-contrib | |
16238 | (directory-files dir-org-contrib t file-re)))) | |
16239 | (remove-re (concat (if (featurep 'xemacs) | |
16240 | "org-colview" "org-colview-xemacs") | |
16241 | "\\'"))) | |
16242 | (setq files (mapcar 'file-name-sans-extension files)) | |
16243 | (setq files (mapcar | |
16244 | (lambda (x) (if (string-match remove-re x) nil x)) | |
16245 | files)) | |
16246 | (setq files (delq nil files)) | |
16247 | (mapc | |
16248 | (lambda (f) | |
16249 | (when (featurep (intern (file-name-nondirectory f))) | |
16250 | (if (and (not uncompiled) | |
16251 | (file-exists-p (concat f ".elc"))) | |
16252 | (load (concat f ".elc") nil nil t) | |
16253 | (load (concat f ".el") nil nil t)))) | |
16254 | files)) | |
16255 | (org-version)) | |
20908596 | 16256 | |
b349f79f | 16257 | ;;;###autoload |
891f4676 | 16258 | (defun org-customize () |
c8d16429 | 16259 | "Call the customize function with org as argument." |
891f4676 | 16260 | (interactive) |
20908596 CD |
16261 | (org-load-modules-maybe) |
16262 | (org-require-autoloaded-modules) | |
891f4676 RS |
16263 | (customize-browse 'org)) |
16264 | ||
16265 | (defun org-create-customize-menu () | |
16266 | "Create a full customization menu for Org-mode, insert it into the menu." | |
16267 | (interactive) | |
20908596 CD |
16268 | (org-load-modules-maybe) |
16269 | (org-require-autoloaded-modules) | |
891f4676 RS |
16270 | (if (fboundp 'customize-menu-create) |
16271 | (progn | |
16272 | (easy-menu-change | |
16273 | '("Org") "Customize" | |
16274 | `(["Browse Org group" org-customize t] | |
16275 | "--" | |
16276 | ,(customize-menu-create 'org) | |
16277 | ["Set" Custom-set t] | |
16278 | ["Save" Custom-save t] | |
16279 | ["Reset to Current" Custom-reset-current t] | |
16280 | ["Reset to Saved" Custom-reset-saved t] | |
16281 | ["Reset to Standard Settings" Custom-reset-standard t])) | |
16282 | (message "\"Org\"-menu now contains full customization menu")) | |
16283 | (error "Cannot expand menu (outdated version of cus-edit.el)"))) | |
16284 | ||
d3f4dbe8 CD |
16285 | ;;;; Miscellaneous stuff |
16286 | ||
d3f4dbe8 | 16287 | ;;; Generally useful functions |
891f4676 | 16288 | |
8d642074 CD |
16289 | (defun org-get-at-bol (property) |
16290 | "Get text property PROPERTY at beginning of line." | |
16291 | (get-text-property (point-at-bol) property)) | |
16292 | ||
db55f368 CD |
16293 | (defun org-find-text-property-in-string (prop s) |
16294 | "Return the first non-nil value of property PROP in string S." | |
16295 | (or (get-text-property 0 prop s) | |
16296 | (get-text-property (or (next-single-property-change 0 prop s) 0) | |
16297 | prop s))) | |
16298 | ||
b349f79f CD |
16299 | (defun org-display-warning (message) ;; Copied from Emacs-Muse |
16300 | "Display the given MESSAGE as a warning." | |
16301 | (if (fboundp 'display-warning) | |
16302 | (display-warning 'org message | |
16303 | (if (featurep 'xemacs) | |
16304 | 'warning | |
16305 | :warning)) | |
16306 | (let ((buf (get-buffer-create "*Org warnings*"))) | |
16307 | (with-current-buffer buf | |
16308 | (goto-char (point-max)) | |
16309 | (insert "Warning (Org): " message) | |
16310 | (unless (bolp) | |
16311 | (newline))) | |
16312 | (display-buffer buf) | |
16313 | (sit-for 0)))) | |
16314 | ||
54a0dee5 CD |
16315 | (defun org-in-commented-line () |
16316 | "Is point in a line starting with `#'?" | |
16317 | (equal (char-after (point-at-bol)) ?#)) | |
16318 | ||
8bfe682a CD |
16319 | (defun org-in-verbatim-emphasis () |
16320 | (save-match-data | |
16321 | (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~"))))) | |
16322 | ||
b349f79f | 16323 | (defun org-goto-marker-or-bmk (marker &optional bookmark) |
621f83e4 | 16324 | "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." |
b349f79f CD |
16325 | (if (and marker (marker-buffer marker) |
16326 | (buffer-live-p (marker-buffer marker))) | |
16327 | (progn | |
16328 | (switch-to-buffer (marker-buffer marker)) | |
16329 | (if (or (> marker (point-max)) (< marker (point-min))) | |
16330 | (widen)) | |
0bd48b37 CD |
16331 | (goto-char marker) |
16332 | (org-show-context 'org-goto)) | |
b349f79f CD |
16333 | (if bookmark |
16334 | (bookmark-jump bookmark) | |
16335 | (error "Cannot find location")))) | |
16336 | ||
16337 | (defun org-quote-csv-field (s) | |
16338 | "Quote field for inclusion in CSV material." | |
16339 | (if (string-match "[\",]" s) | |
16340 | (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") | |
16341 | s)) | |
16342 | ||
20908596 CD |
16343 | (defun org-plist-delete (plist property) |
16344 | "Delete PROPERTY from PLIST. | |
16345 | This is in contrast to merely setting it to 0." | |
16346 | (let (p) | |
16347 | (while plist | |
16348 | (if (not (eq property (car plist))) | |
16349 | (setq p (plist-put p (car plist) (nth 1 plist)))) | |
16350 | (setq plist (cddr plist))) | |
16351 | p)) | |
16352 | ||
16353 | (defun org-force-self-insert (N) | |
16354 | "Needed to enforce self-insert under remapping." | |
16355 | (interactive "p") | |
16356 | (self-insert-command N)) | |
16357 | ||
16358 | (defun org-string-width (s) | |
16359 | "Compute width of string, ignoring invisible characters. | |
16360 | This ignores character with invisibility property `org-link', and also | |
16361 | characters with property `org-cwidth', because these will become invisible | |
16362 | upon the next fontification round." | |
16363 | (let (b l) | |
16364 | (when (or (eq t buffer-invisibility-spec) | |
16365 | (assq 'org-link buffer-invisibility-spec)) | |
16366 | (while (setq b (text-property-any 0 (length s) | |
16367 | 'invisible 'org-link s)) | |
16368 | (setq s (concat (substring s 0 b) | |
16369 | (substring s (or (next-single-property-change | |
16370 | b 'invisible s) (length s))))))) | |
16371 | (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) | |
16372 | (setq s (concat (substring s 0 b) | |
16373 | (substring s (or (next-single-property-change | |
16374 | b 'org-cwidth s) (length s)))))) | |
16375 | (setq l (string-width s) b -1) | |
16376 | (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) | |
16377 | (setq l (- l (get-text-property b 'org-dwidth-n s)))) | |
16378 | l)) | |
16379 | ||
621f83e4 CD |
16380 | (defun org-get-indentation (&optional line) |
16381 | "Get the indentation of the current line, interpreting tabs. | |
16382 | When LINE is given, assume it represents a line and compute its indentation." | |
16383 | (if line | |
16384 | (if (string-match "^ *" (org-remove-tabs line)) | |
16385 | (match-end 0)) | |
16386 | (save-excursion | |
16387 | (beginning-of-line 1) | |
16388 | (skip-chars-forward " \t") | |
16389 | (current-column)))) | |
16390 | ||
16391 | (defun org-remove-tabs (s &optional width) | |
16392 | "Replace tabulators in S with spaces. | |
16393 | Assumes that s is a single line, starting in column 0." | |
16394 | (setq width (or width tab-width)) | |
16395 | (while (string-match "\t" s) | |
16396 | (setq s (replace-match | |
16397 | (make-string | |
16398 | (- (* width (/ (+ (match-beginning 0) width) width)) | |
16399 | (match-beginning 0)) ?\ ) | |
16400 | t t s))) | |
16401 | s) | |
16402 | ||
16403 | (defun org-fix-indentation (line ind) | |
16404 | "Fix indentation in LINE. | |
16405 | IND is a cons cell with target and minimum indentation. | |
33306645 | 16406 | If the current indentation in LINE is smaller than the minimum, |
621f83e4 CD |
16407 | leave it alone. If it is larger than ind, set it to the target." |
16408 | (let* ((l (org-remove-tabs line)) | |
16409 | (i (org-get-indentation l)) | |
16410 | (i1 (car ind)) (i2 (cdr ind))) | |
16411 | (if (>= i i2) (setq l (substring line i2))) | |
16412 | (if (> i1 0) | |
16413 | (concat (make-string i1 ?\ ) l) | |
16414 | l))) | |
16415 | ||
c8d0cf5c CD |
16416 | (defun org-remove-indentation (code &optional n) |
16417 | "Remove the maximum common indentation from the lines in CODE. | |
16418 | N may optionally be the number of spaces to remove." | |
16419 | (with-temp-buffer | |
16420 | (insert code) | |
16421 | (org-do-remove-indentation n) | |
16422 | (buffer-string))) | |
16423 | ||
16424 | (defun org-do-remove-indentation (&optional n) | |
16425 | "Remove the maximum common indentation from the buffer." | |
16426 | (untabify (point-min) (point-max)) | |
16427 | (let ((min 10000) re) | |
16428 | (if n | |
16429 | (setq min n) | |
16430 | (goto-char (point-min)) | |
16431 | (while (re-search-forward "^ *[^ \n]" nil t) | |
16432 | (setq min (min min (1- (- (match-end 0) (match-beginning 0))))))) | |
16433 | (unless (or (= min 0) (= min 10000)) | |
16434 | (setq re (format "^ \\{%d\\}" min)) | |
16435 | (goto-char (point-min)) | |
16436 | (while (re-search-forward re nil t) | |
16437 | (replace-match "") | |
16438 | (end-of-line 1)) | |
16439 | min))) | |
16440 | ||
8bfe682a CD |
16441 | (defun org-fill-template (template alist) |
16442 | "Find each %key of ALIST in TEMPLATE and replace it." | |
16443 | (let (entry key value) | |
16444 | (setq alist (sort (copy-sequence alist) | |
16445 | (lambda (a b) (< (length (car a)) (length (car b)))))) | |
16446 | (while (setq entry (pop alist)) | |
16447 | (setq template | |
16448 | (replace-regexp-in-string | |
16449 | (concat "%" (regexp-quote (car entry))) | |
16450 | (cdr entry) template t t))) | |
16451 | template)) | |
16452 | ||
b349f79f CD |
16453 | (defun org-base-buffer (buffer) |
16454 | "Return the base buffer of BUFFER, if it has one. Else return the buffer." | |
16455 | (if (not buffer) | |
16456 | buffer | |
16457 | (or (buffer-base-buffer buffer) | |
16458 | buffer))) | |
20908596 CD |
16459 | |
16460 | (defun org-trim (s) | |
16461 | "Remove whitespace at beginning and end of string." | |
16462 | (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) | |
16463 | (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) | |
16464 | s) | |
16465 | ||
16466 | (defun org-wrap (string &optional width lines) | |
16467 | "Wrap string to either a number of lines, or a width in characters. | |
16468 | If WIDTH is non-nil, the string is wrapped to that width, however many lines | |
16469 | that costs. If there is a word longer than WIDTH, the text is actually | |
16470 | wrapped to the length of that word. | |
16471 | IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | |
16472 | many lines, whatever width that takes. | |
16473 | The return value is a list of lines, without newlines at the end." | |
16474 | (let* ((words (org-split-string string "[ \t\n]+")) | |
16475 | (maxword (apply 'max (mapcar 'org-string-width words))) | |
16476 | w ll) | |
16477 | (cond (width | |
16478 | (org-do-wrap words (max maxword width))) | |
16479 | (lines | |
16480 | (setq w maxword) | |
16481 | (setq ll (org-do-wrap words maxword)) | |
16482 | (if (<= (length ll) lines) | |
16483 | ll | |
16484 | (setq ll words) | |
16485 | (while (> (length ll) lines) | |
16486 | (setq w (1+ w)) | |
16487 | (setq ll (org-do-wrap words w))) | |
16488 | ll)) | |
16489 | (t (error "Cannot wrap this"))))) | |
16490 | ||
16491 | (defun org-do-wrap (words width) | |
16492 | "Create lines of maximum width WIDTH (in characters) from word list WORDS." | |
16493 | (let (lines line) | |
16494 | (while words | |
16495 | (setq line (pop words)) | |
16496 | (while (and words (< (+ (length line) (length (car words))) width)) | |
16497 | (setq line (concat line " " (pop words)))) | |
16498 | (setq lines (push line lines))) | |
16499 | (nreverse lines))) | |
16500 | ||
16501 | (defun org-split-string (string &optional separators) | |
16502 | "Splits STRING into substrings at SEPARATORS. | |
16503 | No empty strings are returned if there are matches at the beginning | |
16504 | and end of string." | |
16505 | (let ((rexp (or separators "[ \f\t\n\r\v]+")) | |
16506 | (start 0) | |
16507 | notfirst | |
16508 | (list nil)) | |
16509 | (while (and (string-match rexp string | |
16510 | (if (and notfirst | |
16511 | (= start (match-beginning 0)) | |
16512 | (< start (length string))) | |
16513 | (1+ start) start)) | |
16514 | (< (match-beginning 0) (length string))) | |
16515 | (setq notfirst t) | |
16516 | (or (eq (match-beginning 0) 0) | |
16517 | (and (eq (match-beginning 0) (match-end 0)) | |
16518 | (eq (match-beginning 0) start)) | |
16519 | (setq list | |
16520 | (cons (substring string start (match-beginning 0)) | |
16521 | list))) | |
16522 | (setq start (match-end 0))) | |
16523 | (or (eq start (length string)) | |
16524 | (setq list | |
16525 | (cons (substring string start) | |
16526 | list))) | |
16527 | (nreverse list))) | |
16528 | ||
c8d0cf5c CD |
16529 | (defun org-quote-vert (s) |
16530 | "Replace \"|\" with \"\\vert\"." | |
16531 | (while (string-match "|" s) | |
16532 | (setq s (replace-match "\\vert" t t s))) | |
16533 | s) | |
16534 | ||
16535 | (defun org-uuidgen-p (s) | |
16536 | "Is S an ID created by UUIDGEN?" | |
16537 | (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) | |
16538 | ||
c4b5acde CD |
16539 | (defun org-context () |
16540 | "Return a list of contexts of the current cursor position. | |
16541 | If several contexts apply, all are returned. | |
16542 | Each context entry is a list with a symbol naming the context, and | |
16543 | two positions indicating start and end of the context. Possible | |
16544 | contexts are: | |
16545 | ||
16546 | :headline anywhere in a headline | |
16547 | :headline-stars on the leading stars in a headline | |
16548 | :todo-keyword on a TODO keyword (including DONE) in a headline | |
16549 | :tags on the TAGS in a headline | |
16550 | :priority on the priority cookie in a headline | |
16551 | :item on the first line of a plain list item | |
e39856be | 16552 | :item-bullet on the bullet/number of a plain list item |
c4b5acde CD |
16553 | :checkbox on the checkbox in a plain list item |
16554 | :table in an org-mode table | |
16555 | :table-special on a special filed in a table | |
16556 | :table-table in a table.el table | |
d3f4dbe8 | 16557 | :link on a hyperlink |
c4b5acde CD |
16558 | :keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE. |
16559 | :target on a <<target>> | |
16560 | :radio-target on a <<<radio-target>>> | |
e39856be CD |
16561 | :latex-fragment on a LaTeX fragment |
16562 | :latex-preview on a LaTeX fragment with overlayed preview image | |
c4b5acde CD |
16563 | |
16564 | This function expects the position to be visible because it uses font-lock | |
16565 | faces as a help to recognize the following contexts: :table-special, :link, | |
16566 | and :keyword." | |
16567 | (let* ((f (get-text-property (point) 'face)) | |
16568 | (faces (if (listp f) f (list f))) | |
e39856be | 16569 | (p (point)) clist o) |
c4b5acde CD |
16570 | ;; First the large context |
16571 | (cond | |
a3fbe8c4 | 16572 | ((org-on-heading-p t) |
c4b5acde CD |
16573 | (push (list :headline (point-at-bol) (point-at-eol)) clist) |
16574 | (when (progn | |
16575 | (beginning-of-line 1) | |
16576 | (looking-at org-todo-line-tags-regexp)) | |
16577 | (push (org-point-in-group p 1 :headline-stars) clist) | |
16578 | (push (org-point-in-group p 2 :todo-keyword) clist) | |
16579 | (push (org-point-in-group p 4 :tags) clist)) | |
16580 | (goto-char p) | |
8bfe682a | 16581 | (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1)) |
a3fbe8c4 | 16582 | (if (looking-at "\\[#[A-Z0-9]\\]") |
c4b5acde CD |
16583 | (push (org-point-in-group p 0 :priority) clist))) |
16584 | ||
16585 | ((org-at-item-p) | |
e39856be | 16586 | (push (org-point-in-group p 2 :item-bullet) clist) |
c4b5acde CD |
16587 | (push (list :item (point-at-bol) |
16588 | (save-excursion (org-end-of-item) (point))) | |
16589 | clist) | |
16590 | (and (org-at-item-checkbox-p) | |
16591 | (push (org-point-in-group p 0 :checkbox) clist))) | |
16592 | ||
16593 | ((org-at-table-p) | |
16594 | (push (list :table (org-table-begin) (org-table-end)) clist) | |
16595 | (if (memq 'org-formula faces) | |
16596 | (push (list :table-special | |
16597 | (previous-single-property-change p 'face) | |
16598 | (next-single-property-change p 'face)) clist))) | |
16599 | ((org-at-table-p 'any) | |
16600 | (push (list :table-table) clist))) | |
16601 | (goto-char p) | |
16602 | ||
16603 | ;; Now the small context | |
16604 | (cond | |
16605 | ((org-at-timestamp-p) | |
16606 | (push (org-point-in-group p 0 :timestamp) clist)) | |
16607 | ((memq 'org-link faces) | |
16608 | (push (list :link | |
16609 | (previous-single-property-change p 'face) | |
16610 | (next-single-property-change p 'face)) clist)) | |
16611 | ((memq 'org-special-keyword faces) | |
16612 | (push (list :keyword | |
16613 | (previous-single-property-change p 'face) | |
16614 | (next-single-property-change p 'face)) clist)) | |
16615 | ((org-on-target-p) | |
16616 | (push (org-point-in-group p 0 :target) clist) | |
16617 | (goto-char (1- (match-beginning 0))) | |
16618 | (if (looking-at org-radio-target-regexp) | |
16619 | (push (org-point-in-group p 0 :radio-target) clist)) | |
e39856be CD |
16620 | (goto-char p)) |
16621 | ((setq o (car (delq nil | |
c44f0d75 | 16622 | (mapcar |
e39856be CD |
16623 | (lambda (x) |
16624 | (if (memq x org-latex-fragment-image-overlays) x)) | |
16625 | (org-overlays-at (point)))))) | |
c44f0d75 | 16626 | (push (list :latex-fragment |
e39856be | 16627 | (org-overlay-start o) (org-overlay-end o)) clist) |
c44f0d75 | 16628 | (push (list :latex-preview |
e39856be CD |
16629 | (org-overlay-start o) (org-overlay-end o)) clist)) |
16630 | ((org-inside-LaTeX-fragment-p) | |
3278a016 | 16631 | ;; FIXME: positions wrong. |
e39856be | 16632 | (push (list :latex-fragment (point) (point)) clist))) |
c4b5acde CD |
16633 | |
16634 | (setq clist (nreverse (delq nil clist))) | |
16635 | clist)) | |
16636 | ||
15841868 | 16637 | ;; FIXME: Compare with at-regexp-p Do we need both? |
d3f4dbe8 CD |
16638 | (defun org-in-regexp (re &optional nlines visually) |
16639 | "Check if point is inside a match of regexp. | |
16640 | Normally only the current line is checked, but you can include NLINES extra | |
16641 | lines both before and after point into the search. | |
16642 | If VISUALLY is set, require that the cursor is not after the match but | |
16643 | really on, so that the block visually is on the match." | |
16644 | (catch 'exit | |
16645 | (let ((pos (point)) | |
16646 | (eol (point-at-eol (+ 1 (or nlines 0)))) | |
16647 | (inc (if visually 1 0))) | |
16648 | (save-excursion | |
16649 | (beginning-of-line (- 1 (or nlines 0))) | |
16650 | (while (re-search-forward re eol t) | |
a3fbe8c4 | 16651 | (if (and (<= (match-beginning 0) pos) |
d3f4dbe8 CD |
16652 | (>= (+ inc (match-end 0)) pos)) |
16653 | (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) | |
16654 | ||
a3fbe8c4 CD |
16655 | (defun org-at-regexp-p (regexp) |
16656 | "Is point inside a match of REGEXP in the current line?" | |
16657 | (catch 'exit | |
16658 | (save-excursion | |
16659 | (let ((pos (point)) (end (point-at-eol))) | |
16660 | (beginning-of-line 1) | |
16661 | (while (re-search-forward regexp end t) | |
16662 | (if (and (<= (match-beginning 0) pos) | |
16663 | (>= (match-end 0) pos)) | |
16664 | (throw 'exit t))) | |
16665 | nil)))) | |
16666 | ||
03f3cf35 | 16667 | (defun org-occur-in-agenda-files (regexp &optional nlines) |
15841868 | 16668 | "Call `multi-occur' with buffers for all agenda files." |
03f3cf35 JW |
16669 | (interactive "sOrg-files matching: \np") |
16670 | (let* ((files (org-agenda-files)) | |
16671 | (tnames (mapcar 'file-truename files)) | |
2a57416f | 16672 | (extra org-agenda-text-search-extra-files) |
03f3cf35 | 16673 | f) |
20908596 CD |
16674 | (when (eq (car extra) 'agenda-archives) |
16675 | (setq extra (cdr extra)) | |
16676 | (setq files (org-add-archive-files files))) | |
03f3cf35 JW |
16677 | (while (setq f (pop extra)) |
16678 | (unless (member (file-truename f) tnames) | |
16679 | (add-to-list 'files f 'append) | |
16680 | (add-to-list 'tnames (file-truename f) 'append))) | |
16681 | (multi-occur | |
5dec9555 CD |
16682 | (mapcar (lambda (x) |
16683 | (with-current-buffer | |
16684 | (or (get-file-buffer x) (find-file-noselect x)) | |
16685 | (widen) | |
16686 | (current-buffer))) | |
16687 | files) | |
03f3cf35 | 16688 | regexp))) |
15841868 | 16689 | |
2a57416f CD |
16690 | (if (boundp 'occur-mode-find-occurrence-hook) |
16691 | ;; Emacs 23 | |
16692 | (add-hook 'occur-mode-find-occurrence-hook | |
16693 | (lambda () | |
16694 | (when (org-mode-p) | |
16695 | (org-reveal)))) | |
16696 | ;; Emacs 22 | |
16697 | (defadvice occur-mode-goto-occurrence | |
16698 | (after org-occur-reveal activate) | |
16699 | (and (org-mode-p) (org-reveal))) | |
16700 | (defadvice occur-mode-goto-occurrence-other-window | |
16701 | (after org-occur-reveal activate) | |
16702 | (and (org-mode-p) (org-reveal))) | |
16703 | (defadvice occur-mode-display-occurrence | |
16704 | (after org-occur-reveal activate) | |
16705 | (when (org-mode-p) | |
16706 | (let ((pos (occur-mode-find-occurrence))) | |
16707 | (with-current-buffer (marker-buffer pos) | |
16708 | (save-excursion | |
16709 | (goto-char pos) | |
16710 | (org-reveal))))))) | |
16711 | ||
c8d0cf5c CD |
16712 | (defun org-occur-link-in-agenda-files () |
16713 | "Create a link and search for it in the agendas. | |
16714 | The link is not stored in `org-stored-links', it is just created | |
16715 | for the search purpose." | |
16716 | (interactive) | |
16717 | (let ((link (condition-case nil | |
16718 | (org-store-link nil) | |
16719 | (error "Unable to create a link to here")))) | |
16720 | (org-occur-in-agenda-files (regexp-quote link)))) | |
16721 | ||
a3fbe8c4 CD |
16722 | (defun org-uniquify (list) |
16723 | "Remove duplicate elements from LIST." | |
16724 | (let (res) | |
16725 | (mapc (lambda (x) (add-to-list 'res x 'append)) list) | |
16726 | res)) | |
16727 | ||
16728 | (defun org-delete-all (elts list) | |
16729 | "Remove all elements in ELTS from LIST." | |
16730 | (while elts | |
16731 | (setq list (delete (pop elts) list))) | |
16732 | list) | |
16733 | ||
8c6fb58b | 16734 | (defun org-back-over-empty-lines () |
33306645 | 16735 | "Move backwards over whitespace, to the beginning of the first empty line. |
5bf7807a | 16736 | Returns the number of empty lines passed." |
8c6fb58b CD |
16737 | (let ((pos (point))) |
16738 | (skip-chars-backward " \t\n\r") | |
16739 | (beginning-of-line 2) | |
16740 | (goto-char (min (point) pos)) | |
16741 | (count-lines (point) pos))) | |
16742 | ||
16743 | (defun org-skip-whitespace () | |
16744 | (skip-chars-forward " \t\n\r")) | |
16745 | ||
c4b5acde CD |
16746 | (defun org-point-in-group (point group &optional context) |
16747 | "Check if POINT is in match-group GROUP. | |
16748 | If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the | |
16749 | match. If the match group does ot exist or point is not inside it, | |
16750 | return nil." | |
16751 | (and (match-beginning group) | |
16752 | (>= point (match-beginning group)) | |
16753 | (<= point (match-end group)) | |
16754 | (if context | |
16755 | (list context (match-beginning group) (match-end group)) | |
16756 | t))) | |
16757 | ||
374585c9 CD |
16758 | (defun org-switch-to-buffer-other-window (&rest args) |
16759 | "Switch to buffer in a second window on the current frame. | |
16760 | In particular, do not allow pop-up frames." | |
16761 | (let (pop-up-frames special-display-buffer-names special-display-regexps | |
16762 | special-display-function) | |
16763 | (apply 'switch-to-buffer-other-window args))) | |
16764 | ||
d3f4dbe8 CD |
16765 | (defun org-combine-plists (&rest plists) |
16766 | "Create a single property list from all plists in PLISTS. | |
16767 | The process starts by copying the first list, and then setting properties | |
16768 | from the other lists. Settings in the last list are the most significant | |
16769 | ones and overrule settings in the other lists." | |
16770 | (let ((rtn (copy-sequence (pop plists))) | |
16771 | p v ls) | |
16772 | (while plists | |
16773 | (setq ls (pop plists)) | |
16774 | (while ls | |
16775 | (setq p (pop ls) v (pop ls)) | |
16776 | (setq rtn (plist-put rtn p v)))) | |
16777 | rtn)) | |
16778 | ||
891f4676 | 16779 | (defun org-move-line-down (arg) |
634a7d0b | 16780 | "Move the current line down. With prefix argument, move it past ARG lines." |
891f4676 RS |
16781 | (interactive "p") |
16782 | (let ((col (current-column)) | |
16783 | beg end pos) | |
16784 | (beginning-of-line 1) (setq beg (point)) | |
16785 | (beginning-of-line 2) (setq end (point)) | |
16786 | (beginning-of-line (+ 1 arg)) | |
16787 | (setq pos (move-marker (make-marker) (point))) | |
16788 | (insert (delete-and-extract-region beg end)) | |
16789 | (goto-char pos) | |
20908596 | 16790 | (org-move-to-column col))) |
891f4676 RS |
16791 | |
16792 | (defun org-move-line-up (arg) | |
634a7d0b | 16793 | "Move the current line up. With prefix argument, move it past ARG lines." |
891f4676 RS |
16794 | (interactive "p") |
16795 | (let ((col (current-column)) | |
16796 | beg end pos) | |
16797 | (beginning-of-line 1) (setq beg (point)) | |
16798 | (beginning-of-line 2) (setq end (point)) | |
634a7d0b | 16799 | (beginning-of-line (- arg)) |
891f4676 RS |
16800 | (setq pos (move-marker (make-marker) (point))) |
16801 | (insert (delete-and-extract-region beg end)) | |
16802 | (goto-char pos) | |
20908596 | 16803 | (org-move-to-column col))) |
891f4676 | 16804 | |
d3f4dbe8 CD |
16805 | (defun org-replace-escapes (string table) |
16806 | "Replace %-escapes in STRING with values in TABLE. | |
15841868 | 16807 | TABLE is an association list with keys like \"%a\" and string values. |
d3f4dbe8 CD |
16808 | The sequences in STRING may contain normal field width and padding information, |
16809 | for example \"%-5s\". Replacements happen in the sequence given by TABLE, | |
16810 | so values can contain further %-escapes if they are define later in TABLE." | |
16811 | (let ((case-fold-search nil) | |
a3fbe8c4 | 16812 | e re rpl) |
d3f4dbe8 CD |
16813 | (while (setq e (pop table)) |
16814 | (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) | |
16815 | (while (string-match re string) | |
16816 | (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") | |
16817 | (cdr e))) | |
16818 | (setq string (replace-match rpl t t string)))) | |
16819 | string)) | |
16820 | ||
16821 | ||
16822 | (defun org-sublist (list start end) | |
16823 | "Return a section of LIST, from START to END. | |
16824 | Counting starts at 1." | |
16825 | (let (rtn (c start)) | |
16826 | (setq list (nthcdr (1- start) list)) | |
16827 | (while (and list (<= c end)) | |
16828 | (push (pop list) rtn) | |
16829 | (setq c (1+ c))) | |
16830 | (nreverse rtn))) | |
16831 | ||
d3f4dbe8 | 16832 | (defun org-find-base-buffer-visiting (file) |
c8d0cf5c | 16833 | "Like `find-buffer-visiting' but always return the base buffer and |
5bf7807a | 16834 | not an indirect buffer." |
c8d0cf5c CD |
16835 | (let ((buf (or (get-file-buffer file) |
16836 | (find-buffer-visiting file)))) | |
15841868 JW |
16837 | (if buf |
16838 | (or (buffer-base-buffer buf) buf) | |
16839 | nil))) | |
d3f4dbe8 | 16840 | |
0bd48b37 CD |
16841 | (defun org-image-file-name-regexp (&optional extensions) |
16842 | "Return regexp matching the file names of images. | |
16843 | If EXTENSIONS is given, only match these." | |
16844 | (if (and (not extensions) (fboundp 'image-file-name-regexp)) | |
a3fbe8c4 CD |
16845 | (image-file-name-regexp) |
16846 | (let ((image-file-name-extensions | |
0bd48b37 CD |
16847 | (or extensions |
16848 | '("png" "jpeg" "jpg" "gif" "tiff" "tif" | |
16849 | "xbm" "xpm" "pbm" "pgm" "ppm")))) | |
a3fbe8c4 CD |
16850 | (concat "\\." |
16851 | (regexp-opt (nconc (mapcar 'upcase | |
16852 | image-file-name-extensions) | |
16853 | image-file-name-extensions) | |
16854 | t) | |
16855 | "\\'")))) | |
16856 | ||
0bd48b37 | 16857 | (defun org-file-image-p (file &optional extensions) |
a3fbe8c4 CD |
16858 | "Return non-nil if FILE is an image." |
16859 | (save-match-data | |
0bd48b37 | 16860 | (string-match (org-image-file-name-regexp extensions) file))) |
a3fbe8c4 | 16861 | |
b349f79f CD |
16862 | (defun org-get-cursor-date () |
16863 | "Return the date at cursor in as a time. | |
16864 | This works in the calendar and in the agenda, anywhere else it just | |
16865 | returns the current time." | |
16866 | (let (date day defd) | |
16867 | (cond | |
16868 | ((eq major-mode 'calendar-mode) | |
16869 | (setq date (calendar-cursor-to-date) | |
16870 | defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) | |
16871 | ((eq major-mode 'org-agenda-mode) | |
16872 | (setq day (get-text-property (point) 'day)) | |
16873 | (if day | |
16874 | (setq date (calendar-gregorian-from-absolute day) | |
16875 | defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) | |
16876 | (nth 2 date)))))) | |
16877 | (or defd (current-time)))) | |
16878 | ||
16879 | (defvar org-agenda-action-marker (make-marker) | |
16880 | "Marker pointing to the entry for the next agenda action.") | |
16881 | ||
16882 | (defun org-mark-entry-for-agenda-action () | |
16883 | "Mark the current entry as target of an agenda action. | |
16884 | Agenda actions are actions executed from the agenda with the key `k', | |
16885 | which make use of the date at the cursor." | |
16886 | (interactive) | |
16887 | (move-marker org-agenda-action-marker | |
16888 | (save-excursion (org-back-to-heading t) (point)) | |
16889 | (current-buffer)) | |
16890 | (message | |
16891 | "Entry marked for action; press `k' at desired date in agenda or calendar")) | |
16892 | ||
d3f4dbe8 | 16893 | ;;; Paragraph filling stuff. |
e0e66b8e | 16894 | ;; We want this to be just right, so use the full arsenal. |
a3fbe8c4 CD |
16895 | |
16896 | (defun org-indent-line-function () | |
16897 | "Indent line like previous, but further if previous was headline or item." | |
16898 | (interactive) | |
b38c6895 CD |
16899 | (let* ((pos (point)) |
16900 | (itemp (org-at-item-p)) | |
c8d0cf5c CD |
16901 | (case-fold-search t) |
16902 | (org-drawer-regexp (or org-drawer-regexp "\000")) | |
b38c6895 CD |
16903 | column bpos bcol tpos tcol bullet btype bullet-type) |
16904 | ;; Find the previous relevant line | |
16905 | (beginning-of-line 1) | |
16906 | (cond | |
16907 | ((looking-at "#") (setq column 0)) | |
5152b597 | 16908 | ((looking-at "\\*+ ") (setq column 0)) |
c8d0cf5c CD |
16909 | ((and (looking-at "[ \t]*:END:") |
16910 | (save-excursion (re-search-backward org-drawer-regexp nil t))) | |
16911 | (save-excursion | |
16912 | (goto-char (1- (match-beginning 1))) | |
16913 | (setq column (current-column)))) | |
16914 | ((and (looking-at "[ \t]+#\\+end_\\([a-z]+\\)") | |
16915 | (save-excursion | |
16916 | (re-search-backward | |
16917 | (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) | |
16918 | (setq column (org-get-indentation (match-string 0)))) | |
b38c6895 CD |
16919 | (t |
16920 | (beginning-of-line 0) | |
c8d0cf5c CD |
16921 | (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]") |
16922 | (not (looking-at "[ \t]*:END:")) | |
16923 | (not (looking-at org-drawer-regexp))) | |
b38c6895 CD |
16924 | (beginning-of-line 0)) |
16925 | (cond | |
16926 | ((looking-at "\\*+[ \t]+") | |
b349f79f CD |
16927 | (if (not org-adapt-indentation) |
16928 | (setq column 0) | |
16929 | (goto-char (match-end 0)) | |
16930 | (setq column (current-column)))) | |
c8d0cf5c CD |
16931 | ((looking-at org-drawer-regexp) |
16932 | (goto-char (1- (match-beginning 1))) | |
16933 | (setq column (current-column))) | |
16934 | ((looking-at "\\([ \t]*\\):END:") | |
16935 | (goto-char (match-end 1)) | |
16936 | (setq column (current-column))) | |
b38c6895 CD |
16937 | ((org-in-item-p) |
16938 | (org-beginning-of-item) | |
b349f79f | 16939 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") |
b38c6895 CD |
16940 | (setq bpos (match-beginning 1) tpos (match-end 0) |
16941 | bcol (progn (goto-char bpos) (current-column)) | |
16942 | tcol (progn (goto-char tpos) (current-column)) | |
16943 | bullet (match-string 1) | |
16944 | bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) | |
b349f79f CD |
16945 | (if (> tcol (+ bcol org-description-max-indent)) |
16946 | (setq tcol (+ bcol 5))) | |
b38c6895 CD |
16947 | (if (not itemp) |
16948 | (setq column tcol) | |
16949 | (goto-char pos) | |
16950 | (beginning-of-line 1) | |
8c6fb58b CD |
16951 | (if (looking-at "\\S-") |
16952 | (progn | |
16953 | (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") | |
16954 | (setq bullet (match-string 1) | |
16955 | btype (if (string-match "[0-9]" bullet) "n" bullet)) | |
16956 | (setq column (if (equal btype bullet-type) bcol tcol))) | |
16957 | (setq column (org-get-indentation))))) | |
b38c6895 CD |
16958 | (t (setq column (org-get-indentation)))))) |
16959 | (goto-char pos) | |
a3fbe8c4 | 16960 | (if (<= (current-column) (current-indentation)) |
20908596 CD |
16961 | (org-indent-line-to column) |
16962 | (save-excursion (org-indent-line-to column))) | |
38f8646b CD |
16963 | (setq column (current-column)) |
16964 | (beginning-of-line 1) | |
16965 | (if (looking-at | |
8c6fb58b | 16966 | "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") |
8bfe682a CD |
16967 | (replace-match (concat (match-string 1) |
16968 | (format org-property-format | |
16969 | (match-string 2) (match-string 3))) | |
16970 | t t)) | |
20908596 | 16971 | (org-move-to-column column))) |
e0e66b8e CD |
16972 | |
16973 | (defun org-set-autofill-regexps () | |
16974 | (interactive) | |
16975 | ;; In the paragraph separator we include headlines, because filling | |
16976 | ;; text in a line directly attached to a headline would otherwise | |
16977 | ;; fill the headline as well. | |
5137195a | 16978 | (org-set-local 'comment-start-skip "^#+[ \t]*") |
8d642074 | 16979 | (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|#]") |
e0e66b8e | 16980 | ;; The paragraph starter includes hand-formatted lists. |
c8d0cf5c CD |
16981 | (org-set-local |
16982 | 'paragraph-start | |
16983 | (concat | |
16984 | "\f" "\\|" | |
16985 | "[ ]*$" "\\|" | |
16986 | "\\*+ " "\\|" | |
8d642074 | 16987 | "[ \t]*#" "\\|" |
c8d0cf5c CD |
16988 | "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)" "\\|" |
16989 | "[ \t]*[:|]" "\\|" | |
16990 | "\\$\\$" "\\|" | |
16991 | "\\\\\\(begin\\|end\\|[][]\\)")) | |
e0e66b8e CD |
16992 | ;; Inhibit auto-fill for headers, tables and fixed-width lines. |
16993 | ;; But only if the user has not turned off tables or fixed-width regions | |
5137195a CD |
16994 | (org-set-local |
16995 | 'auto-fill-inhibit-regexp | |
7d58338e | 16996 | (concat "\\*+ \\|#\\+" |
5137195a CD |
16997 | "\\|[ \t]*" org-keyword-time-regexp |
16998 | (if (or org-enable-table-editor org-enable-fixed-width-editor) | |
16999 | (concat | |
17000 | "\\|[ \t]*[" | |
17001 | (if org-enable-table-editor "|" "") | |
17002 | (if org-enable-fixed-width-editor ":" "") | |
17003 | "]")))) | |
e0e66b8e CD |
17004 | ;; We use our own fill-paragraph function, to make sure that tables |
17005 | ;; and fixed-width regions are not wrapped. That function will pass | |
17006 | ;; through to `fill-paragraph' when appropriate. | |
5137195a CD |
17007 | (org-set-local 'fill-paragraph-function 'org-fill-paragraph) |
17008 | ; Adaptive filling: To get full control, first make sure that | |
6eff18ef | 17009 | ;; `adaptive-fill-regexp' never matches. Then install our own matcher. |
5137195a CD |
17010 | (org-set-local 'adaptive-fill-regexp "\000") |
17011 | (org-set-local 'adaptive-fill-function | |
2a57416f CD |
17012 | 'org-adaptive-fill-function) |
17013 | (org-set-local | |
17014 | 'align-mode-rules-list | |
17015 | '((org-in-buffer-settings | |
17016 | (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") | |
17017 | (modes . '(org-mode)))))) | |
e0e66b8e CD |
17018 | |
17019 | (defun org-fill-paragraph (&optional justify) | |
17020 | "Re-align a table, pass through to fill-paragraph if no table." | |
17021 | (let ((table-p (org-at-table-p)) | |
17022 | (table.el-p (org-at-table.el-p))) | |
8c6fb58b CD |
17023 | (cond ((and (equal (char-after (point-at-bol)) ?*) |
17024 | (save-excursion (goto-char (point-at-bol)) | |
17025 | (looking-at outline-regexp))) | |
17026 | t) ; skip headlines | |
17027 | (table.el-p t) ; skip table.el tables | |
17028 | (table-p (org-table-align) t) ; align org-mode tables | |
17029 | (t nil)))) ; call paragraph-fill | |
e0e66b8e CD |
17030 | |
17031 | ;; For reference, this is the default value of adaptive-fill-regexp | |
17032 | ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" | |
17033 | ||
17034 | (defun org-adaptive-fill-function () | |
17035 | "Return a fill prefix for org-mode files. | |
17036 | In particular, this makes sure hanging paragraphs for hand-formatted lists | |
17037 | work correctly." | |
d3f4dbe8 CD |
17038 | (cond ((looking-at "#[ \t]+") |
17039 | (match-string 0)) | |
b349f79f CD |
17040 | ((looking-at "[ \t]*\\([-*+] .*? :: \\)") |
17041 | (save-excursion | |
17042 | (if (> (match-end 1) (+ (match-beginning 1) | |
17043 | org-description-max-indent)) | |
17044 | (goto-char (+ (match-beginning 1) 5)) | |
17045 | (goto-char (match-end 0))) | |
17046 | (make-string (current-column) ?\ ))) | |
ce4fdcb9 | 17047 | ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] ?\\)?") |
a3fbe8c4 CD |
17048 | (save-excursion |
17049 | (goto-char (match-end 0)) | |
17050 | (make-string (current-column) ?\ ))) | |
d3f4dbe8 | 17051 | (t nil))) |
891f4676 | 17052 | |
20908596 CD |
17053 | ;;; Other stuff. |
17054 | ||
17055 | (defun org-toggle-fixed-width-section (arg) | |
17056 | "Toggle the fixed-width export. | |
17057 | If there is no active region, the QUOTE keyword at the current headline is | |
17058 | inserted or removed. When present, it causes the text between this headline | |
17059 | and the next to be exported as fixed-width text, and unmodified. | |
17060 | If there is an active region, this command adds or removes a colon as the | |
17061 | first character of this line. If the first character of a line is a colon, | |
17062 | this line is also exported in fixed-width font." | |
17063 | (interactive "P") | |
17064 | (let* ((cc 0) | |
17065 | (regionp (org-region-active-p)) | |
17066 | (beg (if regionp (region-beginning) (point))) | |
17067 | (end (if regionp (region-end))) | |
17068 | (nlines (or arg (if (and beg end) (count-lines beg end) 1))) | |
17069 | (case-fold-search nil) | |
c8d0cf5c | 17070 | (re "[ \t]*\\(: \\)") |
20908596 CD |
17071 | off) |
17072 | (if regionp | |
17073 | (save-excursion | |
17074 | (goto-char beg) | |
17075 | (setq cc (current-column)) | |
17076 | (beginning-of-line 1) | |
17077 | (setq off (looking-at re)) | |
17078 | (while (> nlines 0) | |
17079 | (setq nlines (1- nlines)) | |
17080 | (beginning-of-line 1) | |
17081 | (cond | |
17082 | (arg | |
17083 | (org-move-to-column cc t) | |
c8d0cf5c | 17084 | (insert ": \n") |
20908596 CD |
17085 | (forward-line -1)) |
17086 | ((and off (looking-at re)) | |
17087 | (replace-match "" t t nil 1)) | |
c8d0cf5c | 17088 | ((not off) (org-move-to-column cc t) (insert ": "))) |
20908596 CD |
17089 | (forward-line 1))) |
17090 | (save-excursion | |
17091 | (org-back-to-heading) | |
17092 | (if (looking-at (concat outline-regexp | |
17093 | "\\( *\\<" org-quote-string "\\>[ \t]*\\)")) | |
17094 | (replace-match "" t t nil 1) | |
17095 | (if (looking-at outline-regexp) | |
17096 | (progn | |
17097 | (goto-char (match-end 0)) | |
17098 | (insert org-quote-string " ")))))))) | |
891f4676 | 17099 | |
c8d0cf5c CD |
17100 | (defun org-reftex-citation () |
17101 | "Use reftex-citation to insert a citation into the buffer. | |
17102 | This looks for a line like | |
17103 | ||
17104 | #+BIBLIOGRAPHY: foo plain option:-d | |
17105 | ||
8bfe682a | 17106 | and derives from it that foo.bib is the bibliography file relevant |
c8d0cf5c CD |
17107 | for this document. It then installs the necessary environment for RefTeX |
17108 | to work in this buffer and calls `reftex-citation' to insert a citation | |
17109 | into the buffer. | |
17110 | ||
17111 | Export of such citations to both LaTeX and HTML is handled by the contributed | |
17112 | package org-exp-bibtex by Taru Karttunen." | |
17113 | (interactive) | |
17114 | (let ((reftex-docstruct-symbol 'rds) | |
17115 | (reftex-cite-format "\\cite{%l}") | |
17116 | rds bib) | |
17117 | (save-excursion | |
17118 | (save-restriction | |
17119 | (widen) | |
17120 | (let ((case-fold-search t) | |
17121 | (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)")) | |
17122 | (if (not (save-excursion | |
17123 | (or (re-search-forward re nil t) | |
17124 | (re-search-backward re nil t)))) | |
17125 | (error "No bibliography defined in file") | |
17126 | (setq bib (concat (match-string 1) ".bib") | |
17127 | rds (list (list 'bib bib))))))) | |
17128 | (call-interactively 'reftex-citation))) | |
17129 | ||
20908596 | 17130 | ;;;; Functions extending outline functionality |
2a57416f | 17131 | |
1e8fbb6d | 17132 | (defun org-beginning-of-line (&optional arg) |
891f4676 | 17133 | "Go to the beginning of the current line. If that is invisible, continue |
1e8fbb6d CD |
17134 | to a visible line beginning. This makes the function of C-a more intuitive. |
17135 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
17136 | first attempt, and only move to after the tags when the cursor is already | |
17137 | beyond the end of the headline." | |
17138 | (interactive "P") | |
c8d0cf5c CD |
17139 | (let ((pos (point)) |
17140 | (special (if (consp org-special-ctrl-a/e) | |
17141 | (car org-special-ctrl-a/e) | |
17142 | org-special-ctrl-a/e)) | |
17143 | refpos) | |
17144 | (if (org-bound-and-true-p line-move-visual) | |
17145 | (beginning-of-visual-line 1) | |
17146 | (beginning-of-line 1)) | |
7b96ff9a CD |
17147 | (if (and arg (fboundp 'move-beginning-of-line)) |
17148 | (call-interactively 'move-beginning-of-line) | |
17149 | (if (bobp) | |
17150 | nil | |
17151 | (backward-char 1) | |
17152 | (if (org-invisible-p) | |
17153 | (while (and (not (bobp)) (org-invisible-p)) | |
17154 | (backward-char 1) | |
17155 | (beginning-of-line 1)) | |
17156 | (forward-char 1)))) | |
c8d0cf5c | 17157 | (when special |
48aaad2d | 17158 | (cond |
b349f79f | 17159 | ((and (looking-at org-complex-heading-regexp) |
48aaad2d | 17160 | (= (char-after (match-end 1)) ?\ )) |
b349f79f CD |
17161 | (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) |
17162 | (point-at-eol))) | |
48aaad2d | 17163 | (goto-char |
c8d0cf5c | 17164 | (if (eq special t) |
b349f79f CD |
17165 | (cond ((> pos refpos) refpos) |
17166 | ((= pos (point)) refpos) | |
374585c9 CD |
17167 | (t (point))) |
17168 | (cond ((> pos (point)) (point)) | |
17169 | ((not (eq last-command this-command)) (point)) | |
b349f79f | 17170 | (t refpos))))) |
48aaad2d CD |
17171 | ((org-at-item-p) |
17172 | (goto-char | |
c8d0cf5c | 17173 | (if (eq special t) |
374585c9 CD |
17174 | (cond ((> pos (match-end 4)) (match-end 4)) |
17175 | ((= pos (point)) (match-end 4)) | |
17176 | (t (point))) | |
17177 | (cond ((> pos (point)) (point)) | |
17178 | ((not (eq last-command this-command)) (point)) | |
b349f79f CD |
17179 | (t (match-end 4)))))))) |
17180 | (org-no-warnings | |
17181 | (and (featurep 'xemacs) (setq zmacs-region-stays t))))) | |
04d18304 | 17182 | |
1e8fbb6d CD |
17183 | (defun org-end-of-line (&optional arg) |
17184 | "Go to the end of the line. | |
17185 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
17186 | first attempt, and only move to after the tags when the cursor is already | |
17187 | beyond the end of the headline." | |
17188 | (interactive "P") | |
c8d0cf5c CD |
17189 | (let ((special (if (consp org-special-ctrl-a/e) |
17190 | (cdr org-special-ctrl-a/e) | |
17191 | org-special-ctrl-a/e))) | |
17192 | (if (or (not special) | |
17193 | (not (org-on-heading-p)) | |
17194 | arg) | |
17195 | (call-interactively | |
17196 | (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line) | |
17197 | ((fboundp 'move-end-of-line) 'move-end-of-line) | |
17198 | (t 'end-of-line))) | |
17199 | (let ((pos (point))) | |
17200 | (beginning-of-line 1) | |
8d642074 | 17201 | (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\)?$")) |
c8d0cf5c CD |
17202 | (if (eq special t) |
17203 | (if (or (< pos (match-beginning 1)) | |
17204 | (= pos (match-end 0))) | |
17205 | (goto-char (match-beginning 1)) | |
17206 | (goto-char (match-end 0))) | |
17207 | (if (or (< pos (match-end 0)) (not (eq this-command last-command))) | |
17208 | (goto-char (match-end 0)) | |
17209 | (goto-char (match-beginning 1)))) | |
17210 | (call-interactively (if (fboundp 'move-end-of-line) | |
17211 | 'move-end-of-line | |
17212 | 'end-of-line))))) | |
17213 | (org-no-warnings | |
17214 | (and (featurep 'xemacs) (setq zmacs-region-stays t))))) | |
b349f79f | 17215 | |
5137195a | 17216 | (define-key org-mode-map "\C-a" 'org-beginning-of-line) |
1e8fbb6d | 17217 | (define-key org-mode-map "\C-e" 'org-end-of-line) |
8d642074 CD |
17218 | (define-key org-mode-map [home] 'org-beginning-of-line) |
17219 | (define-key org-mode-map [end] 'org-end-of-line) | |
891f4676 | 17220 | |
c8d0cf5c CD |
17221 | (defun org-backward-sentence (&optional arg) |
17222 | "Go to beginning of sentence, or beginning of table field. | |
17223 | This will call `backward-sentence' or `org-table-beginning-of-field', | |
17224 | depending on context." | |
17225 | (interactive "P") | |
17226 | (cond | |
17227 | ((org-at-table-p) (call-interactively 'org-table-beginning-of-field)) | |
17228 | (t (call-interactively 'backward-sentence)))) | |
17229 | ||
17230 | (defun org-forward-sentence (&optional arg) | |
17231 | "Go to end of sentence, or end of table field. | |
17232 | This will call `forward-sentence' or `org-table-end-of-field', | |
17233 | depending on context." | |
17234 | (interactive "P") | |
17235 | (cond | |
17236 | ((org-at-table-p) (call-interactively 'org-table-end-of-field)) | |
17237 | (t (call-interactively 'forward-sentence)))) | |
17238 | ||
17239 | (define-key org-mode-map "\M-a" 'org-backward-sentence) | |
17240 | (define-key org-mode-map "\M-e" 'org-forward-sentence) | |
17241 | ||
2a57416f CD |
17242 | (defun org-kill-line (&optional arg) |
17243 | "Kill line, to tags or end of line." | |
17244 | (interactive "P") | |
17245 | (cond | |
17246 | ((or (not org-special-ctrl-k) | |
17247 | (bolp) | |
17248 | (not (org-on-heading-p))) | |
17249 | (call-interactively 'kill-line)) | |
17250 | ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")) | |
17251 | (kill-region (point) (match-beginning 1)) | |
17252 | (org-set-tags nil t)) | |
17253 | (t (kill-region (point) (point-at-eol))))) | |
17254 | ||
17255 | (define-key org-mode-map "\C-k" 'org-kill-line) | |
17256 | ||
93b62de8 CD |
17257 | (defun org-yank (&optional arg) |
17258 | "Yank. If the kill is a subtree, treat it specially. | |
17259 | This command will look at the current kill and check if is a single | |
17260 | subtree, or a series of subtrees[1]. If it passes the test, and if the | |
17261 | cursor is at the beginning of a line or after the stars of a currently | |
33306645 | 17262 | empty headline, then the yank is handled specially. How exactly depends |
93b62de8 CD |
17263 | on the value of the following variables, both set by default. |
17264 | ||
17265 | org-yank-folded-subtrees | |
33306645 | 17266 | When set, the subtree(s) will be folded after insertion, but only |
93b62de8 CD |
17267 | if doing so would now swallow text after the yanked text. |
17268 | ||
17269 | org-yank-adjusted-subtrees | |
17270 | When set, the subtree will be promoted or demoted in order to | |
17271 | fit into the local outline tree structure, which means that the level | |
17272 | will be adjusted so that it becomes the smaller one of the two | |
17273 | *visible* surrounding headings. | |
17274 | ||
17275 | Any prefix to this command will cause `yank' to be called directly with | |
17276 | no special treatment. In particular, a simple `C-u' prefix will just | |
17277 | plainly yank the text as it is. | |
17278 | ||
c8d0cf5c | 17279 | \[1] The test checks if the first non-white line is a heading |
93b62de8 CD |
17280 | and if there are no other headings with fewer stars." |
17281 | (interactive "P") | |
c8d0cf5c CD |
17282 | (org-yank-generic 'yank arg)) |
17283 | ||
17284 | (defun org-yank-generic (command arg) | |
17285 | "Perform some yank-like command. | |
17286 | ||
17287 | This function implements the behavior described in the `org-yank' | |
17288 | documentation. However, it has been generalized to work for any | |
17289 | interactive command with similar behavior." | |
17290 | ||
17291 | ;; pretend to be command COMMAND | |
17292 | (setq this-command command) | |
17293 | ||
93b62de8 | 17294 | (if arg |
c8d0cf5c CD |
17295 | (call-interactively command) |
17296 | ||
93b62de8 CD |
17297 | (let ((subtreep ; is kill a subtree, and the yank position appropriate? |
17298 | (and (org-kill-is-subtree-p) | |
17299 | (or (bolp) | |
17300 | (and (looking-at "[ \t]*$") | |
ce4fdcb9 | 17301 | (string-match |
93b62de8 CD |
17302 | "\\`\\*+\\'" |
17303 | (buffer-substring (point-at-bol) (point))))))) | |
17304 | swallowp) | |
17305 | (cond | |
17306 | ((and subtreep org-yank-folded-subtrees) | |
17307 | (let ((beg (point)) | |
17308 | end) | |
17309 | (if (and subtreep org-yank-adjusted-subtrees) | |
17310 | (org-paste-subtree nil nil 'for-yank) | |
c8d0cf5c CD |
17311 | (call-interactively command)) |
17312 | ||
93b62de8 CD |
17313 | (setq end (point)) |
17314 | (goto-char beg) | |
17315 | (when (and (bolp) subtreep | |
17316 | (not (setq swallowp | |
17317 | (org-yank-folding-would-swallow-text beg end)))) | |
17318 | (or (looking-at outline-regexp) | |
17319 | (re-search-forward (concat "^" outline-regexp) end t)) | |
17320 | (while (and (< (point) end) (looking-at outline-regexp)) | |
17321 | (hide-subtree) | |
17322 | (org-cycle-show-empty-lines 'folded) | |
17323 | (condition-case nil | |
17324 | (outline-forward-same-level 1) | |
17325 | (error (goto-char end))))) | |
17326 | (when swallowp | |
17327 | (message | |
c8d0cf5c CD |
17328 | "Inserted text not folded because that would swallow text")) |
17329 | ||
93b62de8 CD |
17330 | (goto-char end) |
17331 | (skip-chars-forward " \t\n\r") | |
ce4fdcb9 CD |
17332 | (beginning-of-line 1) |
17333 | (push-mark beg 'nomsg))) | |
93b62de8 | 17334 | ((and subtreep org-yank-adjusted-subtrees) |
ce4fdcb9 CD |
17335 | (let ((beg (point-at-bol))) |
17336 | (org-paste-subtree nil nil 'for-yank) | |
17337 | (push-mark beg 'nomsg))) | |
93b62de8 | 17338 | (t |
c8d0cf5c | 17339 | (call-interactively command)))))) |
ce4fdcb9 | 17340 | |
93b62de8 CD |
17341 | (defun org-yank-folding-would-swallow-text (beg end) |
17342 | "Would hide-subtree at BEG swallow any text after END?" | |
17343 | (let (level) | |
17344 | (save-excursion | |
17345 | (goto-char beg) | |
17346 | (when (or (looking-at outline-regexp) | |
17347 | (re-search-forward (concat "^" outline-regexp) end t)) | |
17348 | (setq level (org-outline-level))) | |
17349 | (goto-char end) | |
17350 | (skip-chars-forward " \t\r\n\v\f") | |
17351 | (if (or (eobp) | |
17352 | (and (bolp) (looking-at org-outline-regexp) | |
17353 | (<= (org-outline-level) level))) | |
17354 | nil ; Nothing would be swallowed | |
17355 | t)))) ; something would swallow | |
621f83e4 CD |
17356 | |
17357 | (define-key org-mode-map "\C-y" 'org-yank) | |
17358 | ||
891f4676 RS |
17359 | (defun org-invisible-p () |
17360 | "Check if point is at a character currently not visible." | |
5137195a CD |
17361 | ;; Early versions of noutline don't have `outline-invisible-p'. |
17362 | (if (fboundp 'outline-invisible-p) | |
17363 | (outline-invisible-p) | |
17364 | (get-char-property (point) 'invisible))) | |
891f4676 | 17365 | |
a96ee7df CD |
17366 | (defun org-invisible-p2 () |
17367 | "Check if point is at a character currently not visible." | |
17368 | (save-excursion | |
5137195a CD |
17369 | (if (and (eolp) (not (bobp))) (backward-char 1)) |
17370 | ;; Early versions of noutline don't have `outline-invisible-p'. | |
17371 | (if (fboundp 'outline-invisible-p) | |
17372 | (outline-invisible-p) | |
17373 | (get-char-property (point) 'invisible)))) | |
17374 | ||
ce4fdcb9 CD |
17375 | (defun org-back-to-heading (&optional invisible-ok) |
17376 | "Call `outline-back-to-heading', but provide a better error message." | |
17377 | (condition-case nil | |
17378 | (outline-back-to-heading invisible-ok) | |
17379 | (error (error "Before first headline at position %d in buffer %s" | |
17380 | (point) (current-buffer))))) | |
17381 | ||
db55f368 CD |
17382 | (defun org-before-first-heading-p () |
17383 | "Before first heading?" | |
17384 | (save-excursion | |
17385 | (null (re-search-backward "^\\*+ " nil t)))) | |
17386 | ||
8d642074 CD |
17387 | (defun org-on-heading-p (&optional ignored) |
17388 | (outline-on-heading-p t)) | |
17389 | (defun org-at-heading-p (&optional ignored) | |
17390 | (outline-on-heading-p t)) | |
17391 | ||
a3fbe8c4 CD |
17392 | (defun org-at-heading-or-item-p () |
17393 | (or (org-on-heading-p) (org-at-item-p))) | |
891f4676 | 17394 | |
a96ee7df | 17395 | (defun org-on-target-p () |
d3f4dbe8 CD |
17396 | (or (org-in-regexp org-radio-target-regexp) |
17397 | (org-in-regexp org-target-regexp))) | |
a96ee7df | 17398 | |
891f4676 RS |
17399 | (defun org-up-heading-all (arg) |
17400 | "Move to the heading line of which the present line is a subheading. | |
17401 | This function considers both visible and invisible heading lines. | |
17402 | With argument, move up ARG levels." | |
5137195a CD |
17403 | (if (fboundp 'outline-up-heading-all) |
17404 | (outline-up-heading-all arg) ; emacs 21 version of outline.el | |
17405 | (outline-up-heading arg t))) ; emacs 22 version of outline.el | |
891f4676 | 17406 | |
d5098885 JW |
17407 | (defun org-up-heading-safe () |
17408 | "Move to the heading line of which the present line is a subheading. | |
17409 | This version will not throw an error. It will return the level of the | |
c8d0cf5c CD |
17410 | headline found, or nil if no higher level is found. |
17411 | ||
17412 | Also, this function will be a lot faster than `outline-up-heading', | |
17413 | because it relies on stars being the outline starters. This can really | |
17414 | make a significant difference in outlines with very many siblings." | |
db55f368 CD |
17415 | (let (start-level re) |
17416 | (org-back-to-heading t) | |
17417 | (setq start-level (funcall outline-level)) | |
17418 | (if (equal start-level 1) | |
17419 | nil | |
17420 | (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} ")) | |
17421 | (if (re-search-backward re nil t) | |
17422 | (funcall outline-level))))) | |
d5098885 | 17423 | |
8c6fb58b CD |
17424 | (defun org-first-sibling-p () |
17425 | "Is this heading the first child of its parents?" | |
17426 | (interactive) | |
17427 | (let ((re (concat "^" outline-regexp)) | |
17428 | level l) | |
17429 | (unless (org-at-heading-p t) | |
17430 | (error "Not at a heading")) | |
17431 | (setq level (funcall outline-level)) | |
17432 | (save-excursion | |
17433 | (if (not (re-search-backward re nil t)) | |
17434 | t | |
17435 | (setq l (funcall outline-level)) | |
17436 | (< l level))))) | |
17437 | ||
3278a016 CD |
17438 | (defun org-goto-sibling (&optional previous) |
17439 | "Goto the next sibling, even if it is invisible. | |
17440 | When PREVIOUS is set, go to the previous sibling instead. Returns t | |
17441 | when a sibling was found. When none is found, return nil and don't | |
17442 | move point." | |
17443 | (let ((fun (if previous 're-search-backward 're-search-forward)) | |
17444 | (pos (point)) | |
17445 | (re (concat "^" outline-regexp)) | |
17446 | level l) | |
5152b597 CD |
17447 | (when (condition-case nil (org-back-to-heading t) (error nil)) |
17448 | (setq level (funcall outline-level)) | |
17449 | (catch 'exit | |
17450 | (or previous (forward-char 1)) | |
17451 | (while (funcall fun re nil t) | |
17452 | (setq l (funcall outline-level)) | |
17453 | (when (< l level) (goto-char pos) (throw 'exit nil)) | |
17454 | (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) | |
17455 | (goto-char pos) | |
17456 | nil)))) | |
3278a016 | 17457 | |
d3f4dbe8 CD |
17458 | (defun org-show-siblings () |
17459 | "Show all siblings of the current headline." | |
17460 | (save-excursion | |
17461 | (while (org-goto-sibling) (org-flag-heading nil))) | |
17462 | (save-excursion | |
17463 | (while (org-goto-sibling 'previous) | |
17464 | (org-flag-heading nil)))) | |
17465 | ||
891f4676 RS |
17466 | (defun org-show-hidden-entry () |
17467 | "Show an entry where even the heading is hidden." | |
17468 | (save-excursion | |
634a7d0b | 17469 | (org-show-entry))) |
891f4676 | 17470 | |
891f4676 | 17471 | (defun org-flag-heading (flag &optional entry) |
2dd9129f | 17472 | "Flag the current heading. FLAG non-nil means make invisible. |
891f4676 RS |
17473 | When ENTRY is non-nil, show the entire entry." |
17474 | (save-excursion | |
17475 | (org-back-to-heading t) | |
891f4676 RS |
17476 | ;; Check if we should show the entire entry |
17477 | (if entry | |
c8d16429 CD |
17478 | (progn |
17479 | (org-show-entry) | |
4b3a9ba7 CD |
17480 | (save-excursion |
17481 | (and (outline-next-heading) | |
17482 | (org-flag-heading nil)))) | |
48aaad2d | 17483 | (outline-flag-region (max (point-min) (1- (point))) |
c8d16429 | 17484 | (save-excursion (outline-end-of-heading) (point)) |
5137195a | 17485 | flag)))) |
891f4676 | 17486 | |
621f83e4 CD |
17487 | (defun org-get-next-sibling () |
17488 | "Move to next heading of the same level, and return point. | |
17489 | If there is no such heading, return nil. | |
17490 | This is like outline-next-sibling, but invisible headings are ok." | |
17491 | (let ((level (funcall outline-level))) | |
17492 | (outline-next-heading) | |
17493 | (while (and (not (eobp)) (> (funcall outline-level) level)) | |
17494 | (outline-next-heading)) | |
17495 | (if (or (eobp) (< (funcall outline-level) level)) | |
17496 | nil | |
17497 | (point)))) | |
17498 | ||
54a0dee5 CD |
17499 | (defun org-get-last-sibling () |
17500 | "Move to previous heading of the same level, and return point. | |
17501 | If there is no such heading, return nil." | |
17502 | (let ((opoint (point)) | |
17503 | (level (funcall outline-level))) | |
17504 | (outline-previous-heading) | |
17505 | (when (and (/= (point) opoint) (outline-on-heading-p t)) | |
17506 | (while (and (> (funcall outline-level) level) | |
17507 | (not (bobp))) | |
17508 | (outline-previous-heading)) | |
17509 | (if (< (funcall outline-level) level) | |
17510 | nil | |
17511 | (point))))) | |
17512 | ||
a3fbe8c4 | 17513 | (defun org-end-of-subtree (&optional invisible-OK to-heading) |
c8d0cf5c | 17514 | ;; This contains an exact copy of the original function, but it uses |
04d18304 CD |
17515 | ;; `org-back-to-heading', to make it work also in invisible |
17516 | ;; trees. And is uses an invisible-OK argument. | |
17517 | ;; Under Emacs this is not needed, but the old outline.el needs this fix. | |
c8d0cf5c CD |
17518 | ;; Furthermore, when used inside Org, finding the end of a large subtree |
17519 | ;; with many children and grandchildren etc, this can be much faster | |
17520 | ;; than the outline version. | |
04d18304 | 17521 | (org-back-to-heading invisible-OK) |
f462ee2c | 17522 | (let ((first t) |
04d18304 | 17523 | (level (funcall outline-level))) |
c8d0cf5c CD |
17524 | (if (and (org-mode-p) (< level 1000)) |
17525 | ;; A true heading (not a plain list item), in Org-mode | |
17526 | ;; This means we can easily find the end by looking | |
17527 | ;; only for the right number of stars. Using a regexp to do | |
17528 | ;; this is so much faster than using a Lisp loop. | |
17529 | (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} "))) | |
17530 | (forward-char 1) | |
17531 | (and (re-search-forward re nil 'move) (beginning-of-line 1))) | |
17532 | ;; something else, do it the slow way | |
17533 | (while (and (not (eobp)) | |
17534 | (or first (> (funcall outline-level) level))) | |
17535 | (setq first nil) | |
17536 | (outline-next-heading))) | |
a3fbe8c4 CD |
17537 | (unless to-heading |
17538 | (if (memq (preceding-char) '(?\n ?\^M)) | |
c8d0cf5c CD |
17539 | (progn |
17540 | ;; Go to end of line before heading | |
17541 | (forward-char -1) | |
17542 | (if (memq (preceding-char) '(?\n ?\^M)) | |
17543 | ;; leave blank line before heading | |
17544 | (forward-char -1)))))) | |
0fee8d6e | 17545 | (point)) |
04d18304 | 17546 | |
c8d0cf5c CD |
17547 | (defadvice outline-end-of-subtree (around prefer-org-version activate compile) |
17548 | "Use Org version in org-mode, for dramatic speed-up." | |
17549 | (if (eq major-mode 'org-mode) | |
17550 | (progn | |
17551 | (org-end-of-subtree nil t) | |
8d642074 | 17552 | (unless (eobp) (backward-char 1))) |
c8d0cf5c CD |
17553 | ad-do-it)) |
17554 | ||
17555 | (defun org-forward-same-level (arg &optional invisible-ok) | |
17556 | "Move forward to the arg'th subheading at same level as this one. | |
17557 | Stop at the first and last subheadings of a superior heading." | |
17558 | (interactive "p") | |
17559 | (org-back-to-heading invisible-ok) | |
17560 | (org-on-heading-p) | |
17561 | (let* ((level (- (match-end 0) (match-beginning 0) 1)) | |
17562 | (re (format "^\\*\\{1,%d\\} " level)) | |
17563 | l) | |
17564 | (forward-char 1) | |
17565 | (while (> arg 0) | |
17566 | (while (and (re-search-forward re nil 'move) | |
17567 | (setq l (- (match-end 0) (match-beginning 0) 1)) | |
17568 | (= l level) | |
17569 | (not invisible-ok) | |
17570 | (org-invisible-p)) | |
17571 | (if (< l level) (setq arg 1))) | |
17572 | (setq arg (1- arg))) | |
17573 | (beginning-of-line 1))) | |
17574 | ||
17575 | (defun org-backward-same-level (arg &optional invisible-ok) | |
17576 | "Move backward to the arg'th subheading at same level as this one. | |
17577 | Stop at the first and last subheadings of a superior heading." | |
17578 | (interactive "p") | |
17579 | (org-back-to-heading) | |
17580 | (org-on-heading-p) | |
17581 | (let* ((level (- (match-end 0) (match-beginning 0) 1)) | |
17582 | (re (format "^\\*\\{1,%d\\} " level)) | |
17583 | l) | |
17584 | (while (> arg 0) | |
17585 | (while (and (re-search-backward re nil 'move) | |
17586 | (setq l (- (match-end 0) (match-beginning 0) 1)) | |
17587 | (= l level) | |
17588 | (not invisible-ok) | |
17589 | (org-invisible-p)) | |
17590 | (if (< l level) (setq arg 1))) | |
17591 | (setq arg (1- arg))))) | |
17592 | ||
634a7d0b CD |
17593 | (defun org-show-subtree () |
17594 | "Show everything after this heading at deeper levels." | |
64f72ae1 JB |
17595 | (outline-flag-region |
17596 | (point) | |
634a7d0b | 17597 | (save-excursion |
54a0dee5 | 17598 | (org-end-of-subtree t t)) |
5137195a | 17599 | nil)) |
634a7d0b CD |
17600 | |
17601 | (defun org-show-entry () | |
17602 | "Show the body directly following this heading. | |
17603 | Show the heading too, if it is currently invisible." | |
17604 | (interactive) | |
17605 | (save-excursion | |
15841868 JW |
17606 | (condition-case nil |
17607 | (progn | |
17608 | (org-back-to-heading t) | |
17609 | (outline-flag-region | |
17610 | (max (point-min) (1- (point))) | |
17611 | (save-excursion | |
c8d0cf5c CD |
17612 | (if (re-search-forward |
17613 | (concat "[\r\n]\\(" outline-regexp "\\)") nil t) | |
17614 | (match-beginning 1) | |
17615 | (point-max))) | |
17616 | nil) | |
17617 | (org-cycle-hide-drawers 'children)) | |
15841868 | 17618 | (error nil)))) |
634a7d0b | 17619 | |
c8d0cf5c | 17620 | (defun org-make-options-regexp (kwds &optional extra) |
891f4676 RS |
17621 | "Make a regular expression for keyword lines." |
17622 | (concat | |
5137195a | 17623 | "^" |
891f4676 RS |
17624 | "#?[ \t]*\\+\\(" |
17625 | (mapconcat 'regexp-quote kwds "\\|") | |
c8d0cf5c | 17626 | (if extra (concat "\\|" extra)) |
891f4676 | 17627 | "\\):[ \t]*" |
c8d0cf5c | 17628 | "\\(.*\\)")) |
891f4676 | 17629 | |
d3f4dbe8 CD |
17630 | ;; Make isearch reveal the necessary context |
17631 | (defun org-isearch-end () | |
17632 | "Reveal context after isearch exits." | |
17633 | (when isearch-success ; only if search was successful | |
17634 | (if (featurep 'xemacs) | |
17635 | ;; Under XEmacs, the hook is run in the correct place, | |
17636 | ;; we directly show the context. | |
17637 | (org-show-context 'isearch) | |
17638 | ;; In Emacs the hook runs *before* restoring the overlays. | |
17639 | ;; So we have to use a one-time post-command-hook to do this. | |
17640 | ;; (Emacs 22 has a special variable, see function `org-mode') | |
17641 | (unless (and (boundp 'isearch-mode-end-hook-quit) | |
17642 | isearch-mode-end-hook-quit) | |
17643 | ;; Only when the isearch was not quitted. | |
17644 | (org-add-hook 'post-command-hook 'org-isearch-post-command | |
17645 | 'append 'local))))) | |
17646 | ||
17647 | (defun org-isearch-post-command () | |
17648 | "Remove self from hook, and show context." | |
17649 | (remove-hook 'post-command-hook 'org-isearch-post-command 'local) | |
17650 | (org-show-context 'isearch)) | |
17651 | ||
a3fbe8c4 | 17652 | |
8c6fb58b CD |
17653 | ;;;; Integration with and fixes for other packages |
17654 | ||
17655 | ;;; Imenu support | |
17656 | ||
17657 | (defvar org-imenu-markers nil | |
17658 | "All markers currently used by Imenu.") | |
17659 | (make-variable-buffer-local 'org-imenu-markers) | |
17660 | ||
17661 | (defun org-imenu-new-marker (&optional pos) | |
17662 | "Return a new marker for use by Imenu, and remember the marker." | |
17663 | (let ((m (make-marker))) | |
17664 | (move-marker m (or pos (point))) | |
17665 | (push m org-imenu-markers) | |
17666 | m)) | |
17667 | ||
17668 | (defun org-imenu-get-tree () | |
17669 | "Produce the index for Imenu." | |
17670 | (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) | |
17671 | (setq org-imenu-markers nil) | |
17672 | (let* ((n org-imenu-depth) | |
17673 | (re (concat "^" outline-regexp)) | |
17674 | (subs (make-vector (1+ n) nil)) | |
17675 | (last-level 0) | |
65c439fd | 17676 | m level head) |
8c6fb58b CD |
17677 | (save-excursion |
17678 | (save-restriction | |
17679 | (widen) | |
17680 | (goto-char (point-max)) | |
17681 | (while (re-search-backward re nil t) | |
17682 | (setq level (org-reduced-level (funcall outline-level))) | |
17683 | (when (<= level n) | |
17684 | (looking-at org-complex-heading-regexp) | |
621f83e4 CD |
17685 | (setq head (org-link-display-format |
17686 | (org-match-string-no-properties 4)) | |
8c6fb58b CD |
17687 | m (org-imenu-new-marker)) |
17688 | (org-add-props head nil 'org-imenu-marker m 'org-imenu t) | |
17689 | (if (>= level last-level) | |
17690 | (push (cons head m) (aref subs level)) | |
17691 | (push (cons head (aref subs (1+ level))) (aref subs level)) | |
17692 | (loop for i from (1+ level) to n do (aset subs i nil))) | |
17693 | (setq last-level level))))) | |
17694 | (aref subs 1))) | |
17695 | ||
17696 | (eval-after-load "imenu" | |
17697 | '(progn | |
17698 | (add-hook 'imenu-after-jump-hook | |
2c3ad40d CD |
17699 | (lambda () |
17700 | (if (eq major-mode 'org-mode) | |
17701 | (org-show-context 'org-goto)))))) | |
8c6fb58b | 17702 | |
621f83e4 CD |
17703 | (defun org-link-display-format (link) |
17704 | "Replace a link with either the description, or the link target | |
17705 | if no description is present" | |
17706 | (save-match-data | |
17707 | (if (string-match org-bracket-link-analytic-regexp link) | |
8bfe682a CD |
17708 | (replace-match (if (match-end 5) |
17709 | (match-string 5 link) | |
17710 | (concat (match-string 1 link) | |
17711 | (match-string 3 link))) | |
17712 | nil t link) | |
621f83e4 CD |
17713 | link))) |
17714 | ||
8c6fb58b CD |
17715 | ;; Speedbar support |
17716 | ||
20908596 CD |
17717 | (defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1) |
17718 | "Overlay marking the agenda restriction line in speedbar.") | |
17719 | (org-overlay-put org-speedbar-restriction-lock-overlay | |
17720 | 'face 'org-agenda-restriction-lock) | |
17721 | (org-overlay-put org-speedbar-restriction-lock-overlay | |
17722 | 'help-echo "Agendas are currently limited to this item.") | |
17723 | (org-detach-overlay org-speedbar-restriction-lock-overlay) | |
17724 | ||
8c6fb58b CD |
17725 | (defun org-speedbar-set-agenda-restriction () |
17726 | "Restrict future agenda commands to the location at point in speedbar. | |
17727 | To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." | |
17728 | (interactive) | |
20908596 | 17729 | (require 'org-agenda) |
65c439fd | 17730 | (let (p m tp np dir txt) |
8c6fb58b CD |
17731 | (cond |
17732 | ((setq p (text-property-any (point-at-bol) (point-at-eol) | |
17733 | 'org-imenu t)) | |
17734 | (setq m (get-text-property p 'org-imenu-marker)) | |
8bfe682a CD |
17735 | (with-current-buffer (marker-buffer m) |
17736 | (goto-char m) | |
17737 | (org-agenda-set-restriction-lock 'subtree))) | |
8c6fb58b CD |
17738 | ((setq p (text-property-any (point-at-bol) (point-at-eol) |
17739 | 'speedbar-function 'speedbar-find-file)) | |
17740 | (setq tp (previous-single-property-change | |
17741 | (1+ p) 'speedbar-function) | |
17742 | np (next-single-property-change | |
17743 | tp 'speedbar-function) | |
17744 | dir (speedbar-line-directory) | |
17745 | txt (buffer-substring-no-properties (or tp (point-min)) | |
17746 | (or np (point-max)))) | |
8bfe682a CD |
17747 | (with-current-buffer (find-file-noselect |
17748 | (let ((default-directory dir)) | |
17749 | (expand-file-name txt))) | |
17750 | (unless (org-mode-p) | |
17751 | (error "Cannot restrict to non-Org-mode file")) | |
17752 | (org-agenda-set-restriction-lock 'file))) | |
8c6fb58b CD |
17753 | (t (error "Don't know how to restrict Org-mode's agenda"))) |
17754 | (org-move-overlay org-speedbar-restriction-lock-overlay | |
17755 | (point-at-bol) (point-at-eol)) | |
17756 | (setq current-prefix-arg nil) | |
17757 | (org-agenda-maybe-redo))) | |
17758 | ||
17759 | (eval-after-load "speedbar" | |
17760 | '(progn | |
17761 | (speedbar-add-supported-extension ".org") | |
17762 | (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) | |
17763 | (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) | |
17764 | (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) | |
17765 | (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) | |
17766 | (add-hook 'speedbar-visiting-tag-hook | |
1ba1f458 | 17767 | (lambda () (and (org-mode-p) (org-show-context 'org-goto)))))) |
8c6fb58b CD |
17768 | |
17769 | ||
20908596 | 17770 | ;;; Fixes and Hacks for problems with other packages |
a3fbe8c4 CD |
17771 | |
17772 | ;; Make flyspell not check words in links, to not mess up our keymap | |
17773 | (defun org-mode-flyspell-verify () | |
17774 | "Don't let flyspell put overlays at active buttons." | |
c8d0cf5c CD |
17775 | (and (not (get-text-property (point) 'keymap)) |
17776 | (not (get-text-property (point) 'org-no-flyspell)))) | |
17777 | ||
17778 | (defun org-remove-flyspell-overlays-in (beg end) | |
17779 | "Remove flyspell overlays in region." | |
17780 | (and (org-bound-and-true-p flyspell-mode) | |
17781 | (fboundp 'flyspell-delete-region-overlays) | |
17782 | (flyspell-delete-region-overlays beg end)) | |
17783 | (add-text-properties beg end '(org-no-flyspell t))) | |
d3f4dbe8 | 17784 | |
8bfe682a | 17785 | ;; Make `bookmark-jump' shows the jump location if it was hidden. |
891f4676 | 17786 | (eval-after-load "bookmark" |
b9661543 CD |
17787 | '(if (boundp 'bookmark-after-jump-hook) |
17788 | ;; We can use the hook | |
17789 | (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) | |
17790 | ;; Hook not available, use advice | |
17791 | (defadvice bookmark-jump (after org-make-visible activate) | |
17792 | "Make the position visible." | |
17793 | (org-bookmark-jump-unhide)))) | |
17794 | ||
8bfe682a | 17795 | ;; Make sure saveplace shows the location if it was hidden |
93b62de8 CD |
17796 | (eval-after-load "saveplace" |
17797 | '(defadvice save-place-find-file-hook (after org-make-visible activate) | |
17798 | "Make the position visible." | |
17799 | (org-bookmark-jump-unhide))) | |
17800 | ||
8bfe682a CD |
17801 | ;; Make sure ecb shows the location if it was hidden |
17802 | (eval-after-load "ecb" | |
17803 | '(defadvice ecb-method-clicked (after esf/org-show-context activate) | |
17804 | "Make hierarchy visible when jumping into location from ECB tree buffer." | |
17805 | (if (eq major-mode 'org-mode) | |
17806 | (org-show-context)))) | |
17807 | ||
b9661543 CD |
17808 | (defun org-bookmark-jump-unhide () |
17809 | "Unhide the current position, to show the bookmark location." | |
b928f99a | 17810 | (and (org-mode-p) |
b9661543 CD |
17811 | (or (org-invisible-p) |
17812 | (save-excursion (goto-char (max (point-min) (1- (point)))) | |
17813 | (org-invisible-p))) | |
3278a016 | 17814 | (org-show-context 'bookmark-jump))) |
891f4676 | 17815 | |
3278a016 CD |
17816 | ;; Make session.el ignore our circular variable |
17817 | (eval-after-load "session" | |
17818 | '(add-to-list 'session-globals-exclude 'org-mark-ring)) | |
0fee8d6e | 17819 | |
d3f4dbe8 | 17820 | ;;;; Experimental code |
b928f99a | 17821 | |
a3fbe8c4 CD |
17822 | (defun org-closed-in-range () |
17823 | "Sparse tree of items closed in a certain time range. | |
8c6fb58b | 17824 | Still experimental, may disappear in the future." |
a3fbe8c4 CD |
17825 | (interactive) |
17826 | ;; Get the time interval from the user. | |
54a0dee5 | 17827 | (let* ((time1 (org-float-time |
a3fbe8c4 | 17828 | (org-read-date nil 'to-time nil "Starting date: "))) |
54a0dee5 | 17829 | (time2 (org-float-time |
a3fbe8c4 CD |
17830 | (org-read-date nil 'to-time nil "End date:"))) |
17831 | ;; callback function | |
17832 | (callback (lambda () | |
17833 | (let ((time | |
54a0dee5 | 17834 | (org-float-time |
a3fbe8c4 CD |
17835 | (apply 'encode-time |
17836 | (org-parse-time-string | |
17837 | (match-string 1)))))) | |
17838 | ;; check if time in interval | |
17839 | (and (>= time time1) (<= time time2)))))) | |
17840 | ;; make tree, check each match with the callback | |
17841 | (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) | |
d3f4dbe8 CD |
17842 | |
17843 | ;;;; Finish up | |
c44f0d75 | 17844 | |
f462ee2c SM |
17845 | (provide 'org) |
17846 | ||
17847 | (run-hooks 'org-load-hook) | |
17848 | ||
17849 | ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd | |
7d58338e | 17850 | |
b349f79f | 17851 | ;;; org.el ends here |
8bfe682a | 17852 |