(U+519A): Add `total-strokes'.
[chise/xemacs-chise.git-] / lisp / obsolete.el
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 (define-compatible-variable-alias 'parse-sexp-lookup-properties
110   'lookup-syntax-properties)
111
112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames
113 (defun frame-first-window (frame)
114   "Return the topmost, leftmost window of FRAME.
115 If omitted, FRAME defaults to the currently selected frame."
116   (frame-highest-window frame 0))
117 (make-compatible 'frame-first-window 'frame-highest-window)
118
119 (define-obsolete-variable-alias 'initial-frame-alist 'initial-frame-plist)
120 (define-obsolete-variable-alias 'minibuffer-frame-alist
121   'minibuffer-frame-plist)
122 (define-obsolete-variable-alias 'pop-up-frame-alist 'pop-up-frame-plist)
123 (define-obsolete-variable-alias 'special-display-frame-alist
124   'special-display-frame-plist)
125
126 ;; Defined in C.
127
128 (define-obsolete-variable-alias 'default-frame-alist 'default-frame-plist)
129 (define-obsolete-variable-alias 'default-x-frame-alist 'default-x-frame-plist)
130 (define-obsolete-variable-alias 'default-tty-frame-alist
131   'default-tty-frame-plist)
132
133 (make-compatible 'frame-parameters 'frame-property)
134 (defun frame-parameters (&optional frame)
135   "Return the parameters-alist of frame FRAME.
136 It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.
137 The meaningful PARMs depend on the kind of frame.
138 If FRAME is omitted, return information on the currently selected frame.
139
140 See the variables `default-frame-plist', `default-x-frame-plist', and
141 `default-tty-frame-plist' for a description of the parameters meaningful
142 for particular types of frames."
143   (or frame (setq frame (selected-frame)))
144   ;; #### This relies on a `copy-sequence' of the user properties in
145   ;; `frame-properties'.  Removing that would make `frame-properties' more
146   ;; efficient but this function less efficient, as we couldn't be
147   ;; destructive.  Since most callers now use `frame-parameters', we'll
148   ;; do it this way.  Should probably change this at some point in the
149   ;; future.
150   (destructive-plist-to-alist (frame-properties frame)))
151
152 (make-compatible 'modify-frame-parameters 'set-frame-properties)
153 (defun modify-frame-parameters (frame alist)
154   "Modify the properties of frame FRAME according to ALIST.
155 ALIST is an alist of properties to change and their new values.
156 Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol.
157 The meaningful PARMs depend on the kind of frame.
158
159 See `set-frame-properties' for built-in property names."
160   ;; it would be nice to be destructive here but that's not safe.
161   (set-frame-properties frame (alist-to-plist alist)))
162
163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; faces
164
165 (define-obsolete-function-alias 'list-faces-display 'edit-faces)
166 (define-obsolete-function-alias 'list-faces 'face-list)
167
168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths
169
170 (defvar Info-default-directory-list nil
171   "This used to be the initial value of Info-directory-list.
172 If you want to change the locations where XEmacs looks for info files,
173 set Info-directory-list.")
174 (make-obsolete-variable 'Info-default-directory-list 'Info-directory-list)
175
176 (defvar init-file-user nil
177   "This used to be the name of the user whose init file was read at startup.")
178 (make-obsolete-variable 'init-file-user 'load-user-init-file-p)
179
180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks
181
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.")
194
195 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion and deletion
196
197 (define-compatible-function-alias 'insert-and-inherit 'insert)
198 (define-compatible-function-alias 'insert-before-markers-and-inherit
199   'insert-before-markers)
200
201 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymaps
202
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)
207
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) '()))
211   parent)
212 (make-compatible 'set-keymap-parent 'set-keymap-parents)
213
214 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu stuff
215
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)
221
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)
229
230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer
231
232 (define-compatible-function-alias 'read-minibuffer
233   'read-expression) ; misleading name
234 (define-compatible-function-alias 'read-input 'read-string)
235
236 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc
237
238 ;; (defun user-original-login-name ()
239 ;;   "Return user's login name from original login.
240 ;; This tries to remain unaffected by `su', by looking in environment variables."
241 ;;   (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
242 (define-obsolete-function-alias 'user-original-login-name 'user-login-name)
243
244 ; old names
245 (define-obsolete-function-alias 'show-buffer 'set-window-buffer)
246 (define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo)
247 (make-compatible 'eval-current-buffer 'eval-buffer)
248 (define-compatible-function-alias 'byte-code-function-p
249   'compiled-function-p) ;FSFmacs
250
251 (define-obsolete-function-alias 'isearch-yank-x-selection
252   'isearch-yank-selection)
253 (define-obsolete-function-alias 'isearch-yank-x-clipboard
254   'isearch-yank-clipboard)
255
256 ;; too bad there's not a way to check for aref, assq, and nconc
257 ;; being called on the values of functions known to return keymaps,
258 ;; or known to return vectors of events instead of strings...
259
260 (make-obsolete-variable 'executing-macro 'executing-kbd-macro)
261
262 (define-compatible-function-alias 'interactive-form 
263   'function-interactive) ;GNU 21.1
264 (define-compatible-function-alias 'assq-delete-all
265   'remassq) ;GNU 21.1
266
267 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline
268
269 (define-compatible-function-alias 'redraw-mode-line 'redraw-modeline)
270 (define-compatible-function-alias 'force-mode-line-update
271   'redraw-modeline) ;; FSF compatibility
272 (define-compatible-variable-alias 'mode-line-map 'modeline-map)
273 (define-compatible-variable-alias 'mode-line-buffer-identification
274   'modeline-buffer-identification)
275 (define-compatible-variable-alias 'mode-line-process 'modeline-process)
276 (define-compatible-variable-alias 'mode-line-modified 'modeline-modified)
277 (make-compatible-variable 'mode-line-inverse-video
278                         "use set-face-highlight-p and set-face-reverse-p")
279 (define-compatible-variable-alias 'default-mode-line-format
280   'default-modeline-format)
281 (define-compatible-variable-alias 'mode-line-format 'modeline-format)
282 (define-compatible-variable-alias 'mode-line-menu 'modeline-menu)
283
284 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; mouse
285
286 ;;; (defun mouse-eval-last-sexpr (event)
287 ;;;   (interactive "@e")
288 ;;;   (save-excursion
289 ;;;     (mouse-set-point event)
290 ;;;     (eval-last-sexp nil)))
291
292 (define-obsolete-function-alias 'mouse-eval-last-sexpr 'mouse-eval-sexp)
293
294 (defun read-mouse-position (frame)
295   (cdr (mouse-position (frame-device frame))))
296 (make-obsolete 'read-mouse-position 'mouse-position)
297
298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; redisplay
299
300 (defun redraw-display (&optional device)
301   (if (eq device t)
302       (mapcar 'redisplay-device (device-list))
303     (redisplay-device device)))
304
305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; window-system objects
306
307 ;; the functionality of column.el has been moved into C
308 ;; Function obsoleted for XEmacs 20.0/February 1997.
309 (defalias 'display-column-mode 'column-number-mode)
310
311 (defun x-color-values  (color &optional frame)
312   "Return a description of the color named COLOR on frame FRAME.
313 The value is a list of integer RGB values--(RED GREEN BLUE).
314 These values appear to range from 0 to 65280 or 65535, depending
315 on the system; white is (65280 65280 65280) or (65535 65535 65535).
316 If FRAME is omitted or nil, use the selected frame."
317   (color-instance-rgb-components (make-color-instance color)))
318 (make-compatible 'x-color-values 'color-instance-rgb-components)
319
320 ;; Two loser functions which shouldn't be used.
321 (make-obsolete 'following-char 'char-after)
322 (make-obsolete 'preceding-char 'char-before)
323
324
325 ;; The following several functions are useful in GNU Emacs 20 because
326 ;; of the multibyte "characters" the internal representation of which
327 ;; leaks into Lisp.  In XEmacs/Mule they are trivial and unnecessary.
328 ;; We provide them for compatibility reasons solely.
329
330 (defun string-to-sequence (string type)
331   "Convert STRING to a sequence of TYPE which contains characters in STRING.
332 TYPE should be `list' or `vector'.
333 Multibyte characters are concerned."
334   (ecase type
335     (list
336      (mapcar #'identity string))
337     (vector
338      (mapvector #'identity string))))
339
340 (defun string-to-list (string)
341   "Return a list of characters in STRING."
342   (mapcar #'identity string))
343
344 (defun string-to-vector (string)
345   "Return a vector of characters in STRING."
346   (mapvector #'identity string))
347
348 (defun store-substring (string idx object)
349   "Embed OBJECT (string or character) at index IDX of STRING."
350   (let* ((str (cond ((stringp object) object)
351                     ((characterp object) (char-to-string object))
352                     (t (error
353                         "Invalid argument (should be string or character): %s"
354                         object))))
355          (string-len (length string))
356          (len (length str))
357          (i 0))
358     (while (and (< i len) (< idx string-len))
359       (aset string idx (aref str i))
360       (setq idx (1+ idx) i (1+ i)))
361     string))
362
363 ;; #### This function is not compatible with FSF in some cases.  Hard
364 ;; to fix, because it is hard to trace the logic of the FSF function.
365 ;; In case we need the exact behavior, we can always copy the FSF
366 ;; version, which is very long and does lots of unnecessary stuff.
367 (defun truncate-string-to-width (str end-column &optional start-column padding)
368   "Truncate string STR to end at column END-COLUMN.
369 The optional 2nd arg START-COLUMN, if non-nil, specifies
370 the starting column; that means to return the characters occupying
371 columns START-COLUMN ... END-COLUMN of STR.
372
373 The optional 3rd arg PADDING, if non-nil, specifies a padding character
374 to add at the end of the result if STR doesn't reach column END-COLUMN,
375 or if END-COLUMN comes in the middle of a character in STR.
376 PADDING is also added at the beginning of the result
377 if column START-COLUMN appears in the middle of a character in STR.
378
379 If PADDING is nil, no padding is added in these cases, so
380 the resulting string may be narrower than END-COLUMN."
381   (or start-column
382       (setq start-column 0))
383   (let ((len (length str)))
384     (concat (substring str (min start-column len) (min end-column len))
385             (and padding (> end-column len)
386                  (make-string (- end-column len) padding)))))
387
388 (defalias 'truncate-string 'truncate-string-to-width)
389 (make-obsolete 'truncate-string 'truncate-string-to-width)
390
391 ;; Keywords already do The Right Thing in XEmacs
392 (make-compatible 'define-widget-keywords "Just use them")
393
394 (make-obsolete 'function-called-at-point 'function-at-point)
395
396 (when (featurep 'utf-2000)
397   (make-obsolete-variable 'utf-2000-version 'xemacs-chise-version))
398
399 (provide 'obsolete)
400 ;;; obsolete.el ends here