comparison lisp/tl/emu.el @ 110:fe104dbd9147 r20-1b7

Import from CVS: tag r20-1b7
author cvs
date Mon, 13 Aug 2007 09:19:45 +0200
parents 0d2f883870bc
children cca96a509cfe
comparison
equal deleted inserted replaced
109:e183fc049578 110:fe104dbd9147
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,1997 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/02/15 22:21:25 steve Exp $ 6 ;; Version: $Id: emu.el,v 1.5 1997/03/16 03:05:44 steve Exp $
7 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs 7 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
8 8
9 ;; This file is part of emu. 9 ;; This file is part of emu.
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
34 (defun (, name) (,@ everything-else)) 34 (defun (, name) (,@ everything-else))
35 (put (quote (, name)) 'defun-maybe t) 35 (put (quote (, name)) 'defun-maybe t)
36 )) 36 ))
37 ))) 37 )))
38 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
39 (put 'defun-maybe 'lisp-indent-function 'defun) 50 (put 'defun-maybe 'lisp-indent-function 'defun)
51 (put 'defmacro-maybe 'lisp-indent-function 'defun)
40 52
41 53
42 (or (boundp 'emacs-major-version) 54 (or (boundp 'emacs-major-version)
43 (defconst emacs-major-version (string-to-int emacs-version))) 55 (defconst emacs-major-version (string-to-int emacs-version)))
44 (or (boundp 'emacs-minor-version) 56 (or (boundp 'emacs-minor-version)
120 (setq rest (cdr rest)) 132 (setq rest (cdr rest))
121 ))) 133 )))
122 default-mime-charset))) 134 default-mime-charset)))
123 135
124 136
125 ;;; @ EMACS 19.29 emulation 137 ;;; @ Emacs 19.29 emulation
126 ;;; 138 ;;;
127 139
128 (defvar path-separator ":" 140 (defvar path-separator ":"
129 "Character used to separate concatenated paths.") 141 "Character used to separate concatenated paths.")
130 142
131 (defun-maybe buffer-substring-no-properties (beg end) 143 (defun-maybe buffer-substring-no-properties (start end)
132 "Return the text from BEG to END, without text properties, as a string. 144 "Return the characters of part of the buffer, without the text properties.
133 \[emu.el; EMACS 19.29 emulating function]" 145 The two arguments START and END are character positions;
134 (let ((string (buffer-substring beg end))) 146 they can be in either order. [Emacs 19.29 emulating function]"
135 (tl:set-text-properties 0 (length string) nil string) 147 (let ((string (buffer-substring start end)))
148 (set-text-properties 0 (length string) nil string)
136 string)) 149 string))
137 150
138 (defun-maybe match-string (num &optional string) 151 (defun-maybe match-string (num &optional string)
139 "Return string of text matched by last search. 152 "Return string of text matched by last search.
140 NUM specifies which parenthesized expression in the last regexp. 153 NUM specifies which parenthesized expression in the last regexp.
141 Value is nil if NUMth pair didn't match, or there were less than NUM pairs. 154 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
142 Zero means the entire text matched by the whole regexp or whole string. 155 Zero means the entire text matched by the whole regexp or whole string.
143 STRING should be given if the last search was by `string-match' on STRING. 156 STRING should be given if the last search was by `string-match' on STRING.
144 \[emu.el; EMACS 19.29 emulating function]" 157 \[Emacs 19.29 emulating function]"
145 (if (match-beginning num) 158 (if (match-beginning num)
146 (if string 159 (if string
147 (substring string (match-beginning num) (match-end num)) 160 (substring string (match-beginning num) (match-end num))
148 (buffer-substring (match-beginning num) (match-end num))))) 161 (buffer-substring (match-beginning num) (match-end num)))))
149 162
161 See `read-from-minibuffer' for details of HISTORY argument." 174 See `read-from-minibuffer' for details of HISTORY argument."
162 (si:read-string prompt initial-input) 175 (si:read-string prompt initial-input)
163 ) 176 )
164 )) 177 ))
165 178
179
180 ;;; @ Emacs 19.30 emulation
181 ;;;
182
166 ;; This function was imported Emacs 19.30. 183 ;; This function was imported Emacs 19.30.
167 (defun-maybe add-to-list (list-var element) 184 (defun-maybe add-to-list (list-var element)
168 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. 185 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
169 If you want to use `add-to-list' on a variable that is not defined 186 If you want to use `add-to-list' on a variable that is not defined
170 until a certain package is loaded, you should put the call to `add-to-list' 187 until a certain package is loaded, you should put the call to `add-to-list'
171 into a hook function that will be run only after loading the package. 188 into a hook function that will be run only after loading the package.
172 \[emu.el; EMACS 19.30 emulating function]" 189 \[Emacs 19.30 emulating function]"
173 (or (member element (symbol-value list-var)) 190 (or (member element (symbol-value list-var))
174 (set list-var (cons element (symbol-value list-var))) 191 (set list-var (cons element (symbol-value list-var)))
175 )) 192 ))
176
177
178 ;;; @ EMACS 19.30 emulation
179 ;;;
180 193
181 (cond ((fboundp 'insert-file-contents-literally) 194 (cond ((fboundp 'insert-file-contents-literally)
182 ) 195 )
183 ((boundp 'file-name-handler-alist) 196 ((boundp 'file-name-handler-alist)
184 (defun insert-file-contents-literally 197 (defun insert-file-contents-literally
186 "Like `insert-file-contents', q.v., but only reads in the file. 199 "Like `insert-file-contents', q.v., but only reads in the file.
187 A buffer may be modified in several ways after reading into the buffer due 200 A buffer may be modified in several ways after reading into the buffer due
188 to advanced Emacs features, such as file-name-handlers, format decoding, 201 to advanced Emacs features, such as file-name-handlers, format decoding,
189 find-file-hooks, etc. 202 find-file-hooks, etc.
190 This function ensures that none of these modifications will take place. 203 This function ensures that none of these modifications will take place.
191 \[emu.el; Emacs 19.30 emulating function]" 204 \[Emacs 19.30 emulating function]"
192 (let (file-name-handler-alist) 205 (let (file-name-handler-alist)
193 (insert-file-contents filename visit beg end replace) 206 (insert-file-contents filename visit beg end replace)
194 )) 207 ))
195 ) 208 )
196 (t 209 (t
197 (defalias 'insert-file-contents-literally 'insert-file-contents) 210 (defalias 'insert-file-contents-literally 'insert-file-contents)
198 )) 211 ))
199 212
200 213
201 ;;; @ EMACS 19.31 emulation 214 ;;; @ Emacs 19.31 emulation
202 ;;; 215 ;;;
203 216
204 (defun-maybe buffer-live-p (object) 217 (defun-maybe buffer-live-p (object)
205 "Return non-nil if OBJECT is a buffer which has not been killed. 218 "Return non-nil if OBJECT is a buffer which has not been killed.
206 Value is nil if OBJECT is not a buffer or if it has been killed. 219 Value is nil if OBJECT is not a buffer or if it has been killed.
207 \[emu.el; EMACS 19.31 emulating function]" 220 \[Emacs 19.31 emulating function]"
208 (and object 221 (and object
209 (get-buffer object) 222 (get-buffer object)
210 (buffer-name (get-buffer object)) 223 (buffer-name (get-buffer object))
211 )) 224 ))
212 225
213 (or (fboundp 'save-selected-window) 226 ;; This macro was imported Emacs 19.33.
214 ;; This function was imported Emacs 19.33. 227 (defmacro-maybe save-selected-window (&rest body)
215 (defmacro save-selected-window (&rest body) 228 "Execute BODY, then select the window that was selected before BODY.
216 "Execute BODY, then select the window that was selected before BODY. 229 \[Emacs 19.31 emulating function]"
217 \[emu.el; EMACS 19.31 emulating function]" 230 (list 'let
218 (list 'let 231 '((save-selected-window-window (selected-window)))
219 '((save-selected-window-window (selected-window))) 232 (list 'unwind-protect
220 (list 'unwind-protect 233 (cons 'progn body)
221 (cons 'progn body) 234 (list 'select-window 'save-selected-window-window))))
222 (list 'select-window 'save-selected-window-window))))
223 )
224 235
225 236
226 ;;; @ XEmacs emulation 237 ;;; @ XEmacs emulation
227 ;;; 238 ;;;
228 239
229 (defun-maybe functionp (obj) 240 (defun-maybe functionp (obj)
230 "Returns t if OBJ is a function, nil otherwise. 241 "Returns t if OBJ is a function, nil otherwise.
231 \[emu.el; XEmacs emulating function]" 242 \[XEmacs emulating function]"
232 (or (subrp obj) 243 (or (subrp obj)
233 (byte-code-function-p obj) 244 (byte-code-function-p obj)
234 (and (symbolp obj)(fboundp obj)) 245 (and (symbolp obj)(fboundp obj))
235 (and (consp obj)(eq (car obj) 'lambda)) 246 (and (consp obj)(eq (car obj) 'lambda))
236 )) 247 ))