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