Mercurial > hg > xemacs-beta
comparison lisp/tl/emu.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | e04119814345 |
children | 54cc21c15cbb |
comparison
equal
deleted
inserted
replaced
69:804d1389bcd6 | 70:131b0175ea99 |
---|---|
1 ;;; emu.el --- Emulation module for each Emacs variants | 1 ;;; emu.el --- Emulation module for each Emacs variants |
2 | 2 |
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> | 5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> |
6 ;; Version: $Id: emu.el,v 1.4 1997/03/16 05:55:39 steve Exp $ | 6 ;; Version: $Id: emu.el,v 1.1.1.1 1996/12/18 22:43:38 steve Exp $ |
7 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs | 7 ;; Keywords: emulation, compatibility, NEmacs, MULE, XEmacs |
8 | 8 |
9 ;; This file is part of emu. | 9 ;; This file is part of tl (Tiny Library). |
10 | 10 |
11 ;; This program is free software; you can redistribute it and/or | 11 ;; This program is free software; you can redistribute it and/or |
12 ;; modify it under the terms of the GNU General Public License as | 12 ;; modify it under the terms of the GNU General Public License as |
13 ;; published by the Free Software Foundation; either version 2, or (at | 13 ;; published by the Free Software Foundation; either version 2, or (at |
14 ;; your option) any later version. | 14 ;; your option) any later version. |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
24 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02111-1307, USA. |
25 | 25 |
26 ;;; Code: | 26 ;;; Code: |
27 | |
28 (defmacro defun-maybe (name &rest everything-else) | |
29 (or (and (fboundp name) | |
30 (not (get name 'defun-maybe)) | |
31 ) | |
32 (` (or (fboundp (quote (, name))) | |
33 (progn | |
34 (defun (, name) (,@ everything-else)) | |
35 (put (quote (, name)) 'defun-maybe t) | |
36 )) | |
37 ))) | |
38 | |
39 (defmacro defmacro-maybe (name &rest everything-else) | |
40 (or (and (fboundp name) | |
41 (not (get name 'defmacro-maybe)) | |
42 ) | |
43 (` (or (fboundp (quote (, name))) | |
44 (progn | |
45 (defmacro (, name) (,@ everything-else)) | |
46 (put (quote (, name)) 'defmacro-maybe t) | |
47 )) | |
48 ))) | |
49 | |
50 (put 'defun-maybe 'lisp-indent-function 'defun) | |
51 (put 'defmacro-maybe 'lisp-indent-function 'defun) | |
52 | |
53 | 27 |
54 (or (boundp 'emacs-major-version) | 28 (or (boundp 'emacs-major-version) |
55 (defconst emacs-major-version (string-to-int emacs-version))) | 29 (defconst emacs-major-version (string-to-int emacs-version))) |
56 (or (boundp 'emacs-minor-version) | 30 (or (boundp 'emacs-minor-version) |
57 (defconst emacs-minor-version | 31 (defconst emacs-minor-version |
99 ) | 73 ) |
100 (t | 74 (t |
101 ;; for EMACS 19 and XEmacs 19 (without mule) | 75 ;; for EMACS 19 and XEmacs 19 (without mule) |
102 (require 'emu-e19) | 76 (require 'emu-e19) |
103 )) | 77 )) |
78 | |
79 | |
80 ;;; @ binary access | |
81 ;;; | |
82 | |
83 (defun insert-binary-file-contents-literally | |
84 (filename &optional visit beg end replace) | |
85 "Like `insert-file-contents-literally', q.v., but don't code conversion. | |
86 A buffer may be modified in several ways after reading into the buffer due | |
87 to advanced Emacs features, such as file-name-handlers, format decoding, | |
88 find-file-hooks, etc. | |
89 This function ensures that none of these modifications will take place. | |
90 \[emu.el]" | |
91 (as-binary-input-file | |
92 (insert-file-contents-literally filename visit beg end replace) | |
93 )) | |
104 | 94 |
105 | 95 |
106 ;;; @ MIME charset | 96 ;;; @ MIME charset |
107 ;;; | 97 ;;; |
108 | 98 |
132 (setq rest (cdr rest)) | 122 (setq rest (cdr rest)) |
133 ))) | 123 ))) |
134 default-mime-charset))) | 124 default-mime-charset))) |
135 | 125 |
136 | 126 |
137 ;;; @ Emacs 19.29 emulation | 127 ;;; @ EMACS 19.29 emulation |
138 ;;; | 128 ;;; |
139 | 129 |
140 (defvar path-separator ":" | 130 (defvar path-separator ":" |
141 "Character used to separate concatenated paths.") | 131 "Character used to separate concatenated paths.") |
142 | 132 |
143 (defun-maybe buffer-substring-no-properties (start end) | 133 (or (fboundp 'buffer-substring-no-properties) |
144 "Return the characters of part of the buffer, without the text properties. | 134 (defun buffer-substring-no-properties (beg end) |
145 The two arguments START and END are character positions; | 135 "Return the text from BEG to END, without text properties, as a string. |
146 they can be in either order. [Emacs 19.29 emulating function]" | 136 \[emu.el; EMACS 19.29 emulating function]" |
147 (let ((string (buffer-substring start end))) | 137 (let ((string (buffer-substring beg end))) |
148 (set-text-properties 0 (length string) nil string) | 138 (tl:set-text-properties 0 (length string) nil string) |
149 string)) | 139 string)) |
150 | 140 ) |
151 (defun-maybe match-string (num &optional string) | |
152 "Return string of text matched by last search. | |
153 NUM specifies which parenthesized expression in the last regexp. | |
154 Value is nil if NUMth pair didn't match, or there were less than NUM pairs. | |
155 Zero means the entire text matched by the whole regexp or whole string. | |
156 STRING should be given if the last search was by `string-match' on STRING. | |
157 \[Emacs 19.29 emulating function]" | |
158 (if (match-beginning num) | |
159 (if string | |
160 (substring string (match-beginning num) (match-end num)) | |
161 (buffer-substring (match-beginning num) (match-end num))))) | |
162 | 141 |
163 (or running-emacs-19_29-or-later | 142 (or running-emacs-19_29-or-later |
164 running-xemacs | 143 running-xemacs |
165 ;; for Emacs 19.28 or earlier | 144 ;; for Emacs 19.28 or earlier |
166 (fboundp 'si:read-string) | 145 (fboundp 'si:read-string) |
174 See `read-from-minibuffer' for details of HISTORY argument." | 153 See `read-from-minibuffer' for details of HISTORY argument." |
175 (si:read-string prompt initial-input) | 154 (si:read-string prompt initial-input) |
176 ) | 155 ) |
177 )) | 156 )) |
178 | 157 |
179 | 158 (or (fboundp 'add-to-list) |
180 ;;; @ Emacs 19.30 emulation | 159 ;; This function was imported Emacs 19.30. |
181 ;;; | 160 (defun add-to-list (list-var element) |
182 | 161 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. |
183 ;; This function was imported Emacs 19.30. | |
184 (defun-maybe add-to-list (list-var element) | |
185 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. | |
186 If you want to use `add-to-list' on a variable that is not defined | 162 If you want to use `add-to-list' on a variable that is not defined |
187 until a certain package is loaded, you should put the call to `add-to-list' | 163 until a certain package is loaded, you should put the call to `add-to-list' |
188 into a hook function that will be run only after loading the package. | 164 into a hook function that will be run only after loading the package. |
189 \[Emacs 19.30 emulating function]" | 165 \[emu.el; EMACS 19.30 emulating function]" |
190 (or (member element (symbol-value list-var)) | 166 (or (member element (symbol-value list-var)) |
191 (set list-var (cons element (symbol-value list-var))) | 167 (set list-var (cons element (symbol-value list-var))))) |
192 )) | 168 ) |
169 | |
170 | |
171 ;;; @ EMACS 19.30 emulation | |
172 ;;; | |
193 | 173 |
194 (cond ((fboundp 'insert-file-contents-literally) | 174 (cond ((fboundp 'insert-file-contents-literally) |
195 ) | 175 ) |
196 ((boundp 'file-name-handler-alist) | 176 ((boundp 'file-name-handler-alist) |
197 (defun insert-file-contents-literally | 177 (defun insert-file-contents-literally |
199 "Like `insert-file-contents', q.v., but only reads in the file. | 179 "Like `insert-file-contents', q.v., but only reads in the file. |
200 A buffer may be modified in several ways after reading into the buffer due | 180 A buffer may be modified in several ways after reading into the buffer due |
201 to advanced Emacs features, such as file-name-handlers, format decoding, | 181 to advanced Emacs features, such as file-name-handlers, format decoding, |
202 find-file-hooks, etc. | 182 find-file-hooks, etc. |
203 This function ensures that none of these modifications will take place. | 183 This function ensures that none of these modifications will take place. |
204 \[Emacs 19.30 emulating function]" | 184 \[emu.el; Emacs 19.30 emulating function]" |
205 (let (file-name-handler-alist) | 185 (let (file-name-handler-alist) |
206 (insert-file-contents filename visit beg end replace) | 186 (insert-file-contents filename visit beg end replace) |
207 )) | 187 )) |
208 ) | 188 ) |
209 (t | 189 (t |
210 (defalias 'insert-file-contents-literally 'insert-file-contents) | 190 (defalias 'insert-file-contents-literally 'insert-file-contents) |
211 )) | 191 )) |
212 | 192 |
213 | 193 |
214 ;;; @ Emacs 19.31 emulation | 194 ;;; @ EMACS 19.31 emulation |
215 ;;; | 195 ;;; |
216 | 196 |
217 (defun-maybe buffer-live-p (object) | 197 (or (fboundp 'buffer-live-p) |
218 "Return non-nil if OBJECT is a buffer which has not been killed. | 198 (defun buffer-live-p (object) |
199 "Return non-nil if OBJECT is a buffer which has not been killed. | |
219 Value is nil if OBJECT is not a buffer or if it has been killed. | 200 Value is nil if OBJECT is not a buffer or if it has been killed. |
220 \[Emacs 19.31 emulating function]" | 201 \[emu.el; EMACS 19.31 emulating function]" |
221 (and object | 202 (and object |
222 (get-buffer object) | 203 (get-buffer object) |
223 (buffer-name (get-buffer object)) | 204 (buffer-name (get-buffer object)) |
224 )) | 205 )) |
225 | 206 ) |
226 ;; This macro was imported Emacs 19.33. | 207 |
227 (defmacro-maybe save-selected-window (&rest body) | 208 (or (fboundp 'save-selected-window) |
228 "Execute BODY, then select the window that was selected before BODY. | 209 ;; This function was imported Emacs 19.33. |
229 \[Emacs 19.31 emulating function]" | 210 (defmacro save-selected-window (&rest body) |
230 (list 'let | 211 "Execute BODY, then select the window that was selected before BODY. |
231 '((save-selected-window-window (selected-window))) | 212 \[emu.el; EMACS 19.31 emulating function]" |
232 (list 'unwind-protect | 213 (list 'let |
233 (cons 'progn body) | 214 '((save-selected-window-window (selected-window))) |
234 (list 'select-window 'save-selected-window-window)))) | 215 (list 'unwind-protect |
216 (cons 'progn body) | |
217 (list 'select-window 'save-selected-window-window)))) | |
218 ) | |
235 | 219 |
236 | 220 |
237 ;;; @ XEmacs emulation | 221 ;;; @ XEmacs emulation |
238 ;;; | 222 ;;; |
239 | 223 |
240 (defun-maybe functionp (obj) | 224 (or (fboundp 'functionp) |
241 "Returns t if OBJ is a function, nil otherwise. | 225 (defun functionp (obj) |
242 \[XEmacs emulating function]" | 226 "Returns t if OBJ is a function, nil otherwise. |
243 (or (subrp obj) | 227 \[emu.el; XEmacs emulating function]" |
244 (byte-code-function-p obj) | 228 (or (subrp obj) |
245 (and (symbolp obj)(fboundp obj)) | 229 (byte-code-function-p obj) |
246 (and (consp obj)(eq (car obj) 'lambda)) | 230 (and (symbolp obj)(fboundp obj)) |
247 )) | 231 (and (consp obj)(eq (car obj) 'lambda)) |
248 | 232 )) |
233 ) | |
234 | |
249 | 235 |
250 ;;; @ for XEmacs 20 | 236 ;;; @ for XEmacs 20 |
251 ;;; | 237 ;;; |
252 | 238 |
253 (or (fboundp 'char-int) | 239 (or (fboundp 'char-int) |