comparison lisp/subr.el @ 83301:b151ec53c504

Merged from [e-mail]--gnu-2005 (patch 68, 286-291) Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-286 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-287 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-288 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-289 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-290 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-291 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-68 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-341

83300:6deb860255f3

	  (setq loop (1+ loop))))))

(defvar key-substitution-in-progress nil
 "Used internally by substitute-key-definition.")

(defun substitute-key-definitions (subst keymap &optional oldmap prefix)
  "Applies the SUBST remapping to key bindings in KEYMAP.
SUBST will be a list of elements of the form (OLDDEF . NEWDEF).
See `substitue-key-definition'."
  ;; 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

    ;; 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-definitions-key defn subst prefix1 keymap))
     scan)))

(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.

For most uses, it is simpler and safer to use command remappping like this:
  \(define-key KEYMAP [remap OLDDEF] NEWDEF)"
  ;; 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.
  (substitute-key-definitions (list (cons olddef newdef)) keymap oldmap prefix))

(defun substitute-key-definitions-key (defn subst prefix keymap)
  (let (inner-def skipped menu-item mapping)
    ;; 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 (setq mapping (assq defn subst))
	    ;; Compare with equal if definition is a key sequence.
	    ;; That is useful for operating on function-key-map.
	    (and (or (stringp defn) (vectorp defn))
		 (setq mapping (assoc defn subst))))
	(define-key keymap prefix
	  (if menu-item
	      (let ((copy (copy-sequence menu-item)))
		(setcar (nthcdr 2 copy) (cdr mapping))
		copy)
	    (nconc (nreverse skipped) (cdr mapping))))
      ;; Look past a symbol that names a keymap.
      (setq inner-def
	    (and defn
		 (condition-case nil (indirect-function defn) (error defn))))
      ;; For nested keymaps, we use `inner-def' rather than `defn' so as to

	       (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-definitions subst keymap inner-def prefix)))))

(defun define-key-after (keymap key definition &optional after)
  "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

  (nth 9 position))


;;;; Obsolescent names for functions.

(defalias 'dot 'point)
(defalias 'dot-marker 'point-marker)
(defalias 'dot-min 'point-min)
(defalias 'dot-max 'point-max)
(defalias 'window-dot 'window-point)
(defalias 'set-window-dot 'set-window-point)
(defalias 'read-input 'read-string)
(defalias 'send-string 'process-send-string)
(defalias 'send-region 'process-send-region)
(defalias 'show-buffer 'set-window-buffer)
(defalias 'buffer-flush-undo 'buffer-disable-undo)
(defalias 'eval-current-buffer 'eval-buffer)
(defalias 'compiled-function-p 'byte-code-function-p)
(defalias 'define-function 'defalias)

