Commit | Line | Data |
---|---|---|
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. | |
141 | This list can be used to load support for any of the languages | |
142 | below, note that each language will depend on a different set of | |
143 | system executables and/or Emacs modes. When a language is | |
144 | \"loaded\", then code blocks in that language can be evaluated | |
145 | with `org-babel-execute-src-block' bound by default to C-c | |
146 | C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can | |
147 | be set to remove code block evaluation from the C-c C-c | |
148 | keybinding. By default only Emacs Lisp (which has no | |
149 | requirements) 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. | |
193 | When non-nil, clones of a subtree don't inherit the ID property. | |
194 | Otherwise they inherit the ID property with a new unique | |
195 | identifier." | |
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. | |
206 | With 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 | 277 | If a description starts with <C>, the file is not part of Emacs |
20908596 CD |
278 | and loading it will require that you have downloaded and properly installed |
279 | the org-mode distribution. | |
280 | ||
281 | You can also use this system to load external packages (i.e. neither Org | |
8d642074 | 282 | core modules, nor modules from the CONTRIB directory). Just add symbols |
efc054e6 | 283 | to the end of the list. If the package is called org-xyz.el, then you need |
20908596 CD |
284 | to 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 | |
357 | In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start | |
86fbb8ca | 358 | selecting a region, or enlarge regions started in this way. |
65c439fd CD |
359 | In Org-mode, in special contexts, these same keys are used for other |
360 | purposes, important enough to compete with shift selection. Org tries | |
361 | to balance these needs by supporting `shift-select-mode' outside these | |
362 | special contexts, under control of this variable. | |
363 | ||
364 | The default of this variable is nil, to avoid confusing behavior. Shifted | |
365 | cursor 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). | |
371 | Outside these contexts, the commands will throw an error. | |
372 | ||
373 | When this variable is t and the cursor is not in a special context, | |
374 | Org-mode will support shift-selection for making and enlarging regions. | |
375 | To make this more effective, the bullet cycling will no longer happen | |
376 | anywhere in an item line, but only if the cursor is exactly on the bullet. | |
377 | ||
378 | If you set this variable to the symbol `always', then the keys | |
379 | will not be special in headlines, property lines, and item lines, to make | |
380 | shift selection work there as well. If this is what you want, you can | |
381 | use the following alternative commands: `C-c C-t' and `C-c ,' to | |
382 | change TODO state and priority, `C-u C-u C-c C-t' can be used to switch | |
383 | TODO sets, `C-c -' to cycle item bullet types, and properties can be | |
384 | edited by hand or in column view. | |
385 | ||
386 | However, when the cursor is on a timestamp, shift-cursor commands | |
387 | will still edit the time stamp - this is just too good to give up. | |
388 | ||
389 | XEmacs user should have this variable set to nil, because shift-select-mode | |
390 | is 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 |
404 | This can also be configured on a per-file basis by adding one of |
405 | the 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 |
420 | This is useful since some lines containing links can be very long and |
421 | uninteresting. 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 |
427 | This can also be configured on a per-file basis by adding one of |
428 | the 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. | |
439 | When this option is turned on, you can use TeX-like syntax for sub- and | |
440 | superscripts. Several characters after \"_\" or \"^\" will be | |
441 | considered as a single item - so grouping with {} is normally not | |
442 | needed. For example, the following things will be parsed as single | |
443 | sub- 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 | ||
451 | Still, ambiguity is possible - so when in doubt use {} to enclose the | |
452 | sub/superscript. If you set this variable to the symbol `{}', | |
453 | the braces are *required* in order to trigger interpretations as | |
454 | sub/superscript. This can be helpful in documents that need \"_\" | |
455 | frequently in plain text. | |
456 | ||
457 | Not all export backends support this, but HTML does. | |
458 | ||
459 | This 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. | |
473 | This can also be configured on a per-file basis by adding one of | |
474 | the 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 | 482 | This is useful when the column width in tables is forced with <N> cookies |
4146eb16 CD |
483 | in table fields. Such tables will look correct only after the first re-align. |
484 | This can also be configured on a per-file basis by adding one of | |
485 | the 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. | |
493 | This can also be configured on a per-file basis by adding one of | |
494 | the 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 | 502 | When the function `org-mode' is called interactively in an empty file, this |
891f4676 RS |
503 | normally means that the file name does not automatically trigger Org-mode. |
504 | To ensure that the file will always be in Org-mode in the future, a | |
35fb9989 CD |
505 | line enforcing Org-mode will be inserted into the buffer, if this option |
506 | has 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. | |
512 | Org-mode uses S-<cursor> keys for changing timestamps and priorities. | |
c8d0cf5c CD |
513 | These keys are also used by other packages like shift-selection-mode' |
514 | \(built into Emacs 23), `CUA-mode' or `windmove.el'. | |
a3fbe8c4 CD |
515 | If you want to use Org-mode together with one of these other modes, |
516 | or more generally if you would like to move some Org-mode commands to | |
517 | other keys, set this variable and configure the keys with the variable | |
ab27a4a0 | 518 | `org-disputed-keys'. |
891f4676 | 519 | |
d3f4dbe8 CD |
520 | This 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 | |
522 | become 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. |
528 | This happens automatically if you run XEmacs or if `window-system' | |
529 | is nil. This variable lets you do the same manually. You must | |
530 | set it before loading org. | |
621f83e4 CD |
531 | |
532 | Example: on Carbon Emacs 22 running graphically, with an external | |
533 | keyboard on a Powerbook, the default way of setting M-left might | |
534 | not work for either Alt or ESC. Setting this variable will make | |
535 | it 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 |
550 | This is an alist, cars are the default keys, second element specifies |
551 | the alternative to use when `org-replace-disputed-keys' is t. | |
552 | ||
553 | Keys can be specified in any syntax supported by `define-key'. | |
554 | The value of this option takes effect only at Org-mode's startup, | |
555 | therefore 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 |
561 | Or return the original if not disputed. |
562 | Also 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. |
586 | When nil, just use the standard three dots. When a string, use that instead, | |
33306645 | 587 | When a face, use the standard 3 dots, but with the specified face. |
374585c9 | 588 | The change affects only Org-mode (which will then use its own display table). |
ab27a4a0 CD |
589 | Changing this requires executing `M-x org-mode' in a buffer to become |
590 | effective." | |
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. | |
606 | A deadline is this string, followed by a time stamp. Should be a word, | |
607 | terminated by a colon. You can insert a schedule keyword and | |
608 | a timestamp with \\[org-deadline]. | |
609 | Changes 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. | |
615 | A schedule is this string, followed by a time stamp. Should be a word, | |
616 | terminated by a colon. You can insert a schedule keyword and | |
617 | a timestamp with \\[org-schedule]. | |
618 | Changes 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. | |
634 | An entry can be toggled between COMMENT and normal with | |
635 | \\[org-toggle-comment]. | |
636 | Changes 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. | |
642 | Quoting applies only to the text in the entry following the headline, and does | |
643 | not extend beyond the next headline, even if that is lower level. | |
644 | An 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. |
652 | After 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 |
685 | Org-mode often shows locations in an org-mode file which might have |
686 | been invisible before. When this is set, the hierarchy of headings | |
687 | above the exposed location is shown. | |
688 | Turning this off for example for sparse trees makes them very compact. | |
689 | Instead of t, this can also be an alist specifying this option for different | |
690 | contexts. 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 |
705 | Org-mode often shows locations in an org-mode file which might have |
706 | been invisible before. When this is set, the heading following the | |
707 | match is shown. | |
708 | Turning this off for example for sparse trees makes them very compact, | |
709 | but makes it harder to edit the location of the match. In such a case, | |
710 | use the command \\[org-reveal] to show more context. | |
711 | Instead of t, this can also be an alist specifying this option for different | |
712 | contexts. 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 |
718 | Org-mode often shows locations in an org-mode file which might have |
719 | been invisible before. When this is set, the sibling of the current entry | |
720 | heading are all made visible. If `org-show-hierarchy-above' is t, | |
721 | the same happens on each level of the hierarchy above the current entry. | |
722 | ||
723 | By default this is on for the isearch context, off for all other contexts. | |
724 | Turning this off for example for sparse trees makes them very compact, | |
725 | but makes it harder to edit the location of the match. In such a case, | |
726 | use the command \\[org-reveal] to show more context. | |
727 | Instead of t, this can also be an alist specifying this option for different | |
728 | contexts. 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 |
734 | Org-mode often shows locations in an org-mode file which might have |
735 | been invisible before. When this is set, the text below the headline that is | |
736 | exposed is also shown. | |
737 | ||
738 | By default this is off for all contexts. | |
739 | Instead of t, this can also be an alist specifying this option for different | |
740 | contexts. 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? | |
746 | This applies to indirect buffers created with the commands | |
747 | \\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. | |
748 | Valid values are: | |
749 | current-window Display in the current window | |
750 | other-window Just display in another window. | |
751 | dedicated-frame Create one new frame, and re-use it each time. | |
752 | new-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 |
765 | This may also be a function to test for appropriate locations where speed |
766 | commands 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. | |
775 | This list will be checked before `org-speed-commands-default' | |
776 | when the variable `org-use-speed-commands' is non-nil | |
777 | and when the cursor is at the beginning of a headline. | |
778 | The car if each entry is a string with a single letter, which must | |
779 | be assigned to `self-insert-command' in the global map. | |
780 | The cdr is either a command to be called interactively, a function | |
1bcdebed CD |
781 | to be called, or a form to be evaluated. |
782 | An entry that is just a list with a single string will be interpreted | |
783 | as a descriptive headline that will be added when listing the speed | |
86fbb8ca | 784 | commands 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. | |
807 | Levels higher than this will, for cycling, be treated as text, not a headline. | |
808 | When `org-odd-levels-only' is set, a value of N in this variable actually | |
809 | means 2N-1 stars as the limiting headline. | |
810 | When nil, cycle all levels. | |
811 | Note 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 | |
814 | than 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. |
822 | Drawers only open with a TAB on the drawer line itself. A drawer looks like | |
823 | this: | |
824 | :DRAWERNAME: | |
825 | ..... | |
38f8646b CD |
826 | :END: |
827 | The drawer \"PROPERTIES\" is special for capturing properties through | |
03f3cf35 JW |
828 | the property API. |
829 | ||
830 | Drawers 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 |
839 | This 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. |
849 | This 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 \ |
851 | of the buffer | |
20106e31 | 852 | must not be a headline - it may be empty or some other text. When used in |
4b3a9ba7 CD |
853 | this way, `org-cycle-hook' is disables temporarily, to make sure the |
854 | cursor stays at the beginning of the buffer. | |
855 | When this option is nil, don't do anything special at the beginning | |
856 | of 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 | |
863 | When the cursor is at the end of an empty headline, i.e with only stars | |
864 | and maybe a TODO keyword, TAB will then switch the entry to become a child, | |
86fbb8ca | 865 | and then all possible ancestor states, before returning to the original state. |
8bfe682a CD |
866 | This makes data entry extremely fast: M-RET to create a new headline, |
867 | on TAB to make it a child, two or more tabs to make it a (grand-)uncle. | |
868 | ||
869 | When the cursor is at the end of an empty plain list item, one TAB will | |
870 | make it a subitem, two or more tabs will back up to make this an item | |
871 | higher 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 |
877 | nil Never |
878 | white Only in completely white lines | |
a0d892d4 | 879 | whitestart Only at the beginning of lines, before the first non-white char |
7d143c25 | 880 | t Everywhere except in headlines |
a3fbe8c4 | 881 | exc-hl-bol Everywhere except at the start of a headline |
7d143c25 CD |
882 | If TAB is used in a place where it does not emulate TAB, the current subtree |
883 | visibility 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. | |
894 | If you leave an empty line between the end of a subtree and the following | |
895 | headline, this empty line is hidden when the subtree is folded. | |
896 | Org-mode will leave (exactly) one empty line visible if the number of | |
897 | empty lines is equal or larger to the number given in this variable. | |
ed21c5c8 | 898 | So the default 2 means at least 2 empty lines after the end of a subtree |
a3fbe8c4 CD |
899 | are needed to produce free space between a collapsed subtree and the |
900 | following headline. | |
901 | ||
54a0dee5 CD |
902 | If the number is negative, and the number of empty lines is at least -N, |
903 | all empty lines are shown. | |
904 | ||
a3fbe8c4 CD |
905 | Special 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. | |
912 | The function(s) in this hook must accept a single argument which indicates | |
913 | the new state that will be set right after running this hook. The | |
914 | argument 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 | |
916 | the 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. |
925 | The function(s) in this hook must accept a single argument which indicates | |
926 | the new state that was set by the most recent `org-cycle' command. The | |
927 | argument 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 | |
929 | the 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 |
940 | This has the effect that two stars are being added/taken away in |
941 | promotion/demotion commands. It also influences how levels are | |
942 | handled by the exporters. | |
943 | Changing it requires restart of `font-lock-mode' to become effective | |
944 | for fontification also in regions already fontified. | |
945 | You may also set this on a per-file basis by adding one of the following | |
946 | lines 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 | |
957 | When this variable is set, Org assumes that you write outlines by | |
958 | indenting text in each node to align with the headline (after the stars). | |
959 | The 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 | ||
972 | Note that this is all about true indentation, by adding and removing | |
973 | space characters. See also `org-indent.el' which does level-dependent | |
974 | indentation 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 | 981 | When t, `C-a' will bring back the cursor to the beginning of the |
a3fbe8c4 | 982 | headline text, i.e. after the stars and after a possible TODO keyword. |
48aaad2d | 983 | In an item, this will be the position after the bullet. |
a3fbe8c4 | 984 | When the cursor is already at that position, another `C-a' will bring |
1e8fbb6d | 985 | it 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 |
988 | in the headline. A second `C-e' will then jump to the true end of the | |
8d642074 CD |
989 | line, after any tags. This also means that, when this variable is |
990 | non-nil, `C-e' also will never jump beyond the end of the heading of a | |
991 | folded section, i.e. not after the ellipses. | |
c8d0cf5c | 992 | |
374585c9 | 993 | When set to the symbol `reversed', the first `C-a' or `C-e' works normally, |
c8d0cf5c CD |
994 | going to the true line boundary first. Only a directly following, identical |
995 | keypress will bring the cursor to the special positions. | |
996 | ||
997 | This may also be a cons cell where the behavior for `C-a' and `C-e' is | |
998 | set 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. | |
1018 | When nil, `C-k' will call the default `kill-line' command. | |
1019 | When 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. | |
1030 | When set to the symbol `error', simply throw an error when C-k is | |
1031 | used to kill (part-of) a headline that has hidden text behind it. | |
1032 | Any other non-nil value will result in a query to the user, if it is | |
1033 | OK 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 |
1042 | If the kill is a single subtree, or a sequence of subtrees, i.e. if |
1043 | it starts with a heading and all other headings in it are either children | |
93b62de8 CD |
1044 | or siblings, then fold all the subtrees. However, do this only if no |
1045 | text 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 |
1051 | With this setting, `org-paste-subtree' is used to insert the subtree, see |
1052 | this 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 |
1058 | When nil, it will go to the end of the line before making a |
1059 | new line. | |
1060 | You may also set this option in a different way for different | |
1061 | contexts. Valid contexts are: | |
1062 | ||
1063 | headline when creating a new headline | |
1064 | item when creating a new item | |
1065 | table in a table field | |
1066 | default 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 |
1085 | When nil, the new heading is created directly after the current line. |
1086 | The commands \\[org-insert-heading-respect-content] and | |
1087 | \\[org-insert-todo-heading-respect-content] turn this variable on | |
1088 | for 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 |
1095 | The value is an alist, with `heading' and `plain-list-item' as CAR, |
1096 | and a boolean flag as CDR. The cdr may also be the symbol `auto', in | |
1097 | which case Org will look at the surrounding headings/items and try to | |
1098 | make an intelligent decision whether to insert a blank line or not. | |
afe98dfa CD |
1099 | |
1100 | For plain lists, if the variable `org-empty-line-terminates-plain-lists' is | |
1101 | set, the setting here is ignored and no empty line is inserted, to avoid | |
1102 | breaking 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. |
1121 | This currently only means they are never auto-wrapped. | |
ab27a4a0 CD |
1122 | When nil, such lines will be treated like ordinary lines. |
1123 | See 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 |
1139 | The highlights will automatically disappear the next time the buffer is |
1140 | changed 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 |
1146 | Such highlights are created by `org-occur' and `org-clock-display'. |
1147 | When nil, `C-c C-c needs to be used to get rid of the highlights. | |
1148 | The 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. | |
1157 | This can be used to recenter the window to show as much of the structure | |
1158 | as 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. | |
1169 | This 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 | 1180 | When nil, such lines will be treated like ordinary lines. |
eb2f9c59 | 1181 | |
ab27a4a0 CD |
1182 | When equal to the symbol `optimized', the table editor will be optimized to |
1183 | do 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. | |
1190 | Optimization requires replacing the functions `self-insert-command', | |
1191 | `delete-char', and `backward-delete-char' in Org-mode buffers, with a | |
1192 | slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is | |
1193 | very good at guessing when a re-align will be necessary, but you can always | |
1194 | force one with \\[org-ctrl-c-ctrl-c]. | |
eb2f9c59 | 1195 | |
ab27a4a0 CD |
1196 | If you would like to use the optimized version in Org-mode, but the |
1197 | un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. | |
eb2f9c59 | 1198 | |
ab27a4a0 CD |
1199 | This variable can be used to turn on and off the table editor during a session, |
1200 | but in order to toggle optimization, a restart is required. | |
634a7d0b | 1201 | |
ab27a4a0 CD |
1202 | See 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 | 1211 | If this is set, then, like in the Emacs command loop, 20 consecutive |
c8d0cf5c CD |
1212 | characters will be undone together. |
1213 | This 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 |
1219 | When it sees such a table, it moves point into it and - if necessary - |
1220 | calls `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 |
1231 | The 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. | |
1236 | The car of each element is a string, to be replaced at the start of a link. | |
1237 | The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated | |
1238 | links 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 |
1242 | The 'linkkey' must be a word word, starting with a letter, followed |
1243 | by letters, numbers, '-' or '_'. | |
1244 | ||
3278a016 | 1245 | If REPLACE is a string, the tag will simply be appended to create the link. |
ce4fdcb9 CD |
1246 | If the string contains \"%s\", the tag will be inserted there. Alternatively, |
1247 | the placeholder \"%h\" will cause a url-encoded version of the tag to | |
1248 | be inserted at that point (see the function `url-hexify-string'). | |
8c6fb58b CD |
1249 | |
1250 | REPLACE may also be a function that will be called with the tag as the | |
1251 | only argument to create the link, which should be returned as a string. | |
1252 | ||
1253 | See 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 | 1264 | Bracket links are like [[link][description]]. This variable sets the initial |
ab27a4a0 CD |
1265 | state in new org-mode buffers. The setting can then be toggled on a |
1266 | per-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. | |
1272 | Valid values are: | |
1273 | ||
a0d892d4 | 1274 | relative Relative to the current directory, i.e. the directory of the file |
4b3a9ba7 | 1275 | into which the link is being inserted. |
a0d892d4 JB |
1276 | absolute Absolute path, if possible with ~ for home directory. |
1277 | noabbrev Absolute path, no abbreviation of home directory. | |
4b3a9ba7 CD |
1278 | adaptive 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. |
1289 | This is a list of symbols, each leading to the activation of a certain link | |
1290 | type. In principle, it does not hurt to turn on most link types - there may | |
1291 | be a small gain when turning off unused link types. The types are: | |
1292 | ||
1293 | bracket The recommended [[link][description]] or [[link]] links with hiding. | |
afe98dfa | 1294 | angle Links in angular brackets that may contain whitespace like |
ab27a4a0 CD |
1295 | <bbdb:Carsten Dominik>. |
1296 | plain Plain links in normal text, no whitespace, like http://google.com. | |
1297 | radio Text that is matched by a radio target, see manual for details. | |
1298 | tag Tag settings in a headline (link to tag search). | |
1299 | date Time stamps (link to calendar). | |
0bd48b37 | 1300 | footnote Footnote labels. |
ab27a4a0 CD |
1301 | |
1302 | Changing 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. |
1315 | If nil the link location will be used. This function must take | |
1316 | two parameters; the first is the link and the second the | |
1317 | description `org-insert-link' has generated, and should return the | |
1318 | description 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 | 1329 | The 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 | ||
1341 | You may use normal field width specification between the % and the letter. | |
1342 | This is for example useful to limit the length of the subject. | |
1343 | ||
1344 | Examples: \"%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 |
1356 | It 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 | |
1363 | Note that before this variable is even considered, org-id must be loaded, | |
c8d0cf5c | 1364 | so please customize `org-modules' and turn it on. |
db55f368 CD |
1365 | |
1366 | The variable can have the following values: | |
1367 | ||
1368 | t Create an ID if needed to make a link to the current entry. | |
1369 | ||
1370 | create-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 |
1381 | create-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 |
1385 | use-existing |
1386 | Use existing ID, do not create one. | |
1387 | ||
1388 | nil 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 | 1402 | A search string will be added to the file name with :: as separator and |
01c35094 | 1403 | used 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 |
1405 | will be placed in the search string of the file link. If set to a | |
acedf35c CD |
1406 | positive integer, only the first n lines of context will be stored. |
1407 | ||
891f4676 RS |
1408 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') |
1409 | negates 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 | |
1416 | The command `org-store-link' adds a link pointing to the current | |
2dd9129f | 1417 | location to an internal list. These links accumulate during a session. |
891f4676 RS |
1418 | The command `org-insert-link' can be used to insert links into any |
1419 | Org-mode file (offering completion for all stored links). When this | |
634a7d0b | 1420 | option is nil, every link which has been inserted once using \\[org-insert-link] |
891f4676 RS |
1421 | will be removed from the list, to make completing the unused links |
1422 | more 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. | |
1433 | This can be used to translate links created for example by the Planner | |
1434 | or emacs-wiki packages to Org syntax. | |
1435 | The function must accept two parameters, a TYPE containing the link | |
1436 | protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, | |
1437 | which is everything after the link protocol. It should return a cons | |
33306645 | 1438 | with possibly modified values of type and path. |
ce4fdcb9 CD |
1439 | Org contains a function for this, so if you set this variable to |
1440 | `org-translate-link-from-planner', you should be able follow many | |
1441 | links 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 |
1452 | Needs to be set before org.el is loaded. |
1453 | This really should not be used, it does not make sense, and the | |
1454 | implementation 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 | 1466 | A longer mouse click will still set point. Does not work on XEmacs. |
a4b39e39 CD |
1467 | Needs 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 |
1473 | Changing 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 | 1479 | When nil, the link search tries to match a phrase with all words |
afe98dfa CD |
1480 | in 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. |
1494 | When following a link with Emacs, it may often be useful to display | |
1495 | this link in another window or frame. This variable can be used to | |
1496 | set this up for the different types of links. | |
1497 | For VM, use any of | |
634a7d0b | 1498 | `vm-visit-folder' |
3ab2c837 | 1499 | `vm-visit-folder-other-window' |
634a7d0b | 1500 | `vm-visit-folder-other-frame' |
891f4676 | 1501 | For Gnus, use any of |
634a7d0b CD |
1502 | `gnus' |
1503 | `gnus-other-frame' | |
93b62de8 | 1504 | `org-gnus-no-new-news' |
891f4676 | 1505 | For FILE, use any of |
634a7d0b CD |
1506 | `find-file' |
1507 | `find-file-other-window' | |
1508 | `find-file-other-frame' | |
86fbb8ca CD |
1509 | For Wanderlust use any of |
1510 | `wl' | |
1511 | `wl-other-frame' | |
891f4676 RS |
1512 | For the calendar, use the variable `calendar-setup'. |
1513 | For BBDB, it is currently only possible to display the matches in | |
1514 | another 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 |
1539 | Activating internal links (from one location in a file to another location |
1540 | in the same file) normally just jumps to the location. When the link is | |
86fbb8ca CD |
1541 | activated with a \\[universal-argument] prefix (or with mouse-3), the link \ |
1542 | is displayed in | |
3278a016 CD |
1543 | another window. When this option is set, the other window actually displays |
1544 | an indirect buffer clone of the current buffer, to avoid any visibility | |
1545 | changes 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 |
1551 | When nil, an error will be generated. |
1552 | This variable applies only to external applications because they | |
1553 | might choke on non-existing files. If the link is to a file that | |
8bfe682a | 1554 | will 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 |
1560 | When nil, following a directory link will run dired or open a finder/explorer |
1561 | window 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 | 1567 | This is a list with the first element being a Lisp function, and the |
3278a016 CD |
1568 | remaining 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 | |
1570 | if 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 | 1580 | Shell links can be dangerous: just think about a link |
ab27a4a0 CD |
1581 | |
1582 | [[shell:rm -rf ~/*][Google Search]] | |
1583 | ||
03f3cf35 | 1584 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1585 | but really it would remove your entire home directory. |
03f3cf35 | 1586 | Therefore we advise against setting this variable to nil. |
c8d0cf5c | 1587 | Just change it to `y-or-n-p' if you want to confirm with a |
03f3cf35 | 1588 | single 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 | 1605 | Elisp links can be dangerous: just think about a link |
4b3a9ba7 CD |
1606 | |
1607 | [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] | |
1608 | ||
03f3cf35 | 1609 | This link would show up in your Org-mode document as \"Google Search\", |
4b3a9ba7 | 1610 | but really it would remove your entire home directory. |
03f3cf35 | 1611 | Therefore we advise against setting this variable to nil. |
c8d0cf5c | 1612 | Just change it to `y-or-n-p' if you want to confirm with a |
03f3cf35 | 1613 | single 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 |
1633 | See `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. | |
1644 | The system \"open\" is known as a default, but we use X11 applications | |
1645 | for some files for which the OS does not have a good default. | |
1646 | See `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. |
1662 | The system \"open\" is used for most files. | |
1663 | See `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. | |
1673 | Org-mode uses system defaults for different file types, but | |
1674 | you can use this variable to set the application for a given file | |
4b3a9ba7 CD |
1675 | extension. The entries in this list are cons cells where the car identifies |
1676 | files and the cdr the corresponding command. Possible values for the | |
1677 | file 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 | |
1724 | Possible 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 |
1740 | For 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 |
1770 | This is just a default location to look for Org files. There is no need |
1771 | at all to put your files into this directory. It is only used in the | |
1772 | following situations: | |
1773 | ||
1774 | 1. 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' | |
1777 | 2. 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 |
1786 | Used as a fall back file for org-remember.el and org-capture.el, for |
1787 | templates 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 | 1796 | Allowed values are: |
2a57416f CD |
1797 | outline 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. | |
1800 | outline-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 |
1815 | When nil, new notes will be filed to the end of a file or entry. |
1816 | This can also be a list with cons cells of regular expressions that | |
1817 | are 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 | ||
1829 | Possible values are: | |
1830 | ||
1831 | nil Don't add anything | |
1832 | time Add a time stamp to the task | |
1833 | note Prompt for a note and add it with template `org-log-note-headings' | |
1834 | ||
1835 | This option can also be set with on a per-file-basis with | |
1836 | ||
1837 | #+STARTUP: nologrefile | |
1838 | #+STARTUP: logrefile | |
1839 | #+STARTUP: lognoterefile | |
1840 | ||
1841 | You can have local logging settings for a subtree by setting the LOGGING | |
1842 | property to one or more of these keywords. | |
1843 | ||
1844 | When bulk-refiling from the agenda, the value `note' is forbidden and | |
1845 | will 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]. | |
1855 | This 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 | ||
1877 | You can set the variable `org-refile-target-verify-function' to a function | |
86fbb8ca | 1878 | to verify each headline found by the simple criteria above. |
621f83e4 CD |
1879 | |
1880 | When this variable is nil, all top-level headlines in the current buffer | |
93b62de8 | 1881 | are 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. | |
1898 | The function will be called without arguments, with point at the | |
1899 | beginning of the headline. It should return t and leave point | |
1900 | where it is if the headline is a valid target for refiling. | |
1901 | ||
1902 | If the target should not be selected, the function must return nil. | |
1903 | In addition to this, it may move point to a place from where the search | |
1904 | should be continued. For example, the function may decide that the entire | |
1905 | subtree of the current entry should be excluded and move point to the end | |
1906 | of 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. | |
1912 | The cache for a particular file will be updated automatically when | |
1913 | the buffer has been killed, or when any of the marker used for flagging | |
1914 | refile targets no longer points at a live buffer. | |
1915 | If you have added new entries to a buffer that might themselves be targets, | |
1916 | you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you | |
1917 | find 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 | 1923 | So a level 3 headline will be available as level1/level2/level3. |
c8d0cf5c | 1924 | |
8c6fb58b | 1925 | When the value is `file', also include the file name (without directory) |
c8d0cf5c CD |
1926 | into the path. In this case, you can also stop the completion after |
1927 | the file name, to get entries inserted as top level in the file. | |
1928 | ||
3ab2c837 | 1929 | When `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 |
1939 | When Org-mode uses the refile interface to select an outline path |
1940 | \(see variable `org-refile-use-outline-path'), the completion of | |
1941 | the path can be done is a single go, or if can be done in steps down | |
1942 | the headline hierarchy. Going in steps is probably the best if you | |
1943 | do not use a special completion package like `ido' or `icicles'. | |
1944 | However, when using these packages, going in one step can be very | |
1945 | fast, 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 |
1951 | New nodes are then created by adding \"/new node name\" to the completion |
1952 | of an existing node. When the value of this variable is `confirm', | |
1953 | new node creation must be confirmed by the user (recommended) | |
1954 | When nil, the completion must match an existing entry. | |
1955 | ||
1956 | Note that, if the new heading is not seen by the criteria | |
1957 | listed in `org-refile-targets', multiple instances of the same | |
1958 | heading would be created by trying again to file under the new | |
1959 | heading." | |
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'. |
1980 | Interested 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 | ||
1986 | Each sequence starts with a symbol, either `sequence' or `type', | |
1987 | indicating if the keywords should be interpreted as a sequence of | |
1988 | action steps, or as different types of TODO items. The first | |
1989 | keywords are states requiring action - these states will select a headline | |
1990 | for inclusion into the global TODO list Org-mode produces. If one of | |
acedf35c | 1991 | the \"keywords\" is the vertical bar, \"|\", the remaining keywords |
a3fbe8c4 CD |
1992 | signify that no further action is necessary. If \"|\" is not found, |
1993 | the last keyword is treated as the only DONE state of the sequence. | |
1994 | ||
1995 | The command \\[org-todo] cycles an entry through these states, and one | |
ab27a4a0 | 1996 | additional state where no keyword is present. For details about this |
a3fbe8c4 CD |
1997 | cycling, see the manual. |
1998 | ||
1999 | TODO keywords and interpretation can also be set on a per-file basis with | |
2000 | the special #+SEQ_TODO and #+TYP_TODO lines. | |
2001 | ||
2a57416f CD |
2002 | Each keyword can optionally specify a character for fast state selection |
2003 | \(in combination with the variable `org-use-fast-todo-selection') | |
2004 | and specifiers for state change logging, using the same syntax | |
2005 | that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says | |
86fbb8ca | 2006 | that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" |
2a57416f CD |
2007 | indicates to record a time stamp each time this state is selected. |
2008 | ||
2009 | Each keyword may also specify if a timestamp or a note should be | |
2010 | recorded when entering or leaving the state, by adding additional | |
2011 | characters in the parenthesis after the keyword. This looks like this: | |
2012 | \"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to | |
2013 | record 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 | |
2015 | Y when leaving the state if and only if the *target* state does not | |
2016 | define X. You may omit any of the fast-selection key or X or /Y, | |
2017 | so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. | |
2018 | ||
a3fbe8c4 | 2019 | For backward compatibility, this variable may also be just a list |
33306645 | 2020 | of keywords - in this case the interpretation (sequence or type) will be |
a3fbe8c4 | 2021 | taken 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 |
2074 | This variable is in principle obsolete and is only used for |
2075 | backward compatibility, if the interpretation of todo keywords is | |
2076 | not given already in `org-todo-keywords'. See that variable for | |
2077 | more 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 |
2085 | This variable describes if and under what circumstances the cycling |
2086 | mechanism for TODO keywords will be replaced by a single-key, direct | |
2087 | selection scheme. | |
2088 | ||
2089 | When nil, fast selection is never used. | |
2090 | ||
2091 | When the symbol `prefix', it will be used when `org-todo' is called with | |
2092 | a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and `C-u t' | |
2093 | in an agenda buffer. | |
2094 | ||
2095 | When t, fast selection is used by default. In this case, the prefix | |
2096 | argument forces cycling instead. | |
2097 | ||
2098 | In all cases, the special interface is only used if access keys have actually | |
2099 | been assigned by the user, i.e. if keywords in the configuration are followed | |
2100 | by 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 |
2109 | ALL-HEADLINES means update todo statistics by including headlines |
2110 | with no TODO keyword as well, counting them as not done. | |
2111 | A list of TODO keywords means the same, but skip keywords that are | |
2112 | not in this list. | |
2113 | ||
2114 | When this is set, todo statistics is updated in the parent of the | |
2115 | current 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 | 2126 | When nil, all entries in the subtree are considered. |
54a0dee5 CD |
2127 | This has only an effect if `org-provide-todo-statistics' is set. |
2128 | To set this to nil for only a single subtree, use a COOKIE_DATA | |
2129 | property 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. | |
2135 | The new state (a string with a TODO keyword, or nil) is available in the | |
2136 | Lisp 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 | ||
2143 | Each function gets as its single argument a property list, see | |
2144 | `org-trigger-hook' for more information about this list. | |
2145 | ||
2146 | If any of the functions in this hook returns nil, the state change | |
2147 | is blocked.") | |
2148 | ||
2149 | (defvar org-trigger-hook nil | |
2150 | "Hook for functions that are triggered by a state change. | |
2151 | ||
2152 | Each function gets as its single argument a property list with at least | |
2153 | the following elements: | |
2154 | ||
2155 | (:type type-of-change :position pos-at-entry-start | |
2156 | :from old-state :to new-state) | |
2157 | ||
2158 | Depending on the type, more properties may be present. | |
2159 | ||
2160 | This mechanism is currently implemented for: | |
2161 | ||
2162 | TODO 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 |
2171 | Also, if a parent has an :ORDERED: property, switching an entry to DONE will |
2172 | be blocked if any prior sibling is not yet done. | |
c8d0cf5c CD |
2173 | Finally, if the parent is blocked because of ordered siblings of its own, |
2174 | the child will also be blocked. | |
5ace2fe5 CD |
2175 | This variable needs to be set before org.el is loaded, and you need to |
2176 | restart Emacs after a change to make the change effective. The only way | |
2177 | to 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 |
2190 | When this is nil, checkboxes have no influence on switching TODO states. |
2191 | When non-nil, you first need to check off all check boxes before the TODO | |
2192 | entry can be switched to DONE. | |
5ace2fe5 CD |
2193 | This variable needs to be set before org.el is loaded, and you need to |
2194 | restart Emacs after a change to make the change effective. The only way | |
2195 | to 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 |
2208 | So when the command \\[org-insert-todo-heading] is used, state change |
2209 | logging will apply if appropriate. When nil, the new TODO item will | |
2210 | be 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 |
2216 | This is the default behavior. However, setting this to nil allows a |
2217 | convenient way to select a TODO state and bypass any logging associated | |
2218 | with 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. | |
2224 | This is a list. Each entry is | |
2225 | ||
2226 | (state-change (tag . flag) .......) | |
2227 | ||
2228 | State-change can be a string with a state, and empty string to indicate the | |
2229 | state that has no TODO keyword, or it can be one of the symbols `todo' | |
2230 | or `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 | ||
2246 | Possible values are: | |
2247 | ||
2248 | nil Don't add anything, just change the keyword | |
2249 | time Add a time stamp to the task | |
8bfe682a | 2250 | note Prompt for a note and add it with template `org-log-note-headings' |
4b3a9ba7 | 2251 | |
db55f368 CD |
2252 | This 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 | |
2258 | You can have local logging settings for a subtree by setting the LOGGING | |
2259 | property 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 | ||
2276 | Possible values are: | |
2277 | ||
2278 | nil Don't add anything, just change the date | |
2279 | time Add a time stamp to the task | |
2280 | note Prompt for a note and add it with template `org-log-note-headings' | |
2281 | ||
2282 | This 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 | ||
2297 | Possible values are: | |
2298 | ||
2299 | nil Don't add anything, just change the date | |
2300 | time Add a time stamp to the task | |
2301 | note Prompt for a note and add it with template `org-log-note-headings' | |
2302 | ||
2303 | This option can also be set with on a per-file-basis with | |
2304 | ||
2305 | #+STARTUP: nologredeadline | |
2306 | #+STARTUP: logredeadline | |
2307 | #+STARTUP: lognoteredeadline | |
2308 | ||
2309 | You can have local logging settings for a subtree by setting the LOGGING | |
2310 | property 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 |
2320 | This can also be configured on a per-file basis by adding one of |
2321 | the 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 |
2331 | When 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 | 2346 | The value is an alist, with the car being a symbol indicating the note |
3278a016 | 2347 | context, and the cdr is the heading to be used. The heading may also be the |
d3f4dbe8 CD |
2348 | empty 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 | ||
2356 | In fact, it is not a good idea to change the `state' entry, because | |
2357 | agenda 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 |
2378 | When nil, state changes notes will be inserted after the headline and |
2379 | any scheduling and clock lines, but not inside a drawer. | |
2380 | ||
2381 | The value of this variable should be the name of the drawer to use. | |
3ab2c837 | 2382 | LOGBOOK is proposed as the default drawer for this purpose, you can |
c8d0cf5c CD |
2383 | also set this to a string to define the drawer of your choice. |
2384 | ||
2385 | A value of t is also allowed, representing \"LOGBOOK\". | |
2386 | ||
2387 | If this variable is set, `org-log-state-notes-insert-after-drawers' | |
2388 | will be ignored. | |
2389 | ||
2390 | You can set the property LOG_INTO_DRAWER to overrule this setting for | |
2391 | a 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. | |
2404 | If the current entry has or inherits a LOG_INTO_DRAWER property, it will be | |
2405 | used 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 |
2414 | Only the drawers that *immediately* follow the headline and the |
2415 | deadline/scheduled line are skipped. | |
2416 | When nil, insert notes right after the heading and perhaps the line | |
c8d0cf5c CD |
2417 | with deadline/scheduling if present. |
2418 | ||
2419 | This variable will have no effect if `org-log-into-drawer' is | |
2420 | set." | |
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. |
2427 | When 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. | |
2434 | By default this is the first task in a TODO sequence, or the previous state | |
2435 | in a TODO_TYP set. But you can specify another task here. | |
2436 | alternatively, 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 | 2443 | An auto-repeating task is immediately switched back to TODO when |
86fbb8ca | 2444 | marked DONE. If you are not logging state changes (by adding \"@\" |
8d642074 CD |
2445 | or \"!\" to the TODO keyword definition), or set `org-log-done' to |
2446 | record a closing note, there will be no record of the task moving | |
3ab2c837 | 2447 | through DONE. This variable forces taking a note anyway. |
2a57416f CD |
2448 | |
2449 | nil Don't force a record | |
2450 | time Record a time stamp | |
2451 | note Record a note | |
2452 | ||
15841868 JW |
2453 | This 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 | ||
2459 | You can have local logging settings for a subtree by setting the LOGGING | |
2460 | property 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 |
2476 | When nil, these commands will be disabled, so that you never accidentally |
2477 | set 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. | |
2483 | Must 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. |
2489 | Must 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 |
2495 | This is the priority an item gets if no explicit priority is given. |
2496 | When starting to cycle on an empty priority the first step in the cycle | |
2497 | depends on `org-priority-start-cycle-with-default'. The resulting first | |
2498 | step priority must not exceed the range from `org-highest-priority' to | |
2499 | `org-lowest-priority' which means that `org-default-priority' has to be | |
2500 | in this range exclusive or inclusive the range boundaries. Else the | |
2501 | first step refuses to set the default and the second will fall back | |
2502 | to (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 | 2508 | When this is nil, the first step in the cycle will be (depending on the |
3ab2c837 BG |
2509 | command used) one higher or lower than the default priority. |
2510 | See 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. | |
2516 | The string is normally the headline. If this is nil Org computes the | |
2517 | priority from the priority cookie like [#A] in the headline. It returns | |
2518 | an integer, increasing by 1000 for each priority level. | |
2519 | The user can set a different function here, which should take a string | |
2520 | as 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 |
2531 | When nil, these labeled time stamps are forces into the second line of an |
2532 | entry, just after the headline. When scheduling from the global TODO list, | |
2533 | the 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. | |
2539 | It 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. | |
2543 | These are two values, the first applies when first creating a time stamp. | |
2544 | The second applies when changing it with the commands `S-up' and `S-down'. | |
2545 | When changing the time stamp, this means that it will change in steps | |
5bf7807a | 2546 | of N minutes, as given by the second value. |
2a57416f CD |
2547 | |
2548 | When a setting is 0 or 1, insert the time unmodified. Useful rounding | |
2549 | numbers should be factors of 60, so for example 5, 10, 15. | |
2550 | ||
86fbb8ca CD |
2551 | When this is larger than 1, you can still force an exact time stamp by using |
2552 | a double prefix argument to a time stamp command like `C-c .' or `C-c !', | |
2a57416f CD |
2553 | and by using a prefix arg to `S-up/down' to specify the exact number |
2554 | of 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 |
2572 | The formats are defined through the variable `org-time-stamp-custom-formats'. |
2573 | To 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 | 2583 | These 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 |
2585 | end of the second format. The custom formats are also honored by export |
2586 | commands, 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. |
2600 | This 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. | |
2606 | org-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 | |
2612 | org-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. | |
2618 | This variable governs the display in sparse trees and in the agenda. | |
2619 | When 0 or negative, it means use this number (the absolute value of it) | |
c8d0cf5c CD |
2620 | even if a deadline has a different individual lead time specified. |
2621 | ||
2622 | Custom 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 | 2629 | This affects the following situations: |
8bfe682a | 2630 | 1. 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 | 2633 | 2. 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 |
2638 | If you set this variable to the symbol `time', then also the following |
2639 | will work: | |
2640 | ||
2641 | 3. 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 |
2644 | Currently none of this works for ISO week specifications. |
2645 | ||
2646 | When this option is nil, the current day, month and year will always be | |
afe98dfa CD |
2647 | used as defaults. |
2648 | ||
2649 | See 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? | |
2658 | The default is to do the same as configured in `org-read-date-prefer-future'. | |
3ab2c837 | 2659 | But you can also set a deviating value here. |
afe98dfa | 2660 | This 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 | ||
2672 | Depending on the system Emacs is running on, certain dates cannot | |
2673 | be represented with the type used internally to represent time. | |
2674 | Dates between 1970-1-1 and 2038-1-1 can always be represented | |
2675 | correctly. Some systems allow for earlier dates, some for later, | |
2676 | some for both. One way to find out it to insert any date into an | |
2677 | Org buffer, putting the cursor on the year and hitting S-up and | |
2678 | S-down to test the range. | |
2679 | ||
2680 | When this variable is set to t, the date/time prompt will not let | |
2681 | you specify dates outside the 1970-2037 range, so it is certain that | |
2682 | these dates will work in whatever version of Emacs you are | |
2683 | running, and also that you can move a file from one Emacs implementation | |
8350f087 | 2684 | to another. Whenever Org is forcing the year for you, it will display |
3ab2c837 BG |
2685 | a message and beep. |
2686 | ||
2687 | When this variable is nil, Org will check if the date is | |
2688 | representable in the specific Emacs implementation you are using. | |
2689 | If not, it will force a year, usually the current year, and beep | |
2690 | to remind you. Currently this setting is not recommended because | |
2691 | the likelihood that you will open your Org files in an Emacs that | |
2692 | has limited date range is not negligible. | |
2693 | ||
2694 | A workaround for this problem is to use diary sexp dates for time | |
2695 | stamps 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 |
2701 | This 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 |
2707 | In the calendar, the date can be selected with mouse-1. However, the |
2708 | minibuffer will also be active, and you can simply enter the date as well. | |
2709 | When 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. | |
2718 | Add key definitions to `minibuffer-local-map', which will be a temporary | |
2719 | copy." | |
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 |
2725 | This 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 |
2732 | IMPORTANT: This is a feature whose implementation is and likely will |
2733 | remain incomplete. Really, it is only here because past midnight seems to | |
71d35b24 | 2734 | be 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 |
2740 | When 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 |
2746 | When a timestamp is modified and the calendar window is visible, it will be |
2747 | moved 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. | |
2758 | When this list is nil, Org-mode will base TAG input on what is already in the | |
2759 | buffer. | |
0b8568f5 JW |
2760 | The value of this variable is an alist, the car of each entry must be a |
2761 | keyword as a string, the cdr may be a character that is used to select | |
2762 | that tag through the fast-tag-selection interface. | |
2763 | See 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. | |
2779 | This is in addition to any in buffer settings or customizations | |
2780 | of `org-tag-alist'. | |
2781 | When this list is nil, Org-mode will base TAG input on `org-tag-alist'. | |
2782 | The value of this variable is an alist, the car of each entry must be a | |
2783 | keyword as a string, the cdr may be a character that is used to select | |
2784 | that tag through the fast-tag-selection interface. | |
2785 | See the manual for details. | |
2786 | To 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. | |
2799 | Instead of customizing this variable directly, you might want to | |
acedf35c | 2800 | set it locally for capture buffers, because there no list of |
ed21c5c8 CD |
2801 | tags 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. | |
2813 | The tags will be inherited if the variable `org-use-tag-inheritance' | |
2814 | says they should be. | |
8bfe682a | 2815 | This 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 |
2819 | This is a special interface to select and deselect tags with single keys. |
2820 | When nil, fast selection is never used. | |
2821 | When the symbol `auto', fast selection is used if and only if selection | |
2822 | characters for tags have been configured, either through the variable | |
2823 | `org-tag-alist' or through a #+TAGS line in the buffer. | |
2824 | When t, fast selection is always used and selection keys are assigned | |
2825 | automatically 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 | 2834 | When nil, you have to press RET to exit it. |
d3f4dbe8 CD |
2835 | During fast tag selection, you can toggle this flag with `C-c'. |
2836 | This variable can also have the value `expert'. In this case, the window | |
2837 | displaying 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 | 2846 | This 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. |
2850 | If this number is positive, it specifies the column. If it is negative, | |
2851 | it 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. |
2858 | Some operations (i.e. demoting) change the length of a headline and | |
2859 | therefore shift the tags around. With this option turned on, after | |
2860 | each 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 | 2866 | When nil, only the tags directly given in a specific line apply there. |
20908596 | 2867 | This may also be a list of tags that should be inherited, or a regexp that |
ff4be292 CD |
2868 | matches tags that should be inherited. Additional control is possible |
2869 | with the variable `org-tags-exclude-from-inheritance' which gives an | |
2870 | explicit list of tags to be excluded from inheritance., even if the value of | |
2871 | `org-use-tag-inheritance' would select it for inheritance. | |
2872 | ||
2873 | If this option is t, a match early-on in a tree can lead to a large | |
2874 | number of matches in the subtree when constructing the agenda or creating | |
2875 | a sparse tree. If you only want to see the first match in a tree during | |
2876 | a 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. | |
2886 | This is a way to exclude a few tags from inheritance. For way to do | |
2887 | the opposite, to actively allow inheritance for selected tags, | |
2888 | see 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. |
2906 | This variable applies to tags/property searches, and also to stuck | |
2907 | projects because this search is based on a tags match as well. | |
2908 | ||
2909 | When set to the symbol `indented', sublevels are indented with | |
2910 | leading dots. | |
2911 | ||
ab27a4a0 CD |
2912 | Because of tag inheritance (see variable `org-use-tag-inheritance'), |
2913 | the sublevels of a headline matching a tag search often also match | |
2914 | the same search. Listing all of them can create very long lists. | |
2915 | Setting this variable to nil causes subtrees of a match to be skipped. | |
ff4be292 CD |
2916 | |
2917 | This variable is semi-obsolete and probably should always be true. It | |
2918 | is 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'. | |
2949 | When `indent-line' hits a property definition, it will format the line | |
2950 | according to this format, mainly to make sure that the values are | |
2951 | lined-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 | 2958 | This setting is chiefly used during property searches. Turning it on can |
20908596 CD |
2959 | cause significant overhead when doing a search, which is why it is not |
2960 | on by default. | |
2961 | ||
03f3cf35 | 2962 | When nil, only the properties directly given in the current entry count. |
20908596 CD |
2963 | When t, every property is inherited. The value may also be a list of |
2964 | properties that should have inheritance, or a regular expression matching | |
2965 | properties that should be inherited. | |
03f3cf35 JW |
2966 | |
2967 | However, note that some special properties use inheritance under special | |
2968 | circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, | |
2969 | and the properties ending in \"_ALL\" when they are used as descriptor | |
20908596 CD |
2970 | for valid values of a property. |
2971 | ||
2972 | Note for programmers: | |
2973 | When querying an entry with `org-entry-get', you can control if inheritance | |
2974 | should be used. By default, `org-entry-get' looks only at the local | |
2975 | properties. You can request inheritance by setting the inherit argument | |
2976 | to t (to force inheritance) or to `selective' (to respect the setting | |
2977 | in 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. |
2998 | This 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. | |
3006 | When this is the empty string, as many characters as possible are shown, | |
3007 | but then there will be no visual indication that the field has been truncated. | |
3008 | When this is a string of length N, the last N characters of a truncated | |
3009 | field are replaced by this string. If the column is narrower than the | |
3010 | ellipses 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. | |
3016 | For example, it can be used to cut out a certain part from a time stamp. | |
40ac2137 | 3017 | The function must take 2 arguments: |
621f83e4 | 3018 | |
33306645 | 3019 | column-title The title of the column (*not* the property name) |
621f83e4 CD |
3020 | value The value that should be modified. |
3021 | ||
3022 | The function should return the value that should be displayed, | |
3023 | or 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. | |
3029 | Effort 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 |
3039 | These are fixed values, for the preset properties. The user variable |
3040 | that can be used to add to this list is `org-global-properties'. | |
3041 | ||
3042 | The entries in this list are cons cells where the car is a property | |
3043 | name and cdr is a string with the value. If the value represents | |
3044 | multiple items like an \"_ALL\" property, separate the items by | |
3045 | spaces.") | |
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 | |
3050 | This list will be combined with the constant `org-global-properties-fixed'. | |
3051 | ||
3052 | The entries in this list are cons cells where the car is a property | |
3053 | name and cdr is a string with the value. | |
3054 | ||
ce4fdcb9 CD |
3055 | You 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. |
3066 | Valid for the current buffer. | |
3067 | This 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. | |
3077 | Such files should use a file variable to set it, for example | |
3078 | ||
a3fbe8c4 | 3079 | # -*- mode: org; org-category: \"ELisp\" |
ab27a4a0 CD |
3080 | |
3081 | or contain a special line | |
3082 | ||
3083 | #+CATEGORY: ELisp | |
3084 | ||
3085 | If the file does not specify a category, then file's base name | |
3086 | is 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. | |
3092 | Entries 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 |
3095 | If 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 |
3098 | If the value of the variable is not a list but a single file name, then |
3099 | the list of agenda files is actually stored and maintained in that file, one | |
ed21c5c8 CD |
3100 | agenda file per line. In this file paths can be given relative to |
3101 | `org-directory'. Tilde expansion and environment variable substitution | |
3102 | are 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 | 3110 | If any element in the list in that variable contains a directory instead |
03f3cf35 JW |
3111 | of a normal file, all files in that directory that are matched by this |
3112 | regular 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 | 3118 | These files will be search in addition to the agenda files by the |
2a57416f CD |
3119 | commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'. |
3120 | Note that these files will only be searched for text search commands, | |
20908596 | 3121 | not for the other agenda views like todo lists, tag searches or the weekly |
2a57416f | 3122 | agenda. This variable is intended to list notes and possibly archive files |
20908596 CD |
3123 | that should also be searched by these two commands. |
3124 | In fact, if the first element in the list is the symbol `agenda-archives', | |
3125 | than all archive files of all agenda files will be added to the search | |
3126 | scope." | |
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'. |
3138 | A 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. | |
3144 | The command `org-calendar-goto-agenda' will be bound to this key. The | |
3145 | default is the character `c' because then `c' can be used to switch back and | |
3146 | forth 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. | |
3152 | The command `org-agenda-action' will be bound to this key. The | |
3153 | default 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. | |
3159 | This option is irrelevant until `org-agenda-diary-file' has been configured | |
3160 | to 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 | |
3163 | if you want to continue doing this, you need to change this to a different | |
3164 | key." | |
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. | |
3170 | When this is the symbol `diary-file', the functionality in the Emacs | |
3171 | calendar will be used to add entries to the `diary-file'. But when this | |
3172 | points 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. |
3201 | This 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. | |
3222 | When 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. | |
3247 | It is imperative that this header make sure that no page number | |
ed21c5c8 CD |
3248 | appears on the page. The package defined in the variables |
3249 | `org-export-latex-default-packages-alist' and `org-export-latex-packages-alist' | |
3250 | will either replace the placeholder \"[PACKAGES]\" in this header, or they | |
3251 | will 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. | |
3295 | Change this only if one of the packages here causes an incompatibility | |
3296 | with another package you are using. | |
3297 | The packages in this list are needed by one part or another of Org-mode | |
86fbb8ca | 3298 | to 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 | ||
3309 | Therefore you should not modify this variable unless you know what you | |
3310 | are doing. The one reason to change it anyway is that you might be loading | |
3311 | some other package that conflicts with one of the default packages. | |
86fbb8ca CD |
3312 | Each cell is of the format \( \"options\" \"package\" snippet-flag\). |
3313 | If SNIPPET-FLAG is t, the package also needs to be included when | |
3314 | compiling 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 | 3328 | These will be inserted after `org-export-latex-default-packages-alist'. |
86fbb8ca CD |
3329 | Each cell is of the format \( \"options\" \"package\" snippet-flag \). |
3330 | SNIPPET-FLAG, when t, indicates that this package is also needed when | |
3331 | turning LaTeX snippets into images for inclusion into HTML. | |
3332 | Make 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. | |
3356 | When nil, the entire headline is fontified. | |
3357 | Changing it requires restart of `font-lock-mode' to become effective | |
3358 | also 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 |
3364 | This works by using the face `org-hide' for these stars. This |
3365 | face is white for a light background, and black for a dark | |
3366 | background. You may have to customize the face `org-hide' to | |
3367 | make this work. | |
3368 | Changing it requires restart of `font-lock-mode' to become effective | |
3369 | also in regions already fontified. | |
3370 | You may also set this on a per-file basis by adding one of the following | |
3371 | lines 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. |
3380 | For example, a value '(title) for this list will make the document's title | |
3381 | appear 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 |
3390 | Normally, only the TODO/DONE keyword indicates the state of a headline. |
3391 | When 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. | |
3398 | Changing 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. | |
3404 | This is useful when setting a background color for the | |
8bfe682a | 3405 | org-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. | |
3421 | When 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. |
3432 | After a match, the match groups contain these elements: | |
afe98dfa CD |
3433 | 0 The match of the full regular expression, including the characters |
3434 | before and after the proper match | |
86fbb8ca CD |
3435 | 1 The character before the proper match, or empty at beginning of line |
3436 | 2 The proper match, including the leading and trailing markers | |
3437 | 3 The leading marker like * or /, indicating the type of highlighting | |
3438 | 4 The text between the emphasis markers, not including the markers | |
3439 | 5 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 | 3502 | This is a list with five entries. Terminology: In an emphasis string |
edd21304 CD |
3503 | like \" *strong word* \", we call the initial space PREMATCH, the final |
3504 | space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters | |
3505 | and \"trong wor\" is the body. The different components in this variable | |
3506 | specify what is allowed/forbidden in each part: | |
3507 | ||
3508 | pre Chars allowed as prematch. Beginning of line will be allowed too. | |
3509 | post Chars allowed as postmatch. End of line will be allowed too. | |
a3fbe8c4 | 3510 | border The chars *forbidden* as border characters. |
edd21304 CD |
3511 | body-regexp A regexp like \".\" to match a body character. Don't use |
3512 | non-shy groups here, and don't allow newline here. | |
3513 | newline The maximum number of newlines allowed in an emphasis exp. | |
8c6fb58b | 3514 | |
c44f0d75 | 3515 | Use 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 |
3536 | Text starting and ending with a special character will be emphasized, for |
3537 | example *bold*, _underlined_ and /italic/. This variable sets the marker | |
a3fbe8c4 | 3538 | characters, the face to be used by font-lock for highlighting in Org-mode |
c44f0d75 | 3539 | Emacs buffers, and the HTML tags to be used for this. |
c8d0cf5c | 3540 | For LaTeX export, see the variable `org-export-latex-emphasis-alist'. |
86fbb8ca | 3541 | For DocBook export, see the variable `org-export-docbook-emphasis-alist'. |
c44f0d75 | 3542 | Use 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. | |
3558 | This 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 |
3569 | Note that `ido-mode' must be active for this variable to be relevant. |
3570 | If you decide to turn this variable on, you might well want to turn off | |
54a0dee5 CD |
3571 | `org-outline-path-complete-in-steps'. |
3572 | See 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 |
3578 | Note that `iswitchb-mode' must be active for this variable to be relevant. |
3579 | If you decide to turn this variable on, you might well want to turn off | |
3580 | `org-outline-path-complete-in-steps'. | |
8bfe682a | 3581 | Note 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. |
3587 | Normal 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. |
3669 | This 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. | |
3702 | If 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. | |
3843 | The 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. | |
3857 | Otherwise, 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. | |
3899 | If 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. | |
3936 | Use 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 |
3961 | The value of this variable is a string, consisting of two parts, |
3962 | separated by a double-colon. The first part is a filename and | |
3963 | the second part is a headline. | |
20908596 | 3964 | |
ce4fdcb9 CD |
3965 | When the filename is omitted, archiving happens in the same file. |
3966 | %s in the filename will be replaced by the current file | |
3967 | name (without the directory part). Archiving to a different file | |
3968 | is useful to keep archived entries from contributing to the | |
3969 | Org-mode Agenda. | |
20908596 | 3970 | |
ce4fdcb9 CD |
3971 | The archived entries will be filed as subtrees of the specified |
3972 | headline. When the headline is omitted, the subtrees are simply | |
0bd48b37 CD |
3973 | filed away at the end of the file, as top-level entries. Also in |
3974 | the heading you can use %s to represent the file name, this can be | |
3975 | useful when using the same archive for a number of different files. | |
20908596 CD |
3976 | |
3977 | Here 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 | ||
3997 | You may set this option on a per-file basis by adding to the buffer a | |
3998 | line like | |
3999 | ||
4000 | #+ARCHIVE: basement::** Finished Tasks | |
4001 | ||
4002 | You may also define it locally for a subtree by setting an ARCHIVE property | |
4003 | in the entry. If such a property is found in an entry, or anywhere up | |
4004 | the 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. | |
4010 | An archived subtree does not open during visibility cycling, and does | |
4011 | not contribute to the agenda listings. | |
4012 | After changing this, font-lock must be restarted in the relevant buffers to | |
4013 | get 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 |
4020 | An archived tree is a tree marked with the tag ARCHIVE. The use of this |
4021 | variable is no longer recommended, you should leave it at the value t. | |
4022 | Instead, 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 |
4035 | An archived tree is a tree marked with the tag ARCHIVE. |
4036 | When nil, archived trees will stay folded. You can still open them with | |
4037 | normal 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. | |
4044 | When nil, matches in these trees are highlighted, but the trees are kept in | |
4045 | collapsed 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: | |
4145 | group 1: the stars | |
4146 | group 2: The todo keyword, maybe | |
4147 | group 3: Priority cookie | |
4148 | group 4: True headline | |
4149 | group 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. | |
4153 | This regexp will match the headline of any node which hase the exact | |
4154 | headline text that is put into the format, but may have any TODO state, | |
4155 | priority 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. | |
4159 | Also 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. | |
4214 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
4215 | groups carry important information: | |
4216 | 0 the full match | |
4217 | 1 the first time, range or not | |
4218 | 8 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. | |
4226 | Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following | |
4227 | groups carry important information: | |
4228 | 0 the full match | |
4229 | 7 hours of duration | |
4230 | 9 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. | |
4239 | After a match, the following groups carry important information: | |
4240 | 0 the full match | |
8bfe682a | 4241 | 1 date plus weekday, for back referencing to make sure both times are on the same day |
20908596 CD |
4242 | 2 the first time, range or not |
4243 | 4 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. |
4298 | Each element is a list of three items: The startup options as written | |
4299 | in the #+STARTUP line, the corresponding variable, and the value to | |
4300 | set this variable to if the option is found. An optional forth element PUSH | |
4301 | means 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. | |
4615 | This 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. | |
4637 | Respect 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. | |
4663 | This 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. | |
4688 | This 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 |
4711 | Org-mode develops organizational tasks around a NOTES file which |
4712 | contains information about projects as plain text. Org-mode is | |
4713 | implemented on top of outline-mode, which is ideal to keep the content | |
4714 | of large files well structured. It supports ToDo items, deadlines and | |
4715 | time stamps, which magically appear in the diary listing of the Emacs | |
4716 | calendar. Tables are easily created with a built-in table editor. | |
4717 | Plain text URL-like links connect to websites, emails (VM), Usenet | |
4718 | messages (Gnus), BBDB entries, and any files related to the project. | |
4719 | For printing and sharing of notes, an Org-mode file (or a part of it) | |
4720 | can be exported as a structured ASCII or HTML file. | |
35fb9989 | 4721 | |
20908596 | 4722 | The 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. | |
4914 | Here is what the match groups contain after a match: | |
4915 | 1: http: | |
4916 | 2: http | |
4917 | 3: path | |
4918 | 4: [desc] | |
4919 | 5: 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. | |
4927 | This 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. | |
4933 | Opening delimiter is LEFT, and closing delimiter is RIGHT, both given | |
4934 | as single character strings. | |
4935 | The regexp returned will match the entire expression including the | |
4936 | delimiters. It will also define a single group which contains the | |
4937 | match except for the outermost delimiters. The maximum depth of | |
4938 | stacked 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. | |
4968 | This 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. |
5031 | This one does not require the space after the date, so it can be used | |
5032 | on 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. | |
5050 | The 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. | |
5081 | If there is an active region, change that region to a new emphasis. | |
5082 | If there is no region, just insert the marker characters and position | |
5083 | the cursor between them. | |
5084 | CHAR should be either the marker character, or the first character of the | |
5085 | HTML tag associated with that emphasis. If CHAR is a space, the means | |
5086 | to remove the emphasis of the selected region. | |
5087 | If char is not given (for example in an interactive call) it | |
5088 | will 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 | '(("\\\\-" . "­") | |
5403 | ("---\\([^-]\\)" . "—\\1") | |
5404 | ("--\\([^-]\\)" . "–\\1") | |
5405 | ("\\.\\.\\." . "…")) | |
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. | |
5496 | With 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. | |
5507 | The regular expression finds the targets also if there is a line break | |
5508 | between 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. |
5534 | This function assumes that the cursor is at the beginning of a line matched | |
86fbb8ca | 5535 | by `outline-regexp'. Otherwise it returns garbage. |
8bfe682a | 5536 | If this is called at a normal headline, the level is the number of stars. |
3ab2c837 | 5537 | Use `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 | 5552 | This is called after `org-font-lock-extra-keywords' is defined, but before |
afe98dfa CD |
5553 | it is installed to be used by font lock. This can be useful if something |
5554 | needs 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. | |
5718 | If 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. | |
5727 | When 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. | |
5757 | If 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. | |
5792 | The will remove the raise properties that are used to show superscripts | |
5793 | and 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 | 5858 | This is the command invoked in Org-mode by the TAB key. Its main purpose |
8bfe682a | 5859 | is outline visibility cycling, but it also invokes other actions |
c8d0cf5c | 5860 | in 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 | 6153 | With \\[universal-argument] prefix arg, switch to startup visibility. |
b349f79f | 6154 | With 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 |
6218 | Really, this shows all headlines with level equal or greater than the level |
6219 | of the first headline in the buffer. This is important, because if the | |
6220 | first headline is not level one, then (hide-sublevels 1) gives confusing | |
6221 | results." | |
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. | |
6233 | With 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. | |
6253 | This 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. | |
6305 | The region to be covered depends on STATE when called through | |
6306 | `org-cycle-hook'. Lisp program can use t for STATE to get the | |
6307 | entire buffer covered. Note that an empty line is only shown if there | |
33306645 | 6308 | are 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. | |
6359 | This is useful for operations that need to scan all of a user's | |
6360 | open 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 | 6411 | Optional 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. | |
6421 | These are overlays with the `invisible' property value `outline'. | |
6422 | The return value is a list of cons cells, with start and stop | |
6423 | positions for each overlay. | |
6424 | If 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. | |
6443 | DATA 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. |
6466 | Optional 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. | |
6587 | RET=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 |
6596 | When you want look-up or go to a different location in a document, the |
6597 | fastest way is often to fold the entire buffer and then dive into the tree. | |
6598 | This method has the disadvantage, that the previous location will be folded, | |
6599 | which may not be what you want. | |
2a57416f | 6600 | |
20908596 CD |
6601 | This command works around this by showing a copy of the current buffer |
6602 | in an indirect buffer, in overview mode. You can dive into the tree in | |
6603 | that copy, use org-occur and incremental search to find a location. | |
6604 | When pressing RET or `Q', the command returns to the original buffer in | |
6605 | which the visibility is still unchanged. After RET is will also jump to | |
3ab2c837 BG |
6606 | the location selected in the indirect buffer and expose the headline |
6607 | hierarchy 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. | |
6639 | This function uses a recursive edit. It returns the selected position | |
6640 | or 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. | |
6752 | With numerical prefix ARG, go up to this level and then take that tree. | |
6753 | If ARG is negative, go up that many levels. | |
6754 | If `org-indirect-buffer-display' is not `new-frame', the command removes the | |
6755 | indirect buffer previously made with this command, to avoid proliferation of | |
86fbb8ca CD |
6756 | indirect buffers. However, when you call the command with a \ |
6757 | \\[universal-argument] prefix, or | |
20908596 CD |
6758 | when `org-indirect-buffer-display' is `new-frame', the last buffer |
6759 | is kept so that you can work with several indirect buffers at the same time. | |
86fbb8ca CD |
6760 | If `org-indirect-buffer-display' is `dedicated-frame', the \ |
6761 | \\[universal-argument] prefix also | |
20908596 CD |
6762 | requests that a new frame be made for the new buffer, so that the dedicated |
6763 | frame 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. |
6844 | If point is in a plain list and FORCE-HEADING is nil, create a new list item. | |
6845 | If point is at the beginning of a headline, insert a sibling before the | |
afe98dfa CD |
6846 | current headline. If point is not at the beginning, split the line, |
6847 | create 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 |
6850 | When INVISIBLE-OK is set, stop at invisible headlines when going back. |
6851 | This 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. | |
6963 | When NO-TAGS is non-nil, don't include tags. | |
6964 | When 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. | |
6983 | This 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. |
7026 | If the heading has no TODO state, or if the state is DONE, use the first | |
7027 | state (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. | |
7057 | Works 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. | |
7066 | Works 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. | |
7077 | The cursor will be at the beginning of the entry. | |
7078 | When 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. | |
7082 | The cursor will be at the beginning of the entry. | |
7083 | When 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. | |
7087 | See 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'. | |
7095 | See 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. | |
7104 | If the region is active in `transient-mark-mode', promote all headings | |
7105 | in 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. | |
7115 | If the region is active in `transient-mark-mode', demote all headings | |
7116 | in 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. | |
7137 | The 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. | |
7146 | Returns 0 for the first headline in the buffer, and nil if before the | |
7147 | first 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. |
7159 | This 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 | |
7167 | time 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' | |
7173 | LEVEL is a current level, CHANGE is by how much the level should be | |
7174 | modified. Even if CHANGE is nil, LEVEL may be returned modified because | |
7175 | even 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. | |
7191 | If the region is active in `transient-mark-mode', promote all headings | |
7192 | in 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. | |
7208 | If the region is active in `transient-mark-mode', demote all headings | |
7209 | in 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. |
7224 | This goes first to child, then to parent, level, then up the hierarchy. | |
7225 | After 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 |
7287 | However, if any line in the current entry has no indentation, or if it |
7288 | would 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. | |
7308 | This will leave level 1 alone, convert level 2 to level 3, level 3 to | |
7309 | level 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. |
7324 | This promotes level 3 to level 2, level 5 to level 3 etc. If the | |
7325 | file contains a section with an even level, conversion would | |
7326 | destroy the structure of the file. An error is signaled in this | |
7327 | case." | |
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. | |
7437 | This is actually only a copy of the kill, because we use the normal kill | |
7438 | ring. 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? | |
7442 | This 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. | |
7446 | With prefix arg N, cut this many sequential subtrees. | |
7447 | This 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. |
7453 | With prefix arg N, cut this many sequential subtrees. | |
7454 | This is a short-hand for marking the subtree and then copying it. | |
b349f79f CD |
7455 | If CUT is non-nil, actually cut the subtree. |
7456 | If FORCE-STORE-MARKERS is non-nil, store the relative locations | |
7457 | of some markers in the region, even if CUT is non-nil. This is | |
7458 | useful 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. |
7489 | The entire subtree is promoted or demoted in order to match a new headline | |
ce4fdcb9 | 7490 | level. |
93b62de8 CD |
7491 | |
7492 | If the cursor is at the beginning of a headline, the same level as | |
7493 | that headline is used to paste the tree | |
7494 | ||
7495 | If not, the new level is derived from the *visible* headings | |
20908596 CD |
7496 | before and after the insertion point, and taken to be the inferior headline |
7497 | level of the two. So if the previous visible heading is level 3 and the | |
7498 | next is level 4 (or vice versa), level 4 will be used for insertion. | |
7499 | This makes sure that the subtree remains an independent subtree and does | |
7500 | not swallow low level entries. | |
03f3cf35 | 7501 | |
20908596 CD |
7502 | You can also force a different level, either by using a numeric prefix |
7503 | argument, or by inserting the heading marker by hand. For example, if the | |
7504 | cursor is after \"*****\", then the tree will be shifted to level 5. | |
b0a10108 | 7505 | |
93b62de8 | 7506 | If optional TREE is given, use this text instead of the kill ring. |
b0a10108 | 7507 | |
93b62de8 CD |
7508 | When FOR-YANK is set, this is called by `org-yank'. In this case, do not |
7509 | move back over whitespace before inserting, and move point to the end of | |
7510 | the 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. | |
7600 | Returns nil if kill does not start with a headline, or if the first | |
7601 | headline level is not the largest headline level in the tree. | |
7602 | So this will actually accept several entries of equal levels as well, | |
7603 | which is OK for `org-paste-subtree'. | |
7604 | If 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. | |
7625 | Those markers are stored together with their positions relative to | |
7626 | the start of the region.") | |
7627 | ||
7628 | (defun org-save-markers-in-region (beg end) | |
7629 | "Check markers in region. | |
7630 | If these markers are between BEG and END, record their position relative | |
7631 | to BEG, so that after moving the block of text, we can put the markers back | |
7632 | into place. | |
7633 | This function gets called just before an entry or tree gets cut from the | |
7634 | buffer. After re-insertion, `org-reinstall-markers-in-region' must be | |
7635 | called 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. | |
7644 | If 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. | |
7691 | The clones will be inserted as siblings. | |
7692 | ||
86fbb8ca CD |
7693 | In interactive use, the user will be prompted for the number of |
7694 | clones to be produced, and for a time SHIFT, which may be a | |
7695 | repeater as used in time stamps, for example `+3d'. | |
c8d0cf5c | 7696 | |
86fbb8ca CD |
7697 | When a valid repeater is given and the entry contains any time |
7698 | stamps, the clones will become a sequence in time, with time | |
7699 | stamps in the subtree shifted for each clone produced. If SHIFT | |
7700 | is nil or the empty string, time stamps will be left alone. The | |
7701 | ID property of the original subtree is removed. | |
c8d0cf5c CD |
7702 | |
7703 | If the original subtree did contain time stamps with a repeater, | |
7704 | the 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. | |
7712 | I this way you can spell out a number of instances of a repeating task, | |
7713 | and 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 |
7786 | Optional argument WITH-CASE means sort case-sensitively. |
7787 | With 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. | |
7807 | When children are sorted, the cursor is in the parent line when this | |
7808 | hook gets called. When a region or a plain list is sorted, the cursor | |
7809 | will 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 |
7814 | If there is an active region, the entries in the region are sorted. |
7815 | Else, if the cursor is before the first entry, sort the top-level items. | |
7816 | Else, the children of the entry at point are sorted. | |
c8d0cf5c CD |
7817 | |
7818 | Sorting can be alphabetically, numerically, by date/time as given by | |
7819 | a time stamp, by a property or by priority. | |
7820 | ||
7821 | The command prompts for the sorting type unless it has been given to the | |
86fbb8ca | 7822 | function 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 |
7824 | precise meaning of each character: | |
7825 | ||
7826 | n Numerically, by converting the beginning of the entry/item to a number. | |
7827 | a Alphabetically, ignoring the TODO keyword and the priority, if any. | |
7828 | t By date/time, either the first active time stamp in the entry, or, if | |
7829 | none exist, by the first inactive one. | |
c8d0cf5c CD |
7830 | s By the scheduled date/time. |
7831 | d By deadline date/time. | |
7832 | c By creation time, which is assumed to be the first inactive time stamp | |
7833 | at the beginning of a line. | |
7834 | p By priority according to the cookie. | |
7835 | r By the value of a property. | |
7836 | ||
7837 | Capital letters will reverse the sort order. | |
2a57416f | 7838 | |
20908596 CD |
7839 | If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be |
7840 | called with point at the beginning of the record. It must return either | |
7841 | a string or a number that should serve as the sorting key for that record. | |
2a57416f | 7842 | |
20908596 CD |
7843 | Comparing entries ignores case by default. However, with an optional argument |
7844 | WITH-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. | |
8005 | The user will be prompted for the SORTING-TYPE if the call to this | |
8006 | function does not specify it. WHAT is only for the prompt, to indicate | |
8007 | what is being sorted. The sorting key will be extracted from | |
8008 | the car of the elements of the table. | |
8009 | If 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'. |
8077 | This mode is for using Org-mode structure commands in other | |
8078 | modes. The following keys behave as if Org-mode were active, if | |
8079 | the cursor is on a headline, or on a plain list item (both as | |
8080 | defined by Org-mode). | |
03f3cf35 | 8081 | |
20908596 CD |
8082 | M-up Move entry/item up |
8083 | M-down Move entry/item down | |
8084 | M-left Promote | |
8085 | M-right Demote | |
8086 | M-S-up Move entry/item up | |
8087 | M-S-down Move entry/item down | |
8088 | M-S-left Promote subtree | |
8089 | M-S-right Demote subtree | |
8090 | M-q Fill paragraph and items like in Org-mode | |
8091 | C-c ^ Sort entries | |
8092 | C-c - Cycle list bullet | |
8093 | TAB Cycle item visibility | |
8094 | M-RET Insert new heading/item | |
33306645 | 8095 | S-M-RET Insert new TODO heading / Checkbox item |
20908596 CD |
8096 | C-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. | |
8108 | In addition to setting orgstruct-mode, this also exports all indentation | |
8109 | and autofilling variables from org-mode into the buffer. It will also | |
8110 | recognize item context in multiline items. | |
8111 | Note that turning off orgstruct-mode will *not* remove the | |
8112 | indentation/paragraph settings. This can only be done by refreshing the | |
8113 | major 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. | |
8215 | FUN is the command to call inside a table. N is used to create a unique | |
8216 | command name. KEYS are keys that should be checked in for a command | |
8217 | to 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 |
8243 | Possible 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. | |
8279 | Optional 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. |
8292 | This will temporarily bind local variables that are typically bound in | |
8293 | Org-mode to the values they have in Org-mode, and then interactively | |
8294 | call 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. | |
8380 | Each function will be called in turn until one returns a non-nil | |
8381 | value. Each function should check if it is responsible for creating | |
8382 | this link (for example by looking at the major mode). | |
8383 | If not, it must exit and return nil. | |
8384 | If yes, it should return a non-nil value after a calling | |
8385 | `org-store-link-props' with a list of properties and values. | |
8386 | Special 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 |
8395 | In addition to these, any additional properties can be specified |
8396 | and 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'. | |
8400 | Re-compute all regular expressions depending on `org-link-types' | |
ab27a4a0 | 8401 | |
20908596 | 8402 | FOLLOW and EXPORT are two functions. |
891f4676 | 8403 | |
20908596 CD |
8404 | FOLLOW should take the link path as the single argument and do whatever |
8405 | is necessary to follow the link, for example find a file or display | |
8406 | a mail message. | |
1e8fbb6d | 8407 | |
20908596 CD |
8408 | EXPORT should format the link path for export to one of the export formats. |
8409 | It 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 |
8416 | The function may use the FORMAT information to return different values |
8417 | depending on the format. The return value will be put literally into | |
afe98dfa CD |
8418 | the exported file. If the return value is nil, this means Org should |
8419 | do what it normally does with links which do not have EXPORT defined. | |
8420 | ||
20908596 CD |
8421 | Org-mode has a built-in default for exporting links. If you are happy with |
8422 | this default, there is no need to define an export function for the link | |
8423 | type. 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. | |
8435 | This link is added to `org-stored-links' and can later be inserted | |
8436 | into an org-buffer with \\[org-insert-link]. | |
8437 | ||
8438 | For some link types, a prefix arg is interpreted: | |
ce4fdcb9 | 8439 | For links to usenet articles, arg negates `org-gnus-prefer-web-links'. |
20908596 CD |
8440 | For 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. | |
8652 | This takes information from `org-store-link-plist' and formats it | |
8653 | according 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 |
8741 | This 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 |
8748 | This 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. | |
8752 | TEXT is a string with the text to escape. | |
8753 | Optional argument TABLE is a list with characters that should be | |
8754 | escaped. When nil, `org-link-escape-chars' is used. | |
8755 | If 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 |
8779 | encodeURIComponent. 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 |
8790 | Note: 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. | |
8851 | This 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 |
8859 | Completion can be used to insert any of the link protocol prefixes like |
8860 | http or ftp in use. | |
8861 | ||
8862 | The 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 |
8864 | press RET at the prompt), the link defaults to the most recently | |
8865 | stored link. As SPC triggers completion in the minibuffer, you need to | |
8866 | use M-SPC or C-q SPC to force the insertion of a space character. | |
8867 | ||
8868 | You will also be prompted for a description, and if one is given, it will | |
8869 | be displayed in the buffer instead of the link. | |
8870 | ||
8871 | If there is already a link at point, this command will allow you to edit link | |
8872 | and description parts. | |
8873 | ||
3ab2c837 BG |
8874 | With a \\[universal-argument] prefix, prompts for a file to link to. The file name can |
8875 | be selected using completion. The path to the file will be relative to the | |
20908596 CD |
8876 | current directory if the file is in the current directory or a subdirectory. |
8877 | Otherwise, 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 |
8879 | option `org-link-file-path-type'. | |
20908596 CD |
8880 | |
8881 | With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in | |
93b62de8 CD |
8882 | the current directory or below. |
8883 | ||
8884 | With three \\[universal-argument] prefixes, negate the meaning of | |
8885 | `org-keep-stored-link-after-insertion'. | |
20908596 CD |
8886 | |
8887 | If `org-make-link-description-function' is non-nil, this function will be | |
8888 | called with the link target, and the result will be the default | |
8889 | link description. | |
8890 | ||
8891 | If the LINK-LOCATION parameter is non-nil, this value will be | |
8892 | used 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. |
8924 | Use 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. | |
9069 | PROMPT is a string to prompt with. CHOICES is a list of strings to choose | |
9070 | from." | |
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. | |
9136 | These functions must take a single argument, the link content. | |
9137 | They will be called for links that look like [[link text][description]] | |
9138 | when LINK TEXT does not have a protocol like \"http:\" and does not look | |
9139 | like a filename (e.g. \"./blue.png\"). | |
9140 | ||
9141 | These functions will be called *before* Org attempts to resolve the | |
9142 | link by doing text searches in the current buffer - so if you want a | |
9143 | link \"[[target]]\" to still find \"<<target>>\", your function should | |
9144 | handle this as a special case. | |
9145 | ||
9146 | When the function does handle the link, it must return a non-nil value. | |
9147 | If it decides that it is not responsible for this link, it must return | |
9148 | nil to indicate that that Org-mode can continue with other options | |
9149 | like exact and fuzzy text search.") | |
9150 | ||
20908596 CD |
9151 | (defun org-next-link () |
9152 | "Move forward to the next link. | |
9153 | If 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. | |
9173 | If 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. | |
9204 | This 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. | |
9240 | This 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. | |
9248 | This command can be called in any mode to follow a link that has | |
9249 | Org-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 | ||
9272 | Functions in this hook must return t if they identify and follow | |
9273 | a link at point. If they don't find anything interesting at point, | |
9274 | they must return nil.") | |
9275 | ||
3ab2c837 | 9276 | (defun org-open-at-point (&optional arg reference-buffer) |
20908596 CD |
9277 | "Open link at or after point. |
9278 | If there is no link at point, this function will search forward up to | |
c8d0cf5c | 9279 | the end of the current line. |
20908596 | 9280 | Normally, files will be opened by an appropriate application. If the |
3ab2c837 | 9281 | optional prefix argument ARG is non-nil, Emacs will visit the file. |
93b62de8 CD |
9282 | With a double prefix argument, try to open outside of Emacs, in the |
9283 | application 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 | 9476 | If there is only one link, follow it immediately as well. |
8d642074 CD |
9477 | If NTH is an integer, immediately pick the NTH link found. |
9478 | If ZERO is a string, check also this string for a link, and if | |
9479 | there 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. | |
9567 | These functions are called in turn with point at the location to | |
9568 | which the link should point. | |
03f3cf35 | 9569 | |
20908596 | 9570 | A function in the hook should first test if it would like to |
86fbb8ca CD |
9571 | handle this file type, for example by checking the `major-mode' |
9572 | or the file extension. If it decides not to handle this file, it | |
20908596 CD |
9573 | should just return nil to give other functions a chance. If it |
9574 | does handle the file, it must return the search string to be used | |
9575 | when following the link. The search string will be part of the | |
9576 | file link, given after a double colon, and `org-open-at-point' | |
9577 | will automatically search for it. If special measures must be | |
9578 | taken to make the search successful, another function should be | |
9579 | added to the companion hook `org-execute-file-search-functions', | |
9580 | which see. | |
7d58338e | 9581 | |
20908596 CD |
9582 | A function in this hook may also use `setq' to set the variable |
9583 | `description' to provide a suggestion for the descriptive text to | |
9584 | be used for this link when it gets inserted into an Org-mode | |
9585 | buffer 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 | ||
9590 | Functions added to this hook must accept a single argument, the | |
9591 | search string that was part of the file link, the part after the | |
9592 | double colon. The function must first check if it would like to | |
86fbb8ca CD |
9593 | handle this search, for example by checking the `major-mode' or |
9594 | the file extension. If it decides not to handle this search, it | |
20908596 CD |
9595 | should just return nil to give other functions a chance. If it |
9596 | does handle the search, it must return a non-nil value to keep | |
9597 | other functions from trying. | |
9598 | ||
9599 | Each function can access the current prefix argument through the | |
9600 | variable `current-prefix-argument'. Note that a single prefix is | |
9601 | used to force opening a link in Emacs, so it may be good to only | |
9602 | use a numeric or double prefix to guide the search function. | |
9603 | ||
9604 | In case this is needed, a function in this hook can also restore | |
9605 | the 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. | |
9612 | If S is surrounded by forward slashes, it is interpreted as a | |
9613 | regular expression. In org-mode files, this will create an `org-occur' | |
9614 | sparse tree. In ordinary files, `occur' will be used to list matches. | |
9615 | If the current buffer is in `dired-mode', grep will be used to search | |
9616 | in 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 | |
9745 | enclose 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'. | |
9780 | If CLEANUP is non-nil, remove the printout of the regular expression | |
9781 | in the *Occur* buffer. This is useful if the regex is long and not useful | |
9782 | to 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. | |
9824 | With prefix arg N, jump back that many stored positions. When | |
9825 | called several times in succession, walk through the entire ring. | |
9826 | Org-mode commands jumping to a different position in the current file, | |
9827 | or to another Org-mode file, automatically push the old position | |
9828 | onto 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. | |
9879 | First, this expands any special file name abbreviations. Then the | |
9880 | configuration variable `org-file-apps' is checked if it contains an | |
9881 | entry for this file type, and if yes, the corresponding command is launched. | |
93b62de8 | 9882 | |
20908596 | 9883 | If no application is found, Emacs simply visits the file. |
93b62de8 CD |
9884 | |
9885 | With optional prefix argument IN-EMACS, Emacs will visit the file. | |
86fbb8ca CD |
9886 | With a double \\[universal-argument] \\[universal-argument] \ |
9887 | prefix arg, Org tries to avoid opening in Emacs | |
ed21c5c8 | 9888 | and to use an external application to visit the file. |
93b62de8 | 9889 | |
86fbb8ca CD |
9890 | Optional LINE specifies a line to go to, optional SEARCH a string |
9891 | to search for. If LINE or SEARCH is given, the file will be | |
9892 | opened in Emacs, unless an entry from org-file-apps that makes | |
9893 | use of groups in a regexp matches. | |
20908596 | 9894 | If 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 | |
10012 | expression which should be matched against the whole link by | |
10013 | org-open-file. | |
10014 | ||
10015 | It assumes that is the case when the entry uses a regular | |
10016 | expression which has at least one grouping construct and the | |
10017 | action is either a lisp form or a command string containing | |
10018 | '%1', i.e. using at least one subexpression match as a | |
10019 | parameter." | |
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. | |
10040 | Also, weed out any non-string entries, because the return value is used | |
10041 | only for regexp matching. | |
10042 | When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist' | |
10043 | point to the symbol `emacs', indicating that the file should | |
10044 | be 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. | |
10060 | Return non-nil if the location is indeed remote. | |
38f8646b | 10061 | |
20908596 CD |
10062 | For example, the filename \"/user@host:/foo\" specifies a location |
10063 | on 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 | |
10264 | The parameters FASTP, LEVEL, and HEADING are for use by a scanner | |
1bcdebed | 10265 | routine which makes outline path derivations for an entire file, |
86fbb8ca | 10266 | avoiding 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 |
10287 | Width is the maximum number of characters that is available. |
10288 | Prefix is a prefix to be included in the returned string, | |
10289 | such 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. | |
10345 | Note that this is still *before* the stuff will be removed from | |
10346 | the *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 | 10351 | The list of target headings is compiled using the information in |
3ab2c837 | 10352 | `org-refile-targets', which see. |
20908596 | 10353 | |
3ab2c837 BG |
10354 | At the target location, the entry is filed as a subitem of the target |
10355 | heading. Depending on `org-reverse-note-order', the new subitem will | |
10356 | either be the first or the last subitem. | |
20908596 | 10357 | |
93b62de8 | 10358 | If there is an active region, all entries in that region will be moved. |
86fbb8ca | 10359 | However, the region must fulfill the requirement that the first heading |
93b62de8 CD |
10360 | is the first one sets the top-level of the moved text - at most siblings |
10361 | below it are allowed. | |
10362 | ||
3ab2c837 BG |
10363 | With prefix arg GOTO, the command will only visit the target location |
10364 | and not actually move anything. | |
10365 | ||
86fbb8ca | 10366 | With a double prefix arg \\[universal-argument] \\[universal-argument], \ |
3ab2c837 | 10367 | go to the location where the last refiling operation has put the subtree. |
8bfe682a | 10368 | With a prefix argument of `2', refile to the running clock. |
c8d0cf5c CD |
10369 | |
10370 | RFLOC can be a refile location obtained in a different way. | |
10371 | ||
86fbb8ca CD |
10372 | See also `org-refile-use-outline-path' and `org-completion-use-ido'. |
10373 | ||
10374 | If you are using target caching (see `org-refile-use-cache'), | |
10375 | You have to clear the target cache in order to find new targets. | |
3ab2c837 BG |
10376 | This can be done with a 0 prefix (`C-0 C-c C-w') or a triple |
10377 | prefix 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. |
10494 | PROMPT should not be suffixed with a colon and a space, because | |
10495 | this 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. | |
10648 | If 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 | 10667 | PLIST 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. | |
10683 | This empties the block, puts the cursor at the insert position and returns | |
10684 | the 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. | |
10708 | If 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. | |
10723 | Update the dynamic block at point. With prefix ARG, update all dynamic | |
10724 | blocks 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 |
10734 | This means to empty the block, parse for parameters and then call |
10735 | the 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 | 10763 | Error 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. | |
10777 | This 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. | |
10837 | This is a list of abbreviation keys and values. The value gets inserted | |
86fbb8ca | 10838 | if you type `<' followed by the key and then press the completion key, |
b349f79f | 10839 | usually `M-TAB'. %file will be replaced by a file name after prompting |
3ab2c837 BG |
10840 | for the file using completion. The cursor will be placed at the position |
10841 | of the `?` in the template. | |
b349f79f CD |
10842 | There are two templates for each key, the first uses the original Org syntax, |
10843 | the second uses Emacs Muse-like syntax tags. These Muse-like tags become | |
86fbb8ca | 10844 | the default when the /org-mtags.el/ module has been loaded. See also the |
ce4fdcb9 | 10845 | variable `org-mtags-prefer-muse-templates'. |
b349f79f CD |
10846 | This 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. | |
10855 | This looks for strings like \"<e\" on an otherwise empty line and | |
10856 | expands 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. | |
10910 | If the last change removed the TODO tag or switched to DONE, then | |
10911 | this 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 | 10917 | Each function takes a todo spec and returns either nil or the spec |
c8d0cf5c CD |
10918 | transformed into canonical form." ) |
10919 | ||
10920 | (defvar org-todo-get-default-hook nil | |
10921 | "Hook for functions that get a default item for todo. | |
c8d0cf5c | 10922 | Each function takes arguments (NEW-MARK OLD-MARK) and returns either |
86fbb8ca | 10923 | nil 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. | |
10955 | The state of an item is given by a keyword at the start of the heading, | |
10956 | like | |
10957 | *** TODO Write paper | |
10958 | *** DONE Call mom | |
10959 | ||
10960 | The different keywords are specified in the variable `org-todo-keywords'. | |
10961 | By default the available states are \"TODO\" and \"DONE\". | |
10962 | So for this example: when the item starts with TODO, it is changed to DONE. | |
10963 | When it starts with DONE, the DONE is removed. And when neither TODO nor | |
10964 | DONE are present, add TODO at the beginning of the heading. | |
10965 | ||
86fbb8ca CD |
10966 | With \\[universal-argument] prefix arg, use completion to determine the new \ |
10967 | state. | |
20908596 | 10968 | With numeric prefix arg, switch to that state. |
86fbb8ca CD |
10969 | With a double \\[universal-argument] prefix, switch to the next set of TODO \ |
10970 | keywords (nextset). | |
10971 | With a triple \\[universal-argument] prefix, circumvent any state blocking. | |
20908596 CD |
10972 | |
10973 | For 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. |
11170 | This checks whether the current task should be blocked from state | |
11171 | changes. 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? | |
11235 | The ORDERED property decides if an entry should require subtasks to be | |
11236 | completed in sequence. Since a property is not very visible, setting | |
11237 | this option means that toggling the ORDERED property with the command | |
11238 | `org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is | |
11239 | not relevant for the behavior, but it makes things more visible. | |
11240 | ||
11241 | Note that toggling the tag with tags commands will not change the property | |
11242 | and therefore not influence behavior! | |
11243 | ||
11244 | This can be t, meaning the tag ORDERED should be used, It can also be a | |
11245 | string 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. |
11254 | For better visibility, you can track the value of this property with a tag. | |
11255 | See 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. | |
11273 | This checks whether the current task should be blocked from state | |
8bfe682a | 11274 | changes 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. | |
11316 | This 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. |
11356 | When `org-hierarchical-todo-statistics' is nil, statistics will cover | |
11357 | the entire subtree and this will travel up the hierarchy and update | |
11358 | statistics 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. | |
11434 | Each function is called with two arguments: the number of not-done entries | |
11435 | and the number of done entries. | |
11436 | ||
11437 | For example, the following function, when added to this hook, will switch | |
11438 | an entry to DONE when all children are done, and back to TODO when new | |
11439 | entries are set to a TODO status. Note that this hook is only called | |
11440 | when 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 | 11450 | This 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. | |
11487 | If KWD is not set, check if there is a text property remembering the | |
11488 | right 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. | |
11503 | Returns 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. | |
11618 | If yes, set TODO state back to what it was and change the base date | |
11619 | of repeating deadline/scheduled time stamps to new date. | |
11620 | This 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. | |
11699 | The tree will show the lines where the regexp matches, and all higher | |
11700 | headlines above the match. | |
c8d0cf5c | 11701 | With a \\[universal-argument] prefix, prompt for a regexp to match. |
20908596 CD |
11702 | With a numeric prefix N, construct a sparse tree for the Nth element |
11703 | of `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 | 11723 | With argument REMOVE, remove any deadline from the item. |
3ab2c837 BG |
11724 | With argument TIME, set the deadline at the corresponding date. TIME |
11725 | can 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 | 11763 | With argument REMOVE, remove any scheduling date from the item. |
3ab2c837 BG |
11764 | With argument TIME, scheduled at the corresponding date. TIME can |
11765 | either 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 | |
11803 | for calling org-schedule with, or if there is no scheduling, | |
11804 | returns 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 | 11811 | calling org-deadline with, or if there is no scheduling, returns |
c8d0cf5c CD |
11812 | nil." |
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 | 11837 | WHAT indicates what kind of time stamp to add. TIME indicates the time to use. |
20908596 CD |
11838 | If non is given, the user is prompted for a date. |
11839 | REMOVE indicates what kind of entries to remove. An old WHAT entry will also | |
11840 | be 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 | |
11955 | log") | |
11956 | ||
20908596 CD |
11957 | (defvar org-log-post-message nil |
11958 | "Message to be displayed after a log note has been stored. | |
11959 | The auto-repeater uses this.") | |
ab27a4a0 | 11960 | |
20908596 CD |
11961 | (defun org-add-note () |
11962 | "Add a note to the current entry. | |
11963 | This 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. |
11971 | If this is about to TODO state change, the new state is expected in STATE. | |
11972 | When FINDPOS is non-nil, find the correct position for the note in | |
621f83e4 CD |
11973 | the current entry. If not, assume that it can be inserted at point. |
11974 | HOW is an indicator what kind of note should be created. | |
11975 | EXTRA 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 |
12152 | POS 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. | |
12164 | This command can create sparse trees. You first need to select the type | |
12165 | of match used to create the tree: | |
d5098885 | 12166 | |
86fbb8ca CD |
12167 | t Show all TODO entries. |
12168 | T Show entries with a specific TODO keyword. | |
c8d0cf5c | 12169 | m Show entries selected by a tags/property match. |
20908596 CD |
12170 | p Enter a property name and its value (both with completion on existing |
12171 | names/values) and show entries with that property. | |
acedf35c | 12172 | r Show entries matching a regular expression (`/' can be used as well) |
c8d0cf5c CD |
12173 | d Show deadlines due within `org-deadline-warning-days'. |
12174 | b Show deadlines and scheduled items before a date. | |
12175 | a 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. | |
12210 | This is a list, each call to org-occur pushes as cons cell, | |
12211 | containing the regular expression and the callback, onto the list. | |
12212 | The list can contain several entries if `org-occur' has been called | |
12213 | several time with the KEEP-PREVIOUS argument. Otherwise, this list | |
12214 | will only contain one set of parameters. When the highlights are | |
12215 | removed (for example with `C-c C-c', or with the next edit (depending | |
12216 | on `org-remove-highlights-with-change'), this variable is emptied | |
12217 | as 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. | |
12222 | The tree will show the lines where the regexp matches, and all higher | |
12223 | headlines above the match. It will also show the heading after the match, | |
12224 | to make sure editing the matching entry is easy. | |
12225 | If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous | |
12226 | call to `org-occur' will be kept, to allow stacking of calls to this | |
12227 | command. | |
12228 | If CALLBACK is non-nil, it is a function which is called to confirm | |
12229 | that 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. | |
12262 | N is the number of matches to move, when negative move backwards. | |
12263 | RESET is entirely ignored - this function always goes back to the | |
12264 | starting 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 |
12288 | How 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. | |
12323 | This can be used to show a consistent set of context around locations | |
12324 | exposed with `org-show-hierarchy-above' or `org-show-following-heading' | |
12325 | not t for the search context. | |
891f4676 | 12326 | |
20908596 CD |
12327 | With optional argument SIBLINGS, on each level of the hierarchy all |
12328 | siblings are shown. This repairs the tree structure to what it would | |
ed21c5c8 | 12329 | look like when opened with hierarchical calls to `org-cycle'. |
86fbb8ca CD |
12330 | With double optional argument \\[universal-argument] \\[universal-argument], \ |
12331 | go to the parent and show the | |
ed21c5c8 | 12332 | entire 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. | |
12354 | BEG and END are ignored. If NOREMOVE is nil, remove this function | |
12355 | from 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. | |
12384 | ACTION 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 | 12479 | Can 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 |
12485 | This is for internal dynamical scoping only. |
12486 | When this is non-nil, the function `org-get-tags-at' will return the value | |
12487 | of `org-scanner-tags' instead of building the list by itself. This | |
12488 | can lead to large speed-ups when the tags scanner is used in a file with | |
12489 | many entries, and when the list of tags is retrieved, for example to | |
12490 | obtain a list of properties. Building the tags list for each entry in such | |
12491 | a file becomes an N^2 operation - but with this variable set, it scales | |
12492 | as 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 | |
12497 | ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, | |
12498 | or `agenda' to produce an entry list for an agenda view. It can also be | |
12499 | a Lisp form or a function that should be called at each matched headline, in | |
12500 | this case the return value is a list of all return values from these calls. | |
12501 | ||
12502 | MATCHER is a Lisp form to be evaluated, testing if a given set of tags | |
12503 | qualifies a headline for inclusion. When TODO-ONLY is non-nil, | |
12504 | only 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 |
12668 | MATCH can contain positive and negative selection of tags, like |
12669 | \"+WORK+URGENT-WITHBOSS\". | |
d60b1ba1 | 12670 | If optional argument TODO-ONLY is non-nil, only select lines that are |
20908596 CD |
12671 | also 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. |
12694 | Optional FILES argument is a list of files to which can be used | |
12695 | instead 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. | |
12858 | If S is already a number, just return it. If it is a string, parse | |
0bd48b37 | 12859 | it 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. | |
12870 | Returns the float number of seconds since the beginning of the | |
12871 | epoch 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. |
12910 | POS defaults to point. If tags are inherited, the list contains | |
12911 | the targets in the same sequence as the headlines appear, i.e. | |
621f83e4 CD |
12912 | the tags of the current headline come last. |
12913 | When LOCAL is non-nil, only return tags from the current headline, | |
12914 | ignore 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. | |
12958 | If 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. | |
13022 | DATA may be a tags string like :aa:bb:cc:, or a list of tags. | |
13023 | If 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. | |
13065 | With 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. | |
13158 | This 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. | |
13249 | CURRENT is the current list of tags in the headline, INHERITED is the | |
13250 | list of inherited tags, and TABLE is an alist of tags and corresponding keys, | |
13251 | possibly with grouping information. TODO-TABLE is a similar table with | |
13252 | TODO keywords, should these have keys assigned to them. | |
13253 | If the keys are nil, a-z are automatically assigned. | |
13254 | Returns 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 | ||
13473 | FUNC is a function or a lisp form. The function will be called without | |
13474 | arguments, with the cursor positioned at the beginning of the headline. | |
13475 | The return values of all calls to the function will be collected and | |
13476 | returned as a list. | |
13477 | ||
c8d0cf5c CD |
13478 | The call to FUNC will be wrapped into a save-excursion form, so FUNC |
13479 | does not need to preserve point. After evaluation, the cursor will be | |
13480 | moved to the end of the line (presumably of the headline of the | |
13481 | processed entry) and search continues from there. Under some | |
13482 | circumstances, this may not produce the wanted results. For example, | |
13483 | if you have removed (e.g. archived) the current (sub)tree it could | |
13484 | mean that the next entry will be skipped entirely. In such cases, you | |
13485 | can specify the position from where search should continue by making | |
13486 | FUNC set the variable `org-map-continue-from' to the desired buffer | |
13487 | position. | |
13488 | ||
b349f79f CD |
13489 | MATCH is a tags/property/todo match as it is used in the agenda tags view. |
13490 | Only headlines that are matched by this query will be considered during | |
13491 | the iteration. When MATCH is nil or t, all headlines will be | |
13492 | visited by the iteration. | |
13493 | ||
13494 | SCOPE determines the scope of this command. It can be any of: | |
13495 | ||
13496 | nil The current buffer, respecting the restriction if any | |
13497 | tree The subtree started with the entry at point | |
3ab2c837 | 13498 | region The entries within the active region, if any |
b349f79f CD |
13499 | file The current buffer, without restriction |
13500 | file-with-archives | |
13501 | The current buffer, and any archives associated with it | |
13502 | agenda All agenda files | |
13503 | agenda-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 | ||
13508 | The remaining args are treated as settings for the skipping facilities of | |
13509 | the 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 | ||
13519 | If your function needs to retrieve the tags including inherited tags | |
13520 | at the *current* entry, you can use the value of the variable | |
13521 | `org-scanner-tags' which will be much faster than getting the value | |
13522 | with `org-get-tags-at'. If your function gets properties with | |
13523 | `org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags' | |
13524 | to t around the call to `org-entry-properties' to get the same speedup. | |
13525 | Note that if your function moves around to retrieve tags and properties at | |
13526 | a *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 |
13592 | These are properties that are not defined in the property drawer, |
13593 | but 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. |
13604 | Being 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. | |
13630 | Match 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. | |
13653 | With numerical prefix arg, use the nth allowed value, 0 stands for the 10th | |
13654 | allowed 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. | |
13704 | BEG and END can be beginning and end of subtree, if not given | |
13705 | they will be found. | |
13706 | If 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. |
13733 | This includes the TODO keyword, the tags, time strings for deadline, | |
13734 | scheduled, and clocking, and any additional properties defined in the | |
13735 | entry. The return value is an alist, keys may occur multiple times | |
13736 | if the property key was used several times. | |
13737 | POM may also be nil, in which case the current entry is used. | |
13738 | If WHICH is nil or `all', get all properties. If WHICH is | |
ed21c5c8 | 13739 | `special' or `standard', only get that subclass. If WHICH |
acedf35c | 13740 | is a string only get exactly this property. SPECIFIC can be a string, the |
ed21c5c8 CD |
13741 | specific property we are interested in. Specifying it can speed |
13742 | things 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. |
13841 | If INHERIT is non-nil and the entry does not have the property, | |
13842 | then also check higher levels of the hierarchy. | |
13843 | If INHERIT is the symbol `selective', use inheritance only if the setting | |
13844 | in `org-use-property-inheritance' selects PROPERTY for inheritance. | |
13845 | If the property is present but empty, the return value is the empty string. | |
86fbb8ca CD |
13846 | If the property is not present at all, nil is returned. |
13847 | ||
13848 | If LITERAL-NIL is set, return the string value \"nil\" as a string, | |
13849 | do not interpret it as the list atom nil. This is used for inheritance | |
13850 | when 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. | |
13876 | If 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. | |
13935 | VALUES 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 | 13960 | Each call to `org-entry-get-with-inheritance' will set this marker to the |
33306645 | 13961 | location of the entry where the inheritance search matched. If there was |
621f83e4 CD |
13962 | no match, the marker will point nowhere. |
13963 | Note that also `org-entry-get' calls this function, if the INHERIT flag | |
13964 | is 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. | |
13968 | The search will stop at the first ancestor which has the property defined. | |
13969 | If the value found is \"nil\", return nil to show that the property | |
13970 | should be considered as undefined (this is the meaning of nil here). | |
13971 | However, 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. | |
13993 | Each hook function should accept two arguments, the name of the property | |
13994 | and 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 | 14053 | With INCLUDE-SPECIALS, also list the special properties that reflect things |
20908596 CD |
14054 | like tags and TODO state. |
14055 | With INCLUDE-DEFAULTS, also include properties that has special meaning | |
3ab2c837 BG |
14056 | internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING |
14057 | and others. | |
20908596 CD |
14058 | With INCLUDE-COLUMNS, also include property names given in COLUMN |
14059 | formats 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. | |
14154 | Each entry should have the following format: | |
14155 | ||
14156 | (PROPERTY . READ-FUNCTION) | |
14157 | ||
14158 | The 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. | |
14163 | This 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. | |
14217 | When called interactively, this will prompt for a property name, offering | |
14218 | completion on existing and default properties. And then it will prompt | |
33306645 | 14219 | for a value, offering completion either on allowed values (via an inherited |
20908596 CD |
14220 | xxx_ALL property) or on existing values in other instances of this property |
14221 | in 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. | |
14265 | This looks for an enclosing column format, extracts the operator and | |
33306645 | 14266 | then 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. | |
14278 | The functions must take a single argument, the name of the property, and | |
14279 | return a flat list of allowed values. If \":ETC\" is one of | |
14280 | the values, this means that these values are intended as defaults for | |
14281 | completion, but that other values should be allowed too. | |
14282 | The functions must return nil if they are not responsible for this | |
14283 | property.") | |
14284 | ||
20908596 CD |
14285 | (defun org-property-get-allowed-values (pom property &optional table) |
14286 | "Get allowed values for the property PROPERTY. | |
14287 | When TABLE is non-nil, return an alist that can directly be used for | |
14288 | completion." | |
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. | |
14350 | If anything goes wrong, throw an error. | |
14351 | You 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 | ||
14357 | The return value will then be either a string with the error message, | |
14358 | or a marker if everything is OK. | |
14359 | ||
14360 | If THIS-BUFFER is set, the outline path does not contain a file, | |
14361 | only 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. | |
14395 | Return a marker to the heading if it was found, or nil if not. | |
14396 | If POS-ONLY is set, return just the position instead of a marker. | |
14397 | ||
14398 | The heading text must match exact, but it may have a TODO keyword, | |
14399 | a 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. | |
14415 | When 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. | |
14431 | IDENT can be a string, a symbol or a number, this function will search for | |
14432 | the string representation of it. | |
14433 | Return 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. |
14462 | If the user specifies a time like HH:MM, or if this command is called | |
14463 | with a prefix argument, the time stamp will contain date and time. | |
14464 | Otherwise, only the date will be included. All parts of a date not | |
14465 | specified by the user will be filled in from the current date/time. | |
14466 | So if you press just return without typing anything, the time stamp | |
14467 | will represent the current date/time. If there is already a timestamp | |
14468 | at 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. | |
14539 | An inactive time stamp is enclosed in square brackets instead of angle | |
14540 | brackets. It is inactive in the sense that it does not trigger agenda entries, | |
14541 | does not link to the calendar and cannot be changed with the S-cursor keys. | |
14542 | So 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. | |
14566 | The prompt will suggest to enter an ISO date, but you can also enter anything | |
14567 | which will at least partially be understood by `parse-time-string'. | |
14568 | Unrecognized parts of the date will default to the current day, month, year, | |
14569 | hour and minute. If this command is called to replace a timestamp at point, | |
86fbb8ca CD |
14570 | of to enter the second timestamp of a range, the default time is taken |
14571 | from the existing stamp. Furthermore, the command prefers the future, | |
14572 | so if you are giving a date where the year is not given, and the day-month | |
14573 | combination is already past in the current year, it will assume you | |
14574 | mean 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 |
14586 | Furthermore you can specify a relative date by giving, as the *first* thing |
14587 | in the input: a plus/minus sign, a number and a letter [dwmy] to indicate | |
14588 | change in days weeks, months, years. | |
14589 | With a single plus or minus, the date is relative to today. With a double | |
14590 | plus 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 |
14596 | The function understands only English month and weekday abbreviations, |
14597 | but this can be configured with the variables `parse-time-months' and | |
14598 | `parse-time-weekdays'. | |
d3f4dbe8 | 14599 | |
20908596 CD |
14600 | While prompting, a calendar is popped up - you can also select the |
14601 | date with the mouse (button 1). The calendar shows a period of three | |
14602 | months. To scroll it to other months, use the keys `>' and `<'. | |
14603 | If you don't like the calendar, turn it off with | |
14604 | \(setq org-read-date-popup-calendar nil) | |
48aaad2d | 14605 | |
20908596 CD |
14606 | With optional argument TO-TIME, the date will immediately be converted |
14607 | to an internal time. | |
14608 | With an optional argument WITH-TIME, the prompt will suggest to also | |
14609 | insert a time. Note that when WITH-TIME is not set, you can still | |
14610 | enter a time, and this function will inform the calling routine about | |
14611 | this change. The calling routine may then choose to change the format | |
14612 | used to insert the time stamp into the buffer to include the time. | |
14613 | With optional argument FROM-STRING, read from this string instead from | |
14614 | the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is | |
14615 | the time/date that is used for everything that is not specified by the | |
14616 | user." | |
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. | |
14993 | TODAY and DEFAULT are internal times, for today and for a default. | |
14994 | Return shift list (N what def-flag) | |
14995 | WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. | |
14996 | N is the number of WHATs to shift. | |
14997 | DEF-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. | |
15027 | The internal representation needed by the calendar is (month day year). | |
15028 | This is a wrapper to handle the brain-dead convention in calendar that | |
15029 | user 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. | |
15045 | Also, 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. | |
15060 | This 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 | 15070 | WITH-HM means use the stamp format that includes the time of the day. |
20908596 CD |
15071 | INACTIVE means use square brackets instead of angular ones, so that the |
15072 | stamp will not contribute to the agenda. | |
15073 | PRE and POST are optional strings to be inserted before and after the | |
15074 | stamp. | |
15075 | The 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. | |
15144 | But 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. | |
15171 | Don'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. | |
15203 | This 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. | |
15214 | A deadline is considered due if it happens within `org-deadline-warning-days' | |
15215 | days from today's date. If the deadline appears in an entry marked DONE, | |
15216 | it is not shown. The prefix arg NDAYS can be used to test that many | |
15217 | days. 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. | |
15264 | Normally the result is just printed in the echo area, but with prefix arg | |
15265 | TO-BUFFER, the result is inserted just after the date stamp into the buffer. | |
15266 | If the time range is actually in a table, the result is inserted into the | |
15267 | next column. | |
15268 | For time difference computation, a year is assumed to be exactly 365 | |
15269 | days 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 | 15346 | If there is a specifier for a cyclic time stamp, get the closest date to |
20908596 | 15347 | DAYNR. |
c8d0cf5c | 15348 | PREFER and SHOW-ALL are passed through to `org-closest-date'. |
3ab2c837 | 15349 | The 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. | |
15368 | 38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007. | |
d60b1ba1 CD |
15369 | The year 2000 cannot be abbreviated. Any year larger than 99 |
15370 | is 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. | |
15379 | D 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. | |
15416 | This 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 | 15440 | When PREFER is `past', return a date that is either CURRENT or past. |
20908596 | 15441 | When PREFER is `future', return a date that is either CURRENT or future. |
33306645 | 15442 | When 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. | |
15519 | This should be a lot faster than the normal `parse-time-string'. | |
15520 | If time is not given, defaults to 0:00. However, with optional NODEFAULT, | |
15521 | hour 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 |
15536 | If the cursor is on the year, change the year. If it is on the month, |
15537 | the day or the time, change that. | |
20908596 CD |
15538 | With 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 |
15544 | If the cursor is on the year, change the year. If it is on the month, |
15545 | the day or the time, change that. | |
20908596 CD |
15546 | With 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. | |
15552 | With 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. | |
15561 | With 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. |
15613 | The 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 | |
15615 | in 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. | |
15759 | If there is a time stamp in the current line, go to that date. | |
15760 | A 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. | |
15786 | If 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 | 15802 | If the string is just a number, interpret it as minutes. |
c8d0cf5c CD |
15803 | In fact, the first hh:mm or number in the string will be taken, |
15804 | there can be extra stuff in the string. | |
15805 | If 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 | ||
15823 | Each entry has the form (MODIFIER . MINUTES). | |
15824 | ||
15825 | In an effort string, a number followed by MODIFIER is multiplied | |
15826 | by the specified number of MINUTES to obtain an effort in | |
15827 | minutes. | |
15828 | ||
15829 | For example, if the value of this variable is ((\"hours\" . 60)), then an | |
15830 | effort 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 | ||
15838 | A bare number is interpreted as minutes, modifiers can be set by | |
15839 | customizing `org-effort-durations' (which see). | |
15840 | ||
15841 | Entries 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. | |
15866 | Prompt for confirmation when there are unsaved changes. | |
15867 | Be sure you know what you are doing before letting this function | |
15868 | overwrite your changes. | |
15869 | ||
15870 | This function is useful in a setup where one tracks org files | |
15871 | with a version control system, to revert on one machine after pulling | |
15872 | changes from another. I believe the procedure must be like this: | |
15873 | ||
15874 | 1. M-x org-save-all-org-buffers | |
15875 | 2. Pull changes from the other machine, resolve conflicts | |
15876 | 3. 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 | 15897 | With a prefix argument, restrict available to files. |
86fbb8ca CD |
15898 | With two prefix arguments, restrict available buffers to agenda files. |
15899 | ||
15900 | Defaults to `iswitchb' for buffer name completion. | |
15901 | Set `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 |
15923 | PREDICATE can be `export', `files' or `agenda'. |
15924 | ||
15925 | export restrict the list to Export buffers. | |
15926 | files restrict the list to buffers visiting Org files. | |
15927 | agenda restrict the list to buffers visiting agenda files. | |
15928 | ||
15929 | If 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. |
15961 | Optional UNRESTRICTED means return the full list even if a restriction | |
15962 | is currently in place. | |
ed21c5c8 | 15963 | When ARCHIVES is t, include all archive files that are really being |
2c3ad40d CD |
15964 | used 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. | |
15992 | If FILE is omitted, use the file associated with the current | |
15993 | buffer." | |
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. | |
15999 | Depending 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 | |
16001 | latter case, the buffer is set up in a way that saving it automatically kills | |
16002 | the 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. | |
16042 | If PAIR-WITH-EXPANSION is t return pairs with un-expanded | |
16043 | filenames, used by `org-store-new-agenda-file-list' to write back | |
16044 | un-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'. | |
16062 | If the current buffer visits an agenda file, find the next one in the list. | |
16063 | If 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. | |
16081 | If the file is not present in the list, it is added to the front. If it is | |
16082 | present, it is moved there. With optional argument TO-END, add/move to the | |
16083 | end 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'. | |
16104 | These are the files which are being checked for agenda entries. | |
ed21c5c8 | 16105 | Optional 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 | |
16141 | it 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. | |
16152 | When 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'. | |
16229 | This mode supports entering LaTeX environment and math in LaTeX fragments | |
16230 | in 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. | |
16238 | This is because we want to insert math symbols without dollars even outside | |
16239 | the LaTeX math segments. If Orgmode thinks that point is actually inside | |
33306645 | 16240 | an 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. | |
16262 | I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing | |
16263 | sequence appearing also before point. | |
16264 | Even though the matchers for math are configurable, this function assumes | |
16265 | that \\begin, \\(, \\[, and $$ are always used. Only the single dollar | |
16266 | delimiters are skipped when they have been removed by customization. | |
3ab2c837 BG |
16267 | The return value is nil, or a cons cell with the delimiter and the |
16268 | position of this delimiter. | |
20908596 CD |
16269 | |
16270 | This function does a reasonably good job, but can locally be fooled by | |
16271 | for example currency specifications. For example it will assume being in | |
16272 | inline math after \"$22.34\". The LaTeX fragment formatter will only format | |
16273 | fragments that are properly closed, but during editing, we have to live | |
16274 | with the uncertainty caused by missing closing delimiters. This function | |
16275 | looks 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. | |
16312 | It 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. | |
16329 | Revert 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. | |
16338 | Revert 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. | |
16356 | If the cursor is in a LaTeX fragment, create the image and overlay | |
16357 | it over the source code. If there is no fragment at point, display | |
16358 | all fragments in the current text, from one headline to the next. With | |
16359 | prefix SUBTREE, display all fragments in the current subtree. With a | |
86fbb8ca CD |
16360 | double prefix arg \\[universal-argument] \\[universal-argument], or when \ |
16361 | the cursor is before the first headline, | |
20908596 CD |
16362 | display all fragments in the buffer. |
16363 | The 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. |
16411 | Some 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. |
16578 | In 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 | ||
16587 | For backward compatibility, if both the positive and the negative place | |
16588 | holder is missing, the positive one (without the \"NO-\") will be | |
16589 | assumed to be present at the end of the template. | |
16590 | DEF-PKG and PKG are assumed to be alists of options/packagename lists. | |
86fbb8ca CD |
16591 | EXTRA is a string. |
16592 | SNIPPETS-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. | |
16653 | INCLUDE-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. | |
16667 | Normally only links without a description part are inlined, because this | |
16668 | is how it will work for export. When INCLUDE-LINKED is set, also links | |
16669 | with a description part will be inlined. This can be nice for a quick | |
16670 | look at those images, but it does not reflect what exported files will look | |
16671 | like. | |
16672 | When REFRESH is set, refresh existing images between BEG and END. | |
16673 | This will create new image displays only if necessary. | |
16674 | BEG 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. | |
17010 | If 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. | |
17041 | Hook functions are called in sequence until a valid handler is | |
17042 | found. | |
17043 | ||
17044 | Each hook takes a single argument, a user-pressed command key | |
17045 | which is also a `self-insert-command' from the global map. | |
17046 | ||
17047 | Within the hook, examine the cursor position and the command key | |
3ab2c837 | 17048 | and return nil or a valid handler as appropriate. Handler could |
afe98dfa CD |
17049 | be one of an interactive command, a function, or a form. |
17050 | ||
17051 | Set `org-use-speed-commands' to non-nil value to enable this | |
3ab2c837 | 17052 | hook. 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. | |
17058 | If the cursor is in a table looking at whitespace, the whitespace is | |
17059 | overwritten, 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. | |
17119 | When deleting backwards, in tables this function will insert whitespace in | |
17120 | front of the next \"|\" separator, to keep the table aligned. The table will | |
ab27a4a0 CD |
17121 | still be marked for re-alignment if the field did fill the entire column, |
17122 | because, 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. | |
17145 | When deleting characters, in tables this function will insert whitespace in | |
ab27a4a0 CD |
17146 | front of the next \"|\" separator, to keep the table aligned. The table will |
17147 | still be marked for re-alignment if the field did fill the entire column, | |
17148 | because, 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. | |
17191 | COMMANDS 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 | ||
17211 | This can be used to add additional functionality to the C-c C-c | |
17212 | key which executes context-dependent commands. This hook is run | |
17213 | before any other test, while `org-ctrl-c-ctrl-c-final-hook' is | |
17214 | run after the last test. | |
17215 | ||
17216 | Each function will be called with no arguments. The function | |
17217 | must check if the context is appropriate for it to act. If yes, | |
17218 | it should do its thing and then return a non-nil value. If the | |
17219 | context 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 | ||
17224 | This can be used to add additional functionality to the C-c C-c | |
17225 | key which executes context-dependent commands. This hook is run | |
17226 | after any other test, while `org-ctrl-c-ctrl-c-hook' is run | |
17227 | before the first test. | |
17228 | ||
17229 | Each function will be called with no arguments. The function | |
17230 | must check if the context is appropriate for it to act. If yes, | |
17231 | it should do its thing and then return a non-nil value. If the | |
17232 | context 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. | |
17236 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
17237 | This hook runs as the first action when TAB is pressed, even before | |
17238 | `org-cycle' messes around with the `outline-regexp' to cater for | |
17239 | inline tasks and plain list item folding. | |
86fbb8ca CD |
17240 | If any function in this hook returns t, any other actions that |
17241 | would have been caused by TAB (such as table field motion or visibility | |
17242 | cycling) 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. | |
17246 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
17247 | This hook runs after it has been established that the cursor is not in a | |
17248 | table, but before checking if the cursor is in a headline or if global cycling | |
17249 | should be done. | |
17250 | If any function in this hook returns t, not other actions like visibility | |
17251 | cycling will be done.") | |
17252 | ||
17253 | (defvar org-tab-after-check-for-cycling-hook nil | |
17254 | "Hook for functions to attach themselves to TAB. | |
17255 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
17256 | This hook runs after it has been established that not table field motion and | |
17257 | not visibility should be done because of current context. This is probably | |
17258 | the 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. | |
17262 | See `org-ctrl-c-ctrl-c-hook' for more information. | |
17263 | This hook runs after every other options for TAB have been exhausted, but | |
17264 | before indentation and \t insertion takes place.") | |
17265 | ||
c8d0cf5c CD |
17266 | (defvar org-metaleft-hook nil |
17267 | "Hook for functions attaching themselves to `M-left'. | |
17268 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
17269 | (defvar org-metaright-hook nil | |
17270 | "Hook for functions attaching themselves to `M-right'. | |
17271 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
17272 | (defvar org-metaup-hook nil | |
17273 | "Hook for functions attaching themselves to `M-up'. | |
17274 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
17275 | (defvar org-metadown-hook nil | |
17276 | "Hook for functions attaching themselves to `M-down'. | |
17277 | See `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'. | |
17280 | See `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'. | |
17283 | See `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'. | |
17286 | See `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'. | |
17289 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
17290 | (defvar org-metareturn-hook nil | |
17291 | "Hook for functions attaching themselves to `M-RET'. | |
17292 | See `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'. | |
17295 | See `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'. | |
17298 | This one runs after all other options except shift-select have been excluded. | |
17299 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
17300 | (defvar org-shiftdown-hook nil | |
17301 | "Hook for functions attaching themselves to `S-down'. | |
17302 | See `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'. | |
17305 | This one runs after all other options except shift-select have been excluded. | |
17306 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
17307 | (defvar org-shiftleft-hook nil | |
17308 | "Hook for functions attaching themselves to `S-left'. | |
17309 | See `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'. | |
17312 | This one runs after all other options except shift-select have been excluded. | |
17313 | See `org-ctrl-c-ctrl-c-hook' for more information.") | |
17314 | (defvar org-shiftright-hook nil | |
17315 | "Hook for functions attaching themselves to `S-right'. | |
17316 | See `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'. | |
17319 | This one runs after all other options except shift-select have been excluded. | |
17320 | See `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 |
17338 | Calls `org-cycle' with argument t, or `org-table-previous-field', depending |
17339 | on context. | |
28e5b051 | 17340 | See 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 |
17353 | Calls `org-promote-subtree', `org-outdent-item', |
17354 | or `org-table-delete-column', depending on context. | |
28e5b051 | 17355 | See 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 |
17366 | Calls `org-demote-subtree', `org-indent-item', |
17367 | or `org-table-insert-column', depending on context. | |
28e5b051 | 17368 | See 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 |
17379 | Calls `org-move-subtree-up' or `org-table-kill-row' or |
17380 | `org-move-item-up' depending on context. See the individual commands | |
17381 | for 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 |
17392 | Calls `org-move-subtree-down' or `org-table-insert-row' or |
17393 | `org-move-item-down', depending on context. See the individual | |
17394 | commands 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. |
17409 | Calls `org-do-promote' or `org-table-move-column', depending on context. | |
7a368970 | 17410 | With no specific context, calls the Emacs default `backward-word'. |
28e5b051 | 17411 | See 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. |
17438 | Calls `org-do-demote' or `org-table-move-column', depending on context. | |
7a368970 | 17439 | With no specific context, calls the Emacs default `forward-word'. |
28e5b051 | 17440 | See 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. | |
17467 | WHAT can be either `headlines' or `items'. If the current line is | |
17468 | an outline or item heading and it has a folded subtree below it, | |
17469 | this 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 |
17494 | Calls `org-move-subtree-up' or `org-table-move-row' or |
17495 | `org-move-item-up', depending on context. See the individual commands | |
17496 | for 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 |
17507 | Calls `org-move-subtree-down' or `org-table-move-row' or |
17508 | `org-move-item-down', depending on context. See the individual | |
17509 | commands 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 |
17520 | Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', |
17521 | depending 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 |
17544 | Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' |
17545 | depending 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. |
17568 | Depending 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. |
17604 | Depending 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. |
17705 | Calls `org-table-copy' or `org-copy-subtree', depending on context. | |
17706 | See 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. |
17713 | Calls `org-table-copy' or `org-cut-subtree', depending on context. | |
17714 | See 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. |
17721 | Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. | |
17722 | See 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. |
17730 | When at a table, call the formula editor with `org-table-edit-formulas'. | |
17731 | When at the first line of an src example, call `org-edit-src-code'. | |
17732 | When 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 | ||
17763 | This 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. | |
17912 | Also 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. |
17929 | Calls `org-table-next-row' or `newline', depending on context. | |
17930 | See 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. |
17962 | Calls `org-table-next-row' or `newline-and-indent', depending on | |
17963 | context. 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 |
17969 | Calls `org-table-recalculate' or `org-toggle-heading', |
17970 | depending 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. |
17981 | Also turns a plain line or a region of lines into list items. | |
0bd48b37 | 17982 | Calls `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. |
17997 | If there is no active region, only the current line is considered. | |
17998 | ||
3ab2c837 BG |
17999 | If the first non blank line in the region is an headline, convert |
18000 | all headlines to items, shifting text accordingly. | |
0bd48b37 | 18001 | |
3ab2c837 | 18002 | If it is an item, convert all items to normal lines. |
0bd48b37 | 18003 | |
3ab2c837 BG |
18004 | If it is normal text, change region into an item. With a prefix |
18005 | argument 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. | |
18127 | If there is no active region, only the current line is considered. | |
18128 | ||
3ab2c837 BG |
18129 | If the first non blank line is an headline, remove the stars from |
18130 | all headlines in the region. | |
0bd48b37 | 18131 | |
3ab2c837 | 18132 | If it is a plain list item, turn all plain list items into headings. |
0bd48b37 | 18133 | |
3ab2c837 BG |
18134 | If it is a normal line, turn each and every normal line (i.e. not |
18135 | an heading or an item) in the region into a heading. | |
0bd48b37 CD |
18136 | |
18137 | When converting a line into a heading, the number of stars is chosen | |
c8d0cf5c CD |
18138 | such that the lines become children of the current entry. However, |
18139 | when a prefix argument is given, its value determines the number of | |
18140 | stars 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. |
18221 | Calls `org-insert-heading' or `org-table-wrap-region', depending on context. | |
18222 | See 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. | |
18491 | With 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 | ||
18499 | Don't hesitate to report any problems or inaccurate documentation. | |
18500 | ||
18501 | If you don't have setup sending mail from (X)Emacs, please copy the | |
18502 | output buffer into your mail program, as it gives us important | |
18503 | information 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 | ||
18519 | We would like to add your full Org-mode and Outline configuration to the | |
18520 | bug report. This greatly simplifies the work of the maintainer and | |
18521 | other experts on the mailing list. | |
18522 | ||
18523 | HOWEVER, some variables you have customized may contain private | |
18524 | information. The names of customers, colleagues, or friends, might | |
18525 | appear in the form of file names, tags, todo states, or search strings. | |
18526 | If you answer yes to the prompt, you might want to check and remove | |
18527 | such 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 | |
18544 | what 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 | ||
18548 | Your 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. | |
18589 | With 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. | |
18733 | This ignores character with invisibility property `org-link', and also | |
18734 | characters with property `org-cwidth', because these will become invisible | |
18735 | upon 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. | |
18755 | If the string is shorter or has length MAXLENGTH, just return the | |
18756 | original string. If it is longer, the functions finds a space in the | |
18757 | string, breaks this string off at that locations and adds three dots | |
18758 | as ellipsis. Including the ellipsis, the string will not be longer | |
18759 | than MAXLENGTH. If finding a good breaking point in the string does | |
18760 | not work, the string is just chopped off in the middle of a word | |
18761 | if 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. | |
18772 | When 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. | |
18794 | Assumes 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. | |
18806 | IND is a cons cell with target and minimum indentation. | |
33306645 | 18807 | If the current indentation in LINE is smaller than the minimum, |
621f83e4 CD |
18808 | leave 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. | |
18819 | N 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. | |
18870 | If WIDTH is non-nil, the string is wrapped to that width, however many lines | |
18871 | that costs. If there is a word longer than WIDTH, the text is actually | |
18872 | wrapped to the length of that word. | |
18873 | IF WIDTH is nil and LINES is non-nil, the string is forced into at most that | |
18874 | many lines, whatever width that takes. | |
18875 | The 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. | |
18905 | No empty strings are returned if there are matches at the beginning | |
18906 | and 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. | |
18943 | If several contexts apply, all are returned. | |
18944 | Each context entry is a list with a symbol naming the context, and | |
18945 | two positions indicating start and end of the context. Possible | |
18946 | contexts 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 | |
18966 | This function expects the position to be visible because it uses font-lock | |
18967 | faces as a help to recognize the following contexts: :table-special, :link, | |
18968 | and :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. | |
19042 | Normally only the current line is checked, but you can include NLINES extra | |
19043 | lines both before and after point into the search. | |
19044 | If VISUALLY is set, require that the cursor is not after the match but | |
19045 | really 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 | 19071 | This will also return t if point is on one of the two matches or |
3ab2c837 | 19072 | in an unfinished block. END-RE can be a string or a form |
afe98dfa CD |
19073 | returning a string. |
19074 | ||
3ab2c837 BG |
19075 | An optional third argument bounds the search for START-RE. It |
19076 | defaults 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 | ||
19090 | NAMES 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. | |
19150 | The link is not stored in `org-stored-links', it is just created | |
19151 | for 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. | |
19172 | Taken 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 | 19199 | Returns 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. | |
19213 | If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the | |
86fbb8ca | 19214 | match. If the match group does not exist or point is not inside it, |
c4b5acde CD |
19215 | return 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 |
19225 | In particular, do not allow pop-up frames. |
19226 | Returns 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. | |
19233 | The process starts by copying the first list, and then setting properties | |
19234 | from the other lists. Settings in the last list are the most significant | |
19235 | ones 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 | 19273 | TABLE is an association list with keys like \"%a\" and string values. |
d3f4dbe8 CD |
19274 | The sequences in STRING may contain normal field width and padding information, |
19275 | for example \"%-5s\". Replacements happen in the sequence given by TABLE, | |
19276 | so 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. | |
19300 | Counting 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 | 19310 | not 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. | |
19319 | If 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. | |
19340 | This works in the calendar and in the agenda, anywhere else it just | |
19341 | returns 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. | |
19360 | Agenda actions are actions executed from the agenda with the key `k', | |
19361 | which 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. | |
19371 | This puts point at the start of the current subtree, and mark at the end. | |
19372 | ||
19373 | If 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'. | |
19505 | Since `adaptive-fill-regexp' is set to never match, we need to | |
19506 | store a backup of its value before entering `org-mode' so that | |
19507 | the 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. | |
19685 | If there is no active region, the QUOTE keyword at the current headline is | |
19686 | inserted or removed. When present, it causes the text between this headline | |
19687 | and the next to be exported as fixed-width text, and unmodified. | |
19688 | If there is an active region, this command adds or removes a colon as the | |
19689 | first character of this line. If the first character of a line is a colon, | |
19690 | this 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. | |
19730 | This looks for a line like | |
19731 | ||
19732 | #+BIBLIOGRAPHY: foo plain option:-d | |
19733 | ||
8bfe682a | 19734 | and derives from it that foo.bib is the bibliography file relevant |
c8d0cf5c CD |
19735 | for this document. It then installs the necessary environment for RefTeX |
19736 | to work in this buffer and calls `reftex-citation' to insert a citation | |
19737 | into the buffer. | |
19738 | ||
19739 | Export of such citations to both LaTeX and HTML is handled by the contributed | |
19740 | package 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 |
19762 | to a visible line beginning. This makes the function of C-a more intuitive. |
19763 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
19764 | first attempt, and only move to after the tags when the cursor is already | |
19765 | beyond 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. | |
19813 | If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the | |
19814 | first attempt, and only move to after the tags when the cursor is already | |
19815 | beyond 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. | |
19849 | This will call `backward-sentence' or `org-table-beginning-of-field', | |
19850 | depending 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. | |
19858 | This will call `forward-sentence' or `org-table-end-of-field', | |
19859 | depending 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. | |
19890 | This command will look at the current kill and check if is a single | |
19891 | subtree, or a series of subtrees[1]. If it passes the test, and if the | |
19892 | cursor is at the beginning of a line or after the stars of a currently | |
33306645 | 19893 | empty headline, then the yank is handled specially. How exactly depends |
93b62de8 CD |
19894 | on the value of the following variables, both set by default. |
19895 | ||
19896 | org-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 | ||
19900 | org-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 | ||
19906 | Any prefix to this command will cause `yank' to be called directly with | |
86fbb8ca CD |
19907 | no special treatment. In particular, a simple \\[universal-argument] prefix \ |
19908 | will just | |
93b62de8 CD |
19909 | plainly 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 | ||
19919 | This function implements the behavior described in the `org-yank' | |
3ab2c837 | 19920 | documentation. However, it has been generalized to work for any |
c8d0cf5c CD |
19921 | interactive 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. | |
19995 | This 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. | |
20036 | If the heading only contains a TODO keyword, it is still still considered | |
20037 | empty." | |
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. | |
20053 | This function considers both visible and invisible heading lines. | |
20054 | With 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. | |
20061 | This version will not throw an error. It will return the level of the | |
c8d0cf5c CD |
20062 | headline found, or nil if no higher level is found. |
20063 | ||
20064 | Also, this function will be a lot faster than `outline-up-heading', | |
20065 | because it relies on stars being the outline starters. This can really | |
20066 | make 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. | |
20092 | When PREVIOUS is set, go to the previous sibling instead. Returns t | |
20093 | when a sibling was found. When none is found, return nil and don't | |
20094 | move 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 | 20120 | Return t when a child was found. Otherwise don't move point and |
afe98dfa | 20121 | return 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 |
20137 | When 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. | |
20153 | If there is no such heading, return nil. | |
20154 | This 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. | |
20165 | If 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. | |
20221 | This will move over empty lines, lines with planning time stamps, | |
20222 | clocking 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 |
20240 | Stop at the first and last subheadings of a superior heading. |
20241 | Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil | |
20242 | it 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. | |
20262 | Stop 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. | |
20288 | Show 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 | |
20390 | if 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. | |
20412 | To 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 | 20514 | Still 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 |