annotate lisp/subr.el @ 2504:181eef669324

* subr.el (overlay-start, overlay-end, overlay-buffer): New defsubsts.
author Jim Blandy <jimb@redhat.com>
date Sat, 10 Apr 1993 06:21:55 +0000
parents 83319ce2d2f3
children 39ad4eda7fea
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 648
diff changeset
1 ;;; subr.el --- basic lisp subroutines for Emacs
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
2
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
3 ;;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
4
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
5 ;; This file is part of GNU Emacs.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
6
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
8 ;; it under the terms of the GNU General Public License as published by
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
9 ;; the Free Software Foundation; either version 2, or (at your option)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
10 ;; any later version.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
11
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
12 ;; GNU Emacs is distributed in the hope that it will be useful,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
15 ;; GNU General Public License for more details.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
16
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
17 ;; You should have received a copy of the GNU General Public License
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
20
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
21 ;;; Code:
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
22
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
23
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
24 ;;;; Lisp language features.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
25
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
26 (defmacro lambda (&rest cdr)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
27 "Return a lambda expression.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
28 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
29 self-quoting; the result of evaluating the lambda expression is the
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
30 expression itself. The lambda expression may then be treated as a
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
31 function, i. e. stored as the function value of a symbol, passed to
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
32 funcall or mapcar, etcetera.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
33 ARGS should take the same form as an argument list for a `defun'.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
34 DOCSTRING should be a string, as described for `defun'. It may be omitted.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
35 INTERACTIVE should be a call to the function `interactive', which see.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
36 It may also be omitted.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
37 BODY should be a list of lisp expressions."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
38 ;; Note that this definition should not use backquotes; subr.el should not
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
39 ;; depend on backquote.el.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
40 (list 'function (cons 'lambda cdr)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
41
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
42 ;;(defmacro defun-inline (name args &rest body)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
43 ;; "Create an \"inline defun\" (actually a macro).
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
44 ;;Use just like `defun'."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
45 ;; (nconc (list 'defmacro name '(&rest args))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
46 ;; (if (stringp (car body))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
47 ;; (prog1 (list (car body))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
48 ;; (setq body (or (cdr body) body))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
49 ;; (list (list 'cons (list 'quote
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
50 ;; (cons 'lambda (cons args body)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
51 ;; 'args))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
52
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
53
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
54 ;;;; Window tree functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
55
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
56 (defun one-window-p (&optional nomini)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
57 "Returns non-nil if there is only one window.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
58 Optional arg NOMINI non-nil means don't count the minibuffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
59 even if it is active."
707
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
60 (let ((base-window (selected-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
61 (if (and nomini (eq base-window (minibuffer-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
62 (setq base-window (next-window base-window)))
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
63 (eq base-window
e4253da532fb *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 675
diff changeset
64 (next-window base-window (if nomini 'arg)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
65
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
66 (defun walk-windows (proc &optional minibuf all-frames)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
67 "Cycle through all visible windows, calling PROC for each one.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
68 PROC is called with a window as argument.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
69 Optional second arg MINIBUF t means count the minibuffer window
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
70 even if not active. If MINIBUF is neither t nor nil it means
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
71 not to count the minibuffer even if it is active.
1959
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
72
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
73 Optional third arg ALL-FRAMES, if t, means include all frames.
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
74 ALL-FRAMES nil or omitted means cycle within the selected frame,
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
75 but include the minibuffer window (if MINIBUF says so) that that
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
76 frame uses, even if it is on another frame.
3c827b8110db (walk-windows): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1903
diff changeset
77 If ALL-FRAMES is neither nil nor t, stick strictly to the selected frame."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
78 (let* ((walk-windows-start (selected-window))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
79 (walk-windows-current walk-windows-start))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
80 (while (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
81 (setq walk-windows-current
779
c2dbf1fe0506 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 707
diff changeset
82 (next-window walk-windows-current minibuf all-frames))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
83 (funcall proc walk-windows-current)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
84 (not (eq walk-windows-current walk-windows-start))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
85
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
86
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
87 ;;;; Keymap support.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
88
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
89 (defun undefined ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
90 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
91 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
92
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
93 ;Prevent the \{...} documentation construct
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
94 ;from mentioning keys that run this command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
95 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
96
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
97 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
98 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
99 Normally, as an exception, digits and minus-sign are set to make prefix args,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
100 but optional second arg NODIGITS non-nil treats them like other chars."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
101 (let ((i 0))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
102 (while (<= i 127)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
103 (if (eql (lookup-key global-map (char-to-string i)) 'self-insert-command)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
104 (define-key map (char-to-string i) 'undefined))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
105 (setq i (1+ i))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
106 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
107 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
108 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
109 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
110 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
111 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
112 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
113 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
115 ;Moved to keymap.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
116 ;(defun copy-keymap (keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
117 ; "Return a copy of KEYMAP"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
118 ; (while (not (keymapp keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
119 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
120 ; (if (vectorp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
121 ; (copy-sequence keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
122 ; (copy-alist keymap)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
123
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
124 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
125 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
126 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
127 If optional fourth argument OLDMAP is specified, we redefine
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
128 in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
129 (or prefix (setq prefix ""))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
130 (let* ((scan (or oldmap keymap))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
131 (vec1 (vector nil))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
132 (prefix1 (vconcat prefix vec1)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
133 ;; Scan OLDMAP, finding each char or event-symbol that
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
134 ;; has any definition, and act on it with hack-key.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
135 (while (consp scan)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
136 (if (consp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
137 (let ((char (car (car scan)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
138 (defn (cdr (car scan))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
139 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
140 ;; the inside of the following let that handles array elements.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
141 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
142 (aset prefix1 (length prefix) char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
143 (let (inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
144 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
145 (while (stringp (car-safe defn))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
146 (setq defn (cdr defn)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
147 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
148 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
149 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
150 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
151 (if (eq defn olddef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
152 (define-key keymap prefix1 newdef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
153 (if (keymapp defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
154 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
155 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
156 prefix1)))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
157 (if (arrayp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
158 (let* ((array (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
159 (len (length array))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
160 (i 0))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
161 (while (< i len)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
162 (let ((char i) (defn (aref array i)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
163 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
164 ;; the inside of the previous let.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
165 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
166 (aset prefix1 (length prefix) char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
167 (let (inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
168 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
169 (while (stringp (car-safe defn))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
170 (setq defn (cdr defn)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
171 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
172 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
173 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
174 (setq inner-def (symbol-function inner-def)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
175 (if (eq defn olddef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
176 (define-key keymap prefix1 newdef)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
177 (if (keymapp defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
178 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
179 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
180 prefix1)))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
181 (setq i (1+ i))))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
182 (setq scan (cdr scan)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
183
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
184 (defun keyboard-translate (from to)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
185 "Translate character FROM to TO at a low level.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
186 This function creates a `keyboard-translate-table' if necessary
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
187 and then modifies one entry in it."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
188 (or (arrayp keyboard-translate-table)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
189 (setq keyboard-translate-table ""))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
190 (if (or (> from (length keyboard-translate-table))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
191 (> to (length keyboard-translate-table)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
192 (progn
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
193 (let* ((i (length keyboard-translate-table))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
194 (table (make-string (- 256 i) 0)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
195 (while (< i 256)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
196 (aset table i i)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
197 (setq i (1+ i)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
198 (setq keyboard-translate-table table))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
199 (aset keyboard-translate-table from to))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
200
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
201
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
202 ;;;; The global keymap tree.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
203
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
204 ;;; global-map, esc-map, and ctl-x-map have their values set up in
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
205 ;;; keymap.c; we just give them docstrings here.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
206
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
207 (defvar global-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
208 "Default global keymap mapping Emacs keyboard input into commands.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
209 The value is a keymap which is usually (but not necessarily) Emacs's
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
210 global map.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
211
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
212 (defvar esc-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
213 "Default keymap for ESC (meta) commands.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
214 The normal global definition of the character ESC indirects to this keymap.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
215
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
216 (defvar ctl-x-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
217 "Default keymap for C-x commands.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
218 The normal global definition of the character C-x indirects to this keymap.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
219
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
220 (defvar ctl-x-4-map (make-sparse-keymap)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
221 "Keymap for subcommands of C-x 4")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
222 (fset 'ctl-x-4-prefix ctl-x-4-map)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
223 (define-key ctl-x-map "4" 'ctl-x-4-prefix)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
224
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
225 (defvar ctl-x-5-map (make-sparse-keymap)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
226 "Keymap for frame commands.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
227 (fset 'ctl-x-5-prefix ctl-x-5-map)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
228 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
229
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
230
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
231 ;;;; Event manipulation functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
232
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
233 (defun listify-key-sequence (key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
234 "Convert a key sequence to a list of events."
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
235 (if (vectorp key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
236 (append key nil)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
237 (mapcar (function (lambda (c)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
238 (if (> c 127)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
239 (logxor c 8388736)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
240 c)))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
241 (append key nil))))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
242
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
243 (defsubst eventp (obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
244 "True if the argument is an event object."
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
245 (or (integerp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
246 (and (symbolp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
247 (get obj 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
248 (and (consp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
249 (symbolp (car obj))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
250 (get (car obj) 'event-symbol-elements))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
251
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
252 (defun event-modifiers (event)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
253 "Returns a list of symbols representing the modifier keys in event EVENT.
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
254 The elements of the list may include `meta', `control',
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
255 `shift', `hyper', `super', `alt'.
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
256 See also the function `event-modifier-bits'."
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
257 (let ((type event))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
258 (if (listp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
259 (setq type (car type)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
260 (if (symbolp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
261 (cdr (get type 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
262 (let ((list nil))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
263 (or (zerop (logand type (lsh 1 23)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
264 (setq list (cons 'meta list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
265 (or (and (zerop (logand type (lsh 1 22)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
266 (>= (logand type 127) 32))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
267 (setq list (cons 'control list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
268 (or (and (zerop (logand type (lsh 1 21)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
269 (= (logand type 255) (downcase (logand type 255))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
270 (setq list (cons 'shift list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
271 (or (zerop (logand type (lsh 1 20)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
272 (setq list (cons 'hyper list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
273 (or (zerop (logand type (lsh 1 19)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
274 (setq list (cons 'super list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
275 (or (zerop (logand type (lsh 1 18)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
276 (setq list (cons 'alt list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
277 list))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
278
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
279 (defun event-basic-type (event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
280 "Returns the basic type of the given event (all modifiers removed).
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
281 The value is an ASCII printing character (not upper case) or a symbol."
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
282 (if (symbolp event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
283 (car (get event 'event-symbol-elements))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
284 (let ((base (logand event (1- (lsh 1 18)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
285 (downcase (if (< base 32) (logior base 64) base)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
286
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
287 (defsubst mouse-movement-p (object)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
288 "Return non-nil if OBJECT is a mouse movement event."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
289 (and (consp object)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
290 (eq (car object) 'mouse-movement)))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
291
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
292 (defsubst event-start (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
293 "Return the starting position of EVENT.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
294 If EVENT is a mouse press or a mouse click, this returns the location
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
295 of the event.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
296 If EVENT is a drag, this returns the drag's starting position.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
297 The return value is of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
298 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
299 The `posn-' functions access elements of such lists."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
300 (nth 1 event))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
301
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
302 (defsubst event-end (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
303 "Return the ending location of EVENT. EVENT should be a click or drag event.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
304 If EVENT is a click event, this function is the same as `event-start'.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
305 The return value is of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
306 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
307 The `posn-' functions access elements of such lists."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
308 (nth (1- (length event)) event))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
309
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
310 (defsubst posn-window (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
311 "Return the window in POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
312 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
313 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
314 as returned by the `event-start' and `event-end' functions."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
315 (nth 0 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
316
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
317 (defsubst posn-point (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
318 "Return the buffer location in POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
319 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
320 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
321 as returned by the `event-start' and `event-end' functions."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
322 (nth 1 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
323
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
324 (defsubst posn-col-row (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
325 "Return the row and column in POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
326 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
327 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
328 as returned by the `event-start' and `event-end' functions."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
329 (nth 2 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
330
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
331 (defsubst posn-timestamp (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
332 "Return the timestamp of POSITION.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
333 POSITION should be a list of the form
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
334 (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
335 nas returned by the `event-start' and `event-end' functions."
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
336 (nth 3 position))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
337
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
338
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
339 ;;;; Overlay dissection functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
340
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
341 (defsubst overlay-start (overlay)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
342 "Return the position at which OVERLAY starts."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
343 (marker-position (car (car overlay))))
1130
e18597ff3c95 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1112
diff changeset
344
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
345 (defsubst overlay-end (overlay)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
346 "Return the position at which OVERLAY ends."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
347 (marker-position (cdr (car overlay))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
348
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
349 (defsubst overlay-buffer (overlay)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
350 "Return the buffer OVERLAY belongs to."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
351 (marker-buffer (overlay-start overlay)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
352
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
353
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
354 ;;;; Obsolescent names for functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
355
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
356 (fset 'make-syntax-table 'copy-syntax-table)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
357 (fset 'dot 'point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
358 (fset 'dot-marker 'point-marker)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
359 (fset 'dot-min 'point-min)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
360 (fset 'dot-max 'point-max)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
361 (fset 'window-dot 'window-point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
362 (fset 'set-window-dot 'set-window-point)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
363 (fset 'read-input 'read-string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
364 (fset 'send-string 'process-send-string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
365 (fset 'send-region 'process-send-region)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
366 (fset 'show-buffer 'set-window-buffer)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
367 (fset 'buffer-flush-undo 'buffer-disable-undo)
675
85fd29f25c75 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 668
diff changeset
368 (fset 'eval-current-buffer 'eval-buffer)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1695
diff changeset
369 (fset 'compiled-function-p 'byte-code-function-p)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
370
1867
4262f19c6cc9 * subr.el (mod): Add back this alias for %.
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
371 ;;; This name isn't mentioned in the manual, and we've been hoping to
4262f19c6cc9 * subr.el (mod): Add back this alias for %.
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
372 ;;; phase it out, but there's still a lot of code out there, even for
4262f19c6cc9 * subr.el (mod): Add back this alias for %.
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
373 ;;; Emacs 18.59, which uses mod. I'm going to let the byte compiler's
4262f19c6cc9 * subr.el (mod): Add back this alias for %.
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
374 ;;; make-obsolete function to poke people a little more, and leave the
4262f19c6cc9 * subr.el (mod): Add back this alias for %.
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
375 ;;; `mod' name around for a while longer.
4262f19c6cc9 * subr.el (mod): Add back this alias for %.
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
376 (fset 'mod '%)
4262f19c6cc9 * subr.el (mod): Add back this alias for %.
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
377
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
378 ;; Some programs still use this as a function.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
379 (defun baud-rate ()
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
380 "Obsolete function returning the value of the `baud-rate' variable."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
381 baud-rate)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
382
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
383
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
384 ;;;; Alternate names for functions - these are not being phased out.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
385
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
386 (fset 'string= 'string-equal)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
387 (fset 'string< 'string-lessp)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
388 (fset 'move-marker 'set-marker)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
389 (fset 'eql 'eq)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
390 (fset 'not 'null)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
391 (fset 'rplaca 'setcar)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
392 (fset 'rplacd 'setcdr)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
393 (fset 'beep 'ding) ;preserve lingual purtity
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
394 (fset 'indent-to-column 'indent-to)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
395 (fset 'backward-delete-char 'delete-backward-char)
353
38d331b3a0b8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 293
diff changeset
396 (fset 'search-forward-regexp (symbol-function 're-search-forward))
38d331b3a0b8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 293
diff changeset
397 (fset 'search-backward-regexp (symbol-function 're-search-backward))
2428
83319ce2d2f3 * subr.el (int-to-string): Make this an alias for the subr
Jim Blandy <jimb@redhat.com>
parents: 2383
diff changeset
398 (fset 'int-to-string 'number-to-string)
1903
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
399
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
400 ;;; Should this be an obsolete name? If you decide it should, you get
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
401 ;;; to go through all the sources and change them.
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
402 (fset 'string-to-int 'string-to-number)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
403
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
404 ;;;; Hook manipulation functions.
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
405
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
406 (defun run-hooks (&rest hooklist)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
407 "Takes hook names and runs each one in turn. Major mode functions use this.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
408 Each argument should be a symbol, a hook variable.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
409 These symbols are processed in the order specified.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
410 If a hook symbol has a non-nil value, that value may be a function
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
411 or a list of functions to be called to run the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
412 If the value is a function, it is called with no arguments.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
413 If it is a list, the elements are called, in order, with no arguments."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
414 (while hooklist
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
415 (let ((sym (car hooklist)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
416 (and (boundp sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
417 (symbol-value sym)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
418 (let ((value (symbol-value sym)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
419 (if (and (listp value) (not (eq (car value) 'lambda)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
420 (mapcar 'funcall value)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
421 (funcall value)))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
422 (setq hooklist (cdr hooklist))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
423
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
424 ;; Tell C code how to call this function.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
425 (defconst run-hooks 'run-hooks
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
426 "Variable by which C primitives find the function `run-hooks'.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
427 Don't change it.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
428
2383
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
429 (defun add-hook (hook function &optional append)
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
430 "Add to the value of HOOK the function FUNCTION unless already present (it
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
431 becomes the first hook on the list unless optional APPEND is non-nil, in
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
432 which case it becomes the last). HOOK should be a symbol, and FUNCTION may be
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
433 any valid function. HOOK's value should be a list of functions, not a single
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
434 function. If HOOK is void, it is first set to nil."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
435 (or (boundp hook) (set hook nil))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
436 (or (if (consp function)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
437 ;; Clever way to tell whether a given lambda-expression
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
438 ;; is equal to anything in the hook.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
439 (let ((tail (assoc (cdr function) (symbol-value hook))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
440 (equal function tail))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
441 (memq function (symbol-value hook)))
2383
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
442 (set hook
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
443 (if append
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
444 (nconc (symbol-value hook) (list function))
b7941d286c3f (add-hook) Added optional arg to cause hook to be appended rather than
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2071
diff changeset
445 (cons function (symbol-value hook))))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
446
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
447
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
448 ;;;; Specifying things to do after certain files are loaded.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
449
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
450 (defun eval-after-load (file form)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
451 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
452 This makes or adds to an entry on `after-load-alist'.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
453 FILE should be the name of a library, with no directory name."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
454 (or (assoc file after-load-alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
455 (setq after-load-alist (cons (list file) after-load-alist)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
456 (nconc (assoc file after-load-alist) (list form))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
457 form)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
458
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
459 (defun eval-next-after-load (file)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
460 "Read the following input sexp, and run it whenever FILE is loaded.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
461 This makes or adds to an entry on `after-load-alist'.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
462 FILE should be the name of a library, with no directory name."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
463 (eval-after-load file (read)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
464
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
465
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
466 ;;;; Input and display facilities.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
467
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
468 (defun read-quoted-char (&optional prompt)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
469 "Like `read-char', except that if the first character read is an octal
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
470 digit, we read up to two more octal digits and return the character
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
471 represented by the octal number consisting of those digits.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
472 Optional argument PROMPT specifies a string to use to prompt the user."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
473 (let ((count 0) (code 0) char)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
474 (while (< count 3)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
475 (let ((inhibit-quit (zerop count))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
476 (help-form nil))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
477 (and prompt (message "%s-" prompt))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
478 (setq char (read-char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
479 (if inhibit-quit (setq quit-flag nil)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
480 (cond ((null char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
481 ((and (<= ?0 char) (<= char ?7))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
482 (setq code (+ (* code 8) (- char ?0))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
483 count (1+ count))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
484 (and prompt (message (setq prompt
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
485 (format "%s %c" prompt char)))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
486 ((> count 0)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
487 (setq unread-command-events (list char) count 259))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
488 (t (setq code char count 259))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
489 (logand 255 code)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
490
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
491 (defun force-mode-line-update (&optional all)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
492 "Force the mode-line of the current buffer to be redisplayed.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
493 With optional non-nil ALL then force then force redisplay of all mode-lines."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
494 (if all (save-excursion (set-buffer (other-buffer))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
495 (set-buffer-modified-p (buffer-modified-p)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
496
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
497 (defun momentary-string-display (string pos &optional exit-char message)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
498 "Momentarily display STRING in the buffer at POS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
499 Display remains until next character is typed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
500 If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
501 otherwise it is then available as input (as a command if nothing else).
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
502 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
503 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
504 (or exit-char (setq exit-char ?\ ))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
505 (let ((buffer-read-only nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
506 (modified (buffer-modified-p))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
507 (name buffer-file-name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
508 insert-end)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
509 (unwind-protect
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
510 (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
511 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
512 (goto-char pos)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
513 ;; defeat file locking... don't try this at home, kids!
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
514 (setq buffer-file-name nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
515 (insert-before-markers string)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
516 (setq insert-end (point)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
517 (message (or message "Type %s to continue editing.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
518 (single-key-description exit-char))
2033
10cdd2928c7d (momentary-string-display): Handle any event when flushing the display.
Richard M. Stallman <rms@gnu.org>
parents: 2021
diff changeset
519 (let ((char (read-event)))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
520 (or (eq char exit-char)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1695
diff changeset
521 (setq unread-command-events (list char)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
522 (if insert-end
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
523 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
524 (delete-region pos insert-end)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
525 (setq buffer-file-name name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
526 (set-buffer-modified-p modified))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
527
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
528
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
529 ;;;; Miscellanea.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
530
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
531 (defun ignore (&rest ignore)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
532 "Do nothing.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
533 Accept any number of arguments, but ignore them."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
534 nil)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
535
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
536 (defun error (&rest args)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
537 "Signal an error, making error message by passing all args to `format'."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
538 (while t
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
539 (signal 'error (list (apply 'format args)))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
540
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
541 (defun user-original-login-name ()
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
542 "Return user's login name from original login.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
543 This tries to remain unaffected by `su', by looking in environment variables."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
544 (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
545
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
546 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
547 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
548 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
549 NAME is name for process. It is modified if necessary to make it unique.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
550 BUFFER is the buffer or (buffer-name) to associate with the process.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
551 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
552 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
553 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
554 with any buffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
555 Third arg is command name, the name of a shell command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
556 Remaining arguments are the arguments for the command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
557 Wildcards and redirection are handle as usual in the shell."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
558 (if (eq system-type 'vax-vms)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
559 (apply 'start-process name buffer args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
560 (start-process name buffer shell-file-name "-c"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
561 (concat "exec " (mapconcat 'identity args " ")))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
562
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
563 (defmacro save-match-data (&rest body)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
564 "Execute the BODY forms, restoring the global value of the match data."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
565 (let ((original (make-symbol "match-data")))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
566 (list
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
567 'let (list (list original '(match-data)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
568 (list 'unwind-protect
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
569 (cons 'progn body)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
570 (list 'store-match-data original)))))
144
535ec1aa78ef *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 114
diff changeset
571
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
572 ;; now in fns.c
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
573 ;(defun nth (n list)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
574 ; "Returns the Nth element of LIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
575 ;N counts from zero. If LIST is not that long, nil is returned."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
576 ; (car (nthcdr n list)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
577 ;
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
578 ;(defun copy-alist (alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
579 ; "Return a copy of ALIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
580 ;This is a new alist which represents the same mapping
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
581 ;from objects to objects, but does not share the alist structure with ALIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
582 ;The objects mapped (cars and cdrs of elements of the alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
583 ;are shared, however."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
584 ; (setq alist (copy-sequence alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
585 ; (let ((tail alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
586 ; (while tail
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
587 ; (if (consp (car tail))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
588 ; (setcar tail (cons (car (car tail)) (cdr (car tail)))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
589 ; (setq tail (cdr tail))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
590 ; alist)
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
591
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
592 ;;; subr.el ends here
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
593