subr.el 138 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1
;;; subr.el --- basic lisp subroutines for Emacs
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
David Lawrence's avatar
David Lawrence committed
5

Pavel Janík's avatar
Pavel Janík committed
6 7 8
;; Maintainer: FSF
;; Keywords: internal

David Lawrence's avatar
David Lawrence committed
9 10
;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
David Lawrence's avatar
David Lawrence committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
David Lawrence's avatar
David Lawrence committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
David Lawrence's avatar
David Lawrence committed
23

24 25
;;; Commentary:

Eric S. Raymond's avatar
Eric S. Raymond committed
26
;;; Code:
27

28 29 30 31
(defvar custom-declare-variable-list nil
  "Record `defcustom' calls made before `custom.el' is loaded to handle them.
Each element of this list holds the arguments to one call to `defcustom'.")

Richard M. Stallman's avatar
Richard M. Stallman committed
32
;; Use this, rather than defcustom, in subr.el and other files loaded
33 34 35 36
;; before custom.el.
(defun custom-declare-variable-early (&rest arguments)
  (setq custom-declare-variable-list
	(cons arguments custom-declare-variable-list)))
37

38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
(defmacro declare-function (fn file &optional arglist fileonly)
  "Tell the byte-compiler that function FN is defined, in FILE.
Optional ARGLIST is the argument list used by the function.  The
FILE argument is not used by the byte-compiler, but by the
`check-declare' package, which checks that FILE contains a
definition for FN.  ARGLIST is used by both the byte-compiler and
`check-declare' to check for consistency.

FILE can be either a Lisp file (in which case the \".el\"
extension is optional), or a C file.  C files are expanded
relative to the Emacs \"src/\" directory.  Lisp files are
searched for using `locate-library', and if that fails they are
expanded relative to the location of the file containing the
declaration.  A FILE with an \"ext:\" prefix is an external file.
`check-declare' will check such files if they are found, and skip
them without error if they are not.

FILEONLY non-nil means that `check-declare' will only check that
FILE exists, not that it defines FN.  This is intended for
function-definitions that `check-declare' does not recognize, e.g.
`defstruct'.

To specify a value for FILEONLY without passing an argument list,
set ARGLIST to `t'.  This is necessary because `nil' means an
empty argument list, rather than an unspecified one.

Note that for the purposes of `check-declare', this statement
must be the first non-whitespace on a line, and everything up to
the end of FILE must be all on the same line.  For example:

\(declare-function c-end-of-defun \"progmodes/cc-cmds.el\"
                  \(&optional arg))

Glenn Morris's avatar
Glenn Morris committed
71
For more information, see Info node `(elisp)Declaring Functions'."
72 73
  ;; Does nothing - byte-compile-declare-function does the work.
  nil)
Eli Zaretskii's avatar
Eli Zaretskii committed
74

75

76
;;;; Basic Lisp macros.
77

Stefan Monnier's avatar
Stefan Monnier committed
78 79
(defalias 'not 'null)

Kenichi Handa's avatar
Kenichi Handa committed
80
(defmacro noreturn (form)
Luc Teirlinck's avatar
Luc Teirlinck committed
81 82
  "Evaluate FORM, expecting it not to return.
If FORM does return, signal an error."
Kenichi Handa's avatar
Kenichi Handa committed
83 84 85 86
  `(prog1 ,form
     (error "Form marked with `noreturn' did return")))

(defmacro 1value (form)
Luc Teirlinck's avatar
Luc Teirlinck committed
87 88 89
  "Evaluate FORM, expecting a constant return value.
This is the global do-nothing version.  There is also `testcover-1value'
that complains if FORM ever does return differing values."
Kenichi Handa's avatar
Kenichi Handa committed
90 91
  form)

92 93
(defmacro def-edebug-spec (symbol spec)
  "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
94
Both SYMBOL and SPEC are unevaluated.  The SPEC can be 0, t, a symbol
95 96 97
\(naming a function), or a list."
  `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))

98 99 100 101 102
(defmacro lambda (&rest cdr)
  "Return a lambda expression.
A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
self-quoting; the result of evaluating the lambda expression is the
expression itself.  The lambda expression may then be treated as a
Richard M. Stallman's avatar
Richard M. Stallman committed
103
function, i.e., stored as the function value of a symbol, passed to
104
`funcall' or `mapcar', etc.
Richard M. Stallman's avatar
Richard M. Stallman committed
105

106
ARGS should take the same form as an argument list for a `defun'.
Richard M. Stallman's avatar
Richard M. Stallman committed
107 108 109
DOCSTRING is an optional documentation string.
 If present, it should describe how to call the function.
 But documentation strings are usually not useful in nameless functions.
110 111
INTERACTIVE should be a call to the function `interactive', which see.
It may also be omitted.
112 113 114
BODY should be a list of Lisp expressions.

\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
115 116 117 118
  ;; Note that this definition should not use backquotes; subr.el should not
  ;; depend on backquote.el.
  (list 'function (cons 'lambda cdr)))

Richard M. Stallman's avatar
Richard M. Stallman committed
119
(defmacro push (newelt listname)
Richard M. Stallman's avatar
Richard M. Stallman committed
120
  "Add NEWELT to the list stored in the symbol LISTNAME.
Richard M. Stallman's avatar
Richard M. Stallman committed
121
This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)).
Richard M. Stallman's avatar
Richard M. Stallman committed
122
LISTNAME must be a symbol."
123
  (declare (debug (form sexp)))
