Commit | Line | Data |
---|---|---|
20908596 CD |
1 | ;;; org-compat.el --- Compatibility code for Org-mode |
2 | ||
cbd20947 | 3 | ;; Copyright (C) 2004-2011 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 | |
3ab2c837 | 8 | ;; Version: 7.7 |
20908596 CD |
9 | ;; |
10 | ;; This file is part of GNU Emacs. | |
11 | ;; | |
b1fc2b50 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
20908596 | 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. | |
20908596 CD |
16 | |
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. | |
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/>. |
20908596 CD |
24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
25 | ;; | |
26 | ;;; Commentary: | |
27 | ||
28 | ;; This file contains code needed for compatibility with XEmacs and older | |
29 | ;; versions of GNU Emacs. | |
30 | ||
31 | ;;; Code: | |
32 | ||
c8d0cf5c CD |
33 | (eval-when-compile |
34 | (require 'cl)) | |
35 | ||
621f83e4 CD |
36 | (require 'org-macs) |
37 | ||
8d642074 | 38 | (declare-function find-library-name "find-func" (library)) |
9d459fc5 | 39 | (declare-function w32-focus-frame "term/w32-win" (frame)) |
c8d0cf5c | 40 | |
86fbb8ca CD |
41 | ;; The following constant is for backward compatibility. We do not use |
42 | ;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) | |
43 | ;; at compilation time and can therefore optimize code better. | |
44 | (defconst org-xemacs-p (featurep 'xemacs)) | |
20908596 CD |
45 | (defconst org-format-transports-properties-p |
46 | (let ((x "a")) | |
47 | (add-text-properties 0 1 '(test t) x) | |
48 | (get-text-property 0 'test (format "%s" x))) | |
49 | "Does format transport text properties?") | |
50 | ||
51 | (defun org-compatible-face (inherits specs) | |
52 | "Make a compatible face specification. | |
53 | If INHERITS is an existing face and if the Emacs version supports it, | |
c8d0cf5c CD |
54 | just inherit the face. If INHERITS is set and the Emacs version does |
55 | not support it, copy the face specification from the inheritance face. | |
56 | If INHERITS is not given and SPECS is, use SPECS to define the face. | |
20908596 CD |
57 | XEmacs and Emacs 21 do not know about the `min-colors' attribute. |
58 | For them we convert a (min-colors 8) entry to a `tty' entry and move it | |
59 | to the top of the list. The `min-colors' attribute will be removed from | |
60 | any other entries, and any resulting duplicates will be removed entirely." | |
c8d0cf5c CD |
61 | (when (and inherits (facep inherits) (not specs)) |
62 | (setq specs (or specs | |
63 | (get inherits 'saved-face) | |
64 | (get inherits 'face-defface-spec)))) | |
20908596 CD |
65 | (cond |
66 | ((and inherits (facep inherits) | |
c8d0cf5c CD |
67 | (not (featurep 'xemacs)) |
68 | (>= emacs-major-version 22) | |
69 | ;; do not inherit outline faces before Emacs 23 | |
70 | (or (>= emacs-major-version 23) | |
71 | (not (string-match "\\`outline-[0-9]+" | |
72 | (symbol-name inherits))))) | |
20908596 CD |
73 | (list (list t :inherit inherits))) |
74 | ((or (featurep 'xemacs) (< emacs-major-version 22)) | |
75 | ;; These do not understand the `min-colors' attribute. | |
76 | (let (r e a) | |
77 | (while (setq e (pop specs)) | |
78 | (cond | |
79 | ((memq (car e) '(t default)) (push e r)) | |
80 | ((setq a (member '(min-colors 8) (car e))) | |
81 | (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) | |
82 | (cdr e))))) | |
83 | ((setq a (assq 'min-colors (car e))) | |
84 | (setq e (cons (delq a (car e)) (cdr e))) | |
85 | (or (assoc (car e) r) (push e r))) | |
86 | (t (or (assoc (car e) r) (push e r))))) | |
87 | (nreverse r))) | |
88 | (t specs))) | |
89 | (put 'org-compatible-face 'lisp-indent-function 1) | |
90 | ||
86fbb8ca CD |
91 | (defun org-version-check (version feature level) |
92 | (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) | |
93 | (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) | |
94 | (rmaj (or (nth 0 v1) 99)) | |
95 | (rmin (or (nth 1 v1) 99)) | |
96 | (rbld (or (nth 2 v1) 99)) | |
97 | (maj (or (nth 0 v2) 0)) | |
98 | (min (or (nth 1 v2) 0)) | |
99 | (bld (or (nth 2 v2) 0))) | |
100 | (if (or (< maj rmaj) | |
101 | (and (= maj rmaj) | |
102 | (< min rmin)) | |
103 | (and (= maj rmaj) | |
104 | (= min rmin) | |
105 | (< bld rbld))) | |
106 | (if (eq level :predicate) | |
107 | ;; just return if we have the version | |
108 | nil | |
109 | (let ((msg (format "Emacs %s or greater is recommended for %s" | |
110 | version feature))) | |
111 | (display-warning 'org msg level) | |
112 | t)) | |
113 | t))) | |
114 | ||
20908596 CD |
115 | ;;;; Emacs/XEmacs compatibility |
116 | ||
86fbb8ca CD |
117 | ;; Keys |
118 | (defconst org-xemacs-key-equivalents | |
119 | '(([mouse-1] . [button1]) | |
120 | ([mouse-2] . [button2]) | |
121 | ([mouse-3] . [button3]) | |
122 | ([C-mouse-4] . [(control mouse-4)]) | |
123 | ([C-mouse-5] . [(control mouse-5)])) | |
124 | "Translation alist for a couple of keys.") | |
125 | ||
20908596 | 126 | ;; Overlay compatibility functions |
20908596 CD |
127 | (defun org-detach-overlay (ovl) |
128 | (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) | |
20908596 CD |
129 | (defun org-overlay-display (ovl text &optional face evap) |
130 | "Make overlay OVL display TEXT with face FACE." | |
131 | (if (featurep 'xemacs) | |
132 | (let ((gl (make-glyph text))) | |
133 | (and face (set-glyph-face gl face)) | |
134 | (set-extent-property ovl 'invisible t) | |
135 | (set-extent-property ovl 'end-glyph gl)) | |
136 | (overlay-put ovl 'display text) | |
137 | (if face (overlay-put ovl 'face face)) | |
138 | (if evap (overlay-put ovl 'evaporate t)))) | |
139 | (defun org-overlay-before-string (ovl text &optional face evap) | |
140 | "Make overlay OVL display TEXT with face FACE." | |
141 | (if (featurep 'xemacs) | |
142 | (let ((gl (make-glyph text))) | |
143 | (and face (set-glyph-face gl face)) | |
144 | (set-extent-property ovl 'begin-glyph gl)) | |
145 | (if face (org-add-props text nil 'face face)) | |
146 | (overlay-put ovl 'before-string text) | |
147 | (if evap (overlay-put ovl 'evaporate t)))) | |
20908596 CD |
148 | (defun org-find-overlays (prop &optional pos delete) |
149 | "Find all overlays specifying PROP at POS or point. | |
150 | If DELETE is non-nil, delete all those overlays." | |
86fbb8ca | 151 | (let ((overlays (overlays-at (or pos (point)))) |
20908596 CD |
152 | ov found) |
153 | (while (setq ov (pop overlays)) | |
86fbb8ca CD |
154 | (if (overlay-get ov prop) |
155 | (if delete (delete-overlay ov) (push ov found)))) | |
20908596 CD |
156 | found)) |
157 | ||
86fbb8ca CD |
158 | (defun org-get-x-clipboard (value) |
159 | "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." | |
160 | (if (eq window-system 'x) | |
161 | (let ((x (org-get-x-clipboard-compat value))) | |
162 | (if x (org-no-properties x))))) | |
163 | ||
afe98dfa CD |
164 | (defsubst org-decompose-region (beg end) |
165 | "Decompose from BEG to END." | |
166 | (if (featurep 'xemacs) | |
167 | (let ((modified-p (buffer-modified-p)) | |
168 | (buffer-read-only nil)) | |
169 | (remove-text-properties beg end '(composition nil)) | |
170 | (set-buffer-modified-p modified-p)) | |
171 | (decompose-region beg end))) | |
172 | ||
86fbb8ca CD |
173 | ;; Miscellaneous functions |
174 | ||
20908596 CD |
175 | (defun org-add-hook (hook function &optional append local) |
176 | "Add-hook, compatible with both Emacsen." | |
177 | (if (and local (featurep 'xemacs)) | |
178 | (add-local-hook hook function append) | |
179 | (add-hook hook function append local))) | |
180 | ||
181 | (defun org-add-props (string plist &rest props) | |
182 | "Add text properties to entire string, from beginning to end. | |
183 | PLIST may be a list of properties, PROPS are individual properties and values | |
184 | that will be added to PLIST. Returns the string that was modified." | |
185 | (add-text-properties | |
186 | 0 (length string) (if props (append plist props) plist) string) | |
187 | string) | |
188 | (put 'org-add-props 'lisp-indent-function 2) | |
189 | ||
93b62de8 CD |
190 | (defun org-fit-window-to-buffer (&optional window max-height min-height |
191 | shrink-only) | |
192 | "Fit WINDOW to the buffer, but only if it is not a side-by-side window. | |
193 | WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are | |
194 | passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call | |
86fbb8ca | 195 | `shrink-window-if-larger-than-buffer' instead, the height limit is |
93b62de8 | 196 | ignored in this case." |
0bd48b37 CD |
197 | (cond ((if (fboundp 'window-full-width-p) |
198 | (not (window-full-width-p window)) | |
199 | (> (frame-width) (window-width window))) | |
93b62de8 CD |
200 | ;; do nothing if another window would suffer |
201 | ) | |
202 | ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) | |
203 | (fit-window-to-buffer window max-height min-height)) | |
204 | ((fboundp 'shrink-window-if-larger-than-buffer) | |
205 | (shrink-window-if-larger-than-buffer window))) | |
206 | (or window (selected-window))) | |
207 | ||
afe98dfa CD |
208 | (defun org-number-sequence (from &optional to inc) |
209 | "Call `number-sequence or emulate it." | |
210 | (if (fboundp 'number-sequence) | |
211 | (number-sequence from to inc) | |
212 | (if (or (not to) (= from to)) | |
213 | (list from) | |
214 | (or inc (setq inc 1)) | |
215 | (when (zerop inc) (error "The increment can not be zero")) | |
216 | (let (seq (n 0) (next from)) | |
217 | (if (> inc 0) | |
218 | (while (<= next to) | |
219 | (setq seq (cons next seq) | |
220 | n (1+ n) | |
221 | next (+ from (* n inc)))) | |
222 | (while (>= next to) | |
223 | (setq seq (cons next seq) | |
224 | n (1+ n) | |
225 | next (+ from (* n inc))))) | |
226 | (nreverse seq))))) | |
227 | ||
20908596 CD |
228 | ;; Region compatibility |
229 | ||
230 | (defvar org-ignore-region nil | |
231 | "To temporarily disable the active region.") | |
232 | ||
233 | (defun org-region-active-p () | |
234 | "Is `transient-mark-mode' on and the region active? | |
235 | Works on both Emacs and XEmacs." | |
236 | (if org-ignore-region | |
237 | nil | |
238 | (if (featurep 'xemacs) | |
239 | (and zmacs-regions (region-active-p)) | |
240 | (if (fboundp 'use-region-p) | |
241 | (use-region-p) | |
242 | (and transient-mark-mode mark-active))))) ; Emacs 22 and before | |
243 | ||
c8d0cf5c CD |
244 | (defun org-cursor-to-region-beginning () |
245 | (when (and (org-region-active-p) | |
246 | (> (point) (region-beginning))) | |
247 | (exchange-point-and-mark))) | |
248 | ||
3ab2c837 BG |
249 | ;; Emacs 22 misses `activate-mark' |
250 | (if (fboundp 'activate-mark) | |
251 | (defalias 'org-activate-mark 'activate-mark) | |
252 | (defun org-activate-mark () | |
253 | (when (mark t) | |
254 | (setq mark-active t) | |
255 | (unless transient-mark-mode | |
256 | (setq transient-mark-mode 'lambda))))) | |
257 | ||
20908596 CD |
258 | ;; Invisibility compatibility |
259 | ||
20908596 CD |
260 | (defun org-remove-from-invisibility-spec (arg) |
261 | "Remove elements from `buffer-invisibility-spec'." | |
262 | (if (fboundp 'remove-from-invisibility-spec) | |
263 | (remove-from-invisibility-spec arg) | |
264 | (if (consp buffer-invisibility-spec) | |
265 | (setq buffer-invisibility-spec | |
266 | (delete arg buffer-invisibility-spec))))) | |
267 | ||
268 | (defun org-in-invisibility-spec-p (arg) | |
269 | "Is ARG a member of `buffer-invisibility-spec'?" | |
270 | (if (consp buffer-invisibility-spec) | |
271 | (member arg buffer-invisibility-spec) | |
272 | nil)) | |
273 | ||
86fbb8ca | 274 | (defmacro org-xemacs-without-invisibility (&rest body) |
4c36be58 | 275 | "Turn off extents with invisibility while executing BODY." |
86fbb8ca CD |
276 | `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) |
277 | 'all-extents-closed-open 'invisible)) | |
278 | ext-inv-specs) | |
279 | (dolist (ext ext-inv) | |
280 | (when (extent-property ext 'invisible) | |
281 | (add-to-list 'ext-inv-specs (list ext (extent-property | |
282 | ext 'invisible))) | |
283 | (set-extent-property ext 'invisible nil))) | |
284 | ,@body | |
285 | (dolist (ext-inv-spec ext-inv-specs) | |
286 | (set-extent-property (car ext-inv-spec) 'invisible | |
287 | (cadr ext-inv-spec))))) | |
288 | ||
20908596 CD |
289 | (defun org-indent-to-column (column &optional minimum buffer) |
290 | "Work around a bug with extents with invisibility in XEmacs." | |
71d35b24 | 291 | (if (featurep 'xemacs) |
86fbb8ca | 292 | (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) |
71d35b24 | 293 | (indent-to-column column minimum))) |
20908596 CD |
294 | |
295 | (defun org-indent-line-to (column) | |
296 | "Work around a bug with extents with invisibility in XEmacs." | |
71d35b24 | 297 | (if (featurep 'xemacs) |
86fbb8ca | 298 | (org-xemacs-without-invisibility (indent-line-to column)) |
71d35b24 | 299 | (indent-line-to column))) |
20908596 CD |
300 | |
301 | (defun org-move-to-column (column &optional force buffer) | |
71d35b24 | 302 | (if (featurep 'xemacs) |
86fbb8ca | 303 | (org-xemacs-without-invisibility (move-to-column column force buffer)) |
71d35b24 | 304 | (move-to-column column force))) |
621f83e4 CD |
305 | |
306 | (defun org-get-x-clipboard-compat (value) | |
86fbb8ca CD |
307 | "Get the clipboard value on XEmacs or Emacs 21." |
308 | (cond ((featurep 'xemacs) | |
309 | (org-no-warnings (get-selection-no-error value))) | |
621f83e4 CD |
310 | ((fboundp 'x-get-selection) |
311 | (condition-case nil | |
312 | (or (x-get-selection value 'UTF8_STRING) | |
313 | (x-get-selection value 'COMPOUND_TEXT) | |
314 | (x-get-selection value 'STRING) | |
315 | (x-get-selection value 'TEXT)) | |
316 | (error nil))))) | |
317 | ||
318 | (defun org-propertize (string &rest properties) | |
319 | (if (featurep 'xemacs) | |
ce4fdcb9 CD |
320 | (progn |
321 | (add-text-properties 0 (length string) properties string) | |
322 | string) | |
621f83e4 | 323 | (apply 'propertize string properties))) |
71d35b24 | 324 | |
ce4fdcb9 CD |
325 | (defun org-substring-no-properties (string &optional from to) |
326 | (if (featurep 'xemacs) | |
db55f368 | 327 | (org-no-properties (substring string (or from 0) to)) |
ce4fdcb9 CD |
328 | (substring-no-properties string from to))) |
329 | ||
c8d0cf5c CD |
330 | (defun org-find-library-name (library) |
331 | (if (fboundp 'find-library-name) | |
332 | (file-name-directory (find-library-name library)) | |
333 | ; XEmacs does not have `find-library-name' | |
334 | (flet ((find-library-name-helper (filename ignored-codesys) | |
335 | filename) | |
336 | (find-library-name (library) | |
337 | (find-library library nil 'find-library-name-helper))) | |
338 | (file-name-directory (find-library-name library))))) | |
339 | ||
0bd48b37 CD |
340 | (defun org-count-lines (s) |
341 | "How many lines in string S?" | |
342 | (let ((start 0) (n 1)) | |
343 | (while (string-match "\n" s start) | |
344 | (setq start (match-end 0) n (1+ n))) | |
345 | (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) | |
346 | (setq n (1- n))) | |
347 | n)) | |
348 | ||
c8d0cf5c CD |
349 | (defun org-kill-new (string &rest args) |
350 | (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) | |
351 | string) | |
352 | (apply 'kill-new string args)) | |
353 | ||
54a0dee5 CD |
354 | (defun org-select-frame-set-input-focus (frame) |
355 | "Select FRAME, raise it, and set input focus, if possible." | |
356 | (cond ((featurep 'xemacs) | |
357 | (if (fboundp 'select-frame-set-input-focus) | |
358 | (select-frame-set-input-focus frame) | |
359 | (raise-frame frame) | |
360 | (select-frame frame) | |
361 | (focus-frame frame))) | |
362 | ;; `select-frame-set-input-focus' defined in Emacs 21 will not | |
363 | ;; set the input focus. | |
364 | ((>= emacs-major-version 22) | |
365 | (select-frame-set-input-focus frame)) | |
366 | (t | |
367 | (raise-frame frame) | |
368 | (select-frame frame) | |
369 | (cond ((memq window-system '(x ns mac)) | |
370 | (x-focus-frame frame)) | |
371 | ((eq window-system 'w32) | |
372 | (w32-focus-frame frame))) | |
373 | (when focus-follows-mouse | |
374 | (set-mouse-position frame (1- (frame-width frame)) 0))))) | |
375 | ||
376 | (defun org-float-time (&optional time) | |
377 | "Convert time value TIME to a floating point number. | |
378 | TIME defaults to the current time." | |
379 | (if (featurep 'xemacs) | |
380 | (time-to-seconds (or time (current-time))) | |
381 | (float-time time))) | |
382 | ||
acedf35c CD |
383 | (if (fboundp 'string-match-p) |
384 | (defalias 'org-string-match-p 'string-match-p) | |
385 | (defun org-string-match-p (regexp string &optional start) | |
86fbb8ca | 386 | (save-match-data |
acedf35c | 387 | (funcall 'string-match regexp string start)))) |
86fbb8ca | 388 | |
acedf35c CD |
389 | (if (fboundp 'looking-at-p) |
390 | (defalias 'org-looking-at-p 'looking-at-p) | |
391 | (defun org-looking-at-p (&rest args) | |
86fbb8ca | 392 | (save-match-data |
afe98dfa | 393 | (apply 'looking-at args)))) |
86fbb8ca | 394 | |
ed21c5c8 CD |
395 | ; XEmacs does not have `looking-back'. |
396 | (if (fboundp 'looking-back) | |
397 | (defalias 'org-looking-back 'looking-back) | |
398 | (defun org-looking-back (regexp &optional limit greedy) | |
399 | "Return non-nil if text before point matches regular expression REGEXP. | |
400 | Like `looking-at' except matches before point, and is slower. | |
401 | LIMIT if non-nil speeds up the search by specifying a minimum | |
402 | starting position, to avoid checking matches that would start | |
403 | before LIMIT. | |
404 | ||
405 | If GREEDY is non-nil, extend the match backwards as far as | |
406 | possible, stopping when a single additional previous character | |
407 | cannot be part of a match for REGEXP. When the match is | |
408 | extended, its starting position is allowed to occur before | |
409 | LIMIT." | |
410 | (let ((start (point)) | |
411 | (pos | |
412 | (save-excursion | |
413 | (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) | |
414 | (point))))) | |
415 | (if (and greedy pos) | |
416 | (save-restriction | |
417 | (narrow-to-region (point-min) start) | |
418 | (while (and (> pos (point-min)) | |
419 | (save-excursion | |
420 | (goto-char pos) | |
421 | (backward-char 1) | |
422 | (looking-at (concat "\\(?:" regexp "\\)\\'")))) | |
423 | (setq pos (1- pos))) | |
424 | (save-excursion | |
425 | (goto-char pos) | |
426 | (looking-at (concat "\\(?:" regexp "\\)\\'"))))) | |
427 | (not (null pos))))) | |
428 | ||
acedf35c CD |
429 | (defun org-floor* (x &optional y) |
430 | "Return a list of the floor of X and the fractional part of X. | |
431 | With two arguments, return floor and remainder of their quotient." | |
432 | (let ((q (floor x y))) | |
433 | (list q (- x (if y (* y q) q))))) | |
434 | ||
20908596 CD |
435 | (provide 'org-compat) |
436 | ||
5b409b39 | 437 | |
b349f79f | 438 | |
20908596 | 439 | ;;; org-compat.el ends here |