Spelling fixes.
[bpt/emacs.git] / lisp / org / org.el
CommitLineData
a3fbe8c4 1;;; org.el --- Outline-based notes management and organizer
791d856f 2;; Carstens outline-mode for keeping track of everything.
cbd20947 3;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
ef943dba 4;;
0b8568f5 5;; Author: Carsten Dominik <carsten at orgmode dot org>
4da1a99d 6;; Keywords: outlines, hypermedia, calendar, wp
0b8568f5 7;; Homepage: http://orgmode.org
3ab2c837 8;; Version: 7.7
ef943dba 9;;
359ec616 10;; This file is part of GNU Emacs.
ef943dba 11;;
b1fc2b50 12;; GNU Emacs is free software: you can redistribute it and/or modify
359ec616 13;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
891f4676 16
359ec616
RS
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
891f4676
RS
21
22;; You should have received a copy of the GNU General Public License
b1fc2b50 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
891f4676 24;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
891f4676
RS
25;;
26;;; Commentary:
27;;
28;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
29;; project planning with a fast and effective plain-text system.
30;;
f85d958a
CD
31;; Org-mode develops organizational tasks around NOTES files that contain
32;; information about projects as plain text. Org-mode is implemented on
33;; top of outline-mode, which makes it possible to keep the content of
34;; large files well structured. Visibility cycling and structure editing
35;; help to work with the tree. Tables are easily created with a built-in
36;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
37;; and scheduling. It dynamically compiles entries into an agenda that
38;; utilizes and smoothly integrates much of the Emacs calendar and diary.
39;; Plain text URL-like links connect to websites, emails, Usenet
40;; messages, BBDB entries, and any files related to the projects. For
41;; printing and sharing of notes, an Org-mode file can be exported as a
42;; structured ASCII file, as HTML, or (todo and agenda items only) as an
43;; iCalendar file. It can also serve as a publishing tool for a set of
44;; linked webpages.
45;;
3278a016
CD
46;; Installation and Activation
47;; ---------------------------
48;; See the corresponding sections in the manual at
891f4676 49;;
0b8568f5 50;; http://orgmode.org/org.html#Installation
891f4676
RS
51;;
52;; Documentation
53;; -------------
eb2f9c59
CD
54;; The documentation of Org-mode can be found in the TeXInfo file. The
55;; distribution also contains a PDF version of it. At the homepage of
56;; Org-mode, you can read the same text online as HTML. There is also an
7a368970
CD
57;; excellent reference card made by Philip Rooke. This card can be found
58;; in the etc/ directory of Emacs 22.
891f4676 59;;
d3f4dbe8 60;; A list of recent changes can be found at
d5098885 61;; http://orgmode.org/Changes.html
0fee8d6e 62;;
891f4676
RS
63;;; Code:
64
20908596
CD
65(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
66(defvar org-table-formula-constants-local nil
67 "Local version of `org-table-formula-constants'.")
68(make-variable-buffer-local 'org-table-formula-constants-local)
69
d3f4dbe8
CD
70;;;; Require other packages
71
edd21304 72(eval-when-compile
ab27a4a0 73 (require 'cl)
3820f429
CD
74 (require 'gnus-sum))
75
76(require 'calendar)
acedf35c 77
3820f429 78;; Emacs 22 calendar compatibility: Make sure the new variables are available
86fbb8ca
CD
79(when (fboundp 'defvaralias)
80 (unless (boundp 'calendar-view-holidays-initially-flag)
81 (defvaralias 'calendar-view-holidays-initially-flag
82 'view-calendar-holidays-initially))
83 (unless (boundp 'calendar-view-diary-initially-flag)
84 (defvaralias 'calendar-view-diary-initially-flag
85 'view-diary-entries-initially))
86 (unless (boundp 'diary-fancy-buffer)
87 (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)))
3820f429 88
0fee8d6e
CD
89(require 'outline) (require 'noutline)
90;; Other stuff we need.
891f4676 91(require 'time-date)
8c6fb58b 92(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
891f4676 93(require 'easymenu)
86fbb8ca 94(require 'overlay)
891f4676 95
20908596 96(require 'org-macs)
ed21c5c8 97(require 'org-entities)
20908596
CD
98(require 'org-compat)
99(require 'org-faces)
621f83e4 100(require 'org-list)
3ab2c837 101(require 'org-pcomplete)
c8d0cf5c 102(require 'org-src)
0bd48b37 103(require 'org-footnote)
20908596 104
3ab2c837
BG
105(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
106(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
107(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
3ab2c837
BG
108(declare-function org-at-clock-log-p "org-clock" ())
109(declare-function org-clock-timestamps-up "org-clock" ())
110(declare-function org-clock-timestamps-down "org-clock" ())
111
86fbb8ca
CD
112;; babel
113(require 'ob)
114(require 'ob-table)
115(require 'ob-lob)
116(require 'ob-ref)
117(require 'ob-tangle)
118(require 'ob-comint)
119(require 'ob-keys)
120
121;; load languages based on value of `org-babel-load-languages'
122(defvar org-babel-load-languages)
123;;;###autoload
124(defun org-babel-do-load-languages (sym value)
125 "Load the languages defined in `org-babel-load-languages'."
126 (set-default sym value)
127 (mapc (lambda (pair)
128 (let ((active (cdr pair)) (lang (symbol-name (car pair))))
129 (if active
130 (progn
131 (require (intern (concat "ob-" lang))))
132 (progn
133 (funcall 'fmakunbound
134 (intern (concat "org-babel-execute:" lang)))
135 (funcall 'fmakunbound
136 (intern (concat "org-babel-expand-body:" lang)))))))
137 org-babel-load-languages))
138
139(defcustom org-babel-load-languages '((emacs-lisp . t))
140 "Languages which can be evaluated in Org-mode buffers.
141This list can be used to load support for any of the languages
142below, note that each language will depend on a different set of
143system executables and/or Emacs modes. When a language is
144\"loaded\", then code blocks in that language can be evaluated
145with `org-babel-execute-src-block' bound by default to C-c
146C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can
147be set to remove code block evaluation from the C-c C-c
148keybinding. By default only Emacs Lisp (which has no
149requirements) is loaded."
150 :group 'org-babel
151 :set 'org-babel-do-load-languages
152 :type '(alist :tag "Babel Languages"
153 :key-type
154 (choice
3ab2c837 155 (const :tag "Awk" awk)
86fbb8ca
CD
156 (const :tag "C" C)
157 (const :tag "R" R)
158 (const :tag "Asymptote" asymptote)
afe98dfa 159 (const :tag "Calc" calc)
86fbb8ca
CD
160 (const :tag "Clojure" clojure)
161 (const :tag "CSS" css)
162 (const :tag "Ditaa" ditaa)
163 (const :tag "Dot" dot)
164 (const :tag "Emacs Lisp" emacs-lisp)
165 (const :tag "Gnuplot" gnuplot)
166 (const :tag "Haskell" haskell)
3ab2c837 167 (const :tag "Java" java)
afe98dfa 168 (const :tag "Javascript" js)
86fbb8ca 169 (const :tag "Latex" latex)
afe98dfa 170 (const :tag "Ledger" ledger)
3ab2c837
BG
171 (const :tag "Lilypond" lilypond)
172 (const :tag "Maxima" maxima)
86fbb8ca
CD
173 (const :tag "Matlab" matlab)
174 (const :tag "Mscgen" mscgen)
175 (const :tag "Ocaml" ocaml)
176 (const :tag "Octave" octave)
afe98dfa 177 (const :tag "Org" org)
86fbb8ca 178 (const :tag "Perl" perl)
afe98dfa 179 (const :tag "PlantUML" plantuml)
86fbb8ca
CD
180 (const :tag "Python" python)
181 (const :tag "Ruby" ruby)
182 (const :tag "Sass" sass)
afe98dfa 183 (const :tag "Scheme" scheme)
86fbb8ca
CD
184 (const :tag "Screen" screen)
185 (const :tag "Shell Script" sh)
186 (const :tag "Sql" sql)
187 (const :tag "Sqlite" sqlite))
188 :value-type (boolean :tag "Activate" :value t)))
189
d3f4dbe8 190;;;; Customization variables
86fbb8ca
CD
191(defcustom org-clone-delete-id nil
192 "Remove ID property of clones of a subtree.
193When non-nil, clones of a subtree don't inherit the ID property.
194Otherwise they inherit the ID property with a new unique
195identifier."
196 :type 'boolean
197 :group 'org-id)
891f4676 198
d3f4dbe8
CD
199;;; Version
200
3ab2c837 201(defconst org-version "7.7"
891f4676 202 "The version number of the file org.el.")
2a57416f
CD
203
204(defun org-version (&optional here)
205 "Show the org-mode version in the echo area.
206With prefix arg HERE, insert it at point."
207 (interactive "P")
8bfe682a
CD
208 (let* ((origin default-directory)
209 (version org-version)
54a0dee5
CD
210 (git-version)
211 (dir (concat (file-name-directory (locate-library "org")) "../" )))
8bfe682a
CD
212 (when (and (file-exists-p (expand-file-name ".git" dir))
213 (executable-find "git"))
214 (unwind-protect
215 (progn
216 (cd dir)
217 (when (eql 0 (shell-command "git describe --abbrev=4 HEAD"))
81ad75af 218 (with-current-buffer "*Shell Command Output*"
54a0dee5 219 (goto-char (point-min))
8bfe682a
CD
220 (setq git-version (buffer-substring (point) (point-at-eol))))
221 (subst-char-in-string ?- ?. git-version t)
222 (when (string-match "\\S-"
223 (shell-command-to-string
224 "git diff-index --name-only HEAD --"))
225 (setq git-version (concat git-version ".dirty")))
226 (setq version (concat version " (" git-version ")"))))
227 (cd origin)))
54a0dee5
CD
228 (setq version (format "Org-mode version %s" version))
229 (if here (insert version))
8bfe682a 230 (message version)))
891f4676 231
d3f4dbe8 232;;; Compatibility constants
38f8646b 233
d3f4dbe8
CD
234;;; The custom variables
235
891f4676 236(defgroup org nil
b0a10108 237 "Outline-based notes management and organizer."
891f4676
RS
238 :tag "Org"
239 :group 'outlines
891f4676
RS
240 :group 'calendar)
241
8bfe682a
CD
242(defcustom org-mode-hook nil
243 "Mode hook for Org-mode, run after the mode was turned on."
244 :group 'org
245 :type 'hook)
246
2a57416f
CD
247(defcustom org-load-hook nil
248 "Hook that is run after org.el has been loaded."
249 :group 'org
250 :type 'hook)
251
20908596
CD
252(defvar org-modules) ; defined below
253(defvar org-modules-loaded nil
254 "Have the modules been loaded already?")
255
256(defun org-load-modules-maybe (&optional force)
ce4fdcb9 257 "Load all extensions listed in `org-modules'."
20908596
CD
258 (when (or force (not org-modules-loaded))
259 (mapc (lambda (ext)
260 (condition-case nil (require ext)
261 (error (message "Problems while trying to load feature `%s'" ext))))
262 org-modules)
263 (setq org-modules-loaded t)))
264
265(defun org-set-modules (var value)
266 "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
267 (set var value)
268 (when (featurep 'org)
269 (org-load-modules-maybe 'force)))
270
6dc30f44
CD
271(when (org-bound-and-true-p org-modules)
272 (let ((a (member 'org-infojs org-modules)))
273 (and a (setcar a 'org-jsinfo))))
274
ed21c5c8 275(defcustom org-modules '(org-bbdb org-bibtex org-docview org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl)
20908596 276 "Modules that should always be loaded together with org.el.
efc054e6 277If a description starts with <C>, the file is not part of Emacs
20908596
CD
278and loading it will require that you have downloaded and properly installed
279the org-mode distribution.
280
281You can also use this system to load external packages (i.e. neither Org
8d642074 282core modules, nor modules from the CONTRIB directory). Just add symbols
efc054e6 283to the end of the list. If the package is called org-xyz.el, then you need
20908596
CD
284to add the symbol `xyz', and the package must have a call to
285
286 (provide 'org-xyz)"
15841868 287 :group 'org
20908596
CD
288 :set 'org-set-modules
289 :type
290 '(set :greedy t
291 (const :tag " bbdb: Links to BBDB entries" org-bbdb)
292 (const :tag " bibtex: Links to BibTeX entries" org-bibtex)
8d642074 293 (const :tag " crypt: Encryption of subtrees" org-crypt)
ed21c5c8
CD
294 (const :tag " ctags: Access to Emacs tags with links" org-ctags)
295 (const :tag " docview: Links to doc-view buffers" org-docview)
20908596 296 (const :tag " gnus: Links to GNUS folders/messages" org-gnus)
db55f368 297 (const :tag " id: Global IDs for identifying entries" org-id)
20908596 298 (const :tag " info: Links to Info nodes" org-info)
6dc30f44 299 (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo)
8bfe682a 300 (const :tag " habit: Track your consistency with habits" org-habit)
c8d0cf5c 301 (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask)
20908596
CD
302 (const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
303 (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message)
304 (const :tag " mew Links to Mew folders/messages" org-mew)
305 (const :tag " mhe: Links to MHE folders/messages" org-mhe)
c8d0cf5c 306 (const :tag " protocol: Intercept calls from emacsclient" org-protocol)
20908596 307 (const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
3ab2c837 308 (const :tag " special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks)
20908596
CD
309 (const :tag " vm: Links to VM folders/messages" org-vm)
310 (const :tag " wl: Links to Wanderlust folders/messages" org-wl)
8bfe682a 311 (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m)
20908596 312 (const :tag " mouse: Additional mouse support" org-mouse)
afe98dfa 313 (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler)
20908596
CD
314
315 (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
8bfe682a 316 (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark)
c8d0cf5c
CD
317 (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
318 (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
319 (const :tag "C collector: Collect properties into tables" org-collector)
8d642074 320 (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
3ab2c837 321 (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill)
8bfe682a 322 (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol)
3ab2c837 323 (const :tag "C eshell Support for links to working directories in eshell" org-eshell)
b349f79f 324 (const :tag "C eval: Include command output as text" org-eval)
ce4fdcb9 325 (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
8bfe682a 326 (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry)
c8d0cf5c 327 (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex)
8bfe682a 328 (const :tag "C git-link: Provide org links to specific file version" org-git-link)
8d642074
CD
329 (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
330
8bfe682a 331 (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice)
8d642074 332
8bfe682a
CD
333 (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira)
334 (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
335 (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
3ab2c837 336 (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
c8d0cf5c 337 (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
86fbb8ca 338 (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber)
20908596 339 (const :tag "C man: Support for links to manpages in Org-mode" org-man)
b349f79f 340 (const :tag "C mtags: Support for muse-like tags" org-mtags)
3ab2c837 341 (const :tag "C odt: OpenDocumentText exporter for Org-mode" org-odt)
20908596 342 (const :tag "C panel: Simple routines for us with bad memory" org-panel)
8bfe682a 343 (const :tag "C registry: A registry for Org-mode links" org-registry)
20908596
CD
344 (const :tag "C org2rem: Convert org appointments into reminders" org2rem)
345 (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen)
ed21c5c8 346 (const :tag "C secretary: Team management with org-mode" org-secretary)
20908596 347 (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert)
c8d0cf5c 348 (const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
8bfe682a 349 (const :tag "C track: Keep up with Org-mode development" org-track)
afe98dfa
CD
350 (const :tag "C velocity Something like Notational Velocity for Org" org-velocity)
351 (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
20908596
CD
352 (repeat :tag "External packages" :inline t (symbol :tag "Package"))))
353
65c439fd 354(defcustom org-support-shift-select nil
ed21c5c8 355 "Non-nil means make shift-cursor commands select text when possible.
65c439fd
CD
356
357In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start
86fbb8ca 358selecting a region, or enlarge regions started in this way.
65c439fd
CD
359In Org-mode, in special contexts, these same keys are used for other
360purposes, important enough to compete with shift selection. Org tries
361to balance these needs by supporting `shift-select-mode' outside these
362special contexts, under control of this variable.
363
364The default of this variable is nil, to avoid confusing behavior. Shifted
365cursor keys will then execute Org commands in the following contexts:
366- on a headline, changing TODO state (left/right) and priority (up/down)
367- on a time stamp, changing the time
368- in a plain list item, changing the bullet type
369- in a property definition line, switching between allowed values
370- in the BEGIN line of a clock table (changing the time block).
371Outside these contexts, the commands will throw an error.
372
373When this variable is t and the cursor is not in a special context,
374Org-mode will support shift-selection for making and enlarging regions.
375To make this more effective, the bullet cycling will no longer happen
376anywhere in an item line, but only if the cursor is exactly on the bullet.
377
378If you set this variable to the symbol `always', then the keys
379will not be special in headlines, property lines, and item lines, to make
380shift selection work there as well. If this is what you want, you can
381use the following alternative commands: `C-c C-t' and `C-c ,' to
382change TODO state and priority, `C-u C-u C-c C-t' can be used to switch
383TODO sets, `C-c -' to cycle item bullet types, and properties can be
384edited by hand or in column view.
385
386However, when the cursor is on a timestamp, shift-cursor commands
387will still edit the time stamp - this is just too good to give up.
388
389XEmacs user should have this variable set to nil, because shift-select-mode
390is Emacs 23 only."
391 :group 'org
392 :type '(choice
393 (const :tag "Never" nil)
394 (const :tag "When outside special context" t)
395 (const :tag "Everywhere except timestamps" always)))
15841868 396
891f4676
RS
397(defgroup org-startup nil
398 "Options concerning startup of Org-mode."
399 :tag "Org Startup"
400 :group 'org)
401
402(defcustom org-startup-folded t
ed21c5c8 403 "Non-nil means entering Org-mode will switch to OVERVIEW.
ef943dba
CD
404This can also be configured on a per-file basis by adding one of
405the following lines anywhere in the buffer:
406
8d642074
CD
407 #+STARTUP: fold (or `overview', this is equivalent)
408 #+STARTUP: nofold (or `showall', this is equivalent)
409 #+STARTUP: content
410 #+STARTUP: showeverything"
891f4676 411 :group 'org-startup
35fb9989 412 :type '(choice
c8d16429
CD
413 (const :tag "nofold: show all" nil)
414 (const :tag "fold: overview" t)
8d642074
CD
415 (const :tag "content: all headlines" content)
416 (const :tag "show everything, even drawers" showeverything)))
891f4676
RS
417
418(defcustom org-startup-truncated t
ed21c5c8 419 "Non-nil means entering Org-mode will set `truncate-lines'.
891f4676
RS
420This is useful since some lines containing links can be very long and
421uninteresting. Also tables look terrible when wrapped."
422 :group 'org-startup
423 :type 'boolean)
424
c8d0cf5c 425(defcustom org-startup-indented nil
ed21c5c8 426 "Non-nil means turn on `org-indent-mode' on startup.
c8d0cf5c
CD
427This can also be configured on a per-file basis by adding one of
428the following lines anywhere in the buffer:
429
430 #+STARTUP: indent
431 #+STARTUP: noindent"
432 :group 'org-structure
433 :type '(choice
434 (const :tag "Not" nil)
435 (const :tag "Globally (slow on startup in large files)" t)))
436
86fbb8ca
CD
437(defcustom org-use-sub-superscripts t
438 "Non-nil means interpret \"_\" and \"^\" for export.
439When this option is turned on, you can use TeX-like syntax for sub- and
440superscripts. Several characters after \"_\" or \"^\" will be
441considered as a single item - so grouping with {} is normally not
442needed. For example, the following things will be parsed as single
443sub- or superscripts.
444
445 10^24 or 10^tau several digits will be considered 1 item.
446 10^-12 or 10^-tau a leading sign with digits or a word
447 x^2-y^3 will be read as x^2 - y^3, because items are
448 terminated by almost any nonword/nondigit char.
449 x_{i^2} or x^(2-i) braces or parenthesis do grouping.
450
451Still, ambiguity is possible - so when in doubt use {} to enclose the
452sub/superscript. If you set this variable to the symbol `{}',
453the braces are *required* in order to trigger interpretations as
454sub/superscript. This can be helpful in documents that need \"_\"
455frequently in plain text.
456
457Not all export backends support this, but HTML does.
458
459This option can also be set with the +OPTIONS line, e.g. \"^:nil\"."
460 :group 'org-startup
461 :group 'org-export-translation
462 :type '(choice
463 (const :tag "Always interpret" t)
464 (const :tag "Only with braces" {})
465 (const :tag "Never interpret" nil)))
466
467(if (fboundp 'defvaralias)
468 (defvaralias 'org-export-with-sub-superscripts 'org-use-sub-superscripts))
469
470
ed21c5c8
CD
471(defcustom org-startup-with-beamer-mode nil
472 "Non-nil means turn on `org-beamer-mode' on startup.
473This can also be configured on a per-file basis by adding one of
474the following lines anywhere in the buffer:
475
476 #+STARTUP: beamer"
477 :group 'org-startup
478 :type 'boolean)
479
ab27a4a0 480(defcustom org-startup-align-all-tables nil
ed21c5c8 481 "Non-nil means align all tables when visiting a file.
ab27a4a0 482This is useful when the column width in tables is forced with <N> cookies
4146eb16
CD
483in table fields. Such tables will look correct only after the first re-align.
484This can also be configured on a per-file basis by adding one of
485the following lines anywhere in the buffer:
486 #+STARTUP: align
487 #+STARTUP: noalign"
ab27a4a0
CD
488 :group 'org-startup
489 :type 'boolean)
490
afe98dfa
CD
491(defcustom org-startup-with-inline-images nil
492 "Non-nil means show inline images when loading a new Org file.
493This can also be configured on a per-file basis by adding one of
494the following lines anywhere in the buffer:
495 #+STARTUP: inlineimages
496 #+STARTUP: noinlineimages"
497 :group 'org-startup
498 :type 'boolean)
499
c52dbe8c 500(defcustom org-insert-mode-line-in-empty-file nil
891f4676 501 "Non-nil means insert the first line setting Org-mode in empty files.
35fb9989 502When the function `org-mode' is called interactively in an empty file, this
891f4676
RS
503normally means that the file name does not automatically trigger Org-mode.
504To ensure that the file will always be in Org-mode in the future, a
35fb9989
CD
505line enforcing Org-mode will be inserted into the buffer, if this option
506has been set."
891f4676
RS
507 :group 'org-startup
508 :type 'boolean)
509
a3fbe8c4
CD
510(defcustom org-replace-disputed-keys nil
511 "Non-nil means use alternative key bindings for some keys.
512Org-mode uses S-<cursor> keys for changing timestamps and priorities.
c8d0cf5c
CD
513These keys are also used by other packages like shift-selection-mode'
514\(built into Emacs 23), `CUA-mode' or `windmove.el'.
a3fbe8c4
CD
515If you want to use Org-mode together with one of these other modes,
516or more generally if you would like to move some Org-mode commands to
517other keys, set this variable and configure the keys with the variable
ab27a4a0 518`org-disputed-keys'.
891f4676 519
d3f4dbe8
CD
520This option is only relevant at load-time of Org-mode, and must be set
521*before* org.el is loaded. Changing it requires a restart of Emacs to
522become effective."
ab27a4a0
CD
523 :group 'org-startup
524 :type 'boolean)
891f4676 525
621f83e4 526(defcustom org-use-extra-keys nil
86fbb8ca
CD
527 "Non-nil means use extra key sequence definitions for certain commands.
528This happens automatically if you run XEmacs or if `window-system'
529is nil. This variable lets you do the same manually. You must
530set it before loading org.
621f83e4
CD
531
532Example: on Carbon Emacs 22 running graphically, with an external
533keyboard on a Powerbook, the default way of setting M-left might
534not work for either Alt or ESC. Setting this variable will make
535it work for ESC."
536 :group 'org-startup
537 :type 'boolean)
538
a3fbe8c4
CD
539(if (fboundp 'defvaralias)
540 (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys))
541
542(defcustom org-disputed-keys
543 '(([(shift up)] . [(meta p)])
544 ([(shift down)] . [(meta n)])
545 ([(shift left)] . [(meta -)])
546 ([(shift right)] . [(meta +)])
547 ([(control shift right)] . [(meta shift +)])
548 ([(control shift left)] . [(meta shift -)]))
ab27a4a0 549 "Keys for which Org-mode and other modes compete.
a3fbe8c4
CD
550This is an alist, cars are the default keys, second element specifies
551the alternative to use when `org-replace-disputed-keys' is t.
552
553Keys can be specified in any syntax supported by `define-key'.
554The value of this option takes effect only at Org-mode's startup,
555therefore you'll have to restart Emacs to apply it after changing."
556 :group 'org-startup
557 :type 'alist)
ab27a4a0
CD
558
559(defun org-key (key)
a3fbe8c4 560 "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
86fbb8ca
CD
561Or return the original if not disputed.
562Also apply the translations defined in `org-xemacs-key-equivalents'."
563 (when org-replace-disputed-keys
564 (let* ((nkey (key-description key))
565 (x (org-find-if (lambda (x)
566 (equal (key-description (car x)) nkey))
567 org-disputed-keys)))
568 (setq key (if x (cdr x) key))))
569 (when (featurep 'xemacs)
570 (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key)))
571 key)
a3fbe8c4
CD
572
573(defun org-find-if (predicate seq)
574 (catch 'exit
575 (while seq
576 (if (funcall predicate (car seq))
577 (throw 'exit (car seq))
578 (pop seq)))))
579
580(defun org-defkey (keymap key def)
581 "Define a key, possibly translated, as returned by `org-key'."
582 (define-key keymap (org-key key) def))
ab27a4a0 583
8c6fb58b 584(defcustom org-ellipsis nil
ab27a4a0
CD
585 "The ellipsis to use in the Org-mode outline.
586When nil, just use the standard three dots. When a string, use that instead,
33306645 587When a face, use the standard 3 dots, but with the specified face.
374585c9 588The change affects only Org-mode (which will then use its own display table).
ab27a4a0
CD
589Changing this requires executing `M-x org-mode' in a buffer to become
590effective."
591 :group 'org-startup
592 :type '(choice (const :tag "Default" nil)
374585c9 593 (face :tag "Face" :value org-warning)
ab27a4a0
CD
594 (string :tag "String" :value "...#")))
595
596(defvar org-display-table nil
597 "The display table for org-mode, in case `org-ellipsis' is non-nil.")
598
599(defgroup org-keywords nil
600 "Keywords in Org-mode."
601 :tag "Org Keywords"
602 :group 'org)
891f4676
RS
603
604(defcustom org-deadline-string "DEADLINE:"
605 "String to mark deadline entries.
606A deadline is this string, followed by a time stamp. Should be a word,
607terminated by a colon. You can insert a schedule keyword and
608a timestamp with \\[org-deadline].
609Changes become only effective after restarting Emacs."
610 :group 'org-keywords
611 :type 'string)
612
613(defcustom org-scheduled-string "SCHEDULED:"
614 "String to mark scheduled TODO entries.
615A schedule is this string, followed by a time stamp. Should be a word,
616terminated by a colon. You can insert a schedule keyword and
617a timestamp with \\[org-schedule].
618Changes become only effective after restarting Emacs."
619 :group 'org-keywords
620 :type 'string)
621
7ac93e3c 622(defcustom org-closed-string "CLOSED:"
b0a10108 623 "String used as the prefix for timestamps logging closing a TODO entry."
7ac93e3c
CD
624 :group 'org-keywords
625 :type 'string)
626
edd21304
CD
627(defcustom org-clock-string "CLOCK:"
628 "String used as prefix for timestamps clocking work hours on an item."
629 :group 'org-keywords
630 :type 'string)
631
891f4676
RS
632(defcustom org-comment-string "COMMENT"
633 "Entries starting with this keyword will never be exported.
634An entry can be toggled between COMMENT and normal with
635\\[org-toggle-comment].
636Changes become only effective after restarting Emacs."
637 :group 'org-keywords
638 :type 'string)
639
b9661543
CD
640(defcustom org-quote-string "QUOTE"
641 "Entries starting with this keyword will be exported in fixed-width font.
642Quoting applies only to the text in the entry following the headline, and does
643not extend beyond the next headline, even if that is lower level.
644An entry can be toggled between QUOTE and normal with
b0a10108 645\\[org-toggle-fixed-width-section]."
b9661543
CD
646 :group 'org-keywords
647 :type 'string)
648
a3fbe8c4 649(defconst org-repeat-re
8bfe682a 650 "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)"
d3f4dbe8
CD
651 "Regular expression for specifying repeated events.
652After a match, group 1 contains the repeat expression.")
653
ab27a4a0
CD
654(defgroup org-structure nil
655 "Options concerning the general structure of Org-mode files."
656 :tag "Org Structure"
657 :group 'org)
634a7d0b 658
d3f4dbe8
CD
659(defgroup org-reveal-location nil
660 "Options about how to make context of a location visible."
661 :tag "Org Reveal Location"
662 :group 'org-structure)
663
8c6fb58b
CD
664(defconst org-context-choice
665 '(choice
666 (const :tag "Always" t)
667 (const :tag "Never" nil)
668 (repeat :greedy t :tag "Individual contexts"
669 (cons
670 (choice :tag "Context"
671 (const agenda)
672 (const org-goto)
673 (const occur-tree)
674 (const tags-tree)
675 (const link-search)
676 (const mark-goto)
677 (const bookmark-jump)
678 (const isearch)
679 (const default))
680 (boolean))))
681 "Contexts for the reveal options.")
682
d3f4dbe8 683(defcustom org-show-hierarchy-above '((default . t))
ed21c5c8 684 "Non-nil means show full hierarchy when revealing a location.
d3f4dbe8
CD
685Org-mode often shows locations in an org-mode file which might have
686been invisible before. When this is set, the hierarchy of headings
687above the exposed location is shown.
688Turning this off for example for sparse trees makes them very compact.
689Instead of t, this can also be an alist specifying this option for different
690contexts. Valid contexts are
691 agenda when exposing an entry from the agenda
692 org-goto when using the command `org-goto' on key C-c C-j
693 occur-tree when using the command `org-occur' on key C-c /
694 tags-tree when constructing a sparse tree based on tags matches
695 link-search when exposing search matches associated with a link
696 mark-goto when exposing the jump goal of a mark
697 bookmark-jump when exposing a bookmark location
698 isearch when exiting from an incremental search
699 default default for all contexts not set explicitly"
700 :group 'org-reveal-location
8c6fb58b 701 :type org-context-choice)
d3f4dbe8 702
a3fbe8c4 703(defcustom org-show-following-heading '((default . nil))
ed21c5c8 704 "Non-nil means show following heading when revealing a location.
d3f4dbe8
CD
705Org-mode often shows locations in an org-mode file which might have
706been invisible before. When this is set, the heading following the
707match is shown.
708Turning this off for example for sparse trees makes them very compact,
709but makes it harder to edit the location of the match. In such a case,
710use the command \\[org-reveal] to show more context.
711Instead of t, this can also be an alist specifying this option for different
712contexts. See `org-show-hierarchy-above' for valid contexts."
713 :group 'org-reveal-location
8c6fb58b 714 :type org-context-choice)
d3f4dbe8
CD
715
716(defcustom org-show-siblings '((default . nil) (isearch t))
ed21c5c8 717 "Non-nil means show all sibling heading when revealing a location.
d3f4dbe8
CD
718Org-mode often shows locations in an org-mode file which might have
719been invisible before. When this is set, the sibling of the current entry
720heading are all made visible. If `org-show-hierarchy-above' is t,
721the same happens on each level of the hierarchy above the current entry.
722
723By default this is on for the isearch context, off for all other contexts.
724Turning this off for example for sparse trees makes them very compact,
725but makes it harder to edit the location of the match. In such a case,
726use the command \\[org-reveal] to show more context.
727Instead of t, this can also be an alist specifying this option for different
728contexts. See `org-show-hierarchy-above' for valid contexts."
729 :group 'org-reveal-location
8c6fb58b
CD
730 :type org-context-choice)
731
732(defcustom org-show-entry-below '((default . nil))
ed21c5c8 733 "Non-nil means show the entry below a headline when revealing a location.
8c6fb58b
CD
734Org-mode often shows locations in an org-mode file which might have
735been invisible before. When this is set, the text below the headline that is
736exposed is also shown.
737
738By default this is off for all contexts.
739Instead of t, this can also be an alist specifying this option for different
740contexts. See `org-show-hierarchy-above' for valid contexts."
741 :group 'org-reveal-location
742 :type org-context-choice)
d3f4dbe8 743
20908596
CD
744(defcustom org-indirect-buffer-display 'other-window
745 "How should indirect tree buffers be displayed?
746This applies to indirect buffers created with the commands
747\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer].
748Valid values are:
749current-window Display in the current window
750other-window Just display in another window.
751dedicated-frame Create one new frame, and re-use it each time.
752new-frame Make a new frame each time. Note that in this case
753 previously-made indirect buffers are kept, and you need to
754 kill these buffers yourself."
755 :group 'org-structure
756 :group 'org-agenda-windows
757 :type '(choice
758 (const :tag "In current window" current-window)
759 (const :tag "In current frame, other window" other-window)
760 (const :tag "Each time a new frame" new-frame)
761 (const :tag "One dedicated frame" dedicated-frame)))
762
8bfe682a 763(defcustom org-use-speed-commands nil
ed21c5c8 764 "Non-nil means activate single letter commands at beginning of a headline.
1bcdebed
CD
765This may also be a function to test for appropriate locations where speed
766commands should be active."
8bfe682a 767 :group 'org-structure
1bcdebed
CD
768 :type '(choice
769 (const :tag "Never" nil)
770 (const :tag "At beginning of headline stars" t)
771 (function)))
8bfe682a
CD
772
773(defcustom org-speed-commands-user nil
774 "Alist of additional speed commands.
775This list will be checked before `org-speed-commands-default'
776when the variable `org-use-speed-commands' is non-nil
777and when the cursor is at the beginning of a headline.
778The car if each entry is a string with a single letter, which must
779be assigned to `self-insert-command' in the global map.
780The cdr is either a command to be called interactively, a function
1bcdebed
CD
781to be called, or a form to be evaluated.
782An entry that is just a list with a single string will be interpreted
783as a descriptive headline that will be added when listing the speed
86fbb8ca 784commands in the Help buffer using the `?' speed command."
8bfe682a 785 :group 'org-structure
1bcdebed
CD
786 :type '(repeat :value ("k" . ignore)
787 (choice :value ("k" . ignore)
788 (list :tag "Descriptive Headline" (string :tag "Headline"))
789 (cons :tag "Letter and Command"
790 (string :tag "Command letter")
791 (choice
792 (function)
793 (sexp))))))
8bfe682a 794
ab27a4a0
CD
795(defgroup org-cycle nil
796 "Options concerning visibility cycling in Org-mode."
797 :tag "Org Cycle"
798 :group 'org-structure)
634a7d0b 799
c8d0cf5c 800(defcustom org-cycle-skip-children-state-if-no-children t
ed21c5c8 801 "Non-nil means skip CHILDREN state in entries that don't have any."
c8d0cf5c
CD
802 :group 'org-cycle
803 :type 'boolean)
804
805(defcustom org-cycle-max-level nil
806 "Maximum level which should still be subject to visibility cycling.
807Levels higher than this will, for cycling, be treated as text, not a headline.
808When `org-odd-levels-only' is set, a value of N in this variable actually
809means 2N-1 stars as the limiting headline.
810When nil, cycle all levels.
811Note that the limiting level of cycling is also influenced by
812`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but
813`org-inlinetask-min-level' is, cycling will be limited to levels one less
814than its value."
815 :group 'org-cycle
816 :type '(choice
817 (const :tag "No limit" nil)
818 (integer :tag "Maximum level")))
819
820(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK")
5152b597
CD
821 "Names of drawers. Drawers are not opened by cycling on the headline above.
822Drawers only open with a TAB on the drawer line itself. A drawer looks like
823this:
824 :DRAWERNAME:
825 .....
38f8646b
CD
826 :END:
827The drawer \"PROPERTIES\" is special for capturing properties through
03f3cf35
JW
828the property API.
829
830Drawers can be defined on the per-file basis with a line like:
831
832#+DRAWERS: HIDDEN STATE PROPERTIES"
5152b597 833 :group 'org-structure
c8d0cf5c 834 :group 'org-cycle
5152b597
CD
835 :type '(repeat (string :tag "Drawer Name")))
836
c8d0cf5c 837(defcustom org-hide-block-startup nil
ed21c5c8 838 "Non-nil means entering Org-mode will fold all blocks.
c8d0cf5c
CD
839This can also be set in on a per-file basis with
840
841#+STARTUP: hideblocks
842#+STARTUP: showblocks"
843 :group 'org-startup
844 :group 'org-cycle
845 :type 'boolean)
846
374585c9 847(defcustom org-cycle-global-at-bob nil
4b3a9ba7
CD
848 "Cycle globally if cursor is at beginning of buffer and not at a headline.
849This makes it possible to do global cycling without having to use S-TAB or
86fbb8ca
CD
850\\[universal-argument] TAB. For this special case to work, the first line \
851of the buffer
20106e31 852must not be a headline - it may be empty or some other text. When used in
4b3a9ba7
CD
853this way, `org-cycle-hook' is disables temporarily, to make sure the
854cursor stays at the beginning of the buffer.
855When this option is nil, don't do anything special at the beginning
856of the buffer."
857 :group 'org-cycle
858 :type 'boolean)
859
8bfe682a 860(defcustom org-cycle-level-after-item/entry-creation t
ed21c5c8 861 "Non-nil means cycle entry level or item indentation in new empty entries.
8bfe682a
CD
862
863When the cursor is at the end of an empty headline, i.e with only stars
864and maybe a TODO keyword, TAB will then switch the entry to become a child,
86fbb8ca 865and then all possible ancestor states, before returning to the original state.
8bfe682a
CD
866This makes data entry extremely fast: M-RET to create a new headline,
867on TAB to make it a child, two or more tabs to make it a (grand-)uncle.
868
869When the cursor is at the end of an empty plain list item, one TAB will
870make it a subitem, two or more tabs will back up to make this an item
871higher up in the item hierarchy."
872 :group 'org-cycle
873 :type 'boolean)
874
ab27a4a0
CD
875(defcustom org-cycle-emulate-tab t
876 "Where should `org-cycle' emulate TAB.
7d143c25
CD
877nil Never
878white Only in completely white lines
a0d892d4 879whitestart Only at the beginning of lines, before the first non-white char
7d143c25 880t Everywhere except in headlines
a3fbe8c4 881exc-hl-bol Everywhere except at the start of a headline
7d143c25
CD
882If TAB is used in a place where it does not emulate TAB, the current subtree
883visibility is cycled."
ab27a4a0
CD
884 :group 'org-cycle
885 :type '(choice (const :tag "Never" nil)
886 (const :tag "Only in completely white lines" white)
7d143c25 887 (const :tag "Before first char in a line" whitestart)
ab27a4a0 888 (const :tag "Everywhere except in headlines" t)
a3fbe8c4 889 (const :tag "Everywhere except at bol in headlines" exc-hl-bol)
ab27a4a0 890 ))
094f65d4 891
a3fbe8c4
CD
892(defcustom org-cycle-separator-lines 2
893 "Number of empty lines needed to keep an empty line between collapsed trees.
894If you leave an empty line between the end of a subtree and the following
895headline, this empty line is hidden when the subtree is folded.
896Org-mode will leave (exactly) one empty line visible if the number of
897empty lines is equal or larger to the number given in this variable.
ed21c5c8 898So the default 2 means at least 2 empty lines after the end of a subtree
a3fbe8c4
CD
899are needed to produce free space between a collapsed subtree and the
900following headline.
901
54a0dee5
CD
902If the number is negative, and the number of empty lines is at least -N,
903all empty lines are shown.
904
a3fbe8c4
CD
905Special case: when 0, never leave empty lines in collapsed view."
906 :group 'org-cycle
907 :type 'integer)
621f83e4 908(put 'org-cycle-separator-lines 'safe-local-variable 'integerp)
a3fbe8c4 909
c8d0cf5c
CD
910(defcustom org-pre-cycle-hook nil
911 "Hook that is run before visibility cycling is happening.
912The function(s) in this hook must accept a single argument which indicates
913the new state that will be set right after running this hook. The
914argument is a symbol. Before a global state change, it can have the values
915`overview', `content', or `all'. Before a local state change, it can have
916the values `folded', `children', or `subtree'."
917 :group 'org-cycle
918 :type 'hook)
919
6769c0dc 920(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
5152b597 921 org-cycle-hide-drawers
a3fbe8c4 922 org-cycle-show-empty-lines
6769c0dc 923 org-optimize-window-after-visibility-change)
ab27a4a0
CD
924 "Hook that is run after `org-cycle' has changed the buffer visibility.
925The function(s) in this hook must accept a single argument which indicates
926the new state that was set by the most recent `org-cycle' command. The
927argument is a symbol. After a global state change, it can have the values
928`overview', `content', or `all'. After a local state change, it can have
929the values `folded', `children', or `subtree'."
930 :group 'org-cycle
931 :type 'hook)
094f65d4 932
ab27a4a0
CD
933(defgroup org-edit-structure nil
934 "Options concerning structure editing in Org-mode."
935 :tag "Org Edit Structure"
936 :group 'org-structure)
634a7d0b 937
2a57416f 938(defcustom org-odd-levels-only nil
ed21c5c8 939 "Non-nil means skip even levels and only use odd levels for the outline.
2a57416f
CD
940This has the effect that two stars are being added/taken away in
941promotion/demotion commands. It also influences how levels are
942handled by the exporters.
943Changing it requires restart of `font-lock-mode' to become effective
944for fontification also in regions already fontified.
945You may also set this on a per-file basis by adding one of the following
946lines to the buffer:
947
948 #+STARTUP: odd
949 #+STARTUP: oddeven"
950 :group 'org-edit-structure
ed21c5c8 951 :group 'org-appearance
2a57416f
CD
952 :type 'boolean)
953
954(defcustom org-adapt-indentation t
ed21c5c8 955 "Non-nil means adapt indentation to outline node level.
c8d0cf5c
CD
956
957When this variable is set, Org assumes that you write outlines by
958indenting text in each node to align with the headline (after the stars).
959The following issues are influenced by this variable:
960
961- When this is set and the *entire* text in an entry is indented, the
962 indentation is increased by one space in a demotion command, and
963 decreased by one in a promotion command. If any line in the entry
964 body starts with text at column 0, indentation is not changed at all.
965
966- Property drawers and planning information is inserted indented when
967 this variable s set. When nil, they will not be indented.
968
969- TAB indents a line relative to context. The lines below a headline
970 will be indented when this variable is set.
971
972Note that this is all about true indentation, by adding and removing
973space characters. See also `org-indent.el' which does level-dependent
974indentation in a virtual way, i.e. at display time in Emacs."
2a57416f
CD
975 :group 'org-edit-structure
976 :type 'boolean)
977
1e8fbb6d 978(defcustom org-special-ctrl-a/e nil
48aaad2d 979 "Non-nil means `C-a' and `C-e' behave specially in headlines and items.
c8d0cf5c 980
374585c9 981When t, `C-a' will bring back the cursor to the beginning of the
a3fbe8c4 982headline text, i.e. after the stars and after a possible TODO keyword.
48aaad2d 983In an item, this will be the position after the bullet.
a3fbe8c4 984When the cursor is already at that position, another `C-a' will bring
1e8fbb6d 985it to the beginning of the line.
c8d0cf5c 986
1e8fbb6d
CD
987`C-e' will jump to the end of the headline, ignoring the presence of tags
988in the headline. A second `C-e' will then jump to the true end of the
8d642074
CD
989line, after any tags. This also means that, when this variable is
990non-nil, `C-e' also will never jump beyond the end of the heading of a
991folded section, i.e. not after the ellipses.
c8d0cf5c 992
374585c9 993When set to the symbol `reversed', the first `C-a' or `C-e' works normally,
c8d0cf5c
CD
994going to the true line boundary first. Only a directly following, identical
995keypress will bring the cursor to the special positions.
996
997This may also be a cons cell where the behavior for `C-a' and `C-e' is
998set separately."
a3fbe8c4 999 :group 'org-edit-structure
374585c9
CD
1000 :type '(choice
1001 (const :tag "off" nil)
8d642074
CD
1002 (const :tag "on: after stars/bullet and before tags first" t)
1003 (const :tag "reversed: true line boundary first" reversed)
c8d0cf5c
CD
1004 (cons :tag "Set C-a and C-e separately"
1005 (choice :tag "Special C-a"
1006 (const :tag "off" nil)
8d642074
CD
1007 (const :tag "on: after stars/bullet first" t)
1008 (const :tag "reversed: before stars/bullet first" reversed))
c8d0cf5c
CD
1009 (choice :tag "Special C-e"
1010 (const :tag "off" nil)
8d642074
CD
1011 (const :tag "on: before tags first" t)
1012 (const :tag "reversed: after tags first" reversed)))))
1e8fbb6d
CD
1013(if (fboundp 'defvaralias)
1014 (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e))
1015
2a57416f
CD
1016(defcustom org-special-ctrl-k nil
1017 "Non-nil means `C-k' will behave specially in headlines.
1018When nil, `C-k' will call the default `kill-line' command.
1019When t, the following will happen while the cursor is in the headline:
4146eb16 1020
2a57416f
CD
1021- When the cursor is at the beginning of a headline, kill the entire
1022 line and possible the folded subtree below the line.
1023- When in the middle of the headline text, kill the headline up to the tags.
1024- When after the headline text, kill the tags."
ab27a4a0 1025 :group 'org-edit-structure
ab27a4a0 1026 :type 'boolean)
891f4676 1027
86fbb8ca
CD
1028(defcustom org-ctrl-k-protect-subtree nil
1029 "Non-nil means, do not delete a hidden subtree with C-k.
1030When set to the symbol `error', simply throw an error when C-k is
1031used to kill (part-of) a headline that has hidden text behind it.
1032Any other non-nil value will result in a query to the user, if it is
1033OK to kill that hidden subtree. When nil, kill without remorse."
1034 :group 'org-edit-structure
1035 :type '(choice
1036 (const :tag "Do not protect hidden subtrees" nil)
1037 (const :tag "Protect hidden subtrees with a security query" t)
1038 (const :tag "Never kill a hidden subtree with C-k" error)))
1039
621f83e4 1040(defcustom org-yank-folded-subtrees t
ed21c5c8 1041 "Non-nil means when yanking subtrees, fold them.
621f83e4
CD
1042If the kill is a single subtree, or a sequence of subtrees, i.e. if
1043it starts with a heading and all other headings in it are either children
93b62de8
CD
1044or siblings, then fold all the subtrees. However, do this only if no
1045text after the yank would be swallowed into a folded tree by this action."
1046 :group 'org-edit-structure
1047 :type 'boolean)
1048
5ace2fe5 1049(defcustom org-yank-adjusted-subtrees nil
ed21c5c8 1050 "Non-nil means when yanking subtrees, adjust the level.
93b62de8
CD
1051With this setting, `org-paste-subtree' is used to insert the subtree, see
1052this function for details."
621f83e4
CD
1053 :group 'org-edit-structure
1054 :type 'boolean)
1055
2a57416f 1056(defcustom org-M-RET-may-split-line '((default . t))
ed21c5c8 1057 "Non-nil means M-RET will split the line at the cursor position.
2a57416f
CD
1058When nil, it will go to the end of the line before making a
1059new line.
1060You may also set this option in a different way for different
1061contexts. Valid contexts are:
1062
1063headline when creating a new headline
1064item when creating a new item
1065table in a table field
1066default the value to be used for all contexts not explicitly
1067 customized"
1068 :group 'org-structure
1069 :group 'org-table
1070 :type '(choice
1071 (const :tag "Always" t)
1072 (const :tag "Never" nil)
1073 (repeat :greedy t :tag "Individual contexts"
1074 (cons
1075 (choice :tag "Context"
1076 (const headline)
1077 (const item)
1078 (const table)
1079 (const default))
1080 (boolean)))))
1081
30313b90 1082
621f83e4 1083(defcustom org-insert-heading-respect-content nil
ed21c5c8 1084 "Non-nil means insert new headings after the current subtree.
621f83e4
CD
1085When nil, the new heading is created directly after the current line.
1086The commands \\[org-insert-heading-respect-content] and
1087\\[org-insert-todo-heading-respect-content] turn this variable on
1088for the duration of the command."
1089 :group 'org-structure
1090 :type 'boolean)
1091
0bd48b37
CD
1092(defcustom org-blank-before-new-entry '((heading . auto)
1093 (plain-list-item . auto))
3278a016 1094 "Should `org-insert-heading' leave a blank line before new heading/item?
3ab2c837
BG
1095The value is an alist, with `heading' and `plain-list-item' as CAR,
1096and a boolean flag as CDR. The cdr may also be the symbol `auto', in
1097which case Org will look at the surrounding headings/items and try to
1098make an intelligent decision whether to insert a blank line or not.
afe98dfa
CD
1099
1100For plain lists, if the variable `org-empty-line-terminates-plain-lists' is
1101set, the setting here is ignored and no empty line is inserted, to avoid
1102breaking the list structure."
3278a016
CD
1103 :group 'org-edit-structure
1104 :type '(list
0bd48b37
CD
1105 (cons (const heading)
1106 (choice (const :tag "Never" nil)
1107 (const :tag "Always" t)
1108 (const :tag "Auto" auto)))
1109 (cons (const plain-list-item)
1110 (choice (const :tag "Never" nil)
1111 (const :tag "Always" t)
1112 (const :tag "Auto" auto)))))
3278a016 1113
4b3a9ba7
CD
1114(defcustom org-insert-heading-hook nil
1115 "Hook being run after inserting a new heading."
1116 :group 'org-edit-structure
8c6fb58b 1117 :type 'hook)
4b3a9ba7 1118
ab27a4a0 1119(defcustom org-enable-fixed-width-editor t
ed21c5c8
CD
1120 "Non-nil means lines starting with \":\" are treated as fixed-width.
1121This currently only means they are never auto-wrapped.
ab27a4a0
CD
1122When nil, such lines will be treated like ordinary lines.
1123See also the QUOTE keyword."
1124 :group 'org-edit-structure
1125 :type 'boolean)
30313b90 1126
2a57416f 1127(defcustom org-goto-auto-isearch t
86fbb8ca 1128 "Non-nil means typing characters in `org-goto' starts incremental search."
2a57416f
CD
1129 :group 'org-edit-structure
1130 :type 'boolean)
1131
ab27a4a0
CD
1132(defgroup org-sparse-trees nil
1133 "Options concerning sparse trees in Org-mode."
1134 :tag "Org Sparse Trees"
1135 :group 'org-structure)
891f4676 1136
ab27a4a0 1137(defcustom org-highlight-sparse-tree-matches t
ed21c5c8 1138 "Non-nil means highlight all matches that define a sparse tree.
ab27a4a0
CD
1139The highlights will automatically disappear the next time the buffer is
1140changed by an edit command."
1141 :group 'org-sparse-trees
15f43010 1142 :type 'boolean)
891f4676 1143
3278a016 1144(defcustom org-remove-highlights-with-change t
ed21c5c8 1145 "Non-nil means any change to the buffer will remove temporary highlights.
3278a016
CD
1146Such highlights are created by `org-occur' and `org-clock-display'.
1147When nil, `C-c C-c needs to be used to get rid of the highlights.
1148The highlights created by `org-preview-latex-fragment' always need
1149`C-c C-c' to be removed."
ab27a4a0 1150 :group 'org-sparse-trees
3278a016 1151 :group 'org-time
891f4676
RS
1152 :type 'boolean)
1153
7ac93e3c 1154
ab27a4a0
CD
1155(defcustom org-occur-hook '(org-first-headline-recenter)
1156 "Hook that is run after `org-occur' has constructed a sparse tree.
1157This can be used to recenter the window to show as much of the structure
1158as possible."
1159 :group 'org-sparse-trees
1160 :type 'hook)
d924f2e5 1161
8c6fb58b
CD
1162(defgroup org-imenu-and-speedbar nil
1163 "Options concerning imenu and speedbar in Org-mode."
1164 :tag "Org Imenu and Speedbar"
1165 :group 'org-structure)
1166
1167(defcustom org-imenu-depth 2
1168 "The maximum level for Imenu access to Org-mode headlines.
1169This also applied for speedbar access."
1170 :group 'org-imenu-and-speedbar
c8d0cf5c 1171 :type 'integer)
8c6fb58b 1172
ab27a4a0
CD
1173(defgroup org-table nil
1174 "Options concerning tables in Org-mode."
1175 :tag "Org Table"
1176 :group 'org)
eb2f9c59 1177
ab27a4a0 1178(defcustom org-enable-table-editor 'optimized
ed21c5c8 1179 "Non-nil means lines starting with \"|\" are handled by the table editor.
ab27a4a0 1180When nil, such lines will be treated like ordinary lines.
eb2f9c59 1181
ab27a4a0
CD
1182When equal to the symbol `optimized', the table editor will be optimized to
1183do the following:
3278a016
CD
1184- Automatic overwrite mode in front of whitespace in table fields.
1185 This makes the structure of the table stay in tact as long as the edited
ab27a4a0
CD
1186 field does not exceed the column width.
1187- Minimize the number of realigns. Normally, the table is aligned each time
1188 TAB or RET are pressed to move to another field. With optimization this
1189 happens only if changes to a field might have changed the column width.
1190Optimization requires replacing the functions `self-insert-command',
1191`delete-char', and `backward-delete-char' in Org-mode buffers, with a
1192slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
1193very good at guessing when a re-align will be necessary, but you can always
1194force one with \\[org-ctrl-c-ctrl-c].
eb2f9c59 1195
ab27a4a0
CD
1196If you would like to use the optimized version in Org-mode, but the
1197un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
eb2f9c59 1198
ab27a4a0
CD
1199This variable can be used to turn on and off the table editor during a session,
1200but in order to toggle optimization, a restart is required.
634a7d0b 1201
ab27a4a0
CD
1202See also the variable `org-table-auto-blank-field'."
1203 :group 'org-table
1204 :type '(choice
1205 (const :tag "off" nil)
1206 (const :tag "on" t)
1207 (const :tag "on, optimized" optimized)))
634a7d0b 1208
c8d0cf5c
CD
1209(defcustom org-self-insert-cluster-for-undo t
1210 "Non-nil means cluster self-insert commands for undo when possible.
8bfe682a 1211If this is set, then, like in the Emacs command loop, 20 consecutive
c8d0cf5c
CD
1212characters will be undone together.
1213This is configurable, because there is some impact on typing performance."
1214 :group 'org-table
1215 :type 'boolean)
1216
ab27a4a0 1217(defcustom org-table-tab-recognizes-table.el t
ed21c5c8 1218 "Non-nil means TAB will automatically notice a table.el table.
ab27a4a0
CD
1219When it sees such a table, it moves point into it and - if necessary -
1220calls `table-recognize-table'."
1221 :group 'org-table-editing
79c4be8e
CD
1222 :type 'boolean)
1223
891f4676
RS
1224(defgroup org-link nil
1225 "Options concerning links in Org-mode."
1226 :tag "Org Link"
1227 :group 'org)
1228
3278a016 1229(defvar org-link-abbrev-alist-local nil
a3fbe8c4 1230 "Buffer-local version of `org-link-abbrev-alist', which see.
3278a016
CD
1231The value of this is taken from the #+LINK lines.")
1232(make-variable-buffer-local 'org-link-abbrev-alist-local)
1233
1234(defcustom org-link-abbrev-alist nil
1235 "Alist of link abbreviations.
1236The car of each element is a string, to be replaced at the start of a link.
1237The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated
1238links in Org-mode buffers can have an optional tag after a double colon, e.g.
1239
d3f4dbe8 1240 [[linkkey:tag][description]]
3278a016 1241
c8d0cf5c
CD
1242The 'linkkey' must be a word word, starting with a letter, followed
1243by letters, numbers, '-' or '_'.
1244
3278a016 1245If REPLACE is a string, the tag will simply be appended to create the link.
ce4fdcb9
CD
1246If the string contains \"%s\", the tag will be inserted there. Alternatively,
1247the placeholder \"%h\" will cause a url-encoded version of the tag to
1248be inserted at that point (see the function `url-hexify-string').
8c6fb58b
CD
1249
1250REPLACE may also be a function that will be called with the tag as the
1251only argument to create the link, which should be returned as a string.
1252
1253See the manual for examples."
3278a016 1254 :group 'org-link
93b62de8
CD
1255 :type '(repeat
1256 (cons
1257 (string :tag "Protocol")
1258 (choice
1259 (string :tag "Format")
1260 (function)))))
3278a016 1261
ab27a4a0 1262(defcustom org-descriptive-links t
ed21c5c8 1263 "Non-nil means hide link part and only show description of bracket links.
33306645 1264Bracket links are like [[link][description]]. This variable sets the initial
ab27a4a0
CD
1265state in new org-mode buffers. The setting can then be toggled on a
1266per-buffer basis from the Org->Hyperlinks menu."
4da1a99d
CD
1267 :group 'org-link
1268 :type 'boolean)
1269
4b3a9ba7
CD
1270(defcustom org-link-file-path-type 'adaptive
1271 "How the path name in file links should be stored.
1272Valid values are:
1273
a0d892d4 1274relative Relative to the current directory, i.e. the directory of the file
4b3a9ba7 1275 into which the link is being inserted.
a0d892d4
JB
1276absolute Absolute path, if possible with ~ for home directory.
1277noabbrev Absolute path, no abbreviation of home directory.
4b3a9ba7
CD
1278adaptive Use relative path for files in the current directory and sub-
1279 directories of it. For other files, use an absolute path."
1280 :group 'org-link
1281 :type '(choice
1282 (const relative)
1283 (const absolute)
1284 (const noabbrev)
1285 (const adaptive)))
1286
0bd48b37 1287(defcustom org-activate-links '(bracket angle plain radio tag date footnote)
ab27a4a0
CD
1288 "Types of links that should be activated in Org-mode files.
1289This is a list of symbols, each leading to the activation of a certain link
1290type. In principle, it does not hurt to turn on most link types - there may
1291be a small gain when turning off unused link types. The types are:
1292
1293bracket The recommended [[link][description]] or [[link]] links with hiding.
afe98dfa 1294angle Links in angular brackets that may contain whitespace like
ab27a4a0
CD
1295 <bbdb:Carsten Dominik>.
1296plain Plain links in normal text, no whitespace, like http://google.com.
1297radio Text that is matched by a radio target, see manual for details.
1298tag Tag settings in a headline (link to tag search).
1299date Time stamps (link to calendar).
0bd48b37 1300footnote Footnote labels.
ab27a4a0
CD
1301
1302Changing this variable requires a restart of Emacs to become effective."
a96ee7df 1303 :group 'org-link
0bd48b37 1304 :type '(set :greedy t
afe98dfa
CD
1305 (const :tag "Double bracket links" bracket)
1306 (const :tag "Angular bracket links" angle)
2a57416f 1307 (const :tag "Plain text links" plain)
ab27a4a0
CD
1308 (const :tag "Radio target matches" radio)
1309 (const :tag "Tags" tag)
0bd48b37
CD
1310 (const :tag "Timestamps" date)
1311 (const :tag "Footnotes" footnote)))
ab27a4a0 1312
20908596 1313(defcustom org-make-link-description-function nil
86fbb8ca
CD
1314 "Function to use to generate link descriptions from links.
1315If nil the link location will be used. This function must take
1316two parameters; the first is the link and the second the
1317description `org-insert-link' has generated, and should return the
1318description to use."
20908596
CD
1319 :group 'org-link
1320 :type 'function)
1321
ab27a4a0 1322(defgroup org-link-store nil
5bf7807a 1323 "Options concerning storing links in Org-mode."
ab27a4a0
CD
1324 :tag "Org Store Link"
1325 :group 'org-link)
891f4676 1326
d3f4dbe8
CD
1327(defcustom org-email-link-description-format "Email %c: %.30s"
1328 "Format of the description part of a link to an email or usenet message.
33306645 1329The following %-escapes will be replaced by corresponding information:
d3f4dbe8
CD
1330
1331%F full \"From\" field
1332%f name, taken from \"From\" field, address if no name
1333%T full \"To\" field
1334%t first name in \"To\" field, address if no name
33306645 1335%c correspondent. Usually \"from NAME\", but if you sent it yourself, it
d3f4dbe8
CD
1336 will be \"to NAME\". See also the variable `org-from-is-user-regexp'.
1337%s subject
3ab2c837 1338%d date
d3f4dbe8
CD
1339%m message-id.
1340
1341You may use normal field width specification between the % and the letter.
1342This is for example useful to limit the length of the subject.
1343
1344Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\""
1345 :group 'org-link-store
1346 :type 'string)
1347
1348(defcustom org-from-is-user-regexp
1349 (let (r1 r2)
1350 (when (and user-mail-address (not (string= user-mail-address "")))
1351 (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>")))
1352 (when (and user-full-name (not (string= user-full-name "")))
1353 (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>")))
1354 (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2)))
33306645 1355 "Regexp matched against the \"From:\" header of an email or usenet message.
d3f4dbe8
CD
1356It should match if the message is from the user him/herself."
1357 :group 'org-link-store
1358 :type 'regexp)
1359
c8d0cf5c 1360(defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id
ed21c5c8 1361 "Non-nil means storing a link to an Org file will use entry IDs.
db55f368
CD
1362
1363Note that before this variable is even considered, org-id must be loaded,
c8d0cf5c 1364so please customize `org-modules' and turn it on.
db55f368
CD
1365
1366The variable can have the following values:
1367
1368t Create an ID if needed to make a link to the current entry.
1369
1370create-if-interactive
1371 If `org-store-link' is called directly (interactively, as a user
1372 command), do create an ID to support the link. But when doing the
1373 job for remember, only use the ID if it already exists. The
1374 purpose of this setting is to avoid proliferation of unwanted
1375 IDs, just because you happen to be in an Org file when you
1376 call `org-remember' that automatically and preemptively
1377 creates a link. If you do want to get an ID link in a remember
1378 template to an entry not having an ID, create it first by
1379 explicitly creating a link to it, using `C-c C-l' first.
1380
c8d0cf5c
CD
1381create-if-interactive-and-no-custom-id
1382 Like create-if-interactive, but do not create an ID if there is
1383 a CUSTOM_ID property defined in the entry. This is the default.
1384
db55f368
CD
1385use-existing
1386 Use existing ID, do not create one.
1387
1388nil Never use an ID to make a link, instead link using a text search for
1389 the headline text."
1390 :group 'org-link-store
1391 :type '(choice
1392 (const :tag "Create ID to make link" t)
c8d0cf5c
CD
1393 (const :tag "Create if storing link interactively"
1394 create-if-interactive)
1395 (const :tag "Create if storing link interactively and no CUSTOM_ID is present"
1396 create-if-interactive-and-no-custom-id)
1397 (const :tag "Only use existing" use-existing)
db55f368
CD
1398 (const :tag "Do not use ID to create link" nil)))
1399
f425a6ea 1400(defcustom org-context-in-file-links t
ed21c5c8 1401 "Non-nil means file links from `org-store-link' contain context.
a96ee7df 1402A search string will be added to the file name with :: as separator and
01c35094 1403used to find the context when the link is activated by the command
3ab2c837
BG
1404`org-open-at-point'. When this option is t, the entire active region
1405will be placed in the search string of the file link. If set to a
acedf35c
CD
1406positive integer, only the first n lines of context will be stored.
1407
891f4676
RS
1408Using a prefix arg to the command \\[org-store-link] (`org-store-link')
1409negates this setting for the duration of the command."
ab27a4a0 1410 :group 'org-link-store
acedf35c 1411 :type '(choice boolean integer))
891f4676
RS
1412
1413(defcustom org-keep-stored-link-after-insertion nil
ed21c5c8 1414 "Non-nil means keep link in list for entire session.
891f4676
RS
1415
1416The command `org-store-link' adds a link pointing to the current
2dd9129f 1417location to an internal list. These links accumulate during a session.
891f4676
RS
1418The command `org-insert-link' can be used to insert links into any
1419Org-mode file (offering completion for all stored links). When this
634a7d0b 1420option is nil, every link which has been inserted once using \\[org-insert-link]
891f4676
RS
1421will be removed from the list, to make completing the unused links
1422more efficient."
ab27a4a0
CD
1423 :group 'org-link-store
1424 :type 'boolean)
1425
ab27a4a0 1426(defgroup org-link-follow nil
5bf7807a 1427 "Options concerning following links in Org-mode."
ab27a4a0
CD
1428 :tag "Org Follow Link"
1429 :group 'org-link)
1430
ce4fdcb9
CD
1431(defcustom org-link-translation-function nil
1432 "Function to translate links with different syntax to Org syntax.
1433This can be used to translate links created for example by the Planner
1434or emacs-wiki packages to Org syntax.
1435The function must accept two parameters, a TYPE containing the link
1436protocol name like \"rmail\" or \"gnus\" as a string, and the linked path,
1437which is everything after the link protocol. It should return a cons
33306645 1438with possibly modified values of type and path.
ce4fdcb9
CD
1439Org contains a function for this, so if you set this variable to
1440`org-translate-link-from-planner', you should be able follow many
1441links created by planner."
1442 :group 'org-link-follow
1443 :type 'function)
1444
2a57416f
CD
1445(defcustom org-follow-link-hook nil
1446 "Hook that is run after a link has been followed."
1447 :group 'org-link-follow
1448 :type 'hook)
1449
ab27a4a0 1450(defcustom org-tab-follows-link nil
ed21c5c8 1451 "Non-nil means on links TAB will follow the link.
c8d0cf5c
CD
1452Needs to be set before org.el is loaded.
1453This really should not be used, it does not make sense, and the
1454implementation is bad."
ab27a4a0
CD
1455 :group 'org-link-follow
1456 :type 'boolean)
1457
cc6dbcb7 1458(defcustom org-return-follows-link nil
86fbb8ca 1459 "Non-nil means on links RET will follow the link."
ab27a4a0 1460 :group 'org-link-follow
891f4676
RS
1461 :type 'boolean)
1462
2a57416f
CD
1463(defcustom org-mouse-1-follows-link
1464 (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
ed21c5c8 1465 "Non-nil means mouse-1 on a link will follow the link.
2a57416f 1466A longer mouse click will still set point. Does not work on XEmacs.
a4b39e39
CD
1467Needs to be set before org.el is loaded."
1468 :group 'org-link-follow
1469 :type 'boolean)
1470
ab27a4a0 1471(defcustom org-mark-ring-length 4
86fbb8ca 1472 "Number of different positions to be recorded in the ring.
ab27a4a0
CD
1473Changing this requires a restart of Emacs to work correctly."
1474 :group 'org-link-follow
33306645 1475 :type 'integer)
ab27a4a0 1476
afe98dfa
CD
1477(defcustom org-link-search-must-match-exact-headline 'query-to-create
1478 "Non-nil means internal links in Org files must exactly match a headline.
3ab2c837 1479When nil, the link search tries to match a phrase with all words
afe98dfa
CD
1480in the search text."
1481 :group 'org-link-follow
1482 :type '(choice
c5e87d10 1483 (const :tag "Use fuzzy text search" nil)
afe98dfa 1484 (const :tag "Match only exact headline" t)
4c36be58 1485 (const :tag "Match exact headline or query to create it"
afe98dfa
CD
1486 query-to-create)))
1487
891f4676
RS
1488(defcustom org-link-frame-setup
1489 '((vm . vm-visit-folder-other-frame)
86fbb8ca
CD
1490 (gnus . org-gnus-no-new-news)
1491 (file . find-file-other-window)
1492 (wl . wl-other-frame))
891f4676
RS
1493 "Setup the frame configuration for following links.
1494When following a link with Emacs, it may often be useful to display
1495this link in another window or frame. This variable can be used to
1496set this up for the different types of links.
1497For VM, use any of
634a7d0b 1498 `vm-visit-folder'
3ab2c837 1499 `vm-visit-folder-other-window'
634a7d0b 1500 `vm-visit-folder-other-frame'
891f4676 1501For Gnus, use any of
634a7d0b
CD
1502 `gnus'
1503 `gnus-other-frame'
93b62de8 1504 `org-gnus-no-new-news'
891f4676 1505For FILE, use any of
634a7d0b
CD
1506 `find-file'
1507 `find-file-other-window'
1508 `find-file-other-frame'
86fbb8ca
CD
1509For Wanderlust use any of
1510 `wl'
1511 `wl-other-frame'
891f4676
RS
1512For the calendar, use the variable `calendar-setup'.
1513For BBDB, it is currently only possible to display the matches in
1514another window."
ab27a4a0 1515 :group 'org-link-follow
891f4676 1516 :type '(list
c8d16429
CD
1517 (cons (const vm)
1518 (choice
1519 (const vm-visit-folder)
1520 (const vm-visit-folder-other-window)
1521 (const vm-visit-folder-other-frame)))
1522 (cons (const gnus)
1523 (choice
1524 (const gnus)
93b62de8
CD
1525 (const gnus-other-frame)
1526 (const org-gnus-no-new-news)))
c8d16429
CD
1527 (cons (const file)
1528 (choice
1529 (const find-file)
1530 (const find-file-other-window)
86fbb8ca
CD
1531 (const find-file-other-frame)))
1532 (cons (const wl)
1533 (choice
1534 (const wl)
1535 (const wl-other-frame)))))
891f4676 1536
3278a016 1537(defcustom org-display-internal-link-with-indirect-buffer nil
ed21c5c8 1538 "Non-nil means use indirect buffer to display infile links.
3278a016
CD
1539Activating internal links (from one location in a file to another location
1540in the same file) normally just jumps to the location. When the link is
86fbb8ca
CD
1541activated with a \\[universal-argument] prefix (or with mouse-3), the link \
1542is displayed in
3278a016
CD
1543another window. When this option is set, the other window actually displays
1544an indirect buffer clone of the current buffer, to avoid any visibility
1545changes to the current buffer."
1546 :group 'org-link-follow
1547 :type 'boolean)
1548
891f4676 1549(defcustom org-open-non-existing-files nil
ed21c5c8 1550 "Non-nil means `org-open-file' will open non-existing files.
c8d0cf5c
CD
1551When nil, an error will be generated.
1552This variable applies only to external applications because they
1553might choke on non-existing files. If the link is to a file that
8bfe682a 1554will be opened in Emacs, the variable is ignored."
ab27a4a0 1555 :group 'org-link-follow
891f4676
RS
1556 :type 'boolean)
1557
2c3ad40d 1558(defcustom org-open-directory-means-index-dot-org nil
ed21c5c8 1559 "Non-nil means a link to a directory really means to index.org.
2c3ad40d
CD
1560When nil, following a directory link will run dired or open a finder/explorer
1561window on that directory."
1562 :group 'org-link-follow
1563 :type 'boolean)
1564
3278a016
CD
1565(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s")
1566 "Function and arguments to call for following mailto links.
86fbb8ca 1567This is a list with the first element being a Lisp function, and the
3278a016
CD
1568remaining elements being arguments to the function. In string arguments,
1569%a will be replaced by the address, and %s will be replaced by the subject
1570if one was given like in <mailto:arthur@galaxy.org::this subject>."
1571 :group 'org-link-follow
1572 :type '(choice
1573 (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s"))
1574 (const :tag "compose-mail" (compose-mail "%a" "%s"))
1575 (const :tag "message-mail" (message-mail "%a" "%s"))
1576 (cons :tag "other" (function) (repeat :tag "argument" sexp))))
1577
4b3a9ba7 1578(defcustom org-confirm-shell-link-function 'yes-or-no-p
ed21c5c8 1579 "Non-nil means ask for confirmation before executing shell links.
03f3cf35 1580Shell links can be dangerous: just think about a link
ab27a4a0
CD
1581
1582 [[shell:rm -rf ~/*][Google Search]]
1583
03f3cf35 1584This link would show up in your Org-mode document as \"Google Search\",
4b3a9ba7 1585but really it would remove your entire home directory.
03f3cf35 1586Therefore we advise against setting this variable to nil.
c8d0cf5c 1587Just change it to `y-or-n-p' if you want to confirm with a
03f3cf35 1588single keystroke rather than having to type \"yes\"."
4b3a9ba7
CD
1589 :group 'org-link-follow
1590 :type '(choice
1591 (const :tag "with yes-or-no (safer)" yes-or-no-p)
1592 (const :tag "with y-or-n (faster)" y-or-n-p)
1593 (const :tag "no confirmation (dangerous)" nil)))
86fbb8ca
CD
1594(put 'org-confirm-shell-link-function
1595 'safe-local-variable
3ab2c837
BG
1596 #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
1597
1598(defcustom org-confirm-shell-link-not-regexp ""
1599 "A regexp to skip confirmation for shell links."
1600 :group 'org-link-follow
1601 :type 'regexp)
4b3a9ba7
CD
1602
1603(defcustom org-confirm-elisp-link-function 'yes-or-no-p
ed21c5c8 1604 "Non-nil means ask for confirmation before executing Emacs Lisp links.
03f3cf35 1605Elisp links can be dangerous: just think about a link
4b3a9ba7
CD
1606
1607 [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
1608
03f3cf35 1609This link would show up in your Org-mode document as \"Google Search\",
4b3a9ba7 1610but really it would remove your entire home directory.
03f3cf35 1611Therefore we advise against setting this variable to nil.
c8d0cf5c 1612Just change it to `y-or-n-p' if you want to confirm with a
03f3cf35 1613single keystroke rather than having to type \"yes\"."
ab27a4a0
CD
1614 :group 'org-link-follow
1615 :type '(choice
1616 (const :tag "with yes-or-no (safer)" yes-or-no-p)
1617 (const :tag "with y-or-n (faster)" y-or-n-p)
1618 (const :tag "no confirmation (dangerous)" nil)))
86fbb8ca
CD
1619(put 'org-confirm-shell-link-function
1620 'safe-local-variable
3ab2c837
BG
1621 #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
1622
1623(defcustom org-confirm-elisp-link-not-regexp ""
1624 "A regexp to skip confirmation for Elisp links."
1625 :group 'org-link-follow
1626 :type 'regexp)
891f4676 1627
ee53c9b7 1628(defconst org-file-apps-defaults-gnu
6769c0dc 1629 '((remote . emacs)
93b62de8 1630 (system . mailcap)
6769c0dc 1631 (t . mailcap))
b0a10108 1632 "Default file applications on a UNIX or GNU/Linux system.
891f4676
RS
1633See `org-file-apps'.")
1634
1635(defconst org-file-apps-defaults-macosx
6769c0dc 1636 '((remote . emacs)
3278a016 1637 (t . "open %s")
93b62de8 1638 (system . "open %s")
891f4676 1639 ("ps.gz" . "gv %s")
891f4676
RS
1640 ("eps.gz" . "gv %s")
1641 ("dvi" . "xdvi %s")
1642 ("fig" . "xfig %s"))
1643 "Default file applications on a MacOS X system.
1644The system \"open\" is known as a default, but we use X11 applications
1645for some files for which the OS does not have a good default.
1646See `org-file-apps'.")
1647
1648(defconst org-file-apps-defaults-windowsnt
c44f0d75 1649 (list
6769c0dc
CD
1650 '(remote . emacs)
1651 (cons t
93b62de8
CD
1652 (list (if (featurep 'xemacs)
1653 'mswindows-shell-execute
1654 'w32-shell-execute)
1655 "open" 'file))
1656 (cons 'system
6769c0dc
CD
1657 (list (if (featurep 'xemacs)
1658 'mswindows-shell-execute
1659 'w32-shell-execute)
1660 "open" 'file)))
891f4676
RS
1661 "Default file applications on a Windows NT system.
1662The system \"open\" is used for most files.
1663See `org-file-apps'.")
1664
1665(defcustom org-file-apps
1666 '(
621f83e4 1667 (auto-mode . emacs)
8bfe682a 1668 ("\\.mm\\'" . default)
621f83e4 1669 ("\\.x?html?\\'" . default)
71d35b24 1670 ("\\.pdf\\'" . default)
891f4676
RS
1671 )
1672 "External applications for opening `file:path' items in a document.
1673Org-mode uses system defaults for different file types, but
1674you can use this variable to set the application for a given file
4b3a9ba7
CD
1675extension. The entries in this list are cons cells where the car identifies
1676files and the cdr the corresponding command. Possible values for the
1677file identifier are
86fbb8ca
CD
1678 \"string\" A string as a file identifier can be interpreted in different
1679 ways, depending on its contents:
1680
1681 - Alphanumeric characters only:
1682 Match links with this file extension.
1683 Example: (\"pdf\" . \"evince %s\")
1684 to open PDFs with evince.
1685
1686 - Regular expression: Match links where the
1687 filename matches the regexp. If you want to
1688 use groups here, use shy groups.
1689
1690 Example: (\"\\.x?html\\'\" . \"firefox %s\")
1691 (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\")
1692 to open *.html and *.xhtml with firefox.
1693
1694 - Regular expression which contains (non-shy) groups:
1695 Match links where the whole link, including \"::\", and
1696 anything after that, matches the regexp.
1697 In a custom command string, %1, %2, etc. are replaced with
1698 the parts of the link that were matched by the groups.
1699 For backwards compatibility, if a command string is given
1700 that does not use any of the group matches, this case is
1701 handled identically to the second one (i.e. match against
1702 file name only).
1703 In a custom lisp form, you can access the group matches with
1704 (match-string n link).
1705
1706 Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\")
1707 to open [[file:document.pdf::5]] with evince at page 5.
1708
4b3a9ba7 1709 `directory' Matches a directory
5137195a 1710 `remote' Matches a remote file, accessible through tramp or efs.
c44f0d75 1711 Remote files most likely should be visited through Emacs
6769c0dc 1712 because external applications cannot handle such paths.
33306645 1713`auto-mode' Matches files that are matched by any entry in `auto-mode-alist',
93b62de8 1714 so all files Emacs knows how to handle. Using this with
621f83e4 1715 command `emacs' will open most files in Emacs. Beware that this
33306645 1716 will also open html files inside Emacs, unless you add
621f83e4
CD
1717 (\"html\" . default) to the list as well.
1718 t Default for files not matched by any of the other options.
93b62de8
CD
1719 `system' The system command to open files, like `open' on Windows
1720 and Mac OS X, and mailcap under GNU/Linux. This is the command
1721 that will be selected if you call `C-c C-o' with a double
86fbb8ca 1722 \\[universal-argument] \\[universal-argument] prefix.
4b3a9ba7
CD
1723
1724Possible values for the command are:
1725 `emacs' The file will be visited by the current Emacs process.
621f83e4
CD
1726 `default' Use the default application for this file type, which is the
1727 association for t in the list, most likely in the system-specific
1728 part.
33306645 1729 This can be used to overrule an unwanted setting in the
621f83e4 1730 system-specific variable.
93b62de8
CD
1731 `system' Use the system command for opening files, like \"open\".
1732 This command is specified by the entry whose car is `system'.
1733 Most likely, the system-specific version of this variable
1734 does define this command, but you can overrule/replace it
1735 here.
4b3a9ba7 1736 string A command to be executed by a shell; %s will be replaced
86fbb8ca 1737 by the path to the file.
4b3a9ba7 1738 sexp A Lisp form which will be evaluated. The file path will
86fbb8ca 1739 be available in the Lisp variable `file'.
891f4676
RS
1740For more examples, see the system specific constants
1741`org-file-apps-defaults-macosx'
1742`org-file-apps-defaults-windowsnt'
ee53c9b7 1743`org-file-apps-defaults-gnu'."
ab27a4a0 1744 :group 'org-link-follow
891f4676 1745 :type '(repeat
a96ee7df
CD
1746 (cons (choice :value ""
1747 (string :tag "Extension")
93b62de8 1748 (const :tag "System command to open files" system)
a96ee7df 1749 (const :tag "Default for unrecognized files" t)
6769c0dc 1750 (const :tag "Remote file" remote)
621f83e4
CD
1751 (const :tag "Links to a directory" directory)
1752 (const :tag "Any files that have Emacs modes"
1753 auto-mode))
c8d16429 1754 (choice :value ""
a96ee7df 1755 (const :tag "Visit with Emacs" emacs)
93b62de8
CD
1756 (const :tag "Use default" default)
1757 (const :tag "Use the system command" system)
a96ee7df
CD
1758 (string :tag "Command")
1759 (sexp :tag "Lisp form")))))
891f4676 1760
86fbb8ca
CD
1761
1762
20908596
CD
1763(defgroup org-refile nil
1764 "Options concerning refiling entries in Org-mode."
d60b1ba1 1765 :tag "Org Refile"
891f4676
RS
1766 :group 'org)
1767
1768(defcustom org-directory "~/org"
1769 "Directory with org files.
c8d0cf5c
CD
1770This is just a default location to look for Org files. There is no need
1771at all to put your files into this directory. It is only used in the
1772following situations:
1773
17741. When a remember template specifies a target file that is not an
1775 absolute path. The path will then be interpreted relative to
1776 `org-directory'
17772. When a remember note is filed away in an interactive way (when exiting the
04e65fdb 1778 note buffer with `C-1 C-c C-c'. The user is prompted for an org file,
c8d0cf5c 1779 with `org-directory' as the default path."
20908596 1780 :group 'org-refile
891f4676
RS
1781 :group 'org-remember
1782 :type 'directory)
1783
0a505855 1784(defcustom org-default-notes-file (convert-standard-filename "~/.notes")
891f4676 1785 "Default target for storing notes.
86fbb8ca
CD
1786Used as a fall back file for org-remember.el and org-capture.el, for
1787templates that do not specify a target file."
20908596 1788 :group 'org-refile
891f4676
RS
1789 :group 'org-remember
1790 :type '(choice
c8d16429
CD
1791 (const :tag "Default from remember-data-file" nil)
1792 file))
891f4676 1793
2a57416f
CD
1794(defcustom org-goto-interface 'outline
1795 "The default interface to be used for `org-goto'.
33306645 1796Allowed values are:
2a57416f
CD
1797outline The interface shows an outline of the relevant file
1798 and the correct heading is found by moving through
1799 the outline or by searching with incremental search.
1800outline-path-completion Headlines in the current buffer are offered via
d60b1ba1
CD
1801 completion. This is the interface also used by
1802 the refile command."
20908596 1803 :group 'org-refile
2a57416f
CD
1804 :type '(choice
1805 (const :tag "Outline" outline)
1806 (const :tag "Outline-path-completion" outline-path-completion)))
8c6fb58b 1807
db55f368 1808(defcustom org-goto-max-level 5
86fbb8ca 1809 "Maximum target level when running `org-goto' with refile interface."
db55f368 1810 :group 'org-refile
c8d0cf5c 1811 :type 'integer)
db55f368 1812
891f4676 1813(defcustom org-reverse-note-order nil
ed21c5c8 1814 "Non-nil means store new notes at the beginning of a file or entry.
8c6fb58b
CD
1815When nil, new notes will be filed to the end of a file or entry.
1816This can also be a list with cons cells of regular expressions that
1817are matched against file names, and values."
891f4676 1818 :group 'org-remember
d60b1ba1 1819 :group 'org-refile
891f4676 1820 :type '(choice
c8d16429
CD
1821 (const :tag "Reverse always" t)
1822 (const :tag "Reverse never" nil)
1823 (repeat :tag "By file name regexp"
1824 (cons regexp boolean))))
891f4676 1825
ed21c5c8
CD
1826(defcustom org-log-refile nil
1827 "Information to record when a task is refiled.
1828
1829Possible values are:
1830
1831nil Don't add anything
1832time Add a time stamp to the task
1833note Prompt for a note and add it with template `org-log-note-headings'
1834
1835This option can also be set with on a per-file-basis with
1836
1837 #+STARTUP: nologrefile
1838 #+STARTUP: logrefile
1839 #+STARTUP: lognoterefile
1840
1841You can have local logging settings for a subtree by setting the LOGGING
1842property to one or more of these keywords.
1843
1844When bulk-refiling from the agenda, the value `note' is forbidden and
1845will temporarily be changed to `time'."
1846 :group 'org-refile
1847 :group 'org-progress
1848 :type '(choice
1849 (const :tag "No logging" nil)
1850 (const :tag "Record timestamp" time)
1851 (const :tag "Record timestamp with note." note)))
1852
8c6fb58b
CD
1853(defcustom org-refile-targets nil
1854 "Targets for refiling entries with \\[org-refile].
1855This is list of cons cells. Each cell contains:
1856- a specification of the files to be considered, either a list of files,
20908596 1857 or a symbol whose function or variable value will be used to retrieve
fdf730ed 1858 a file name or a list of file names. If you use `org-agenda-files' for
afe98dfa
CD
1859 that, all agenda files will be scanned for targets. Nil means consider
1860 headings in the current buffer.
c8d0cf5c
CD
1861- A specification of how to find candidate refile targets. This may be
1862 any of:
8c6fb58b
CD
1863 - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
1864 This tag has to be present in all target headlines, inheritance will
1865 not be considered.
1866 - a cons cell (:todo . \"KEYWORD\") to identify refile targets by
1867 todo keyword.
1868 - a cons cell (:regexp . \"REGEXP\") with a regular expression matching
1869 headlines that are refiling targets.
1870 - a cons cell (:level . N). Any headline of level N is considered a target.
c8d0cf5c
CD
1871 Note that, when `org-odd-levels-only' is set, level corresponds to
1872 order in hierarchy, not to the number of stars.
3ab2c837 1873 - a cons cell (:maxlevel . N). Any headline with level <= N is a target.
c8d0cf5c
CD
1874 Note that, when `org-odd-levels-only' is set, level corresponds to
1875 order in hierarchy, not to the number of stars.
1876
1877You can set the variable `org-refile-target-verify-function' to a function
86fbb8ca 1878to verify each headline found by the simple criteria above.
621f83e4
CD
1879
1880When this variable is nil, all top-level headlines in the current buffer
93b62de8 1881are used, equivalent to the value `((nil . (:level . 1))'."
d60b1ba1 1882 :group 'org-refile
8c6fb58b
CD
1883 :type '(repeat
1884 (cons
1885 (choice :value org-agenda-files
1886 (const :tag "All agenda files" org-agenda-files)
1887 (const :tag "Current buffer" nil)
1888 (function) (variable) (file))
1889 (choice :tag "Identify target headline by"
ce4fdcb9
CD
1890 (cons :tag "Specific tag" (const :value :tag) (string))
1891 (cons :tag "TODO keyword" (const :value :todo) (string))
1892 (cons :tag "Regular expression" (const :value :regexp) (regexp))
1893 (cons :tag "Level number" (const :value :level) (integer))
1894 (cons :tag "Max Level number" (const :value :maxlevel) (integer))))))
8c6fb58b 1895
c8d0cf5c
CD
1896(defcustom org-refile-target-verify-function nil
1897 "Function to verify if the headline at point should be a refile target.
1898The function will be called without arguments, with point at the
1899beginning of the headline. It should return t and leave point
1900where it is if the headline is a valid target for refiling.
1901
1902If the target should not be selected, the function must return nil.
1903In addition to this, it may move point to a place from where the search
1904should be continued. For example, the function may decide that the entire
1905subtree of the current entry should be excluded and move point to the end
1906of the subtree."
1907 :group 'org-refile
1908 :type 'function)
1909
86fbb8ca
CD
1910(defcustom org-refile-use-cache nil
1911 "Non-nil means cache refile targets to speed up the process.
1912The cache for a particular file will be updated automatically when
1913the buffer has been killed, or when any of the marker used for flagging
1914refile targets no longer points at a live buffer.
1915If you have added new entries to a buffer that might themselves be targets,
1916you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you
1917find that easier, `C-u C-u C-u C-c C-w'."
1918 :group 'org-refile
1919 :type 'boolean)
1920
8c6fb58b 1921(defcustom org-refile-use-outline-path nil
ed21c5c8 1922 "Non-nil means provide refile targets as paths.
8c6fb58b 1923So a level 3 headline will be available as level1/level2/level3.
c8d0cf5c 1924
8c6fb58b 1925When the value is `file', also include the file name (without directory)
c8d0cf5c
CD
1926into the path. In this case, you can also stop the completion after
1927the file name, to get entries inserted as top level in the file.
1928
3ab2c837 1929When `full-file-path', include the full file path."
d60b1ba1 1930 :group 'org-refile
8c6fb58b
CD
1931 :type '(choice
1932 (const :tag "Not" nil)
1933 (const :tag "Yes" t)
1934 (const :tag "Start with file name" file)
1935 (const :tag "Start with full file path" full-file-path)))
1936
d60b1ba1 1937(defcustom org-outline-path-complete-in-steps t
ed21c5c8 1938 "Non-nil means complete the outline path in hierarchical steps.
d60b1ba1
CD
1939When Org-mode uses the refile interface to select an outline path
1940\(see variable `org-refile-use-outline-path'), the completion of
1941the path can be done is a single go, or if can be done in steps down
1942the headline hierarchy. Going in steps is probably the best if you
1943do not use a special completion package like `ido' or `icicles'.
1944However, when using these packages, going in one step can be very
1945fast, while still showing the whole path to the entry."
1946 :group 'org-refile
1947 :type 'boolean)
1948
c8d0cf5c 1949(defcustom org-refile-allow-creating-parent-nodes nil
ed21c5c8 1950 "Non-nil means allow to create new nodes as refile targets.
c8d0cf5c
CD
1951New nodes are then created by adding \"/new node name\" to the completion
1952of an existing node. When the value of this variable is `confirm',
1953new node creation must be confirmed by the user (recommended)
1954When nil, the completion must match an existing entry.
1955
1956Note that, if the new heading is not seen by the criteria
1957listed in `org-refile-targets', multiple instances of the same
1958heading would be created by trying again to file under the new
1959heading."
1960 :group 'org-refile
1961 :type '(choice
1962 (const :tag "Never" nil)
1963 (const :tag "Always" t)
1964 (const :tag "Prompt for confirmation" confirm)))
1965
ab27a4a0
CD
1966(defgroup org-todo nil
1967 "Options concerning TODO items in Org-mode."
1968 :tag "Org TODO"
891f4676
RS
1969 :group 'org)
1970
d3f4dbe8
CD
1971(defgroup org-progress nil
1972 "Options concerning Progress logging in Org-mode."
1973 :tag "Org Progress"
1974 :group 'org-time)
1975
c8d0cf5c 1976(defvar org-todo-interpretation-widgets
3ab2c837 1977 '((:tag "Sequence (cycling hits every state)" sequence)
c8d0cf5c 1978 (:tag "Type (cycling directly to DONE)" type))
86fbb8ca
CD
1979 "The available interpretation symbols for customizing `org-todo-keywords'.
1980Interested libraries should add to this list.")
c8d0cf5c 1981
a3fbe8c4
CD
1982(defcustom org-todo-keywords '((sequence "TODO" "DONE"))
1983 "List of TODO entry keyword sequences and their interpretation.
1984\\<org-mode-map>This is a list of sequences.
1985
1986Each sequence starts with a symbol, either `sequence' or `type',
1987indicating if the keywords should be interpreted as a sequence of
1988action steps, or as different types of TODO items. The first
1989keywords are states requiring action - these states will select a headline
1990for inclusion into the global TODO list Org-mode produces. If one of
acedf35c 1991the \"keywords\" is the vertical bar, \"|\", the remaining keywords
a3fbe8c4
CD
1992signify that no further action is necessary. If \"|\" is not found,
1993the last keyword is treated as the only DONE state of the sequence.
1994
1995The command \\[org-todo] cycles an entry through these states, and one
ab27a4a0 1996additional state where no keyword is present. For details about this
a3fbe8c4
CD
1997cycling, see the manual.
1998
1999TODO keywords and interpretation can also be set on a per-file basis with
2000the special #+SEQ_TODO and #+TYP_TODO lines.
2001
2a57416f
CD
2002Each keyword can optionally specify a character for fast state selection
2003\(in combination with the variable `org-use-fast-todo-selection')
2004and specifiers for state change logging, using the same syntax
2005that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says
86fbb8ca 2006that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\"
2a57416f
CD
2007indicates to record a time stamp each time this state is selected.
2008
2009Each keyword may also specify if a timestamp or a note should be
2010recorded when entering or leaving the state, by adding additional
2011characters in the parenthesis after the keyword. This looks like this:
2012\"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to
2013record only the time of the state change. With X and Y being either
2014\"@\" or \"!\", \"X/Y\" means use X when entering the state, and use
2015Y when leaving the state if and only if the *target* state does not
2016define X. You may omit any of the fast-selection key or X or /Y,
2017so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid.
2018
a3fbe8c4 2019For backward compatibility, this variable may also be just a list
33306645 2020of keywords - in this case the interpretation (sequence or type) will be
a3fbe8c4 2021taken from the (otherwise obsolete) variable `org-todo-interpretation'."
ab27a4a0
CD
2022 :group 'org-todo
2023 :group 'org-keywords
a3fbe8c4
CD
2024 :type '(choice
2025 (repeat :tag "Old syntax, just keywords"
2026 (string :tag "Keyword"))
2027 (repeat :tag "New syntax"
2028 (cons
2029 (choice
2030 :tag "Interpretation"
c8d0cf5c
CD
2031 ;;Quick and dirty way to see
2032 ;;`org-todo-interpretations'. This takes the
2033 ;;place of item arguments
2034 :convert-widget
2035 (lambda (widget)
2036 (widget-put widget
2037 :args (mapcar
2038 #'(lambda (x)
2039 (widget-convert
2040 (cons 'const x)))
2041 org-todo-interpretation-widgets))
2042 widget))
a3fbe8c4
CD
2043 (repeat
2044 (string :tag "Keyword"))))))
2045
2a57416f
CD
2046(defvar org-todo-keywords-1 nil
2047 "All TODO and DONE keywords active in a buffer.")
a3fbe8c4
CD
2048(make-variable-buffer-local 'org-todo-keywords-1)
2049(defvar org-todo-keywords-for-agenda nil)
2050(defvar org-done-keywords-for-agenda nil)
8d642074 2051(defvar org-drawers-for-agenda nil)
621f83e4
CD
2052(defvar org-todo-keyword-alist-for-agenda nil)
2053(defvar org-tag-alist-for-agenda nil)
20908596 2054(defvar org-agenda-contributing-files nil)
a3fbe8c4
CD
2055(defvar org-not-done-keywords nil)
2056(make-variable-buffer-local 'org-not-done-keywords)
2057(defvar org-done-keywords nil)
2058(make-variable-buffer-local 'org-done-keywords)
2059(defvar org-todo-heads nil)
2060(make-variable-buffer-local 'org-todo-heads)
2061(defvar org-todo-sets nil)
2062(make-variable-buffer-local 'org-todo-sets)
d5098885
JW
2063(defvar org-todo-log-states nil)
2064(make-variable-buffer-local 'org-todo-log-states)
a3fbe8c4
CD
2065(defvar org-todo-kwd-alist nil)
2066(make-variable-buffer-local 'org-todo-kwd-alist)
0b8568f5
JW
2067(defvar org-todo-key-alist nil)
2068(make-variable-buffer-local 'org-todo-key-alist)
2069(defvar org-todo-key-trigger nil)
2070(make-variable-buffer-local 'org-todo-key-trigger)
791d856f 2071
ab27a4a0
CD
2072(defcustom org-todo-interpretation 'sequence
2073 "Controls how TODO keywords are interpreted.
a3fbe8c4
CD
2074This variable is in principle obsolete and is only used for
2075backward compatibility, if the interpretation of todo keywords is
2076not given already in `org-todo-keywords'. See that variable for
2077more information."
ab27a4a0
CD
2078 :group 'org-todo
2079 :group 'org-keywords
2080 :type '(choice (const sequence)
2081 (const type)))
28e5b051 2082
5ace2fe5 2083(defcustom org-use-fast-todo-selection t
ed21c5c8 2084 "Non-nil means use the fast todo selection scheme with C-c C-t.
0b8568f5
JW
2085This variable describes if and under what circumstances the cycling
2086mechanism for TODO keywords will be replaced by a single-key, direct
2087selection scheme.
2088
2089When nil, fast selection is never used.
2090
2091When the symbol `prefix', it will be used when `org-todo' is called with
2092a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t'
2093in an agenda buffer.
2094
2095When t, fast selection is used by default. In this case, the prefix
2096argument forces cycling instead.
2097
2098In all cases, the special interface is only used if access keys have actually
2099been assigned by the user, i.e. if keywords in the configuration are followed
2100by a letter in parenthesis, like TODO(t)."
2101 :group 'org-todo
2102 :type '(choice
2103 (const :tag "Never" nil)
2104 (const :tag "By default" t)
2105 (const :tag "Only with C-u C-c C-t" prefix)))
2106
b349f79f 2107(defcustom org-provide-todo-statistics t
ed21c5c8 2108 "Non-nil means update todo statistics after insert and toggle.
c8d0cf5c
CD
2109ALL-HEADLINES means update todo statistics by including headlines
2110with no TODO keyword as well, counting them as not done.
2111A list of TODO keywords means the same, but skip keywords that are
2112not in this list.
2113
2114When this is set, todo statistics is updated in the parent of the
2115current entry each time a todo state is changed."
2116 :group 'org-todo
2117 :type '(choice
2118 (const :tag "Yes, only for TODO entries" t)
2119 (const :tag "Yes, including all entries" 'all-headlines)
2120 (repeat :tag "Yes, for TODOs in this list"
2121 (string :tag "TODO keyword"))
2122 (other :tag "No TODO statistics" nil)))
2123
2124(defcustom org-hierarchical-todo-statistics t
ed21c5c8 2125 "Non-nil means TODO statistics covers just direct children.
c8d0cf5c 2126When nil, all entries in the subtree are considered.
54a0dee5
CD
2127This has only an effect if `org-provide-todo-statistics' is set.
2128To set this to nil for only a single subtree, use a COOKIE_DATA
2129property and include the word \"recursive\" into the value."
b349f79f
CD
2130 :group 'org-todo
2131 :type 'boolean)
2132
ab27a4a0
CD
2133(defcustom org-after-todo-state-change-hook nil
2134 "Hook which is run after the state of a TODO item was changed.
2135The new state (a string with a TODO keyword, or nil) is available in the
2136Lisp variable `state'."
2137 :group 'org-todo
2138 :type 'hook)
891f4676 2139
d6685abc
CD
2140(defvar org-blocker-hook nil
2141 "Hook for functions that are allowed to block a state change.
2142
2143Each function gets as its single argument a property list, see
2144`org-trigger-hook' for more information about this list.
2145
2146If any of the functions in this hook returns nil, the state change
2147is blocked.")
2148
2149(defvar org-trigger-hook nil
2150 "Hook for functions that are triggered by a state change.
2151
2152Each function gets as its single argument a property list with at least
2153the following elements:
2154
2155 (:type type-of-change :position pos-at-entry-start
2156 :from old-state :to new-state)
2157
2158Depending on the type, more properties may be present.
2159
2160This mechanism is currently implemented for:
2161
2162TODO state changes
2163------------------
2164:type todo-state-change
2165:from previous state (keyword as a string), or nil, or a symbol
2166 'todo' or 'done', to indicate the general type of state.
2167:to new state, like in :from")
2168
2169(defcustom org-enforce-todo-dependencies nil
ed21c5c8 2170 "Non-nil means undone TODO entries will block switching the parent to DONE.
d6685abc
CD
2171Also, if a parent has an :ORDERED: property, switching an entry to DONE will
2172be blocked if any prior sibling is not yet done.
c8d0cf5c
CD
2173Finally, if the parent is blocked because of ordered siblings of its own,
2174the child will also be blocked.
5ace2fe5
CD
2175This variable needs to be set before org.el is loaded, and you need to
2176restart Emacs after a change to make the change effective. The only way
2177to change is while Emacs is running is through the customize interface."
d6685abc
CD
2178 :set (lambda (var val)
2179 (set var val)
2180 (if val
6c817206 2181 (add-hook 'org-blocker-hook
c8d0cf5c 2182 'org-block-todo-from-children-or-siblings-or-parent)
6c817206 2183 (remove-hook 'org-blocker-hook
c8d0cf5c 2184 'org-block-todo-from-children-or-siblings-or-parent)))
6c817206
CD
2185 :group 'org-todo
2186 :type 'boolean)
2187
2188(defcustom org-enforce-todo-checkbox-dependencies nil
ed21c5c8 2189 "Non-nil means unchecked boxes will block switching the parent to DONE.
6c817206
CD
2190When this is nil, checkboxes have no influence on switching TODO states.
2191When non-nil, you first need to check off all check boxes before the TODO
2192entry can be switched to DONE.
5ace2fe5
CD
2193This variable needs to be set before org.el is loaded, and you need to
2194restart Emacs after a change to make the change effective. The only way
2195to change is while Emacs is running is through the customize interface."
6c817206
CD
2196 :set (lambda (var val)
2197 (set var val)
2198 (if val
2199 (add-hook 'org-blocker-hook
2200 'org-block-todo-from-checkboxes)
2201 (remove-hook 'org-blocker-hook
2202 'org-block-todo-from-checkboxes)))
d6685abc
CD
2203 :group 'org-todo
2204 :type 'boolean)
2205
c8d0cf5c 2206(defcustom org-treat-insert-todo-heading-as-state-change nil
ed21c5c8 2207 "Non-nil means inserting a TODO heading is treated as state change.
c8d0cf5c
CD
2208So when the command \\[org-insert-todo-heading] is used, state change
2209logging will apply if appropriate. When nil, the new TODO item will
2210be inserted directly, and no logging will take place."
2211 :group 'org-todo
2212 :type 'boolean)
2213
2214(defcustom org-treat-S-cursor-todo-selection-as-state-change t
ed21c5c8 2215 "Non-nil means switching TODO states with S-cursor counts as state change.
c8d0cf5c
CD
2216This is the default behavior. However, setting this to nil allows a
2217convenient way to select a TODO state and bypass any logging associated
2218with that."
2219 :group 'org-todo
2220 :type 'boolean)
2221
71d35b24
CD
2222(defcustom org-todo-state-tags-triggers nil
2223 "Tag changes that should be triggered by TODO state changes.
2224This is a list. Each entry is
2225
2226 (state-change (tag . flag) .......)
2227
2228State-change can be a string with a state, and empty string to indicate the
2229state that has no TODO keyword, or it can be one of the symbols `todo'
2230or `done', meaning any not-done or done state, respectively."
2231 :group 'org-todo
2232 :group 'org-tags
2233 :type '(repeat
2234 (cons (choice :tag "When changing to"
2235 (const :tag "Not-done state" todo)
2236 (const :tag "Done state" done)
2237 (string :tag "State"))
2238 (repeat
2239 (cons :tag "Tag action"
2240 (string :tag "Tag")
2241 (choice (const :tag "Add" t) (const :tag "Remove" nil)))))))
2242
ab27a4a0 2243(defcustom org-log-done nil
db55f368
CD
2244 "Information to record when a task moves to the DONE state.
2245
2246Possible values are:
2247
2248nil Don't add anything, just change the keyword
2249time Add a time stamp to the task
8bfe682a 2250note Prompt for a note and add it with template `org-log-note-headings'
4b3a9ba7 2251
db55f368
CD
2252This option can also be set with on a per-file-basis with
2253
2254 #+STARTUP: nologdone
d3f4dbe8 2255 #+STARTUP: logdone
d3f4dbe8 2256 #+STARTUP: lognotedone
db55f368
CD
2257
2258You can have local logging settings for a subtree by setting the LOGGING
2259property to one or more of these keywords."
ab27a4a0 2260 :group 'org-todo
d3f4dbe8 2261 :group 'org-progress
3278a016 2262 :type '(choice
2a57416f
CD
2263 (const :tag "No logging" nil)
2264 (const :tag "Record CLOSED timestamp" time)
8bfe682a 2265 (const :tag "Record CLOSED timestamp with note." note)))
2a57416f
CD
2266
2267;; Normalize old uses of org-log-done.
2268(cond
2269 ((eq org-log-done t) (setq org-log-done 'time))
2270 ((and (listp org-log-done) (memq 'done org-log-done))
2271 (setq org-log-done 'note)))
2272
8bfe682a
CD
2273(defcustom org-log-reschedule nil
2274 "Information to record when the scheduling date of a tasks is modified.
2275
2276Possible values are:
2277
2278nil Don't add anything, just change the date
2279time Add a time stamp to the task
2280note Prompt for a note and add it with template `org-log-note-headings'
2281
2282This option can also be set with on a per-file-basis with
2283
2284 #+STARTUP: nologreschedule
2285 #+STARTUP: logreschedule
2286 #+STARTUP: lognotereschedule"
2287 :group 'org-todo
2288 :group 'org-progress
2289 :type '(choice
2290 (const :tag "No logging" nil)
2291 (const :tag "Record timestamp" time)
2292 (const :tag "Record timestamp with note." note)))
2293
2294(defcustom org-log-redeadline nil
2295 "Information to record when the deadline date of a tasks is modified.
2296
2297Possible values are:
2298
2299nil Don't add anything, just change the date
2300time Add a time stamp to the task
2301note Prompt for a note and add it with template `org-log-note-headings'
2302
2303This option can also be set with on a per-file-basis with
2304
2305 #+STARTUP: nologredeadline
2306 #+STARTUP: logredeadline
2307 #+STARTUP: lognoteredeadline
2308
2309You can have local logging settings for a subtree by setting the LOGGING
2310property to one or more of these keywords."
2311 :group 'org-todo
2312 :group 'org-progress
2313 :type '(choice
2314 (const :tag "No logging" nil)
2315 (const :tag "Record timestamp" time)
2316 (const :tag "Record timestamp with note." note)))
2317
2a57416f 2318(defcustom org-log-note-clock-out nil
ed21c5c8 2319 "Non-nil means record a note when clocking out of an item.
2a57416f
CD
2320This can also be configured on a per-file basis by adding one of
2321the following lines anywhere in the buffer:
2322
2323 #+STARTUP: lognoteclock-out
2324 #+STARTUP: nolognoteclock-out"
2325 :group 'org-todo
2326 :group 'org-progress
2327 :type 'boolean)
d3f4dbe8 2328
a3fbe8c4 2329(defcustom org-log-done-with-time t
ed21c5c8 2330 "Non-nil means the CLOSED time stamp will contain date and time.
a3fbe8c4
CD
2331When nil, only the date will be recorded."
2332 :group 'org-progress
2333 :type 'boolean)
2334
d3f4dbe8 2335(defcustom org-log-note-headings
20908596 2336 '((done . "CLOSING NOTE %t")
c8d0cf5c 2337 (state . "State %-12s from %-12S %t")
20908596 2338 (note . "Note taken on %t")
8bfe682a 2339 (reschedule . "Rescheduled from %S on %t")
ed21c5c8 2340 (delschedule . "Not scheduled, was %S on %t")
8bfe682a 2341 (redeadline . "New deadline from %S on %t")
ed21c5c8
CD
2342 (deldeadline . "Removed deadline, was %S on %t")
2343 (refile . "Refiled on %t")
d3f4dbe8 2344 (clock-out . ""))
20908596 2345 "Headings for notes added to entries.
48aaad2d 2346The value is an alist, with the car being a symbol indicating the note
3278a016 2347context, and the cdr is the heading to be used. The heading may also be the
d3f4dbe8
CD
2348empty string.
2349%t in the heading will be replaced by a time stamp.
86fbb8ca 2350%T will be an active time stamp instead the default inactive one
d3f4dbe8 2351%s will be replaced by the new TODO state, in double quotes.
c8d0cf5c 2352%S will be replaced by the old TODO state, in double quotes.
d3f4dbe8 2353%u will be replaced by the user name.
ed21c5c8
CD
2354%U will be replaced by the full user name.
2355
2356In fact, it is not a good idea to change the `state' entry, because
2357agenda log mode depends on the format of these entries."
3278a016 2358 :group 'org-todo
d3f4dbe8 2359 :group 'org-progress
3278a016
CD
2360 :type '(list :greedy t
2361 (cons (const :tag "Heading when closing an item" done) string)
d3f4dbe8
CD
2362 (cons (const :tag
2363 "Heading when changing todo state (todo sequence only)"
2364 state) string)
20908596 2365 (cons (const :tag "Heading when just taking a note" note) string)
8bfe682a 2366 (cons (const :tag "Heading when clocking out" clock-out) string)
ed21c5c8 2367 (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
8bfe682a 2368 (cons (const :tag "Heading when rescheduling" reschedule) string)
ed21c5c8
CD
2369 (cons (const :tag "Heading when changing deadline" redeadline) string)
2370 (cons (const :tag "Heading when deleting a deadline" deldeadline) string)
2371 (cons (const :tag "Heading when refiling" refile) string)))
e0e66b8e 2372
20908596
CD
2373(unless (assq 'note org-log-note-headings)
2374 (push '(note . "%t") org-log-note-headings))
2375
c8d0cf5c 2376(defcustom org-log-into-drawer nil
ed21c5c8 2377 "Non-nil means insert state change notes and time stamps into a drawer.
c8d0cf5c
CD
2378When nil, state changes notes will be inserted after the headline and
2379any scheduling and clock lines, but not inside a drawer.
2380
2381The value of this variable should be the name of the drawer to use.
3ab2c837 2382LOGBOOK is proposed as the default drawer for this purpose, you can
c8d0cf5c
CD
2383also set this to a string to define the drawer of your choice.
2384
2385A value of t is also allowed, representing \"LOGBOOK\".
2386
2387If this variable is set, `org-log-state-notes-insert-after-drawers'
2388will be ignored.
2389
2390You can set the property LOG_INTO_DRAWER to overrule this setting for
2391a subtree."
2392 :group 'org-todo
2393 :group 'org-progress
2394 :type '(choice
2395 (const :tag "Not into a drawer" nil)
2396 (const :tag "LOGBOOK" t)
2397 (string :tag "Other")))
2398
2399(if (fboundp 'defvaralias)
2400 (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer))
2401
2402(defun org-log-into-drawer ()
2403 "Return the value of `org-log-into-drawer', but let properties overrule.
2404If the current entry has or inherits a LOG_INTO_DRAWER property, it will be
2405used instead of the default value."
3ab2c837 2406 (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
c8d0cf5c
CD
2407 (cond
2408 ((or (not p) (equal p "nil")) org-log-into-drawer)
2409 ((equal p "t") "LOGBOOK")
2410 (t p))))
2411
71d35b24 2412(defcustom org-log-state-notes-insert-after-drawers nil
ed21c5c8 2413 "Non-nil means insert state change notes after any drawers in entry.
71d35b24
CD
2414Only the drawers that *immediately* follow the headline and the
2415deadline/scheduled line are skipped.
2416When nil, insert notes right after the heading and perhaps the line
c8d0cf5c
CD
2417with deadline/scheduling if present.
2418
2419This variable will have no effect if `org-log-into-drawer' is
2420set."
71d35b24
CD
2421 :group 'org-todo
2422 :group 'org-progress
2423 :type 'boolean)
2424
48aaad2d 2425(defcustom org-log-states-order-reversed t
ed21c5c8
CD
2426 "Non-nil means the latest state note will be directly after heading.
2427When nil, the state change notes will be ordered according to time."
48aaad2d
CD
2428 :group 'org-todo
2429 :group 'org-progress
2430 :type 'boolean)
2431
86fbb8ca
CD
2432(defcustom org-todo-repeat-to-state nil
2433 "The TODO state to which a repeater should return the repeating task.
2434By default this is the first task in a TODO sequence, or the previous state
2435in a TODO_TYP set. But you can specify another task here.
2436alternatively, set the :REPEAT_TO_STATE: property of the entry."
2437 :group 'org-todo
2438 :type '(choice (const :tag "Head of sequence" nil)
2439 (string :tag "Specific state")))
2440
2a57416f 2441(defcustom org-log-repeat 'time
ed21c5c8 2442 "Non-nil means record moving through the DONE state when triggering repeat.
8d642074 2443An auto-repeating task is immediately switched back to TODO when
86fbb8ca 2444marked DONE. If you are not logging state changes (by adding \"@\"
8d642074
CD
2445or \"!\" to the TODO keyword definition), or set `org-log-done' to
2446record a closing note, there will be no record of the task moving
3ab2c837 2447through DONE. This variable forces taking a note anyway.
2a57416f
CD
2448
2449nil Don't force a record
2450time Record a time stamp
2451note Record a note
2452
15841868
JW
2453This option can also be set with on a per-file-basis with
2454
2455 #+STARTUP: logrepeat
2a57416f 2456 #+STARTUP: lognoterepeat
15841868
JW
2457 #+STARTUP: nologrepeat
2458
2459You can have local logging settings for a subtree by setting the LOGGING
2460property to one or more of these keywords."
d3f4dbe8
CD
2461 :group 'org-todo
2462 :group 'org-progress
2a57416f
CD
2463 :type '(choice
2464 (const :tag "Don't force a record" nil)
2465 (const :tag "Force recording the DONE state" time)
2466 (const :tag "Force recording a note with the DONE state" note)))
d3f4dbe8 2467
8c6fb58b 2468
ab27a4a0 2469(defgroup org-priorities nil
4146eb16 2470 "Priorities in Org-mode."
ab27a4a0
CD
2471 :tag "Org Priorities"
2472 :group 'org-todo)
28e5b051 2473
c8d0cf5c 2474(defcustom org-enable-priority-commands t
ed21c5c8 2475 "Non-nil means priority commands are active.
c8d0cf5c
CD
2476When nil, these commands will be disabled, so that you never accidentally
2477set a priority."
2478 :group 'org-priorities
2479 :type 'boolean)
2480
a3fbe8c4
CD
2481(defcustom org-highest-priority ?A
2482 "The highest priority of TODO items. A character like ?A, ?B etc.
2483Must have a smaller ASCII number than `org-lowest-priority'."
ab27a4a0
CD
2484 :group 'org-priorities
2485 :type 'character)
891f4676 2486
ab27a4a0 2487(defcustom org-lowest-priority ?C
a3fbe8c4
CD
2488 "The lowest priority of TODO items. A character like ?A, ?B etc.
2489Must have a larger ASCII number than `org-highest-priority'."
2490 :group 'org-priorities
2491 :type 'character)
2492
2493(defcustom org-default-priority ?B
2494 "The default priority of TODO items.
3ab2c837
BG
2495This is the priority an item gets if no explicit priority is given.
2496When starting to cycle on an empty priority the first step in the cycle
2497depends on `org-priority-start-cycle-with-default'. The resulting first
2498step priority must not exceed the range from `org-highest-priority' to
2499`org-lowest-priority' which means that `org-default-priority' has to be
2500in this range exclusive or inclusive the range boundaries. Else the
2501first step refuses to set the default and the second will fall back
2502to (depending on the command used) the highest or lowest priority."
ab27a4a0
CD
2503 :group 'org-priorities
2504 :type 'character)
2505
15841868 2506(defcustom org-priority-start-cycle-with-default t
ed21c5c8 2507 "Non-nil means start with default priority when starting to cycle.
15841868 2508When this is nil, the first step in the cycle will be (depending on the
3ab2c837
BG
2509command used) one higher or lower than the default priority.
2510See also `org-default-priority'."
15841868
JW
2511 :group 'org-priorities
2512 :type 'boolean)
2513
acedf35c
CD
2514(defcustom org-get-priority-function nil
2515 "Function to extract the priority from a string.
2516The string is normally the headline. If this is nil Org computes the
2517priority from the priority cookie like [#A] in the headline. It returns
2518an integer, increasing by 1000 for each priority level.
2519The user can set a different function here, which should take a string
2520as an argument and return the numeric priority."
2521 :group 'org-priorities
2522 :type 'function)
2523
ab27a4a0
CD
2524(defgroup org-time nil
2525 "Options concerning time stamps and deadlines in Org-mode."
2526 :tag "Org Time"
2527 :group 'org)
2528
4b3a9ba7 2529(defcustom org-insert-labeled-timestamps-at-point nil
ed21c5c8 2530 "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point.
4b3a9ba7
CD
2531When nil, these labeled time stamps are forces into the second line of an
2532entry, just after the headline. When scheduling from the global TODO list,
2533the time stamp will always be forced into the second line."
2534 :group 'org-time
2535 :type 'boolean)
2536
ab27a4a0
CD
2537(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
2538 "Formats for `format-time-string' which are used for time stamps.
2539It is not recommended to change this constant.")
2540
2a57416f
CD
2541(defcustom org-time-stamp-rounding-minutes '(0 5)
2542 "Number of minutes to round time stamps to.
2543These are two values, the first applies when first creating a time stamp.
2544The second applies when changing it with the commands `S-up' and `S-down'.
2545When changing the time stamp, this means that it will change in steps
5bf7807a 2546of N minutes, as given by the second value.
2a57416f
CD
2547
2548When a setting is 0 or 1, insert the time unmodified. Useful rounding
2549numbers should be factors of 60, so for example 5, 10, 15.
2550
86fbb8ca
CD
2551When this is larger than 1, you can still force an exact time stamp by using
2552a double prefix argument to a time stamp command like `C-c .' or `C-c !',
2a57416f
CD
2553and by using a prefix arg to `S-up/down' to specify the exact number
2554of minutes to shift."
ab27a4a0 2555 :group 'org-time
3ab2c837 2556 :get #'(lambda (var) ; Make sure both elements are there
2a57416f
CD
2557 (if (integerp (default-value var))
2558 (list (default-value var) 5)
2559 (default-value var)))
2560 :type '(list
2561 (integer :tag "when inserting times")
2562 (integer :tag "when modifying times")))
2563
20908596 2564;; Normalize old customizations of this variable.
2a57416f
CD
2565(when (integerp org-time-stamp-rounding-minutes)
2566 (setq org-time-stamp-rounding-minutes
2567 (list org-time-stamp-rounding-minutes
2568 org-time-stamp-rounding-minutes)))
ab27a4a0 2569
3278a016 2570(defcustom org-display-custom-times nil
ed21c5c8 2571 "Non-nil means overlay custom formats over all time stamps.
3278a016
CD
2572The formats are defined through the variable `org-time-stamp-custom-formats'.
2573To turn this on on a per-file basis, insert anywhere in the file:
2574 #+STARTUP: customtime"
2575 :group 'org-time
2576 :set 'set-default
2577 :type 'sexp)
2578(make-variable-buffer-local 'org-display-custom-times)
2579
2580(defcustom org-time-stamp-custom-formats
2581 '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american
2582 "Custom formats for time stamps. See `format-time-string' for the syntax.
333f9019 2583These are overlaid over the default ISO format if the variable
b38c6895 2584`org-display-custom-times' is set. Time like %H:%M should be at the
c8d0cf5c
CD
2585end of the second format. The custom formats are also honored by export
2586commands, if custom time display is turned on at the time of export."
3278a016
CD
2587 :group 'org-time
2588 :type 'sexp)
2589
d3f4dbe8
CD
2590(defun org-time-stamp-format (&optional long inactive)
2591 "Get the right format for a time string."
2592 (let ((f (if long (cdr org-time-stamp-formats)
2593 (car org-time-stamp-formats))))
2594 (if inactive
2595 (concat "[" (substring f 1 -1) "]")
2596 f)))
2597
b349f79f 2598(defcustom org-time-clocksum-format "%d:%02d"
86fbb8ca
CD
2599 "The format string used when creating CLOCKSUM lines.
2600This is also used when org-mode generates a time duration."
b349f79f
CD
2601 :group 'org-time
2602 :type 'string)
ce4fdcb9 2603
8bfe682a
CD
2604(defcustom org-time-clocksum-use-fractional nil
2605 "If non-nil, \\[org-clock-display] uses fractional times.
2606org-mode generates a time duration."
2607 :group 'org-time
2608 :type 'boolean)
2609
2610(defcustom org-time-clocksum-fractional-format "%.2f"
2611 "The format string used when creating CLOCKSUM lines, or when
2612org-mode generates a time duration."
2613 :group 'org-time
2614 :type 'string)
2615
20908596
CD
2616(defcustom org-deadline-warning-days 14
2617 "No. of days before expiration during which a deadline becomes active.
2618This variable governs the display in sparse trees and in the agenda.
2619When 0 or negative, it means use this number (the absolute value of it)
c8d0cf5c
CD
2620even if a deadline has a different individual lead time specified.
2621
2622Custom commands can set this variable in the options section."
20908596
CD
2623 :group 'org-time
2624 :group 'org-agenda-daily/weekly
c8d0cf5c 2625 :type 'integer)
20908596 2626
8c6fb58b 2627(defcustom org-read-date-prefer-future t
ed21c5c8 2628 "Non-nil means assume future for incomplete date input from user.
8c6fb58b 2629This affects the following situations:
8bfe682a 26301. The user gives a month but not a year.
86fbb8ca
CD
2631 For example, if it is April and you enter \"feb 2\", this will be read
2632 as Feb 2, *next* year. \"May 5\", however, will be this year.
8bfe682a 26332. The user gives a day, but no month.
8c6fb58b
CD
2634 For example, if today is the 15th, and you enter \"3\", Org-mode will
2635 read this as the third of *next* month. However, if you enter \"17\",
2636 it will be considered as *this* month.
8c6fb58b 2637
8bfe682a
CD
2638If you set this variable to the symbol `time', then also the following
2639will work:
2640
26413. If the user gives a time, but no day. If the time is before now,
2642 to will be interpreted as tomorrow.
20908596 2643
8bfe682a
CD
2644Currently none of this works for ISO week specifications.
2645
2646When this option is nil, the current day, month and year will always be
afe98dfa
CD
2647used as defaults.
2648
2649See also `org-agenda-jump-prefer-future'."
8c6fb58b 2650 :group 'org-time
8bfe682a
CD
2651 :type '(choice
2652 (const :tag "Never" nil)
2653 (const :tag "Check month and day" t)
2654 (const :tag "Check month, day, and time" time)))
8c6fb58b 2655
afe98dfa
CD
2656(defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future
2657 "Should the agenda jump command prefer the future for incomplete dates?
2658The default is to do the same as configured in `org-read-date-prefer-future'.
3ab2c837 2659But you can also set a deviating value here.
afe98dfa 2660This may t or nil, or the symbol `org-read-date-prefer-future'."
01c35094
JB
2661 :group 'org-agenda
2662 :group 'org-time
afe98dfa 2663 :type '(choice
acedf35c 2664 (const :tag "Use org-read-date-prefer-future"
afe98dfa
CD
2665 org-read-date-prefer-future)
2666 (const :tag "Never" nil)
2667 (const :tag "Always" t)))
2668
3ab2c837
BG
2669(defcustom org-read-date-force-compatible-dates t
2670 "Should date/time prompt force dates that are guaranteed to work in Emacs?
2671
2672Depending on the system Emacs is running on, certain dates cannot
2673be represented with the type used internally to represent time.
2674Dates between 1970-1-1 and 2038-1-1 can always be represented
2675correctly. Some systems allow for earlier dates, some for later,
2676some for both. One way to find out it to insert any date into an
2677Org buffer, putting the cursor on the year and hitting S-up and
2678S-down to test the range.
2679
2680When this variable is set to t, the date/time prompt will not let
2681you specify dates outside the 1970-2037 range, so it is certain that
2682these dates will work in whatever version of Emacs you are
2683running, and also that you can move a file from one Emacs implementation
8350f087 2684to another. Whenever Org is forcing the year for you, it will display
3ab2c837
BG
2685a message and beep.
2686
2687When this variable is nil, Org will check if the date is
2688representable in the specific Emacs implementation you are using.
2689If not, it will force a year, usually the current year, and beep
2690to remind you. Currently this setting is not recommended because
2691the likelihood that you will open your Org files in an Emacs that
2692has limited date range is not negligible.
2693
2694A workaround for this problem is to use diary sexp dates for time
2695stamps outside of this range."
2696 :group 'org-time
2697 :type 'boolean)
2698
8c6fb58b 2699(defcustom org-read-date-display-live t
ed21c5c8 2700 "Non-nil means display current interpretation of date prompt live.
8c6fb58b
CD
2701This display will be in an overlay, in the minibuffer."
2702 :group 'org-time
2703 :type 'boolean)
2704
2705(defcustom org-read-date-popup-calendar t
ed21c5c8 2706 "Non-nil means pop up a calendar when prompting for a date.
ab27a4a0
CD
2707In the calendar, the date can be selected with mouse-1. However, the
2708minibuffer will also be active, and you can simply enter the date as well.
2709When nil, only the minibuffer will be available."
2710 :group 'org-time
891f4676 2711 :type 'boolean)
8c6fb58b
CD
2712(if (fboundp 'defvaralias)
2713 (defvaralias 'org-popup-calendar-for-date-prompt
2714 'org-read-date-popup-calendar))
2715
c8d0cf5c
CD
2716(defcustom org-read-date-minibuffer-setup-hook nil
2717 "Hook to be used to set up keys for the date/time interface.
2718Add key definitions to `minibuffer-local-map', which will be a temporary
2719copy."
2720 :group 'org-time
2721 :type 'hook)
2722
8c6fb58b 2723(defcustom org-extend-today-until 0
621f83e4 2724 "The hour when your day really ends. Must be an integer.
8c6fb58b
CD
2725This has influence for the following applications:
2726- When switching the agenda to \"today\". It it is still earlier than
2727 the time given here, the day recognized as TODAY is actually yesterday.
2728- When a date is read from the user and it is still before the time given
2729 here, the current date and time will be assumed to be yesterday, 23:59.
621f83e4 2730 Also, timestamps inserted in remember templates follow this rule.
8c6fb58b 2731
621f83e4
CD
2732IMPORTANT: This is a feature whose implementation is and likely will
2733remain incomplete. Really, it is only here because past midnight seems to
71d35b24 2734be the favorite working time of John Wiegley :-)"
8c6fb58b 2735 :group 'org-time
c8d0cf5c 2736 :type 'integer)
891f4676 2737
0b8568f5 2738(defcustom org-edit-timestamp-down-means-later nil
ed21c5c8 2739 "Non-nil means S-down will increase the time in a time stamp.
0b8568f5
JW
2740When nil, S-up will increase."
2741 :group 'org-time
2742 :type 'boolean)
2743
ab27a4a0 2744(defcustom org-calendar-follow-timestamp-change t
ed21c5c8 2745 "Non-nil means make the calendar window follow timestamp changes.
ab27a4a0
CD
2746When a timestamp is modified and the calendar window is visible, it will be
2747moved to the new date."
2748 :group 'org-time
2749 :type 'boolean)
891f4676 2750
ab27a4a0 2751(defgroup org-tags nil
4146eb16 2752 "Options concerning tags in Org-mode."
ab27a4a0
CD
2753 :tag "Org Tags"
2754 :group 'org)
891f4676 2755
4b3a9ba7
CD
2756(defcustom org-tag-alist nil
2757 "List of tags allowed in Org-mode files.
2758When this list is nil, Org-mode will base TAG input on what is already in the
2759buffer.
0b8568f5
JW
2760The value of this variable is an alist, the car of each entry must be a
2761keyword as a string, the cdr may be a character that is used to select
2762that tag through the fast-tag-selection interface.
2763See the manual for details."
4b3a9ba7
CD
2764 :group 'org-tags
2765 :type '(repeat
7d143c25
CD
2766 (choice
2767 (cons (string :tag "Tag name")
2768 (character :tag "Access char"))
8bfe682a
CD
2769 (list :tag "Start radio group"
2770 (const :startgroup)
2771 (option (string :tag "Group description")))
2772 (list :tag "End radio group"
2773 (const :endgroup)
2774 (option (string :tag "Group description")))
c8d0cf5c
CD
2775 (const :tag "New line" (:newline)))))
2776
2777(defcustom org-tag-persistent-alist nil
2778 "List of tags that will always appear in all Org-mode files.
2779This is in addition to any in buffer settings or customizations
2780of `org-tag-alist'.
2781When this list is nil, Org-mode will base TAG input on `org-tag-alist'.
2782The value of this variable is an alist, the car of each entry must be a
2783keyword as a string, the cdr may be a character that is used to select
2784that tag through the fast-tag-selection interface.
2785See the manual for details.
2786To disable these tags on a per-file basis, insert anywhere in the file:
2787 #+STARTUP: noptag"
2788 :group 'org-tags
2789 :type '(repeat
2790 (choice
2791 (cons (string :tag "Tag name")
2792 (character :tag "Access char"))
2793 (const :tag "Start radio group" (:startgroup))
2794 (const :tag "End radio group" (:endgroup))
2795 (const :tag "New line" (:newline)))))
4b3a9ba7 2796
ed21c5c8
CD
2797(defcustom org-complete-tags-always-offer-all-agenda-tags nil
2798 "If non-nil, always offer completion for all tags of all agenda files.
2799Instead of customizing this variable directly, you might want to
acedf35c 2800set it locally for capture buffers, because there no list of
ed21c5c8
CD
2801tags in that file can be created dynamically (there are none).
2802
acedf35c 2803 (add-hook 'org-capture-mode-hook
ed21c5c8
CD
2804 (lambda ()
2805 (set (make-local-variable
2806 'org-complete-tags-always-offer-all-agenda-tags)
2807 t)))"
2808 :group 'org-tags
2809 :type 'boolean)
2810
b349f79f
CD
2811(defvar org-file-tags nil
2812 "List of tags that can be inherited by all entries in the file.
2813The tags will be inherited if the variable `org-use-tag-inheritance'
2814says they should be.
8bfe682a 2815This variable is populated from #+FILETAGS lines.")
b349f79f 2816
4b3a9ba7 2817(defcustom org-use-fast-tag-selection 'auto
ed21c5c8 2818 "Non-nil means use fast tag selection scheme.
4b3a9ba7
CD
2819This is a special interface to select and deselect tags with single keys.
2820When nil, fast selection is never used.
2821When the symbol `auto', fast selection is used if and only if selection
2822characters for tags have been configured, either through the variable
2823`org-tag-alist' or through a #+TAGS line in the buffer.
2824When t, fast selection is always used and selection keys are assigned
2825automatically if necessary."
2826 :group 'org-tags
2827 :type '(choice
2828 (const :tag "Always" t)
2829 (const :tag "Never" nil)
2830 (const :tag "When selection characters are configured" 'auto)))
2831
3278a016 2832(defcustom org-fast-tag-selection-single-key nil
ed21c5c8 2833 "Non-nil means fast tag selection exits after first change.
3278a016 2834When nil, you have to press RET to exit it.
d3f4dbe8
CD
2835During fast tag selection, you can toggle this flag with `C-c'.
2836This variable can also have the value `expert'. In this case, the window
2837displaying the tags menu is not even shown, until you press C-c again."
3278a016 2838 :group 'org-tags
d3f4dbe8
CD
2839 :type '(choice
2840 (const :tag "No" nil)
2841 (const :tag "Yes" t)
2842 (const :tag "Expert" expert)))
3278a016 2843
d5098885 2844(defvar org-fast-tag-selection-include-todo nil
ed21c5c8 2845 "Non-nil means fast tags selection interface will also offer TODO states.
d5098885 2846This is an undocumented feature, you should not rely on it.")
0b8568f5 2847
5ace2fe5 2848(defcustom org-tags-column (if (featurep 'xemacs) -76 -77)
ab27a4a0
CD
2849 "The column to which tags should be indented in a headline.
2850If this number is positive, it specifies the column. If it is negative,
2851it means that the tags should be flushright to that column. For example,
15841868 2852-80 works well for a normal 80 character screen."
ab27a4a0
CD
2853 :group 'org-tags
2854 :type 'integer)
891f4676 2855
ab27a4a0 2856(defcustom org-auto-align-tags t
3ab2c837
BG
2857 "Non-nil keeps tags aligned when modifying headlines.
2858Some operations (i.e. demoting) change the length of a headline and
2859therefore shift the tags around. With this option turned on, after
2860each such operation the tags are again aligned to `org-tags-column'."
ab27a4a0
CD
2861 :group 'org-tags
2862 :type 'boolean)
891f4676 2863
ab27a4a0 2864(defcustom org-use-tag-inheritance t
ed21c5c8 2865 "Non-nil means tags in levels apply also for sublevels.
ab27a4a0 2866When nil, only the tags directly given in a specific line apply there.
20908596 2867This may also be a list of tags that should be inherited, or a regexp that
ff4be292
CD
2868matches tags that should be inherited. Additional control is possible
2869with the variable `org-tags-exclude-from-inheritance' which gives an
2870explicit list of tags to be excluded from inheritance., even if the value of
2871`org-use-tag-inheritance' would select it for inheritance.
2872
2873If this option is t, a match early-on in a tree can lead to a large
2874number of matches in the subtree when constructing the agenda or creating
2875a sparse tree. If you only want to see the first match in a tree during
2876a search, check out the variable `org-tags-match-list-sublevels'."
ab27a4a0 2877 :group 'org-tags
20908596
CD
2878 :type '(choice
2879 (const :tag "Not" nil)
2880 (const :tag "Always" t)
2881 (repeat :tag "Specific tags" (string :tag "Tag"))
2882 (regexp :tag "Tags matched by regexp")))
2883
ff4be292
CD
2884(defcustom org-tags-exclude-from-inheritance nil
2885 "List of tags that should never be inherited.
2886This is a way to exclude a few tags from inheritance. For way to do
2887the opposite, to actively allow inheritance for selected tags,
2888see the variable `org-use-tag-inheritance'."
2889 :group 'org-tags
2890 :type '(repeat (string :tag "Tag")))
2891
20908596
CD
2892(defun org-tag-inherit-p (tag)
2893 "Check if TAG is one that should be inherited."
2894 (cond
ff4be292 2895 ((member tag org-tags-exclude-from-inheritance) nil)
20908596
CD
2896 ((eq org-use-tag-inheritance t) t)
2897 ((not org-use-tag-inheritance) nil)
2898 ((stringp org-use-tag-inheritance)
2899 (string-match org-use-tag-inheritance tag))
2900 ((listp org-use-tag-inheritance)
2901 (member tag org-use-tag-inheritance))
2902 (t (error "Invalid setting of `org-use-tag-inheritance'"))))
ab27a4a0 2903
b349f79f 2904(defcustom org-tags-match-list-sublevels t
c8d0cf5c
CD
2905 "Non-nil means list also sublevels of headlines matching a search.
2906This variable applies to tags/property searches, and also to stuck
2907projects because this search is based on a tags match as well.
2908
2909When set to the symbol `indented', sublevels are indented with
2910leading dots.
2911
ab27a4a0
CD
2912Because of tag inheritance (see variable `org-use-tag-inheritance'),
2913the sublevels of a headline matching a tag search often also match
2914the same search. Listing all of them can create very long lists.
2915Setting this variable to nil causes subtrees of a match to be skipped.
ff4be292
CD
2916
2917This variable is semi-obsolete and probably should always be true. It
2918is better to limit inheritance to certain tags using the variables
33306645 2919`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'."
ab27a4a0 2920 :group 'org-tags
c8d0cf5c
CD
2921 :type '(choice
2922 (const :tag "No, don't list them" nil)
2923 (const :tag "Yes, do list them" t)
2924 (const :tag "List them, indented with leading dots" indented)))
2925
2926(defcustom org-tags-sort-function nil
da6062e6 2927 "When set, tags are sorted using this comparison function."
c8d0cf5c
CD
2928 :group 'org-tags
2929 :type '(choice
2930 (const :tag "No sorting" nil)
2931 (const :tag "Alphabetical" string<)
2932 (const :tag "Reverse alphabetical" string>)
2933 (function :tag "Custom function" nil)))
ab27a4a0
CD
2934
2935(defvar org-tags-history nil
2936 "History of minibuffer reads for tags.")
2937(defvar org-last-tags-completion-table nil
2938 "The last used completion table for tags.")
d5098885
JW
2939(defvar org-after-tags-change-hook nil
2940 "Hook that is run after the tags in a line have changed.")
ab27a4a0 2941
38f8646b
CD
2942(defgroup org-properties nil
2943 "Options concerning properties in Org-mode."
2944 :tag "Org Properties"
2945 :group 'org)
2946
2947(defcustom org-property-format "%-10s %s"
2948 "How property key/value pairs should be formatted by `indent-line'.
2949When `indent-line' hits a property definition, it will format the line
2950according to this format, mainly to make sure that the values are
2951lined-up with respect to each other."
2952 :group 'org-properties
2953 :type 'string)
2954
03f3cf35 2955(defcustom org-use-property-inheritance nil
ed21c5c8 2956 "Non-nil means properties apply also for sublevels.
20908596 2957
86fbb8ca 2958This setting is chiefly used during property searches. Turning it on can
20908596
CD
2959cause significant overhead when doing a search, which is why it is not
2960on by default.
2961
03f3cf35 2962When nil, only the properties directly given in the current entry count.
20908596
CD
2963When t, every property is inherited. The value may also be a list of
2964properties that should have inheritance, or a regular expression matching
2965properties that should be inherited.
03f3cf35
JW
2966
2967However, note that some special properties use inheritance under special
2968circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS,
2969and the properties ending in \"_ALL\" when they are used as descriptor
20908596
CD
2970for valid values of a property.
2971
2972Note for programmers:
2973When querying an entry with `org-entry-get', you can control if inheritance
2974should be used. By default, `org-entry-get' looks only at the local
2975properties. You can request inheritance by setting the inherit argument
2976to t (to force inheritance) or to `selective' (to respect the setting
2977in this variable)."
03f3cf35 2978 :group 'org-properties
8c6fb58b
CD
2979 :type '(choice
2980 (const :tag "Not" nil)
20908596
CD
2981 (const :tag "Always" t)
2982 (repeat :tag "Specific properties" (string :tag "Property"))
2983 (regexp :tag "Properties matched by regexp")))
2984
2985(defun org-property-inherit-p (property)
2986 "Check if PROPERTY is one that should be inherited."
2987 (cond
2988 ((eq org-use-property-inheritance t) t)
2989 ((not org-use-property-inheritance) nil)
2990 ((stringp org-use-property-inheritance)
2991 (string-match org-use-property-inheritance property))
2992 ((listp org-use-property-inheritance)
2993 (member property org-use-property-inheritance))
2994 (t (error "Invalid setting of `org-use-property-inheritance'"))))
03f3cf35 2995
7d58338e 2996(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
38f8646b
CD
2997 "The default column format, if no other format has been defined.
2998This variable can be set on the per-file basis by inserting a line
2999
3000#+COLUMNS: %25ITEM ....."
3001 :group 'org-properties
3002 :type 'string)
3003
b349f79f
CD
3004(defcustom org-columns-ellipses ".."
3005 "The ellipses to be used when a field in column view is truncated.
3006When this is the empty string, as many characters as possible are shown,
3007but then there will be no visual indication that the field has been truncated.
3008When this is a string of length N, the last N characters of a truncated
3009field are replaced by this string. If the column is narrower than the
3010ellipses string, only part of the ellipses string will be shown."
3011 :group 'org-properties
3012 :type 'string)
3013
621f83e4
CD
3014(defcustom org-columns-modify-value-for-display-function nil
3015 "Function that modifies values for display in column view.
3016For example, it can be used to cut out a certain part from a time stamp.
40ac2137 3017The function must take 2 arguments:
621f83e4 3018
33306645 3019column-title The title of the column (*not* the property name)
621f83e4
CD
3020value The value that should be modified.
3021
3022The function should return the value that should be displayed,
3023or nil if the normal value should be used."
3024 :group 'org-properties
3025 :type 'function)
b349f79f 3026
20908596
CD
3027(defcustom org-effort-property "Effort"
3028 "The property that is being used to keep track of effort estimates.
3029Effort estimates given in this property need to have the format H:MM."
3030 :group 'org-properties
3031 :group 'org-progress
3032 :type '(string :tag "Property"))
3033
b349f79f 3034(defconst org-global-properties-fixed
c8d0cf5c
CD
3035 '(("VISIBILITY_ALL" . "folded children content all")
3036 ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
b349f79f 3037 "List of property/value pairs that can be inherited by any entry.
b349f79f 3038
c8d0cf5c
CD
3039These are fixed values, for the preset properties. The user variable
3040that can be used to add to this list is `org-global-properties'.
3041
3042The entries in this list are cons cells where the car is a property
3043name and cdr is a string with the value. If the value represents
3044multiple items like an \"_ALL\" property, separate the items by
3045spaces.")
b349f79f 3046
48aaad2d
CD
3047(defcustom org-global-properties nil
3048 "List of property/value pairs that can be inherited by any entry.
c8d0cf5c
CD
3049
3050This list will be combined with the constant `org-global-properties-fixed'.
3051
3052The entries in this list are cons cells where the car is a property
3053name and cdr is a string with the value.
3054
ce4fdcb9
CD
3055You can set buffer-local values for the same purpose in the variable
3056`org-file-properties' this by adding lines like
48aaad2d
CD
3057
3058#+PROPERTY: NAME VALUE"
3059 :group 'org-properties
3060 :type '(repeat
3061 (cons (string :tag "Property")
3062 (string :tag "Value"))))
3063
b349f79f 3064(defvar org-file-properties nil
48aaad2d
CD
3065 "List of property/value pairs that can be inherited by any entry.
3066Valid for the current buffer.
3067This variable is populated from #+PROPERTY lines.")
b349f79f 3068(make-variable-buffer-local 'org-file-properties)
38f8646b 3069
ab27a4a0 3070(defgroup org-agenda nil
d3f4dbe8 3071 "Options concerning agenda views in Org-mode."
ab27a4a0
CD
3072 :tag "Org Agenda"
3073 :group 'org)
3074
3075(defvar org-category nil
3076 "Variable used by org files to set a category for agenda display.
3077Such files should use a file variable to set it, for example
3078
a3fbe8c4 3079# -*- mode: org; org-category: \"ELisp\"
ab27a4a0
CD
3080
3081or contain a special line
3082
3083#+CATEGORY: ELisp
3084
3085If the file does not specify a category, then file's base name
3086is used instead.")
3087(make-variable-buffer-local 'org-category)
3ab2c837 3088(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x))))
ab27a4a0
CD
3089
3090(defcustom org-agenda-files nil
3091 "The files to be used for agenda display.
3092Entries may be added to this list with \\[org-agenda-file-to-front] and removed with
3093\\[org-remove-file]. You can also use customize to edit the list.
3094
03f3cf35
JW
3095If an entry is a directory, all files in that directory that are matched by
3096`org-agenda-file-regexp' will be part of the file list.
3097
ab27a4a0
CD
3098If the value of the variable is not a list but a single file name, then
3099the list of agenda files is actually stored and maintained in that file, one
ed21c5c8
CD
3100agenda file per line. In this file paths can be given relative to
3101`org-directory'. Tilde expansion and environment variable substitution
3102are also made."
ab27a4a0 3103 :group 'org-agenda
891f4676 3104 :type '(choice
03f3cf35 3105 (repeat :tag "List of files and directories" file)
ab27a4a0 3106 (file :tag "Store list in a file\n" :value "~/.agenda_files")))
891f4676 3107
8c6fb58b 3108(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'"
03f3cf35 3109 "Regular expression to match files for `org-agenda-files'.
fbe6c10d 3110If any element in the list in that variable contains a directory instead
03f3cf35
JW
3111of a normal file, all files in that directory that are matched by this
3112regular expression will be included."
3113 :group 'org-agenda
3114 :type 'regexp)
3115
2a57416f
CD
3116(defcustom org-agenda-text-search-extra-files nil
3117 "List of extra files to be searched by text search commands.
20908596 3118These files will be search in addition to the agenda files by the
2a57416f
CD
3119commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'.
3120Note that these files will only be searched for text search commands,
20908596 3121not for the other agenda views like todo lists, tag searches or the weekly
2a57416f 3122agenda. This variable is intended to list notes and possibly archive files
20908596
CD
3123that should also be searched by these two commands.
3124In fact, if the first element in the list is the symbol `agenda-archives',
3125than all archive files of all agenda files will be added to the search
3126scope."
03f3cf35 3127 :group 'org-agenda
20908596
CD
3128 :type '(set :greedy t
3129 (const :tag "Agenda Archives" agenda-archives)
3130 (repeat :inline t (file))))
03f3cf35 3131
2a57416f
CD
3132(if (fboundp 'defvaralias)
3133 (defvaralias 'org-agenda-multi-occur-extra-files
3134 'org-agenda-text-search-extra-files))
3135
20908596 3136(defcustom org-agenda-skip-unavailable-files nil
cf7241c8
JB
3137 "Non-nil means to just skip non-reachable files in `org-agenda-files'.
3138A nil value means to remove them, after a query, from the list."
d3f4dbe8 3139 :group 'org-agenda
20908596 3140 :type 'boolean)
d3f4dbe8
CD
3141
3142(defcustom org-calendar-to-agenda-key [?c]
3143 "The key to be installed in `calendar-mode-map' for switching to the agenda.
3144The command `org-calendar-goto-agenda' will be bound to this key. The
3145default is the character `c' because then `c' can be used to switch back and
3146forth between agenda and calendar."
3147 :group 'org-agenda
3148 :type 'sexp)
3149
b349f79f
CD
3150(defcustom org-calendar-agenda-action-key [?k]
3151 "The key to be installed in `calendar-mode-map' for agenda-action.
3152The command `org-agenda-action' will be bound to this key. The
3153default is the character `k' because we use the same key in the agenda."
3154 :group 'org-agenda
3155 :type 'sexp)
3156
8bfe682a
CD
3157(defcustom org-calendar-insert-diary-entry-key [?i]
3158 "The key to be installed in `calendar-mode-map' for adding diary entries.
3159This option is irrelevant until `org-agenda-diary-file' has been configured
3160to point to an Org-mode file. When that is the case, the command
3161`org-agenda-diary-entry' will be bound to the key given here, by default
3162`i'. In the calendar, `i' normally adds entries to `diary-file'. So
3163if you want to continue doing this, you need to change this to a different
3164key."
3165 :group 'org-agenda
3166 :type 'sexp)
3167
3168(defcustom org-agenda-diary-file 'diary-file
3169 "File to which to add new entries with the `i' key in agenda and calendar.
3170When this is the symbol `diary-file', the functionality in the Emacs
3171calendar will be used to add entries to the `diary-file'. But when this
3172points to a file, `org-agenda-diary-entry' will be used instead."
3173 :group 'org-agenda
3174 :type '(choice
3175 (const :tag "The standard Emacs diary file" diary-file)
3176 (file :tag "Special Org file diary entries")))
3177
20908596 3178(eval-after-load "calendar"
b349f79f
CD
3179 '(progn
3180 (org-defkey calendar-mode-map org-calendar-to-agenda-key
3181 'org-calendar-goto-agenda)
3182 (org-defkey calendar-mode-map org-calendar-agenda-action-key
8bfe682a
CD
3183 'org-agenda-action)
3184 (add-hook 'calendar-mode-hook
3185 (lambda ()
3186 (unless (eq org-agenda-diary-file 'diary-file)
3187 (define-key calendar-mode-map
3188 org-calendar-insert-diary-entry-key
3189 'org-agenda-diary-entry))))))
03f3cf35 3190
6769c0dc 3191(defgroup org-latex nil
5bf7807a 3192 "Options for embedding LaTeX code into Org-mode."
6769c0dc
CD
3193 :tag "Org LaTeX"
3194 :group 'org)
3195
3196(defcustom org-format-latex-options
a3fbe8c4 3197 '(:foreground default :background default :scale 1.0
afe98dfa
CD
3198 :html-foreground "Black" :html-background "Transparent"
3199 :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\["))
6769c0dc
CD
3200 "Options for creating images from LaTeX fragments.
3201This is a property list with the following properties:
efc054e6
JB
3202:foreground the foreground color for images embedded in Emacs, e.g. \"Black\".
3203 `default' means use the foreground of the default face.
6769c0dc 3204:background the background color, or \"Transparent\".
a3fbe8c4 3205 `default' means use the background of the default face.
afe98dfa 3206:scale a scaling factor for the size of the images, to get more pixels
a3fbe8c4 3207:html-foreground, :html-background, :html-scale
efc054e6 3208 the same numbers for HTML export.
6769c0dc
CD
3209:matchers a list indicating which matchers should be used to
3210 find LaTeX fragments. Valid members of this list are:
3211 \"begin\" find environments
0bd48b37 3212 \"$1\" find single characters surrounded by $.$
e39856be 3213 \"$\" find math expressions surrounded by $...$
6769c0dc 3214 \"$$\" find math expressions surrounded by $$....$$
e39856be
CD
3215 \"\\(\" find math expressions surrounded by \\(...\\)
3216 \"\\ [\" find math expressions surrounded by \\ [...\\]"
15841868 3217 :group 'org-latex
6769c0dc
CD
3218 :type 'plist)
3219
ed21c5c8
CD
3220(defcustom org-format-latex-signal-error t
3221 "Non-nil means signal an error when image creation of LaTeX snippets fails.
3222When nil, just push out a message."
3223 :group 'org-latex
3224 :type 'boolean)
3225
a3fbe8c4 3226(defcustom org-format-latex-header "\\documentclass{article}
a3fbe8c4
CD
3227\\usepackage[usenames]{color}
3228\\usepackage{amsmath}
a3fbe8c4 3229\\usepackage[mathscr]{eucal}
8d642074 3230\\pagestyle{empty} % do not remove
ed21c5c8
CD
3231\[PACKAGES]
3232\[DEFAULT-PACKAGES]
8d642074
CD
3233% The settings below are copied from fullpage.sty
3234\\setlength{\\textwidth}{\\paperwidth}
3235\\addtolength{\\textwidth}{-3cm}
3236\\setlength{\\oddsidemargin}{1.5cm}
3237\\addtolength{\\oddsidemargin}{-2.54cm}
3238\\setlength{\\evensidemargin}{\\oddsidemargin}
3239\\setlength{\\textheight}{\\paperheight}
3240\\addtolength{\\textheight}{-\\headheight}
3241\\addtolength{\\textheight}{-\\headsep}
3242\\addtolength{\\textheight}{-\\footskip}
3243\\addtolength{\\textheight}{-3cm}
3244\\setlength{\\topmargin}{1.5cm}
3245\\addtolength{\\topmargin}{-2.54cm}"
3246 "The document header used for processing LaTeX fragments.
3247It is imperative that this header make sure that no page number
ed21c5c8
CD
3248appears on the page. The package defined in the variables
3249`org-export-latex-default-packages-alist' and `org-export-latex-packages-alist'
3250will either replace the placeholder \"[PACKAGES]\" in this header, or they
3251will be appended."
15841868 3252 :group 'org-latex
a3fbe8c4
CD
3253 :type 'string)
3254
ed21c5c8
CD
3255(defvar org-format-latex-header-extra nil)
3256
86fbb8ca
CD
3257(defun org-set-packages-alist (var val)
3258 "Set the packages alist and make sure it has 3 elements per entry."
3259 (set var (mapcar (lambda (x)
3260 (if (and (consp x) (= (length x) 2))
3261 (list (car x) (nth 1 x) t)
3262 x))
3263 val)))
3264
3265(defun org-get-packages-alist (var)
3266
3267 "Get the packages alist and make sure it has 3 elements per entry."
3268 (mapcar (lambda (x)
3269 (if (and (consp x) (= (length x) 2))
3270 (list (car x) (nth 1 x) t)
3271 x))
3272 (default-value var)))
3273
ed21c5c8 3274;; The following variables are defined here because is it also used
5dec9555
CD
3275;; when formatting latex fragments. Originally it was part of the
3276;; LaTeX exporter, which is why the name includes "export".
ed21c5c8 3277(defcustom org-export-latex-default-packages-alist
86fbb8ca
CD
3278 '(("AUTO" "inputenc" t)
3279 ("T1" "fontenc" t)
3280 ("" "fixltx2e" nil)
3281 ("" "graphicx" t)
3282 ("" "longtable" nil)
3283 ("" "float" nil)
3284 ("" "wrapfig" nil)
3285 ("" "soul" t)
86fbb8ca
CD
3286 ("" "textcomp" t)
3287 ("" "marvosym" t)
3288 ("" "wasysym" t)
3289 ("" "latexsym" t)
3290 ("" "amssymb" t)
3291 ("" "hyperref" nil)
ed21c5c8
CD
3292 "\\tolerance=1000"
3293 )
3294 "Alist of default packages to be inserted in the header.
3295Change this only if one of the packages here causes an incompatibility
3296with another package you are using.
3297The packages in this list are needed by one part or another of Org-mode
86fbb8ca 3298to function properly.
ed21c5c8 3299
afe98dfa 3300- inputenc, fontenc: for basic font and character selection
ed21c5c8
CD
3301- textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used
3302 for interpreting the entities in `org-entities'. You can skip some of these
3303 packages if you don't use any of the symbols in it.
3304- graphicx: for including images
3305- float, wrapfig: for figure placement
3306- longtable: for long tables
3307- hyperref: for cross references
3308
3309Therefore you should not modify this variable unless you know what you
3310are doing. The one reason to change it anyway is that you might be loading
3311some other package that conflicts with one of the default packages.
86fbb8ca
CD
3312Each cell is of the format \( \"options\" \"package\" snippet-flag\).
3313If SNIPPET-FLAG is t, the package also needs to be included when
3314compiling LaTeX snippets into images for inclusion into HTML."
5dec9555 3315 :group 'org-export-latex
86fbb8ca
CD
3316 :set 'org-set-packages-alist
3317 :get 'org-get-packages-alist
5dec9555 3318 :type '(repeat
86fbb8ca 3319 (choice
ed21c5c8
CD
3320 (list :tag "options/package pair"
3321 (string :tag "options")
86fbb8ca
CD
3322 (string :tag "package")
3323 (boolean :tag "Snippet"))
3324 (string :tag "A line of LaTeX"))))
5152b597 3325
ed21c5c8 3326(defcustom org-export-latex-packages-alist nil
86fbb8ca 3327 "Alist of packages to be inserted in every LaTeX header.
ed21c5c8 3328These will be inserted after `org-export-latex-default-packages-alist'.
86fbb8ca
CD
3329Each cell is of the format \( \"options\" \"package\" snippet-flag \).
3330SNIPPET-FLAG, when t, indicates that this package is also needed when
3331turning LaTeX snippets into images for inclusion into HTML.
3332Make sure that you only list packages here which:
ed21c5c8
CD
3333- you want in every file
3334- do not conflict with the default packages in
3335 `org-export-latex-default-packages-alist'
3336- do not conflict with the setup in `org-format-latex-header'."
3337 :group 'org-export-latex
86fbb8ca
CD
3338 :set 'org-set-packages-alist
3339 :get 'org-get-packages-alist
ed21c5c8 3340 :type '(repeat
86fbb8ca 3341 (choice
ed21c5c8
CD
3342 (list :tag "options/package pair"
3343 (string :tag "options")
86fbb8ca
CD
3344 (string :tag "package")
3345 (boolean :tag "Snippet"))
3346 (string :tag "A line of LaTeX"))))
3347
ed21c5c8
CD
3348
3349(defgroup org-appearance nil
3350 "Settings for Org-mode appearance."
3351 :tag "Org Appearance"
20908596 3352 :group 'org)
8c6fb58b 3353
20908596
CD
3354(defcustom org-level-color-stars-only nil
3355 "Non-nil means fontify only the stars in each headline.
3356When nil, the entire headline is fontified.
3357Changing it requires restart of `font-lock-mode' to become effective
3358also in regions already fontified."
ed21c5c8 3359 :group 'org-appearance
6769c0dc
CD
3360 :type 'boolean)
3361
20908596 3362(defcustom org-hide-leading-stars nil
ed21c5c8 3363 "Non-nil means hide the first N-1 stars in a headline.
20908596
CD
3364This works by using the face `org-hide' for these stars. This
3365face is white for a light background, and black for a dark
3366background. You may have to customize the face `org-hide' to
3367make this work.
3368Changing it requires restart of `font-lock-mode' to become effective
3369also in regions already fontified.
3370You may also set this on a per-file basis by adding one of the following
3371lines to the buffer:
891f4676 3372
20908596
CD
3373 #+STARTUP: hidestars
3374 #+STARTUP: showstars"
ed21c5c8 3375 :group 'org-appearance
891f4676
RS
3376 :type 'boolean)
3377
ed21c5c8 3378(defcustom org-hidden-keywords nil
3ab2c837
BG
3379 "List of symbols corresponding to keywords to be hidden the org buffer.
3380For example, a value '(title) for this list will make the document's title
3381appear in the buffer without the initial #+TITLE: keyword."
ed21c5c8
CD
3382 :group 'org-appearance
3383 :type '(set (const :tag "#+AUTHOR" author)
3384 (const :tag "#+DATE" date)
3385 (const :tag "#+EMAIL" email)
3ab2c837 3386 (const :tag "#+TITLE" title)))
ed21c5c8 3387
20908596 3388(defcustom org-fontify-done-headline nil
ed21c5c8 3389 "Non-nil means change the face of a headline if it is marked DONE.
20908596
CD
3390Normally, only the TODO/DONE keyword indicates the state of a headline.
3391When this is non-nil, the headline after the keyword is set to the
3392`org-headline-done' as an additional indication."
ed21c5c8 3393 :group 'org-appearance
ab27a4a0
CD
3394 :type 'boolean)
3395
20908596
CD
3396(defcustom org-fontify-emphasized-text t
3397 "Non-nil means fontify *bold*, /italic/ and _underlined_ text.
3398Changing this variable requires a restart of Emacs to take effect."
ed21c5c8 3399 :group 'org-appearance
891f4676
RS
3400 :type 'boolean)
3401
c8d0cf5c
CD
3402(defcustom org-fontify-whole-heading-line nil
3403 "Non-nil means fontify the whole line for headings.
3404This is useful when setting a background color for the
8bfe682a 3405org-level-* faces."
ed21c5c8 3406 :group 'org-appearance
c8d0cf5c
CD
3407 :type 'boolean)
3408
20908596 3409(defcustom org-highlight-latex-fragments-and-specials nil
ed21c5c8
CD
3410 "Non-nil means fontify what is treated specially by the exporters."
3411 :group 'org-appearance
a96ee7df
CD
3412 :type 'boolean)
3413
20908596
CD
3414(defcustom org-hide-emphasis-markers nil
3415 "Non-nil mean font-lock should hide the emphasis marker characters."
ed21c5c8 3416 :group 'org-appearance
8c6fb58b
CD
3417 :type 'boolean)
3418
86fbb8ca
CD
3419(defcustom org-pretty-entities nil
3420 "Non-nil means show entities as UTF8 characters.
3421When nil, the \\name form remains in the buffer."
3422 :group 'org-appearance
3423 :type 'boolean)
3424
3425(defcustom org-pretty-entities-include-sub-superscripts t
3426 "Non-nil means, pretty entity display includes formatting sub/superscripts."
3427 :group 'org-appearance
3428 :type 'boolean)
3429
edd21304 3430(defvar org-emph-re nil
86fbb8ca
CD
3431 "Regular expression for matching emphasis.
3432After a match, the match groups contain these elements:
afe98dfa
CD
34330 The match of the full regular expression, including the characters
3434 before and after the proper match
86fbb8ca
CD
34351 The character before the proper match, or empty at beginning of line
34362 The proper match, including the leading and trailing markers
34373 The leading marker like * or /, indicating the type of highlighting
34384 The text between the emphasis markers, not including the markers
34395 The character after the match, empty at the end of a line")
8c6fb58b
CD
3440(defvar org-verbatim-re nil
3441 "Regular expression for matching verbatim text.")
edd21304
CD
3442(defvar org-emphasis-regexp-components) ; defined just below
3443(defvar org-emphasis-alist) ; defined just below
3444(defun org-set-emph-re (var val)
3445 "Set variable and compute the emphasis regular expression."
3446 (set var val)
3447 (when (and (boundp 'org-emphasis-alist)
3448 (boundp 'org-emphasis-regexp-components)
3449 org-emphasis-alist org-emphasis-regexp-components)
3450 (let* ((e org-emphasis-regexp-components)
3451 (pre (car e))
3452 (post (nth 1 e))
3453 (border (nth 2 e))
3454 (body (nth 3 e))
3455 (nl (nth 4 e))
edd21304 3456 (body1 (concat body "*?"))
8c6fb58b
CD
3457 (markers (mapconcat 'car org-emphasis-alist ""))
3458 (vmarkers (mapconcat
3459 (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) ""))
3460 org-emphasis-alist "")))
edd21304
CD
3461 ;; make sure special characters appear at the right position in the class
3462 (if (string-match "\\^" markers)
3463 (setq markers (concat (replace-match "" t t markers) "^")))
3464 (if (string-match "-" markers)
3465 (setq markers (concat (replace-match "" t t markers) "-")))
8c6fb58b
CD
3466 (if (string-match "\\^" vmarkers)
3467 (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
3468 (if (string-match "-" vmarkers)
3469 (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
3278a016
CD
3470 (if (> nl 0)
3471 (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
3472 (int-to-string nl) "\\}")))
edd21304
CD
3473 ;; Make the regexp
3474 (setq org-emph-re
65c439fd 3475 (concat "\\([" pre "]\\|^\\)"
edd21304
CD
3476 "\\("
3477 "\\([" markers "]\\)"
3478 "\\("
8c6fb58b 3479 "[^" border "]\\|"
65c439fd 3480 "[^" border "]"
edd21304 3481 body1
65c439fd 3482 "[^" border "]"
edd21304
CD
3483 "\\)"
3484 "\\3\\)"
65c439fd 3485 "\\([" post "]\\|$\\)"))
8c6fb58b
CD
3486 (setq org-verbatim-re
3487 (concat "\\([" pre "]\\|^\\)"
3488 "\\("
3489 "\\([" vmarkers "]\\)"
3490 "\\("
3491 "[^" border "]\\|"
3492 "[^" border "]"
3493 body1
3494 "[^" border "]"
3495 "\\)"
3496 "\\3\\)"
3497 "\\([" post "]\\|$\\)")))))
edd21304
CD
3498
3499(defcustom org-emphasis-regexp-components
c8d0cf5c 3500 '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1)
8c6fb58b 3501 "Components used to build the regular expression for emphasis.
acedf35c 3502This is a list with five entries. Terminology: In an emphasis string
edd21304
CD
3503like \" *strong word* \", we call the initial space PREMATCH, the final
3504space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters
3505and \"trong wor\" is the body. The different components in this variable
3506specify what is allowed/forbidden in each part:
3507
3508pre Chars allowed as prematch. Beginning of line will be allowed too.
3509post Chars allowed as postmatch. End of line will be allowed too.
a3fbe8c4 3510border The chars *forbidden* as border characters.
edd21304
CD
3511body-regexp A regexp like \".\" to match a body character. Don't use
3512 non-shy groups here, and don't allow newline here.
3513newline The maximum number of newlines allowed in an emphasis exp.
8c6fb58b 3514
c44f0d75 3515Use customize to modify this, or restart Emacs after changing it."
ed21c5c8 3516 :group 'org-appearance
edd21304
CD
3517 :set 'org-set-emph-re
3518 :type '(list
3519 (sexp :tag "Allowed chars in pre ")
3520 (sexp :tag "Allowed chars in post ")
3521 (sexp :tag "Forbidden chars in border ")
3522 (sexp :tag "Regexp for body ")
3523 (integer :tag "number of newlines allowed")
b349f79f 3524 (option (boolean :tag "Please ignore this button"))))
edd21304
CD
3525
3526(defcustom org-emphasis-alist
20908596 3527 `(("*" bold "<b>" "</b>")
edd21304 3528 ("/" italic "<i>" "</i>")
93b62de8 3529 ("_" underline "<span style=\"text-decoration:underline;\">" "</span>")
8c6fb58b 3530 ("=" org-code "<code>" "</code>" verbatim)
93b62de8 3531 ("~" org-verbatim "<code>" "</code>" verbatim)
20908596
CD
3532 ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t))
3533 "<del>" "</del>")
a3fbe8c4 3534 )
8c6fb58b 3535 "Special syntax for emphasized text.
edd21304
CD
3536Text starting and ending with a special character will be emphasized, for
3537example *bold*, _underlined_ and /italic/. This variable sets the marker
a3fbe8c4 3538characters, the face to be used by font-lock for highlighting in Org-mode
c44f0d75 3539Emacs buffers, and the HTML tags to be used for this.
c8d0cf5c 3540For LaTeX export, see the variable `org-export-latex-emphasis-alist'.
86fbb8ca 3541For DocBook export, see the variable `org-export-docbook-emphasis-alist'.
c44f0d75 3542Use customize to modify this, or restart Emacs after changing it."
ed21c5c8 3543 :group 'org-appearance
edd21304
CD
3544 :set 'org-set-emph-re
3545 :type '(repeat
3546 (list
3547 (string :tag "Marker character")
0fee8d6e
CD
3548 (choice
3549 (face :tag "Font-lock-face")
3550 (plist :tag "Face property list"))
edd21304 3551 (string :tag "HTML start tag")
8c6fb58b
CD
3552 (string :tag "HTML end tag")
3553 (option (const verbatim)))))
edd21304 3554
c8d0cf5c
CD
3555(defvar org-protecting-blocks
3556 '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
3557 "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
3558This is needed for font-lock setup.")
3559
20908596
CD
3560;;; Miscellaneous options
3561
3562(defgroup org-completion nil
3563 "Completion in Org-mode."
3564 :tag "Org Completion"
3565 :group 'org)
891f4676 3566
ce4fdcb9 3567(defcustom org-completion-use-ido nil
ed21c5c8 3568 "Non-nil means use ido completion wherever possible.
0bd48b37
CD
3569Note that `ido-mode' must be active for this variable to be relevant.
3570If you decide to turn this variable on, you might well want to turn off
54a0dee5
CD
3571`org-outline-path-complete-in-steps'.
3572See also `org-completion-use-iswitchb'."
3573 :group 'org-completion
3574 :type 'boolean)
3575
3576(defcustom org-completion-use-iswitchb nil
ed21c5c8 3577 "Non-nil means use iswitchb completion wherever possible.
54a0dee5
CD
3578Note that `iswitchb-mode' must be active for this variable to be relevant.
3579If you decide to turn this variable on, you might well want to turn off
3580`org-outline-path-complete-in-steps'.
8bfe682a 3581Note that this variable has only an effect if `org-completion-use-ido' is nil."
ce4fdcb9 3582 :group 'org-completion
ff4be292 3583 :type 'boolean)
ce4fdcb9 3584
20908596 3585(defcustom org-completion-fallback-command 'hippie-expand
acedf35c
CD
3586 "The expansion command called by \\[pcomplete] in normal context.
3587Normal means, no org-mode-specific context."
20908596
CD
3588 :group 'org-completion
3589 :type 'function)
ab27a4a0 3590
8bfe682a 3591;;; Functions and variables from their packages
8c6fb58b
CD
3592;; Declared here to avoid compiler warnings
3593
8c6fb58b
CD
3594;; XEmacs only
3595(defvar outline-mode-menu-heading)
3596(defvar outline-mode-menu-show)
3597(defvar outline-mode-menu-hide)
3598(defvar zmacs-regions) ; XEmacs regions
3599
3600;; Emacs only
3601(defvar mark-active)
3602
3603;; Various packages
bf9f6f03 3604(declare-function calendar-absolute-from-iso "cal-iso" (date))
f30cf46c 3605(declare-function calendar-forward-day "cal-move" (arg))
f30cf46c
GM
3606(declare-function calendar-goto-date "cal-move" (date))
3607(declare-function calendar-goto-today "cal-move" ())
bf9f6f03 3608(declare-function calendar-iso-from-absolute "cal-iso" (date))
20908596
CD
3609(defvar calc-embedded-close-formula)
3610(defvar calc-embedded-open-formula)
182aef95
DN
3611(declare-function cdlatex-tab "ext:cdlatex" ())
3612(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
8c6fb58b 3613(defvar font-lock-unfontify-region-function)
64a51001
GM
3614(declare-function iswitchb-read-buffer "iswitchb"
3615 (prompt &optional default require-match start matches-set))
20908596
CD
3616(defvar iswitchb-temp-buflist)
3617(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
0bd48b37 3618(defvar org-agenda-tags-todo-honor-ignore-options)
20908596 3619(declare-function org-agenda-skip "org-agenda" ())
1bcdebed
CD
3620(declare-function
3621 org-format-agenda-item "org-agenda"
3622 (extra txt &optional category tags dotime noprefix remove-re habitp))
20908596
CD
3623(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
3624(declare-function org-agenda-change-all-lines "org-agenda"
d60b1ba1 3625 (newhead hdmarker &optional fixface just-this))
20908596
CD
3626(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
3627(declare-function org-agenda-maybe-redo "org-agenda" ())
b349f79f
CD
3628(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda"
3629 (beg end))
ce4fdcb9 3630(declare-function org-agenda-copy-local-variable "org-agenda" (var))
0bd48b37
CD
3631(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
3632 "org-agenda" (&optional end))
c8d0cf5c 3633(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
afe98dfa 3634(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
acedf35c
CD
3635(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
3636(declare-function org-inlinetask-goto-end "org-inlinetask" ())
9d459fc5 3637(declare-function org-indent-mode "org-indent" (&optional arg))
f30cf46c 3638(declare-function parse-time-string "parse-time" (string))
8bfe682a 3639(declare-function org-attach-reveal "org-attach" (&optional if-exists))
86fbb8ca 3640(declare-function org-export-latex-fix-inputenc "org-latex" ())
acedf35c 3641(declare-function orgtbl-send-table "org-table" (&optional maybe))
8c6fb58b 3642(defvar remember-data-file)
8c6fb58b 3643(defvar texmathp-why)
20908596
CD
3644(declare-function speedbar-line-directory "speedbar" (&optional depth))
3645(declare-function table--at-cell-p "table" (position &optional object at-column))
3646
8c6fb58b
CD
3647(defvar w3m-current-url)
3648(defvar w3m-current-title)
8c6fb58b
CD
3649
3650(defvar org-latex-regexps)
d3f4dbe8 3651
20908596 3652;;; Autoload and prepare some org modules
4b3a9ba7 3653
20908596
CD
3654;; Some table stuff that needs to be defined here, because it is used
3655;; by the functions setting up org-mode or checking for table context.
4b3a9ba7 3656
20908596 3657(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
86fbb8ca 3658 "Detect an org-type or table-type table.")
20908596 3659(defconst org-table-line-regexp "^[ \t]*|"
86fbb8ca 3660 "Detect an org-type table line.")
20908596 3661(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
86fbb8ca 3662 "Detect an org-type table line.")
20908596 3663(defconst org-table-hline-regexp "^[ \t]*|-"
86fbb8ca 3664 "Detect an org-type table hline.")
20908596 3665(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
86fbb8ca 3666 "Detect a table-type table hline.")
20908596 3667(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
86fbb8ca
CD
3668 "Detect the first line outside a table when searching from within it.
3669This works for both table types.")
4b3a9ba7 3670
20908596 3671;; Autoload the functions in org-table.el that are needed by functions here.
ab27a4a0 3672
20908596
CD
3673(eval-and-compile
3674 (org-autoload "org-table"
3675 '(org-table-align org-table-begin org-table-blank-field
3676 org-table-convert org-table-convert-region org-table-copy-down
3677 org-table-copy-region org-table-create
3678 org-table-create-or-convert-from-region
3679 org-table-create-with-table.el org-table-current-dline
3680 org-table-cut-region org-table-delete-column org-table-edit-field
3681 org-table-edit-formulas org-table-end org-table-eval-formula
3682 org-table-export org-table-field-info
3683 org-table-get-stored-formulas org-table-goto-column
3684 org-table-hline-and-move org-table-import org-table-insert-column
3685 org-table-insert-hline org-table-insert-row org-table-iterate
3686 org-table-justify-field-maybe org-table-kill-row
3687 org-table-maybe-eval-formula org-table-maybe-recalculate-line
3688 org-table-move-column org-table-move-column-left
3689 org-table-move-column-right org-table-move-row
3690 org-table-move-row-down org-table-move-row-up
3691 org-table-next-field org-table-next-row org-table-paste-rectangle
3692 org-table-previous-field org-table-recalculate
3693 org-table-rotate-recalc-marks org-table-sort-lines org-table-sum
3694 org-table-toggle-coordinate-overlays
3695 org-table-toggle-formula-debugger org-table-wrap-region
86fbb8ca
CD
3696 orgtbl-mode turn-on-orgtbl org-table-to-lisp
3697 orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex
3698 orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo)))
3278a016 3699
20908596
CD
3700(defun org-at-table-p (&optional table-type)
3701 "Return t if the cursor is inside an org-type table.
3702If TABLE-TYPE is non-nil, also check for table.el-type tables."
3703 (if org-enable-table-editor
1d676e9f 3704 (save-excursion
20908596
CD
3705 (beginning-of-line 1)
3706 (looking-at (if table-type org-table-any-line-regexp
3707 org-table-line-regexp)))
3708 nil))
3709(defsubst org-table-p () (org-at-table-p))
edd21304 3710
20908596
CD
3711(defun org-at-table.el-p ()
3712 "Return t if and only if we are at a table.el table."
3713 (and (org-at-table-p 'any)
3714 (save-excursion
3715 (goto-char (org-table-begin 'any))
3716 (looking-at org-table1-hline-regexp))))
3717(defun org-table-recognize-table.el ()
3718 "If there is a table.el table nearby, recognize it and move into it."
3719 (if org-table-tab-recognizes-table.el
3720 (if (org-at-table.el-p)
3721 (progn
3722 (beginning-of-line 1)
3723 (if (looking-at org-table-dataline-regexp)
3724 nil
3725 (if (looking-at org-table1-hline-regexp)
3726 (progn
3727 (beginning-of-line 2)
3728 (if (looking-at org-table-any-border-regexp)
3729 (beginning-of-line -1)))))
3730 (if (re-search-forward "|" (org-table-end t) t)
3731 (progn
3732 (require 'table)
3733 (if (table--at-cell-p (point))
3734 t
3735 (message "recognizing table.el table...")
3736 (table-recognize-table)
3737 (message "recognizing table.el table...done")))
86fbb8ca 3738 (error "This should not happen"))
20908596
CD
3739 t)
3740 nil)
3741 nil))
edd21304 3742
20908596
CD
3743(defun org-at-table-hline-p ()
3744 "Return t if the cursor is inside a hline in a table."
3745 (if org-enable-table-editor
3746 (save-excursion
3747 (beginning-of-line 1)
3748 (looking-at org-table-hline-regexp))
3749 nil))
edd21304 3750
20908596 3751(defvar org-table-clean-did-remove-column nil)
6769c0dc 3752
86fbb8ca 3753(defun org-table-map-tables (function &optional quietly)
d3f4dbe8
CD
3754 "Apply FUNCTION to the start of all tables in the buffer."
3755 (save-excursion
3756 (save-restriction
3757 (widen)
3758 (goto-char (point-min))
3759 (while (re-search-forward org-table-any-line-regexp nil t)
86fbb8ca
CD
3760 (unless quietly
3761 (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))))
d3f4dbe8 3762 (beginning-of-line 1)
c8d0cf5c
CD
3763 (when (looking-at org-table-line-regexp)
3764 (save-excursion (funcall function))
3765 (or (looking-at org-table-line-regexp)
3766 (forward-char 1)))
d3f4dbe8 3767 (re-search-forward org-table-any-border-regexp nil 1))))
86fbb8ca 3768 (unless quietly (message "Mapping tables: done")))
edd21304 3769
c8d0cf5c 3770;; Declare and autoload functions from org-exp.el & Co
d3f4dbe8 3771
20908596
CD
3772(declare-function org-default-export-plist "org-exp")
3773(declare-function org-infile-export-plist "org-exp")
3774(declare-function org-get-current-options "org-exp")
3775(eval-and-compile
3776 (org-autoload "org-exp"
c8d0cf5c
CD
3777 '(org-export org-export-visible
3778 org-insert-export-options-template
3779 org-table-clean-before-export))
3780 (org-autoload "org-ascii"
3781 '(org-export-as-ascii org-export-ascii-preprocess
3782 org-export-as-ascii-to-buffer org-replace-region-by-ascii
3783 org-export-region-as-ascii))
ed21c5c8
CD
3784 (org-autoload "org-latex"
3785 '(org-export-as-latex-batch org-export-as-latex-to-buffer
3786 org-replace-region-by-latex org-export-region-as-latex
3787 org-export-as-latex org-export-as-pdf
3788 org-export-as-pdf-and-open))
c8d0cf5c
CD
3789 (org-autoload "org-html"
3790 '(org-export-as-html-and-open
3791 org-export-as-html-batch org-export-as-html-to-buffer
3792 org-replace-region-by-html org-export-region-as-html
3793 org-export-as-html))
ed21c5c8
CD
3794 (org-autoload "org-docbook"
3795 '(org-export-as-docbook-batch org-export-as-docbook-to-buffer
3796 org-replace-region-by-docbook org-export-region-as-docbook
3797 org-export-as-docbook-pdf org-export-as-docbook-pdf-and-open
3798 org-export-as-docbook))
c8d0cf5c
CD
3799 (org-autoload "org-icalendar"
3800 '(org-export-icalendar-this-file
3801 org-export-icalendar-all-agenda-files
3802 org-export-icalendar-combine-agenda-files))
ed21c5c8
CD
3803 (org-autoload "org-xoxo" '(org-export-as-xoxo))
3804 (org-autoload "org-beamer" '(org-beamer-mode org-beamer-sectioning)))
d3f4dbe8 3805
621f83e4 3806;; Declare and autoload functions from org-agenda.el
d3f4dbe8 3807
20908596 3808(eval-and-compile
621f83e4 3809 (org-autoload "org-agenda"
20908596
CD
3810 '(org-agenda org-agenda-list org-search-view
3811 org-todo-list org-tags-view org-agenda-list-stuck-projects
0bd48b37
CD
3812 org-diary org-agenda-to-appt
3813 org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))
d3f4dbe8 3814
20908596
CD
3815;; Autoload org-remember
3816
3817(eval-and-compile
3818 (org-autoload "org-remember"
3819 '(org-remember-insinuate org-remember-annotation
3820 org-remember-apply-template org-remember org-remember-handler)))
3821
86fbb8ca
CD
3822(eval-and-compile
3823 (org-autoload "org-capture"
3824 '(org-capture org-capture-insert-template-here
3825 org-capture-import-remember-templates)))
3826
20908596
CD
3827;; Autoload org-clock.el
3828
b349f79f
CD
3829(declare-function org-clock-save-markers-for-cut-and-paste "org-clock"
3830 (beg end))
0bd48b37 3831(declare-function org-clock-update-mode-line "org-clock" ())
8bfe682a
CD
3832(declare-function org-resolve-clocks "org-clock"
3833 (&optional also-non-dangling-p prompt last-valid))
b349f79f 3834(defvar org-clock-start-time)
20908596
CD
3835(defvar org-clock-marker (make-marker)
3836 "Marker recording the last clock-in.")
54a0dee5
CD
3837(defvar org-clock-hd-marker (make-marker)
3838 "Marker recording the last clock-in, but the headline position.")
8bfe682a
CD
3839(defvar org-clock-heading ""
3840 "The heading of the current clock entry.")
c8d0cf5c
CD
3841(defun org-clock-is-active ()
3842 "Return non-nil if clock is currently running.
3843The return value is actually the clock marker."
3844 (marker-buffer org-clock-marker))
20908596
CD
3845
3846(eval-and-compile
3847 (org-autoload
3848 "org-clock"
3849 '(org-clock-in org-clock-out org-clock-cancel
3850 org-clock-goto org-clock-sum org-clock-display
0bd48b37 3851 org-clock-remove-overlays org-clock-report
20908596 3852 org-clocktable-shift org-dblock-write:clocktable
8bfe682a 3853 org-get-clocktable org-resolve-clocks)))
20908596
CD
3854
3855(defun org-clock-update-time-maybe ()
3856 "If this is a CLOCK line, update it and return t.
3857Otherwise, return nil."
0fee8d6e 3858 (interactive)
5137195a 3859 (save-excursion
20908596
CD
3860 (beginning-of-line 1)
3861 (skip-chars-forward " \t")
3862 (when (looking-at org-clock-string)
3863 (let ((re (concat "[ \t]*" org-clock-string
b349f79f
CD
3864 " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]"
3865 "\\([ \t]*=>.*\\)?\\)?"))
71d35b24 3866 ts te h m s neg)
b349f79f
CD
3867 (cond
3868 ((not (looking-at re))
3869 nil)
3870 ((not (match-end 2))
3871 (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
3872 (> org-clock-marker (point))
3873 (<= org-clock-marker (point-at-eol)))
3874 ;; The clock is running here
3875 (setq org-clock-start-time
ce4fdcb9 3876 (apply 'encode-time
b349f79f 3877 (org-parse-time-string (match-string 1))))
0bd48b37 3878 (org-clock-update-mode-line)))
b349f79f
CD
3879 (t
3880 (and (match-end 4) (delete-region (match-beginning 4) (match-end 4)))
20908596
CD
3881 (end-of-line 1)
3882 (setq ts (match-string 1)
b349f79f 3883 te (match-string 3))
54a0dee5 3884 (setq s (- (org-float-time
20908596 3885 (apply 'encode-time (org-parse-time-string te)))
54a0dee5 3886 (org-float-time
20908596 3887 (apply 'encode-time (org-parse-time-string ts))))
71d35b24
CD
3888 neg (< s 0)
3889 s (abs s)
20908596
CD
3890 h (floor (/ s 3600))
3891 s (- s (* 3600 h))
3892 m (floor (/ s 60))
3893 s (- s (* 60 s)))
71d35b24 3894 (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m))
b349f79f 3895 t))))))
5137195a 3896
20908596
CD
3897(defun org-check-running-clock ()
3898 "Check if the current buffer contains the running clock.
3899If yes, offer to stop it and to save the buffer with the changes."
3900 (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
3901 (y-or-n-p (format "Clock-out in buffer %s before killing it? "
3902 (buffer-name))))
3903 (org-clock-out)
3904 (when (y-or-n-p "Save changed buffer?")
3905 (save-buffer))))
3906
3907(defun org-clocktable-try-shift (dir n)
3908 "Check if this line starts a clock table, if yes, shift the time block."
3ab2c837 3909 (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>")
20908596
CD
3910 (org-clocktable-shift dir n)))
3911
ff4be292
CD
3912;; Autoload org-timer.el
3913
ff4be292
CD
3914(eval-and-compile
3915 (org-autoload
3916 "org-timer"
3917 '(org-timer-start org-timer org-timer-item
c8d0cf5c
CD
3918 org-timer-change-times-in-region
3919 org-timer-set-timer
3920 org-timer-reset-timers
3921 org-timer-show-remaining-time)))
3922
3923;; Autoload org-feed.el
3924
3925(eval-and-compile
3926 (org-autoload
3927 "org-feed"
3928 '(org-feed-update org-feed-update-all org-feed-goto-inbox)))
3929
ff4be292 3930
c8d0cf5c
CD
3931;; Autoload org-indent.el
3932
8bfe682a
CD
3933;; Define the variable already here, to make sure we have it.
3934(defvar org-indent-mode nil
3935 "Non-nil if Org-Indent mode is enabled.
3936Use the command `org-indent-mode' to change this variable.")
3937
c8d0cf5c
CD
3938(eval-and-compile
3939 (org-autoload
3940 "org-indent"
3941 '(org-indent-mode)))
ff4be292 3942
8d642074
CD
3943;; Autoload org-mobile.el
3944
3945(eval-and-compile
3946 (org-autoload
3947 "org-mobile"
3948 '(org-mobile-push org-mobile-pull org-mobile-create-sumo-agenda)))
3949
20908596
CD
3950;; Autoload archiving code
3951;; The stuff that is needed for cycling and tags has to be defined here.
3952
3953(defgroup org-archive nil
3954 "Options concerning archiving in Org-mode."
3955 :tag "Org Archive"
3956 :group 'org-structure)
3957
3958(defcustom org-archive-location "%s_archive::"
3959 "The location where subtrees should be archived.
3960
ce4fdcb9
CD
3961The value of this variable is a string, consisting of two parts,
3962separated by a double-colon. The first part is a filename and
3963the second part is a headline.
20908596 3964
ce4fdcb9
CD
3965When the filename is omitted, archiving happens in the same file.
3966%s in the filename will be replaced by the current file
3967name (without the directory part). Archiving to a different file
3968is useful to keep archived entries from contributing to the
3969Org-mode Agenda.
20908596 3970
ce4fdcb9
CD
3971The archived entries will be filed as subtrees of the specified
3972headline. When the headline is omitted, the subtrees are simply
0bd48b37
CD
3973filed away at the end of the file, as top-level entries. Also in
3974the heading you can use %s to represent the file name, this can be
3975useful when using the same archive for a number of different files.
20908596
CD
3976
3977Here are a few examples:
3978\"%s_archive::\"
3979 If the current file is Projects.org, archive in file
3980 Projects.org_archive, as top-level trees. This is the default.
3981
3982\"::* Archived Tasks\"
3983 Archive in the current file, under the top-level headline
3984 \"* Archived Tasks\".
3985
3986\"~/org/archive.org::\"
3987 Archive in file ~/org/archive.org (absolute path), as top-level trees.
3988
0bd48b37 3989\"~/org/archive.org::From %s\"
8bfe682a 3990 Archive in file ~/org/archive.org (absolute path), under headlines
0bd48b37
CD
3991 \"From FILENAME\" where file name is the current file name.
3992
20908596
CD
3993\"basement::** Finished Tasks\"
3994 Archive in file ./basement (relative path), as level 3 trees
3995 below the level 2 heading \"** Finished Tasks\".
3996
3997You may set this option on a per-file basis by adding to the buffer a
3998line like
3999
4000#+ARCHIVE: basement::** Finished Tasks
4001
4002You may also define it locally for a subtree by setting an ARCHIVE property
4003in the entry. If such a property is found in an entry, or anywhere up
4004the hierarchy, it will be used."
4005 :group 'org-archive
4006 :type 'string)
4007
4008(defcustom org-archive-tag "ARCHIVE"
4009 "The tag that marks a subtree as archived.
4010An archived subtree does not open during visibility cycling, and does
4011not contribute to the agenda listings.
4012After changing this, font-lock must be restarted in the relevant buffers to
4013get the proper fontification."
4014 :group 'org-archive
4015 :group 'org-keywords
4016 :type 'string)
4017
4018(defcustom org-agenda-skip-archived-trees t
ed21c5c8 4019 "Non-nil means the agenda will skip any items located in archived trees.
2c3ad40d
CD
4020An archived tree is a tree marked with the tag ARCHIVE. The use of this
4021variable is no longer recommended, you should leave it at the value t.
4022Instead, use the key `v' to cycle the archives-mode in the agenda."
20908596
CD
4023 :group 'org-archive
4024 :group 'org-agenda-skip
4025 :type 'boolean)
4026
8bfe682a 4027(defcustom org-columns-skip-archived-trees t
ed21c5c8 4028 "Non-nil means ignore archived trees when creating column view."
c8d0cf5c
CD
4029 :group 'org-archive
4030 :group 'org-properties
4031 :type 'boolean)
4032
20908596 4033(defcustom org-cycle-open-archived-trees nil
ed21c5c8 4034 "Non-nil means `org-cycle' will open archived trees.
20908596
CD
4035An archived tree is a tree marked with the tag ARCHIVE.
4036When nil, archived trees will stay folded. You can still open them with
4037normal outline commands like `show-all', but not with the cycling commands."
4038 :group 'org-archive
4039 :group 'org-cycle
4040 :type 'boolean)
4041
4042(defcustom org-sparse-tree-open-archived-trees nil
4043 "Non-nil means sparse tree construction shows matches in archived trees.
4044When nil, matches in these trees are highlighted, but the trees are kept in
4045collapsed state."
4046 :group 'org-archive
4047 :group 'org-sparse-trees
4048 :type 'boolean)
4049
4050(defun org-cycle-hide-archived-subtrees (state)
4051 "Re-hide all archived subtrees after a visibility state change."
4052 (when (and (not org-cycle-open-archived-trees)
4053 (not (memq state '(overview folded))))
d3f4dbe8 4054 (save-excursion
20908596
CD
4055 (let* ((globalp (memq state '(contents all)))
4056 (beg (if globalp (point-min) (point)))
4057 (end (if globalp (point-max) (org-end-of-subtree t))))
4058 (org-hide-archived-subtrees beg end)
4059 (goto-char beg)
4060 (if (looking-at (concat ".*:" org-archive-tag ":"))
4061 (message "%s" (substitute-command-keys
4062 "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
4063
4064(defun org-force-cycle-archived ()
4065 "Cycle subtree even if it is archived."
d3f4dbe8 4066 (interactive)
20908596
CD
4067 (setq this-command 'org-cycle)
4068 (let ((org-cycle-open-archived-trees t))
4069 (call-interactively 'org-cycle)))
3278a016 4070
20908596
CD
4071(defun org-hide-archived-subtrees (beg end)
4072 "Re-hide all archived subtrees after a visibility state change."
4073 (save-excursion
4074 (let* ((re (concat ":" org-archive-tag ":")))
38f8646b 4075 (goto-char beg)
20908596 4076 (while (re-search-forward re end t)
ed21c5c8
CD
4077 (when (org-on-heading-p)
4078 (org-flag-subtree t)
4079 (org-end-of-subtree t))))))
a3fbe8c4 4080
8bfe682a
CD
4081(defun org-flag-subtree (flag)
4082 (save-excursion
4083 (org-back-to-heading t)
4084 (outline-end-of-heading)
4085 (outline-flag-region (point)
4086 (progn (org-end-of-subtree t) (point))
4087 flag)))
4088
20908596 4089(defalias 'org-advertized-archive-subtree 'org-archive-subtree)
ab27a4a0 4090
20908596
CD
4091(eval-and-compile
4092 (org-autoload "org-archive"
4093 '(org-add-archive-files org-archive-subtree
5dec9555
CD
4094 org-archive-to-archive-sibling org-toggle-archive-tag
4095 org-archive-subtree-default
4096 org-archive-subtree-default-with-confirmation)))
ab27a4a0 4097
20908596 4098;; Autoload Column View Code
a3fbe8c4 4099
20908596
CD
4100(declare-function org-columns-number-to-string "org-colview")
4101(declare-function org-columns-get-format-and-top-level "org-colview")
4102(declare-function org-columns-compute "org-colview")
a3fbe8c4 4103
20908596
CD
4104(org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview")
4105 '(org-columns-number-to-string org-columns-get-format-and-top-level
4106 org-columns-compute org-agenda-columns org-columns-remove-overlays
0627c265 4107 org-columns org-insert-columns-dblock org-dblock-write:columnview))
a3fbe8c4 4108
b349f79f
CD
4109;; Autoload ID code
4110
db55f368 4111(declare-function org-id-store-link "org-id")
c8d0cf5c
CD
4112(declare-function org-id-locations-load "org-id")
4113(declare-function org-id-locations-save "org-id")
4114(defvar org-id-track-globally)
b349f79f 4115(org-autoload "org-id"
ce4fdcb9
CD
4116 '(org-id-get-create org-id-new org-id-copy org-id-get
4117 org-id-get-with-outline-path-completion
afe98dfa 4118 org-id-get-with-outline-drilling org-id-store-link
db55f368 4119 org-id-goto org-id-find org-id-store-link))
b349f79f 4120
c8d0cf5c
CD
4121;; Autoload Plotting Code
4122
4123(org-autoload "org-plot"
4124 '(org-plot/gnuplot))
4125
20908596 4126;;; Variables for pre-computed regular expressions, all buffer local
a3fbe8c4 4127
20908596
CD
4128(defvar org-drawer-regexp nil
4129 "Matches first line of a hidden block.")
4130(make-variable-buffer-local 'org-drawer-regexp)
4131(defvar org-todo-regexp nil
4132 "Matches any of the TODO state keywords.")
4133(make-variable-buffer-local 'org-todo-regexp)
4134(defvar org-not-done-regexp nil
4135 "Matches any of the TODO state keywords except the last one.")
4136(make-variable-buffer-local 'org-not-done-regexp)
c8d0cf5c
CD
4137(defvar org-not-done-heading-regexp nil
4138 "Matches a TODO headline that is not done.")
4139(make-variable-buffer-local 'org-not-done-regexp)
20908596
CD
4140(defvar org-todo-line-regexp nil
4141 "Matches a headline and puts TODO state into group 2 if present.")
4142(make-variable-buffer-local 'org-todo-line-regexp)
4143(defvar org-complex-heading-regexp nil
4144 "Matches a headline and puts everything into groups:
4145group 1: the stars
4146group 2: The todo keyword, maybe
4147group 3: Priority cookie
4148group 4: True headline
4149group 5: Tags")
4150(make-variable-buffer-local 'org-complex-heading-regexp)
afe98dfa
CD
4151(defvar org-complex-heading-regexp-format nil
4152 "Printf format to make regexp to match an exact headline.
4153This regexp will match the headline of any node which hase the exact
4154headline text that is put into the format, but may have any TODO state,
4155priority and tags.")
8d642074 4156(make-variable-buffer-local 'org-complex-heading-regexp-format)
20908596
CD
4157(defvar org-todo-line-tags-regexp nil
4158 "Matches a headline and puts TODO state into group 2 if present.
4159Also put tags into group 4 if tags are present.")
4160(make-variable-buffer-local 'org-todo-line-tags-regexp)
4161(defvar org-nl-done-regexp nil
4162 "Matches newline followed by a headline with the DONE keyword.")
4163(make-variable-buffer-local 'org-nl-done-regexp)
4164(defvar org-looking-at-done-regexp nil
4165 "Matches the DONE keyword a point.")
4166(make-variable-buffer-local 'org-looking-at-done-regexp)
4167(defvar org-ds-keyword-length 12
4168 "Maximum length of the Deadline and SCHEDULED keywords.")
4169(make-variable-buffer-local 'org-ds-keyword-length)
4170(defvar org-deadline-regexp nil
4171 "Matches the DEADLINE keyword.")
4172(make-variable-buffer-local 'org-deadline-regexp)
4173(defvar org-deadline-time-regexp nil
4174 "Matches the DEADLINE keyword together with a time stamp.")
4175(make-variable-buffer-local 'org-deadline-time-regexp)
4176(defvar org-deadline-line-regexp nil
4177 "Matches the DEADLINE keyword and the rest of the line.")
4178(make-variable-buffer-local 'org-deadline-line-regexp)
4179(defvar org-scheduled-regexp nil
4180 "Matches the SCHEDULED keyword.")
4181(make-variable-buffer-local 'org-scheduled-regexp)
4182(defvar org-scheduled-time-regexp nil
4183 "Matches the SCHEDULED keyword together with a time stamp.")
4184(make-variable-buffer-local 'org-scheduled-time-regexp)
4185(defvar org-closed-time-regexp nil
4186 "Matches the CLOSED keyword together with a time stamp.")
4187(make-variable-buffer-local 'org-closed-time-regexp)
a3fbe8c4 4188
20908596
CD
4189(defvar org-keyword-time-regexp nil
4190 "Matches any of the 4 keywords, together with the time stamp.")
4191(make-variable-buffer-local 'org-keyword-time-regexp)
4192(defvar org-keyword-time-not-clock-regexp nil
4193 "Matches any of the 3 keywords, together with the time stamp.")
4194(make-variable-buffer-local 'org-keyword-time-not-clock-regexp)
4195(defvar org-maybe-keyword-time-regexp nil
86fbb8ca 4196 "Matches a timestamp, possibly preceded by a keyword.")
20908596
CD
4197(make-variable-buffer-local 'org-maybe-keyword-time-regexp)
4198(defvar org-planning-or-clock-line-re nil
4199 "Matches a line with planning or clock info.")
4200(make-variable-buffer-local 'org-planning-or-clock-line-re)
ed21c5c8
CD
4201(defvar org-all-time-keywords nil
4202 "List of time keywords.")
4203(make-variable-buffer-local 'org-all-time-keywords)
a3fbe8c4 4204
20908596
CD
4205(defconst org-plain-time-of-day-regexp
4206 (concat
4207 "\\(\\<[012]?[0-9]"
4208 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
4209 "\\(--?"
4210 "\\(\\<[012]?[0-9]"
4211 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
4212 "\\)?")
4213 "Regular expression to match a plain time or time range.
4214Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
4215groups carry important information:
42160 the full match
42171 the first time, range or not
42188 the second time, if it is a range.")
a3fbe8c4 4219
20908596
CD
4220(defconst org-plain-time-extension-regexp
4221 (concat
4222 "\\(\\<[012]?[0-9]"
4223 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
4224 "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?")
4225 "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40.
4226Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
4227groups carry important information:
42280 the full match
42297 hours of duration
42309 minutes of duration")
4231
4232(defconst org-stamp-time-of-day-regexp
4233 (concat
4234 "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)"
4235 "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>"
4236 "\\(--?"
4237 "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
4238 "Regular expression to match a timestamp time or time range.
4239After a match, the following groups carry important information:
42400 the full match
8bfe682a 42411 date plus weekday, for back referencing to make sure both times are on the same day
20908596
CD
42422 the first time, range or not
42434 the second time, if it is a range.")
4244
4245(defconst org-startup-options
4246 '(("fold" org-startup-folded t)
4247 ("overview" org-startup-folded t)
4248 ("nofold" org-startup-folded nil)
4249 ("showall" org-startup-folded nil)
8d642074 4250 ("showeverything" org-startup-folded showeverything)
20908596 4251 ("content" org-startup-folded content)
c8d0cf5c
CD
4252 ("indent" org-startup-indented t)
4253 ("noindent" org-startup-indented nil)
20908596
CD
4254 ("hidestars" org-hide-leading-stars t)
4255 ("showstars" org-hide-leading-stars nil)
4256 ("odd" org-odd-levels-only t)
4257 ("oddeven" org-odd-levels-only nil)
4258 ("align" org-startup-align-all-tables t)
4259 ("noalign" org-startup-align-all-tables nil)
afe98dfa
CD
4260 ("inlineimages" org-startup-with-inline-images t)
4261 ("noinlineimages" org-startup-with-inline-images nil)
20908596
CD
4262 ("customtime" org-display-custom-times t)
4263 ("logdone" org-log-done time)
4264 ("lognotedone" org-log-done note)
4265 ("nologdone" org-log-done nil)
4266 ("lognoteclock-out" org-log-note-clock-out t)
4267 ("nolognoteclock-out" org-log-note-clock-out nil)
4268 ("logrepeat" org-log-repeat state)
4269 ("lognoterepeat" org-log-repeat note)
4270 ("nologrepeat" org-log-repeat nil)
8bfe682a
CD
4271 ("logreschedule" org-log-reschedule time)
4272 ("lognotereschedule" org-log-reschedule note)
4273 ("nologreschedule" org-log-reschedule nil)
4274 ("logredeadline" org-log-redeadline time)
4275 ("lognoteredeadline" org-log-redeadline note)
4276 ("nologredeadline" org-log-redeadline nil)
ed21c5c8
CD
4277 ("logrefile" org-log-refile time)
4278 ("lognoterefile" org-log-refile note)
4279 ("nologrefile" org-log-refile nil)
0bd48b37
CD
4280 ("fninline" org-footnote-define-inline t)
4281 ("nofninline" org-footnote-define-inline nil)
4282 ("fnlocal" org-footnote-section nil)
4283 ("fnauto" org-footnote-auto-label t)
4284 ("fnprompt" org-footnote-auto-label nil)
4285 ("fnconfirm" org-footnote-auto-label confirm)
4286 ("fnplain" org-footnote-auto-label plain)
c8d0cf5c
CD
4287 ("fnadjust" org-footnote-auto-adjust t)
4288 ("nofnadjust" org-footnote-auto-adjust nil)
20908596 4289 ("constcgs" constants-unit-system cgs)
c8d0cf5c
CD
4290 ("constSI" constants-unit-system SI)
4291 ("noptag" org-tag-persistent-alist nil)
4292 ("hideblocks" org-hide-block-startup t)
ed21c5c8 4293 ("nohideblocks" org-hide-block-startup nil)
86fbb8ca
CD
4294 ("beamer" org-startup-with-beamer-mode t)
4295 ("entitiespretty" org-pretty-entities t)
4296 ("entitiesplain" org-pretty-entities nil))
20908596
CD
4297 "Variable associated with STARTUP options for org-mode.
4298Each element is a list of three items: The startup options as written
4299in the #+STARTUP line, the corresponding variable, and the value to
4300set this variable to if the option is found. An optional forth element PUSH
4301means to push this value onto the list in the variable.")
4302
4303(defun org-set-regexps-and-options ()
4304 "Precompute regular expressions for current buffer."
4305 (when (org-mode-p)
4306 (org-set-local 'org-todo-kwd-alist nil)
4307 (org-set-local 'org-todo-key-alist nil)
4308 (org-set-local 'org-todo-key-trigger nil)
4309 (org-set-local 'org-todo-keywords-1 nil)
4310 (org-set-local 'org-done-keywords nil)
4311 (org-set-local 'org-todo-heads nil)
4312 (org-set-local 'org-todo-sets nil)
4313 (org-set-local 'org-todo-log-states nil)
b349f79f
CD
4314 (org-set-local 'org-file-properties nil)
4315 (org-set-local 'org-file-tags nil)
20908596 4316 (let ((re (org-make-options-regexp
c8d0cf5c 4317 '("CATEGORY" "TODO" "COLUMNS"
b349f79f 4318 "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES"
86fbb8ca
CD
4319 "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS"
4320 "OPTIONS")
c8d0cf5c 4321 "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
20908596 4322 (splitre "[ \t]+")
86fbb8ca 4323 (scripts org-use-sub-superscripts)
20908596 4324 kwds kws0 kwsa key log value cat arch tags const links hw dws
ed21c5c8 4325 tail sep kws1 prio props ftags drawers beamer-p
b349f79f 4326 ext-setup-or-nil setup-contents (start 0))
a3fbe8c4 4327 (save-excursion
20908596
CD
4328 (save-restriction
4329 (widen)
4330 (goto-char (point-min))
b349f79f
CD
4331 (while (or (and ext-setup-or-nil
4332 (string-match re ext-setup-or-nil start)
4333 (setq start (match-end 0)))
4334 (and (setq ext-setup-or-nil nil start 0)
4335 (re-search-forward re nil t)))
4336 (setq key (upcase (match-string 1 ext-setup-or-nil))
4337 value (org-match-string-no-properties 2 ext-setup-or-nil))
86fbb8ca 4338 (if (stringp value) (setq value (org-trim value)))
20908596
CD
4339 (cond
4340 ((equal key "CATEGORY")
20908596
CD
4341 (setq cat value))
4342 ((member key '("SEQ_TODO" "TODO"))
4343 (push (cons 'sequence (org-split-string value splitre)) kwds))
4344 ((equal key "TYP_TODO")
4345 (push (cons 'type (org-split-string value splitre)) kwds))
c8d0cf5c
CD
4346 ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key)
4347 ;; general TODO-like setup
4348 (push (cons (intern (downcase (match-string 1 key)))
4349 (org-split-string value splitre)) kwds))
20908596 4350 ((equal key "TAGS")
c8d0cf5c
CD
4351 (setq tags (append tags (if tags '("\\n") nil)
4352 (org-split-string value splitre))))
20908596
CD
4353 ((equal key "COLUMNS")
4354 (org-set-local 'org-columns-default-format value))
4355 ((equal key "LINK")
4356 (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value)
4357 (push (cons (match-string 1 value)
4358 (org-trim (match-string 2 value)))
4359 links)))
4360 ((equal key "PRIORITIES")
4361 (setq prio (org-split-string value " +")))
4362 ((equal key "PROPERTY")
4363 (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
4364 (push (cons (match-string 1 value) (match-string 2 value))
4365 props)))
b349f79f
CD
4366 ((equal key "FILETAGS")
4367 (when (string-match "\\S-" value)
4368 (setq ftags
4369 (append
4370 ftags
4371 (apply 'append
4372 (mapcar (lambda (x) (org-split-string x ":"))
4373 (org-split-string value)))))))
20908596
CD
4374 ((equal key "DRAWERS")
4375 (setq drawers (org-split-string value splitre)))
4376 ((equal key "CONSTANTS")
4377 (setq const (append const (org-split-string value splitre))))
4378 ((equal key "STARTUP")
4379 (let ((opts (org-split-string value splitre))
4380 l var val)
4381 (while (setq l (pop opts))
4382 (when (setq l (assoc l org-startup-options))
4383 (setq var (nth 1 l) val (nth 2 l))
4384 (if (not (nth 3 l))
4385 (set (make-local-variable var) val)
4386 (if (not (listp (symbol-value var)))
4387 (set (make-local-variable var) nil))
4388 (set (make-local-variable var) (symbol-value var))
4389 (add-to-list var val))))))
4390 ((equal key "ARCHIVE")
86fbb8ca 4391 (setq arch value)
20908596 4392 (remove-text-properties 0 (length arch)
b349f79f 4393 '(face t fontified t) arch))
ed21c5c8
CD
4394 ((equal key "LATEX_CLASS")
4395 (setq beamer-p (equal value "beamer")))
86fbb8ca
CD
4396 ((equal key "OPTIONS")
4397 (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value)
4398 (setq scripts (read (match-string 2 value)))))
b349f79f
CD
4399 ((equal key "SETUPFILE")
4400 (setq setup-contents (org-file-contents
4401 (expand-file-name
4402 (org-remove-double-quotes value))
4403 'noerror))
4404 (if (not ext-setup-or-nil)
4405 (setq ext-setup-or-nil setup-contents start 0)
4406 (setq ext-setup-or-nil
4407 (concat (substring ext-setup-or-nil 0 start)
4408 "\n" setup-contents "\n"
4409 (substring ext-setup-or-nil start)))))
4410 ))))
86fbb8ca 4411 (org-set-local 'org-use-sub-superscripts scripts)
20908596
CD
4412 (when cat
4413 (org-set-local 'org-category (intern cat))
4414 (push (cons "CATEGORY" cat) props))
4415 (when prio
4416 (if (< (length prio) 3) (setq prio '("A" "C" "B")))
4417 (setq prio (mapcar 'string-to-char prio))
4418 (org-set-local 'org-highest-priority (nth 0 prio))
4419 (org-set-local 'org-lowest-priority (nth 1 prio))
4420 (org-set-local 'org-default-priority (nth 2 prio)))
b349f79f 4421 (and props (org-set-local 'org-file-properties (nreverse props)))
c8d0cf5c
CD
4422 (and ftags (org-set-local 'org-file-tags
4423 (mapcar 'org-add-prop-inherited ftags)))
20908596
CD
4424 (and drawers (org-set-local 'org-drawers drawers))
4425 (and arch (org-set-local 'org-archive-location arch))
4426 (and links (setq org-link-abbrev-alist-local (nreverse links)))
4427 ;; Process the TODO keywords
4428 (unless kwds
4429 ;; Use the global values as if they had been given locally.
4430 (setq kwds (default-value 'org-todo-keywords))
4431 (if (stringp (car kwds))
4432 (setq kwds (list (cons org-todo-interpretation
4433 (default-value 'org-todo-keywords)))))
4434 (setq kwds (reverse kwds)))
4435 (setq kwds (nreverse kwds))
4436 (let (inter kws kw)
4437 (while (setq kws (pop kwds))
c8d0cf5c
CD
4438 (let ((kws (or
4439 (run-hook-with-args-until-success
4440 'org-todo-setup-filter-hook kws)
4441 kws)))
4442 (setq inter (pop kws) sep (member "|" kws)
4443 kws0 (delete "|" (copy-sequence kws))
4444 kwsa nil
4445 kws1 (mapcar
4446 (lambda (x)
4447 ;; 1 2
4448 (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
4449 (progn
4450 (setq kw (match-string 1 x)
4451 key (and (match-end 2) (match-string 2 x))
4452 log (org-extract-log-state-settings x))
4453 (push (cons kw (and key (string-to-char key))) kwsa)
4454 (and log (push log org-todo-log-states))
4455 kw)
4456 (error "Invalid TODO keyword %s" x)))
4457 kws0)
4458 kwsa (if kwsa (append '((:startgroup))
4459 (nreverse kwsa)
4460 '((:endgroup))))
4461 hw (car kws1)
4462 dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
4463 tail (list inter hw (car dws) (org-last dws))))
20908596
CD
4464 (add-to-list 'org-todo-heads hw 'append)
4465 (push kws1 org-todo-sets)
4466 (setq org-done-keywords (append org-done-keywords dws nil))
4467 (setq org-todo-key-alist (append org-todo-key-alist kwsa))
4468 (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1)
4469 (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil)))
4470 (setq org-todo-sets (nreverse org-todo-sets)
4471 org-todo-kwd-alist (nreverse org-todo-kwd-alist)
4472 org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist))
4473 org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)))
4474 ;; Process the constants
4475 (when const
4476 (let (e cst)
4477 (while (setq e (pop const))
4478 (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
4479 (push (cons (match-string 1 e) (match-string 2 e)) cst)))
4480 (setq org-table-formula-constants-local cst)))
a3fbe8c4 4481
20908596
CD
4482 ;; Process the tags.
4483 (when tags
4484 (let (e tgs)
4485 (while (setq e (pop tags))
4486 (cond
4487 ((equal e "{") (push '(:startgroup) tgs))
4488 ((equal e "}") (push '(:endgroup) tgs))
c8d0cf5c 4489 ((equal e "\\n") (push '(:newline) tgs))
afe98dfa 4490 ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
20908596
CD
4491 (push (cons (match-string 1 e)
4492 (string-to-char (match-string 2 e)))
4493 tgs))
4494 (t (push (list e) tgs))))
4495 (org-set-local 'org-tag-alist nil)
4496 (while (setq e (pop tgs))
4497 (or (and (stringp (car e))
4498 (assoc (car e) org-tag-alist))
b349f79f
CD
4499 (push e org-tag-alist)))))
4500
4501 ;; Compute the regular expressions and other local variables
4502 (if (not org-done-keywords)
54a0dee5
CD
4503 (setq org-done-keywords (and org-todo-keywords-1
4504 (list (org-last org-todo-keywords-1)))))
b349f79f
CD
4505 (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string)
4506 (length org-scheduled-string)
4507 (length org-clock-string)
4508 (length org-closed-string)))
4509 org-drawer-regexp
4510 (concat "^[ \t]*:\\("
4511 (mapconcat 'regexp-quote org-drawers "\\|")
4512 "\\):[ \t]*$")
4513 org-not-done-keywords
4514 (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
4515 org-todo-regexp
4516 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1
4517 "\\|") "\\)\\>")
4518 org-not-done-regexp
4519 (concat "\\<\\("
4520 (mapconcat 'regexp-quote org-not-done-keywords "\\|")
4521 "\\)\\>")
c8d0cf5c
CD
4522 org-not-done-heading-regexp
4523 (concat "^\\(\\*+\\)[ \t]+\\("
4524 (mapconcat 'regexp-quote org-not-done-keywords "\\|")
4525 "\\)\\>")
b349f79f
CD
4526 org-todo-line-regexp
4527 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
4528 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
4529 "\\)\\>\\)?[ \t]*\\(.*\\)")
4530 org-complex-heading-regexp
0bd48b37 4531 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
b349f79f
CD
4532 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
4533 "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)"
afe98dfa 4534 "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
8d642074
CD
4535 org-complex-heading-regexp-format
4536 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
4537 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
86fbb8ca
CD
4538 "\\)\\>\\)?"
4539 "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?"
4540 "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
4541 "[ \t]*\\(%s\\)"
4542 "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
afe98dfa 4543 "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?[ \t]*$")
b349f79f
CD
4544 org-nl-done-regexp
4545 (concat "\n\\*+[ \t]+"
4546 "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|")
4547 "\\)" "\\>")
4548 org-todo-line-tags-regexp
4549 (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
4550 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
4551 (org-re
afe98dfa 4552 "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:[ \t]*\\)?$\\)"))
b349f79f
CD
4553 org-looking-at-done-regexp
4554 (concat "^" "\\(?:"
4555 (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)"
4556 "\\>")
4557 org-deadline-regexp (concat "\\<" org-deadline-string)
4558 org-deadline-time-regexp
4559 (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
4560 org-deadline-line-regexp
4561 (concat "\\<\\(" org-deadline-string "\\).*")
4562 org-scheduled-regexp
4563 (concat "\\<" org-scheduled-string)
4564 org-scheduled-time-regexp
4565 (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
4566 org-closed-time-regexp
4567 (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
4568 org-keyword-time-regexp
4569 (concat "\\<\\(" org-scheduled-string
4570 "\\|" org-deadline-string
4571 "\\|" org-closed-string
4572 "\\|" org-clock-string "\\)"
4573 " *[[<]\\([^]>]+\\)[]>]")
4574 org-keyword-time-not-clock-regexp
4575 (concat "\\<\\(" org-scheduled-string
4576 "\\|" org-deadline-string
4577 "\\|" org-closed-string
4578 "\\)"
4579 " *[[<]\\([^]>]+\\)[]>]")
4580 org-maybe-keyword-time-regexp
4581 (concat "\\(\\<\\(" org-scheduled-string
4582 "\\|" org-deadline-string
4583 "\\|" org-closed-string
4584 "\\|" org-clock-string "\\)\\)?"
4585 " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
4586 org-planning-or-clock-line-re
4587 (concat "\\(?:^[ \t]*\\(" org-scheduled-string
4588 "\\|" org-deadline-string
4589 "\\|" org-closed-string "\\|" org-clock-string
4590 "\\)\\>\\)")
ed21c5c8
CD
4591 org-all-time-keywords
4592 (mapcar (lambda (w) (substring w 0 -1))
4593 (list org-scheduled-string org-deadline-string
4594 org-clock-string org-closed-string))
b349f79f
CD
4595 )
4596 (org-compute-latex-and-specials-regexp)
4597 (org-set-font-lock-defaults))))
4598
4599(defun org-file-contents (file &optional noerror)
4600 "Return the contents of FILE, as a string."
4601 (if (or (not file)
4602 (not (file-readable-p file)))
4603 (if noerror
4604 (progn
86fbb8ca 4605 (message "Cannot read file \"%s\"" file)
b349f79f
CD
4606 (ding) (sit-for 2)
4607 "")
86fbb8ca 4608 (error "Cannot read file \"%s\"" file))
b349f79f
CD
4609 (with-temp-buffer
4610 (insert-file-contents file)
4611 (buffer-string))))
891f4676 4612
20908596
CD
4613(defun org-extract-log-state-settings (x)
4614 "Extract the log state setting from a TODO keyword string.
4615This will extract info from a string like \"WAIT(w@/!)\"."
4616 (let (kw key log1 log2)
4617 (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
4618 (setq kw (match-string 1 x)
4619 key (and (match-end 2) (match-string 2 x))
4620 log1 (and (match-end 3) (match-string 3 x))
4621 log2 (and (match-end 4) (match-string 4 x)))
4622 (and (or log1 log2)
4623 (list kw
4624 (and log1 (if (equal log1 "!") 'time 'note))
4625 (and log2 (if (equal log2 "!") 'time 'note)))))))
891f4676 4626
20908596
CD
4627(defun org-remove-keyword-keys (list)
4628 "Remove a pair of parenthesis at the end of each string in LIST."
4629 (mapcar (lambda (x)
4630 (if (string-match "(.*)$" x)
4631 (substring x 0 (match-beginning 0))
4632 x))
4633 list))
891f4676 4634
20908596
CD
4635(defun org-assign-fast-keys (alist)
4636 "Assign fast keys to a keyword-key alist.
4637Respect keys that are already there."
ed21c5c8 4638 (let (new e (alt ?0))
20908596 4639 (while (setq e (pop alist))
ed21c5c8
CD
4640 (if (or (memq (car e) '(:newline :endgroup :startgroup))
4641 (cdr e)) ;; Key already assigned.
4642 (push e new)
4643 (let ((clist (string-to-list (downcase (car e))))
4644 (used (append new alist)))
4645 (when (= (car clist) ?@)
4646 (pop clist))
4647 (while (and clist (rassoc (car clist) used))
4648 (pop clist))
4649 (unless clist
4650 (while (rassoc alt used)
4651 (incf alt)))
4652 (push (cons (car e) (or (car clist) alt)) new))))
20908596 4653 (nreverse new)))
d3f4dbe8 4654
20908596 4655;;; Some variables used in various places
d3f4dbe8 4656
20908596
CD
4657(defvar org-window-configuration nil
4658 "Used in various places to store a window configuration.")
8d642074
CD
4659(defvar org-selected-window nil
4660 "Used in various places to store a window configuration.")
20908596
CD
4661(defvar org-finish-function nil
4662 "Function to be called when `C-c C-c' is used.
4663This is for getting out of special buffers like remember.")
d3f4dbe8 4664
d3f4dbe8 4665
20908596
CD
4666;; FIXME: Occasionally check by commenting these, to make sure
4667;; no other functions uses these, forgetting to let-bind them.
4668(defvar entry)
20908596
CD
4669(defvar last-state)
4670(defvar date)
d3f4dbe8 4671
20908596 4672;; Defined somewhere in this file, but used before definition.
ed21c5c8 4673(defvar org-entities) ;; defined in org-entities.el
20908596
CD
4674(defvar org-struct-menu)
4675(defvar org-org-menu)
4676(defvar org-tbl-menu)
3278a016 4677
20908596 4678;;;; Define the Org-mode
3278a016 4679
20908596 4680(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
86fbb8ca 4681 (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 4682
d3f4dbe8 4683
20908596
CD
4684;; We use a before-change function to check if a table might need
4685;; an update.
4686(defvar org-table-may-need-update t
4687 "Indicates that a table might need an update.
4688This variable is set by `org-before-change-function'.
4689`org-table-align' sets it back to nil.")
4690(defun org-before-change-function (beg end)
4691 "Every change indicates that a table might need an update."
4692 (setq org-table-may-need-update t))
4693(defvar org-mode-map)
20908596 4694(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
ed21c5c8 4695(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param.
20908596 4696(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
c8d0cf5c
CD
4697(defvar org-inhibit-logging nil) ; Dynamically-scoped param.
4698(defvar org-inhibit-blocking nil) ; Dynamically-scoped param.
20908596 4699(defvar org-table-buffer-is-an nil)
3ab2c837
BG
4700
4701;; org-outline-regexp ought to be a defconst but is let-binding
4702;; in some places -- e.g. see the macro org-with-limited-levels
4703(defvar org-outline-regexp "\\*+ ")
4704(defconst org-outline-regexp-bol "^\\*+ ")
f425a6ea
CD
4705
4706;;;###autoload
20908596
CD
4707(define-derived-mode org-mode outline-mode "Org"
4708 "Outline-based notes management and organizer, alias
4709\"Carsten's outline-mode for keeping track of everything.\"
891f4676 4710
20908596
CD
4711Org-mode develops organizational tasks around a NOTES file which
4712contains information about projects as plain text. Org-mode is
4713implemented on top of outline-mode, which is ideal to keep the content
4714of large files well structured. It supports ToDo items, deadlines and
4715time stamps, which magically appear in the diary listing of the Emacs
4716calendar. Tables are easily created with a built-in table editor.
4717Plain text URL-like links connect to websites, emails (VM), Usenet
4718messages (Gnus), BBDB entries, and any files related to the project.
4719For printing and sharing of notes, an Org-mode file (or a part of it)
4720can be exported as a structured ASCII or HTML file.
35fb9989 4721
20908596 4722The following commands are available:
35fb9989 4723
20908596 4724\\{org-mode-map}"
634a7d0b 4725
20908596
CD
4726 ;; Get rid of Outline menus, they are not needed
4727 ;; Need to do this here because define-derived-mode sets up
4728 ;; the keymap so late. Still, it is a waste to call this each time
4729 ;; we switch another buffer into org-mode.
4730 (if (featurep 'xemacs)
4731 (when (boundp 'outline-mode-menu-heading)
86fbb8ca 4732 ;; Assume this is Greg's port, it uses easymenu
20908596
CD
4733 (easy-menu-remove outline-mode-menu-heading)
4734 (easy-menu-remove outline-mode-menu-show)
4735 (easy-menu-remove outline-mode-menu-hide))
4736 (define-key org-mode-map [menu-bar headings] 'undefined)
4737 (define-key org-mode-map [menu-bar hide] 'undefined)
4738 (define-key org-mode-map [menu-bar show] 'undefined))
a3fbe8c4 4739
20908596
CD
4740 (org-load-modules-maybe)
4741 (easy-menu-add org-org-menu)
4742 (easy-menu-add org-tbl-menu)
4743 (org-install-agenda-files-menu)
86fbb8ca
CD
4744 (if org-descriptive-links (add-to-invisibility-spec '(org-link)))
4745 (add-to-invisibility-spec '(org-cwidth))
4746 (add-to-invisibility-spec '(org-hide-block . t))
20908596
CD
4747 (when (featurep 'xemacs)
4748 (org-set-local 'line-move-ignore-invisible t))
4749 (org-set-local 'outline-regexp org-outline-regexp)
4750 (org-set-local 'outline-level 'org-outline-level)
aa97fd08 4751 (setq bidi-paragraph-direction 'left-to-right)
20908596
CD
4752 (when (and org-ellipsis
4753 (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)
4754 (fboundp 'make-glyph-code))
4755 (unless org-display-table
4756 (setq org-display-table (make-display-table)))
4757 (set-display-table-slot
4758 org-display-table 4
4759 (vconcat (mapcar
4760 (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
4761 org-ellipsis)))
4762 (if (stringp org-ellipsis) org-ellipsis "..."))))
4763 (setq buffer-display-table org-display-table))
4764 (org-set-regexps-and-options)
fdf730ed
CD
4765 (when (and org-tag-faces (not org-tags-special-faces-re))
4766 ;; tag faces set outside customize.... force initialization.
4767 (org-set-tag-faces 'org-tag-faces org-tag-faces))
20908596
CD
4768 ;; Calc embedded
4769 (org-set-local 'calc-embedded-open-mode "# ")
20908596
CD
4770 (modify-syntax-entry ?@ "w")
4771 (if org-startup-truncated (setq truncate-lines t))
4772 (org-set-local 'font-lock-unfontify-region-function
4773 'org-unfontify-region)
4774 ;; Activate before-change-function
4775 (org-set-local 'org-table-may-need-update t)
4776 (org-add-hook 'before-change-functions 'org-before-change-function nil
4777 'local)
4778 ;; Check for running clock before killing a buffer
4779 (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
4780 ;; Paragraphs and auto-filling
4781 (org-set-autofill-regexps)
4782 (setq indent-line-function 'org-indent-line-function)
4783 (org-update-radio-target-regexp)
86fbb8ca
CD
4784 ;; Beginning/end of defun
4785 (org-set-local 'beginning-of-defun-function 'org-beginning-of-defun)
4786 (org-set-local 'end-of-defun-function 'org-end-of-defun)
3ab2c837
BG
4787 ;; Next error for sparse trees
4788 (org-set-local 'next-error-function 'org-occur-next-match)
5ace2fe5
CD
4789 ;; Make sure dependence stuff works reliably, even for users who set it
4790 ;; too late :-(
4791 (if org-enforce-todo-dependencies
4792 (add-hook 'org-blocker-hook
c8d0cf5c 4793 'org-block-todo-from-children-or-siblings-or-parent)
5ace2fe5 4794 (remove-hook 'org-blocker-hook
c8d0cf5c 4795 'org-block-todo-from-children-or-siblings-or-parent))
5ace2fe5
CD
4796 (if org-enforce-todo-checkbox-dependencies
4797 (add-hook 'org-blocker-hook
4798 'org-block-todo-from-checkboxes)
4799 (remove-hook 'org-blocker-hook
4800 'org-block-todo-from-checkboxes))
7ac93e3c 4801
20908596 4802 ;; Comment characters
86fbb8ca 4803 (org-set-local 'comment-start "#")
20908596 4804 (org-set-local 'comment-padding " ")
891f4676 4805
20908596
CD
4806 ;; Align options lines
4807 (org-set-local
4808 'align-mode-rules-list
4809 '((org-in-buffer-settings
4810 (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
4811 (modes . '(org-mode)))))
891f4676 4812
20908596
CD
4813 ;; Imenu
4814 (org-set-local 'imenu-create-index-function
4815 'org-imenu-get-tree)
891f4676 4816
20908596
CD
4817 ;; Make isearch reveal context
4818 (if (or (featurep 'xemacs)
4819 (not (boundp 'outline-isearch-open-invisible-function)))
4820 ;; Emacs 21 and XEmacs make use of the hook
4821 (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local)
4822 ;; Emacs 22 deals with this through a special variable
4823 (org-set-local 'outline-isearch-open-invisible-function
4824 (lambda (&rest ignore) (org-show-context 'isearch))))
634a7d0b 4825
ed21c5c8
CD
4826 ;; Turn on org-beamer-mode?
4827 (and org-startup-with-beamer-mode (org-beamer-mode 1))
4828
acedf35c
CD
4829 ;; Setup the pcomplete hooks
4830 (set (make-local-variable 'pcomplete-command-completion-function)
3ab2c837 4831 'org-pcomplete-initial)
acedf35c
CD
4832 (set (make-local-variable 'pcomplete-command-name-function)
4833 'org-command-at-point)
4834 (set (make-local-variable 'pcomplete-default-completion-function)
4835 'ignore)
4836 (set (make-local-variable 'pcomplete-parse-arguments-function)
4837 'org-parse-arguments)
4838 (set (make-local-variable 'pcomplete-termination-string) "")
3ab2c837
BG
4839 (set (make-local-variable 'face-remapping-alist)
4840 '((default org-default)))
acedf35c 4841
20908596
CD
4842 ;; If empty file that did not turn on org-mode automatically, make it to.
4843 (if (and org-insert-mode-line-in-empty-file
3ab2c837 4844 (org-called-interactively-p 'any)
20908596
CD
4845 (= (point-min) (point-max)))
4846 (insert "# -*- mode: org -*-\n\n"))
20908596
CD
4847 (unless org-inhibit-startup
4848 (when org-startup-align-all-tables
4849 (let ((bmp (buffer-modified-p)))
86fbb8ca 4850 (org-table-map-tables 'org-table-align 'quietly)
20908596 4851 (set-buffer-modified-p bmp)))
afe98dfa
CD
4852 (when org-startup-with-inline-images
4853 (org-display-inline-images))
c8d0cf5c
CD
4854 (when org-startup-indented
4855 (require 'org-indent)
4856 (org-indent-mode 1))
ed21c5c8
CD
4857 (unless org-inhibit-startup-visibility-stuff
4858 (org-set-startup-visibility))))
ef943dba 4859
8bfe682a
CD
4860(when (fboundp 'abbrev-table-put)
4861 (abbrev-table-put org-mode-abbrev-table
4862 :parents (list text-mode-abbrev-table)))
4863
20908596 4864(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
b9661543 4865
20908596
CD
4866(defun org-current-time ()
4867 "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
4868 (if (> (car org-time-stamp-rounding-minutes) 1)
4869 (let ((r (car org-time-stamp-rounding-minutes))
4870 (time (decode-time)))
4871 (apply 'encode-time
4872 (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
4873 (nthcdr 2 time))))
4874 (current-time)))
ef943dba 4875
acedf35c
CD
4876(defun org-today ()
4877 "Return today date, considering `org-extend-today-until'."
4878 (time-to-days
4879 (time-subtract (current-time)
4880 (list 0 (* 3600 org-extend-today-until) 0))))
4881
20908596 4882;;;; Font-Lock stuff, including the activators
ef943dba 4883
20908596 4884(defvar org-mouse-map (make-sparse-keymap))
86fbb8ca
CD
4885(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse)
4886(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse)
20908596
CD
4887(when org-mouse-1-follows-link
4888 (org-defkey org-mouse-map [follow-link] 'mouse-face))
4889(when org-tab-follows-link
4890 (org-defkey org-mouse-map [(tab)] 'org-open-at-point)
4891 (org-defkey org-mouse-map "\C-i" 'org-open-at-point))
48aaad2d 4892
20908596 4893(require 'font-lock)
48aaad2d 4894
20908596
CD
4895(defconst org-non-link-chars "]\t\n\r<>")
4896(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
afe98dfa 4897 "shell" "elisp" "doi" "message"))
20908596
CD
4898(defvar org-link-types-re nil
4899 "Matches a link that has a url-like prefix like \"http:\"")
4900(defvar org-link-re-with-space nil
4901 "Matches a link with spaces, optional angular brackets around it.")
4902(defvar org-link-re-with-space2 nil
4903 "Matches a link with spaces, optional angular brackets around it.")
ce4fdcb9
CD
4904(defvar org-link-re-with-space3 nil
4905 "Matches a link with spaces, only for internal part in bracket links.")
20908596
CD
4906(defvar org-angle-link-re nil
4907 "Matches link with angular brackets, spaces are allowed.")
4908(defvar org-plain-link-re nil
4909 "Matches plain link, without spaces.")
4910(defvar org-bracket-link-regexp nil
4911 "Matches a link in double brackets.")
4912(defvar org-bracket-link-analytic-regexp nil
4913 "Regular expression used to analyze links.
4914Here is what the match groups contain after a match:
49151: http:
49162: http
49173: path
49184: [desc]
49195: desc")
0bd48b37 4920(defvar org-bracket-link-analytic-regexp++ nil
86fbb8ca 4921 "Like `org-bracket-link-analytic-regexp', but include coderef internal type.")
20908596
CD
4922(defvar org-any-link-re nil
4923 "Regular expression matching any link.")
48aaad2d 4924
86fbb8ca
CD
4925(defcustom org-match-sexp-depth 3
4926 "Number of stacked braces for sub/superscript matching.
4927This has to be set before loading org.el to be effective."
4928 :group 'org-export-translation ; ??????????????????????????/
4929 :type 'integer)
4930
4931(defun org-create-multibrace-regexp (left right n)
4932 "Create a regular expression which will match a balanced sexp.
4933Opening delimiter is LEFT, and closing delimiter is RIGHT, both given
4934as single character strings.
4935The regexp returned will match the entire expression including the
4936delimiters. It will also define a single group which contains the
4937match except for the outermost delimiters. The maximum depth of
4938stacked delimiters is N. Escaping delimiters is not possible."
4939 (let* ((nothing (concat "[^" left right "]*?"))
4940 (or "\\|")
4941 (re nothing)
4942 (next (concat "\\(?:" nothing left nothing right "\\)+" nothing)))
4943 (while (> n 1)
4944 (setq n (1- n)
4945 re (concat re or next)
4946 next (concat "\\(?:" nothing left next right "\\)+" nothing)))
4947 (concat left "\\(" re "\\)" right)))
4948
4949(defvar org-match-substring-regexp
4950 (concat
4951 "\\([^\\]\\)\\([_^]\\)\\("
4952 "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
4953 "\\|"
4954 "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
4955 "\\|"
4956 "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
4957 "The regular expression matching a sub- or superscript.")
4958
4959(defvar org-match-substring-with-braces-regexp
4960 (concat
4961 "\\([^\\]\\)\\([_^]\\)\\("
4962 "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
4963 "\\)")
4964 "The regular expression matching a sub- or superscript, forcing braces.")
4965
20908596
CD
4966(defun org-make-link-regexps ()
4967 "Update the link regular expressions.
4968This should be called after the variable `org-link-types' has changed."
4969 (setq org-link-types-re
4970 (concat
ed21c5c8 4971 "\\`\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):")
20908596
CD
4972 org-link-re-with-space
4973 (concat
ed21c5c8 4974 "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
20908596
CD
4975 "\\([^" org-non-link-chars " ]"
4976 "[^" org-non-link-chars "]*"
4977 "[^" org-non-link-chars " ]\\)>?")
4978 org-link-re-with-space2
4979 (concat
ed21c5c8 4980 "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
20908596 4981 "\\([^" org-non-link-chars " ]"
93b62de8 4982 "[^\t\n\r]*"
20908596 4983 "[^" org-non-link-chars " ]\\)>?")
ce4fdcb9
CD
4984 org-link-re-with-space3
4985 (concat
ed21c5c8 4986 "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
ce4fdcb9
CD
4987 "\\([^" org-non-link-chars " ]"
4988 "[^\t\n\r]*\\)")
20908596
CD
4989 org-angle-link-re
4990 (concat
ed21c5c8 4991 "<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
20908596
CD
4992 "\\([^" org-non-link-chars " ]"
4993 "[^" org-non-link-chars "]*"
4994 "\\)>")
4995 org-plain-link-re
4996 (concat
ed21c5c8 4997 "\\<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
afe98dfa 4998 (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)"))
ed21c5c8 4999 ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
20908596
CD
5000 org-bracket-link-regexp
5001 "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
5002 org-bracket-link-analytic-regexp
5003 (concat
5004 "\\[\\["
ed21c5c8 5005 "\\(\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):\\)?"
20908596
CD
5006 "\\([^]]+\\)"
5007 "\\]"
5008 "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
5009 "\\]")
0bd48b37
CD
5010 org-bracket-link-analytic-regexp++
5011 (concat
5012 "\\[\\["
ed21c5c8 5013 "\\(\\(" (mapconcat 'regexp-quote (cons "coderef" org-link-types) "\\|") "\\):\\)?"
0bd48b37
CD
5014 "\\([^]]+\\)"
5015 "\\]"
5016 "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
5017 "\\]")
20908596
CD
5018 org-any-link-re
5019 (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
5020 org-angle-link-re "\\)\\|\\("
5021 org-plain-link-re "\\)")))
48aaad2d 5022
20908596 5023(org-make-link-regexps)
8c6fb58b 5024
20908596
CD
5025(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^\r\n>]*?\\)>"
5026 "Regular expression for fast time stamp matching.")
3ab2c837 5027(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]\r\n>]*?\\)[]>]"
20908596 5028 "Regular expression for fast time stamp matching.")
3ab2c837 5029(defconst org-ts-regexp0 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
20908596
CD
5030 "Regular expression matching time strings for analysis.
5031This one does not require the space after the date, so it can be used
5032on a string that terminates immediately after the date.")
3ab2c837 5033(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) +\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)"
20908596
CD
5034 "Regular expression matching time strings for analysis.")
5035(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>")
5036 "Regular expression matching time stamps, with groups.")
5037(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]")
5038 "Regular expression matching time stamps (also [..]), with groups.")
5039(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp)
5040 "Regular expression matching a time stamp range.")
5041(defconst org-tr-regexp-both
5042 (concat org-ts-regexp-both "--?-?" org-ts-regexp-both)
5043 "Regular expression matching a time stamp range.")
5044(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?"
5045 org-ts-regexp "\\)?")
5046 "Regular expression matching a time stamp or time stamp range.")
5047(defconst org-tsr-regexp-both (concat org-ts-regexp-both "\\(--?-?"
5048 org-ts-regexp-both "\\)?")
5049 "Regular expression matching a time stamp or time stamp range.
5050The time stamps may be either active or inactive.")
48aaad2d 5051
20908596 5052(defvar org-emph-face nil)
2a57416f 5053
20908596 5054(defun org-do-emphasis-faces (limit)
4c36be58 5055 "Run through the buffer and add overlays to emphasized strings."
c8d0cf5c 5056 (let (rtn a)
20908596
CD
5057 (while (and (not rtn) (re-search-forward org-emph-re limit t))
5058 (if (not (= (char-after (match-beginning 3))
5059 (char-after (match-beginning 4))))
5060 (progn
5061 (setq rtn t)
c8d0cf5c 5062 (setq a (assoc (match-string 3) org-emphasis-alist))
20908596
CD
5063 (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
5064 'face
c8d0cf5c
CD
5065 (nth 1 a))
5066 (and (nth 4 a)
5067 (org-remove-flyspell-overlays-in
5068 (match-beginning 0) (match-end 0)))
20908596 5069 (add-text-properties (match-beginning 2) (match-end 2)
86fbb8ca 5070 '(font-lock-multiline t org-emphasis t))
20908596
CD
5071 (when org-hide-emphasis-markers
5072 (add-text-properties (match-end 4) (match-beginning 5)
5073 '(invisible org-link))
5074 (add-text-properties (match-beginning 3) (match-end 3)
5075 '(invisible org-link)))))
5076 (backward-char 1))
5077 rtn))
891f4676 5078
20908596
CD
5079(defun org-emphasize (&optional char)
5080 "Insert or change an emphasis, i.e. a font like bold or italic.
5081If there is an active region, change that region to a new emphasis.
5082If there is no region, just insert the marker characters and position
5083the cursor between them.
5084CHAR should be either the marker character, or the first character of the
5085HTML tag associated with that emphasis. If CHAR is a space, the means
5086to remove the emphasis of the selected region.
5087If char is not given (for example in an interactive call) it
5088will be prompted for."
5089 (interactive)
5090 (let ((eal org-emphasis-alist) e det
5091 (erc org-emphasis-regexp-components)
5092 (prompt "")
5093 (string "") beg end move tag c s)
5094 (if (org-region-active-p)
5095 (setq beg (region-beginning) end (region-end)
5096 string (buffer-substring beg end))
5097 (setq move t))
48aaad2d 5098
20908596
CD
5099 (while (setq e (pop eal))
5100 (setq tag (car (org-split-string (nth 2 e) "[ <>/]+"))
5101 c (aref tag 0))
5102 (push (cons c (string-to-char (car e))) det)
5103 (setq prompt (concat prompt (format " [%s%c]%s" (car e) c
5104 (substring tag 1)))))
93b62de8 5105 (setq det (nreverse det))
20908596
CD
5106 (unless char
5107 (message "%s" (concat "Emphasis marker or tag:" prompt))
5108 (setq char (read-char-exclusive)))
5109 (setq char (or (cdr (assoc char det)) char))
5110 (if (equal char ?\ )
5111 (setq s "" move nil)
5112 (unless (assoc (char-to-string char) org-emphasis-alist)
5113 (error "No such emphasis marker: \"%c\"" char))
5114 (setq s (char-to-string char)))
5115 (while (and (> (length string) 1)
5116 (equal (substring string 0 1) (substring string -1))
5117 (assoc (substring string 0 1) org-emphasis-alist))
5118 (setq string (substring string 1 -1)))
5119 (setq string (concat s string s))
5120 (if beg (delete-region beg end))
5121 (unless (or (bolp)
5122 (string-match (concat "[" (nth 0 erc) "\n]")
5123 (char-to-string (char-before (point)))))
5124 (insert " "))
ed21c5c8
CD
5125 (unless (or (eobp)
5126 (string-match (concat "[" (nth 1 erc) "\n]")
5127 (char-to-string (char-after (point)))))
20908596
CD
5128 (insert " ") (backward-char 1))
5129 (insert string)
5130 (and move (backward-char 1))))
891f4676 5131
20908596
CD
5132(defconst org-nonsticky-props
5133 '(mouse-face highlight keymap invisible intangible help-echo org-linked-text))
891f4676 5134
c8d0cf5c
CD
5135(defsubst org-rear-nonsticky-at (pos)
5136 (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
891f4676 5137
20908596
CD
5138(defun org-activate-plain-links (limit)
5139 "Run through the buffer and add overlays to links."
5140 (catch 'exit
5141 (let (f)
c8d0cf5c
CD
5142 (if (re-search-forward org-plain-link-re limit t)
5143 (progn
5144 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
5145 (setq f (get-text-property (match-beginning 0) 'face))
5146 (if (or (eq f 'org-tag)
5147 (and (listp f) (memq 'org-tag f)))
5148 nil
5149 (add-text-properties (match-beginning 0) (match-end 0)
5150 (list 'mouse-face 'highlight
5dec9555 5151 'face 'org-link
c8d0cf5c
CD
5152 'keymap org-mouse-map))
5153 (org-rear-nonsticky-at (match-end 0)))
5154 t)))))
891f4676 5155
20908596 5156(defun org-activate-code (limit)
621f83e4
CD
5157 (if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t)
5158 (progn
c8d0cf5c 5159 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
20908596
CD
5160 (remove-text-properties (match-beginning 0) (match-end 0)
5161 '(display t invisible t intangible t))
5162 t)))
891f4676 5163
afe98dfa
CD
5164(defcustom org-src-fontify-natively nil
5165 "When non-nil, fontify code in code blocks."
5166 :type 'boolean
5167 :group 'org-appearance
5168 :group 'org-babel)
5169
c8d0cf5c 5170(defun org-fontify-meta-lines-and-blocks (limit)
3ab2c837
BG
5171 (condition-case nil
5172 (org-fontify-meta-lines-and-blocks-1 limit)
5173 (error (message "org-mode fontification error"))))
5174
5175(defun org-fontify-meta-lines-and-blocks-1 (limit)
c8d0cf5c
CD
5176 "Fontify #+ lines and blocks, in the correct ways."
5177 (let ((case-fold-search t))
5178 (if (re-search-forward
afe98dfa 5179 "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
c8d0cf5c
CD
5180 limit t)
5181 (let ((beg (match-beginning 0))
afe98dfa
CD
5182 (block-start (match-end 0))
5183 (block-end nil)
5184 (lang (match-string 7))
c8d0cf5c
CD
5185 (beg1 (line-beginning-position 2))
5186 (dc1 (downcase (match-string 2)))
5187 (dc3 (downcase (match-string 3)))
3ab2c837 5188 end end1 quoting block-type ovl)
c8d0cf5c
CD
5189 (cond
5190 ((member dc1 '("html:" "ascii:" "latex:" "docbook:"))
5191 ;; a single line of backend-specific content
5192 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
5193 (remove-text-properties (match-beginning 0) (match-end 0)
5194 '(display t invisible t intangible t))
5195 (add-text-properties (match-beginning 1) (match-end 3)
5196 '(font-lock-fontified t face org-meta-line))
afe98dfa 5197 (add-text-properties (match-beginning 6) (+ (match-end 6) 1)
c8d0cf5c 5198 '(font-lock-fontified t face org-block))
afe98dfa 5199 ; for backend-specific code
c8d0cf5c
CD
5200 t)
5201 ((and (match-end 4) (equal dc3 "begin"))
86fbb8ca 5202 ;; Truly a block
5dec9555
CD
5203 (setq block-type (downcase (match-string 5))
5204 quoting (member block-type org-protecting-blocks))
c8d0cf5c
CD
5205 (when (re-search-forward
5206 (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*")
5207 nil t) ;; on purpose, we look further than LIMIT
5208 (setq end (match-end 0) end1 (1- (match-beginning 0)))
afe98dfa 5209 (setq block-end (match-beginning 0))
c8d0cf5c
CD
5210 (when quoting
5211 (remove-text-properties beg end
5212 '(display t invisible t intangible t)))
5213 (add-text-properties
5214 beg end
5215 '(font-lock-fontified t font-lock-multiline t))
5216 (add-text-properties beg beg1 '(face org-meta-line))
3ab2c837
BG
5217 (add-text-properties end1 (min (point-max) (1+ end))
5218 '(face org-meta-line)) ; for end_src
5dec9555 5219 (cond
3ab2c837
BG
5220 ((and lang (not (string= lang "")) org-src-fontify-natively)
5221 (org-src-font-lock-fontify-block lang block-start block-end)
5222 ;; remove old background overlays
5223 (mapc (lambda (ov)
5224 (if (eq (overlay-get ov 'face) 'org-block-background)
5225 (delete-overlay ov)))
5226 (overlays-at (/ (+ beg1 block-end) 2)))
5227 ;; add a background overlay
5228 (setq ovl (make-overlay beg1 block-end))
5229 (overlay-put ovl 'face 'org-block-background)
5230 (overlay-put ovl 'evaporate t)) ;; make it go away when empty
5dec9555 5231 (quoting
3ab2c837
BG
5232 (add-text-properties beg1 (min (point-max) (1+ end1))
5233 '(face org-block))) ; end of source block
ed21c5c8 5234 ((not org-fontify-quote-and-verse-blocks))
5dec9555 5235 ((string= block-type "quote")
3ab2c837 5236 (add-text-properties beg1 (1+ end1) '(face org-quote)))
5dec9555 5237 ((string= block-type "verse")
3ab2c837
BG
5238 (add-text-properties beg1 (1+ end1) '(face org-verse))))
5239 (add-text-properties beg beg1 '(face org-block-begin-line))
5240 (add-text-properties (1+ end) (1+ end1) '(face org-block-end-line))
c8d0cf5c 5241 t))
ed21c5c8
CD
5242 ((member dc1 '("title:" "author:" "email:" "date:"))
5243 (add-text-properties
5244 beg (match-end 3)
5245 (if (member (intern (substring dc1 0 -1)) org-hidden-keywords)
5246 '(font-lock-fontified t invisible t)
5247 '(font-lock-fontified t face org-document-info-keyword)))
5248 (add-text-properties
5249 (match-beginning 6) (match-end 6)
5250 (if (string-equal dc1 "title:")
5251 '(font-lock-fontified t face org-document-title)
5252 '(font-lock-fontified t face org-document-info))))
c8d0cf5c
CD
5253 ((not (member (char-after beg) '(?\ ?\t)))
5254 ;; just any other in-buffer setting, but not indented
5255 (add-text-properties
3ab2c837 5256 beg (1+ (match-end 0))
c8d0cf5c
CD
5257 '(font-lock-fontified t face org-meta-line))
5258 t)
8d642074 5259 ((or (member dc1 '("begin:" "end:" "caption:" "label:"
86fbb8ca 5260 "orgtbl:" "tblfm:" "tblname:" "result:"
3ab2c837
BG
5261 "results:" "source:" "srcname:" "call:"
5262 "data:" "header:" "headers:"))
c8d0cf5c
CD
5263 (and (match-end 4) (equal dc3 "attr")))
5264 (add-text-properties
5265 beg (match-end 0)
5266 '(font-lock-fontified t face org-meta-line))
5267 t)
8d642074
CD
5268 ((member dc3 '(" " ""))
5269 (add-text-properties
5270 beg (match-end 0)
5271 '(font-lock-fontified t face font-lock-comment-face)))
c8d0cf5c
CD
5272 (t nil))))))
5273
20908596
CD
5274(defun org-activate-angle-links (limit)
5275 "Run through the buffer and add overlays to links."
5276 (if (re-search-forward org-angle-link-re limit t)
5277 (progn
c8d0cf5c 5278 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
20908596
CD
5279 (add-text-properties (match-beginning 0) (match-end 0)
5280 (list 'mouse-face 'highlight
c8d0cf5c
CD
5281 'keymap org-mouse-map))
5282 (org-rear-nonsticky-at (match-end 0))
20908596 5283 t)))
891f4676 5284
0bd48b37 5285(defun org-activate-footnote-links (limit)
3ab2c837
BG
5286 "Run through the buffer and add overlays to footnotes."
5287 (let ((fn (org-footnote-next-reference-or-definition limit)))
5288 (when fn
5289 (let ((beg (nth 1 fn)) (end (nth 2 fn)))
5290 (org-remove-flyspell-overlays-in beg end)
5291 (add-text-properties beg end
0bd48b37 5292 (list 'mouse-face 'highlight
0bd48b37
CD
5293 'keymap org-mouse-map
5294 'help-echo
3ab2c837 5295 (if (= (point-at-bol) beg)
0bd48b37
CD
5296 "Footnote definition"
5297 "Footnote reference")
3ab2c837
BG
5298 'font-lock-fontified t
5299 'font-lock-multiline t
5300 'face 'org-footnote))))))
0bd48b37 5301
20908596
CD
5302(defun org-activate-bracket-links (limit)
5303 "Run through the buffer and add overlays to bracketed links."
5304 (if (re-search-forward org-bracket-link-regexp limit t)
5305 (let* ((help (concat "LINK: "
5306 (org-match-string-no-properties 1)))
5307 ;; FIXME: above we should remove the escapes.
5308 ;; but that requires another match, protecting match data,
5309 ;; a lot of overhead for font-lock.
5310 (ip (org-maybe-intangible
c8d0cf5c 5311 (list 'invisible 'org-link
20908596
CD
5312 'keymap org-mouse-map 'mouse-face 'highlight
5313 'font-lock-multiline t 'help-echo help)))
c8d0cf5c
CD
5314 (vp (list 'keymap org-mouse-map 'mouse-face 'highlight
5315 'font-lock-multiline t 'help-echo help)))
20908596
CD
5316 ;; We need to remove the invisible property here. Table narrowing
5317 ;; may have made some of this invisible.
c8d0cf5c 5318 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
20908596
CD
5319 (remove-text-properties (match-beginning 0) (match-end 0)
5320 '(invisible nil))
5321 (if (match-end 3)
5322 (progn
5323 (add-text-properties (match-beginning 0) (match-beginning 3) ip)
c8d0cf5c 5324 (org-rear-nonsticky-at (match-beginning 3))
20908596 5325 (add-text-properties (match-beginning 3) (match-end 3) vp)
c8d0cf5c
CD
5326 (org-rear-nonsticky-at (match-end 3))
5327 (add-text-properties (match-end 3) (match-end 0) ip)
5328 (org-rear-nonsticky-at (match-end 0)))
20908596 5329 (add-text-properties (match-beginning 0) (match-beginning 1) ip)
c8d0cf5c 5330 (org-rear-nonsticky-at (match-beginning 1))
20908596 5331 (add-text-properties (match-beginning 1) (match-end 1) vp)
c8d0cf5c
CD
5332 (org-rear-nonsticky-at (match-end 1))
5333 (add-text-properties (match-end 1) (match-end 0) ip)
5334 (org-rear-nonsticky-at (match-end 0)))
20908596 5335 t)))
891f4676 5336
20908596
CD
5337(defun org-activate-dates (limit)
5338 "Run through the buffer and add overlays to dates."
5339 (if (re-search-forward org-tsr-regexp-both limit t)
5340 (progn
c8d0cf5c 5341 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
20908596
CD
5342 (add-text-properties (match-beginning 0) (match-end 0)
5343 (list 'mouse-face 'highlight
20908596 5344 'keymap org-mouse-map))
c8d0cf5c 5345 (org-rear-nonsticky-at (match-end 0))
20908596
CD
5346 (when org-display-custom-times
5347 (if (match-end 3)
5348 (org-display-custom-time (match-beginning 3) (match-end 3)))
5349 (org-display-custom-time (match-beginning 1) (match-end 1)))
5350 t)))
891f4676 5351
20908596
CD
5352(defvar org-target-link-regexp nil
5353 "Regular expression matching radio targets in plain text.")
ff4be292 5354(make-variable-buffer-local 'org-target-link-regexp)
20908596
CD
5355(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>"
5356 "Regular expression matching a link target.")
5357(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>"
5358 "Regular expression matching a radio target.")
5359(defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target.
5360 "Regular expression matching any target.")
a3fbe8c4 5361
20908596
CD
5362(defun org-activate-target-links (limit)
5363 "Run through the buffer and add overlays to target matches."
5364 (when org-target-link-regexp
5365 (let ((case-fold-search t))
5366 (if (re-search-forward org-target-link-regexp limit t)
5367 (progn
c8d0cf5c 5368 (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
20908596
CD
5369 (add-text-properties (match-beginning 0) (match-end 0)
5370 (list 'mouse-face 'highlight
20908596
CD
5371 'keymap org-mouse-map
5372 'help-echo "Radio target link"
5373 'org-linked-text t))
c8d0cf5c 5374 (org-rear-nonsticky-at (match-end 0))
20908596 5375 t)))))
891f4676 5376
20908596
CD
5377(defun org-update-radio-target-regexp ()
5378 "Find all radio targets in this file and update the regular expression."
5379 (interactive)
5380 (when (memq 'radio org-activate-links)
5381 (setq org-target-link-regexp
5382 (org-make-target-link-regexp (org-all-targets 'radio)))
5383 (org-restart-font-lock)))
891f4676 5384
20908596
CD
5385(defun org-hide-wide-columns (limit)
5386 (let (s e)
5387 (setq s (text-property-any (point) (or limit (point-max))
5388 'org-cwidth t))
5389 (when s
5390 (setq e (next-single-property-change s 'org-cwidth))
5391 (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth)))
5392 (goto-char e)
5393 t)))
891f4676 5394
20908596
CD
5395(defvar org-latex-and-specials-regexp nil
5396 "Regular expression for highlighting export special stuff.")
5397(defvar org-match-substring-regexp)
5398(defvar org-match-substring-with-braces-regexp)
54a0dee5
CD
5399
5400;; This should be with the exporter code, but we also use if for font-locking
5401(defconst org-export-html-special-string-regexps
5402 '(("\\\\-" . "&shy;")
5403 ("---\\([^-]\\)" . "&mdash;\\1")
5404 ("--\\([^-]\\)" . "&ndash;\\1")
5405 ("\\.\\.\\." . "&hellip;"))
5406 "Regular expressions for special string conversion.")
5407
891f4676 5408
20908596
CD
5409(defun org-compute-latex-and-specials-regexp ()
5410 "Compute regular expression for stuff treated specially by exporters."
5411 (if (not org-highlight-latex-fragments-and-specials)
5412 (org-set-local 'org-latex-and-specials-regexp nil)
5413 (require 'org-exp)
5414 (let*
5415 ((matchers (plist-get org-format-latex-options :matchers))
5416 (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x))
5417 org-latex-regexps)))
ed21c5c8 5418 (org-export-allow-BIND nil)
20908596
CD
5419 (options (org-combine-plists (org-default-export-plist)
5420 (org-infile-export-plist)))
5421 (org-export-with-sub-superscripts (plist-get options :sub-superscript))
5422 (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments))
5423 (org-export-with-TeX-macros (plist-get options :TeX-macros))
5424 (org-export-html-expand (plist-get options :expand-quoted-html))
5425 (org-export-with-special-strings (plist-get options :special-strings))
5426 (re-sub
5427 (cond
5428 ((equal org-export-with-sub-superscripts '{})
5429 (list org-match-substring-with-braces-regexp))
5430 (org-export-with-sub-superscripts
5431 (list org-match-substring-regexp))
5432 (t nil)))
5433 (re-latex
5434 (if org-export-with-LaTeX-fragments
5435 (mapcar (lambda (x) (nth 1 x)) latexs)))
5436 (re-macros
5437 (if org-export-with-TeX-macros
5438 (list (concat "\\\\"
5439 (regexp-opt
86fbb8ca
CD
5440 (append
5441
5442 (delq nil
5443 (mapcar 'car-safe
5444 (append org-entities-user
5445 org-entities)))
5446 (if (boundp 'org-latex-entities)
5447 (mapcar (lambda (x)
5448 (or (car-safe x) x))
5449 org-latex-entities)
5450 nil))
20908596
CD
5451 'words))) ; FIXME
5452 ))
5453 ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
5454 (re-special (if org-export-with-special-strings
5455 (mapcar (lambda (x) (car x))
5456 org-export-html-special-string-regexps)))
5457 (re-rest
5458 (delq nil
5459 (list
5460 (if org-export-html-expand "@<[^>\n]+>")
5461 ))))
5462 (org-set-local
5463 'org-latex-and-specials-regexp
5464 (mapconcat 'identity (append re-latex re-sub re-macros re-special
5465 re-rest) "\\|")))))
d3f4dbe8 5466
20908596
CD
5467(defun org-do-latex-and-special-faces (limit)
5468 "Run through the buffer and add overlays to links."
5469 (when org-latex-and-specials-regexp
5470 (let (rtn d)
5471 (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp
5472 limit t))
5473 (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0))
5474 'face))
5475 '(org-code org-verbatim underline)))
5476 (progn
5477 (setq rtn t
5478 d (cond ((member (char-after (1+ (match-beginning 0)))
5479 '(?_ ?^)) 1)
5480 (t 0)))
5481 (font-lock-prepend-text-property
5482 (+ d (match-beginning 0)) (match-end 0)
5483 'face 'org-latex-and-export-specials)
5484 (add-text-properties (+ d (match-beginning 0)) (match-end 0)
5485 '(font-lock-multiline t)))))
5486 rtn)))
d3f4dbe8 5487
20908596 5488(defun org-restart-font-lock ()
86fbb8ca 5489 "Restart `font-lock-mode', to force refontification."
20908596
CD
5490 (when (and (boundp 'font-lock-mode) font-lock-mode)
5491 (font-lock-mode -1)
5492 (font-lock-mode 1)))
d3f4dbe8 5493
20908596
CD
5494(defun org-all-targets (&optional radio)
5495 "Return a list of all targets in this file.
5496With optional argument RADIO, only find radio targets."
5497 (let ((re (if radio org-radio-target-regexp org-target-regexp))
5498 rtn)
5499 (save-excursion
5500 (goto-char (point-min))
5501 (while (re-search-forward re nil t)
5502 (add-to-list 'rtn (downcase (org-match-string-no-properties 1))))
5503 rtn)))
891f4676 5504
20908596
CD
5505(defun org-make-target-link-regexp (targets)
5506 "Make regular expression matching all strings in TARGETS.
5507The regular expression finds the targets also if there is a line break
5508between words."
5509 (and targets
5510 (concat
5511 "\\<\\("
5512 (mapconcat
5513 (lambda (x)
3ab2c837 5514 (setq x (regexp-quote x))
20908596
CD
5515 (while (string-match " +" x)
5516 (setq x (replace-match "\\s-+" t t x)))
5517 x)
5518 targets
5519 "\\|")
5520 "\\)\\>")))
3278a016 5521
20908596 5522(defun org-activate-tags (limit)
afe98dfa 5523 (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t)
20908596 5524 (progn
ed21c5c8 5525 (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
20908596
CD
5526 (add-text-properties (match-beginning 1) (match-end 1)
5527 (list 'mouse-face 'highlight
20908596 5528 'keymap org-mouse-map))
c8d0cf5c 5529 (org-rear-nonsticky-at (match-end 1))
20908596 5530 t)))
891f4676 5531
20908596 5532(defun org-outline-level ()
8bfe682a
CD
5533 "Compute the outline level of the heading at point.
5534This function assumes that the cursor is at the beginning of a line matched
86fbb8ca 5535by `outline-regexp'. Otherwise it returns garbage.
8bfe682a 5536If this is called at a normal headline, the level is the number of stars.
3ab2c837 5537Use `org-reduced-level' to remove the effect of `org-odd-levels'."
20908596 5538 (save-excursion
3ab2c837
BG
5539 (looking-at org-outline-regexp)
5540 (1- (- (match-end 0) (match-beginning 0)))))
15841868 5541
20908596 5542(defvar org-font-lock-keywords nil)
891f4676 5543
b349f79f 5544(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
20908596 5545 "Regular expression matching a property line.")
891f4676 5546
b349f79f
CD
5547(defvar org-font-lock-hook nil
5548 "Functions to be called for special font lock stuff.")
5549
afe98dfa
CD
5550(defvar org-font-lock-set-keywords-hook nil
5551 "Functions that can manipulate `org-font-lock-extra-keywords'.
da6062e6 5552This is called after `org-font-lock-extra-keywords' is defined, but before
afe98dfa
CD
5553it is installed to be used by font lock. This can be useful if something
5554needs to be inserted at a specific position in the font-lock sequence.")
5555
b349f79f
CD
5556(defun org-font-lock-hook (limit)
5557 (run-hook-with-args 'org-font-lock-hook limit))
5558
20908596
CD
5559(defun org-set-font-lock-defaults ()
5560 (let* ((em org-fontify-emphasized-text)
5561 (lk org-activate-links)
5562 (org-font-lock-extra-keywords
5563 (list
b349f79f
CD
5564 ;; Call the hook
5565 '(org-font-lock-hook)
20908596 5566 ;; Headlines
c8d0cf5c
CD
5567 `(,(if org-fontify-whole-heading-line
5568 "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)"
5569 "^\\(\\**\\)\\(\\* \\)\\(.*\\)")
5570 (1 (org-get-level-face 1))
5571 (2 (org-get-level-face 2))
5572 (3 (org-get-level-face 3)))
20908596
CD
5573 ;; Table lines
5574 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
5575 (1 'org-table t))
5576 ;; Table internals
5577 '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t))
5578 '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t))
5579 '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
afe98dfa 5580 '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
20908596
CD
5581 ;; Drawers
5582 (list org-drawer-regexp '(0 'org-special-keyword t))
5583 (list "^[ \t]*:END:" '(0 'org-special-keyword t))
5584 ;; Properties
5585 (list org-property-re
5586 '(1 'org-special-keyword t)
5587 '(3 'org-property-value t))
20908596
CD
5588 ;; Links
5589 (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
5590 (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
5dec9555 5591 (if (memq 'plain lk) '(org-activate-plain-links))
20908596
CD
5592 (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
5593 (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
5594 (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
3ab2c837 5595 (if (memq 'footnote lk) '(org-activate-footnote-links))
20908596
CD
5596 '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
5597 '(org-hide-wide-columns (0 nil append))
5598 ;; TODO lines
c8d0cf5c 5599 (list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)")
20908596
CD
5600 '(1 (org-get-todo-face 1) t))
5601 ;; DONE
5602 (if org-fontify-done-headline
5603 (list (concat "^[*]+ +\\<\\("
5604 (mapconcat 'regexp-quote org-done-keywords "\\|")
5605 "\\)\\(.*\\)")
5606 '(2 'org-headline-done t))
5607 nil)
5608 ;; Priorities
c8d0cf5c 5609 '(org-font-lock-add-priority-faces)
ff4be292
CD
5610 ;; Tags
5611 '(org-font-lock-add-tag-faces)
20908596
CD
5612 ;; Special keywords
5613 (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
5614 (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
5615 (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
5616 (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
5617 ;; Emphasis
5618 (if em
5619 (if (featurep 'xemacs)
5620 '(org-do-emphasis-faces (0 nil append))
5621 '(org-do-emphasis-faces)))
5622 ;; Checkboxes
afe98dfa
CD
5623 '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
5624 1 'org-checkbox prepend)
5625 (if (cdr (assq 'checkbox org-list-automatic-rules))
20908596
CD
5626 '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
5627 (0 (org-get-checkbox-statistics-face) t)))
b349f79f 5628 ;; Description list items
3ab2c837
BG
5629 '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
5630 1 'bold prepend)
c8d0cf5c 5631 ;; ARCHIVEd headings
3ab2c837
BG
5632 (list (concat
5633 org-outline-regexp-bol
5634 "\\(.*:" org-archive-tag ":.*\\)")
20908596
CD
5635 '(1 'org-archived prepend))
5636 ;; Specials
5637 '(org-do-latex-and-special-faces)
86fbb8ca
CD
5638 '(org-fontify-entities)
5639 '(org-raise-scripts)
20908596
CD
5640 ;; Code
5641 '(org-activate-code (1 'org-code t))
5642 ;; COMMENT
5643 (list (concat "^\\*+[ \t]+\\<\\(" org-comment-string
5644 "\\|" org-quote-string "\\)\\>")
5645 '(1 'org-special-keyword t))
5646 '("^#.*" (0 'font-lock-comment-face t))
c8d0cf5c
CD
5647 ;; Blocks and meta lines
5648 '(org-fontify-meta-lines-and-blocks)
20908596
CD
5649 )))
5650 (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
afe98dfa 5651 (run-hooks 'org-font-lock-set-keywords-hook)
20908596
CD
5652 ;; Now set the full font-lock-keywords
5653 (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
5654 (org-set-local 'font-lock-defaults
5655 '(org-font-lock-keywords t nil nil backward-paragraph))
5656 (kill-local-variable 'font-lock-keywords) nil))
5657
86fbb8ca
CD
5658(defun org-toggle-pretty-entities ()
5659 "Toggle the composition display of entities as UTF8 characters."
5660 (interactive)
5661 (org-set-local 'org-pretty-entities (not org-pretty-entities))
5662 (org-restart-font-lock)
5663 (if org-pretty-entities
8d5ed899 5664 (message "Entities are displayed as UTF8 characters")
86fbb8ca
CD
5665 (save-restriction
5666 (widen)
afe98dfa 5667 (org-decompose-region (point-min) (point-max))
86fbb8ca
CD
5668 (message "Entities are displayed plain"))))
5669
5670(defun org-fontify-entities (limit)
5671 "Find an entity to fontify."
5672 (let (ee)
5673 (when org-pretty-entities
5674 (catch 'match
5675 (while (re-search-forward
5676 "\\\\\\([a-zA-Z][a-zA-Z0-9]*\\)\\($\\|[^[:alnum:]\n]\\)"
5677 limit t)
5678 (if (and (not (org-in-indented-comment-line))
5679 (setq ee (org-entity-get (match-string 1)))
5680 (= (length (nth 6 ee)) 1))
5681 (progn
5682 (add-text-properties
5683 (match-beginning 0) (match-end 1)
5684 (list 'font-lock-fontified t))
5685 (compose-region (match-beginning 0) (match-end 1)
5686 (nth 6 ee) nil)
5687 (backward-char 1)
5688 (throw 'match t))))
5689 nil))))
5690
c8d0cf5c 5691(defun org-fontify-like-in-org-mode (s &optional odd-levels)
86fbb8ca 5692 "Fontify string S like in Org-mode."
c8d0cf5c
CD
5693 (with-temp-buffer
5694 (insert s)
5695 (let ((org-odd-levels-only odd-levels))
5696 (org-mode)
5697 (font-lock-fontify-buffer)
5698 (buffer-string))))
5699
20908596
CD
5700(defvar org-m nil)
5701(defvar org-l nil)
5702(defvar org-f nil)
5703(defun org-get-level-face (n)
acedf35c
CD
5704 "Get the right face for match N in font-lock matching of headlines."
5705 (setq org-l (- (match-end 2) (match-beginning 1) 1))
5706 (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
5707 (if org-cycle-level-faces
5708 (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces))
5709 (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces)))
5710 (cond
5711 ((eq n 1) (if org-hide-leading-stars 'org-hide org-f))
5712 ((eq n 2) org-f)
5713 (t (if org-level-color-stars-only nil org-f))))
5714
20908596
CD
5715
5716(defun org-get-todo-face (kwd)
5717 "Get the right face for a TODO keyword KWD.
5718If KWD is a number, get the corresponding match group."
5719 (if (numberp kwd) (setq kwd (match-string kwd)))
ed21c5c8
CD
5720 (or (org-face-from-face-or-color
5721 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
20908596
CD
5722 (and (member kwd org-done-keywords) 'org-done)
5723 'org-todo))
d3f4dbe8 5724
ed21c5c8
CD
5725(defun org-face-from-face-or-color (context inherit face-or-color)
5726 "Create a face list that inherits INHERIT, but sets the foreground color.
5727When FACE-OR-COLOR is not a string, just return it."
5728 (if (stringp face-or-color)
5729 (list :inherit inherit
5730 (cdr (assoc context org-faces-easy-properties))
5731 face-or-color)
5732 face-or-color))
5733
ff4be292
CD
5734(defun org-font-lock-add-tag-faces (limit)
5735 "Add the special tag faces."
5736 (when (and org-tag-faces org-tags-special-faces-re)
5737 (while (re-search-forward org-tags-special-faces-re limit t)
5738 (add-text-properties (match-beginning 1) (match-end 1)
5739 (list 'face (org-get-tag-face 1)
5740 'font-lock-fontified t))
5741 (backward-char 1))))
5742
c8d0cf5c
CD
5743(defun org-font-lock-add-priority-faces (limit)
5744 "Add the special priority faces."
5745 (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
5746 (add-text-properties
5747 (match-beginning 0) (match-end 0)
ed21c5c8
CD
5748 (list 'face (or (org-face-from-face-or-color
5749 'priority 'org-special-keyword
5750 (cdr (assoc (char-after (match-beginning 1))
5751 org-priority-faces)))
c8d0cf5c
CD
5752 'org-special-keyword)
5753 'font-lock-fontified t))))
5754
ff4be292
CD
5755(defun org-get-tag-face (kwd)
5756 "Get the right face for a TODO keyword KWD.
5757If KWD is a number, get the corresponding match group."
5758 (if (numberp kwd) (setq kwd (match-string kwd)))
ed21c5c8
CD
5759 (or (org-face-from-face-or-color
5760 'tag 'org-tag (cdr (assoc kwd org-tag-faces)))
ff4be292
CD
5761 'org-tag))
5762
20908596
CD
5763(defun org-unfontify-region (beg end &optional maybe_loudly)
5764 "Remove fontification and activation overlays from links."
5765 (font-lock-default-unfontify-region beg end)
5766 (let* ((buffer-undo-list t)
5767 (inhibit-read-only t) (inhibit-point-motion-hooks t)
5768 (inhibit-modification-hooks t)
5769 deactivate-mark buffer-file-name buffer-file-truename)
afe98dfa 5770 (org-decompose-region beg end)
8bfe682a
CD
5771 (remove-text-properties
5772 beg end
5773 (if org-indent-mode
5774 ;; also remove line-prefix and wrap-prefix properties
5775 '(mouse-face t keymap t org-linked-text t
5776 invisible t intangible t
5777 line-prefix t wrap-prefix t
86fbb8ca 5778 org-no-flyspell t org-emphasis t)
8bfe682a
CD
5779 '(mouse-face t keymap t org-linked-text t
5780 invisible t intangible t
86fbb8ca
CD
5781 org-no-flyspell t org-emphasis t)))
5782 (org-remove-font-lock-display-properties beg end)))
5783
5784(defconst org-script-display '(((raise -0.3) (height 0.7))
5785 ((raise 0.3) (height 0.7))
5786 ((raise -0.5))
5787 ((raise 0.5)))
5788 "Display properties for showing superscripts and subscripts.")
5789
5790(defun org-remove-font-lock-display-properties (beg end)
5791 "Remove specific display properties that have been added by font lock.
5792The will remove the raise properties that are used to show superscripts
5793and subscripts."
5794 (let (next prop)
5795 (while (< beg end)
5796 (setq next (next-single-property-change beg 'display nil end)
5797 prop (get-text-property beg 'display))
5798 (if (member prop org-script-display)
5799 (put-text-property beg next 'display nil))
5800 (setq beg next))))
5801
5802(defun org-raise-scripts (limit)
5803 "Add raise properties to sub/superscripts."
5804 (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts)
5805 (if (re-search-forward
5806 (if (eq org-use-sub-superscripts t)
5807 org-match-substring-regexp
5808 org-match-substring-with-braces-regexp)
5809 limit t)
5810 (let* ((pos (point)) table-p comment-p
5811 (mpos (match-beginning 3))
5812 (emph-p (get-text-property mpos 'org-emphasis))
5813 (link-p (get-text-property mpos 'mouse-face))
5814 (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
5815 (goto-char (point-at-bol))
5816 (setq table-p (org-looking-at-p org-table-dataline-regexp)
5817 comment-p (org-looking-at-p "[ \t]*#"))
5818 (goto-char pos)
5819 ;; FIXME: Should we go back one character here, for a_b^c
5820 ;; (goto-char (1- pos)) ;????????????????????
5821 (if (or comment-p emph-p link-p keyw-p)
5822 t
5823 (put-text-property (match-beginning 3) (match-end 0)
5824 'display
5825 (if (equal (char-after (match-beginning 2)) ?^)
5826 (nth (if table-p 3 1) org-script-display)
5827 (nth (if table-p 2 0) org-script-display)))
5828 (add-text-properties (match-beginning 2) (match-end 2)
5829 (list 'invisible t
5830 'org-dwidth t 'org-dwidth-n 1))
5831 (if (and (eq (char-after (match-beginning 3)) ?{)
5832 (eq (char-before (match-end 3)) ?}))
5833 (progn
5834 (add-text-properties
5835 (match-beginning 3) (1+ (match-beginning 3))
5836 (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
5837 (add-text-properties
5838 (1- (match-end 3)) (match-end 3)
5839 (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))
5840 t)))))
d3f4dbe8 5841
20908596 5842;;;; Visibility cycling, including org-goto and indirect buffer
7ac93e3c 5843
20908596 5844;;; Cycling
891f4676 5845
20908596
CD
5846(defvar org-cycle-global-status nil)
5847(make-variable-buffer-local 'org-cycle-global-status)
5848(defvar org-cycle-subtree-status nil)
5849(make-variable-buffer-local 'org-cycle-subtree-status)
891f4676 5850
48aaad2d 5851;;;###autoload
c8d0cf5c
CD
5852
5853(defvar org-inlinetask-min-level)
5854
20908596 5855(defun org-cycle (&optional arg)
c8d0cf5c
CD
5856 "TAB-action and visibility cycling for Org-mode.
5857
54a0dee5 5858This is the command invoked in Org-mode by the TAB key. Its main purpose
8bfe682a 5859is outline visibility cycling, but it also invokes other actions
c8d0cf5c 5860in special contexts.
891f4676 5861
20908596
CD
5862- When this function is called with a prefix argument, rotate the entire
5863 buffer through 3 states (global cycling)
5864 1. OVERVIEW: Show only top-level headlines.
5865 2. CONTENTS: Show all headlines of all levels, but no body text.
5866 3. SHOW ALL: Show everything.
c8d0cf5c 5867 When called with two `C-u C-u' prefixes, switch to the startup visibility,
b349f79f
CD
5868 determined by the variable `org-startup-folded', and by any VISIBILITY
5869 properties in the buffer.
c8d0cf5c
CD
5870 When called with three `C-u C-u C-u' prefixed, show the entire buffer,
5871 including any drawers.
5872
5873- When inside a table, re-align the table and move to the next field.
eb2f9c59 5874
20908596
CD
5875- When point is at the beginning of a headline, rotate the subtree started
5876 by this line through 3 different states (local cycling)
5877 1. FOLDED: Only the main headline is shown.
5878 2. CHILDREN: The main headline and the direct children are shown.
5879 From this state, you can move to one of the children
5880 and zoom in further.
5881 3. SUBTREE: Show the entire subtree, including body text.
c8d0cf5c 5882 If there is no subtree, switch directly from CHILDREN to FOLDED.
eb2f9c59 5883
ed21c5c8
CD
5884- When point is at the beginning of an empty headline and the variable
5885 `org-cycle-level-after-item/entry-creation' is set, cycle the level
5886 of the headline by demoting and promoting it to likely levels. This
86fbb8ca 5887 speeds up creation document structure by pressing TAB once or several
ed21c5c8
CD
5888 times right after creating a new headline.
5889
20908596
CD
5890- When there is a numeric prefix, go up to a heading with level ARG, do
5891 a `show-subtree' and return to the previous cursor position. If ARG
5892 is negative, go up that many levels.
eb2f9c59 5893
b349f79f
CD
5894- When point is not at the beginning of a headline, execute the global
5895 binding for TAB, which is re-indenting the line. See the option
20908596 5896 `org-cycle-emulate-tab' for details.
c8d16429 5897
20908596 5898- Special case: if point is at the beginning of the buffer and there is
afe98dfa
CD
5899 no headline in line 1, this function will act as if called with prefix arg
5900 (C-u TAB, same as S-TAB) also when called without prefix arg.
20908596 5901 But only if also the variable `org-cycle-global-at-bob' is t."
d3f4dbe8 5902 (interactive "P")
20908596 5903 (org-load-modules-maybe)
8bfe682a
CD
5904 (unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
5905 (and org-cycle-level-after-item/entry-creation
5906 (or (org-cycle-level)
5907 (org-cycle-item-indentation))))
c8d0cf5c
CD
5908 (let* ((limit-level
5909 (or org-cycle-max-level
5910 (and (boundp 'org-inlinetask-min-level)
5911 org-inlinetask-min-level
5912 (1- org-inlinetask-min-level))))
5913 (nstars (and limit-level
5914 (if org-odd-levels-only
5915 (and limit-level (1- (* limit-level 2)))
5916 limit-level)))
3ab2c837
BG
5917 (org-outline-regexp
5918 (if (not (org-mode-p))
5919 outline-regexp
5920 (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))
afe98dfa 5921 (bob-special (and org-cycle-global-at-bob (not arg) (bobp)
3ab2c837 5922 (not (looking-at org-outline-regexp))))
c8d0cf5c
CD
5923 (org-cycle-hook
5924 (if bob-special
5925 (delq 'org-optimize-window-after-visibility-change
5926 (copy-sequence org-cycle-hook))
5927 org-cycle-hook))
5928 (pos (point)))
5929
5930 (if (or bob-special (equal arg '(4)))
5931 ;; special case: use global cycling
5932 (setq arg t))
fbe6c10d 5933
c8d0cf5c 5934 (cond
621f83e4 5935
c8d0cf5c 5936 ((equal arg '(16))
afe98dfa 5937 (setq last-command 'dummy)
c8d0cf5c
CD
5938 (org-set-startup-visibility)
5939 (message "Startup visibility, plus VISIBILITY properties"))
b349f79f 5940
c8d0cf5c
CD
5941 ((equal arg '(64))
5942 (show-all)
5943 (message "Entire buffer visible, including drawers"))
6e2752e7 5944
3ab2c837 5945 ;; Table: enter it or move to the next field.
c8d0cf5c 5946 ((org-at-table-p 'any)
ed21c5c8
CD
5947 (if (org-at-table.el-p)
5948 (message "Use C-c ' to edit table.el tables")
5949 (if arg (org-table-edit-field t)
5950 (org-table-justify-field-maybe)
5951 (call-interactively 'org-table-next-field))))
c8d0cf5c
CD
5952
5953 ((run-hook-with-args-until-success
5954 'org-tab-after-check-for-table-hook))
5955
3ab2c837
BG
5956 ;; Global cycling: delegate to `org-cycle-internal-global'.
5957 ((eq arg t) (org-cycle-internal-global))
c8d0cf5c 5958
3ab2c837 5959 ;; Drawers: delegate to `org-flag-drawer'.
c8d0cf5c
CD
5960 ((and org-drawers org-drawer-regexp
5961 (save-excursion
5962 (beginning-of-line 1)
5963 (looking-at org-drawer-regexp)))
3ab2c837 5964 (org-flag-drawer ; toggle block visibility
c8d0cf5c
CD
5965 (not (get-char-property (match-end 0) 'invisible))))
5966
3ab2c837 5967 ;; Show-subtree, ARG levels up from here.
c8d0cf5c 5968 ((integerp arg)
c8d0cf5c
CD
5969 (save-excursion
5970 (org-back-to-heading)
5971 (outline-up-heading (if (< arg 0) (- arg)
5972 (- (funcall outline-level) arg)))
5973 (org-show-subtree)))
64f72ae1 5974
3ab2c837
BG
5975 ;; Inline task: delegate to `org-inlinetask-toggle-visibility'.
5976 ((and (featurep 'org-inlinetask)
5977 (org-inlinetask-at-task-p)
c8d0cf5c 5978 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
3ab2c837 5979 (org-inlinetask-toggle-visibility))
20908596 5980
3ab2c837
BG
5981 ;; At an item/headline: delegate to `org-cycle-internal-local'.
5982 ((and (or (and org-cycle-include-plain-lists (org-at-item-p))
5983 (save-excursion (beginning-of-line 1)
5984 (looking-at org-outline-regexp)))
5985 (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
c8d0cf5c 5986 (org-cycle-internal-local))
20908596 5987
3ab2c837 5988 ;; From there: TAB emulation and template completion.
c8d0cf5c 5989 (buffer-read-only (org-back-to-heading))
20908596 5990
c8d0cf5c
CD
5991 ((run-hook-with-args-until-success
5992 'org-tab-after-check-for-cycling-hook))
20908596 5993
c8d0cf5c 5994 ((org-try-structure-completion))
eb2f9c59 5995
c8d0cf5c 5996 ((org-try-cdlatex-tab))
3278a016 5997
8bfe682a
CD
5998 ((run-hook-with-args-until-success
5999 'org-tab-before-tab-emulation-hook))
6000
c8d0cf5c
CD
6001 ((and (eq org-cycle-emulate-tab 'exc-hl-bol)
6002 (or (not (bolp))
3ab2c837 6003 (not (looking-at org-outline-regexp))))
c8d0cf5c 6004 (call-interactively (global-key-binding "\t")))
b349f79f 6005
c8d0cf5c
CD
6006 ((if (and (memq org-cycle-emulate-tab '(white whitestart))
6007 (save-excursion (beginning-of-line 1) (looking-at "[ \t]*"))
6008 (or (and (eq org-cycle-emulate-tab 'white)
6009 (= (match-end 0) (point-at-eol)))
6010 (and (eq org-cycle-emulate-tab 'whitestart)
6011 (>= (match-end 0) pos))))
6012 t
6013 (eq org-cycle-emulate-tab t))
6014 (call-interactively (global-key-binding "\t")))
eb2f9c59 6015
c8d0cf5c
CD
6016 (t (save-excursion
6017 (org-back-to-heading)
6018 (org-cycle)))))))
634a7d0b 6019
c8d0cf5c
CD
6020(defun org-cycle-internal-global ()
6021 "Do the global cycling action."
6022 (cond
6023 ((and (eq last-command this-command)
6024 (eq org-cycle-global-status 'overview))
6025 ;; We just created the overview - now do table of contents
6026 ;; This can be slow in very large buffers, so indicate action
6027 (run-hook-with-args 'org-pre-cycle-hook 'contents)
6028 (message "CONTENTS...")
6029 (org-content)
6030 (message "CONTENTS...done")
6031 (setq org-cycle-global-status 'contents)
6032 (run-hook-with-args 'org-cycle-hook 'contents))
6033
6034 ((and (eq last-command this-command)
6035 (eq org-cycle-global-status 'contents))
6036 ;; We just showed the table of contents - now show everything
6037 (run-hook-with-args 'org-pre-cycle-hook 'all)
6038 (show-all)
6039 (message "SHOW ALL")
6040 (setq org-cycle-global-status 'all)
6041 (run-hook-with-args 'org-cycle-hook 'all))
20908596 6042
c8d0cf5c
CD
6043 (t
6044 ;; Default action: go to overview
6045 (run-hook-with-args 'org-pre-cycle-hook 'overview)
6046 (org-overview)
6047 (message "OVERVIEW")
6048 (setq org-cycle-global-status 'overview)
6049 (run-hook-with-args 'org-cycle-hook 'overview))))
6050
6051(defun org-cycle-internal-local ()
6052 "Do the local cycling action."
3ab2c837
BG
6053 (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
6054 ;; First, determine end of headline (EOH), end of subtree or item
6055 ;; (EOS), and if item or heading has children (HAS-CHILDREN).
c8d0cf5c 6056 (save-excursion
3ab2c837
BG
6057 (if (org-at-item-p)
6058 (progn
6059 (beginning-of-line)
6060 (setq struct (org-list-struct))
6061 (setq eoh (point-at-eol))
6062 (setq eos (org-list-get-item-end-before-blank (point) struct))
6063 (setq has-children (org-list-has-child-p (point) struct)))
6064 (org-back-to-heading)
6065 (setq eoh (save-excursion (outline-end-of-heading) (point)))
6066 (setq eos (save-excursion
6067 (org-end-of-subtree t)
6068 (unless (eobp)
6069 (skip-chars-forward " \t\n"))
6070 (if (eobp) (point) (1- (point)))))
6071 (setq has-children
6072 (or (save-excursion
6073 (let ((level (funcall outline-level)))
6074 (outline-next-heading)
6075 (and (org-at-heading-p t)
6076 (> (funcall outline-level) level))))
6077 (save-excursion
6078 (org-list-search-forward (org-item-beginning-re) eos t)))))
6079 ;; Determine end invisible part of buffer (EOL)
6080 (beginning-of-line 2)
6081 ;; XEmacs doesn't have `next-single-char-property-change'
6082 (if (featurep 'xemacs)
c8d0cf5c
CD
6083 (while (and (not (eobp)) ;; this is like `next-line'
6084 (get-char-property (1- (point)) 'invisible))
3ab2c837
BG
6085 (beginning-of-line 2))
6086 (while (and (not (eobp)) ;; this is like `next-line'
6087 (get-char-property (1- (point)) 'invisible))
6088 (goto-char (next-single-char-property-change (point) 'invisible))
6089 (and (eolp) (beginning-of-line 2))))
6090 (setq eol (point)))
c8d0cf5c
CD
6091 ;; Find out what to do next and set `this-command'
6092 (cond
6093 ((= eos eoh)
6094 ;; Nothing is hidden behind this heading
6095 (run-hook-with-args 'org-pre-cycle-hook 'empty)
6096 (message "EMPTY ENTRY")
6097 (setq org-cycle-subtree-status nil)
6098 (save-excursion
6099 (goto-char eos)
6100 (outline-next-heading)
3ab2c837 6101 (if (outline-invisible-p) (org-flag-heading nil))))
c8d0cf5c
CD
6102 ((and (or (>= eol eos)
6103 (not (string-match "\\S-" (buffer-substring eol eos))))
6104 (or has-children
6105 (not (setq children-skipped
6106 org-cycle-skip-children-state-if-no-children))))
6107 ;; Entire subtree is hidden in one line: children view
6108 (run-hook-with-args 'org-pre-cycle-hook 'children)
3ab2c837
BG
6109 (if (org-at-item-p)
6110 (org-list-set-item-visibility (point-at-bol) struct 'children)
6111 (org-show-entry)
6112 (show-children)
6113 ;; Fold every list in subtree to top-level items.
6114 (when (eq org-cycle-include-plain-lists 'integrate)
6115 (save-excursion
6116 (org-back-to-heading)
6117 (while (org-list-search-forward (org-item-beginning-re) eos t)
6118 (beginning-of-line 1)
6119 (let* ((struct (org-list-struct))
6120 (prevs (org-list-prevs-alist struct))
6121 (end (org-list-get-bottom-point struct)))
6122 (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
6123 (org-list-get-all-items (point) struct prevs))
6124 (goto-char end))))))
c8d0cf5c
CD
6125 (message "CHILDREN")
6126 (save-excursion
6127 (goto-char eos)
6128 (outline-next-heading)
3ab2c837 6129 (if (outline-invisible-p) (org-flag-heading nil)))
c8d0cf5c
CD
6130 (setq org-cycle-subtree-status 'children)
6131 (run-hook-with-args 'org-cycle-hook 'children))
6132 ((or children-skipped
6133 (and (eq last-command this-command)
6134 (eq org-cycle-subtree-status 'children)))
6135 ;; We just showed the children, or no children are there,
6136 ;; now show everything.
6137 (run-hook-with-args 'org-pre-cycle-hook 'subtree)
afe98dfa 6138 (outline-flag-region eoh eos nil)
c8d0cf5c
CD
6139 (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
6140 (setq org-cycle-subtree-status 'subtree)
6141 (run-hook-with-args 'org-cycle-hook 'subtree))
6142 (t
6143 ;; Default action: hide the subtree.
6144 (run-hook-with-args 'org-pre-cycle-hook 'folded)
afe98dfa 6145 (outline-flag-region eoh eos t)
c8d0cf5c
CD
6146 (message "FOLDED")
6147 (setq org-cycle-subtree-status 'folded)
6148 (run-hook-with-args 'org-cycle-hook 'folded)))))
20908596
CD
6149
6150;;;###autoload
6151(defun org-global-cycle (&optional arg)
b349f79f 6152 "Cycle the global visibility. For details see `org-cycle'.
86fbb8ca 6153With \\[universal-argument] prefix arg, switch to startup visibility.
b349f79f 6154With a numeric prefix, show all headlines up to that level."
20908596
CD
6155 (interactive "P")
6156 (let ((org-cycle-include-plain-lists
6157 (if (org-mode-p) org-cycle-include-plain-lists nil)))
b349f79f
CD
6158 (cond
6159 ((integerp arg)
6160 (show-all)
6161 (hide-sublevels arg)
6162 (setq org-cycle-global-status 'contents))
6163 ((equal arg '(4))
6164 (org-set-startup-visibility)
6165 (message "Startup visibility, plus VISIBILITY properties."))
6166 (t
6167 (org-cycle '(4))))))
6168
6169(defun org-set-startup-visibility ()
6170 "Set the visibility required by startup options and properties."
6171 (cond
6172 ((eq org-startup-folded t)
6173 (org-cycle '(4)))
6174 ((eq org-startup-folded 'content)
6175 (let ((this-command 'org-cycle) (last-command 'org-cycle))
6176 (org-cycle '(4)) (org-cycle '(4)))))
8d642074
CD
6177 (unless (eq org-startup-folded 'showeverything)
6178 (if org-hide-block-startup (org-hide-block-all))
6179 (org-set-visibility-according-to-property 'no-cleanup)
6180 (org-cycle-hide-archived-subtrees 'all)
6181 (org-cycle-hide-drawers 'all)
86fbb8ca 6182 (org-cycle-show-empty-lines t)))
b349f79f
CD
6183
6184(defun org-set-visibility-according-to-property (&optional no-cleanup)
6185 "Switch subtree visibilities according to :VISIBILITY: property."
6186 (interactive)
65c439fd 6187 (let (org-show-entry-below state)
b349f79f 6188 (save-excursion
acedf35c
CD
6189 (goto-char (point-min))
6190 (while (re-search-forward
b349f79f
CD
6191 "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)"
6192 nil t)
6193 (setq state (match-string 1))
6194 (save-excursion
6195 (org-back-to-heading t)
6196 (hide-subtree)
6197 (org-reveal)
6198 (cond
6199 ((equal state '("fold" "folded"))
6200 (hide-subtree))
6201 ((equal state "children")
6202 (org-show-hidden-entry)
6203 (show-children))
6204 ((equal state "content")
6205 (save-excursion
6206 (save-restriction
6207 (org-narrow-to-subtree)
6208 (org-content))))
6209 ((member state '("all" "showall"))
6210 (show-subtree)))))
6211 (unless no-cleanup
6212 (org-cycle-hide-archived-subtrees 'all)
6213 (org-cycle-hide-drawers 'all)
6214 (org-cycle-show-empty-lines 'all)))))
3278a016 6215
20908596 6216(defun org-overview ()
33306645 6217 "Switch to overview mode, showing only top-level headlines.
20908596
CD
6218Really, this shows all headlines with level equal or greater than the level
6219of the first headline in the buffer. This is important, because if the
6220first headline is not level one, then (hide-sublevels 1) gives confusing
6221results."
d3f4dbe8 6222 (interactive)
20908596
CD
6223 (let ((level (save-excursion
6224 (goto-char (point-min))
3ab2c837 6225 (if (re-search-forward org-outline-regexp-bol nil t)
20908596
CD
6226 (progn
6227 (goto-char (match-beginning 0))
6228 (funcall outline-level))))))
6229 (and level (hide-sublevels level))))
891f4676 6230
20908596
CD
6231(defun org-content (&optional arg)
6232 "Show all headlines in the buffer, like a table of contents.
6233With numerical argument N, show content up to level N."
6234 (interactive "P")
6235 (save-excursion
6236 ;; Visit all headings and show their offspring
6237 (and (integerp arg) (org-overview))
6238 (goto-char (point-max))
6239 (catch 'exit
6240 (while (and (progn (condition-case nil
6241 (outline-previous-visible-heading 1)
6242 (error (goto-char (point-min))))
6243 t)
3ab2c837 6244 (looking-at org-outline-regexp))
20908596
CD
6245 (if (integerp arg)
6246 (show-children (1- arg))
6247 (show-branches))
6248 (if (bobp) (throw 'exit nil))))))
891f4676 6249
d943b3c6 6250
20908596
CD
6251(defun org-optimize-window-after-visibility-change (state)
6252 "Adjust the window after a change in outline visibility.
6253This function is the default value of the hook `org-cycle-hook'."
6254 (when (get-buffer-window (current-buffer))
6255 (cond
20908596
CD
6256 ((eq state 'content) nil)
6257 ((eq state 'all) nil)
6258 ((eq state 'folded) nil)
6259 ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1)))
6260 ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1))))))
891f4676 6261
c8d0cf5c
CD
6262(defun org-remove-empty-overlays-at (pos)
6263 "Remove outline overlays that do not contain non-white stuff."
6264 (mapc
6265 (lambda (o)
86fbb8ca
CD
6266 (and (eq 'outline (overlay-get o 'invisible))
6267 (not (string-match "\\S-" (buffer-substring (overlay-start o)
6268 (overlay-end o))))
6269 (delete-overlay o)))
6270 (overlays-at pos)))
c8d0cf5c
CD
6271
6272(defun org-clean-visibility-after-subtree-move ()
6273 "Fix visibility issues after moving a subtree."
6274 ;; First, find a reasonable region to look at:
6275 ;; Start two siblings above, end three below
6276 (let* ((beg (save-excursion
54a0dee5
CD
6277 (and (org-get-last-sibling)
6278 (org-get-last-sibling))
c8d0cf5c
CD
6279 (point)))
6280 (end (save-excursion
54a0dee5
CD
6281 (and (org-get-next-sibling)
6282 (org-get-next-sibling)
6283 (org-get-next-sibling))
c8d0cf5c
CD
6284 (if (org-at-heading-p)
6285 (point-at-eol)
6286 (point))))
6287 (level (looking-at "\\*+"))
6288 (re (if level (concat "^" (regexp-quote (match-string 0)) " "))))
6289 (save-excursion
6290 (save-restriction
6291 (narrow-to-region beg end)
6292 (when re
6293 ;; Properly fold already folded siblings
6294 (goto-char (point-min))
6295 (while (re-search-forward re nil t)
3ab2c837 6296 (if (and (not (outline-invisible-p))
ed21c5c8 6297 (save-excursion
3ab2c837 6298 (goto-char (point-at-eol)) (outline-invisible-p)))
c8d0cf5c
CD
6299 (hide-entry))))
6300 (org-cycle-show-empty-lines 'overview)
6301 (org-cycle-hide-drawers 'overview)))))
6302
20908596
CD
6303(defun org-cycle-show-empty-lines (state)
6304 "Show empty lines above all visible headlines.
6305The region to be covered depends on STATE when called through
6306`org-cycle-hook'. Lisp program can use t for STATE to get the
6307entire buffer covered. Note that an empty line is only shown if there
33306645 6308are at least `org-cycle-separator-lines' empty lines before the headline."
54a0dee5 6309 (when (not (= org-cycle-separator-lines 0))
20908596 6310 (save-excursion
54a0dee5 6311 (let* ((n (abs org-cycle-separator-lines))
20908596
CD
6312 (re (cond
6313 ((= n 1) "\\(\n[ \t]*\n\\*+\\) ")
6314 ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ")
6315 (t (let ((ns (number-to-string (- n 2))))
6316 (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
6317 "[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
54a0dee5 6318 beg end b e)
20908596
CD
6319 (cond
6320 ((memq state '(overview contents t))
6321 (setq beg (point-min) end (point-max)))
6322 ((memq state '(children folded))
6323 (setq beg (point) end (progn (org-end-of-subtree t t)
6324 (beginning-of-line 2)
6325 (point)))))
6326 (when beg
6327 (goto-char beg)
6328 (while (re-search-forward re end t)
54a0dee5
CD
6329 (unless (get-char-property (match-end 1) 'invisible)
6330 (setq e (match-end 1))
6331 (if (< org-cycle-separator-lines 0)
6332 (setq b (save-excursion
6333 (goto-char (match-beginning 0))
6334 (org-back-over-empty-lines)
8d642074
CD
6335 (if (save-excursion
6336 (goto-char (max (point-min) (1- (point))))
6337 (org-on-heading-p))
6338 (1- (point))
6339 (point))))
54a0dee5
CD
6340 (setq b (match-beginning 1)))
6341 (outline-flag-region b e nil)))))))
20908596
CD
6342 ;; Never hide empty lines at the end of the file.
6343 (save-excursion
6344 (goto-char (point-max))
6345 (outline-previous-heading)
6346 (outline-end-of-heading)
6347 (if (and (looking-at "[ \t\n]+")
6348 (= (match-end 0) (point-max)))
6349 (outline-flag-region (point) (match-end 0) nil))))
48aaad2d 6350
2c3ad40d
CD
6351(defun org-show-empty-lines-in-parent ()
6352 "Move to the parent and re-show empty lines before visible headlines."
6353 (save-excursion
6354 (let ((context (if (org-up-heading-safe) 'children 'overview)))
6355 (org-cycle-show-empty-lines context))))
6356
8bfe682a
CD
6357(defun org-files-list ()
6358 "Return `org-agenda-files' list, plus all open org-mode files.
6359This is useful for operations that need to scan all of a user's
6360open and agenda-wise Org files."
6361 (let ((files (mapcar 'expand-file-name (org-agenda-files))))
6362 (dolist (buf (buffer-list))
6363 (with-current-buffer buf
3ab2c837 6364 (if (and (org-mode-p) (buffer-file-name))
8bfe682a
CD
6365 (let ((file (expand-file-name (buffer-file-name))))
6366 (unless (member file files)
6367 (push file files))))))
6368 files))
6369
6370(defsubst org-entry-beginning-position ()
6371 "Return the beginning position of the current entry."
6372 (save-excursion (outline-back-to-heading t) (point)))
6373
6374(defsubst org-entry-end-position ()
6375 "Return the end position of the current entry."
6376 (save-excursion (outline-next-heading) (point)))
6377
20908596
CD
6378(defun org-cycle-hide-drawers (state)
6379 "Re-hide all drawers after a visibility state change."
6380 (when (and (org-mode-p)
c8d0cf5c 6381 (not (memq state '(overview folded contents))))
20908596
CD
6382 (save-excursion
6383 (let* ((globalp (memq state '(contents all)))
6384 (beg (if globalp (point-min) (point)))
c8d0cf5c
CD
6385 (end (if globalp (point-max)
6386 (if (eq state 'children)
6387 (save-excursion (outline-next-heading) (point))
6388 (org-end-of-subtree t)))))
20908596
CD
6389 (goto-char beg)
6390 (while (re-search-forward org-drawer-regexp end t)
6391 (org-flag-drawer t))))))
2a57416f 6392
20908596
CD
6393(defun org-flag-drawer (flag)
6394 (save-excursion
6395 (beginning-of-line 1)
6396 (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
3ab2c837 6397 (let ((b (match-end 0)))
20908596
CD
6398 (if (re-search-forward
6399 "^[ \t]*:END:"
6400 (save-excursion (outline-next-heading) (point)) t)
6401 (outline-flag-region b (point-at-eol) flag)
54a0dee5 6402 (error ":END: line missing at position %s" b))))))
891f4676 6403
20908596
CD
6404(defun org-subtree-end-visible-p ()
6405 "Is the end of the current subtree visible?"
6406 (pos-visible-in-window-p
6407 (save-excursion (org-end-of-subtree t) (point))))
2a57416f 6408
20908596
CD
6409(defun org-first-headline-recenter (&optional N)
6410 "Move cursor to the first headline and recenter the headline.
ed21c5c8 6411Optional argument N means put the headline into the Nth line of the window."
20908596 6412 (goto-char (point-min))
3ab2c837 6413 (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
20908596
CD
6414 (beginning-of-line)
6415 (recenter (prefix-numeric-value N))))
2a57416f 6416
afe98dfa
CD
6417;;; Saving and restoring visibility
6418
6419(defun org-outline-overlay-data (&optional use-markers)
6420 "Return a list of the locations of all outline overlays.
6421These are overlays with the `invisible' property value `outline'.
6422The return value is a list of cons cells, with start and stop
6423positions for each overlay.
6424If USE-MARKERS is set, return the positions as markers."
6425 (let (beg end)
6426 (save-excursion
6427 (save-restriction
6428 (widen)
6429 (delq nil
6430 (mapcar (lambda (o)
6431 (when (eq (overlay-get o 'invisible) 'outline)
6432 (setq beg (overlay-start o)
6433 end (overlay-end o))
6434 (and beg end (> end beg)
6435 (if use-markers
6436 (cons (move-marker (make-marker) beg)
6437 (move-marker (make-marker) end))
6438 (cons beg end)))))
6439 (overlays-in (point-min) (point-max))))))))
6440
6441(defun org-set-outline-overlay-data (data)
6442 "Create visibility overlays for all positions in DATA.
6443DATA should have been made by `org-outline-overlay-data'."
6444 (let (o)
6445 (save-excursion
6446 (save-restriction
6447 (widen)
6448 (show-all)
6449 (mapc (lambda (c)
6450 (setq o (make-overlay (car c) (cdr c)))
6451 (overlay-put o 'invisible 'outline))
6452 data)))))
ed21c5c8 6453
c8d0cf5c
CD
6454;;; Folding of blocks
6455
6456(defconst org-block-regexp
3ab2c837 6457 "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
c8d0cf5c
CD
6458 "Regular expression for hiding blocks.")
6459
6460(defvar org-hide-block-overlays nil
8bfe682a 6461 "Overlays hiding blocks.")
c8d0cf5c
CD
6462(make-variable-buffer-local 'org-hide-block-overlays)
6463
6464(defun org-block-map (function &optional start end)
86fbb8ca
CD
6465 "Call FUNCTION at the head of all source blocks in the current buffer.
6466Optional arguments START and END can be used to limit the range."
c8d0cf5c
CD
6467 (let ((start (or start (point-min)))
6468 (end (or end (point-max))))
6469 (save-excursion
6470 (goto-char start)
6471 (while (and (< (point) end) (re-search-forward org-block-regexp end t))
6472 (save-excursion
6473 (save-match-data
6474 (goto-char (match-beginning 0))
6475 (funcall function)))))))
6476
6477(defun org-hide-block-toggle-all ()
6478 "Toggle the visibility of all blocks in the current buffer."
6479 (org-block-map #'org-hide-block-toggle))
6480
6481(defun org-hide-block-all ()
6482 "Fold all blocks in the current buffer."
6483 (interactive)
6484 (org-show-block-all)
6485 (org-block-map #'org-hide-block-toggle-maybe))
6486
6487(defun org-show-block-all ()
6488 "Unfold all blocks in the current buffer."
86fbb8ca
CD
6489 (interactive)
6490 (mapc 'delete-overlay org-hide-block-overlays)
c8d0cf5c
CD
6491 (setq org-hide-block-overlays nil))
6492
6493(defun org-hide-block-toggle-maybe ()
6494 "Toggle visibility of block at point."
6495 (interactive)
6496 (let ((case-fold-search t))
6497 (if (save-excursion
6498 (beginning-of-line 1)
6499 (looking-at org-block-regexp))
6500 (progn (org-hide-block-toggle)
6501 t) ;; to signal that we took action
6502 nil))) ;; to signal that we did not
6503
6504(defun org-hide-block-toggle (&optional force)
6505 "Toggle the visibility of the current block."
6506 (interactive)
6507 (save-excursion
6508 (beginning-of-line)
6509 (if (re-search-forward org-block-regexp nil t)
6510 (let ((start (- (match-beginning 4) 1)) ;; beginning of body
54a0dee5
CD
6511 (end (match-end 0)) ;; end of entire body
6512 ov)
c8d0cf5c 6513 (if (memq t (mapcar (lambda (overlay)
86fbb8ca 6514 (eq (overlay-get overlay 'invisible)
c8d0cf5c 6515 'org-hide-block))
86fbb8ca 6516 (overlays-at start)))
54a0dee5
CD
6517 (if (or (not force) (eq force 'off))
6518 (mapc (lambda (ov)
6519 (when (member ov org-hide-block-overlays)
6520 (setq org-hide-block-overlays
6521 (delq ov org-hide-block-overlays)))
86fbb8ca 6522 (when (eq (overlay-get ov 'invisible)
54a0dee5 6523 'org-hide-block)
86fbb8ca
CD
6524 (delete-overlay ov)))
6525 (overlays-at start)))
6526 (setq ov (make-overlay start end))
6527 (overlay-put ov 'invisible 'org-hide-block)
54a0dee5 6528 ;; make the block accessible to isearch
86fbb8ca 6529 (overlay-put
54a0dee5
CD
6530 ov 'isearch-open-invisible
6531 (lambda (ov)
6532 (when (member ov org-hide-block-overlays)
6533 (setq org-hide-block-overlays
6534 (delq ov org-hide-block-overlays)))
86fbb8ca 6535 (when (eq (overlay-get ov 'invisible)
54a0dee5 6536 'org-hide-block)
86fbb8ca 6537 (delete-overlay ov))))
54a0dee5 6538 (push ov org-hide-block-overlays)))
c8d0cf5c
CD
6539 (error "Not looking at a source block"))))
6540
6541;; org-tab-after-check-for-cycling-hook
6542(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)
6543;; Remove overlays when changing major mode
6544(add-hook 'org-mode-hook
6545 (lambda () (org-add-hook 'change-major-mode-hook
6546 'org-show-block-all 'append 'local)))
6547
20908596 6548;;; Org-goto
2a57416f 6549
20908596
CD
6550(defvar org-goto-window-configuration nil)
6551(defvar org-goto-marker nil)
6552(defvar org-goto-map
6553 (let ((map (make-sparse-keymap)))
6554 (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command mouse-drag-region universal-argument org-occur)) cmd)
6555 (while (setq cmd (pop cmds))
6556 (substitute-key-definition cmd cmd map global-map)))
6557 (suppress-keymap map)
6558 (org-defkey map "\C-m" 'org-goto-ret)
6559 (org-defkey map [(return)] 'org-goto-ret)
6560 (org-defkey map [(left)] 'org-goto-left)
6561 (org-defkey map [(right)] 'org-goto-right)
6562 (org-defkey map [(control ?g)] 'org-goto-quit)
6563 (org-defkey map "\C-i" 'org-cycle)
6564 (org-defkey map [(tab)] 'org-cycle)
6565 (org-defkey map [(down)] 'outline-next-visible-heading)
6566 (org-defkey map [(up)] 'outline-previous-visible-heading)
6567 (if org-goto-auto-isearch
6568 (if (fboundp 'define-key-after)
6569 (define-key-after map [t] 'org-goto-local-auto-isearch)
6570 nil)
6571 (org-defkey map "q" 'org-goto-quit)
6572 (org-defkey map "n" 'outline-next-visible-heading)
6573 (org-defkey map "p" 'outline-previous-visible-heading)
6574 (org-defkey map "f" 'outline-forward-same-level)
6575 (org-defkey map "b" 'outline-backward-same-level)
6576 (org-defkey map "u" 'outline-up-heading))
6577 (org-defkey map "/" 'org-occur)
6578 (org-defkey map "\C-c\C-n" 'outline-next-visible-heading)
6579 (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading)
6580 (org-defkey map "\C-c\C-f" 'outline-forward-same-level)
6581 (org-defkey map "\C-c\C-b" 'outline-backward-same-level)
6582 (org-defkey map "\C-c\C-u" 'outline-up-heading)
6583 map))
2a57416f 6584
20908596
CD
6585(defconst org-goto-help
6586"Browse buffer copy, to find location or copy text. Just type for auto-isearch.
6587RET=jump to location [Q]uit and return to previous location
6588\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
2a57416f 6589
20908596 6590(defvar org-goto-start-pos) ; dynamically scoped parameter
2a57416f 6591
8bfe682a 6592;; FIXME: Docstring does not mention both interfaces
20908596
CD
6593(defun org-goto (&optional alternative-interface)
6594 "Look up a different location in the current file, keeping current visibility.
2a57416f 6595
20908596
CD
6596When you want look-up or go to a different location in a document, the
6597fastest way is often to fold the entire buffer and then dive into the tree.
6598This method has the disadvantage, that the previous location will be folded,
6599which may not be what you want.
2a57416f 6600
20908596
CD
6601This command works around this by showing a copy of the current buffer
6602in an indirect buffer, in overview mode. You can dive into the tree in
6603that copy, use org-occur and incremental search to find a location.
6604When pressing RET or `Q', the command returns to the original buffer in
6605which the visibility is still unchanged. After RET is will also jump to
3ab2c837
BG
6606the location selected in the indirect buffer and expose the headline
6607hierarchy above."
20908596 6608 (interactive "P")
db55f368 6609 (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level))))
20908596 6610 (org-refile-use-outline-path t)
c8d0cf5c 6611 (org-refile-target-verify-function nil)
20908596
CD
6612 (interface
6613 (if (not alternative-interface)
6614 org-goto-interface
6615 (if (eq org-goto-interface 'outline)
6616 'outline-path-completion
6617 'outline)))
6618 (org-goto-start-pos (point))
6619 (selected-point
6620 (if (eq interface 'outline)
6621 (car (org-get-location (current-buffer) org-goto-help))
3ab2c837 6622 (let ((pa (org-refile-get-location "Goto")))
afe98dfa
CD
6623 (org-refile-check-position pa)
6624 (nth 3 pa)))))
20908596
CD
6625 (if selected-point
6626 (progn
6627 (org-mark-ring-push org-goto-start-pos)
6628 (goto-char selected-point)
3ab2c837 6629 (if (or (outline-invisible-p) (org-invisible-p2))
20908596
CD
6630 (org-show-context 'org-goto)))
6631 (message "Quit"))))
2a57416f 6632
20908596
CD
6633(defvar org-goto-selected-point nil) ; dynamically scoped parameter
6634(defvar org-goto-exit-command nil) ; dynamically scoped parameter
6635(defvar org-goto-local-auto-isearch-map) ; defined below
891f4676 6636
20908596
CD
6637(defun org-get-location (buf help)
6638 "Let the user select a location in the Org-mode buffer BUF.
6639This function uses a recursive edit. It returns the selected position
6640or nil."
6641 (let ((isearch-mode-map org-goto-local-auto-isearch-map)
6642 (isearch-hide-immediately nil)
6643 (isearch-search-fun-function
621f83e4 6644 (lambda () 'org-goto-local-search-headings))
ed21c5c8
CD
6645 (org-goto-selected-point org-goto-exit-command)
6646 (pop-up-frames nil)
6647 (special-display-buffer-names nil)
6648 (special-display-regexps nil)
6649 (special-display-function nil))
20908596
CD
6650 (save-excursion
6651 (save-window-excursion
6652 (delete-other-windows)
6653 (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
c3313451 6654 (switch-to-buffer
20908596
CD
6655 (condition-case nil
6656 (make-indirect-buffer (current-buffer) "*org-goto*")
6657 (error (make-indirect-buffer (current-buffer) "*org-goto*"))))
6658 (with-output-to-temp-buffer "*Help*"
6659 (princ help))
93b62de8 6660 (org-fit-window-to-buffer (get-buffer-window "*Help*"))
20908596
CD
6661 (setq buffer-read-only nil)
6662 (let ((org-startup-truncated t)
6663 (org-startup-folded nil)
6664 (org-startup-align-all-tables nil))
6665 (org-mode)
6666 (org-overview))
6667 (setq buffer-read-only t)
6668 (if (and (boundp 'org-goto-start-pos)
6669 (integer-or-marker-p org-goto-start-pos))
6670 (let ((org-show-hierarchy-above t)
6671 (org-show-siblings t)
6672 (org-show-following-heading t))
6673 (goto-char org-goto-start-pos)
3ab2c837 6674 (and (outline-invisible-p) (org-show-context)))
20908596 6675 (goto-char (point-min)))
7b96ff9a 6676 (let (org-special-ctrl-a/e) (org-beginning-of-line))
20908596
CD
6677 (message "Select location and press RET")
6678 (use-local-map org-goto-map)
6679 (recursive-edit)
6680 ))
6681 (kill-buffer "*org-goto*")
6682 (cons org-goto-selected-point org-goto-exit-command)))
891f4676 6683
20908596
CD
6684(defvar org-goto-local-auto-isearch-map (make-sparse-keymap))
6685(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
6686(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
6687(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)
891f4676 6688
621f83e4
CD
6689(defun org-goto-local-search-headings (string bound noerror)
6690 "Search and make sure that any matches are in headlines."
20908596 6691 (catch 'return
621f83e4
CD
6692 (while (if isearch-forward
6693 (search-forward string bound noerror)
6694 (search-backward string bound noerror))
20908596
CD
6695 (when (let ((context (mapcar 'car (save-match-data (org-context)))))
6696 (and (member :headline context)
6697 (not (member :tags context))))
6698 (throw 'return (point))))))
a96ee7df 6699
20908596
CD
6700(defun org-goto-local-auto-isearch ()
6701 "Start isearch."
6702 (interactive)
6703 (goto-char (point-min))
6704 (let ((keys (this-command-keys)))
6705 (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char)
6706 (isearch-mode t)
6707 (isearch-process-search-char (string-to-char keys)))))
d924f2e5 6708
20908596
CD
6709(defun org-goto-ret (&optional arg)
6710 "Finish `org-goto' by going to the new location."
6711 (interactive "P")
6712 (setq org-goto-selected-point (point)
6713 org-goto-exit-command 'return)
6714 (throw 'exit nil))
891f4676 6715
20908596
CD
6716(defun org-goto-left ()
6717 "Finish `org-goto' by going to the new location."
6718 (interactive)
6719 (if (org-on-heading-p)
6720 (progn
6721 (beginning-of-line 1)
6722 (setq org-goto-selected-point (point)
6723 org-goto-exit-command 'left)
6724 (throw 'exit nil))
6725 (error "Not on a heading")))
891f4676 6726
20908596
CD
6727(defun org-goto-right ()
6728 "Finish `org-goto' by going to the new location."
6729 (interactive)
6730 (if (org-on-heading-p)
6731 (progn
6732 (setq org-goto-selected-point (point)
6733 org-goto-exit-command 'right)
6734 (throw 'exit nil))
6735 (error "Not on a heading")))
891f4676 6736
20908596
CD
6737(defun org-goto-quit ()
6738 "Finish `org-goto' without cursor motion."
6739 (interactive)
6740 (setq org-goto-selected-point nil)
6741 (setq org-goto-exit-command 'quit)
6742 (throw 'exit nil))
4b3a9ba7 6743
20908596 6744;;; Indirect buffer display of subtrees
4b3a9ba7 6745
20908596
CD
6746(defvar org-indirect-dedicated-frame nil
6747 "This is the frame being used for indirect tree display.")
6748(defvar org-last-indirect-buffer nil)
891f4676 6749
20908596
CD
6750(defun org-tree-to-indirect-buffer (&optional arg)
6751 "Create indirect buffer and narrow it to current subtree.
6752With numerical prefix ARG, go up to this level and then take that tree.
6753If ARG is negative, go up that many levels.
6754If `org-indirect-buffer-display' is not `new-frame', the command removes the
6755indirect buffer previously made with this command, to avoid proliferation of
86fbb8ca
CD
6756indirect buffers. However, when you call the command with a \
6757\\[universal-argument] prefix, or
20908596
CD
6758when `org-indirect-buffer-display' is `new-frame', the last buffer
6759is kept so that you can work with several indirect buffers at the same time.
86fbb8ca
CD
6760If `org-indirect-buffer-display' is `dedicated-frame', the \
6761\\[universal-argument] prefix also
20908596
CD
6762requests that a new frame be made for the new buffer, so that the dedicated
6763frame is not changed."
6764 (interactive "P")
6765 (let ((cbuf (current-buffer))
6766 (cwin (selected-window))
d3f4dbe8 6767 (pos (point))
20908596
CD
6768 beg end level heading ibuf)
6769 (save-excursion
6770 (org-back-to-heading t)
6771 (when (numberp arg)
6772 (setq level (org-outline-level))
6773 (if (< arg 0) (setq arg (+ level arg)))
6774 (while (> (setq level (org-outline-level)) arg)
6775 (outline-up-heading 1 t)))
6776 (setq beg (point)
6777 heading (org-get-heading))
ed21c5c8
CD
6778 (org-end-of-subtree t t)
6779 (if (org-on-heading-p) (backward-char 1))
6780 (setq end (point)))
20908596
CD
6781 (if (and (buffer-live-p org-last-indirect-buffer)
6782 (not (eq org-indirect-buffer-display 'new-frame))
6783 (not arg))
6784 (kill-buffer org-last-indirect-buffer))
6785 (setq ibuf (org-get-indirect-buffer cbuf)
6786 org-last-indirect-buffer ibuf)
d3f4dbe8 6787 (cond
20908596
CD
6788 ((or (eq org-indirect-buffer-display 'new-frame)
6789 (and arg (eq org-indirect-buffer-display 'dedicated-frame)))
6790 (select-frame (make-frame))
6791 (delete-other-windows)
c3313451 6792 (switch-to-buffer ibuf)
20908596
CD
6793 (org-set-frame-title heading))
6794 ((eq org-indirect-buffer-display 'dedicated-frame)
6795 (raise-frame
6796 (select-frame (or (and org-indirect-dedicated-frame
6797 (frame-live-p org-indirect-dedicated-frame)
6798 org-indirect-dedicated-frame)
6799 (setq org-indirect-dedicated-frame (make-frame)))))
6800 (delete-other-windows)
c3313451 6801 (switch-to-buffer ibuf)
20908596
CD
6802 (org-set-frame-title (concat "Indirect: " heading)))
6803 ((eq org-indirect-buffer-display 'current-window)
c3313451 6804 (switch-to-buffer ibuf))
20908596
CD
6805 ((eq org-indirect-buffer-display 'other-window)
6806 (pop-to-buffer ibuf))
f924a367 6807 (t (error "Invalid value")))
20908596
CD
6808 (if (featurep 'xemacs)
6809 (save-excursion (org-mode) (turn-on-font-lock)))
6810 (narrow-to-region beg end)
6811 (show-all)
6812 (goto-char pos)
6813 (and (window-live-p cwin) (select-window cwin))))
edd21304 6814
20908596
CD
6815(defun org-get-indirect-buffer (&optional buffer)
6816 (setq buffer (or buffer (current-buffer)))
6817 (let ((n 1) (base (buffer-name buffer)) bname)
6818 (while (buffer-live-p
6819 (get-buffer (setq bname (concat base "-" (number-to-string n)))))
6820 (setq n (1+ n)))
6821 (condition-case nil
6822 (make-indirect-buffer buffer bname 'clone)
6823 (error (make-indirect-buffer buffer bname)))))
ef943dba 6824
20908596
CD
6825(defun org-set-frame-title (title)
6826 "Set the title of the current frame to the string TITLE."
6827 ;; FIXME: how to name a single frame in XEmacs???
6828 (unless (featurep 'xemacs)
6829 (modify-frame-parameters (selected-frame) (list (cons 'name title)))))
ef943dba 6830
20908596 6831;;;; Structure editing
ef943dba 6832
20908596 6833;;; Inserting headlines
ef943dba 6834
0bd48b37
CD
6835(defun org-previous-line-empty-p ()
6836 (save-excursion
6837 (and (not (bobp))
6838 (or (beginning-of-line 0) t)
6839 (save-match-data
6840 (looking-at "[ \t]*$")))))
c8d0cf5c 6841
ed21c5c8 6842(defun org-insert-heading (&optional force-heading invisible-ok)
20908596
CD
6843 "Insert a new heading or item with same depth at point.
6844If point is in a plain list and FORCE-HEADING is nil, create a new list item.
6845If point is at the beginning of a headline, insert a sibling before the
afe98dfa
CD
6846current headline. If point is not at the beginning, split the line,
6847create the new headline with the text in the current line after point
6848\(but see also the variable `org-M-RET-may-split-line').
6849
ed21c5c8
CD
6850When INVISIBLE-OK is set, stop at invisible headlines when going back.
6851This is important for non-interactive uses of the command."
20908596 6852 (interactive "P")
ed21c5c8 6853 (if (or (= (buffer-size) 0)
afe98dfa
CD
6854 (and (not (save-excursion
6855 (and (ignore-errors (org-back-to-heading invisible-ok))
6856 (org-on-heading-p))))
ed21c5c8 6857 (not (org-in-item-p))))
afe98dfa
CD
6858 (progn
6859 (insert "\n* ")
6860 (run-hooks 'org-insert-heading-hook))
20908596 6861 (when (or force-heading (not (org-insert-item)))
0bd48b37 6862 (let* ((empty-line-p nil)
afe98dfa
CD
6863 (level nil)
6864 (on-heading (org-on-heading-p))
0bd48b37 6865 (head (save-excursion
20908596
CD
6866 (condition-case nil
6867 (progn
ed21c5c8 6868 (org-back-to-heading invisible-ok)
afe98dfa
CD
6869 (when (and (not on-heading)
6870 (featurep 'org-inlinetask)
6871 (integerp org-inlinetask-min-level)
6872 (>= (length (match-string 0))
6873 org-inlinetask-min-level))
6874 ;; Find a heading level before the inline task
6875 (while (and (setq level (org-up-heading-safe))
6876 (>= level org-inlinetask-min-level)))
6877 (if (org-on-heading-p)
6878 (org-back-to-heading invisible-ok)
6879 (error "This should not happen")))
0bd48b37 6880 (setq empty-line-p (org-previous-line-empty-p))
20908596
CD
6881 (match-string 0))
6882 (error "*"))))
0bd48b37
CD
6883 (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
6884 (blank (if (eq blank-a 'auto) empty-line-p blank-a))
93b62de8 6885 pos hide-previous previous-pos)
20908596
CD
6886 (cond
6887 ((and (org-on-heading-p) (bolp)
6888 (or (bobp)
3ab2c837 6889 (save-excursion (backward-char 1) (not (outline-invisible-p)))))
20908596
CD
6890 ;; insert before the current line
6891 (open-line (if blank 2 1)))
6892 ((and (bolp)
54a0dee5 6893 (not org-insert-heading-respect-content)
20908596
CD
6894 (or (bobp)
6895 (save-excursion
3ab2c837 6896 (backward-char 1) (not (outline-invisible-p)))))
20908596
CD
6897 ;; insert right here
6898 nil)
6899 (t
93b62de8 6900 ;; somewhere in the line
71d35b24 6901 (save-excursion
93b62de8 6902 (setq previous-pos (point-at-bol))
71d35b24 6903 (end-of-line)
3ab2c837 6904 (setq hide-previous (outline-invisible-p)))
93b62de8 6905 (and org-insert-heading-respect-content (org-show-subtree))
20908596 6906 (let ((split
93b62de8
CD
6907 (and (org-get-alist-option org-M-RET-may-split-line 'headline)
6908 (save-excursion
6909 (let ((p (point)))
6910 (goto-char (point-at-bol))
6911 (and (looking-at org-complex-heading-regexp)
6912 (> p (match-beginning 4)))))))
20908596 6913 tags pos)
621f83e4
CD
6914 (cond
6915 (org-insert-heading-respect-content
6916 (org-end-of-subtree nil t)
afe98dfa
CD
6917 (when (featurep 'org-inlinetask)
6918 (while (and (not (eobp))
6919 (looking-at "\\(\\*+\\)[ \t]+")
6920 (>= (length (match-string 1))
6921 org-inlinetask-min-level))
6922 (org-end-of-subtree nil t)))
93b62de8 6923 (or (bolp) (newline))
0bd48b37
CD
6924 (or (org-previous-line-empty-p)
6925 (and blank (newline)))
621f83e4
CD
6926 (open-line 1))
6927 ((org-on-heading-p)
93b62de8
CD
6928 (when hide-previous
6929 (show-children)
6930 (org-show-entry))
afe98dfa 6931 (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
621f83e4
CD
6932 (setq tags (and (match-end 2) (match-string 2)))
6933 (and (match-end 1)
6934 (delete-region (match-beginning 1) (match-end 1)))
6935 (setq pos (point-at-bol))
20908596 6936 (or split (end-of-line 1))
621f83e4 6937 (delete-horizontal-space)
ed21c5c8
CD
6938 (if (string-match "\\`\\*+\\'"
6939 (buffer-substring (point-at-bol) (point)))
6940 (insert " "))
621f83e4
CD
6941 (newline (if blank 2 1))
6942 (when tags
6943 (save-excursion
6944 (goto-char pos)
6945 (end-of-line 1)
6946 (insert " " tags)
6947 (org-set-tags nil 'align))))
6948 (t
6949 (or split (end-of-line 1))
6950 (newline (if blank 2 1)))))))
20908596
CD
6951 (insert head) (just-one-space)
6952 (setq pos (point))
6953 (end-of-line 1)
6954 (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
71d35b24
CD
6955 (when (and org-insert-heading-respect-content hide-previous)
6956 (save-excursion
93b62de8
CD
6957 (goto-char previous-pos)
6958 (hide-subtree)))
20908596 6959 (run-hooks 'org-insert-heading-hook)))))
ef943dba 6960
3ab2c837
BG
6961(defun org-get-heading (&optional no-tags no-todo)
6962 "Return the heading of the current entry, without the stars.
6963When NO-TAGS is non-nil, don't include tags.
6964When NO-TODO is non-nil, don't include TODO keywords."
20908596
CD
6965 (save-excursion
6966 (org-back-to-heading t)
3ab2c837
BG
6967 (cond
6968 ((and no-tags no-todo)
6969 (looking-at org-complex-heading-regexp)
6970 (match-string 4))
6971 (no-tags
6972 (looking-at "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$")
6973 (match-string 1))
6974 (no-todo
6975 (looking-at (concat "\\*+[ \t]+" org-todo-regexp " +"
6976 "\\([^\n\r]*?[ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$"))
6977 (match-string 2))
6978 (t (looking-at "\\*+[ \t]+\\([^\r\n]*\\)")
6979 (match-string 1)))))
ef943dba 6980
0bd48b37
CD
6981(defun org-heading-components ()
6982 "Return the components of the current heading.
6983This is a list with the following elements:
6984- the level as an integer
6985- the reduced level, different if `org-odd-levels-only' is set.
6986- the TODO keyword, or nil
6987- the priority character, like ?A, or nil if no priority is given
6988- the headline text itself, or the tags string if no headline text
6989- the tags string, or nil."
6990 (save-excursion
6991 (org-back-to-heading t)
ed21c5c8 6992 (if (let (case-fold-search) (looking-at org-complex-heading-regexp))
0bd48b37
CD
6993 (list (length (match-string 1))
6994 (org-reduced-level (length (match-string 1)))
6995 (org-match-string-no-properties 2)
6996 (and (match-end 3) (aref (match-string 3) 2))
6997 (org-match-string-no-properties 4)
6998 (org-match-string-no-properties 5)))))
6999
c8d0cf5c
CD
7000(defun org-get-entry ()
7001 "Get the entry text, after heading, entire subtree."
7002 (save-excursion
7003 (org-back-to-heading t)
7004 (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
7005
20908596
CD
7006(defun org-insert-heading-after-current ()
7007 "Insert a new heading with same level as current, after current subtree."
7008 (interactive)
7009 (org-back-to-heading)
7010 (org-insert-heading)
7011 (org-move-subtree-down)
7012 (end-of-line 1))
35fb9989 7013
621f83e4
CD
7014(defun org-insert-heading-respect-content ()
7015 (interactive)
7016 (let ((org-insert-heading-respect-content t))
71d35b24 7017 (org-insert-heading t)))
621f83e4 7018
71d35b24
CD
7019(defun org-insert-todo-heading-respect-content (&optional force-state)
7020 (interactive "P")
621f83e4 7021 (let ((org-insert-heading-respect-content t))
71d35b24 7022 (org-insert-todo-heading force-state t)))
621f83e4 7023
71d35b24 7024(defun org-insert-todo-heading (arg &optional force-heading)
20908596
CD
7025 "Insert a new heading with the same level and TODO state as current heading.
7026If the heading has no TODO state, or if the state is DONE, use the first
7027state (TODO by default). Also with prefix arg, force first state."
7028 (interactive "P")
71d35b24
CD
7029 (when (or force-heading (not (org-insert-item 'checkbox)))
7030 (org-insert-heading force-heading)
20908596
CD
7031 (save-excursion
7032 (org-back-to-heading)
7033 (outline-previous-heading)
7034 (looking-at org-todo-line-regexp))
c8d0cf5c
CD
7035 (let*
7036 ((new-mark-x
7037 (if (or arg
7038 (not (match-beginning 2))
7039 (member (match-string 2) org-done-keywords))
7040 (car org-todo-keywords-1)
7041 (match-string 2)))
7042 (new-mark
7043 (or
7044 (run-hook-with-args-until-success
7045 'org-todo-get-default-hook new-mark-x nil)
7046 new-mark-x)))
7047 (beginning-of-line 1)
3ab2c837 7048 (and (looking-at org-outline-regexp) (goto-char (match-end 0))
c8d0cf5c
CD
7049 (if org-treat-insert-todo-heading-as-state-change
7050 (org-todo new-mark)
7051 (insert new-mark " "))))
b349f79f
CD
7052 (when org-provide-todo-statistics
7053 (org-update-parent-todo-statistics))))
ef943dba 7054
20908596
CD
7055(defun org-insert-subheading (arg)
7056 "Insert a new subheading and demote it.
7057Works for outline headings and for plain lists alike."
7058 (interactive "P")
7059 (org-insert-heading arg)
7060 (cond
7061 ((org-on-heading-p) (org-do-demote))
afe98dfa 7062 ((org-at-item-p) (org-indent-item))))
4da1a99d 7063
20908596
CD
7064(defun org-insert-todo-subheading (arg)
7065 "Insert a new subheading with TODO keyword or checkbox and demote it.
7066Works for outline headings and for plain lists alike."
7067 (interactive "P")
7068 (org-insert-todo-heading arg)
d3f4dbe8 7069 (cond
20908596 7070 ((org-on-heading-p) (org-do-demote))
afe98dfa 7071 ((org-at-item-p) (org-indent-item))))
4da1a99d 7072
20908596 7073;;; Promotion and Demotion
4da1a99d 7074
c8d0cf5c
CD
7075(defvar org-after-demote-entry-hook nil
7076 "Hook run after an entry has been demoted.
7077The cursor will be at the beginning of the entry.
7078When a subtree is being demoted, the hook will be called for each node.")
7079
7080(defvar org-after-promote-entry-hook nil
7081 "Hook run after an entry has been promoted.
7082The cursor will be at the beginning of the entry.
7083When a subtree is being promoted, the hook will be called for each node.")
7084
20908596
CD
7085(defun org-promote-subtree ()
7086 "Promote the entire subtree.
7087See also `org-promote'."
7088 (interactive)
d3f4dbe8 7089 (save-excursion
3ab2c837 7090 (org-with-limited-levels (org-map-tree 'org-promote)))
20908596
CD
7091 (org-fix-position-after-promote))
7092
7093(defun org-demote-subtree ()
7094 "Demote the entire subtree. See `org-demote'.
7095See also `org-promote'."
7096 (interactive)
d3f4dbe8 7097 (save-excursion
3ab2c837 7098 (org-with-limited-levels (org-map-tree 'org-demote)))
20908596 7099 (org-fix-position-after-promote))
4b3a9ba7 7100
20908596
CD
7101
7102(defun org-do-promote ()
7103 "Promote the current heading higher up the tree.
7104If the region is active in `transient-mark-mode', promote all headings
7105in the region."
7106 (interactive)
3278a016 7107 (save-excursion
20908596
CD
7108 (if (org-region-active-p)
7109 (org-map-region 'org-promote (region-beginning) (region-end))
7110 (org-promote)))
7111 (org-fix-position-after-promote))
7112
7113(defun org-do-demote ()
7114 "Demote the current heading lower down the tree.
7115If the region is active in `transient-mark-mode', demote all headings
7116in the region."
7117 (interactive)
4da1a99d 7118 (save-excursion
20908596
CD
7119 (if (org-region-active-p)
7120 (org-map-region 'org-demote (region-beginning) (region-end))
7121 (org-demote)))
7122 (org-fix-position-after-promote))
4b3a9ba7 7123
20908596
CD
7124(defun org-fix-position-after-promote ()
7125 "Make sure that after pro/demotion cursor position is right."
7126 (let ((pos (point)))
7127 (when (save-excursion
7128 (beginning-of-line 1)
7129 (looking-at org-todo-line-regexp)
7130 (or (equal pos (match-end 1)) (equal pos (match-end 2))))
7131 (cond ((eobp) (insert " "))
7132 ((eolp) (insert " "))
7133 ((equal (char-after) ?\ ) (forward-char 1))))))
4b3a9ba7 7134
8bfe682a
CD
7135(defun org-current-level ()
7136 "Return the level of the current entry, or nil if before the first headline.
7137The level is the number of stars at the beginning of the headline."
7138 (save-excursion
3ab2c837
BG
7139 (org-with-limited-levels
7140 (ignore-errors
7141 (org-back-to-heading t)
7142 (funcall outline-level)))))
8bfe682a 7143
ed21c5c8
CD
7144(defun org-get-previous-line-level ()
7145 "Return the outline depth of the last headline before the current line.
7146Returns 0 for the first headline in the buffer, and nil if before the
7147first headline."
7148 (let ((current-level (org-current-level))
7149 (prev-level (when (> (line-number-at-pos) 1)
7150 (save-excursion
7151 (beginning-of-line 0)
7152 (org-current-level)))))
7153 (cond ((null current-level) nil) ; Before first headline
7154 ((null prev-level) 0) ; At first headline
7155 (prev-level))))
7156
20908596 7157(defun org-reduced-level (l)
0bd48b37
CD
7158 "Compute the effective level of a heading.
7159This takes into account the setting of `org-odd-levels-only'."
3ab2c837
BG
7160 (cond
7161 ((zerop l) 0)
7162 (org-odd-levels-only (1+ (floor (/ l 2))))
7163 (t l)))
4b3a9ba7 7164
ed21c5c8
CD
7165(defun org-level-increment ()
7166 "Return the number of stars that will be added or removed at a
7167time to headlines when structure editing, based on the value of
7168`org-odd-levels-only'."
7169 (if org-odd-levels-only 2 1))
7170
20908596
CD
7171(defun org-get-valid-level (level &optional change)
7172 "Rectify a level change under the influence of `org-odd-levels-only'
7173LEVEL is a current level, CHANGE is by how much the level should be
7174modified. Even if CHANGE is nil, LEVEL may be returned modified because
7175even level numbers will become the next higher odd number."
7176 (if org-odd-levels-only
7177 (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
7178 ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
7179 ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
c8d0cf5c 7180 (max 1 (+ level (or change 0)))))
4b3a9ba7 7181
20908596
CD
7182(if (boundp 'define-obsolete-function-alias)
7183 (if (or (featurep 'xemacs) (< emacs-major-version 23))
7184 (define-obsolete-function-alias 'org-get-legal-level
7185 'org-get-valid-level)
7186 (define-obsolete-function-alias 'org-get-legal-level
7187 'org-get-valid-level "23.1")))
4b3a9ba7 7188
20908596
CD
7189(defun org-promote ()
7190 "Promote the current heading higher up the tree.
7191If the region is active in `transient-mark-mode', promote all headings
7192in the region."
7193 (org-back-to-heading t)
7194 (let* ((level (save-match-data (funcall outline-level)))
3ab2c837
BG
7195 (after-change-functions (remove 'flyspell-after-change-function
7196 after-change-functions))
20908596
CD
7197 (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
7198 (diff (abs (- level (length up-head) -1))))
7199 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary"))
7200 (replace-match up-head nil t)
7201 ;; Fixup tag positioning
7202 (and org-auto-align-tags (org-set-tags nil t))
c8d0cf5c
CD
7203 (if org-adapt-indentation (org-fixup-indentation (- diff)))
7204 (run-hooks 'org-after-promote-entry-hook)))
891f4676 7205
20908596
CD
7206(defun org-demote ()
7207 "Demote the current heading lower down the tree.
7208If the region is active in `transient-mark-mode', demote all headings
7209in the region."
7210 (org-back-to-heading t)
7211 (let* ((level (save-match-data (funcall outline-level)))
3ab2c837
BG
7212 (after-change-functions (remove 'flyspell-after-change-function
7213 after-change-functions))
20908596
CD
7214 (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
7215 (diff (abs (- level (length down-head) -1))))
7216 (replace-match down-head nil t)
7217 ;; Fixup tag positioning
7218 (and org-auto-align-tags (org-set-tags nil t))
c8d0cf5c
CD
7219 (if org-adapt-indentation (org-fixup-indentation diff))
7220 (run-hooks 'org-after-demote-entry-hook)))
20908596 7221
8bfe682a 7222(defun org-cycle-level ()
ed21c5c8
CD
7223 "Cycle the level of an empty headline through possible states.
7224This goes first to child, then to parent, level, then up the hierarchy.
7225After top level, it switches back to sibling level."
7226 (interactive)
8bfe682a 7227 (let ((org-adapt-indentation nil))
ed21c5c8
CD
7228 (when (org-point-at-end-of-empty-headline)
7229 (setq this-command 'org-cycle-level) ; Only needed for caching
7230 (let ((cur-level (org-current-level))
7231 (prev-level (org-get-previous-line-level)))
7232 (cond
7233 ;; If first headline in file, promote to top-level.
7234 ((= prev-level 0)
7235 (loop repeat (/ (- cur-level 1) (org-level-increment))
7236 do (org-do-promote)))
7237 ;; If same level as prev, demote one.
7238 ((= prev-level cur-level)
7239 (org-do-demote))
7240 ;; If parent is top-level, promote to top level if not already.
7241 ((= prev-level 1)
7242 (loop repeat (/ (- cur-level 1) (org-level-increment))
7243 do (org-do-promote)))
7244 ;; If top-level, return to prev-level.
7245 ((= cur-level 1)
7246 (loop repeat (/ (- prev-level 1) (org-level-increment))
7247 do (org-do-demote)))
7248 ;; If less than prev-level, promote one.
7249 ((< cur-level prev-level)
7250 (org-do-promote))
7251 ;; If deeper than prev-level, promote until higher than
7252 ;; prev-level.
7253 ((> cur-level prev-level)
7254 (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
7255 do (org-do-promote))))
7256 t))))
8bfe682a 7257
20908596
CD
7258(defun org-map-tree (fun)
7259 "Call FUN for every heading underneath the current one."
7260 (org-back-to-heading)
7261 (let ((level (funcall outline-level)))
7262 (save-excursion
7263 (funcall fun)
7264 (while (and (progn
7265 (outline-next-heading)
7266 (> (funcall outline-level) level))
7267 (not (eobp)))
7268 (funcall fun)))))
7269
7270(defun org-map-region (fun beg end)
7271 "Call FUN for every heading between BEG and END."
7272 (let ((org-ignore-region t))
7273 (save-excursion
7274 (setq end (copy-marker end))
7275 (goto-char beg)
3ab2c837 7276 (if (and (re-search-forward org-outline-regexp-bol nil t)
20908596
CD
7277 (< (point) end))
7278 (funcall fun))
7279 (while (and (progn
7280 (outline-next-heading)
7281 (< (point) end))
7282 (not (eobp)))
7283 (funcall fun)))))
7284
7285(defun org-fixup-indentation (diff)
86fbb8ca 7286 "Change the indentation in the current entry by DIFF.
20908596
CD
7287However, if any line in the current entry has no indentation, or if it
7288would end up with no indentation after the change, nothing at all is done."
7289 (save-excursion
7290 (let ((end (save-excursion (outline-next-heading)
7291 (point-marker)))
7292 (prohibit (if (> diff 0)
7293 "^\\S-"
7294 (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
7295 col)
7296 (unless (save-excursion (end-of-line 1)
7297 (re-search-forward prohibit end t))
7298 (while (and (< (point) end)
7299 (re-search-forward "^[ \t]+" end t))
7300 (goto-char (match-end 0))
7301 (setq col (current-column))
7302 (if (< diff 0) (replace-match ""))
ce4fdcb9 7303 (org-indent-to-column (+ diff col))))
20908596
CD
7304 (move-marker end nil))))
7305
7306(defun org-convert-to-odd-levels ()
7307 "Convert an org-mode file with all levels allowed to one with odd levels.
7308This will leave level 1 alone, convert level 2 to level 3, level 3 to
7309level 5 etc."
7310 (interactive)
7311 (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ")
3ab2c837 7312 (let ((outline-level 'org-outline-level)
8d642074 7313 (org-odd-levels-only nil) n)
20908596
CD
7314 (save-excursion
7315 (goto-char (point-min))
7316 (while (re-search-forward "^\\*\\*+ " nil t)
7317 (setq n (- (length (match-string 0)) 2))
7318 (while (>= (setq n (1- n)) 0)
7319 (org-demote))
7320 (end-of-line 1))))))
4b3a9ba7 7321
20908596 7322(defun org-convert-to-oddeven-levels ()
86fbb8ca
CD
7323 "Convert an org-mode file with only odd levels to one with odd/even levels.
7324This promotes level 3 to level 2, level 5 to level 3 etc. If the
7325file contains a section with an even level, conversion would
7326destroy the structure of the file. An error is signaled in this
7327case."
20908596
CD
7328 (interactive)
7329 (goto-char (point-min))
7330 ;; First check if there are no even levels
7331 (when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
7332 (org-show-context t)
f924a367 7333 (error "Not all levels are odd in this file. Conversion not possible"))
20908596 7334 (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
8d642074
CD
7335 (let ((outline-regexp org-outline-regexp)
7336 (outline-level 'org-outline-level)
7337 (org-odd-levels-only nil) n)
20908596
CD
7338 (save-excursion
7339 (goto-char (point-min))
7340 (while (re-search-forward "^\\*\\*+ " nil t)
7341 (setq n (/ (1- (length (match-string 0))) 2))
7342 (while (>= (setq n (1- n)) 0)
7343 (org-promote))
7344 (end-of-line 1))))))
a96ee7df 7345
20908596
CD
7346(defun org-tr-level (n)
7347 "Make N odd if required."
7348 (if org-odd-levels-only (1+ (/ n 2)) n))
8c6fb58b 7349
20908596 7350;;; Vertical tree motion, cutting and pasting of subtrees
8c6fb58b 7351
20908596
CD
7352(defun org-move-subtree-up (&optional arg)
7353 "Move the current subtree up past ARG headlines of the same level."
7354 (interactive "p")
7355 (org-move-subtree-down (- (prefix-numeric-value arg))))
b0a10108 7356
20908596
CD
7357(defun org-move-subtree-down (&optional arg)
7358 "Move the current subtree down past ARG headlines of the same level."
7359 (interactive "p")
7360 (setq arg (prefix-numeric-value arg))
54a0dee5
CD
7361 (let ((movfunc (if (> arg 0) 'org-get-next-sibling
7362 'org-get-last-sibling))
20908596
CD
7363 (ins-point (make-marker))
7364 (cnt (abs arg))
3ab2c837 7365 (col (current-column))
20908596
CD
7366 beg beg0 end txt folded ne-beg ne-end ne-ins ins-end)
7367 ;; Select the tree
7368 (org-back-to-heading)
7369 (setq beg0 (point))
7370 (save-excursion
7371 (setq ne-beg (org-back-over-empty-lines))
7372 (setq beg (point)))
7373 (save-match-data
7374 (save-excursion (outline-end-of-heading)
3ab2c837 7375 (setq folded (outline-invisible-p)))
20908596
CD
7376 (outline-end-of-subtree))
7377 (outline-next-heading)
7378 (setq ne-end (org-back-over-empty-lines))
7379 (setq end (point))
7380 (goto-char beg0)
7381 (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg))
7382 ;; include less whitespace
7383 (save-excursion
7384 (goto-char beg)
7385 (forward-line (- ne-beg ne-end))
7386 (setq beg (point))))
7387 ;; Find insertion point, with error handling
7388 (while (> cnt 0)
3ab2c837 7389 (or (and (funcall movfunc) (looking-at org-outline-regexp))
20908596
CD
7390 (progn (goto-char beg0)
7391 (error "Cannot move past superior level or buffer limit")))
7392 (setq cnt (1- cnt)))
7393 (if (> arg 0)
7394 ;; Moving forward - still need to move over subtree
7395 (progn (org-end-of-subtree t t)
7396 (save-excursion
7397 (org-back-over-empty-lines)
7398 (or (bolp) (newline)))))
7399 (setq ne-ins (org-back-over-empty-lines))
7400 (move-marker ins-point (point))
7401 (setq txt (buffer-substring beg end))
b349f79f 7402 (org-save-markers-in-region beg end)
20908596 7403 (delete-region beg end)
c8d0cf5c 7404 (org-remove-empty-overlays-at beg)
ff4be292
CD
7405 (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil))
7406 (or (bobp) (outline-flag-region (1- (point)) (point) nil))
c8d0cf5c 7407 (and (not (bolp)) (looking-at "\n") (forward-char 1))
b349f79f
CD
7408 (let ((bbb (point)))
7409 (insert-before-markers txt)
7410 (org-reinstall-markers-in-region bbb)
7411 (move-marker ins-point bbb))
20908596
CD
7412 (or (bolp) (insert "\n"))
7413 (setq ins-end (point))
7414 (goto-char ins-point)
7415 (org-skip-whitespace)
7416 (when (and (< arg 0)
7417 (org-first-sibling-p)
7418 (> ne-ins ne-beg))
7419 ;; Move whitespace back to beginning
7420 (save-excursion
7421 (goto-char ins-end)
7422 (let ((kill-whole-line t))
7423 (kill-line (- ne-ins ne-beg)) (point)))
7424 (insert (make-string (- ne-ins ne-beg) ?\n)))
7425 (move-marker ins-point nil)
c8d0cf5c
CD
7426 (if folded
7427 (hide-subtree)
20908596
CD
7428 (org-show-entry)
7429 (show-children)
c8d0cf5c 7430 (org-cycle-hide-drawers 'children))
3ab2c837
BG
7431 (org-clean-visibility-after-subtree-move)
7432 ;; move back to the initial column we were at
7433 (move-to-column col)))
8c6fb58b 7434
20908596
CD
7435(defvar org-subtree-clip ""
7436 "Clipboard for cut and paste of subtrees.
7437This is actually only a copy of the kill, because we use the normal kill
7438ring. We need it to check if the kill was created by `org-copy-subtree'.")
8c6fb58b 7439
20908596
CD
7440(defvar org-subtree-clip-folded nil
7441 "Was the last copied subtree folded?
7442This is used to fold the tree back after pasting.")
b0a10108 7443
20908596
CD
7444(defun org-cut-subtree (&optional n)
7445 "Cut the current subtree into the clipboard.
7446With prefix arg N, cut this many sequential subtrees.
7447This is a short-hand for marking the subtree and then cutting it."
7448 (interactive "p")
7449 (org-copy-subtree n 'cut))
8c6fb58b 7450
b349f79f 7451(defun org-copy-subtree (&optional n cut force-store-markers)
20908596
CD
7452 "Cut the current subtree into the clipboard.
7453With prefix arg N, cut this many sequential subtrees.
7454This is a short-hand for marking the subtree and then copying it.
b349f79f
CD
7455If CUT is non-nil, actually cut the subtree.
7456If FORCE-STORE-MARKERS is non-nil, store the relative locations
7457of some markers in the region, even if CUT is non-nil. This is
7458useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
20908596
CD
7459 (interactive "p")
7460 (let (beg end folded (beg0 (point)))
3ab2c837 7461 (if (org-called-interactively-p 'any)
20908596
CD
7462 (org-back-to-heading nil) ; take what looks like a subtree
7463 (org-back-to-heading t)) ; take what is really there
7464 (org-back-over-empty-lines)
7465 (setq beg (point))
7466 (skip-chars-forward " \t\r\n")
7467 (save-match-data
7468 (save-excursion (outline-end-of-heading)
3ab2c837 7469 (setq folded (outline-invisible-p)))
20908596 7470 (condition-case nil
c8d0cf5c 7471 (org-forward-same-level (1- n) t)
20908596
CD
7472 (error nil))
7473 (org-end-of-subtree t t))
7474 (org-back-over-empty-lines)
7475 (setq end (point))
7476 (goto-char beg0)
7477 (when (> end beg)
7478 (setq org-subtree-clip-folded folded)
b349f79f
CD
7479 (when (or cut force-store-markers)
7480 (org-save-markers-in-region beg end))
20908596
CD
7481 (if cut (kill-region beg end) (copy-region-as-kill beg end))
7482 (setq org-subtree-clip (current-kill 0))
7483 (message "%s: Subtree(s) with %d characters"
7484 (if cut "Cut" "Copied")
7485 (length org-subtree-clip)))))
b0a10108 7486
93b62de8 7487(defun org-paste-subtree (&optional level tree for-yank)
20908596
CD
7488 "Paste the clipboard as a subtree, with modification of headline level.
7489The entire subtree is promoted or demoted in order to match a new headline
ce4fdcb9 7490level.
93b62de8
CD
7491
7492If the cursor is at the beginning of a headline, the same level as
7493that headline is used to paste the tree
7494
7495If not, the new level is derived from the *visible* headings
20908596
CD
7496before and after the insertion point, and taken to be the inferior headline
7497level of the two. So if the previous visible heading is level 3 and the
7498next is level 4 (or vice versa), level 4 will be used for insertion.
7499This makes sure that the subtree remains an independent subtree and does
7500not swallow low level entries.
03f3cf35 7501
20908596
CD
7502You can also force a different level, either by using a numeric prefix
7503argument, or by inserting the heading marker by hand. For example, if the
7504cursor is after \"*****\", then the tree will be shifted to level 5.
b0a10108 7505
93b62de8 7506If optional TREE is given, use this text instead of the kill ring.
b0a10108 7507
93b62de8
CD
7508When FOR-YANK is set, this is called by `org-yank'. In this case, do not
7509move back over whitespace before inserting, and move point to the end of
7510the inserted text when done."
20908596 7511 (interactive "P")
c8d0cf5c 7512 (setq tree (or tree (and kill-ring (current-kill 0))))
20908596
CD
7513 (unless (org-kill-is-subtree-p tree)
7514 (error "%s"
7515 (substitute-command-keys
7516 "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
3ab2c837
BG
7517 (org-with-limited-levels
7518 (let* ((visp (not (outline-invisible-p)))
7519 (txt tree)
85cb5d57 7520 (^re_ (concat "\\(\\*+\\)[ \t]*")) ;FIXME: Why `concat'?
3ab2c837
BG
7521 (old-level (if (string-match org-outline-regexp-bol txt)
7522 (- (match-end 0) (match-beginning 0) 1)
7523 -1))
7524 (force-level (cond (level (prefix-numeric-value level))
7525 ((and (looking-at "[ \t]*$")
7526 (string-match
7527 ^re_ (buffer-substring
7528 (point-at-bol) (point))))
7529 (- (match-end 1) (match-beginning 1)))
7530 ((and (bolp)
7531 (looking-at org-outline-regexp))
7532 (- (match-end 0) (point) 1))
7533 (t nil)))
7534 (previous-level (save-excursion
7535 (condition-case nil
7536 (progn
7537 (outline-previous-visible-heading 1)
85cb5d57 7538 (if (looking-at re) ;FIXME: What's `re'?
3ab2c837
BG
7539 (- (match-end 0) (match-beginning 0) 1)
7540 1))
7541 (error 1))))
7542 (next-level (save-excursion
7543 (condition-case nil
7544 (progn
7545 (or (looking-at org-outline-regexp)
7546 (outline-next-visible-heading 1))
85cb5d57 7547 (if (looking-at re) ;FIXME: What's `re'?
3ab2c837
BG
7548 (- (match-end 0) (match-beginning 0) 1)
7549 1))
7550 (error 1))))
7551 (new-level (or force-level (max previous-level next-level)))
7552 (shift (if (or (= old-level -1)
7553 (= new-level -1)
7554 (= old-level new-level))
7555 0
7556 (- new-level old-level)))
7557 (delta (if (> shift 0) -1 1))
7558 (func (if (> shift 0) 'org-demote 'org-promote))
7559 (org-odd-levels-only nil)
7560 beg end newend)
7561 ;; Remove the forced level indicator
7562 (if force-level
7563 (delete-region (point-at-bol) (point)))
7564 ;; Paste
7565 (beginning-of-line 1)
7566 (unless for-yank (org-back-over-empty-lines))
7567 (setq beg (point))
7568 (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
7569 (insert-before-markers txt)
7570 (unless (string-match "\n\\'" txt) (insert "\n"))
7571 (setq newend (point))
7572 (org-reinstall-markers-in-region beg)
7573 (setq end (point))
7574 (goto-char beg)
7575 (skip-chars-forward " \t\n\r")
7576 (setq beg (point))
7577 (if (and (outline-invisible-p) visp)
7578 (save-excursion (outline-show-heading)))
7579 ;; Shift if necessary
7580 (unless (= shift 0)
7581 (save-restriction
7582 (narrow-to-region beg end)
7583 (while (not (= shift 0))
7584 (org-map-region func (point-min) (point-max))
7585 (setq shift (+ delta shift)))
7586 (goto-char (point-min))
7587 (setq newend (point-max))))
7588 (when (or (org-called-interactively-p 'interactive) for-yank)
7589 (message "Clipboard pasted as level %d subtree" new-level))
7590 (if (and (not for-yank) ; in this case, org-yank will decide about folding
7591 kill-ring
7592 (eq org-subtree-clip (current-kill 0))
7593 org-subtree-clip-folded)
7594 ;; The tree was folded before it was killed/copied
7595 (hide-subtree))
7596 (and for-yank (goto-char newend)))))
4b3a9ba7 7597
20908596
CD
7598(defun org-kill-is-subtree-p (&optional txt)
7599 "Check if the current kill is an outline subtree, or a set of trees.
7600Returns nil if kill does not start with a headline, or if the first
7601headline level is not the largest headline level in the tree.
7602So this will actually accept several entries of equal levels as well,
7603which is OK for `org-paste-subtree'.
7604If optional TXT is given, check this string instead of the current kill."
7605 (let* ((kill (or txt (and kill-ring (current-kill 0)) ""))
3ab2c837
BG
7606 (re (org-get-limited-outline-regexp))
7607 (^re (concat "^" re))
20908596 7608 (start-level (and kill
3ab2c837
BG
7609 (string-match
7610 (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)")
7611 kill)
20908596 7612 (- (match-end 2) (match-beginning 2) 1)))
621f83e4 7613 (start (1+ (or (match-beginning 2) -1))))
20908596
CD
7614 (if (not start-level)
7615 (progn
7616 nil) ;; does not even start with a heading
7617 (catch 'exit
3ab2c837 7618 (while (setq start (string-match ^re kill (1+ start)))
20908596
CD
7619 (when (< (- (match-end 0) (match-beginning 0) 1) start-level)
7620 (throw 'exit nil)))
7621 t))))
8c6fb58b 7622
b349f79f
CD
7623(defvar org-markers-to-move nil
7624 "Markers that should be moved with a cut-and-paste operation.
7625Those markers are stored together with their positions relative to
7626the start of the region.")
7627
7628(defun org-save-markers-in-region (beg end)
7629 "Check markers in region.
7630If these markers are between BEG and END, record their position relative
7631to BEG, so that after moving the block of text, we can put the markers back
7632into place.
7633This function gets called just before an entry or tree gets cut from the
7634buffer. After re-insertion, `org-reinstall-markers-in-region' must be
7635called immediately, to move the markers with the entries."
7636 (setq org-markers-to-move nil)
7637 (when (featurep 'org-clock)
7638 (org-clock-save-markers-for-cut-and-paste beg end))
7639 (when (featurep 'org-agenda)
7640 (org-agenda-save-markers-for-cut-and-paste beg end)))
7641
7642(defun org-check-and-save-marker (marker beg end)
7643 "Check if MARKER is between BEG and END.
7644If yes, remember the marker and the distance to BEG."
7645 (when (and (marker-buffer marker)
7646 (equal (marker-buffer marker) (current-buffer)))
7647 (if (and (>= marker beg) (< marker end))
7648 (push (cons marker (- marker beg)) org-markers-to-move))))
7649
7650(defun org-reinstall-markers-in-region (beg)
7651 "Move all remembered markers to their position relative to BEG."
7652 (mapc (lambda (x)
7653 (move-marker (car x) (+ beg (cdr x))))
7654 org-markers-to-move)
7655 (setq org-markers-to-move nil))
7656
20908596
CD
7657(defun org-narrow-to-subtree ()
7658 "Narrow buffer to the current subtree."
7659 (interactive)
7660 (save-excursion
7661 (save-match-data
3ab2c837
BG
7662 (org-with-limited-levels
7663 (narrow-to-region
7664 (progn (org-back-to-heading t) (point))
7665 (progn (org-end-of-subtree t t)
7666 (if (and (org-on-heading-p) (not (eobp))) (backward-char 1))
7667 (point)))))))
7668
7669(defun org-narrow-to-block ()
7670 "Narrow buffer to the current block."
7671 (interactive)
7672 (let ((bstart "^[ \t]*#\\+begin")
7673 (bend "[ \t]*#\\+end")
7674 (case-fold-search t) ;; allow #+BEGIN
7675 b_start b_end)
7676 (if (org-in-regexps-block-p bstart bend)
7677 (progn
7678 (save-excursion (re-search-backward bstart nil t)
7679 (setq b_start (match-beginning 0)))
7680 (save-excursion (re-search-forward bend nil t)
7681 (setq b_end (match-end 0)))
7682 (narrow-to-region b_start b_end))
7683 (error "Not in a block"))))
8c6fb58b 7684
86fbb8ca
CD
7685(eval-when-compile
7686 (defvar org-property-drawer-re))
7687
acedf35c 7688(defvar org-property-start-re) ;; defined below
c8d0cf5c
CD
7689(defun org-clone-subtree-with-time-shift (n &optional shift)
7690 "Clone the task (subtree) at point N times.
7691The clones will be inserted as siblings.
7692
86fbb8ca
CD
7693In interactive use, the user will be prompted for the number of
7694clones to be produced, and for a time SHIFT, which may be a
7695repeater as used in time stamps, for example `+3d'.
c8d0cf5c 7696
86fbb8ca
CD
7697When a valid repeater is given and the entry contains any time
7698stamps, the clones will become a sequence in time, with time
7699stamps in the subtree shifted for each clone produced. If SHIFT
7700is nil or the empty string, time stamps will be left alone. The
7701ID property of the original subtree is removed.
c8d0cf5c
CD
7702
7703If the original subtree did contain time stamps with a repeater,
7704the following will happen:
7705- the repeater will be removed in each clone
7706- an additional clone will be produced, with the current, unshifted
7707 date(s) in the entry.
7708- the original entry will be placed *after* all the clones, with
7709 repeater intact.
7710- the start days in the repeater in the original entry will be shifted
7711 to past the last clone.
7712I this way you can spell out a number of instances of a repeating task,
7713and still retain the repeater to cover future instances of the task."
7714 (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ")
86fbb8ca 7715 (let (beg end template task idprop
c8d0cf5c
CD
7716 shift-n shift-what doshift nmin nmax (n-no-remove -1))
7717 (if (not (and (integerp n) (> n 0)))
7718 (error "Invalid number of replications %s" n))
7719 (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
7720 (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
7721 shift)))
7722 (error "Invalid shift specification %s" shift))
7723 (when doshift
7724 (setq shift-n (string-to-number (match-string 1 shift))
7725 shift-what (cdr (assoc (match-string 2 shift)
7726 '(("d" . day) ("w" . week)
7727 ("m" . month) ("y" . year))))))
7728 (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
7729 (setq nmin 1 nmax n)
7730 (org-back-to-heading t)
7731 (setq beg (point))
86fbb8ca 7732 (setq idprop (org-entry-get nil "ID"))
c8d0cf5c 7733 (org-end-of-subtree t t)
8bfe682a 7734 (or (bolp) (insert "\n"))
c8d0cf5c
CD
7735 (setq end (point))
7736 (setq template (buffer-substring beg end))
3ab2c837
BG
7737 ;; Remove clocks and empty drawers
7738 (with-temp-buffer
7739 (insert template)
7740 (goto-char (point-min))
7741 (while (re-search-forward
7742 "^[ \t]*CLOCK:.*$" (save-excursion (org-end-of-subtree t t)) t)
7743 (replace-match "")
7744 (kill-whole-line))
7745 (goto-char (point-min))
7746 (while (re-search-forward
7747 (concat "^[ \t]*:" (regexp-opt org-drawers) ":[ \t]*$") nil t)
7748 (mapc (lambda(d) (org-remove-empty-drawer-at d (point))) org-drawers))
7749 (setq template (buffer-substring (point-min) (point-max))))
c8d0cf5c
CD
7750 (when (and doshift
7751 (string-match "<[^<>\n]+ \\+[0-9]+[dwmy][^<>\n]*>" template))
7752 (delete-region beg end)
7753 (setq end beg)
7754 (setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
7755 (goto-char end)
7756 (loop for n from nmin to nmax do
86fbb8ca
CD
7757 ;; prepare clone
7758 (with-temp-buffer
7759 (insert template)
7760 (org-mode)
7761 (goto-char (point-min))
7762 (and idprop (if org-clone-delete-id
7763 (org-entry-delete nil "ID")
7764 (org-id-get-create t)))
acedf35c 7765 (while (re-search-forward org-property-start-re nil t)
86fbb8ca
CD
7766 (org-remove-empty-drawer-at "PROPERTIES" (point)))
7767 (goto-char (point-min))
7768 (when doshift
c8d0cf5c
CD
7769 (while (re-search-forward org-ts-regexp-both nil t)
7770 (org-timestamp-change (* n shift-n) shift-what))
7771 (unless (= n n-no-remove)
7772 (goto-char (point-min))
7773 (while (re-search-forward org-ts-regexp nil t)
7774 (save-excursion
7775 (goto-char (match-beginning 0))
7776 (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)")
86fbb8ca
CD
7777 (delete-region (match-beginning 1) (match-end 1)))))))
7778 (setq task (buffer-string)))
c8d0cf5c
CD
7779 (insert task))
7780 (goto-char beg)))
8c6fb58b 7781
20908596 7782;;; Outline Sorting
a0d892d4 7783
20908596 7784(defun org-sort (with-case)
afe98dfa 7785 "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
c8d0cf5c
CD
7786Optional argument WITH-CASE means sort case-sensitively.
7787With a double prefix argument, also remove duplicate entries."
20908596 7788 (interactive "P")
afe98dfa
CD
7789 (cond
7790 ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case))
7791 ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case))
7792 (t
7793 (org-call-with-arg 'org-sort-entries with-case))))
8c6fb58b 7794
20908596
CD
7795(defun org-sort-remove-invisible (s)
7796 (remove-text-properties 0 (length s) org-rm-props s)
7797 (while (string-match org-bracket-link-regexp s)
7798 (setq s (replace-match (if (match-end 2)
7799 (match-string 3 s)
7800 (match-string 1 s)) t t s)))
7801 s)
8c6fb58b 7802
20908596 7803(defvar org-priority-regexp) ; defined later in the file
8c6fb58b 7804
c8d0cf5c
CD
7805(defvar org-after-sorting-entries-or-items-hook nil
7806 "Hook that is run after a bunch of entries or items have been sorted.
7807When children are sorted, the cursor is in the parent line when this
7808hook gets called. When a region or a plain list is sorted, the cursor
7809will be in the first entry of the sorted region/list.")
7810
afe98dfa 7811(defun org-sort-entries
fdf730ed 7812 (&optional with-case sorting-type getkey-func compare-func property)
afe98dfa 7813 "Sort entries on a certain level of an outline tree.
20908596
CD
7814If there is an active region, the entries in the region are sorted.
7815Else, if the cursor is before the first entry, sort the top-level items.
7816Else, the children of the entry at point are sorted.
c8d0cf5c
CD
7817
7818Sorting can be alphabetically, numerically, by date/time as given by
7819a time stamp, by a property or by priority.
7820
7821The command prompts for the sorting type unless it has been given to the
86fbb8ca 7822function through the SORTING-TYPE argument, which needs to be a character,
c8d0cf5c
CD
7823\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the
7824precise meaning of each character:
7825
7826n Numerically, by converting the beginning of the entry/item to a number.
7827a Alphabetically, ignoring the TODO keyword and the priority, if any.
7828t By date/time, either the first active time stamp in the entry, or, if
7829 none exist, by the first inactive one.
c8d0cf5c
CD
7830s By the scheduled date/time.
7831d By deadline date/time.
7832c By creation time, which is assumed to be the first inactive time stamp
7833 at the beginning of a line.
7834p By priority according to the cookie.
7835r By the value of a property.
7836
7837Capital letters will reverse the sort order.
2a57416f 7838
20908596
CD
7839If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
7840called with point at the beginning of the record. It must return either
7841a string or a number that should serve as the sorting key for that record.
2a57416f 7842
20908596
CD
7843Comparing entries ignores case by default. However, with an optional argument
7844WITH-CASE, the sorting considers case as well."
8c6fb58b 7845 (interactive "P")
20908596
CD
7846 (let ((case-func (if with-case 'identity 'downcase))
7847 start beg end stars re re2
afe98dfa 7848 txt what tmp)
20908596
CD
7849 ;; Find beginning and end of region to sort
7850 (cond
7851 ((org-region-active-p)
7852 ;; we will sort the region
7853 (setq end (region-end)
7854 what "region")
7855 (goto-char (region-beginning))
7856 (if (not (org-on-heading-p)) (outline-next-heading))
7857 (setq start (point)))
20908596
CD
7858 ((or (org-on-heading-p)
7859 (condition-case nil (progn (org-back-to-heading) t) (error nil)))
7860 ;; we will sort the children of the current headline
7861 (org-back-to-heading)
7862 (setq start (point)
7863 end (progn (org-end-of-subtree t t)
5dec9555 7864 (or (bolp) (insert "\n"))
20908596
CD
7865 (org-back-over-empty-lines)
7866 (point))
7867 what "children")
7868 (goto-char start)
7869 (show-subtree)
7870 (outline-next-heading))
7871 (t
7872 ;; we will sort the top-level entries in this file
7873 (goto-char (point-min))
7874 (or (org-on-heading-p) (outline-next-heading))
5dec9555
CD
7875 (setq start (point))
7876 (goto-char (point-max))
7877 (beginning-of-line 1)
7878 (when (looking-at ".*?\\S-")
7879 ;; File ends in a non-white line
7880 (end-of-line 1)
7881 (insert "\n"))
7882 (setq end (point-max))
7883 (setq what "top-level")
20908596
CD
7884 (goto-char start)
7885 (show-all)))
2a57416f 7886
20908596
CD
7887 (setq beg (point))
7888 (if (>= beg end) (error "Nothing to sort"))
8c6fb58b 7889
afe98dfa
CD
7890 (looking-at "\\(\\*+\\)")
7891 (setq stars (match-string 1)
7892 re (concat "^" (regexp-quote stars) " +")
3ab2c837 7893 re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
afe98dfa
CD
7894 txt (buffer-substring beg end))
7895 (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
7896 (if (and (not (equal stars "*")) (string-match re2 txt))
7897 (error "Region to sort contains a level above the first entry"))
f425a6ea 7898
20908596
CD
7899 (unless sorting-type
7900 (message
afe98dfa 7901 "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
c8d0cf5c 7902 [t]ime [s]cheduled [d]eadline [c]reated
afe98dfa 7903 A/N/T/S/D/C/P/O/F means reversed:"
20908596
CD
7904 what)
7905 (setq sorting-type (read-char-exclusive))
3278a016 7906
20908596
CD
7907 (and (= (downcase sorting-type) ?f)
7908 (setq getkey-func
54a0dee5 7909 (org-icompleting-read "Sort using function: "
afe98dfa 7910 obarray 'fboundp t nil nil))
20908596 7911 (setq getkey-func (intern getkey-func)))
f425a6ea 7912
20908596
CD
7913 (and (= (downcase sorting-type) ?r)
7914 (setq property
54a0dee5 7915 (org-icompleting-read "Property: "
afe98dfa
CD
7916 (mapcar 'list (org-buffer-property-keys t))
7917 nil t))))
4ed31842 7918
20908596 7919 (message "Sorting entries...")
3278a016 7920
20908596
CD
7921 (save-restriction
7922 (narrow-to-region start end)
20908596 7923 (let ((dcst (downcase sorting-type))
c8d0cf5c 7924 (case-fold-search nil)
20908596
CD
7925 (now (current-time)))
7926 (sort-subr
7927 (/= dcst sorting-type)
7928 ;; This function moves to the beginning character of the "record" to
7929 ;; be sorted.
afe98dfa
CD
7930 (lambda nil
7931 (if (re-search-forward re nil t)
7932 (goto-char (match-beginning 0))
7933 (goto-char (point-max))))
20908596
CD
7934 ;; This function moves to the last character of the "record" being
7935 ;; sorted.
afe98dfa
CD
7936 (lambda nil
7937 (save-match-data
7938 (condition-case nil
7939 (outline-forward-same-level 1)
7940 (error
7941 (goto-char (point-max))))))
20908596 7942 ;; This function returns the value that gets sorted against.
afe98dfa
CD
7943 (lambda nil
7944 (cond
7945 ((= dcst ?n)
7946 (if (looking-at org-complex-heading-regexp)
7947 (string-to-number (match-string 4))
7948 nil))
7949 ((= dcst ?a)
7950 (if (looking-at org-complex-heading-regexp)
7951 (funcall case-func (match-string 4))
7952 nil))
7953 ((= dcst ?t)
7954 (let ((end (save-excursion (outline-next-heading) (point))))
7955 (if (or (re-search-forward org-ts-regexp end t)
7956 (re-search-forward org-ts-regexp-both end t))
7957 (org-time-string-to-seconds (match-string 0))
7958 (org-float-time now))))
7959 ((= dcst ?c)
7960 (let ((end (save-excursion (outline-next-heading) (point))))
7961 (if (re-search-forward
7962 (concat "^[ \t]*\\[" org-ts-regexp1 "\\]")
7963 end t)
7964 (org-time-string-to-seconds (match-string 0))
7965 (org-float-time now))))
7966 ((= dcst ?s)
7967 (let ((end (save-excursion (outline-next-heading) (point))))
7968 (if (re-search-forward org-scheduled-time-regexp end t)
7969 (org-time-string-to-seconds (match-string 1))
7970 (org-float-time now))))
7971 ((= dcst ?d)
7972 (let ((end (save-excursion (outline-next-heading) (point))))
7973 (if (re-search-forward org-deadline-time-regexp end t)
7974 (org-time-string-to-seconds (match-string 1))
7975 (org-float-time now))))
7976 ((= dcst ?p)
7977 (if (re-search-forward org-priority-regexp (point-at-eol) t)
7978 (string-to-char (match-string 2))
7979 org-default-priority))
7980 ((= dcst ?r)
7981 (or (org-entry-get nil property) ""))
7982 ((= dcst ?o)
7983 (if (looking-at org-complex-heading-regexp)
7984 (- 9999 (length (member (match-string 2)
7985 org-todo-keywords-1)))))
7986 ((= dcst ?f)
7987 (if getkey-func
7988 (progn
7989 (setq tmp (funcall getkey-func))
7990 (if (stringp tmp) (setq tmp (funcall case-func tmp)))
7991 tmp)
7992 (error "Invalid key function `%s'" getkey-func)))
7993 (t (error "Invalid sorting type `%c'" sorting-type))))
20908596
CD
7994 nil
7995 (cond
7996 ((= dcst ?a) 'string<)
fdf730ed 7997 ((= dcst ?f) compare-func)
c8d0cf5c 7998 ((member dcst '(?p ?t ?s ?d ?c)) '<)
20908596 7999 (t nil)))))
c8d0cf5c 8000 (run-hooks 'org-after-sorting-entries-or-items-hook)
20908596 8001 (message "Sorting entries...done")))
a96ee7df 8002
20908596
CD
8003(defun org-do-sort (table what &optional with-case sorting-type)
8004 "Sort TABLE of WHAT according to SORTING-TYPE.
8005The user will be prompted for the SORTING-TYPE if the call to this
8006function does not specify it. WHAT is only for the prompt, to indicate
8007what is being sorted. The sorting key will be extracted from
8008the car of the elements of the table.
8009If WITH-CASE is non-nil, the sorting will be case-sensitive."
8010 (unless sorting-type
8011 (message
8012 "Sort %s: [a]lphabetic. [n]umeric. [t]ime. A/N/T means reversed:"
8013 what)
8014 (setq sorting-type (read-char-exclusive)))
8015 (let ((dcst (downcase sorting-type))
8016 extractfun comparefun)
8017 ;; Define the appropriate functions
8018 (cond
8019 ((= dcst ?n)
8020 (setq extractfun 'string-to-number
8021 comparefun (if (= dcst sorting-type) '< '>)))
8022 ((= dcst ?a)
8023 (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x))
8024 (lambda(x) (downcase (org-sort-remove-invisible x))))
8025 comparefun (if (= dcst sorting-type)
8026 'string<
8027 (lambda (a b) (and (not (string< a b))
8028 (not (string= a b)))))))
8029 ((= dcst ?t)
8030 (setq extractfun
8031 (lambda (x)
c8d0cf5c
CD
8032 (if (or (string-match org-ts-regexp x)
8033 (string-match org-ts-regexp-both x))
54a0dee5 8034 (org-float-time
20908596
CD
8035 (org-time-string-to-time (match-string 0 x)))
8036 0))
8037 comparefun (if (= dcst sorting-type) '< '>)))
8038 (t (error "Invalid sorting type `%c'" sorting-type)))
a96ee7df 8039
20908596
CD
8040 (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
8041 table)
8042 (lambda (a b) (funcall comparefun (car a) (car b))))))
891f4676 8043
4b3a9ba7 8044
20908596 8045;;; The orgstruct minor mode
4b3a9ba7 8046
20908596
CD
8047;; Define a minor mode which can be used in other modes in order to
8048;; integrate the org-mode structure editing commands.
374585c9 8049
20908596
CD
8050;; This is really a hack, because the org-mode structure commands use
8051;; keys which normally belong to the major mode. Here is how it
8052;; works: The minor mode defines all the keys necessary to operate the
8053;; structure commands, but wraps the commands into a function which
8054;; tests if the cursor is currently at a headline or a plain list
8055;; item. If that is the case, the structure command is used,
8056;; temporarily setting many Org-mode variables like regular
8057;; expressions for filling etc. However, when any of those keys is
8058;; used at a different location, function uses `key-binding' to look
8059;; up if the key has an associated command in another currently active
8060;; keymap (minor modes, major mode, global), and executes that
8061;; command. There might be problems if any of the keys is otherwise
8062;; used as a prefix key.
4b3a9ba7 8063
20908596
CD
8064;; Another challenge is that the key binding for TAB can be tab or \C-i,
8065;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
8066;; addresses this by checking explicitly for both bindings.
2a94e282 8067
20908596
CD
8068(defvar orgstruct-mode-map (make-sparse-keymap)
8069 "Keymap for the minor `orgstruct-mode'.")
03f3cf35 8070
20908596 8071(defvar org-local-vars nil
86fbb8ca 8072 "List of local variables, for use by `orgstruct-mode'.")
03f3cf35 8073
20908596
CD
8074;;;###autoload
8075(define-minor-mode orgstruct-mode
86fbb8ca
CD
8076 "Toggle the minor mode `orgstruct-mode'.
8077This mode is for using Org-mode structure commands in other
8078modes. The following keys behave as if Org-mode were active, if
8079the cursor is on a headline, or on a plain list item (both as
8080defined by Org-mode).
03f3cf35 8081
20908596
CD
8082M-up Move entry/item up
8083M-down Move entry/item down
8084M-left Promote
8085M-right Demote
8086M-S-up Move entry/item up
8087M-S-down Move entry/item down
8088M-S-left Promote subtree
8089M-S-right Demote subtree
8090M-q Fill paragraph and items like in Org-mode
8091C-c ^ Sort entries
8092C-c - Cycle list bullet
8093TAB Cycle item visibility
8094M-RET Insert new heading/item
33306645 8095S-M-RET Insert new TODO heading / Checkbox item
20908596
CD
8096C-c C-c Set tags / toggle checkbox"
8097 nil " OrgStruct" nil
8098 (org-load-modules-maybe)
8099 (and (orgstruct-setup) (defun orgstruct-setup () nil)))
891f4676 8100
20908596
CD
8101;;;###autoload
8102(defun turn-on-orgstruct ()
8103 "Unconditionally turn on `orgstruct-mode'."
8104 (orgstruct-mode 1))
8105
c8d0cf5c
CD
8106(defun orgstruct++-mode (&optional arg)
8107 "Toggle `orgstruct-mode', the enhanced version of it.
8108In addition to setting orgstruct-mode, this also exports all indentation
8109and autofilling variables from org-mode into the buffer. It will also
8110recognize item context in multiline items.
8111Note that turning off orgstruct-mode will *not* remove the
8112indentation/paragraph settings. This can only be done by refreshing the
8113major mode, for example with \\[normal-mode]."
8114 (interactive "P")
8115 (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
8116 (if (< arg 1)
8117 (orgstruct-mode -1)
8118 (orgstruct-mode 1)
8119 (let (var val)
8120 (mapc
8121 (lambda (x)
8122 (when (string-match
8123 "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
8124 (symbol-name (car x)))
8125 (setq var (car x) val (nth 1 x))
8126 (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
8127 org-local-vars)
8128 (org-set-local 'orgstruct-is-++ t))))
8129
8130(defvar orgstruct-is-++ nil
86fbb8ca 8131 "Is `orgstruct-mode' in ++ version in the current-buffer?")
c8d0cf5c
CD
8132(make-variable-buffer-local 'orgstruct-is-++)
8133
20908596
CD
8134;;;###autoload
8135(defun turn-on-orgstruct++ ()
c8d0cf5c
CD
8136 "Unconditionally turn on `orgstruct++-mode'."
8137 (orgstruct++-mode 1))
20908596
CD
8138
8139(defun orgstruct-error ()
8140 "Error when there is no default binding for a structure key."
8141 (interactive)
8142 (error "This key has no function outside structure elements"))
891f4676 8143
20908596
CD
8144(defun orgstruct-setup ()
8145 "Setup orgstruct keymaps."
8146 (let ((nfunc 0)
8147 (bindings
8148 (list
8149 '([(meta up)] org-metaup)
8150 '([(meta down)] org-metadown)
8151 '([(meta left)] org-metaleft)
8152 '([(meta right)] org-metaright)
8153 '([(meta shift up)] org-shiftmetaup)
8154 '([(meta shift down)] org-shiftmetadown)
8155 '([(meta shift left)] org-shiftmetaleft)
8156 '([(meta shift right)] org-shiftmetaright)
c8d0cf5c
CD
8157 '([?\e (up)] org-metaup)
8158 '([?\e (down)] org-metadown)
8159 '([?\e (left)] org-metaleft)
8160 '([?\e (right)] org-metaright)
8161 '([?\e (shift up)] org-shiftmetaup)
8162 '([?\e (shift down)] org-shiftmetadown)
8163 '([?\e (shift left)] org-shiftmetaleft)
8164 '([?\e (shift right)] org-shiftmetaright)
20908596
CD
8165 '([(shift up)] org-shiftup)
8166 '([(shift down)] org-shiftdown)
ce4fdcb9
CD
8167 '([(shift left)] org-shiftleft)
8168 '([(shift right)] org-shiftright)
20908596
CD
8169 '("\C-c\C-c" org-ctrl-c-ctrl-c)
8170 '("\M-q" fill-paragraph)
8171 '("\C-c^" org-sort)
8172 '("\C-c-" org-cycle-list-bullet)))
8173 elt key fun cmd)
8174 (while (setq elt (pop bindings))
8175 (setq nfunc (1+ nfunc))
8176 (setq key (org-key (car elt))
8177 fun (nth 1 elt)
8178 cmd (orgstruct-make-binding fun nfunc key))
8179 (org-defkey orgstruct-mode-map key cmd))
891f4676 8180
20908596
CD
8181 ;; Special treatment needed for TAB and RET
8182 (org-defkey orgstruct-mode-map [(tab)]
8183 (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i"))
8184 (org-defkey orgstruct-mode-map "\C-i"
8185 (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)]))
6769c0dc 8186
20908596
CD
8187 (org-defkey orgstruct-mode-map "\M-\C-m"
8188 (orgstruct-make-binding 'org-insert-heading 105
8189 "\M-\C-m" [(meta return)]))
8190 (org-defkey orgstruct-mode-map [(meta return)]
8191 (orgstruct-make-binding 'org-insert-heading 106
8192 [(meta return)] "\M-\C-m"))
891f4676 8193
20908596
CD
8194 (org-defkey orgstruct-mode-map [(shift meta return)]
8195 (orgstruct-make-binding 'org-insert-todo-heading 107
8196 [(meta return)] "\M-\C-m"))
891f4676 8197
c8d0cf5c
CD
8198 (org-defkey orgstruct-mode-map "\e\C-m"
8199 (orgstruct-make-binding 'org-insert-heading 108
8200 "\e\C-m" [?\e (return)]))
8201 (org-defkey orgstruct-mode-map [?\e (return)]
8202 (orgstruct-make-binding 'org-insert-heading 109
8203 [?\e (return)] "\e\C-m"))
8204 (org-defkey orgstruct-mode-map [?\e (shift return)]
8205 (orgstruct-make-binding 'org-insert-todo-heading 110
8206 [?\e (return)] "\e\C-m"))
8207
20908596
CD
8208 (unless org-local-vars
8209 (setq org-local-vars (org-get-local-variables)))
891f4676 8210
20908596 8211 t))
891f4676 8212
20908596
CD
8213(defun orgstruct-make-binding (fun n &rest keys)
8214 "Create a function for binding in the structure minor mode.
8215FUN is the command to call inside a table. N is used to create a unique
8216command name. KEYS are keys that should be checked in for a command
8217to execute outside of tables."
8218 (eval
8219 (list 'defun
8220 (intern (concat "orgstruct-hijacker-command-" (int-to-string n)))
8221 '(arg)
8222 (concat "In Structure, run `" (symbol-name fun) "'.\n"
8223 "Outside of structure, run the binding of `"
8224 (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
8225 "'.")
8226 '(interactive "p")
8227 (list 'if
c8d0cf5c
CD
8228 `(org-context-p 'headline 'item
8229 (and orgstruct-is-++
8230 ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t)
8231 'item-body))
20908596
CD
8232 (list 'org-run-like-in-org-mode (list 'quote fun))
8233 (list 'let '(orgstruct-mode)
8234 (list 'call-interactively
8235 (append '(or)
8236 (mapcar (lambda (k)
8237 (list 'key-binding k))
8238 keys)
8239 '('orgstruct-error))))))))
64f72ae1 8240
20908596 8241(defun org-context-p (&rest contexts)
621f83e4 8242 "Check if local context is any of CONTEXTS.
20908596
CD
8243Possible values in the list of contexts are `table', `headline', and `item'."
8244 (let ((pos (point)))
8245 (goto-char (point-at-bol))
8246 (prog1 (or (and (memq 'table contexts)
8247 (looking-at "[ \t]*|"))
8248 (and (memq 'headline contexts)
3ab2c837 8249 (looking-at org-outline-regexp))
20908596 8250 (and (memq 'item contexts)
c8d0cf5c
CD
8251 (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))
8252 (and (memq 'item-body contexts)
8253 (org-in-item-p)))
20908596 8254 (goto-char pos))))
4b3a9ba7 8255
20908596
CD
8256(defun org-get-local-variables ()
8257 "Return a list of all local variables in an org-mode buffer."
8258 (let (varlist)
8259 (with-current-buffer (get-buffer-create "*Org tmp*")
8260 (erase-buffer)
8261 (org-mode)
8262 (setq varlist (buffer-local-variables)))
8263 (kill-buffer "*Org tmp*")
8264 (delq nil
8265 (mapcar
8266 (lambda (x)
8267 (setq x
8268 (if (symbolp x)
8269 (list x)
8270 (list (car x) (list 'quote (cdr x)))))
8271 (if (string-match
8272 "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)"
8273 (symbol-name (car x)))
8274 x nil))
8275 varlist))))
891f4676 8276
3ab2c837
BG
8277(defun org-clone-local-variables (from-buffer &optional regexp)
8278 "Clone local variables from FROM-BUFFER.
8279Optional argument REGEXP selects variables to clone."
8280 (mapc
8281 (lambda (pair)
8282 (and (symbolp (car pair))
8283 (or (null regexp)
8284 (string-match regexp (symbol-name (car pair))))
8285 (set (make-local-variable (car pair))
8286 (cdr pair))))
8287 (buffer-local-variables from-buffer)))
8288
20908596
CD
8289;;;###autoload
8290(defun org-run-like-in-org-mode (cmd)
c8d0cf5c
CD
8291 "Run a command, pretending that the current buffer is in Org-mode.
8292This will temporarily bind local variables that are typically bound in
8293Org-mode to the values they have in Org-mode, and then interactively
8294call CMD."
20908596
CD
8295 (org-load-modules-maybe)
8296 (unless org-local-vars
8297 (setq org-local-vars (org-get-local-variables)))
8298 (eval (list 'let org-local-vars
8299 (list 'call-interactively (list 'quote cmd)))))
891f4676 8300
20908596 8301;;;; Archiving
891f4676 8302
3ab2c837 8303(defun org-get-category (&optional pos force-refresh)
20908596 8304 "Get the category applying to position POS."
3ab2c837
BG
8305 (if force-refresh (org-refresh-category-properties))
8306 (let ((pos (or pos (point))))
8307 (or (get-text-property pos 'org-category)
8308 (progn (org-refresh-category-properties)
8309 (get-text-property pos 'org-category)))))
a96ee7df 8310
20908596
CD
8311(defun org-refresh-category-properties ()
8312 "Refresh category text properties in the buffer."
8313 (let ((def-cat (cond
8314 ((null org-category)
8315 (if buffer-file-name
8316 (file-name-sans-extension
8317 (file-name-nondirectory buffer-file-name))
8318 "???"))
8319 ((symbolp org-category) (symbol-name org-category))
8320 (t org-category)))
8321 beg end cat pos optionp)
8322 (org-unmodified
8323 (save-excursion
8324 (save-restriction
8325 (widen)
8326 (goto-char (point-min))
8327 (put-text-property (point) (point-max) 'org-category def-cat)
8328 (while (re-search-forward
8329 "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t)
8330 (setq pos (match-end 0)
8331 optionp (equal (char-after (match-beginning 0)) ?#)
8332 cat (org-trim (match-string 2)))
8333 (if optionp
8334 (setq beg (point-at-bol) end (point-max))
8335 (org-back-to-heading t)
8336 (setq beg (point) end (org-end-of-subtree t t)))
8337 (put-text-property beg end 'org-category cat)
8338 (goto-char pos)))))))
891f4676 8339
891f4676 8340
20908596 8341;;;; Link Stuff
03f3cf35 8342
20908596 8343;;; Link abbreviations
891f4676 8344
20908596
CD
8345(defun org-link-expand-abbrev (link)
8346 "Apply replacements as defined in `org-link-abbrev-alist."
3ab2c837 8347 (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link)
20908596
CD
8348 (let* ((key (match-string 1 link))
8349 (as (or (assoc key org-link-abbrev-alist-local)
8350 (assoc key org-link-abbrev-alist)))
8351 (tag (and (match-end 2) (match-string 3 link)))
8352 rpl)
8353 (if (not as)
8354 link
8355 (setq rpl (cdr as))
8356 (cond
8357 ((symbolp rpl) (funcall rpl tag))
8358 ((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
ce4fdcb9
CD
8359 ((string-match "%h" rpl)
8360 (replace-match (url-hexify-string (or tag "")) t t rpl))
20908596
CD
8361 (t (concat rpl tag)))))
8362 link))
4b3a9ba7 8363
20908596 8364;;; Storing and inserting links
0fee8d6e 8365
20908596
CD
8366(defvar org-insert-link-history nil
8367 "Minibuffer history for links inserted with `org-insert-link'.")
38f8646b 8368
20908596
CD
8369(defvar org-stored-links nil
8370 "Contains the links stored with `org-store-link'.")
38f8646b 8371
20908596
CD
8372(defvar org-store-link-plist nil
8373 "Plist with info about the most recently link created with `org-store-link'.")
fbe6c10d 8374
20908596
CD
8375(defvar org-link-protocols nil
8376 "Link protocols added to Org-mode using `org-add-link-type'.")
f425a6ea 8377
20908596
CD
8378(defvar org-store-link-functions nil
8379 "List of functions that are called to create and store a link.
8380Each function will be called in turn until one returns a non-nil
8381value. Each function should check if it is responsible for creating
8382this link (for example by looking at the major mode).
8383If not, it must exit and return nil.
8384If yes, it should return a non-nil value after a calling
8385`org-store-link-props' with a list of properties and values.
8386Special properties are:
30313b90 8387
86fbb8ca 8388:type The link prefix, like \"http\". This must be given.
20908596
CD
8389:link The link, like \"http://www.astro.uva.nl/~dominik\".
8390 This is obligatory as well.
8391:description Optional default description for the second pair
8392 of brackets in an Org-mode link. The user can still change
8393 this when inserting this link into an Org-mode buffer.
30313b90 8394
20908596
CD
8395In addition to these, any additional properties can be specified
8396and then used in remember templates.")
35402b98 8397
20908596
CD
8398(defun org-add-link-type (type &optional follow export)
8399 "Add TYPE to the list of `org-link-types'.
8400Re-compute all regular expressions depending on `org-link-types'
ab27a4a0 8401
20908596 8402FOLLOW and EXPORT are two functions.
891f4676 8403
20908596
CD
8404FOLLOW should take the link path as the single argument and do whatever
8405is necessary to follow the link, for example find a file or display
8406a mail message.
1e8fbb6d 8407
20908596
CD
8408EXPORT should format the link path for export to one of the export formats.
8409It should be a function accepting three arguments:
fbe6c10d 8410
20908596 8411 path the path of the link, the text after the prefix (like \"http:\")
3ab2c837
BG
8412 desc the description of the link, if any, or a description added by
8413 org-export-normalize-links if there is none
afe98dfa 8414 format the export format, a symbol like `html' or `latex' or `ascii'..
fbe6c10d 8415
20908596
CD
8416The function may use the FORMAT information to return different values
8417depending on the format. The return value will be put literally into
afe98dfa
CD
8418the exported file. If the return value is nil, this means Org should
8419do what it normally does with links which do not have EXPORT defined.
8420
20908596
CD
8421Org-mode has a built-in default for exporting links. If you are happy with
8422this default, there is no need to define an export function for the link
8423type. For a simple example of an export function, see `org-bbdb.el'."
8424 (add-to-list 'org-link-types type t)
8425 (org-make-link-regexps)
8426 (if (assoc type org-link-protocols)
8427 (setcdr (assoc type org-link-protocols) (list follow export))
8428 (push (list type follow export) org-link-protocols)))
374585c9 8429
8d642074
CD
8430(defvar org-agenda-buffer-name)
8431
20908596
CD
8432;;;###autoload
8433(defun org-store-link (arg)
8434 "\\<org-mode-map>Store an org-link to the current location.
8435This link is added to `org-stored-links' and can later be inserted
8436into an org-buffer with \\[org-insert-link].
8437
8438For some link types, a prefix arg is interpreted:
ce4fdcb9 8439For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
20908596
CD
8440For file links, arg negates `org-context-in-file-links'."
8441 (interactive "P")
8442 (org-load-modules-maybe)
8443 (setq org-store-link-plist nil) ; reset
3ab2c837
BG
8444 (org-with-limited-levels
8445 (let (link cpltxt desc description search txt custom-id agenda-link)
8446 (cond
8447
8448 ((run-hook-with-args-until-success 'org-store-link-functions)
8449 (setq link (plist-get org-store-link-plist :link)
8450 desc (or (plist-get org-store-link-plist :description) link)))
8451
8452 ((equal (buffer-name) "*Org Edit Src Example*")
8453 (let (label gc)
8454 (while (or (not label)
8455 (save-excursion
8456 (save-restriction
8457 (widen)
8458 (goto-char (point-min))
8459 (re-search-forward
8460 (regexp-quote (format org-coderef-label-format label))
8461 nil t))))
8462 (when label (message "Label exists already") (sit-for 2))
8463 (setq label (read-string "Code line label: " label)))
8464 (end-of-line 1)
8465 (setq link (format org-coderef-label-format label))
8466 (setq gc (- 79 (length link)))
8467 (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
8468 (insert link)
8469 (setq link (concat "(" label ")") desc nil)))
8470
8471 ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
8472 ;; We are in the agenda, link to referenced location
8473 (let ((m (or (get-text-property (point) 'org-hd-marker)
8474 (get-text-property (point) 'org-marker))))
8475 (when m
8476 (org-with-point-at m
8477 (setq agenda-link
8478 (if (org-called-interactively-p 'any)
8479 (call-interactively 'org-store-link)
8480 (org-store-link nil)))))))
8481
8482 ((eq major-mode 'calendar-mode)
8483 (let ((cd (calendar-cursor-to-date)))
8484 (setq link
8485 (format-time-string
8486 (car org-time-stamp-formats)
8487 (apply 'encode-time
8488 (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
8489 nil nil nil))))
8490 (org-store-link-props :type "calendar" :date cd)))
8491
8492 ((eq major-mode 'w3-mode)
8493 (setq cpltxt (if (and (buffer-name)
8494 (not (string-match "Untitled" (buffer-name))))
8495 (buffer-name)
8496 (url-view-url t))
8497 link (org-make-link (url-view-url t)))
8498 (org-store-link-props :type "w3" :url (url-view-url t)))
8499
8500 ((eq major-mode 'w3m-mode)
8501 (setq cpltxt (or w3m-current-title w3m-current-url)
8502 link (org-make-link w3m-current-url))
8503 (org-store-link-props :type "w3m" :url (url-view-url t)))
8504
8505 ((setq search (run-hook-with-args-until-success
8506 'org-create-file-search-functions))
8507 (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
8508 "::" search))
8509 (setq cpltxt (or description link)))
8510
8511 ((eq major-mode 'image-mode)
8512 (setq cpltxt (concat "file:"
8513 (abbreviate-file-name buffer-file-name))
8514 link (org-make-link cpltxt))
8515 (org-store-link-props :type "image" :file buffer-file-name))
8516
8517 ((eq major-mode 'dired-mode)
8518 ;; link to the file in the current line
8519 (let ((file (dired-get-filename nil t)))
8520 (setq file (if file
8521 (abbreviate-file-name
8522 (expand-file-name (dired-get-filename nil t)))
8523 ;; otherwise, no file so use current directory.
8524 default-directory))
8525 (setq cpltxt (concat "file:" file)
8526 link (org-make-link cpltxt))))
8527
8528 ((and (buffer-file-name (buffer-base-buffer)) (org-mode-p))
8529 (setq custom-id (org-entry-get nil "CUSTOM_ID"))
8530 (cond
8531 ((org-in-regexp "<<\\(.*?\\)>>")
8532 (setq cpltxt
8533 (concat "file:"
8534 (abbreviate-file-name
8535 (buffer-file-name (buffer-base-buffer)))
8536 "::" (match-string 1))
8537 link (org-make-link cpltxt)))
8538 ((and (featurep 'org-id)
8539 (or (eq org-link-to-org-use-id t)
8540 (and (eq org-link-to-org-use-id 'create-if-interactive)
8541 (org-called-interactively-p 'any))
8542 (and (eq org-link-to-org-use-id
8543 'create-if-interactive-and-no-custom-id)
8544 (org-called-interactively-p 'any)
8545 (not custom-id))
8546 (and org-link-to-org-use-id
8547 (org-entry-get nil "ID"))))
8548 ;; We can make a link using the ID.
8549 (setq link (condition-case nil
8550 (prog1 (org-id-store-link)
8551 (setq desc (plist-get org-store-link-plist
8552 :description)))
8553 (error
8554 ;; probably before first headline, link to file only
8555 (concat "file:"
8556 (abbreviate-file-name
8557 (buffer-file-name (buffer-base-buffer))))))))
8558 (t
8559 ;; Just link to current headline
8560 (setq cpltxt (concat "file:"
afe98dfa 8561 (abbreviate-file-name
3ab2c837
BG
8562 (buffer-file-name (buffer-base-buffer)))))
8563 ;; Add a context search string
8564 (when (org-xor org-context-in-file-links arg)
8565 (setq txt (cond
8566 ((org-on-heading-p) nil)
8567 ((org-region-active-p)
8568 (buffer-substring (region-beginning) (region-end)))
8569 (t nil)))
8570 (when (or (null txt) (string-match "\\S-" txt))
8571 (setq cpltxt
8572 (concat cpltxt "::"
8573 (condition-case nil
8574 (org-make-org-heading-search-string txt)
8575 (error "")))
8576 desc (or (nth 4 (ignore-errors
8577 (org-heading-components))) "NONE"))))
8578 (if (string-match "::\\'" cpltxt)
8579 (setq cpltxt (substring cpltxt 0 -2)))
8580 (setq link (org-make-link cpltxt)))))
8581
8582 ((buffer-file-name (buffer-base-buffer))
8583 ;; Just link to this file here.
8584 (setq cpltxt (concat "file:"
8585 (abbreviate-file-name
8586 (buffer-file-name (buffer-base-buffer)))))
8587 ;; Add a context string
8588 (when (org-xor org-context-in-file-links arg)
8589 (setq txt (if (org-region-active-p)
8590 (buffer-substring (region-beginning) (region-end))
8591 (buffer-substring (point-at-bol) (point-at-eol))))
8592 ;; Only use search option if there is some text.
8593 (when (string-match "\\S-" txt)
8594 (setq cpltxt
8595 (concat cpltxt "::" (org-make-org-heading-search-string txt))
8596 desc "NONE")))
8597 (setq link (org-make-link cpltxt)))
8598
8599 ((org-called-interactively-p 'interactive)
8600 (error "Cannot link to a buffer which is not visiting a file"))
8601
8602 (t (setq link nil)))
8603
8604 (if (consp link) (setq cpltxt (car link) link (cdr link)))
8605 (setq link (or link cpltxt)
8606 desc (or desc cpltxt))
8607 (if (equal desc "NONE") (setq desc nil))
8608
8609 (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
8610 (progn
8611 (setq org-stored-links
8612 (cons (list link desc) org-stored-links))
8613 (message "Stored: %s" (or desc link))
8614 (when custom-id
8615 (setq link (concat "file:" (abbreviate-file-name (buffer-file-name))
8616 "::#" custom-id))
8617 (setq org-stored-links
8618 (cons (list link desc) org-stored-links))))
8619 (or agenda-link (and link (org-make-link-string link desc)))))))
20908596
CD
8620
8621(defun org-store-link-props (&rest plist)
8622 "Store link properties, extract names and addresses."
8623 (let (x adr)
8624 (when (setq x (plist-get plist :from))
8625 (setq adr (mail-extract-address-components x))
93b62de8
CD
8626 (setq plist (plist-put plist :fromname (car adr)))
8627 (setq plist (plist-put plist :fromaddress (nth 1 adr))))
20908596
CD
8628 (when (setq x (plist-get plist :to))
8629 (setq adr (mail-extract-address-components x))
93b62de8
CD
8630 (setq plist (plist-put plist :toname (car adr)))
8631 (setq plist (plist-put plist :toaddress (nth 1 adr)))))
20908596
CD
8632 (let ((from (plist-get plist :from))
8633 (to (plist-get plist :to)))
8634 (when (and from to org-from-is-user-regexp)
93b62de8
CD
8635 (setq plist
8636 (plist-put plist :fromto
8637 (if (string-match org-from-is-user-regexp from)
8638 (concat "to %t")
8639 (concat "from %f"))))))
20908596
CD
8640 (setq org-store-link-plist plist))
8641
8642(defun org-add-link-props (&rest plist)
8643 "Add these properties to the link property list."
8644 (let (key value)
8645 (while plist
8646 (setq key (pop plist) value (pop plist))
8647 (setq org-store-link-plist
8648 (plist-put org-store-link-plist key value)))))
8649
8650(defun org-email-link-description (&optional fmt)
8651 "Return the description part of an email link.
8652This takes information from `org-store-link-plist' and formats it
8653according to FMT (default from `org-email-link-description-format')."
8654 (setq fmt (or fmt org-email-link-description-format))
8655 (let* ((p org-store-link-plist)
8656 (to (plist-get p :toaddress))
8657 (from (plist-get p :fromaddress))
8658 (table
8659 (list
8660 (cons "%c" (plist-get p :fromto))
8661 (cons "%F" (plist-get p :from))
8662 (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?"))
8663 (cons "%T" (plist-get p :to))
8664 (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?"))
8665 (cons "%s" (plist-get p :subject))
3ab2c837 8666 (cons "%d" (plist-get p :date))
20908596
CD
8667 (cons "%m" (plist-get p :message-id)))))
8668 (when (string-match "%c" fmt)
8669 ;; Check if the user wrote this message
8670 (if (and org-from-is-user-regexp from to
8671 (save-match-data (string-match org-from-is-user-regexp from)))
8672 (setq fmt (replace-match "to %t" t t fmt))
8673 (setq fmt (replace-match "from %f" t t fmt))))
8674 (org-replace-escapes fmt table)))
8675
8676(defun org-make-org-heading-search-string (&optional string heading)
8677 "Make search string for STRING or current headline."
8678 (interactive)
acedf35c
CD
8679 (let ((s (or string (org-get-heading)))
8680 (lines org-context-in-file-links))
20908596
CD
8681 (unless (and string (not heading))
8682 ;; We are using a headline, clean up garbage in there.
8683 (if (string-match org-todo-regexp s)
8684 (setq s (replace-match "" t t s)))
afe98dfa 8685 (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s)
20908596
CD
8686 (setq s (replace-match "" t t s)))
8687 (setq s (org-trim s))
8688 (if (string-match (concat "^\\(" org-quote-string "\\|"
8689 org-comment-string "\\)") s)
8690 (setq s (replace-match "" t t s)))
8691 (while (string-match org-ts-regexp s)
8692 (setq s (replace-match "" t t s))))
20908596 8693 (or string (setq s (concat "*" s))) ; Add * for headlines
acedf35c
CD
8694 (when (and string (integerp lines) (> lines 0))
8695 (let ((slines (org-split-string s "\n")))
8696 (when (< lines (length slines))
01c35094 8697 (setq s (mapconcat
acedf35c 8698 'identity
01c35094 8699 (reverse (nthcdr (- (length slines) lines)
acedf35c 8700 (reverse slines))) "\n")))))
20908596 8701 (mapconcat 'identity (org-split-string s "[ \t]+") " ")))
891f4676 8702
20908596
CD
8703(defun org-make-link (&rest strings)
8704 "Concatenate STRINGS."
8705 (apply 'concat strings))
ab27a4a0 8706
20908596
CD
8707(defun org-make-link-string (link &optional description)
8708 "Make a link with brackets, consisting of LINK and DESCRIPTION."
8709 (unless (string-match "\\S-" link)
8710 (error "Empty link"))
5dec9555
CD
8711 (when (and description
8712 (stringp description)
8713 (not (string-match "\\S-" description)))
8714 (setq description nil))
20908596
CD
8715 (when (stringp description)
8716 ;; Remove brackets from the description, they are fatal.
8717 (while (string-match "\\[" description)
8718 (setq description (replace-match "{" t t description)))
8719 (while (string-match "\\]" description)
8720 (setq description (replace-match "}" t t description))))
3ab2c837 8721 (when (equal link description)
20908596
CD
8722 ;; No description needed, it is identical
8723 (setq description nil))
8724 (when (and (not description)
3ab2c837 8725 (not (string-match (org-image-file-name-regexp) link))
20908596 8726 (not (equal link (org-link-escape link))))
2c3ad40d 8727 (setq description (org-extract-attributes link)))
3ab2c837
BG
8728 (setq link
8729 (cond ((string-match (org-image-file-name-regexp) link) link)
8730 ((string-match org-link-types-re link)
8731 (concat (match-string 1 link)
8732 (org-link-escape (substring link (match-end 1)))))
8733 (t (org-link-escape link))))
afe98dfa 8734 (concat "[[" link "]"
20908596
CD
8735 (if description (concat "[" description "]") "")
8736 "]"))
8737
8738(defconst org-link-escape-chars
3ab2c837
BG
8739 '(?\ ?\[ ?\] ?\; ?\= ?\+)
8740 "List of characters that should be escaped in link.
20908596
CD
8741This is the list that is used for internal purposes.")
8742
c8d0cf5c
CD
8743(defvar org-url-encoding-use-url-hexify nil)
8744
20908596 8745(defconst org-link-escape-chars-browser
3ab2c837
BG
8746 '(?\ )
8747 "List of escapes for characters that are problematic in links.
20908596
CD
8748This is the list that is used before handing over to the browser.")
8749
3ab2c837
BG
8750(defun org-link-escape (text &optional table merge)
8751 "Return percent escaped representation of TEXT.
8752TEXT is a string with the text to escape.
8753Optional argument TABLE is a list with characters that should be
8754escaped. When nil, `org-link-escape-chars' is used.
8755If optional argument MERGE is set, merge TABLE into
8756`org-link-escape-chars'."
ed21c5c8 8757 (if (and org-url-encoding-use-url-hexify (not table))
c8d0cf5c 8758 (url-hexify-string text)
3ab2c837
BG
8759 (cond
8760 ((and table merge)
8761 (mapc (lambda (defchr)
8762 (unless (member defchr table)
8763 (setq table (cons defchr table)))) org-link-escape-chars))
8764 ((null table)
8765 (setq table org-link-escape-chars)))
8766 (mapconcat
8767 (lambda (char)
8768 (if (or (member char table)
8769 (< char 32) (= char 37) (> char 126))
8770 (mapconcat (lambda (sequence-element)
8771 (format "%%%.2X" sequence-element))
8772 (or (encode-coding-char char 'utf-8)
8773 (error "Unable to percent escape character: %s"
8774 (char-to-string char))) "")
8775 (char-to-string char))) text "")))
8776
8777(defun org-link-unescape (str)
fe7a3057
JB
8778 "Unhex hexified Unicode strings as returned from the JavaScript function
8779encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'."
3ab2c837
BG
8780 (unless (and (null str) (string= "" str))
8781 (let ((pos 0) (case-fold-search t) unhexed)
8782 (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos))
8783 (setq unhexed (org-link-unescape-compound (match-string 0 str)))
8784 (setq str (replace-match unhexed t t str))
8785 (setq pos (+ pos (length unhexed))))))
8786 str)
8787
8788(defun org-link-unescape-compound (hex)
fe7a3057 8789 "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'.
3ab2c837
BG
8790Note: this function also decodes single byte encodings like
8791`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group."
8792 (save-match-data
8793 (let* ((bytes (cdr (split-string hex "%")))
8794 (ret "")
8795 (eat 0)
8796 (sum 0))
8797 (while bytes
8798 (let* ((val (string-to-number (pop bytes) 16))
8799 (shift-xor
8800 (if (= 0 eat)
8801 (cond
8802 ((>= val 252) (cons 6 252))
8803 ((>= val 248) (cons 5 248))
8804 ((>= val 240) (cons 4 240))
8805 ((>= val 224) (cons 3 224))
8806 ((>= val 192) (cons 2 192))
8807 (t (cons 0 0)))
8808 (cons 6 128))))
8809 (if (>= val 192) (setq eat (car shift-xor)))
8810 (setq val (logxor val (cdr shift-xor)))
8811 (setq sum (+ (lsh sum (car shift-xor)) val))
8812 (if (> eat 0) (setq eat (- eat 1)))
8813 (cond
8814 ((= 0 eat) ;multi byte
8815 (setq ret (concat ret (org-char-to-string sum)))
8816 (setq sum 0))
8817 ((not bytes) ; single byte(s)
8818 (setq ret (org-link-unescape-single-byte-sequence hex))))
8819 )) ;; end (while bytes
8820 ret )))
8821
8822(defun org-link-unescape-single-byte-sequence (hex)
8823 "Unhexify hex-encoded single byte character sequences."
8824 (mapconcat (lambda (byte)
8825 (char-to-string (string-to-number byte 16)))
8826 (cdr (split-string hex "%")) ""))
20908596
CD
8827
8828(defun org-xor (a b)
8829 "Exclusive or."
8830 (if a (not b) b))
8831
20908596
CD
8832(defun org-fixup-message-id-for-http (s)
8833 "Replace special characters in a message id, so it can be used in an http query."
86fbb8ca
CD
8834 (when (string-match "%" s)
8835 (setq s (mapconcat (lambda (c)
8836 (if (eq c ?%)
8837 "%25"
8838 (char-to-string c)))
8839 s "")))
20908596
CD
8840 (while (string-match "<" s)
8841 (setq s (replace-match "%3C" t t s)))
8842 (while (string-match ">" s)
8843 (setq s (replace-match "%3E" t t s)))
8844 (while (string-match "@" s)
8845 (setq s (replace-match "%40" t t s)))
8846 s)
8847
8848;;;###autoload
8849(defun org-insert-link-global ()
8850 "Insert a link like Org-mode does.
8851This command can be called in any mode to insert a link in Org-mode syntax."
8852 (interactive)
8853 (org-load-modules-maybe)
8854 (org-run-like-in-org-mode 'org-insert-link))
8855
8856(defun org-insert-link (&optional complete-file link-location)
8857 "Insert a link. At the prompt, enter the link.
8858
93b62de8
CD
8859Completion can be used to insert any of the link protocol prefixes like
8860http or ftp in use.
8861
8862The history can be used to select a link previously stored with
20908596
CD
8863`org-store-link'. When the empty string is entered (i.e. if you just
8864press RET at the prompt), the link defaults to the most recently
8865stored link. As SPC triggers completion in the minibuffer, you need to
8866use M-SPC or C-q SPC to force the insertion of a space character.
8867
8868You will also be prompted for a description, and if one is given, it will
8869be displayed in the buffer instead of the link.
8870
8871If there is already a link at point, this command will allow you to edit link
8872and description parts.
8873
3ab2c837
BG
8874With a \\[universal-argument] prefix, prompts for a file to link to. The file name can
8875be selected using completion. The path to the file will be relative to the
20908596
CD
8876current directory if the file is in the current directory or a subdirectory.
8877Otherwise, the link will be the absolute path as completed in the minibuffer
93b62de8
CD
8878\(i.e. normally ~/path/to/file). You can configure this behavior using the
8879option `org-link-file-path-type'.
20908596
CD
8880
8881With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in
93b62de8
CD
8882the current directory or below.
8883
8884With three \\[universal-argument] prefixes, negate the meaning of
8885`org-keep-stored-link-after-insertion'.
20908596
CD
8886
8887If `org-make-link-description-function' is non-nil, this function will be
8888called with the link target, and the result will be the default
8889link description.
8890
8891If the LINK-LOCATION parameter is non-nil, this value will be
8892used as the link location instead of reading one interactively."
8893 (interactive "P")
8894 (let* ((wcf (current-window-configuration))
8895 (region (if (org-region-active-p)
8896 (buffer-substring (region-beginning) (region-end))))
8897 (remove (and region (list (region-beginning) (region-end))))
8898 (desc region)
8899 tmphist ; byte-compile incorrectly complains about this
8900 (link link-location)
c8d0cf5c 8901 entry file all-prefixes)
20908596
CD
8902 (cond
8903 (link-location) ; specified by arg, just use it.
8904 ((org-in-regexp org-bracket-link-regexp 1)
8905 ;; We do have a link at point, and we are going to edit it.
8906 (setq remove (list (match-beginning 0) (match-end 0)))
8907 (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
8908 (setq link (read-string "Link: "
8909 (org-link-unescape
8910 (org-match-string-no-properties 1)))))
8911 ((or (org-in-regexp org-angle-link-re)
8912 (org-in-regexp org-plain-link-re))
8913 ;; Convert to bracket link
8914 (setq remove (list (match-beginning 0) (match-end 0))
8915 link (read-string "Link: "
8916 (org-remove-angle-brackets (match-string 0)))))
93b62de8 8917 ((member complete-file '((4) (16)))
20908596 8918 ;; Completing read for file names.
c8d0cf5c 8919 (setq link (org-file-complete-link complete-file)))
20908596
CD
8920 (t
8921 ;; Read link, with completion for stored links.
8922 (with-output-to-temp-buffer "*Org Links*"
c8d0cf5c
CD
8923 (princ "Insert a link.
8924Use TAB to complete link prefixes, then RET for type-specific completion support\n")
20908596
CD
8925 (when org-stored-links
8926 (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n")
8927 (princ (mapconcat
8928 (lambda (x)
8929 (if (nth 1 x) (concat (car x) " (" (nth 1 x) ")") (car x)))
8930 (reverse org-stored-links) "\n"))))
8931 (let ((cw (selected-window)))
ed21c5c8 8932 (select-window (get-buffer-window "*Org Links*" 'visible))
3ab2c837 8933 (with-current-buffer "*Org Links*" (setq truncate-lines) t)
c8d0cf5c
CD
8934 (unless (pos-visible-in-window-p (point-max))
8935 (org-fit-window-to-buffer))
8936 (and (window-live-p cw) (select-window cw)))
20908596
CD
8937 ;; Fake a link history, containing the stored links.
8938 (setq tmphist (append (mapcar 'car org-stored-links)
8939 org-insert-link-history))
c8d0cf5c
CD
8940 (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local)
8941 (mapcar 'car org-link-abbrev-alist)
8942 org-link-types))
20908596 8943 (unwind-protect
c8d0cf5c
CD
8944 (progn
8945 (setq link
54a0dee5
CD
8946 (let ((org-completion-use-ido nil)
8947 (org-completion-use-iswitchb nil))
c8d0cf5c
CD
8948 (org-completing-read
8949 "Link: "
8950 (append
8951 (mapcar (lambda (x) (list (concat x ":")))
8952 all-prefixes)
8953 (mapcar 'car org-stored-links))
8954 nil nil nil
8955 'tmphist
8956 (car (car org-stored-links)))))
ed21c5c8
CD
8957 (if (not (string-match "\\S-" link))
8958 (error "No link selected"))
c8d0cf5c
CD
8959 (if (or (member link all-prefixes)
8960 (and (equal ":" (substring link -1))
8961 (member (substring link 0 -1) all-prefixes)
8962 (setq link (substring link 0 -1))))
8963 (setq link (org-link-try-special-completion link))))
20908596
CD
8964 (set-window-configuration wcf)
8965 (kill-buffer "*Org Links*"))
8966 (setq entry (assoc link org-stored-links))
8967 (or entry (push link org-insert-link-history))
8968 (if (funcall (if (equal complete-file '(64)) 'not 'identity)
8969 (not org-keep-stored-link-after-insertion))
8970 (setq org-stored-links (delq (assoc link org-stored-links)
8971 org-stored-links)))
8972 (setq desc (or desc (nth 1 entry)))))
8973
8974 (if (string-match org-plain-link-re link)
8975 ;; URL-like link, normalize the use of angular brackets.
8976 (setq link (org-make-link (org-remove-angle-brackets link))))
891f4676 8977
20908596
CD
8978 ;; Check if we are linking to the current file with a search option
8979 ;; If yes, simplify the link by using only the search option.
8980 (when (and buffer-file-name
ce4fdcb9 8981 (string-match "^file:\\(.+?\\)::\\([^>]+\\)" link))
20908596
CD
8982 (let* ((path (match-string 1 link))
8983 (case-fold-search nil)
8984 (search (match-string 2 link)))
8985 (save-match-data
8986 (if (equal (file-truename buffer-file-name) (file-truename path))
8987 ;; We are linking to this same file, with a search option
8988 (setq link search)))))
38f8646b 8989
20908596 8990 ;; Check if we can/should use a relative path. If yes, simplify the link
ed21c5c8
CD
8991 (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
8992 (let* ((type (match-string 1 link))
8993 (path (match-string 2 link))
20908596
CD
8994 (origpath path)
8995 (case-fold-search nil))
8996 (cond
93b62de8
CD
8997 ((or (eq org-link-file-path-type 'absolute)
8998 (equal complete-file '(16)))
20908596
CD
8999 (setq path (abbreviate-file-name (expand-file-name path))))
9000 ((eq org-link-file-path-type 'noabbrev)
9001 (setq path (expand-file-name path)))
9002 ((eq org-link-file-path-type 'relative)
9003 (setq path (file-relative-name path)))
9004 (t
9005 (save-match-data
9006 (if (string-match (concat "^" (regexp-quote
86fbb8ca
CD
9007 (expand-file-name
9008 (file-name-as-directory
9009 default-directory))))
20908596
CD
9010 (expand-file-name path))
9011 ;; We are linking a file with relative path name.
9012 (setq path (substring (expand-file-name path)
93b62de8
CD
9013 (match-end 0)))
9014 (setq path (abbreviate-file-name (expand-file-name path)))))))
ed21c5c8 9015 (setq link (concat type path))
20908596
CD
9016 (if (equal desc origpath)
9017 (setq desc path))))
38f8646b 9018
20908596
CD
9019 (if org-make-link-description-function
9020 (setq desc (funcall org-make-link-description-function link desc)))
38f8646b 9021
20908596
CD
9022 (setq desc (read-string "Description: " desc))
9023 (unless (string-match "\\S-" desc) (setq desc nil))
9024 (if remove (apply 'delete-region remove))
9025 (insert (org-make-link-string link desc))))
38f8646b 9026
c8d0cf5c
CD
9027(defun org-link-try-special-completion (type)
9028 "If there is completion support for link type TYPE, offer it."
9029 (let ((fun (intern (concat "org-" type "-complete-link"))))
9030 (if (functionp fun)
9031 (funcall fun)
9032 (read-string "Link (no completion support): " (concat type ":")))))
9033
9034(defun org-file-complete-link (&optional arg)
9035 "Create a file link using completion."
9036 (let (file link)
9037 (setq file (read-file-name "File: "))
9038 (let ((pwd (file-name-as-directory (expand-file-name ".")))
9039 (pwd1 (file-name-as-directory (abbreviate-file-name
86fbb8ca 9040 (expand-file-name ".")))))
c8d0cf5c
CD
9041 (cond
9042 ((equal arg '(16))
9043 (setq link (org-make-link
9044 "file:"
9045 (abbreviate-file-name (expand-file-name file)))))
9046 ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
9047 (setq link (org-make-link "file:" (match-string 1 file))))
9048 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
9049 (expand-file-name file))
9050 (setq link (org-make-link
9051 "file:" (match-string 1 (expand-file-name file)))))
9052 (t (setq link (org-make-link "file:" file)))))
9053 link))
9054
20908596 9055(defun org-completing-read (&rest args)
93b62de8 9056 "Completing-read with SPACE being a normal character."
20908596
CD
9057 (let ((minibuffer-local-completion-map
9058 (copy-keymap minibuffer-local-completion-map)))
9059 (org-defkey minibuffer-local-completion-map " " 'self-insert-command)
0bd48b37 9060 (org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
54a0dee5 9061 (apply 'org-icompleting-read args)))
ce4fdcb9 9062
54a0dee5
CD
9063(defun org-completing-read-no-i (&rest args)
9064 (let (org-completion-use-ido org-completion-use-iswitchb)
9148fdd0
CD
9065 (apply 'org-completing-read args)))
9066
54a0dee5
CD
9067(defun org-iswitchb-completing-read (prompt choices &rest args)
9068 "Use iswitch as a completing-read replacement to choose from choices.
9069PROMPT is a string to prompt with. CHOICES is a list of strings to choose
9070from."
8d642074
CD
9071 (let* ((iswitchb-use-virtual-buffers nil)
9072 (iswitchb-make-buflist-hook
9073 (lambda ()
9074 (setq iswitchb-temp-buflist choices))))
54a0dee5
CD
9075 (iswitchb-read-buffer prompt)))
9076
9077(defun org-icompleting-read (&rest args)
8bfe682a
CD
9078 "Completing-read using `ido-mode' or `iswitchb' speedups if available."
9079 (org-without-partial-completion
9080 (if (and org-completion-use-ido
9081 (fboundp 'ido-completing-read)
9082 (boundp 'ido-mode) ido-mode
9083 (listp (second args)))
9084 (let ((ido-enter-matching-directory nil))
9085 (apply 'ido-completing-read (concat (car args))
9086 (if (consp (car (nth 1 args)))
3ab2c837 9087 (mapcar 'car (nth 1 args))
8bfe682a
CD
9088 (nth 1 args))
9089 (cddr args)))
9090 (if (and org-completion-use-iswitchb
9091 (boundp 'iswitchb-mode) iswitchb-mode
9092 (listp (second args)))
9093 (apply 'org-iswitchb-completing-read (concat (car args))
9094 (if (consp (car (nth 1 args)))
3ab2c837 9095 (mapcar 'car (nth 1 args))
8bfe682a
CD
9096 (nth 1 args))
9097 (cddr args))
9098 (apply 'completing-read args)))))
38f8646b 9099
2c3ad40d
CD
9100(defun org-extract-attributes (s)
9101 "Extract the attributes cookie from a string and set as text property."
621f83e4 9102 (let (a attr (start 0) key value)
2c3ad40d
CD
9103 (save-match-data
9104 (when (string-match "{{\\([^}]+\\)}}$" s)
9105 (setq a (match-string 1 s) s (substring s 0 (match-beginning 0)))
9106 (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start)
9107 (setq key (match-string 1 a) value (match-string 2 a)
9108 start (match-end 0)
9109 attr (plist-put attr (intern key) value))))
db55f368 9110 (org-add-props s nil 'org-attr attr))
2c3ad40d
CD
9111 s))
9112
c8d0cf5c
CD
9113(defun org-extract-attributes-from-string (tag)
9114 (let (key value attr)
9115 (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag)
9116 (setq key (match-string 1 tag) value (match-string 2 tag)
9117 tag (replace-match "" t t tag)
9118 attr (plist-put attr (intern key) value)))
9119 (cons tag attr)))
9120
2c3ad40d
CD
9121(defun org-attributes-to-string (plist)
9122 "Format a property list into an HTML attribute list."
9123 (let ((s "") key value)
9124 (while plist
9125 (setq key (pop plist) value (pop plist))
db55f368
CD
9126 (and value
9127 (setq s (concat s " " (symbol-name key) "=\"" value "\""))))
2c3ad40d
CD
9128 s))
9129
20908596 9130;;; Opening/following a link
03f3cf35 9131
20908596 9132(defvar org-link-search-failed nil)
38f8646b 9133
ed21c5c8
CD
9134(defvar org-open-link-functions nil
9135 "Hook for functions finding a plain text link.
9136These functions must take a single argument, the link content.
9137They will be called for links that look like [[link text][description]]
9138when LINK TEXT does not have a protocol like \"http:\" and does not look
9139like a filename (e.g. \"./blue.png\").
9140
9141These functions will be called *before* Org attempts to resolve the
9142link by doing text searches in the current buffer - so if you want a
9143link \"[[target]]\" to still find \"<<target>>\", your function should
9144handle this as a special case.
9145
9146When the function does handle the link, it must return a non-nil value.
9147If it decides that it is not responsible for this link, it must return
9148nil to indicate that that Org-mode can continue with other options
9149like exact and fuzzy text search.")
9150
20908596
CD
9151(defun org-next-link ()
9152 "Move forward to the next link.
9153If the link is in hidden text, expose it."
9154 (interactive)
9155 (when (and org-link-search-failed (eq this-command last-command))
9156 (goto-char (point-min))
9157 (message "Link search wrapped back to beginning of buffer"))
9158 (setq org-link-search-failed nil)
9159 (let* ((pos (point))
9160 (ct (org-context))
9161 (a (assoc :link ct)))
9162 (if a (goto-char (nth 2 a)))
9163 (if (re-search-forward org-any-link-re nil t)
9164 (progn
9165 (goto-char (match-beginning 0))
3ab2c837 9166 (if (outline-invisible-p) (org-show-context)))
20908596
CD
9167 (goto-char pos)
9168 (setq org-link-search-failed t)
9169 (error "No further link found"))))
38f8646b 9170
20908596
CD
9171(defun org-previous-link ()
9172 "Move backward to the previous link.
9173If the link is in hidden text, expose it."
7d58338e 9174 (interactive)
20908596
CD
9175 (when (and org-link-search-failed (eq this-command last-command))
9176 (goto-char (point-max))
9177 (message "Link search wrapped back to end of buffer"))
9178 (setq org-link-search-failed nil)
9179 (let* ((pos (point))
9180 (ct (org-context))
9181 (a (assoc :link ct)))
9182 (if a (goto-char (nth 1 a)))
9183 (if (re-search-backward org-any-link-re nil t)
9184 (progn
9185 (goto-char (match-beginning 0))
3ab2c837 9186 (if (outline-invisible-p) (org-show-context)))
20908596
CD
9187 (goto-char pos)
9188 (setq org-link-search-failed t)
9189 (error "No further link found"))))
7d58338e 9190
ce4fdcb9
CD
9191(defun org-translate-link (s)
9192 "Translate a link string if a translation function has been defined."
9193 (if (and org-link-translation-function
9194 (fboundp org-link-translation-function)
9195 (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s))
9196 (progn
9197 (setq s (funcall org-link-translation-function
9198 (match-string 1) (match-string 2)))
9199 (concat (car s) ":" (cdr s)))
9200 s))
9201
9202(defun org-translate-link-from-planner (type path)
9203 "Translate a link from Emacs Planner syntax so that Org can follow it.
9204This is still an experimental function, your mileage may vary."
9205 (cond
9206 ((member type '("http" "https" "news" "ftp"))
9207 ;; standard Internet links are the same.
9208 nil)
9209 ((and (equal type "irc") (string-match "^//" path))
9210 ;; Planner has two / at the beginning of an irc link, we have 1.
9211 ;; We should have zero, actually....
9212 (setq path (substring path 1)))
9213 ((and (equal type "lisp") (string-match "^/" path))
9214 ;; Planner has a slash, we do not.
9215 (setq type "elisp" path (substring path 1)))
9216 ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path)
8bfe682a 9217 ;; A typical message link. Planner has the id after the final slash,
ce4fdcb9
CD
9218 ;; we separate it with a hash mark
9219 (setq path (concat (match-string 1 path) "#"
9220 (org-remove-angle-brackets (match-string 2 path)))))
9221 )
9222 (cons type path))
9223
20908596
CD
9224(defun org-find-file-at-mouse (ev)
9225 "Open file link or URL at mouse."
9226 (interactive "e")
9227 (mouse-set-point ev)
9228 (org-open-at-point 'in-emacs))
7d58338e 9229
20908596
CD
9230(defun org-open-at-mouse (ev)
9231 "Open file link or URL at mouse."
9232 (interactive "e")
9233 (mouse-set-point ev)
ce4fdcb9
CD
9234 (if (eq major-mode 'org-agenda-mode)
9235 (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
20908596 9236 (org-open-at-point))
38f8646b 9237
20908596
CD
9238(defvar org-window-config-before-follow-link nil
9239 "The window configuration before following a link.
9240This is saved in case the need arises to restore it.")
38f8646b 9241
20908596
CD
9242(defvar org-open-link-marker (make-marker)
9243 "Marker pointing to the location where `org-open-at-point; was called.")
9244
9245;;;###autoload
9246(defun org-open-at-point-global ()
9247 "Follow a link like Org-mode does.
9248This command can be called in any mode to follow a link that has
9249Org-mode syntax."
9250 (interactive)
9251 (org-run-like-in-org-mode 'org-open-at-point))
9252
9253;;;###autoload
54a0dee5 9254(defun org-open-link-from-string (s &optional arg reference-buffer)
20908596
CD
9255 "Open a link in the string S, as if it was in Org-mode."
9256 (interactive "sLink: \nP")
54a0dee5 9257 (let ((reference-buffer (or reference-buffer (current-buffer))))
c8d0cf5c
CD
9258 (with-temp-buffer
9259 (let ((org-inhibit-startup t))
9260 (org-mode)
9261 (insert s)
9262 (goto-char (point-min))
ed21c5c8
CD
9263 (when reference-buffer
9264 (setq org-link-abbrev-alist-local
9265 (with-current-buffer reference-buffer
9266 org-link-abbrev-alist-local)))
c8d0cf5c 9267 (org-open-at-point arg reference-buffer)))))
20908596 9268
afe98dfa
CD
9269(defvar org-open-at-point-functions nil
9270 "Hook that is run when following a link at point.
9271
9272Functions in this hook must return t if they identify and follow
9273a link at point. If they don't find anything interesting at point,
9274they must return nil.")
9275
3ab2c837 9276(defun org-open-at-point (&optional arg reference-buffer)
20908596
CD
9277 "Open link at or after point.
9278If there is no link at point, this function will search forward up to
c8d0cf5c 9279the end of the current line.
20908596 9280Normally, files will be opened by an appropriate application. If the
3ab2c837 9281optional prefix argument ARG is non-nil, Emacs will visit the file.
93b62de8
CD
9282With a double prefix argument, try to open outside of Emacs, in the
9283application the system uses for this file type."
20908596 9284 (interactive "P")
86fbb8ca
CD
9285 ;; if in a code block, then open the block's results
9286 (unless (call-interactively #'org-babel-open-src-block-result)
20908596
CD
9287 (org-load-modules-maybe)
9288 (move-marker org-open-link-marker (point))
9289 (setq org-window-config-before-follow-link (current-window-configuration))
9290 (org-remove-occur-highlights nil nil t)
0bd48b37 9291 (cond
54a0dee5
CD
9292 ((and (org-on-heading-p)
9293 (not (org-in-regexp
f924a367 9294 (concat org-plain-link-re "\\|"
54a0dee5
CD
9295 org-bracket-link-regexp "\\|"
9296 org-angle-link-re "\\|"
ed21c5c8
CD
9297 "[ \t]:[^ \t\n]+:[ \t]*$")))
9298 (not (get-text-property (point) 'org-linked-text)))
3ab2c837 9299 (or (org-offer-links-in-entry arg)
8bfe682a 9300 (progn (require 'org-attach) (org-attach-reveal 'if-exists))))
afe98dfa 9301 ((run-hook-with-args-until-success 'org-open-at-point-functions))
0bd48b37 9302 ((org-at-timestamp-p t) (org-follow-timestamp-link))
acedf35c
CD
9303 ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
9304 (not (org-in-regexp org-bracket-link-regexp)))
0bd48b37 9305 (org-footnote-action))
c8d0cf5c 9306 (t
20908596
CD
9307 (let (type path link line search (pos (point)))
9308 (catch 'match
9309 (save-excursion
9310 (skip-chars-forward "^]\n\r")
ed21c5c8 9311 (when (org-in-regexp org-bracket-link-regexp 1)
2c3ad40d
CD
9312 (setq link (org-extract-attributes
9313 (org-link-unescape (org-match-string-no-properties 1))))
20908596
CD
9314 (while (string-match " *\n *" link)
9315 (setq link (replace-match " " t t link)))
9316 (setq link (org-link-expand-abbrev link))
2c3ad40d
CD
9317 (cond
9318 ((or (file-name-absolute-p link)
9319 (string-match "^\\.\\.?/" link))
9320 (setq type "file" path link))
ce4fdcb9 9321 ((string-match org-link-re-with-space3 link)
2c3ad40d
CD
9322 (setq type (match-string 1 link) path (match-string 2 link)))
9323 (t (setq type "thisfile" path link)))
20908596 9324 (throw 'match t)))
8c6fb58b 9325
20908596
CD
9326 (when (get-text-property (point) 'org-linked-text)
9327 (setq type "thisfile"
9328 pos (if (get-text-property (1+ (point)) 'org-linked-text)
9329 (1+ (point)) (point))
9330 path (buffer-substring
3ab2c837
BG
9331 (or (previous-single-property-change pos 'org-linked-text)
9332 (point-min))
9333 (or (next-single-property-change pos 'org-linked-text)
9334 (point-max))))
20908596 9335 (throw 'match t))
8c6fb58b 9336
20908596
CD
9337 (save-excursion
9338 (when (or (org-in-regexp org-angle-link-re)
9339 (org-in-regexp org-plain-link-re))
9340 (setq type (match-string 1) path (match-string 2))
9341 (throw 'match t)))
20908596 9342 (save-excursion
afe98dfa 9343 (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
20908596
CD
9344 (setq type "tags"
9345 path (match-string 1))
9346 (while (string-match ":" path)
9347 (setq path (replace-match "+" t t path)))
c8d0cf5c
CD
9348 (throw 'match t)))
9349 (when (org-in-regexp "<\\([^><\n]+\\)>")
9350 (setq type "tree-match"
9351 path (match-string 1))
9352 (throw 'match t)))
20908596
CD
9353 (unless path
9354 (error "No link found"))
c8d0cf5c
CD
9355
9356 ;; switch back to reference buffer
9357 ;; needed when if called in a temporary buffer through
9358 ;; org-open-link-from-string
54a0dee5
CD
9359 (with-current-buffer (or reference-buffer (current-buffer))
9360
9361 ;; Remove any trailing spaces in path
9362 (if (string-match " +\\'" path)
9363 (setq path (replace-match "" t t path)))
9364 (if (and org-link-translation-function
9365 (fboundp org-link-translation-function))
9366 ;; Check if we need to translate the link
9367 (let ((tmp (funcall org-link-translation-function type path)))
9368 (setq type (car tmp) path (cdr tmp))))
f924a367 9369
54a0dee5 9370 (cond
f924a367 9371
54a0dee5
CD
9372 ((assoc type org-link-protocols)
9373 (funcall (nth 1 (assoc type org-link-protocols)) path))
f924a367 9374
54a0dee5
CD
9375 ((equal type "mailto")
9376 (let ((cmd (car org-link-mailto-program))
9377 (args (cdr org-link-mailto-program)) args1
9378 (address path) (subject "") a)
9379 (if (string-match "\\(.*\\)::\\(.*\\)" path)
9380 (setq address (match-string 1 path)
9381 subject (org-link-escape (match-string 2 path))))
9382 (while args
9383 (cond
9384 ((not (stringp (car args))) (push (pop args) args1))
9385 (t (setq a (pop args))
9386 (if (string-match "%a" a)
9387 (setq a (replace-match address t t a)))
9388 (if (string-match "%s" a)
9389 (setq a (replace-match subject t t a)))
9390 (push a args1))))
9391 (apply cmd (nreverse args1))))
f924a367 9392
54a0dee5
CD
9393 ((member type '("http" "https" "ftp" "news"))
9394 (browse-url (concat type ":" (org-link-escape
9395 path org-link-escape-chars-browser))))
f924a367 9396
86fbb8ca
CD
9397 ((string= type "doi")
9398 (browse-url (concat "http://dx.doi.org/"
9399 (org-link-escape
9400 path org-link-escape-chars-browser))))
9401
54a0dee5
CD
9402 ((member type '("message"))
9403 (browse-url (concat type ":" path)))
f924a367 9404
54a0dee5 9405 ((string= type "tags")
3ab2c837 9406 (org-tags-view arg path))
f924a367 9407
54a0dee5
CD
9408 ((string= type "tree-match")
9409 (org-occur (concat "\\[" (regexp-quote path) "\\]")))
f924a367 9410
54a0dee5
CD
9411 ((string= type "file")
9412 (if (string-match "::\\([0-9]+\\)\\'" path)
9413 (setq line (string-to-number (match-string 1 path))
9414 path (substring path 0 (match-beginning 0)))
9415 (if (string-match "::\\(.+\\)\\'" path)
9416 (setq search (match-string 1 path)
9417 path (substring path 0 (match-beginning 0)))))
9418 (if (string-match "[*?{]" (file-name-nondirectory path))
9419 (dired path)
3ab2c837 9420 (org-open-file path arg line search)))
f924a367 9421
54a0dee5
CD
9422 ((string= type "shell")
9423 (let ((cmd path))
3ab2c837
BG
9424 (if (or (and (not (string= org-confirm-shell-link-not-regexp ""))
9425 (string-match org-confirm-shell-link-not-regexp cmd))
9426 (not org-confirm-shell-link-function)
54a0dee5
CD
9427 (funcall org-confirm-shell-link-function
9428 (format "Execute \"%s\" in shell? "
9429 (org-add-props cmd nil
9430 'face 'org-warning))))
9431 (progn
9432 (message "Executing %s" cmd)
9433 (shell-command cmd))
9434 (error "Abort"))))
f924a367 9435
54a0dee5
CD
9436 ((string= type "elisp")
9437 (let ((cmd path))
3ab2c837
BG
9438 (if (or (and (not (string= org-confirm-elisp-link-not-regexp ""))
9439 (string-match org-confirm-elisp-link-not-regexp cmd))
9440 (not org-confirm-elisp-link-function)
54a0dee5
CD
9441 (funcall org-confirm-elisp-link-function
9442 (format "Execute \"%s\" as elisp? "
9443 (org-add-props cmd nil
9444 'face 'org-warning))))
9445 (message "%s => %s" cmd
9446 (if (equal (string-to-char cmd) ?\()
9447 (eval (read cmd))
9448 (call-interactively (read cmd))))
9449 (error "Abort"))))
f924a367 9450
ed21c5c8
CD
9451 ((and (string= type "thisfile")
9452 (run-hook-with-args-until-success
9453 'org-open-link-functions path)))
9454
9455 ((string= type "thisfile")
3ab2c837 9456 (if arg
ed21c5c8
CD
9457 (switch-to-buffer-other-window
9458 (org-get-buffer-for-internal-link (current-buffer)))
9459 (org-mark-ring-push))
9460 (let ((cmd `(org-link-search
9461 ,path
3ab2c837
BG
9462 ,(cond ((equal arg '(4)) ''occur)
9463 ((equal arg '(16)) ''org-occur)
ed21c5c8
CD
9464 (t nil))
9465 ,pos)))
9466 (condition-case nil (eval cmd)
9467 (error (progn (widen) (eval cmd))))))
9468
54a0dee5 9469 (t
8d642074
CD
9470 (browse-url-at-point)))))))
9471 (move-marker org-open-link-marker nil)
86fbb8ca 9472 (run-hook-with-args 'org-follow-link-hook)))
54a0dee5 9473
8d642074 9474(defun org-offer-links-in-entry (&optional nth zero)
8bfe682a 9475 "Offer links in the current entry and follow the selected link.
54a0dee5 9476If there is only one link, follow it immediately as well.
8d642074
CD
9477If NTH is an integer, immediately pick the NTH link found.
9478If ZERO is a string, check also this string for a link, and if
9479there is one, offer it as link number zero."
54a0dee5
CD
9480 (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|"
9481 "\\(" org-angle-link-re "\\)\\|"
9482 "\\(" org-plain-link-re "\\)"))
9483 (cnt ?0)
9484 (in-emacs (if (integerp nth) nil nth))
8d642074
CD
9485 have-zero end links link c)
9486 (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
9487 (push (match-string 0 zero) links)
9488 (setq cnt (1- cnt) have-zero t))
54a0dee5
CD
9489 (save-excursion
9490 (org-back-to-heading t)
9491 (setq end (save-excursion (outline-next-heading) (point)))
9492 (while (re-search-forward re end t)
9493 (push (match-string 0) links))
9494 (setq links (org-uniquify (reverse links))))
03f3cf35 9495
54a0dee5 9496 (cond
8bfe682a
CD
9497 ((null links)
9498 (message "No links"))
54a0dee5 9499 ((equal (length links) 1)
ed21c5c8 9500 (setq link (list (car links))))
8d642074
CD
9501 ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
9502 (setq link (nth (if have-zero nth (1- nth)) links)))
54a0dee5
CD
9503 (t ; we have to select a link
9504 (save-excursion
9505 (save-window-excursion
9506 (delete-other-windows)
9507 (with-output-to-temp-buffer "*Select Link*"
54a0dee5
CD
9508 (mapc (lambda (l)
9509 (if (not (string-match org-bracket-link-regexp l))
9510 (princ (format "[%c] %s\n" (incf cnt)
9511 (org-remove-angle-brackets l)))
9512 (if (match-end 3)
9513 (princ (format "[%c] %s (%s)\n" (incf cnt)
9514 (match-string 3 l) (match-string 1 l)))
9515 (princ (format "[%c] %s\n" (incf cnt)
9516 (match-string 1 l))))))
9517 links))
9518 (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
ed21c5c8 9519 (message "Select link to open, RET to open all:")
54a0dee5
CD
9520 (setq c (read-char-exclusive))
9521 (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
9522 (when (equal c ?q) (error "Abort"))
ed21c5c8
CD
9523 (if (equal c ?\C-m)
9524 (setq link links)
9525 (setq nth (- c ?0))
9526 (if have-zero (setq nth (1+ nth)))
9527 (unless (and (integerp nth) (>= (length links) nth))
9528 (error "Invalid link selection"))
9529 (setq link (list (nth (1- nth) links))))))
8bfe682a 9530 (if link
ed21c5c8
CD
9531 (let ((buf (current-buffer)))
9532 (dolist (l link)
9533 (org-open-link-from-string l in-emacs buf))
9534 t)
8bfe682a 9535 nil)))
fbe6c10d 9536
ed21c5c8
CD
9537;; Add special file links that specify the way of opening
9538
9539(org-add-link-type "file+sys" 'org-open-file-with-system)
9540(org-add-link-type "file+emacs" 'org-open-file-with-emacs)
9541(defun org-open-file-with-system (path)
86fbb8ca 9542 "Open file at PATH using the system way of opening it."
ed21c5c8
CD
9543 (org-open-file path 'system))
9544(defun org-open-file-with-emacs (path)
86fbb8ca 9545 "Open file at PATH in Emacs."
ed21c5c8
CD
9546 (org-open-file path 'emacs))
9547(defun org-remove-file-link-modifiers ()
9548 "Remove the file link modifiers in `file+sys:' and `file+emacs:' links."
9549 (goto-char (point-min))
9550 (while (re-search-forward "\\<file\\+\\(sys\\|emacs\\):" nil t)
9551 (org-if-unprotected
9552 (replace-match "file:" t t))))
9553(eval-after-load "org-exp"
9554 '(add-hook 'org-export-preprocess-before-normalizing-links-hook
9555 'org-remove-file-link-modifiers))
9556
20908596 9557;;;; Time estimates
fbe6c10d 9558
20908596
CD
9559(defun org-get-effort (&optional pom)
9560 "Get the effort estimate for the current entry."
9561 (org-entry-get pom org-effort-property))
2a57416f 9562
20908596 9563;;; File search
38f8646b 9564
20908596
CD
9565(defvar org-create-file-search-functions nil
9566 "List of functions to construct the right search string for a file link.
9567These functions are called in turn with point at the location to
9568which the link should point.
03f3cf35 9569
20908596 9570A function in the hook should first test if it would like to
86fbb8ca
CD
9571handle this file type, for example by checking the `major-mode'
9572or the file extension. If it decides not to handle this file, it
20908596
CD
9573should just return nil to give other functions a chance. If it
9574does handle the file, it must return the search string to be used
9575when following the link. The search string will be part of the
9576file link, given after a double colon, and `org-open-at-point'
9577will automatically search for it. If special measures must be
9578taken to make the search successful, another function should be
9579added to the companion hook `org-execute-file-search-functions',
9580which see.
7d58338e 9581
20908596
CD
9582A function in this hook may also use `setq' to set the variable
9583`description' to provide a suggestion for the descriptive text to
9584be used for this link when it gets inserted into an Org-mode
9585buffer with \\[org-insert-link].")
9586
9587(defvar org-execute-file-search-functions nil
9588 "List of functions to execute a file search triggered by a link.
9589
9590Functions added to this hook must accept a single argument, the
9591search string that was part of the file link, the part after the
9592double colon. The function must first check if it would like to
86fbb8ca
CD
9593handle this search, for example by checking the `major-mode' or
9594the file extension. If it decides not to handle this search, it
20908596
CD
9595should just return nil to give other functions a chance. If it
9596does handle the search, it must return a non-nil value to keep
9597other functions from trying.
9598
9599Each function can access the current prefix argument through the
9600variable `current-prefix-argument'. Note that a single prefix is
9601used to force opening a link in Emacs, so it may be good to only
9602use a numeric or double prefix to guide the search function.
9603
9604In case this is needed, a function in this hook can also restore
9605the window configuration before `org-open-at-point' was called using:
9606
9607 (set-window-configuration org-window-config-before-follow-link)")
9608
afe98dfa 9609(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
20908596
CD
9610(defun org-link-search (s &optional type avoid-pos)
9611 "Search for a link search option.
9612If S is surrounded by forward slashes, it is interpreted as a
9613regular expression. In org-mode files, this will create an `org-occur'
9614sparse tree. In ordinary files, `occur' will be used to list matches.
9615If the current buffer is in `dired-mode', grep will be used to search
9616in all files. If AVOID-POS is given, ignore matches near that position."
9617 (let ((case-fold-search t)
9618 (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
9619 (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
9620 (append '(("") (" ") ("\t") ("\n"))
9621 org-emphasis-alist)
9622 "\\|") "\\)"))
9623 (pos (point))
9624 (pre nil) (post nil)
9625 words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall)
9626 (cond
afe98dfa 9627 ;; First check if there are any special search functions
20908596
CD
9628 ((run-hook-with-args-until-success 'org-execute-file-search-functions s))
9629 ;; Now try the builtin stuff
c8d0cf5c
CD
9630 ((and (equal (string-to-char s0) ?#)
9631 (> (length s0) 1)
9632 (save-excursion
9633 (goto-char (point-min))
9634 (and
9635 (re-search-forward
9636 (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
9637 (setq type 'dedicated
9638 pos (match-beginning 0))))
9639 ;; There is an exact target for this
9640 (goto-char pos)
9641 (org-back-to-heading t)))
20908596
CD
9642 ((save-excursion
9643 (goto-char (point-min))
9644 (and
9645 (re-search-forward
9646 (concat "<<" (regexp-quote s0) ">>") nil t)
9647 (setq type 'dedicated
9648 pos (match-beginning 0))))
9649 ;; There is an exact target for this
9650 (goto-char pos))
0bd48b37
CD
9651 ((and (string-match "^(\\(.*\\))$" s0)
9652 (save-excursion
9653 (goto-char (point-min))
9654 (and
9655 (re-search-forward
9656 (concat "[^[]" (regexp-quote
9657 (format org-coderef-label-format
9658 (match-string 1 s0))))
9659 nil t)
9660 (setq type 'dedicated
9661 pos (1+ (match-beginning 0))))))
9662 ;; There is a coderef target for this
9663 (goto-char pos))
20908596
CD
9664 ((string-match "^/\\(.*\\)/$" s)
9665 ;; A regular expression
9666 (cond
9667 ((org-mode-p)
9668 (org-occur (match-string 1 s)))
9669 ;;((eq major-mode 'dired-mode)
9670 ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
9671 (t (org-do-occur (match-string 1 s)))))
afe98dfa
CD
9672 ((and (org-mode-p) org-link-search-must-match-exact-headline)
9673 (and (equal (string-to-char s) ?*) (setq s (substring s 1)))
9674 (goto-char (point-min))
9675 (cond
9676 ((let (case-fold-search)
9677 (re-search-forward (format org-complex-heading-regexp-format
9678 (regexp-quote s))
9679 nil t))
9680 ;; OK, found a match
9681 (setq type 'dedicated)
9682 (goto-char (match-beginning 0)))
9683 ((and (not org-link-search-inhibit-query)
9684 (eq org-link-search-must-match-exact-headline 'query-to-create)
9685 (y-or-n-p "No match - create this as a new heading? "))
9686 (goto-char (point-max))
9687 (or (bolp) (newline))
9688 (insert "* " s "\n")
9689 (beginning-of-line 0))
9690 (t
9691 (goto-char pos)
9692 (error "No match"))))
20908596 9693 (t
afe98dfa 9694 ;; A normal search string
20908596
CD
9695 (when (equal (string-to-char s) ?*)
9696 ;; Anchor on headlines, post may include tags.
9697 (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*"
afe98dfa 9698 post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$")
20908596
CD
9699 s (substring s 1)))
9700 (remove-text-properties
9701 0 (length s)
9702 '(face nil mouse-face nil keymap nil fontified nil) s)
9703 ;; Make a series of regular expressions to find a match
9704 (setq words (org-split-string s "[ \n\r\t]+")
9705
9706 re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
9707 re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+")
9708 "\\)" markers)
9709 re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]")
9710 re2a (concat "[ \t\r\n]" re2a_)
9711 re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
9712 re4 (concat "[^a-zA-Z_]" re4_)
9713
9714 re1 (concat pre re2 post)
9715 re3 (concat pre (if pre re4_ re4) post)
9716 re5 (concat pre ".*" re4)
9717 re2 (concat pre re2)
9718 re2a (concat pre (if pre re2a_ re2a))
9719 re4 (concat pre (if pre re4_ re4))
9720 reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
9721 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
9722 re5 "\\)"
9723 ))
9724 (cond
9725 ((eq type 'org-occur) (org-occur reall))
9726 ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
9727 (t (goto-char (point-min))
9728 (setq type 'fuzzy)
9729 (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated))
9730 (org-search-not-self 1 re1 nil t)
9731 (org-search-not-self 1 re2 nil t)
9732 (org-search-not-self 1 re2a nil t)
9733 (org-search-not-self 1 re3 nil t)
9734 (org-search-not-self 1 re4 nil t)
9735 (org-search-not-self 1 re5 nil t)
9736 )
9737 (goto-char (match-beginning 1))
9738 (goto-char pos)
afe98dfa 9739 (error "No match"))))))
20908596
CD
9740 (and (org-mode-p) (org-show-context 'link-search))
9741 type))
9742
9743(defun org-search-not-self (group &rest args)
9744 "Execute `re-search-forward', but only accept matches that do not
9745enclose the position of `org-open-link-marker'."
9746 (let ((m org-open-link-marker))
9747 (catch 'exit
9748 (while (apply 're-search-forward args)
9749 (unless (get-text-property (match-end group) 'intangible) ; Emacs 21
9750 (goto-char (match-end group))
9751 (if (and (or (not (eq (marker-buffer m) (current-buffer)))
9752 (> (match-beginning 0) (marker-position m))
9753 (< (match-end 0) (marker-position m)))
9754 (save-match-data
9755 (or (not (org-in-regexp
9756 org-bracket-link-analytic-regexp 1))
9757 (not (match-end 4)) ; no description
9758 (and (<= (match-beginning 4) (point))
9759 (>= (match-end 4) (point))))))
9760 (throw 'exit (point))))))))
7d58338e 9761
20908596
CD
9762(defun org-get-buffer-for-internal-link (buffer)
9763 "Return a buffer to be used for displaying the link target of internal links."
9764 (cond
9765 ((not org-display-internal-link-with-indirect-buffer)
9766 buffer)
9767 ((string-match "(Clone)$" (buffer-name buffer))
9768 (message "Buffer is already a clone, not making another one")
9769 ;; we also do not modify visibility in this case
9770 buffer)
9771 (t ; make a new indirect buffer for displaying the link
9772 (let* ((bn (buffer-name buffer))
9773 (ibn (concat bn "(Clone)"))
9774 (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone))))
9775 (with-current-buffer ib (org-overview))
9776 ib))))
7d58338e 9777
20908596
CD
9778(defun org-do-occur (regexp &optional cleanup)
9779 "Call the Emacs command `occur'.
9780If CLEANUP is non-nil, remove the printout of the regular expression
9781in the *Occur* buffer. This is useful if the regex is long and not useful
9782to read."
9783 (occur regexp)
9784 (when cleanup
9785 (let ((cwin (selected-window)) win beg end)
9786 (when (setq win (get-buffer-window "*Occur*"))
9787 (select-window win))
7d58338e 9788 (goto-char (point-min))
20908596
CD
9789 (when (re-search-forward "match[a-z]+" nil t)
9790 (setq beg (match-end 0))
9791 (if (re-search-forward "^[ \t]*[0-9]+" nil t)
9792 (setq end (1- (match-beginning 0)))))
9793 (and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
9794 (goto-char (point-min))
9795 (select-window cwin))))
7d58338e 9796
20908596 9797;;; The mark ring for links jumps
48aaad2d 9798
20908596
CD
9799(defvar org-mark-ring nil
9800 "Mark ring for positions before jumps in Org-mode.")
9801(defvar org-mark-ring-last-goto nil
9802 "Last position in the mark ring used to go back.")
9803;; Fill and close the ring
9804(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
9805(loop for i from 1 to org-mark-ring-length do
9806 (push (make-marker) org-mark-ring))
9807(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
9808 org-mark-ring)
9809
9810(defun org-mark-ring-push (&optional pos buffer)
9811 "Put the current position or POS into the mark ring and rotate it."
48aaad2d 9812 (interactive)
20908596
CD
9813 (setq pos (or pos (point)))
9814 (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring))
9815 (move-marker (car org-mark-ring)
9816 (or pos (point))
9817 (or buffer (current-buffer)))
9818 (message "%s"
9819 (substitute-command-keys
9820 "Position saved to mark ring, go back with \\[org-mark-ring-goto].")))
48aaad2d 9821
20908596
CD
9822(defun org-mark-ring-goto (&optional n)
9823 "Jump to the previous position in the mark ring.
9824With prefix arg N, jump back that many stored positions. When
9825called several times in succession, walk through the entire ring.
9826Org-mode commands jumping to a different position in the current file,
9827or to another Org-mode file, automatically push the old position
9828onto the ring."
9829 (interactive "p")
9830 (let (p m)
9831 (if (eq last-command this-command)
9832 (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring)))
9833 (setq p org-mark-ring))
9834 (setq org-mark-ring-last-goto p)
9835 (setq m (car p))
c3313451 9836 (switch-to-buffer (marker-buffer m))
20908596 9837 (goto-char m)
3ab2c837 9838 (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
fbe6c10d 9839
20908596
CD
9840(defun org-remove-angle-brackets (s)
9841 (if (equal (substring s 0 1) "<") (setq s (substring s 1)))
9842 (if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
9843 s)
9844(defun org-add-angle-brackets (s)
9845 (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
9846 (if (equal (substring s -1) ">") nil (setq s (concat s ">")))
9847 s)
b349f79f
CD
9848(defun org-remove-double-quotes (s)
9849 (if (equal (substring s 0 1) "\"") (setq s (substring s 1)))
9850 (if (equal (substring s -1) "\"") (setq s (substring s 0 -1)))
9851 s)
7d58338e 9852
20908596 9853;;; Following specific links
48aaad2d 9854
20908596
CD
9855(defun org-follow-timestamp-link ()
9856 (cond
9857 ((org-at-date-range-p t)
9858 (let ((org-agenda-start-on-weekday)
9859 (t1 (match-string 1))
9860 (t2 (match-string 2)))
9861 (setq t1 (time-to-days (org-time-string-to-time t1))
9862 t2 (time-to-days (org-time-string-to-time t2)))
9863 (org-agenda-list nil t1 (1+ (- t2 t1)))))
9864 ((org-at-timestamp-p t)
9865 (org-agenda-list nil (time-to-days (org-time-string-to-time
9866 (substring (match-string 1) 0 10)))
9867 1))
9868 (t (error "This should not happen"))))
48aaad2d 9869
03f3cf35 9870
20908596 9871;;; Following file links
3ab2c837
BG
9872(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force))
9873(declare-function mailcap-extension-to-mime "mailcap" (extn))
9874(declare-function mailcap-mime-info
9875 "mailcap" (string &optional request no-decode))
20908596
CD
9876(defvar org-wait nil)
9877(defun org-open-file (path &optional in-emacs line search)
9878 "Open the file at PATH.
9879First, this expands any special file name abbreviations. Then the
9880configuration variable `org-file-apps' is checked if it contains an
9881entry for this file type, and if yes, the corresponding command is launched.
93b62de8 9882
20908596 9883If no application is found, Emacs simply visits the file.
93b62de8
CD
9884
9885With optional prefix argument IN-EMACS, Emacs will visit the file.
86fbb8ca
CD
9886With a double \\[universal-argument] \\[universal-argument] \
9887prefix arg, Org tries to avoid opening in Emacs
ed21c5c8 9888and to use an external application to visit the file.
93b62de8 9889
86fbb8ca
CD
9890Optional LINE specifies a line to go to, optional SEARCH a string
9891to search for. If LINE or SEARCH is given, the file will be
9892opened in Emacs, unless an entry from org-file-apps that makes
9893use of groups in a regexp matches.
20908596 9894If the file does not exist, an error is thrown."
20908596
CD
9895 (let* ((file (if (equal path "")
9896 buffer-file-name
9897 (substitute-in-file-name (expand-file-name path))))
86fbb8ca
CD
9898 (file-apps (append org-file-apps (org-default-apps)))
9899 (apps (org-remove-if
9900 'org-file-apps-entry-match-against-dlink-p file-apps))
9901 (apps-dlink (org-remove-if-not
9902 'org-file-apps-entry-match-against-dlink-p file-apps))
20908596
CD
9903 (remp (and (assq 'remote apps) (org-file-remote-p file)))
9904 (dirp (if remp nil (file-directory-p file)))
2c3ad40d
CD
9905 (file (if (and dirp org-open-directory-means-index-dot-org)
9906 (concat (file-name-as-directory file) "index.org")
9907 file))
621f83e4 9908 (a-m-a-p (assq 'auto-mode apps))
20908596 9909 (dfile (downcase file))
ed21c5c8
CD
9910 ;; reconstruct the original file: link from the PATH, LINE and SEARCH args
9911 (link (cond ((and (eq line nil)
9912 (eq search nil))
9913 file)
9914 (line
9915 (concat file "::" (number-to-string line)))
9916 (search
9917 (concat file "::" search))))
9918 (dlink (downcase link))
20908596
CD
9919 (old-buffer (current-buffer))
9920 (old-pos (point))
9921 (old-mode major-mode)
ed21c5c8 9922 ext cmd link-match-data)
20908596
CD
9923 (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile)
9924 (setq ext (match-string 1 dfile))
9925 (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile)
9926 (setq ext (match-string 1 dfile))))
93b62de8 9927 (cond
ed21c5c8 9928 ((member in-emacs '((16) system))
93b62de8
CD
9929 (setq cmd (cdr (assoc 'system apps))))
9930 (in-emacs (setq cmd 'emacs))
9931 (t
20908596
CD
9932 (setq cmd (or (and remp (cdr (assoc 'remote apps)))
9933 (and dirp (cdr (assoc 'directory apps)))
86fbb8ca
CD
9934 ; first, try matching against apps-dlink
9935 ; if we get a match here, store the match data for later
9936 (let ((match (assoc-default dlink apps-dlink
9937 'string-match)))
9938 (if match
ed21c5c8 9939 (progn (setq link-match-data (match-data))
86fbb8ca
CD
9940 match)
9941 (progn (setq in-emacs (or in-emacs line search))
9942 nil))) ; if we have no match in apps-dlink,
9943 ; always open the file in emacs if line or search
9944 ; is given (for backwards compatibility)
9945 (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
9946 'string-match)
20908596 9947 (cdr (assoc ext apps))
93b62de8
CD
9948 (cdr (assoc t apps))))))
9949 (when (eq cmd 'system)
9950 (setq cmd (cdr (assoc 'system apps))))
621f83e4
CD
9951 (when (eq cmd 'default)
9952 (setq cmd (cdr (assoc t apps))))
20908596
CD
9953 (when (eq cmd 'mailcap)
9954 (require 'mailcap)
9955 (mailcap-parse-mailcaps)
9956 (let* ((mime-type (mailcap-extension-to-mime (or ext "")))
9957 (command (mailcap-mime-info mime-type)))
9958 (if (stringp command)
9959 (setq cmd command)
9960 (setq cmd 'emacs))))
9961 (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
9962 (not (file-exists-p file))
9963 (not org-open-non-existing-files))
9964 (error "No such file: %s" file))
9965 (cond
9966 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
9967 ;; Remove quotes around the file name - we'll use shell-quote-argument.
9968 (while (string-match "['\"]%s['\"]" cmd)
9969 (setq cmd (replace-match "%s" t t cmd)))
9970 (while (string-match "%s" cmd)
9971 (setq cmd (replace-match
b349f79f
CD
9972 (save-match-data
9973 (shell-quote-argument
9974 (convert-standard-filename file)))
20908596 9975 t t cmd)))
86fbb8ca 9976
ed21c5c8
CD
9977 ;; Replace "%1", "%2" etc. in command with group matches from regex
9978 (save-match-data
9979 (let ((match-index 1)
9980 (number-of-groups (- (/ (length link-match-data) 2) 1)))
9981 (set-match-data link-match-data)
9982 (while (<= match-index number-of-groups)
9983 (let ((regex (concat "%" (number-to-string match-index)))
9984 (replace-with (match-string match-index dlink)))
9985 (while (string-match regex cmd)
9986 (setq cmd (replace-match replace-with t t cmd))))
9987 (setq match-index (+ match-index 1)))))
9988
20908596
CD
9989 (save-window-excursion
9990 (start-process-shell-command cmd nil cmd)
9991 (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
9992 ))
9993 ((or (stringp cmd)
9994 (eq cmd 'emacs))
9995 (funcall (cdr (assq 'file org-link-frame-setup)) file)
9996 (widen)
54a0dee5 9997 (if line (org-goto-line line)
20908596
CD
9998 (if search (org-link-search search))))
9999 ((consp cmd)
b349f79f 10000 (let ((file (convert-standard-filename file)))
ed21c5c8
CD
10001 (save-match-data
10002 (set-match-data link-match-data)
10003 (eval cmd))))
20908596
CD
10004 (t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
10005 (and (org-mode-p) (eq old-mode 'org-mode)
10006 (or (not (equal old-buffer (current-buffer)))
10007 (not (equal old-pos (point))))
10008 (org-mark-ring-push old-pos old-buffer))))
38f8646b 10009
86fbb8ca
CD
10010(defun org-file-apps-entry-match-against-dlink-p (entry)
10011 "This function returns non-nil if `entry' uses a regular
10012expression which should be matched against the whole link by
10013org-open-file.
10014
10015It assumes that is the case when the entry uses a regular
10016expression which has at least one grouping construct and the
10017action is either a lisp form or a command string containing
10018'%1', i.e. using at least one subexpression match as a
10019parameter."
10020 (let ((selector (car entry))
10021 (action (cdr entry)))
10022 (if (stringp selector)
10023 (and (> (regexp-opt-depth selector) 0)
10024 (or (and (stringp action)
10025 (string-match "%[0-9]" action))
10026 (consp action)))
10027 nil)))
10028
20908596
CD
10029(defun org-default-apps ()
10030 "Return the default applications for this operating system."
10031 (cond
10032 ((eq system-type 'darwin)
10033 org-file-apps-defaults-macosx)
10034 ((eq system-type 'windows-nt)
10035 org-file-apps-defaults-windowsnt)
10036 (t org-file-apps-defaults-gnu)))
38f8646b 10037
621f83e4
CD
10038(defun org-apps-regexp-alist (list &optional add-auto-mode)
10039 "Convert extensions to regular expressions in the cars of LIST.
10040Also, weed out any non-string entries, because the return value is used
10041only for regexp matching.
10042When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist'
10043point to the symbol `emacs', indicating that the file should
10044be opened in Emacs."
10045 (append
10046 (delq nil
10047 (mapcar (lambda (x)
10048 (if (not (stringp (car x)))
10049 nil
10050 (if (string-match "\\W" (car x))
10051 x
86fbb8ca 10052 (cons (concat "\\." (car x) "\\'") (cdr x)))))
621f83e4
CD
10053 list))
10054 (if add-auto-mode
10055 (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
10056
20908596
CD
10057(defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
10058(defun org-file-remote-p (file)
10059 "Test whether FILE specifies a location on a remote system.
10060Return non-nil if the location is indeed remote.
38f8646b 10061
20908596
CD
10062For example, the filename \"/user@host:/foo\" specifies a location
10063on the system \"/user@host:\"."
10064 (cond ((fboundp 'file-remote-p)
10065 (file-remote-p file))
10066 ((fboundp 'tramp-handle-file-remote-p)
10067 (tramp-handle-file-remote-p file))
10068 ((and (boundp 'ange-ftp-name-format)
10069 (string-match (car ange-ftp-name-format) file))
10070 t)
10071 (t nil)))
03f3cf35 10072
03f3cf35 10073
20908596 10074;;;; Refiling
7d58338e 10075
20908596
CD
10076(defun org-get-org-file ()
10077 "Read a filename, with default directory `org-directory'."
10078 (let ((default (or org-default-notes-file remember-data-file)))
10079 (read-file-name (format "File name [%s]: " default)
10080 (file-name-as-directory org-directory)
10081 default)))
7d58338e 10082
20908596
CD
10083(defun org-notes-order-reversed-p ()
10084 "Check if the current file should receive notes in reversed order."
7d58338e 10085 (cond
20908596
CD
10086 ((not org-reverse-note-order) nil)
10087 ((eq t org-reverse-note-order) t)
10088 ((not (listp org-reverse-note-order)) nil)
10089 (t (catch 'exit
10090 (let ((all org-reverse-note-order)
10091 entry)
10092 (while (setq entry (pop all))
10093 (if (string-match (car entry) buffer-file-name)
10094 (throw 'exit (cdr entry))))
10095 nil)))))
38f8646b 10096
20908596
CD
10097(defvar org-refile-target-table nil
10098 "The list of refile targets, created by `org-refile'.")
fbe6c10d 10099
20908596
CD
10100(defvar org-agenda-new-buffers nil
10101 "Buffers created to visit agenda files.")
03f3cf35 10102
86fbb8ca
CD
10103(defvar org-refile-cache nil
10104 "Cache for refile targets.")
10105
86fbb8ca
CD
10106(defvar org-refile-markers nil
10107 "All the markers used for caching refile locations.")
10108
10109(defun org-refile-marker (pos)
10110 "Get a new refile marker, but only if caching is in use."
10111 (if (not org-refile-use-cache)
10112 pos
10113 (let ((m (make-marker)))
10114 (move-marker m pos)
10115 (push m org-refile-markers)
10116 m)))
10117
10118(defun org-refile-cache-clear ()
10119 "Clear the refile cache and disable all the markers."
10120 (mapc (lambda (m) (move-marker m nil)) org-refile-markers)
10121 (setq org-refile-markers nil)
10122 (setq org-refile-cache nil)
10123 (message "Refile cache has been cleared"))
10124
10125(defun org-refile-cache-check-set (set)
10126 "Check if all the markers in the cache still have live buffers."
10127 (let (marker)
10128 (catch 'exit
10129 (while (and set (setq marker (nth 3 (pop set))))
10130 ;; if org-refile-use-outline-path is 'file, marker may be nil
10131 (when (and marker (null (marker-buffer marker)))
10132 (message "not found") (sit-for 3)
10133 (throw 'exit nil)))
10134 t)))
10135
10136(defun org-refile-cache-put (set &rest identifiers)
10137 "Push the refile targets SET into the cache, under IDENTIFIERS."
10138 (let* ((key (sha1 (prin1-to-string identifiers)))
10139 (entry (assoc key org-refile-cache)))
10140 (if entry
10141 (setcdr entry set)
10142 (push (cons key set) org-refile-cache))))
10143
10144(defun org-refile-cache-get (&rest identifiers)
10145 "Retrieve the cached value for refile targets given by IDENTIFIERS."
10146 (cond
10147 ((not org-refile-cache) nil)
10148 ((not org-refile-use-cache) (org-refile-cache-clear) nil)
10149 (t
10150 (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers))
10151 org-refile-cache))))
10152 (and set (org-refile-cache-check-set set) set)))))
10153
3ab2c837 10154(defun org-refile-get-targets (&optional default-buffer excluded-entries)
20908596 10155 "Produce a table with refile targets."
c8d0cf5c
CD
10156 (let ((case-fold-search nil)
10157 ;; otherwise org confuses "TODO" as a kw and "Todo" as a word
10158 (entries (or org-refile-targets '((nil . (:level . 1)))))
86fbb8ca 10159 targets tgs txt re files f desc descre fast-path-p level pos0)
db55f368 10160 (message "Getting targets...")
20908596
CD
10161 (with-current-buffer (or default-buffer (current-buffer))
10162 (while (setq entry (pop entries))
10163 (setq files (car entry) desc (cdr entry))
db55f368 10164 (setq fast-path-p nil)
20908596
CD
10165 (cond
10166 ((null files) (setq files (list (current-buffer))))
10167 ((eq files 'org-agenda-files)
10168 (setq files (org-agenda-files 'unrestricted)))
10169 ((and (symbolp files) (fboundp files))
10170 (setq files (funcall files)))
10171 ((and (symbolp files) (boundp files))
10172 (setq files (symbol-value files))))
10173 (if (stringp files) (setq files (list files)))
10174 (cond
10175 ((eq (car desc) :tag)
10176 (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
10177 ((eq (car desc) :todo)
10178 (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
10179 ((eq (car desc) :regexp)
10180 (setq descre (cdr desc)))
10181 ((eq (car desc) :level)
10182 (setq descre (concat "^\\*\\{" (number-to-string
10183 (if org-odd-levels-only
10184 (1- (* 2 (cdr desc)))
10185 (cdr desc)))
10186 "\\}[ \t]")))
10187 ((eq (car desc) :maxlevel)
db55f368 10188 (setq fast-path-p t)
20908596
CD
10189 (setq descre (concat "^\\*\\{1," (number-to-string
10190 (if org-odd-levels-only
10191 (1- (* 2 (cdr desc)))
10192 (cdr desc)))
10193 "\\}[ \t]")))
10194 (t (error "Bad refiling target description %s" desc)))
10195 (while (setq f (pop files))
81ad75af 10196 (with-current-buffer
8bfe682a 10197 (if (bufferp f) f (org-get-agenda-file-buffer f))
86fbb8ca
CD
10198 (or
10199 (setq tgs (org-refile-cache-get (buffer-file-name) descre))
10200 (progn
10201 (if (bufferp f) (setq f (buffer-file-name
10202 (buffer-base-buffer f))))
10203 (setq f (and f (expand-file-name f)))
10204 (if (eq org-refile-use-outline-path 'file)
10205 (push (list (file-name-nondirectory f) f nil nil) tgs))
10206 (save-excursion
10207 (save-restriction
10208 (widen)
10209 (goto-char (point-min))
10210 (while (re-search-forward descre nil t)
10211 (goto-char (setq pos0 (point-at-bol)))
10212 (catch 'next
10213 (when org-refile-target-verify-function
10214 (save-match-data
10215 (or (funcall org-refile-target-verify-function)
10216 (throw 'next t))))
3ab2c837
BG
10217 (when (and (looking-at org-complex-heading-regexp)
10218 (not (member (match-string 4) excluded-entries)))
86fbb8ca
CD
10219 (setq level (org-reduced-level
10220 (- (match-end 1) (match-beginning 1)))
10221 txt (org-link-display-format (match-string 4))
afe98dfa
CD
10222 txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt)
10223 re (format org-complex-heading-regexp-format
10224 (regexp-quote (match-string 4))))
86fbb8ca
CD
10225 (when org-refile-use-outline-path
10226 (setq txt (mapconcat
10227 'org-protect-slash
10228 (append
10229 (if (eq org-refile-use-outline-path
10230 'file)
10231 (list (file-name-nondirectory
10232 (buffer-file-name
10233 (buffer-base-buffer))))
10234 (if (eq org-refile-use-outline-path
10235 'full-file-path)
10236 (list (buffer-file-name
10237 (buffer-base-buffer)))))
10238 (org-get-outline-path fast-path-p
10239 level txt)
10240 (list txt))
10241 "/")))
10242 (push (list txt f re (org-refile-marker (point)))
10243 tgs)))
10244 (when (= (point) pos0)
10245 ;; verification function has not moved point
10246 (goto-char (point-at-eol))))))))
10247 (when org-refile-use-cache
10248 (org-refile-cache-put tgs (buffer-file-name) descre))
10249 (setq targets (append tgs targets))
10250 ))))
db55f368 10251 (message "Getting targets...done")
c8d0cf5c 10252 (nreverse targets)))
20908596 10253
621f83e4
CD
10254(defun org-protect-slash (s)
10255 (while (string-match "/" s)
10256 (setq s (replace-match "\\" t t s)))
10257 s)
ce4fdcb9 10258
db55f368
CD
10259(defvar org-olpa (make-vector 20 nil))
10260
10261(defun org-get-outline-path (&optional fastp level heading)
1bcdebed 10262 "Return the outline path to the current entry, as a list.
86fbb8ca
CD
10263
10264The parameters FASTP, LEVEL, and HEADING are for use by a scanner
1bcdebed 10265routine which makes outline path derivations for an entire file,
86fbb8ca 10266avoiding backtracing. Refile target collection makes use of that."
db55f368
CD
10267 (if fastp
10268 (progn
33306645 10269 (if (> level 19)
86fbb8ca 10270 (error "Outline path failure, more than 19 levels"))
db55f368
CD
10271 (loop for i from level upto 19 do
10272 (aset org-olpa i nil))
10273 (prog1
10274 (delq nil (append org-olpa nil))
10275 (aset org-olpa level heading)))
ed21c5c8 10276 (let (rtn case-fold-search)
db55f368 10277 (save-excursion
5dec9555
CD
10278 (save-restriction
10279 (widen)
10280 (while (org-up-heading-safe)
10281 (when (looking-at org-complex-heading-regexp)
10282 (push (org-match-string-no-properties 4) rtn)))
10283 rtn)))))
7d58338e 10284
1bcdebed 10285(defun org-format-outline-path (path &optional width prefix)
86fbb8ca 10286 "Format the outline path PATH for display.
1bcdebed
CD
10287Width is the maximum number of characters that is available.
10288Prefix is a prefix to be included in the returned string,
10289such as the file name."
10290 (setq width (or width 79))
10291 (if prefix (setq width (- width (length prefix))))
10292 (if (not path)
10293 (or prefix "")
10294 (let* ((nsteps (length path))
10295 (total-width (+ nsteps (apply '+ (mapcar 'length path))))
10296 (maxwidth (if (<= total-width width)
10297 10000 ;; everything fits
10298 ;; we need to shorten the level headings
10299 (/ (- width nsteps) nsteps)))
10300 (org-odd-levels-only nil)
10301 (n 0)
10302 (total (1+ (length prefix))))
10303 (setq maxwidth (max maxwidth 10))
10304 (concat prefix
10305 (mapconcat
10306 (lambda (h)
10307 (setq n (1+ n))
10308 (if (and (= n nsteps) (< maxwidth 10000))
10309 (setq maxwidth (- total-width total)))
10310 (if (< (length h) maxwidth)
10311 (progn (setq total (+ total (length h) 1)) h)
10312 (setq h (substring h 0 (- maxwidth 2))
10313 total (+ total maxwidth 1))
10314 (if (string-match "[ \t]+\\'" h)
10315 (setq h (substring h 0 (match-beginning 0))))
10316 (setq h (concat h "..")))
10317 (org-add-props h nil 'face
10318 (nth (% (1- n) org-n-level-faces)
10319 org-level-faces))
10320 h)
10321 path "/")))))
10322
10323(defun org-display-outline-path (&optional file current)
10324 "Display the current outline path in the echo area."
10325 (interactive "P")
ed21c5c8
CD
10326 (let* ((bfn (buffer-file-name (buffer-base-buffer)))
10327 (case-fold-search nil)
10328 (path (and (org-mode-p) (org-get-outline-path))))
1bcdebed
CD
10329 (if current (setq path (append path
10330 (save-excursion
10331 (org-back-to-heading t)
10332 (if (looking-at org-complex-heading-regexp)
10333 (list (match-string 4)))))))
5dec9555
CD
10334 (message "%s"
10335 (org-format-outline-path
1bcdebed
CD
10336 path
10337 (1- (frame-width))
10338 (and file bfn (concat (file-name-nondirectory bfn) "/"))))))
10339
20908596
CD
10340(defvar org-refile-history nil
10341 "History for refiling operations.")
7d58338e 10342
c8d0cf5c
CD
10343(defvar org-after-refile-insert-hook nil
10344 "Hook run after `org-refile' has inserted its stuff at the new location.
10345Note that this is still *before* the stuff will be removed from
10346the *old* location.")
10347
86fbb8ca 10348(defvar org-capture-last-stored-marker)
c8d0cf5c 10349(defun org-refile (&optional goto default-buffer rfloc)
3ab2c837 10350 "Move the entry or entries at point to another heading.
20908596 10351The list of target headings is compiled using the information in
3ab2c837 10352`org-refile-targets', which see.
20908596 10353
3ab2c837
BG
10354At the target location, the entry is filed as a subitem of the target
10355heading. Depending on `org-reverse-note-order', the new subitem will
10356either be the first or the last subitem.
20908596 10357
93b62de8 10358If there is an active region, all entries in that region will be moved.
86fbb8ca 10359However, the region must fulfill the requirement that the first heading
93b62de8
CD
10360is the first one sets the top-level of the moved text - at most siblings
10361below it are allowed.
10362
3ab2c837
BG
10363With prefix arg GOTO, the command will only visit the target location
10364and not actually move anything.
10365
86fbb8ca 10366With a double prefix arg \\[universal-argument] \\[universal-argument], \
3ab2c837 10367go to the location where the last refiling operation has put the subtree.
8bfe682a 10368With a prefix argument of `2', refile to the running clock.
c8d0cf5c
CD
10369
10370RFLOC can be a refile location obtained in a different way.
10371
86fbb8ca
CD
10372See also `org-refile-use-outline-path' and `org-completion-use-ido'.
10373
10374If you are using target caching (see `org-refile-use-cache'),
10375You have to clear the target cache in order to find new targets.
3ab2c837
BG
10376This can be done with a 0 prefix (`C-0 C-c C-w') or a triple
10377prefix argument (`C-u C-u C-u C-c C-w')."
10378
20908596 10379 (interactive "P")
86fbb8ca
CD
10380 (if (member goto '(0 (64)))
10381 (org-refile-cache-clear)
10382 (let* ((cbuf (current-buffer))
10383 (regionp (org-region-active-p))
10384 (region-start (and regionp (region-beginning)))
10385 (region-end (and regionp (region-end)))
10386 (region-length (and regionp (- region-end region-start)))
10387 (filename (buffer-file-name (buffer-base-buffer cbuf)))
10388 pos it nbuf file re level reversed)
10389 (setq last-command nil)
10390 (when regionp
10391 (goto-char region-start)
10392 (or (bolp) (goto-char (point-at-bol)))
10393 (setq region-start (point))
10394 (unless (org-kill-is-subtree-p
10395 (buffer-substring region-start region-end))
10396 (error "The region is not a (sequence of) subtree(s)")))
10397 (if (equal goto '(16))
10398 (org-refile-goto-last-stored)
10399 (when (or
10400 (and (equal goto 2)
10401 org-clock-hd-marker (marker-buffer org-clock-hd-marker)
10402 (prog1
10403 (setq it (list (or org-clock-heading "running clock")
10404 (buffer-file-name
10405 (marker-buffer org-clock-hd-marker))
10406 ""
10407 (marker-position org-clock-hd-marker)))
10408 (setq goto nil)))
10409 (setq it (or rfloc
10410 (save-excursion
10411 (org-refile-get-location
3ab2c837 10412 (if goto "Goto" "Refile to") default-buffer
86fbb8ca
CD
10413 org-refile-allow-creating-parent-nodes)))))
10414 (setq file (nth 1 it)
10415 re (nth 2 it)
10416 pos (nth 3 it))
10417 (if (and (not goto)
10418 pos
10419 (equal (buffer-file-name) file)
10420 (if regionp
10421 (and (>= pos region-start)
10422 (<= pos region-end))
10423 (and (>= pos (point))
10424 (< pos (save-excursion
10425 (org-end-of-subtree t t))))))
10426 (error "Cannot refile to position inside the tree or region"))
10427
10428 (setq nbuf (or (find-buffer-visiting file)
10429 (find-file-noselect file)))
10430 (if goto
93b62de8 10431 (progn
c3313451 10432 (switch-to-buffer nbuf)
86fbb8ca
CD
10433 (goto-char pos)
10434 (org-show-context 'org-goto))
10435 (if regionp
10436 (progn
10437 (org-kill-new (buffer-substring region-start region-end))
10438 (org-save-markers-in-region region-start region-end))
10439 (org-copy-subtree 1 nil t))
10440 (with-current-buffer (setq nbuf (or (find-buffer-visiting file)
10441 (find-file-noselect file)))
10442 (setq reversed (org-notes-order-reversed-p))
10443 (save-excursion
10444 (save-restriction
10445 (widen)
10446 (if pos
10447 (progn
10448 (goto-char pos)
3ab2c837 10449 (looking-at org-outline-regexp)
86fbb8ca
CD
10450 (setq level (org-get-valid-level (funcall outline-level) 1))
10451 (goto-char
10452 (if reversed
10453 (or (outline-next-heading) (point-max))
10454 (or (save-excursion (org-get-next-sibling))
10455 (org-end-of-subtree t t)
10456 (point-max)))))
10457 (setq level 1)
10458 (if (not reversed)
10459 (goto-char (point-max))
10460 (goto-char (point-min))
10461 (or (outline-next-heading) (goto-char (point-max)))))
10462 (if (not (bolp)) (newline))
10463 (org-paste-subtree level)
10464 (when org-log-refile
10465 (org-add-log-setup 'refile nil nil 'findpos
10466 org-log-refile)
10467 (unless (eq org-log-refile 'note)
10468 (save-excursion (org-add-log-note))))
10469 (and org-auto-align-tags (org-set-tags nil t))
10470 (bookmark-set "org-refile-last-stored")
10471 ;; If we are refiling for capture, make sure that the
10472 ;; last-capture pointers point here
10473 (when (org-bound-and-true-p org-refile-for-capture)
10474 (bookmark-set "org-capture-last-stored-marker")
10475 (move-marker org-capture-last-stored-marker (point)))
10476 (if (fboundp 'deactivate-mark) (deactivate-mark))
10477 (run-hooks 'org-after-refile-insert-hook))))
10478 (if regionp
10479 (delete-region (point) (+ (point) region-length))
10480 (org-cut-subtree))
10481 (when (featurep 'org-inlinetask)
10482 (org-inlinetask-remove-END-maybe))
10483 (setq org-markers-to-move nil)
10484 (message "Refiled to \"%s\" in file %s" (car it) file)))))))
20908596
CD
10485
10486(defun org-refile-goto-last-stored ()
10487 "Go to the location where the last refile was stored."
38f8646b 10488 (interactive)
20908596
CD
10489 (bookmark-jump "org-refile-last-stored")
10490 (message "This is the location of the last refile"))
38f8646b 10491
c8d0cf5c 10492(defun org-refile-get-location (&optional prompt default-buffer new-nodes)
3ab2c837
BG
10493 "Prompt the user for a refile location, using PROMPT.
10494PROMPT should not be suffixed with a colon and a space, because
10495this function appends the default value from
10496`org-refile-history' automatically, if that is not empty."
20908596 10497 (let ((org-refile-targets org-refile-targets)
3ab2c837
BG
10498 (org-refile-use-outline-path org-refile-use-outline-path)
10499 excluded-entries)
10500 (when (and (eq major-mode 'org-mode)
10501 (not org-refile-use-cache))
10502 (org-map-tree
10503 (lambda()
10504 (setq excluded-entries
10505 (append excluded-entries (list (org-get-heading t t)))))))
10506 (setq org-refile-target-table
10507 (org-refile-get-targets default-buffer excluded-entries)))
20908596
CD
10508 (unless org-refile-target-table
10509 (error "No refile targets"))
3ab2c837
BG
10510 (let* ((prompt (concat prompt
10511 (and (car org-refile-history)
10512 (concat " (default " (car org-refile-history) ")"))
10513 ": "))
10514 (cbuf (current-buffer))
10515 (partial-completion-mode nil)
bb31cb31 10516 (cfn (buffer-file-name (buffer-base-buffer cbuf)))
d60b1ba1
CD
10517 (cfunc (if (and org-refile-use-outline-path
10518 org-outline-path-complete-in-steps)
b349f79f 10519 'org-olpath-completing-read
54a0dee5 10520 'org-icompleting-read))
b349f79f 10521 (extra (if org-refile-use-outline-path "/" ""))
bb31cb31 10522 (filename (and cfn (expand-file-name cfn)))
20908596
CD
10523 (tbl (mapcar
10524 (lambda (x)
c8d0cf5c
CD
10525 (if (and (not (member org-refile-use-outline-path
10526 '(file full-file-path)))
10527 (not (equal filename (nth 1 x))))
b349f79f
CD
10528 (cons (concat (car x) extra " ("
10529 (file-name-nondirectory (nth 1 x)) ")")
20908596 10530 (cdr x))
b349f79f 10531 (cons (concat (car x) extra) (cdr x))))
20908596 10532 org-refile-target-table))
c8d0cf5c
CD
10533 (completion-ignore-case t)
10534 pa answ parent-target child parent old-hist)
10535 (setq old-hist org-refile-history)
10536 (setq answ (funcall cfunc prompt tbl nil (not new-nodes)
3ab2c837 10537 nil 'org-refile-history (car org-refile-history)))
c8d0cf5c 10538 (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
afe98dfa 10539 (org-refile-check-position pa)
f924a367 10540 (if pa
c8d0cf5c
CD
10541 (progn
10542 (when (or (not org-refile-history)
10543 (not (eq old-hist org-refile-history))
10544 (not (equal (car pa) (car org-refile-history))))
10545 (setq org-refile-history
10546 (cons (car pa) (if (assoc (car org-refile-history) tbl)
10547 org-refile-history
10548 (cdr org-refile-history))))
10549 (if (equal (car org-refile-history) (nth 1 org-refile-history))
10550 (pop org-refile-history)))
10551 pa)
ed21c5c8
CD
10552 (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
10553 (progn
10554 (setq parent (match-string 1 answ)
10555 child (match-string 2 answ))
10556 (setq parent-target (or (assoc parent tbl)
10557 (assoc (concat parent "/") tbl)))
10558 (when (and parent-target
10559 (or (eq new-nodes t)
10560 (and (eq new-nodes 'confirm)
10561 (y-or-n-p (format "Create new node \"%s\"? "
10562 child)))))
10563 (org-refile-new-child parent-target child)))
10564 (error "Invalid target location")))))
c8d0cf5c 10565
afe98dfa
CD
10566(defun org-refile-check-position (refile-pointer)
10567 "Check if the refile pointer matches the readline to which it points."
10568 (let* ((file (nth 1 refile-pointer))
10569 (re (nth 2 refile-pointer))
10570 (pos (nth 3 refile-pointer))
10571 buffer)
10572 (when (org-string-nw-p re)
10573 (setq buffer (if (markerp pos)
10574 (marker-buffer pos)
10575 (or (find-buffer-visiting file)
10576 (find-file-noselect file))))
10577 (with-current-buffer buffer
10578 (save-excursion
10579 (save-restriction
10580 (widen)
10581 (goto-char pos)
10582 (beginning-of-line 1)
10583 (unless (org-looking-at-p re)
3ab2c837 10584 (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))
afe98dfa 10585
c8d0cf5c
CD
10586(defun org-refile-new-child (parent-target child)
10587 "Use refile target PARENT-TARGET to add new CHILD below it."
10588 (unless parent-target
10589 (error "Cannot find parent for new node"))
10590 (let ((file (nth 1 parent-target))
10591 (pos (nth 3 parent-target))
10592 level)
10593 (with-current-buffer (or (find-buffer-visiting file)
10594 (find-file-noselect file))
10595 (save-excursion
10596 (save-restriction
10597 (widen)
10598 (if pos
10599 (goto-char pos)
10600 (goto-char (point-max))
10601 (if (not (bolp)) (newline)))
3ab2c837 10602 (when (looking-at org-outline-regexp)
c8d0cf5c
CD
10603 (setq level (funcall outline-level))
10604 (org-end-of-subtree t t))
10605 (org-back-over-empty-lines)
10606 (insert "\n" (make-string
10607 (if pos (org-get-valid-level level 1) 1) ?*)
10608 " " child "\n")
10609 (beginning-of-line 0)
10610 (list (concat (car parent-target) "/" child) file "" (point)))))))
7d58338e 10611
b349f79f
CD
10612(defun org-olpath-completing-read (prompt collection &rest args)
10613 "Read an outline path like a file name."
c8d0cf5c 10614 (let ((thetable collection)
54a0dee5 10615 (org-completion-use-ido nil) ; does not work with ido.
f924a367 10616 (org-completion-use-iswitchb nil)) ; or iswitchb
ce4fdcb9 10617 (apply
54a0dee5 10618 'org-icompleting-read prompt
b349f79f 10619 (lambda (string predicate &optional flag)
65c439fd 10620 (let (rtn r f (l (length string)))
b349f79f
CD
10621 (cond
10622 ((eq flag nil)
10623 ;; try completion
10624 (try-completion string thetable))
10625 ((eq flag t)
10626 ;; all-completions
10627 (setq rtn (all-completions string thetable predicate))
10628 (mapcar
10629 (lambda (x)
10630 (setq r (substring x l))
10631 (if (string-match " ([^)]*)$" x)
10632 (setq f (match-string 0 x))
10633 (setq f ""))
10634 (if (string-match "/" r)
10635 (concat string (substring r 0 (match-end 0)) f)
10636 x))
10637 rtn))
10638 ((eq flag 'lambda)
10639 ;; exact match?
10640 (assoc string thetable)))
10641 ))
10642 args)))
10643
20908596
CD
10644;;;; Dynamic blocks
10645
10646(defun org-find-dblock (name)
10647 "Find the first dynamic block with name NAME in the buffer.
10648If not found, stay at current position and return nil."
10649 (let (pos)
7d58338e 10650 (save-excursion
03f3cf35 10651 (goto-char (point-min))
3ab2c837 10652 (setq pos (and (re-search-forward (concat "^[ \t]*#\\+BEGIN:[ \t]+" name "\\>")
20908596
CD
10653 nil t)
10654 (match-beginning 0))))
10655 (if pos (goto-char pos))
10656 pos))
4b3a9ba7 10657
20908596 10658(defconst org-dblock-start-re
8d642074 10659 "^[ \t]*#\\+BEGIN:[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
8bfe682a 10660 "Matches the start line of a dynamic block, with parameters.")
891f4676 10661
8d642074 10662(defconst org-dblock-end-re "^[ \t]*#\\+END\\([: \t\r\n]\\|$\\)"
33306645 10663 "Matches the end of a dynamic block.")
8c6fb58b 10664
20908596
CD
10665(defun org-create-dblock (plist)
10666 "Create a dynamic block section, with parameters taken from PLIST.
33306645 10667PLIST must contain a :name entry which is used as name of the block."
8d642074
CD
10668 (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
10669 (end-of-line 1)
10670 (newline))
10671 (let ((col (current-column))
10672 (name (plist-get plist :name)))
20908596
CD
10673 (insert "#+BEGIN: " name)
10674 (while plist
10675 (if (eq (car plist) :name)
10676 (setq plist (cddr plist))
10677 (insert " " (prin1-to-string (pop plist)))))
8d642074 10678 (insert "\n\n" (make-string col ?\ ) "#+END:\n")
20908596 10679 (beginning-of-line -2)))
891f4676 10680
20908596
CD
10681(defun org-prepare-dblock ()
10682 "Prepare dynamic block for refresh.
10683This empties the block, puts the cursor at the insert position and returns
10684the property list including an extra property :name with the block name."
10685 (unless (looking-at org-dblock-start-re)
10686 (error "Not at a dynamic block"))
10687 (let* ((begdel (1+ (match-end 0)))
10688 (name (org-no-properties (match-string 1)))
10689 (params (append (list :name name)
10690 (read (concat "(" (match-string 3) ")")))))
8d642074
CD
10691 (save-excursion
10692 (beginning-of-line 1)
10693 (skip-chars-forward " \t")
10694 (setq params (plist-put params :indentation-column (current-column))))
20908596
CD
10695 (unless (re-search-forward org-dblock-end-re nil t)
10696 (error "Dynamic block not terminated"))
10697 (setq params
10698 (append params
10699 (list :content (buffer-substring
10700 begdel (match-beginning 0)))))
10701 (delete-region begdel (match-beginning 0))
10702 (goto-char begdel)
10703 (open-line 1)
10704 params))
891f4676 10705
20908596
CD
10706(defun org-map-dblocks (&optional command)
10707 "Apply COMMAND to all dynamic blocks in the current buffer.
10708If COMMAND is not given, use `org-update-dblock'."
ed21c5c8 10709 (let ((cmd (or command 'org-update-dblock)))
20908596
CD
10710 (save-excursion
10711 (goto-char (point-min))
10712 (while (re-search-forward org-dblock-start-re nil t)
ed21c5c8
CD
10713 (goto-char (match-beginning 0))
10714 (save-excursion
10715 (condition-case nil
10716 (funcall cmd)
10717 (error (message "Error during update of dynamic block"))))
20908596
CD
10718 (unless (re-search-forward org-dblock-end-re nil t)
10719 (error "Dynamic block not terminated"))))))
891f4676 10720
20908596
CD
10721(defun org-dblock-update (&optional arg)
10722 "User command for updating dynamic blocks.
10723Update the dynamic block at point. With prefix ARG, update all dynamic
10724blocks in the buffer."
10725 (interactive "P")
10726 (if arg
10727 (org-update-all-dblocks)
10728 (or (looking-at org-dblock-start-re)
10729 (org-beginning-of-dblock))
10730 (org-update-dblock)))
8c6fb58b 10731
20908596 10732(defun org-update-dblock ()
86fbb8ca 10733 "Update the dynamic block at point.
20908596
CD
10734This means to empty the block, parse for parameters and then call
10735the correct writing function."
acedf35c 10736 (interactive)
20908596
CD
10737 (save-window-excursion
10738 (let* ((pos (point))
10739 (line (org-current-line))
10740 (params (org-prepare-dblock))
10741 (name (plist-get params :name))
8d642074 10742 (indent (plist-get params :indentation-column))
20908596
CD
10743 (cmd (intern (concat "org-dblock-write:" name))))
10744 (message "Updating dynamic block `%s' at line %d..." name line)
10745 (funcall cmd params)
10746 (message "Updating dynamic block `%s' at line %d...done" name line)
8d642074
CD
10747 (goto-char pos)
10748 (when (and indent (> indent 0))
10749 (setq indent (make-string indent ?\ ))
10750 (save-excursion
10751 (org-beginning-of-dblock)
10752 (forward-line 1)
10753 (while (not (looking-at org-dblock-end-re))
10754 (insert indent)
10755 (beginning-of-line 2))
10756 (when (looking-at org-dblock-end-re)
10757 (and (looking-at "[ \t]+")
10758 (replace-match ""))
10759 (insert indent)))))))
8c6fb58b 10760
20908596
CD
10761(defun org-beginning-of-dblock ()
10762 "Find the beginning of the dynamic block at point.
33306645 10763Error if there is no such block at point."
20908596
CD
10764 (let ((pos (point))
10765 beg)
10766 (end-of-line 1)
10767 (if (and (re-search-backward org-dblock-start-re nil t)
10768 (setq beg (match-beginning 0))
10769 (re-search-forward org-dblock-end-re nil t)
10770 (> (match-end 0) pos))
10771 (goto-char beg)
10772 (goto-char pos)
10773 (error "Not in a dynamic block"))))
03f3cf35 10774
20908596
CD
10775(defun org-update-all-dblocks ()
10776 "Update all dynamic blocks in the buffer.
10777This function can be used in a hook."
acedf35c 10778 (interactive)
20908596
CD
10779 (when (org-mode-p)
10780 (org-map-dblocks 'org-update-dblock)))
03f3cf35 10781
891f4676 10782
20908596 10783;;;; Completion
891f4676 10784
20908596 10785(defconst org-additional-option-like-keywords
acedf35c
CD
10786 '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML:"
10787 "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook:"
ed21c5c8 10788 "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:"
acedf35c 10789 "LATEX_CLASS:" "LATEX_CLASS_OPTIONS:" "ATTR_LaTeX:"
c8d0cf5c
CD
10790 "BEGIN:" "END:"
10791 "ORGTBL" "TBLFM:" "TBLNAME:"
621f83e4
CD
10792 "BEGIN_EXAMPLE" "END_EXAMPLE"
10793 "BEGIN_QUOTE" "END_QUOTE"
10794 "BEGIN_VERSE" "END_VERSE"
c8d0cf5c 10795 "BEGIN_CENTER" "END_CENTER"
db55f368 10796 "BEGIN_SRC" "END_SRC"
acedf35c
CD
10797 "BEGIN_RESULT" "END_RESULT"
10798 "SOURCE:" "SRCNAME:" "FUNCTION:"
3ab2c837 10799 "RESULTS:" "DATA:"
acedf35c
CD
10800 "HEADER:" "HEADERS:"
10801 "BABEL:"
10802 "CATEGORY:" "COLUMNS:" "PROPERTY:"
10803 "CAPTION:" "LABEL:"
10804 "SETUPFILE:"
10805 "INCLUDE:"
10806 "BIND:"
10807 "MACRO:"))
891f4676 10808
b349f79f
CD
10809(defcustom org-structure-template-alist
10810 '(
ce4fdcb9 10811 ("s" "#+begin_src ?\n\n#+end_src"
b349f79f
CD
10812 "<src lang=\"?\">\n\n</src>")
10813 ("e" "#+begin_example\n?\n#+end_example"
10814 "<example>\n?\n</example>")
10815 ("q" "#+begin_quote\n?\n#+end_quote"
10816 "<quote>\n?\n</quote>")
10817 ("v" "#+begin_verse\n?\n#+end_verse"
10818 "<verse>\n?\n/verse>")
c8d0cf5c
CD
10819 ("c" "#+begin_center\n?\n#+end_center"
10820 "<center>\n?\n/center>")
b349f79f
CD
10821 ("l" "#+begin_latex\n?\n#+end_latex"
10822 "<literal style=\"latex\">\n?\n</literal>")
10823 ("L" "#+latex: "
10824 "<literal style=\"latex\">?</literal>")
10825 ("h" "#+begin_html\n?\n#+end_html"
10826 "<literal style=\"html\">\n?\n</literal>")
10827 ("H" "#+html: "
10828 "<literal style=\"html\">?</literal>")
10829 ("a" "#+begin_ascii\n?\n#+end_ascii")
10830 ("A" "#+ascii: ")
3ab2c837
BG
10831 ("i" "#+index: ?"
10832 "#+index: ?")
10833 ("I" "#+include %file ?"
b349f79f
CD
10834 "<include file=%file markup=\"?\">")
10835 )
10836 "Structure completion elements.
10837This is a list of abbreviation keys and values. The value gets inserted
86fbb8ca 10838if you type `<' followed by the key and then press the completion key,
b349f79f 10839usually `M-TAB'. %file will be replaced by a file name after prompting
3ab2c837
BG
10840for the file using completion. The cursor will be placed at the position
10841of the `?` in the template.
b349f79f
CD
10842There are two templates for each key, the first uses the original Org syntax,
10843the second uses Emacs Muse-like syntax tags. These Muse-like tags become
86fbb8ca 10844the default when the /org-mtags.el/ module has been loaded. See also the
ce4fdcb9 10845variable `org-mtags-prefer-muse-templates'.
b349f79f
CD
10846This is an experimental feature, it is undecided if it is going to stay in."
10847 :group 'org-completion
10848 :type '(repeat
10849 (string :tag "Key")
10850 (string :tag "Template")
10851 (string :tag "Muse Template")))
10852
10853(defun org-try-structure-completion ()
10854 "Try to complete a structure template before point.
10855This looks for strings like \"<e\" on an otherwise empty line and
10856expands them."
10857 (let ((l (buffer-substring (point-at-bol) (point)))
10858 a)
10859 (when (and (looking-at "[ \t]*$")
3ab2c837 10860 (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l)
b349f79f
CD
10861 (setq a (assoc (match-string 1 l) org-structure-template-alist)))
10862 (org-complete-expand-structure-template (+ -1 (point-at-bol)
10863 (match-beginning 1)) a)
10864 t)))
10865
10866(defun org-complete-expand-structure-template (start cell)
10867 "Expand a structure template."
ce4fdcb9 10868 (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates))
c8d0cf5c
CD
10869 (rpl (nth (if musep 2 1) cell))
10870 (ind ""))
b349f79f
CD
10871 (delete-region start (point))
10872 (when (string-match "\\`#\\+" rpl)
10873 (cond
10874 ((bolp))
10875 ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
c8d0cf5c 10876 (setq ind (buffer-substring (point-at-bol) (point))))
b349f79f
CD
10877 (t (newline))))
10878 (setq start (point))
10879 (if (string-match "%file" rpl)
ce4fdcb9 10880 (setq rpl (replace-match
b349f79f
CD
10881 (concat
10882 "\""
10883 (save-match-data
10884 (abbreviate-file-name (read-file-name "Include file: ")))
10885 "\"")
10886 t t rpl)))
c8d0cf5c
CD
10887 (setq rpl (mapconcat 'identity (split-string rpl "\n")
10888 (concat "\n" ind)))
b349f79f
CD
10889 (insert rpl)
10890 (if (re-search-backward "\\?" start t) (delete-char 1))))
ce4fdcb9 10891
20908596
CD
10892;;;; TODO, DEADLINE, Comments
10893
10894(defun org-toggle-comment ()
10895 "Change the COMMENT state of an entry."
10896 (interactive)
10897 (save-excursion
10898 (org-back-to-heading)
10899 (let (case-fold-search)
3ab2c837 10900 (if (looking-at (concat org-outline-regexp
20908596
CD
10901 "\\( *\\<" org-comment-string "\\>[ \t]*\\)"))
10902 (replace-match "" t t nil 1)
3ab2c837 10903 (if (looking-at org-outline-regexp)
20908596
CD
10904 (progn
10905 (goto-char (match-end 0))
10906 (insert org-comment-string " ")))))))
10907
10908(defvar org-last-todo-state-is-todo nil
10909 "This is non-nil when the last TODO state change led to a TODO state.
10910If the last change removed the TODO tag or switched to DONE, then
10911this is nil.")
10912
33306645 10913(defvar org-setting-tags nil) ; dynamically skipped
8c6fb58b 10914
c8d0cf5c
CD
10915(defvar org-todo-setup-filter-hook nil
10916 "Hook for functions that pre-filter todo specs.
86fbb8ca 10917Each function takes a todo spec and returns either nil or the spec
c8d0cf5c
CD
10918transformed into canonical form." )
10919
10920(defvar org-todo-get-default-hook nil
10921 "Hook for functions that get a default item for todo.
c8d0cf5c 10922Each function takes arguments (NEW-MARK OLD-MARK) and returns either
86fbb8ca 10923nil or a string to be used for the todo mark." )
c8d0cf5c 10924
93b62de8 10925(defvar org-agenda-headline-snapshot-before-repeat)
c8d0cf5c 10926
3ab2c837
BG
10927(defun org-current-effective-time ()
10928 "Return current time adjusted for `org-extend-today-until' variable"
10929 (let* ((ct (org-current-time))
10930 (dct (decode-time ct))
10931 (ct1
10932 (if (< (nth 2 dct) org-extend-today-until)
10933 (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
10934 ct)))
10935 ct1))
10936
10937(defun org-todo-yesterday (&optional arg)
10938 "Like `org-todo' but the time of change will be 23:59 of yesterday"
10939 (interactive "P")
10940 (let* ((hour (third (decode-time
10941 (org-current-time))))
10942 (org-extend-today-until (1+ hour)))
10943 (org-todo arg)))
10944
10945(defun org-agenda-todo-yesterday (&optional arg)
10946 "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday"
10947 (interactive "P")
10948 (let* ((hour (third (decode-time
10949 (org-current-time))))
10950 (org-extend-today-until (1+ hour)))
10951 (org-agenda-todo arg)))
10952
20908596
CD
10953(defun org-todo (&optional arg)
10954 "Change the TODO state of an item.
10955The state of an item is given by a keyword at the start of the heading,
10956like
10957 *** TODO Write paper
10958 *** DONE Call mom
10959
10960The different keywords are specified in the variable `org-todo-keywords'.
10961By default the available states are \"TODO\" and \"DONE\".
10962So for this example: when the item starts with TODO, it is changed to DONE.
10963When it starts with DONE, the DONE is removed. And when neither TODO nor
10964DONE are present, add TODO at the beginning of the heading.
10965
86fbb8ca
CD
10966With \\[universal-argument] prefix arg, use completion to determine the new \
10967state.
20908596 10968With numeric prefix arg, switch to that state.
86fbb8ca
CD
10969With a double \\[universal-argument] prefix, switch to the next set of TODO \
10970keywords (nextset).
10971With a triple \\[universal-argument] prefix, circumvent any state blocking.
20908596
CD
10972
10973For calling through lisp, arg is also interpreted in the following way:
10974'none -> empty state
10975\"\"(empty string) -> switch to empty state
10976'done -> switch to DONE
10977'nextset -> switch to the next set of keywords
10978'previousset -> switch to the previous set of keywords
10979\"WAITING\" -> switch to the specified keyword, but only if it
10980 really is a member of `org-todo-keywords'."
10981 (interactive "P")
65c439fd 10982 (if (equal arg '(16)) (setq arg 'nextset))
c8d0cf5c
CD
10983 (let ((org-blocker-hook org-blocker-hook)
10984 (case-fold-search nil))
6c817206
CD
10985 (when (equal arg '(64))
10986 (setq arg nil org-blocker-hook nil))
c8d0cf5c
CD
10987 (when (and org-blocker-hook
10988 (or org-inhibit-blocking
10989 (org-entry-get nil "NOBLOCKING")))
10990 (setq org-blocker-hook nil))
6c817206
CD
10991 (save-excursion
10992 (catch 'exit
8bfe682a 10993 (org-back-to-heading t)
3ab2c837 10994 (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
c8d0cf5c 10995 (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)"))
6c817206
CD
10996 (looking-at " *"))
10997 (let* ((match-data (match-data))
10998 (startpos (point-at-bol))
86fbb8ca 10999 (logging (save-match-data (org-entry-get nil "LOGGING" t t)))
6c817206
CD
11000 (org-log-done org-log-done)
11001 (org-log-repeat org-log-repeat)
11002 (org-todo-log-states org-todo-log-states)
11003 (this (match-string 1))
11004 (hl-pos (match-beginning 0))
11005 (head (org-get-todo-sequence-head this))
11006 (ass (assoc head org-todo-kwd-alist))
11007 (interpret (nth 1 ass))
11008 (done-word (nth 3 ass))
11009 (final-done-word (nth 4 ass))
11010 (last-state (or this ""))
11011 (completion-ignore-case t)
11012 (member (member this org-todo-keywords-1))
11013 (tail (cdr member))
11014 (state (cond
11015 ((and org-todo-key-trigger
11016 (or (and (equal arg '(4))
11017 (eq org-use-fast-todo-selection 'prefix))
11018 (and (not arg) org-use-fast-todo-selection
11019 (not (eq org-use-fast-todo-selection
11020 'prefix)))))
11021 ;; Use fast selection
11022 (org-fast-todo-selection))
11023 ((and (equal arg '(4))
11024 (or (not org-use-fast-todo-selection)
11025 (not org-todo-key-trigger)))
11026 ;; Read a state with completion
54a0dee5 11027 (org-icompleting-read
6c817206
CD
11028 "State: " (mapcar (lambda(x) (list x))
11029 org-todo-keywords-1)
11030 nil t))
11031 ((eq arg 'right)
20908596 11032 (if this
6c817206
CD
11033 (if tail (car tail) nil)
11034 (car org-todo-keywords-1)))
11035 ((eq arg 'left)
11036 (if (equal member org-todo-keywords-1)
11037 nil
11038 (if this
11039 (nth (- (length org-todo-keywords-1)
11040 (length tail) 2)
11041 org-todo-keywords-1)
11042 (org-last org-todo-keywords-1))))
11043 ((and (eq org-use-fast-todo-selection t) (equal arg '(4))
11044 (setq arg nil))) ; hack to fall back to cycling
11045 (arg
11046 ;; user or caller requests a specific state
11047 (cond
11048 ((equal arg "") nil)
11049 ((eq arg 'none) nil)
11050 ((eq arg 'done) (or done-word (car org-done-keywords)))
11051 ((eq arg 'nextset)
20908596 11052 (or (car (cdr (member head org-todo-heads)))
6c817206
CD
11053 (car org-todo-heads)))
11054 ((eq arg 'previousset)
11055 (let ((org-todo-heads (reverse org-todo-heads)))
11056 (or (car (cdr (member head org-todo-heads)))
11057 (car org-todo-heads))))
11058 ((car (member arg org-todo-keywords-1)))
8bfe682a
CD
11059 ((stringp arg)
11060 (error "State `%s' not valid in this file" arg))
6c817206
CD
11061 ((nth (1- (prefix-numeric-value arg))
11062 org-todo-keywords-1))))
11063 ((null member) (or head (car org-todo-keywords-1)))
11064 ((equal this final-done-word) nil) ;; -> make empty
11065 ((null tail) nil) ;; -> first entry
6c817206
CD
11066 ((memq interpret '(type priority))
11067 (if (eq this-command last-command)
11068 (car tail)
11069 (if (> (length tail) 0)
11070 (or done-word (car org-done-keywords))
11071 nil)))
c8d0cf5c
CD
11072 (t
11073 (car tail))))
11074 (state (or
11075 (run-hook-with-args-until-success
11076 'org-todo-get-default-hook state last-state)
11077 state))
6c817206
CD
11078 (next (if state (concat " " state " ") " "))
11079 (change-plist (list :type 'todo-state-change :from this :to state
11080 :position startpos))
11081 dolog now-done-p)
11082 (when org-blocker-hook
11083 (setq org-last-todo-state-is-todo
11084 (not (member this org-done-keywords)))
11085 (unless (save-excursion
11086 (save-match-data
3ab2c837
BG
11087 (org-with-wide-buffer
11088 (run-hook-with-args-until-failure
11089 'org-blocker-hook change-plist))))
11090 (if (org-called-interactively-p 'interactive)
6c817206
CD
11091 (error "TODO state change from %s to %s blocked" this state)
11092 ;; fail silently
11093 (message "TODO state change from %s to %s blocked" this state)
11094 (throw 'exit nil))))
11095 (store-match-data match-data)
11096 (replace-match next t t)
11097 (unless (pos-visible-in-window-p hl-pos)
11098 (message "TODO state changed to %s" (org-trim next)))
11099 (unless head
11100 (setq head (org-get-todo-sequence-head state)
11101 ass (assoc head org-todo-kwd-alist)
11102 interpret (nth 1 ass)
11103 done-word (nth 3 ass)
11104 final-done-word (nth 4 ass)))
11105 (when (memq arg '(nextset previousset))
11106 (message "Keyword-Set %d/%d: %s"
11107 (- (length org-todo-sets) -1
11108 (length (memq (assoc state org-todo-sets) org-todo-sets)))
11109 (length org-todo-sets)
11110 (mapconcat 'identity (assoc state org-todo-sets) " ")))
65c439fd 11111 (setq org-last-todo-state-is-todo
6c817206
CD
11112 (not (member state org-done-keywords)))
11113 (setq now-done-p (and (member state org-done-keywords)
11114 (not (member this org-done-keywords))))
11115 (and logging (org-local-logging logging))
11116 (when (and (or org-todo-log-states org-log-done)
c8d0cf5c 11117 (not (eq org-inhibit-logging t))
6c817206
CD
11118 (not (memq arg '(nextset previousset))))
11119 ;; we need to look at recording a time and note
11120 (setq dolog (or (nth 1 (assoc state org-todo-log-states))
11121 (nth 2 (assoc this org-todo-log-states))))
c8d0cf5c
CD
11122 (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
11123 (setq dolog 'time))
6c817206
CD
11124 (when (and state
11125 (member state org-not-done-keywords)
11126 (not (member this org-not-done-keywords)))
11127 ;; This is now a todo state and was not one before
11128 ;; If there was a CLOSED time stamp, get rid of it.
11129 (org-add-planning-info nil nil 'closed))
11130 (when (and now-done-p org-log-done)
11131 ;; It is now done, and it was not done before
3ab2c837 11132 (org-add-planning-info 'closed (org-current-effective-time))
6c817206 11133 (if (and (not dolog) (eq 'note org-log-done))
c8d0cf5c 11134 (org-add-log-setup 'done state this 'findpos 'note)))
6c817206
CD
11135 (when (and state dolog)
11136 ;; This is a non-nil state, and we need to log it
c8d0cf5c 11137 (org-add-log-setup 'state state this 'findpos dolog)))
6c817206
CD
11138 ;; Fixup tag positioning
11139 (org-todo-trigger-tag-changes state)
11140 (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
11141 (when org-provide-todo-statistics
11142 (org-update-parent-todo-statistics))
11143 (run-hooks 'org-after-todo-state-change-hook)
11144 (if (and arg (not (member state org-done-keywords)))
11145 (setq head (org-get-todo-sequence-head state)))
11146 (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
11147 ;; Do we need to trigger a repeat?
11148 (when now-done-p
11149 (when (boundp 'org-agenda-headline-snapshot-before-repeat)
11150 ;; This is for the agenda, take a snapshot of the headline.
11151 (save-match-data
11152 (setq org-agenda-headline-snapshot-before-repeat
11153 (org-get-heading))))
11154 (org-auto-repeat-maybe state))
11155 ;; Fixup cursor location if close to the keyword
11156 (if (and (outline-on-heading-p)
11157 (not (bolp))
11158 (save-excursion (beginning-of-line 1)
11159 (looking-at org-todo-line-regexp))
11160 (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
11161 (progn
11162 (goto-char (or (match-end 2) (match-end 1)))
c8d0cf5c 11163 (and (looking-at " ") (just-one-space))))
6c817206
CD
11164 (when org-trigger-hook
11165 (save-excursion
11166 (run-hook-with-args 'org-trigger-hook change-plist))))))))
fbe6c10d 11167
c8d0cf5c 11168(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
d6685abc
CD
11169 "Block turning an entry into a TODO, using the hierarchy.
11170This checks whether the current task should be blocked from state
11171changes. Such blocking occurs when:
11172
11173 1. The task has children which are not all in a completed state.
11174
11175 2. A task has a parent with the property :ORDERED:, and there
11176 are siblings prior to the current task with incomplete
c8d0cf5c
CD
11177 status.
11178
11179 3. The parent of the task is blocked because it has siblings that should
11180 be done first, or is child of a block grandparent TODO entry."
11181
ed21c5c8
CD
11182 (if (not org-enforce-todo-dependencies)
11183 t ; if locally turned off don't block
11184 (catch 'dont-block
11185 ;; If this is not a todo state change, or if this entry is already DONE,
11186 ;; do not block
11187 (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
11188 (member (plist-get change-plist :from)
11189 (cons 'done org-done-keywords))
11190 (member (plist-get change-plist :to)
11191 (cons 'todo org-not-done-keywords))
11192 (not (plist-get change-plist :to)))
11193 (throw 'dont-block t))
11194 ;; If this task has children, and any are undone, it's blocked
11195 (save-excursion
11196 (org-back-to-heading t)
11197 (let ((this-level (funcall outline-level)))
11198 (outline-next-heading)
11199 (let ((child-level (funcall outline-level)))
11200 (while (and (not (eobp))
11201 (> child-level this-level))
11202 ;; this todo has children, check whether they are all
11203 ;; completed
11204 (if (and (not (org-entry-is-done-p))
11205 (org-entry-is-todo-p))
11206 (throw 'dont-block nil))
11207 (outline-next-heading)
11208 (setq child-level (funcall outline-level))))))
11209 ;; Otherwise, if the task's parent has the :ORDERED: property, and
11210 ;; any previous siblings are undone, it's blocked
11211 (save-excursion
11212 (org-back-to-heading t)
11213 (let* ((pos (point))
11214 (parent-pos (and (org-up-heading-safe) (point))))
c8d0cf5c 11215 (if (not parent-pos) (throw 'dont-block t)) ; no parent
86fbb8ca 11216 (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
c8d0cf5c
CD
11217 (forward-line 1)
11218 (re-search-forward org-not-done-heading-regexp pos t))
ed21c5c8 11219 (throw 'dont-block nil)) ; block, there is an older sibling not done.
91af3942 11220 ;; Search further up the hierarchy, to see if an ancestor is blocked
ed21c5c8
CD
11221 (while t
11222 (goto-char parent-pos)
11223 (if (not (looking-at org-not-done-heading-regexp))
11224 (throw 'dont-block t)) ; do not block, parent is not a TODO
11225 (setq pos (point))
11226 (setq parent-pos (and (org-up-heading-safe) (point)))
11227 (if (not parent-pos) (throw 'dont-block t)) ; no parent
86fbb8ca 11228 (when (and (org-not-nil (org-entry-get (point) "ORDERED"))
ed21c5c8
CD
11229 (forward-line 1)
11230 (re-search-forward org-not-done-heading-regexp pos t))
11231 (throw 'dont-block nil)))))))) ; block, older sibling not done.
c8d0cf5c
CD
11232
11233(defcustom org-track-ordered-property-with-tag nil
11234 "Should the ORDERED property also be shown as a tag?
11235The ORDERED property decides if an entry should require subtasks to be
11236completed in sequence. Since a property is not very visible, setting
11237this option means that toggling the ORDERED property with the command
11238`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is
11239not relevant for the behavior, but it makes things more visible.
11240
11241Note that toggling the tag with tags commands will not change the property
11242and therefore not influence behavior!
11243
11244This can be t, meaning the tag ORDERED should be used, It can also be a
11245string to select a different tag for this task."
11246 :group 'org-todo
11247 :type '(choice
11248 (const :tag "No tracking" nil)
11249 (const :tag "Track with ORDERED tag" t)
11250 (string :tag "Use other tag")))
d6685abc 11251
a2a2e7fb 11252(defun org-toggle-ordered-property ()
c8d0cf5c
CD
11253 "Toggle the ORDERED property of the current entry.
11254For better visibility, you can track the value of this property with a tag.
11255See variable `org-track-ordered-property-with-tag'."
a2a2e7fb 11256 (interactive)
c8d0cf5c
CD
11257 (let* ((t1 org-track-ordered-property-with-tag)
11258 (tag (and t1 (if (stringp t1) t1 "ORDERED"))))
11259 (save-excursion
11260 (org-back-to-heading)
11261 (if (org-entry-get nil "ORDERED")
11262 (progn
11263 (org-delete-property "ORDERED")
11264 (and tag (org-toggle-tag tag 'off))
11265 (message "Subtasks can be completed in arbitrary order"))
11266 (org-entry-put nil "ORDERED" "t")
11267 (and tag (org-toggle-tag tag 'on))
11268 (message "Subtasks must be completed in sequence")))))
11269
11270(defvar org-blocked-by-checkboxes) ; dynamically scoped
6c817206
CD
11271(defun org-block-todo-from-checkboxes (change-plist)
11272 "Block turning an entry into a TODO, using checkboxes.
11273This checks whether the current task should be blocked from state
8bfe682a 11274changes because there are unchecked boxes in this entry."
ed21c5c8
CD
11275 (if (not org-enforce-todo-checkbox-dependencies)
11276 t ; if locally turned off don't block
11277 (catch 'dont-block
11278 ;; If this is not a todo state change, or if this entry is already DONE,
11279 ;; do not block
11280 (when (or (not (eq (plist-get change-plist :type) 'todo-state-change))
11281 (member (plist-get change-plist :from)
11282 (cons 'done org-done-keywords))
11283 (member (plist-get change-plist :to)
11284 (cons 'todo org-not-done-keywords))
11285 (not (plist-get change-plist :to)))
11286 (throw 'dont-block t))
11287 ;; If this task has checkboxes that are not checked, it's blocked
11288 (save-excursion
11289 (org-back-to-heading t)
11290 (let ((beg (point)) end)
11291 (outline-next-heading)
11292 (setq end (point))
11293 (goto-char beg)
11294 (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]"
11295 end t)
11296 (progn
11297 (if (boundp 'org-blocked-by-checkboxes)
11298 (setq org-blocked-by-checkboxes t))
11299 (throw 'dont-block nil)))))
11300 t))) ; do not block
11301
11302(defun org-entry-blocked-p ()
11303 "Is the current entry blocked?"
11304 (if (org-entry-get nil "NOBLOCKING")
11305 nil ;; Never block this entry
11306 (not
11307 (run-hook-with-args-until-failure
11308 'org-blocker-hook
11309 (list :type 'todo-state-change
11310 :position (point)
11311 :from 'todo
11312 :to 'done)))))
6c817206 11313
54a0dee5
CD
11314(defun org-update-statistics-cookies (all)
11315 "Update the statistics cookie, either from TODO or from checkboxes.
11316This should be called with the cursor in a line with a statistics cookie."
11317 (interactive "P")
11318 (if all
11319 (progn
11320 (org-update-checkbox-count 'all)
11321 (org-map-entries 'org-update-parent-todo-statistics))
11322 (if (not (org-on-heading-p))
11323 (org-update-checkbox-count)
11324 (let ((pos (move-marker (make-marker) (point)))
11325 end l1 l2)
11326 (ignore-errors (org-back-to-heading t))
11327 (if (not (org-on-heading-p))
11328 (org-update-checkbox-count)
11329 (setq l1 (org-outline-level))
11330 (setq end (save-excursion
11331 (outline-next-heading)
11332 (if (org-on-heading-p) (setq l2 (org-outline-level)))
11333 (point)))
ed21c5c8
CD
11334 (if (and (save-excursion
11335 (re-search-forward
11336 "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t))
54a0dee5
CD
11337 (not (save-excursion (re-search-forward
11338 ":COOKIE_DATA:.*\\<todo\\>" end t))))
11339 (org-update-checkbox-count)
11340 (if (and l2 (> l2 l1))
11341 (progn
11342 (goto-char end)
11343 (org-update-parent-todo-statistics))
ed21c5c8
CD
11344 (goto-char pos)
11345 (beginning-of-line 1)
11346 (while (re-search-forward
11347 "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)"
11348 (point-at-eol) t)
11349 (replace-match (if (match-end 2) "[100%]" "[0/0]") t t)))))
54a0dee5
CD
11350 (goto-char pos)
11351 (move-marker pos nil)))))
f924a367 11352
c8d0cf5c 11353(defvar org-entry-property-inherited-from) ;; defined below
b349f79f 11354(defun org-update-parent-todo-statistics ()
c8d0cf5c
CD
11355 "Update any statistics cookie in the parent of the current headline.
11356When `org-hierarchical-todo-statistics' is nil, statistics will cover
11357the entire subtree and this will travel up the hierarchy and update
11358statistics everywhere."
3ab2c837
BG
11359 (let* ((prop (save-excursion (org-up-heading-safe)
11360 (org-entry-get nil "COOKIE_DATA" 'inherit)))
c8d0cf5c 11361 (recursive (or (not org-hierarchical-todo-statistics)
3ab2c837
BG
11362 (and prop (string-match "\\<recursive\\>" prop))))
11363 (lim (or (and prop (marker-position org-entry-property-inherited-from))
11364 0))
c8d0cf5c
CD
11365 (first t)
11366 (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
8d642074 11367 level ltoggle l1 new ndel
3ab2c837
BG
11368 (cnt-all 0) (cnt-done 0) is-percent kwd
11369 checkbox-beg ov ovs ove cookie-present)
b349f79f
CD
11370 (catch 'exit
11371 (save-excursion
c8d0cf5c 11372 (beginning-of-line 1)
3ab2c837
BG
11373 (setq ltoggle (funcall outline-level))
11374 ;; Three situations are to consider:
11375
11376 ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up
11377 ;; to the top-level ancestor on the headline;
11378
11379 ;; 2. If parent has "recursive" property, repeat up to the
11380 ;; headline setting that property, taking inheritance into
11381 ;; account;
11382
11383 ;; 3. Else, move up to direct parent and proceed only once.
c8d0cf5c
CD
11384 (while (and (setq level (org-up-heading-safe))
11385 (or recursive first)
11386 (>= (point) lim))
8bfe682a 11387 (setq first nil cookie-present nil)
c8d0cf5c
CD
11388 (unless (and level
11389 (not (string-match
11390 "\\<checkbox\\>"
3ab2c837
BG
11391 (downcase (or (org-entry-get nil "COOKIE_DATA")
11392 "")))))
c8d0cf5c
CD
11393 (throw 'exit nil))
11394 (while (re-search-forward box-re (point-at-eol) t)
11395 (setq cnt-all 0 cnt-done 0 cookie-present t)
3ab2c837 11396 (setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
c8d0cf5c
CD
11397 (save-match-data
11398 (unless (outline-next-heading) (throw 'exit nil))
11399 (while (and (looking-at org-complex-heading-regexp)
3ab2c837
BG
11400 (> (setq l1 (length (match-string 1))) level))
11401 (setq kwd (and (or recursive (= l1 ltoggle))
11402 (match-string 2)))
11403 (if (or (eq org-provide-todo-statistics 'all-headlines)
11404 (and (listp org-provide-todo-statistics)
11405 (or (member kwd org-provide-todo-statistics)
11406 (member kwd org-done-keywords))))
11407 (setq cnt-all (1+ cnt-all))
11408 (if (eq org-provide-todo-statistics t)
11409 (and kwd (setq cnt-all (1+ cnt-all)))))
11410 (and (member kwd org-done-keywords)
11411 (setq cnt-done (1+ cnt-done)))
11412 (outline-next-heading)))
8d642074 11413 (setq new
3ab2c837
BG
11414 (if is-percent
11415 (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
11416 (format "[%d/%d]" cnt-done cnt-all))
11417 ndel (- (match-end 0) checkbox-beg))
11418 ;; handle overlays when updating cookie from column view
11419 (when (setq ov (car (overlays-at checkbox-beg)))
11420 (setq ovs (overlay-start ov) ove (overlay-end ov))
11421 (delete-overlay ov))
11422 (goto-char checkbox-beg)
8d642074 11423 (insert new)
3ab2c837
BG
11424 (delete-region (point) (+ (point) ndel))
11425 (when org-auto-align-tags (org-fix-tags-on-the-fly))
11426 (when ov (move-overlay ov ovs ove)))
8bfe682a
CD
11427 (when cookie-present
11428 (run-hook-with-args 'org-after-todo-statistics-hook
11429 cnt-done (- cnt-all cnt-done))))))
c8d0cf5c 11430 (run-hooks 'org-todo-statistics-hook)))
b349f79f
CD
11431
11432(defvar org-after-todo-statistics-hook nil
11433 "Hook that is called after a TODO statistics cookie has been updated.
11434Each function is called with two arguments: the number of not-done entries
11435and the number of done entries.
11436
11437For example, the following function, when added to this hook, will switch
11438an entry to DONE when all children are done, and back to TODO when new
11439entries are set to a TODO status. Note that this hook is only called
11440when there is a statistics cookie in the headline!
11441
11442 (defun org-summary-todo (n-done n-not-done)
11443 \"Switch entry to DONE when all subentries are done, to TODO otherwise.\"
11444 (let (org-log-done org-log-states) ; turn off logging
11445 (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\"))))
11446")
71d35b24 11447
c8d0cf5c
CD
11448(defvar org-todo-statistics-hook nil
11449 "Hook that is run whenever Org thinks TODO statistics should be updated.
8bfe682a 11450This hook runs even if there is no statistics cookie present, in which case
c8d0cf5c
CD
11451`org-after-todo-statistics-hook' would not run.")
11452
71d35b24
CD
11453(defun org-todo-trigger-tag-changes (state)
11454 "Apply the changes defined in `org-todo-state-tags-triggers'."
11455 (let ((l org-todo-state-tags-triggers)
11456 changes)
11457 (when (or (not state) (equal state ""))
11458 (setq changes (append changes (cdr (assoc "" l)))))
11459 (when (and (stringp state) (> (length state) 0))
11460 (setq changes (append changes (cdr (assoc state l)))))
11461 (when (member state org-not-done-keywords)
11462 (setq changes (append changes (cdr (assoc 'todo l)))))
11463 (when (member state org-done-keywords)
11464 (setq changes (append changes (cdr (assoc 'done l)))))
11465 (dolist (c changes)
11466 (org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
ce4fdcb9 11467
20908596
CD
11468(defun org-local-logging (value)
11469 "Get logging settings from a property VALUE."
11470 (let* (words w a)
11471 ;; directly set the variables, they are already local.
11472 (setq org-log-done nil
11473 org-log-repeat nil
11474 org-todo-log-states nil)
11475 (setq words (org-split-string value))
11476 (while (setq w (pop words))
11477 (cond
11478 ((setq a (assoc w org-startup-options))
11479 (and (member (nth 1 a) '(org-log-done org-log-repeat))
11480 (set (nth 1 a) (nth 2 a))))
11481 ((setq a (org-extract-log-state-settings w))
11482 (and (member (car a) org-todo-keywords-1)
11483 (push a org-todo-log-states)))))))
03f3cf35 11484
20908596
CD
11485(defun org-get-todo-sequence-head (kwd)
11486 "Return the head of the TODO sequence to which KWD belongs.
11487If KWD is not set, check if there is a text property remembering the
11488right sequence."
11489 (let (p)
11490 (cond
11491 ((not kwd)
11492 (or (get-text-property (point-at-bol) 'org-todo-head)
03f3cf35 11493 (progn
20908596
CD
11494 (setq p (next-single-property-change (point-at-bol) 'org-todo-head
11495 nil (point-at-eol)))
11496 (get-text-property p 'org-todo-head))))
11497 ((not (member kwd org-todo-keywords-1))
11498 (car org-todo-keywords-1))
11499 (t (nth 2 (assoc kwd org-todo-kwd-alist))))))
891f4676 11500
20908596
CD
11501(defun org-fast-todo-selection ()
11502 "Fast TODO keyword selection with single keys.
11503Returns the new TODO keyword, or nil if no state change should occur."
11504 (let* ((fulltable org-todo-key-alist)
11505 (done-keywords org-done-keywords) ;; needed for the faces.
11506 (maxlen (apply 'max (mapcar
11507 (lambda (x)
11508 (if (stringp (car x)) (string-width (car x)) 0))
11509 fulltable)))
11510 (expert nil)
11511 (fwidth (+ maxlen 3 1 3))
11512 (ncol (/ (- (window-width) 4) fwidth))
11513 tg cnt e c tbl
11514 groups ingroup)
d6685abc
CD
11515 (save-excursion
11516 (save-window-excursion
11517 (if expert
11518 (set-buffer (get-buffer-create " *Org todo*"))
11519 (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
11520 (erase-buffer)
11521 (org-set-local 'org-done-keywords done-keywords)
11522 (setq tbl fulltable cnt 0)
11523 (while (setq e (pop tbl))
11524 (cond
11525 ((equal e '(:startgroup))
11526 (push '() groups) (setq ingroup t)
11527 (when (not (= cnt 0))
11528 (setq cnt 0)
11529 (insert "\n"))
11530 (insert "{ "))
11531 ((equal e '(:endgroup))
11532 (setq ingroup nil cnt 0)
11533 (insert "}\n"))
c8d0cf5c
CD
11534 ((equal e '(:newline))
11535 (when (not (= cnt 0))
11536 (setq cnt 0)
11537 (insert "\n")
11538 (setq e (car tbl))
11539 (while (equal (car tbl) '(:newline))
11540 (insert "\n")
11541 (setq tbl (cdr tbl)))))
d6685abc
CD
11542 (t
11543 (setq tg (car e) c (cdr e))
11544 (if ingroup (push tg (car groups)))
11545 (setq tg (org-add-props tg nil 'face
11546 (org-get-todo-face tg)))
11547 (if (and (= cnt 0) (not ingroup)) (insert " "))
11548 (insert "[" c "] " tg (make-string
11549 (- fwidth 4 (length tg)) ?\ ))
11550 (when (= (setq cnt (1+ cnt)) ncol)
11551 (insert "\n")
11552 (if ingroup (insert " "))
11553 (setq cnt 0)))))
11554 (insert "\n")
11555 (goto-char (point-min))
11556 (if (not expert) (org-fit-window-to-buffer))
11557 (message "[a-z..]:Set [SPC]:clear")
11558 (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
20908596 11559 (cond
d6685abc
CD
11560 ((or (= c ?\C-g)
11561 (and (= c ?q) (not (rassoc c fulltable))))
11562 (setq quit-flag t))
11563 ((= c ?\ ) nil)
11564 ((setq e (rassoc c fulltable) tg (car e))
11565 tg)
11566 (t (setq quit-flag t)))))))
ab27a4a0 11567
20908596
CD
11568(defun org-entry-is-todo-p ()
11569 (member (org-get-todo-state) org-not-done-keywords))
11570
11571(defun org-entry-is-done-p ()
11572 (member (org-get-todo-state) org-done-keywords))
11573
11574(defun org-get-todo-state ()
11575 (save-excursion
11576 (org-back-to-heading t)
11577 (and (looking-at org-todo-line-regexp)
11578 (match-end 2)
11579 (match-string 2))))
11580
11581(defun org-at-date-range-p (&optional inactive-ok)
11582 "Is the cursor inside a date range?"
d3f4dbe8 11583 (interactive)
20908596
CD
11584 (save-excursion
11585 (catch 'exit
11586 (let ((pos (point)))
11587 (skip-chars-backward "^[<\r\n")
11588 (skip-chars-backward "<[")
11589 (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
11590 (>= (match-end 0) pos)
11591 (throw 'exit t))
11592 (skip-chars-backward "^<[\r\n")
11593 (skip-chars-backward "<[")
11594 (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp))
11595 (>= (match-end 0) pos)
11596 (throw 'exit t)))
11597 nil)))
891f4676 11598
8bfe682a 11599(defun org-get-repeat (&optional tagline)
2c3ad40d 11600 "Check if there is a deadline/schedule with repeater in this entry."
20908596
CD
11601 (save-match-data
11602 (save-excursion
11603 (org-back-to-heading t)
8bfe682a
CD
11604 (and (re-search-forward (if tagline
11605 (concat tagline "\\s-*" org-repeat-re)
11606 org-repeat-re)
11607 (org-entry-end-position) t)
11608 (match-string-no-properties 1)))))
891f4676 11609
20908596 11610(defvar org-last-changed-timestamp)
b349f79f 11611(defvar org-last-inserted-timestamp)
20908596
CD
11612(defvar org-log-post-message)
11613(defvar org-log-note-purpose)
11614(defvar org-log-note-how)
621f83e4 11615(defvar org-log-note-extra)
20908596
CD
11616(defun org-auto-repeat-maybe (done-word)
11617 "Check if the current headline contains a repeated deadline/schedule.
11618If yes, set TODO state back to what it was and change the base date
11619of repeating deadline/scheduled time stamps to new date.
11620This function is run automatically after each state change to a DONE state."
11621 ;; last-state is dynamically scoped into this function
11622 (let* ((repeat (org-get-repeat))
11623 (aa (assoc last-state org-todo-kwd-alist))
11624 (interpret (nth 1 aa))
11625 (head (nth 2 aa))
11626 (whata '(("d" . day) ("m" . month) ("y" . year)))
11627 (msg "Entry repeats: ")
11628 (org-log-done nil)
11629 (org-todo-log-states nil)
86fbb8ca 11630 re type n what ts time to-state)
20908596
CD
11631 (when repeat
11632 (if (eq org-log-repeat t) (setq org-log-repeat 'state))
86fbb8ca
CD
11633 (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
11634 org-todo-repeat-to-state))
11635 (unless (and to-state (member to-state org-todo-keywords-1))
11636 (setq to-state (if (eq interpret 'type) last-state head)))
11637 (org-todo to-state)
11638 (when (or org-log-repeat (org-entry-get nil "CLOCK"))
11639 (org-entry-put nil "LAST_REPEAT" (format-time-string
11640 (org-time-stamp-format t t))))
20908596
CD
11641 (when org-log-repeat
11642 (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
11643 (memq 'org-add-log-note post-command-hook))
11644 ;; OK, we are already setup for some record
11645 (if (eq org-log-repeat 'note)
11646 ;; make sure we take a note, not only a time stamp
11647 (setq org-log-note-how 'note))
11648 ;; Set up for taking a record
11649 (org-add-log-setup 'state (or done-word (car org-done-keywords))
c8d0cf5c 11650 last-state
20908596
CD
11651 'findpos org-log-repeat)))
11652 (org-back-to-heading t)
11653 (org-add-planning-info nil nil 'closed)
11654 (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
11655 org-deadline-time-regexp "\\)\\|\\("
11656 org-ts-regexp "\\)"))
11657 (while (re-search-forward
11658 re (save-excursion (outline-next-heading) (point)) t)
11659 (setq type (if (match-end 1) org-scheduled-string
11660 (if (match-end 3) org-deadline-string "Plain:"))
65c439fd 11661 ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))))
20908596
CD
11662 (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts)
11663 (setq n (string-to-number (match-string 2 ts))
11664 what (match-string 3 ts))
11665 (if (equal what "w") (setq n (* n 7) what "d"))
11666 ;; Preparation, see if we need to modify the start date for the change
11667 (when (match-end 1)
11668 (setq time (save-match-data (org-time-string-to-time ts)))
11669 (cond
11670 ((equal (match-string 1 ts) ".")
11671 ;; Shift starting date to today
11672 (org-timestamp-change
3ab2c837 11673 (- (org-today) (time-to-days time))
20908596
CD
11674 'day))
11675 ((equal (match-string 1 ts) "+")
afe98dfa
CD
11676 (let ((nshiftmax 10) (nshift 0))
11677 (while (or (= nshift 0)
11678 (<= (time-to-days time)
11679 (time-to-days (current-time))))
11680 (when (= (incf nshift) nshiftmax)
11681 (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift))
11682 (error "Abort")))
11683 (org-timestamp-change n (cdr (assoc what whata)))
11684 (org-at-timestamp-p t)
11685 (setq ts (match-string 1))
11686 (setq time (save-match-data (org-time-string-to-time ts)))))
20908596
CD
11687 (org-timestamp-change (- n) (cdr (assoc what whata)))
11688 ;; rematch, so that we have everything in place for the real shift
11689 (org-at-timestamp-p t)
11690 (setq ts (match-string 1))
11691 (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([dwmy]\\)" ts))))
11692 (org-timestamp-change n (cdr (assoc what whata)))
621f83e4 11693 (setq msg (concat msg type " " org-last-changed-timestamp " "))))
20908596
CD
11694 (setq org-log-post-message msg)
11695 (message "%s" msg))))
891f4676 11696
20908596
CD
11697(defun org-show-todo-tree (arg)
11698 "Make a compact tree which shows all headlines marked with TODO.
11699The tree will show the lines where the regexp matches, and all higher
11700headlines above the match.
c8d0cf5c 11701With a \\[universal-argument] prefix, prompt for a regexp to match.
20908596
CD
11702With a numeric prefix N, construct a sparse tree for the Nth element
11703of `org-todo-keywords-1'."
11704 (interactive "P")
11705 (let ((case-fold-search nil)
11706 (kwd-re
11707 (cond ((null arg) org-not-done-regexp)
11708 ((equal arg '(4))
54a0dee5 11709 (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): "
20908596
CD
11710 (mapcar 'list org-todo-keywords-1))))
11711 (concat "\\("
11712 (mapconcat 'identity (org-split-string kwd "|") "\\|")
11713 "\\)\\>")))
11714 ((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
11715 (regexp-quote (nth (1- (prefix-numeric-value arg))
11716 org-todo-keywords-1)))
11717 (t (error "Invalid prefix argument: %s" arg)))))
11718 (message "%d TODO entries found"
3ab2c837 11719 (org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
891f4676 11720
b349f79f 11721(defun org-deadline (&optional remove time)
20908596 11722 "Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
b349f79f 11723With argument REMOVE, remove any deadline from the item.
3ab2c837
BG
11724With argument TIME, set the deadline at the corresponding date. TIME
11725can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
20908596 11726 (interactive "P")
ed21c5c8
CD
11727 (let* ((old-date (org-entry-get nil "DEADLINE"))
11728 (repeater (and old-date
3ab2c837
BG
11729 (string-match
11730 "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
11731 old-date)
ed21c5c8 11732 (match-string 1 old-date))))
8bfe682a
CD
11733 (if remove
11734 (progn
ed21c5c8
CD
11735 (when (and old-date org-log-redeadline)
11736 (org-add-log-setup 'deldeadline nil old-date 'findpos
11737 org-log-redeadline))
8bfe682a
CD
11738 (org-remove-timestamp-with-keyword org-deadline-string)
11739 (message "Item no longer has a deadline."))
ed21c5c8
CD
11740 (org-add-planning-info 'deadline time 'closed)
11741 (when (and old-date org-log-redeadline
11742 (not (equal old-date
11743 (substring org-last-inserted-timestamp 1 -1))))
11744 (org-add-log-setup 'redeadline nil old-date 'findpos
11745 org-log-redeadline))
11746 (when repeater
11747 (save-excursion
11748 (org-back-to-heading t)
11749 (when (re-search-forward (concat org-deadline-string " "
11750 org-last-inserted-timestamp)
11751 (save-excursion
11752 (outline-next-heading) (point)) t)
11753 (goto-char (1- (match-end 0)))
11754 (insert " " repeater)
11755 (setq org-last-inserted-timestamp
11756 (concat (substring org-last-inserted-timestamp 0 -1)
11757 " " repeater
11758 (substring org-last-inserted-timestamp -1))))))
11759 (message "Deadline on %s" org-last-inserted-timestamp))))
db4a7382 11760
b349f79f 11761(defun org-schedule (&optional remove time)
20908596 11762 "Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
b349f79f 11763With argument REMOVE, remove any scheduling date from the item.
3ab2c837
BG
11764With argument TIME, scheduled at the corresponding date. TIME can
11765either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
20908596 11766 (interactive "P")
ed21c5c8
CD
11767 (let* ((old-date (org-entry-get nil "SCHEDULED"))
11768 (repeater (and old-date
3ab2c837
BG
11769 (string-match
11770 "\\([.+-]+[0-9]+[dwmy]\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
11771 old-date)
ed21c5c8 11772 (match-string 1 old-date))))
8bfe682a
CD
11773 (if remove
11774 (progn
ed21c5c8
CD
11775 (when (and old-date org-log-reschedule)
11776 (org-add-log-setup 'delschedule nil old-date 'findpos
11777 org-log-reschedule))
8bfe682a
CD
11778 (org-remove-timestamp-with-keyword org-scheduled-string)
11779 (message "Item is no longer scheduled."))
ed21c5c8
CD
11780 (org-add-planning-info 'scheduled time 'closed)
11781 (when (and old-date org-log-reschedule
11782 (not (equal old-date
11783 (substring org-last-inserted-timestamp 1 -1))))
11784 (org-add-log-setup 'reschedule nil old-date 'findpos
11785 org-log-reschedule))
11786 (when repeater
11787 (save-excursion
11788 (org-back-to-heading t)
11789 (when (re-search-forward (concat org-scheduled-string " "
11790 org-last-inserted-timestamp)
11791 (save-excursion
11792 (outline-next-heading) (point)) t)
11793 (goto-char (1- (match-end 0)))
11794 (insert " " repeater)
11795 (setq org-last-inserted-timestamp
11796 (concat (substring org-last-inserted-timestamp 0 -1)
11797 " " repeater
11798 (substring org-last-inserted-timestamp -1))))))
11799 (message "Scheduled to %s" org-last-inserted-timestamp))))
20908596 11800
c8d0cf5c
CD
11801(defun org-get-scheduled-time (pom &optional inherit)
11802 "Get the scheduled time as a time tuple, of a format suitable
11803for calling org-schedule with, or if there is no scheduling,
11804returns nil."
11805 (let ((time (org-entry-get pom "SCHEDULED" inherit)))
11806 (when time
11807 (apply 'encode-time (org-parse-time-string time)))))
11808
11809(defun org-get-deadline-time (pom &optional inherit)
86fbb8ca 11810 "Get the deadline as a time tuple, of a format suitable for
8bfe682a 11811calling org-deadline with, or if there is no scheduling, returns
c8d0cf5c
CD
11812nil."
11813 (let ((time (org-entry-get pom "DEADLINE" inherit)))
11814 (when time
11815 (apply 'encode-time (org-parse-time-string time)))))
11816
20908596
CD
11817(defun org-remove-timestamp-with-keyword (keyword)
11818 "Remove all time stamps with KEYWORD in the current entry."
11819 (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*"))
11820 beg)
11821 (save-excursion
11822 (org-back-to-heading t)
11823 (setq beg (point))
54a0dee5 11824 (outline-next-heading)
20908596
CD
11825 (while (re-search-backward re beg t)
11826 (replace-match "")
b349f79f
CD
11827 (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
11828 (equal (char-before) ?\ ))
11829 (backward-delete-char 1)
11830 (if (string-match "^[ \t]*$" (buffer-substring
11831 (point-at-bol) (point-at-eol)))
11832 (delete-region (point-at-bol)
11833 (min (point-max) (1+ (point-at-eol))))))))))
3278a016 11834
20908596
CD
11835(defun org-add-planning-info (what &optional time &rest remove)
11836 "Insert new timestamp with keyword in the line directly after the headline.
3ab2c837 11837WHAT indicates what kind of time stamp to add. TIME indicates the time to use.
20908596
CD
11838If non is given, the user is prompted for a date.
11839REMOVE indicates what kind of entries to remove. An old WHAT entry will also
11840be removed."
11841 (interactive)
11842 (let (org-time-was-given org-end-time-was-given ts
11843 end default-time default-input)
0b8568f5 11844
c8d0cf5c 11845 (catch 'exit
3ab2c837
BG
11846 (when (and (memq what '(scheduled deadline))
11847 (or (not time)
11848 (and (stringp time)
11849 (string-match "^[-+]+[0-9]" time))))
c8d0cf5c
CD
11850 ;; Try to get a default date/time from existing timestamp
11851 (save-excursion
20908596 11852 (org-back-to-heading t)
c8d0cf5c
CD
11853 (setq end (save-excursion (outline-next-heading) (point)))
11854 (when (re-search-forward (if (eq what 'scheduled)
11855 org-scheduled-time-regexp
11856 org-deadline-time-regexp)
11857 end t)
11858 (setq ts (match-string 1)
11859 default-time
11860 (apply 'encode-time (org-parse-time-string ts))
11861 default-input (and ts (org-get-compact-tod ts))))))
11862 (when what
3ab2c837
BG
11863 (setq time
11864 (if (and (stringp time)
11865 (string-match "^[-+]+[0-9]" time))
11866 ;; This is a relative time, set the proper date
11867 (apply 'encode-time
11868 (org-read-date-analyze
11869 time default-time (decode-time default-time)))
11870 ;; If necessary, get the time from the user
11871 (or time (org-read-date nil 'to-time nil nil
11872 default-time default-input)))))
c8d0cf5c
CD
11873
11874 (when (and org-insert-labeled-timestamps-at-point
11875 (member what '(scheduled deadline)))
11876 (insert
11877 (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
11878 (org-insert-time-stamp time org-time-was-given
11879 nil nil nil (list org-end-time-was-given))
11880 (setq what nil))
11881 (save-excursion
11882 (save-restriction
11883 (let (col list elt ts buffer-invisibility-spec)
11884 (org-back-to-heading t)
3ab2c837 11885 (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"))
c8d0cf5c
CD
11886 (goto-char (match-end 1))
11887 (setq col (current-column))
11888 (goto-char (match-end 0))
11889 (if (eobp) (insert "\n") (forward-char 1))
11890 (when (and (not what)
11891 (not (looking-at
11892 (concat "[ \t]*"
11893 org-keyword-time-not-clock-regexp))))
11894 ;; Nothing to add, nothing to remove...... :-)
11895 (throw 'exit nil))
3ab2c837 11896 (if (and (not (looking-at org-outline-regexp))
c8d0cf5c
CD
11897 (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
11898 "[^\r\n]*"))
11899 (not (equal (match-string 1) org-clock-string)))
11900 (narrow-to-region (match-beginning 0) (match-end 0))
11901 (insert-before-markers "\n")
11902 (backward-char 1)
11903 (narrow-to-region (point) (point))
11904 (and org-adapt-indentation (org-indent-to-column col)))
11905 ;; Check if we have to remove something.
11906 (setq list (cons what remove))
11907 (while list
11908 (setq elt (pop list))
c8d0cf5c
CD
11909 (when (or (and (eq elt 'scheduled)
11910 (re-search-forward org-scheduled-time-regexp nil t))
11911 (and (eq elt 'deadline)
11912 (re-search-forward org-deadline-time-regexp nil t))
11913 (and (eq elt 'closed)
11914 (re-search-forward org-closed-time-regexp nil t)))
11915 (replace-match "")
3ab2c837
BG
11916 (if (looking-at "--+<[^>]+>") (replace-match ""))))
11917 (and (looking-at "^[ \t]+") (replace-match ""))
8bfe682a 11918 (and org-adapt-indentation (bolp) (org-indent-to-column col))
c8d0cf5c
CD
11919 (when what
11920 (insert
11921 (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
11922 (cond ((eq what 'scheduled) org-scheduled-string)
11923 ((eq what 'deadline) org-deadline-string)
11924 ((eq what 'closed) org-closed-string))
11925 " ")
11926 (setq ts (org-insert-time-stamp
11927 time
11928 (or org-time-was-given
11929 (and (eq what 'closed) org-log-done-with-time))
11930 (eq what 'closed)
11931 nil nil (list org-end-time-was-given)))
3ab2c837
BG
11932 (insert
11933 (if (not (or (bolp) (eq (char-before) ?\ )
11934 (memq (char-after) '(32 10))
11935 (eobp))) " " ""))
c8d0cf5c 11936 (end-of-line 1))
20908596 11937 (goto-char (point-min))
c8d0cf5c 11938 (widen)
86fbb8ca 11939 (if (and (looking-at "[ \t]*\n")
c8d0cf5c
CD
11940 (equal (char-before) ?\n))
11941 (delete-region (1- (point)) (point-at-eol)))
11942 ts))))))
ab27a4a0 11943
20908596
CD
11944(defvar org-log-note-marker (make-marker))
11945(defvar org-log-note-purpose nil)
11946(defvar org-log-note-state nil)
c8d0cf5c 11947(defvar org-log-note-previous-state nil)
20908596 11948(defvar org-log-note-how nil)
621f83e4 11949(defvar org-log-note-extra nil)
20908596
CD
11950(defvar org-log-note-window-configuration nil)
11951(defvar org-log-note-return-to (make-marker))
3ab2c837
BG
11952(defvar org-log-note-effective-time nil
11953 "Remembered current time so that dynamically scoped
11954`org-extend-today-until' affects tha timestamps in state change
11955log")
11956
20908596
CD
11957(defvar org-log-post-message nil
11958 "Message to be displayed after a log note has been stored.
11959The auto-repeater uses this.")
ab27a4a0 11960
20908596
CD
11961(defun org-add-note ()
11962 "Add a note to the current entry.
11963This is done in the same way as adding a state change note."
11964 (interactive)
c8d0cf5c 11965 (org-add-log-setup 'note nil nil 'findpos nil))
8c6fb58b 11966
621f83e4 11967(defvar org-property-end-re)
c8d0cf5c 11968(defun org-add-log-setup (&optional purpose state prev-state
afe98dfa 11969 findpos how extra)
20908596
CD
11970 "Set up the post command hook to take a note.
11971If this is about to TODO state change, the new state is expected in STATE.
11972When FINDPOS is non-nil, find the correct position for the note in
621f83e4
CD
11973the current entry. If not, assume that it can be inserted at point.
11974HOW is an indicator what kind of note should be created.
11975EXTRA is additional text that will be inserted into the notes buffer."
c8d0cf5c
CD
11976 (let* ((org-log-into-drawer (org-log-into-drawer))
11977 (drawer (cond ((stringp org-log-into-drawer)
11978 org-log-into-drawer)
11979 (org-log-into-drawer "LOGBOOK")
11980 (t nil))))
11981 (save-restriction
11982 (save-excursion
11983 (when findpos
11984 (org-back-to-heading t)
11985 (narrow-to-region (point) (save-excursion
11986 (outline-next-heading) (point)))
3ab2c837 11987 (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"
c8d0cf5c
CD
11988 "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
11989 "[^\r\n]*\\)?"))
11990 (goto-char (match-end 0))
11991 (cond
11992 (drawer
11993 (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$")
11994 nil t)
11995 (progn
11996 (goto-char (match-end 0))
11997 (or org-log-states-order-reversed
11998 (and (re-search-forward org-property-end-re nil t)
11999 (goto-char (1- (match-beginning 0))))))
12000 (insert "\n:" drawer ":\n:END:")
12001 (beginning-of-line 0)
12002 (org-indent-line-function)
12003 (beginning-of-line 2)
12004 (org-indent-line-function)
12005 (end-of-line 0)))
12006 ((and org-log-state-notes-insert-after-drawers
12007 (save-excursion
12008 (forward-line) (looking-at org-drawer-regexp)))
12009 (forward-line)
12010 (while (looking-at org-drawer-regexp)
12011 (goto-char (match-end 0))
12012 (re-search-forward org-property-end-re (point-max) t)
12013 (forward-line))
12014 (forward-line -1)))
12015 (unless org-log-states-order-reversed
12016 (and (= (char-after) ?\n) (forward-char 1))
12017 (org-skip-over-state-notes)
12018 (skip-chars-backward " \t\n\r")))
12019 (move-marker org-log-note-marker (point))
12020 (setq org-log-note-purpose purpose
12021 org-log-note-state state
12022 org-log-note-previous-state prev-state
12023 org-log-note-how how
3ab2c837
BG
12024 org-log-note-extra extra
12025 org-log-note-effective-time (org-current-effective-time))
c8d0cf5c 12026 (add-hook 'post-command-hook 'org-add-log-note 'append)))))
ab27a4a0 12027
20908596
CD
12028(defun org-skip-over-state-notes ()
12029 "Skip past the list of State notes in an entry."
12030 (if (looking-at "\n[ \t]*- State") (forward-char 1))
3ab2c837
BG
12031 (when (ignore-errors (goto-char (org-in-item-p)))
12032 (let* ((struct (org-list-struct))
12033 (prevs (org-list-prevs-alist struct)))
afe98dfa 12034 (while (looking-at "[ \t]*- State")
3ab2c837
BG
12035 (goto-char (or (org-list-get-next-item (point) struct prevs)
12036 (org-list-get-item-end (point) struct)))))))
891f4676 12037
20908596
CD
12038(defun org-add-log-note (&optional purpose)
12039 "Pop up a window for taking a note, and add this note later at point."
12040 (remove-hook 'post-command-hook 'org-add-log-note)
12041 (setq org-log-note-window-configuration (current-window-configuration))
12042 (delete-other-windows)
12043 (move-marker org-log-note-return-to (point))
c3313451 12044 (switch-to-buffer (marker-buffer org-log-note-marker))
20908596
CD
12045 (goto-char org-log-note-marker)
12046 (org-switch-to-buffer-other-window "*Org Note*")
12047 (erase-buffer)
12048 (if (memq org-log-note-how '(time state))
71d35b24 12049 (let (current-prefix-arg) (org-store-log-note))
20908596
CD
12050 (let ((org-inhibit-startup t)) (org-mode))
12051 (insert (format "# Insert note for %s.
12052# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
12053 (cond
12054 ((eq org-log-note-purpose 'clock-out) "stopped clock")
12055 ((eq org-log-note-purpose 'done) "closed todo item")
12056 ((eq org-log-note-purpose 'state)
c8d0cf5c
CD
12057 (format "state change from \"%s\" to \"%s\""
12058 (or org-log-note-previous-state "")
12059 (or org-log-note-state "")))
8bfe682a
CD
12060 ((eq org-log-note-purpose 'reschedule)
12061 "rescheduling")
ed21c5c8
CD
12062 ((eq org-log-note-purpose 'delschedule)
12063 "no longer scheduled")
8bfe682a
CD
12064 ((eq org-log-note-purpose 'redeadline)
12065 "changing deadline")
ed21c5c8
CD
12066 ((eq org-log-note-purpose 'deldeadline)
12067 "removing deadline")
12068 ((eq org-log-note-purpose 'refile)
12069 "refiling")
20908596
CD
12070 ((eq org-log-note-purpose 'note)
12071 "this entry")
12072 (t (error "This should not happen")))))
621f83e4 12073 (if org-log-note-extra (insert org-log-note-extra))
20908596 12074 (org-set-local 'org-finish-function 'org-store-log-note)))
ab27a4a0 12075
20908596
CD
12076(defvar org-note-abort nil) ; dynamically scoped
12077(defun org-store-log-note ()
12078 "Finish taking a log note, and insert it to where it belongs."
12079 (let ((txt (buffer-string))
12080 (note (cdr (assq org-log-note-purpose org-log-note-headings)))
afe98dfa 12081 lines ind bul)
20908596
CD
12082 (kill-buffer (current-buffer))
12083 (while (string-match "\\`#.*\n[ \t\n]*" txt)
12084 (setq txt (replace-match "" t t txt)))
12085 (if (string-match "\\s-+\\'" txt)
12086 (setq txt (replace-match "" t t txt)))
12087 (setq lines (org-split-string txt "\n"))
12088 (when (and note (string-match "\\S-" note))
12089 (setq note
12090 (org-replace-escapes
12091 note
12092 (list (cons "%u" (user-login-name))
12093 (cons "%U" user-full-name)
12094 (cons "%t" (format-time-string
12095 (org-time-stamp-format 'long 'inactive)
3ab2c837 12096 org-log-note-effective-time))
86fbb8ca
CD
12097 (cons "%T" (format-time-string
12098 (org-time-stamp-format 'long nil)
3ab2c837 12099 org-log-note-effective-time))
20908596
CD
12100 (cons "%s" (if org-log-note-state
12101 (concat "\"" org-log-note-state "\"")
c8d0cf5c
CD
12102 ""))
12103 (cons "%S" (if org-log-note-previous-state
12104 (concat "\"" org-log-note-previous-state "\"")
12105 "\"\"")))))
20908596
CD
12106 (if lines (setq note (concat note " \\\\")))
12107 (push note lines))
c8d0cf5c
CD
12108 (when (or current-prefix-arg org-note-abort)
12109 (when org-log-into-drawer
12110 (org-remove-empty-drawer-at
12111 (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK")
12112 org-log-note-marker))
12113 (setq lines nil))
20908596 12114 (when lines
81ad75af 12115 (with-current-buffer (marker-buffer org-log-note-marker)
20908596
CD
12116 (save-excursion
12117 (goto-char org-log-note-marker)
12118 (move-marker org-log-note-marker nil)
12119 (end-of-line 1)
12120 (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
afe98dfa 12121 (setq ind (save-excursion
3ab2c837
BG
12122 (if (ignore-errors (goto-char (org-in-item-p)))
12123 (let ((struct (org-list-struct)))
12124 (org-list-get-ind
12125 (org-list-get-top-point struct) struct))
afe98dfa
CD
12126 (skip-chars-backward " \r\t\n")
12127 (cond
12128 ((and (org-at-heading-p)
12129 org-adapt-indentation)
12130 (1+ (org-current-level)))
12131 ((org-at-heading-p) 0)
12132 (t (org-get-indentation))))))
12133 (setq bul (org-list-bullet-string "-"))
12134 (org-indent-line-to ind)
12135 (insert bul (pop lines))
12136 (let ((ind-body (+ (length bul) ind)))
12137 (while lines
12138 (insert "\n")
12139 (org-indent-line-to ind-body)
12140 (insert (pop lines))))
c8d0cf5c
CD
12141 (message "Note stored")
12142 (org-back-to-heading t)
12143 (org-cycle-hide-drawers 'children)))))
20908596
CD
12144 (set-window-configuration org-log-note-window-configuration)
12145 (with-current-buffer (marker-buffer org-log-note-return-to)
12146 (goto-char org-log-note-return-to))
12147 (move-marker org-log-note-return-to nil)
12148 (and org-log-post-message (message "%s" org-log-post-message)))
a3fbe8c4 12149
c8d0cf5c 12150(defun org-remove-empty-drawer-at (drawer pos)
8bfe682a 12151 "Remove an empty drawer DRAWER at position POS.
c8d0cf5c
CD
12152POS may also be a marker."
12153 (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
12154 (save-excursion
12155 (save-restriction
12156 (widen)
12157 (goto-char pos)
12158 (if (org-in-regexp
12159 (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
12160 (replace-match ""))))))
12161
20908596
CD
12162(defun org-sparse-tree (&optional arg)
12163 "Create a sparse tree, prompt for the details.
12164This command can create sparse trees. You first need to select the type
12165of match used to create the tree:
d5098885 12166
86fbb8ca
CD
12167t Show all TODO entries.
12168T Show entries with a specific TODO keyword.
c8d0cf5c 12169m Show entries selected by a tags/property match.
20908596
CD
12170p Enter a property name and its value (both with completion on existing
12171 names/values) and show entries with that property.
acedf35c 12172r Show entries matching a regular expression (`/' can be used as well)
c8d0cf5c
CD
12173d Show deadlines due within `org-deadline-warning-days'.
12174b Show deadlines and scheduled items before a date.
12175a Show deadlines and scheduled items after a date."
20908596
CD
12176 (interactive "P")
12177 (let (ans kwd value)
acedf35c 12178 (message "Sparse tree: [r]egexp [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date")
20908596
CD
12179 (setq ans (read-char-exclusive))
12180 (cond
12181 ((equal ans ?d)
12182 (call-interactively 'org-check-deadlines))
12183 ((equal ans ?b)
12184 (call-interactively 'org-check-before-date))
c8d0cf5c
CD
12185 ((equal ans ?a)
12186 (call-interactively 'org-check-after-date))
20908596 12187 ((equal ans ?t)
86fbb8ca
CD
12188 (org-show-todo-tree nil))
12189 ((equal ans ?T)
20908596 12190 (org-show-todo-tree '(4)))
c8d0cf5c
CD
12191 ((member ans '(?T ?m))
12192 (call-interactively 'org-match-sparse-tree))
20908596 12193 ((member ans '(?p ?P))
54a0dee5 12194 (setq kwd (org-icompleting-read "Property: "
20908596 12195 (mapcar 'list (org-buffer-property-keys))))
54a0dee5 12196 (setq value (org-icompleting-read "Value: "
20908596
CD
12197 (mapcar 'list (org-property-values kwd))))
12198 (unless (string-match "\\`{.*}\\'" value)
12199 (setq value (concat "\"" value "\"")))
c8d0cf5c 12200 (org-match-sparse-tree arg (concat kwd "=" value)))
20908596
CD
12201 ((member ans '(?r ?R ?/))
12202 (call-interactively 'org-occur))
12203 (t (error "No such sparse tree command \"%c\"" ans)))))
a3fbe8c4 12204
20908596
CD
12205(defvar org-occur-highlights nil
12206 "List of overlays used for occur matches.")
12207(make-variable-buffer-local 'org-occur-highlights)
12208(defvar org-occur-parameters nil
12209 "Parameters of the active org-occur calls.
12210This is a list, each call to org-occur pushes as cons cell,
12211containing the regular expression and the callback, onto the list.
12212The list can contain several entries if `org-occur' has been called
12213several time with the KEEP-PREVIOUS argument. Otherwise, this list
12214will only contain one set of parameters. When the highlights are
12215removed (for example with `C-c C-c', or with the next edit (depending
12216on `org-remove-highlights-with-change'), this variable is emptied
12217as well.")
12218(make-variable-buffer-local 'org-occur-parameters)
a3fbe8c4 12219
20908596
CD
12220(defun org-occur (regexp &optional keep-previous callback)
12221 "Make a compact tree which shows all matches of REGEXP.
12222The tree will show the lines where the regexp matches, and all higher
12223headlines above the match. It will also show the heading after the match,
12224to make sure editing the matching entry is easy.
12225If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
12226call to `org-occur' will be kept, to allow stacking of calls to this
12227command.
12228If CALLBACK is non-nil, it is a function which is called to confirm
12229that the match should indeed be shown."
12230 (interactive "sRegexp: \nP")
c8d0cf5c
CD
12231 (when (equal regexp "")
12232 (error "Regexp cannot be empty"))
20908596
CD
12233 (unless keep-previous
12234 (org-remove-occur-highlights nil nil t))
12235 (push (cons regexp callback) org-occur-parameters)
12236 (let ((cnt 0))
a3fbe8c4 12237 (save-excursion
a3fbe8c4 12238 (goto-char (point-min))
20908596
CD
12239 (if (or (not keep-previous) ; do not want to keep
12240 (not org-occur-highlights)) ; no previous matches
12241 ;; hide everything
12242 (org-overview))
12243 (while (re-search-forward regexp nil t)
12244 (when (or (not callback)
12245 (save-match-data (funcall callback)))
12246 (setq cnt (1+ cnt))
12247 (when org-highlight-sparse-tree-matches
12248 (org-highlight-new-match (match-beginning 0) (match-end 0)))
12249 (org-show-context 'occur-tree))))
12250 (when org-remove-highlights-with-change
12251 (org-add-hook 'before-change-functions 'org-remove-occur-highlights
12252 nil 'local))
12253 (unless org-sparse-tree-open-archived-trees
12254 (org-hide-archived-subtrees (point-min) (point-max)))
12255 (run-hooks 'org-occur-hook)
3ab2c837 12256 (if (org-called-interactively-p 'interactive)
20908596
CD
12257 (message "%d match(es) for regexp %s" cnt regexp))
12258 cnt))
a3fbe8c4 12259
3ab2c837
BG
12260(defun org-occur-next-match (&optional n reset)
12261 "Function for `next-error-function' to find sparse tree matches.
12262N is the number of matches to move, when negative move backwards.
12263RESET is entirely ignored - this function always goes back to the
12264starting point when no match is found."
12265 (let* ((limit (if (< n 0) (point-min) (point-max)))
12266 (search-func (if (< n 0)
12267 'previous-single-char-property-change
12268 'next-single-char-property-change))
12269 (n (abs n))
12270 (pos (point))
12271 p1)
12272 (catch 'exit
12273 (while (setq p1 (funcall search-func (point) 'org-type))
12274 (when (equal p1 limit)
12275 (goto-char pos)
12276 (error "No more matches"))
12277 (when (equal (get-char-property p1 'org-type) 'org-occur)
12278 (setq n (1- n))
12279 (when (= n 0)
12280 (goto-char p1)
12281 (throw 'exit (point))))
12282 (goto-char p1))
12283 (goto-char p1)
12284 (error "No more matches"))))
12285
20908596 12286(defun org-show-context (&optional key)
86fbb8ca 12287 "Make sure point and context are visible.
20908596
CD
12288How much context is shown depends upon the variables
12289`org-show-hierarchy-above', `org-show-following-heading'. and
12290`org-show-siblings'."
12291 (let ((heading-p (org-on-heading-p t))
12292 (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
12293 (following-p (org-get-alist-option org-show-following-heading key))
12294 (entry-p (org-get-alist-option org-show-entry-below key))
12295 (siblings-p (org-get-alist-option org-show-siblings key)))
12296 (catch 'exit
12297 ;; Show heading or entry text
12298 (if (and heading-p (not entry-p))
12299 (org-flag-heading nil) ; only show the heading
3ab2c837 12300 (and (or entry-p (outline-invisible-p) (org-invisible-p2))
20908596
CD
12301 (org-show-hidden-entry))) ; show entire entry
12302 (when following-p
12303 ;; Show next sibling, or heading below text
12304 (save-excursion
12305 (and (if heading-p (org-goto-sibling) (outline-next-heading))
12306 (org-flag-heading nil))))
12307 (when siblings-p (org-show-siblings))
12308 (when hierarchy-p
12309 ;; show all higher headings, possibly with siblings
12310 (save-excursion
12311 (while (and (condition-case nil
12312 (progn (org-up-heading-all 1) t)
12313 (error nil))
12314 (not (bobp)))
12315 (org-flag-heading nil)
12316 (when siblings-p (org-show-siblings))))))))
a3fbe8c4 12317
ed21c5c8
CD
12318(defvar org-reveal-start-hook nil
12319 "Hook run before revealing a location.")
12320
20908596
CD
12321(defun org-reveal (&optional siblings)
12322 "Show current entry, hierarchy above it, and the following headline.
12323This can be used to show a consistent set of context around locations
12324exposed with `org-show-hierarchy-above' or `org-show-following-heading'
12325not t for the search context.
891f4676 12326
20908596
CD
12327With optional argument SIBLINGS, on each level of the hierarchy all
12328siblings are shown. This repairs the tree structure to what it would
ed21c5c8 12329look like when opened with hierarchical calls to `org-cycle'.
86fbb8ca
CD
12330With double optional argument \\[universal-argument] \\[universal-argument], \
12331go to the parent and show the
ed21c5c8 12332entire tree."
20908596 12333 (interactive "P")
ed21c5c8 12334 (run-hooks 'org-reveal-start-hook)
20908596
CD
12335 (let ((org-show-hierarchy-above t)
12336 (org-show-following-heading t)
12337 (org-show-siblings (if siblings t org-show-siblings)))
ed21c5c8
CD
12338 (org-show-context nil))
12339 (when (equal siblings '(16))
12340 (save-excursion
12341 (when (org-up-heading-safe)
12342 (org-show-subtree)
12343 (run-hook-with-args 'org-cycle-hook 'subtree)))))
891f4676 12344
20908596
CD
12345(defun org-highlight-new-match (beg end)
12346 "Highlight from BEG to END and mark the highlight is an occur headline."
86fbb8ca
CD
12347 (let ((ov (make-overlay beg end)))
12348 (overlay-put ov 'face 'secondary-selection)
3ab2c837 12349 (overlay-put ov 'org-type 'org-occur)
20908596 12350 (push ov org-occur-highlights)))
791d856f 12351
20908596
CD
12352(defun org-remove-occur-highlights (&optional beg end noremove)
12353 "Remove the occur highlights from the buffer.
12354BEG and END are ignored. If NOREMOVE is nil, remove this function
12355from the `before-change-functions' in the current buffer."
12356 (interactive)
12357 (unless org-inhibit-highlight-removal
86fbb8ca 12358 (mapc 'delete-overlay org-occur-highlights)
20908596
CD
12359 (setq org-occur-highlights nil)
12360 (setq org-occur-parameters nil)
12361 (unless noremove
12362 (remove-hook 'before-change-functions
12363 'org-remove-occur-highlights 'local))))
891f4676 12364
20908596 12365;;;; Priorities
891f4676 12366
20908596
CD
12367(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)"
12368 "Regular expression matching the priority indicator.")
d3f4dbe8 12369
20908596 12370(defvar org-remove-priority-next-time nil)
891f4676 12371
20908596
CD
12372(defun org-priority-up ()
12373 "Increase the priority of the current item."
03f3cf35 12374 (interactive)
20908596 12375 (org-priority 'up))
891f4676 12376
20908596
CD
12377(defun org-priority-down ()
12378 "Decrease the priority of the current item."
12379 (interactive)
12380 (org-priority 'down))
5bf7807a 12381
20908596
CD
12382(defun org-priority (&optional action)
12383 "Change the priority of an item by ARG.
12384ACTION can be `set', `up', `down', or a character."
12385 (interactive)
c8d0cf5c
CD
12386 (unless org-enable-priority-commands
12387 (error "Priority commands are disabled"))
20908596
CD
12388 (setq action (or action 'set))
12389 (let (current new news have remove)
12390 (save-excursion
9148fdd0 12391 (org-back-to-heading t)
20908596
CD
12392 (if (looking-at org-priority-regexp)
12393 (setq current (string-to-char (match-string 2))
3ab2c837 12394 have t))
20908596 12395 (cond
8bfe682a
CD
12396 ((eq action 'remove)
12397 (setq remove t new ?\ ))
20908596
CD
12398 ((or (eq action 'set)
12399 (if (featurep 'xemacs) (characterp action) (integerp action)))
12400 (if (not (eq action 'set))
12401 (setq new action)
12402 (message "Priority %c-%c, SPC to remove: "
12403 org-highest-priority org-lowest-priority)
afe98dfa
CD
12404 (save-match-data
12405 (setq new (read-char-exclusive))))
20908596
CD
12406 (if (and (= (upcase org-highest-priority) org-highest-priority)
12407 (= (upcase org-lowest-priority) org-lowest-priority))
12408 (setq new (upcase new)))
12409 (cond ((equal new ?\ ) (setq remove t))
12410 ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
12411 (error "Priority must be between `%c' and `%c'"
12412 org-highest-priority org-lowest-priority))))
12413 ((eq action 'up)
3ab2c837
BG
12414 (setq new (if have
12415 (1- current) ; normal cycling
12416 ;; last priority was empty
12417 (if (eq last-command this-command)
12418 org-lowest-priority ; wrap around empty to lowest
12419 ;; default
12420 (if org-priority-start-cycle-with-default
12421 org-default-priority
12422 (1- org-default-priority))))))
20908596 12423 ((eq action 'down)
3ab2c837
BG
12424 (setq new (if have
12425 (1+ current) ; normal cycling
12426 ;; last priority was empty
12427 (if (eq last-command this-command)
12428 org-highest-priority ; wrap around empty to highest
12429 ;; default
12430 (if org-priority-start-cycle-with-default
12431 org-default-priority
12432 (1+ org-default-priority))))))
20908596
CD
12433 (t (error "Invalid action")))
12434 (if (or (< (upcase new) org-highest-priority)
12435 (> (upcase new) org-lowest-priority))
3ab2c837
BG
12436 (if (and (memq action '(up down))
12437 (not have) (not (eq last-command this-command)))
12438 ;; `new' is from default priority
12439 (error
12440 "The default can not be set, see `org-default-priority' why")
12441 ;; normal cycling: `new' is beyond highest/lowest priority
12442 ;; and is wrapped around to the empty priority
12443 (setq remove t)))
20908596
CD
12444 (setq news (format "%c" new))
12445 (if have
12446 (if remove
12447 (replace-match "" t t nil 1)
12448 (replace-match news t t nil 2))
12449 (if remove
12450 (error "No priority cookie found in line")
c8d0cf5c
CD
12451 (let ((case-fold-search nil))
12452 (looking-at org-todo-line-regexp))
20908596
CD
12453 (if (match-end 2)
12454 (progn
12455 (goto-char (match-end 2))
12456 (insert " [#" news "]"))
12457 (goto-char (match-beginning 3))
c8d0cf5c
CD
12458 (insert "[#" news "] "))))
12459 (org-preserve-lc (org-set-tags nil 'align)))
20908596
CD
12460 (if remove
12461 (message "Priority removed")
12462 (message "Priority of current item set to %s" news))))
5bf7807a 12463
20908596
CD
12464(defun org-get-priority (s)
12465 "Find priority cookie and return priority."
acedf35c
CD
12466 (if (functionp org-get-priority-function)
12467 (funcall org-get-priority-function)
12468 (save-match-data
12469 (if (not (string-match org-priority-regexp s))
12470 (* 1000 (- org-lowest-priority org-default-priority))
12471 (* 1000 (- org-lowest-priority
12472 (string-to-char (match-string 2 s))))))))
891f4676 12473
20908596 12474;;;; Tags
634a7d0b 12475
2c3ad40d 12476(defvar org-agenda-archives-mode)
c8d0cf5c
CD
12477(defvar org-map-continue-from nil
12478 "Position from where mapping should continue.
8bfe682a 12479Can be set by the action argument to `org-scan-tag's and `org-map-entries'.")
c8d0cf5c
CD
12480
12481(defvar org-scanner-tags nil
12482 "The current tag list while the tags scanner is running.")
12483(defvar org-trust-scanner-tags nil
3ab2c837 12484 "Should `org-get-tags-at' use the tags for the scanner.
c8d0cf5c
CD
12485This is for internal dynamical scoping only.
12486When this is non-nil, the function `org-get-tags-at' will return the value
12487of `org-scanner-tags' instead of building the list by itself. This
12488can lead to large speed-ups when the tags scanner is used in a file with
12489many entries, and when the list of tags is retrieved, for example to
12490obtain a list of properties. Building the tags list for each entry in such
12491a file becomes an N^2 operation - but with this variable set, it scales
12492as N.")
12493
20908596
CD
12494(defun org-scan-tags (action matcher &optional todo-only)
12495 "Scan headline tags with inheritance and produce output ACTION.
b349f79f
CD
12496
12497ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
12498or `agenda' to produce an entry list for an agenda view. It can also be
12499a Lisp form or a function that should be called at each matched headline, in
12500this case the return value is a list of all return values from these calls.
12501
12502MATCHER is a Lisp form to be evaluated, testing if a given set of tags
12503qualifies a headline for inclusion. When TODO-ONLY is non-nil,
12504only lines with a TODO keyword are included in the output."
0bd48b37 12505 (require 'org-agenda)
3ab2c837 12506 (let* ((re (concat "^" org-outline-regexp " *\\(\\<\\("
20908596
CD
12507 (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
12508 (org-re
afe98dfa 12509 "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
2c3ad40d 12510 (props (list 'face 'default
c8d0cf5c 12511 'done-face 'org-agenda-done
2c3ad40d 12512 'undone-face 'default
20908596
CD
12513 'mouse-face 'highlight
12514 'org-not-done-regexp org-not-done-regexp
12515 'org-todo-regexp org-todo-regexp
20908596
CD
12516 'help-echo
12517 (format "mouse-2 or RET jump to org file %s"
12518 (abbreviate-file-name
12519 (or (buffer-file-name (buffer-base-buffer))
12520 (buffer-name (buffer-base-buffer)))))))
12521 (case-fold-search nil)
c8d0cf5c 12522 (org-map-continue-from nil)
b349f79f 12523 lspos tags tags-list
c8d0cf5c 12524 (tags-alist (list (cons 0 org-file-tags)))
b349f79f 12525 (llast 0) rtn rtn1 level category i txt
20908596 12526 todo marker entry priority)
621f83e4 12527 (when (not (or (member action '(agenda sparse-tree)) (functionp action)))
b349f79f 12528 (setq action (list 'lambda nil action)))
20908596
CD
12529 (save-excursion
12530 (goto-char (point-min))
12531 (when (eq action 'sparse-tree)
12532 (org-overview)
12533 (org-remove-occur-highlights))
12534 (while (re-search-forward re nil t)
12535 (catch :skip
c8d0cf5c
CD
12536 (setq todo (if (match-end 1) (org-match-string-no-properties 2))
12537 tags (if (match-end 4) (org-match-string-no-properties 4)))
12538 (goto-char (setq lspos (match-beginning 0)))
20908596
CD
12539 (setq level (org-reduced-level (funcall outline-level))
12540 category (org-get-category))
12541 (setq i llast llast level)
12542 ;; remove tag lists from same and sublevels
12543 (while (>= i level)
12544 (when (setq entry (assoc i tags-alist))
12545 (setq tags-alist (delete entry tags-alist)))
12546 (setq i (1- i)))
12547 ;; add the next tags
12548 (when tags
c8d0cf5c 12549 (setq tags (org-split-string tags ":")
20908596
CD
12550 tags-alist
12551 (cons (cons level tags) tags-alist)))
12552 ;; compile tags for current headline
12553 (setq tags-list
12554 (if org-use-tag-inheritance
ff4be292 12555 (apply 'append (mapcar 'cdr (reverse tags-alist)))
c8d0cf5c
CD
12556 tags)
12557 org-scanner-tags tags-list)
ff4be292
CD
12558 (when org-use-tag-inheritance
12559 (setcdr (car tags-alist)
12560 (mapcar (lambda (x)
12561 (setq x (copy-sequence x))
12562 (org-add-prop-inherited x))
12563 (cdar tags-alist))))
20908596 12564 (when (and tags org-use-tag-inheritance
c8d0cf5c
CD
12565 (or (not (eq t org-use-tag-inheritance))
12566 org-tags-exclude-from-inheritance))
20908596
CD
12567 ;; selective inheritance, remove uninherited ones
12568 (setcdr (car tags-alist)
3ab2c837
BG
12569 (org-remove-uninherited-tags (cdar tags-alist))))
12570 (when (and
12571
12572 ;; eval matcher only when the todo condition is OK
12573 (and (or (not todo-only) (member todo org-not-done-keywords))
12574 (let ((case-fold-search t)) (eval matcher)))
12575
12576 ;; Call the skipper, but return t if it does not skip,
12577 ;; so that the `and' form continues evaluating
12578 (progn
12579 (unless (eq action 'sparse-tree) (org-agenda-skip))
12580 t)
12581
12582 ;; Check if timestamps are deselecting this entry
12583 (or (not todo-only)
12584 (and (member todo org-not-done-keywords)
12585 (or (not org-agenda-tags-todo-honor-ignore-options)
12586 (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))
12587
12588 ;; Extra check for the archive tag
12589 ;; FIXME: Does the skipper already do this????
12590 (or
12591 (not (member org-archive-tag tags-list))
12592 ;; we have an archive tag, should we use this anyway?
12593 (or (not org-agenda-skip-archived-trees)
12594 (and (eq action 'agenda) org-agenda-archives-mode))))
03f3cf35 12595
b349f79f
CD
12596 ;; select this headline
12597
12598 (cond
12599 ((eq action 'sparse-tree)
12600 (and org-highlight-sparse-tree-matches
12601 (org-get-heading) (match-end 0)
12602 (org-highlight-new-match
12603 (match-beginning 0) (match-beginning 1)))
12604 (org-show-context 'tags-tree))
12605 ((eq action 'agenda)
20908596
CD
12606 (setq txt (org-format-agenda-item
12607 ""
12608 (concat
c8d0cf5c 12609 (if (eq org-tags-match-list-sublevels 'indented)
20908596
CD
12610 (make-string (1- level) ?.) "")
12611 (org-get-heading))
c8d0cf5c
CD
12612 category
12613 tags-list
12614 )
20908596
CD
12615 priority (org-get-priority txt))
12616 (goto-char lspos)
12617 (setq marker (org-agenda-new-marker))
12618 (org-add-props txt props
12619 'org-marker marker 'org-hd-marker marker 'org-category category
c8d0cf5c 12620 'todo-state todo
20908596
CD
12621 'priority priority 'type "tagsmatch")
12622 (push txt rtn))
b349f79f 12623 ((functionp action)
c8d0cf5c 12624 (setq org-map-continue-from nil)
b349f79f
CD
12625 (save-excursion
12626 (setq rtn1 (funcall action))
c8d0cf5c 12627 (push rtn1 rtn)))
b349f79f
CD
12628 (t (error "Invalid action")))
12629
20908596 12630 ;; if we are to skip sublevels, jump to end of subtree
c8d0cf5c
CD
12631 (unless org-tags-match-list-sublevels
12632 (org-end-of-subtree t)
12633 (backward-char 1))))
12634 ;; Get the correct position from where to continue
12635 (if org-map-continue-from
12636 (goto-char org-map-continue-from)
12637 (and (= (point) lspos) (end-of-line 1)))))
20908596
CD
12638 (when (and (eq action 'sparse-tree)
12639 (not org-sparse-tree-open-archived-trees))
12640 (org-hide-archived-subtrees (point-min) (point-max)))
12641 (nreverse rtn)))
891f4676 12642
3ab2c837 12643(defun org-remove-uninherited-tags (tags)
20908596
CD
12644 "Remove all tags that are not inherited from the list TAGS."
12645 (cond
ff4be292
CD
12646 ((eq org-use-tag-inheritance t)
12647 (if org-tags-exclude-from-inheritance
12648 (org-delete-all org-tags-exclude-from-inheritance tags)
12649 tags))
20908596
CD
12650 ((not org-use-tag-inheritance) nil)
12651 ((stringp org-use-tag-inheritance)
12652 (delq nil (mapcar
ff4be292
CD
12653 (lambda (x)
12654 (if (and (string-match org-use-tag-inheritance x)
12655 (not (member x org-tags-exclude-from-inheritance)))
12656 x nil))
20908596
CD
12657 tags)))
12658 ((listp org-use-tag-inheritance)
621f83e4 12659 (delq nil (mapcar
ff4be292
CD
12660 (lambda (x)
12661 (if (member x org-use-tag-inheritance) x nil))
621f83e4 12662 tags)))))
2a57416f 12663
20908596
CD
12664(defvar todo-only) ;; dynamically scoped
12665
c8d0cf5c 12666(defun org-match-sparse-tree (&optional todo-only match)
d60b1ba1 12667 "Create a sparse tree according to tags string MATCH.
20908596
CD
12668MATCH can contain positive and negative selection of tags, like
12669\"+WORK+URGENT-WITHBOSS\".
d60b1ba1 12670If optional argument TODO-ONLY is non-nil, only select lines that are
20908596
CD
12671also TODO lines."
12672 (interactive "P")
12673 (org-prepare-agenda-buffers (list (current-buffer)))
12674 (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
15841868 12675
c8d0cf5c
CD
12676(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
12677
20908596
CD
12678(defvar org-cached-props nil)
12679(defun org-cached-entry-get (pom property)
12680 (if (or (eq t org-use-property-inheritance)
12681 (and (stringp org-use-property-inheritance)
12682 (string-match org-use-property-inheritance property))
12683 (and (listp org-use-property-inheritance)
12684 (member property org-use-property-inheritance)))
12685 ;; Caching is not possible, check it directly
12686 (org-entry-get pom property 'inherit)
12687 ;; Get all properties, so that we can do complicated checks easily
12688 (cdr (assoc property (or org-cached-props
12689 (setq org-cached-props
12690 (org-entry-properties pom)))))))
15841868 12691
20908596 12692(defun org-global-tags-completion-table (&optional files)
3ab2c837
BG
12693 "Return the list of all tags in all agenda buffer/files.
12694Optional FILES argument is a list of files to which can be used
12695instead of the agenda files."
20908596
CD
12696 (save-excursion
12697 (org-uniquify
12698 (delq nil
12699 (apply 'append
12700 (mapcar
12701 (lambda (file)
12702 (set-buffer (find-file-noselect file))
12703 (append (org-get-buffer-tags)
12704 (mapcar (lambda (x) (if (stringp (car-safe x))
12705 (list (car-safe x)) nil))
12706 org-tag-alist)))
12707 (if (and files (car files))
12708 files
12709 (org-agenda-files))))))))
2a57416f 12710
20908596 12711(defun org-make-tags-matcher (match)
3ab2c837 12712 "Create the TAGS/TODO matcher form for the selection string MATCH."
20908596 12713 ;; todo-only is scoped dynamically into this function, and the function
33306645 12714 ;; may change it if the matcher asks for it.
20908596
CD
12715 (unless match
12716 ;; Get a new match request, with completion
12717 (let ((org-last-tags-completion-table
12718 (org-global-tags-completion-table)))
54a0dee5 12719 (setq match (org-completing-read-no-i
20908596
CD
12720 "Match: " 'org-tags-completion-function nil nil nil
12721 'org-tags-history))))
15841868 12722
20908596
CD
12723 ;; Parse the string and create a lisp form
12724 (let ((match0 match)
afe98dfa 12725 (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)"))
20908596
CD
12726 minus tag mm
12727 tagsmatch todomatch tagsmatcher todomatcher kwd matcher
621f83e4 12728 orterms term orlist re-p str-p level-p level-op time-p
acedf35c 12729 prop-p pn pv po gv rest)
20908596
CD
12730 (if (string-match "/+" match)
12731 ;; match contains also a todo-matching request
12732 (progn
12733 (setq tagsmatch (substring match 0 (match-beginning 0))
12734 todomatch (substring match (match-end 0)))
12735 (if (string-match "^!" todomatch)
12736 (setq todo-only t todomatch (substring todomatch 1)))
12737 (if (string-match "^\\s-*$" todomatch)
12738 (setq todomatch nil)))
12739 ;; only matching tags
12740 (setq tagsmatch match todomatch nil))
15841868 12741
20908596
CD
12742 ;; Make the tags matcher
12743 (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch)))
12744 (setq tagsmatcher t)
12745 (setq orterms (org-split-string tagsmatch "|") orlist nil)
12746 (while (setq term (pop orterms))
12747 (while (and (equal (substring term -1) "\\") orterms)
12748 (setq term (concat term "|" (pop orterms)))) ; repair bad split
12749 (while (string-match re term)
93b62de8
CD
12750 (setq rest (substring term (match-end 0))
12751 minus (and (match-end 1)
20908596 12752 (equal (match-string 1 term) "-"))
afe98dfa
CD
12753 tag (save-match-data (replace-regexp-in-string
12754 "\\\\-" "-"
12755 (match-string 2 term)))
20908596
CD
12756 re-p (equal (string-to-char tag) ?{)
12757 level-p (match-end 4)
12758 prop-p (match-end 5)
12759 mm (cond
12760 (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list))
12761 (level-p
12762 (setq level-op (org-op-to-function (match-string 3 term)))
12763 `(,level-op level ,(string-to-number
12764 (match-string 4 term))))
12765 (prop-p
12766 (setq pn (match-string 5 term)
12767 po (match-string 6 term)
12768 pv (match-string 7 term)
20908596
CD
12769 re-p (equal (string-to-char pv) ?{)
12770 str-p (equal (string-to-char pv) ?\")
93b62de8
CD
12771 time-p (save-match-data
12772 (string-match "^\"[[<].*[]>]\"$" pv))
20908596 12773 pv (if (or re-p str-p) (substring pv 1 -1) pv))
2c3ad40d
CD
12774 (if time-p (setq pv (org-matcher-time pv)))
12775 (setq po (org-op-to-function po (if time-p 'time str-p)))
93b62de8
CD
12776 (cond
12777 ((equal pn "CATEGORY")
12778 (setq gv '(get-text-property (point) 'org-category)))
12779 ((equal pn "TODO")
12780 (setq gv 'todo))
12781 (t
12782 (setq gv `(org-cached-entry-get nil ,pn))))
20908596
CD
12783 (if re-p
12784 (if (eq po 'org<>)
12785 `(not (string-match ,pv (or ,gv "")))
12786 `(string-match ,pv (or ,gv "")))
12787 (if str-p
12788 `(,po (or ,gv "") ,pv)
12789 `(,po (string-to-number (or ,gv ""))
12790 ,(string-to-number pv) ))))
c8d0cf5c 12791 (t `(member ,tag tags-list)))
20908596 12792 mm (if minus (list 'not mm) mm)
93b62de8 12793 term rest)
20908596
CD
12794 (push mm tagsmatcher))
12795 (push (if (> (length tagsmatcher) 1)
12796 (cons 'and tagsmatcher)
12797 (car tagsmatcher))
12798 orlist)
12799 (setq tagsmatcher nil))
12800 (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))
12801 (setq tagsmatcher
12802 (list 'progn '(setq org-cached-props nil) tagsmatcher)))
12803 ;; Make the todo matcher
12804 (if (or (not todomatch) (not (string-match "\\S-" todomatch)))
12805 (setq todomatcher t)
12806 (setq orterms (org-split-string todomatch "|") orlist nil)
12807 (while (setq term (pop orterms))
12808 (while (string-match re term)
12809 (setq minus (and (match-end 1)
12810 (equal (match-string 1 term) "-"))
12811 kwd (match-string 2 term)
12812 re-p (equal (string-to-char kwd) ?{)
12813 term (substring term (match-end 0))
12814 mm (if re-p
12815 `(string-match ,(substring kwd 1 -1) todo)
12816 (list 'equal 'todo kwd))
12817 mm (if minus (list 'not mm) mm))
12818 (push mm todomatcher))
12819 (push (if (> (length todomatcher) 1)
12820 (cons 'and todomatcher)
12821 (car todomatcher))
12822 orlist)
12823 (setq todomatcher nil))
12824 (setq todomatcher (if (> (length orlist) 1)
12825 (cons 'or orlist) (car orlist))))
a3fbe8c4 12826
20908596
CD
12827 ;; Return the string and lisp forms of the matcher
12828 (setq matcher (if todomatcher
12829 (list 'and tagsmatcher todomatcher)
12830 tagsmatcher))
12831 (cons match0 matcher)))
d3f4dbe8 12832
20908596 12833(defun org-op-to-function (op &optional stringp)
2c3ad40d 12834 "Turn an operator into the appropriate function."
20908596
CD
12835 (setq op
12836 (cond
2c3ad40d
CD
12837 ((equal op "<" ) '(< string< org-time<))
12838 ((equal op ">" ) '(> org-string> org-time>))
12839 ((member op '("<=" "=<")) '(<= org-string<= org-time<=))
12840 ((member op '(">=" "=>")) '(>= org-string>= org-time>=))
12841 ((member op '("=" "==")) '(= string= org-time=))
12842 ((member op '("<>" "!=")) '(org<> org-string<> org-time<>))))
12843 (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op))
20908596
CD
12844
12845(defun org<> (a b) (not (= a b)))
12846(defun org-string<= (a b) (or (string= a b) (string< a b)))
12847(defun org-string>= (a b) (not (string< a b)))
12848(defun org-string> (a b) (and (not (string= a b)) (not (string< a b))))
12849(defun org-string<> (a b) (not (string= a b)))
0bd48b37
CD
12850(defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b)))
12851(defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b)))
12852(defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b)))
12853(defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b)))
12854(defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b)))
12855(defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b)))
2c3ad40d
CD
12856(defun org-2ft (s)
12857 "Convert S to a floating point time.
12858If S is already a number, just return it. If it is a string, parse
0bd48b37 12859it as a time string and apply `float-time' to it. If S is nil, just return 0."
2c3ad40d
CD
12860 (cond
12861 ((numberp s) s)
12862 ((stringp s)
12863 (condition-case nil
12864 (float-time (apply 'encode-time (org-parse-time-string s)))
12865 (error 0.)))
12866 (t 0.)))
12867
ce4fdcb9
CD
12868(defun org-time-today ()
12869 "Time in seconds today at 0:00.
12870Returns the float number of seconds since the beginning of the
12871epoch to the beginning of today (00:00)."
12872 (float-time (apply 'encode-time
12873 (append '(0 0 0) (nthcdr 3 (decode-time))))))
12874
2c3ad40d 12875(defun org-matcher-time (s)
33306645 12876 "Interpret a time comparison value."
ff4be292
CD
12877 (save-match-data
12878 (cond
12879 ((string= s "<now>") (float-time))
12880 ((string= s "<today>") (org-time-today))
12881 ((string= s "<tomorrow>") (+ 86400.0 (org-time-today)))
12882 ((string= s "<yesterday>") (- (org-time-today) 86400.0))
12883 ((string-match "^<\\([-+][0-9]+\\)\\([dwmy]\\)>$" s)
12884 (+ (org-time-today)
12885 (* (string-to-number (match-string 1 s))
12886 (cdr (assoc (match-string 2 s)
12887 '(("d" . 86400.0) ("w" . 604800.0)
12888 ("m" . 2678400.0) ("y" . 31557600.0)))))))
12889 (t (org-2ft s)))))
15841868 12890
20908596
CD
12891(defun org-match-any-p (re list)
12892 "Does re match any element of list?"
12893 (setq list (mapcar (lambda (x) (string-match re x)) list))
12894 (delq nil list))
15841868 12895
33306645 12896(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
86fbb8ca 12897(defvar org-tags-overlay (make-overlay 1 1))
20908596 12898(org-detach-overlay org-tags-overlay)
e0e66b8e 12899
621f83e4
CD
12900(defun org-get-local-tags-at (&optional pos)
12901 "Get a list of tags defined in the current headline."
12902 (org-get-tags-at pos 'local))
12903
12904(defun org-get-local-tags ()
12905 "Get a list of tags defined in the current headline."
12906 (org-get-tags-at nil 'local))
12907
12908(defun org-get-tags-at (&optional pos local)
20908596
CD
12909 "Get a list of all headline tags applicable at POS.
12910POS defaults to point. If tags are inherited, the list contains
12911the targets in the same sequence as the headlines appear, i.e.
621f83e4
CD
12912the tags of the current headline come last.
12913When LOCAL is non-nil, only return tags from the current headline,
12914ignore inherited ones."
d3f4dbe8 12915 (interactive)
c8d0cf5c
CD
12916 (if (and org-trust-scanner-tags
12917 (or (not pos) (equal pos (point)))
12918 (not local))
12919 org-scanner-tags
12920 (let (tags ltags lastpos parent)
12921 (save-excursion
12922 (save-restriction
12923 (widen)
12924 (goto-char (or pos (point)))
12925 (save-match-data
12926 (catch 'done
12927 (condition-case nil
12928 (progn
12929 (org-back-to-heading t)
12930 (while (not (equal lastpos (point)))
12931 (setq lastpos (point))
12932 (when (looking-at
afe98dfa 12933 (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
c8d0cf5c
CD
12934 (setq ltags (org-split-string
12935 (org-match-string-no-properties 1) ":"))
12936 (when parent
12937 (setq ltags (mapcar 'org-add-prop-inherited ltags)))
12938 (setq tags (append
12939 (if parent
3ab2c837 12940 (org-remove-uninherited-tags ltags)
c8d0cf5c
CD
12941 ltags)
12942 tags)))
12943 (or org-use-tag-inheritance (throw 'done t))
12944 (if local (throw 'done t))
12945 (or (org-up-heading-safe) (error nil))
12946 (setq parent t)))
12947 (error nil)))))
3ab2c837
BG
12948 (if local
12949 tags
12950 (append (org-remove-uninherited-tags org-file-tags) tags))))))
d3f4dbe8 12951
ff4be292
CD
12952(defun org-add-prop-inherited (s)
12953 (add-text-properties 0 (length s) '(inherited t) s)
12954 s)
12955
20908596
CD
12956(defun org-toggle-tag (tag &optional onoff)
12957 "Toggle the tag TAG for the current line.
12958If ONOFF is `on' or `off', don't toggle but set to this state."
20908596 12959 (let (res current)
15841868 12960 (save-excursion
db55f368 12961 (org-back-to-heading t)
afe98dfa 12962 (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
20908596
CD
12963 (point-at-eol) t)
12964 (progn
12965 (setq current (match-string 1))
12966 (replace-match ""))
12967 (setq current ""))
12968 (setq current (nreverse (org-split-string current ":")))
12969 (cond
12970 ((eq onoff 'on)
12971 (setq res t)
12972 (or (member tag current) (push tag current)))
12973 ((eq onoff 'off)
12974 (or (not (member tag current)) (setq current (delete tag current))))
12975 (t (if (member tag current)
12976 (setq current (delete tag current))
12977 (setq res t)
12978 (push tag current))))
15841868 12979 (end-of-line 1)
20908596
CD
12980 (if current
12981 (progn
12982 (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
12983 (org-set-tags nil t))
12984 (delete-horizontal-space))
12985 (run-hooks 'org-after-tags-change-hook))
12986 res))
15841868 12987
20908596
CD
12988(defun org-align-tags-here (to-col)
12989 ;; Assumes that this is a headline
12990 (let ((pos (point)) (col (current-column)) ncol tags-l p)
891f4676 12991 (beginning-of-line 1)
afe98dfa 12992 (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
20908596
CD
12993 (< pos (match-beginning 2)))
12994 (progn
12995 (setq tags-l (- (match-end 2) (match-beginning 2)))
12996 (goto-char (match-beginning 1))
12997 (insert " ")
12998 (delete-region (point) (1+ (match-beginning 2)))
12999 (setq ncol (max (1+ (current-column))
13000 (1+ col)
13001 (if (> to-col 0)
13002 to-col
13003 (- (abs to-col) tags-l))))
13004 (setq p (point))
13005 (insert (make-string (- ncol (current-column)) ?\ ))
13006 (setq ncol (current-column))
b349f79f 13007 (when indent-tabs-mode (tabify p (point-at-eol)))
20908596
CD
13008 (org-move-to-column (min ncol col) t))
13009 (goto-char pos))))
2a57416f 13010
71d35b24
CD
13011(defun org-set-tags-command (&optional arg just-align)
13012 "Call the set-tags command for the current entry."
13013 (interactive "P")
13014 (if (org-on-heading-p)
13015 (org-set-tags arg just-align)
13016 (save-excursion
13017 (org-back-to-heading t)
13018 (org-set-tags arg just-align))))
13019
8d642074
CD
13020(defun org-set-tags-to (data)
13021 "Set the tags of the current entry to DATA, replacing the current tags.
13022DATA may be a tags string like :aa:bb:cc:, or a list of tags.
13023If DATA is nil or the empty string, any tags will be removed."
13024 (interactive "sTags: ")
13025 (setq data
13026 (cond
13027 ((eq data nil) "")
13028 ((equal data "") "")
13029 ((stringp data)
13030 (concat ":" (mapconcat 'identity (org-split-string data ":+") ":")
13031 ":"))
13032 ((listp data)
13033 (concat ":" (mapconcat 'identity data ":") ":"))
13034 (t nil)))
13035 (when data
13036 (save-excursion
13037 (org-back-to-heading t)
13038 (when (looking-at org-complex-heading-regexp)
13039 (if (match-end 5)
13040 (progn
13041 (goto-char (match-beginning 5))
13042 (insert data)
13043 (delete-region (point) (point-at-eol))
13044 (org-set-tags nil 'align))
13045 (goto-char (point-at-eol))
13046 (insert " " data)
13047 (org-set-tags nil 'align)))
13048 (beginning-of-line 1)
13049 (if (looking-at ".*?\\([ \t]+\\)$")
13050 (delete-region (match-beginning 1) (match-end 1))))))
13051
86fbb8ca
CD
13052(defun org-align-all-tags ()
13053 "Align the tags i all headings."
13054 (interactive)
13055 (save-excursion
13056 (or (ignore-errors (org-back-to-heading t))
13057 (outline-next-heading))
13058 (if (org-on-heading-p)
13059 (org-set-tags t)
13060 (message "No headings"))))
13061
afe98dfa 13062(defvar org-indent-indentation-per-level)
20908596
CD
13063(defun org-set-tags (&optional arg just-align)
13064 "Set the tags for the current headline.
13065With prefix ARG, realign all tags in headings in the current buffer."
13066 (interactive "P")
3ab2c837 13067 (let* ((re org-outline-regexp-bol)
20908596
CD
13068 (current (org-get-tags-string))
13069 (col (current-column))
13070 (org-setting-tags t)
13071 table current-tags inherited-tags ; computed below when needed
afe98dfa 13072 tags p0 c0 c1 rpl di tc level)
20908596
CD
13073 (if arg
13074 (save-excursion
2a57416f 13075 (goto-char (point-min))
20908596
CD
13076 (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
13077 (while (re-search-forward re nil t)
13078 (org-set-tags nil t)
13079 (end-of-line 1)))
13080 (message "All tags realigned to column %d" org-tags-column))
13081 (if just-align
13082 (setq tags current)
13083 ;; Get a new set of tags from the user
13084 (save-excursion
c8d0cf5c 13085 (setq table (append org-tag-persistent-alist
ed21c5c8 13086 (or org-tag-alist (org-get-buffer-tags))
afe98dfa
CD
13087 (and
13088 org-complete-tags-always-offer-all-agenda-tags
13089 (org-global-tags-completion-table
13090 (org-agenda-files))))
20908596
CD
13091 org-last-tags-completion-table table
13092 current-tags (org-split-string current ":")
13093 inherited-tags (nreverse
13094 (nthcdr (length current-tags)
13095 (nreverse (org-get-tags-at))))
13096 tags
13097 (if (or (eq t org-use-fast-tag-selection)
13098 (and org-use-fast-tag-selection
13099 (delq nil (mapcar 'cdr table))))
13100 (org-fast-tag-selection
13101 current-tags inherited-tags table
afe98dfa
CD
13102 (if org-fast-tag-selection-include-todo
13103 org-todo-key-alist))
20908596
CD
13104 (let ((org-add-colon-after-tag-completion t))
13105 (org-trim
3ab2c837
BG
13106 (org-icompleting-read "Tags: "
13107 'org-tags-completion-function
13108 nil nil current 'org-tags-history))))))
20908596
CD
13109 (while (string-match "[-+&]+" tags)
13110 ;; No boolean logic, just a list
13111 (setq tags (replace-match ":" t t tags))))
64f72ae1 13112
3ab2c837 13113 (setq tags (replace-regexp-in-string "[,]" ":" tags))
afe98dfa 13114
c8d0cf5c
CD
13115 (if org-tags-sort-function
13116 (setq tags (mapconcat 'identity
afe98dfa
CD
13117 (sort (org-split-string
13118 tags (org-re "[^[:alnum:]_@#%]+"))
c8d0cf5c
CD
13119 org-tags-sort-function) ":")))
13120
20908596 13121 (if (string-match "\\`[\t ]*\\'" tags)
c8d0cf5c 13122 (setq tags "")
20908596
CD
13123 (unless (string-match ":$" tags) (setq tags (concat tags ":")))
13124 (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
891f4676 13125
20908596
CD
13126 ;; Insert new tags at the correct column
13127 (beginning-of-line 1)
afe98dfa
CD
13128 (setq level (or (and (looking-at org-outline-regexp)
13129 (- (match-end 0) (point) 1))
13130 1))
20908596
CD
13131 (cond
13132 ((and (equal current "") (equal tags "")))
13133 ((re-search-forward
13134 (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
13135 (point-at-eol) t)
13136 (if (equal tags "")
13137 (setq rpl "")
13138 (goto-char (match-beginning 0))
afe98dfa
CD
13139 (setq c0 (current-column)
13140 ;; compute offset for the case of org-indent-mode active
13141 di (if org-indent-mode
13142 (* (1- org-indent-indentation-per-level) (1- level))
13143 0)
13144 p0 (if (equal (char-before) ?*) (1+ (point)) (point))
13145 tc (+ org-tags-column (if (> org-tags-column 0) (- di) di))
13146 c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags))))
20908596
CD
13147 rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
13148 (replace-match rpl t t)
13149 (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
13150 tags)
13151 (t (error "Tags alignment failed")))
13152 (org-move-to-column col)
13153 (unless just-align
13154 (run-hooks 'org-after-tags-change-hook)))))
891f4676 13155
20908596
CD
13156(defun org-change-tag-in-region (beg end tag off)
13157 "Add or remove TAG for each entry in the region.
13158This works in the agenda, and also in an org-mode buffer."
13159 (interactive
13160 (list (region-beginning) (region-end)
13161 (let ((org-last-tags-completion-table
13162 (if (org-mode-p)
13163 (org-get-buffer-tags)
13164 (org-global-tags-completion-table))))
54a0dee5 13165 (org-icompleting-read
20908596
CD
13166 "Tag: " 'org-tags-completion-function nil nil nil
13167 'org-tags-history))
13168 (progn
13169 (message "[s]et or [r]emove? ")
13170 (equal (read-char-exclusive) ?r))))
13171 (if (fboundp 'deactivate-mark) (deactivate-mark))
13172 (let ((agendap (equal major-mode 'org-agenda-mode))
13173 l1 l2 m buf pos newhead (cnt 0))
13174 (goto-char end)
13175 (setq l2 (1- (org-current-line)))
13176 (goto-char beg)
13177 (setq l1 (org-current-line))
13178 (loop for l from l1 to l2 do
54a0dee5 13179 (org-goto-line l)
20908596
CD
13180 (setq m (get-text-property (point) 'org-hd-marker))
13181 (when (or (and (org-mode-p) (org-on-heading-p))
13182 (and agendap m))
13183 (setq buf (if agendap (marker-buffer m) (current-buffer))
13184 pos (if agendap m (point)))
13185 (with-current-buffer buf
13186 (save-excursion
13187 (save-restriction
13188 (goto-char pos)
13189 (setq cnt (1+ cnt))
13190 (org-toggle-tag tag (if off 'off 'on))
13191 (setq newhead (org-get-heading)))))
13192 (and agendap (org-agenda-change-all-lines newhead m))))
13193 (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
891f4676 13194
20908596
CD
13195(defun org-tags-completion-function (string predicate &optional flag)
13196 (let (s1 s2 rtn (ctable org-last-tags-completion-table)
13197 (confirm (lambda (x) (stringp (car x)))))
afe98dfa 13198 (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
20908596
CD
13199 (setq s1 (match-string 1 string)
13200 s2 (match-string 2 string))
13201 (setq s1 "" s2 string))
13202 (cond
13203 ((eq flag nil)
13204 ;; try completion
13205 (setq rtn (try-completion s2 ctable confirm))
13206 (if (stringp rtn)
13207 (setq rtn
13208 (concat s1 s2 (substring rtn (length s2))
13209 (if (and org-add-colon-after-tag-completion
13210 (assoc rtn ctable))
13211 ":" ""))))
13212 rtn)
13213 ((eq flag t)
13214 ;; all-completions
13215 (all-completions s2 ctable confirm)
13216 )
13217 ((eq flag 'lambda)
13218 ;; exact match?
13219 (assoc s2 ctable)))
d3f4dbe8 13220 ))
ab27a4a0 13221
20908596 13222(defun org-fast-tag-insert (kwd tags face &optional end)
33306645 13223 "Insert KDW, and the TAGS, the latter with face FACE. Also insert END."
20908596
CD
13224 (insert (format "%-12s" (concat kwd ":"))
13225 (org-add-props (mapconcat 'identity tags " ") nil 'face face)
13226 (or end "")))
891f4676 13227
20908596
CD
13228(defun org-fast-tag-show-exit (flag)
13229 (save-excursion
54a0dee5 13230 (org-goto-line 3)
20908596
CD
13231 (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
13232 (replace-match ""))
13233 (when flag
13234 (end-of-line 1)
13235 (org-move-to-column (- (window-width) 19) t)
13236 (insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
64f72ae1 13237
20908596
CD
13238(defun org-set-current-tags-overlay (current prefix)
13239 (let ((s (concat ":" (mapconcat 'identity current ":") ":")))
13240 (if (featurep 'xemacs)
13241 (org-overlay-display org-tags-overlay (concat prefix s)
13242 'secondary-selection)
13243 (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
13244 (org-overlay-display org-tags-overlay (concat prefix s)))))
891f4676 13245
ed21c5c8 13246(defvar org-last-tag-selection-key nil)
20908596
CD
13247(defun org-fast-tag-selection (current inherited table &optional todo-table)
13248 "Fast tag selection with single keys.
13249CURRENT is the current list of tags in the headline, INHERITED is the
13250list of inherited tags, and TABLE is an alist of tags and corresponding keys,
13251possibly with grouping information. TODO-TABLE is a similar table with
13252TODO keywords, should these have keys assigned to them.
13253If the keys are nil, a-z are automatically assigned.
13254Returns the new tags string, or nil to not change the current settings."
13255 (let* ((fulltable (append table todo-table))
13256 (maxlen (apply 'max (mapcar
13257 (lambda (x)
13258 (if (stringp (car x)) (string-width (car x)) 0))
13259 fulltable)))
13260 (buf (current-buffer))
13261 (expert (eq org-fast-tag-selection-single-key 'expert))
13262 (buffer-tags nil)
13263 (fwidth (+ maxlen 3 1 3))
13264 (ncol (/ (- (window-width) 4) fwidth))
13265 (i-face 'org-done)
13266 (c-face 'org-todo)
13267 tg cnt e c char c1 c2 ntable tbl rtn
13268 ov-start ov-end ov-prefix
13269 (exit-after-next org-fast-tag-selection-single-key)
13270 (done-keywords org-done-keywords)
13271 groups ingroup)
13272 (save-excursion
13273 (beginning-of-line 1)
13274 (if (looking-at
afe98dfa 13275 (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
20908596
CD
13276 (setq ov-start (match-beginning 1)
13277 ov-end (match-end 1)
13278 ov-prefix "")
13279 (setq ov-start (1- (point-at-eol))
13280 ov-end (1+ ov-start))
13281 (skip-chars-forward "^\n\r")
13282 (setq ov-prefix
13283 (concat
13284 (buffer-substring (1- (point)) (point))
13285 (if (> (current-column) org-tags-column)
13286 " "
13287 (make-string (- org-tags-column (current-column)) ?\ ))))))
86fbb8ca 13288 (move-overlay org-tags-overlay ov-start ov-end)
20908596
CD
13289 (save-window-excursion
13290 (if expert
13291 (set-buffer (get-buffer-create " *Org tags*"))
03f3cf35 13292 (delete-other-windows)
20908596
CD
13293 (split-window-vertically)
13294 (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
13295 (erase-buffer)
13296 (org-set-local 'org-done-keywords done-keywords)
13297 (org-fast-tag-insert "Inherited" inherited i-face "\n")
13298 (org-fast-tag-insert "Current" current c-face "\n\n")
13299 (org-fast-tag-show-exit exit-after-next)
13300 (org-set-current-tags-overlay current ov-prefix)
13301 (setq tbl fulltable char ?a cnt 0)
13302 (while (setq e (pop tbl))
13303 (cond
8bfe682a 13304 ((equal (car e) :startgroup)
20908596
CD
13305 (push '() groups) (setq ingroup t)
13306 (when (not (= cnt 0))
13307 (setq cnt 0)
13308 (insert "\n"))
8bfe682a
CD
13309 (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
13310 ((equal (car e) :endgroup)
20908596 13311 (setq ingroup nil cnt 0)
8bfe682a 13312 (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
c8d0cf5c
CD
13313 ((equal e '(:newline))
13314 (when (not (= cnt 0))
13315 (setq cnt 0)
13316 (insert "\n")
13317 (setq e (car tbl))
13318 (while (equal (car tbl) '(:newline))
13319 (insert "\n")
13320 (setq tbl (cdr tbl)))))
20908596 13321 (t
54a0dee5 13322 (setq tg (copy-sequence (car e)) c2 nil)
20908596
CD
13323 (if (cdr e)
13324 (setq c (cdr e))
13325 ;; automatically assign a character.
13326 (setq c1 (string-to-char
13327 (downcase (substring
13328 tg (if (= (string-to-char tg) ?@) 1 0)))))
13329 (if (or (rassoc c1 ntable) (rassoc c1 table))
13330 (while (or (rassoc char ntable) (rassoc char table))
13331 (setq char (1+ char)))
13332 (setq c2 c1))
13333 (setq c (or c2 char)))
13334 (if ingroup (push tg (car groups)))
13335 (setq tg (org-add-props tg nil 'face
13336 (cond
13337 ((not (assoc tg table))
13338 (org-get-todo-face tg))
13339 ((member tg current) c-face)
13340 ((member tg inherited) i-face)
13341 (t nil))))
13342 (if (and (= cnt 0) (not ingroup)) (insert " "))
13343 (insert "[" c "] " tg (make-string
13344 (- fwidth 4 (length tg)) ?\ ))
13345 (push (cons tg c) ntable)
13346 (when (= (setq cnt (1+ cnt)) ncol)
13347 (insert "\n")
13348 (if ingroup (insert " "))
13349 (setq cnt 0)))))
13350 (setq ntable (nreverse ntable))
13351 (insert "\n")
13352 (goto-char (point-min))
93b62de8 13353 (if (not expert) (org-fit-window-to-buffer))
20908596
CD
13354 (setq rtn
13355 (catch 'exit
13356 (while t
8bfe682a
CD
13357 (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s"
13358 (if (not groups) "no " "")
20908596
CD
13359 (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
13360 (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
ed21c5c8 13361 (setq org-last-tag-selection-key c)
03f3cf35 13362 (cond
20908596
CD
13363 ((= c ?\r) (throw 'exit t))
13364 ((= c ?!)
13365 (setq groups (not groups))
13366 (goto-char (point-min))
13367 (while (re-search-forward "[{}]" nil t) (replace-match " ")))
13368 ((= c ?\C-c)
13369 (if (not expert)
13370 (org-fast-tag-show-exit
13371 (setq exit-after-next (not exit-after-next)))
13372 (setq expert nil)
13373 (delete-other-windows)
3ab2c837 13374 (set-window-buffer (split-window-vertically) " *Org tags*")
20908596 13375 (org-switch-to-buffer-other-window " *Org tags*")
93b62de8 13376 (org-fit-window-to-buffer)))
20908596
CD
13377 ((or (= c ?\C-g)
13378 (and (= c ?q) (not (rassoc c ntable))))
13379 (org-detach-overlay org-tags-overlay)
13380 (setq quit-flag t))
13381 ((= c ?\ )
13382 (setq current nil)
13383 (if exit-after-next (setq exit-after-next 'now)))
13384 ((= c ?\t)
13385 (condition-case nil
54a0dee5 13386 (setq tg (org-icompleting-read
20908596
CD
13387 "Tag: "
13388 (or buffer-tags
13389 (with-current-buffer buf
13390 (org-get-buffer-tags)))))
13391 (quit (setq tg "")))
13392 (when (string-match "\\S-" tg)
13393 (add-to-list 'buffer-tags (list tg))
13394 (if (member tg current)
13395 (setq current (delete tg current))
13396 (push tg current)))
13397 (if exit-after-next (setq exit-after-next 'now)))
13398 ((setq e (rassoc c todo-table) tg (car e))
13399 (with-current-buffer buf
13400 (save-excursion (org-todo tg)))
13401 (if exit-after-next (setq exit-after-next 'now)))
13402 ((setq e (rassoc c ntable) tg (car e))
13403 (if (member tg current)
13404 (setq current (delete tg current))
13405 (loop for g in groups do
13406 (if (member tg g)
13407 (mapc (lambda (x)
13408 (setq current (delete x current)))
13409 g)))
13410 (push tg current))
13411 (if exit-after-next (setq exit-after-next 'now))))
a3fbe8c4 13412
20908596
CD
13413 ;; Create a sorted list
13414 (setq current
13415 (sort current
13416 (lambda (a b)
13417 (assoc b (cdr (memq (assoc a ntable) ntable))))))
13418 (if (eq exit-after-next 'now) (throw 'exit t))
13419 (goto-char (point-min))
13420 (beginning-of-line 2)
13421 (delete-region (point) (point-at-eol))
13422 (org-fast-tag-insert "Current" current c-face)
13423 (org-set-current-tags-overlay current ov-prefix)
13424 (while (re-search-forward
afe98dfa 13425 (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t)
20908596
CD
13426 (setq tg (match-string 1))
13427 (add-text-properties
13428 (match-beginning 1) (match-end 1)
13429 (list 'face
13430 (cond
13431 ((member tg current) c-face)
13432 ((member tg inherited) i-face)
13433 (t (get-text-property (match-beginning 1) 'face))))))
13434 (goto-char (point-min)))))
13435 (org-detach-overlay org-tags-overlay)
13436 (if rtn
13437 (mapconcat 'identity current ":")
13438 nil))))
a3fbe8c4 13439
20908596
CD
13440(defun org-get-tags-string ()
13441 "Get the TAGS string in the current headline."
13442 (unless (org-on-heading-p t)
13443 (error "Not on a heading"))
13444 (save-excursion
13445 (beginning-of-line 1)
afe98dfa 13446 (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
20908596
CD
13447 (org-match-string-no-properties 1)
13448 "")))
a3fbe8c4 13449
20908596
CD
13450(defun org-get-tags ()
13451 "Get the list of tags specified in the current headline."
13452 (org-split-string (org-get-tags-string) ":"))
a3fbe8c4 13453
20908596
CD
13454(defun org-get-buffer-tags ()
13455 "Get a table of all tags used in the buffer, for completion."
13456 (let (tags)
2a57416f
CD
13457 (save-excursion
13458 (goto-char (point-min))
20908596 13459 (while (re-search-forward
afe98dfa 13460 (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t)
20908596
CD
13461 (when (equal (char-after (point-at-bol 0)) ?*)
13462 (mapc (lambda (x) (add-to-list 'tags x))
13463 (org-split-string (org-match-string-no-properties 1) ":")))))
8bfe682a 13464 (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags)
20908596 13465 (mapcar 'list tags)))
9acdaa21 13466
b349f79f
CD
13467;;;; The mapping API
13468
13469;;;###autoload
13470(defun org-map-entries (func &optional match scope &rest skip)
13471 "Call FUNC at each headline selected by MATCH in SCOPE.
13472
13473FUNC is a function or a lisp form. The function will be called without
13474arguments, with the cursor positioned at the beginning of the headline.
13475The return values of all calls to the function will be collected and
13476returned as a list.
13477
c8d0cf5c
CD
13478The call to FUNC will be wrapped into a save-excursion form, so FUNC
13479does not need to preserve point. After evaluation, the cursor will be
13480moved to the end of the line (presumably of the headline of the
13481processed entry) and search continues from there. Under some
13482circumstances, this may not produce the wanted results. For example,
13483if you have removed (e.g. archived) the current (sub)tree it could
13484mean that the next entry will be skipped entirely. In such cases, you
13485can specify the position from where search should continue by making
13486FUNC set the variable `org-map-continue-from' to the desired buffer
13487position.
13488
b349f79f
CD
13489MATCH is a tags/property/todo match as it is used in the agenda tags view.
13490Only headlines that are matched by this query will be considered during
13491the iteration. When MATCH is nil or t, all headlines will be
13492visited by the iteration.
13493
13494SCOPE determines the scope of this command. It can be any of:
13495
13496nil The current buffer, respecting the restriction if any
13497tree The subtree started with the entry at point
3ab2c837 13498region The entries within the active region, if any
b349f79f
CD
13499file The current buffer, without restriction
13500file-with-archives
13501 The current buffer, and any archives associated with it
13502agenda All agenda files
13503agenda-with-archives
13504 All agenda files with any archive files associated with them
13505\(file1 file2 ...)
13506 If this is a list, all files in the list will be scanned
13507
13508The remaining args are treated as settings for the skipping facilities of
13509the scanner. The following items can be given here:
13510
13511 archive skip trees with the archive tag.
13512 comment skip trees with the COMMENT keyword
13513 function or Emacs Lisp form:
13514 will be used as value for `org-agenda-skip-function', so whenever
04e65fdb 13515 the function returns t, FUNC will not be called for that
b349f79f 13516 entry and search will continue from the point where the
c8d0cf5c
CD
13517 function leaves it.
13518
13519If your function needs to retrieve the tags including inherited tags
13520at the *current* entry, you can use the value of the variable
13521`org-scanner-tags' which will be much faster than getting the value
13522with `org-get-tags-at'. If your function gets properties with
13523`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags'
13524to t around the call to `org-entry-properties' to get the same speedup.
13525Note that if your function moves around to retrieve tags and properties at
13526a *different* entry, you cannot use these techniques."
2c3ad40d
CD
13527 (let* ((org-agenda-archives-mode nil) ; just to make sure
13528 (org-agenda-skip-archived-trees (memq 'archive skip))
b349f79f
CD
13529 (org-agenda-skip-comment-trees (memq 'comment skip))
13530 (org-agenda-skip-function
13531 (car (org-delete-all '(comment archive) skip)))
13532 (org-tags-match-list-sublevels t)
65c439fd 13533 matcher file res
621f83e4
CD
13534 org-todo-keywords-for-agenda
13535 org-done-keywords-for-agenda
13536 org-todo-keyword-alist-for-agenda
8d642074 13537 org-drawers-for-agenda
621f83e4 13538 org-tag-alist-for-agenda)
b349f79f
CD
13539
13540 (cond
13541 ((eq match t) (setq matcher t))
13542 ((eq match nil) (setq matcher t))
ff4be292 13543 (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
ce4fdcb9 13544
0bd48b37
CD
13545 (save-excursion
13546 (save-restriction
3ab2c837
BG
13547 (cond ((eq scope 'tree)
13548 (org-back-to-heading t)
13549 (org-narrow-to-subtree)
13550 (setq scope nil))
13551 ((and (eq scope 'region) (org-region-active-p))
13552 (narrow-to-region (region-beginning) (region-end))
13553 (setq scope nil)))
ce4fdcb9 13554
0bd48b37
CD
13555 (if (not scope)
13556 (progn
13557 (org-prepare-agenda-buffers
13558 (list (buffer-file-name (current-buffer))))
13559 (setq res (org-scan-tags func matcher)))
13560 ;; Get the right scope
0bd48b37
CD
13561 (cond
13562 ((and scope (listp scope) (symbolp (car scope)))
13563 (setq scope (eval scope)))
13564 ((eq scope 'agenda)
13565 (setq scope (org-agenda-files t)))
13566 ((eq scope 'agenda-with-archives)
13567 (setq scope (org-agenda-files t))
13568 (setq scope (org-add-archive-files scope)))
13569 ((eq scope 'file)
13570 (setq scope (list (buffer-file-name))))
13571 ((eq scope 'file-with-archives)
13572 (setq scope (org-add-archive-files (list (buffer-file-name))))))
13573 (org-prepare-agenda-buffers scope)
13574 (while (setq file (pop scope))
13575 (with-current-buffer (org-find-base-buffer-visiting file)
13576 (save-excursion
13577 (save-restriction
13578 (widen)
13579 (goto-char (point-min))
13580 (setq res (append res (org-scan-tags func matcher))))))))))
13581 res))
9acdaa21 13582
20908596 13583;;;; Properties
9acdaa21 13584
20908596 13585;;; Setting and retrieving properties
891f4676 13586
20908596 13587(defconst org-special-properties
93b62de8 13588 '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
3ab2c837 13589 "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM")
20908596 13590 "The special properties valid in Org-mode.
9acdaa21 13591
20908596
CD
13592These are properties that are not defined in the property drawer,
13593but in some other way.")
9acdaa21 13594
20908596 13595(defconst org-default-properties
c8d0cf5c 13596 '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID"
b349f79f
CD
13597 "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
13598 "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
3ab2c837
BG
13599 "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
13600 "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
86fbb8ca 13601 "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
ed21c5c8 13602 "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
20908596
CD
13603 "Some properties that are used by Org-mode for various purposes.
13604Being in this list makes sure that they are offered for completion.")
9acdaa21 13605
20908596
CD
13606(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
13607 "Regular expression matching the first line of a property drawer.")
9acdaa21 13608
20908596 13609(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
ed21c5c8 13610 "Regular expression matching the last line of a property drawer.")
9acdaa21 13611
2c3ad40d
CD
13612(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
13613 "Regular expression matching the first line of a property drawer.")
13614
13615(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
13616 "Regular expression matching the first line of a property drawer.")
13617
13618(defconst org-property-drawer-re
13619 (concat "\\(" org-property-start-re "\\)[^\000]*\\("
13620 org-property-end-re "\\)\n?")
13621 "Matches an entire property drawer.")
13622
13623(defconst org-clock-drawer-re
13624 (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\("
13625 org-property-end-re "\\)\n?")
13626 "Matches an entire clock drawer.")
13627
3ab2c837
BG
13628(defsubst org-re-property (property)
13629 "Return a regexp matching PROPERTY.
13630Match group 1 will be set to the value "
13631 (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)"))
13632
20908596
CD
13633(defun org-property-action ()
13634 "Do an action on properties."
03f3cf35 13635 (interactive)
20908596
CD
13636 (let (c)
13637 (org-at-property-p)
13638 (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
13639 (setq c (read-char-exclusive))
13640 (cond
13641 ((equal c ?s)
13642 (call-interactively 'org-set-property))
13643 ((equal c ?d)
13644 (call-interactively 'org-delete-property))
13645 ((equal c ?D)
13646 (call-interactively 'org-delete-property-globally))
13647 ((equal c ?c)
13648 (call-interactively 'org-compute-property-at-point))
13649 (t (error "No such property action %c" c)))))
13650
54a0dee5
CD
13651(defun org-set-effort (&optional value)
13652 "Set the effort property of the current entry.
13653With numerical prefix arg, use the nth allowed value, 0 stands for the 10th
13654allowed value."
13655 (interactive "P")
13656 (if (equal value 0) (setq value 10))
13657 (let* ((completion-ignore-case t)
13658 (prop org-effort-property)
13659 (cur (org-entry-get nil prop))
13660 (allowed (org-property-get-allowed-values nil prop 'table))
13661 (existing (mapcar 'list (org-property-values prop)))
8bfe682a 13662 rpl
54a0dee5
CD
13663 (val (cond
13664 ((stringp value) value)
13665 ((and allowed (integerp value))
13666 (or (car (nth (1- value) allowed))
13667 (car (org-last allowed))))
13668 (allowed
8bfe682a
CD
13669 (message "Select 1-9,0, [RET%s]: %s"
13670 (if cur (concat "=" cur) "")
13671 (mapconcat 'car allowed " "))
13672 (setq rpl (read-char-exclusive))
13673 (if (equal rpl ?\r)
13674 cur
13675 (setq rpl (- rpl ?0))
13676 (if (equal rpl 0) (setq rpl 10))
13677 (if (and (> rpl 0) (<= rpl (length allowed)))
13678 (car (nth (1- rpl) allowed))
5dec9555 13679 (org-completing-read "Effort: " allowed nil))))
54a0dee5
CD
13680 (t
13681 (let (org-completion-use-ido org-completion-use-iswitchb)
13682 (org-completing-read
5dec9555 13683 (concat "Effort " (if (and cur (string-match "\\S-" cur))
54a0dee5
CD
13684 (concat "[" cur "]") "")
13685 ": ")
13686 existing nil nil "" nil cur))))))
13687 (unless (equal (org-entry-get nil prop) val)
13688 (org-entry-put nil prop val))
13689 (message "%s is now %s" prop val)))
13690
20908596 13691(defun org-at-property-p ()
ed21c5c8 13692 "Is cursor inside a property drawer?"
03f3cf35 13693 (save-excursion
20908596 13694 (beginning-of-line 1)
ed21c5c8 13695 (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)"))
86fbb8ca
CD
13696 (save-match-data ;; Used by calling procedures
13697 (let ((p (point))
13698 (range (unless (org-before-first-heading-p)
13699 (org-get-property-block))))
13700 (and range (<= (car range) p) (< p (cdr range))))))))
03f3cf35 13701
20908596
CD
13702(defun org-get-property-block (&optional beg end force)
13703 "Return the (beg . end) range of the body of the property drawer.
13704BEG and END can be beginning and end of subtree, if not given
13705they will be found.
13706If the drawer does not exist and FORCE is non-nil, create the drawer."
13707 (catch 'exit
d3f4dbe8 13708 (save-excursion
20908596
CD
13709 (let* ((beg (or beg (progn (org-back-to-heading t) (point))))
13710 (end (or end (progn (outline-next-heading) (point)))))
13711 (goto-char beg)
13712 (if (re-search-forward org-property-start-re end t)
13713 (setq beg (1+ (match-end 0)))
13714 (if force
13715 (save-excursion
13716 (org-insert-property-drawer)
13717 (setq end (progn (outline-next-heading) (point))))
13718 (throw 'exit nil))
13719 (goto-char beg)
13720 (if (re-search-forward org-property-start-re end t)
13721 (setq beg (1+ (match-end 0)))))
13722 (if (re-search-forward org-property-end-re end t)
13723 (setq end (match-beginning 0))
13724 (or force (throw 'exit nil))
13725 (goto-char beg)
13726 (setq end beg)
13727 (org-indent-line-function)
13728 (insert ":END:\n"))
13729 (cons beg end)))))
a3fbe8c4 13730
ed21c5c8 13731(defun org-entry-properties (&optional pom which specific)
20908596
CD
13732 "Get all properties of the entry at point-or-marker POM.
13733This includes the TODO keyword, the tags, time strings for deadline,
13734scheduled, and clocking, and any additional properties defined in the
13735entry. The return value is an alist, keys may occur multiple times
13736if the property key was used several times.
13737POM may also be nil, in which case the current entry is used.
13738If WHICH is nil or `all', get all properties. If WHICH is
ed21c5c8 13739`special' or `standard', only get that subclass. If WHICH
acedf35c 13740is a string only get exactly this property. SPECIFIC can be a string, the
ed21c5c8
CD
13741specific property we are interested in. Specifying it can speed
13742things up because then unnecessary parsing is avoided."
20908596
CD
13743 (setq which (or which 'all))
13744 (org-with-point-at pom
13745 (let ((clockstr (substring org-clock-string 0 -1))
ed21c5c8
CD
13746 (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
13747 (case-fold-search nil)
86fbb8ca 13748 beg end range props sum-props key key1 value string clocksum)
20908596 13749 (save-excursion
0bd48b37
CD
13750 (when (condition-case nil
13751 (and (org-mode-p) (org-back-to-heading t))
13752 (error nil))
20908596
CD
13753 (setq beg (point))
13754 (setq sum-props (get-text-property (point) 'org-summaries))
13755 (setq clocksum (get-text-property (point) :org-clock-minutes))
13756 (outline-next-heading)
13757 (setq end (point))
13758 (when (memq which '(all special))
13759 ;; Get the special properties, like TODO and tags
13760 (goto-char beg)
ed21c5c8
CD
13761 (when (and (or (not specific) (string= specific "TODO"))
13762 (looking-at org-todo-line-regexp) (match-end 2))
20908596 13763 (push (cons "TODO" (org-match-string-no-properties 2)) props))
ed21c5c8
CD
13764 (when (and (or (not specific) (string= specific "PRIORITY"))
13765 (looking-at org-priority-regexp))
20908596 13766 (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
3ab2c837
BG
13767 (when (or (not specific) (string= specific "FILE"))
13768 (push (cons "FILE" buffer-file-name) props))
ed21c5c8
CD
13769 (when (and (or (not specific) (string= specific "TAGS"))
13770 (setq value (org-get-tags-string))
20908596
CD
13771 (string-match "\\S-" value))
13772 (push (cons "TAGS" value) props))
ed21c5c8
CD
13773 (when (and (or (not specific) (string= specific "ALLTAGS"))
13774 (setq value (org-get-tags-at)))
13775 (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":")
13776 ":"))
20908596 13777 props))
ed21c5c8
CD
13778 (when (or (not specific) (string= specific "BLOCKED"))
13779 (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
13780 (when (or (not specific)
86fbb8ca
CD
13781 (member specific
13782 '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
13783 "TIMESTAMP" "TIMESTAMP_IA")))
3ab2c837
BG
13784 (catch 'match
13785 (while (re-search-forward org-maybe-keyword-time-regexp end t)
13786 (setq key (if (match-end 1)
13787 (substring (org-match-string-no-properties 1)
13788 0 -1))
13789 string (if (equal key clockstr)
13790 (org-no-properties
13791 (org-trim
13792 (buffer-substring
13793 (match-beginning 3) (goto-char
13794 (point-at-eol)))))
13795 (substring (org-match-string-no-properties 3)
13796 1 -1)))
13797 ;; Get the correct property name from the key. This is
13798 ;; necessary if the user has configured time keywords.
13799 (setq key1 (concat key ":"))
13800 (cond
13801 ((not key)
13802 (setq key
13803 (if (= (char-after (match-beginning 3)) ?\[)
13804 "TIMESTAMP_IA" "TIMESTAMP")))
13805 ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
13806 ((equal key1 org-deadline-string) (setq key "DEADLINE"))
13807 ((equal key1 org-closed-string) (setq key "CLOSED"))
13808 ((equal key1 org-clock-string) (setq key "CLOCK")))
13809 (if (and specific (equal key specific) (not (equal key "CLOCK")))
13810 (progn
13811 (push (cons key string) props)
13812 ;; no need to search further if match is found
13813 (throw 'match t))
13814 (when (or (equal key "CLOCK") (not (assoc key props)))
13815 (push (cons key string) props))))))
20908596 13816 )
c4f9780e 13817
20908596 13818 (when (memq which '(all standard))
c8d0cf5c 13819 ;; Get the standard properties, like :PROP: ...
20908596
CD
13820 (setq range (org-get-property-block beg end))
13821 (when range
13822 (goto-char (car range))
13823 (while (re-search-forward
13824 (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?")
13825 (cdr range) t)
13826 (setq key (org-match-string-no-properties 1)
13827 value (org-trim (or (org-match-string-no-properties 2) "")))
13828 (unless (member key excluded)
13829 (push (cons key (or value "")) props)))))
13830 (if clocksum
13831 (push (cons "CLOCKSUM"
13832 (org-columns-number-to-string (/ (float clocksum) 60.)
13833 'add_times))
13834 props))
71d35b24 13835 (unless (assoc "CATEGORY" props)
3ab2c837 13836 (push (cons "CATEGORY" (org-get-category)) props))
20908596
CD
13837 (append sum-props (nreverse props)))))))
13838
86fbb8ca 13839(defun org-entry-get (pom property &optional inherit literal-nil)
20908596
CD
13840 "Get value of PROPERTY for entry at point-or-marker POM.
13841If INHERIT is non-nil and the entry does not have the property,
13842then also check higher levels of the hierarchy.
13843If INHERIT is the symbol `selective', use inheritance only if the setting
13844in `org-use-property-inheritance' selects PROPERTY for inheritance.
13845If the property is present but empty, the return value is the empty string.
86fbb8ca
CD
13846If the property is not present at all, nil is returned.
13847
13848If LITERAL-NIL is set, return the string value \"nil\" as a string,
13849do not interpret it as the list atom nil. This is used for inheritance
13850when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
20908596
CD
13851 (org-with-point-at pom
13852 (if (and inherit (if (eq inherit 'selective)
13853 (org-property-inherit-p property)
13854 t))
86fbb8ca 13855 (org-entry-get-with-inheritance property literal-nil)
20908596 13856 (if (member property org-special-properties)
ed21c5c8
CD
13857 ;; We need a special property. Use `org-entry-properties' to
13858 ;; retrieve it, but specify the wanted property
13859 (cdr (assoc property (org-entry-properties nil 'special property)))
3ab2c837
BG
13860 (let ((range (unless (org-before-first-heading-p)
13861 (org-get-property-block))))
20908596
CD
13862 (if (and range
13863 (goto-char (car range))
13864 (re-search-forward
3ab2c837 13865 (org-re-property property)
20908596
CD
13866 (cdr range) t))
13867 ;; Found the property, return it.
13868 (if (match-end 1)
86fbb8ca
CD
13869 (if literal-nil
13870 (org-match-string-no-properties 1)
13871 (org-not-nil (org-match-string-no-properties 1)))
20908596
CD
13872 "")))))))
13873
13874(defun org-property-or-variable-value (var &optional inherit)
13875 "Check if there is a property fixing the value of VAR.
13876If yes, return this value. If not, return the current value of the variable."
13877 (let ((prop (org-entry-get nil (symbol-name var) inherit)))
13878 (if (and prop (stringp prop) (string-match "\\S-" prop))
13879 (read prop)
13880 (symbol-value var))))
13881
13882(defun org-entry-delete (pom property)
13883 "Delete the property PROPERTY from entry at point-or-marker POM."
13884 (org-with-point-at pom
13885 (if (member property org-special-properties)
13886 nil ; cannot delete these properties.
13887 (let ((range (org-get-property-block)))
13888 (if (and range
13889 (goto-char (car range))
13890 (re-search-forward
3ab2c837 13891 (org-re-property property)
20908596
CD
13892 (cdr range) t))
13893 (progn
13894 (delete-region (match-beginning 0) (1+ (point-at-eol)))
13895 t)
13896 nil)))))
13897
13898;; Multi-values properties are properties that contain multiple values
13899;; These values are assumed to be single words, separated by whitespace.
13900(defun org-entry-add-to-multivalued-property (pom property value)
13901 "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
13902 (let* ((old (org-entry-get pom property))
13903 (values (and old (org-split-string old "[ \t]"))))
621f83e4 13904 (setq value (org-entry-protect-space value))
20908596
CD
13905 (unless (member value values)
13906 (setq values (cons value values))
13907 (org-entry-put pom property
13908 (mapconcat 'identity values " ")))))
13909
13910(defun org-entry-remove-from-multivalued-property (pom property value)
13911 "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
13912 (let* ((old (org-entry-get pom property))
13913 (values (and old (org-split-string old "[ \t]"))))
621f83e4 13914 (setq value (org-entry-protect-space value))
20908596
CD
13915 (when (member value values)
13916 (setq values (delete value values))
13917 (org-entry-put pom property
13918 (mapconcat 'identity values " ")))))
9acdaa21 13919
20908596
CD
13920(defun org-entry-member-in-multivalued-property (pom property value)
13921 "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
13922 (let* ((old (org-entry-get pom property))
13923 (values (and old (org-split-string old "[ \t]"))))
621f83e4 13924 (setq value (org-entry-protect-space value))
20908596 13925 (member value values)))
9acdaa21 13926
621f83e4
CD
13927(defun org-entry-get-multivalued-property (pom property)
13928 "Return a list of values in a multivalued property."
13929 (let* ((value (org-entry-get pom property))
13930 (values (and value (org-split-string value "[ \t]"))))
13931 (mapcar 'org-entry-restore-space values)))
13932
13933(defun org-entry-put-multivalued-property (pom property &rest values)
13934 "Set multivalued PROPERTY at point-or-marker POM to VALUES.
13935VALUES should be a list of strings. Spaces will be protected."
13936 (org-entry-put pom property
13937 (mapconcat 'org-entry-protect-space values " "))
13938 (let* ((value (org-entry-get pom property))
13939 (values (and value (org-split-string value "[ \t]"))))
13940 (mapcar 'org-entry-restore-space values)))
13941
13942(defun org-entry-protect-space (s)
13943 "Protect spaces and newline in string S."
13944 (while (string-match " " s)
13945 (setq s (replace-match "%20" t t s)))
13946 (while (string-match "\n" s)
13947 (setq s (replace-match "%0A" t t s)))
13948 s)
13949
13950(defun org-entry-restore-space (s)
13951 "Restore spaces and newline in string S."
13952 (while (string-match "%20" s)
13953 (setq s (replace-match " " t t s)))
13954 (while (string-match "%0A" s)
13955 (setq s (replace-match "\n" t t s)))
13956 s)
13957
13958(defvar org-entry-property-inherited-from (make-marker)
33306645 13959 "Marker pointing to the entry from where a property was inherited.
621f83e4 13960Each call to `org-entry-get-with-inheritance' will set this marker to the
33306645 13961location of the entry where the inheritance search matched. If there was
621f83e4
CD
13962no match, the marker will point nowhere.
13963Note that also `org-entry-get' calls this function, if the INHERIT flag
13964is set.")
15841868 13965
86fbb8ca
CD
13966(defun org-entry-get-with-inheritance (property &optional literal-nil)
13967 "Get entry property, and search higher levels if not present.
13968The search will stop at the first ancestor which has the property defined.
13969If the value found is \"nil\", return nil to show that the property
13970should be considered as undefined (this is the meaning of nil here).
13971However, if LITERAL-NIL is set, return the string value \"nil\" instead."
621f83e4 13972 (move-marker org-entry-property-inherited-from nil)
20908596 13973 (let (tmp)
3ab2c837
BG
13974 (unless (org-before-first-heading-p)
13975 (save-excursion
13976 (save-restriction
13977 (widen)
13978 (catch 'ex
13979 (while t
13980 (when (setq tmp (org-entry-get nil property nil 'literal-nil))
13981 (org-back-to-heading t)
13982 (move-marker org-entry-property-inherited-from (point))
13983 (throw 'ex tmp))
13984 (or (org-up-heading-safe) (throw 'ex nil)))))))
13985 (setq tmp (or tmp
13986 (cdr (assoc property org-file-properties))
13987 (cdr (assoc property org-global-properties))
13988 (cdr (assoc property org-global-properties-fixed))))
13989 (if literal-nil tmp (org-not-nil tmp))))
c4f9780e 13990
ed21c5c8
CD
13991(defvar org-property-changed-functions nil
13992 "Hook called when the value of a property has changed.
13993Each hook function should accept two arguments, the name of the property
13994and the new value.")
13995
20908596
CD
13996(defun org-entry-put (pom property value)
13997 "Set PROPERTY to VALUE for entry at point-or-marker POM."
13998 (org-with-point-at pom
13999 (org-back-to-heading t)
14000 (let ((beg (point)) (end (save-excursion (outline-next-heading) (point)))
14001 range)
14002 (cond
14003 ((equal property "TODO")
14004 (when (and (stringp value) (string-match "\\S-" value)
14005 (not (member value org-todo-keywords-1)))
14006 (error "\"%s\" is not a valid TODO state" value))
14007 (if (or (not value)
14008 (not (string-match "\\S-" value)))
14009 (setq value 'none))
14010 (org-todo value)
14011 (org-set-tags nil 'align))
14012 ((equal property "PRIORITY")
14013 (org-priority (if (and value (stringp value) (string-match "\\S-" value))
14014 (string-to-char value) ?\ ))
14015 (org-set-tags nil 'align))
14016 ((equal property "SCHEDULED")
14017 (if (re-search-forward org-scheduled-time-regexp end t)
14018 (cond
14019 ((eq value 'earlier) (org-timestamp-change -1 'day))
14020 ((eq value 'later) (org-timestamp-change 1 'day))
14021 (t (call-interactively 'org-schedule)))
14022 (call-interactively 'org-schedule)))
14023 ((equal property "DEADLINE")
14024 (if (re-search-forward org-deadline-time-regexp end t)
14025 (cond
14026 ((eq value 'earlier) (org-timestamp-change -1 'day))
14027 ((eq value 'later) (org-timestamp-change 1 'day))
14028 (t (call-interactively 'org-deadline)))
14029 (call-interactively 'org-deadline)))
14030 ((member property org-special-properties)
14031 (error "The %s property can not yet be set with `org-entry-put'"
14032 property))
14033 (t ; a non-special property
14034 (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21
14035 (setq range (org-get-property-block beg end 'force))
14036 (goto-char (car range))
14037 (if (re-search-forward
3ab2c837 14038 (org-re-property property) (cdr range) t)
20908596 14039 (progn
3ab2c837
BG
14040 (delete-region (match-beginning 0) (match-end 0))
14041 (goto-char (match-beginning 0)))
20908596
CD
14042 (goto-char (cdr range))
14043 (insert "\n")
14044 (backward-char 1)
3ab2c837
BG
14045 (org-indent-line-function))
14046 (insert ":" property ":")
20908596 14047 (and value (insert " " value))
ed21c5c8
CD
14048 (org-indent-line-function)))))
14049 (run-hook-with-args 'org-property-changed-functions property value)))
03f3cf35 14050
20908596
CD
14051(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns)
14052 "Get all property keys in the current buffer.
33306645 14053With INCLUDE-SPECIALS, also list the special properties that reflect things
20908596
CD
14054like tags and TODO state.
14055With INCLUDE-DEFAULTS, also include properties that has special meaning
3ab2c837
BG
14056internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING
14057and others.
20908596
CD
14058With INCLUDE-COLUMNS, also include property names given in COLUMN
14059formats in the current buffer."
65c439fd 14060 (let (rtn range cfmt s p)
d3f4dbe8 14061 (save-excursion
20908596
CD
14062 (save-restriction
14063 (widen)
14064 (goto-char (point-min))
14065 (while (re-search-forward org-property-start-re nil t)
14066 (setq range (org-get-property-block))
14067 (goto-char (car range))
14068 (while (re-search-forward
14069 (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):")
14070 (cdr range) t)
14071 (add-to-list 'rtn (org-match-string-no-properties 1)))
14072 (outline-next-heading))))
791d856f 14073
20908596
CD
14074 (when include-specials
14075 (setq rtn (append org-special-properties rtn)))
d3f4dbe8 14076
20908596 14077 (when include-defaults
c8d0cf5c
CD
14078 (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)
14079 (add-to-list 'rtn org-effort-property))
38f8646b 14080
20908596
CD
14081 (when include-columns
14082 (save-excursion
14083 (save-restriction
14084 (widen)
14085 (goto-char (point-min))
14086 (while (re-search-forward
14087 "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)"
14088 nil t)
14089 (setq cfmt (match-string 2) s 0)
14090 (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)")
14091 cfmt s)
14092 (setq s (match-end 0)
14093 p (match-string 1 cfmt))
14094 (unless (or (equal p "ITEM")
14095 (member p org-special-properties))
14096 (add-to-list 'rtn (match-string 1 cfmt))))))))
2a57416f 14097
20908596 14098 (sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
2a57416f 14099
20908596 14100(defun org-property-values (key)
3ab2c837 14101 "Return a list of all values of property KEY in the current buffer."
20908596
CD
14102 (save-excursion
14103 (save-restriction
14104 (widen)
14105 (goto-char (point-min))
3ab2c837 14106 (let ((re (org-re-property key))
20908596
CD
14107 values)
14108 (while (re-search-forward re nil t)
14109 (add-to-list 'values (org-trim (match-string 1))))
14110 (delete "" values)))))
2a57416f 14111
20908596
CD
14112(defun org-insert-property-drawer ()
14113 "Insert a property drawer into the current entry."
14114 (interactive)
14115 (org-back-to-heading t)
3ab2c837 14116 (looking-at org-outline-regexp)
c8d0cf5c
CD
14117 (let ((indent (if org-adapt-indentation
14118 (- (match-end 0)(match-beginning 0))
14119 0))
20908596
CD
14120 (beg (point))
14121 (re (concat "^[ \t]*" org-keyword-time-regexp))
14122 end hiddenp)
14123 (outline-next-heading)
14124 (setq end (point))
14125 (goto-char beg)
14126 (while (re-search-forward re end t))
3ab2c837 14127 (setq hiddenp (outline-invisible-p))
20908596
CD
14128 (end-of-line 1)
14129 (and (equal (char-after) ?\n) (forward-char 1))
c8d0cf5c
CD
14130 (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)")
14131 (if (member (match-string 1) '("CLOCK:" ":END:"))
14132 ;; just skip this line
14133 (beginning-of-line 2)
14134 ;; Drawer start, find the end
14135 (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t)
14136 (beginning-of-line 1)))
20908596
CD
14137 (org-skip-over-state-notes)
14138 (skip-chars-backward " \t\n\r")
14139 (if (eq (char-before) ?*) (forward-char 1))
14140 (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
14141 (beginning-of-line 0)
14142 (org-indent-to-column indent)
14143 (beginning-of-line 2)
14144 (org-indent-to-column indent)
14145 (beginning-of-line 0)
14146 (if hiddenp
14147 (save-excursion
14148 (org-back-to-heading t)
14149 (hide-entry))
14150 (org-flag-drawer t))))
d3f4dbe8 14151
3ab2c837
BG
14152(defvar org-property-set-functions-alist nil
14153 "Property set function alist.
14154Each entry should have the following format:
14155
14156 (PROPERTY . READ-FUNCTION)
14157
14158The read function will be called with the same argument as
14159`org-completing-read'.")
14160
14161(defun org-set-property-function (property)
14162 "Get the function that should be used to set PROPERTY.
14163This is computed according to `org-property-set-functions-alist'."
14164 (or (cdr (assoc property org-property-set-functions-alist))
14165 'org-completing-read))
14166
14167(defun org-read-property-value (property)
14168 "Read PROPERTY value from user."
14169 (let* ((completion-ignore-case t)
14170 (allowed (org-property-get-allowed-values nil property 'table))
14171 (cur (org-entry-get nil property))
14172 (prompt (concat property " value"
14173 (if (and cur (string-match "\\S-" cur))
14174 (concat " [" cur "]") "") ": "))
14175 (set-function (org-set-property-function property))
14176 (val (if allowed
14177 (funcall set-function prompt allowed nil
14178 (not (get-text-property 0 'org-unrestricted
14179 (caar allowed))))
14180 (let (org-completion-use-ido org-completion-use-iswitchb)
14181 (funcall set-function prompt
14182 (mapcar 'list (org-property-values property))
14183 nil nil "" nil cur)))))
14184 (if (equal val "")
14185 cur
14186 val)))
14187
14188(defvar org-last-set-property nil)
14189(defun org-read-property-name ()
14190 "Read a property name."
14191 (let* ((completion-ignore-case t)
14192 (keys (org-buffer-property-keys nil t t))
14193 (default-prop (or (save-excursion
14194 (save-match-data
14195 (beginning-of-line)
14196 (and (looking-at "^\\s-*:\\([^:\n]+\\):")
14197 (null (string= (match-string 1) "END"))
14198 (match-string 1))))
14199 org-last-set-property))
14200 (property (org-icompleting-read
14201 (concat "Property"
14202 (if default-prop (concat " [" default-prop "]") "")
14203 ": ")
14204 (mapcar 'list keys)
14205 nil nil nil nil
14206 default-prop
14207 )))
14208 (if (member property keys)
14209 property
14210 (or (cdr (assoc (downcase property)
14211 (mapcar (lambda (x) (cons (downcase x) x))
14212 keys)))
14213 property))))
14214
20908596
CD
14215(defun org-set-property (property value)
14216 "In the current entry, set PROPERTY to VALUE.
14217When called interactively, this will prompt for a property name, offering
14218completion on existing and default properties. And then it will prompt
33306645 14219for a value, offering completion either on allowed values (via an inherited
20908596
CD
14220xxx_ALL property) or on existing values in other instances of this property
14221in the current file."
3ab2c837
BG
14222 (interactive (list nil nil))
14223 (let* ((property (or property (org-read-property-name)))
14224 (value (or value (org-read-property-value property))))
14225 (setq org-last-set-property property)
14226 (unless (equal (org-entry-get nil property) value)
14227 (org-entry-put nil property value))))
791d856f 14228
20908596
CD
14229(defun org-delete-property (property)
14230 "In the current entry, delete PROPERTY."
14231 (interactive
b349f79f 14232 (let* ((completion-ignore-case t)
86fbb8ca
CD
14233 (prop (org-icompleting-read "Property: "
14234 (org-entry-properties nil 'standard))))
20908596
CD
14235 (list prop)))
14236 (message "Property %s %s" property
14237 (if (org-entry-delete nil property)
14238 "deleted"
14239 "was not present in the entry")))
d3f4dbe8 14240
20908596
CD
14241(defun org-delete-property-globally (property)
14242 "Remove PROPERTY globally, from all entries."
14243 (interactive
b349f79f 14244 (let* ((completion-ignore-case t)
54a0dee5 14245 (prop (org-icompleting-read
20908596
CD
14246 "Globally remove property: "
14247 (mapcar 'list (org-buffer-property-keys)))))
14248 (list prop)))
14249 (save-excursion
14250 (save-restriction
14251 (widen)
14252 (goto-char (point-min))
14253 (let ((cnt 0))
14254 (while (re-search-forward
3ab2c837 14255 (org-re-property property)
20908596
CD
14256 nil t)
14257 (setq cnt (1+ cnt))
14258 (replace-match ""))
14259 (message "Property \"%s\" removed from %d entries" property cnt)))))
d3f4dbe8 14260
20908596 14261(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
d3f4dbe8 14262
20908596
CD
14263(defun org-compute-property-at-point ()
14264 "Compute the property at point.
14265This looks for an enclosing column format, extracts the operator and
33306645 14266then applies it to the property in the column format's scope."
30313b90 14267 (interactive)
20908596
CD
14268 (unless (org-at-property-p)
14269 (error "Not at a property"))
14270 (let ((prop (org-match-string-no-properties 2)))
14271 (org-columns-get-format-and-top-level)
14272 (unless (nth 3 (assoc prop org-columns-current-fmt-compiled))
14273 (error "No operator defined for property %s" prop))
14274 (org-columns-compute prop)))
d3f4dbe8 14275
ed21c5c8
CD
14276(defvar org-property-allowed-value-functions nil
14277 "Hook for functions supplying allowed values for a specific property.
14278The functions must take a single argument, the name of the property, and
14279return a flat list of allowed values. If \":ETC\" is one of
14280the values, this means that these values are intended as defaults for
14281completion, but that other values should be allowed too.
14282The functions must return nil if they are not responsible for this
14283property.")
14284
20908596
CD
14285(defun org-property-get-allowed-values (pom property &optional table)
14286 "Get allowed values for the property PROPERTY.
14287When TABLE is non-nil, return an alist that can directly be used for
14288completion."
14289 (let (vals)
14290 (cond
14291 ((equal property "TODO")
14292 (setq vals (org-with-point-at pom
14293 (append org-todo-keywords-1 '("")))))
14294 ((equal property "PRIORITY")
14295 (let ((n org-lowest-priority))
14296 (while (>= n org-highest-priority)
14297 (push (char-to-string n) vals)
14298 (setq n (1- n)))))
14299 ((member property org-special-properties))
ed21c5c8
CD
14300 ((setq vals (run-hook-with-args-until-success
14301 'org-property-allowed-value-functions property)))
20908596
CD
14302 (t
14303 (setq vals (org-entry-get pom (concat property "_ALL") 'inherit))
20908596
CD
14304 (when (and vals (string-match "\\S-" vals))
14305 (setq vals (car (read-from-string (concat "(" vals ")"))))
14306 (setq vals (mapcar (lambda (x)
14307 (cond ((stringp x) x)
14308 ((numberp x) (number-to-string x))
14309 ((symbolp x) (symbol-name x))
14310 (t "???")))
14311 vals)))))
ed21c5c8
CD
14312 (when (member ":ETC" vals)
14313 (setq vals (remove ":ETC" vals))
14314 (org-add-props (car vals) '(org-unrestricted t)))
20908596 14315 (if table (mapcar 'list vals) vals)))
03f3cf35 14316
20908596
CD
14317(defun org-property-previous-allowed-value (&optional previous)
14318 "Switch to the next allowed value for this property."
14319 (interactive)
14320 (org-property-next-allowed-value t))
d3f4dbe8 14321
20908596
CD
14322(defun org-property-next-allowed-value (&optional previous)
14323 "Switch to the next allowed value for this property."
d3f4dbe8 14324 (interactive)
20908596
CD
14325 (unless (org-at-property-p)
14326 (error "Not at a property"))
14327 (let* ((key (match-string 2))
14328 (value (match-string 3))
14329 (allowed (or (org-property-get-allowed-values (point) key)
14330 (and (member value '("[ ]" "[-]" "[X]"))
14331 '("[ ]" "[X]"))))
14332 nval)
14333 (unless allowed
14334 (error "Allowed values for this property have not been defined"))
14335 (if previous (setq allowed (reverse allowed)))
14336 (if (member value allowed)
14337 (setq nval (car (cdr (member value allowed)))))
14338 (setq nval (or nval (car allowed)))
14339 (if (equal nval value)
14340 (error "Only one allowed value for this property"))
14341 (org-at-property-p)
14342 (replace-match (concat " :" key ": " nval) t t)
14343 (org-indent-line-function)
14344 (beginning-of-line 1)
ed21c5c8
CD
14345 (skip-chars-forward " \t")
14346 (run-hook-with-args 'org-property-changed-functions key nval)))
d3f4dbe8 14347
86fbb8ca
CD
14348(defun org-find-olp (path &optional this-buffer)
14349 "Return a marker pointing to the entry at outline path OLP.
14350If anything goes wrong, throw an error.
14351You can wrap this call to catch the error like this:
14352
14353 (condition-case msg
14354 (org-mobile-locate-entry (match-string 4))
14355 (error (nth 1 msg)))
14356
14357The return value will then be either a string with the error message,
14358or a marker if everything is OK.
14359
14360If THIS-BUFFER is set, the outline path does not contain a file,
14361only headings."
14362 (let* ((file (if this-buffer buffer-file-name (pop path)))
14363 (buffer (if this-buffer (current-buffer) (find-file-noselect file)))
14364 (level 1)
14365 (lmin 1)
14366 (lmax 1)
3ab2c837 14367 limit re end found pos heading cnt flevel)
86fbb8ca
CD
14368 (unless buffer (error "File not found :%s" file))
14369 (with-current-buffer buffer
14370 (save-excursion
14371 (save-restriction
14372 (widen)
14373 (setq limit (point-max))
14374 (goto-char (point-min))
14375 (while (setq heading (pop path))
14376 (setq re (format org-complex-heading-regexp-format
14377 (regexp-quote heading)))
14378 (setq cnt 0 pos (point))
14379 (while (re-search-forward re end t)
14380 (setq level (- (match-end 1) (match-beginning 1)))
14381 (if (and (>= level lmin) (<= level lmax))
3ab2c837 14382 (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
86fbb8ca
CD
14383 (when (= cnt 0) (error "Heading not found on level %d: %s"
14384 lmax heading))
14385 (when (> cnt 1) (error "Heading not unique on level %d: %s"
14386 lmax heading))
14387 (goto-char found)
3ab2c837 14388 (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
86fbb8ca
CD
14389 (setq end (save-excursion (org-end-of-subtree t t))))
14390 (when (org-on-heading-p)
14391 (move-marker (make-marker) (point))))))))
14392
afe98dfa
CD
14393(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
14394 "Find node HEADING in BUFFER.
14395Return a marker to the heading if it was found, or nil if not.
14396If POS-ONLY is set, return just the position instead of a marker.
14397
14398The heading text must match exact, but it may have a TODO keyword,
14399a priority cookie and tags in the standard locations."
14400 (with-current-buffer (or buffer (current-buffer))
14401 (save-excursion
14402 (save-restriction
14403 (widen)
14404 (goto-char (point-min))
14405 (let (case-fold-search)
14406 (if (re-search-forward
14407 (format org-complex-heading-regexp-format
14408 (regexp-quote heading)) nil t)
14409 (if pos-only
14410 (match-beginning 0)
14411 (move-marker (make-marker) (match-beginning 0)))))))))
14412
14413(defun org-find-exact-heading-in-directory (heading &optional dir)
14414 "Find Org node headline HEADING in all .org files in directory DIR.
14415When the target headline is found, return a marker to this location."
14416 (let ((files (directory-files (or dir default-directory)
14417 nil "\\`[^.#].*\\.org\\'"))
14418 file visiting m buffer)
14419 (catch 'found
14420 (while (setq file (pop files))
14421 (message "trying %s" file)
14422 (setq visiting (org-find-base-buffer-visiting file))
14423 (setq buffer (or visiting (find-file-noselect file)))
14424 (setq m (org-find-exact-headline-in-buffer
14425 heading buffer))
14426 (when (and (not m) (not visiting)) (kill-buffer buffer))
14427 (and m (throw 'found m))))))
14428
20908596
CD
14429(defun org-find-entry-with-id (ident)
14430 "Locate the entry that contains the ID property with exact value IDENT.
14431IDENT can be a string, a symbol or a number, this function will search for
14432the string representation of it.
14433Return the position where this entry starts, or nil if there is no such entry."
db55f368 14434 (interactive "sID: ")
20908596
CD
14435 (let ((id (cond
14436 ((stringp ident) ident)
14437 ((symbol-name ident) (symbol-name ident))
14438 ((numberp ident) (number-to-string ident))
14439 (t (error "IDENT %s must be a string, symbol or number" ident))))
14440 (case-fold-search nil))
14441 (save-excursion
14442 (save-restriction
14443 (widen)
14444 (goto-char (point-min))
14445 (when (re-search-forward
14446 (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
14447 nil t)
c8d0cf5c 14448 (org-back-to-heading t)
20908596 14449 (point))))))
48aaad2d 14450
20908596 14451;;;; Timestamps
d3f4dbe8 14452
20908596 14453(defvar org-last-changed-timestamp nil)
b349f79f
CD
14454(defvar org-last-inserted-timestamp nil
14455 "The last time stamp inserted with `org-insert-time-stamp'.")
20908596
CD
14456(defvar org-time-was-given) ; dynamically scoped parameter
14457(defvar org-end-time-was-given) ; dynamically scoped parameter
14458(defvar org-ts-what) ; dynamically scoped parameter
14459
621f83e4 14460(defun org-time-stamp (arg &optional inactive)
20908596
CD
14461 "Prompt for a date/time and insert a time stamp.
14462If the user specifies a time like HH:MM, or if this command is called
14463with a prefix argument, the time stamp will contain date and time.
14464Otherwise, only the date will be included. All parts of a date not
14465specified by the user will be filled in from the current date/time.
14466So if you press just return without typing anything, the time stamp
14467will represent the current date/time. If there is already a timestamp
14468at the cursor, it will be modified."
14469 (interactive "P")
14470 (let* ((ts nil)
14471 (default-time
14472 ;; Default time is either today, or, when entering a range,
14473 ;; the range start.
14474 (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0)))
14475 (save-excursion
14476 (re-search-backward
14477 (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
14478 (- (point) 20) t)))
14479 (apply 'encode-time (org-parse-time-string (match-string 1)))
14480 (current-time)))
14481 (default-input (and ts (org-get-compact-tod ts)))
3ab2c837
BG
14482 (repeater (save-excursion
14483 (save-match-data
14484 (beginning-of-line)
14485 (when (re-search-forward
14486 "\\([.+-]+[0-9]+[dwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[dwmy]\\)?\\) ?"
14487 (save-excursion (progn (end-of-line) (point))) t)
14488 (match-string 0)))))
20908596
CD
14489 org-time-was-given org-end-time-was-given time)
14490 (cond
621f83e4
CD
14491 ((and (org-at-timestamp-p t)
14492 (memq last-command '(org-time-stamp org-time-stamp-inactive))
14493 (memq this-command '(org-time-stamp org-time-stamp-inactive)))
20908596
CD
14494 (insert "--")
14495 (setq time (let ((this-command this-command))
621f83e4
CD
14496 (org-read-date arg 'totime nil nil
14497 default-time default-input)))
14498 (org-insert-time-stamp time (or org-time-was-given arg) inactive))
14499 ((org-at-timestamp-p t)
20908596
CD
14500 (setq time (let ((this-command this-command))
14501 (org-read-date arg 'totime nil nil default-time default-input)))
621f83e4
CD
14502 (when (org-at-timestamp-p t) ; just to get the match data
14503; (setq inactive (eq (char-after (match-beginning 0)) ?\[))
20908596
CD
14504 (replace-match "")
14505 (setq org-last-changed-timestamp
14506 (org-insert-time-stamp
14507 time (or org-time-was-given arg)
3ab2c837
BG
14508 inactive nil nil (list org-end-time-was-given)))
14509 (when repeater (goto-char (1- (point))) (insert " " repeater)
14510 (setq org-last-changed-timestamp
14511 (concat (substring org-last-inserted-timestamp 0 -1)
14512 " " repeater ">"))))
20908596
CD
14513 (message "Timestamp updated"))
14514 (t
14515 (setq time (let ((this-command this-command))
14516 (org-read-date arg 'totime nil nil default-time default-input)))
621f83e4
CD
14517 (org-insert-time-stamp time (or org-time-was-given arg) inactive
14518 nil nil (list org-end-time-was-given))))))
d3f4dbe8 14519
20908596
CD
14520;; FIXME: can we use this for something else, like computing time differences?
14521(defun org-get-compact-tod (s)
14522 (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s)
14523 (let* ((t1 (match-string 1 s))
14524 (h1 (string-to-number (match-string 2 s)))
14525 (m1 (string-to-number (match-string 3 s)))
14526 (t2 (and (match-end 4) (match-string 5 s)))
14527 (h2 (and t2 (string-to-number (match-string 6 s))))
14528 (m2 (and t2 (string-to-number (match-string 7 s))))
14529 dh dm)
14530 (if (not t2)
14531 t1
14532 (setq dh (- h2 h1) dm (- m2 m1))
14533 (if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
14534 (concat t1 "+" (number-to-string dh)
14535 (if (/= 0 dm) (concat ":" (number-to-string dm))))))))
d3f4dbe8 14536
20908596
CD
14537(defun org-time-stamp-inactive (&optional arg)
14538 "Insert an inactive time stamp.
14539An inactive time stamp is enclosed in square brackets instead of angle
14540brackets. It is inactive in the sense that it does not trigger agenda entries,
14541does not link to the calendar and cannot be changed with the S-cursor keys.
14542So these are more for recording a certain time/date."
14543 (interactive "P")
621f83e4 14544 (org-time-stamp arg 'inactive))
15841868 14545
86fbb8ca
CD
14546(defvar org-date-ovl (make-overlay 1 1))
14547(overlay-put org-date-ovl 'face 'org-warning)
20908596 14548(org-detach-overlay org-date-ovl)
d3f4dbe8 14549
20908596
CD
14550(defvar org-ans1) ; dynamically scoped parameter
14551(defvar org-ans2) ; dynamically scoped parameter
8c6fb58b 14552
20908596 14553(defvar org-plain-time-of-day-regexp) ; defined below
d3f4dbe8 14554
b349f79f 14555(defvar org-overriding-default-time nil) ; dynamically scoped
20908596
CD
14556(defvar org-read-date-overlay nil)
14557(defvar org-dcst nil) ; dynamically scoped
c8d0cf5c
CD
14558(defvar org-read-date-history nil)
14559(defvar org-read-date-final-answer nil)
3ab2c837
BG
14560(defvar org-read-date-analyze-futurep nil)
14561(defvar org-read-date-analyze-forced-year nil)
d3f4dbe8 14562
20908596
CD
14563(defun org-read-date (&optional with-time to-time from-string prompt
14564 default-time default-input)
14565 "Read a date, possibly a time, and make things smooth for the user.
14566The prompt will suggest to enter an ISO date, but you can also enter anything
14567which will at least partially be understood by `parse-time-string'.
14568Unrecognized parts of the date will default to the current day, month, year,
14569hour and minute. If this command is called to replace a timestamp at point,
86fbb8ca
CD
14570of to enter the second timestamp of a range, the default time is taken
14571from the existing stamp. Furthermore, the command prefers the future,
14572so if you are giving a date where the year is not given, and the day-month
14573combination is already past in the current year, it will assume you
14574mean next year. For details, see the manual. A few examples:
14575
20908596
CD
14576 3-2-5 --> 2003-02-05
14577 feb 15 --> currentyear-02-15
86fbb8ca 14578 2/15 --> currentyear-02-15
20908596
CD
14579 sep 12 9 --> 2009-09-12
14580 12:45 --> today 12:45
14581 22 sept 0:34 --> currentyear-09-22 0:34
14582 12 --> currentyear-currentmonth-12
14583 Fri --> nearest Friday (today or later)
14584 etc.
8c6fb58b 14585
20908596
CD
14586Furthermore you can specify a relative date by giving, as the *first* thing
14587in the input: a plus/minus sign, a number and a letter [dwmy] to indicate
14588change in days weeks, months, years.
14589With a single plus or minus, the date is relative to today. With a double
14590plus or minus, it is relative to the date in DEFAULT-TIME. E.g.
14591 +4d --> four days from today
14592 +4 --> same as above
14593 +2w --> two weeks from today
14594 ++5 --> five days from default date
d3f4dbe8 14595
20908596
CD
14596The function understands only English month and weekday abbreviations,
14597but this can be configured with the variables `parse-time-months' and
14598`parse-time-weekdays'.
d3f4dbe8 14599
20908596
CD
14600While prompting, a calendar is popped up - you can also select the
14601date with the mouse (button 1). The calendar shows a period of three
14602months. To scroll it to other months, use the keys `>' and `<'.
14603If you don't like the calendar, turn it off with
14604 \(setq org-read-date-popup-calendar nil)
48aaad2d 14605
20908596
CD
14606With optional argument TO-TIME, the date will immediately be converted
14607to an internal time.
14608With an optional argument WITH-TIME, the prompt will suggest to also
14609insert a time. Note that when WITH-TIME is not set, you can still
14610enter a time, and this function will inform the calling routine about
14611this change. The calling routine may then choose to change the format
14612used to insert the time stamp into the buffer to include the time.
14613With optional argument FROM-STRING, read from this string instead from
14614the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
14615the time/date that is used for everything that is not specified by the
14616user."
14617 (require 'parse-time)
14618 (let* ((org-time-stamp-rounding-minutes
14619 (if (equal with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
14620 (org-dcst org-display-custom-times)
14621 (ct (org-current-time))
b349f79f 14622 (def (or org-overriding-default-time default-time ct))
20908596
CD
14623 (defdecode (decode-time def))
14624 (dummy (progn
14625 (when (< (nth 2 defdecode) org-extend-today-until)
14626 (setcar (nthcdr 2 defdecode) -1)
14627 (setcar (nthcdr 1 defdecode) 59)
14628 (setq def (apply 'encode-time defdecode)
14629 defdecode (decode-time def)))))
c8d0cf5c 14630 (calendar-frame-setup nil)
86fbb8ca 14631 (calendar-setup nil)
20908596
CD
14632 (calendar-move-hook nil)
14633 (calendar-view-diary-initially-flag nil)
20908596 14634 (calendar-view-holidays-initially-flag nil)
20908596
CD
14635 (timestr (format-time-string
14636 (if with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") def))
14637 (prompt (concat (if prompt (concat prompt " ") "")
14638 (format "Date+time [%s]: " timestr)))
14639 ans (org-ans0 "") org-ans1 org-ans2 final)
d3f4dbe8 14640
38f8646b 14641 (cond
20908596
CD
14642 (from-string (setq ans from-string))
14643 (org-read-date-popup-calendar
14644 (save-excursion
14645 (save-window-excursion
14646 (calendar)
3ab2c837
BG
14647 (unwind-protect
14648 (progn
14649 (calendar-forward-day (- (time-to-days def)
14650 (calendar-absolute-from-gregorian
14651 (calendar-current-date))))
14652 (org-eval-in-calendar nil t)
14653 (let* ((old-map (current-local-map))
14654 (map (copy-keymap calendar-mode-map))
14655 (minibuffer-local-map (copy-keymap minibuffer-local-map)))
14656 (org-defkey map (kbd "RET") 'org-calendar-select)
14657 (org-defkey map [mouse-1] 'org-calendar-select-mouse)
14658 (org-defkey map [mouse-2] 'org-calendar-select-mouse)
14659 (org-defkey minibuffer-local-map [(meta shift left)]
14660 (lambda () (interactive)
14661 (org-eval-in-calendar '(calendar-backward-month 1))))
14662 (org-defkey minibuffer-local-map [(meta shift right)]
14663 (lambda () (interactive)
14664 (org-eval-in-calendar '(calendar-forward-month 1))))
14665 (org-defkey minibuffer-local-map [(meta shift up)]
14666 (lambda () (interactive)
14667 (org-eval-in-calendar '(calendar-backward-year 1))))
14668 (org-defkey minibuffer-local-map [(meta shift down)]
14669 (lambda () (interactive)
14670 (org-eval-in-calendar '(calendar-forward-year 1))))
14671 (org-defkey minibuffer-local-map [?\e (shift left)]
14672 (lambda () (interactive)
14673 (org-eval-in-calendar '(calendar-backward-month 1))))
14674 (org-defkey minibuffer-local-map [?\e (shift right)]
14675 (lambda () (interactive)
14676 (org-eval-in-calendar '(calendar-forward-month 1))))
14677 (org-defkey minibuffer-local-map [?\e (shift up)]
14678 (lambda () (interactive)
14679 (org-eval-in-calendar '(calendar-backward-year 1))))
14680 (org-defkey minibuffer-local-map [?\e (shift down)]
14681 (lambda () (interactive)
14682 (org-eval-in-calendar '(calendar-forward-year 1))))
14683 (org-defkey minibuffer-local-map [(shift up)]
14684 (lambda () (interactive)
14685 (org-eval-in-calendar '(calendar-backward-week 1))))
14686 (org-defkey minibuffer-local-map [(shift down)]
14687 (lambda () (interactive)
14688 (org-eval-in-calendar '(calendar-forward-week 1))))
14689 (org-defkey minibuffer-local-map [(shift left)]
14690 (lambda () (interactive)
14691 (org-eval-in-calendar '(calendar-backward-day 1))))
14692 (org-defkey minibuffer-local-map [(shift right)]
14693 (lambda () (interactive)
14694 (org-eval-in-calendar '(calendar-forward-day 1))))
14695 (org-defkey minibuffer-local-map ">"
14696 (lambda () (interactive)
14697 (org-eval-in-calendar '(scroll-calendar-left 1))))
14698 (org-defkey minibuffer-local-map "<"
14699 (lambda () (interactive)
14700 (org-eval-in-calendar '(scroll-calendar-right 1))))
14701 (org-defkey minibuffer-local-map "\C-v"
14702 (lambda () (interactive)
14703 (org-eval-in-calendar
14704 '(calendar-scroll-left-three-months 1))))
14705 (org-defkey minibuffer-local-map "\M-v"
14706 (lambda () (interactive)
14707 (org-eval-in-calendar
14708 '(calendar-scroll-right-three-months 1))))
14709 (run-hooks 'org-read-date-minibuffer-setup-hook)
14710 (unwind-protect
14711 (progn
14712 (use-local-map map)
14713 (add-hook 'post-command-hook 'org-read-date-display)
14714 (setq org-ans0 (read-string prompt default-input
14715 'org-read-date-history nil))
14716 ;; org-ans0: from prompt
14717 ;; org-ans1: from mouse click
14718 ;; org-ans2: from calendar motion
14719 (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
14720 (remove-hook 'post-command-hook 'org-read-date-display)
14721 (use-local-map old-map)
14722 (when org-read-date-overlay
14723 (delete-overlay org-read-date-overlay)
14724 (setq org-read-date-overlay nil)))))
14725 (bury-buffer "*Calendar*")))))
d3f4dbe8 14726
20908596
CD
14727 (t ; Naked prompt only
14728 (unwind-protect
c8d0cf5c
CD
14729 (setq ans (read-string prompt default-input
14730 'org-read-date-history timestr))
20908596 14731 (when org-read-date-overlay
86fbb8ca 14732 (delete-overlay org-read-date-overlay)
20908596 14733 (setq org-read-date-overlay nil)))))
d3f4dbe8 14734
20908596 14735 (setq final (org-read-date-analyze ans def defdecode))
afe98dfa 14736
3ab2c837
BG
14737 (when org-read-date-analyze-forced-year
14738 (message "Year was forced into %s"
14739 (if org-read-date-force-compatible-dates
14740 "compatible range (1970-2037)"
14741 "range representable on this machine"))
14742 (ding))
14743
afe98dfa
CD
14744 ;; One round trip to get rid of 34th of August and stuff like that....
14745 (setq final (decode-time (apply 'encode-time final)))
14746
c8d0cf5c 14747 (setq org-read-date-final-answer ans)
d3f4dbe8 14748
20908596
CD
14749 (if to-time
14750 (apply 'encode-time final)
14751 (if (and (boundp 'org-time-was-given) org-time-was-given)
14752 (format "%04d-%02d-%02d %02d:%02d"
14753 (nth 5 final) (nth 4 final) (nth 3 final)
14754 (nth 2 final) (nth 1 final))
14755 (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
c8d0cf5c 14756
20908596
CD
14757(defvar def)
14758(defvar defdecode)
14759(defvar with-time)
14760(defun org-read-date-display ()
33306645 14761 "Display the current date prompt interpretation in the minibuffer."
20908596
CD
14762 (when org-read-date-display-live
14763 (when org-read-date-overlay
86fbb8ca 14764 (delete-overlay org-read-date-overlay))
20908596
CD
14765 (let ((p (point)))
14766 (end-of-line 1)
14767 (while (not (equal (buffer-substring
14768 (max (point-min) (- (point) 4)) (point))
14769 " "))
14770 (insert " "))
14771 (goto-char p))
14772 (let* ((ans (concat (buffer-substring (point-at-bol) (point-max))
14773 " " (or org-ans1 org-ans2)))
14774 (org-end-time-was-given nil)
14775 (f (org-read-date-analyze ans def defdecode))
14776 (fmts (if org-dcst
14777 org-time-stamp-custom-formats
14778 org-time-stamp-formats))
14779 (fmt (if (or with-time
14780 (and (boundp 'org-time-was-given) org-time-was-given))
14781 (cdr fmts)
14782 (car fmts)))
14783 (txt (concat "=> " (format-time-string fmt (apply 'encode-time f)))))
14784 (when (and org-end-time-was-given
14785 (string-match org-plain-time-of-day-regexp txt))
14786 (setq txt (concat (substring txt 0 (match-end 0)) "-"
14787 org-end-time-was-given
14788 (substring txt (match-end 0)))))
8bfe682a
CD
14789 (when org-read-date-analyze-futurep
14790 (setq txt (concat txt " (=>F)")))
20908596 14791 (setq org-read-date-overlay
86fbb8ca 14792 (make-overlay (1- (point-at-eol)) (point-at-eol)))
20908596 14793 (org-overlay-display org-read-date-overlay txt 'secondary-selection))))
d3f4dbe8 14794
20908596 14795(defun org-read-date-analyze (ans def defdecode)
86fbb8ca 14796 "Analyze the combined answer of the date prompt."
20908596 14797 ;; FIXME: cleanup and comment
ed21c5c8
CD
14798 (let ((nowdecode (decode-time (current-time)))
14799 delta deltan deltaw deltadef year month day
14800 hour minute second wday pm h2 m2 tl wday1
14801 iso-year iso-weekday iso-week iso-year iso-date futurep kill-year)
3ab2c837
BG
14802 (setq org-read-date-analyze-futurep nil
14803 org-read-date-analyze-forced-year nil)
b349f79f
CD
14804 (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
14805 (setq ans "+0"))
14806
20908596
CD
14807 (when (setq delta (org-read-date-get-relative ans (current-time) def))
14808 (setq ans (replace-match "" t t ans)
14809 deltan (car delta)
14810 deltaw (nth 1 delta)
14811 deltadef (nth 2 delta)))
d3f4dbe8 14812
20908596 14813 ;; Check if there is an iso week date in there
5dec9555 14814 ;; If yes, store the info and postpone interpreting it until the rest
20908596
CD
14815 ;; of the parsing is done
14816 (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
ed21c5c8
CD
14817 (setq iso-year (if (match-end 1)
14818 (org-small-year-to-year
14819 (string-to-number (match-string 1 ans))))
14820 iso-weekday (if (match-end 3)
14821 (string-to-number (match-string 3 ans)))
20908596
CD
14822 iso-week (string-to-number (match-string 2 ans)))
14823 (setq ans (replace-match "" t t ans)))
d3f4dbe8 14824
ed21c5c8 14825 ;; Help matching ISO dates with single digit month or day, like 2006-8-11.
20908596
CD
14826 (when (string-match
14827 "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
14828 (setq year (if (match-end 2)
14829 (string-to-number (match-string 2 ans))
ed21c5c8
CD
14830 (progn (setq kill-year t)
14831 (string-to-number (format-time-string "%Y"))))
20908596
CD
14832 month (string-to-number (match-string 3 ans))
14833 day (string-to-number (match-string 4 ans)))
14834 (if (< year 100) (setq year (+ 2000 year)))
14835 (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
14836 t nil ans)))
3ab2c837 14837
4c36be58 14838 ;; Help matching dotted european dates
3ab2c837
BG
14839 (when (string-match
14840 "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\. ?\\([1-9][0-9][0-9][0-9]\\)?" ans)
14841 (setq year (if (match-end 3)
14842 (string-to-number (match-string 3 ans))
14843 (progn (setq kill-year t)
14844 (string-to-number (format-time-string "%Y"))))
14845 day (string-to-number (match-string 1 ans))
14846 month (string-to-number (match-string 2 ans))
14847 ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
14848 t nil ans)))
14849
ed21c5c8
CD
14850 ;; Help matching american dates, like 5/30 or 5/30/7
14851 (when (string-match
86fbb8ca 14852 "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans)
ed21c5c8
CD
14853 (setq year (if (match-end 4)
14854 (string-to-number (match-string 4 ans))
14855 (progn (setq kill-year t)
14856 (string-to-number (format-time-string "%Y"))))
14857 month (string-to-number (match-string 1 ans))
14858 day (string-to-number (match-string 2 ans)))
14859 (if (< year 100) (setq year (+ 2000 year)))
14860 (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
14861 t nil ans)))
20908596
CD
14862 ;; Help matching am/pm times, because `parse-time-string' does not do that.
14863 ;; If there is a time with am/pm, and *no* time without it, we convert
14864 ;; so that matching will be successful.
14865 (loop for i from 1 to 2 do ; twice, for end time as well
14866 (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
14867 (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
14868 (setq hour (string-to-number (match-string 1 ans))
14869 minute (if (match-end 3)
14870 (string-to-number (match-string 3 ans))
14871 0)
14872 pm (equal ?p
14873 (string-to-char (downcase (match-string 4 ans)))))
14874 (if (and (= hour 12) (not pm))
14875 (setq hour 0)
14876 (if (and pm (< hour 12)) (setq hour (+ 12 hour))))
14877 (setq ans (replace-match (format "%02d:%02d" hour minute)
14878 t t ans))))
d3f4dbe8 14879
20908596
CD
14880 ;; Check if a time range is given as a duration
14881 (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
14882 (setq hour (string-to-number (match-string 1 ans))
14883 h2 (+ hour (string-to-number (match-string 3 ans)))
14884 minute (string-to-number (match-string 2 ans))
14885 m2 (+ minute (if (match-end 5) (string-to-number
14886 (match-string 5 ans))0)))
14887 (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
14888 (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
14889 t t ans)))
d3f4dbe8 14890
20908596
CD
14891 ;; Check if there is a time range
14892 (when (boundp 'org-end-time-was-given)
14893 (setq org-time-was-given nil)
14894 (when (and (string-match org-plain-time-of-day-regexp ans)
14895 (match-end 8))
14896 (setq org-end-time-was-given (match-string 8 ans))
14897 (setq ans (concat (substring ans 0 (match-beginning 7))
14898 (substring ans (match-end 7))))))
a3fbe8c4 14899
20908596
CD
14900 (setq tl (parse-time-string ans)
14901 day (or (nth 3 tl) (nth 3 defdecode))
14902 month (or (nth 4 tl)
14903 (if (and org-read-date-prefer-future
ed21c5c8
CD
14904 (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode)))
14905 (prog1 (1+ (nth 4 nowdecode)) (setq futurep t))
20908596 14906 (nth 4 defdecode)))
ed21c5c8 14907 year (or (and (not kill-year) (nth 5 tl))
20908596 14908 (if (and org-read-date-prefer-future
ed21c5c8
CD
14909 (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode)))
14910 (prog1 (1+ (nth 5 nowdecode)) (setq futurep t))
20908596
CD
14911 (nth 5 defdecode)))
14912 hour (or (nth 2 tl) (nth 2 defdecode))
14913 minute (or (nth 1 tl) (nth 1 defdecode))
14914 second (or (nth 0 tl) 0)
14915 wday (nth 6 tl))
a3fbe8c4 14916
8bfe682a
CD
14917 (when (and (eq org-read-date-prefer-future 'time)
14918 (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl))
ed21c5c8
CD
14919 (equal day (nth 3 nowdecode))
14920 (equal month (nth 4 nowdecode))
14921 (equal year (nth 5 nowdecode))
8bfe682a 14922 (nth 2 tl)
ed21c5c8
CD
14923 (or (< (nth 2 tl) (nth 2 nowdecode))
14924 (and (= (nth 2 tl) (nth 2 nowdecode))
8bfe682a 14925 (nth 1 tl)
ed21c5c8 14926 (< (nth 1 tl) (nth 1 nowdecode)))))
8bfe682a
CD
14927 (setq day (1+ day)
14928 futurep t))
14929
20908596
CD
14930 ;; Special date definitions below
14931 (cond
14932 (iso-week
14933 ;; There was an iso week
ed21c5c8 14934 (require 'cal-iso)
8bfe682a 14935 (setq futurep nil)
20908596
CD
14936 (setq year (or iso-year year)
14937 day (or iso-weekday wday 1)
14938 wday nil ; to make sure that the trigger below does not match
14939 iso-date (calendar-gregorian-from-absolute
14940 (calendar-absolute-from-iso
14941 (list iso-week day year))))
14942; FIXME: Should we also push ISO weeks into the future?
14943; (when (and org-read-date-prefer-future
14944; (not iso-year)
14945; (< (calendar-absolute-from-gregorian iso-date)
14946; (time-to-days (current-time))))
14947; (setq year (1+ year)
14948; iso-date (calendar-gregorian-from-absolute
14949; (calendar-absolute-from-iso
14950; (list iso-week day year)))))
14951 (setq month (car iso-date)
14952 year (nth 2 iso-date)
14953 day (nth 1 iso-date)))
14954 (deltan
8bfe682a 14955 (setq futurep nil)
20908596
CD
14956 (unless deltadef
14957 (let ((now (decode-time (current-time))))
14958 (setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
14959 (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
14960 ((equal deltaw "w") (setq day (+ day (* 7 deltan))))
14961 ((equal deltaw "m") (setq month (+ month deltan)))
14962 ((equal deltaw "y") (setq year (+ year deltan)))))
14963 ((and wday (not (nth 3 tl)))
8bfe682a 14964 (setq futurep nil)
20908596
CD
14965 ;; Weekday was given, but no day, so pick that day in the week
14966 ;; on or after the derived date.
14967 (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
14968 (unless (equal wday wday1)
14969 (setq day (+ day (% (- wday wday1 -7) 7))))))
14970 (if (and (boundp 'org-time-was-given)
14971 (nth 2 tl))
14972 (setq org-time-was-given t))
14973 (if (< year 100) (setq year (+ 2000 year)))
3ab2c837
BG
14974 ;; Check of the date is representable
14975 (if org-read-date-force-compatible-dates
14976 (progn
14977 (if (< year 1970)
14978 (setq year 1970 org-read-date-analyze-forced-year t))
14979 (if (> year 2037)
14980 (setq year 2037 org-read-date-analyze-forced-year t)))
14981 (condition-case nil
14982 (ignore (encode-time second minute hour day month year))
14983 (error
14984 (setq year (nth 5 defdecode))
14985 (setq org-read-date-analyze-forced-year t))))
8bfe682a 14986 (setq org-read-date-analyze-futurep futurep)
20908596 14987 (list second minute hour day month year)))
d3f4dbe8 14988
20908596 14989(defvar parse-time-weekdays)
d3f4dbe8 14990
20908596
CD
14991(defun org-read-date-get-relative (s today default)
14992 "Check string S for special relative date string.
14993TODAY and DEFAULT are internal times, for today and for a default.
14994Return shift list (N what def-flag)
14995WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year.
14996N is the number of WHATs to shift.
14997DEF-FLAG is t when a double ++ or -- indicates shift relative to
14998 the DEFAULT date rather than TODAY."
7b1019e2
MB
14999 (when (and
15000 (string-match
15001 (concat
15002 "\\`[ \t]*\\([-+]\\{0,2\\}\\)"
15003 "\\([0-9]+\\)?"
15004 "\\([dwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?"
15005 "\\([ \t]\\|$\\)") s)
15006 (or (> (match-end 1) (match-beginning 1)) (match-end 4)))
15007 (let* ((dir (if (> (match-end 1) (match-beginning 1))
20908596
CD
15008 (string-to-char (substring (match-string 1 s) -1))
15009 ?+))
15010 (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1)))))
15011 (n (if (match-end 2) (string-to-number (match-string 2 s)) 1))
15012 (what (if (match-end 3) (match-string 3 s) "d"))
15013 (wday1 (cdr (assoc (downcase what) parse-time-weekdays)))
15014 (date (if rel default today))
15015 (wday (nth 6 (decode-time date)))
15016 delta)
15017 (if wday1
15018 (progn
15019 (setq delta (mod (+ 7 (- wday1 wday)) 7))
15020 (if (= dir ?-) (setq delta (- delta 7)))
15021 (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
15022 (list delta "d" rel))
15023 (list (* n (if (= dir ?-) -1 1)) what rel)))))
d3f4dbe8 15024
ed21c5c8
CD
15025(defun org-order-calendar-date-args (arg1 arg2 arg3)
15026 "Turn a user-specified date into the internal representation.
15027The internal representation needed by the calendar is (month day year).
15028This is a wrapper to handle the brain-dead convention in calendar that
15029user function argument order change dependent on argument order."
15030 (if (boundp 'calendar-date-style)
15031 (cond
15032 ((eq calendar-date-style 'american)
15033 (list arg1 arg2 arg3))
15034 ((eq calendar-date-style 'european)
15035 (list arg2 arg1 arg3))
15036 ((eq calendar-date-style 'iso)
15037 (list arg2 arg3 arg1)))
afe98dfa
CD
15038 (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1
15039 (if (org-bound-and-true-p european-calendar-style)
15040 (list arg2 arg1 arg3)
15041 (list arg1 arg2 arg3)))))
ed21c5c8 15042
20908596
CD
15043(defun org-eval-in-calendar (form &optional keepdate)
15044 "Eval FORM in the calendar window and return to current window.
15045Also, store the cursor date in variable org-ans2."
c8d0cf5c
CD
15046 (let ((sf (selected-frame))
15047 (sw (selected-window)))
15048 (select-window (get-buffer-window "*Calendar*" t))
20908596
CD
15049 (eval form)
15050 (when (and (not keepdate) (calendar-cursor-to-date))
15051 (let* ((date (calendar-cursor-to-date))
15052 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
15053 (setq org-ans2 (format-time-string "%Y-%m-%d" time))))
86fbb8ca 15054 (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
c8d0cf5c 15055 (select-window sw)
54a0dee5 15056 (org-select-frame-set-input-focus sf)))
d3f4dbe8 15057
20908596
CD
15058(defun org-calendar-select ()
15059 "Return to `org-read-date' with the date currently selected.
15060This is used by `org-read-date' in a temporary keymap for the calendar buffer."
d3f4dbe8 15061 (interactive)
20908596
CD
15062 (when (calendar-cursor-to-date)
15063 (let* ((date (calendar-cursor-to-date))
15064 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
15065 (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
15066 (if (active-minibuffer-window) (exit-minibuffer))))
15067
15068(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
15069 "Insert a date stamp for the date given by the internal TIME.
ed21c5c8 15070WITH-HM means use the stamp format that includes the time of the day.
20908596
CD
15071INACTIVE means use square brackets instead of angular ones, so that the
15072stamp will not contribute to the agenda.
15073PRE and POST are optional strings to be inserted before and after the
15074stamp.
15075The command returns the inserted time stamp."
15076 (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
15077 stamp)
15078 (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
15079 (insert-before-markers (or pre ""))
20908596
CD
15080 (when (listp extra)
15081 (setq extra (car extra))
15082 (if (and (stringp extra)
15083 (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra))
15084 (setq extra (format "-%02d:%02d"
15085 (string-to-number (match-string 1 extra))
15086 (string-to-number (match-string 2 extra))))
15087 (setq extra nil)))
15088 (when extra
afe98dfa
CD
15089 (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1))))
15090 (insert-before-markers (setq stamp (format-time-string fmt time)))
20908596 15091 (insert-before-markers (or post ""))
b349f79f 15092 (setq org-last-inserted-timestamp stamp)))
d3f4dbe8 15093
20908596
CD
15094(defun org-toggle-time-stamp-overlays ()
15095 "Toggle the use of custom time stamp formats."
d3f4dbe8 15096 (interactive)
20908596
CD
15097 (setq org-display-custom-times (not org-display-custom-times))
15098 (unless org-display-custom-times
15099 (let ((p (point-min)) (bmp (buffer-modified-p)))
15100 (while (setq p (next-single-property-change p 'display))
15101 (if (and (get-text-property p 'display)
15102 (eq (get-text-property p 'face) 'org-date))
15103 (remove-text-properties
15104 p (setq p (next-single-property-change p 'display))
15105 '(display t))))
15106 (set-buffer-modified-p bmp)))
15107 (if (featurep 'xemacs)
15108 (remove-text-properties (point-min) (point-max) '(end-glyph t)))
15109 (org-restart-font-lock)
15110 (setq org-table-may-need-update t)
15111 (if org-display-custom-times
333f9019 15112 (message "Time stamps are overlaid with custom format")
20908596 15113 (message "Time stamp overlays removed")))
d3f4dbe8 15114
20908596 15115(defun org-display-custom-time (beg end)
b349f79f 15116 "Overlay modified time stamp format over timestamp between BEG and END."
20908596
CD
15117 (let* ((ts (buffer-substring beg end))
15118 t1 w1 with-hm tf time str w2 (off 0))
15119 (save-match-data
15120 (setq t1 (org-parse-time-string ts t))
8bfe682a 15121 (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)?\\'" ts)
20908596
CD
15122 (setq off (- (match-end 0) (match-beginning 0)))))
15123 (setq end (- end off))
15124 (setq w1 (- end beg)
15125 with-hm (and (nth 1 t1) (nth 2 t1))
15126 tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
15127 time (org-fix-decoded-time t1)
15128 str (org-add-props
15129 (format-time-string
15130 (substring tf 1 -1) (apply 'encode-time time))
15131 nil 'mouse-face 'highlight)
15132 w2 (length str))
15133 (if (not (= w2 w1))
15134 (add-text-properties (1+ beg) (+ 2 beg)
15135 (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
15136 (if (featurep 'xemacs)
15137 (progn
15138 (put-text-property beg end 'invisible t)
15139 (put-text-property beg end 'end-glyph (make-glyph str)))
15140 (put-text-property beg end 'display str))))
d3f4dbe8 15141
20908596
CD
15142(defun org-translate-time (string)
15143 "Translate all timestamps in STRING to custom format.
15144But do this only if the variable `org-display-custom-times' is set."
15145 (when org-display-custom-times
15146 (save-match-data
15147 (let* ((start 0)
15148 (re org-ts-regexp-both)
15149 t1 with-hm inactive tf time str beg end)
15150 (while (setq start (string-match re string start))
15151 (setq beg (match-beginning 0)
15152 end (match-end 0)
15153 t1 (save-match-data
15154 (org-parse-time-string (substring string beg end) t))
15155 with-hm (and (nth 1 t1) (nth 2 t1))
15156 inactive (equal (substring string beg (1+ beg)) "[")
15157 tf (funcall (if with-hm 'cdr 'car)
15158 org-time-stamp-custom-formats)
15159 time (org-fix-decoded-time t1)
15160 str (format-time-string
15161 (concat
15162 (if inactive "[" "<") (substring tf 1 -1)
15163 (if inactive "]" ">"))
15164 (apply 'encode-time time))
15165 string (replace-match str t t string)
15166 start (+ start (length str)))))))
15167 string)
d3f4dbe8 15168
20908596
CD
15169(defun org-fix-decoded-time (time)
15170 "Set 0 instead of nil for the first 6 elements of time.
15171Don't touch the rest."
15172 (let ((n 0))
15173 (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
d3f4dbe8 15174
20908596
CD
15175(defun org-days-to-time (timestamp-string)
15176 "Difference between TIMESTAMP-STRING and now in days."
15177 (- (time-to-days (org-time-string-to-time timestamp-string))
15178 (time-to-days (current-time))))
d3f4dbe8 15179
20908596
CD
15180(defun org-deadline-close (timestamp-string &optional ndays)
15181 "Is the time in TIMESTAMP-STRING close to the current date?"
15182 (setq ndays (or ndays (org-get-wdays timestamp-string)))
15183 (and (< (org-days-to-time timestamp-string) ndays)
15184 (not (org-entry-is-done-p))))
d3f4dbe8 15185
20908596
CD
15186(defun org-get-wdays (ts)
15187 "Get the deadline lead time appropriate for timestring TS."
15188 (cond
15189 ((<= org-deadline-warning-days 0)
15190 ;; 0 or negative, enforce this value no matter what
15191 (- org-deadline-warning-days))
c8d0cf5c 15192 ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts)
20908596
CD
15193 ;; lead time is specified.
15194 (floor (* (string-to-number (match-string 1 ts))
15195 (cdr (assoc (match-string 2 ts)
15196 '(("d" . 1) ("w" . 7)
15197 ("m" . 30.4) ("y" . 365.25)))))))
15198 ;; go for the default.
15199 (t org-deadline-warning-days)))
d3f4dbe8 15200
20908596
CD
15201(defun org-calendar-select-mouse (ev)
15202 "Return to `org-read-date' with the date currently selected.
15203This is used by `org-read-date' in a temporary keymap for the calendar buffer."
15204 (interactive "e")
15205 (mouse-set-point ev)
15206 (when (calendar-cursor-to-date)
15207 (let* ((date (calendar-cursor-to-date))
15208 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
15209 (setq org-ans1 (format-time-string "%Y-%m-%d" time)))
15210 (if (active-minibuffer-window) (exit-minibuffer))))
d3f4dbe8 15211
20908596
CD
15212(defun org-check-deadlines (ndays)
15213 "Check if there are any deadlines due or past due.
15214A deadline is considered due if it happens within `org-deadline-warning-days'
15215days from today's date. If the deadline appears in an entry marked DONE,
15216it is not shown. The prefix arg NDAYS can be used to test that many
15217days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown."
d3f4dbe8 15218 (interactive "P")
20908596
CD
15219 (let* ((org-warn-days
15220 (cond
15221 ((equal ndays '(4)) 100000)
15222 (ndays (prefix-numeric-value ndays))
15223 (t (abs org-deadline-warning-days))))
15224 (case-fold-search nil)
15225 (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
15226 (callback
15227 (lambda () (org-deadline-close (match-string 1) org-warn-days))))
d3f4dbe8 15228
20908596
CD
15229 (message "%d deadlines past-due or due within %d days"
15230 (org-occur regexp nil callback)
15231 org-warn-days)))
d3f4dbe8 15232
20908596
CD
15233(defun org-check-before-date (date)
15234 "Check if there are deadlines or scheduled entries before DATE."
15235 (interactive (list (org-read-date)))
15236 (let ((case-fold-search nil)
15237 (regexp (concat "\\<\\(" org-deadline-string
15238 "\\|" org-scheduled-string
15239 "\\) *<\\([^>]+\\)>"))
15240 (callback
15241 (lambda () (time-less-p
15242 (org-time-string-to-time (match-string 2))
15243 (org-time-string-to-time date)))))
15244 (message "%d entries before %s"
15245 (org-occur regexp nil callback) date)))
100a4141 15246
c8d0cf5c
CD
15247(defun org-check-after-date (date)
15248 "Check if there are deadlines or scheduled entries after DATE."
15249 (interactive (list (org-read-date)))
15250 (let ((case-fold-search nil)
15251 (regexp (concat "\\<\\(" org-deadline-string
15252 "\\|" org-scheduled-string
15253 "\\) *<\\([^>]+\\)>"))
15254 (callback
15255 (lambda () (not
15256 (time-less-p
15257 (org-time-string-to-time (match-string 2))
15258 (org-time-string-to-time date))))))
15259 (message "%d entries after %s"
15260 (org-occur regexp nil callback) date)))
15261
20908596
CD
15262(defun org-evaluate-time-range (&optional to-buffer)
15263 "Evaluate a time range by computing the difference between start and end.
15264Normally the result is just printed in the echo area, but with prefix arg
15265TO-BUFFER, the result is inserted just after the date stamp into the buffer.
15266If the time range is actually in a table, the result is inserted into the
15267next column.
15268For time difference computation, a year is assumed to be exactly 365
15269days in order to avoid rounding problems."
d3f4dbe8 15270 (interactive "P")
20908596
CD
15271 (or
15272 (org-clock-update-time-maybe)
15273 (save-excursion
15274 (unless (org-at-date-range-p t)
15275 (goto-char (point-at-bol))
15276 (re-search-forward org-tr-regexp-both (point-at-eol) t))
15277 (if (not (org-at-date-range-p t))
15278 (error "Not at a time-stamp range, and none found in current line")))
15279 (let* ((ts1 (match-string 1))
15280 (ts2 (match-string 2))
15281 (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
15282 (match-end (match-end 0))
15283 (time1 (org-time-string-to-time ts1))
15284 (time2 (org-time-string-to-time ts2))
54a0dee5
CD
15285 (t1 (org-float-time time1))
15286 (t2 (org-float-time time2))
20908596
CD
15287 (diff (abs (- t2 t1)))
15288 (negative (< (- t2 t1) 0))
15289 ;; (ys (floor (* 365 24 60 60)))
15290 (ds (* 24 60 60))
15291 (hs (* 60 60))
15292 (fy "%dy %dd %02d:%02d")
15293 (fy1 "%dy %dd")
15294 (fd "%dd %02d:%02d")
15295 (fd1 "%dd")
15296 (fh "%02d:%02d")
15297 y d h m align)
15298 (if havetime
15299 (setq ; y (floor (/ diff ys)) diff (mod diff ys)
15300 y 0
15301 d (floor (/ diff ds)) diff (mod diff ds)
15302 h (floor (/ diff hs)) diff (mod diff hs)
15303 m (floor (/ diff 60)))
15304 (setq ; y (floor (/ diff ys)) diff (mod diff ys)
15305 y 0
15306 d (floor (+ (/ diff ds) 0.5))
15307 h 0 m 0))
15308 (if (not to-buffer)
15309 (message "%s" (org-make-tdiff-string y d h m))
15310 (if (org-at-table-p)
15311 (progn
15312 (goto-char match-end)
15313 (setq align t)
15314 (and (looking-at " *|") (goto-char (match-end 0))))
15315 (goto-char match-end))
15316 (if (looking-at
15317 "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
15318 (replace-match ""))
15319 (if negative (insert " -"))
15320 (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
15321 (if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
15322 (insert " " (format fh h m))))
15323 (if align (org-table-align))
15324 (message "Time difference inserted")))))
791d856f 15325
20908596
CD
15326(defun org-make-tdiff-string (y d h m)
15327 (let ((fmt "")
15328 (l nil))
15329 (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")
15330 l (push y l)))
15331 (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")
15332 l (push d l)))
15333 (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")
15334 l (push h l)))
15335 (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")
15336 l (push m l)))
15337 (apply 'format fmt (nreverse l))))
ab27a4a0 15338
20908596
CD
15339(defun org-time-string-to-time (s)
15340 (apply 'encode-time (org-parse-time-string s)))
c8d0cf5c 15341(defun org-time-string-to-seconds (s)
54a0dee5 15342 (org-float-time (org-time-string-to-time s)))
791d856f 15343
20908596
CD
15344(defun org-time-string-to-absolute (s &optional daynr prefer show-all)
15345 "Convert a time stamp to an absolute day number.
86fbb8ca 15346If there is a specifier for a cyclic time stamp, get the closest date to
20908596 15347DAYNR.
c8d0cf5c 15348PREFER and SHOW-ALL are passed through to `org-closest-date'.
3ab2c837 15349The variable date is bound by the calendar when this is called."
20908596
CD
15350 (cond
15351 ((and daynr (string-match "\\`%%\\((.*)\\)" s))
15352 (if (org-diary-sexp-entry (match-string 1 s) "" date)
15353 daynr
15354 (+ daynr 1000)))
15355 ((and daynr (string-match "\\+[0-9]+[dwmy]" s))
15356 (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
15357 (time-to-days (current-time))) (match-string 0 s)
15358 prefer show-all))
15359 (t (time-to-days (apply 'encode-time (org-parse-time-string s))))))
791d856f 15360
20908596
CD
15361(defun org-days-to-iso-week (days)
15362 "Return the iso week number."
15363 (require 'cal-iso)
15364 (car (calendar-iso-from-absolute days)))
15365
15366(defun org-small-year-to-year (year)
15367 "Convert 2-digit years into 4-digit years.
1536838-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007.
d60b1ba1
CD
15369The year 2000 cannot be abbreviated. Any year larger than 99
15370is returned unchanged."
20908596
CD
15371 (if (< year 38)
15372 (setq year (+ 2000 year))
15373 (if (< year 100)
15374 (setq year (+ 1900 year))))
15375 year)
791d856f 15376
20908596
CD
15377(defun org-time-from-absolute (d)
15378 "Return the time corresponding to date D.
15379D may be an absolute day number, or a calendar-type list (month day year)."
15380 (if (numberp d) (setq d (calendar-gregorian-from-absolute d)))
15381 (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
d3f4dbe8 15382
20908596
CD
15383(defun org-calendar-holiday ()
15384 "List of holidays, for Diary display in Org-mode."
15385 (require 'holidays)
15386 (let ((hl (funcall
15387 (if (fboundp 'calendar-check-holidays)
15388 'calendar-check-holidays 'check-calendar-holidays) date)))
15389 (if hl (mapconcat 'identity hl "; "))))
d3f4dbe8 15390
20908596
CD
15391(defun org-diary-sexp-entry (sexp entry date)
15392 "Process a SEXP diary ENTRY for DATE."
15393 (require 'diary-lib)
15394 (let ((result (if calendar-debug-sexp
15395 (let ((stack-trace-on-error t))
15396 (eval (car (read-from-string sexp))))
15397 (condition-case nil
15398 (eval (car (read-from-string sexp)))
15399 (error
15400 (beep)
15401 (message "Bad sexp at line %d in %s: %s"
15402 (org-current-line)
15403 (buffer-file-name) sexp)
15404 (sleep-for 2))))))
acedf35c 15405 (cond ((stringp result) (split-string result "; "))
20908596 15406 ((and (consp result)
afe98dfa 15407 (not (consp (cdr result)))
20908596 15408 (stringp (cdr result))) (cdr result))
afe98dfa
CD
15409 ((and (consp result)
15410 (stringp (car result))) result)
20908596
CD
15411 (result entry)
15412 (t nil))))
d3f4dbe8 15413
20908596
CD
15414(defun org-diary-to-ical-string (frombuf)
15415 "Get iCalendar entries from diary entries in buffer FROMBUF.
15416This uses the icalendar.el library."
15417 (let* ((tmpdir (if (featurep 'xemacs)
15418 (temp-directory)
15419 temporary-file-directory))
15420 (tmpfile (make-temp-name
15421 (expand-file-name "orgics" tmpdir)))
15422 buf rtn b e)
81ad75af 15423 (with-current-buffer frombuf
20908596
CD
15424 (icalendar-export-region (point-min) (point-max) tmpfile)
15425 (setq buf (find-buffer-visiting tmpfile))
15426 (set-buffer buf)
15427 (goto-char (point-min))
15428 (if (re-search-forward "^BEGIN:VEVENT" nil t)
15429 (setq b (match-beginning 0)))
15430 (goto-char (point-max))
15431 (if (re-search-backward "^END:VEVENT" nil t)
15432 (setq e (match-end 0)))
15433 (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
15434 (kill-buffer buf)
20908596
CD
15435 (delete-file tmpfile)
15436 rtn))
d3f4dbe8 15437
20908596
CD
15438(defun org-closest-date (start current change prefer show-all)
15439 "Find the date closest to CURRENT that is consistent with START and CHANGE.
3ab2c837 15440When PREFER is `past', return a date that is either CURRENT or past.
20908596 15441When PREFER is `future', return a date that is either CURRENT or future.
33306645 15442When SHOW-ALL is nil, only return the current occurrence of a time stamp."
20908596 15443 ;; Make the proper lists from the dates
d3f4dbe8 15444 (catch 'exit
20908596 15445 (let ((a1 '(("d" . day) ("w" . week) ("m" . month) ("y" . year)))
0bd48b37 15446 dn dw sday cday n1 n2 n0
20908596 15447 d m y y1 y2 date1 date2 nmonths nm ny m2)
d3f4dbe8 15448
20908596
CD
15449 (setq start (org-date-to-gregorian start)
15450 current (org-date-to-gregorian
15451 (if show-all
15452 current
15453 (time-to-days (current-time))))
15454 sday (calendar-absolute-from-gregorian start)
15455 cday (calendar-absolute-from-gregorian current))
d3f4dbe8 15456
20908596 15457 (if (<= cday sday) (throw 'exit sday))
791d856f 15458
20908596
CD
15459 (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change)
15460 (setq dn (string-to-number (match-string 1 change))
15461 dw (cdr (assoc (match-string 2 change) a1)))
86fbb8ca 15462 (error "Invalid change specifier: %s" change))
20908596
CD
15463 (if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
15464 (cond
15465 ((eq dw 'day)
15466 (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn))))
15467 n2 (+ n1 dn)))
15468 ((eq dw 'year)
15469 (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current))
15470 (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1))
15471 (setq date1 (list m d y1)
15472 n1 (calendar-absolute-from-gregorian date1)
15473 date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn)))
15474 n2 (calendar-absolute-from-gregorian date2)))
15475 ((eq dw 'month)
2c3ad40d 15476 ;; approx number of month between the two dates
20908596
CD
15477 (setq nmonths (floor (/ (- cday sday) 30.436875)))
15478 ;; How often does dn fit in there?
15479 (setq d (nth 1 start) m (car start) y (nth 2 start)
15480 nm (* dn (max 0 (1- (floor (/ nmonths dn)))))
15481 m (+ m nm)
15482 ny (floor (/ m 12))
15483 y (+ y ny)
15484 m (- m (* ny 12)))
15485 (while (> m 12) (setq m (- m 12) y (1+ y)))
15486 (setq n1 (calendar-absolute-from-gregorian (list m d y)))
15487 (setq m2 (+ m dn) y2 y)
15488 (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
15489 (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))
2c3ad40d 15490 (while (<= n2 cday)
20908596
CD
15491 (setq n1 n2 m m2 y y2)
15492 (setq m2 (+ m dn) y2 y)
15493 (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
15494 (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))))))
0bd48b37
CD
15495 ;; Make sure n1 is the earlier date
15496 (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2))
20908596
CD
15497 (if show-all
15498 (cond
8d642074 15499 ((eq prefer 'past) (if (= cday n2) n2 n1))
20908596
CD
15500 ((eq prefer 'future) (if (= cday n1) n1 n2))
15501 (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))
15502 (cond
8d642074 15503 ((eq prefer 'past) (if (= cday n2) n2 n1))
20908596
CD
15504 ((eq prefer 'future) (if (= cday n1) n1 n2))
15505 (t (if (= cday n1) n1 n2)))))))
791d856f 15506
20908596 15507(defun org-date-to-gregorian (date)
86fbb8ca 15508 "Turn any specification of DATE into a Gregorian date for the calendar."
20908596
CD
15509 (cond ((integerp date) (calendar-gregorian-from-absolute date))
15510 ((and (listp date) (= (length date) 3)) date)
15511 ((stringp date)
15512 (setq date (org-parse-time-string date))
15513 (list (nth 4 date) (nth 3 date) (nth 5 date)))
15514 ((listp date)
15515 (list (nth 4 date) (nth 3 date) (nth 5 date)))))
d3f4dbe8 15516
20908596
CD
15517(defun org-parse-time-string (s &optional nodefault)
15518 "Parse the standard Org-mode time string.
15519This should be a lot faster than the normal `parse-time-string'.
15520If time is not given, defaults to 0:00. However, with optional NODEFAULT,
15521hour and minute fields will be nil if not given."
15522 (if (string-match org-ts-regexp0 s)
15523 (list 0
15524 (if (or (match-beginning 8) (not nodefault))
15525 (string-to-number (or (match-string 8 s) "0")))
15526 (if (or (match-beginning 7) (not nodefault))
15527 (string-to-number (or (match-string 7 s) "0")))
15528 (string-to-number (match-string 4 s))
15529 (string-to-number (match-string 3 s))
15530 (string-to-number (match-string 2 s))
15531 nil nil nil)
54a0dee5 15532 (error "Not a standard Org-mode time string: %s" s)))
d3f4dbe8 15533
20908596
CD
15534(defun org-timestamp-up (&optional arg)
15535 "Increase the date item at the cursor by one.
3ab2c837
BG
15536If the cursor is on the year, change the year. If it is on the month,
15537the day or the time, change that.
20908596
CD
15538With prefix ARG, change by that many units."
15539 (interactive "p")
86fbb8ca 15540 (org-timestamp-change (prefix-numeric-value arg) nil 'updown))
d3f4dbe8 15541
20908596
CD
15542(defun org-timestamp-down (&optional arg)
15543 "Decrease the date item at the cursor by one.
3ab2c837
BG
15544If the cursor is on the year, change the year. If it is on the month,
15545the day or the time, change that.
20908596
CD
15546With prefix ARG, change by that many units."
15547 (interactive "p")
86fbb8ca 15548 (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown))
d3f4dbe8 15549
20908596
CD
15550(defun org-timestamp-up-day (&optional arg)
15551 "Increase the date in the time stamp by one day.
15552With prefix ARG, change that many days."
15553 (interactive "p")
15554 (if (and (not (org-at-timestamp-p t))
15555 (org-on-heading-p))
15556 (org-todo 'up)
86fbb8ca 15557 (org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
d3f4dbe8 15558
20908596
CD
15559(defun org-timestamp-down-day (&optional arg)
15560 "Decrease the date in the time stamp by one day.
15561With prefix ARG, change that many days."
15562 (interactive "p")
15563 (if (and (not (org-at-timestamp-p t))
15564 (org-on-heading-p))
15565 (org-todo 'down)
86fbb8ca 15566 (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
d3f4dbe8 15567
20908596
CD
15568(defun org-at-timestamp-p (&optional inactive-ok)
15569 "Determine if the cursor is in or at a timestamp."
15570 (interactive)
15571 (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2))
15572 (pos (point))
15573 (ans (or (looking-at tsr)
15574 (save-excursion
15575 (skip-chars-backward "^[<\n\r\t")
15576 (if (> (point) (point-min)) (backward-char 1))
15577 (and (looking-at tsr)
15578 (> (- (match-end 0) pos) -1))))))
15579 (and ans
15580 (boundp 'org-ts-what)
15581 (setq org-ts-what
15582 (cond
15583 ((= pos (match-beginning 0)) 'bracket)
15584 ((= pos (1- (match-end 0))) 'bracket)
15585 ((org-pos-in-match-range pos 2) 'year)
15586 ((org-pos-in-match-range pos 3) 'month)
15587 ((org-pos-in-match-range pos 7) 'hour)
15588 ((org-pos-in-match-range pos 8) 'minute)
15589 ((or (org-pos-in-match-range pos 4)
15590 (org-pos-in-match-range pos 5)) 'day)
15591 ((and (> pos (or (match-end 8) (match-end 5)))
15592 (< pos (match-end 0)))
15593 (- pos (or (match-end 8) (match-end 5))))
15594 (t 'day))))
15595 ans))
a3fbe8c4 15596
20908596
CD
15597(defun org-toggle-timestamp-type ()
15598 "Toggle the type (<active> or [inactive]) of a time stamp."
15599 (interactive)
15600 (when (org-at-timestamp-p t)
93b62de8
CD
15601 (let ((beg (match-beginning 0)) (end (match-end 0))
15602 (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
15603 (save-excursion
15604 (goto-char beg)
15605 (while (re-search-forward "[][<>]" end t)
15606 (replace-match (cdr (assoc (char-after (match-beginning 0)) map))
15607 t t)))
15608 (message "Timestamp is now %sactive"
15609 (if (equal (char-after beg) ?<) "" "in")))))
a3fbe8c4 15610
86fbb8ca 15611(defun org-timestamp-change (n &optional what updown)
20908596
CD
15612 "Change the date in the time stamp at point.
15613The date will be changed by N times WHAT. WHAT can be `day', `month',
15614`year', `minute', `second'. If WHAT is not given, the cursor position
15615in the timestamp determines what will be changed."
3ab2c837 15616 (let ((origin (point)) origin-cat
20908596
CD
15617 with-hm inactive
15618 (dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
15619 org-ts-what
15620 extra rem
15621 ts time time0)
15622 (if (not (org-at-timestamp-p t))
15623 (error "Not at a timestamp"))
15624 (if (and (not what) (eq org-ts-what 'bracket))
15625 (org-toggle-timestamp-type)
3ab2c837
BG
15626 ;; Point isn't on brackets. Remember the part of the time-stamp
15627 ;; the point was in. Indeed, size of time-stamps may change,
15628 ;; but point must be kept in the same category nonetheless.
15629 (setq origin-cat org-ts-what)
20908596
CD
15630 (if (and (not what) (not (eq org-ts-what 'day))
15631 org-display-custom-times
15632 (get-text-property (point) 'display)
15633 (not (get-text-property (1- (point)) 'display)))
15634 (setq org-ts-what 'day))
15635 (setq org-ts-what (or what org-ts-what)
15636 inactive (= (char-after (match-beginning 0)) ?\[)
15637 ts (match-string 0))
15638 (replace-match "")
15639 (if (string-match
8bfe682a 15640 "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[dwmy]\\(/[0-9]+[dwmy]\\)?\\)*\\)[]>]"
20908596
CD
15641 ts)
15642 (setq extra (match-string 1 ts)))
15643 (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
15644 (setq with-hm t))
15645 (setq time0 (org-parse-time-string ts))
86fbb8ca
CD
15646 (when (and updown
15647 (eq org-ts-what 'minute)
15648 (not current-prefix-arg))
15649 ;; This looks like s-up and s-down. Change by one rounding step.
20908596
CD
15650 (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
15651 (when (not (= 0 (setq rem (% (nth 1 time0) dm))))
15652 (setcar (cdr time0) (+ (nth 1 time0)
15653 (if (> n 0) (- rem) (- dm rem))))))
15654 (setq time
15655 (encode-time (or (car time0) 0)
15656 (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
15657 (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
15658 (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
15659 (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
15660 (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))
15661 (nthcdr 6 time0)))
c8d0cf5c
CD
15662 (when (and (member org-ts-what '(hour minute))
15663 extra
15664 (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
15665 (setq extra (org-modify-ts-extra
15666 extra
15667 (if (eq org-ts-what 'hour) 2 5)
15668 n dm)))
20908596
CD
15669 (when (integerp org-ts-what)
15670 (setq extra (org-modify-ts-extra extra org-ts-what n dm)))
15671 (if (eq what 'calendar)
15672 (let ((cal-date (org-get-date-from-calendar)))
15673 (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
15674 (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
15675 (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
15676 (setcar time0 (or (car time0) 0))
15677 (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
15678 (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
15679 (setq time (apply 'encode-time time0))))
3ab2c837
BG
15680 ;; Insert the new time-stamp, and ensure point stays in the same
15681 ;; category as before (i.e. not after the last position in that
15682 ;; category).
15683 (let ((pos (point)))
15684 ;; Stay before inserted string. `save-excursion' is of no use.
15685 (setq org-last-changed-timestamp
15686 (org-insert-time-stamp time with-hm inactive nil nil extra))
15687 (goto-char pos))
15688 (save-match-data
15689 (looking-at org-ts-regexp3)
15690 (goto-char (cond
15691 ;; `day' category ends before `hour' if any, or at
15692 ;; the end of the day name.
15693 ((eq origin-cat 'day)
15694 (min (or (match-beginning 7) (1- (match-end 5))) origin))
15695 ((eq origin-cat 'hour) (min (match-end 7) origin))
15696 ((eq origin-cat 'minute) (min (1- (match-end 8)) origin))
15697 ((integerp origin-cat) (min (1- (match-end 0)) origin))
15698 ;; `year' and `month' have both fixed size: point
15699 ;; couldn't have moved into another part.
15700 (t origin))))
15701 ;; Update clock if on a CLOCK line.
20908596 15702 (org-clock-update-time-maybe)
3ab2c837 15703 ;; Try to recenter the calendar window, if any.
20908596
CD
15704 (if (and org-calendar-follow-timestamp-change
15705 (get-buffer-window "*Calendar*" t)
15706 (memq org-ts-what '(day month year)))
15707 (org-recenter-calendar (time-to-days time))))))
4b3a9ba7 15708
20908596
CD
15709(defun org-modify-ts-extra (s pos n dm)
15710 "Change the different parts of the lead-time and repeat fields in timestamp."
15711 (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4)))
15712 ng h m new rem)
15713 (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s)
891f4676 15714 (cond
20908596
CD
15715 ((or (org-pos-in-match-range pos 2)
15716 (org-pos-in-match-range pos 3))
15717 (setq m (string-to-number (match-string 3 s))
15718 h (string-to-number (match-string 2 s)))
15719 (if (org-pos-in-match-range pos 2)
15720 (setq h (+ h n))
15721 (setq n (* dm (org-no-warnings (signum n))))
15722 (when (not (= 0 (setq rem (% m dm))))
15723 (setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
15724 (setq m (+ m n)))
15725 (if (< m 0) (setq m (+ m 60) h (1- h)))
15726 (if (> m 59) (setq m (- m 60) h (1+ h)))
15727 (setq h (min 24 (max 0 h)))
15728 (setq ng 1 new (format "-%02d:%02d" h m)))
15729 ((org-pos-in-match-range pos 6)
15730 (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
15731 ((org-pos-in-match-range pos 5)
15732 (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s)))))))
891f4676 15733
20908596
CD
15734 ((org-pos-in-match-range pos 9)
15735 (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx))))
15736 ((org-pos-in-match-range pos 8)
15737 (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s))))))))
a3fbe8c4 15738
20908596
CD
15739 (when ng
15740 (setq s (concat
15741 (substring s 0 (match-beginning ng))
15742 new
15743 (substring s (match-end ng))))))
15744 s))
6769c0dc 15745
20908596
CD
15746(defun org-recenter-calendar (date)
15747 "If the calendar is visible, recenter it to DATE."
15748 (let* ((win (selected-window))
15749 (cwin (get-buffer-window "*Calendar*" t))
15750 (calendar-move-hook nil))
15751 (when cwin
15752 (select-window cwin)
15753 (calendar-goto-date (if (listp date) date
15754 (calendar-gregorian-from-absolute date)))
15755 (select-window win))))
2a57416f 15756
20908596
CD
15757(defun org-goto-calendar (&optional arg)
15758 "Go to the Emacs calendar at the current date.
15759If there is a time stamp in the current line, go to that date.
15760A prefix ARG can be used to force the current date."
15761 (interactive "P")
15762 (let ((tsr org-ts-regexp) diff
15763 (calendar-move-hook nil)
15764 (calendar-view-holidays-initially-flag nil)
3820f429 15765 (calendar-view-diary-initially-flag nil))
20908596
CD
15766 (if (or (org-at-timestamp-p)
15767 (save-excursion
15768 (beginning-of-line 1)
15769 (looking-at (concat ".*" tsr))))
15770 (let ((d1 (time-to-days (current-time)))
15771 (d2 (time-to-days
15772 (org-time-string-to-time (match-string 1)))))
15773 (setq diff (- d2 d1))))
15774 (calendar)
15775 (calendar-goto-today)
15776 (if (and diff (not arg)) (calendar-forward-day diff))))
a3fbe8c4 15777
20908596
CD
15778(defun org-get-date-from-calendar ()
15779 "Return a list (month day year) of date at point in calendar."
15780 (with-current-buffer "*Calendar*"
15781 (save-match-data
15782 (calendar-cursor-to-date))))
6769c0dc 15783
20908596
CD
15784(defun org-date-from-calendar ()
15785 "Insert time stamp corresponding to cursor date in *Calendar* buffer.
15786If there is already a time stamp at the cursor position, update it."
15787 (interactive)
15788 (if (org-at-timestamp-p t)
15789 (org-timestamp-change 0 'calendar)
15790 (let ((cal-date (org-get-date-from-calendar)))
15791 (org-insert-time-stamp
15792 (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
d3f4dbe8 15793
20908596
CD
15794(defun org-minutes-to-hh:mm-string (m)
15795 "Compute H:MM from a number of minutes."
15796 (let ((h (/ m 60)))
15797 (setq m (- m (* 60 h)))
b349f79f 15798 (format org-time-clocksum-format h m)))
8c6fb58b 15799
20908596 15800(defun org-hh:mm-string-to-minutes (s)
c8d0cf5c 15801 "Convert a string H:MM to a number of minutes.
8bfe682a 15802If the string is just a number, interpret it as minutes.
c8d0cf5c
CD
15803In fact, the first hh:mm or number in the string will be taken,
15804there can be extra stuff in the string.
15805If no number is found, the return value is 0."
15806 (cond
3ab2c837 15807 ((integerp s) s)
c8d0cf5c
CD
15808 ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
15809 (+ (* (string-to-number (match-string 1 s)) 60)
15810 (string-to-number (match-string 2 s))))
15811 ((string-match "\\([0-9]+\\)" s)
15812 (string-to-number (match-string 1 s)))
15813 (t 0)))
15814
3ab2c837
BG
15815(defcustom org-effort-durations
15816 `(("h" . 60)
15817 ("d" . ,(* 60 8))
15818 ("w" . ,(* 60 8 5))
15819 ("m" . ,(* 60 8 5 4))
15820 ("y" . ,(* 60 8 5 40)))
15821 "Conversion factor to minutes for an effort modifier.
15822
15823Each entry has the form (MODIFIER . MINUTES).
15824
15825In an effort string, a number followed by MODIFIER is multiplied
15826by the specified number of MINUTES to obtain an effort in
15827minutes.
15828
15829For example, if the value of this variable is ((\"hours\" . 60)), then an
15830effort string \"2hours\" is equivalent to 120 minutes."
15831 :group 'org-agenda
15832 :type '(alist :key-type (string :tag "Modifier")
15833 :value-type (number :tag "Minutes")))
15834
15835(defun org-duration-string-to-minutes (s)
15836 "Convert a duration string S to minutes.
15837
15838A bare number is interpreted as minutes, modifiers can be set by
15839customizing `org-effort-durations' (which see).
15840
15841Entries containing a colon are interpreted as H:MM by
15842`org-hh:mm-string-to-minutes'."
15843 (let ((result 0)
15844 (re (concat "\\([0-9]+\\) *\\("
15845 (regexp-opt (mapcar 'car org-effort-durations))
15846 "\\)")))
15847 (while (string-match re s)
15848 (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
15849 (string-to-number (match-string 1 s))))
15850 (setq s (replace-match "" nil t s)))
15851 (incf result (org-hh:mm-string-to-minutes s))
15852 result))
15853
c8d0cf5c
CD
15854;;;; Files
15855
15856(defun org-save-all-org-buffers ()
15857 "Save all Org-mode buffers without user confirmation."
15858 (interactive)
15859 (message "Saving all Org-mode buffers...")
15860 (save-some-buffers t 'org-mode-p)
15861 (when (featurep 'org-id) (org-id-locations-save))
15862 (message "Saving all Org-mode buffers... done"))
15863
15864(defun org-revert-all-org-buffers ()
15865 "Revert all Org-mode buffers.
15866Prompt for confirmation when there are unsaved changes.
15867Be sure you know what you are doing before letting this function
15868overwrite your changes.
15869
15870This function is useful in a setup where one tracks org files
15871with a version control system, to revert on one machine after pulling
15872changes from another. I believe the procedure must be like this:
15873
158741. M-x org-save-all-org-buffers
158752. Pull changes from the other machine, resolve conflicts
158763. M-x org-revert-all-org-buffers"
15877 (interactive)
15878 (unless (yes-or-no-p "Revert all Org buffers from their files? ")
15879 (error "Abort"))
15880 (save-excursion
15881 (save-window-excursion
15882 (mapc
15883 (lambda (b)
15884 (when (and (with-current-buffer b (org-mode-p))
15885 (with-current-buffer b buffer-file-name))
c3313451 15886 (switch-to-buffer b)
c8d0cf5c
CD
15887 (revert-buffer t 'no-confirm)))
15888 (buffer-list))
15889 (when (and (featurep 'org-id) org-id-track-globally)
15890 (org-id-locations-load)))))
6769c0dc 15891
20908596
CD
15892;;;; Agenda files
15893
15894;;;###autoload
86fbb8ca
CD
15895(defun org-switchb (&optional arg)
15896 "Switch between Org buffers.
fdf730ed 15897With a prefix argument, restrict available to files.
86fbb8ca
CD
15898With two prefix arguments, restrict available buffers to agenda files.
15899
15900Defaults to `iswitchb' for buffer name completion.
15901Set `org-completion-use-ido' to make it use ido instead."
fdf730ed
CD
15902 (interactive "P")
15903 (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files))
15904 ((equal arg '(16)) (org-buffer-list 'agenda))
86fbb8ca
CD
15905 (t (org-buffer-list))))
15906 (org-completion-use-iswitchb org-completion-use-iswitchb)
15907 (org-completion-use-ido org-completion-use-ido))
15908 (unless (or org-completion-use-ido org-completion-use-iswitchb)
15909 (setq org-completion-use-iswitchb t))
c3313451 15910 (switch-to-buffer
54a0dee5 15911 (org-icompleting-read "Org buffer: "
86fbb8ca
CD
15912 (mapcar 'list (mapcar 'buffer-name blist))
15913 nil t))))
fdf730ed 15914
86fbb8ca
CD
15915;;; Define some older names previously used for this functionality
15916;;;###autoload
15917(defalias 'org-ido-switchb 'org-switchb)
54a0dee5 15918;;;###autoload
86fbb8ca 15919(defalias 'org-iswitchb 'org-switchb)
54a0dee5 15920
621f83e4 15921(defun org-buffer-list (&optional predicate exclude-tmp)
20908596 15922 "Return a list of Org buffers.
621f83e4
CD
15923PREDICATE can be `export', `files' or `agenda'.
15924
15925export restrict the list to Export buffers.
15926files restrict the list to buffers visiting Org files.
15927agenda restrict the list to buffers visiting agenda files.
15928
15929If EXCLUDE-TMP is non-nil, ignore temporary buffers."
15930 (let* ((bfn nil)
15931 (agenda-files (and (eq predicate 'agenda)
15932 (mapcar 'file-truename (org-agenda-files t))))
15933 (filter
15934 (cond
15935 ((eq predicate 'files)
3ab2c837 15936 (lambda (b) (with-current-buffer b (org-mode-p))))
621f83e4
CD
15937 ((eq predicate 'export)
15938 (lambda (b) (string-match "\*Org .*Export" (buffer-name b))))
15939 ((eq predicate 'agenda)
15940 (lambda (b)
ce4fdcb9 15941 (with-current-buffer b
3ab2c837 15942 (and (org-mode-p)
621f83e4
CD
15943 (setq bfn (buffer-file-name b))
15944 (member (file-truename bfn) agenda-files)))))
ce4fdcb9 15945 (t (lambda (b) (with-current-buffer b
3ab2c837 15946 (or (org-mode-p)
621f83e4
CD
15947 (string-match "\*Org .*Export"
15948 (buffer-name b)))))))))
15949 (delq nil
20908596
CD
15950 (mapcar
15951 (lambda(b)
621f83e4
CD
15952 (if (and (funcall filter b)
15953 (or (not exclude-tmp)
15954 (not (string-match "tmp" (buffer-name b)))))
15955 b
15956 nil))
15957 (buffer-list)))))
20908596 15958
2c3ad40d 15959(defun org-agenda-files (&optional unrestricted archives)
20908596
CD
15960 "Get the list of agenda files.
15961Optional UNRESTRICTED means return the full list even if a restriction
15962is currently in place.
ed21c5c8 15963When ARCHIVES is t, include all archive files that are really being
2c3ad40d
CD
15964used by the agenda files. If ARCHIVE is `ifmode', do this only if
15965`org-agenda-archives-mode' is t."
20908596
CD
15966 (let ((files
15967 (cond
15968 ((and (not unrestricted) (get 'org-agenda-files 'org-restrict)))
15969 ((stringp org-agenda-files) (org-read-agenda-file-list))
15970 ((listp org-agenda-files) org-agenda-files)
15971 (t (error "Invalid value of `org-agenda-files'")))))
15972 (setq files (apply 'append
15973 (mapcar (lambda (f)
15974 (if (file-directory-p f)
15975 (directory-files
15976 f t org-agenda-file-regexp)
15977 (list f)))
15978 files)))
15979 (when org-agenda-skip-unavailable-files
15980 (setq files (delq nil
15981 (mapcar (function
15982 (lambda (file)
15983 (and (file-readable-p file) file)))
15984 files))))
2c3ad40d
CD
15985 (when (or (eq archives t)
15986 (and (eq archives 'ifmode) (eq org-agenda-archives-mode t)))
15987 (setq files (org-add-archive-files files)))
20908596
CD
15988 files))
15989
86fbb8ca
CD
15990(defun org-agenda-file-p (&optional file)
15991 "Return non-nil, if FILE is an agenda file.
15992If FILE is omitted, use the file associated with the current
15993buffer."
15994 (member (or file (buffer-file-name))
15995 (org-agenda-files t)))
15996
20908596
CD
15997(defun org-edit-agenda-file-list ()
15998 "Edit the list of agenda files.
15999Depending on setup, this either uses customize to edit the variable
16000`org-agenda-files', or it visits the file that is holding the list. In the
16001latter case, the buffer is set up in a way that saving it automatically kills
16002the buffer and restores the previous window configuration."
16003 (interactive)
16004 (if (stringp org-agenda-files)
16005 (let ((cw (current-window-configuration)))
16006 (find-file org-agenda-files)
16007 (org-set-local 'org-window-configuration cw)
16008 (org-add-hook 'after-save-hook
16009 (lambda ()
16010 (set-window-configuration
16011 (prog1 org-window-configuration
16012 (kill-buffer (current-buffer))))
16013 (org-install-agenda-files-menu)
16014 (message "New agenda file list installed"))
16015 nil 'local)
16016 (message "%s" (substitute-command-keys
16017 "Edit list and finish with \\[save-buffer]")))
16018 (customize-variable 'org-agenda-files)))
6769c0dc 16019
20908596 16020(defun org-store-new-agenda-file-list (list)
33306645 16021 "Set new value for the agenda file list and save it correctly."
20908596 16022 (if (stringp org-agenda-files)
ed21c5c8
CD
16023 (let ((fe (org-read-agenda-file-list t)) b u)
16024 (while (setq b (find-buffer-visiting org-agenda-files))
16025 (kill-buffer b))
16026 (with-temp-file org-agenda-files
16027 (insert
16028 (mapconcat
16029 (lambda (f) ;; Keep un-expanded entries.
16030 (if (setq u (assoc f fe))
16031 (cdr u)
16032 f))
16033 list "\n")
16034 "\n")))
54a0dee5
CD
16035 (let ((org-mode-hook nil) (org-inhibit-startup t)
16036 (org-insert-mode-line-in-empty-file nil))
20908596
CD
16037 (setq org-agenda-files list)
16038 (customize-save-variable 'org-agenda-files org-agenda-files))))
6769c0dc 16039
ed21c5c8
CD
16040(defun org-read-agenda-file-list (&optional pair-with-expansion)
16041 "Read the list of agenda files from a file.
16042If PAIR-WITH-EXPANSION is t return pairs with un-expanded
16043filenames, used by `org-store-new-agenda-file-list' to write back
16044un-expanded file names."
20908596
CD
16045 (when (file-directory-p org-agenda-files)
16046 (error "`org-agenda-files' cannot be a single directory"))
16047 (when (stringp org-agenda-files)
16048 (with-temp-buffer
16049 (insert-file-contents org-agenda-files)
ed21c5c8
CD
16050 (mapcar
16051 (lambda (f)
16052 (let ((e (expand-file-name (substitute-in-file-name f)
16053 org-directory)))
16054 (if pair-with-expansion
16055 (cons e f)
16056 e)))
16057 (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*")))))
272dfec2 16058
20908596
CD
16059;;;###autoload
16060(defun org-cycle-agenda-files ()
16061 "Cycle through the files in `org-agenda-files'.
16062If the current buffer visits an agenda file, find the next one in the list.
16063If the current buffer does not, find the first agenda file."
16064 (interactive)
16065 (let* ((fs (org-agenda-files t))
16066 (files (append fs (list (car fs))))
16067 (tcf (if buffer-file-name (file-truename buffer-file-name)))
16068 file)
16069 (unless files (error "No agenda files"))
0b8568f5 16070 (catch 'exit
20908596
CD
16071 (while (setq file (pop files))
16072 (if (equal (file-truename file) tcf)
16073 (when (car files)
16074 (find-file (car files))
16075 (throw 'exit t))))
16076 (find-file (car fs)))
c3313451 16077 (if (buffer-base-buffer) (switch-to-buffer (buffer-base-buffer)))))
634a7d0b 16078
20908596
CD
16079(defun org-agenda-file-to-front (&optional to-end)
16080 "Move/add the current file to the top of the agenda file list.
16081If the file is not present in the list, it is added to the front. If it is
16082present, it is moved there. With optional argument TO-END, add/move to the
16083end of the list."
891f4676 16084 (interactive "P")
20908596
CD
16085 (let ((org-agenda-skip-unavailable-files nil)
16086 (file-alist (mapcar (lambda (x)
16087 (cons (file-truename x) x))
16088 (org-agenda-files t)))
16089 (ctf (file-truename buffer-file-name))
16090 x had)
16091 (setq x (assoc ctf file-alist) had x)
0b8568f5 16092
20908596
CD
16093 (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
16094 (if to-end
16095 (setq file-alist (append (delq x file-alist) (list x)))
16096 (setq file-alist (cons x (delq x file-alist))))
16097 (org-store-new-agenda-file-list (mapcar 'cdr file-alist))
16098 (org-install-agenda-files-menu)
16099 (message "File %s to %s of agenda file list"
16100 (if had "moved" "added") (if to-end "end" "front"))))
0b8568f5 16101
20908596
CD
16102(defun org-remove-file (&optional file)
16103 "Remove current file from the list of files in variable `org-agenda-files'.
16104These are the files which are being checked for agenda entries.
ed21c5c8 16105Optional argument FILE means use this file instead of the current."
20908596
CD
16106 (interactive)
16107 (let* ((org-agenda-skip-unavailable-files nil)
16108 (file (or file buffer-file-name))
16109 (true-file (file-truename file))
16110 (afile (abbreviate-file-name file))
16111 (files (delq nil (mapcar
16112 (lambda (x)
16113 (if (equal true-file
16114 (file-truename x))
16115 nil x))
16116 (org-agenda-files t)))))
16117 (if (not (= (length files) (length (org-agenda-files t))))
16118 (progn
16119 (org-store-new-agenda-file-list files)
16120 (org-install-agenda-files-menu)
16121 (message "Removed file: %s" afile))
16122 (message "File was not in list: %s (not removed)" afile))))
891f4676 16123
20908596
CD
16124(defun org-file-menu-entry (file)
16125 (vector file (list 'find-file file) t))
891f4676 16126
20908596
CD
16127(defun org-check-agenda-file (file)
16128 "Make sure FILE exists. If not, ask user what to do."
16129 (when (not (file-exists-p file))
8d642074 16130 (message "non-existent agenda file %s. [R]emove from list or [A]bort?"
20908596
CD
16131 (abbreviate-file-name file))
16132 (let ((r (downcase (read-char-exclusive))))
891f4676 16133 (cond
20908596
CD
16134 ((equal r ?r)
16135 (org-remove-file file)
16136 (throw 'nextfile t))
16137 (t (error "Abort"))))))
a3fbe8c4 16138
20908596
CD
16139(defun org-get-agenda-file-buffer (file)
16140 "Get a buffer visiting FILE. If the buffer needs to be created, add
16141it to the list of buffers which might be released later."
16142 (let ((buf (org-find-base-buffer-visiting file)))
16143 (if buf
16144 buf ; just return it
16145 ;; Make a new buffer and remember it
16146 (setq buf (find-file-noselect file))
16147 (if buf (push buf org-agenda-new-buffers))
16148 buf)))
a3fbe8c4 16149
20908596
CD
16150(defun org-release-buffers (blist)
16151 "Release all buffers in list, asking the user for confirmation when needed.
16152When a buffer is unmodified, it is just killed. When modified, it is saved
16153\(if the user agrees) and then killed."
16154 (let (buf file)
16155 (while (setq buf (pop blist))
16156 (setq file (buffer-file-name buf))
16157 (when (and (buffer-modified-p buf)
16158 file
16159 (y-or-n-p (format "Save file %s? " file)))
16160 (with-current-buffer buf (save-buffer)))
16161 (kill-buffer buf))))
03f3cf35 16162
20908596
CD
16163(defun org-prepare-agenda-buffers (files)
16164 "Create buffers for all agenda files, protect archived trees and comments."
16165 (interactive)
16166 (let ((pa '(:org-archived t))
16167 (pc '(:org-comment t))
16168 (pall '(:org-archived t :org-comment t))
16169 (inhibit-read-only t)
16170 (rea (concat ":" org-archive-tag ":"))
16171 bmp file re)
ef943dba 16172 (save-excursion
20908596
CD
16173 (save-restriction
16174 (while (setq file (pop files))
c8d0cf5c
CD
16175 (catch 'nextfile
16176 (if (bufferp file)
16177 (set-buffer file)
16178 (org-check-agenda-file file)
16179 (set-buffer (org-get-agenda-file-buffer file)))
16180 (widen)
16181 (setq bmp (buffer-modified-p))
16182 (org-refresh-category-properties)
16183 (setq org-todo-keywords-for-agenda
16184 (append org-todo-keywords-for-agenda org-todo-keywords-1))
16185 (setq org-done-keywords-for-agenda
16186 (append org-done-keywords-for-agenda org-done-keywords))
16187 (setq org-todo-keyword-alist-for-agenda
16188 (append org-todo-keyword-alist-for-agenda org-todo-key-alist))
8d642074
CD
16189 (setq org-drawers-for-agenda
16190 (append org-drawers-for-agenda org-drawers))
c8d0cf5c
CD
16191 (setq org-tag-alist-for-agenda
16192 (append org-tag-alist-for-agenda org-tag-alist))
621f83e4 16193
c8d0cf5c
CD
16194 (save-excursion
16195 (remove-text-properties (point-min) (point-max) pall)
16196 (when org-agenda-skip-archived-trees
16197 (goto-char (point-min))
16198 (while (re-search-forward rea nil t)
16199 (if (org-on-heading-p t)
16200 (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
20908596 16201 (goto-char (point-min))
3ab2c837 16202 (setq re (concat org-outline-regexp-bol "+" org-comment-string "\\>"))
c8d0cf5c
CD
16203 (while (re-search-forward re nil t)
16204 (add-text-properties
16205 (match-beginning 0) (org-end-of-subtree t) pc)))
16206 (set-buffer-modified-p bmp)))))
ed21c5c8
CD
16207 (setq org-todo-keywords-for-agenda
16208 (org-uniquify org-todo-keywords-for-agenda))
621f83e4
CD
16209 (setq org-todo-keyword-alist-for-agenda
16210 (org-uniquify org-todo-keyword-alist-for-agenda)
16211 org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda))))
7d143c25 16212
20908596 16213;;;; Embedded LaTeX
891f4676 16214
20908596
CD
16215(defvar org-cdlatex-mode-map (make-sparse-keymap)
16216 "Keymap for the minor `org-cdlatex-mode'.")
16217
16218(org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret)
16219(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret)
16220(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol)
16221(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify)
16222(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment)
16223
16224(defvar org-cdlatex-texmathp-advice-is-done nil
16225 "Flag remembering if we have applied the advice to texmathp already.")
16226
16227(define-minor-mode org-cdlatex-mode
16228 "Toggle the minor `org-cdlatex-mode'.
16229This mode supports entering LaTeX environment and math in LaTeX fragments
16230in Org-mode.
16231\\{org-cdlatex-mode-map}"
16232 nil " OCDL" nil
16233 (when org-cdlatex-mode (require 'cdlatex))
16234 (unless org-cdlatex-texmathp-advice-is-done
16235 (setq org-cdlatex-texmathp-advice-is-done t)
16236 (defadvice texmathp (around org-math-always-on activate)
16237 "Always return t in org-mode buffers.
16238This is because we want to insert math symbols without dollars even outside
16239the LaTeX math segments. If Orgmode thinks that point is actually inside
33306645 16240an embedded LaTeX fragment, let texmathp do its job.
20908596
CD
16241\\[org-cdlatex-mode-map]"
16242 (interactive)
16243 (let (p)
16244 (cond
16245 ((not (org-mode-p)) ad-do-it)
16246 ((eq this-command 'cdlatex-math-symbol)
16247 (setq ad-return-value t
16248 texmathp-why '("cdlatex-math-symbol in org-mode" . 0)))
16249 (t
16250 (let ((p (org-inside-LaTeX-fragment-p)))
16251 (if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
16252 (setq ad-return-value t
16253 texmathp-why '("Org-mode embedded math" . 0))
16254 (if p ad-do-it)))))))))
891f4676 16255
20908596
CD
16256(defun turn-on-org-cdlatex ()
16257 "Unconditionally turn on `org-cdlatex-mode'."
16258 (org-cdlatex-mode 1))
a3fbe8c4 16259
20908596
CD
16260(defun org-inside-LaTeX-fragment-p ()
16261 "Test if point is inside a LaTeX fragment.
16262I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
16263sequence appearing also before point.
16264Even though the matchers for math are configurable, this function assumes
16265that \\begin, \\(, \\[, and $$ are always used. Only the single dollar
16266delimiters are skipped when they have been removed by customization.
3ab2c837
BG
16267The return value is nil, or a cons cell with the delimiter and the
16268position of this delimiter.
20908596
CD
16269
16270This function does a reasonably good job, but can locally be fooled by
16271for example currency specifications. For example it will assume being in
16272inline math after \"$22.34\". The LaTeX fragment formatter will only format
16273fragments that are properly closed, but during editing, we have to live
16274with the uncertainty caused by missing closing delimiters. This function
16275looks only before point, not after."
16276 (catch 'exit
16277 (let ((pos (point))
16278 (dodollar (member "$" (plist-get org-format-latex-options :matchers)))
16279 (lim (progn
16280 (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t)
16281 (point)))
16282 dd-on str (start 0) m re)
16283 (goto-char pos)
16284 (when dodollar
16285 (setq str (concat (buffer-substring lim (point)) "\000 X$.")
16286 re (nth 1 (assoc "$" org-latex-regexps)))
16287 (while (string-match re str start)
16288 (cond
16289 ((= (match-end 0) (length str))
16290 (throw 'exit (cons "$" (+ lim (match-beginning 0) 1))))
16291 ((= (match-end 0) (- (length str) 5))
16292 (throw 'exit nil))
16293 (t (setq start (match-end 0))))))
16294 (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t))
16295 (goto-char pos)
16296 (and (match-beginning 1) (throw 'exit (cons (match-string 1) m)))
16297 (and (match-beginning 2) (throw 'exit nil))
16298 ;; count $$
16299 (while (re-search-backward "\\$\\$" lim t)
16300 (setq dd-on (not dd-on)))
16301 (goto-char pos)
16302 (if dd-on (cons "$$" m))))))
a3fbe8c4 16303
ed21c5c8
CD
16304(defun org-inside-latex-macro-p ()
16305 "Is point inside a LaTeX macro or its arguments?"
16306 (save-match-data
16307 (org-in-regexp
16308 "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
16309
20908596
CD
16310(defun org-try-cdlatex-tab ()
16311 "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
16312It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
16313 - inside a LaTeX fragment, or
16314 - after the first word in a line, where an abbreviation expansion could
16315 insert a LaTeX environment."
16316 (when org-cdlatex-mode
0b8568f5 16317 (cond
20908596
CD
16318 ((save-excursion
16319 (skip-chars-backward "a-zA-Z0-9*")
16320 (skip-chars-backward " \t")
16321 (bolp))
16322 (cdlatex-tab) t)
16323 ((org-inside-LaTeX-fragment-p)
16324 (cdlatex-tab) t)
16325 (t nil))))
c8d16429 16326
20908596
CD
16327(defun org-cdlatex-underscore-caret (&optional arg)
16328 "Execute `cdlatex-sub-superscript' in LaTeX fragments.
16329Revert to the normal definition outside of these fragments."
16330 (interactive "P")
16331 (if (org-inside-LaTeX-fragment-p)
16332 (call-interactively 'cdlatex-sub-superscript)
16333 (let (org-cdlatex-mode)
16334 (call-interactively (key-binding (vector last-input-event))))))
e0e66b8e 16335
20908596
CD
16336(defun org-cdlatex-math-modify (&optional arg)
16337 "Execute `cdlatex-math-modify' in LaTeX fragments.
16338Revert to the normal definition outside of these fragments."
16339 (interactive "P")
16340 (if (org-inside-LaTeX-fragment-p)
16341 (call-interactively 'cdlatex-math-modify)
16342 (let (org-cdlatex-mode)
16343 (call-interactively (key-binding (vector last-input-event))))))
4b3a9ba7 16344
20908596
CD
16345(defvar org-latex-fragment-image-overlays nil
16346 "List of overlays carrying the images of latex fragments.")
16347(make-variable-buffer-local 'org-latex-fragment-image-overlays)
891f4676 16348
20908596
CD
16349(defun org-remove-latex-fragment-image-overlays ()
16350 "Remove all overlays with LaTeX fragment images in current buffer."
86fbb8ca 16351 (mapc 'delete-overlay org-latex-fragment-image-overlays)
20908596 16352 (setq org-latex-fragment-image-overlays nil))
a3fbe8c4 16353
20908596
CD
16354(defun org-preview-latex-fragment (&optional subtree)
16355 "Preview the LaTeX fragment at point, or all locally or globally.
16356If the cursor is in a LaTeX fragment, create the image and overlay
16357it over the source code. If there is no fragment at point, display
16358all fragments in the current text, from one headline to the next. With
16359prefix SUBTREE, display all fragments in the current subtree. With a
86fbb8ca
CD
16360double prefix arg \\[universal-argument] \\[universal-argument], or when \
16361the cursor is before the first headline,
20908596
CD
16362display all fragments in the buffer.
16363The images can be removed again with \\[org-ctrl-c-ctrl-c]."
16364 (interactive "P")
16365 (org-remove-latex-fragment-image-overlays)
16366 (save-excursion
16367 (save-restriction
16368 (let (beg end at msg)
16369 (cond
16370 ((or (equal subtree '(16))
16371 (not (save-excursion
3ab2c837 16372 (re-search-backward org-outline-regexp-bol nil t))))
20908596
CD
16373 (setq beg (point-min) end (point-max)
16374 msg "Creating images for buffer...%s"))
16375 ((equal subtree '(4))
16376 (org-back-to-heading)
16377 (setq beg (point) end (org-end-of-subtree t)
16378 msg "Creating images for subtree...%s"))
16379 (t
16380 (if (setq at (org-inside-LaTeX-fragment-p))
16381 (goto-char (max (point-min) (- (cdr at) 2)))
16382 (org-back-to-heading))
16383 (setq beg (point) end (progn (outline-next-heading) (point))
16384 msg (if at "Creating image...%s"
16385 "Creating images for entry...%s"))))
16386 (message msg "")
16387 (narrow-to-region beg end)
16388 (goto-char beg)
16389 (org-format-latex
16390 (concat "ltxpng/" (file-name-sans-extension
16391 (file-name-nondirectory
16392 buffer-file-name)))
afe98dfa 16393 default-directory 'overlays msg at 'forbuffer 'dvipng)
20908596 16394 (message msg "done. Use `C-c C-c' to remove images.")))))
891f4676 16395
20908596
CD
16396(defvar org-latex-regexps
16397 '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
16398 ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
16399 ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
0bd48b37
CD
16400 ("$1" "\\([^$]\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
16401 ("$" "\\([^$]\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
20908596 16402 ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
54a0dee5
CD
16403 ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
16404 ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
20908596 16405 "Regular expressions for matching embedded LaTeX.")
891f4676 16406
afe98dfa 16407(defvar org-export-have-math nil) ;; dynamic scoping
86fbb8ca 16408(defun org-format-latex (prefix &optional dir overlays msg at
afe98dfa 16409 forbuffer processing-type)
8d642074
CD
16410 "Replace LaTeX fragments with links to an image, and produce images.
16411Some of the options can be changed using the variable
16412`org-format-latex-options'."
20908596
CD
16413 (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
16414 (let* ((prefixnodir (file-name-nondirectory prefix))
16415 (absprefix (expand-file-name prefix dir))
16416 (todir (file-name-directory absprefix))
16417 (opt org-format-latex-options)
16418 (matchers (plist-get opt :matchers))
16419 (re-list org-latex-regexps)
ed21c5c8
CD
16420 (org-format-latex-header-extra
16421 (plist-get (org-infile-export-plist) :latex-header-extra))
5dec9555 16422 (cnt 0) txt hash link beg end re e checkdir
afe98dfa 16423 executables-checked string
20908596 16424 m n block linkfile movefile ov)
20908596
CD
16425 ;; Check the different regular expressions
16426 (while (setq e (pop re-list))
16427 (setq m (car e) re (nth 1 e) n (nth 2 e)
16428 block (if (nth 3 e) "\n\n" ""))
16429 (when (member m matchers)
16430 (goto-char (point-min))
16431 (while (re-search-forward re nil t)
0b91aef0
CD
16432 (when (and (or (not at) (equal (cdr at) (match-beginning n)))
16433 (not (get-text-property (match-beginning n)
54a0dee5
CD
16434 'org-protected))
16435 (or (not overlays)
16436 (not (eq (get-char-property (match-beginning n)
16437 'org-overlay-type)
16438 'org-latex-overlay))))
afe98dfa
CD
16439 (setq org-export-have-math t)
16440 (cond
16441 ((eq processing-type 'verbatim)
16442 ;; Leave the text verbatim, just protect it
16443 (add-text-properties (match-beginning n) (match-end n)
16444 '(org-protected t)))
16445 ((eq processing-type 'mathjax)
16446 ;; Prepare for MathJax processing
16447 (setq string (match-string n))
16448 (if (member m '("$" "$1"))
16449 (save-excursion
16450 (delete-region (match-beginning n) (match-end n))
16451 (goto-char (match-beginning n))
16452 (insert (org-add-props (concat "\\(" (substring string 1 -1)
16453 "\\)")
16454 '(org-protected t))))
86fbb8ca 16455 (add-text-properties (match-beginning n) (match-end n)
afe98dfa
CD
16456 '(org-protected t))))
16457 ((or (eq processing-type 'dvipng) t)
16458 ;; Process to an image
86fbb8ca
CD
16459 (setq txt (match-string n)
16460 beg (match-beginning n) end (match-end n)
16461 cnt (1+ cnt))
16462 (let (print-length print-level) ; make sure full list is printed
16463 (setq hash (sha1 (prin1-to-string
16464 (list org-format-latex-header
16465 org-format-latex-header-extra
16466 org-export-latex-default-packages-alist
16467 org-export-latex-packages-alist
16468 org-format-latex-options
16469 forbuffer txt)))
16470 linkfile (format "%s_%s.png" prefix hash)
16471 movefile (format "%s_%s.png" absprefix hash)))
16472 (setq link (concat block "[[file:" linkfile "]]" block))
16473 (if msg (message msg cnt))
16474 (goto-char beg)
16475 (unless checkdir ; make sure the directory exists
16476 (setq checkdir t)
afe98dfa
CD
16477 (or (file-directory-p todir) (make-directory todir t)))
16478
86fbb8ca
CD
16479 (unless executables-checked
16480 (org-check-external-command
16481 "latex" "needed to convert LaTeX fragments to images")
16482 (org-check-external-command
16483 "dvipng" "needed to convert LaTeX fragments to images")
16484 (setq executables-checked t))
afe98dfa 16485
86fbb8ca
CD
16486 (unless (file-exists-p movefile)
16487 (org-create-formula-image
16488 txt movefile opt forbuffer))
16489 (if overlays
16490 (progn
16491 (mapc (lambda (o)
16492 (if (eq (overlay-get o 'org-overlay-type)
16493 'org-latex-overlay)
16494 (delete-overlay o)))
16495 (overlays-in beg end))
16496 (setq ov (make-overlay beg end))
16497 (overlay-put ov 'org-overlay-type 'org-latex-overlay)
16498 (if (featurep 'xemacs)
16499 (progn
16500 (overlay-put ov 'invisible t)
16501 (overlay-put
16502 ov 'end-glyph
16503 (make-glyph (vector 'png :file movefile))))
16504 (overlay-put
16505 ov 'display
16506 (list 'image :type 'png :file movefile :ascent 'center)))
16507 (push ov org-latex-fragment-image-overlays)
16508 (goto-char end))
16509 (delete-region beg end)
16510 (insert (org-add-props link
16511 (list 'org-latex-src
afe98dfa
CD
16512 (replace-regexp-in-string
16513 "\"" "" txt)))))))))))))
46177585 16514
20908596
CD
16515;; This function borrows from Ganesh Swami's latex2png.el
16516(defun org-create-formula-image (string tofile options buffer)
8d642074 16517 "This calls dvipng."
54a0dee5 16518 (require 'org-latex)
20908596
CD
16519 (let* ((tmpdir (if (featurep 'xemacs)
16520 (temp-directory)
16521 temporary-file-directory))
16522 (texfilebase (make-temp-name
16523 (expand-file-name "orgtex" tmpdir)))
16524 (texfile (concat texfilebase ".tex"))
16525 (dvifile (concat texfilebase ".dvi"))
16526 (pngfile (concat texfilebase ".png"))
16527 (fnh (if (featurep 'xemacs)
16528 (font-height (get-face-font 'default))
16529 (face-attribute 'default :height nil)))
16530 (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
16531 (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
16532 (fg (or (plist-get options (if buffer :foreground :html-foreground))
16533 "Black"))
16534 (bg (or (plist-get options (if buffer :background :html-background))
16535 "Transparent")))
16536 (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)))
16537 (if (eq bg 'default) (setq bg (org-dvipng-color :background)))
16538 (with-temp-file texfile
ed21c5c8
CD
16539 (insert (org-splice-latex-header
16540 org-format-latex-header
16541 org-export-latex-default-packages-alist
86fbb8ca 16542 org-export-latex-packages-alist t
ed21c5c8
CD
16543 org-format-latex-header-extra))
16544 (insert "\n\\begin{document}\n" string "\n\\end{document}\n")
16545 (require 'org-latex)
16546 (org-export-latex-fix-inputenc))
20908596
CD
16547 (let ((dir default-directory))
16548 (condition-case nil
16549 (progn
16550 (cd tmpdir)
16551 (call-process "latex" nil nil nil texfile))
16552 (error nil))
16553 (cd dir))
16554 (if (not (file-exists-p dvifile))
16555 (progn (message "Failed to create dvi file from %s" texfile) nil)
2c3ad40d
CD
16556 (condition-case nil
16557 (call-process "dvipng" nil nil nil
c8d0cf5c 16558 "-fg" fg "-bg" bg
2c3ad40d
CD
16559 "-D" dpi
16560 ;;"-x" scale "-y" scale
16561 "-T" "tight"
16562 "-o" pngfile
16563 dvifile)
16564 (error nil))
20908596 16565 (if (not (file-exists-p pngfile))
ed21c5c8
CD
16566 (if org-format-latex-signal-error
16567 (error "Failed to create png file from %s" texfile)
16568 (message "Failed to create png file from %s" texfile)
16569 nil)
20908596
CD
16570 ;; Use the requested file name and clean up
16571 (copy-file pngfile tofile 'replace)
16572 (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png") do
16573 (delete-file (concat texfilebase e)))
16574 pngfile))))
8c6fb58b 16575
86fbb8ca 16576(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
ed21c5c8
CD
16577 "Fill a LaTeX header template TPL.
16578In the template, the following place holders will be recognized:
16579
16580 [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG
16581 [NO-DEFAULT-PACKAGES] do not include DEF-PKG
86fbb8ca 16582 [PACKAGES] \\usepackage statements for PKG
ed21c5c8
CD
16583 [NO-PACKAGES] do not include PKG
16584 [EXTRA] the string EXTRA
16585 [NO-EXTRA] do not include EXTRA
16586
16587For backward compatibility, if both the positive and the negative place
16588holder is missing, the positive one (without the \"NO-\") will be
16589assumed to be present at the end of the template.
16590DEF-PKG and PKG are assumed to be alists of options/packagename lists.
86fbb8ca
CD
16591EXTRA is a string.
16592SNIPPETS-P indicates if this is run to create snippet images for HTML."
ed21c5c8
CD
16593 (let (rpl (end ""))
16594 (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl)
16595 (setq rpl (if (or (match-end 1) (not def-pkg))
86fbb8ca 16596 "" (org-latex-packages-to-string def-pkg snippets-p t))
ed21c5c8 16597 tpl (replace-match rpl t t tpl))
86fbb8ca
CD
16598 (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
16599
ed21c5c8
CD
16600 (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl)
16601 (setq rpl (if (or (match-end 1) (not pkg))
86fbb8ca 16602 "" (org-latex-packages-to-string pkg snippets-p t))
ed21c5c8 16603 tpl (replace-match rpl t t tpl))
86fbb8ca
CD
16604 (if pkg (setq end
16605 (concat end "\n"
16606 (org-latex-packages-to-string pkg snippets-p)))))
ed21c5c8
CD
16607
16608 (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl)
16609 (setq rpl (if (or (match-end 1) (not extra))
16610 "" (concat extra "\n"))
16611 tpl (replace-match rpl t t tpl))
16612 (if (and extra (string-match "\\S-" extra))
16613 (setq end (concat end "\n" extra))))
16614
16615 (if (string-match "\\S-" end)
16616 (concat tpl "\n" end)
16617 tpl)))
16618
86fbb8ca 16619(defun org-latex-packages-to-string (pkg &optional snippets-p newline)
ed21c5c8
CD
16620 "Turn an alist of packages into a string with the \\usepackage macros."
16621 (setq pkg (mapconcat (lambda(p)
16622 (cond
16623 ((stringp p) p)
86fbb8ca
CD
16624 ((and snippets-p (>= (length p) 3) (not (nth 2 p)))
16625 (format "%% Package %s omitted" (cadr p)))
ed21c5c8
CD
16626 ((equal "" (car p))
16627 (format "\\usepackage{%s}" (cadr p)))
16628 (t
16629 (format "\\usepackage[%s]{%s}"
16630 (car p) (cadr p)))))
16631 pkg
16632 "\n"))
16633 (if newline (concat pkg "\n") pkg))
16634
20908596
CD
16635(defun org-dvipng-color (attr)
16636 "Return an rgb color specification for dvipng."
16637 (apply 'format "rgb %s %s %s"
16638 (mapcar 'org-normalize-color
16639 (color-values (face-attribute 'default attr nil)))))
c44f0d75 16640
20908596
CD
16641(defun org-normalize-color (value)
16642 "Return string to be used as color value for an RGB component."
16643 (format "%g" (/ value 65535.0)))
6769c0dc 16644
86fbb8ca
CD
16645;; Image display
16646
16647
16648(defvar org-inline-image-overlays nil)
16649(make-variable-buffer-local 'org-inline-image-overlays)
16650
16651(defun org-toggle-inline-images (&optional include-linked)
16652 "Toggle the display of inline images.
16653INCLUDE-LINKED is passed to `org-display-inline-images'."
16654 (interactive "P")
16655 (if org-inline-image-overlays
16656 (progn
16657 (org-remove-inline-images)
16658 (message "Inline image display turned off"))
16659 (org-display-inline-images include-linked)
16660 (if org-inline-image-overlays
16661 (message "%d images displayed inline"
16662 (length org-inline-image-overlays))
16663 (message "No images to display inline"))))
16664
16665(defun org-display-inline-images (&optional include-linked refresh beg end)
16666 "Display inline images.
16667Normally only links without a description part are inlined, because this
16668is how it will work for export. When INCLUDE-LINKED is set, also links
16669with a description part will be inlined. This can be nice for a quick
16670look at those images, but it does not reflect what exported files will look
16671like.
16672When REFRESH is set, refresh existing images between BEG and END.
16673This will create new image displays only if necessary.
16674BEG and END default to the buffer boundaries."
16675 (interactive "P")
16676 (unless refresh
16677 (org-remove-inline-images)
3ab2c837 16678 (if (fboundp 'clear-image-cache) (clear-image-cache)))
86fbb8ca
CD
16679 (save-excursion
16680 (save-restriction
16681 (widen)
16682 (setq beg (or beg (point-min)) end (or end (point-max)))
16683 (goto-char (point-min))
afe98dfa 16684 (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
86fbb8ca
CD
16685 (substring (org-image-file-name-regexp) 0 -2)
16686 "\\)\\]" (if include-linked "" "\\]")))
16687 old file ov img)
16688 (while (re-search-forward re end t)
16689 (setq old (get-char-property-and-overlay (match-beginning 1)
16690 'org-image-overlay))
16691 (setq file (expand-file-name
16692 (concat (or (match-string 3) "") (match-string 4))))
16693 (when (file-exists-p file)
16694 (if (and (car-safe old) refresh)
16695 (image-refresh (overlay-get (cdr old) 'display))
afe98dfa 16696 (setq img (save-match-data (create-image file)))
86fbb8ca
CD
16697 (when img
16698 (setq ov (make-overlay (match-beginning 0) (match-end 0)))
16699 (overlay-put ov 'display img)
16700 (overlay-put ov 'face 'default)
16701 (overlay-put ov 'org-image-overlay t)
16702 (overlay-put ov 'modification-hooks
16703 (list 'org-display-inline-modification-hook))
16704 (push ov org-inline-image-overlays)))))))))
16705
16706(defun org-display-inline-modification-hook (ov after beg end &optional len)
16707 "Remove inline-display overlay if a corresponding region is modified."
16708 (let ((inhibit-modification-hooks t))
16709 (when (and ov after)
16710 (delete ov org-inline-image-overlays)
16711 (delete-overlay ov))))
16712
16713(defun org-remove-inline-images ()
16714 "Remove inline display of images."
16715 (interactive)
16716 (mapc 'delete-overlay org-inline-image-overlays)
16717 (setq org-inline-image-overlays nil))
16718
d3f4dbe8 16719;;;; Key bindings
891f4676 16720
1d676e9f 16721;; Make `C-c C-x' a prefix key
a3fbe8c4 16722(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
1d676e9f 16723
28e5b051 16724;; TAB key with modifiers
a3fbe8c4
CD
16725(org-defkey org-mode-map "\C-i" 'org-cycle)
16726(org-defkey org-mode-map [(tab)] 'org-cycle)
16727(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
acedf35c
CD
16728(org-defkey org-mode-map [(meta tab)] 'pcomplete)
16729(org-defkey org-mode-map "\M-\t" 'pcomplete)
16730(org-defkey org-mode-map "\M-\C-i" 'pcomplete)
28e5b051 16731;; The following line is necessary under Suse GNU/Linux
ab27a4a0 16732(unless (featurep 'xemacs)
a3fbe8c4
CD
16733 (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
16734(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
03f3cf35 16735(define-key org-mode-map [backtab] 'org-shifttab)
28e5b051 16736
a3fbe8c4
CD
16737(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
16738(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
16739(org-defkey org-mode-map [(meta return)] 'org-meta-return)
28e5b051
CD
16740
16741;; Cursor keys with modifiers
a3fbe8c4
CD
16742(org-defkey org-mode-map [(meta left)] 'org-metaleft)
16743(org-defkey org-mode-map [(meta right)] 'org-metaright)
16744(org-defkey org-mode-map [(meta up)] 'org-metaup)
16745(org-defkey org-mode-map [(meta down)] 'org-metadown)
16746
16747(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
16748(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
16749(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
16750(org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown)
3278a016 16751
a3fbe8c4
CD
16752(org-defkey org-mode-map [(shift up)] 'org-shiftup)
16753(org-defkey org-mode-map [(shift down)] 'org-shiftdown)
16754(org-defkey org-mode-map [(shift left)] 'org-shiftleft)
16755(org-defkey org-mode-map [(shift right)] 'org-shiftright)
3278a016 16756
a3fbe8c4
CD
16757(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright)
16758(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft)
3ab2c837
BG
16759(org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup)
16760(org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown)
28e5b051 16761
86fbb8ca
CD
16762;; Babel keys
16763(define-key org-mode-map org-babel-key-prefix org-babel-map)
16764(mapc (lambda (pair)
16765 (define-key org-babel-map (car pair) (cdr pair)))
16766 org-babel-key-bindings)
16767
d3f4dbe8
CD
16768;;; Extra keys for tty access.
16769;; We only set them when really needed because otherwise the
16770;; menus don't show the simple keys
3278a016 16771
621f83e4
CD
16772(when (or org-use-extra-keys
16773 (featurep 'xemacs) ;; because XEmacs supports multi-device stuff
3278a016 16774 (not window-system))
a3fbe8c4
CD
16775 (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
16776 (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
16777 (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
16778 (org-defkey org-mode-map [?\e (return)] 'org-meta-return)
16779 (org-defkey org-mode-map [?\e (left)] 'org-metaleft)
16780 (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft)
16781 (org-defkey org-mode-map [?\e (right)] 'org-metaright)
16782 (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright)
16783 (org-defkey org-mode-map [?\e (up)] 'org-metaup)
16784 (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup)
16785 (org-defkey org-mode-map [?\e (down)] 'org-metadown)
16786 (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown)
16787 (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft)
16788 (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright)
16789 (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup)
16790 (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown)
16791 (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup)
16792 (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown)
16793 (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft)
16794 (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
16795 (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
c8d0cf5c 16796 (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)
acedf35c 16797 (org-defkey org-mode-map [?\e (tab)] 'pcomplete)
c8d0cf5c
CD
16798 (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading)
16799 (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
16800 (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
16801 (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup)
16802 (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
d3f4dbe8 16803
3278a016 16804 ;; All the other keys
bea5b1ba 16805
a3fbe8c4
CD
16806(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up.
16807(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
2c3ad40d
CD
16808(if (boundp 'narrow-map)
16809 (org-defkey narrow-map "s" 'org-narrow-to-subtree)
16810 (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree))
3ab2c837
BG
16811(if (boundp 'narrow-map)
16812 (org-defkey narrow-map "b" 'org-narrow-to-block)
16813 (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block))
c8d0cf5c
CD
16814(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level)
16815(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level)
a3fbe8c4
CD
16816(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
16817(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
8bfe682a 16818(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
20908596
CD
16819(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
16820(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
a3fbe8c4
CD
16821(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
16822(org-defkey org-mode-map "\C-c\C-j" 'org-goto)
16823(org-defkey org-mode-map "\C-c\C-t" 'org-todo)
71d35b24 16824(org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command)
a3fbe8c4
CD
16825(org-defkey org-mode-map "\C-c\C-s" 'org-schedule)
16826(org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
16827(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
8c6fb58b 16828(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
03f3cf35 16829(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
c8d0cf5c 16830(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
a3fbe8c4
CD
16831(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
16832(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
c8d0cf5c 16833(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
3ab2c837 16834(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible)
621f83e4
CD
16835(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
16836(org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content)
a3fbe8c4
CD
16837(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
16838(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
16839(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
16840(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
16841(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
16842(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto)
20908596 16843(org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding
a3fbe8c4
CD
16844(org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved
16845(org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r.
16846(org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved
16847(org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range)
16848(org-defkey org-mode-map "\C-c>" 'org-goto-calendar)
16849(org-defkey org-mode-map "\C-c<" 'org-date-from-calendar)
16850(org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files)
16851(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files)
16852(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front)
16853(org-defkey org-mode-map "\C-c]" 'org-remove-file)
8c6fb58b
CD
16854(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock)
16855(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
38f8646b 16856(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus)
2a57416f 16857(org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star)
a3fbe8c4
CD
16858(org-defkey org-mode-map "\C-c^" 'org-sort)
16859(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
03f3cf35 16860(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
54a0dee5 16861(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
a3fbe8c4 16862(org-defkey org-mode-map "\C-m" 'org-return)
8c6fb58b 16863(org-defkey org-mode-map "\C-j" 'org-return-indent)
a3fbe8c4
CD
16864(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
16865(org-defkey org-mode-map "\C-c " 'org-table-blank-field)
16866(org-defkey org-mode-map "\C-c+" 'org-table-sum)
16867(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
b349f79f 16868(org-defkey org-mode-map "\C-c'" 'org-edit-special)
a3fbe8c4
CD
16869(org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
16870(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
a3fbe8c4
CD
16871(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
16872(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
621f83e4 16873(org-defkey org-mode-map "\C-c\C-a" 'org-attach)
a3fbe8c4
CD
16874(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
16875(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
16876(org-defkey org-mode-map "\C-c\C-e" 'org-export)
16877(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
16878(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
c8d0cf5c 16879(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
8d642074
CD
16880(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
16881(org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
acedf35c 16882(org-defkey org-mode-map "\C-c@" 'org-mark-subtree)
c8d0cf5c
CD
16883(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree)
16884;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree)
a3fbe8c4 16885
b349f79f 16886(org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action)
a3fbe8c4
CD
16887(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special)
16888(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special)
16889(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special)
16890
16891(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays)
16892(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in)
16893(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out)
15841868 16894(org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
a3fbe8c4
CD
16895(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-cancel)
16896(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
16897(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
16898(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
16899(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
86fbb8ca
CD
16900(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images)
16901(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
a3fbe8c4 16902(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
03f3cf35 16903(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
54a0dee5 16904(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
a2a2e7fb 16905(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
621f83e4 16906(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
c8d0cf5c 16907(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
afe98dfa 16908(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer)
edd21304 16909
ff4be292
CD
16910(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
16911(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
16912(org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start)
afe98dfa 16913(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop)
0bd48b37 16914(org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue)
ff4be292 16915
38f8646b
CD
16916(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns)
16917
c8d0cf5c
CD
16918(define-key org-mode-map "\C-c\C-x!" 'org-reload)
16919
16920(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all)
16921(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox)
16922
16923(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
16924
16925
edd21304 16926(when (featurep 'xemacs)
a3fbe8c4 16927 (org-defkey org-mode-map 'button3 'popup-mode-menu))
4b3a9ba7 16928
c8d0cf5c 16929
8bfe682a
CD
16930(defconst org-speed-commands-default
16931 '(
1bcdebed
CD
16932 ("Outline Navigation")
16933 ("n" . (org-speed-move-safe 'outline-next-visible-heading))
16934 ("p" . (org-speed-move-safe 'outline-previous-visible-heading))
16935 ("f" . (org-speed-move-safe 'org-forward-same-level))
16936 ("b" . (org-speed-move-safe 'org-backward-same-level))
16937 ("u" . (org-speed-move-safe 'outline-up-heading))
16938 ("j" . org-goto)
16939 ("g" . (org-refile t))
16940 ("Outline Visibility")
8bfe682a
CD
16941 ("c" . org-cycle)
16942 ("C" . org-shifttab)
1bcdebed
CD
16943 (" " . org-display-outline-path)
16944 ("Outline Structure Editing")
8bfe682a
CD
16945 ("U" . org-shiftmetaup)
16946 ("D" . org-shiftmetadown)
16947 ("r" . org-metaright)
16948 ("l" . org-metaleft)
16949 ("R" . org-shiftmetaright)
16950 ("L" . org-shiftmetaleft)
16951 ("i" . (progn (forward-char 1) (call-interactively
16952 'org-insert-heading-respect-content)))
1bcdebed
CD
16953 ("^" . org-sort)
16954 ("w" . org-refile)
16955 ("a" . org-archive-subtree-default-with-confirmation)
acedf35c 16956 ("." . org-mark-subtree)
1bcdebed 16957 ("Clock Commands")
8bfe682a
CD
16958 ("I" . org-clock-in)
16959 ("O" . org-clock-out)
1bcdebed 16960 ("Meta Data Editing")
8bfe682a 16961 ("t" . org-todo)
8bfe682a
CD
16962 ("0" . (org-priority ?\ ))
16963 ("1" . (org-priority ?A))
16964 ("2" . (org-priority ?B))
16965 ("3" . (org-priority ?C))
1bcdebed
CD
16966 (";" . org-set-tags-command)
16967 ("e" . org-set-effort)
16968 ("Agenda Views etc")
16969 ("v" . org-agenda)
16970 ("/" . org-sparse-tree)
1bcdebed
CD
16971 ("Misc")
16972 ("o" . org-open-at-point)
8bfe682a 16973 ("?" . org-speed-command-help)
afe98dfa
CD
16974 ("<" . (org-agenda-set-restriction-lock 'subtree))
16975 (">" . (org-agenda-remove-restriction-lock))
8bfe682a
CD
16976 )
16977 "The default speed commands.")
16978
16979(defun org-print-speed-command (e)
1bcdebed
CD
16980 (if (> (length (car e)) 1)
16981 (progn
16982 (princ "\n")
16983 (princ (car e))
16984 (princ "\n")
16985 (princ (make-string (length (car e)) ?-))
16986 (princ "\n"))
16987 (princ (car e))
16988 (princ " ")
16989 (if (symbolp (cdr e))
16990 (princ (symbol-name (cdr e)))
16991 (prin1 (cdr e)))
16992 (princ "\n")))
8bfe682a
CD
16993
16994(defun org-speed-command-help ()
16995 "Show the available speed commands."
16996 (interactive)
16997 (if (not org-use-speed-commands)
86fbb8ca 16998 (error "Speed commands are not activated, customize `org-use-speed-commands'")
8bfe682a 16999 (with-output-to-temp-buffer "*Help*"
1bcdebed 17000 (princ "User-defined Speed commands\n===========================\n")
8bfe682a
CD
17001 (mapc 'org-print-speed-command org-speed-commands-user)
17002 (princ "\n")
1bcdebed
CD
17003 (princ "Built-in Speed commands\n=======================\n")
17004 (mapc 'org-print-speed-command org-speed-commands-default))
17005 (with-current-buffer "*Help*"
17006 (setq truncate-lines t))))
17007
17008(defun org-speed-move-safe (cmd)
17009 "Execute CMD, but make sure that the cursor always ends up in a headline.
17010If not, return to the original position and throw an error."
17011 (interactive)
17012 (let ((pos (point)))
17013 (call-interactively cmd)
17014 (unless (and (bolp) (org-on-heading-p))
17015 (goto-char pos)
17016 (error "Boundary reached while executing %s" cmd))))
8bfe682a 17017
c8d0cf5c
CD
17018(defvar org-self-insert-command-undo-counter 0)
17019
20908596 17020(defvar org-table-auto-blank-field) ; defined in org-table.el
8bfe682a 17021(defvar org-speed-command nil)
afe98dfa
CD
17022
17023(defun org-speed-command-default-hook (keys)
17024 "Hook for activating single-letter speed commands.
3ab2c837
BG
17025`org-speed-commands-default' specifies a minimal command set. Use
17026`org-speed-commands-user' for further customization."
17027 (when (or (and (bolp) (looking-at org-outline-regexp))
afe98dfa
CD
17028 (and (functionp org-use-speed-commands)
17029 (funcall org-use-speed-commands)))
17030 (cdr (assoc keys (append org-speed-commands-user
17031 org-speed-commands-default)))))
17032
17033(defun org-babel-speed-command-hook (keys)
17034 "Hook for activating single-letter code block commands."
17035 (when (and (bolp) (looking-at org-babel-src-block-regexp))
17036 (cdr (assoc keys org-babel-key-bindings))))
17037
17038(defcustom org-speed-command-hook
17039 '(org-speed-command-default-hook org-babel-speed-command-hook)
17040 "Hook for activating speed commands at strategic locations.
17041Hook functions are called in sequence until a valid handler is
17042found.
17043
17044Each hook takes a single argument, a user-pressed command key
17045which is also a `self-insert-command' from the global map.
17046
17047Within the hook, examine the cursor position and the command key
3ab2c837 17048and return nil or a valid handler as appropriate. Handler could
afe98dfa
CD
17049be one of an interactive command, a function, or a form.
17050
17051Set `org-use-speed-commands' to non-nil value to enable this
3ab2c837 17052hook. The default setting is `org-speed-command-default-hook'."
afe98dfa
CD
17053 :group 'org-structure
17054 :type 'hook)
17055
791d856f
CD
17056(defun org-self-insert-command (N)
17057 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
17058If the cursor is in a table looking at whitespace, the whitespace is
17059overwritten, and the table is not marked as requiring realignment."
17060 (interactive "p")
8bfe682a
CD
17061 (cond
17062 ((and org-use-speed-commands
afe98dfa
CD
17063 (setq org-speed-command
17064 (run-hook-with-args-until-success
17065 'org-speed-command-hook (this-command-keys))))
8bfe682a
CD
17066 (cond
17067 ((commandp org-speed-command)
17068 (setq this-command org-speed-command)
17069 (call-interactively org-speed-command))
17070 ((functionp org-speed-command)
db4a7382 17071 (funcall org-speed-command))
8bfe682a
CD
17072 ((and org-speed-command (listp org-speed-command))
17073 (eval org-speed-command))
17074 (t (let (org-use-speed-commands)
17075 (call-interactively 'org-self-insert-command)))))
17076 ((and
17077 (org-table-p)
17078 (progn
17079 ;; check if we blank the field, and if that triggers align
17080 (and (featurep 'org-table) org-table-auto-blank-field
17081 (member last-command
17082 '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand))
17083 (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |"))
17084 ;; got extra space, this field does not determine column width
17085 (let (org-table-may-need-update) (org-table-blank-field))
c8d0cf5c 17086 ;; no extra space, this field may determine column width
8bfe682a
CD
17087 (org-table-blank-field)))
17088 t)
17089 (eq N 1)
17090 (looking-at "[^|\n]* |"))
17091 (let (org-table-may-need-update)
17092 (goto-char (1- (match-end 0)))
3ab2c837 17093 (delete-char -1)
8bfe682a
CD
17094 (goto-char (match-beginning 0))
17095 (self-insert-command N)))
17096 (t
791d856f 17097 (setq org-table-may-need-update t)
1e8fbb6d 17098 (self-insert-command N)
c8d0cf5c
CD
17099 (org-fix-tags-on-the-fly)
17100 (if org-self-insert-cluster-for-undo
17101 (if (not (eq last-command 'org-self-insert-command))
17102 (setq org-self-insert-command-undo-counter 1)
17103 (if (>= org-self-insert-command-undo-counter 20)
17104 (setq org-self-insert-command-undo-counter 1)
17105 (and (> org-self-insert-command-undo-counter 0)
3ab2c837 17106 buffer-undo-list (listp buffer-undo-list)
c8d0cf5c
CD
17107 (not (cadr buffer-undo-list)) ; remove nil entry
17108 (setcdr buffer-undo-list (cddr buffer-undo-list)))
17109 (setq org-self-insert-command-undo-counter
8bfe682a 17110 (1+ org-self-insert-command-undo-counter))))))))
1e8fbb6d
CD
17111
17112(defun org-fix-tags-on-the-fly ()
17113 (when (and (equal (char-after (point-at-bol)) ?*)
17114 (org-on-heading-p))
17115 (org-align-tags-here org-tags-column)))
791d856f 17116
791d856f
CD
17117(defun org-delete-backward-char (N)
17118 "Like `delete-backward-char', insert whitespace at field end in tables.
17119When deleting backwards, in tables this function will insert whitespace in
17120front of the next \"|\" separator, to keep the table aligned. The table will
ab27a4a0
CD
17121still be marked for re-alignment if the field did fill the entire column,
17122because, in this case the deletion might narrow the column."
791d856f
CD
17123 (interactive "p")
17124 (if (and (org-table-p)
c8d16429
CD
17125 (eq N 1)
17126 (string-match "|" (buffer-substring (point-at-bol) (point)))
17127 (looking-at ".*?|"))
edd21304 17128 (let ((pos (point))
ab27a4a0
CD
17129 (noalign (looking-at "[^|\n\r]* |"))
17130 (c org-table-may-need-update))
c8d16429 17131 (backward-delete-char N)
afe98dfa
CD
17132 (if (not overwrite-mode)
17133 (progn
17134 (skip-chars-forward "^|")
17135 (insert " ")
17136 (goto-char (1- pos))))
ab27a4a0
CD
17137 ;; noalign: if there were two spaces at the end, this field
17138 ;; does not determine the width of the column.
17139 (if noalign (setq org-table-may-need-update c)))
1e8fbb6d
CD
17140 (backward-delete-char N)
17141 (org-fix-tags-on-the-fly)))
791d856f
CD
17142
17143(defun org-delete-char (N)
17144 "Like `delete-char', but insert whitespace at field end in tables.
17145When deleting characters, in tables this function will insert whitespace in
ab27a4a0
CD
17146front of the next \"|\" separator, to keep the table aligned. The table will
17147still be marked for re-alignment if the field did fill the entire column,
17148because, in this case the deletion might narrow the column."
791d856f
CD
17149 (interactive "p")
17150 (if (and (org-table-p)
c8d16429
CD
17151 (not (bolp))
17152 (not (= (char-after) ?|))
17153 (eq N 1))
791d856f 17154 (if (looking-at ".*?|")
ab27a4a0
CD
17155 (let ((pos (point))
17156 (noalign (looking-at "[^|\n\r]* |"))
17157 (c org-table-may-need-update))
c8d16429
CD
17158 (replace-match (concat
17159 (substring (match-string 0) 1 -1)
17160 " |"))
ab27a4a0
CD
17161 (goto-char pos)
17162 ;; noalign: if there were two spaces at the end, this field
17163 ;; does not determine the width of the column.
4b3a9ba7
CD
17164 (if noalign (setq org-table-may-need-update c)))
17165 (delete-char N))
1e8fbb6d
CD
17166 (delete-char N)
17167 (org-fix-tags-on-the-fly)))
791d856f 17168
3278a016
CD
17169;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
17170(put 'org-self-insert-command 'delete-selection t)
17171(put 'orgtbl-self-insert-command 'delete-selection t)
17172(put 'org-delete-char 'delete-selection 'supersede)
17173(put 'org-delete-backward-char 'delete-selection 'supersede)
1e4f816a 17174(put 'org-yank 'delete-selection 'yank)
3278a016 17175
7373bc42
CD
17176;; Make `flyspell-mode' delay after some commands
17177(put 'org-self-insert-command 'flyspell-delayed t)
17178(put 'orgtbl-self-insert-command 'flyspell-delayed t)
17179(put 'org-delete-char 'flyspell-delayed t)
17180(put 'org-delete-backward-char 'flyspell-delayed t)
17181
8c6fb58b
CD
17182;; Make pabbrev-mode expand after org-mode commands
17183(put 'org-self-insert-command 'pabbrev-expand-after-command t)
33306645 17184(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
15841868 17185
791d856f
CD
17186;; How to do this: Measure non-white length of current string
17187;; If equal to column width, we should realign.
17188
28e5b051
CD
17189(defun org-remap (map &rest commands)
17190 "In MAP, remap the functions given in COMMANDS.
17191COMMANDS is a list of alternating OLDDEF NEWDEF command names."
17192 (let (new old)
17193 (while commands
17194 (setq old (pop commands) new (pop commands))
17195 (if (fboundp 'command-remapping)
a3fbe8c4 17196 (org-defkey map (vector 'remap old) new)
28e5b051 17197 (substitute-key-definition old new map global-map)))))
e0e66b8e 17198
791d856f
CD
17199(when (eq org-enable-table-editor 'optimized)
17200 ;; If the user wants maximum table support, we need to hijack
17201 ;; some standard editing functions
28e5b051
CD
17202 (org-remap org-mode-map
17203 'self-insert-command 'org-self-insert-command
17204 'delete-char 'org-delete-char
17205 'delete-backward-char 'org-delete-backward-char)
a3fbe8c4 17206 (org-defkey org-mode-map "|" 'org-force-self-insert))
791d856f 17207
c8d0cf5c 17208(defvar org-ctrl-c-ctrl-c-hook nil
3ab2c837
BG
17209 "Hook for functions attaching themselves to `C-c C-c'.
17210
17211This can be used to add additional functionality to the C-c C-c
17212key which executes context-dependent commands. This hook is run
17213before any other test, while `org-ctrl-c-ctrl-c-final-hook' is
17214run after the last test.
17215
17216Each function will be called with no arguments. The function
17217must check if the context is appropriate for it to act. If yes,
17218it should do its thing and then return a non-nil value. If the
17219context is wrong, just do nothing and return nil.")
17220
17221(defvar org-ctrl-c-ctrl-c-final-hook nil
17222 "Hook for functions attaching themselves to `C-c C-c'.
17223
17224This can be used to add additional functionality to the C-c C-c
17225key which executes context-dependent commands. This hook is run
17226after any other test, while `org-ctrl-c-ctrl-c-hook' is run
17227before the first test.
17228
17229Each function will be called with no arguments. The function
17230must check if the context is appropriate for it to act. If yes,
17231it should do its thing and then return a non-nil value. If the
17232context is wrong, just do nothing and return nil.")
c8d0cf5c
CD
17233
17234(defvar org-tab-first-hook nil
17235 "Hook for functions to attach themselves to TAB.
17236See `org-ctrl-c-ctrl-c-hook' for more information.
17237This hook runs as the first action when TAB is pressed, even before
17238`org-cycle' messes around with the `outline-regexp' to cater for
17239inline tasks and plain list item folding.
86fbb8ca
CD
17240If any function in this hook returns t, any other actions that
17241would have been caused by TAB (such as table field motion or visibility
17242cycling) will not occur.")
c8d0cf5c
CD
17243
17244(defvar org-tab-after-check-for-table-hook nil
17245 "Hook for functions to attach themselves to TAB.
17246See `org-ctrl-c-ctrl-c-hook' for more information.
17247This hook runs after it has been established that the cursor is not in a
17248table, but before checking if the cursor is in a headline or if global cycling
17249should be done.
17250If any function in this hook returns t, not other actions like visibility
17251cycling will be done.")
17252
17253(defvar org-tab-after-check-for-cycling-hook nil
17254 "Hook for functions to attach themselves to TAB.
17255See `org-ctrl-c-ctrl-c-hook' for more information.
17256This hook runs after it has been established that not table field motion and
17257not visibility should be done because of current context. This is probably
17258the place where a package like yasnippets can hook in.")
17259
8bfe682a
CD
17260(defvar org-tab-before-tab-emulation-hook nil
17261 "Hook for functions to attach themselves to TAB.
17262See `org-ctrl-c-ctrl-c-hook' for more information.
17263This hook runs after every other options for TAB have been exhausted, but
17264before indentation and \t insertion takes place.")
17265
c8d0cf5c
CD
17266(defvar org-metaleft-hook nil
17267 "Hook for functions attaching themselves to `M-left'.
17268See `org-ctrl-c-ctrl-c-hook' for more information.")
17269(defvar org-metaright-hook nil
17270 "Hook for functions attaching themselves to `M-right'.
17271See `org-ctrl-c-ctrl-c-hook' for more information.")
17272(defvar org-metaup-hook nil
17273 "Hook for functions attaching themselves to `M-up'.
17274See `org-ctrl-c-ctrl-c-hook' for more information.")
17275(defvar org-metadown-hook nil
17276 "Hook for functions attaching themselves to `M-down'.
17277See `org-ctrl-c-ctrl-c-hook' for more information.")
17278(defvar org-shiftmetaleft-hook nil
17279 "Hook for functions attaching themselves to `M-S-left'.
17280See `org-ctrl-c-ctrl-c-hook' for more information.")
17281(defvar org-shiftmetaright-hook nil
17282 "Hook for functions attaching themselves to `M-S-right'.
17283See `org-ctrl-c-ctrl-c-hook' for more information.")
17284(defvar org-shiftmetaup-hook nil
17285 "Hook for functions attaching themselves to `M-S-up'.
17286See `org-ctrl-c-ctrl-c-hook' for more information.")
17287(defvar org-shiftmetadown-hook nil
17288 "Hook for functions attaching themselves to `M-S-down'.
17289See `org-ctrl-c-ctrl-c-hook' for more information.")
17290(defvar org-metareturn-hook nil
17291 "Hook for functions attaching themselves to `M-RET'.
17292See `org-ctrl-c-ctrl-c-hook' for more information.")
86fbb8ca
CD
17293(defvar org-shiftup-hook nil
17294 "Hook for functions attaching themselves to `S-up'.
17295See `org-ctrl-c-ctrl-c-hook' for more information.")
17296(defvar org-shiftup-final-hook nil
17297 "Hook for functions attaching themselves to `S-up'.
17298This one runs after all other options except shift-select have been excluded.
17299See `org-ctrl-c-ctrl-c-hook' for more information.")
17300(defvar org-shiftdown-hook nil
17301 "Hook for functions attaching themselves to `S-down'.
17302See `org-ctrl-c-ctrl-c-hook' for more information.")
17303(defvar org-shiftdown-final-hook nil
17304 "Hook for functions attaching themselves to `S-down'.
17305This one runs after all other options except shift-select have been excluded.
17306See `org-ctrl-c-ctrl-c-hook' for more information.")
17307(defvar org-shiftleft-hook nil
17308 "Hook for functions attaching themselves to `S-left'.
17309See `org-ctrl-c-ctrl-c-hook' for more information.")
17310(defvar org-shiftleft-final-hook nil
17311 "Hook for functions attaching themselves to `S-left'.
17312This one runs after all other options except shift-select have been excluded.
17313See `org-ctrl-c-ctrl-c-hook' for more information.")
17314(defvar org-shiftright-hook nil
17315 "Hook for functions attaching themselves to `S-right'.
17316See `org-ctrl-c-ctrl-c-hook' for more information.")
17317(defvar org-shiftright-final-hook nil
17318 "Hook for functions attaching themselves to `S-right'.
17319This one runs after all other options except shift-select have been excluded.
17320See `org-ctrl-c-ctrl-c-hook' for more information.")
c8d0cf5c 17321
65c439fd
CD
17322(defun org-modifier-cursor-error ()
17323 "Throw an error, a modified cursor command was applied in wrong context."
17324 (error "This command is active in special context like tables, headlines or items"))
17325
17326(defun org-shiftselect-error ()
891f4676 17327 "Throw an error because Shift-Cursor command was applied in wrong context."
65c439fd 17328 (if (and (boundp 'shift-select-mode) shift-select-mode)
f924a367
JB
17329 (error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
17330 (error "This command works only in special context like headlines or timestamps")))
65c439fd
CD
17331
17332(defun org-call-for-shift-select (cmd)
17333 (let ((this-command-keys-shift-translated t))
17334 (call-interactively cmd)))
891f4676 17335
edd21304 17336(defun org-shifttab (&optional arg)
28e5b051 17337 "Global visibility cycling or move to previous table field.
4b3a9ba7
CD
17338Calls `org-cycle' with argument t, or `org-table-previous-field', depending
17339on context.
28e5b051 17340See the individual commands for more information."
edd21304 17341 (interactive "P")
891f4676 17342 (cond
4b3a9ba7 17343 ((org-at-table-p) (call-interactively 'org-table-previous-field))
b349f79f 17344 ((integerp arg)
8d642074
CD
17345 (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
17346 (message "Content view to level: %d" arg)
17347 (org-content (prefix-numeric-value arg2))
17348 (setq org-cycle-global-status 'overview)))
4b3a9ba7 17349 (t (call-interactively 'org-global-cycle))))
891f4676 17350
634a7d0b 17351(defun org-shiftmetaleft ()
28e5b051 17352 "Promote subtree or delete table column.
a3fbe8c4
CD
17353Calls `org-promote-subtree', `org-outdent-item',
17354or `org-table-delete-column', depending on context.
28e5b051 17355See the individual commands for more information."
634a7d0b 17356 (interactive)
891f4676 17357 (cond
c8d0cf5c 17358 ((run-hook-with-args-until-success 'org-shiftmetaleft-hook))
4b3a9ba7
CD
17359 ((org-at-table-p) (call-interactively 'org-table-delete-column))
17360 ((org-on-heading-p) (call-interactively 'org-promote-subtree))
86fbb8ca 17361 ((org-at-item-p) (call-interactively 'org-outdent-item-tree))
65c439fd 17362 (t (org-modifier-cursor-error))))
634a7d0b
CD
17363
17364(defun org-shiftmetaright ()
28e5b051 17365 "Demote subtree or insert table column.
a3fbe8c4
CD
17366Calls `org-demote-subtree', `org-indent-item',
17367or `org-table-insert-column', depending on context.
28e5b051 17368See the individual commands for more information."
634a7d0b 17369 (interactive)
891f4676 17370 (cond
c8d0cf5c 17371 ((run-hook-with-args-until-success 'org-shiftmetaright-hook))
4b3a9ba7
CD
17372 ((org-at-table-p) (call-interactively 'org-table-insert-column))
17373 ((org-on-heading-p) (call-interactively 'org-demote-subtree))
86fbb8ca 17374 ((org-at-item-p) (call-interactively 'org-indent-item-tree))
65c439fd 17375 (t (org-modifier-cursor-error))))
634a7d0b 17376
891f4676 17377(defun org-shiftmetaup (&optional arg)
28e5b051 17378 "Move subtree up or kill table row.
7a368970
CD
17379Calls `org-move-subtree-up' or `org-table-kill-row' or
17380`org-move-item-up' depending on context. See the individual commands
17381for more information."
891f4676
RS
17382 (interactive "P")
17383 (cond
c8d0cf5c 17384 ((run-hook-with-args-until-success 'org-shiftmetaup-hook))
4b3a9ba7
CD
17385 ((org-at-table-p) (call-interactively 'org-table-kill-row))
17386 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
17387 ((org-at-item-p) (call-interactively 'org-move-item-up))
65c439fd 17388 (t (org-modifier-cursor-error))))
c8d0cf5c 17389
891f4676 17390(defun org-shiftmetadown (&optional arg)
28e5b051 17391 "Move subtree down or insert table row.
7a368970
CD
17392Calls `org-move-subtree-down' or `org-table-insert-row' or
17393`org-move-item-down', depending on context. See the individual
17394commands for more information."
891f4676
RS
17395 (interactive "P")
17396 (cond
c8d0cf5c 17397 ((run-hook-with-args-until-success 'org-shiftmetadown-hook))
4b3a9ba7
CD
17398 ((org-at-table-p) (call-interactively 'org-table-insert-row))
17399 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
17400 ((org-at-item-p) (call-interactively 'org-move-item-down))
65c439fd 17401 (t (org-modifier-cursor-error))))
891f4676 17402
86fbb8ca
CD
17403(defsubst org-hidden-tree-error ()
17404 (error
17405 "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
17406
891f4676 17407(defun org-metaleft (&optional arg)
28e5b051
CD
17408 "Promote heading or move table column to left.
17409Calls `org-do-promote' or `org-table-move-column', depending on context.
7a368970 17410With no specific context, calls the Emacs default `backward-word'.
28e5b051 17411See the individual commands for more information."
891f4676
RS
17412 (interactive "P")
17413 (cond
c8d0cf5c 17414 ((run-hook-with-args-until-success 'org-metaleft-hook))
4b3a9ba7 17415 ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left))
3ab2c837
BG
17416 ((org-with-limited-levels
17417 (or (org-on-heading-p)
17418 (and (org-region-active-p)
17419 (save-excursion
17420 (goto-char (region-beginning))
17421 (org-on-heading-p)))))
86fbb8ca 17422 (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
4b3a9ba7 17423 (call-interactively 'org-do-promote))
3ab2c837
BG
17424 ;; At an inline task.
17425 ((org-on-heading-p)
17426 (call-interactively 'org-inlinetask-promote))
c8d0cf5c
CD
17427 ((or (org-at-item-p)
17428 (and (org-region-active-p)
17429 (save-excursion
17430 (goto-char (region-beginning))
17431 (org-at-item-p))))
86fbb8ca 17432 (when (org-check-for-hidden 'items) (org-hidden-tree-error))
c8d0cf5c 17433 (call-interactively 'org-outdent-item))
4b3a9ba7 17434 (t (call-interactively 'backward-word))))
634a7d0b 17435
891f4676 17436(defun org-metaright (&optional arg)
28e5b051
CD
17437 "Demote subtree or move table column to right.
17438Calls `org-do-demote' or `org-table-move-column', depending on context.
7a368970 17439With no specific context, calls the Emacs default `forward-word'.
28e5b051 17440See the individual commands for more information."
891f4676
RS
17441 (interactive "P")
17442 (cond
c8d0cf5c 17443 ((run-hook-with-args-until-success 'org-metaright-hook))
4b3a9ba7 17444 ((org-at-table-p) (call-interactively 'org-table-move-column))
3ab2c837
BG
17445 ((org-with-limited-levels
17446 (or (org-on-heading-p)
17447 (and (org-region-active-p)
17448 (save-excursion
17449 (goto-char (region-beginning))
17450 (org-on-heading-p)))))
86fbb8ca 17451 (when (org-check-for-hidden 'headlines) (org-hidden-tree-error))
4b3a9ba7 17452 (call-interactively 'org-do-demote))
3ab2c837
BG
17453 ;; At an inline task.
17454 ((org-on-heading-p)
17455 (call-interactively 'org-inlinetask-demote))
c8d0cf5c
CD
17456 ((or (org-at-item-p)
17457 (and (org-region-active-p)
17458 (save-excursion
17459 (goto-char (region-beginning))
17460 (org-at-item-p))))
86fbb8ca 17461 (when (org-check-for-hidden 'items) (org-hidden-tree-error))
c8d0cf5c 17462 (call-interactively 'org-indent-item))
4b3a9ba7 17463 (t (call-interactively 'forward-word))))
634a7d0b 17464
86fbb8ca
CD
17465(defun org-check-for-hidden (what)
17466 "Check if there are hidden headlines/items in the current visual line.
17467WHAT can be either `headlines' or `items'. If the current line is
17468an outline or item heading and it has a folded subtree below it,
17469this function returns t, nil otherwise."
17470 (let ((re (cond
3ab2c837
BG
17471 ((eq what 'headlines) org-outline-regexp-bol)
17472 ((eq what 'items) (org-item-beginning-re))
86fbb8ca
CD
17473 (t (error "This should not happen"))))
17474 beg end)
17475 (save-excursion
17476 (catch 'exit
17477 (unless (org-region-active-p)
17478 (setq beg (point-at-bol))
17479 (beginning-of-line 2)
17480 (while (and (not (eobp)) ;; this is like `next-line'
17481 (get-char-property (1- (point)) 'invisible))
17482 (beginning-of-line 2))
17483 (setq end (point))
17484 (goto-char beg)
17485 (goto-char (point-at-eol))
17486 (setq end (max end (point)))
17487 (while (re-search-forward re end t)
17488 (if (get-char-property (match-beginning 0) 'invisible)
17489 (throw 'exit t))))
17490 nil))))
17491
891f4676 17492(defun org-metaup (&optional arg)
28e5b051 17493 "Move subtree up or move table row up.
7a368970
CD
17494Calls `org-move-subtree-up' or `org-table-move-row' or
17495`org-move-item-up', depending on context. See the individual commands
17496for more information."
891f4676
RS
17497 (interactive "P")
17498 (cond
c8d0cf5c 17499 ((run-hook-with-args-until-success 'org-metaup-hook))
4b3a9ba7
CD
17500 ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up))
17501 ((org-on-heading-p) (call-interactively 'org-move-subtree-up))
17502 ((org-at-item-p) (call-interactively 'org-move-item-up))
03f3cf35 17503 (t (transpose-lines 1) (beginning-of-line -1))))
634a7d0b 17504
891f4676 17505(defun org-metadown (&optional arg)
28e5b051 17506 "Move subtree down or move table row down.
7a368970
CD
17507Calls `org-move-subtree-down' or `org-table-move-row' or
17508`org-move-item-down', depending on context. See the individual
17509commands for more information."
891f4676
RS
17510 (interactive "P")
17511 (cond
c8d0cf5c 17512 ((run-hook-with-args-until-success 'org-metadown-hook))
4b3a9ba7
CD
17513 ((org-at-table-p) (call-interactively 'org-table-move-row))
17514 ((org-on-heading-p) (call-interactively 'org-move-subtree-down))
17515 ((org-at-item-p) (call-interactively 'org-move-item-down))
03f3cf35 17516 (t (beginning-of-line 2) (transpose-lines 1) (beginning-of-line 0))))
891f4676
RS
17517
17518(defun org-shiftup (&optional arg)
4b3a9ba7 17519 "Increase item in timestamp or increase priority of current headline.
a3fbe8c4
CD
17520Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item',
17521depending on context. See the individual commands for more information."
891f4676
RS
17522 (interactive "P")
17523 (cond
86fbb8ca 17524 ((run-hook-with-args-until-success 'org-shiftup-hook))
65c439fd
CD
17525 ((and org-support-shift-select (org-region-active-p))
17526 (org-call-for-shift-select 'previous-line))
0b8568f5
JW
17527 ((org-at-timestamp-p t)
17528 (call-interactively (if org-edit-timestamp-down-means-later
17529 'org-timestamp-down 'org-timestamp-up)))
65c439fd 17530 ((and (not (eq org-support-shift-select 'always))
c8d0cf5c 17531 org-enable-priority-commands
65c439fd
CD
17532 (org-on-heading-p))
17533 (call-interactively 'org-priority-up))
17534 ((and (not org-support-shift-select) (org-at-item-p))
17535 (call-interactively 'org-previous-item))
20908596 17536 ((org-clocktable-try-shift 'up arg))
86fbb8ca 17537 ((run-hook-with-args-until-success 'org-shiftup-final-hook))
65c439fd
CD
17538 (org-support-shift-select
17539 (org-call-for-shift-select 'previous-line))
17540 (t (org-shiftselect-error))))
891f4676
RS
17541
17542(defun org-shiftdown (&optional arg)
4b3a9ba7 17543 "Decrease item in timestamp or decrease priority of current headline.
a3fbe8c4
CD
17544Calls `org-timestamp-down' or `org-priority-down', or `org-next-item'
17545depending on context. See the individual commands for more information."
891f4676
RS
17546 (interactive "P")
17547 (cond
86fbb8ca 17548 ((run-hook-with-args-until-success 'org-shiftdown-hook))
65c439fd
CD
17549 ((and org-support-shift-select (org-region-active-p))
17550 (org-call-for-shift-select 'next-line))
0b8568f5
JW
17551 ((org-at-timestamp-p t)
17552 (call-interactively (if org-edit-timestamp-down-means-later
17553 'org-timestamp-up 'org-timestamp-down)))
65c439fd 17554 ((and (not (eq org-support-shift-select 'always))
c8d0cf5c 17555 org-enable-priority-commands
65c439fd
CD
17556 (org-on-heading-p))
17557 (call-interactively 'org-priority-down))
17558 ((and (not org-support-shift-select) (org-at-item-p))
17559 (call-interactively 'org-next-item))
20908596 17560 ((org-clocktable-try-shift 'down arg))
86fbb8ca 17561 ((run-hook-with-args-until-success 'org-shiftdown-final-hook))
c8d0cf5c 17562 (org-support-shift-select
65c439fd
CD
17563 (org-call-for-shift-select 'next-line))
17564 (t (org-shiftselect-error))))
891f4676 17565
20908596 17566(defun org-shiftright (&optional arg)
ce4fdcb9
CD
17567 "Cycle the thing at point or in the current line, depending on context.
17568Depending on context, this does one of the following:
17569
17570- switch a timestamp at point one day into the future
17571- on a headline, switch to the next TODO keyword.
17572- on an item, switch entire list to the next bullet type
17573- on a property line, switch to the next allowed value
17574- on a clocktable definition line, move time block into the future"
20908596 17575 (interactive "P")
f425a6ea 17576 (cond
86fbb8ca 17577 ((run-hook-with-args-until-success 'org-shiftright-hook))
65c439fd
CD
17578 ((and org-support-shift-select (org-region-active-p))
17579 (org-call-for-shift-select 'forward-char))
8df0de1c 17580 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
65c439fd
CD
17581 ((and (not (eq org-support-shift-select 'always))
17582 (org-on-heading-p))
c8d0cf5c
CD
17583 (let ((org-inhibit-logging
17584 (not org-treat-S-cursor-todo-selection-as-state-change))
17585 (org-inhibit-blocking
17586 (not org-treat-S-cursor-todo-selection-as-state-change)))
17587 (org-call-with-arg 'org-todo 'right)))
65c439fd
CD
17588 ((or (and org-support-shift-select
17589 (not (eq org-support-shift-select 'always))
17590 (org-at-item-bullet-p))
17591 (and (not org-support-shift-select) (org-at-item-p)))
17592 (org-call-with-arg 'org-cycle-list-bullet nil))
17593 ((and (not (eq org-support-shift-select 'always))
17594 (org-at-property-p))
17595 (call-interactively 'org-property-next-allowed-value))
20908596 17596 ((org-clocktable-try-shift 'right arg))
86fbb8ca 17597 ((run-hook-with-args-until-success 'org-shiftright-final-hook))
c8d0cf5c 17598 (org-support-shift-select
65c439fd
CD
17599 (org-call-for-shift-select 'forward-char))
17600 (t (org-shiftselect-error))))
f425a6ea 17601
20908596 17602(defun org-shiftleft (&optional arg)
ce4fdcb9
CD
17603 "Cycle the thing at point or in the current line, depending on context.
17604Depending on context, this does one of the following:
17605
17606- switch a timestamp at point one day into the past
17607- on a headline, switch to the previous TODO keyword.
17608- on an item, switch entire list to the previous bullet type
17609- on a property line, switch to the previous allowed value
17610- on a clocktable definition line, move time block into the past"
20908596 17611 (interactive "P")
f425a6ea 17612 (cond
86fbb8ca 17613 ((run-hook-with-args-until-success 'org-shiftleft-hook))
65c439fd
CD
17614 ((and org-support-shift-select (org-region-active-p))
17615 (org-call-for-shift-select 'backward-char))
8df0de1c 17616 ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
65c439fd
CD
17617 ((and (not (eq org-support-shift-select 'always))
17618 (org-on-heading-p))
c8d0cf5c
CD
17619 (let ((org-inhibit-logging
17620 (not org-treat-S-cursor-todo-selection-as-state-change))
17621 (org-inhibit-blocking
17622 (not org-treat-S-cursor-todo-selection-as-state-change)))
17623 (org-call-with-arg 'org-todo 'left)))
65c439fd
CD
17624 ((or (and org-support-shift-select
17625 (not (eq org-support-shift-select 'always))
17626 (org-at-item-bullet-p))
17627 (and (not org-support-shift-select) (org-at-item-p)))
17628 (org-call-with-arg 'org-cycle-list-bullet 'previous))
17629 ((and (not (eq org-support-shift-select 'always))
17630 (org-at-property-p))
7d58338e 17631 (call-interactively 'org-property-previous-allowed-value))
20908596 17632 ((org-clocktable-try-shift 'left arg))
86fbb8ca 17633 ((run-hook-with-args-until-success 'org-shiftleft-final-hook))
c8d0cf5c 17634 (org-support-shift-select
65c439fd
CD
17635 (org-call-for-shift-select 'backward-char))
17636 (t (org-shiftselect-error))))
f425a6ea 17637
a3fbe8c4
CD
17638(defun org-shiftcontrolright ()
17639 "Switch to next TODO set."
17640 (interactive)
17641 (cond
65c439fd
CD
17642 ((and org-support-shift-select (org-region-active-p))
17643 (org-call-for-shift-select 'forward-word))
17644 ((and (not (eq org-support-shift-select 'always))
17645 (org-on-heading-p))
17646 (org-call-with-arg 'org-todo 'nextset))
17647 (org-support-shift-select
17648 (org-call-for-shift-select 'forward-word))
17649 (t (org-shiftselect-error))))
a3fbe8c4
CD
17650
17651(defun org-shiftcontrolleft ()
17652 "Switch to previous TODO set."
17653 (interactive)
17654 (cond
65c439fd
CD
17655 ((and org-support-shift-select (org-region-active-p))
17656 (org-call-for-shift-select 'backward-word))
17657 ((and (not (eq org-support-shift-select 'always))
17658 (org-on-heading-p))
17659 (org-call-with-arg 'org-todo 'previousset))
17660 (org-support-shift-select
17661 (org-call-for-shift-select 'backward-word))
17662 (t (org-shiftselect-error))))
a3fbe8c4 17663
3ab2c837
BG
17664(defun org-shiftcontrolup ()
17665 "Change timestamps synchronously up in CLOCK log lines."
17666 (interactive)
17667 (cond ((and (not org-support-shift-select)
17668 (org-at-clock-log-p)
17669 (org-at-timestamp-p t))
17670 (org-clock-timestamps-up))
17671 (t (org-shiftselect-error))))
17672
17673(defun org-shiftcontroldown ()
17674 "Change timestamps synchronously down in CLOCK log lines."
17675 (interactive)
17676 (cond ((and (not org-support-shift-select)
17677 (org-at-clock-log-p)
17678 (org-at-timestamp-p t))
17679 (org-clock-timestamps-down))
17680 (t (org-shiftselect-error))))
17681
a3fbe8c4
CD
17682(defun org-ctrl-c-ret ()
17683 "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
17684 (interactive)
17685 (cond
17686 ((org-at-table-p) (call-interactively 'org-table-hline-and-move))
17687 (t (call-interactively 'org-insert-heading))))
17688
3ab2c837
BG
17689(defun org-copy-visible (beg end)
17690 "Copy the visible parts of the region."
17691 (interactive "r")
17692 (let (snippets s)
17693 (save-excursion
17694 (save-restriction
17695 (narrow-to-region beg end)
17696 (setq s (goto-char (point-min)))
17697 (while (not (= (point) (point-max)))
17698 (goto-char (org-find-invisible))
17699 (push (buffer-substring s (point)) snippets)
17700 (setq s (goto-char (org-find-visible))))))
17701 (kill-new (apply 'concat (nreverse snippets)))))
17702
634a7d0b 17703(defun org-copy-special ()
28e5b051
CD
17704 "Copy region in table or copy current subtree.
17705Calls `org-table-copy' or `org-copy-subtree', depending on context.
17706See the individual commands for more information."
634a7d0b 17707 (interactive)
64f72ae1 17708 (call-interactively
9acdaa21 17709 (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
891f4676 17710
634a7d0b 17711(defun org-cut-special ()
28e5b051
CD
17712 "Cut region in table or cut current subtree.
17713Calls `org-table-copy' or `org-cut-subtree', depending on context.
17714See the individual commands for more information."
634a7d0b 17715 (interactive)
9acdaa21
CD
17716 (call-interactively
17717 (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
891f4676
RS
17718
17719(defun org-paste-special (arg)
28e5b051
CD
17720 "Paste rectangular region into table, or past subtree relative to level.
17721Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context.
17722See the individual commands for more information."
891f4676
RS
17723 (interactive "P")
17724 (if (org-at-table-p)
634a7d0b 17725 (org-table-paste-rectangle)
891f4676
RS
17726 (org-paste-subtree arg)))
17727
86fbb8ca 17728(defun org-edit-special (&optional arg)
b349f79f
CD
17729 "Call a special editor for the stuff at point.
17730When at a table, call the formula editor with `org-table-edit-formulas'.
17731When at the first line of an src example, call `org-edit-src-code'.
17732When in an #+include line, visit the include file. Otherwise call
17733`ffap' to visit the file at point."
17734 (interactive)
86fbb8ca
CD
17735 ;; possibly prep session before editing source
17736 (when arg
17737 (let* ((info (org-babel-get-src-block-info))
17738 (lang (nth 0 info))
17739 (params (nth 2 info))
17740 (session (cdr (assoc :session params))))
17741 (when (and info session) ;; we are in a source-code block with a session
17742 (funcall
17743 (intern (concat "org-babel-prep-session:" lang)) session params))))
17744 (cond ;; proceed with `org-edit-special'
b349f79f
CD
17745 ((save-excursion
17746 (beginning-of-line 1)
17747 (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)"))
17748 (find-file (org-trim (match-string 1))))
17749 ((org-edit-src-code))
621f83e4 17750 ((org-edit-fixed-width-region))
86fbb8ca
CD
17751 ((org-at-table.el-p)
17752 (org-edit-src-code))
acedf35c
CD
17753 ((or (org-at-table-p)
17754 (save-excursion
17755 (beginning-of-line 1)
17756 (looking-at "[ \t]*#\\+TBLFM:")))
86fbb8ca 17757 (call-interactively 'org-table-edit-formulas))
b349f79f
CD
17758 (t (call-interactively 'ffap))))
17759
891f4676 17760(defun org-ctrl-c-ctrl-c (&optional arg)
a4b39e39
CD
17761 "Set tags in headline, or update according to changed information at point.
17762
17763This command does many different things, depending on context:
17764
c8d0cf5c
CD
17765- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location,
17766 this is what we do.
17767
54a0dee5
CD
17768- If the cursor is on a statistics cookie, update it.
17769
a4b39e39
CD
17770- If the cursor is in a headline, prompt for tags and insert them
17771 into the current line, aligned to `org-tags-column'. When called
17772 with prefix arg, realign all tags in the current buffer.
17773
17774- If the cursor is in one of the special #+KEYWORD lines, this
17775 triggers scanning the buffer for these lines and updating the
edd21304 17776 information.
a4b39e39
CD
17777
17778- If the cursor is inside a table, realign the table. This command
17779 works even if the automatic table editor has been turned off.
17780
17781- If the cursor is on a #+TBLFM line, re-apply the formulas to
17782 the entire table.
17783
0bd48b37
CD
17784- If the cursor is at a footnote reference or definition, jump to
17785 the corresponding definition or references, respectively.
17786
15841868
JW
17787- If the cursor is a the beginning of a dynamic block, update it.
17788
afe98dfa 17789- If the current buffer is a capture buffer, close note and file it.
a4b39e39 17790
afe98dfa
CD
17791- If the cursor is on a <<<target>>>, update radio targets and
17792 corresponding links in this buffer.
a4b39e39
CD
17793
17794- If the cursor is on a numbered item in a plain list, renumber the
8c6fb58b
CD
17795 ordered list.
17796
86fbb8ca
CD
17797- If the cursor is on a checkbox, toggle it.
17798
17799- If the cursor is on a code block, evaluate it. The variable
17800 `org-confirm-babel-evaluate' can be used to control prompting
17801 before code block evaluation, by default every code block
17802 evaluation requires confirmation. Code block evaluation can be
17803 inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
891f4676
RS
17804 (interactive "P")
17805 (let ((org-enable-table-editor t))
17806 (cond
20908596 17807 ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
3278a016 17808 org-occur-highlights
6769c0dc 17809 org-latex-fragment-image-overlays)
0bd48b37 17810 (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
edd21304 17811 (org-remove-occur-highlights)
6769c0dc
CD
17812 (org-remove-latex-fragment-image-overlays)
17813 (message "Temporary highlights/overlays removed from current buffer"))
ab27a4a0
CD
17814 ((and (local-variable-p 'org-finish-function (current-buffer))
17815 (fboundp org-finish-function))
17816 (funcall org-finish-function))
c8d0cf5c 17817 ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
ed21c5c8
CD
17818 ((or (looking-at org-property-start-re)
17819 (org-at-property-p))
7d58338e 17820 (call-interactively 'org-property-action))
4b3a9ba7 17821 ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp))
54a0dee5
CD
17822 ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]")
17823 (or (org-on-heading-p) (org-at-item-p)))
17824 (call-interactively 'org-update-statistics-cookies))
4b3a9ba7 17825 ((org-on-heading-p) (call-interactively 'org-set-tags))
891f4676 17826 ((org-at-table.el-p)
ed21c5c8 17827 (message "Use C-c ' to edit table.el tables"))
891f4676 17828 ((org-at-table-p)
9acdaa21
CD
17829 (org-table-maybe-eval-formula)
17830 (if arg
4b3a9ba7 17831 (call-interactively 'org-table-recalculate)
c8d16429 17832 (org-table-maybe-recalculate-line))
acedf35c
CD
17833 (call-interactively 'org-table-align)
17834 (orgtbl-send-table 'maybe))
0bd48b37
CD
17835 ((or (org-footnote-at-reference-p)
17836 (org-footnote-at-definition-p))
17837 (call-interactively 'org-footnote-action))
4b3a9ba7 17838 ((org-at-item-checkbox-p)
3ab2c837
BG
17839 ;; Cursor at a checkbox: repair list and update checkboxes. Send
17840 ;; list only if at top item.
17841 (let* ((cbox (match-string 1))
17842 (struct (org-list-struct))
17843 (old-struct (copy-tree struct))
17844 (parents (org-list-parents-alist struct))
17845 (prevs (org-list-prevs-alist struct))
17846 (orderedp (org-entry-get nil "ORDERED"))
17847 (firstp (= (org-list-get-top-point struct) (point-at-bol)))
17848 block-item)
17849 ;; Use a light version of `org-toggle-checkbox' to avoid
17850 ;; computing list structure twice.
17851 (org-list-set-checkbox (point-at-bol) struct
17852 (cond
17853 ((equal arg '(16)) "[-]")
17854 ((equal arg '(4)) nil)
17855 ((equal "[X]" cbox) "[ ]")
17856 (t "[X]")))
17857 (org-list-struct-fix-ind struct parents)
17858 (org-list-struct-fix-bul struct prevs)
17859 (setq block-item
17860 (org-list-struct-fix-box struct parents prevs orderedp))
17861 (when block-item
17862 (message
17863 "Checkboxes were removed due to unchecked box at line %d"
17864 (org-current-line block-item)))
17865 (org-list-struct-apply-struct struct old-struct)
17866 (org-update-checkbox-count-maybe)
17867 (when firstp (org-list-send-list 'maybe))))
7a368970 17868 ((org-at-item-p)
3ab2c837
BG
17869 ;; Cursor at an item: repair list. Do checkbox related actions
17870 ;; only if function was called with an argument. Send list only
17871 ;; if at top item.
17872 (let* ((struct (org-list-struct))
17873 (old-struct (copy-tree struct))
17874 (parents (org-list-parents-alist struct))
17875 (prevs (org-list-prevs-alist struct))
17876 (firstp (= (org-list-get-top-point struct) (point-at-bol))))
17877 (org-list-struct-fix-ind struct parents)
17878 (org-list-struct-fix-bul struct prevs)
17879 (when arg
17880 (org-list-set-checkbox (point-at-bol) struct "[ ]")
17881 (org-list-struct-fix-box struct parents prevs))
17882 (org-list-struct-apply-struct struct old-struct)
17883 (when arg (org-update-checkbox-count-maybe))
17884 (when firstp (org-list-send-list 'maybe))))
8d642074 17885 ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re))
15841868
JW
17886 ;; Dynamic block
17887 (beginning-of-line 1)
621f83e4 17888 (save-excursion (org-update-dblock)))
c8d0cf5c
CD
17889 ((save-excursion
17890 (beginning-of-line 1)
17891 (looking-at "[ \t]*#\\+\\([A-Z]+\\)"))
9acdaa21
CD
17892 (cond
17893 ((equal (match-string 1) "TBLFM")
c8d16429
CD
17894 ;; Recalculate the table before this line
17895 (save-excursion
17896 (beginning-of-line 1)
17897 (skip-chars-backward " \r\n\t")
4b3a9ba7 17898 (if (org-at-table-p)
8d642074 17899 (org-call-with-arg 'org-table-recalculate (or arg t)))))
9acdaa21 17900 (t
ed21c5c8
CD
17901 (let ((org-inhibit-startup-visibility-stuff t)
17902 (org-startup-align-all-tables nil))
17903 (org-save-outline-visibility 'use-markers (org-mode-restart)))
b349f79f 17904 (message "Local setup has been refreshed"))))
c8d0cf5c 17905 ((org-clock-update-time-maybe))
3ab2c837
BG
17906 (t
17907 (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
17908 (error "C-c C-c can do nothing useful at this location"))))))
891f4676 17909
28e5b051
CD
17910(defun org-mode-restart ()
17911 "Restart Org-mode, to scan again for special lines.
17912Also updates the keyword regular expressions."
17913 (interactive)
b349f79f
CD
17914 (org-mode)
17915 (message "Org-mode restarted"))
28e5b051 17916
03f3cf35 17917(defun org-kill-note-or-show-branches ()
a0d892d4 17918 "If this is a Note buffer, abort storing the note. Else call `show-branches'."
03f3cf35
JW
17919 (interactive)
17920 (if (not org-finish-function)
86fbb8ca
CD
17921 (progn
17922 (hide-subtree)
17923 (call-interactively 'show-branches))
03f3cf35
JW
17924 (let ((org-note-abort t))
17925 (funcall org-finish-function))))
17926
8c6fb58b 17927(defun org-return (&optional indent)
28e5b051
CD
17928 "Goto next table row or insert a newline.
17929Calls `org-table-next-row' or `newline', depending on context.
17930See the individual commands for more information."
634a7d0b 17931 (interactive)
891f4676 17932 (cond
8c6fb58b 17933 ((bobp) (if indent (newline-and-indent) (newline)))
c8d0cf5c
CD
17934 ((org-at-table-p)
17935 (org-table-justify-field-maybe)
17936 (call-interactively 'org-table-next-row))
3ab2c837
BG
17937 ;; when `newline-and-indent' is called within a list, make sure
17938 ;; text moved stays inside the item.
17939 ((and (org-in-item-p) indent)
17940 (if (and (org-at-item-p) (>= (point) (match-end 0)))
17941 (progn
17942 (newline)
17943 (org-indent-line-to (length (match-string 0))))
17944 (let ((ind (org-get-indentation)))
17945 (newline)
17946 (if (org-looking-back org-list-end-re)
17947 (org-indent-line-function)
17948 (org-indent-line-to ind)))))
c8d0cf5c
CD
17949 ((and org-return-follows-link
17950 (eq (get-text-property (point) 'face) 'org-link))
17951 (call-interactively 'org-open-at-point))
2a57416f
CD
17952 ((and (org-at-heading-p)
17953 (looking-at
afe98dfa 17954 (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")))
2a57416f
CD
17955 (org-show-entry)
17956 (end-of-line 1)
17957 (newline))
8c6fb58b 17958 (t (if indent (newline-and-indent) (newline)))))
891f4676 17959
8c6fb58b 17960(defun org-return-indent ()
8c6fb58b
CD
17961 "Goto next table row or insert a newline and indent.
17962Calls `org-table-next-row' or `newline-and-indent', depending on
17963context. See the individual commands for more information."
2a57416f 17964 (interactive)
8c6fb58b 17965 (org-return t))
03f3cf35 17966
2a57416f
CD
17967(defun org-ctrl-c-star ()
17968 "Compute table, or change heading status of lines.
0bd48b37
CD
17969Calls `org-table-recalculate' or `org-toggle-heading',
17970depending on context."
2a57416f
CD
17971 (interactive)
17972 (cond
17973 ((org-at-table-p)
17974 (call-interactively 'org-table-recalculate))
0bd48b37 17975 (t
2a57416f 17976 ;; Convert all lines in region to list items
0bd48b37 17977 (call-interactively 'org-toggle-heading))))
2a57416f 17978
38f8646b 17979(defun org-ctrl-c-minus ()
2a57416f
CD
17980 "Insert separator line in table or modify bullet status of line.
17981Also turns a plain line or a region of lines into list items.
0bd48b37 17982Calls `org-table-insert-hline', `org-toggle-item', or
2a57416f 17983`org-cycle-list-bullet', depending on context."
38f8646b
CD
17984 (interactive)
17985 (cond
17986 ((org-at-table-p)
17987 (call-interactively 'org-table-insert-hline))
2a57416f 17988 ((org-region-active-p)
0bd48b37 17989 (call-interactively 'org-toggle-item))
38f8646b
CD
17990 ((org-in-item-p)
17991 (call-interactively 'org-cycle-list-bullet))
0bd48b37
CD
17992 (t
17993 (call-interactively 'org-toggle-item))))
17994
3ab2c837 17995(defun org-toggle-item (arg)
0bd48b37
CD
17996 "Convert headings or normal lines to items, items to normal lines.
17997If there is no active region, only the current line is considered.
17998
3ab2c837
BG
17999If the first non blank line in the region is an headline, convert
18000all headlines to items, shifting text accordingly.
0bd48b37 18001
3ab2c837 18002If it is an item, convert all items to normal lines.
0bd48b37 18003
3ab2c837
BG
18004If it is normal text, change region into an item. With a prefix
18005argument ARG, change each line in region into an item."
18006 (interactive "P")
18007 (let ((shift-text
18008 (function
18009 ;; Shift text in current section to IND, from point to END.
18010 ;; The function leaves point to END line.
18011 (lambda (ind end)
18012 (let ((min-i 1000) (end (copy-marker end)))
18013 ;; First determine the minimum indentation (MIN-I) of
18014 ;; the text.
18015 (save-excursion
18016 (catch 'exit
18017 (while (< (point) end)
18018 (let ((i (org-get-indentation)))
18019 (cond
18020 ;; Skip blank lines and inline tasks.
18021 ((looking-at "^[ \t]*$"))
18022 ((looking-at org-outline-regexp-bol))
18023 ;; We can't find less than 0 indentation.
18024 ((zerop i) (throw 'exit (setq min-i 0)))
18025 ((< i min-i) (setq min-i i))))
18026 (forward-line))))
18027 ;; Then indent each line so that a line indented to
18028 ;; MIN-I becomes indented to IND. Ignore blank lines
18029 ;; and inline tasks in the process.
18030 (let ((delta (- ind min-i)))
18031 (while (< (point) end)
18032 (unless (or (looking-at "^[ \t]*$")
18033 (looking-at org-outline-regexp-bol))
18034 (org-indent-line-to (+ (org-get-indentation) delta)))
18035 (forward-line)))))))
18036 (skip-blanks
18037 (function
18038 ;; Return beginning of first non-blank line, starting from
18039 ;; line at POS.
18040 (lambda (pos)
18041 (save-excursion
18042 (goto-char pos)
18043 (skip-chars-forward " \r\t\n")
18044 (point-at-bol)))))
18045 beg end)
18046 ;; Determine boundaries of changes.
0bd48b37 18047 (if (org-region-active-p)
3ab2c837
BG
18048 (setq beg (funcall skip-blanks (region-beginning))
18049 end (copy-marker (region-end)))
18050 (setq beg (funcall skip-blanks (point-at-bol))
18051 end (copy-marker (point-at-eol))))
18052 ;; Depending on the starting line, choose an action on the text
18053 ;; between BEG and END.
18054 (org-with-limited-levels
18055 (save-excursion
18056 (goto-char beg)
18057 (cond
18058 ;; Case 1. Start at an item: de-itemize. Note that it only
18059 ;; happens when a region is active: `org-ctrl-c-minus'
18060 ;; would call `org-cycle-list-bullet' otherwise.
18061 ((org-at-item-p)
18062 (while (< (point) end)
18063 (when (org-at-item-p)
18064 (skip-chars-forward " \t")
18065 (delete-region (point) (match-end 0)))
18066 (forward-line)))
18067 ;; Case 2. Start at an heading: convert to items.
18068 ((org-on-heading-p)
18069 (let* ((bul (org-list-bullet-string "-"))
18070 (bul-len (length bul))
18071 ;; Indentation of the first heading. It should be
18072 ;; relative to the indentation of its parent, if any.
18073 (start-ind (save-excursion
18074 (cond
18075 ((not org-adapt-indentation) 0)
18076 ((not (outline-previous-heading)) 0)
18077 (t (length (match-string 0))))))
18078 ;; Level of first heading. Further headings will be
18079 ;; compared to it to determine hierarchy in the list.
18080 (ref-level (org-reduced-level (org-outline-level))))
18081 (while (< (point) end)
18082 (let* ((level (org-reduced-level (org-outline-level)))
18083 (delta (max 0 (- level ref-level))))
18084 ;; If current headline is less indented than the first
18085 ;; one, set it as reference, in order to preserve
18086 ;; subtrees.
18087 (when (< level ref-level) (setq ref-level level))
18088 (replace-match bul t t)
18089 (org-indent-line-to (+ start-ind (* delta bul-len)))
18090 ;; Ensure all text down to END (or SECTION-END) belongs
18091 ;; to the newly created item.
18092 (let ((section-end (save-excursion
18093 (or (outline-next-heading) (point)))))
18094 (forward-line)
18095 (funcall shift-text
18096 (+ start-ind (* (1+ delta) bul-len))
18097 (min end section-end)))))))
18098 ;; Case 3. Normal line with ARG: turn each non-item line into
18099 ;; an item.
18100 (arg
18101 (while (< (point) end)
18102 (unless (or (org-on-heading-p) (org-at-item-p))
18103 (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
18104 (replace-match
18105 (concat "\\1" (org-list-bullet-string "-") "\\2"))))
18106 (forward-line)))
18107 ;; Case 4. Normal line without ARG: make the first line of
18108 ;; region an item, and shift indentation of others
18109 ;; lines to set them as item's body.
18110 (t (let* ((bul (org-list-bullet-string "-"))
18111 (bul-len (length bul))
18112 (ref-ind (org-get-indentation)))
18113 (skip-chars-forward " \t")
18114 (insert bul)
18115 (forward-line)
18116 (while (< (point) end)
18117 ;; Ensure that lines less indented than first one
18118 ;; still get included in item body.
18119 (funcall shift-text
18120 (+ ref-ind bul-len)
18121 (min end (save-excursion (or (outline-next-heading)
18122 (point)))))
18123 (forward-line)))))))))
0bd48b37
CD
18124
18125(defun org-toggle-heading (&optional nstars)
18126 "Convert headings to normal text, or items or text to headings.
18127If there is no active region, only the current line is considered.
18128
3ab2c837
BG
18129If the first non blank line is an headline, remove the stars from
18130all headlines in the region.
0bd48b37 18131
3ab2c837 18132If it is a plain list item, turn all plain list items into headings.
0bd48b37 18133
3ab2c837
BG
18134If it is a normal line, turn each and every normal line (i.e. not
18135an heading or an item) in the region into a heading.
0bd48b37
CD
18136
18137When converting a line into a heading, the number of stars is chosen
c8d0cf5c
CD
18138such that the lines become children of the current entry. However,
18139when a prefix argument is given, its value determines the number of
18140stars to add."
0bd48b37 18141 (interactive "P")
3ab2c837
BG
18142 (let ((skip-blanks
18143 (function
18144 ;; Return beginning of first non-blank line, starting from
18145 ;; line at POS.
18146 (lambda (pos)
18147 (save-excursion
18148 (goto-char pos)
18149 (skip-chars-forward " \r\t\n")
18150 (point-at-bol)))))
18151 beg end)
18152 ;; Determine boundaries of changes. If region ends at a bol, do
18153 ;; not consider the last line to be in the region.
0bd48b37 18154 (if (org-region-active-p)
3ab2c837
BG
18155 (setq beg (funcall skip-blanks (region-beginning))
18156 end (copy-marker (save-excursion
18157 (goto-char (region-end))
18158 (if (bolp) (point) (point-at-eol)))))
18159 (setq beg (funcall skip-blanks (point-at-bol))
18160 end (copy-marker (point-at-eol))))
18161 ;; Ensure inline tasks don't count as headings.
18162 (org-with-limited-levels
18163 (save-excursion
18164 (goto-char beg)
18165 (cond
18166 ;; Case 1. Started at an heading: de-star headings.
18167 ((org-on-heading-p)
18168 (while (< (point) end)
18169 (when (org-on-heading-p t)
18170 (looking-at org-outline-regexp) (replace-match ""))
18171 (forward-line)))
18172 ;; Case 2. Started at an item: change items into headlines.
18173 ;; One star will be added by `org-list-to-subtree'.
18174 ((org-at-item-p)
18175 (let* ((stars (make-string
18176 (if nstars
18177 ;; subtract the star that will be added again by
18178 ;; `org-list-to-subtree'
18179 (1- (prefix-numeric-value current-prefix-arg))
18180 (or (org-current-level) 0))
18181 ?*))
18182 (add-stars
18183 (cond (nstars "") ; stars from prefix only
18184 ((equal stars "") "") ; before first heading
18185 (org-odd-levels-only "*") ; inside heading, odd
18186 (t "")))) ; inside heading, oddeven
18187 (while (< (point) end)
18188 (when (org-at-item-p)
18189 ;; Pay attention to cases when region ends before list.
18190 (let* ((struct (org-list-struct))
18191 (list-end (min (org-list-get-bottom-point struct) (1+ end))))
18192 (save-restriction
18193 (narrow-to-region (point) list-end)
18194 (insert
18195 (org-list-to-subtree
18196 (org-list-parse-list t)
18197 '(:istart (concat stars add-stars (funcall get-stars depth))
18198 :icount (concat stars add-stars (funcall get-stars depth))))))))
18199 (forward-line))))
18200 ;; Case 3. Started at normal text: make every line an heading,
18201 ;; skipping headlines and items.
18202 (t (let* ((stars (make-string
18203 (if nstars
18204 (prefix-numeric-value current-prefix-arg)
18205 (or (org-current-level) 0))
18206 ?*))
18207 (add-stars
18208 (cond (nstars "") ; stars from prefix only
18209 ((equal stars "") "*") ; before first heading
18210 (org-odd-levels-only "**") ; inside heading, odd
18211 (t "*"))) ; inside heading, oddeven
18212 (rpl (concat stars add-stars " ")))
18213 (while (< (point) end)
18214 (when (and (not (org-on-heading-p)) (not (org-at-item-p))
18215 (looking-at "\\([ \t]*\\)\\(\\S-\\)"))
18216 (replace-match (concat rpl (match-string 2))))
18217 (forward-line)))))))))
5bf7807a 18218
791d856f 18219(defun org-meta-return (&optional arg)
28e5b051
CD
18220 "Insert a new heading or wrap a region in a table.
18221Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
18222See the individual commands for more information."
791d856f
CD
18223 (interactive "P")
18224 (cond
c8d0cf5c 18225 ((run-hook-with-args-until-success 'org-metareturn-hook))
791d856f 18226 ((org-at-table-p)
4b3a9ba7
CD
18227 (call-interactively 'org-table-wrap-region))
18228 (t (call-interactively 'org-insert-heading))))
891f4676
RS
18229
18230;;; Menu entries
18231
891f4676 18232;; Define the Org-mode menus
9acdaa21
CD
18233(easy-menu-define org-tbl-menu org-mode-map "Tbl menu"
18234 '("Tbl"
20908596 18235 ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)]
9acdaa21
CD
18236 ["Next Field" org-cycle (org-at-table-p)]
18237 ["Previous Field" org-shifttab (org-at-table-p)]
18238 ["Next Row" org-return (org-at-table-p)]
18239 "--"
18240 ["Blank Field" org-table-blank-field (org-at-table-p)]
ab27a4a0 18241 ["Edit Field" org-table-edit-field (org-at-table-p)]
9acdaa21
CD
18242 ["Copy Field from Above" org-table-copy-down (org-at-table-p)]
18243 "--"
18244 ("Column"
18245 ["Move Column Left" org-metaleft (org-at-table-p)]
18246 ["Move Column Right" org-metaright (org-at-table-p)]
18247 ["Delete Column" org-shiftmetaleft (org-at-table-p)]
d3f4dbe8 18248 ["Insert Column" org-shiftmetaright (org-at-table-p)])
9acdaa21
CD
18249 ("Row"
18250 ["Move Row Up" org-metaup (org-at-table-p)]
18251 ["Move Row Down" org-metadown (org-at-table-p)]
18252 ["Delete Row" org-shiftmetaup (org-at-table-p)]
18253 ["Insert Row" org-shiftmetadown (org-at-table-p)]
e0e66b8e 18254 ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
9acdaa21 18255 "--"
38f8646b 18256 ["Insert Hline" org-ctrl-c-minus (org-at-table-p)])
9acdaa21
CD
18257 ("Rectangle"
18258 ["Copy Rectangle" org-copy-special (org-at-table-p)]
18259 ["Cut Rectangle" org-cut-special (org-at-table-p)]
18260 ["Paste Rectangle" org-paste-special (org-at-table-p)]
18261 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
18262 "--"
18263 ("Calculate"
c4f9780e 18264 ["Set Column Formula" org-table-eval-formula (org-at-table-p)]
d3f4dbe8 18265 ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
b349f79f 18266 ["Edit Formulas" org-edit-special (org-at-table-p)]
c4f9780e 18267 "--"
9acdaa21
CD
18268 ["Recalculate line" org-table-recalculate (org-at-table-p)]
18269 ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"]
d3f4dbe8
CD
18270 ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"]
18271 "--"
9acdaa21 18272 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)]
c4f9780e 18273 "--"
64f72ae1 18274 ["Sum Column/Rectangle" org-table-sum
9acdaa21
CD
18275 (or (org-at-table-p) (org-region-active-p))]
18276 ["Which Column?" org-table-current-column (org-at-table-p)])
18277 ["Debug Formulas"
d3f4dbe8 18278 org-table-toggle-formula-debugger
20908596 18279 :style toggle :selected (org-bound-and-true-p org-table-formula-debug)]
d3f4dbe8
CD
18280 ["Show Col/Row Numbers"
18281 org-table-toggle-coordinate-overlays
20908596
CD
18282 :style toggle
18283 :selected (org-bound-and-true-p org-table-overlay-coordinates)]
9acdaa21 18284 "--"
9acdaa21 18285 ["Create" org-table-create (and (not (org-at-table-p))
c8d16429 18286 org-enable-table-editor)]
ab27a4a0 18287 ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))]
9acdaa21
CD
18288 ["Import from File" org-table-import (not (org-at-table-p))]
18289 ["Export to File" org-table-export (org-at-table-p)]
18290 "--"
18291 ["Create/Convert from/to table.el" org-table-create-with-table.el t]))
18292
891f4676
RS
18293(easy-menu-define org-org-menu org-mode-map "Org menu"
18294 '("Org"
3278a016 18295 ("Show/Hide"
20908596
CD
18296 ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))]
18297 ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
18298 ["Sparse Tree..." org-sparse-tree t]
3278a016 18299 ["Reveal Context" org-reveal t]
d3f4dbe8
CD
18300 ["Show All" show-all t]
18301 "--"
18302 ["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
891f4676
RS
18303 "--"
18304 ["New Heading" org-insert-heading t]
18305 ("Navigate Headings"
18306 ["Up" outline-up-heading t]
18307 ["Next" outline-next-visible-heading t]
18308 ["Previous" outline-previous-visible-heading t]
18309 ["Next Same Level" outline-forward-same-level t]
18310 ["Previous Same Level" outline-backward-same-level t]
18311 "--"
374585c9 18312 ["Jump" org-goto t])
891f4676 18313 ("Edit Structure"
35fb9989
CD
18314 ["Move Subtree Up" org-shiftmetaup (not (org-at-table-p))]
18315 ["Move Subtree Down" org-shiftmetadown (not (org-at-table-p))]
891f4676
RS
18316 "--"
18317 ["Copy Subtree" org-copy-special (not (org-at-table-p))]
18318 ["Cut Subtree" org-cut-special (not (org-at-table-p))]
18319 ["Paste Subtree" org-paste-special (not (org-at-table-p))]
18320 "--"
c8d0cf5c
CD
18321 ["Clone subtree, shift time" org-clone-subtree-with-time-shift t]
18322 "--"
3ab2c837
BG
18323 ["Copy visible text" org-copy-visible t]
18324 "--"
891f4676
RS
18325 ["Promote Heading" org-metaleft (not (org-at-table-p))]
18326 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))]
18327 ["Demote Heading" org-metaright (not (org-at-table-p))]
30313b90
CD
18328 ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]
18329 "--"
d3f4dbe8
CD
18330 ["Sort Region/Children" org-sort (not (org-at-table-p))]
18331 "--"
4ed31842
CD
18332 ["Convert to odd levels" org-convert-to-odd-levels t]
18333 ["Convert to odd/even levels" org-convert-to-oddeven-levels t])
a3fbe8c4 18334 ("Editing"
b349f79f 18335 ["Emphasis..." org-emphasize t]
0bd48b37
CD
18336 ["Edit Source Example" org-edit-special t]
18337 "--"
18338 ["Footnote new/jump" org-footnote-action t]
18339 ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"])
6769c0dc 18340 ("Archive"
8bfe682a 18341 ["Archive (default method)" org-archive-subtree-default t]
6769c0dc 18342 "--"
8bfe682a
CD
18343 ["Move Subtree to Archive file" org-advertized-archive-subtree t]
18344 ["Toggle ARCHIVE tag" org-toggle-archive-tag t]
18345 ["Move subtree to Archive sibling" org-archive-to-archive-sibling t]
d3f4dbe8 18346 )
891f4676 18347 "--"
c8d0cf5c
CD
18348 ("Hyperlinks"
18349 ["Store Link (Global)" org-store-link t]
18350 ["Find existing link to here" org-occur-link-in-agenda-files t]
18351 ["Insert Link" org-insert-link t]
18352 ["Follow Link" org-open-at-point t]
18353 "--"
18354 ["Next link" org-next-link t]
18355 ["Previous link" org-previous-link t]
18356 "--"
18357 ["Descriptive Links"
86fbb8ca 18358 (progn (add-to-invisibility-spec '(org-link)) (org-restart-font-lock))
c8d0cf5c
CD
18359 :style radio
18360 :selected (member '(org-link) buffer-invisibility-spec)]
18361 ["Literal Links"
18362 (progn
18363 (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock))
18364 :style radio
18365 :selected (not (member '(org-link) buffer-invisibility-spec))])
18366 "--"
35fb9989 18367 ("TODO Lists"
891f4676 18368 ["TODO/DONE/-" org-todo t]
5137195a
CD
18369 ("Select keyword"
18370 ["Next keyword" org-shiftright (org-on-heading-p)]
18371 ["Previous keyword" org-shiftleft (org-on-heading-p)]
acedf35c 18372 ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))]
a3fbe8c4
CD
18373 ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]
18374 ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))])
86fbb8ca
CD
18375 ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
18376 ["Global TODO list" org-todo-list :active t :keys "C-c a t"]
891f4676 18377 "--"
a2a2e7fb
CD
18378 ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies)
18379 :selected org-enforce-todo-dependencies :style toggle :active t]
18380 "Settings for tree at point"
18381 ["Do Children sequentially" org-toggle-ordered-property :style radio
3ab2c837 18382 :selected (org-entry-get nil "ORDERED")
a2a2e7fb
CD
18383 :active org-enforce-todo-dependencies :keys "C-c C-x o"]
18384 ["Do Children parallel" org-toggle-ordered-property :style radio
3ab2c837 18385 :selected (not (org-entry-get nil "ORDERED"))
a2a2e7fb
CD
18386 :active org-enforce-todo-dependencies :keys "C-c C-x o"]
18387 "--"
35fb9989
CD
18388 ["Set Priority" org-priority t]
18389 ["Priority Up" org-shiftup t]
c8d0cf5c
CD
18390 ["Priority Down" org-shiftdown t]
18391 "--"
18392 ["Get news from all feeds" org-feed-update-all t]
18393 ["Go to the inbox of a feed..." org-feed-goto-inbox t]
18394 ["Customize feeds" (customize-variable 'org-feed-alist) t])
38f8646b 18395 ("TAGS and Properties"
579d2d62 18396 ["Set Tags" org-set-tags-command t]
fd8d5da9 18397 ["Change tag in region" org-change-tag-in-region (org-region-active-p)]
03f3cf35 18398 "--"
fd8d5da9 18399 ["Set property" org-set-property t]
03f3cf35
JW
18400 ["Column view of properties" org-columns t]
18401 ["Insert Column View DBlock" org-insert-columns-dblock t])
891f4676
RS
18402 ("Dates and Scheduling"
18403 ["Timestamp" org-time-stamp t]
28e5b051 18404 ["Timestamp (inactive)" org-time-stamp-inactive t]
891f4676 18405 ("Change Date"
3278a016
CD
18406 ["1 Day Later" org-shiftright t]
18407 ["1 Day Earlier" org-shiftleft t]
35fb9989
CD
18408 ["1 ... Later" org-shiftup t]
18409 ["1 ... Earlier" org-shiftdown t])
891f4676
RS
18410 ["Compute Time Range" org-evaluate-time-range t]
18411 ["Schedule Item" org-schedule t]
18412 ["Deadline" org-deadline t]
18413 "--"
3278a016
CD
18414 ["Custom time format" org-toggle-time-stamp-overlays
18415 :style radio :selected org-display-custom-times]
18416 "--"
891f4676 18417 ["Goto Calendar" org-goto-calendar t]
ff4be292
CD
18418 ["Date from Calendar" org-date-from-calendar t]
18419 "--"
0bd48b37
CD
18420 ["Start/Restart Timer" org-timer-start t]
18421 ["Pause/Continue Timer" org-timer-pause-or-continue t]
18422 ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"]
18423 ["Insert Timer String" org-timer t]
18424 ["Insert Timer Item" org-timer-item t])
edd21304 18425 ("Logging work"
c8d0cf5c
CD
18426 ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"]
18427 ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]
edd21304
CD
18428 ["Clock out" org-clock-out t]
18429 ["Clock cancel" org-clock-cancel t]
c8d0cf5c
CD
18430 "--"
18431 ["Mark as default task" org-clock-mark-default-task t]
18432 ["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 18433 ["Goto running clock" org-clock-goto t]
c8d0cf5c 18434 "--"
edd21304 18435 ["Display times" org-clock-display t]
0fee8d6e 18436 ["Create clock table" org-clock-report t]
edd21304
CD
18437 "--"
18438 ["Record DONE time"
18439 (progn (setq org-log-done (not org-log-done))
18440 (message "Switching to %s will %s record a timestamp"
a3fbe8c4 18441 (car org-done-keywords)
edd21304
CD
18442 (if org-log-done "automatically" "not")))
18443 :style toggle :selected org-log-done])
891f4676 18444 "--"
3278a016 18445 ["Agenda Command..." org-agenda t]
8c6fb58b 18446 ["Set Restriction Lock" org-agenda-set-restriction-lock t]
d924f2e5
CD
18447 ("File List for Agenda")
18448 ("Special views current file"
4da1a99d
CD
18449 ["TODO Tree" org-show-todo-tree t]
18450 ["Check Deadlines" org-check-deadlines t]
18451 ["Timeline" org-timeline t]
c8d0cf5c 18452 ["Tags/Property tree" org-match-sparse-tree t])
891f4676 18453 "--"
3278a016 18454 ["Export/Publish..." org-export t]
6769c0dc 18455 ("LaTeX"
c44f0d75 18456 ["Org CDLaTeX mode" org-cdlatex-mode :style toggle
6769c0dc
CD
18457 :selected org-cdlatex-mode]
18458 ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
18459 ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
18460 ["Modify math symbol" org-cdlatex-math-modify
18461 (org-inside-LaTeX-fragment-p)]
c8d0cf5c
CD
18462 ["Insert citation" org-reftex-citation t]
18463 "--"
86fbb8ca 18464 ["Template for BEAMER" org-insert-beamer-options-template t])
891f4676 18465 "--"
8d642074
CD
18466 ("MobileOrg"
18467 ["Push Files and Views" org-mobile-push t]
18468 ["Get Captured and Flagged" org-mobile-pull t]
18469 ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
18470 "--"
18471 ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
18472 "--"
891f4676
RS
18473 ("Documentation"
18474 ["Show Version" org-version t]
18475 ["Info Documentation" org-info t])
18476 ("Customize"
18477 ["Browse Org Group" org-customize t]
18478 "--"
ab27a4a0 18479 ["Expand This Menu" org-create-customize-menu
891f4676 18480 (fboundp 'customize-menu-create)])
54a0dee5 18481 ["Send bug report" org-submit-bug-report t]
28e5b051 18482 "--"
c8d0cf5c
CD
18483 ("Refresh/Reload"
18484 ["Refresh setup current buffer" org-mode-restart t]
18485 ["Reload Org (after update)" org-reload t]
18486 ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x r"])
891f4676
RS
18487 ))
18488
891f4676
RS
18489(defun org-info (&optional node)
18490 "Read documentation for Org-mode in the info system.
18491With optional NODE, go directly to that node."
18492 (interactive)
74c52de1 18493 (info (format "(org)%s" (or node ""))))
891f4676 18494
54a0dee5
CD
18495;;;###autoload
18496(defun org-submit-bug-report ()
18497 "Submit a bug report on Org-mode via mail.
18498
18499Don't hesitate to report any problems or inaccurate documentation.
18500
18501If you don't have setup sending mail from (X)Emacs, please copy the
18502output buffer into your mail program, as it gives us important
18503information about your Org-mode version and configuration."
18504 (interactive)
18505 (require 'reporter)
18506 (org-load-modules-maybe)
18507 (org-require-autoloaded-modules)
18508 (let ((reporter-prompt-for-summary-p "Bug report subject: "))
18509 (reporter-submit-bug-report
18510 "emacs-orgmode@gnu.org"
18511 (org-version)
18512 (let (list)
18513 (save-window-excursion
c3313451 18514 (switch-to-buffer (get-buffer-create "*Warn about privacy*"))
54a0dee5
CD
18515 (delete-other-windows)
18516 (erase-buffer)
18517 (insert "You are about to submit a bug report to the Org-mode mailing list.
18518
18519We would like to add your full Org-mode and Outline configuration to the
18520bug report. This greatly simplifies the work of the maintainer and
18521other experts on the mailing list.
18522
18523HOWEVER, some variables you have customized may contain private
18524information. The names of customers, colleagues, or friends, might
18525appear in the form of file names, tags, todo states, or search strings.
18526If you answer yes to the prompt, you might want to check and remove
18527such private information before sending the email.")
18528 (add-text-properties (point-min) (point-max) '(face org-warning))
18529 (when (yes-or-no-p "Include your Org-mode configuration ")
18530 (mapatoms
18531 (lambda (v)
18532 (and (boundp v)
18533 (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v))
18534 (or (and (symbol-value v)
18535 (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v)))
18536 (and
18537 (get v 'custom-type) (get v 'standard-value)
18538 (not (equal (symbol-value v) (eval (car (get v 'standard-value)))))))
18539 (push v list)))))
18540 (kill-buffer (get-buffer "*Warn about privacy*"))
18541 list))
18542 nil nil
18543 "Remember to cover the basics, that is, what you expected to happen and
18544what in fact did happen. You don't know how to make a good report? See
18545
18546 http://orgmode.org/manual/Feedback.html#Feedback
18547
18548Your bug report will be posted to the Org-mode mailing list.
1bcdebed
CD
18549------------------------------------------------------------------------")
18550 (save-excursion
18551 (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
18552 (replace-match "\\1Bug: \\3 [\\2]")))))
db4a7382 18553
54a0dee5 18554
891f4676 18555(defun org-install-agenda-files-menu ()
ab27a4a0
CD
18556 (let ((bl (buffer-list)))
18557 (save-excursion
18558 (while bl
18559 (set-buffer (pop bl))
b928f99a
CD
18560 (if (org-mode-p) (setq bl nil)))
18561 (when (org-mode-p)
ab27a4a0
CD
18562 (easy-menu-change
18563 '("Org") "File List for Agenda"
18564 (append
18565 (list
18566 ["Edit File List" (org-edit-agenda-file-list) t]
18567 ["Add/Move Current File to Front of List" org-agenda-file-to-front t]
18568 ["Remove Current File from List" org-remove-file t]
18569 ["Cycle through agenda files" org-cycle-agenda-files t]
15841868 18570 ["Occur in all agenda files" org-occur-in-agenda-files t]
ab27a4a0
CD
18571 "--")
18572 (mapcar 'org-file-menu-entry (org-agenda-files t))))))))
891f4676 18573
d3f4dbe8 18574;;;; Documentation
891f4676 18575
b349f79f 18576;;;###autoload
20908596
CD
18577(defun org-require-autoloaded-modules ()
18578 (interactive)
18579 (mapc 'require
c8d0cf5c
CD
18580 '(org-agenda org-archive org-ascii org-attach org-clock org-colview
18581 org-docbook org-exp org-html org-icalendar
18582 org-id org-latex
18583 org-publish org-remember org-table
18584 org-timer org-xoxo)))
18585
18586;;;###autoload
18587(defun org-reload (&optional uncompiled)
18588 "Reload all org lisp files.
18589With prefix arg UNCOMPILED, load the uncompiled versions."
18590 (interactive "P")
18591 (require 'find-func)
18592 (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)")
18593 (dir-org (file-name-directory (org-find-library-name "org")))
18594 (dir-org-contrib (ignore-errors
18595 (file-name-directory
18596 (org-find-library-name "org-contribdir"))))
86fbb8ca
CD
18597 (babel-files
18598 (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el"))
18599 (append (list nil "comint" "eval" "exp" "keys"
18600 "lob" "ref" "table" "tangle")
18601 (delq nil
18602 (mapcar
18603 (lambda (lang)
18604 (when (cdr lang) (symbol-name (car lang))))
18605 org-babel-load-languages)))))
c8d0cf5c
CD
18606 (files
18607 (append (directory-files dir-org t file-re)
86fbb8ca 18608 babel-files
c8d0cf5c
CD
18609 (and dir-org-contrib
18610 (directory-files dir-org-contrib t file-re))))
18611 (remove-re (concat (if (featurep 'xemacs)
18612 "org-colview" "org-colview-xemacs")
18613 "\\'")))
18614 (setq files (mapcar 'file-name-sans-extension files))
18615 (setq files (mapcar
18616 (lambda (x) (if (string-match remove-re x) nil x))
18617 files))
18618 (setq files (delq nil files))
18619 (mapc
18620 (lambda (f)
18621 (when (featurep (intern (file-name-nondirectory f)))
18622 (if (and (not uncompiled)
18623 (file-exists-p (concat f ".elc")))
18624 (load (concat f ".elc") nil nil t)
18625 (load (concat f ".el") nil nil t))))
18626 files))
18627 (org-version))
20908596 18628
b349f79f 18629;;;###autoload
891f4676 18630(defun org-customize ()
c8d16429 18631 "Call the customize function with org as argument."
891f4676 18632 (interactive)
20908596
CD
18633 (org-load-modules-maybe)
18634 (org-require-autoloaded-modules)
891f4676
RS
18635 (customize-browse 'org))
18636
18637(defun org-create-customize-menu ()
18638 "Create a full customization menu for Org-mode, insert it into the menu."
18639 (interactive)
20908596
CD
18640 (org-load-modules-maybe)
18641 (org-require-autoloaded-modules)
891f4676
RS
18642 (if (fboundp 'customize-menu-create)
18643 (progn
18644 (easy-menu-change
18645 '("Org") "Customize"
18646 `(["Browse Org group" org-customize t]
18647 "--"
18648 ,(customize-menu-create 'org)
18649 ["Set" Custom-set t]
18650 ["Save" Custom-save t]
18651 ["Reset to Current" Custom-reset-current t]
18652 ["Reset to Saved" Custom-reset-saved t]
18653 ["Reset to Standard Settings" Custom-reset-standard t]))
18654 (message "\"Org\"-menu now contains full customization menu"))
18655 (error "Cannot expand menu (outdated version of cus-edit.el)")))
18656
d3f4dbe8
CD
18657;;;; Miscellaneous stuff
18658
d3f4dbe8 18659;;; Generally useful functions
891f4676 18660
8d642074
CD
18661(defun org-get-at-bol (property)
18662 "Get text property PROPERTY at beginning of line."
18663 (get-text-property (point-at-bol) property))
18664
db55f368
CD
18665(defun org-find-text-property-in-string (prop s)
18666 "Return the first non-nil value of property PROP in string S."
18667 (or (get-text-property 0 prop s)
18668 (get-text-property (or (next-single-property-change 0 prop s) 0)
18669 prop s)))
18670
b349f79f
CD
18671(defun org-display-warning (message) ;; Copied from Emacs-Muse
18672 "Display the given MESSAGE as a warning."
18673 (if (fboundp 'display-warning)
18674 (display-warning 'org message
86fbb8ca 18675 (if (featurep 'xemacs) 'warning :warning))
b349f79f
CD
18676 (let ((buf (get-buffer-create "*Org warnings*")))
18677 (with-current-buffer buf
18678 (goto-char (point-max))
18679 (insert "Warning (Org): " message)
18680 (unless (bolp)
18681 (newline)))
18682 (display-buffer buf)
18683 (sit-for 0))))
18684
3ab2c837
BG
18685(defun org-eval (form)
18686 "Eval FORM and return result."
18687 (condition-case error
18688 (eval form)
18689 (error (format "%%![Error: %s]" error))))
18690
54a0dee5
CD
18691(defun org-in-commented-line ()
18692 "Is point in a line starting with `#'?"
18693 (equal (char-after (point-at-bol)) ?#))
18694
86fbb8ca
CD
18695(defun org-in-indented-comment-line ()
18696 "Is point in a line starting with `#' after some white space?"
18697 (save-excursion
18698 (save-match-data
18699 (goto-char (point-at-bol))
18700 (looking-at "[ \t]*#"))))
18701
8bfe682a
CD
18702(defun org-in-verbatim-emphasis ()
18703 (save-match-data
18704 (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~")))))
18705
b349f79f 18706(defun org-goto-marker-or-bmk (marker &optional bookmark)
621f83e4 18707 "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
b349f79f
CD
18708 (if (and marker (marker-buffer marker)
18709 (buffer-live-p (marker-buffer marker)))
18710 (progn
c3313451 18711 (switch-to-buffer (marker-buffer marker))
b349f79f
CD
18712 (if (or (> marker (point-max)) (< marker (point-min)))
18713 (widen))
0bd48b37
CD
18714 (goto-char marker)
18715 (org-show-context 'org-goto))
b349f79f
CD
18716 (if bookmark
18717 (bookmark-jump bookmark)
18718 (error "Cannot find location"))))
18719
18720(defun org-quote-csv-field (s)
18721 "Quote field for inclusion in CSV material."
18722 (if (string-match "[\",]" s)
18723 (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
18724 s))
18725
20908596
CD
18726(defun org-force-self-insert (N)
18727 "Needed to enforce self-insert under remapping."
18728 (interactive "p")
18729 (self-insert-command N))
18730
18731(defun org-string-width (s)
18732 "Compute width of string, ignoring invisible characters.
18733This ignores character with invisibility property `org-link', and also
18734characters with property `org-cwidth', because these will become invisible
18735upon the next fontification round."
18736 (let (b l)
18737 (when (or (eq t buffer-invisibility-spec)
18738 (assq 'org-link buffer-invisibility-spec))
18739 (while (setq b (text-property-any 0 (length s)
18740 'invisible 'org-link s))
18741 (setq s (concat (substring s 0 b)
18742 (substring s (or (next-single-property-change
18743 b 'invisible s) (length s)))))))
18744 (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
18745 (setq s (concat (substring s 0 b)
18746 (substring s (or (next-single-property-change
18747 b 'org-cwidth s) (length s))))))
18748 (setq l (string-width s) b -1)
18749 (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
18750 (setq l (- l (get-text-property b 'org-dwidth-n s))))
18751 l))
18752
acedf35c
CD
18753(defun org-shorten-string (s maxlength)
18754 "Shorten string S so tht it is no longer than MAXLENGTH characters.
18755If the string is shorter or has length MAXLENGTH, just return the
18756original string. If it is longer, the functions finds a space in the
18757string, breaks this string off at that locations and adds three dots
18758as ellipsis. Including the ellipsis, the string will not be longer
18759than MAXLENGTH. If finding a good breaking point in the string does
18760not work, the string is just chopped off in the middle of a word
18761if necessary."
18762 (if (<= (length s) maxlength)
18763 s
18764 (let* ((n (max (- maxlength 4) 1))
18765 (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)")))
18766 (if (string-match re s)
18767 (concat (match-string 1 s) "...")
18768 (concat (substring s 0 (max (- maxlength 3) 0)) "...")))))
18769
621f83e4
CD
18770(defun org-get-indentation (&optional line)
18771 "Get the indentation of the current line, interpreting tabs.
18772When LINE is given, assume it represents a line and compute its indentation."
18773 (if line
18774 (if (string-match "^ *" (org-remove-tabs line))
18775 (match-end 0))
18776 (save-excursion
18777 (beginning-of-line 1)
18778 (skip-chars-forward " \t")
18779 (current-column))))
18780
3ab2c837
BG
18781(defun org-get-string-indentation (s)
18782 "What indentation has S due to SPACE and TAB at the beginning of the string?"
18783 (let ((n -1) (i 0) (w tab-width) c)
18784 (catch 'exit
18785 (while (< (setq n (1+ n)) (length s))
18786 (setq c (aref s n))
18787 (cond ((= c ?\ ) (setq i (1+ i)))
18788 ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
18789 (t (throw 'exit t)))))
18790 i))
18791
621f83e4
CD
18792(defun org-remove-tabs (s &optional width)
18793 "Replace tabulators in S with spaces.
18794Assumes that s is a single line, starting in column 0."
18795 (setq width (or width tab-width))
18796 (while (string-match "\t" s)
18797 (setq s (replace-match
18798 (make-string
18799 (- (* width (/ (+ (match-beginning 0) width) width))
18800 (match-beginning 0)) ?\ )
18801 t t s)))
18802 s)
18803
18804(defun org-fix-indentation (line ind)
18805 "Fix indentation in LINE.
18806IND is a cons cell with target and minimum indentation.
33306645 18807If the current indentation in LINE is smaller than the minimum,
621f83e4
CD
18808leave it alone. If it is larger than ind, set it to the target."
18809 (let* ((l (org-remove-tabs line))
18810 (i (org-get-indentation l))
18811 (i1 (car ind)) (i2 (cdr ind)))
18812 (if (>= i i2) (setq l (substring line i2)))
18813 (if (> i1 0)
18814 (concat (make-string i1 ?\ ) l)
18815 l)))
18816
c8d0cf5c
CD
18817(defun org-remove-indentation (code &optional n)
18818 "Remove the maximum common indentation from the lines in CODE.
18819N may optionally be the number of spaces to remove."
18820 (with-temp-buffer
18821 (insert code)
18822 (org-do-remove-indentation n)
18823 (buffer-string)))
18824
18825(defun org-do-remove-indentation (&optional n)
18826 "Remove the maximum common indentation from the buffer."
18827 (untabify (point-min) (point-max))
18828 (let ((min 10000) re)
18829 (if n
18830 (setq min n)
18831 (goto-char (point-min))
18832 (while (re-search-forward "^ *[^ \n]" nil t)
18833 (setq min (min min (1- (- (match-end 0) (match-beginning 0)))))))
18834 (unless (or (= min 0) (= min 10000))
18835 (setq re (format "^ \\{%d\\}" min))
18836 (goto-char (point-min))
18837 (while (re-search-forward re nil t)
18838 (replace-match "")
18839 (end-of-line 1))
18840 min)))
18841
8bfe682a
CD
18842(defun org-fill-template (template alist)
18843 "Find each %key of ALIST in TEMPLATE and replace it."
ed21c5c8
CD
18844 (let ((case-fold-search nil)
18845 entry key value)
8bfe682a
CD
18846 (setq alist (sort (copy-sequence alist)
18847 (lambda (a b) (< (length (car a)) (length (car b))))))
18848 (while (setq entry (pop alist))
18849 (setq template
18850 (replace-regexp-in-string
18851 (concat "%" (regexp-quote (car entry)))
18852 (cdr entry) template t t)))
18853 template))
18854
b349f79f
CD
18855(defun org-base-buffer (buffer)
18856 "Return the base buffer of BUFFER, if it has one. Else return the buffer."
18857 (if (not buffer)
18858 buffer
18859 (or (buffer-base-buffer buffer)
18860 buffer)))
20908596
CD
18861
18862(defun org-trim (s)
18863 "Remove whitespace at beginning and end of string."
18864 (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s)))
18865 (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s)))
18866 s)
18867
18868(defun org-wrap (string &optional width lines)
18869 "Wrap string to either a number of lines, or a width in characters.
18870If WIDTH is non-nil, the string is wrapped to that width, however many lines
18871that costs. If there is a word longer than WIDTH, the text is actually
18872wrapped to the length of that word.
18873IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
18874many lines, whatever width that takes.
18875The return value is a list of lines, without newlines at the end."
18876 (let* ((words (org-split-string string "[ \t\n]+"))
18877 (maxword (apply 'max (mapcar 'org-string-width words)))
18878 w ll)
18879 (cond (width
18880 (org-do-wrap words (max maxword width)))
18881 (lines
18882 (setq w maxword)
18883 (setq ll (org-do-wrap words maxword))
18884 (if (<= (length ll) lines)
18885 ll
18886 (setq ll words)
18887 (while (> (length ll) lines)
18888 (setq w (1+ w))
18889 (setq ll (org-do-wrap words w)))
18890 ll))
18891 (t (error "Cannot wrap this")))))
18892
18893(defun org-do-wrap (words width)
18894 "Create lines of maximum width WIDTH (in characters) from word list WORDS."
18895 (let (lines line)
18896 (while words
18897 (setq line (pop words))
18898 (while (and words (< (+ (length line) (length (car words))) width))
18899 (setq line (concat line " " (pop words))))
18900 (setq lines (push line lines)))
18901 (nreverse lines)))
18902
18903(defun org-split-string (string &optional separators)
18904 "Splits STRING into substrings at SEPARATORS.
18905No empty strings are returned if there are matches at the beginning
18906and end of string."
18907 (let ((rexp (or separators "[ \f\t\n\r\v]+"))
18908 (start 0)
18909 notfirst
18910 (list nil))
18911 (while (and (string-match rexp string
18912 (if (and notfirst
18913 (= start (match-beginning 0))
18914 (< start (length string)))
18915 (1+ start) start))
18916 (< (match-beginning 0) (length string)))
18917 (setq notfirst t)
18918 (or (eq (match-beginning 0) 0)
18919 (and (eq (match-beginning 0) (match-end 0))
18920 (eq (match-beginning 0) start))
18921 (setq list
18922 (cons (substring string start (match-beginning 0))
18923 list)))
18924 (setq start (match-end 0)))
18925 (or (eq start (length string))
18926 (setq list
18927 (cons (substring string start)
18928 list)))
18929 (nreverse list)))
18930
c8d0cf5c
CD
18931(defun org-quote-vert (s)
18932 "Replace \"|\" with \"\\vert\"."
18933 (while (string-match "|" s)
18934 (setq s (replace-match "\\vert" t t s)))
18935 s)
18936
18937(defun org-uuidgen-p (s)
18938 "Is S an ID created by UUIDGEN?"
18939 (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s)))
18940
c4b5acde
CD
18941(defun org-context ()
18942 "Return a list of contexts of the current cursor position.
18943If several contexts apply, all are returned.
18944Each context entry is a list with a symbol naming the context, and
18945two positions indicating start and end of the context. Possible
18946contexts are:
18947
18948:headline anywhere in a headline
18949:headline-stars on the leading stars in a headline
18950:todo-keyword on a TODO keyword (including DONE) in a headline
18951:tags on the TAGS in a headline
18952:priority on the priority cookie in a headline
18953:item on the first line of a plain list item
e39856be 18954:item-bullet on the bullet/number of a plain list item
c4b5acde
CD
18955:checkbox on the checkbox in a plain list item
18956:table in an org-mode table
18957:table-special on a special filed in a table
18958:table-table in a table.el table
d3f4dbe8 18959:link on a hyperlink
c4b5acde
CD
18960:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE,COMMENT, QUOTE.
18961:target on a <<target>>
18962:radio-target on a <<<radio-target>>>
e39856be 18963:latex-fragment on a LaTeX fragment
333f9019 18964:latex-preview on a LaTeX fragment with overlaid preview image
c4b5acde
CD
18965
18966This function expects the position to be visible because it uses font-lock
18967faces as a help to recognize the following contexts: :table-special, :link,
18968and :keyword."
18969 (let* ((f (get-text-property (point) 'face))
18970 (faces (if (listp f) f (list f)))
e39856be 18971 (p (point)) clist o)
c4b5acde
CD
18972 ;; First the large context
18973 (cond
a3fbe8c4 18974 ((org-on-heading-p t)
c4b5acde
CD
18975 (push (list :headline (point-at-bol) (point-at-eol)) clist)
18976 (when (progn
18977 (beginning-of-line 1)
18978 (looking-at org-todo-line-tags-regexp))
18979 (push (org-point-in-group p 1 :headline-stars) clist)
18980 (push (org-point-in-group p 2 :todo-keyword) clist)
18981 (push (org-point-in-group p 4 :tags) clist))
18982 (goto-char p)
8bfe682a 18983 (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
a3fbe8c4 18984 (if (looking-at "\\[#[A-Z0-9]\\]")
c4b5acde
CD
18985 (push (org-point-in-group p 0 :priority) clist)))
18986
18987 ((org-at-item-p)
e39856be 18988 (push (org-point-in-group p 2 :item-bullet) clist)
c4b5acde
CD
18989 (push (list :item (point-at-bol)
18990 (save-excursion (org-end-of-item) (point)))
18991 clist)
18992 (and (org-at-item-checkbox-p)
18993 (push (org-point-in-group p 0 :checkbox) clist)))
18994
18995 ((org-at-table-p)
18996 (push (list :table (org-table-begin) (org-table-end)) clist)
18997 (if (memq 'org-formula faces)
18998 (push (list :table-special
18999 (previous-single-property-change p 'face)
19000 (next-single-property-change p 'face)) clist)))
19001 ((org-at-table-p 'any)
19002 (push (list :table-table) clist)))
19003 (goto-char p)
19004
19005 ;; Now the small context
19006 (cond
19007 ((org-at-timestamp-p)
19008 (push (org-point-in-group p 0 :timestamp) clist))
19009 ((memq 'org-link faces)
19010 (push (list :link
19011 (previous-single-property-change p 'face)
19012 (next-single-property-change p 'face)) clist))
19013 ((memq 'org-special-keyword faces)
19014 (push (list :keyword
19015 (previous-single-property-change p 'face)
19016 (next-single-property-change p 'face)) clist))
19017 ((org-on-target-p)
19018 (push (org-point-in-group p 0 :target) clist)
19019 (goto-char (1- (match-beginning 0)))
19020 (if (looking-at org-radio-target-regexp)
19021 (push (org-point-in-group p 0 :radio-target) clist))
e39856be
CD
19022 (goto-char p))
19023 ((setq o (car (delq nil
c44f0d75 19024 (mapcar
e39856be
CD
19025 (lambda (x)
19026 (if (memq x org-latex-fragment-image-overlays) x))
86fbb8ca 19027 (overlays-at (point))))))
c44f0d75 19028 (push (list :latex-fragment
86fbb8ca 19029 (overlay-start o) (overlay-end o)) clist)
c44f0d75 19030 (push (list :latex-preview
86fbb8ca 19031 (overlay-start o) (overlay-end o)) clist))
e39856be 19032 ((org-inside-LaTeX-fragment-p)
3278a016 19033 ;; FIXME: positions wrong.
e39856be 19034 (push (list :latex-fragment (point) (point)) clist)))
c4b5acde
CD
19035
19036 (setq clist (nreverse (delq nil clist)))
19037 clist))
19038
15841868 19039;; FIXME: Compare with at-regexp-p Do we need both?
d3f4dbe8
CD
19040(defun org-in-regexp (re &optional nlines visually)
19041 "Check if point is inside a match of regexp.
19042Normally only the current line is checked, but you can include NLINES extra
19043lines both before and after point into the search.
19044If VISUALLY is set, require that the cursor is not after the match but
19045really on, so that the block visually is on the match."
19046 (catch 'exit
19047 (let ((pos (point))
19048 (eol (point-at-eol (+ 1 (or nlines 0))))
19049 (inc (if visually 1 0)))
19050 (save-excursion
19051 (beginning-of-line (- 1 (or nlines 0)))
19052 (while (re-search-forward re eol t)
a3fbe8c4 19053 (if (and (<= (match-beginning 0) pos)
d3f4dbe8
CD
19054 (>= (+ inc (match-end 0)) pos))
19055 (throw 'exit (cons (match-beginning 0) (match-end 0)))))))))
19056
a3fbe8c4
CD
19057(defun org-at-regexp-p (regexp)
19058 "Is point inside a match of REGEXP in the current line?"
19059 (catch 'exit
19060 (save-excursion
19061 (let ((pos (point)) (end (point-at-eol)))
19062 (beginning-of-line 1)
19063 (while (re-search-forward regexp end t)
19064 (if (and (<= (match-beginning 0) pos)
19065 (>= (match-end 0) pos))
19066 (throw 'exit t)))
19067 nil))))
19068
afe98dfa 19069(defun org-in-regexps-block-p (start-re end-re &optional bound)
86fbb8ca 19070 "Return t if the current point is between matches of START-RE and END-RE.
afe98dfa 19071This will also return t if point is on one of the two matches or
3ab2c837 19072in an unfinished block. END-RE can be a string or a form
afe98dfa
CD
19073returning a string.
19074
3ab2c837
BG
19075An optional third argument bounds the search for START-RE. It
19076defaults to previous heading or `point-min'."
afe98dfa
CD
19077 (let ((pos (point))
19078 (limit (or bound (save-excursion (outline-previous-heading)))))
ed21c5c8 19079 (save-excursion
afe98dfa
CD
19080 ;; we're on a block when point is on start-re...
19081 (or (org-at-regexp-p start-re)
19082 ;; ... or start-re can be found above...
19083 (and (re-search-backward start-re limit t)
19084 ;; ... but no end-re between start-re and point.
19085 (not (re-search-forward (eval end-re) pos t)))))))
ed21c5c8 19086
3ab2c837
BG
19087(defun org-in-block-p (names)
19088 "Is point inside any block whose name belongs to NAMES?
19089
19090NAMES is a list of strings containing names of blocks."
19091 (save-match-data
19092 (catch 'exit
19093 (let ((case-fold-search t))
19094 (mapc (lambda (name)
19095 (let ((n (regexp-quote name)))
19096 (when (org-in-regexps-block-p
19097 (concat "^[ \t]*#\\+begin_" n)
19098 (concat "^[ \t]*#\\+end_" n))
19099 (throw 'exit t))))
19100 names))
19101 nil)))
19102
03f3cf35 19103(defun org-occur-in-agenda-files (regexp &optional nlines)
15841868 19104 "Call `multi-occur' with buffers for all agenda files."
03f3cf35
JW
19105 (interactive "sOrg-files matching: \np")
19106 (let* ((files (org-agenda-files))
19107 (tnames (mapcar 'file-truename files))
2a57416f 19108 (extra org-agenda-text-search-extra-files)
03f3cf35 19109 f)
20908596
CD
19110 (when (eq (car extra) 'agenda-archives)
19111 (setq extra (cdr extra))
19112 (setq files (org-add-archive-files files)))
03f3cf35
JW
19113 (while (setq f (pop extra))
19114 (unless (member (file-truename f) tnames)
19115 (add-to-list 'files f 'append)
19116 (add-to-list 'tnames (file-truename f) 'append)))
19117 (multi-occur
5dec9555
CD
19118 (mapcar (lambda (x)
19119 (with-current-buffer
19120 (or (get-file-buffer x) (find-file-noselect x))
19121 (widen)
19122 (current-buffer)))
19123 files)
03f3cf35 19124 regexp)))
15841868 19125
2a57416f
CD
19126(if (boundp 'occur-mode-find-occurrence-hook)
19127 ;; Emacs 23
19128 (add-hook 'occur-mode-find-occurrence-hook
19129 (lambda ()
19130 (when (org-mode-p)
19131 (org-reveal))))
19132 ;; Emacs 22
19133 (defadvice occur-mode-goto-occurrence
19134 (after org-occur-reveal activate)
19135 (and (org-mode-p) (org-reveal)))
19136 (defadvice occur-mode-goto-occurrence-other-window
19137 (after org-occur-reveal activate)
19138 (and (org-mode-p) (org-reveal)))
19139 (defadvice occur-mode-display-occurrence
19140 (after org-occur-reveal activate)
19141 (when (org-mode-p)
19142 (let ((pos (occur-mode-find-occurrence)))
19143 (with-current-buffer (marker-buffer pos)
19144 (save-excursion
19145 (goto-char pos)
19146 (org-reveal)))))))
19147
c8d0cf5c
CD
19148(defun org-occur-link-in-agenda-files ()
19149 "Create a link and search for it in the agendas.
19150The link is not stored in `org-stored-links', it is just created
19151for the search purpose."
19152 (interactive)
19153 (let ((link (condition-case nil
19154 (org-store-link nil)
19155 (error "Unable to create a link to here"))))
19156 (org-occur-in-agenda-files (regexp-quote link))))
19157
a3fbe8c4
CD
19158(defun org-uniquify (list)
19159 "Remove duplicate elements from LIST."
19160 (let (res)
19161 (mapc (lambda (x) (add-to-list 'res x 'append)) list)
19162 res))
19163
19164(defun org-delete-all (elts list)
19165 "Remove all elements in ELTS from LIST."
19166 (while elts
19167 (setq list (delete (pop elts) list)))
19168 list)
19169
86fbb8ca
CD
19170(defun org-count (cl-item cl-seq)
19171 "Count the number of occurrences of ITEM in SEQ.
19172Taken from `count' in cl-seq.el with all keyword arguments removed."
19173 (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x)
19174 (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
19175 (while (< cl-start cl-end)
19176 (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
19177 (if (equal cl-item cl-x) (setq cl-count (1+ cl-count)))
19178 (setq cl-start (1+ cl-start)))
19179 cl-count))
19180
19181(defun org-remove-if (predicate seq)
19182 "Remove everything from SEQ that fulfills PREDICATE."
19183 (let (res e)
19184 (while seq
19185 (setq e (pop seq))
19186 (if (not (funcall predicate e)) (push e res)))
19187 (nreverse res)))
19188
19189(defun org-remove-if-not (predicate seq)
19190 "Remove everything from SEQ that does not fulfill PREDICATE."
19191 (let (res e)
19192 (while seq
19193 (setq e (pop seq))
19194 (if (funcall predicate e) (push e res)))
19195 (nreverse res)))
19196
8c6fb58b 19197(defun org-back-over-empty-lines ()
33306645 19198 "Move backwards over whitespace, to the beginning of the first empty line.
5bf7807a 19199Returns the number of empty lines passed."
8c6fb58b 19200 (let ((pos (point)))
3ab2c837
BG
19201 (if (cdr (assoc 'heading org-blank-before-new-entry))
19202 (skip-chars-backward " \t\n\r")
19203 (forward-line -1))
8c6fb58b
CD
19204 (beginning-of-line 2)
19205 (goto-char (min (point) pos))
19206 (count-lines (point) pos)))
19207
19208(defun org-skip-whitespace ()
19209 (skip-chars-forward " \t\n\r"))
19210
c4b5acde
CD
19211(defun org-point-in-group (point group &optional context)
19212 "Check if POINT is in match-group GROUP.
19213If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the
86fbb8ca 19214match. If the match group does not exist or point is not inside it,
c4b5acde
CD
19215return nil."
19216 (and (match-beginning group)
19217 (>= point (match-beginning group))
19218 (<= point (match-end group))
19219 (if context
19220 (list context (match-beginning group) (match-end group))
19221 t)))
19222
374585c9
CD
19223(defun org-switch-to-buffer-other-window (&rest args)
19224 "Switch to buffer in a second window on the current frame.
86fbb8ca
CD
19225In particular, do not allow pop-up frames.
19226Returns the newly created buffer."
374585c9
CD
19227 (let (pop-up-frames special-display-buffer-names special-display-regexps
19228 special-display-function)
19229 (apply 'switch-to-buffer-other-window args)))
19230
d3f4dbe8
CD
19231(defun org-combine-plists (&rest plists)
19232 "Create a single property list from all plists in PLISTS.
19233The process starts by copying the first list, and then setting properties
19234from the other lists. Settings in the last list are the most significant
19235ones and overrule settings in the other lists."
19236 (let ((rtn (copy-sequence (pop plists)))
19237 p v ls)
19238 (while plists
19239 (setq ls (pop plists))
19240 (while ls
19241 (setq p (pop ls) v (pop ls))
19242 (setq rtn (plist-put rtn p v))))
19243 rtn))
19244
891f4676 19245(defun org-move-line-down (arg)
634a7d0b 19246 "Move the current line down. With prefix argument, move it past ARG lines."
891f4676
RS
19247 (interactive "p")
19248 (let ((col (current-column))
19249 beg end pos)
19250 (beginning-of-line 1) (setq beg (point))
19251 (beginning-of-line 2) (setq end (point))
19252 (beginning-of-line (+ 1 arg))
19253 (setq pos (move-marker (make-marker) (point)))
19254 (insert (delete-and-extract-region beg end))
19255 (goto-char pos)
20908596 19256 (org-move-to-column col)))
891f4676
RS
19257
19258(defun org-move-line-up (arg)
634a7d0b 19259 "Move the current line up. With prefix argument, move it past ARG lines."
891f4676
RS
19260 (interactive "p")
19261 (let ((col (current-column))
19262 beg end pos)
19263 (beginning-of-line 1) (setq beg (point))
19264 (beginning-of-line 2) (setq end (point))
634a7d0b 19265 (beginning-of-line (- arg))
891f4676
RS
19266 (setq pos (move-marker (make-marker) (point)))
19267 (insert (delete-and-extract-region beg end))
19268 (goto-char pos)
20908596 19269 (org-move-to-column col)))
891f4676 19270
d3f4dbe8
CD
19271(defun org-replace-escapes (string table)
19272 "Replace %-escapes in STRING with values in TABLE.
15841868 19273TABLE is an association list with keys like \"%a\" and string values.
d3f4dbe8
CD
19274The sequences in STRING may contain normal field width and padding information,
19275for example \"%-5s\". Replacements happen in the sequence given by TABLE,
19276so values can contain further %-escapes if they are define later in TABLE."
86fbb8ca
CD
19277 (let ((tbl (copy-alist table))
19278 (case-fold-search nil)
19279 (pchg 0)
19280 e re rpl)
19281 (while (setq e (pop tbl))
d3f4dbe8 19282 (setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
86fbb8ca
CD
19283 (when (and (cdr e) (string-match re (cdr e)))
19284 (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0)))
19285 (safe "SREF"))
19286 (add-text-properties 0 3 (list 'sref sref) safe)
19287 (setcdr e (replace-match safe t t (cdr e)))))
d3f4dbe8 19288 (while (string-match re string)
86fbb8ca
CD
19289 (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s")
19290 (cdr e)))
19291 (setq string (replace-match rpl t t string))))
19292 (while (setq pchg (next-property-change pchg string))
19293 (let ((sref (get-text-property pchg 'sref string)))
19294 (when (and sref (string-match "SREF" string pchg))
19295 (setq string (replace-match sref t t string)))))
d3f4dbe8
CD
19296 string))
19297
d3f4dbe8
CD
19298(defun org-sublist (list start end)
19299 "Return a section of LIST, from START to END.
19300Counting starts at 1."
19301 (let (rtn (c start))
19302 (setq list (nthcdr (1- start) list))
19303 (while (and list (<= c end))
19304 (push (pop list) rtn)
19305 (setq c (1+ c)))
19306 (nreverse rtn)))
19307
d3f4dbe8 19308(defun org-find-base-buffer-visiting (file)
c8d0cf5c 19309 "Like `find-buffer-visiting' but always return the base buffer and
5bf7807a 19310not an indirect buffer."
c8d0cf5c
CD
19311 (let ((buf (or (get-file-buffer file)
19312 (find-buffer-visiting file))))
15841868
JW
19313 (if buf
19314 (or (buffer-base-buffer buf) buf)
19315 nil)))
d3f4dbe8 19316
0bd48b37
CD
19317(defun org-image-file-name-regexp (&optional extensions)
19318 "Return regexp matching the file names of images.
19319If EXTENSIONS is given, only match these."
19320 (if (and (not extensions) (fboundp 'image-file-name-regexp))
a3fbe8c4
CD
19321 (image-file-name-regexp)
19322 (let ((image-file-name-extensions
0bd48b37
CD
19323 (or extensions
19324 '("png" "jpeg" "jpg" "gif" "tiff" "tif"
19325 "xbm" "xpm" "pbm" "pgm" "ppm"))))
a3fbe8c4
CD
19326 (concat "\\."
19327 (regexp-opt (nconc (mapcar 'upcase
19328 image-file-name-extensions)
19329 image-file-name-extensions)
19330 t)
19331 "\\'"))))
19332
0bd48b37 19333(defun org-file-image-p (file &optional extensions)
a3fbe8c4
CD
19334 "Return non-nil if FILE is an image."
19335 (save-match-data
0bd48b37 19336 (string-match (org-image-file-name-regexp extensions) file)))
a3fbe8c4 19337
b349f79f
CD
19338(defun org-get-cursor-date ()
19339 "Return the date at cursor in as a time.
19340This works in the calendar and in the agenda, anywhere else it just
19341returns the current time."
19342 (let (date day defd)
19343 (cond
19344 ((eq major-mode 'calendar-mode)
19345 (setq date (calendar-cursor-to-date)
19346 defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
19347 ((eq major-mode 'org-agenda-mode)
19348 (setq day (get-text-property (point) 'day))
19349 (if day
19350 (setq date (calendar-gregorian-from-absolute day)
19351 defd (encode-time 0 0 0 (nth 1 date) (nth 0 date)
19352 (nth 2 date))))))
19353 (or defd (current-time))))
19354
19355(defvar org-agenda-action-marker (make-marker)
19356 "Marker pointing to the entry for the next agenda action.")
19357
19358(defun org-mark-entry-for-agenda-action ()
19359 "Mark the current entry as target of an agenda action.
19360Agenda actions are actions executed from the agenda with the key `k',
19361which make use of the date at the cursor."
19362 (interactive)
19363 (move-marker org-agenda-action-marker
19364 (save-excursion (org-back-to-heading t) (point))
19365 (current-buffer))
19366 (message
19367 "Entry marked for action; press `k' at desired date in agenda or calendar"))
19368
acedf35c
CD
19369(defun org-mark-subtree ()
19370 "Mark the current subtree.
19371This puts point at the start of the current subtree, and mark at the end.
19372
19373If point is in an inline task, mark that task instead."
19374 (interactive)
19375 (let ((inline-task-p
19376 (and (featurep 'org-inlinetask)
19377 (org-inlinetask-in-task-p)))
19378 (beg))
19379 ;; Get beginning of subtree
19380 (cond
19381 (inline-task-p (org-inlinetask-goto-beginning))
19382 ((org-at-heading-p) (beginning-of-line))
3ab2c837 19383 (t (org-with-limited-levels (outline-previous-visible-heading 1))))
acedf35c
CD
19384 (setq beg (point))
19385 ;; Get end of it
19386 (if inline-task-p
19387 (org-inlinetask-goto-end)
19388 (org-end-of-subtree))
19389 ;; Mark zone
19390 (push-mark (point) nil t)
19391 (goto-char beg)))
19392
d3f4dbe8 19393;;; Paragraph filling stuff.
e0e66b8e 19394;; We want this to be just right, so use the full arsenal.
a3fbe8c4
CD
19395
19396(defun org-indent-line-function ()
acedf35c 19397 "Indent line depending on context."
a3fbe8c4 19398 (interactive)
b38c6895
CD
19399 (let* ((pos (point))
19400 (itemp (org-at-item-p))
c8d0cf5c
CD
19401 (case-fold-search t)
19402 (org-drawer-regexp (or org-drawer-regexp "\000"))
afe98dfa
CD
19403 (inline-task-p (and (featurep 'org-inlinetask)
19404 (org-inlinetask-in-task-p)))
3ab2c837
BG
19405 (inline-re (and inline-task-p
19406 (org-inlinetask-outline-regexp)))
19407 column)
b38c6895
CD
19408 (beginning-of-line 1)
19409 (cond
afe98dfa 19410 ;; Comments
acedf35c 19411 ((looking-at "# ") (setq column 0))
afe98dfa 19412 ;; Headings
3ab2c837
BG
19413 ((looking-at org-outline-regexp) (setq column 0))
19414 ;; Included files
19415 ((looking-at "#\\+include:") (setq column 0))
19416 ;; Footnote definition
19417 ((looking-at org-footnote-definition-re) (setq column 0))
acedf35c
CD
19418 ;; Literal examples
19419 ((looking-at "[ \t]*:[ \t]")
19420 (setq column (org-get-indentation))) ; do nothing
3ab2c837
BG
19421 ;; Lists
19422 ((ignore-errors (goto-char (org-in-item-p)))
19423 (setq column (if itemp
19424 (org-get-indentation)
19425 (org-list-item-body-column (point))))
19426 (goto-char pos))
afe98dfa 19427 ;; Drawers
c8d0cf5c
CD
19428 ((and (looking-at "[ \t]*:END:")
19429 (save-excursion (re-search-backward org-drawer-regexp nil t)))
19430 (save-excursion
19431 (goto-char (1- (match-beginning 1)))
19432 (setq column (current-column))))
afe98dfa
CD
19433 ;; Special blocks
19434 ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
c8d0cf5c
CD
19435 (save-excursion
19436 (re-search-backward
19437 (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
19438 (setq column (org-get-indentation (match-string 0))))
afe98dfa
CD
19439 ((and (not (looking-at "[ \t]*#\\+begin_"))
19440 (org-in-regexps-block-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
19441 (save-excursion
19442 (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
19443 (setq column
19444 (if (equal (downcase (match-string 1)) "src")
19445 ;; src blocks: let `org-edit-src-exit' handle them
19446 (org-get-indentation)
19447 (org-get-indentation (match-string 0)))))
acedf35c
CD
19448 ;; This line has nothing special, look at the previous relevant
19449 ;; line to compute indentation
b38c6895
CD
19450 (t
19451 (beginning-of-line 0)
afe98dfa 19452 (while (and (not (bobp))
acedf35c 19453 (not (looking-at org-drawer-regexp))
3ab2c837
BG
19454 ;; When point started in an inline task, do not move
19455 ;; above task starting line.
19456 (not (and inline-task-p (looking-at inline-re)))
19457 ;; Skip drawers, blocks, empty lines, verbatim,
19458 ;; comments, tables, footnotes definitions, lists,
19459 ;; inline tasks.
acedf35c
CD
19460 (or (and (looking-at "[ \t]*:END:")
19461 (re-search-backward org-drawer-regexp nil t))
19462 (and (looking-at "[ \t]*#\\+end_")
19463 (re-search-backward "[ \t]*#\\+begin_"nil t))
19464 (looking-at "[ \t]*[\n:#|]")
3ab2c837
BG
19465 (looking-at org-footnote-definition-re)
19466 (and (ignore-errors (goto-char (org-in-item-p)))
19467 (goto-char
19468 (org-list-get-top-point (org-list-struct))))
afe98dfa
CD
19469 (and (not inline-task-p)
19470 (featurep 'org-inlinetask)
acedf35c
CD
19471 (org-inlinetask-in-task-p)
19472 (or (org-inlinetask-goto-beginning) t))))
afe98dfa 19473 (beginning-of-line 0))
b38c6895 19474 (cond
afe98dfa 19475 ;; There was an heading above.
b38c6895 19476 ((looking-at "\\*+[ \t]+")
b349f79f
CD
19477 (if (not org-adapt-indentation)
19478 (setq column 0)
19479 (goto-char (match-end 0))
19480 (setq column (current-column))))
acedf35c 19481 ;; A drawer had started and is unfinished
c8d0cf5c 19482 ((looking-at org-drawer-regexp)
afe98dfa
CD
19483 (goto-char (1- (match-beginning 1)))
19484 (setq column (current-column)))
afe98dfa 19485 ;; Else, nothing noticeable found: get indentation and go on.
b38c6895 19486 (t (setq column (org-get-indentation))))))
acedf35c 19487 ;; Now apply indentation and move cursor accordingly
b38c6895 19488 (goto-char pos)
a3fbe8c4 19489 (if (<= (current-column) (current-indentation))
20908596
CD
19490 (org-indent-line-to column)
19491 (save-excursion (org-indent-line-to column)))
acedf35c 19492 ;; Special polishing for properties, see `org-property-format'
38f8646b
CD
19493 (setq column (current-column))
19494 (beginning-of-line 1)
19495 (if (looking-at
8c6fb58b 19496 "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
8bfe682a
CD
19497 (replace-match (concat (match-string 1)
19498 (format org-property-format
19499 (match-string 2) (match-string 3)))
19500 t t))
20908596 19501 (org-move-to-column column)))
e0e66b8e 19502
ed21c5c8
CD
19503(defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp
19504 "Variable to store copy of `adaptive-fill-regexp'.
19505Since `adaptive-fill-regexp' is set to never match, we need to
19506store a backup of its value before entering `org-mode' so that
19507the functionality can be provided as a fall-back.")
19508
e0e66b8e
CD
19509(defun org-set-autofill-regexps ()
19510 (interactive)
19511 ;; In the paragraph separator we include headlines, because filling
19512 ;; text in a line directly attached to a headline would otherwise
19513 ;; fill the headline as well.
5137195a 19514 (org-set-local 'comment-start-skip "^#+[ \t]*")
8d642074 19515 (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|#]")
e0e66b8e 19516 ;; The paragraph starter includes hand-formatted lists.
c8d0cf5c
CD
19517 (org-set-local
19518 'paragraph-start
19519 (concat
19520 "\f" "\\|"
19521 "[ ]*$" "\\|"
3ab2c837 19522 org-outline-regexp "\\|"
8d642074 19523 "[ \t]*#" "\\|"
3ab2c837 19524 (org-item-re) "\\|"
c8d0cf5c
CD
19525 "[ \t]*[:|]" "\\|"
19526 "\\$\\$" "\\|"
19527 "\\\\\\(begin\\|end\\|[][]\\)"))
e0e66b8e
CD
19528 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
19529 ;; But only if the user has not turned off tables or fixed-width regions
5137195a
CD
19530 (org-set-local
19531 'auto-fill-inhibit-regexp
3ab2c837
BG
19532 (concat org-outline-regexp
19533 "\\|#\\+"
5137195a
CD
19534 "\\|[ \t]*" org-keyword-time-regexp
19535 (if (or org-enable-table-editor org-enable-fixed-width-editor)
19536 (concat
19537 "\\|[ \t]*["
19538 (if org-enable-table-editor "|" "")
19539 (if org-enable-fixed-width-editor ":" "")
19540 "]"))))
e0e66b8e
CD
19541 ;; We use our own fill-paragraph function, to make sure that tables
19542 ;; and fixed-width regions are not wrapped. That function will pass
19543 ;; through to `fill-paragraph' when appropriate.
5137195a 19544 (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
3ab2c837
BG
19545 ;; Prevent auto-fill from inserting unwanted new items.
19546 (org-set-local 'fill-nobreak-predicate
19547 (if (memq 'org-fill-item-nobreak-p fill-nobreak-predicate)
19548 fill-nobreak-predicate
19549 (cons 'org-fill-item-nobreak-p fill-nobreak-predicate)))
ed21c5c8 19550 ;; Adaptive filling: To get full control, first make sure that
6eff18ef 19551 ;; `adaptive-fill-regexp' never matches. Then install our own matcher.
86fbb8ca 19552 (unless (local-variable-p 'adaptive-fill-regexp (current-buffer))
ed21c5c8
CD
19553 (org-set-local 'org-adaptive-fill-regexp-backup
19554 adaptive-fill-regexp))
5137195a 19555 (org-set-local 'adaptive-fill-regexp "\000")
3ab2c837 19556 (org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
5137195a 19557 (org-set-local 'adaptive-fill-function
2a57416f
CD
19558 'org-adaptive-fill-function)
19559 (org-set-local
19560 'align-mode-rules-list
19561 '((org-in-buffer-settings
19562 (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
19563 (modes . '(org-mode))))))
e0e66b8e 19564
3ab2c837
BG
19565(defun org-fill-item-nobreak-p ()
19566 "Non-nil when a line break at point would insert a new item."
19567 (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))
19568
e0e66b8e
CD
19569(defun org-fill-paragraph (&optional justify)
19570 "Re-align a table, pass through to fill-paragraph if no table."
19571 (let ((table-p (org-at-table-p))
3ab2c837
BG
19572 (table.el-p (org-at-table.el-p))
19573 (itemp (org-in-item-p)))
8c6fb58b
CD
19574 (cond ((and (equal (char-after (point-at-bol)) ?*)
19575 (save-excursion (goto-char (point-at-bol))
3ab2c837
BG
19576 (looking-at org-outline-regexp)))
19577 t) ; skip headlines
19578 (table.el-p t) ; skip table.el tables
19579 (table-p (org-table-align) t) ; align Org tables
19580 (itemp ; align text in items
19581 (let* ((struct (save-excursion (goto-char itemp)
19582 (org-list-struct)))
19583 (parents (org-list-parents-alist struct))
19584 (children (org-list-get-children itemp struct parents))
19585 beg end prev next prefix)
19586 ;; Determine in which part of item point is: before
19587 ;; first child, after last child, between two
19588 ;; sub-lists, or simply in item if there's no child.
19589 (cond
19590 ((not children)
19591 (setq prefix (make-string (org-list-item-body-column itemp) ?\ )
19592 beg itemp
19593 end (org-list-get-item-end itemp struct)))
19594 ((< (point) (setq next (car children)))
19595 (setq prefix (make-string (org-list-item-body-column itemp) ?\ )
19596 beg itemp
19597 end next))
19598 ((> (point) (setq prev (car (last children))))
19599 (setq beg (org-list-get-item-end prev struct)
19600 end (org-list-get-item-end itemp struct)
19601 prefix (save-excursion
19602 (goto-char beg)
19603 (skip-chars-forward " \t")
19604 (make-string (current-column) ?\ ))))
19605 (t (catch 'exit
19606 (while (setq next (pop children))
19607 (if (> (point) next)
19608 (setq prev next)
19609 (setq beg (org-list-get-item-end prev struct)
19610 end next
19611 prefix (save-excursion
19612 (goto-char beg)
19613 (skip-chars-forward " \t")
19614 (make-string (current-column) ?\ )))
19615 (throw 'exit nil))))))
19616 ;; Use `fill-paragraph' with buffer narrowed to item
19617 ;; without any child, and with our computed PREFIX.
19618 (flet ((fill-context-prefix (from to &optional flr) prefix))
19619 (save-restriction
19620 (narrow-to-region beg end)
19621 (save-excursion (fill-paragraph justify)))) t))
19622 ;; Special case where point is not in a list but is on
19623 ;; a paragraph adjacent to a list: make sure this paragraph
19624 ;; doesn't get merged with the end of the list by narrowing
19625 ;; buffer first.
19626 ((save-excursion (forward-paragraph -1)
19627 (setq itemp (org-in-item-p)))
19628 (let ((struct (save-excursion (goto-char itemp)
19629 (org-list-struct))))
19630 (save-restriction
19631 (narrow-to-region (org-list-get-bottom-point struct)
19632 (save-excursion (forward-paragraph 1)
19633 (point)))
19634 (fill-paragraph justify) t)))
19635 ;; Else simply call `fill-paragraph'.
19636 (t nil))))
e0e66b8e
CD
19637
19638;; For reference, this is the default value of adaptive-fill-regexp
19639;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*"
19640
19641(defun org-adaptive-fill-function ()
3ab2c837
BG
19642 "Return a fill prefix for org-mode files."
19643 (let (itemp)
19644 (save-excursion
19645 (cond
19646 ;; Comment line
19647 ((looking-at "#[ \t]+")
19648 (match-string-no-properties 0))
19649 ;; Plain list item
19650 ((org-at-item-p)
19651 (make-string (org-list-item-body-column (point-at-bol)) ?\ ))
19652 ;; Point is in a list after `backward-paragraph': original
19653 ;; point wasn't in the list, or filling would have been taken
19654 ;; care of by `org-auto-fill-function', but the list and the
19655 ;; real paragraph are not separated by a blank line. Thus, move
19656 ;; point after the list to go back to real paragraph and
19657 ;; determine fill-prefix.
19658 ((setq itemp (org-in-item-p))
19659 (goto-char itemp)
19660 (let* ((struct (org-list-struct))
19661 (bottom (org-list-get-bottom-point struct)))
19662 (goto-char bottom)
19663 (make-string (org-get-indentation) ?\ )))
19664 ;; Other text
19665 ((looking-at org-adaptive-fill-regexp-backup)
19666 (match-string-no-properties 0))))))
19667
19668(defun org-auto-fill-function ()
19669 "Auto-fill function."
19670 (let (itemp prefix)
19671 ;; When in a list, compute an appropriate fill-prefix and make
19672 ;; sure it will be used by `do-auto-fill'.
19673 (if (setq itemp (org-in-item-p))
19674 (progn
19675 (setq prefix (make-string (org-list-item-body-column itemp) ?\ ))
19676 (flet ((fill-context-prefix (from to &optional flr) prefix))
19677 (do-auto-fill)))
19678 ;; Else just use `do-auto-fill'.
19679 (do-auto-fill))))
891f4676 19680
20908596
CD
19681;;; Other stuff.
19682
19683(defun org-toggle-fixed-width-section (arg)
19684 "Toggle the fixed-width export.
19685If there is no active region, the QUOTE keyword at the current headline is
19686inserted or removed. When present, it causes the text between this headline
19687and the next to be exported as fixed-width text, and unmodified.
19688If there is an active region, this command adds or removes a colon as the
19689first character of this line. If the first character of a line is a colon,
19690this line is also exported in fixed-width font."
19691 (interactive "P")
19692 (let* ((cc 0)
19693 (regionp (org-region-active-p))
19694 (beg (if regionp (region-beginning) (point)))
19695 (end (if regionp (region-end)))
19696 (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
19697 (case-fold-search nil)
c8d0cf5c 19698 (re "[ \t]*\\(: \\)")
20908596
CD
19699 off)
19700 (if regionp
19701 (save-excursion
19702 (goto-char beg)
19703 (setq cc (current-column))
19704 (beginning-of-line 1)
19705 (setq off (looking-at re))
19706 (while (> nlines 0)
19707 (setq nlines (1- nlines))
19708 (beginning-of-line 1)
19709 (cond
19710 (arg
19711 (org-move-to-column cc t)
c8d0cf5c 19712 (insert ": \n")
20908596
CD
19713 (forward-line -1))
19714 ((and off (looking-at re))
19715 (replace-match "" t t nil 1))
c8d0cf5c 19716 ((not off) (org-move-to-column cc t) (insert ": ")))
20908596
CD
19717 (forward-line 1)))
19718 (save-excursion
19719 (org-back-to-heading)
3ab2c837 19720 (if (looking-at (concat org-outline-regexp
20908596
CD
19721 "\\( *\\<" org-quote-string "\\>[ \t]*\\)"))
19722 (replace-match "" t t nil 1)
3ab2c837 19723 (if (looking-at org-outline-regexp)
20908596
CD
19724 (progn
19725 (goto-char (match-end 0))
19726 (insert org-quote-string " "))))))))
891f4676 19727
c8d0cf5c
CD
19728(defun org-reftex-citation ()
19729 "Use reftex-citation to insert a citation into the buffer.
19730This looks for a line like
19731
19732#+BIBLIOGRAPHY: foo plain option:-d
19733
8bfe682a 19734and derives from it that foo.bib is the bibliography file relevant
c8d0cf5c
CD
19735for this document. It then installs the necessary environment for RefTeX
19736to work in this buffer and calls `reftex-citation' to insert a citation
19737into the buffer.
19738
19739Export of such citations to both LaTeX and HTML is handled by the contributed
19740package org-exp-bibtex by Taru Karttunen."
19741 (interactive)
19742 (let ((reftex-docstruct-symbol 'rds)
19743 (reftex-cite-format "\\cite{%l}")
19744 rds bib)
19745 (save-excursion
19746 (save-restriction
19747 (widen)
19748 (let ((case-fold-search t)
19749 (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)"))
19750 (if (not (save-excursion
19751 (or (re-search-forward re nil t)
19752 (re-search-backward re nil t))))
19753 (error "No bibliography defined in file")
19754 (setq bib (concat (match-string 1) ".bib")
19755 rds (list (list 'bib bib)))))))
19756 (call-interactively 'reftex-citation)))
19757
20908596 19758;;;; Functions extending outline functionality
2a57416f 19759
1e8fbb6d 19760(defun org-beginning-of-line (&optional arg)
891f4676 19761 "Go to the beginning of the current line. If that is invisible, continue
1e8fbb6d
CD
19762to a visible line beginning. This makes the function of C-a more intuitive.
19763If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
19764first attempt, and only move to after the tags when the cursor is already
19765beyond the end of the headline."
19766 (interactive "P")
c8d0cf5c
CD
19767 (let ((pos (point))
19768 (special (if (consp org-special-ctrl-a/e)
19769 (car org-special-ctrl-a/e)
19770 org-special-ctrl-a/e))
19771 refpos)
19772 (if (org-bound-and-true-p line-move-visual)
19773 (beginning-of-visual-line 1)
19774 (beginning-of-line 1))
7b96ff9a
CD
19775 (if (and arg (fboundp 'move-beginning-of-line))
19776 (call-interactively 'move-beginning-of-line)
19777 (if (bobp)
19778 nil
19779 (backward-char 1)
86fbb8ca
CD
19780 (if (org-truely-invisible-p)
19781 (while (and (not (bobp)) (org-truely-invisible-p))
7b96ff9a
CD
19782 (backward-char 1)
19783 (beginning-of-line 1))
19784 (forward-char 1))))
c8d0cf5c 19785 (when special
48aaad2d 19786 (cond
b349f79f 19787 ((and (looking-at org-complex-heading-regexp)
48aaad2d 19788 (= (char-after (match-end 1)) ?\ ))
b349f79f
CD
19789 (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
19790 (point-at-eol)))
48aaad2d 19791 (goto-char
c8d0cf5c 19792 (if (eq special t)
b349f79f
CD
19793 (cond ((> pos refpos) refpos)
19794 ((= pos (point)) refpos)
374585c9
CD
19795 (t (point)))
19796 (cond ((> pos (point)) (point))
19797 ((not (eq last-command this-command)) (point))
b349f79f 19798 (t refpos)))))
48aaad2d
CD
19799 ((org-at-item-p)
19800 (goto-char
c8d0cf5c 19801 (if (eq special t)
3ab2c837
BG
19802 (cond ((> pos (match-end 0)) (match-end 0))
19803 ((= pos (point)) (match-end 0))
374585c9
CD
19804 (t (point)))
19805 (cond ((> pos (point)) (point))
19806 ((not (eq last-command this-command)) (point))
3ab2c837 19807 (t (match-end 0))))))))
b349f79f
CD
19808 (org-no-warnings
19809 (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
04d18304 19810
1e8fbb6d
CD
19811(defun org-end-of-line (&optional arg)
19812 "Go to the end of the line.
19813If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
19814first attempt, and only move to after the tags when the cursor is already
19815beyond the end of the headline."
19816 (interactive "P")
c8d0cf5c
CD
19817 (let ((special (if (consp org-special-ctrl-a/e)
19818 (cdr org-special-ctrl-a/e)
19819 org-special-ctrl-a/e)))
19820 (if (or (not special)
19821 (not (org-on-heading-p))
19822 arg)
19823 (call-interactively
19824 (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line)
19825 ((fboundp 'move-end-of-line) 'move-end-of-line)
19826 (t 'end-of-line)))
19827 (let ((pos (point)))
19828 (beginning-of-line 1)
afe98dfa 19829 (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
c8d0cf5c
CD
19830 (if (eq special t)
19831 (if (or (< pos (match-beginning 1))
19832 (= pos (match-end 0)))
19833 (goto-char (match-beginning 1))
19834 (goto-char (match-end 0)))
19835 (if (or (< pos (match-end 0)) (not (eq this-command last-command)))
19836 (goto-char (match-end 0))
19837 (goto-char (match-beginning 1))))
19838 (call-interactively (if (fboundp 'move-end-of-line)
19839 'move-end-of-line
19840 'end-of-line)))))
19841 (org-no-warnings
19842 (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
b349f79f 19843
5137195a 19844(define-key org-mode-map "\C-a" 'org-beginning-of-line)
1e8fbb6d 19845(define-key org-mode-map "\C-e" 'org-end-of-line)
891f4676 19846
c8d0cf5c
CD
19847(defun org-backward-sentence (&optional arg)
19848 "Go to beginning of sentence, or beginning of table field.
19849This will call `backward-sentence' or `org-table-beginning-of-field',
19850depending on context."
19851 (interactive "P")
19852 (cond
19853 ((org-at-table-p) (call-interactively 'org-table-beginning-of-field))
19854 (t (call-interactively 'backward-sentence))))
19855
19856(defun org-forward-sentence (&optional arg)
19857 "Go to end of sentence, or end of table field.
19858This will call `forward-sentence' or `org-table-end-of-field',
19859depending on context."
19860 (interactive "P")
19861 (cond
19862 ((org-at-table-p) (call-interactively 'org-table-end-of-field))
19863 (t (call-interactively 'forward-sentence))))
19864
19865(define-key org-mode-map "\M-a" 'org-backward-sentence)
19866(define-key org-mode-map "\M-e" 'org-forward-sentence)
19867
2a57416f
CD
19868(defun org-kill-line (&optional arg)
19869 "Kill line, to tags or end of line."
19870 (interactive "P")
19871 (cond
19872 ((or (not org-special-ctrl-k)
19873 (bolp)
19874 (not (org-on-heading-p)))
86fbb8ca
CD
19875 (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
19876 org-ctrl-k-protect-subtree)
19877 (if (or (eq org-ctrl-k-protect-subtree 'error)
19878 (not (y-or-n-p "Kill hidden subtree along with headline? ")))
19879 (error "C-k aborted - would kill hidden subtree")))
2a57416f 19880 (call-interactively 'kill-line))
afe98dfa 19881 ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))
2a57416f
CD
19882 (kill-region (point) (match-beginning 1))
19883 (org-set-tags nil t))
19884 (t (kill-region (point) (point-at-eol)))))
19885
19886(define-key org-mode-map "\C-k" 'org-kill-line)
19887
93b62de8
CD
19888(defun org-yank (&optional arg)
19889 "Yank. If the kill is a subtree, treat it specially.
19890This command will look at the current kill and check if is a single
19891subtree, or a series of subtrees[1]. If it passes the test, and if the
19892cursor is at the beginning of a line or after the stars of a currently
33306645 19893empty headline, then the yank is handled specially. How exactly depends
93b62de8
CD
19894on the value of the following variables, both set by default.
19895
19896org-yank-folded-subtrees
33306645 19897 When set, the subtree(s) will be folded after insertion, but only
93b62de8
CD
19898 if doing so would now swallow text after the yanked text.
19899
19900org-yank-adjusted-subtrees
19901 When set, the subtree will be promoted or demoted in order to
19902 fit into the local outline tree structure, which means that the level
19903 will be adjusted so that it becomes the smaller one of the two
19904 *visible* surrounding headings.
19905
19906Any prefix to this command will cause `yank' to be called directly with
86fbb8ca
CD
19907no special treatment. In particular, a simple \\[universal-argument] prefix \
19908will just
93b62de8
CD
19909plainly yank the text as it is.
19910
c8d0cf5c 19911\[1] The test checks if the first non-white line is a heading
93b62de8
CD
19912 and if there are no other headings with fewer stars."
19913 (interactive "P")
c8d0cf5c
CD
19914 (org-yank-generic 'yank arg))
19915
19916(defun org-yank-generic (command arg)
19917 "Perform some yank-like command.
19918
19919This function implements the behavior described in the `org-yank'
3ab2c837 19920documentation. However, it has been generalized to work for any
c8d0cf5c
CD
19921interactive command with similar behavior."
19922
19923 ;; pretend to be command COMMAND
19924 (setq this-command command)
19925
93b62de8 19926 (if arg
c8d0cf5c
CD
19927 (call-interactively command)
19928
93b62de8
CD
19929 (let ((subtreep ; is kill a subtree, and the yank position appropriate?
19930 (and (org-kill-is-subtree-p)
19931 (or (bolp)
19932 (and (looking-at "[ \t]*$")
ce4fdcb9 19933 (string-match
93b62de8
CD
19934 "\\`\\*+\\'"
19935 (buffer-substring (point-at-bol) (point)))))))
19936 swallowp)
19937 (cond
19938 ((and subtreep org-yank-folded-subtrees)
19939 (let ((beg (point))
19940 end)
19941 (if (and subtreep org-yank-adjusted-subtrees)
19942 (org-paste-subtree nil nil 'for-yank)
c8d0cf5c
CD
19943 (call-interactively command))
19944
93b62de8
CD
19945 (setq end (point))
19946 (goto-char beg)
19947 (when (and (bolp) subtreep
19948 (not (setq swallowp
19949 (org-yank-folding-would-swallow-text beg end))))
3ab2c837
BG
19950 (org-with-limited-levels
19951 (or (looking-at org-outline-regexp)
19952 (re-search-forward org-outline-regexp-bol end t))
19953 (while (and (< (point) end) (looking-at org-outline-regexp))
19954 (hide-subtree)
19955 (org-cycle-show-empty-lines 'folded)
19956 (condition-case nil
19957 (outline-forward-same-level 1)
19958 (error (goto-char end))))))
93b62de8
CD
19959 (when swallowp
19960 (message
3ab2c837 19961 "Inserted text not folded because that would swallow text"))
c8d0cf5c 19962
93b62de8
CD
19963 (goto-char end)
19964 (skip-chars-forward " \t\n\r")
ce4fdcb9
CD
19965 (beginning-of-line 1)
19966 (push-mark beg 'nomsg)))
93b62de8 19967 ((and subtreep org-yank-adjusted-subtrees)
ce4fdcb9
CD
19968 (let ((beg (point-at-bol)))
19969 (org-paste-subtree nil nil 'for-yank)
19970 (push-mark beg 'nomsg)))
93b62de8 19971 (t
c8d0cf5c 19972 (call-interactively command))))))
ce4fdcb9 19973
93b62de8
CD
19974(defun org-yank-folding-would-swallow-text (beg end)
19975 "Would hide-subtree at BEG swallow any text after END?"
19976 (let (level)
3ab2c837
BG
19977 (org-with-limited-levels
19978 (save-excursion
19979 (goto-char beg)
19980 (when (or (looking-at org-outline-regexp)
19981 (re-search-forward org-outline-regexp-bol end t))
19982 (setq level (org-outline-level)))
19983 (goto-char end)
19984 (skip-chars-forward " \t\r\n\v\f")
19985 (if (or (eobp)
19986 (and (bolp) (looking-at org-outline-regexp)
19987 (<= (org-outline-level) level)))
19988 nil ; Nothing would be swallowed
19989 t))))) ; something would swallow
621f83e4
CD
19990
19991(define-key org-mode-map "\C-y" 'org-yank)
19992
86fbb8ca
CD
19993(defun org-truely-invisible-p ()
19994 "Check if point is at a character currently not visible.
19995This version does not only check the character property, but also
19996`visible-mode'."
19997 ;; Early versions of noutline don't have `outline-invisible-p'.
19998 (if (org-bound-and-true-p visible-mode)
19999 nil
3ab2c837 20000 (outline-invisible-p)))
86fbb8ca 20001
a96ee7df
CD
20002(defun org-invisible-p2 ()
20003 "Check if point is at a character currently not visible."
20004 (save-excursion
5137195a
CD
20005 (if (and (eolp) (not (bobp))) (backward-char 1))
20006 ;; Early versions of noutline don't have `outline-invisible-p'.
3ab2c837 20007 (outline-invisible-p)))
5137195a 20008
ce4fdcb9
CD
20009(defun org-back-to-heading (&optional invisible-ok)
20010 "Call `outline-back-to-heading', but provide a better error message."
20011 (condition-case nil
20012 (outline-back-to-heading invisible-ok)
20013 (error (error "Before first headline at position %d in buffer %s"
20014 (point) (current-buffer)))))
20015
86fbb8ca
CD
20016(defun org-beginning-of-defun ()
20017 "Go to the beginning of the subtree, i.e. back to the heading."
20018 (org-back-to-heading))
20019(defun org-end-of-defun ()
20020 "Go to the end of the subtree."
20021 (org-end-of-subtree nil t))
20022
db55f368
CD
20023(defun org-before-first-heading-p ()
20024 "Before first heading?"
20025 (save-excursion
3ab2c837
BG
20026 (end-of-line)
20027 (null (re-search-backward org-outline-regexp-bol nil t))))
db55f368 20028
8d642074
CD
20029(defun org-on-heading-p (&optional ignored)
20030 (outline-on-heading-p t))
20031(defun org-at-heading-p (&optional ignored)
20032 (outline-on-heading-p t))
20033
ed21c5c8
CD
20034(defun org-point-at-end-of-empty-headline ()
20035 "If point is at the end of an empty headline, return t, else nil.
20036If the heading only contains a TODO keyword, it is still still considered
20037empty."
20038 (and (looking-at "[ \t]*$")
20039 (save-excursion
20040 (beginning-of-line 1)
3ab2c837
BG
20041 (let ((case-fold-search nil))
20042 (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp
20043 "\\)?[ \t]*$"))))))
a3fbe8c4
CD
20044(defun org-at-heading-or-item-p ()
20045 (or (org-on-heading-p) (org-at-item-p)))
891f4676 20046
a96ee7df 20047(defun org-on-target-p ()
d3f4dbe8
CD
20048 (or (org-in-regexp org-radio-target-regexp)
20049 (org-in-regexp org-target-regexp)))
a96ee7df 20050
891f4676
RS
20051(defun org-up-heading-all (arg)
20052 "Move to the heading line of which the present line is a subheading.
20053This function considers both visible and invisible heading lines.
20054With argument, move up ARG levels."
5137195a
CD
20055 (if (fboundp 'outline-up-heading-all)
20056 (outline-up-heading-all arg) ; emacs 21 version of outline.el
20057 (outline-up-heading arg t))) ; emacs 22 version of outline.el
891f4676 20058
d5098885
JW
20059(defun org-up-heading-safe ()
20060 "Move to the heading line of which the present line is a subheading.
20061This version will not throw an error. It will return the level of the
c8d0cf5c
CD
20062headline found, or nil if no higher level is found.
20063
20064Also, this function will be a lot faster than `outline-up-heading',
20065because it relies on stars being the outline starters. This can really
20066make a significant difference in outlines with very many siblings."
db55f368
CD
20067 (let (start-level re)
20068 (org-back-to-heading t)
20069 (setq start-level (funcall outline-level))
20070 (if (equal start-level 1)
20071 nil
20072 (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} "))
20073 (if (re-search-backward re nil t)
20074 (funcall outline-level)))))
d5098885 20075
8c6fb58b
CD
20076(defun org-first-sibling-p ()
20077 "Is this heading the first child of its parents?"
20078 (interactive)
3ab2c837 20079 (let ((re org-outline-regexp-bol)
8c6fb58b
CD
20080 level l)
20081 (unless (org-at-heading-p t)
20082 (error "Not at a heading"))
20083 (setq level (funcall outline-level))
20084 (save-excursion
20085 (if (not (re-search-backward re nil t))
20086 t
20087 (setq l (funcall outline-level))
20088 (< l level)))))
20089
3278a016
CD
20090(defun org-goto-sibling (&optional previous)
20091 "Goto the next sibling, even if it is invisible.
20092When PREVIOUS is set, go to the previous sibling instead. Returns t
20093when a sibling was found. When none is found, return nil and don't
20094move point."
20095 (let ((fun (if previous 're-search-backward 're-search-forward))
20096 (pos (point))
3ab2c837 20097 (re org-outline-regexp-bol)
3278a016 20098 level l)
5152b597
CD
20099 (when (condition-case nil (org-back-to-heading t) (error nil))
20100 (setq level (funcall outline-level))
20101 (catch 'exit
20102 (or previous (forward-char 1))
20103 (while (funcall fun re nil t)
20104 (setq l (funcall outline-level))
20105 (when (< l level) (goto-char pos) (throw 'exit nil))
20106 (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t)))
20107 (goto-char pos)
20108 nil))))
3278a016 20109
d3f4dbe8
CD
20110(defun org-show-siblings ()
20111 "Show all siblings of the current headline."
20112 (save-excursion
20113 (while (org-goto-sibling) (org-flag-heading nil)))
20114 (save-excursion
20115 (while (org-goto-sibling 'previous)
20116 (org-flag-heading nil))))
20117
afe98dfa
CD
20118(defun org-goto-first-child ()
20119 "Goto the first child, even if it is invisible.
3ab2c837 20120Return t when a child was found. Otherwise don't move point and
afe98dfa 20121return nil."
3ab2c837 20122 (let (level (pos (point)) (re org-outline-regexp-bol))
afe98dfa
CD
20123 (when (condition-case nil (org-back-to-heading t) (error nil))
20124 (setq level (outline-level))
20125 (forward-char 1)
20126 (if (and (re-search-forward re nil t) (> (outline-level) level))
20127 (progn (goto-char (match-beginning 0)) t)
20128 (goto-char pos) nil))))
20129
891f4676
RS
20130(defun org-show-hidden-entry ()
20131 "Show an entry where even the heading is hidden."
20132 (save-excursion
634a7d0b 20133 (org-show-entry)))
891f4676 20134
891f4676 20135(defun org-flag-heading (flag &optional entry)
2dd9129f 20136 "Flag the current heading. FLAG non-nil means make invisible.
891f4676
RS
20137When ENTRY is non-nil, show the entire entry."
20138 (save-excursion
20139 (org-back-to-heading t)
891f4676
RS
20140 ;; Check if we should show the entire entry
20141 (if entry
c8d16429
CD
20142 (progn
20143 (org-show-entry)
4b3a9ba7
CD
20144 (save-excursion
20145 (and (outline-next-heading)
20146 (org-flag-heading nil))))
48aaad2d 20147 (outline-flag-region (max (point-min) (1- (point)))
c8d16429 20148 (save-excursion (outline-end-of-heading) (point))
5137195a 20149 flag))))
891f4676 20150
621f83e4
CD
20151(defun org-get-next-sibling ()
20152 "Move to next heading of the same level, and return point.
20153If there is no such heading, return nil.
20154This is like outline-next-sibling, but invisible headings are ok."
20155 (let ((level (funcall outline-level)))
20156 (outline-next-heading)
20157 (while (and (not (eobp)) (> (funcall outline-level) level))
20158 (outline-next-heading))
20159 (if (or (eobp) (< (funcall outline-level) level))
20160 nil
20161 (point))))
20162
54a0dee5
CD
20163(defun org-get-last-sibling ()
20164 "Move to previous heading of the same level, and return point.
20165If there is no such heading, return nil."
20166 (let ((opoint (point))
20167 (level (funcall outline-level)))
20168 (outline-previous-heading)
20169 (when (and (/= (point) opoint) (outline-on-heading-p t))
20170 (while (and (> (funcall outline-level) level)
20171 (not (bobp)))
20172 (outline-previous-heading))
20173 (if (< (funcall outline-level) level)
20174 nil
20175 (point)))))
20176
a3fbe8c4 20177(defun org-end-of-subtree (&optional invisible-OK to-heading)
c8d0cf5c 20178 ;; This contains an exact copy of the original function, but it uses
04d18304
CD
20179 ;; `org-back-to-heading', to make it work also in invisible
20180 ;; trees. And is uses an invisible-OK argument.
20181 ;; Under Emacs this is not needed, but the old outline.el needs this fix.
c8d0cf5c
CD
20182 ;; Furthermore, when used inside Org, finding the end of a large subtree
20183 ;; with many children and grandchildren etc, this can be much faster
20184 ;; than the outline version.
04d18304 20185 (org-back-to-heading invisible-OK)
f462ee2c 20186 (let ((first t)
04d18304 20187 (level (funcall outline-level)))
c8d0cf5c
CD
20188 (if (and (org-mode-p) (< level 1000))
20189 ;; A true heading (not a plain list item), in Org-mode
20190 ;; This means we can easily find the end by looking
20191 ;; only for the right number of stars. Using a regexp to do
20192 ;; this is so much faster than using a Lisp loop.
20193 (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} ")))
20194 (forward-char 1)
20195 (and (re-search-forward re nil 'move) (beginning-of-line 1)))
20196 ;; something else, do it the slow way
20197 (while (and (not (eobp))
20198 (or first (> (funcall outline-level) level)))
20199 (setq first nil)
20200 (outline-next-heading)))
a3fbe8c4
CD
20201 (unless to-heading
20202 (if (memq (preceding-char) '(?\n ?\^M))
c8d0cf5c
CD
20203 (progn
20204 ;; Go to end of line before heading
20205 (forward-char -1)
20206 (if (memq (preceding-char) '(?\n ?\^M))
20207 ;; leave blank line before heading
20208 (forward-char -1))))))
0fee8d6e 20209 (point))
04d18304 20210
c8d0cf5c
CD
20211(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
20212 "Use Org version in org-mode, for dramatic speed-up."
3ab2c837 20213 (if (org-mode-p)
c8d0cf5c
CD
20214 (progn
20215 (org-end-of-subtree nil t)
8d642074 20216 (unless (eobp) (backward-char 1)))
c8d0cf5c
CD
20217 ad-do-it))
20218
3ab2c837
BG
20219(defun org-end-of-meta-data-and-drawers ()
20220 "Jump to the first text after meta data and drawers in the current entry.
20221This will move over empty lines, lines with planning time stamps,
20222clocking lines, and drawers."
20223 (org-back-to-heading t)
20224 (let ((end (save-excursion (outline-next-heading) (point)))
20225 (re (concat "\\(" org-drawer-regexp "\\)"
20226 "\\|" "[ \t]*" org-keyword-time-regexp)))
20227 (forward-line 1)
20228 (while (re-search-forward re end t)
20229 (if (not (match-end 1))
20230 ;; empty or planning line
20231 (forward-line 1)
20232 ;; a drawer, find the end
20233 (re-search-forward "^[ \t]*:END:" end 'move)
20234 (forward-line 1)))
20235 (and (re-search-forward "[^\n]" nil t) (backward-char 1))
20236 (point)))
20237
c8d0cf5c
CD
20238(defun org-forward-same-level (arg &optional invisible-ok)
20239 "Move forward to the arg'th subheading at same level as this one.
afe98dfa
CD
20240Stop at the first and last subheadings of a superior heading.
20241Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil
20242it wil also look at invisible ones."
c8d0cf5c
CD
20243 (interactive "p")
20244 (org-back-to-heading invisible-ok)
20245 (org-on-heading-p)
20246 (let* ((level (- (match-end 0) (match-beginning 0) 1))
20247 (re (format "^\\*\\{1,%d\\} " level))
20248 l)
20249 (forward-char 1)
20250 (while (> arg 0)
20251 (while (and (re-search-forward re nil 'move)
20252 (setq l (- (match-end 0) (match-beginning 0) 1))
20253 (= l level)
20254 (not invisible-ok)
3ab2c837 20255 (progn (backward-char 1) (outline-invisible-p)))
c8d0cf5c
CD
20256 (if (< l level) (setq arg 1)))
20257 (setq arg (1- arg)))
20258 (beginning-of-line 1)))
20259
20260(defun org-backward-same-level (arg &optional invisible-ok)
20261 "Move backward to the arg'th subheading at same level as this one.
20262Stop at the first and last subheadings of a superior heading."
20263 (interactive "p")
20264 (org-back-to-heading)
20265 (org-on-heading-p)
20266 (let* ((level (- (match-end 0) (match-beginning 0) 1))
20267 (re (format "^\\*\\{1,%d\\} " level))
20268 l)
20269 (while (> arg 0)
20270 (while (and (re-search-backward re nil 'move)
20271 (setq l (- (match-end 0) (match-beginning 0) 1))
20272 (= l level)
20273 (not invisible-ok)
3ab2c837 20274 (outline-invisible-p))
c8d0cf5c
CD
20275 (if (< l level) (setq arg 1)))
20276 (setq arg (1- arg)))))
20277
634a7d0b
CD
20278(defun org-show-subtree ()
20279 "Show everything after this heading at deeper levels."
64f72ae1
JB
20280 (outline-flag-region
20281 (point)
634a7d0b 20282 (save-excursion
54a0dee5 20283 (org-end-of-subtree t t))
5137195a 20284 nil))
634a7d0b
CD
20285
20286(defun org-show-entry ()
20287 "Show the body directly following this heading.
20288Show the heading too, if it is currently invisible."
20289 (interactive)
20290 (save-excursion
15841868
JW
20291 (condition-case nil
20292 (progn
20293 (org-back-to-heading t)
20294 (outline-flag-region
20295 (max (point-min) (1- (point)))
20296 (save-excursion
c8d0cf5c 20297 (if (re-search-forward
3ab2c837 20298 (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
c8d0cf5c
CD
20299 (match-beginning 1)
20300 (point-max)))
20301 nil)
20302 (org-cycle-hide-drawers 'children))
15841868 20303 (error nil))))
634a7d0b 20304
c8d0cf5c 20305(defun org-make-options-regexp (kwds &optional extra)
891f4676
RS
20306 "Make a regular expression for keyword lines."
20307 (concat
5137195a 20308 "^"
891f4676
RS
20309 "#?[ \t]*\\+\\("
20310 (mapconcat 'regexp-quote kwds "\\|")
c8d0cf5c 20311 (if extra (concat "\\|" extra))
891f4676 20312 "\\):[ \t]*"
c8d0cf5c 20313 "\\(.*\\)"))
891f4676 20314
d3f4dbe8
CD
20315;; Make isearch reveal the necessary context
20316(defun org-isearch-end ()
20317 "Reveal context after isearch exits."
20318 (when isearch-success ; only if search was successful
20319 (if (featurep 'xemacs)
20320 ;; Under XEmacs, the hook is run in the correct place,
20321 ;; we directly show the context.
20322 (org-show-context 'isearch)
20323 ;; In Emacs the hook runs *before* restoring the overlays.
20324 ;; So we have to use a one-time post-command-hook to do this.
20325 ;; (Emacs 22 has a special variable, see function `org-mode')
20326 (unless (and (boundp 'isearch-mode-end-hook-quit)
20327 isearch-mode-end-hook-quit)
20328 ;; Only when the isearch was not quitted.
20329 (org-add-hook 'post-command-hook 'org-isearch-post-command
20330 'append 'local)))))
20331
20332(defun org-isearch-post-command ()
20333 "Remove self from hook, and show context."
20334 (remove-hook 'post-command-hook 'org-isearch-post-command 'local)
20335 (org-show-context 'isearch))
20336
a3fbe8c4 20337
8c6fb58b
CD
20338;;;; Integration with and fixes for other packages
20339
20340;;; Imenu support
20341
20342(defvar org-imenu-markers nil
20343 "All markers currently used by Imenu.")
20344(make-variable-buffer-local 'org-imenu-markers)
20345
20346(defun org-imenu-new-marker (&optional pos)
20347 "Return a new marker for use by Imenu, and remember the marker."
20348 (let ((m (make-marker)))
20349 (move-marker m (or pos (point)))
20350 (push m org-imenu-markers)
20351 m))
20352
20353(defun org-imenu-get-tree ()
20354 "Produce the index for Imenu."
20355 (mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
20356 (setq org-imenu-markers nil)
20357 (let* ((n org-imenu-depth)
3ab2c837 20358 (re (concat "^" (org-get-limited-outline-regexp)))
8c6fb58b
CD
20359 (subs (make-vector (1+ n) nil))
20360 (last-level 0)
65c439fd 20361 m level head)
8c6fb58b
CD
20362 (save-excursion
20363 (save-restriction
20364 (widen)
20365 (goto-char (point-max))
20366 (while (re-search-backward re nil t)
20367 (setq level (org-reduced-level (funcall outline-level)))
20368 (when (<= level n)
20369 (looking-at org-complex-heading-regexp)
621f83e4
CD
20370 (setq head (org-link-display-format
20371 (org-match-string-no-properties 4))
8c6fb58b
CD
20372 m (org-imenu-new-marker))
20373 (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
20374 (if (>= level last-level)
20375 (push (cons head m) (aref subs level))
20376 (push (cons head (aref subs (1+ level))) (aref subs level))
20377 (loop for i from (1+ level) to n do (aset subs i nil)))
20378 (setq last-level level)))))
20379 (aref subs 1)))
20380
20381(eval-after-load "imenu"
20382 '(progn
20383 (add-hook 'imenu-after-jump-hook
2c3ad40d 20384 (lambda ()
3ab2c837 20385 (if (org-mode-p)
2c3ad40d 20386 (org-show-context 'org-goto))))))
8c6fb58b 20387
621f83e4
CD
20388(defun org-link-display-format (link)
20389 "Replace a link with either the description, or the link target
20390if no description is present"
20391 (save-match-data
20392 (if (string-match org-bracket-link-analytic-regexp link)
8bfe682a
CD
20393 (replace-match (if (match-end 5)
20394 (match-string 5 link)
20395 (concat (match-string 1 link)
20396 (match-string 3 link)))
20397 nil t link)
621f83e4
CD
20398 link)))
20399
8c6fb58b
CD
20400;; Speedbar support
20401
86fbb8ca 20402(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1)
20908596 20403 "Overlay marking the agenda restriction line in speedbar.")
86fbb8ca 20404(overlay-put org-speedbar-restriction-lock-overlay
20908596 20405 'face 'org-agenda-restriction-lock)
86fbb8ca 20406(overlay-put org-speedbar-restriction-lock-overlay
20908596
CD
20407 'help-echo "Agendas are currently limited to this item.")
20408(org-detach-overlay org-speedbar-restriction-lock-overlay)
20409
8c6fb58b
CD
20410(defun org-speedbar-set-agenda-restriction ()
20411 "Restrict future agenda commands to the location at point in speedbar.
20412To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
20413 (interactive)
20908596 20414 (require 'org-agenda)
65c439fd 20415 (let (p m tp np dir txt)
8c6fb58b
CD
20416 (cond
20417 ((setq p (text-property-any (point-at-bol) (point-at-eol)
20418 'org-imenu t))
20419 (setq m (get-text-property p 'org-imenu-marker))
8bfe682a
CD
20420 (with-current-buffer (marker-buffer m)
20421 (goto-char m)
20422 (org-agenda-set-restriction-lock 'subtree)))
8c6fb58b
CD
20423 ((setq p (text-property-any (point-at-bol) (point-at-eol)
20424 'speedbar-function 'speedbar-find-file))
20425 (setq tp (previous-single-property-change
20426 (1+ p) 'speedbar-function)
20427 np (next-single-property-change
20428 tp 'speedbar-function)
20429 dir (speedbar-line-directory)
20430 txt (buffer-substring-no-properties (or tp (point-min))
20431 (or np (point-max))))
8bfe682a
CD
20432 (with-current-buffer (find-file-noselect
20433 (let ((default-directory dir))
20434 (expand-file-name txt)))
20435 (unless (org-mode-p)
20436 (error "Cannot restrict to non-Org-mode file"))
20437 (org-agenda-set-restriction-lock 'file)))
8c6fb58b 20438 (t (error "Don't know how to restrict Org-mode's agenda")))
86fbb8ca
CD
20439 (move-overlay org-speedbar-restriction-lock-overlay
20440 (point-at-bol) (point-at-eol))
8c6fb58b
CD
20441 (setq current-prefix-arg nil)
20442 (org-agenda-maybe-redo)))
20443
20444(eval-after-load "speedbar"
20445 '(progn
20446 (speedbar-add-supported-extension ".org")
20447 (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction)
20448 (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction)
20449 (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock)
20450 (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
20451 (add-hook 'speedbar-visiting-tag-hook
1ba1f458 20452 (lambda () (and (org-mode-p) (org-show-context 'org-goto))))))
8c6fb58b 20453
20908596 20454;;; Fixes and Hacks for problems with other packages
a3fbe8c4
CD
20455
20456;; Make flyspell not check words in links, to not mess up our keymap
20457(defun org-mode-flyspell-verify ()
3ab2c837
BG
20458 "Don't let flyspell put overlays at active buttons, or on
20459 {todo,all-time,additional-option-like}-keywords."
20460 (let ((pos (max (1- (point)) (point-min)))
20461 (word (thing-at-point 'word)))
20462 (and (not (get-text-property pos 'keymap))
20463 (not (get-text-property pos 'org-no-flyspell))
20464 (not (member word org-todo-keywords-1))
20465 (not (member word org-all-time-keywords))
20466 (not (member word org-additional-option-like-keywords)))))
c8d0cf5c
CD
20467
20468(defun org-remove-flyspell-overlays-in (beg end)
20469 "Remove flyspell overlays in region."
20470 (and (org-bound-and-true-p flyspell-mode)
20471 (fboundp 'flyspell-delete-region-overlays)
20472 (flyspell-delete-region-overlays beg end))
20473 (add-text-properties beg end '(org-no-flyspell t)))
d3f4dbe8 20474
8bfe682a 20475;; Make `bookmark-jump' shows the jump location if it was hidden.
891f4676 20476(eval-after-load "bookmark"
b9661543
CD
20477 '(if (boundp 'bookmark-after-jump-hook)
20478 ;; We can use the hook
20479 (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
20480 ;; Hook not available, use advice
20481 (defadvice bookmark-jump (after org-make-visible activate)
20482 "Make the position visible."
20483 (org-bookmark-jump-unhide))))
20484
8bfe682a 20485;; Make sure saveplace shows the location if it was hidden
93b62de8
CD
20486(eval-after-load "saveplace"
20487 '(defadvice save-place-find-file-hook (after org-make-visible activate)
20488 "Make the position visible."
20489 (org-bookmark-jump-unhide)))
20490
8bfe682a
CD
20491;; Make sure ecb shows the location if it was hidden
20492(eval-after-load "ecb"
20493 '(defadvice ecb-method-clicked (after esf/org-show-context activate)
20494 "Make hierarchy visible when jumping into location from ECB tree buffer."
3ab2c837 20495 (if (org-mode-p)
8bfe682a
CD
20496 (org-show-context))))
20497
b9661543
CD
20498(defun org-bookmark-jump-unhide ()
20499 "Unhide the current position, to show the bookmark location."
b928f99a 20500 (and (org-mode-p)
3ab2c837 20501 (or (outline-invisible-p)
b9661543 20502 (save-excursion (goto-char (max (point-min) (1- (point))))
3ab2c837 20503 (outline-invisible-p)))
3278a016 20504 (org-show-context 'bookmark-jump)))
891f4676 20505
3278a016
CD
20506;; Make session.el ignore our circular variable
20507(eval-after-load "session"
20508 '(add-to-list 'session-globals-exclude 'org-mark-ring))
0fee8d6e 20509
d3f4dbe8 20510;;;; Experimental code
b928f99a 20511
a3fbe8c4
CD
20512(defun org-closed-in-range ()
20513 "Sparse tree of items closed in a certain time range.
8c6fb58b 20514Still experimental, may disappear in the future."
a3fbe8c4
CD
20515 (interactive)
20516 ;; Get the time interval from the user.
54a0dee5 20517 (let* ((time1 (org-float-time
a3fbe8c4 20518 (org-read-date nil 'to-time nil "Starting date: ")))
54a0dee5 20519 (time2 (org-float-time
a3fbe8c4
CD
20520 (org-read-date nil 'to-time nil "End date:")))
20521 ;; callback function
20522 (callback (lambda ()
20523 (let ((time
54a0dee5 20524 (org-float-time
a3fbe8c4
CD
20525 (apply 'encode-time
20526 (org-parse-time-string
20527 (match-string 1))))))
20528 ;; check if time in interval
20529 (and (>= time time1) (<= time time2))))))
20530 ;; make tree, check each match with the callback
20531 (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
d3f4dbe8
CD
20532
20533;;;; Finish up
c44f0d75 20534
f462ee2c
SM
20535(provide 'org)
20536
20537(run-hooks 'org-load-hook)
20538
5b409b39 20539
7d58338e 20540
b349f79f 20541;;; org.el ends here