Commit | Line | Data |
---|---|---|
dda00b2c BW |
1 | ;;; mh-compat.el --- make MH-E compatibile with various versions of Emacs |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 |
dcf71371 | 4 | ;; Free Software Foundation, Inc. |
dda00b2c BW |
5 | |
6 | ;; Author: Bill Wohler <wohler@newt.com> | |
7 | ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 | ;; Keywords: mail | |
9 | ;; See: mh-e.el | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
5e809f55 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
dda00b2c | 14 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
dda00b2c BW |
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 | |
5e809f55 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
dda00b2c BW |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;;; Change Log: | |
29 | ||
30 | ;;; Code: | |
31 | ||
32 | ;; This is a good place to gather code that is used for compatibility | |
33 | ;; between different versions of Emacs. Please document which versions | |
34 | ;; of Emacs that the defsubst, defalias, or defmacro applies. That | |
35 | ;; way, it's easy to occasionally go through this file and see which | |
36 | ;; macros we can retire. | |
37 | ||
06e7028b | 38 | ;; Please use mh-gnus.el when providing compatibility with different |
d5dc8c56 | 39 | ;; versions of Gnus. |
dda00b2c | 40 | |
d5dc8c56 | 41 | ;; Items are listed alphabetically (except for mh-require which is |
30545916 | 42 | ;; needed sooner it would normally appear). |
d5dc8c56 BW |
43 | |
44 | (require 'mh-acros) | |
45 | ||
46 | (mh-do-in-gnu-emacs | |
47 | (defalias 'mh-require 'require)) | |
48 | ||
49 | (mh-do-in-xemacs | |
50 | (defun mh-require (feature &optional filename noerror) | |
51 | "If feature FEATURE is not loaded, load it from FILENAME. | |
52 | If FEATURE is not a member of the list `features', then the feature | |
53 | is not loaded; so load the file FILENAME. | |
54 | If FILENAME is omitted, the printname of FEATURE is used as the file name. | |
55 | If the optional third argument NOERROR is non-nil, | |
56 | then return nil if the file is not found instead of signaling an error. | |
57 | ||
58 | Simulate NOERROR argument in XEmacs which lacks it." | |
59 | (if (not (featurep feature)) | |
60 | (if filename | |
61 | (load filename noerror t) | |
62 | (load (format "%s" feature) noerror t))))) | |
dda00b2c | 63 | |
c90c4cf1 | 64 | (defun-mh mh-assoc-string assoc-string (key list case-fold) |
06e7028b | 65 | "Like `assoc' but specifically for strings. |
dda00b2c | 66 | Case is ignored if CASE-FOLD is non-nil. |
d5dc8c56 BW |
67 | This function is used by Emacs versions that lack `assoc-string', |
68 | introduced in Emacs 22." | |
06e7028b BW |
69 | (if case-fold |
70 | (assoc-ignore-case key list) | |
71 | (assoc key list))) | |
72 | ||
d5dc8c56 BW |
73 | ;; For XEmacs. |
74 | (defalias 'mh-cancel-timer | |
75 | (if (fboundp 'cancel-timer) | |
76 | 'cancel-timer | |
77 | 'delete-itimer)) | |
78 | ||
1a98ebdf | 79 | (defun mh-display-color-cells (&optional display) |
d5dc8c56 | 80 | "Return the number of color cells supported by DISPLAY. |
1a98ebdf BW |
81 | This function is used by XEmacs to return 2 when `device-color-cells' |
82 | or `display-color-cells' returns nil. This happens when compiling or | |
a425dc3d BW |
83 | running on a tty and causes errors since `display-color-cells' is |
84 | expected to return an integer." | |
1a98ebdf BW |
85 | (cond ((fboundp 'display-color-cells) ; GNU Emacs, XEmacs 21.5b28 |
86 | (or (display-color-cells display) 2)) | |
87 | ((fboundp 'device-color-cells) ; XEmacs 21.4 | |
88 | (or (device-color-cells display) 2)) | |
89 | (t 2))) | |
dda00b2c BW |
90 | |
91 | (defmacro mh-display-completion-list (completions &optional common-substring) | |
92 | "Display the list of COMPLETIONS. | |
06e7028b BW |
93 | See documentation for `display-completion-list' for a description of the |
94 | arguments COMPLETIONS and perhaps COMMON-SUBSTRING. | |
d5dc8c56 BW |
95 | This macro is used by Emacs versions that lack a COMMON-SUBSTRING |
96 | argument, introduced in Emacs 22." | |
dda00b2c BW |
97 | (if (< emacs-major-version 22) |
98 | `(display-completion-list ,completions) | |
99 | `(display-completion-list ,completions ,common-substring))) | |
100 | ||
06e7028b BW |
101 | (defmacro mh-face-foreground (face &optional frame inherit) |
102 | "Return the foreground color name of FACE, or nil if unspecified. | |
103 | See documentation for `face-foreground' for a description of the | |
104 | arguments FACE, FRAME, and perhaps INHERIT. | |
d5dc8c56 BW |
105 | This macro is used by Emacs versions that lack an INHERIT argument, |
106 | introduced in Emacs 22." | |
06e7028b BW |
107 | (if (< emacs-major-version 22) |
108 | `(face-foreground ,face ,frame) | |
109 | `(face-foreground ,face ,frame ,inherit))) | |
110 | ||
111 | (defmacro mh-face-background (face &optional frame inherit) | |
112 | "Return the background color name of face, or nil if unspecified. | |
113 | See documentation for `back-foreground' for a description of the | |
114 | arguments FACE, FRAME, and INHERIT. | |
d5dc8c56 BW |
115 | This macro is used by Emacs versions that lack an INHERIT argument, |
116 | introduced in Emacs 22." | |
06e7028b BW |
117 | (if (< emacs-major-version 22) |
118 | `(face-background ,face ,frame) | |
119 | `(face-background ,face ,frame ,inherit))) | |
120 | ||
c90c4cf1 | 121 | (defun-mh mh-font-lock-add-keywords font-lock-add-keywords |
30545916 | 122 | (mode keywords &optional how) |
21acd4c9 | 123 | "XEmacs does not have `font-lock-add-keywords'. |
30545916 BW |
124 | This function returns nil on that system.") |
125 | ||
c90c4cf1 | 126 | (defun-mh mh-image-load-path-for-library |
08f99a54 | 127 | image-load-path-for-library (library image &optional path no-error) |
d79c9e9d | 128 | "Return a suitable search path for images used by LIBRARY. |
c80658b7 | 129 | |
1792673d | 130 | It searches for IMAGE in `image-load-path' (excluding |
e8b5a7ce BW |
131 | \"`data-directory'/images\") and `load-path', followed by a path |
132 | suitable for LIBRARY, which includes \"../../etc/images\" and | |
133 | \"../etc/images\" relative to the library file itself, and then | |
134 | in \"`data-directory'/images\". | |
c80658b7 | 135 | |
44e3f440 BW |
136 | Then this function returns a list of directories which contains |
137 | first the directory in which IMAGE was found, followed by the | |
138 | value of `load-path'. If PATH is given, it is used instead of | |
139 | `load-path'. | |
08f99a54 | 140 | |
44e3f440 BW |
141 | If NO-ERROR is non-nil and a suitable path can't be found, don't |
142 | signal an error. Instead, return a list of directories as before, | |
143 | except that nil appears in place of the image directory. | |
c80658b7 BW |
144 | |
145 | Here is an example that uses a common idiom to provide | |
146 | compatibility with versions of Emacs that lack the variable | |
147 | `image-load-path': | |
148 | ||
f875b154 BW |
149 | ;; Shush compiler. |
150 | (defvar image-load-path) | |
c80658b7 | 151 | |
44e3f440 | 152 | (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\")) |
f875b154 BW |
153 | (image-load-path (cons (car load-path) |
154 | (when (boundp 'image-load-path) | |
155 | image-load-path)))) | |
44e3f440 | 156 | (mh-tool-bar-folder-buttons-init))" |
c80658b7 BW |
157 | (unless library (error "No library specified")) |
158 | (unless image (error "No image specified")) | |
e8b5a7ce BW |
159 | (let (image-directory image-directory-load-path) |
160 | ;; Check for images in image-load-path or load-path. | |
161 | (let ((img image) | |
162 | (dir (or | |
163 | ;; Images in image-load-path. | |
164 | (mh-image-search-load-path image) | |
165 | ;; Images in load-path. | |
166 | (locate-library image))) | |
167 | parent) | |
168 | ;; Since the image might be in a nested directory (for | |
169 | ;; example, mail/attach.pbm), adjust `image-directory' | |
170 | ;; accordingly. | |
171 | (when dir | |
172 | (setq dir (file-name-directory dir)) | |
173 | (while (setq parent (file-name-directory img)) | |
174 | (setq img (directory-file-name parent) | |
175 | dir (expand-file-name "../" dir)))) | |
176 | (setq image-directory-load-path dir)) | |
177 | ||
178 | ;; If `image-directory-load-path' isn't Emacs' image directory, | |
179 | ;; it's probably a user preference, so use it. Then use a | |
180 | ;; relative setting if possible; otherwise, use | |
181 | ;; `image-directory-load-path'. | |
c80658b7 | 182 | (cond |
e8b5a7ce BW |
183 | ;; User-modified image-load-path? |
184 | ((and image-directory-load-path | |
185 | (not (equal image-directory-load-path | |
186 | (file-name-as-directory | |
187 | (expand-file-name "images" data-directory))))) | |
188 | (setq image-directory image-directory-load-path)) | |
c80658b7 BW |
189 | ;; Try relative setting. |
190 | ((let (library-name d1ei d2ei) | |
191 | ;; First, find library in the load-path. | |
192 | (setq library-name (locate-library library)) | |
193 | (if (not library-name) | |
194 | (error "Cannot find library %s in load-path" library)) | |
195 | ;; And then set image-directory relative to that. | |
196 | (setq | |
197 | ;; Go down 2 levels. | |
e8b5a7ce BW |
198 | d2ei (file-name-as-directory |
199 | (expand-file-name | |
200 | (concat (file-name-directory library-name) "../../etc/images"))) | |
c80658b7 | 201 | ;; Go down 1 level. |
e8b5a7ce BW |
202 | d1ei (file-name-as-directory |
203 | (expand-file-name | |
204 | (concat (file-name-directory library-name) "../etc/images")))) | |
c80658b7 BW |
205 | (setq image-directory |
206 | ;; Set it to nil if image is not found. | |
207 | (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) | |
208 | ((file-exists-p (expand-file-name image d1ei)) d1ei))))) | |
e8b5a7ce BW |
209 | ;; Use Emacs' image directory. |
210 | (image-directory-load-path | |
211 | (setq image-directory image-directory-load-path)) | |
08f99a54 | 212 | (no-error |
08f99a54 | 213 | (message "Could not find image %s for library %s" image library)) |
c80658b7 BW |
214 | (t |
215 | (error "Could not find image %s for library %s" image library))) | |
216 | ||
44e3f440 BW |
217 | ;; Return an augmented `path' or `load-path'. |
218 | (nconc (list image-directory) | |
219 | (delete image-directory (copy-sequence (or path load-path)))))) | |
c80658b7 | 220 | |
c90c4cf1 | 221 | (defun-mh mh-image-search-load-path |
fc0f755f PG |
222 | image-search-load-path (file &optional path) |
223 | "Emacs 21 and XEmacs don't have `image-search-load-path'. | |
224 | This function returns nil on those systems." | |
225 | nil) | |
226 | ||
d5dc8c56 BW |
227 | ;; For XEmacs. |
228 | (defalias 'mh-line-beginning-position | |
229 | (if (fboundp 'line-beginning-position) | |
230 | 'line-beginning-position | |
231 | 'point-at-bol)) | |
232 | ||
233 | ;; For XEmacs. | |
234 | (defalias 'mh-line-end-position | |
235 | (if (fboundp 'line-end-position) | |
236 | 'line-end-position | |
237 | 'point-at-eol)) | |
238 | ||
239 | (mh-require 'mailabbrev nil t) | |
c90c4cf1 | 240 | (defun-mh mh-mail-abbrev-make-syntax-table |
d5dc8c56 BW |
241 | mail-abbrev-make-syntax-table () |
242 | "Emacs 21 and XEmacs don't have `mail-abbrev-make-syntax-table'. | |
fc0f755f | 243 | This function returns nil on those systems." |
d5dc8c56 BW |
244 | nil) |
245 | ||
c90c4cf1 | 246 | (defun-mh mh-match-string-no-properties |
d5dc8c56 BW |
247 | match-string-no-properties (num &optional string) |
248 | "Return string of text matched by last search, without text properties. | |
249 | This function is used by XEmacs that lacks `match-string-no-properties'. | |
250 | The function `buffer-substring-no-properties' is used instead. | |
251 | The argument STRING is ignored." | |
252 | (buffer-substring-no-properties | |
253 | (match-beginning num) (match-end num))) | |
254 | ||
c90c4cf1 | 255 | (defun-mh mh-replace-regexp-in-string replace-regexp-in-string |
613cd8c5 | 256 | (regexp rep string &optional fixedcase literal subexp start) |
d5dc8c56 BW |
257 | "Replace REGEXP with REP everywhere in STRING and return result. |
258 | This function is used by XEmacs that lacks `replace-regexp-in-string'. | |
259 | The function `replace-in-string' is used instead. | |
4a732ae9 BW |
260 | The arguments FIXEDCASE, SUBEXP, and START, used by |
261 | `replace-in-string' are ignored." | |
262 | (replace-in-string string regexp rep literal)) | |
d5dc8c56 | 263 | |
06e7028b BW |
264 | ;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21. |
265 | (if (not (boundp 'url-unreserved-chars)) | |
e6e91eda | 266 | (defconst mh-url-unreserved-chars |
06e7028b BW |
267 | '( |
268 | ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z | |
269 | ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z | |
270 | ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 | |
271 | ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) | |
272 | "A list of characters that are _NOT_ reserved in the URL spec. | |
273 | This is taken from RFC 2396.")) | |
274 | ||
c90c4cf1 | 275 | (defun-mh mh-url-hexify-string url-hexify-string (str) |
06e7028b BW |
276 | "Escape characters in a string. |
277 | This is a copy of `url-hexify-string' from url-util.el in Emacs | |
278 | 22; needed by Emacs 21." | |
279 | (mapconcat | |
280 | (lambda (char) | |
281 | ;; Fixme: use a char table instead. | |
282 | (if (not (memq char mh-url-unreserved-chars)) | |
283 | (if (> char 255) | |
284 | (error "Hexifying multibyte character %s" str) | |
285 | (format "%%%02X" char)) | |
286 | (char-to-string char))) | |
287 | str "")) | |
288 | ||
c90c4cf1 | 289 | (defun-mh mh-view-mode-enter |
d5dc8c56 BW |
290 | view-mode-enter (&optional return-to exit-action) |
291 | "Enter View mode. | |
292 | This function is used by XEmacs that lacks `view-mode-enter'. | |
293 | The function `view-mode' is used instead. | |
294 | The arguments RETURN-TO and EXIT-ACTION are ignored." | |
295 | ;; Shush compiler. | |
296 | (if return-to nil) | |
297 | (if exit-action nil) | |
298 | (view-mode 1)) | |
299 | ||
06e7028b BW |
300 | (defmacro mh-write-file-functions () |
301 | "Return `write-file-functions' if it exists. | |
302 | Otherwise return `local-write-file-hooks'. | |
303 | This macro exists purely for compatibility. The former symbol is used | |
304 | in Emacs 22 onward while the latter is used in previous versions and | |
305 | XEmacs." | |
306 | (if (boundp 'write-file-functions) | |
307 | ''write-file-functions ;Emacs 22 on | |
308 | ''local-write-file-hooks)) ;XEmacs | |
309 | ||
dda00b2c BW |
310 | (provide 'mh-compat) |
311 | ||
312 | ;; Local Variables: | |
313 | ;; no-byte-compile: t | |
314 | ;; indent-tabs-mode: nil | |
315 | ;; sentence-end-double-space: nil | |
316 | ;; End: | |
317 | ||
a1ab640d | 318 | ;; arch-tag: 577b0eab-a5cd-45e1-8d9f-c1a426f4d73c |
dda00b2c | 319 | ;;; mh-compat.el ends here |