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