Mercurial > hg > xemacs-beta

comparison lisp/obsolete.el @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 8de8e3f6228a
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
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
356 ;; ### This function is not compatible with FSF in some cases. Hard
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