Commit c4f484f2 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

Much rearrangement of functions and division into pages. No code changes.

parent 5798342c
......@@ -37,7 +37,7 @@ Each element of this list holds the arguments to one call to `defcustom'.")
(cons arguments custom-declare-variable-list)))
;;;; Lisp language features.
;;;; Basic Lisp macros.
(defalias 'not 'null)
......@@ -144,6 +144,59 @@ the return value (nil if RESULT is omitted).
Treated as a declaration when used at the right place in a
`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)"
nil)
;;;; 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)
"Non-nil if OBJECT is any kind of function or a special form.
Also non-nil if OBJECT is a symbol and its function definition is
\(recursively) a function or special form. This does not include
macros."
(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)))))))
(subrp object) (byte-code-function-p object)
(eq (car-safe object) 'lambda)))
;; This should probably be written in C (i.e., without using `walk-windows').
(defun get-buffer-window-list (buffer &optional minibuf frame)
"Return list of all windows displaying BUFFER, or nil if none.
BUFFER can be a buffer or a buffer name.
See `walk-windows' for the meaning of MINIBUF and FRAME."
(let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
(walk-windows (function (lambda (window)
(if (eq (window-buffer window) buffer)
(setq windows (cons window windows)))))
minibuf frame)
windows))
;;;; List functions.
(defsubst caar (x)
"Return the car of the car of X."
......@@ -240,23 +293,6 @@ of course, also replace TO with a slightly larger value
next (+ from (* n inc)))))
(nreverse seq))))
(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))
(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.
......@@ -277,6 +313,8 @@ argument VECP, this copies vectors as well as conses."
(aset tree i (copy-tree (aref tree i) vecp)))
tree)
tree)))
;;;; Various list-search functions.
(defun assoc-default (key alist &optional test default)
"Find object KEY in a pseudo-alist ALIST.
......@@ -321,15 +359,67 @@ Non-strings in LIST are ignored."
(setq list (cdr list)))
list)
(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))
;;;; Keymap support.
(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))
(defun undefined ()
(interactive)
(ding))
;Prevent the \{...} documentation construct
;from mentioning keys that run this command.
;; Prevent the \{...} documentation construct
;; from mentioning keys that run this command.
(put 'undefined 'suppress-keymap t)
(defun suppress-keymap (map &optional nodigits)
......@@ -346,76 +436,6 @@ but optional second arg NODIGITS non-nil treats them like other chars."
(define-key map (char-to-string loop) 'digit-argument)
(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
;; 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
(and defn
(condition-case nil (indirect-function defn) (error defn))))
;; 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)))))
(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
......@@ -483,12 +503,6 @@ Don't call this function; it is for internal use only."
(funcall function (car p) (cdr p))))
(map-keymap function keymap)))
(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))
(put 'keyboard-translate-table 'char-table-extra-slots 0)
(defun keyboard-translate (from to)
......@@ -499,37 +513,159 @@ and then modifies one entry in it."
(setq keyboard-translate-table
(make-char-table 'keyboard-translate-table nil)))
(aset keyboard-translate-table from to))
;;;; The global keymap tree.
;;; global-map, esc-map, and ctl-x-map have their values set up in
;;; keymap.c; we just give them docstrings here.
;;;; Key binding commands.
(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.")
(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.
(defvar esc-map nil
"Default keymap for ESC (meta) commands.
The normal global definition of the character ESC indirects to this keymap.")
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))
(defvar ctl-x-map nil
"Default keymap for C-x commands.
The normal global definition of the character C-x indirects to this keymap.")
(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.
(defvar ctl-x-4-map (make-sparse-keymap)
"Keymap for subcommands of C-x 4.")
(defalias 'ctl-x-4-prefix ctl-x-4-map)
(define-key ctl-x-map "4" 'ctl-x-4-prefix)
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)))
(defvar ctl-x-5-map (make-sparse-keymap)
"Keymap for frame commands.")
(defalias 'ctl-x-5-prefix ctl-x-5-map)
(define-key ctl-x-map "5" 'ctl-x-5-prefix)
(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))
(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
"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
;; 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
(and defn
(condition-case nil (indirect-function defn) (error defn))))
;; 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)))))
;;;; The global keymap tree.
;;; 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)
"Keymap for subcommands of C-x 4.")
(defalias 'ctl-x-4-prefix ctl-x-4-map)
(define-key ctl-x-map "4" 'ctl-x-4-prefix)
(defvar ctl-x-5-map (make-sparse-keymap)
"Keymap for frame commands.")
(defalias 'ctl-x-5-prefix ctl-x-5-map)
(define-key ctl-x-map "5" 'ctl-x-5-prefix)
;;;; Event manipulation functions.
;; The call to `read' is to ensure that the value is computed at load time
......@@ -642,6 +778,8 @@ The `posn-' functions access elements of such lists."
"Return the multi-click count of EVENT, a click or drag event.
The return value is a positive integer."
(if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
;;;; Extracting fields of the positions in an event.
(defsubst posn-window (position)
"Return the window in POSITION.
......@@ -831,6 +969,8 @@ is converted into a string by expressing it in decimal."
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
(defalias 'user-original-login-name 'user-login-name)
;;;; Hook manipulation functions.
......@@ -991,7 +1131,143 @@ The return value is the new value of LIST-VAR."
(if (and oa ob)
(< oa ob)
oa)))))))
;;;; Mode hooks.
(defvar delay-mode-hooks nil
"If non-nil, `run-mode-hooks' should delay running the hooks.")
(defvar delayed-mode-hooks nil
"List of delayed mode hooks waiting to be run.")
(make-variable-buffer-local 'delayed-mode-hooks)
(put 'delay-mode-hooks 'permanent-local t)
(defvar after-change-major-mode-hook nil
"Normal hook run at the very end of major mode functions.")
(defun run-mode-hooks (&rest hooks)
"Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
Execution is delayed if `delay-mode-hooks' is non-nil.
If `delay-mode-hooks' is nil, run `after-change-major-mode-hook'
after running the mode hooks.
Major mode functions should use this."
(if delay-mode-hooks
;; Delaying case.
(dolist (hook hooks)
(push hook delayed-mode-hooks))
;; Normal case, just run the hook as before plus any delayed hooks.
(setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
(setq delayed-mode-hooks nil)
(apply 'run-hooks hooks)
(run-hooks 'after-change-major-mode-hook)))
(defmacro delay-mode-hooks (&rest body)
"Execute BODY, but delay any `run-mode-hooks'.
These hooks will be executed by the first following call to
`run-mode-hooks' that occurs outside any `delayed-mode-hooks' form.
Only affects hooks run in the current buffer."
(declare (debug t) (indent 0))
`(progn
(make-local-variable 'delay-mode-hooks)
(let ((delay-mode-hooks t))
,@body)))
;; PUBLIC: find if the current mode derives from another.
(defun derived-mode-p (&rest modes)
"Non-nil if the current major mode is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards."
(let ((parent major-mode))
(while (and (not (memq parent modes))
(setq parent (get parent 'derived-mode-parent))))
parent))
;;;; Minor modes.
;; If a minor mode is not defined with define-minor-mode,
;; add it here explicitly.
;; isearch-mode is deliberately excluded, since you should
;; not call it yourself.
(defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
overwrite-mode view-mode
hs-minor-mode)
"List of all minor mode functions.")
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
"Register a new minor mode.
This is an XEmacs-compatibility function. Use `define-minor-mode' instead.
TOGGLE is a symbol which is the name of a buffer-local variable that
is toggled on or off to say whether the minor mode is active or not.
NAME specifies what will appear in the mode line when the minor mode
is active. NAME should be either a string starting with a space, or a
symbol whose value is such a string.
Optional KEYMAP is the keymap for the minor mode that will be added
to `minor-mode-map-alist'.
Optional AFTER specifies that TOGGLE should be added after AFTER
in `minor-mode-alist'.
Optional TOGGLE-FUN is an interactive function to toggle the mode.
It defaults to (and should by convention be) TOGGLE.
If TOGGLE has a non-nil `:included' property, an entry for the mode is
included in the mode-line minor mode menu.
If TOGGLE has a `:menu-tag', that is used for the menu item's label."
(unless (memq toggle minor-mode-list)
(push toggle minor-mode-list))
(unless toggle-fun (setq toggle-fun toggle))
(unless (eq toggle-fun toggle)
(put toggle :minor-mode-function toggle-fun))
;; Add the name to the minor-mode-alist.
(when name
(let ((existing (assq toggle minor-mode-alist)))
(if existing
(setcdr existing (list name))
(let ((tail minor-mode-alist) found)
(while (and tail (not found))
(if (eq after (caar tail))
(setq found tail)
(setq tail (cdr tail))))
(if found
(let ((rest (cdr found)))
(setcdr found nil)
(nconc found (list (list toggle name)) rest))
(setq minor-mode-alist (cons (list toggle name)
minor-mode-alist)))))))
;; Add the toggle to the minor-modes menu if requested.
(when (get toggle :included)
(define-key mode-line-mode-menu
(vector toggle)
(list 'menu-item
(concat
(or (get toggle :menu-tag)
(if (stringp name) name (symbol-name toggle)))
(let ((mode-name (if (symbolp name) (symbol-value name))))
(if (and (stringp mode-name) (string-match "[^ ]+" mode-name))
(concat " (" (match-string 0 mode-name) ")"))))
toggle-fun
:button (cons :toggle toggle))))
;; Add the map to the minor-mode-map-alist.
(when keymap
(let ((existing (assq toggle minor-mode-map-alist)))
(if existing
(setcdr existing keymap)
(let ((tail minor-mode-map-alist) found)
(while (and tail (not found))
(if (eq after (caar tail))
(setq found tail)
(setq tail (cdr tail))))
(if found
(let ((rest (cdr found)))
(setcdr found nil)
(nconc found (list (cons toggle keymap)) rest))
(setq minor-mode-map-alist (cons (cons toggle keymap)
minor-mode-map-alist))))))))
;;; Load history
......@@ -1080,7 +1356,9 @@ This makes or adds to an entry on `after-load-alist'.
FILE should be the name of a library, with no directory name."
(eval-after-load file (read)))
;;; open-network-stream is a wrapper around make-network-process.
;;;; Process stuff.
;; open-network-stream is a wrapper around make-network-process.
(when (featurep 'make-network-process)
(defun open-network-stream (name buffer host service)
......@@ -1380,6 +1658,8 @@ This finishes the change group by reverting all of its changes."
;; Revert the undo info to what it was when we grabbed the state.
(setq buffer-undo-list elt)))))
;;;; Display-related functions.
;; For compatibility.
(defalias 'redraw-modeline 'force-mode-line-update)
......@@ -1517,34 +1797,122 @@ mode.")
This variable is meaningful on MS-DOG and Windows NT.
On those systems, it is automatically local in every buffer.
On other systems, this variable is normally always nil.")
;;;; Misc. useful functions.
;; This should probably be written in C (i.e., without using `walk-windows').
(defun get-buffer-window-list (buffer &optional minibuf frame)
"Return list of all windows displaying BUFFER, or nil if none.
BUFFER can be a buffer or a buffer name.
See `walk-windows' for the meaning of MINIBUF and FRAME."
(let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
(walk-windows (function (lambda (window)
(if (eq (window-buffer window) buffer)
(setq windows (cons window windows)))))
minibuf frame)
windows))
(defun find-tag-default ()