|
428
|
1 ;;; obsolete.el --- obsoleteness support
|
|
|
2
|
|
|
3 ;; Copyright (C) 1985-1994, 1997 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1994, 1995 Amdahl Corporation.
|
|
|
5 ;; Copyright (C) 1995 Sun Microsystems.
|
|
|
6
|
|
|
7 ;; Maintainer: XEmacs Development Team
|
|
|
8 ;; Keywords: internal, dumped
|
|
|
9
|
|
|
10 ;; This file is part of XEmacs.
|
|
|
11
|
|
|
12 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
13 ;; under the terms of the GNU General Public License as published by
|
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;; any later version.
|
|
|
16
|
|
|
17 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
20 ;; General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
|
23 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
24 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
25 ;; Boston, MA 02111-1307, USA.
|
|
|
26
|
|
|
27 ;;; Synched up with: Not in FSF.
|
|
|
28
|
|
|
29 ;;; Commentary:
|
|
|
30
|
|
|
31 ;; This file is dumped with XEmacs.
|
|
|
32
|
|
|
33 ;; The obsoleteness support used to be scattered throughout various
|
|
|
34 ;; source files. We put the stuff in one place to remove the junkiness
|
|
|
35 ;; from other source files and to facilitate creating/updating things
|
|
|
36 ;; like sysdep.el.
|
|
|
37
|
|
|
38 ;;; Code:
|
|
|
39
|
|
|
40 (defsubst define-obsolete-function-alias (oldfun newfun)
|
|
|
41 "Define OLDFUN as an obsolete alias for function NEWFUN.
|
|
|
42 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
|
|
|
43 as obsolete."
|
|
|
44 (define-function oldfun newfun)
|
|
|
45 (make-obsolete oldfun newfun))
|
|
|
46
|
|
|
47 (defsubst define-compatible-function-alias (oldfun newfun)
|
|
|
48 "Define OLDFUN as a compatible alias for function NEWFUN.
|
|
|
49 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
|
|
|
50 as provided for compatibility only."
|
|
|
51 (define-function oldfun newfun)
|
|
|
52 (make-compatible oldfun newfun))
|
|
|
53
|
|
|
54 (defsubst define-obsolete-variable-alias (oldvar newvar)
|
|
|
55 "Define OLDVAR as an obsolete alias for variable NEWVAR.
|
|
|
56 This makes referencing or setting OLDVAR equivalent to referencing or
|
|
|
57 setting NEWVAR and marks OLDVAR as obsolete.
|
|
|
58 If OLDVAR was bound and NEWVAR was not, Set NEWVAR to OLDVAR.
|
|
|
59
|
|
|
60 Note: Use this before any other references (defvar/defcustom) to NEWVAR"
|
|
|
61 (let ((needs-setting (and (boundp oldvar) (not (boundp newvar))))
|
|
|
62 (value (and (boundp oldvar) (symbol-value oldvar))))
|
|
|
63 (defvaralias oldvar newvar)
|
|
|
64 (make-obsolete-variable oldvar newvar)
|
|
|
65 (and needs-setting (set newvar value))))
|
|
|
66
|
|
|
67 (defsubst define-compatible-variable-alias (oldvar newvar)
|
|
|
68 "Define OLDVAR as a compatible alias for variable NEWVAR.
|
|
|
69 This makes referencing or setting OLDVAR equivalent to referencing or
|
|
|
70 setting NEWVAR and marks OLDVAR as provided for compatibility only."
|
|
|
71 (defvaralias oldvar newvar)
|
|
|
72 (make-compatible-variable oldvar newvar))
|
|
|
73
|
|
|
74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; device stuff
|
|
|
75
|
|
|
76 (make-compatible-variable 'window-system "use (console-type)")
|
|
|
77
|
|
|
78 (defun x-display-color-p (&optional device)
|
|
|
79 "Return t if DEVICE is a color device."
|
|
|
80 (eq 'color (device-class device)))
|
|
|
81 (make-compatible 'x-display-color-p 'device-class)
|
|
|
82
|
|
|
83 (define-function 'x-color-display-p 'x-display-color-p)
|
|
|
84 (make-compatible 'x-display-color-p 'device-class)
|
|
|
85
|
|
|
86 (defun x-display-grayscale-p (&optional device)
|
|
|
87 "Return t if DEVICE is a grayscale device."
|
|
|
88 (eq 'grayscale (device-class device)))
|
|
|
89 (make-compatible 'x-display-grayscale-p 'device-class)
|
|
|
90
|
|
|
91 (define-function 'x-grayscale-display-p 'x-display-grayscale-p)
|
|
|
92 (make-compatible 'x-display-grayscale-p 'device-class)
|
|
|
93
|
|
|
94 (define-compatible-function-alias 'x-display-pixel-width 'device-pixel-width)
|
|
|
95 (define-compatible-function-alias 'x-display-pixel-height 'device-pixel-height)
|
|
|
96 (define-compatible-function-alias 'x-display-planes 'device-bitplanes)
|
|
|
97 (define-compatible-function-alias 'x-display-color-cells 'device-color-cells)
|
|
|
98
|
|
|
99 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; events
|
|
|
100
|
|
|
101 (define-obsolete-function-alias 'menu-event-p 'misc-user-event-p)
|
|
|
102 (make-obsolete-variable 'unread-command-char 'unread-command-events)
|
|
|
103
|
|
|
104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents
|
|
|
105
|
|
|
106 (make-obsolete 'set-window-dot 'set-window-point)
|
|
|
107
|
|
|
108 (define-obsolete-function-alias 'extent-buffer 'extent-object)
|
|
|
109
|
|
|
110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames
|
|
|
111 (defun frame-first-window (frame)
|
|
|
112 "Return the topmost, leftmost window of FRAME.
|
|
|
113 If omitted, FRAME defaults to the currently selected frame."
|
|
|
114 (frame-highest-window frame 0))
|
|
|
115 (make-compatible 'frame-first-window 'frame-highest-window)
|
|
|
116
|
|
|
117 (define-obsolete-variable-alias 'initial-frame-alist 'initial-frame-plist)
|
|
|
118 (define-obsolete-variable-alias 'minibuffer-frame-alist
|
|
|
119 'minibuffer-frame-plist)
|
|
|
120 (define-obsolete-variable-alias 'pop-up-frame-alist 'pop-up-frame-plist)
|
|
|
121 (define-obsolete-variable-alias 'special-display-frame-alist
|
|
|
122 'special-display-frame-plist)
|
|
|
123
|
|
|
124 ;; Defined in C.
|
|
|
125
|
|
|
126 (define-obsolete-variable-alias 'default-frame-alist 'default-frame-plist)
|
|
|
127 (define-obsolete-variable-alias 'default-x-frame-alist 'default-x-frame-plist)
|
|
|
128 (define-obsolete-variable-alias 'default-tty-frame-alist
|
|
|
129 'default-tty-frame-plist)
|
|
|
130
|
|
|
131 (make-compatible 'frame-parameters 'frame-property)
|
|
|
132 (defun frame-parameters (&optional frame)
|
|
|
133 "Return the parameters-alist of frame FRAME.
|
|
|
134 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
|
|
|
135 The meaningful PARMs depend on the kind of frame.
|
|
|
136 If FRAME is omitted, return information on the currently selected frame.
|
|
|
137
|
|
|
138 See the variables `default-frame-plist', `default-x-frame-plist', and
|
|
|
139 `default-tty-frame-plist' for a description of the parameters meaningful
|
|
|
140 for particular types of frames."
|
|
|
141 (or frame (setq frame (selected-frame)))
|
|
|
142 ;; #### This relies on a `copy-sequence' of the user properties in
|
|
|
143 ;; `frame-properties'. Removing that would make `frame-properties' more
|
|
|
144 ;; efficient but this function less efficient, as we couldn't be
|
|
|
145 ;; destructive. Since most callers now use `frame-parameters', we'll
|
|
|
146 ;; do it this way. Should probably change this at some point in the
|
|
|
147 ;; future.
|
|
|
148 (destructive-plist-to-alist (frame-properties frame)))
|
|
|
149
|
|
|
150 (make-compatible 'modify-frame-parameters 'set-frame-properties)
|
|
|
151 (defun modify-frame-parameters (frame alist)
|
|
|
152 "Modify the properties of frame FRAME according to ALIST.
|
|
|
153 ALIST is an alist of properties to change and their new values.
|
|
|
154 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
|
|
|
155 The meaningful PARMs depend on the kind of frame.
|
|
|
156
|
|
|
157 See `set-frame-properties' for built-in property names."
|
|
|
158 ;; it would be nice to be destructive here but that's not safe.
|
|
|
159 (set-frame-properties frame (alist-to-plist alist)))
|
|
|
160
|
|
|
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; faces
|
|
|
162
|
|
|
163 (define-obsolete-function-alias 'list-faces-display 'edit-faces)
|
|
|
164 (define-obsolete-function-alias 'list-faces 'face-list)
|
|
|
165
|
|
|
166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths
|
|
|
167
|
|
|
168 (defvar Info-default-directory-list nil
|
|
|
169 "This used to be the initial value of Info-directory-list.
|
|
|
170 If you want to change the locations where XEmacs looks for info files,
|
|
|
171 set Info-directory-list.")
|
|
|
172 (make-obsolete-variable 'Info-default-directory-list 'Info-directory-list)
|
|
|
173
|
|
|
174 (defvar init-file-user nil
|
|
|
175 "This used to be the name of the user whose init file was read at startup.")
|
|
|
176 (make-obsolete-variable 'init-file-user 'load-user-init-file-p)
|
|
|
177
|
|
|
178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks
|
|
|
179
|
|
|
180 (make-compatible-variable 'lisp-indent-hook 'lisp-indent-function)
|
|
|
181 (make-compatible-variable 'comment-indent-hook 'comment-indent-function)
|
|
|
182 (make-obsolete-variable 'temp-buffer-show-hook
|
|
|
183 'temp-buffer-show-function)
|
|
|
184 (make-obsolete-variable 'inhibit-local-variables
|
|
|
185 "use `enable-local-variables' (with the reversed sense).")
|
|
|
186 (make-obsolete-variable 'suspend-hooks 'suspend-hook)
|
|
|
187 (make-obsolete-variable 'first-change-function 'first-change-hook)
|
|
|
188 (make-obsolete-variable 'before-change-function
|
|
|
189 "use before-change-functions; which is a list of functions rather than a single function.")
|
|
|
190 (make-obsolete-variable 'after-change-function
|
|
|
191 "use after-change-functions; which is a list of functions rather than a single function.")
|
|
|
192
|
|
|
193 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion and deletion
|
|
|
194
|
|
|
195 (define-compatible-function-alias 'insert-and-inherit 'insert)
|
|
|
196 (define-compatible-function-alias 'insert-before-markers-and-inherit
|
|
|
197 'insert-before-markers)
|
|
|
198
|
|
|
199 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymaps
|
|
|
200
|
|
|
201 (defun keymap-parent (keymap)
|
|
|
202 "Return the first parent of the given keymap."
|
|
|
203 (car (keymap-parents keymap)))
|
|
|
204 (make-compatible 'keymap-parent 'keymap-parents)
|
|
|
205
|
|
|
206 (defun set-keymap-parent (keymap parent)
|
|
|
207 "Make the given keymap have (only) the given parent."
|
|
|
208 (set-keymap-parents keymap (if parent (list parent) '()))
|
|
|
209 parent)
|
|
|
210 (make-compatible 'set-keymap-parent 'set-keymap-parents)
|
|
|
211
|
|
|
212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu stuff
|
|
|
213
|
|
|
214 (defun add-menu-item (menu-path item-name function enabled-p &optional before)
|
|
|
215 "Obsolete. See the function `add-menu-button'."
|
|
|
216 (or item-name (error "must specify an item name"))
|
|
|
217 (add-menu-button menu-path (vector item-name function enabled-p) before))
|
|
|
218 (make-obsolete 'add-menu-item 'add-menu-button)
|
|
|
219
|
|
|
220 (defun add-menu (menu-path menu-name menu-items &optional before)
|
|
|
221 "See the function `add-submenu'."
|
|
|
222 (or menu-name (error (gettext "must specify a menu name")))
|
|
|
223 (or menu-items (error (gettext "must specify some menu items")))
|
|
|
224 (add-submenu menu-path (cons menu-name menu-items) before))
|
|
|
225 ;; Can't make this obsolete. easymenu depends on it.
|
|
|
226 (make-compatible 'add-menu 'add-submenu)
|
|
|
227
|
|
|
228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer
|
|
|
229
|
|
|
230 (define-compatible-function-alias 'read-minibuffer
|
|
|
231 'read-expression) ; misleading name
|
|
|
232 (define-compatible-function-alias 'read-input 'read-string)
|
|
|
233
|
|
|
234 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc
|
|
|
235
|
|
|
236 ;; (defun user-original-login-name ()
|
|
|
237 ;; "Return user's login name from original login.
|
|
|
238 ;; This tries to remain unaffected by `su', by looking in environment variables."
|
|
|
239 ;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
|
|
|
240 (define-obsolete-function-alias 'user-original-login-name 'user-login-name)
|
|
|
241
|
|
|
242 ; old names
|
|
|
243 (define-obsolete-function-alias 'show-buffer 'set-window-buffer)
|
|
|
244 (define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo)
|
|
|
245 (make-compatible 'eval-current-buffer 'eval-buffer)
|
|
|
246 (define-compatible-function-alias 'byte-code-function-p
|
|
|
247 'compiled-function-p) ;FSFmacs
|
|
|
248
|
|
|
249 (define-obsolete-function-alias 'isearch-yank-x-selection
|
|
|
250 'isearch-yank-selection)
|
|
|
251 (define-obsolete-function-alias 'isearch-yank-x-clipboard
|
|
|
252 'isearch-yank-clipboard)
|
|
|
253
|
|
|
254 ;; too bad there's not a way to check for aref, assq, and nconc
|
|
|
255 ;; being called on the values of functions known to return keymaps,
|
|
|
256 ;; or known to return vectors of events instead of strings...
|
|
|
257
|
|
|
258 (make-obsolete-variable 'executing-macro 'executing-kbd-macro)
|
|
|
259
|
|
|
260 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline
|
|
|
261
|
|
|
262 (define-compatible-function-alias 'redraw-mode-line 'redraw-modeline)
|
|
|
263 (define-compatible-function-alias 'force-mode-line-update
|
|
|
264 'redraw-modeline) ;; FSF compatibility
|
|
|
265 (define-compatible-variable-alias 'mode-line-map 'modeline-map)
|
|
|
266 (define-compatible-variable-alias 'mode-line-buffer-identification
|
|
|
267 'modeline-buffer-identification)
|
|
|
268 (define-compatible-variable-alias 'mode-line-process 'modeline-process)
|
|
|
269 (define-compatible-variable-alias 'mode-line-modified 'modeline-modified)
|
|
|
270 (make-compatible-variable 'mode-line-inverse-video
|
|
|
271 "use set-face-highlight-p and set-face-reverse-p")
|
|
|
272 (define-compatible-variable-alias 'default-mode-line-format
|
|
|
273 'default-modeline-format)
|
|
|
274 (define-compatible-variable-alias 'mode-line-format 'modeline-format)
|
|
|
275 (define-compatible-variable-alias 'mode-line-menu 'modeline-menu)
|
|
|
276
|
|
|
277 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; mouse
|
|
|
278
|
|
|
279 ;;; (defun mouse-eval-last-sexpr (event)
|
|
|
280 ;;; (interactive "@e")
|
|
|
281 ;;; (save-excursion
|
|
|
282 ;;; (mouse-set-point event)
|
|
|
283 ;;; (eval-last-sexp nil)))
|
|
|
284
|
|
|
285 (define-obsolete-function-alias 'mouse-eval-last-sexpr 'mouse-eval-sexp)
|
|
|
286
|
|
|
287 (defun read-mouse-position (frame)
|
|
|
288 (cdr (mouse-position (frame-device frame))))
|
|
|
289 (make-obsolete 'read-mouse-position 'mouse-position)
|
|
|
290
|
|
|
291 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; redisplay
|
|
|
292
|
|
|
293 (defun redraw-display (&optional device)
|
|
|
294 (if (eq device t)
|
|
|
295 (mapcar 'redisplay-device (device-list))
|
|
|
296 (redisplay-device device)))
|
|
|
297
|
|
|
298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; window-system objects
|
|
|
299
|
|
|
300 ;; the functionality of column.el has been moved into C
|
|
|
301 ;; Function obsoleted for XEmacs 20.0/February 1997.
|
|
|
302 (defalias 'display-column-mode 'column-number-mode)
|
|
|
303
|
|
|
304 (defun x-color-values (color &optional frame)
|
|
|
305 "Return a description of the color named COLOR on frame FRAME.
|
|
|
306 The value is a list of integer RGB values--(RED GREEN BLUE).
|
|
|
307 These values appear to range from 0 to 65280 or 65535, depending
|
|
|
308 on the system; white is (65280 65280 65280) or (65535 65535 65535).
|
|
|
309 If FRAME is omitted or nil, use the selected frame."
|
|
|
310 (color-instance-rgb-components (make-color-instance color)))
|
|
|
311 (make-compatible 'x-color-values 'color-instance-rgb-components)
|
|
|
312
|
|
|
313 ;; Two loser functions which shouldn't be used.
|
|
|
314 (make-obsolete 'following-char 'char-after)
|
|
|
315 (make-obsolete 'preceding-char 'char-before)
|
|
|
316
|
|
|
317
|
|
|
318 ;; The following several functions are useful in GNU Emacs 20 because
|
|
|
319 ;; of the multibyte "characters" the internal representation of which
|
|
|
320 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary.
|
|
|
321 ;; We provide them for compatibility reasons solely.
|
|
|
322
|
|
|
323 (defun string-to-sequence (string type)
|
|
|
324 "Convert STRING to a sequence of TYPE which contains characters in STRING.
|
|
|
325 TYPE should be `list' or `vector'.
|
|
|
326 Multibyte characters are concerned."
|
|
|
327 (ecase type
|
|
|
328 (list
|
|
|
329 (mapcar #'identity string))
|
|
|
330 (vector
|
|
|
331 (mapvector #'identity string))))
|
|
|
332
|
|
|
333 (defun string-to-list (string)
|
|
|
334 "Return a list of characters in STRING."
|
|
|
335 (mapcar #'identity string))
|
|
|
336
|
|
|
337 (defun string-to-vector (string)
|
|
|
338 "Return a vector of characters in STRING."
|
|
|
339 (mapvector #'identity string))
|
|
|
340
|
|
|
341 (defun store-substring (string idx obj)
|
|
|
342 "Embed OBJ (string or character) at index IDX of STRING."
|
|
|
343 (let* ((str (cond ((stringp obj) obj)
|
|
|
344 ((characterp obj) (char-to-string obj))
|
|
|
345 (t (error
|
|
|
346 "Invalid argument (should be string or character): %s"
|
|
|
347 obj))))
|
|
|
348 (string-len (length string))
|
|
|
349 (len (length str))
|
|
|
350 (i 0))
|
|
|
351 (while (and (< i len) (< idx string-len))
|
|
|
352 (aset string idx (aref str i))
|
|
|
353 (setq idx (1+ idx) i (1+ i)))
|
|
|
354 string))
|
|
|
355
|
|
440
|
356 ;; #### This function is not compatible with FSF in some cases. Hard
|
|
428
|
357 ;; to fix, because it is hard to trace the logic of the FSF function.
|
|
|
358 ;; In case we need the exact behavior, we can always copy the FSF
|
|
|
359 ;; version, which is very long and does lots of unnecessary stuff.
|
|
|
360 (defun truncate-string-to-width (str end-column &optional start-column padding)
|
|
|
361 "Truncate string STR to end at column END-COLUMN.
|
|
|
362 The optional 2nd arg START-COLUMN, if non-nil, specifies
|
|
|
363 the starting column; that means to return the characters occupying
|
|
|
364 columns START-COLUMN ... END-COLUMN of STR.
|
|
|
365
|
|
|
366 The optional 3rd arg PADDING, if non-nil, specifies a padding character
|
|
|
367 to add at the end of the result if STR doesn't reach column END-COLUMN,
|
|
|
368 or if END-COLUMN comes in the middle of a character in STR.
|
|
|
369 PADDING is also added at the beginning of the result
|
|
|
370 if column START-COLUMN appears in the middle of a character in STR.
|
|
|
371
|
|
|
372 If PADDING is nil, no padding is added in these cases, so
|
|
|
373 the resulting string may be narrower than END-COLUMN."
|
|
|
374 (or start-column
|
|
|
375 (setq start-column 0))
|
|
|
376 (let ((len (length str)))
|
|
|
377 (concat (substring str (min start-column len) (min end-column len))
|
|
|
378 (and padding (> end-column len)
|
|
|
379 (make-string (- end-column len) padding)))))
|
|
|
380
|
|
|
381 (defalias 'truncate-string 'truncate-string-to-width)
|
|
|
382 (make-obsolete 'truncate-string 'truncate-string-to-width)
|
|
|
383
|
|
|
384 ;; Keywords already do The Right Thing in XEmacs
|
|
|
385 (make-compatible 'define-widget-keywords "Just use them")
|
|
|
386
|
|
|
387 (make-obsolete 'function-called-at-point 'function-at-point)
|
|
|
388
|
|
|
389 (provide 'obsolete)
|
|
|
390 ;;; obsolete.el ends here
|