Dave Love's avatar
Dave Love committed
124 125
  (list 'setq listname
	(list 'cons newelt listname)))
Richard M. Stallman's avatar
Richard M. Stallman committed
126 127 128 129 130 131

(defmacro pop (listname)
  "Return the first element of LISTNAME's value, and remove it from the list.
LISTNAME must be a symbol whose value is a list.
If the value is nil, `pop' returns nil but does not actually
change the list."
132
  (declare (debug (sexp)))
133 134 135
  (list 'car
	(list 'prog1 listname
	      (list 'setq listname (list 'cdr listname)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
136

137
(defmacro when (cond &rest body)
Kim F. Storm's avatar
Kim F. Storm committed
138 139 140 141
  "If COND yields non-nil, do BODY, else return nil.
When COND yields non-nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.

Juanma Barranquero's avatar
Juanma Barranquero committed
142
\(fn COND BODY...)"
143
  (declare (indent 1) (debug t))
144
  (list 'if cond (cons 'progn body)))
145

146
(defmacro unless (cond &rest body)
Kim F. Storm's avatar
Kim F. Storm committed
147 148 149 150
  "If COND yields nil, do BODY, else return nil.
When COND yields nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.

Juanma Barranquero's avatar
Juanma Barranquero committed
151
\(fn COND BODY...)"
152
  (declare (indent 1) (debug t))
153
  (cons 'if (cons cond (cons nil body))))
154

155 156 157
(defvar --dolist-tail-- nil
  "Temporary variable used in `dolist' expansion.")

158
(defmacro dolist (spec &rest body)
159
  "Loop over a list.
160
Evaluate BODY with VAR bound to each car from LIST, in turn.
161 162
Then evaluate RESULT to get return value, default nil.

Markus Rost's avatar
Markus Rost committed
163
\(fn (VAR LIST [RESULT]) BODY...)"
164
  (declare (indent 1) (debug ((symbolp form &optional form) body)))
165 166 167 168
  ;; It would be cleaner to create an uninterned symbol,
  ;; but that uses a lot more space when many functions in many files
  ;; use dolist.
  (let ((temp '--dolist-tail--))
169 170 171 172
    `(let ((,temp ,(nth 1 spec))
	   ,(car spec))
       (while ,temp
	 (setq ,(car spec) (car ,temp))
173 174
	 ,@body
	 (setq ,temp (cdr ,temp)))
175 176
       ,@(if (cdr (cdr spec))
	     `((setq ,(car spec) nil) ,@(cdr (cdr spec)))))))
177

178 179 180
(defvar --dotimes-limit-- nil
  "Temporary variable used in `dotimes' expansion.")

181
(defmacro dotimes (spec &rest body)
182
  "Loop a certain number of times.
183 184
Evaluate BODY with VAR bound to successive integers running from 0,
inclusive, to COUNT, exclusive.  Then evaluate RESULT to get
185 186
the return value (nil if RESULT is omitted).

Markus Rost's avatar
Markus Rost committed
187
\(fn (VAR COUNT [RESULT]) BODY...)"
188
  (declare (indent 1) (debug dolist))
189 190 191 192
  ;; It would be cleaner to create an uninterned symbol,
  ;; but that uses a lot more space when many functions in many files
  ;; use dotimes.
  (let ((temp '--dotimes-limit--)
193 194 195 196 197 198 199 200
	(start 0)
	(end (nth 1 spec)))
    `(let ((,temp ,end)
	   (,(car spec) ,start))
       (while (< ,(car spec) ,temp)
	 ,@body
	 (setq ,(car spec) (1+ ,(car spec))))
       ,@(cdr (cdr spec)))))
201

Kenichi Handa's avatar
Kenichi Handa committed
202 203 204
(defmacro declare (&rest specs)
  "Do not evaluate any arguments and return nil.
Treated as a declaration when used at the right place in a
205
`defmacro' form.  \(See Info anchor `(elisp)Definition of declare'.)"
Kenichi Handa's avatar
Kenichi Handa committed
206
  nil)
207 208 209 210 211

(defmacro ignore-errors (&rest body)
  "Execute BODY; if an error occurs, return nil.
Otherwise, return result of last form in BODY."
  `(condition-case nil (progn ,@body) (error nil)))
212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238

;;;; Basic Lisp functions.

(defun ignore (&rest ignore)
  "Do nothing and return nil.
This function accepts any number of arguments, but ignores them."
  (interactive)
  nil)

(defun error (&rest args)
  "Signal an error, making error message by passing all args to `format'.
In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period.  Please follow this convention
for the sake of consistency."
  (while t
    (signal 'error (list (apply 'format args)))))

;; We put this here instead of in frame.el so that it's defined even on
;; systems where frame.el isn't loaded.
(defun frame-configuration-p (object)
  "Return non-nil if OBJECT seems to be a frame configuration.
Any list whose car is `frame-configuration' is assumed to be a frame
configuration."
  (and (consp object)
       (eq (car object) 'frame-configuration)))

(defun functionp (object)
239
  "Non-nil if OBJECT is a function."
240 241 242 243 244 245
  (or (and (symbolp object) (fboundp object)
	   (condition-case nil
	       (setq object (indirect-function object))
	     (error nil))
	   (eq (car-safe object) 'autoload)
	   (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
246 247 248 249
      (and (subrp object)
           ;; Filter out special forms.
           (not (eq 'unevalled (cdr (subr-arity object)))))
      (byte-code-function-p object)
250 251 252
      (eq (car-safe object) 'lambda)))

;;;; List functions.
Kenichi Handa's avatar
Kenichi Handa committed
253

254 255 256 257 258 259 260 261 262 263 264 265 266 267 268
(defsubst caar (x)
  "Return the car of the car of X."
  (car (car x)))

(defsubst cadr (x)
  "Return the car of the cdr of X."
  (car (cdr x)))

(defsubst cdar (x)
  "Return the cdr of the car of X."
  (cdr (car x)))

(defsubst cddr (x)
  "Return the cdr of the cdr of X."
  (cdr (cdr x)))
Richard M. Stallman's avatar
Richard M. Stallman committed
269

270 271 272 273 274
(defun last (list &optional n)
  "Return the last link of LIST.  Its car is the last element.
If LIST is nil, return nil.
If N is non-nil, return the Nth-to-last link of LIST.
If N is bigger than the length of LIST, return LIST."
275
  (if n
276
      (let ((m 0) (p list))
277 278 279
	(while (consp p)
	  (setq m (1+ m) p (cdr p)))
	(if (<= n 0) p
280 281 282 283
	  (if (< n m) (nthcdr (- m n) list) list)))
    (while (consp (cdr list))
      (setq list (cdr list)))
    list))
284

285
(defun butlast (list &optional n)
286
  "Return a copy of LIST with the last N elements removed."
287 288
  (if (and n (<= n 0)) list
    (nbutlast (copy-sequence list) n)))
289

290
(defun nbutlast (list &optional n)
291
  "Modifies LIST to remove the last N elements."
292
  (let ((m (length list)))
293 294 295
    (or n (setq n 1))
    (and (< n m)
	 (progn
296 297
	   (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
	   list))))
298

Kenichi Handa's avatar
Kenichi Handa committed
299 300 301 302 303 304 305 306 307 308 309
(defun delete-dups (list)
  "Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it.  LIST must be a proper list.
Of several `equal' occurrences of an element in LIST, the first
one is kept."
  (let ((tail list))
    (while tail
      (setcdr tail (delete (car tail) (cdr tail)))
      (setq tail (cdr tail))))
  list)

310
(defun number-sequence (from &optional to inc)
311
  "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
Kenichi Handa's avatar
Kenichi Handa committed
312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333
INC is the increment used between numbers in the sequence and defaults to 1.
So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from
zero.  TO is only included if there is an N for which TO = FROM + N * INC.
If TO is nil or numerically equal to FROM, return \(FROM).
If INC is positive and TO is less than FROM, or INC is negative
and TO is larger than FROM, return nil.
If INC is zero and TO is neither nil nor numerically equal to
FROM, signal an error.

This function is primarily designed for integer arguments.
Nevertheless, FROM, TO and INC can be integer or float.  However,
floating point arithmetic is inexact.  For instance, depending on
the machine, it may quite well happen that
\(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4),
whereas \(number-sequence 0.4 0.8 0.2) returns a list with three
elements.  Thus, if some of the arguments are floats and one wants
to make sure that TO is included, one may have to explicitly write
TO as \(+ FROM \(* N INC)) or use a variable whose value was
computed with this exact expression.  Alternatively, you can,
of course, also replace TO with a slightly larger value
\(or a slightly more negative value if INC is negative)."
  (if (or (not to) (= from to))
334 335
      (list from)
    (or inc (setq inc 1))
Kenichi Handa's avatar
Kenichi Handa committed
336 337 338 339 340 341 342 343 344 345 346
    (when (zerop inc) (error "The increment can not be zero"))
    (let (seq (n 0) (next from))
      (if (> inc 0)
          (while (<= next to)
            (setq seq (cons next seq)
                  n (1+ n)
                  next (+ from (* n inc))))
        (while (>= next to)
          (setq seq (cons next seq)
                n (1+ n)
                next (+ from (* n inc)))))
347
      (nreverse seq))))
348

349 350 351
(defun copy-tree (tree &optional vecp)
  "Make a copy of TREE.
If TREE is a cons cell, this recursively copies both its car and its cdr.
352
Contrast to `copy-sequence', which copies only along the cdrs.  With second
353 354
argument VECP, this copies vectors as well as conses."
  (if (consp tree)
355 356 357 358 359 360 361
      (let (result)
	(while (consp tree)
	  (let ((newcar (car tree)))
	    (if (or (consp (car tree)) (and vecp (vectorp (car tree))))
		(setq newcar (copy-tree (car tree) vecp)))
	    (push newcar result))
	  (setq tree (cdr tree)))
362
	(nconc (nreverse result) tree))
363 364 365
    (if (and vecp (vectorp tree))
	(let ((i (length (setq tree (copy-sequence tree)))))
	  (while (>= (setq i (1- i)) 0)
366 367 368
	    (aset tree i (copy-tree (aref tree i) vecp)))
	  tree)
      tree)))
369 370

;;;; Various list-search functions.
371

372 373
(defun assoc-default (key alist &optional test default)
  "Find object KEY in a pseudo-alist ALIST.
374 375 376 377 378 379 380
ALIST is a list of conses or objects.  Each element
 (or the element's car, if it is a cons) is compared with KEY by
 calling TEST, with two arguments: (i) the element or its car,
 and (ii) KEY.
If that is non-nil, the element matches; then `assoc-default'
 returns the element's cdr, if it is a cons, or DEFAULT if the
 element is not a cons.
381 382 383 384 385 386 387 388 389 390

If no element matches, the value is nil.
If TEST is omitted or nil, `equal' is used."
  (let (found (tail alist) value)
    (while (and tail (not found))
      (let ((elt (car tail)))
	(when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
	  (setq found t value (if (consp elt) (cdr elt) default))))
      (setq tail (cdr tail)))
    value))
391

392
(make-obsolete 'assoc-ignore-case 'assoc-string "22.1")
393 394 395 396
(defun assoc-ignore-case (key alist)
  "Like `assoc', but ignores differences in case and text representation.
KEY must be a string.  Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
Kenichi Handa's avatar
Kenichi Handa committed
397
  (assoc-string key alist t))
398

399
(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1")
400 401
(defun assoc-ignore-representation (key alist)
  "Like `assoc', but ignores differences in text representation.
Juanma Barranquero's avatar
Juanma Barranquero committed
402
KEY must be a string.
403
Unibyte strings are converted to multibyte for comparison."
Kenichi Handa's avatar
Kenichi Handa committed
404
  (assoc-string key alist nil))
405 406 407 408

(defun member-ignore-case (elt list)
  "Like `member', but ignores differences in case and text representation.
ELT must be a string.  Upper-case and lower-case letters are treated as equal.
409 410 411 412 413
Unibyte strings are converted to multibyte for comparison.
Non-strings in LIST are ignored."
  (while (and list
	      (not (and (stringp (car list))
			(eq t (compare-strings elt 0 nil (car list) 0 nil t)))))
414 415
    (setq list (cdr list)))
  list)
416

417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462
(defun assq-delete-all (key alist)
  "Delete from ALIST all elements whose car is `eq' to KEY.
Return the modified alist.
Elements of ALIST that are not conses are ignored."
  (while (and (consp (car alist))
	      (eq (car (car alist)) key))
    (setq alist (cdr alist)))
  (let ((tail alist) tail-cdr)
    (while (setq tail-cdr (cdr tail))
      (if (and (consp (car tail-cdr))
	       (eq (car (car tail-cdr)) key))
	  (setcdr tail (cdr tail-cdr))
	(setq tail tail-cdr))))
  alist)

(defun rassq-delete-all (value alist)
  "Delete from ALIST all elements whose cdr is `eq' to VALUE.
Return the modified alist.
Elements of ALIST that are not conses are ignored."
  (while (and (consp (car alist))
	      (eq (cdr (car alist)) value))
    (setq alist (cdr alist)))
  (let ((tail alist) tail-cdr)
    (while (setq tail-cdr (cdr tail))
      (if (and (consp (car tail-cdr))
	       (eq (cdr (car tail-cdr)) value))
	  (setcdr tail (cdr tail-cdr))
	(setq tail tail-cdr))))
  alist)

(defun remove (elt seq)
  "Return a copy of SEQ with all occurrences of ELT removed.
SEQ must be a list, vector, or string.  The comparison is done with `equal'."
  (if (nlistp seq)
      ;; If SEQ isn't a list, there's no need to copy SEQ because
      ;; `delete' will return a new object.
      (delete elt seq)
    (delete elt (copy-sequence seq))))

(defun remq (elt list)
  "Return LIST with all occurrences of ELT removed.
The comparison is done with `eq'.  Contrary to `delq', this does not use
side-effects, and the argument LIST is not modified."
  (if (memq elt list)
      (delq elt (copy-sequence list))
    list))
463 464

;;;; Keymap support.
David Lawrence's avatar
David Lawrence committed
465

466 467 468 469 470 471
(defmacro kbd (keys)
  "Convert KEYS to the internal Emacs key representation.
KEYS should be a string constant in the format used for
saving keyboard macros (see `edmacro-mode')."
  (read-kbd-macro keys))

David Lawrence's avatar
David Lawrence committed
472 473 474 475
(defun undefined ()
  (interactive)
  (ding))

476 477
;; Prevent the \{...} documentation construct
;; from mentioning keys that run this command.
David Lawrence's avatar
David Lawrence committed
478 479 480 481 482 483
(put 'undefined 'suppress-keymap t)

(defun suppress-keymap (map &optional nodigits)
  "Make MAP override all normally self-inserting keys to be undefined.
Normally, as an exception, digits and minus-sign are set to make prefix args,
but optional second arg NODIGITS non-nil treats them like other chars."
484
  (define-key map [remap self-insert-command] 'undefined)
David Lawrence's avatar
David Lawrence committed
485 486 487 488 489 490 491 492 493
  (or nodigits
      (let (loop)
	(define-key map "-" 'negative-argument)
	;; Make plain numbers do numeric args.
	(setq loop ?0)
	(while (<= loop ?9)
	  (define-key map (char-to-string loop) 'digit-argument)
	  (setq loop (1+ loop))))))

494
(defun define-key-after (keymap key definition &optional after)
495 496 497
  "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
This is like `define-key' except that the binding for KEY is placed
just after the binding for the event AFTER, instead of at the beginning
498 499 500
of the map.  Note that AFTER must be an event type (like KEY), NOT a command
\(like DEFINITION).

501
If AFTER is t or omitted, the new binding goes at the end of the keymap.
502
AFTER should be a single event type--a symbol or a character, not a sequence.
503

504
Bindings are always added before any inherited map.
505

506 507
The order of bindings in a keymap matters when it is used as a menu."
  (unless after (setq after t))
508 509
  (or (keymapp keymap)
      (signal 'wrong-type-argument (list 'keymapp keymap)))
510 511 512 513 514 515 516
  (setq key
	(if (<= (length key) 1) (aref key 0)
	  (setq keymap (lookup-key keymap
				   (apply 'vector
					  (butlast (mapcar 'identity key)))))
	  (aref key (1- (length key)))))
  (let ((tail keymap) done inserted)
517 518
    (while (and (not done) tail)
      ;; Delete any earlier bindings for the same key.
519
      (if (eq (car-safe (car (cdr tail))) key)
520
	  (setcdr tail (cdr (cdr tail))))
521 522
      ;; If we hit an included map, go down that one.
      (if (keymapp (car tail)) (setq tail (car tail)))
523 524
      ;; When we reach AFTER's binding, insert the new binding after.
      ;; If we reach an inherited keymap, insert just before that.
525
      ;; If we reach the end of this keymap, insert at the end.
526 527
      (if (or (and (eq (car-safe (car tail)) after)
		   (not (eq after t)))
528 529
	      (eq (car (cdr tail)) 'keymap)
	      (null (cdr tail)))
530
	  (progn
531 532 533 534 535 536 537
	    ;; Stop the scan only if we find a parent keymap.
	    ;; Keep going past the inserted element
	    ;; so we can delete any duplications that come later.
	    (if (eq (car (cdr tail)) 'keymap)
		(setq done t))
	    ;; Don't insert more than once.
	    (or inserted
538
		(setcdr tail (cons (cons key definition) (cdr tail))))
539
	    (setq inserted t)))
540 541
      (setq tail (cdr tail)))))

542
(defun map-keymap-sorted (function keymap)
543 544
  "Implement `map-keymap' with sorting.
Don't call this function; it is for internal use only."
545 546 547 548 549 550 551 552 553 554 555 556 557 558
  (let (list)
    (map-keymap (lambda (a b) (push (cons a b) list))
                keymap)
    (setq list (sort list
                     (lambda (a b)
                       (setq a (car a) b (car b))
                       (if (integerp a)
                           (if (integerp b) (< a b)
                             t)
                         (if (integerp b) t
                           ;; string< also accepts symbols.
                           (string< a b))))))
    (dolist (p list)
      (funcall function (car p) (cdr p)))))
559

560 561 562
(defun keymap-canonicalize (map)
  "Return an equivalent keymap, without inheritance."
  (let ((bindings ())
563 564
        (ranges ())
	(prompt (keymap-prompt map)))
565 566 567 568 569 570 571 572
    (while (keymapp map)
      (setq map (map-keymap-internal
                 (lambda (key item)
                   (if (consp key)
                       ;; Treat char-ranges specially.
                       (push (cons key item) ranges)
                     (push (cons key item) bindings)))
                 map)))
573
    (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
574 575
    (dolist (binding ranges)
      ;; Treat char-ranges specially.
Stefan Monnier's avatar
Stefan Monnier committed
576
      (define-key map (vector (car binding)) (cdr binding)))
577 578 579 580 581 582 583 584 585 586
    (dolist (binding (prog1 bindings (setq bindings ())))
      (let* ((key (car binding))
             (item (cdr binding))
             (oldbind (assq key bindings)))
        ;; Newer bindings override older.
        (if oldbind (setq bindings (delq oldbind bindings)))
        (when item                      ;nil bindings just hide older ones.
          (push binding bindings))))
    (nconc map bindings)))

587 588
(put 'keyboard-translate-table 'char-table-extra-slots 0)

589 590 591 592
(defun keyboard-translate (from to)
  "Translate character FROM to TO at a low level.
This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it."
593 594 595
  (or (char-table-p keyboard-translate-table)
      (setq keyboard-translate-table
	    (make-char-table 'keyboard-translate-table nil)))
596 597
  (aset keyboard-translate-table from to))

598
;;;; Key binding commands.
599

600 601 602 603 604 605 606
(defun global-set-key (key command)
  "Give KEY a global binding as COMMAND.
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
KEY is a key sequence; noninteractively, it is a string or vector
of characters or event types, and non-ASCII characters with codes
above 127 (such as ISO Latin-1) can be included if you use a vector.
607

608 609 610 611 612 613 614
Note that if KEY has a local binding in the current buffer,
that local binding will continue to shadow any global binding
that you make with this function."
  (interactive "KSet key globally: \nCSet key %s to command: ")
  (or (vectorp key) (stringp key)
      (signal 'wrong-type-argument (list 'arrayp key)))
  (define-key (current-global-map) key command))
615

616 617 618 619 620 621 622
(defun local-set-key (key command)
  "Give KEY a local binding as COMMAND.
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
KEY is a key sequence; noninteractively, it is a string or vector
of characters or event types, and non-ASCII characters with codes
above 127 (such as ISO Latin-1) can be included if you use a vector.
623

624 625 626 627 628 629 630 631 632
The binding goes in the current buffer's local map,
which in most cases is shared with all other buffers in the same major mode."
  (interactive "KSet key locally: \nCSet key %s locally to command: ")
  (let ((map (current-local-map)))
    (or map
	(use-local-map (setq map (make-sparse-keymap))))
    (or (vectorp key) (stringp key)
	(signal 'wrong-type-argument (list 'arrayp key)))
    (define-key map key command)))
633

634 635 636 637 638
(defun global-unset-key (key)
  "Remove global binding of KEY.
KEY is a string or vector representing a sequence of keystrokes."
  (interactive "kUnset key globally: ")
  (global-set-key key nil))
639

640 641 642 643 644 645 646 647 648 649 650
(defun local-unset-key (key)
  "Remove local binding of KEY.
KEY is a string or vector representing a sequence of keystrokes."
  (interactive "kUnset key locally: ")
  (if (current-local-map)
      (local-set-key key nil))
  nil)

;;;; substitute-key-definition and its subroutines.

(defvar key-substitution-in-progress nil
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
651
  "Used internally by `substitute-key-definition'.")
652 653 654 655 656 657 658

(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
  "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
In other words, OLDDEF is replaced with NEWDEF where ever it appears.
Alternatively, if optional fourth argument OLDMAP is specified, we redefine
in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.

659 660
If you don't specify OLDMAP, you can usually get the same results
in a cleaner way with command remapping, like this:
661 662
  \(define-key KEYMAP [remap OLDDEF] NEWDEF)
\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706
  ;; Don't document PREFIX in the doc string because we don't want to
  ;; advertise it.  It's meant for recursive calls only.  Here's its
  ;; meaning

  ;; If optional argument PREFIX is specified, it should be a key
  ;; prefix, a string.  Redefined bindings will then be bound to the
  ;; original key, with PREFIX added at the front.
  (or prefix (setq prefix ""))
  (let* ((scan (or oldmap keymap))
	 (prefix1 (vconcat prefix [nil]))
	 (key-substitution-in-progress
	  (cons scan key-substitution-in-progress)))
    ;; Scan OLDMAP, finding each char or event-symbol that
    ;; has any definition, and act on it with hack-key.
    (map-keymap
     (lambda (char defn)
       (aset prefix1 (length prefix) char)
       (substitute-key-definition-key defn olddef newdef prefix1 keymap))
     scan)))

(defun substitute-key-definition-key (defn olddef newdef prefix keymap)
  (let (inner-def skipped menu-item)
    ;; Find the actual command name within the binding.
    (if (eq (car-safe defn) 'menu-item)
	(setq menu-item defn defn (nth 2 defn))
      ;; Skip past menu-prompt.
      (while (stringp (car-safe defn))
	(push (pop defn) skipped))
      ;; Skip past cached key-equivalence data for menu items.
      (if (consp (car-safe defn))
	  (setq defn (cdr defn))))
    (if (or (eq defn olddef)
	    ;; Compare with equal if definition is a key sequence.
	    ;; That is useful for operating on function-key-map.
	    (and (or (stringp defn) (vectorp defn))
		 (equal defn olddef)))
	(define-key keymap prefix
	  (if menu-item
	      (let ((copy (copy-sequence menu-item)))
		(setcar (nthcdr 2 copy) newdef)
		copy)
	    (nconc (nreverse skipped) newdef)))
      ;; Look past a symbol that names a keymap.
      (setq inner-def
707
	    (or (indirect-function defn t) defn))
708 709 710 711 712 713 714 715 716 717 718 719
      ;; For nested keymaps, we use `inner-def' rather than `defn' so as to
      ;; avoid autoloading a keymap.  This is mostly done to preserve the
      ;; original non-autoloading behavior of pre-map-keymap times.
      (if (and (keymapp inner-def)
	       ;; Avoid recursively scanning
	       ;; where KEYMAP does not have a submap.
	       (let ((elt (lookup-key keymap prefix)))
		 (or (null elt) (natnump elt) (keymapp elt)))
	       ;; Avoid recursively rescanning keymap being scanned.
	       (not (memq inner-def key-substitution-in-progress)))
	  ;; If this one isn't being scanned already, scan it now.
	  (substitute-key-definition olddef newdef keymap inner-def prefix)))))
720 721


Juanma Barranquero's avatar
Juanma Barranquero committed
722
;;;; The global keymap tree.
723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740

;;; global-map, esc-map, and ctl-x-map have their values set up in
;;; keymap.c; we just give them docstrings here.

(defvar global-map nil
  "Default global keymap mapping Emacs keyboard input into commands.
The value is a keymap which is usually (but not necessarily) Emacs's
global map.")

(defvar esc-map nil
  "Default keymap for ESC (meta) commands.
The normal global definition of the character ESC indirects to this keymap.")

(defvar ctl-x-map nil
  "Default keymap for C-x commands.
The normal global definition of the character C-x indirects to this keymap.")

(defvar ctl-x-4-map (make-sparse-keymap)
Pavel Janík's avatar
Pavel Janík committed
741
  "Keymap for subcommands of C-x 4.")
742
(defalias 'ctl-x-4-prefix ctl-x-4-map)
743 744 745 746
(define-key ctl-x-map "4" 'ctl-x-4-prefix)

(defvar ctl-x-5-map (make-sparse-keymap)
  "Keymap for frame commands.")
747
(defalias 'ctl-x-5-prefix ctl-x-5-map)
748 749
(define-key ctl-x-map "5" 'ctl-x-5-prefix)

750

751 752
;;;; Event manipulation functions.

753 754 755 756
;; The call to `read' is to ensure that the value is computed at load time
;; and not compiled into the .elc file.  The value is negative on most
;; machines, but not on all!
(defconst listify-key-sequence-1 (logior 128 (read "?\\M-\\^@")))
757

758 759 760 761 762 763
(defun listify-key-sequence (key)
  "Convert a key sequence to a list of events."
  (if (vectorp key)
      (append key nil)
    (mapcar (function (lambda (c)
			(if (> c 127)
764
			    (logxor c listify-key-sequence-1)
765
			  c)))
766
	    key)))
767

768 769
(defsubst eventp (obj)
  "True if the argument is an event object."
770 771 772 773
  (or (and (integerp obj)
	   ;; Filter out integers too large to be events.
	   ;; M is the biggest modifier.
	   (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1)))))
774
	   (characterp (event-basic-type obj)))
775 776 777 778 779 780 781
      (and (symbolp obj)
	   (get obj 'event-symbol-elements))
      (and (consp obj)
	   (symbolp (car obj))
	   (get (car obj) 'event-symbol-elements))))

(defun event-modifiers (event)
782
  "Return a list of symbols representing the modifier keys in event EVENT.
783
The elements of the list may include `meta', `control',
784
`shift', `hyper', `super', `alt', `click', `double', `triple', `drag',
785 786 787 788 789
and `down'.
EVENT may be an event or an event type.  If EVENT is a symbol
that has never been used in an event that has been read as input
in the current Emacs session, then this function can return nil,
even when EVENT actually has modifiers."
790 791 792 793
  (let ((type event))
    (if (listp type)
	(setq type (car type)))
    (if (symbolp type)
794 795 796
        ;; Don't read event-symbol-elements directly since we're not
        ;; sure the symbol has already been parsed.
	(cdr (internal-event-symbol-parse-modifiers type))
797 798 799 800
      (let ((list nil)
	    (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
					       ?\H-\^@ ?\s-\^@ ?\A-\^@)))))
	(if (not (zerop (logand type ?\M-\^@)))
801
	    (push 'meta list))
802 803
	(if (or (not (zerop (logand type ?\C-\^@)))
		(< char 32))
804
	    (push 'control list))
805 806
	(if (or (not (zerop (logand type ?\S-\^@)))
		(/= char (downcase char)))
807
	    (push 'shift list))
808
	(or (zerop (logand type ?\H-\^@))
809
	    (push 'hyper list))
810
	(or (zerop (logand type ?\s-\^@))
811
	    (push 'super list))
812
	(or (zerop (logand type ?\A-\^@))
813
	    (push 'alt list))
814 815
	list))))

816
(defun event-basic-type (event)
817
  "Return the basic type of the given event (all modifiers removed).
818 819 820 821
The value is a printing character (not upper case) or a symbol.
EVENT may be an event or an event type.  If EVENT is a symbol
that has never been used in an event that has been read as input
in the current Emacs session, then this function may return nil."
822 823
  (if (consp event)
      (setq event (car event)))
824 825
  (if (symbolp event)
      (car (get event 'event-symbol-elements))
826 827 828 829 830 831 832
    (let* ((base (logand event (1- ?\A-\^@)))
	   (uncontrolled (if (< base 32) (logior base 64) base)))
      ;; There are some numbers that are invalid characters and
      ;; cause `downcase' to get an error.
      (condition-case ()
	  (downcase uncontrolled)
	(error uncontrolled)))))
833

834 835
(defsubst mouse-movement-p (object)
  "Return non-nil if OBJECT is a mouse movement event."
836
  (eq (car-safe object) 'mouse-movement))
837

838 839 840 841 842
(defun mouse-event-p (object)
  "Return non-nil if OBJECT is a mouse click event."
  ;; is this really correct? maybe remove mouse-movement?
  (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement)))

843 844
(defsubst event-start (event)
  "Return the starting position of EVENT.
Kenichi Handa's avatar
Kenichi Handa committed
845
If EVENT is a mouse or key press or a mouse click, this returns the location
846 847 848
of the event.
If EVENT is a drag, this returns the drag's starting position.
The return value is of the form
Kenichi Handa's avatar
Kenichi Handa committed
849 850
   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
    IMAGE (DX . DY) (WIDTH . HEIGHT))
851
The `posn-' functions access elements of such lists."
852 853
  (if (consp event) (nth 1 event)
    (list (selected-window) (point) '(0 . 0) 0)))
854 855

(defsubst event-end (event)
Kenichi Handa's avatar
Kenichi Handa committed
856 857
  "Return the ending location of EVENT.
EVENT should be a click, drag, or key press event.
858 859
If EVENT is a click event, this function is the same as `event-start'.
The return value is of the form
Kenichi Handa's avatar
Kenichi Handa committed
860 861
   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
    IMAGE (DX . DY) (WIDTH . HEIGHT))
862
The `posn-' functions access elements of such lists."
863 864
  (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
    (list (selected-window) (point) '(0 . 0) 0)))
865

866 867 868
(defsubst event-click-count (event)
  "Return the multi-click count of EVENT, a click or drag event.
The return value is a positive integer."
869
  (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
870 871

;;;; Extracting fields of the positions in an event.
872

873 874
(defsubst posn-window (position)
  "Return the window in POSITION.
Kenichi Handa's avatar
Kenichi Handa committed
875 876
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
877 878
  (nth 0 position))

Kenichi Handa's avatar
Kenichi Handa committed
879 880 881 882 883 884 885 886 887
(defsubst posn-area (position)
  "Return the window area recorded in POSITION, or nil for the text area.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (let ((area (if (consp (nth 1 position))
		  (car (nth 1 position))
		(nth 1 position))))
    (and (symbolp area) area)))

888 889
(defsubst posn-point (position)
  "Return the buffer location in POSITION.
Kenichi Handa's avatar
Kenichi Handa committed
890 891 892 893 894 895 896 897 898 899
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (or (nth 5 position)
      (if (consp (nth 1 position))
	  (car (nth 1 position))
	(nth 1 position))))

(defun posn-set-point (position)
  "Move point to POSITION.
Select the corresponding window as well."
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
900 901 902 903 904
  (if (not (windowp (posn-window position)))
      (error "Position not in text area of window"))
  (select-window (posn-window position))
  (if (numberp (posn-point position))
      (goto-char (posn-point position))))
905

906 907
(defsubst posn-x-y (position)
  "Return the x and y coordinates in POSITION.
Kenichi Handa's avatar
Kenichi Handa committed
908 909
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
910 911
  (nth 2 position))

912 913
(declare-function scroll-bar-scale "scroll-bar" (num-denom whole))

914
(defun posn-col-row (position)
Kenichi Handa's avatar
Kenichi Handa committed
915 916 917 918
  "Return the nominal column and row in POSITION, measured in characters.
The column and row values are approximations calculated from the x
and y coordinates in POSITION and the frame's default character width
and height.
919
For a scroll-bar event, the result column is 0, and the row
Kenichi Handa's avatar
Kenichi Handa committed
920 921 922 923 924 925 926 927 928 929 930 931 932 933 934
corresponds to the vertical position of the click in the scroll bar.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (let* ((pair   (posn-x-y position))
	 (window (posn-window position))
	 (area   (posn-area position)))
    (cond
     ((null window)
      '(0 . 0))
     ((eq area 'vertical-scroll-bar)
      (cons 0 (scroll-bar-scale pair (1- (window-height window)))))
     ((eq area 'horizontal-scroll-bar)
      (cons (scroll-bar-scale pair (window-width window)) 0))
     (t
      (let* ((frame (if (framep window) window (window-frame window)))
935 936 937 938 939 940 941 942 943 944 945 946 947
	     ;; FIXME: This should take line-spacing properties on
	     ;; newlines into account.
	     (spacing (when (display-graphic-p frame)
			(or (with-current-buffer (window-buffer window)
			      line-spacing)
			    (frame-parameter frame 'line-spacing)))))
	(cond ((floatp spacing)
	       (setq spacing (truncate (* spacing
					  (frame-char-height frame)))))
	      ((null spacing)
	       (setq spacing 0)))
	(cons (/ (car pair) (frame-char-width frame))
	      (/ (cdr pair) (+ (frame-char-height frame) spacing))))))))
Kenichi Handa's avatar
Kenichi Handa committed
948 949 950 951 952 953 954 955 956

(defun posn-actual-col-row (position)
  "Return the actual column and row in POSITION, measured in characters.
These are the actual row number in the window and character number in that row.
Return nil if POSITION does not contain the actual position; in that case
`posn-col-row' can be used to get approximate values.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 6 position))
957

958 959
(defsubst posn-timestamp (position)
  "Return the timestamp of POSITION.
Kenichi Handa's avatar
Kenichi Handa committed
960 961
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
962
  (nth 3 position))
963

Kenichi Handa's avatar
Kenichi Handa committed
964
(defsubst posn-string (position)
965 966
  "Return the string object of POSITION.
Value is a cons (STRING . STRING-POS), or nil if not a string.
Kenichi Handa's avatar
Kenichi Handa committed
967 968 969 970 971
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 4 position))

(defsubst posn-image (position)
972
  "Return the image object of POSITION.
973
Value is a list (image ...), or nil if not an image.
Kenichi Handa's avatar
Kenichi Handa committed
974 975 976 977 978 979
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 7 position))

(defsubst posn-object (position)
  "Return the object (image or string) of POSITION.
980 981
Value is a list (image ...) for an image object, a cons cell
\(STRING . STRING-POS) for a string object, and nil for a buffer position.
Kenichi Handa's avatar
Kenichi Handa committed
982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (or (posn-image position) (posn-string position)))

(defsubst posn-object-x-y (position)
  "Return the x and y coordinates relative to the object of POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 8 position))

(defsubst posn-object-width-height (position)
  "Return the pixel width and height of the object of POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 9 position))

David Lawrence's avatar
David Lawrence committed
998

999 1000
;;;; Obsolescent names for functions.

1001 1002 1003 1004 1005 1006
(define-obsolete-function-alias 'window-dot 'window-point "22.1")
(define-obsolete-function-alias 'set-window-dot 'set-window-point "22.1")
(define-obsolete-function-alias 'read-input 'read-string "22.1")
(define-obsolete-function-alias 'show-buffer 'set-window-buffer "22.1")
(define-obsolete-function-alias 'eval-current-buffer 'eval-buffer "22.1")
(define-obsolete-function-alias 'string-to-int 'string-to-number "22.1")
David Lawrence's avatar
David Lawrence committed
1007

1008
(make-obsolete 'char-bytes "now always returns 1." "20.4")
1009
(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1")
Richard M. Stallman's avatar
Richard M. Stallman committed
1010

1011 1012 1013 1014 1015 1016
(defun insert-string (&rest args)
  "Mocklisp-compatibility insert function.
Like the function `insert' except that any argument that is a number
is converted into a string by expressing it in decimal."
  (dolist (el args)
    (insert (if (integerp el) (number-to-string el) el))))
1017
(make-obsolete 'insert-string 'insert "22.1")
1018

1019
(defun makehash (&optional test) (make-hash-table :test (or test 'eql)))
1020
(make-obsolete 'makehash 'make-hash-table "22.1")
1021

1022 1023
;; Some programs still use this as a function.
(defun baud-rate ()
1024
  "Return the value of the `baud-rate' variable."
1025
  baud-rate)
1026
(make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15")
1027

1028 1029 1030 1031 1032
;; These are used by VM and some old programs
(defalias 'focus-frame 'ignore "")
(make-obsolete 'focus-frame "it does nothing." "22.1")
(defalias 'unfocus-frame 'ignore "")
(make-obsolete 'unfocus-frame "it does nothing." "22.1")
1033 1034
(make-obsolete 'make-variable-frame-local
	       "explicitly check for a frame-parameter instead." "22.2")
1035

1036
;;;; Obsolescence declarations for variables, and aliases.
1037

1038 1039 1040 1041 1042 1043 1044
(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1")
(make-obsolete 'window-redisplay-end-trigger nil "23.1")
(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")

(make-obsolete 'process-filter-multibyte-p nil "23.1")
(make-obsolete 'set-process-filter-multibyte nil "23.1")

1045
(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
1046 1047 1048 1049 1050 1051 1052
(make-obsolete-variable
 'mode-line-inverse-video
 "use the appropriate faces instead."
 "21.1")
(make-obsolete-variable
 'unread-command-char
 "use `unread-command-events' instead.  That variable is a list of events
1053
to reread, so it now uses nil to mean `no event', instead of -1."
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
1054
 "before 19.15")
1055

1056 1057
;; Lisp manual only updated in 22.1.
(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
1058
  "before 19.34")
1059

1060
(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
1061 1062
(make-obsolete-variable 'x-lost-selection-hooks
			'x-lost-selection-functions "22.1")
1063
(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
1064 1065
(make-obsolete-variable 'x-sent-selection-hooks
			'x-sent-selection-functions "22.1")
1066

1067 1068 1069 1070 1071 1072
;; This was introduced in 21.4 for pre-unicode unification.  That
;; usage was rendered obsolete in 23.1 which uses Unicode internally.
;; Other uses are possible, so this variable is not _really_ obsolete,
;; but Stefan insists to mark it so.
(make-obsolete-variable 'translation-table-for-input nil "23.1")

1073
(defvaralias 'messages-buffer-max-lines 'message-log-max)
1074 1075 1076

;; These aliases exist in Emacs 19.34, and probably before, but were
;; only marked as obsolete in 23.1.
Glenn Morris's avatar
Glenn Morris committed
1077
;; The lisp manual (since at least Emacs 21) describes them as
1078 1079 1080 1081 1082 1083
;; existing "for compatibility with Emacs version 18".
(define-obsolete-variable-alias 'last-input-char 'last-input-event
  "at least 19.34")
(define-obsolete-variable-alias 'last-command-char 'last-command-event
  "at least 19.34")

1084 1085 1086

;;;; Alternate names for functions - these are not being phased out.

1087 1088
(defalias 'send-string 'process-send-string)
(defalias 'send-region 'process-send-region)
1089 1090 1091 1092 1093
(defalias 'string= 'string-equal)
(defalias 'string< 'string-lessp)
(defalias 'move-marker 'set-marker)
(defalias 'rplaca 'setcar)
(defalias 'rplacd 'setcdr)
1094
(defalias 'beep 'ding) ;preserve lingual purity
1095 1096 1097 1098 1099
(defalias 'indent-to-column 'indent-to)
(defalias 'backward-delete-char 'delete-backward-char)
(defalias 'search-forward-regexp (symbol-function 're-search-forward))
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
(defalias 'int-to-string 'number-to-string)
1100
(defalias 'store-match-data 'set-match-data)
1101
(defalias 'chmod 'set-file-modes)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1102
(defalias 'mkdir 'make-directory)
1103
;; These are the XEmacs names:
1104 1105
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)