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 &optional when doc)
39 "Define OLDFUN as an obsolete alias for function NEWFUN.
40 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
43 Optional arguments, WHEN and DOC exist purely for compatibility
44 with GNU Emacs. They're silently ignored in SXEmacs."
45 (define-function oldfun newfun)
46 (make-obsolete oldfun newfun when))
48 (defsubst define-compatible-function-alias (oldfun newfun)
49 "Define OLDFUN as a compatible alias for function NEWFUN.
50 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
51 as provided for compatibility only."
52 (define-function oldfun newfun)
53 (make-compatible oldfun newfun))
55 (defsubst define-obsolete-variable-alias (oldvar newvar &optional when doc)
56 "Define OLDVAR as an obsolete alias for variable NEWVAR.
57 This makes referencing or setting OLDVAR equivalent to referencing or
58 setting NEWVAR and marks OLDVAR as obsolete.
59 If OLDVAR was bound and NEWVAR was not, Set NEWVAR to OLDVAR.
61 Optional arguments, WHEN and DOC exist purely for compatibility with
62 GNU Emacs. They're silently ignored in SXEmacs.
64 Note: Use this before any other references (defvar/defcustom) to NEWVAR."
65 (let ((needs-setting (and (boundp oldvar) (not (boundp newvar))))
66 (value (and (boundp oldvar) (symbol-value oldvar))))
67 (defvaralias oldvar newvar)
68 (make-obsolete-variable oldvar newvar when)
69 (and needs-setting (set newvar value))))
71 (defsubst define-compatible-variable-alias (oldvar newvar)
72 "Define OLDVAR as a compatible alias for variable NEWVAR.
73 This makes referencing or setting OLDVAR equivalent to referencing or
74 setting NEWVAR and marks OLDVAR as provided for compatibility only."
75 (defvaralias oldvar newvar)
76 (make-compatible-variable oldvar newvar))
78 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; device stuff
80 (make-compatible-variable 'window-system "use (console-type)")
82 (defun x-display-color-p (&optional device)
83 "Return t if DEVICE is a color device."
84 (eq 'color (device-class device)))
85 (make-compatible 'x-display-color-p 'device-class)
87 (define-function 'x-color-display-p 'x-display-color-p)
88 (make-compatible 'x-display-color-p 'device-class)
90 (defun x-display-grayscale-p (&optional device)
91 "Return t if DEVICE is a grayscale device."
92 (eq 'grayscale (device-class device)))
93 (make-compatible 'x-display-grayscale-p 'device-class)
95 (define-function 'x-grayscale-display-p 'x-display-grayscale-p)
96 (make-compatible 'x-display-grayscale-p 'device-class)
98 (define-compatible-function-alias 'x-display-pixel-width 'device-pixel-width)
99 (define-compatible-function-alias 'x-display-pixel-height 'device-pixel-height)
100 (define-compatible-function-alias 'x-display-planes 'device-bitplanes)
101 (define-compatible-function-alias 'x-display-color-cells 'device-color-cells)
103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; events
105 (define-obsolete-function-alias 'menu-event-p 'misc-user-event-p)
106 (make-obsolete-variable 'unread-command-char 'unread-command-events)
108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents
110 (make-obsolete 'set-window-dot 'set-window-point)
112 (define-obsolete-function-alias 'extent-buffer 'extent-object)
113 (define-compatible-variable-alias 'parse-sexp-lookup-properties
114 'lookup-syntax-properties)
116 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames
117 (defun frame-first-window (frame)
118 "Return the topmost, leftmost window of FRAME.
119 If omitted, FRAME defaults to the currently selected frame."
120 (frame-highest-window frame 0))
121 (make-compatible 'frame-first-window 'frame-highest-window)
123 (define-obsolete-variable-alias 'initial-frame-alist 'initial-frame-plist)
124 (define-obsolete-variable-alias 'minibuffer-frame-alist
125 'minibuffer-frame-plist)
126 (define-obsolete-variable-alias 'pop-up-frame-alist 'pop-up-frame-plist)
127 (define-obsolete-variable-alias 'special-display-frame-alist
128 'special-display-frame-plist)
132 (define-obsolete-variable-alias 'default-frame-alist 'default-frame-plist)
133 (define-obsolete-variable-alias 'default-x-frame-alist 'default-x-frame-plist)
134 (define-obsolete-variable-alias 'default-tty-frame-alist
135 'default-tty-frame-plist)
137 (make-compatible 'frame-parameters 'frame-property)
138 (defun frame-parameters (&optional frame)
139 "Return the parameters-alist of frame FRAME.
140 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
141 The meaningful PARMs depend on the kind of frame.
142 If FRAME is omitted, return information on the currently selected frame.
144 See the variables `default-frame-plist', `default-x-frame-plist', and
145 `default-tty-frame-plist' for a description of the parameters meaningful
146 for particular types of frames."
147 (or frame (setq frame (selected-frame)))
148 ;; #### This relies on a `copy-sequence' of the user properties in
149 ;; `frame-properties'. Removing that would make `frame-properties' more
150 ;; efficient but this function less efficient, as we couldn't be
151 ;; destructive. Since most callers now use `frame-parameters', we'll
152 ;; do it this way. Should probably change this at some point in the
154 (destructive-plist-to-alist (frame-properties frame)))
156 (make-compatible 'modify-frame-parameters 'set-frame-properties)
157 (defun modify-frame-parameters (frame alist)
158 "Modify the properties of frame FRAME according to ALIST.
159 ALIST is an alist of properties to change and their new values.
160 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
161 The meaningful PARMs depend on the kind of frame.
163 See `set-frame-properties' for built-in property names."
164 ;; it would be nice to be destructive here but that's not safe.
165 (set-frame-properties frame (alist-to-plist alist)))
167 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; faces
169 (define-obsolete-function-alias 'list-faces-display 'edit-faces)
170 (define-obsolete-function-alias 'list-faces 'face-list)
172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths
174 (defvar Info-default-directory-list nil
175 "This used to be the initial value of Info-directory-list.
176 If you want to change the locations where XEmacs looks for info files,
177 set Info-directory-list.")
178 (make-obsolete-variable 'Info-default-directory-list 'Info-directory-list)
180 (defvar init-file-user nil
181 "This used to be the name of the user whose init file was read at startup.")
182 (make-obsolete-variable 'init-file-user 'load-user-init-file-p)
184 (define-obsolete-function-alias 'pui-add-install-directory
185 'pui-set-local-package-get-directory) ; misleading name
186 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks
188 (make-compatible-variable 'lisp-indent-hook 'lisp-indent-function)
189 (make-compatible-variable 'comment-indent-hook 'comment-indent-function)
190 (make-obsolete-variable 'temp-buffer-show-hook
191 'temp-buffer-show-function)
192 (make-obsolete-variable 'inhibit-local-variables
193 "use `enable-local-variables' (with the reversed sense).")
194 (make-obsolete-variable 'suspend-hooks 'suspend-hook)
195 (make-obsolete-variable 'first-change-function 'first-change-hook)
196 (make-obsolete-variable 'before-change-function
197 "use before-change-functions; which is a list of functions rather than a single function.")
198 (make-obsolete-variable 'after-change-function
199 "use after-change-functions; which is a list of functions rather than a single function.")
201 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion and deletion
203 (define-compatible-function-alias 'insert-and-inherit 'insert)
204 (define-compatible-function-alias 'insert-before-markers-and-inherit
205 'insert-before-markers)
207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymaps
209 (defun keymap-parent (keymap)
210 "Return the first parent of the given keymap."
211 (car (keymap-parents keymap)))
212 (make-compatible 'keymap-parent 'keymap-parents)
214 (defun set-keymap-parent (keymap parent)
215 "Make the given keymap have (only) the given parent."
216 (set-keymap-parents keymap (if parent (list parent) '()))
218 (make-compatible 'set-keymap-parent 'set-keymap-parents)
220 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu stuff
222 (defun add-menu-item (menu-path item-name function enabled-p &optional before)
223 "Obsolete. See the function `add-menu-button'."
224 (or item-name (error "must specify an item name"))
225 (add-menu-button menu-path (vector item-name function enabled-p) before))
226 (make-obsolete 'add-menu-item 'add-menu-button)
228 (defun add-menu (menu-path menu-name menu-items &optional before)
229 "See the function `add-submenu'."
230 (or menu-name (error "must specify a menu name"))
231 (or menu-items (error "must specify some menu items"))
232 (add-submenu menu-path (cons menu-name menu-items) before))
233 ;; Can't make this obsolete. easymenu depends on it.
234 (make-compatible 'add-menu 'add-submenu)
236 (define-obsolete-function-alias 'package-get-download-menu
237 'package-ui-download-menu)
239 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer
241 (define-compatible-function-alias 'read-minibuffer
242 'read-expression) ; misleading name
243 (define-compatible-function-alias 'read-input 'read-string)
245 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc
247 ;; (defun user-original-login-name ()
248 ;; "Return user's login name from original login.
249 ;; This tries to remain unaffected by `su', by looking in environment variables."
250 ;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
251 (define-obsolete-function-alias 'user-original-login-name 'user-login-name)
254 (define-obsolete-function-alias 'show-buffer 'set-window-buffer)
255 (define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo)
256 (make-compatible 'eval-current-buffer 'eval-buffer)
257 (define-compatible-function-alias 'byte-code-function-p
258 'compiled-function-p) ;FSFmacs
260 (define-obsolete-function-alias 'isearch-yank-x-selection
261 'isearch-yank-selection)
262 (define-obsolete-function-alias 'isearch-yank-x-clipboard
263 'isearch-yank-clipboard)
265 ;; too bad there's not a way to check for aref, assq, and nconc
266 ;; being called on the values of functions known to return keymaps,
267 ;; or known to return vectors of events instead of strings...
269 (make-obsolete-variable 'executing-macro 'executing-kbd-macro)
271 (define-compatible-function-alias 'interactive-form
272 'function-interactive) ;GNU 21.1
273 (define-compatible-function-alias 'assq-delete-all
277 (define-compatible-function-alias 'line-beginning-position 'point-at-bol)
278 (define-compatible-function-alias 'line-end-position 'point-at-eol)
280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline
282 (define-compatible-function-alias 'redraw-mode-line 'redraw-modeline)
283 (define-compatible-function-alias 'force-mode-line-update
284 'redraw-modeline) ;; FSF compatibility
285 (define-compatible-variable-alias 'mode-line-map 'modeline-map)
286 (define-compatible-variable-alias 'mode-line-buffer-identification
287 'modeline-buffer-identification)
288 (define-compatible-variable-alias 'mode-line-process 'modeline-process)
289 (define-compatible-variable-alias 'mode-line-modified 'modeline-modified)
290 (make-compatible-variable 'mode-line-inverse-video
291 "use set-face-highlight-p and set-face-reverse-p")
292 (define-compatible-variable-alias 'default-mode-line-format
293 'default-modeline-format)
294 (define-compatible-variable-alias 'mode-line-format 'modeline-format)
295 (define-compatible-variable-alias 'mode-line-menu 'modeline-menu)
297 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; mouse
299 ;;; (defun mouse-eval-last-sexpr (event)
300 ;;; (interactive "@e")
302 ;;; (mouse-set-point event)
303 ;;; (eval-last-sexp nil)))
305 (define-obsolete-function-alias 'mouse-eval-last-sexpr 'mouse-eval-sexp)
307 (defun read-mouse-position (frame)
308 (cdr (mouse-position (frame-device frame))))
309 (make-obsolete 'read-mouse-position 'mouse-position)
311 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; redisplay
313 (defun redraw-display (&optional device)
315 (mapcar 'redisplay-device (device-list))
316 (redisplay-device device)))
318 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; sound
320 (defun play-sound-file (file &optional volume device)
321 "Play the sound in FILE on DEVICE's speaker at the specified VOLUME
322 \(0-100, default specified by the `bell-volume' variable\).
324 With no further media drivers, the sound file must be in the
325 Sun/NeXT U-LAW format. Under Linux WAV files are also supported.
327 DEVICE can be any device created by `make-audio-device' and
328 defaults to `default-audio-device', or, if that is `nil',
329 to the selected device."
330 (let ((ms (make-media-stream :file file)))
332 (declare-fboundp (play-media-stream ms device)))))
333 (make-obsolete #'play-sound-file
334 "use `make-media-stream' and `play-media-stream' instead.")
337 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; window-system objects
339 ;; the functionality of column.el has been moved into C
340 ;; Function obsoleted for XEmacs 20.0/February 1997.
341 (defalias 'display-column-mode 'column-number-mode)
343 (defun x-color-values (color &optional frame)
344 "Return a description of the color named COLOR on frame FRAME.
345 The value is a list of integer RGB values--(RED GREEN BLUE).
346 These values appear to range from 0 to 65280 or 65535, depending
347 on the system; white is (65280 65280 65280) or (65535 65535 65535).
348 If FRAME is omitted or nil, use the selected frame."
349 (color-instance-rgb-components (make-color-instance color)))
350 (make-compatible 'x-color-values 'color-instance-rgb-components)
352 ;; Two loser functions which shouldn't be used.
353 (make-obsolete 'following-char 'char-after)
354 (make-obsolete 'preceding-char 'char-before)
357 ;; The following several functions are useful in GNU Emacs 20 because
358 ;; of the multibyte "characters" the internal representation of which
359 ;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary.
360 ;; We provide them for compatibility reasons solely.
362 (defun string-to-sequence (string type)
363 "Convert STRING to a sequence of TYPE which contains characters in STRING.
364 TYPE should be `list' or `vector'.
365 Multibyte characters are concerned."
368 (mapcar #'identity string))
370 (mapvector #'identity string))))
372 (defun string-to-list (string)
373 "Return a list of characters in STRING."
374 (mapcar #'identity string))
376 (defun string-to-vector (string)
377 "Return a vector of characters in STRING."
378 (mapvector #'identity string))
380 (defun store-substring (string idx object)
381 "Embed OBJECT (string or character) at index IDX of STRING."
382 (let* ((str (cond ((stringp object) object)
383 ((characterp object) (char-to-string object))
385 "Invalid argument (should be string or character): %s"
387 (string-len (length string))
390 (while (and (< i len) (< idx string-len))
391 (aset string idx (aref str i))
392 (setq idx (1+ idx) i (1+ i)))
395 ;; #### This function is not compatible with FSF in some cases. Hard
396 ;; to fix, because it is hard to trace the logic of the FSF function.
397 ;; In case we need the exact behavior, we can always copy the FSF
398 ;; version, which is very long and does lots of unnecessary stuff.
399 (defun truncate-string-to-width (str end-column &optional start-column padding)
400 "Truncate string STR to end at column END-COLUMN.
401 The optional 2nd arg START-COLUMN, if non-nil, specifies
402 the starting column; that means to return the characters occupying
403 columns START-COLUMN ... END-COLUMN of STR.
405 The optional 3rd arg PADDING, if non-nil, specifies a padding character
406 to add at the end of the result if STR doesn't reach column END-COLUMN,
407 or if END-COLUMN comes in the middle of a character in STR.
408 PADDING is also added at the beginning of the result
409 if column START-COLUMN appears in the middle of a character in STR.
411 If PADDING is nil, no padding is added in these cases, so
412 the resulting string may be narrower than END-COLUMN."
414 (setq start-column 0))
415 (let ((len (length str)))
416 (concat (substring str (min start-column len) (min end-column len))
417 (and padding (> end-column len)
418 (make-string (- end-column len) padding)))))
420 (defalias 'truncate-string 'truncate-string-to-width)
421 (make-obsolete 'truncate-string 'truncate-string-to-width)
423 ;; Keywords already do The Right Thing in XEmacs
424 (make-compatible 'define-widget-keywords "Just use them")
426 (make-obsolete 'function-called-at-point 'function-at-point)
428 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; Arch Version stuff
429 (make-obsolete-variable 'sxemacs-arch-version 'sxemacs-git-version "22.1.13")
432 ;;; obsolete.el ends here