Commit ffd56f97 authored by Jim Blandy's avatar Jim Blandy

*** empty log message ***

parent 502ddf23
;;; Maintain autoloads in loaddefs.el.
;;; Copyright (C) 1991 Free Software Foundation, Inc.
;;; Copyright (C) 1991, 1992 Free Software Foundation, Inc.
;;; Written by Roland McGrath.
;;;
;;; This program is free software; you can redistribute it and/or modify
......@@ -267,7 +267,7 @@ file \"%s\") doesn't exist. Remove its autoload section? "
Runs \\[update-file-autoloads] on files and \\[update-directory-autoloads]
on directories. Must be used only with -batch, and kills Emacs on completion.
Each file will be processed even if an error occurred previously.
For example, invoke \"emacs -batch -f batch-byte-compile *.el\""
For example, invoke \"emacs -batch -f batch-update-autoloads *.el\""
(if (not noninteractive)
(error "batch-update-file-autoloads is to be used only with -batch"))
(let ((lost nil)
......@@ -288,3 +288,4 @@ For example, invoke \"emacs -batch -f batch-byte-compile *.el\""
(kill-emacs (if lost 1 0))))
(provide 'autoload)
......@@ -18,6 +18,8 @@
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; We don't want to have any undo records in the dumped Emacs.
(buffer-disable-undo "*scratch*")
(load "subr")
(load "map-ynp")
......@@ -107,6 +109,9 @@
(load "site-init" t)
(garbage-collect)
;;; At this point, we're ready to resume undo recording for scratch.
(buffer-enable-undo "*scratch*")
(if (or (equal (nth 3 command-line-args) "dump")
(equal (nth 4 command-line-args) "dump"))
(if (eq system-type 'vax-vms)
......
......@@ -115,11 +115,17 @@ directory name of the directory where the `.emacs' file was looked for.")
(message "Back to top level.")
(setq command-line-processed t)
;; In presence of symlinks, switch to cleaner form of default directory.
(if (and (not (eq system-type 'vax-vms))
(getenv "PWD")
(equal (nthcdr 10 (file-attributes default-directory))
(nthcdr 10 (file-attributes (getenv "PWD")))))
(setq default-directory (file-name-as-directory (getenv "PWD"))))
(if (not (eq system-type 'vax-vms))
(mapcar (function
(lambda (var)
(let ((value (getev var)))
(if (and value
(< (length value) (length default-directory))
(equal (file-attributes default-directory)
(file-attributes value)))
(setq default-directory
(file-name-as-directory value))))))
'("PWD" "HOME")))
(let ((tail directory-abbrev-alist))
(while tail
(if (string-match (car (car tail)) default-directory)
......
......@@ -340,3 +340,7 @@ and then modifies one entry in it."
(setq i (1+ i)))
(setq keyboard-translate-table table)))
(aset keyboard-translate-table from to))
(defmacro lambda (&rest cdr)
(` (function (lambda (,@ cdr)))))
......@@ -91,6 +91,7 @@ end
define xcons
print (struct Lisp_Cons *) ($ & 0x00ffffff)
print *$
print $$
end
document xcons
Print the contents of $, assuming it is an Elisp cons.
......
......@@ -1077,15 +1077,21 @@ Garbage collection happens automatically if you cons more than\n\
tem = Fnthcdr (make_number (30), Vcommand_history);
if (CONSP (tem))
XCONS (tem)->cdr = Qnil;
/* Likewise for undo information. */
{
register struct buffer *nextb = all_buffers;
while (nextb)
{
nextb->undo_list
= truncate_undo_list (nextb->undo_list, undo_threshold,
undo_high_threshold);
/* If a buffer's undo list is Qt, that means that undo is
turned off in that buffer. Calling truncate_undo_list on
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
if (! EQ (nextb->undo_list, Qt))
nextb->undo_list
= truncate_undo_list (nextb->undo_list, undo_threshold,
undo_high_threshold);
nextb = nextb->next;
}
}
......
......@@ -558,11 +558,22 @@ If BUFFER is omitted or nil, some interesting buffer is returned.")
DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 1,1,
0,
"Make BUFFER stop keeping undo information.")
(buf)
register Lisp_Object buf;
(buffer)
register Lisp_Object buffer;
{
CHECK_BUFFER (buf, 0);
XBUFFER (buf)->undo_list = Qt;
Lisp_Object real_buffer;
if (NILP (buffer))
XSET (real_buffer, Lisp_Buffer, current_buffer);
else
{
real_buffer = Fget_buffer (buffer);
if (NILP (real_buffer))
nsberror (buffer);
}
XBUFFER (real_buffer)->undo_list = Qt;
return Qnil;
}
......@@ -570,23 +581,22 @@ DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
0, 1, "",
"Start keeping undo information for buffer BUFFER.\n\
No argument or nil as argument means do this for the current buffer.")
(buf)
register Lisp_Object buf;
(buffer)
register Lisp_Object buffer;
{
register struct buffer *b;
register Lisp_Object buf1;
Lisp_Object real_buffer;
if (NILP (buf))
b = current_buffer;
if (NILP (buffer))
XSET (real_buffer, Lisp_Buffer, current_buffer);
else
{
buf1 = Fget_buffer (buf);
if (NILP (buf1)) nsberror (buf);
b = XBUFFER (buf1);
real_buffer = Fget_buffer (buffer);
if (NILP (real_buffer))
nsberror (buffer);
}
if (EQ (b->undo_list, Qt))
b->undo_list = Qnil;
if (EQ (XBUFFER (real_buffer)->undo_list, Qt))
XBUFFER (real_buffer)->undo_list = Qnil;
return Qnil;
}
......@@ -1285,10 +1295,7 @@ init_buffer_once ()
/* super-magic invisible buffer */
Vbuffer_alist = Qnil;
tem = Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
/* Want no undo records for *scratch*
until after Emacs is dumped */
Fbuffer_disable_undo (tem);
Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
}
init_buffer ()
......
......@@ -179,12 +179,7 @@ Otherwise, this is done only if an arg is read using the minibuffer.")
retry:
for (fun = function;
XTYPE (fun) == Lisp_Symbol && !EQ (fun, Qunbound);
fun = XSYMBOL (fun)->function)
{
QUIT;
}
fun = indirect_function (function);
specs = Qnil;
string = 0;
......
......@@ -125,25 +125,29 @@ If you quit, the process is killed with SIGKILL.")
CHECK_STRING (infile, 1);
}
else
#ifdef VMS
infile = build_string ("NLA0:");
#else
infile = build_string ("/dev/null");
#endif /* not VMS */
{
register Lisp_Object tem;
if (nargs < 3)
buffer = Qnil;
else
{
buffer = tem = args[2];
if (!(EQ (tem, Qnil) || EQ (tem, Qt)
|| XFASTINT (tem) == 0))
{
buffer = Fget_buffer (tem);
CHECK_BUFFER (buffer, 2);
}
}
}
if (nargs >= 3)
{
register Lisp_Object tem;
buffer = tem = args[2];
if (!(EQ (tem, Qnil)
|| EQ (tem, Qt)
|| XFASTINT (tem) == 0))
{
buffer = Fget_buffer (tem);
CHECK_BUFFER (buffer, 2);
}
}
else
buffer = Qnil;
display = nargs >= 3 ? args[3] : Qnil;
display = nargs >= 4 ? args[3] : Qnil;
{
register int i;
......
......@@ -37,7 +37,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
Lisp_Object Qvoid_variable, Qvoid_function;
Lisp_Object Qvoid_variable, Qvoid_function, Qcyclic_function_indirection;
Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
Lisp_Object Qend_of_file, Qarith_error;
......@@ -480,13 +480,13 @@ DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's functi
DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
"Return SYMBOL's function definition. Error if that is void.")
(sym)
register Lisp_Object sym;
(symbol)
register Lisp_Object symbol;
{
CHECK_SYMBOL (sym, 0);
if (EQ (XSYMBOL (sym)->function, Qunbound))
return Fsignal (Qvoid_function, Fcons (sym, Qnil));
return XSYMBOL (sym)->function;
CHECK_SYMBOL (symbol, 0);
if (EQ (XSYMBOL (symbol)->function, Qunbound))
return Fsignal (Qvoid_function, Fcons (symbol, Qnil));
return XSYMBOL (symbol)->function;
}
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.")
......@@ -530,6 +530,7 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
XSYMBOL (sym)->plist = newplist;
return newplist;
}
/* Getting and setting values of symbols */
......@@ -1094,6 +1095,61 @@ From now on the default value will apply in this buffer.")
return sym;
}
/* Find the function at the end of a chain of symbol function indirections. */
/* If OBJECT is a symbol, find the end of its function chain and
return the value found there. If OBJECT is not a symbol, just
return it. If there is a cycle in the function chain, signal a
cyclic-function-indirection error.
This is like Findirect_function, except that it doesn't signal an
error if the chain ends up unbound. */
Lisp_Object
indirect_function (object, error)
register Lisp_Object object;
{
Lisp_Object tortise, hare;
hare = tortise = object;
for (;;)
{
if (XTYPE (hare) != Lisp_Symbol || EQ (hare, Qunbound))
break;
hare = XSYMBOL (hare)->function;
if (XTYPE (hare) != Lisp_Symbol || EQ (hare, Qunbound))
break;
hare = XSYMBOL (hare)->function;
tortise = XSYMBOL (tortise)->function;
if (EQ (hare, tortise))
Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil));
}
return hare;
}
DEFUN ("indirect-function", Findirect_function, Sindirect_function, 1, 1, 0,
"Return the function at the end of OBJECT's function chain.\n\
If OBJECT is a symbol, follow all function indirections and return the final\n\
function binding.\n\
If OBJECT is not a symbol, just return it.\n\
Signal a void-function error if the final symbol is unbound.\n\
Signal a cyclic-function-indirection error if there is a loop in the\n\
function chain of symbols.")
(object)
register Lisp_Object object;
{
Lisp_Object result;
result = indirect_function (object);
if (EQ (result, Qunbound))
return Fsignal (Qvoid_function, Fcons (object, Qnil));
return result;
}
/* Extract and set vector and string elements */
DEFUN ("aref", Faref, Saref, 2, 2, 0,
......@@ -1698,6 +1754,7 @@ syms_of_data ()
Qwrong_type_argument = intern ("wrong-type-argument");
Qargs_out_of_range = intern ("args-out-of-range");
Qvoid_function = intern ("void-function");
Qcyclic_function_indirection = intern ("cyclic-function-indirection");
Qvoid_variable = intern ("void-variable");
Qsetting_constant = intern ("setting-constant");
Qinvalid_read_syntax = intern ("invalid-read-syntax");
......@@ -1762,6 +1819,11 @@ syms_of_data ()
Fput (Qvoid_function, Qerror_message,
build_string ("Symbol's function definition is void"));
Fput (Qcyclic_function_indirection, Qerror_conditions,
Fcons (Qcyclic_function_indirection, Fcons (Qerror, Qnil)));
Fput (Qcyclic_function_indirection, Qerror_message,
build_string ("Symbol's chain of function indirections contains a loop"));
Fput (Qvoid_variable, Qerror_conditions,
Fcons (Qvoid_variable, Fcons (Qerror, Qnil)));
Fput (Qvoid_variable, Qerror_message,
......@@ -1832,6 +1894,7 @@ syms_of_data ()
staticpro (&Qwrong_type_argument);
staticpro (&Qargs_out_of_range);
staticpro (&Qvoid_function);
staticpro (&Qcyclic_function_indirection);
staticpro (&Qvoid_variable);
staticpro (&Qsetting_constant);
staticpro (&Qinvalid_read_syntax);
......@@ -1898,6 +1961,7 @@ syms_of_data ()
defsubr (&Ssetcar);
defsubr (&Ssetcdr);
defsubr (&Ssymbol_function);
defsubr (&Sindirect_function);
defsubr (&Ssymbol_plist);
defsubr (&Ssymbol_name);
defsubr (&Smakunbound);
......
......@@ -680,7 +680,32 @@ Both arguments are required.")
}
/* Return a string with the contents of the current region */
/* Making strings from buffer contents. */
/* Return a Lisp_String containing the text of the current buffer from
START to END.
We don't want to use plain old make_string here, because it calls
make_uninit_string, which can cause the buffer arena to be
compacted. make_string has no way of knowing that the data has
been moved, and thus copies the wrong data into the string. This
doesn't effect most of the other users of make_string, so it should
be left as is. But we should use this function when conjuring
buffer substrings. */
Lisp_Object
make_buffer_string (start, end)
int start, end;
{
Lisp_Object result;
if (start < GPT && GPT < end)
move_gap (start);
result = make_uninit_string (end - start);
bcopy (&FETCH_CHAR (start), XSTRING (result)->data, end - start);
return result;
}
DEFUN ("buffer-substring", Fbuffer_substring, Sbuffer_substring, 2, 2, 0,
"Return the contents of part of the current buffer as a string.\n\
......@@ -690,33 +715,19 @@ they can be in either order.")
Lisp_Object b, e;
{
register int beg, end;
Lisp_Object result;
validate_region (&b, &e);
beg = XINT (b);
end = XINT (e);
if (beg < GPT && end > GPT)
move_gap (beg);
/* Plain old make_string calls make_uninit_string, which can cause
the buffer arena to be compacted. make_string has no way of
knowing that the data has been moved, and thus copies the wrong
data into the string. This doesn't effect most of the other
users of make_string, so it should be left as is. */
result = make_uninit_string (end - beg);
bcopy (&FETCH_CHAR (beg), XSTRING (result)->data, end - beg);
return result;
return make_buffer_string (beg, end);
}
DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
"Return the contents of the current buffer as a string.")
()
{
if (BEGV < GPT && ZV > GPT)
move_gap (BEGV);
return make_string (BEGV_ADDR, ZV - BEGV);
return make_buffer_string (BEGV, ZV);
}
DEFUN ("insert-buffer-substring", Finsert_buffer_substring, Sinsert_buffer_substring,
......
......@@ -465,12 +465,7 @@ and input is currently coming from the keyboard (not in keyboard macro).")
that DOES eval its args.
If it is a built-in function (such as load or eval-region)
return nil. */
fun = *btp->function;
while (XTYPE (fun) == Lisp_Symbol)
{
QUIT;
fun = Fsymbol_function (fun);
}
fun = Findirect_function (*btp->function);
if (XTYPE (fun) == Lisp_Subr)
return Qnil;
/* btp points to the frame of a Lisp function that called interactive-p.
......@@ -1206,14 +1201,9 @@ Also, a symbol satisfies `commandp' if its function definition does so.")
fun = function;
/* Dereference symbols, but avoid infinte loops. Eech. */
while (XTYPE (fun) == Lisp_Symbol)
{
if (++i > 10) return Qnil;
tem = Ffboundp (fun);
if (NILP (tem)) return Qnil;
fun = Fsymbol_function (fun);
}
fun = indirect_function (fun);
if (EQ (fun, Qunbound))
return Qnil;
/* Emacs primitives are interactive if their DEFUN specifies an
interactive spec. */
......@@ -1333,14 +1323,8 @@ do_autoload (fundef, funname)
Vautoload_queue = Qt;
unbind_to (count, Qnil);
while (XTYPE (fun) == Lisp_Symbol)
{
QUIT;
val = XSYMBOL (fun)->function;
if (EQ (val, Qunbound))
Fsymbol_function (fun); /* Get the right kind of error! */
fun = val;
}
fun = Findirect_function (fun);
if (XTYPE (fun) == Lisp_Cons
&& EQ (XCONS (fun)->car, Qautoload))
error ("Autoloading failed to define function %s",
......@@ -1404,15 +1388,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
/* At this point, only original_fun and original_args
have values that will be used below */
retry:
fun = original_fun;
while (XTYPE (fun) == Lisp_Symbol)
{
QUIT;
val = XSYMBOL (fun)->function;
if (EQ (val, Qunbound))
Fsymbol_function (fun); /* Get the right kind of error! */
fun = val;
}
fun = Findirect_function (original_fun);
if (XTYPE (fun) == Lisp_Subr)
{
......@@ -1582,16 +1558,12 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
numargs += nargs - 2;
while (XTYPE (fun) == Lisp_Symbol)
fun = indirect_function (fun);
if (EQ (fun, Qunbound))
{
QUIT;
fun = XSYMBOL (fun)->function;
if (EQ (fun, Qunbound))
{
/* Let funcall get the error */
fun = args[0];
goto funcall;
}
/* Let funcall get the error */
fun = args[0];
goto funcall;
}
if (XTYPE (fun) == Lisp_Subr)
......@@ -1779,14 +1751,8 @@ Thus, (funcall 'cons 'x 'y) returns (x . y).")
retry:
fun = args[0];
while (XTYPE (fun) == Lisp_Symbol)
{
QUIT;
val = XSYMBOL (fun)->function;
if (EQ (val, Qunbound))
Fsymbol_function (fun); /* Get the right kind of error! */
fun = val;
}
fun = Findirect_function (fun);
if (XTYPE (fun) == Lisp_Subr)
{
......
......@@ -17,6 +17,7 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
#include "config.h"
#include <sys/types.h>
#include <sys/stat.h>
......@@ -52,7 +53,6 @@ extern int sys_nerr;
#include <sys/time.h>
#endif
#include "config.h"
#include "lisp.h"
#include "buffer.h"
#include "window.h"
......
......@@ -43,6 +43,7 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
#include "syssignal.h"
#include "systerm.h"
#include "systime.h"
extern int errno;
......@@ -311,8 +312,9 @@ Lisp_Object Qmode_line;
Lisp_Object Qvertical_split;
/* Address (if not 0) of word to zero out if a SIGIO interrupt happens. */
long *input_available_clear_word;
/* Address (if not 0) of EMACS_TIME to zero out if a SIGIO interrupt
happens. */
EMACS_TIME *input_available_clear_time;
/* Nonzero means use SIGIO interrupts; zero means use CBREAK mode.
Default is 1 if INTERRUPT_INPUT is defined. */
......@@ -1160,8 +1162,7 @@ read_char (commandflag)
XSET (Vlast_event_screen, Lisp_Screen, selected_screen);
#endif
waiting_for_input = 0;
input_available_clear_word = 0;
clear_waiting_for_input ();
goto non_reread;
}
......@@ -1491,7 +1492,7 @@ kbd_buffer_store_event (event)
will set Vlast_event_screen again, so this is safe to do. */
extern SIGTYPE interrupt_signal ();
XSET (Vlast_event_screen, Lisp_Screen, event->screen);
last_event_timestamp = XINT (event->timestamp);
last_event_timestamp = event->timestamp;
interrupt_signal ();
return;
}
......@@ -2237,8 +2238,8 @@ input_available_signal (signo)
sigisheld (SIGIO);
#endif
if (input_available_clear_word)
*input_available_clear_word = 0;
if (input_available_clear_time)
EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
while (1)
{
......@@ -2793,13 +2794,7 @@ Otherwise, that is done only if an arg is read using the minibuffer.")
while (1)
{
final = cmd;
while (XTYPE (final) == Lisp_Symbol)
{
if (EQ (Qunbound, XSYMBOL (final)->function))
Fsymbol_function (final); /* Get an error! */
final = XSYMBOL (final)->function;
}
final = Findirect_function (cmd);
if (CONSP (final) && (tem = Fcar (final), EQ (tem, Qautoload)))
do_autoload (final, cmd);
......@@ -3012,6 +3007,14 @@ detect_input_pending ()
return input_pending;
}
/* This is called in some cases before a possible quit.
It cases the next call to detect_input_pending to recompute input_pending.
So calling this function unnecessarily can't do any harm. */
clear_input_pending ()
{
input_pending = 0;
}
DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0,
"T if command input is currently available with no waiting.\n\
Actually, the value is nil only if we can be sure that no input is available.")
......@@ -3194,10 +3197,10 @@ stuff_buffered_input (stuffstring)
#endif /* BSD and not BSD4_1 */
}
set_waiting_for_input (word_to_clear)
long *word_to_clear;
set_waiting_for_input (time_to_clear)
EMACS_TIME *time_to_clear;
{
input_available_clear_word = word_to_clear;
input_available_clear_time = time_to_clear;
/* Tell interrupt_signal to throw back to read_char, */
waiting_for_input = 1;
......@@ -3219,7 +3222,7 @@ clear_waiting_for_input ()
{
/* Tell interrupt_signal not to throw back to read_char, */
waiting_for_input = 0;
input_available_clear_word = 0;
input_available_clear_time = 0;