(defalias 'sref 'aref)
(make-obsolete 'sref 'aref "20.4")
(make-obsolete 'char-bytes "now always returns 1." "20.4")
(make-obsolete 'chars-in-region "use (abs (- BEG END))." "20.3")
(make-obsolete 'dot 'point		"before 19.15")
(make-obsolete 'dot-max 'point-max	"before 19.15")
(make-obsolete 'dot-min 'point-min	"before 19.15")
(make-obsolete 'dot-marker 'point-marker "before 19.15")
(make-obsolete 'buffer-flush-undo 'buffer-disable-undo "before 19.15")
(make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15")
(make-obsolete 'compiled-function-p 'byte-code-function-p "before 19.15")
(make-obsolete 'define-function 'defalias "20.1")
(make-obsolete 'focus-frame "it does nothing." "19.32")
(make-obsolete 'unfocus-frame "it does nothing." "19.32")

(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."

;; Some programs still use this as a function.
(defun baud-rate ()
  "Return the value of the `baud-rate' variable."
  baud-rate)

(defalias 'focus-frame 'ignore "")
(defalias 'unfocus-frame 'ignore "")


;;;; Obsolescence declarations for variables, and aliases.

(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
(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 to reread, so it now uses nil to mean `no event', instead of -1."
  "before 19.15")
(make-obsolete-variable 'executing-macro 'executing-kbd-macro "before 19.34")
(make-obsolete-variable 'post-command-idle-hook
  "use timers instead, with `run-with-idle-timer'." "before 19.34")
(make-obsolete-variable 'post-command-idle-delay
  "use timers instead, with `run-with-idle-timer'." "before 19.34")

(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
(make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "22.1")
(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
(make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "22.1")

(defun syntax-class (syntax)
  "Return the syntax class part of the syntax descriptor SYNTAX.
If SYNTAX is nil, return nil."
  (and syntax (logand (car syntax) 65535)))

(defun add-to-invisibility-spec (arg)
  "Add elements to `buffer-invisibility-spec'.
See documentation for `buffer-invisibility-spec' for the kind of elements
that can be added."
  (if (eq buffer-invisibility-spec t)
      (setq buffer-invisibility-spec (list t)))
  (setq buffer-invisibility-spec
	(cons arg buffer-invisibility-spec)))

(defun remove-from-invisibility-spec (arg)
  "Remove elements from `buffer-invisibility-spec'."
  (if (consp buffer-invisibility-spec)
    (setq buffer-invisibility-spec (delete arg buffer-invisibility-spec))))

(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.

83301:b151ec53c504

	  (setq loop (1+ loop))))))

(defvar key-substitution-in-progress nil
 "Used internally by substitute-key-definition.")

(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.

For most uses, it is simpler and safer to use command remappping like this:
  \(define-key KEYMAP [remap OLDDEF] NEWDEF)"
  ;; 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

    ;; 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
	    (and defn
		 (condition-case nil (indirect-function defn) (error defn))))
      ;; For nested keymaps, we use `inner-def' rather than `defn' so as to

	       (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)))))

(defun define-key-after (keymap key definition &optional after)
  "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

  (nth 9 position))


;;;; Obsolescent names for functions.

(defalias 'window-dot 'window-point)
(defalias 'set-window-dot 'set-window-point)
(defalias 'read-input 'read-string)
(defalias 'send-string 'process-send-string)
(defalias 'send-region 'process-send-region)
(defalias 'show-buffer 'set-window-buffer)
(defalias 'eval-current-buffer 'eval-buffer)

(make-obsolete 'char-bytes "now always returns 1." "20.4")
(make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15")

(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."

;; Some programs still use this as a function.
(defun baud-rate ()
  "Return the value of the `baud-rate' variable."
  baud-rate)


;;;; Obsolescence declarations for variables, and aliases.

(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
(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 to reread, so it now uses nil to mean `no event', instead of -1."
  "before 19.15")
(make-obsolete-variable 'post-command-idle-hook
  "use timers instead, with `run-with-idle-timer'." "before 19.34")
(make-obsolete-variable 'post-command-idle-delay
  "use timers instead, with `run-with-idle-timer'." "before 19.34")

;; Lisp manual only updated in 22.1.
(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
			      "before 19.34")

(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
(make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "22.1")
(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
(make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "22.1")

(defun syntax-class (syntax)
  "Return the syntax class part of the syntax descriptor SYNTAX.
If SYNTAX is nil, return nil."
  (and syntax (logand (car syntax) 65535)))

(defun add-to-invisibility-spec (element)
  "Add ELEMENT to `buffer-invisibility-spec'.
See documentation for `buffer-invisibility-spec' for the kind of elements
that can be added."
  (if (eq buffer-invisibility-spec t)
      (setq buffer-invisibility-spec (list t)))
  (setq buffer-invisibility-spec
	(cons element buffer-invisibility-spec)))

(defun remove-from-invisibility-spec (element)
  "Remove ELEMENT from `buffer-invisibility-spec'."
  (if (consp buffer-invisibility-spec)
    (setq buffer-invisibility-spec (delete element buffer-invisibility-spec))))

(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.