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