aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorJim Blandy1991-05-23 23:18:53 +0000
committerJim Blandy1991-05-23 23:18:53 +0000
commitf927c5aedf17f6c37acc624fda99aef0f31f1a19 (patch)
tree6e47fbf512e0bd16e7bab3a0cbad046dc319488d /src
parent8c73a61a2031822d4342d37d5156fdf84b9f2ee3 (diff)
downloademacs-f927c5aedf17f6c37acc624fda99aef0f31f1a19.tar.gz
emacs-f927c5aedf17f6c37acc624fda99aef0f31f1a19.zip
Initial revision
Diffstat (limited to 'src')
-rw-r--r--src/emacs.c751
-rw-r--r--src/minibuf.c1261
2 files changed, 2012 insertions, 0 deletions
diff --git a/src/emacs.c b/src/emacs.c
new file mode 100644
index 00000000000..0d6aa206590
--- /dev/null
+++ b/src/emacs.c
@@ -0,0 +1,751 @@
1/* Fully extensible Emacs, running on Unix, intended for GNU.
2 Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21#include <signal.h>
22#include <errno.h>
23
24#include "config.h"
25#include <stdio.h>
26
27#include <sys/types.h>
28#include <sys/file.h>
29
30#ifdef VMS
31#include <ssdef.h>
32#endif
33
34#ifdef USG5
35#include <fcntl.h>
36#endif
37
38#ifdef BSD
39#include <sys/ioctl.h>
40#endif
41
42#ifdef APOLLO
43#ifndef APOLLO_SR10
44#include <default_acl.h>
45#endif
46#endif
47
48#undef NULL
49#include "lisp.h"
50#include "commands.h"
51
52#ifndef O_RDWR
53#define O_RDWR 2
54#endif
55
56#define PRIO_PROCESS 0
57
58/* Command line args from shell, as list of strings */
59Lisp_Object Vcommand_line_args;
60
61/* Set nonzero after Emacs has started up the first time.
62 Prevents reinitialization of the Lisp world and keymaps
63 on subsequent starts. */
64int initialized;
65
66/* Variable whose value is symbol giving operating system type */
67Lisp_Object Vsystem_type;
68
69/* If non-zero, emacs should not attempt to use an window-specific code,
70 but instead should use the virtual terminal under which it was started */
71int inhibit_window_system;
72
73#ifdef HAVE_X_WINDOWS
74/* If non-zero, -d was specified, meaning we're using some window system. */
75int display_arg;
76#endif
77
78/* An address near the bottom of the stack.
79 Tells GC how to save a copy of the stack. */
80char *stack_bottom;
81
82#ifdef HAVE_X_WINDOWS
83extern Lisp_Object Vwindow_system;
84#endif /* HAVE_X_WINDOWS */
85
86#ifdef USG_SHARED_LIBRARIES
87/* If nonzero, this is the place to put the end of the writable segment
88 at startup. */
89
90unsigned int bss_end = 0;
91#endif
92
93/* Nonzero means running Emacs without interactive terminal. */
94
95int noninteractive;
96
97/* Value of Lisp variable `noninteractive'.
98 Normally same as C variable `noninteractive'
99 but nothing terrible happens if user sets this one. */
100
101int noninteractive1;
102
103/* Signal code for the fatal signal that was received */
104int fatal_error_code;
105
106/* Nonzero if handling a fatal error already */
107int fatal_error_in_progress;
108
109/* Handle bus errors, illegal instruction, etc. */
110fatal_error_signal (sig)
111 int sig;
112{
113#ifdef BSD
114 int tpgrp;
115#endif /* BSD */
116
117 fatal_error_code = sig;
118 signal (sig, SIG_DFL);
119
120 /* If fatal error occurs in code below, avoid infinite recursion. */
121 if (fatal_error_in_progress)
122 kill (getpid (), fatal_error_code);
123
124 fatal_error_in_progress = 1;
125
126 /* If we are controlling the terminal, reset terminal modes */
127#ifdef BSD
128 if (ioctl(0, TIOCGPGRP, &tpgrp) == 0
129 && tpgrp == getpgrp (0))
130#endif /* BSD */
131 {
132 reset_sys_modes ();
133 if (sig != SIGTERM)
134 fprintf (stderr, "Fatal error (%d).", sig);
135 }
136
137 /* Clean up */
138#ifdef subprocesses
139 kill_buffer_processes (Qnil);
140#endif
141 Fdo_auto_save (Qt, Qnil);
142
143#ifdef CLASH_DETECTION
144 unlock_all_files ();
145#endif /* CLASH_DETECTION */
146
147#ifdef VMS
148 kill_vms_processes ();
149 LIB$STOP (SS$_ABORT);
150#else
151 /* Signal the same code; this time it will really be fatal. */
152 kill (getpid (), fatal_error_code);
153#endif /* not VMS */
154}
155
156/* Code for dealing with Lisp access to the Unix command line */
157
158static
159init_cmdargs (argc, argv, skip_args)
160 int argc;
161 char **argv;
162 int skip_args;
163{
164 register int i;
165
166 Vcommand_line_args = Qnil;
167
168 for (i = argc - 1; i >= 0; i--)
169 {
170 if (i == 0 || i > skip_args)
171 Vcommand_line_args
172 = Fcons (build_string (argv[i]), Vcommand_line_args);
173 }
174}
175
176#ifdef VMS
177#ifdef LINK_CRTL_SHARE
178#ifdef SHAREABLE_LIB_BUG
179extern noshare char **environ;
180#endif /* SHAREABLE_LIB_BUG */
181#endif /* LINK_CRTL_SHARE */
182#endif /* VMS */
183
184/* ARGSUSED */
185main (argc, argv, envp)
186 int argc;
187 char **argv;
188 char **envp;
189{
190 char stack_bottom_variable;
191 int skip_args = 0;
192 extern int errno;
193 extern sys_nerr;
194 extern char *sys_errlist[];
195 extern void malloc_warning ();
196
197/* Map in shared memory, if we are using that. */
198#ifdef HAVE_SHM
199 if (argc > 1 && !strcmp (argv[1], "-nl"))
200 {
201 map_in_data (0);
202 /* The shared memory was just restored, which clobbered this. */
203 skip_args = 1;
204 }
205 else
206 {
207 map_in_data (1);
208 /* The shared memory was just restored, which clobbered this. */
209 skip_args = 0;
210 }
211#endif
212
213#ifdef HAVE_X_WINDOWS
214 /* Stupid kludge to catch command-line display spec. ask jla */
215 {
216 int i;
217
218 for (i = 1; (i < argc && ! display_arg); i++)
219 if (!strcmp (argv[i], "-d"))
220 display_arg = 1;
221 }
222#endif
223
224#ifdef VMS
225 /* If -map specified, map the data file in */
226 if (argc > 2 && ! strcmp (argv[1], "-map"))
227 {
228 skip_args = 2;
229 mapin_data (argv[2]);
230 }
231
232#ifdef LINK_CRTL_SHARE
233#ifdef SHAREABLE_LIB_BUG
234 /* Bletcherous shared libraries! */
235 if (!stdin)
236 stdin = fdopen (0, "r");
237 if (!stdout)
238 stdout = fdopen (1, "w");
239 if (!stderr)
240 stderr = fdopen (2, "w");
241 if (!environ)
242 environ = envp;
243#endif /* SHAREABLE_LIB_BUG */
244#endif /* LINK_CRTL_SHARE */
245#endif /* VMS */
246
247 /* Record (approximately) where the stack begins. */
248 stack_bottom = &stack_bottom_variable;
249
250#ifdef RUN_TIME_REMAP
251 if (initialized)
252 run_time_remap (argv[0]);
253#endif
254
255#ifdef USG_SHARED_LIBRARIES
256 if (bss_end)
257 brk (bss_end);
258#endif
259
260 clearerr (stdin);
261#ifdef BSD
262 setpgrp (0, getpid ());
263#endif
264
265#ifdef APOLLO
266#ifndef APOLLO_SR10
267 /* If USE_DOMAIN_ACLS environment variable exists,
268 use ACLs rather than UNIX modes. */
269 if (egetenv ("USE_DOMAIN_ACLS"))
270 default_acl (USE_DEFACL);
271#endif
272#endif /* APOLLO */
273
274#ifndef SYSTEM_MALLOC
275 if (! initialized)
276 malloc_init (0, malloc_warning);
277#endif /* not SYSTEM_MALLOC */
278
279#ifdef HIGHPRI
280 setpriority (PRIO_PROCESS, getpid (), HIGHPRI);
281 setuid (getuid ());
282#endif /* HIGHPRI */
283
284#ifdef BSD
285 /* interrupt_input has trouble if we aren't in a separate process group. */
286 setpgrp (getpid (), getpid ());
287#endif
288
289 inhibit_window_system = 0;
290
291/* Handle the -t switch, which specifies filename to use as terminal */
292 if (skip_args + 2 < argc && !strcmp (argv[skip_args + 1], "-t"))
293 {
294 int result;
295 skip_args += 2;
296 close (0);
297 close (1);
298 result = open (argv[skip_args], O_RDWR, 2 );
299 if (result < 0)
300 {
301 char *errstring;
302
303 if (errno >= 0 && errno < sys_nerr)
304 errstring = sys_errlist[errno];
305 else
306 errstring = "undocumented error code";
307 fprintf (stderr, "emacs: %s: %s\n", argv[skip_args], errstring);
308 exit (1);
309 }
310 dup (0);
311 if (! isatty (0))
312 {
313 fprintf (stderr, "emacs: %s: not a tty\n", argv[skip_args]);
314 exit (1);
315 }
316 fprintf (stderr, "Using %s\n", argv[skip_args]);
317#ifdef HAVE_X_WINDOWS
318 inhibit_window_system = 1; /* -t => -nw */
319#endif
320 }
321
322 if (skip_args + 1 < argc
323 && (!strcmp (argv[skip_args + 1], "-nw")))
324 {
325 skip_args += 1;
326 inhibit_window_system = 1;
327 }
328
329/* Handle the -batch switch, which means don't do interactive display. */
330 noninteractive = 0;
331 if (skip_args + 1 < argc && !strcmp (argv[skip_args + 1], "-batch"))
332 {
333 skip_args += 1;
334 noninteractive = 1;
335 }
336
337 if (
338#ifndef CANNOT_DUMP
339 ! noninteractive || initialized
340#else
341 1
342#endif
343 )
344 {
345 /* Don't catch these signals in batch mode if not initialized.
346 On some machines, this sets static data that would make
347 signal fail to work right when the dumped Emacs is run. */
348 signal (SIGHUP, fatal_error_signal);
349 signal (SIGQUIT, fatal_error_signal);
350 signal (SIGILL, fatal_error_signal);
351 signal (SIGTRAP, fatal_error_signal);
352 signal (SIGIOT, fatal_error_signal);
353#ifdef SIGEMT
354 signal (SIGEMT, fatal_error_signal);
355#endif
356 signal (SIGFPE, fatal_error_signal);
357 signal (SIGBUS, fatal_error_signal);
358 signal (SIGSEGV, fatal_error_signal);
359 signal (SIGSYS, fatal_error_signal);
360 signal (SIGTERM, fatal_error_signal);
361#ifdef SIGXCPU
362 signal (SIGXCPU, fatal_error_signal);
363#endif
364#ifdef SIGXFSZ
365 signal (SIGXFSZ, fatal_error_signal);
366#endif /* SIGXFSZ */
367
368#ifdef AIX
369 signal (SIGDANGER, fatal_error_signal);
370 signal (20, fatal_error_signal);
371 signal (21, fatal_error_signal);
372 signal (22, fatal_error_signal);
373 signal (23, fatal_error_signal);
374 signal (24, fatal_error_signal);
375 signal (SIGAIO, fatal_error_signal);
376 signal (SIGPTY, fatal_error_signal);
377 signal (SIGIOINT, fatal_error_signal);
378 signal (SIGGRANT, fatal_error_signal);
379 signal (SIGRETRACT, fatal_error_signal);
380 signal (SIGSOUND, fatal_error_signal);
381 signal (SIGMSG, fatal_error_signal);
382#endif /* AIX */
383 }
384
385 noninteractive1 = noninteractive;
386
387/* Perform basic initializations (not merely interning symbols) */
388
389 if (!initialized)
390 {
391 init_alloc_once ();
392 init_obarray ();
393 init_eval_once ();
394 init_syntax_once (); /* Create standard syntax table. */
395 /* Must be done before init_buffer */
396 init_casetab_once ();
397 init_buffer_once (); /* Create buffer table and some buffers */
398 init_minibuf_once (); /* Create list of minibuffers */
399 /* Must precede init_window_once */
400 init_window_once (); /* Init the window system */
401 }
402
403 init_alloc ();
404#ifdef MAINTAIN_ENVIRONMENT
405 init_environ ();
406#endif
407 init_eval ();
408 init_data ();
409 init_read ();
410
411 init_cmdargs (argc, argv, skip_args); /* Create list Vcommand_line_args */
412 init_buffer (); /* Init default directory of main buffer */
413 if (!noninteractive)
414 {
415#ifdef VMS
416 init_vms_input ();/* init_display calls get_screen_size, that needs this */
417#endif /* VMS */
418 init_display (); /* Determine terminal type. init_sys_modes uses results */
419 }
420 init_keyboard (); /* This too must precede init_sys_modes */
421 init_callproc (); /* And this too. */
422#ifdef VMS
423 init_vmsproc (); /* And this too. */
424#endif /* VMS */
425 init_sys_modes (); /* Init system terminal modes (RAW or CBREAK, etc.) */
426 init_xdisp ();
427 init_macros ();
428 init_editfns ();
429#ifdef LISP_FLOAT_TYPE
430 init_floatfns ();
431#endif
432#ifdef VMS
433 init_vmsfns ();
434#endif /* VMS */
435#ifdef subprocesses
436 init_process ();
437#endif /* subprocesses */
438
439/* Intern the names of all standard functions and variables; define standard keys */
440
441 if (!initialized)
442 {
443 /* The basic levels of Lisp must come first */
444 /* And data must come first of all
445 for the sake of symbols like error-message */
446 syms_of_data ();
447 syms_of_alloc ();
448#ifdef MAINTAIN_ENVIRONMENT
449 syms_of_environ ();
450#endif /* MAINTAIN_ENVIRONMENT */
451 syms_of_read ();
452 syms_of_print ();
453 syms_of_eval ();
454 syms_of_fns ();
455#ifdef LISP_FLOAT_TYPE
456 syms_of_floatfns ();
457#endif
458
459 syms_of_abbrev ();
460 syms_of_buffer ();
461 syms_of_bytecode ();
462 syms_of_callint ();
463 syms_of_casefiddle ();
464 syms_of_casetab ();
465 syms_of_callproc ();
466 syms_of_cmds ();
467#ifndef NO_DIR_LIBRARY
468 syms_of_dired ();
469#endif /* not NO_DIR_LIBRARY */
470 syms_of_display ();
471 syms_of_doc ();
472 syms_of_editfns ();
473 syms_of_emacs ();
474 syms_of_fileio ();
475#ifdef CLASH_DETECTION
476 syms_of_filelock ();
477#endif /* CLASH_DETECTION */
478 syms_of_indent ();
479 syms_of_keyboard ();
480 syms_of_keymap ();
481 syms_of_macros ();
482 syms_of_marker ();
483 syms_of_minibuf ();
484 syms_of_mocklisp ();
485#ifdef subprocesses
486 syms_of_process ();
487#endif /* subprocesses */
488 syms_of_search ();
489#ifdef MULTI_SCREEN
490 syms_of_screen ();
491#endif
492 syms_of_syntax ();
493 syms_of_undo ();
494#ifdef VMS
495 syms_of_vmsproc ();
496#endif /* VMS */
497 syms_of_window ();
498 syms_of_xdisp ();
499#ifdef HAVE_X_WINDOWS
500 syms_of_xfns ();
501#ifdef HAVE_X_MENU
502 syms_of_xmenu ();
503#endif /* HAVE_X_MENU */
504#endif /* HAVE_X_WINDOWS */
505
506#ifdef SYMS_SYSTEM
507 SYMS_SYSTEM;
508#endif
509
510#ifdef SYMS_MACHINE
511 SYMS_MACHINE;
512#endif
513
514 keys_of_casefiddle ();
515 keys_of_cmds ();
516 keys_of_buffer ();
517 keys_of_keyboard ();
518 keys_of_keymap ();
519 keys_of_macros ();
520 keys_of_minibuf ();
521 keys_of_window ();
522 }
523
524 if (!initialized)
525 {
526 /* Handle -l loadup-and-dump, args passed by Makefile. */
527 if (argc > 2 + skip_args && !strcmp (argv[1 + skip_args], "-l"))
528 Vtop_level = Fcons (intern ("load"),
529 Fcons (build_string (argv[2 + skip_args]), Qnil));
530#ifdef CANNOT_DUMP
531 /* Unless next switch is -nl, load "loadup.el" first thing. */
532 if (!(argc > 1 + skip_args && !strcmp (argv[1 + skip_args], "-nl")))
533 Vtop_level = Fcons (intern ("load"),
534 Fcons (build_string ("loadup.el"), Qnil));
535#endif /* CANNOT_DUMP */
536 }
537
538 initialized = 1;
539
540 /* Enter editor command loop. This never returns. */
541 Frecursive_edit ();
542 /* NOTREACHED */
543}
544
545DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P",
546 "Exit the Emacs job and kill it. Ask for confirmation, without argument.\n\
547If ARG is an integer, return ARG as the exit program code.\n\
548If ARG is a string, stuff it as keyboard input.\n\n\
549The value of `kill-emacs-hook', if not void,\n\
550is a list of functions (of no args),\n\
551all of which are called before Emacs is actually killed.")
552 (arg)
553 Lisp_Object arg;
554{
555 Lisp_Object hook, hook1;
556 int i;
557 struct gcpro gcpro1;
558
559 GCPRO1 (arg);
560
561 if (feof (stdin))
562 arg = Qt;
563
564 if (!NULL (Vrun_hooks) && !noninteractive)
565 call1 (Vrun_hooks, intern ("kill-emacs-hook"));
566
567#ifdef subprocesses
568 kill_buffer_processes (Qnil);
569#endif /* subprocesses */
570
571#ifdef VMS
572 kill_vms_processes ();
573#endif /* VMS */
574
575 Fdo_auto_save (Qt, Qnil);
576
577#ifdef CLASH_DETECTION
578 unlock_all_files ();
579#endif /* CLASH_DETECTION */
580
581 fflush (stdout);
582 reset_sys_modes ();
583
584#ifdef HAVE_X_WINDOWS
585 if (!noninteractive && EQ (Vwindow_system, intern ("x")))
586 Fx_close_current_connection ();
587#endif /* HAVE_X_WINDOWS */
588
589 UNGCPRO;
590
591/* Is it really necessary to do this deassign
592 when we are going to exit anyway? */
593/* #ifdef VMS
594 stop_vms_input ();
595 #endif */
596 stuff_buffered_input (arg);
597#ifdef SIGIO
598 /* There is a tendency for a SIGIO signal to arrive within exit,
599 and cause a SIGHUP because the input descriptor is already closed. */
600 unrequest_sigio ();
601 signal (SIGIO, SIG_IGN);
602#endif
603 exit ((XTYPE (arg) == Lisp_Int) ? XINT (arg)
604#ifdef VMS
605 : 1
606#else
607 : 0
608#endif
609 );
610 /* NOTREACHED */
611}
612
613#ifndef CANNOT_DUMP
614/* Nothing like this can be implemented on an Apollo.
615 What a loss! */
616
617#ifdef HAVE_SHM
618
619DEFUN ("dump-emacs-data", Fdump_emacs_data, Sdump_emacs_data, 1, 1, 0,
620 "Dump current state of Emacs into data file FILENAME.\n\
621This function exists on systems that use HAVE_SHM.")
622 (intoname)
623 Lisp_Object intoname;
624{
625 extern int my_edata;
626 Lisp_Object tem;
627 extern void malloc_warning ();
628
629 CHECK_STRING (intoname, 0);
630 intoname = Fexpand_file_name (intoname, Qnil);
631
632 tem = Vpurify_flag;
633 Vpurify_flag = Qnil;
634
635 fflush (stdout);
636 /* Tell malloc where start of impure now is */
637 /* Also arrange for warnings when nearly out of space. */
638#ifndef SYSTEM_MALLOC
639 malloc_init (&my_edata, malloc_warning);
640#endif
641 map_out_data (XSTRING (intoname)->data);
642
643 Vpurify_flag = tem;
644
645 return Qnil;
646}
647
648#else /* not HAVE_SHM */
649
650DEFUN ("dump-emacs", Fdump_emacs, Sdump_emacs, 2, 2, 0,
651 "Dump current state of Emacs into executable file FILENAME.\n\
652Take symbols from SYMFILE (presumably the file you executed to run Emacs).\n\
653This is used in the file `loadup.el' when building Emacs.\n\
654\n\
655Bind `command-line-processed' to nil before dumping,\n\
656if you want the dumped Emacs to process its command line\n\
657and announce itself normally when it is run.")
658 (intoname, symname)
659 Lisp_Object intoname, symname;
660{
661 extern int my_edata;
662 Lisp_Object tem;
663 extern void malloc_warning ();
664
665 CHECK_STRING (intoname, 0);
666 intoname = Fexpand_file_name (intoname, Qnil);
667 if (!NULL (symname))
668 {
669 CHECK_STRING (symname, 0);
670 if (XSTRING (symname)->size)
671 symname = Fexpand_file_name (symname, Qnil);
672 }
673
674 tem = Vpurify_flag;
675 Vpurify_flag = Qnil;
676
677 fflush (stdout);
678#ifdef VMS
679 mapout_data (XSTRING (intoname)->data);
680#else
681 /* Tell malloc where start of impure now is */
682 /* Also arrange for warnings when nearly out of space. */
683#ifndef SYSTEM_MALLOC
684 malloc_init (&my_edata, malloc_warning);
685#endif
686 unexec (XSTRING (intoname)->data,
687 !NULL (symname) ? XSTRING (symname)->data : 0, &my_edata, 0, 0);
688#endif /* not VMS */
689
690 Vpurify_flag = tem;
691
692 return Qnil;
693}
694
695#endif /* not HAVE_SHM */
696
697#endif /* not CANNOT_DUMP */
698
699#ifdef VMS
700#define SEPCHAR ','
701#else
702#define SEPCHAR ':'
703#endif
704
705Lisp_Object
706decode_env_path (evarname, defalt)
707 char *evarname, *defalt;
708{
709 register char *path, *p;
710 extern char *index ();
711
712 Lisp_Object lpath;
713
714 path = (char *) egetenv (evarname);
715 if (!path)
716 path = defalt;
717 lpath = Qnil;
718 while (1)
719 {
720 p = index (path, SEPCHAR);
721 if (!p) p = path + strlen (path);
722 lpath = Fcons (p - path ? make_string (path, p - path) : Qnil,
723 lpath);
724 if (*p)
725 path = p + 1;
726 else
727 break;
728 }
729 return Fnreverse (lpath);
730}
731
732syms_of_emacs ()
733{
734#ifdef HAVE_SHM
735 defsubr (&Sdump_emacs_data);
736#else
737 defsubr (&Sdump_emacs);
738#endif
739
740 defsubr (&Skill_emacs);
741
742 DEFVAR_LISP ("command-line-args", &Vcommand_line_args,
743 "Args passed by shell to Emacs, as a list of strings.");
744
745 DEFVAR_LISP ("system-type", &Vsystem_type,
746 "Value is symbol indicating type of operating system you are using.");
747 Vsystem_type = intern (SYSTEM_TYPE);
748
749 DEFVAR_BOOL ("noninteractive", &noninteractive1,
750 "Non-nil means Emacs is running without interactive terminal.");
751}
diff --git a/src/minibuf.c b/src/minibuf.c
new file mode 100644
index 00000000000..478e95b4fe4
--- /dev/null
+++ b/src/minibuf.c
@@ -0,0 +1,1261 @@
1/* Minibuffer input and completion.
2 Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
21#include "config.h"
22#include "lisp.h"
23#include "commands.h"
24#include "buffer.h"
25#include "dispextern.h"
26#include "screen.h"
27#include "window.h"
28#include "syntax.h"
29
30#define min(a, b) ((a) < (b) ? (a) : (b))
31
32/* List of buffers for use as minibuffers.
33 The first element of the list is used for the outermost minibuffer invocation,
34 the next element is used for a recursive minibuffer invocation, etc.
35 The list is extended at the end as deeped minibuffer recursions are encountered. */
36Lisp_Object Vminibuffer_list;
37
38struct minibuf_save_data
39 {
40 char *prompt;
41 int prompt_width;
42 Lisp_Object help_form;
43 Lisp_Object current_prefix_arg;
44 };
45
46int minibuf_save_vector_size;
47struct minibuf_save_data *minibuf_save_vector;
48
49/* Depth in minibuffer invocations. */
50int minibuf_level;
51
52/* Nonzero means display completion help for invalid input */
53int auto_help;
54
55/* Fread_minibuffer leaves the input, as a string, here */
56Lisp_Object last_minibuf_string;
57
58/* Nonzero means let functions called when within a minibuffer
59 invoke recursive minibuffers (to read arguments, or whatever) */
60int enable_recursive_minibuffers;
61
62/* help-form is bound to this while in the minibuffer. */
63
64Lisp_Object Vminibuffer_help_form;
65
66/* Nonzero means completion ignores case. */
67
68int completion_ignore_case;
69
70/* If last completion attempt reported "Complete but not unique"
71 then this is the string completed then; otherwise this is nil. */
72
73static Lisp_Object last_exact_completion;
74
75Lisp_Object Quser_variable_p;
76
77/* Width in columns of current minibuffer prompt. */
78
79extern int minibuf_prompt_width;
80
81#ifdef MULTI_SCREEN
82
83/* When the global-minibuffer-screen is not used, this is the screen
84 where the minbuffer is active, and thus where certain windows
85 (completions, etc.) should appear. */
86struct screen *active_screen;
87
88extern Lisp_Object Vglobal_minibuffer_screen;
89#endif
90
91/* Actual minibuffer invocation. */
92
93void read_minibuf_unwind ();
94Lisp_Object get_minibuffer ();
95Lisp_Object read_minibuf ();
96
97Lisp_Object
98read_minibuf (map, initial, prompt, backup_n, expflag)
99 Lisp_Object map;
100 Lisp_Object initial;
101 Lisp_Object prompt;
102 Lisp_Object backup_n;
103 int expflag;
104{
105 register Lisp_Object val;
106 int count = specpdl_ptr - specpdl;
107 struct gcpro gcpro1, gcpro2;
108 Lisp_Object prev_screen = Qnil;
109
110 if (XTYPE (prompt) != Lisp_String)
111 prompt = build_string ("");
112
113 /* Emacs in -batch mode calls minibuffer: print the prompt. */
114 if (noninteractive && XTYPE (prompt) == Lisp_String)
115 printf ("%s", XSTRING (prompt)->data);
116
117 if (!enable_recursive_minibuffers
118 && minibuf_level > 0
119 && (EQ (selected_window, minibuf_window)))
120#if 0
121 || selected_screen != XSCREEN (WINDOW_SCREEN (XWINDOW (minibuf_window)))
122#endif
123 error ("Command attempted to use minibuffer while in minibuffer");
124
125 if (minibuf_level == minibuf_save_vector_size)
126 minibuf_save_vector =
127 (struct minibuf_save_data *)
128 xrealloc (minibuf_save_vector,
129 (minibuf_save_vector_size *= 2)
130 * sizeof (struct minibuf_save_data));
131 minibuf_save_vector[minibuf_level].prompt = minibuf_prompt;
132 minibuf_save_vector[minibuf_level].prompt_width = minibuf_prompt_width;
133 minibuf_prompt_width = 0;
134 /* >> Why is this done this way rather than binding these variables? */
135 minibuf_save_vector[minibuf_level].help_form = Vhelp_form;
136 minibuf_save_vector[minibuf_level].current_prefix_arg = Vcurrent_prefix_arg;
137 GCPRO2 (minibuf_save_vector[minibuf_level].help_form,
138 minibuf_save_vector[minibuf_level].current_prefix_arg);
139
140 record_unwind_protect (Fset_window_configuration,
141 Fcurrent_window_configuration ());
142
143 val = current_buffer->directory;
144 Fset_buffer (get_minibuffer (minibuf_level));
145 current_buffer->directory = val;
146 Fmake_local_variable (Qprint_escape_newlines);
147 print_escape_newlines = 1;
148
149 Vminibuf_scroll_window = selected_window;
150 Fset_window_buffer (minibuf_window, Fcurrent_buffer ());
151#ifdef MULTI_SCREEN
152 if (SCREENP (Vglobal_minibuffer_screen))
153 active_screen = selected_screen;
154#endif
155 Fselect_window (minibuf_window);
156 XFASTINT (XWINDOW (minibuf_window)->hscroll) = 0;
157
158 Ferase_buffer ();
159 minibuf_level++;
160 record_unwind_protect (read_minibuf_unwind, Qnil);
161
162 if (!NULL (initial))
163 {
164 Finsert (1, &initial);
165 if (!NULL (backup_n) && XTYPE (backup_n) == Lisp_Int)
166 Fforward_char (backup_n);
167 }
168
169 minibuf_prompt = (char *) alloca (XSTRING (prompt)->size + 1);
170 bcopy (XSTRING (prompt)->data, minibuf_prompt, XSTRING (prompt)->size + 1);
171 echo_area_glyphs = 0;
172
173 Vhelp_form = Vminibuffer_help_form;
174 current_buffer->keymap = map;
175
176/* ??? MCC did redraw_screen here if switching screens. */
177 recursive_edit_1 ();
178
179 /* If cursor is on the minibuffer line,
180 show the user we have exited by putting it in column 0. */
181 if ((SCREEN_CURSOR_Y (selected_screen)
182 >= XFASTINT (XWINDOW (minibuf_window)->top))
183 && !noninteractive)
184 {
185 SCREEN_CURSOR_X (selected_screen) = 0;
186 update_screen (selected_screen, 1, 1);
187 }
188
189 /* Make minibuffer contents into a string */
190 val = make_string (BEG_ADDR, Z - BEG);
191 bcopy (GAP_END_ADDR, XSTRING (val)->data + GPT - BEG, Z - GPT);
192 unbind_to (count, Qnil); /* The appropriate screen will get selected
193 from set-window-configuration. */
194
195 UNGCPRO;
196
197 /* VAL is the string of minibuffer text. */
198
199 last_minibuf_string = val;
200
201 /* If Lisp form desired instead of string, parse it */
202 if (expflag)
203 val = Fread (val);
204
205#ifdef MULTI_SCREEN
206 if (active_screen)
207 active_screen = (struct screen *) 0;
208#endif
209
210 return val;
211}
212
213/* Return a buffer to be used as the minibuffer at depth `depth'.
214 depth = 0 is the lowest allowed argument, and that is the value
215 used for nonrecursive minibuffer invocations */
216
217Lisp_Object
218get_minibuffer (depth)
219 int depth;
220{
221 Lisp_Object tail, num, buf;
222 char name[14];
223 extern Lisp_Object nconc2 ();
224
225 XFASTINT (num) = depth;
226 tail = Fnthcdr (num, Vminibuffer_list);
227 if (NULL (tail))
228 {
229 tail = Fcons (Qnil, Qnil);
230 Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
231 }
232 buf = Fcar (tail);
233 if (NULL (buf) || NULL (XBUFFER (buf)->name))
234 {
235 sprintf (name, " *Minibuf-%d*", depth);
236 buf = Fget_buffer_create (build_string (name));
237 XCONS (tail)->car = buf;
238 }
239 else
240 reset_buffer (XBUFFER (buf));
241 return buf;
242}
243
244/* This function is called on exiting minibuffer, whether normally or not,
245 and it restores the current window, buffer, etc. */
246
247void
248read_minibuf_unwind ()
249{
250 /* Erase the minibuffer we were using at this level. */
251 Fset_buffer (XWINDOW (minibuf_window)->buffer);
252
253 /* Prevent error in erase-buffer. */
254 current_buffer->read_only = Qnil;
255 Ferase_buffer ();
256
257 /* If this was a recursive minibuffer,
258 tie the minibuffer window back to the outer level minibuffer buffer */
259 minibuf_level--;
260 /* Make sure minibuffer window is erased, not ignored */
261 windows_or_buffers_changed++;
262 XFASTINT (XWINDOW (minibuf_window)->last_modified) = 0;
263
264 /* Restore prompt from outer minibuffer */
265 minibuf_prompt = minibuf_save_vector[minibuf_level].prompt;
266 minibuf_prompt_width = minibuf_save_vector[minibuf_level].prompt_width;
267 Vhelp_form = minibuf_save_vector[minibuf_level].help_form;
268 Vcurrent_prefix_arg = minibuf_save_vector[minibuf_level].current_prefix_arg;
269}
270
271DEFUN ("read-from-minibuffer", Fread_from_minibuffer, Sread_from_minibuffer, 1, 5, 0,
272 "Read a string from the minibuffer, prompting with string PROMPT.\n\
273If optional second arg INITIAL-CONTENTS is non-nil, it is a string\n\
274 to be inserted into the minibuffer before reading input.\n\
275Third arg KEYMAP is a keymap to use whilst reading;\n\
276 if omitted or nil, the default is `minibuffer-local-map'.\n\
277If fourth arg READ is non-nil, then interpret the result as a lisp object\n\
278 and return that object:\n\
279 in other words, do `(car (read-from-string INPUT-STRING))'\n\
280Fifth arg POSITION, if non-nil, is where to put point\n\
281 in the minibuffer after inserting INITIAL-CONTENTS.")
282 (prompt, initial_input, keymap, read, position)
283 Lisp_Object prompt, initial_input, keymap, read, position;
284{
285 int pos = 0;
286
287 CHECK_STRING (prompt, 0);
288 if (!NULL (initial_input))
289 {
290 CHECK_STRING (initial_input, 1);
291 if (!NULL (position))
292 {
293 CHECK_NUMBER (position, 0);
294 /* Convert to distance from end of input. */
295 pos = XINT (position) - 1 - XSTRING (initial_input)->size;
296 }
297 }
298
299 if (NULL (keymap))
300 keymap = Vminibuffer_local_map;
301 else
302 keymap = get_keymap (keymap,2);
303 return read_minibuf (keymap, initial_input, prompt,
304 pos, !NULL (read));
305}
306
307DEFUN ("read-minibuffer", Fread_minibuffer, Sread_minibuffer, 1, 2, 0,
308 "Return a Lisp object read using the minibuffer.\n\
309Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
310is a string to insert in the minibuffer before reading.")
311 (prompt, initial_contents)
312 Lisp_Object prompt, initial_contents;
313{
314 CHECK_STRING (prompt, 0);
315 if (!NULL (initial_contents))
316 CHECK_STRING (initial_contents, 1)
317 return read_minibuf (Vminibuffer_local_map, initial_contents, prompt, Qnil, 1);
318}
319
320DEFUN ("eval-minibuffer", Feval_minibuffer, Seval_minibuffer, 1, 2, 0,
321 "Return value of Lisp expression read using the minibuffer.\n\
322Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS\n\
323is a string to insert in the minibuffer before reading.")
324 (prompt, initial_contents)
325 Lisp_Object prompt, initial_contents;
326{
327 return Feval (Fread_minibuffer (prompt, initial_contents));
328}
329
330/* Functions that use the minibuffer to read various things. */
331
332DEFUN ("read-string", Fread_string, Sread_string, 1, 2, 0,
333 "Read a string from the minibuffer, prompting with string PROMPT.\n\
334If non-nil second arg INITIAL-INPUT is a string to insert before reading.")
335 (prompt, initial_input)
336 Lisp_Object prompt, initial_input;
337{
338 return Fread_from_minibuffer (prompt, initial_input, Qnil, Qnil, Qnil);
339}
340
341DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 2, 1, 0,
342 "Args PROMPT and INIT, strings. Read a string from the terminal, not allowing blanks.\n\
343Prompt with PROMPT, and provide INIT as an initial value of the input string.")
344 (prompt, init)
345 Lisp_Object prompt, init;
346{
347 CHECK_STRING (prompt, 0);
348 if (! NULL (init))
349 CHECK_STRING (init, 1);
350
351 return read_minibuf (Vminibuffer_local_ns_map, init, prompt, Qnil, 0);
352}
353
354DEFUN ("read-command", Fread_command, Sread_command, 1, 1, 0,
355 "One arg PROMPT, a string. Read the name of a command and return as a symbol.\n\
356Prompts with PROMPT.")
357 (prompt)
358 Lisp_Object prompt;
359{
360 return Fintern (Fcompleting_read (prompt, Vobarray, Qcommandp, Qt, Qnil, Qnil),
361 Qnil);
362}
363
364#ifdef NOTDEF
365DEFUN ("read-function", Fread_function, Sread_function, 1, 1, 0,
366 "One arg PROMPT, a string. Read the name of a function and return as a symbol.\n\
367Prompts with PROMPT.")
368 (prompt)
369 Lisp_Object prompt;
370{
371 return Fintern (Fcompleting_read (prompt, Vobarray, Qfboundp, Qt, Qnil, Qnil),
372 Qnil);
373}
374#endif /* NOTDEF */
375
376DEFUN ("read-variable", Fread_variable, Sread_variable, 1, 1, 0,
377 "One arg PROMPT, a string. Read the name of a user variable and return\n\
378it as a symbol. Prompts with PROMPT.\n\
379A user variable is one whose documentation starts with a `*' character.")
380 (prompt)
381 Lisp_Object prompt;
382{
383 return Fintern (Fcompleting_read (prompt, Vobarray,
384 Quser_variable_p, Qt, Qnil, Qnil),
385 Qnil);
386}
387
388DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
389 "One arg PROMPT, a string. Read the name of a buffer and return as a string.\n\
390Prompts with PROMPT.\n\
391Optional second arg is value to return if user enters an empty line.\n\
392If optional third arg REQUIRE-MATCH is non-nil, only existing buffer names are allowed.")
393 (prompt, def, require_match)
394 Lisp_Object prompt, def, require_match;
395{
396 Lisp_Object tem;
397 Lisp_Object args[3];
398 struct gcpro gcpro1;
399
400 if (XTYPE (def) == Lisp_Buffer)
401 def = XBUFFER (def)->name;
402 if (!NULL (def))
403 {
404 args[0] = build_string ("%s(default %s) ");
405 args[1] = prompt;
406 args[2] = def;
407 prompt = Fformat (3, args);
408 }
409 GCPRO1 (def);
410 tem = Fcompleting_read (prompt, Vbuffer_alist, Qnil, require_match, Qnil, Qnil);
411 UNGCPRO;
412 if (XSTRING (tem)->size)
413 return tem;
414 return def;
415}
416
417DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0,
418 "Return common substring of all completions of STRING in ALIST.\n\
419Each car of each element of ALIST is tested to see if it begins with STRING.\n\
420All that match are compared together; the longest initial sequence\n\
421common to all matches is returned as a string.\n\
422If there is no match at all, nil is returned.\n\
423For an exact match, t is returned.\n\
424\n\
425ALIST can be an obarray instead of an alist.\n\
426Then the print names of all symbols in the obarray are the possible matches.\n\
427\n\
428ALIST can also be a function to do the completion itself.\n\
429It receives three arguments: the values STRING, PREDICATE and nil.\n\
430Whatever it returns becomes the value of `try-completion'.\n\
431\n\
432If optional third argument PREDICATE is non-nil,\n\
433it is used to test each possible match.\n\
434The match is a candidate only if PREDICATE returns non-nil.\n\
435The argument given to PREDICATE is the alist element or the symbol from the obarray.")
436 (string, alist, pred)
437 Lisp_Object string, alist, pred;
438{
439 Lisp_Object bestmatch, tail, elt, eltstring;
440 int bestmatchsize;
441 int compare, matchsize;
442 int list = CONSP (alist) || NULL (alist);
443 int index, obsize;
444 int matchcount = 0;
445 Lisp_Object bucket, zero, end, tem;
446 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
447
448 CHECK_STRING (string, 0);
449 if (!list && XTYPE (alist) != Lisp_Vector)
450 return call3 (alist, string, pred, Qnil);
451
452 bestmatch = Qnil;
453
454 /* If ALIST is not a list, set TAIL just for gc pro. */
455 tail = alist;
456 if (! list)
457 {
458 index = 0;
459 obsize = XVECTOR (alist)->size;
460 bucket = XVECTOR (alist)->contents[index];
461 }
462
463 while (1)
464 {
465 /* Get the next element of the alist or obarray. */
466 /* Exit the loop if the elements are all used up. */
467 /* elt gets the alist element or symbol.
468 eltstring gets the name to check as a completion. */
469
470 if (list)
471 {
472 if (NULL (tail))
473 break;
474 elt = Fcar (tail);
475 eltstring = Fcar (elt);
476 tail = Fcdr (tail);
477 }
478 else
479 {
480 if (XFASTINT (bucket) != 0)
481 {
482 elt = bucket;
483 eltstring = Fsymbol_name (elt);
484 if (XSYMBOL (bucket)->next)
485 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
486 else
487 XFASTINT (bucket) = 0;
488 }
489 else if (++index >= obsize)
490 break;
491 else
492 {
493 bucket = XVECTOR (alist)->contents[index];
494 continue;
495 }
496 }
497
498 /* Is this element a possible completion? */
499
500 if (XTYPE (eltstring) == Lisp_String &&
501 XSTRING (string)->size <= XSTRING (eltstring)->size &&
502 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
503 XSTRING (string)->size))
504 {
505 /* Yes. */
506 /* Ignore this element if there is a predicate
507 and the predicate doesn't like it. */
508
509 if (!NULL (pred))
510 {
511 if (EQ (pred, Qcommandp))
512 tem = Fcommandp (elt);
513 else
514 {
515 GCPRO4 (tail, string, eltstring, bestmatch);
516 tem = call1 (pred, elt);
517 UNGCPRO;
518 }
519 if (NULL (tem)) continue;
520 }
521
522 /* Update computation of how much all possible completions match */
523
524 matchcount++;
525 if (NULL (bestmatch))
526 bestmatch = eltstring, bestmatchsize = XSTRING (eltstring)->size;
527 else
528 {
529 compare = min (bestmatchsize, XSTRING (eltstring)->size);
530 matchsize = scmp (XSTRING (bestmatch)->data,
531 XSTRING (eltstring)->data,
532 compare);
533 bestmatchsize = (matchsize >= 0) ? matchsize : compare;
534 }
535 }
536 }
537
538 if (NULL (bestmatch))
539 return Qnil; /* No completions found */
540 if (matchcount == 1 && bestmatchsize == XSTRING (string)->size)
541 return Qt;
542
543 XFASTINT (zero) = 0; /* Else extract the part in which */
544 XFASTINT (end) = bestmatchsize; /* all completions agree */
545 return Fsubstring (bestmatch, zero, end);
546}
547
548/* Compare exactly LEN chars of strings at S1 and S2,
549 ignoring case if appropriate.
550 Return -1 if strings match,
551 else number of chars that match at the beginning. */
552
553scmp (s1, s2, len)
554 register char *s1, *s2;
555 int len;
556{
557 register int l = len;
558
559 if (completion_ignore_case)
560 {
561 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
562 l--;
563 }
564 else
565 {
566 while (l && *s1++ == *s2++)
567 l--;
568 }
569 if (l == 0)
570 return -1;
571 else return len - l;
572}
573
574DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 3, 0,
575 "Search for partial matches to STRING in ALIST.\n\
576Each car of each element of ALIST is tested to see if it begins with STRING.\n\
577The value is a list of all the strings from ALIST that match.\n\
578ALIST can be an obarray instead of an alist.\n\
579Then the print names of all symbols in the obarray are the possible matches.\n\
580\n\
581ALIST can also be a function to do the completion itself.\n\
582It receives three arguments: the values STRING, PREDICATE and t.\n\
583Whatever it returns becomes the value of `all-completion'.\n\
584\n\
585If optional third argument PREDICATE is non-nil,\n\
586it is used to test each possible match.\n\
587The match is a candidate only if PREDICATE returns non-nil.\n\
588The argument given to PREDICATE is the alist element or the symbol from the obarray.")
589 (string, alist, pred)
590 Lisp_Object string, alist, pred;
591{
592 Lisp_Object tail, elt, eltstring;
593 Lisp_Object allmatches;
594 int list = CONSP (alist) || NULL (alist);
595 int index, obsize;
596 Lisp_Object bucket, tem;
597 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
598
599 CHECK_STRING (string, 0);
600 if (!list && XTYPE (alist) != Lisp_Vector)
601 {
602 return call3 (alist, string, pred, Qt);
603 }
604 allmatches = Qnil;
605
606 /* If ALIST is not a list, set TAIL just for gc pro. */
607 tail = alist;
608 if (! list)
609 {
610 index = 0;
611 obsize = XVECTOR (alist)->size;
612 bucket = XVECTOR (alist)->contents[index];
613 }
614
615 while (1)
616 {
617 /* Get the next element of the alist or obarray. */
618 /* Exit the loop if the elements are all used up. */
619 /* elt gets the alist element or symbol.
620 eltstring gets the name to check as a completion. */
621
622 if (list)
623 {
624 if (NULL (tail))
625 break;
626 elt = Fcar (tail);
627 eltstring = Fcar (elt);
628 tail = Fcdr (tail);
629 }
630 else
631 {
632 if (XFASTINT (bucket) != 0)
633 {
634 elt = bucket;
635 eltstring = Fsymbol_name (elt);
636 if (XSYMBOL (bucket)->next)
637 XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
638 else
639 XFASTINT (bucket) = 0;
640 }
641 else if (++index >= obsize)
642 break;
643 else
644 {
645 bucket = XVECTOR (alist)->contents[index];
646 continue;
647 }
648 }
649
650 /* Is this element a possible completion? */
651
652 if (XTYPE (eltstring) == Lisp_String &&
653 XSTRING (string)->size <= XSTRING (eltstring)->size &&
654 XSTRING (eltstring)->data[0] != ' ' &&
655 0 > scmp (XSTRING (eltstring)->data, XSTRING (string)->data,
656 XSTRING (string)->size))
657 {
658 /* Yes. */
659 /* Ignore this element if there is a predicate
660 and the predicate doesn't like it. */
661
662 if (!NULL (pred))
663 {
664 if (EQ (pred, Qcommandp))
665 tem = Fcommandp (elt);
666 else
667 {
668 GCPRO4 (tail, eltstring, allmatches, string);
669 tem = call1 (pred, elt);
670 UNGCPRO;
671 }
672 if (NULL (tem)) continue;
673 }
674 /* Ok => put it on the list. */
675 allmatches = Fcons (eltstring, allmatches);
676 }
677 }
678
679 return Fnreverse (allmatches);
680}
681
682Lisp_Object Vminibuffer_completion_table, Qminibuffer_completion_table;
683Lisp_Object Vminibuffer_completion_predicate, Qminibuffer_completion_predicate;
684Lisp_Object Vminibuffer_completion_confirm, Qminibuffer_completion_confirm;
685
686DEFUN ("completing-read", Fcompleting_read, Scompleting_read, 2, 6, 0,
687 "Read a string in the minibuffer, with completion.\n\
688Args are PROMPT, TABLE, PREDICATE, REQUIRE-MATCH and INITIAL-INPUT.\n\
689PROMPT is a string to prompt with; normally it ends in a colon and a space.\n\
690TABLE is an alist whose elements' cars are strings, or an obarray.\n\
691PREDICATE limits completion to a subset of TABLE.\n\
692See `try-completion' for more details on completion, TABLE, and PREDICATE.\n\
693If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless\n\
694 the input is (or completes to) an element of TABLE.\n\
695 If it is also not t, Return does not exit if it does non-null completion.\n\
696If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.\n\
697Case is ignored if ambient value of `completion-ignore-case' is non-nil.\n\
698If BACKUP-N is specified, point should be placed that many spaces from\n\
699the end of the buffer. This is useful when providing default values,\n\
700because you can put point before the last component of a filename or any\n\
701other component that is likely to be deleted.")
702 (prompt, table, pred, require_match, init, backup_n)
703 Lisp_Object prompt, table, pred, require_match, init, backup_n;
704{
705 Lisp_Object val;
706 int count = specpdl_ptr - specpdl;
707 specbind (Qminibuffer_completion_table, table);
708 specbind (Qminibuffer_completion_predicate, pred);
709 specbind (Qminibuffer_completion_confirm,
710 EQ (require_match, Qt) ? Qnil : Qt);
711 last_exact_completion = Qnil;
712 val = read_minibuf (NULL (require_match)
713 ? Vminibuffer_local_completion_map
714 : Vminibuffer_local_must_match_map,
715 init, prompt, backup_n, 0);
716 return unbind_to (count, val);
717}
718
719/* Temporarily display the string M at the end of the current
720 minibuffer contents. This is used to display things like
721 "[No Match]" when the user requests a completion for a prefix
722 that has no possible completions, and other quick, unobtrusive
723 messages. */
724
725temp_echo_area_glyphs (m)
726 char *m;
727{
728 /* It's not very modular to do things this way, but then it seems
729 to me that the whole echo_area_glyphs thing is a hack anyway. */
730 extern char *previous_echo_glyphs;
731
732 int osize = ZV;
733 Lisp_Object oinhibit;
734 oinhibit = Vinhibit_quit;
735
736 /* Clear out any old echo-area message to make way for our new
737 thing. */
738 echo_area_glyphs = previous_echo_glyphs = 0;
739
740 SET_PT (osize);
741 insert_string (m);
742 SET_PT (osize);
743 Vinhibit_quit = Qt;
744 Fsit_for (make_number (2), Qnil, Qnil);
745 del_range (point, ZV);
746 if (!NULL (Vquit_flag))
747 {
748 Vquit_flag = Qnil;
749 unread_command_char = Ctl ('g');
750 }
751 Vinhibit_quit = oinhibit;
752}
753
754Lisp_Object Fminibuffer_completion_help ();
755
756/* returns:
757 * 0 no possible completion
758 * 1 was already an exact and unique completion
759 * 3 was already an exact completion
760 * 4 completed to an exact completion
761 * 5 some completion happened
762 * 6 no completion happened
763 */
764int
765do_completion ()
766{
767 Lisp_Object completion, tem;
768 int completedp;
769 Lisp_Object last;
770
771 completion = Ftry_completion (Fbuffer_string (), Vminibuffer_completion_table,
772 Vminibuffer_completion_predicate);
773 last = last_exact_completion;
774 last_exact_completion = Qnil;
775
776 if (NULL (completion))
777 {
778 bitch_at_user ();
779 temp_echo_area_glyphs (" [No match]");
780 return 0;
781 }
782
783 if (EQ (completion, Qt)) /* exact and unique match */
784 return 1;
785
786 /* compiler bug */
787 tem = Fstring_equal (completion, Fbuffer_string());
788 if (completedp = NULL (tem))
789 {
790 Ferase_buffer (); /* Some completion happened */
791 Finsert (1, &completion);
792 }
793
794 /* It did find a match. Do we match some possibility exactly now? */
795 if (CONSP (Vminibuffer_completion_table)
796 || NULL (Vminibuffer_completion_table))
797 tem = Fassoc (Fbuffer_string (), Vminibuffer_completion_table);
798 else if (XTYPE (Vminibuffer_completion_table) == Lisp_Vector)
799 {
800 /* the primitive used by Fintern_soft */
801 extern Lisp_Object oblookup ();
802
803 tem = Fbuffer_string ();
804 /* Bypass intern-soft as that loses for nil */
805 tem = oblookup (Vminibuffer_completion_table,
806 XSTRING (tem)->data, XSTRING (tem)->size);
807 if (XTYPE (tem) != Lisp_Symbol)
808 tem = Qnil;
809 else if (!NULL (Vminibuffer_completion_predicate))
810 tem = call1 (Vminibuffer_completion_predicate, tem);
811 else
812 tem = Qt;
813 }
814 else
815 tem = call3 (Vminibuffer_completion_table,
816 Fbuffer_string (),
817 Vminibuffer_completion_predicate,
818 Qlambda);
819
820 if (NULL (tem))
821 { /* not an exact match */
822 if (completedp)
823 return 5;
824 else if (auto_help)
825 Fminibuffer_completion_help ();
826 else
827 temp_echo_area_glyphs (" [Next char not unique]");
828 return 6;
829 }
830 else if (completedp)
831 return 4;
832 /* If the last exact completion and this one were the same,
833 it means we've already given a "Complete but not unique"
834 message and the user's hit TAB again, so no we give him help. */
835 last_exact_completion = completion;
836 if (!NULL (last))
837 {
838 tem = Fbuffer_string ();
839 if (!NULL (Fequal (tem, last)))
840 Fminibuffer_completion_help ();
841 }
842 return 3;
843
844}
845
846
847DEFUN ("minibuffer-complete", Fminibuffer_complete, Sminibuffer_complete, 0, 0, "",
848 "Complete the minibuffer contents as far as possible.")
849 ()
850{
851 register int i = do_completion ();
852 switch (i)
853 {
854 case 0:
855 return Qnil;
856
857 case 1:
858 temp_echo_area_glyphs (" [Sole completion]");
859 break;
860
861 case 3:
862 temp_echo_area_glyphs (" [Complete, but not unique]");
863 break;
864 }
865
866 return Qt;
867}
868
869DEFUN ("minibuffer-complete-and-exit", Fminibuffer_complete_and_exit,
870 Sminibuffer_complete_and_exit, 0, 0, "",
871 "Complete the minibuffer contents, and maybe exit.\n\
872Exit if the name is valid with no completion needed.\n\
873If name was completed to a valid match,\n\
874a repetition of this command will exit.")
875 ()
876{
877 register int i;
878
879 /* Allow user to specify null string */
880 if (BEGV == ZV)
881 goto exit;
882
883 i = do_completion ();
884 switch (i)
885 {
886 case 1:
887 case 3:
888 goto exit;
889
890 case 4:
891 if (!NULL (Vminibuffer_completion_confirm))
892 {
893 temp_echo_area_glyphs (" [Confirm]");
894 return Qnil;
895 }
896 else
897 goto exit;
898
899 default:
900 return Qnil;
901 }
902 exit:
903 Fthrow (Qexit, Qnil);
904 /* NOTREACHED */
905}
906
907DEFUN ("minibuffer-complete-word", Fminibuffer_complete_word, Sminibuffer_complete_word,
908 0, 0, "",
909 "Complete the minibuffer contents at most a single word.\n\
910After one word is completed as much as possible, a space or hyphen\n\
911is added, provided that matches some possible completion.")
912 ()
913{
914 Lisp_Object completion, tem;
915 register int i;
916 register unsigned char *completion_string;
917 /* We keep calling Fbuffer_string
918 rather than arrange for GC to hold onto a pointer to
919 one of the strings thus made. */
920
921 completion = Ftry_completion (Fbuffer_string (),
922 Vminibuffer_completion_table,
923 Vminibuffer_completion_predicate);
924 if (NULL (completion))
925 {
926 bitch_at_user ();
927 temp_echo_area_glyphs (" [No match]");
928 return Qnil;
929 }
930 if (EQ (completion, Qt))
931 return Qnil;
932
933#if 0 /* How the below code used to look, for reference */
934 tem = Fbuffer_string ();
935 b = XSTRING (tem)->data;
936 i = ZV - 1 - XSTRING (completion)->size;
937 p = XSTRING (completion)->data;
938 if (i > 0 ||
939 0 <= scmp (b, p, ZV - 1))
940 {
941 i = 1;
942 /* Set buffer to longest match of buffer tail and completion head. */
943 while (0 <= scmp (b + i, p, ZV - 1 - i))
944 i++;
945 del_range (1, i + 1);
946 SET_PT (ZV);
947 }
948#else /* Rewritten code */
949 {
950 register unsigned char *buffer_string;
951 int buffer_length, completion_length;
952
953 tem = Fbuffer_string ();
954 buffer_string = XSTRING (tem)->data;
955 completion_string = XSTRING (completion)->data;
956 buffer_length = XSTRING (tem)->size; /* ie ZV - BEGV */
957 completion_length = XSTRING (completion)->size;
958 i = buffer_length - completion_length;
959 /* Mly: I don't understand what this is supposed to do AT ALL */
960 if (i > 0 ||
961 0 <= scmp (buffer_string, completion_string, buffer_length))
962 {
963 /* Set buffer to longest match of buffer tail and completion head. */
964 if (i <= 0) i = 1;
965 buffer_string += i;
966 buffer_length -= i;
967 while (0 <= scmp (buffer_string++, completion_string, buffer_length--))
968 i++;
969 del_range (1, i + 1);
970 SET_PT (ZV);
971 }
972 }
973#endif /* Rewritten code */
974 i = ZV - BEGV;
975
976 /* If completion finds next char not unique,
977 consider adding a space or a hyphen */
978 if (i == XSTRING (completion)->size)
979 {
980 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string (" ")),
981 Vminibuffer_completion_table,
982 Vminibuffer_completion_predicate);
983 if (XTYPE (tem) == Lisp_String)
984 completion = tem;
985 else
986 {
987 tem = Ftry_completion (concat2 (Fbuffer_string (), build_string ("-")),
988 Vminibuffer_completion_table,
989 Vminibuffer_completion_predicate);
990 if (XTYPE (tem) == Lisp_String)
991 completion = tem;
992 }
993 }
994
995 /* Now find first word-break in the stuff found by completion.
996 i gets index in string of where to stop completing. */
997 completion_string = XSTRING (completion)->data;
998
999 for (; i < XSTRING (completion)->size; i++)
1000 if (SYNTAX (completion_string[i]) != Sword) break;
1001 if (i < XSTRING (completion)->size)
1002 i = i + 1;
1003
1004 /* If got no characters, print help for user. */
1005
1006 if (i == ZV - BEGV)
1007 {
1008 if (auto_help)
1009 Fminibuffer_completion_help ();
1010 return Qnil;
1011 }
1012
1013 /* Otherwise insert in minibuffer the chars we got */
1014
1015 Ferase_buffer ();
1016 insert_from_string (completion, 0, i);
1017 return Qt;
1018}
1019
1020DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
1021 1, 1, 0,
1022 "Display in a buffer the list of completions, COMPLETIONS.\n\
1023Each element may be just a symbol or string\n\
1024or may be a list of two strings to be printed as if concatenated.")
1025 (completions)
1026 Lisp_Object completions;
1027{
1028 register Lisp_Object tail, elt;
1029 register int i;
1030 struct buffer *old = current_buffer;
1031 /* No GCPRO needed, since (when it matters) every variable
1032 points to a non-string that is pointed to by COMPLETIONS. */
1033
1034 set_buffer_internal (XBUFFER (Vstandard_output));
1035
1036 if (NULL (completions))
1037 insert_string ("There are no possible completions of what you have typed.");
1038 else
1039 {
1040 insert_string ("Possible completions are:");
1041 for (tail = completions, i = 0; !NULL (tail); tail = Fcdr (tail), i++)
1042 {
1043 /* this needs fixing for the case of long completions
1044 and/or narrow windows */
1045 /* Sadly, the window it will appear in is not known
1046 until after the text has been made. */
1047 if (i & 1)
1048 Findent_to (make_number (35), make_number (1));
1049 else
1050 Fterpri (Qnil);
1051 elt = Fcar (tail);
1052 if (CONSP (elt))
1053 {
1054 Fprinc (Fcar (elt), Qnil);
1055 Fprinc (Fcar (Fcdr (elt)), Qnil);
1056 }
1057 else
1058 Fprinc (elt, Qnil);
1059 }
1060 }
1061 set_buffer_internal (old);
1062 return Qnil;
1063}
1064
1065DEFUN ("minibuffer-completion-help", Fminibuffer_completion_help, Sminibuffer_completion_help,
1066 0, 0, "",
1067 "Display a list of possible completions of the current minibuffer contents.")
1068 ()
1069{
1070 Lisp_Object completions;
1071
1072 message ("Making completion list...");
1073 completions = Fall_completions (Fbuffer_string (),
1074 Vminibuffer_completion_table,
1075 Vminibuffer_completion_predicate);
1076 echo_area_glyphs = 0;
1077
1078 if (NULL (completions))
1079 {
1080 bitch_at_user ();
1081 temp_echo_area_glyphs (" [No completions]");
1082 }
1083 else
1084 internal_with_output_to_temp_buffer ("*Completions*",
1085 Fdisplay_completion_list,
1086 Fsort (completions, Qstring_lessp));
1087 return Qnil;
1088}
1089
1090DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, 0, "",
1091 "Terminate minibuffer input.")
1092 ()
1093{
1094 if (XTYPE (last_command_char) == Lisp_Int)
1095 internal_self_insert (last_command_char, 0);
1096 else
1097 bitch_at_user ();
1098
1099 Fthrow (Qexit, Qnil);
1100}
1101
1102DEFUN ("exit-minibuffer", Fexit_minibuffer, Sexit_minibuffer, 0, 0, "",
1103 "Terminate this minibuffer argument.")
1104 ()
1105{
1106 Fthrow (Qexit, Qnil);
1107}
1108
1109DEFUN ("minibuffer-depth", Fminibuffer_depth, Sminibuffer_depth, 0, 0, 0,
1110 "Return current depth of activations of minibuffer, a nonnegative integer.")
1111 ()
1112{
1113 return make_number (minibuf_level);
1114}
1115
1116
1117init_minibuf_once ()
1118{
1119 Vminibuffer_list = Qnil;
1120 staticpro (&Vminibuffer_list);
1121}
1122
1123syms_of_minibuf ()
1124{
1125 minibuf_level = 0;
1126 minibuf_prompt = 0;
1127 minibuf_save_vector_size = 5;
1128 minibuf_save_vector = (struct minibuf_save_data *) malloc (5 * sizeof (struct minibuf_save_data));
1129
1130 Qminibuffer_completion_table = intern ("minibuffer-completion-table");
1131 staticpro (&Qminibuffer_completion_table);
1132
1133 Qminibuffer_completion_confirm = intern ("minibuffer-completion-confirm");
1134 staticpro (&Qminibuffer_completion_confirm);
1135
1136 Qminibuffer_completion_predicate = intern ("minibuffer-completion-predicate");
1137 staticpro (&Qminibuffer_completion_predicate);
1138
1139 staticpro (&last_minibuf_string);
1140 last_minibuf_string = Qnil;
1141
1142 Quser_variable_p = intern ("user-variable-p");
1143 staticpro (&Quser_variable_p);
1144
1145
1146
1147 DEFVAR_BOOL ("completion-auto-help", &auto_help,
1148 "*Non-nil means automatically provide help for invalid completion input.");
1149 auto_help = 1;
1150
1151 DEFVAR_BOOL ("completion-ignore-case", &completion_ignore_case,
1152 "Non-nil means don't consider case significant in completion.");
1153 completion_ignore_case = 0;
1154
1155 DEFVAR_BOOL ("enable-recursive-minibuffers", &enable_recursive_minibuffers,
1156 "*Non-nil means to allow minibuffer commands while in the minibuffer.\n\
1157More precisely, this variable makes a difference when the minibuffer window\n\
1158is the selected window. If you are in some other window, minibuffer commands\n\
1159are allowed even if a minibuffer is active.");
1160 enable_recursive_minibuffers = 0;
1161
1162 DEFVAR_LISP ("minibuffer-completion-table", &Vminibuffer_completion_table,
1163 "Alist or obarray used for completion in the minibuffer.\n\
1164This becomes the ALIST argument to `try-completion' and `all-completion'.\n\
1165\n\
1166The value may alternatively be a function, which is given three arguments:\n\
1167 STRING, the current buffer contents;\n\
1168 PREDICATE, the predicate for filtering possible matches;\n\
1169 CODE, which says what kind of things to do.\n\
1170CODE can be nil, t or `lambda'.\n\
1171nil means to return the best completion of STRING, or nil if there is none.\n\
1172t means to return a list of all possible completions of STRING.\n\
1173`lambda' means to return t if STRING is a valid completion as it stands.");
1174 Vminibuffer_completion_table = Qnil;
1175
1176 DEFVAR_LISP ("minibuffer-completion-predicate", &Vminibuffer_completion_predicate,
1177 "Within call to `completing-read', this holds the PREDICATE argument.");
1178 Vminibuffer_completion_predicate = Qnil;
1179
1180 DEFVAR_LISP ("minibuffer-completion-confirm", &Vminibuffer_completion_confirm,
1181 "Non-nil => demand confirmation of completion before exiting minibuffer.");
1182 Vminibuffer_completion_confirm = Qnil;
1183
1184 DEFVAR_LISP ("minibuffer-help-form", &Vminibuffer_help_form,
1185 "Value that `help-form' takes on inside the minibuffer.");
1186 Vminibuffer_help_form = Qnil;
1187
1188 defsubr (&Sread_from_minibuffer);
1189 defsubr (&Seval_minibuffer);
1190 defsubr (&Sread_minibuffer);
1191 defsubr (&Sread_string);
1192 defsubr (&Sread_command);
1193 defsubr (&Sread_variable);
1194 defsubr (&Sread_buffer);
1195 defsubr (&Sread_no_blanks_input);
1196 defsubr (&Sminibuffer_depth);
1197
1198 defsubr (&Stry_completion);
1199 defsubr (&Sall_completions);
1200 defsubr (&Scompleting_read);
1201 defsubr (&Sminibuffer_complete);
1202 defsubr (&Sminibuffer_complete_word);
1203 defsubr (&Sminibuffer_complete_and_exit);
1204 defsubr (&Sdisplay_completion_list);
1205 defsubr (&Sminibuffer_completion_help);
1206
1207 defsubr (&Sself_insert_and_exit);
1208 defsubr (&Sexit_minibuffer);
1209
1210}
1211
1212keys_of_minibuf ()
1213{
1214 initial_define_key (Vminibuffer_local_map, Ctl ('g'),
1215 "abort-recursive-edit");
1216 initial_define_key (Vminibuffer_local_map, Ctl ('m'),
1217 "exit-minibuffer");
1218 initial_define_key (Vminibuffer_local_map, Ctl ('j'),
1219 "exit-minibuffer");
1220
1221 initial_define_key (Vminibuffer_local_ns_map, Ctl ('g'),
1222 "abort-recursive-edit");
1223 initial_define_key (Vminibuffer_local_ns_map, Ctl ('m'),
1224 "exit-minibuffer");
1225 initial_define_key (Vminibuffer_local_ns_map, Ctl ('j'),
1226 "exit-minibuffer");
1227
1228 initial_define_key (Vminibuffer_local_ns_map, ' ',
1229 "exit-minibuffer");
1230 initial_define_key (Vminibuffer_local_ns_map, '\t',
1231 "exit-minibuffer");
1232 initial_define_key (Vminibuffer_local_ns_map, '?',
1233 "self-insert-and-exit");
1234
1235 initial_define_key (Vminibuffer_local_completion_map, Ctl ('g'),
1236 "abort-recursive-edit");
1237 initial_define_key (Vminibuffer_local_completion_map, Ctl ('m'),
1238 "exit-minibuffer");
1239 initial_define_key (Vminibuffer_local_completion_map, Ctl ('j'),
1240 "exit-minibuffer");
1241
1242 initial_define_key (Vminibuffer_local_completion_map, '\t',
1243 "minibuffer-complete");
1244 initial_define_key (Vminibuffer_local_completion_map, ' ',
1245 "minibuffer-complete-word");
1246 initial_define_key (Vminibuffer_local_completion_map, '?',
1247 "minibuffer-completion-help");
1248
1249 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('g'),
1250 "abort-recursive-edit");
1251 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('m'),
1252 "minibuffer-complete-and-exit");
1253 initial_define_key (Vminibuffer_local_must_match_map, Ctl ('j'),
1254 "minibuffer-complete-and-exit");
1255 initial_define_key (Vminibuffer_local_must_match_map, '\t',
1256 "minibuffer-complete");
1257 initial_define_key (Vminibuffer_local_must_match_map, ' ',
1258 "minibuffer-complete-word");
1259 initial_define_key (Vminibuffer_local_must_match_map, '?',
1260 "minibuffer-completion-help");
1261}