Commit | Line | Data |
---|---|---|
20908596 CD |
1 | ;;; org-compat.el --- Compatibility code for Org-mode |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2004-2014 Free Software Foundation, Inc. |
20908596 CD |
4 | |
5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
7 | ;; Homepage: http://orgmode.org | |
20908596 CD |
8 | ;; |
9 | ;; This file is part of GNU Emacs. | |
10 | ;; | |
b1fc2b50 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
20908596 | 12 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
20908596 CD |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
20908596 CD |
23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
24 | ;; | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; This file contains code needed for compatibility with XEmacs and older | |
28 | ;; versions of GNU Emacs. | |
29 | ||
30 | ;;; Code: | |
31 | ||
c8d0cf5c CD |
32 | (eval-when-compile |
33 | (require 'cl)) | |
34 | ||
621f83e4 CD |
35 | (require 'org-macs) |
36 | ||
9d459fc5 | 37 | (declare-function w32-focus-frame "term/w32-win" (frame)) |
c8d0cf5c | 38 | |
86fbb8ca CD |
39 | ;; The following constant is for backward compatibility. We do not use |
40 | ;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) | |
41 | ;; at compilation time and can therefore optimize code better. | |
42 | (defconst org-xemacs-p (featurep 'xemacs)) | |
20908596 CD |
43 | (defconst org-format-transports-properties-p |
44 | (let ((x "a")) | |
45 | (add-text-properties 0 1 '(test t) x) | |
46 | (get-text-property 0 'test (format "%s" x))) | |
47 | "Does format transport text properties?") | |
48 | ||
49 | (defun org-compatible-face (inherits specs) | |
50 | "Make a compatible face specification. | |
51 | If INHERITS is an existing face and if the Emacs version supports it, | |
c8d0cf5c CD |
52 | just inherit the face. If INHERITS is set and the Emacs version does |
53 | not support it, copy the face specification from the inheritance face. | |
54 | If INHERITS is not given and SPECS is, use SPECS to define the face. | |
20908596 CD |
55 | XEmacs and Emacs 21 do not know about the `min-colors' attribute. |
56 | For them we convert a (min-colors 8) entry to a `tty' entry and move it | |
57 | to the top of the list. The `min-colors' attribute will be removed from | |
58 | any other entries, and any resulting duplicates will be removed entirely." | |
c8d0cf5c CD |
59 | (when (and inherits (facep inherits) (not specs)) |
60 | (setq specs (or specs | |
61 | (get inherits 'saved-face) | |
62 | (get inherits 'face-defface-spec)))) | |
20908596 CD |
63 | (cond |
64 | ((and inherits (facep inherits) | |
c8d0cf5c CD |
65 | (not (featurep 'xemacs)) |
66 | (>= emacs-major-version 22) | |
67 | ;; do not inherit outline faces before Emacs 23 | |
68 | (or (>= emacs-major-version 23) | |
69 | (not (string-match "\\`outline-[0-9]+" | |
70 | (symbol-name inherits))))) | |
20908596 CD |
71 | (list (list t :inherit inherits))) |
72 | ((or (featurep 'xemacs) (< emacs-major-version 22)) | |
73 | ;; These do not understand the `min-colors' attribute. | |
74 | (let (r e a) | |
75 | (while (setq e (pop specs)) | |
76 | (cond | |
77 | ((memq (car e) '(t default)) (push e r)) | |
78 | ((setq a (member '(min-colors 8) (car e))) | |
79 | (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) | |
80 | (cdr e))))) | |
81 | ((setq a (assq 'min-colors (car e))) | |
82 | (setq e (cons (delq a (car e)) (cdr e))) | |
83 | (or (assoc (car e) r) (push e r))) | |
84 | (t (or (assoc (car e) r) (push e r))))) | |
85 | (nreverse r))) | |
86 | (t specs))) | |
87 | (put 'org-compatible-face 'lisp-indent-function 1) | |
88 | ||
86fbb8ca CD |
89 | (defun org-version-check (version feature level) |
90 | (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) | |
91 | (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) | |
92 | (rmaj (or (nth 0 v1) 99)) | |
93 | (rmin (or (nth 1 v1) 99)) | |
94 | (rbld (or (nth 2 v1) 99)) | |
95 | (maj (or (nth 0 v2) 0)) | |
96 | (min (or (nth 1 v2) 0)) | |
97 | (bld (or (nth 2 v2) 0))) | |
98 | (if (or (< maj rmaj) | |
99 | (and (= maj rmaj) | |
100 | (< min rmin)) | |
101 | (and (= maj rmaj) | |
102 | (= min rmin) | |
103 | (< bld rbld))) | |
104 | (if (eq level :predicate) | |
105 | ;; just return if we have the version | |
106 | nil | |
107 | (let ((msg (format "Emacs %s or greater is recommended for %s" | |
108 | version feature))) | |
109 | (display-warning 'org msg level) | |
110 | t)) | |
111 | t))) | |
112 | ||
8223b1d2 | 113 | \f |
20908596 CD |
114 | ;;;; Emacs/XEmacs compatibility |
115 | ||
271672fa BG |
116 | (eval-and-compile |
117 | (defun org-defvaralias (new-alias base-variable &optional docstring) | |
118 | "Compatibility function for defvaralias. | |
119 | Don't do the aliasing when `defvaralias' is not bound." | |
120 | (declare (indent 1)) | |
121 | (when (fboundp 'defvaralias) | |
122 | (defvaralias new-alias base-variable docstring))) | |
123 | ||
124 | (when (and (not (boundp 'user-emacs-directory)) | |
125 | (boundp 'user-init-directory)) | |
126 | (org-defvaralias 'user-emacs-directory 'user-init-directory))) | |
127 | ||
128 | (when (featurep 'xemacs) | |
129 | (defadvice custom-handle-keyword | |
130 | (around org-custom-handle-keyword | |
131 | activate preactivate) | |
132 | "Remove custom keywords not recognized to avoid producing an error." | |
133 | (cond | |
134 | ((eq (ad-get-arg 1) :package-version)) | |
135 | (t ad-do-it))) | |
136 | (defadvice define-obsolete-variable-alias | |
137 | (around org-define-obsolete-variable-alias | |
138 | (obsolete-name current-name &optional when docstring) | |
139 | activate preactivate) | |
140 | "Declare arguments defined in later versions of Emacs." | |
141 | ad-do-it) | |
142 | (defadvice define-obsolete-function-alias | |
143 | (around org-define-obsolete-function-alias | |
144 | (obsolete-name current-name &optional when docstring) | |
145 | activate preactivate) | |
146 | "Declare arguments defined in later versions of Emacs." | |
147 | ad-do-it) | |
148 | (defvar customize-package-emacs-version-alist nil) | |
149 | (defvar temporary-file-directory (temp-directory))) | |
150 | ||
86fbb8ca CD |
151 | ;; Keys |
152 | (defconst org-xemacs-key-equivalents | |
153 | '(([mouse-1] . [button1]) | |
154 | ([mouse-2] . [button2]) | |
155 | ([mouse-3] . [button3]) | |
156 | ([C-mouse-4] . [(control mouse-4)]) | |
157 | ([C-mouse-5] . [(control mouse-5)])) | |
158 | "Translation alist for a couple of keys.") | |
159 | ||
20908596 | 160 | ;; Overlay compatibility functions |
20908596 CD |
161 | (defun org-detach-overlay (ovl) |
162 | (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) | |
20908596 CD |
163 | (defun org-overlay-display (ovl text &optional face evap) |
164 | "Make overlay OVL display TEXT with face FACE." | |
165 | (if (featurep 'xemacs) | |
166 | (let ((gl (make-glyph text))) | |
167 | (and face (set-glyph-face gl face)) | |
168 | (set-extent-property ovl 'invisible t) | |
169 | (set-extent-property ovl 'end-glyph gl)) | |
170 | (overlay-put ovl 'display text) | |
171 | (if face (overlay-put ovl 'face face)) | |
172 | (if evap (overlay-put ovl 'evaporate t)))) | |
173 | (defun org-overlay-before-string (ovl text &optional face evap) | |
174 | "Make overlay OVL display TEXT with face FACE." | |
175 | (if (featurep 'xemacs) | |
176 | (let ((gl (make-glyph text))) | |
177 | (and face (set-glyph-face gl face)) | |
178 | (set-extent-property ovl 'begin-glyph gl)) | |
179 | (if face (org-add-props text nil 'face face)) | |
180 | (overlay-put ovl 'before-string text) | |
181 | (if evap (overlay-put ovl 'evaporate t)))) | |
20908596 CD |
182 | (defun org-find-overlays (prop &optional pos delete) |
183 | "Find all overlays specifying PROP at POS or point. | |
184 | If DELETE is non-nil, delete all those overlays." | |
86fbb8ca | 185 | (let ((overlays (overlays-at (or pos (point)))) |
20908596 CD |
186 | ov found) |
187 | (while (setq ov (pop overlays)) | |
86fbb8ca CD |
188 | (if (overlay-get ov prop) |
189 | (if delete (delete-overlay ov) (push ov found)))) | |
20908596 CD |
190 | found)) |
191 | ||
86fbb8ca | 192 | (defun org-get-x-clipboard (value) |
73d3db82 BG |
193 | "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21." |
194 | (cond ((eq window-system 'x) | |
195 | (let ((x (org-get-x-clipboard-compat value))) | |
196 | (if x (org-no-properties x)))) | |
197 | ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) | |
198 | (w32-get-clipboard-data)))) | |
86fbb8ca | 199 | |
afe98dfa CD |
200 | (defsubst org-decompose-region (beg end) |
201 | "Decompose from BEG to END." | |
202 | (if (featurep 'xemacs) | |
203 | (let ((modified-p (buffer-modified-p)) | |
204 | (buffer-read-only nil)) | |
205 | (remove-text-properties beg end '(composition nil)) | |
206 | (set-buffer-modified-p modified-p)) | |
207 | (decompose-region beg end))) | |
208 | ||
86fbb8ca CD |
209 | ;; Miscellaneous functions |
210 | ||
20908596 CD |
211 | (defun org-add-hook (hook function &optional append local) |
212 | "Add-hook, compatible with both Emacsen." | |
213 | (if (and local (featurep 'xemacs)) | |
214 | (add-local-hook hook function append) | |
215 | (add-hook hook function append local))) | |
216 | ||
217 | (defun org-add-props (string plist &rest props) | |
218 | "Add text properties to entire string, from beginning to end. | |
219 | PLIST may be a list of properties, PROPS are individual properties and values | |
220 | that will be added to PLIST. Returns the string that was modified." | |
221 | (add-text-properties | |
222 | 0 (length string) (if props (append plist props) plist) string) | |
223 | string) | |
224 | (put 'org-add-props 'lisp-indent-function 2) | |
225 | ||
93b62de8 CD |
226 | (defun org-fit-window-to-buffer (&optional window max-height min-height |
227 | shrink-only) | |
228 | "Fit WINDOW to the buffer, but only if it is not a side-by-side window. | |
229 | WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are | |
230 | passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call | |
86fbb8ca | 231 | `shrink-window-if-larger-than-buffer' instead, the height limit is |
93b62de8 | 232 | ignored in this case." |
0bd48b37 CD |
233 | (cond ((if (fboundp 'window-full-width-p) |
234 | (not (window-full-width-p window)) | |
c7cf0ebc BG |
235 | ;; do nothing if another window would suffer |
236 | (> (frame-width) (window-width window)))) | |
93b62de8 CD |
237 | ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) |
238 | (fit-window-to-buffer window max-height min-height)) | |
239 | ((fboundp 'shrink-window-if-larger-than-buffer) | |
240 | (shrink-window-if-larger-than-buffer window))) | |
241 | (or window (selected-window))) | |
242 | ||
afe98dfa CD |
243 | (defun org-number-sequence (from &optional to inc) |
244 | "Call `number-sequence or emulate it." | |
245 | (if (fboundp 'number-sequence) | |
246 | (number-sequence from to inc) | |
247 | (if (or (not to) (= from to)) | |
248 | (list from) | |
249 | (or inc (setq inc 1)) | |
250 | (when (zerop inc) (error "The increment can not be zero")) | |
251 | (let (seq (n 0) (next from)) | |
252 | (if (> inc 0) | |
253 | (while (<= next to) | |
254 | (setq seq (cons next seq) | |
255 | n (1+ n) | |
256 | next (+ from (* n inc)))) | |
257 | (while (>= next to) | |
258 | (setq seq (cons next seq) | |
259 | n (1+ n) | |
260 | next (+ from (* n inc))))) | |
261 | (nreverse seq))))) | |
262 | ||
30cb51f1 BG |
263 | ;; `set-transient-map' is only in Emacs >= 24.4 |
264 | (defalias 'org-set-transient-map | |
265 | (if (fboundp 'set-transient-map) | |
266 | 'set-transient-map | |
267 | 'set-temporary-overlay-map)) | |
268 | ||
20908596 CD |
269 | ;; Region compatibility |
270 | ||
271 | (defvar org-ignore-region nil | |
271672fa | 272 | "Non-nil means temporarily disable the active region.") |
20908596 CD |
273 | |
274 | (defun org-region-active-p () | |
275 | "Is `transient-mark-mode' on and the region active? | |
276 | Works on both Emacs and XEmacs." | |
277 | (if org-ignore-region | |
278 | nil | |
279 | (if (featurep 'xemacs) | |
280 | (and zmacs-regions (region-active-p)) | |
281 | (if (fboundp 'use-region-p) | |
282 | (use-region-p) | |
283 | (and transient-mark-mode mark-active))))) ; Emacs 22 and before | |
284 | ||
c8d0cf5c CD |
285 | (defun org-cursor-to-region-beginning () |
286 | (when (and (org-region-active-p) | |
287 | (> (point) (region-beginning))) | |
288 | (exchange-point-and-mark))) | |
289 | ||
3ab2c837 BG |
290 | ;; Emacs 22 misses `activate-mark' |
291 | (if (fboundp 'activate-mark) | |
292 | (defalias 'org-activate-mark 'activate-mark) | |
293 | (defun org-activate-mark () | |
294 | (when (mark t) | |
295 | (setq mark-active t) | |
e66ba1df BG |
296 | (when (and (boundp 'transient-mark-mode) |
297 | (not transient-mark-mode)) | |
298 | (setq transient-mark-mode 'lambda)) | |
299 | (when (boundp 'zmacs-regions) | |
300 | (setq zmacs-regions t))))) | |
301 | ||
20908596 CD |
302 | ;; Invisibility compatibility |
303 | ||
20908596 CD |
304 | (defun org-remove-from-invisibility-spec (arg) |
305 | "Remove elements from `buffer-invisibility-spec'." | |
306 | (if (fboundp 'remove-from-invisibility-spec) | |
307 | (remove-from-invisibility-spec arg) | |
308 | (if (consp buffer-invisibility-spec) | |
309 | (setq buffer-invisibility-spec | |
310 | (delete arg buffer-invisibility-spec))))) | |
311 | ||
312 | (defun org-in-invisibility-spec-p (arg) | |
313 | "Is ARG a member of `buffer-invisibility-spec'?" | |
314 | (if (consp buffer-invisibility-spec) | |
315 | (member arg buffer-invisibility-spec) | |
316 | nil)) | |
317 | ||
86fbb8ca | 318 | (defmacro org-xemacs-without-invisibility (&rest body) |
27e428e7 | 319 | "Turn off extents with invisibility while executing BODY." |
86fbb8ca CD |
320 | `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) |
321 | 'all-extents-closed-open 'invisible)) | |
322 | ext-inv-specs) | |
323 | (dolist (ext ext-inv) | |
324 | (when (extent-property ext 'invisible) | |
325 | (add-to-list 'ext-inv-specs (list ext (extent-property | |
326 | ext 'invisible))) | |
327 | (set-extent-property ext 'invisible nil))) | |
328 | ,@body | |
329 | (dolist (ext-inv-spec ext-inv-specs) | |
330 | (set-extent-property (car ext-inv-spec) 'invisible | |
331 | (cadr ext-inv-spec))))) | |
e66ba1df | 332 | (def-edebug-spec org-xemacs-without-invisibility (body)) |
86fbb8ca | 333 | |
20908596 CD |
334 | (defun org-indent-to-column (column &optional minimum buffer) |
335 | "Work around a bug with extents with invisibility in XEmacs." | |
71d35b24 | 336 | (if (featurep 'xemacs) |
86fbb8ca | 337 | (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) |
71d35b24 | 338 | (indent-to-column column minimum))) |
20908596 CD |
339 | |
340 | (defun org-indent-line-to (column) | |
341 | "Work around a bug with extents with invisibility in XEmacs." | |
71d35b24 | 342 | (if (featurep 'xemacs) |
86fbb8ca | 343 | (org-xemacs-without-invisibility (indent-line-to column)) |
71d35b24 | 344 | (indent-line-to column))) |
20908596 | 345 | |
30cb51f1 BG |
346 | (defun org-move-to-column (column &optional force buffer) |
347 | "Move to column COLUMN. | |
348 | Pass COLUMN and FORCE to `move-to-column'. | |
349 | Pass BUFFER to the XEmacs version of `move-to-column'." | |
350 | (let* ((with-bracket-link | |
351 | (save-excursion | |
352 | (forward-line 0) | |
353 | (looking-at (concat "^.*" org-bracket-link-regexp)))) | |
354 | (buffer-invisibility-spec | |
355 | (cond | |
356 | ((or (not (derived-mode-p 'org-mode)) | |
357 | (and with-bracket-link (org-invisible-p2))) | |
358 | (remove '(org-link) buffer-invisibility-spec)) | |
359 | (with-bracket-link | |
360 | (remove t buffer-invisibility-spec)) | |
361 | (t buffer-invisibility-spec)))) | |
271672fa | 362 | (if (featurep 'xemacs) |
30cb51f1 BG |
363 | (org-xemacs-without-invisibility |
364 | (move-to-column column force buffer)) | |
271672fa | 365 | (move-to-column column force)))) |
621f83e4 CD |
366 | |
367 | (defun org-get-x-clipboard-compat (value) | |
86fbb8ca CD |
368 | "Get the clipboard value on XEmacs or Emacs 21." |
369 | (cond ((featurep 'xemacs) | |
370 | (org-no-warnings (get-selection-no-error value))) | |
621f83e4 CD |
371 | ((fboundp 'x-get-selection) |
372 | (condition-case nil | |
373 | (or (x-get-selection value 'UTF8_STRING) | |
374 | (x-get-selection value 'COMPOUND_TEXT) | |
375 | (x-get-selection value 'STRING) | |
376 | (x-get-selection value 'TEXT)) | |
377 | (error nil))))) | |
378 | ||
379 | (defun org-propertize (string &rest properties) | |
380 | (if (featurep 'xemacs) | |
ce4fdcb9 CD |
381 | (progn |
382 | (add-text-properties 0 (length string) properties string) | |
383 | string) | |
621f83e4 | 384 | (apply 'propertize string properties))) |
71d35b24 | 385 | |
8223b1d2 | 386 | (defmacro org-find-library-dir (library) |
bdebdb64 | 387 | `(file-name-directory (or (locate-library ,library) ""))) |
c8d0cf5c | 388 | |
0bd48b37 CD |
389 | (defun org-count-lines (s) |
390 | "How many lines in string S?" | |
391 | (let ((start 0) (n 1)) | |
392 | (while (string-match "\n" s start) | |
393 | (setq start (match-end 0) n (1+ n))) | |
394 | (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) | |
395 | (setq n (1- n))) | |
396 | n)) | |
397 | ||
c8d0cf5c CD |
398 | (defun org-kill-new (string &rest args) |
399 | (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) | |
400 | string) | |
401 | (apply 'kill-new string args)) | |
402 | ||
54a0dee5 CD |
403 | (defun org-select-frame-set-input-focus (frame) |
404 | "Select FRAME, raise it, and set input focus, if possible." | |
405 | (cond ((featurep 'xemacs) | |
406 | (if (fboundp 'select-frame-set-input-focus) | |
407 | (select-frame-set-input-focus frame) | |
408 | (raise-frame frame) | |
409 | (select-frame frame) | |
410 | (focus-frame frame))) | |
411 | ;; `select-frame-set-input-focus' defined in Emacs 21 will not | |
412 | ;; set the input focus. | |
413 | ((>= emacs-major-version 22) | |
414 | (select-frame-set-input-focus frame)) | |
415 | (t | |
416 | (raise-frame frame) | |
417 | (select-frame frame) | |
418 | (cond ((memq window-system '(x ns mac)) | |
419 | (x-focus-frame frame)) | |
420 | ((eq window-system 'w32) | |
421 | (w32-focus-frame frame))) | |
422 | (when focus-follows-mouse | |
423 | (set-mouse-position frame (1- (frame-width frame)) 0))))) | |
424 | ||
425 | (defun org-float-time (&optional time) | |
426 | "Convert time value TIME to a floating point number. | |
427 | TIME defaults to the current time." | |
428 | (if (featurep 'xemacs) | |
429 | (time-to-seconds (or time (current-time))) | |
430 | (float-time time))) | |
431 | ||
c7cf0ebc BG |
432 | ;; `user-error' is only available from 24.2.50 on |
433 | (unless (fboundp 'user-error) | |
434 | (defalias 'user-error 'error)) | |
435 | ||
436 | (defmacro org-no-popups (&rest body) | |
437 | "Suppress popup windows. | |
438 | Let-bind some variables to nil around BODY to achieve the desired | |
439 | effect, which variables to use depends on the Emacs version." | |
271672fa BG |
440 | (if (org-version-check "24.2.50" "" :predicate) |
441 | `(let (pop-up-frames display-buffer-alist) | |
442 | ,@body) | |
443 | `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) | |
444 | ,@body))) | |
c7cf0ebc | 445 | |
acedf35c CD |
446 | (if (fboundp 'string-match-p) |
447 | (defalias 'org-string-match-p 'string-match-p) | |
448 | (defun org-string-match-p (regexp string &optional start) | |
86fbb8ca | 449 | (save-match-data |
acedf35c | 450 | (funcall 'string-match regexp string start)))) |
86fbb8ca | 451 | |
acedf35c CD |
452 | (if (fboundp 'looking-at-p) |
453 | (defalias 'org-looking-at-p 'looking-at-p) | |
454 | (defun org-looking-at-p (&rest args) | |
86fbb8ca | 455 | (save-match-data |
afe98dfa | 456 | (apply 'looking-at args)))) |
86fbb8ca | 457 | |
c7cf0ebc | 458 | ;; XEmacs does not have `looking-back'. |
ed21c5c8 CD |
459 | (if (fboundp 'looking-back) |
460 | (defalias 'org-looking-back 'looking-back) | |
461 | (defun org-looking-back (regexp &optional limit greedy) | |
462 | "Return non-nil if text before point matches regular expression REGEXP. | |
463 | Like `looking-at' except matches before point, and is slower. | |
464 | LIMIT if non-nil speeds up the search by specifying a minimum | |
465 | starting position, to avoid checking matches that would start | |
466 | before LIMIT. | |
467 | ||
468 | If GREEDY is non-nil, extend the match backwards as far as | |
469 | possible, stopping when a single additional previous character | |
470 | cannot be part of a match for REGEXP. When the match is | |
471 | extended, its starting position is allowed to occur before | |
472 | LIMIT." | |
473 | (let ((start (point)) | |
474 | (pos | |
475 | (save-excursion | |
476 | (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) | |
477 | (point))))) | |
478 | (if (and greedy pos) | |
479 | (save-restriction | |
480 | (narrow-to-region (point-min) start) | |
481 | (while (and (> pos (point-min)) | |
482 | (save-excursion | |
483 | (goto-char pos) | |
484 | (backward-char 1) | |
485 | (looking-at (concat "\\(?:" regexp "\\)\\'")))) | |
486 | (setq pos (1- pos))) | |
487 | (save-excursion | |
488 | (goto-char pos) | |
489 | (looking-at (concat "\\(?:" regexp "\\)\\'"))))) | |
490 | (not (null pos))))) | |
491 | ||
acedf35c CD |
492 | (defun org-floor* (x &optional y) |
493 | "Return a list of the floor of X and the fractional part of X. | |
494 | With two arguments, return floor and remainder of their quotient." | |
495 | (let ((q (floor x y))) | |
496 | (list q (- x (if y (* y q) q))))) | |
497 | ||
8223b1d2 | 498 | ;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. |
e66ba1df BG |
499 | (defun org-pop-to-buffer-same-window |
500 | (&optional buffer-or-name norecord label) | |
501 | "Pop to buffer specified by BUFFER-OR-NAME in the selected window." | |
502 | (if (fboundp 'pop-to-buffer-same-window) | |
503 | (funcall | |
504 | 'pop-to-buffer-same-window buffer-or-name norecord) | |
505 | (funcall 'switch-to-buffer buffer-or-name norecord))) | |
5b409b39 | 506 | |
c7cf0ebc BG |
507 | ;; RECURSIVE has been introduced with Emacs 23.2. |
508 | ;; This is copying and adapted from `tramp-compat-delete-directory' | |
509 | (defun org-delete-directory (directory &optional recursive) | |
510 | "Compatibility function for `delete-directory'." | |
511 | (if (null recursive) | |
512 | (delete-directory directory) | |
513 | (condition-case nil | |
514 | (funcall 'delete-directory directory recursive) | |
515 | ;; This Emacs version does not support the RECURSIVE flag. We | |
516 | ;; use the implementation from Emacs 23.2. | |
517 | (wrong-number-of-arguments | |
518 | (setq directory (directory-file-name (expand-file-name directory))) | |
519 | (if (not (file-symlink-p directory)) | |
520 | (mapc (lambda (file) | |
521 | (if (eq t (car (file-attributes file))) | |
522 | (org-delete-directory file recursive) | |
523 | (delete-file file))) | |
524 | (directory-files | |
525 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | |
526 | (delete-directory directory))))) | |
8223b1d2 BG |
527 | |
528 | ;;;###autoload | |
529 | (defmacro org-check-version () | |
530 | "Try very hard to provide sensible version strings." | |
531 | (let* ((org-dir (org-find-library-dir "org")) | |
532 | (org-version.el (concat org-dir "org-version.el")) | |
533 | (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) | |
534 | (if (require 'org-version org-version.el 'noerror) | |
535 | '(progn | |
536 | (autoload 'org-release "org-version.el") | |
537 | (autoload 'org-git-version "org-version.el")) | |
538 | (if (require 'org-fixup org-fixup.el 'noerror) | |
539 | '(org-fixup) | |
540 | ;; provide fallback definitions and complain | |
541 | (warn "Could not define org version correctly. Check installation!") | |
542 | '(progn | |
543 | (defun org-release () "N/A") | |
544 | (defun org-git-version () "N/A !!check installation!!")))))) | |
545 | ||
271672fa BG |
546 | (defun org-file-equal-p (f1 f2) |
547 | "Return t if files F1 and F2 are the same. | |
548 | Implements `file-equal-p' for older emacsen and XEmacs." | |
549 | (if (fboundp 'file-equal-p) | |
550 | (file-equal-p f1 f2) | |
551 | (let (f1-attr f2-attr) | |
552 | (and (setq f1-attr (file-attributes (file-truename f1))) | |
553 | (setq f2-attr (file-attributes (file-truename f2))) | |
554 | (equal f1-attr f2-attr))))) | |
555 | ||
556 | ;; `buffer-narrowed-p' is available for Emacs >=24.3 | |
557 | (defun org-buffer-narrowed-p () | |
558 | "Compatibility function for `buffer-narrowed-p'." | |
559 | (if (fboundp 'buffer-narrowed-p) | |
560 | (buffer-narrowed-p) | |
561 | (/= (- (point-max) (point-min)) (buffer-size)))) | |
562 | ||
563 | (defmacro org-with-silent-modifications (&rest body) | |
564 | (if (fboundp 'with-silent-modifications) | |
565 | `(with-silent-modifications ,@body) | |
566 | `(org-unmodified ,@body))) | |
567 | (def-edebug-spec org-with-silent-modifications (body)) | |
568 | ||
e66ba1df | 569 | (provide 'org-compat) |
b349f79f | 570 | |
20908596 | 571 | ;;; org-compat.el ends here |