1 ;;; org-compat.el --- Compatibility code for Org-mode
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: http://orgmode.org
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;; This file contains code needed for compatibility with XEmacs and older
31 ;; versions of GNU Emacs.
35 (defconst org-xemacs-p
(featurep 'xemacs
)) ; not used by org.el itself
36 (defconst org-format-transports-properties-p
38 (add-text-properties 0 1 '(test t
) x
)
39 (get-text-property 0 'test
(format "%s" x
)))
40 "Does format transport text properties?")
42 (defun org-compatible-face (inherits specs
)
43 "Make a compatible face specification.
44 If INHERITS is an existing face and if the Emacs version supports it,
45 just inherit the face. If not, use SPECS to define the face.
46 XEmacs and Emacs 21 do not know about the `min-colors' attribute.
47 For them we convert a (min-colors 8) entry to a `tty' entry and move it
48 to the top of the list. The `min-colors' attribute will be removed from
49 any other entries, and any resulting duplicates will be removed entirely."
51 ((and inherits
(facep inherits
)
52 (not (featurep 'xemacs
)) (> emacs-major-version
22))
53 ;; In Emacs 23, we use inheritance where possible.
54 ;; We only do this in Emacs 23, because only there the outline
55 ;; faces have been changed to the original org-mode-level-faces.
56 (list (list t
:inherit inherits
)))
57 ((or (featurep 'xemacs
) (< emacs-major-version
22))
58 ;; These do not understand the `min-colors' attribute.
60 (while (setq e
(pop specs
))
62 ((memq (car e
) '(t default
)) (push e r
))
63 ((setq a
(member '(min-colors 8) (car e
)))
64 (nconc r
(list (cons (cons '(type tty
) (delq (car a
) (car e
)))
66 ((setq a
(assq 'min-colors
(car e
)))
67 (setq e
(cons (delq a
(car e
)) (cdr e
)))
68 (or (assoc (car e
) r
) (push e r
)))
69 (t (or (assoc (car e
) r
) (push e r
)))))
72 (put 'org-compatible-face
'lisp-indent-function
1)
74 ;;;; Emacs/XEmacs compatibility
76 ;; Overlay compatibility functions
77 (defun org-make-overlay (beg end
&optional buffer
)
78 (if (featurep 'xemacs
)
79 (make-extent beg end buffer
)
80 (make-overlay beg end buffer
)))
81 (defun org-delete-overlay (ovl)
82 (if (featurep 'xemacs
) (progn (delete-extent ovl
) nil
) (delete-overlay ovl
)))
83 (defun org-detach-overlay (ovl)
84 (if (featurep 'xemacs
) (detach-extent ovl
) (delete-overlay ovl
)))
85 (defun org-move-overlay (ovl beg end
&optional buffer
)
86 (if (featurep 'xemacs
)
87 (set-extent-endpoints ovl beg end
(or buffer
(current-buffer)))
88 (move-overlay ovl beg end buffer
)))
89 (defun org-overlay-put (ovl prop value
)
90 (if (featurep 'xemacs
)
91 (set-extent-property ovl prop value
)
92 (overlay-put ovl prop value
)))
93 (defun org-overlay-display (ovl text
&optional face evap
)
94 "Make overlay OVL display TEXT with face FACE."
95 (if (featurep 'xemacs
)
96 (let ((gl (make-glyph text
)))
97 (and face
(set-glyph-face gl face
))
98 (set-extent-property ovl
'invisible t
)
99 (set-extent-property ovl
'end-glyph gl
))
100 (overlay-put ovl
'display text
)
101 (if face
(overlay-put ovl
'face face
))
102 (if evap
(overlay-put ovl
'evaporate t
))))
103 (defun org-overlay-before-string (ovl text
&optional face evap
)
104 "Make overlay OVL display TEXT with face FACE."
105 (if (featurep 'xemacs
)
106 (let ((gl (make-glyph text
)))
107 (and face
(set-glyph-face gl face
))
108 (set-extent-property ovl
'begin-glyph gl
))
109 (if face
(org-add-props text nil
'face face
))
110 (overlay-put ovl
'before-string text
)
111 (if evap
(overlay-put ovl
'evaporate t
))))
112 (defun org-overlay-get (ovl prop
)
113 (if (featurep 'xemacs
)
114 (extent-property ovl prop
)
115 (overlay-get ovl prop
)))
116 (defun org-overlays-at (pos)
117 (if (featurep 'xemacs
) (extents-at pos
) (overlays-at pos
)))
118 (defun org-overlays-in (&optional start end
)
119 (if (featurep 'xemacs
)
120 (extent-list nil start end
)
121 (overlays-in start end
)))
122 (defun org-overlay-start (o)
123 (if (featurep 'xemacs
) (extent-start-position o
) (overlay-start o
)))
124 (defun org-overlay-end (o)
125 (if (featurep 'xemacs
) (extent-end-position o
) (overlay-end o
)))
126 (defun org-overlay-buffer (o)
127 (if (featurep 'xemacs
) (extent-buffer o
) (overlay-buffer o
)))
128 (defun org-find-overlays (prop &optional pos delete
)
129 "Find all overlays specifying PROP at POS or point.
130 If DELETE is non-nil, delete all those overlays."
131 (let ((overlays (org-overlays-at (or pos
(point))))
133 (while (setq ov
(pop overlays
))
134 (if (org-overlay-get ov prop
)
135 (if delete
(org-delete-overlay ov
) (push ov found
))))
138 (defun org-add-hook (hook function
&optional append local
)
139 "Add-hook, compatible with both Emacsen."
140 (if (and local
(featurep 'xemacs
))
141 (add-local-hook hook function append
)
142 (add-hook hook function append local
)))
144 (defun org-add-props (string plist
&rest props
)
145 "Add text properties to entire string, from beginning to end.
146 PLIST may be a list of properties, PROPS are individual properties and values
147 that will be added to PLIST. Returns the string that was modified."
149 0 (length string
) (if props
(append plist props
) plist
) string
)
151 (put 'org-add-props
'lisp-indent-function
2)
153 ;; Region compatibility
155 (defvar org-ignore-region nil
156 "To temporarily disable the active region.")
158 (defun org-region-active-p ()
159 "Is `transient-mark-mode' on and the region active?
160 Works on both Emacs and XEmacs."
161 (if org-ignore-region
163 (if (featurep 'xemacs
)
164 (and zmacs-regions
(region-active-p))
165 (if (fboundp 'use-region-p
)
167 (and transient-mark-mode mark-active
))))) ; Emacs 22 and before
169 ;; Invisibility compatibility
171 (defun org-add-to-invisibility-spec (arg)
172 "Add elements to `buffer-invisibility-spec'.
173 See documentation for `buffer-invisibility-spec' for the kind of elements
176 ((fboundp 'add-to-invisibility-spec
)
177 (add-to-invisibility-spec arg
))
178 ((or (null buffer-invisibility-spec
) (eq buffer-invisibility-spec t
))
179 (setq buffer-invisibility-spec
(list arg
)))
181 (setq buffer-invisibility-spec
182 (cons arg buffer-invisibility-spec
)))))
184 (defun org-remove-from-invisibility-spec (arg)
185 "Remove elements from `buffer-invisibility-spec'."
186 (if (fboundp 'remove-from-invisibility-spec
)
187 (remove-from-invisibility-spec arg
)
188 (if (consp buffer-invisibility-spec
)
189 (setq buffer-invisibility-spec
190 (delete arg buffer-invisibility-spec
)))))
192 (defun org-in-invisibility-spec-p (arg)
193 "Is ARG a member of `buffer-invisibility-spec'?"
194 (if (consp buffer-invisibility-spec
)
195 (member arg buffer-invisibility-spec
)
199 (provide 'org-compat
)
201 ;;; org-compat.el ends here