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)