Commit | Line | Data |
---|---|---|
20908596 CD |
1 | ;;; org-macs.el --- Top-level definitions for Org-mode |
2 | ||
3ab2c837 BG |
3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
4 | ;; Free Software Foundation, Inc. | |
20908596 CD |
5 | |
6 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
7 | ;; Keywords: outlines, hypermedia, calendar, wp | |
8 | ;; Homepage: http://orgmode.org | |
3ab2c837 | 9 | ;; Version: 7.7 |
20908596 CD |
10 | ;; |
11 | ;; This file is part of GNU Emacs. | |
12 | ;; | |
b1fc2b50 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
20908596 | 14 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
20908596 CD |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
20908596 CD |
25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
26 | ;; | |
27 | ;;; Commentary: | |
28 | ||
29 | ;; This file contains macro definitions, defsubst definitions, other | |
30 | ;; stuff needed for compilation and top-level forms in Org-mode, as well | |
31 | ;; lots of small functions that are not org-mode specific but simply | |
32 | ;; generally useful stuff. | |
33 | ||
34 | ;;; Code: | |
35 | ||
c8d0cf5c CD |
36 | (eval-and-compile |
37 | (unless (fboundp 'declare-function) | |
3ab2c837 BG |
38 | (defmacro declare-function (fn file &optional arglist fileonly))) |
39 | (if (>= emacs-major-version 23) | |
40 | (defsubst org-char-to-string(c) | |
41 | "Defsubst to decode UTF-8 character values in emacs 23 and beyond." | |
42 | (char-to-string c)) | |
43 | (defsubst org-char-to-string (c) | |
44 | "Defsubst to decode UTF-8 character values in emacs 22." | |
45 | (string (decode-char 'ucs c))))) | |
c8d0cf5c CD |
46 | |
47 | (declare-function org-add-props "org-compat" (string plist &rest props)) | |
afe98dfa CD |
48 | (declare-function org-string-match-p "org-compat" (&rest args)) |
49 | ||
50 | (defmacro org-called-interactively-p (&optional kind) | |
3ab2c837 BG |
51 | (if (featurep 'xemacs) |
52 | `(interactive-p) | |
afe98dfa CD |
53 | (if (or (> emacs-major-version 23) |
54 | (and (>= emacs-major-version 23) | |
55 | (>= emacs-minor-version 2))) | |
3ab2c837 BG |
56 | `(with-no-warnings (called-interactively-p ,kind)) ;; defined with no argument in <=23.1 |
57 | `(interactive-p)))) | |
c8d0cf5c | 58 | |
acedf35c CD |
59 | (if (and (not (fboundp 'with-silent-modifications)) |
60 | (or (< emacs-major-version 23) | |
61 | (and (= emacs-major-version 23) | |
62 | (< emacs-minor-version 2)))) | |
63 | (defmacro with-silent-modifications (&rest body) | |
64 | `(org-unmodified ,@body))) | |
65 | ||
20908596 CD |
66 | (defmacro org-bound-and-true-p (var) |
67 | "Return the value of symbol VAR if it is bound, else nil." | |
68 | `(and (boundp (quote ,var)) ,var)) | |
69 | ||
afe98dfa CD |
70 | (defun org-string-nw-p (s) |
71 | "Is S a string with a non-white character?" | |
72 | (and (stringp s) | |
73 | (org-string-match-p "\\S-" s) | |
74 | s)) | |
75 | ||
86fbb8ca CD |
76 | (defun org-not-nil (v) |
77 | "If V not nil, and also not the string \"nil\", then return V. | |
78 | Otherwise return nil." | |
79 | (and v (not (equal v "nil")) v)) | |
80 | ||
20908596 | 81 | (defmacro org-unmodified (&rest body) |
c8d0cf5c CD |
82 | "Execute body without changing `buffer-modified-p'. |
83 | Also, do not record undo information." | |
20908596 | 84 | `(set-buffer-modified-p |
c8d0cf5c CD |
85 | (prog1 (buffer-modified-p) |
86 | (let ((buffer-undo-list t) | |
87 | before-change-functions after-change-functions) | |
88 | ,@body)))) | |
20908596 CD |
89 | |
90 | (defmacro org-re (s) | |
91 | "Replace posix classes in regular expression." | |
92 | (if (featurep 'xemacs) | |
93 | (let ((ss s)) | |
94 | (save-match-data | |
95 | (while (string-match "\\[:alnum:\\]" ss) | |
96 | (setq ss (replace-match "a-zA-Z0-9" t t ss))) | |
0bd48b37 CD |
97 | (while (string-match "\\[:word:\\]" ss) |
98 | (setq ss (replace-match "a-zA-Z0-9" t t ss))) | |
20908596 CD |
99 | (while (string-match "\\[:alpha:\\]" ss) |
100 | (setq ss (replace-match "a-zA-Z" t t ss))) | |
ed21c5c8 CD |
101 | (while (string-match "\\[:punct:\\]" ss) |
102 | (setq ss (replace-match "\001-@[-`{-~" t t ss))) | |
20908596 CD |
103 | ss)) |
104 | s)) | |
105 | ||
106 | (defmacro org-preserve-lc (&rest body) | |
107 | `(let ((_line (org-current-line)) | |
108 | (_col (current-column))) | |
109 | (unwind-protect | |
110 | (progn ,@body) | |
54a0dee5 | 111 | (org-goto-line _line) |
20908596 CD |
112 | (org-move-to-column _col)))) |
113 | ||
114 | (defmacro org-without-partial-completion (&rest body) | |
3ab2c837 BG |
115 | `(if (and (boundp 'partial-completion-mode) |
116 | partial-completion-mode | |
117 | (fboundp 'partial-completion-mode)) | |
20908596 CD |
118 | (unwind-protect |
119 | (progn | |
3ab2c837 | 120 | (partial-completion-mode -1) |
20908596 | 121 | ,@body) |
3ab2c837 BG |
122 | (partial-completion-mode 1)) |
123 | ,@body)) | |
20908596 | 124 | |
20908596 | 125 | (defmacro org-maybe-intangible (props) |
33306645 | 126 | "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. |
86fbb8ca | 127 | In Emacs 21, invisible text is not avoided by the command loop, so the |
20908596 CD |
128 | intangible property is needed to make sure point skips this text. |
129 | In Emacs 22, this is not necessary. The intangible text property has | |
130 | led to problems with flyspell. These problems are fixed in flyspell.el, | |
131 | but we still avoid setting the property in Emacs 22 and later. | |
132 | We use a macro so that the test can happen at compilation time." | |
133 | (if (< emacs-major-version 22) | |
134 | `(append '(intangible t) ,props) | |
135 | props)) | |
136 | ||
137 | (defmacro org-with-point-at (pom &rest body) | |
138 | "Move to buffer and point of point-or-marker POM for the duration of BODY." | |
3ab2c837 | 139 | `(let ((pom ,pom)) |
20908596 | 140 | (save-excursion |
3ab2c837 BG |
141 | (if (markerp pom) (set-buffer (marker-buffer pom))) |
142 | (save-excursion | |
143 | (goto-char (or pom (point))) | |
144 | ,@body)))) | |
8d642074 | 145 | (put 'org-with-point-at 'lisp-indent-function 1) |
20908596 CD |
146 | |
147 | (defmacro org-no-warnings (&rest body) | |
148 | (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) | |
149 | ||
150 | (defmacro org-if-unprotected (&rest body) | |
151 | "Execute BODY if there is no `org-protected' text property at point." | |
152 | `(unless (get-text-property (point) 'org-protected) | |
153 | ,@body)) | |
154 | ||
0bd48b37 CD |
155 | (defmacro org-if-unprotected-1 (&rest body) |
156 | "Execute BODY if there is no `org-protected' text property at point-1." | |
157 | `(unless (get-text-property (1- (point)) 'org-protected) | |
158 | ,@body)) | |
159 | ||
c8d0cf5c | 160 | (defmacro org-if-unprotected-at (pos &rest body) |
8d642074 | 161 | "Execute BODY if there is no `org-protected' text property at POS." |
c8d0cf5c CD |
162 | `(unless (get-text-property ,pos 'org-protected) |
163 | ,@body)) | |
8bfe682a CD |
164 | (put 'org-if-unprotected-at 'lisp-indent-function 1) |
165 | ||
ed21c5c8 CD |
166 | (defun org-re-search-forward-unprotected (&rest args) |
167 | "Like re-search-forward, but stop only in unprotected places." | |
168 | (catch 'exit | |
169 | (while t | |
170 | (unless (apply 're-search-forward args) | |
171 | (throw 'exit nil)) | |
172 | (unless (get-text-property (match-beginning 0) 'org-protected) | |
173 | (throw 'exit (point)))))) | |
c8d0cf5c | 174 | |
20908596 CD |
175 | (defmacro org-with-remote-undo (_buffer &rest _body) |
176 | "Execute BODY while recording undo information in two buffers." | |
177 | `(let ((_cline (org-current-line)) | |
178 | (_cmd this-command) | |
179 | (_buf1 (current-buffer)) | |
180 | (_buf2 ,_buffer) | |
181 | (_undo1 buffer-undo-list) | |
182 | (_undo2 (with-current-buffer ,_buffer buffer-undo-list)) | |
183 | _c1 _c2) | |
184 | ,@_body | |
185 | (when org-agenda-allow-remote-undo | |
186 | (setq _c1 (org-verify-change-for-undo | |
187 | _undo1 (with-current-buffer _buf1 buffer-undo-list)) | |
188 | _c2 (org-verify-change-for-undo | |
189 | _undo2 (with-current-buffer _buf2 buffer-undo-list))) | |
190 | (when (or _c1 _c2) | |
191 | ;; make sure there are undo boundaries | |
192 | (and _c1 (with-current-buffer _buf1 (undo-boundary))) | |
193 | (and _c2 (with-current-buffer _buf2 (undo-boundary))) | |
194 | ;; remember which buffer to undo | |
195 | (push (list _cmd _cline _buf1 _c1 _buf2 _c2) | |
196 | org-agenda-undo-list))))) | |
3ab2c837 | 197 | (put 'org-with-remote-undo 'lisp-indent-function 1) |
20908596 CD |
198 | |
199 | (defmacro org-no-read-only (&rest body) | |
200 | "Inhibit read-only for BODY." | |
201 | `(let ((inhibit-read-only t)) ,@body)) | |
202 | ||
203 | (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t | |
86fbb8ca CD |
204 | rear-nonsticky t mouse-map t fontified t |
205 | org-emphasis t) | |
20908596 CD |
206 | "Properties to remove when a string without properties is wanted.") |
207 | ||
208 | (defsubst org-match-string-no-properties (num &optional string) | |
209 | (if (featurep 'xemacs) | |
210 | (let ((s (match-string num string))) | |
211 | (and s (remove-text-properties 0 (length s) org-rm-props s)) | |
212 | s) | |
213 | (match-string-no-properties num string))) | |
214 | ||
215 | (defsubst org-no-properties (s) | |
216 | (if (fboundp 'set-text-properties) | |
217 | (set-text-properties 0 (length s) nil s) | |
218 | (remove-text-properties 0 (length s) org-rm-props s)) | |
219 | s) | |
220 | ||
221 | (defsubst org-get-alist-option (option key) | |
222 | (cond ((eq key t) t) | |
223 | ((eq option t) t) | |
224 | ((assoc key option) (cdr (assoc key option))) | |
225 | (t (cdr (assq 'default option))))) | |
226 | ||
c8d0cf5c | 227 | (defsubst org-check-external-command (cmd &optional use no-error) |
8bfe682a | 228 | "Check if external program CMD for USE exists, error if not. |
54a0dee5 | 229 | When the program does exist, return its path. |
c8d0cf5c CD |
230 | When it does not exist and NO-ERROR is set, return nil. |
231 | Otherwise, throw an error. The optional argument USE can describe what this | |
232 | program is needed for, so that the error message can be more informative." | |
233 | (or (executable-find cmd) | |
234 | (if no-error | |
235 | nil | |
236 | (error "Can't find `%s'%s" cmd | |
237 | (if use (format " (%s)" use) ""))))) | |
238 | ||
20908596 CD |
239 | (defsubst org-inhibit-invisibility () |
240 | "Modified `buffer-invisibility-spec' for Emacs 21. | |
241 | Some ops with invisible text do not work correctly on Emacs 21. For these | |
242 | we turn off invisibility temporarily. Use this in a `let' form." | |
243 | (if (< emacs-major-version 22) nil buffer-invisibility-spec)) | |
244 | ||
245 | (defsubst org-set-local (var value) | |
246 | "Make VAR local in current buffer and set it to VALUE." | |
c8d0cf5c | 247 | (set (make-local-variable var) value)) |
20908596 CD |
248 | |
249 | (defsubst org-mode-p () | |
250 | "Check if the current buffer is in Org-mode." | |
251 | (eq major-mode 'org-mode)) | |
252 | ||
253 | (defsubst org-last (list) | |
254 | "Return the last element of LIST." | |
255 | (car (last list))) | |
256 | ||
257 | (defun org-let (list &rest body) | |
258 | (eval (cons 'let (cons list body)))) | |
259 | (put 'org-let 'lisp-indent-function 1) | |
260 | ||
261 | (defun org-let2 (list1 list2 &rest body) | |
262 | (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) | |
263 | (put 'org-let2 'lisp-indent-function 2) | |
264 | ||
265 | (defsubst org-call-with-arg (command arg) | |
17d65915 | 266 | "Call COMMAND interactively, but pretend prefix arg was ARG." |
20908596 CD |
267 | (let ((current-prefix-arg arg)) (call-interactively command))) |
268 | ||
269 | (defsubst org-current-line (&optional pos) | |
270 | (save-excursion | |
271 | (and pos (goto-char pos)) | |
272 | ;; works also in narrowed buffer, because we start at 1, not point-min | |
273 | (+ (if (bolp) 1 0) (count-lines 1 (point))))) | |
274 | ||
54a0dee5 CD |
275 | (defsubst org-goto-line (N) |
276 | (save-restriction | |
277 | (widen) | |
278 | (goto-char (point-min)) | |
279 | (forward-line (1- N)))) | |
280 | ||
0bd48b37 CD |
281 | (defsubst org-current-line-string (&optional to-here) |
282 | (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol)))) | |
283 | ||
20908596 CD |
284 | (defsubst org-pos-in-match-range (pos n) |
285 | (and (match-beginning n) | |
286 | (<= (match-beginning n) pos) | |
287 | (>= (match-end n) pos))) | |
288 | ||
289 | (defun org-autoload (file functions) | |
17d65915 | 290 | "Establish autoload for all FUNCTIONS in FILE, if not bound already." |
20908596 CD |
291 | (let ((d (format "Documentation will be available after `%s.el' is loaded." |
292 | file)) | |
293 | f) | |
294 | (while (setq f (pop functions)) | |
295 | (or (fboundp f) (autoload f file d t))))) | |
296 | ||
297 | (defun org-match-line (re) | |
298 | "Looking-at at the beginning of the current line." | |
299 | (save-excursion | |
300 | (goto-char (point-at-bol)) | |
301 | (looking-at re))) | |
302 | ||
303 | (defun org-plist-delete (plist property) | |
304 | "Delete PROPERTY from PLIST. | |
305 | This is in contrast to merely setting it to 0." | |
306 | (let (p) | |
307 | (while plist | |
308 | (if (not (eq property (car plist))) | |
309 | (setq p (plist-put p (car plist) (nth 1 plist)))) | |
310 | (setq plist (cddr plist))) | |
311 | p)) | |
312 | ||
c8d0cf5c CD |
313 | (defun org-replace-match-keep-properties (newtext &optional fixedcase |
314 | literal string) | |
315 | "Like `replace-match', but add the text properties found original text." | |
316 | (setq newtext (org-add-props newtext (text-properties-at | |
317 | (match-beginning 0) string))) | |
318 | (replace-match newtext fixedcase literal string)) | |
319 | ||
e720ae53 GM |
320 | (defmacro org-save-outline-visibility (use-markers &rest body) |
321 | "Save and restore outline visibility around BODY. | |
322 | If USE-MARKERS is non-nil, use markers for the positions. | |
323 | This means that the buffer may change while running BODY, | |
324 | but it also means that the buffer should stay alive | |
325 | during the operation, because otherwise all these markers will | |
326 | point nowhere." | |
327 | (declare (indent 1)) | |
3ab2c837 BG |
328 | `(let ((data (org-outline-overlay-data ,use-markers)) |
329 | rtn) | |
e720ae53 GM |
330 | (unwind-protect |
331 | (progn | |
3ab2c837 | 332 | (setq rtn (progn ,@body)) |
e720ae53 GM |
333 | (org-set-outline-overlay-data data)) |
334 | (when ,use-markers | |
335 | (mapc (lambda (c) | |
336 | (and (markerp (car c)) (move-marker (car c) nil)) | |
337 | (and (markerp (cdr c)) (move-marker (cdr c) nil))) | |
3ab2c837 BG |
338 | data))) |
339 | rtn)) | |
340 | ||
341 | (defmacro org-with-wide-buffer (&rest body) | |
342 | "Execute body while temporarily widening the buffer." | |
343 | `(save-excursion | |
344 | (save-restriction | |
345 | (widen) | |
346 | ,@body))) | |
e720ae53 | 347 | |
afe98dfa CD |
348 | (defmacro org-with-limited-levels (&rest body) |
349 | "Execute BODY with limited number of outline levels." | |
3ab2c837 BG |
350 | `(let* ((org-outline-regexp (org-get-limited-outline-regexp)) |
351 | (outline-regexp org-outline-regexp) | |
352 | (org-outline-regexp-at-bol (concat "^" org-outline-regexp))) | |
afe98dfa CD |
353 | ,@body)) |
354 | ||
3ab2c837 | 355 | (defvar org-outline-regexp) ; defined in org.el |
afe98dfa CD |
356 | (defvar org-odd-levels-only) ; defined in org.el |
357 | (defvar org-inlinetask-min-level) ; defined in org-inlinetask.el | |
358 | (defun org-get-limited-outline-regexp () | |
359 | "Return outline-regexp with limited number of levels. | |
360 | The number of levels is controlled by `org-inlinetask-min-level'" | |
361 | (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) | |
3ab2c837 | 362 | org-outline-regexp |
afe98dfa CD |
363 | (let* ((limit-level (1- org-inlinetask-min-level)) |
364 | (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) | |
365 | (format "\\*\\{1,%d\\} " nstars)))) | |
e720ae53 | 366 | |
3ab2c837 BG |
367 | (defun org-format-seconds (string seconds) |
368 | "Compatibility function replacing format-seconds" | |
369 | (if (fboundp 'format-seconds) | |
370 | (format-seconds string seconds) | |
371 | (format-time-string string (seconds-to-time seconds)))) | |
372 | ||
20908596 CD |
373 | (provide 'org-macs) |
374 | ||
5b409b39 | 375 | |
b349f79f | 376 | |
20908596 | 377 | ;;; org-macs.el ends here |