1 ;;; obsolete.el --- obsoleteness support
3 ;; Copyright (C) 1985-1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1994, 1995 Amdahl Corporation.
5 ;; Copyright (C) 1995 Sun Microsystems.
7 ;; Maintainer: SXEmacs Development Team
8 ;; Keywords: internal, dumped
10 ;; This file is part of SXEmacs.
12 ;; SXEmacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; SXEmacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Synched up with: Not in FSF.
29 ;; This file is dumped with SXEmacs.
31 ;; The obsoleteness support used to be scattered throughout various
32 ;; source files. We put the stuff in one place to remove the junkiness
33 ;; from other source files and to facilitate creating/updating things
38 (defsubst define-obsolete-function-alias (oldfun newfun)
39 "Define OLDFUN as an obsolete alias for function NEWFUN.
40 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
42 (define-function oldfun newfun)
43 (make-obsolete oldfun newfun))
45 (defsubst define-compatible-function-alias (oldfun newfun)
46 "Define OLDFUN as a compatible alias for function NEWFUN.
47 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
48 as provided for compatibility only."
49 (define-function oldfun newfun)
50 (make-compatible oldfun newfun))
52 (defsubst define-obsolete-variable-alias (oldvar newvar)
53 "Define OLDVAR as an obsolete alias for variable NEWVAR.
54 This makes referencing or setting OLDVAR equivalent to referencing or
55 setting NEWVAR and marks OLDVAR as obsolete.
56 If OLDVAR was bound and NEWVAR was not, Set NEWVAR to OLDVAR.
58 Note: Use this before any other references (defvar/defcustom) to NEWVAR."
59 (let ((needs-setting (and (boundp oldvar) (not (boundp newvar))))
60 (value (and (boundp oldvar) (symbol-value oldvar))))
61 (defvaralias oldvar newvar)
62 (make-obsolete-variable oldvar newvar)
63 (and needs-setting (set newvar value))))
65 (defsubst define-compatible-variable-alias (oldvar newvar)
66 "Define OLDVAR as a compatible alias for variable NEWVAR.
67 This makes referencing or setting OLDVAR equivalent to referencing or
68 setting NEWVAR and marks OLDVAR as provided for compatibility only."
69 (defvaralias oldvar newvar)
70 (make-compatible-variable oldvar newvar))
72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; device stuff
74 (make-compatible-variable 'window-system "use (console-type)")
76 (defun x-display-color-p (&optional device)
77 "Return t if DEVICE is a color device."
78 (eq 'color (device-class device)))
79 (make-compatible 'x-display-color-p 'device-class)
81 (define-function 'x-color-display-p 'x-display-color-p)
82 (make-compatible 'x-display-color-p 'device-class)
84 (defun x-display-grayscale-p (&optional device)
85 "Return t if DEVICE is a grayscale device."
86 (eq 'grayscale (device-class device)))
87 (make-compatible 'x-display-grayscale-p 'device-class)
89 (define-function 'x-grayscale-display-p 'x-display-grayscale-p)
90 (make-compatible 'x-display-grayscale-p 'device-class)
92 (define-compatible-function-alias 'x-display-pixel-width 'device-pixel-width)
93 (define-compatible-function-alias 'x-display-pixel-height 'device-pixel-height)
94 (define-compatible-function-alias 'x-display-planes 'device-bitplanes)
95 (define-compatible-function-alias 'x-display-color-cells 'device-color-cells)
97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; events
99 (define-obsolete-function-alias 'menu-event-p 'misc-user-event-p)
100 (make-obsolete-variable 'unread-command-char 'unread-command-events)
102 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents
104 (make-obsolete 'set-window-dot 'set-window-point)
106 (define-obsolete-function-alias 'extent-buffer 'extent-object)
107 (define-compatible-variable-alias 'parse-sexp-lookup-properties
108 'lookup-syntax-properties)
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)
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)
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)
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.
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
148 (destructive-plist-to-alist (frame-properties frame)))
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.
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)))
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; faces
163 (define-obsolete-function-alias 'list-faces-display 'edit-faces)
164 (define-obsolete-function-alias 'list-faces 'face-list)
166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths
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)
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)
178 (define-obsolete-function-alias 'pui-add-install-directory
179 'pui-set-local-package-get-directory) ; misleading name
180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks
182 (make-compatible-variable 'lisp-indent-hook 'lisp-indent-function)
183 (make-compatible-variable 'comment-indent-hook 'comment-indent-function)
184 (make-obsolete-variable 'temp-buffer-show-hook
185 'temp-buffer-show-function)
186 (make-obsolete-variable 'inhibit-local-variables
187 "use `enable-local-variables' (with the reversed sense).")
188 (make-obsolete-variable 'suspend-hooks 'suspend-hook)
189 (make-obsolete-variable 'first-change-function 'first-change-hook)
190 (make-obsolete-variable 'before-change-function
191 "use before-change-functions; which is a list of functions rather than a single function.")
192 (make-obsolete-variable 'after-change-function
193 "use after-change-functions; which is a list of functions rather than a single function.")
195 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion and deletion
197 (define-compatible-function-alias 'insert-and-inherit 'insert)
198 (define-compatible-function-alias 'insert-before-markers-and-inherit
199 'insert-before-markers)
201 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymaps
203 (defun keymap-parent (keymap)
204 "Return the first parent of the given keymap."
205 (car (keymap-parents keymap)))
206 (make-compatible 'keymap-parent 'keymap-parents)
208 (defun set-keymap-parent (keymap parent)
209 "Make the given keymap have (only) the given parent."
210 (set-keymap-parents keymap (if parent (list parent) '()))
212 (make-compatible 'set-keymap-parent 'set-keymap-parents)
214 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu stuff
216 (defun add-menu-item (menu-path item-name function enabled-p &optional before)
217 "Obsolete. See the function `add-menu-button'."
218 (or item-name (error "must specify an item name"))
219 (add-menu-button menu-path (vector item-name function enabled-p) before))
220 (make-obsolete 'add-menu-item 'add-menu-button)
222 (defun add-menu (menu-path menu-name menu-items &optional before)
223 "See the function `add-submenu'."
224 (or menu-name (error "must specify a menu name"))
225 (or menu-items (error "must specify some menu items"))
226 (add-submenu menu-path (cons menu-name menu-items) before))
227 ;; Can't make this obsolete. easymenu depends on it.
228 (make-compatible 'add-menu 'add-submenu)
230 (define-obsolete-function-alias 'package-get-download-menu
231 'package-ui-download-menu)
233 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer
235 (define-compatible-function-alias 'read-minibuffer
236 'read-expression) ; misleading name
237 (define-compatible-function-alias 'read-input 'read-string)
239 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc
241 ;; (defun user-original-login-name ()
242 ;; "Return user's login name from original login.
243 ;; This tries to remain unaffected by `su', by looking in environment variables."
244 ;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
245 (define-obsolete-function-alias 'user-original-login-name 'user-login-name)
248 (define-obsolete-function-alias 'show-buffer 'set-window-buffer)
249 (define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo)
250 (make-compatible 'eval-current-buffer 'eval-buffer)
251 (define-compatible-function-alias 'byte-code-function-p
252 'compiled-function-p) ;FSFmacs
254 (define-obsolete-function-alias 'isearch-yank-x-selection
255 'isearch-yank-selection)
256 (define-obsolete-function-alias 'isearch-yank-x-clipboard
257 'isearch-yank-clipboard)
259 ;; too bad there's not a way to check for aref, assq, and nconc
260 ;; being called on the values of functions known to return keymaps,
261 ;; or known to return vectors of events instead of strings...
263 (make-obsolete-variable 'executing-macro 'executing-kbd-macro)
265 (define-compatible-function-alias 'interactive-form
266 'function-interactive) ;GNU 21.1
267 (define-compatible-function-alias 'assq-delete-all
271 (define-compatible-function-alias 'line-beginning-position 'point-at-bol)
272 (define-compatible-function-alias 'line-end-position 'point-at-eol)
274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline
276 (define-compatible-function-alias 'redraw-mode-line 'redraw-modeline)
277 (define-compatible-function-alias 'force-mode-line-update
278 'redraw-modeline) ;; FSF compatibility
279 (define-compatible-variable-alias 'mode-line-map 'modeline-map)
280 (define-compatible-variable-alias 'mode-line-buffer-identification
281 'modeline-buffer-identification)
282 (define-compatible-variable-alias 'mode-line-process 'modeline-process)
283 (define-compatible-variable-alias 'mode-line-modified 'modeline-modified)
284 (make-compatible-variable 'mode-line-inverse-video
285 "use set-face-highlight-p and set-face-reverse-p")
286 (define-compatible-variable-alias 'default-mode-line-format
287 'default-modeline-format)
288 (define-compatible-variable-alias 'mode-line-format 'modeline-format)
289 (define-compatible-variable-alias 'mode-line-menu 'modeline-menu)
291 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; mouse
293 ;;; (defun mouse-eval-last-sexpr (event)
294 ;;; (interactive "@e")
296 ;;; (mouse-set-point event)
297 ;;; (eval-last-sexp nil)))
299 (define-obsolete-function-alias 'mouse-eval-last-sexpr 'mouse-eval-sexp)
301 (defun read-mouse-position (frame)
302 (cdr (mouse-position (frame-device frame))))
303 (make-obsolete 'read-mouse-position 'mouse-position)
305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; redisplay
307 (defun redraw-display (&optional device)
309 (mapcar 'redisplay-device (device-list))
310 (redisplay-device device)))
312 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; sound
314 (defun play-sound-file (file &optional volume device)
315 "Play the sound in FILE on DEVICE's speaker at the specified VOLUME
316 \(0-100, default specified by the `bell-volume' variable\).
318 With no further media drivers, the sound file must be in the
319 Sun/NeXT U-LAW format. Under Linux WAV files are also supported.
321 DEVICE can be any device created by `make-audio-device' and
322 defaults to `default-audio-device', or, if that is `nil',
323 to the selected device."
324 (let ((ms (make-media-stream :file file)))
326 (declare-fboundp (play-media-stream ms device)))))
327 (make-obsolete #'play-sound-file
328 "use `make-media-stream' and `play-media-stream' instead.")
331 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; window-system objects
333 ;; the functionality of column.el has been moved into C
334 ;; Function obsoleted for XEmacs 20.0/February 1997.
335 (defalias 'display-column-mode 'column-number-mode)
337 (defun x-color-values (color &optional frame)
338 "Return a description of the color named COLOR on frame FRAME.
339 The value is a list of integer RGB values--(RED GREEN BLUE).
340 These values appear to range from 0 to 65280 or 65535, depending
341 on the system; white is (65280 65280 65280) or (65535 65535 65535).
342 If FRAME is omitted or nil, use the selected frame."
343 (color-instance-rgb-components (make-color-instance color)))
344 (make-compatible 'x-color-values 'color-instance-rgb-components)
346 ;; Two loser functions which shouldn't be used.
347 (make-obsolete 'following-char 'char-after)
348 (make-obsolete 'preceding-char 'char-before)
351 ;; The following several functions are useful in GNU Emacs 20 because
352 ;; of the multibyte "characters" the internal representation of which
353 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary.
354 ;; We provide them for compatibility reasons solely.
356 (defun string-to-sequence (string type)
357 "Convert STRING to a sequence of TYPE which contains characters in STRING.
358 TYPE should be `list' or `vector'.
359 Multibyte characters are concerned."
362 (mapcar #'identity string))
364 (mapvector #'identity string))))
366 (defun string-to-list (string)
367 "Return a list of characters in STRING."
368 (mapcar #'identity string))
370 (defun string-to-vector (string)
371 "Return a vector of characters in STRING."
372 (mapvector #'identity string))
374 (defun store-substring (string idx object)
375 "Embed OBJECT (string or character) at index IDX of STRING."
376 (let* ((str (cond ((stringp object) object)
377 ((characterp object) (char-to-string object))
379 "Invalid argument (should be string or character): %s"
381 (string-len (length string))
384 (while (and (< i len) (< idx string-len))
385 (aset string idx (aref str i))
386 (setq idx (1+ idx) i (1+ i)))
389 ;; #### This function is not compatible with FSF in some cases. Hard
390 ;; to fix, because it is hard to trace the logic of the FSF function.
391 ;; In case we need the exact behavior, we can always copy the FSF
392 ;; version, which is very long and does lots of unnecessary stuff.
393 (defun truncate-string-to-width (str end-column &optional start-column padding)
394 "Truncate string STR to end at column END-COLUMN.
395 The optional 2nd arg START-COLUMN, if non-nil, specifies
396 the starting column; that means to return the characters occupying
397 columns START-COLUMN ... END-COLUMN of STR.
399 The optional 3rd arg PADDING, if non-nil, specifies a padding character
400 to add at the end of the result if STR doesn't reach column END-COLUMN,
401 or if END-COLUMN comes in the middle of a character in STR.
402 PADDING is also added at the beginning of the result
403 if column START-COLUMN appears in the middle of a character in STR.
405 If PADDING is nil, no padding is added in these cases, so
406 the resulting string may be narrower than END-COLUMN."
408 (setq start-column 0))
409 (let ((len (length str)))
410 (concat (substring str (min start-column len) (min end-column len))
411 (and padding (> end-column len)
412 (make-string (- end-column len) padding)))))
414 (defalias 'truncate-string 'truncate-string-to-width)
415 (make-obsolete 'truncate-string 'truncate-string-to-width)
417 ;; Keywords already do The Right Thing in XEmacs
418 (make-compatible 'define-widget-keywords "Just use them")
420 (make-obsolete 'function-called-at-point 'function-at-point)
422 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Arch Version stuff
423 (make-obsolete-variable 'sxemacs-arch-version 'sxemacs-git-version "22.1.13")
426 ;;; obsolete.el ends here