procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from emacs--devo--0

Browse source 
Patches applied:

 * emacs--devo--0  (patch 490-504)

   - Update from CVS
   - Merge from gnus--rel--5.10

 * gnus--rel--5.10  (patch 161-163)

   - Update from CVS
   - Merge from emacs--devo--0

Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-130
This commit is contained in:
Miles Bader 2006-11-07 23:22:48 +00:00
commit dbc3b08c40
156 changed files with 8249 additions and 4836 deletions
Download patch file Download diff file Expand all files Collapse all files

15
ChangeLog
View file

@ -1,3 +1,18 @@
2006-11-04 Romain Francoise <romain@orebokech.com>
* Makefile.in (bootstrap-clean-before): Use new target `bootstrap-clean'
in the leim subdirectory.
Fix typo.
2006-11-03 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
* configure.in: Enable sparc64/ia64/powerpc FreeBSD builds.
2006-10-30 Chong Yidong <cyd@stupidchicken.com>
* make-dist: Add makefile.w32-in to the man, lispref and lispintro
directories.
2006-10-29 Chong Yidong <cyd@stupidchicken.com>
* configure: Regenerate using autoconf 2.59.

3
Makefile.in
View file

@ -280,7 +280,7 @@ epaths-force: FRC
-e 's;/[*] *arch-tag:.*;/*;') && \
${srcdir}/move-if-change epaths.h.$$$$ src/epaths.h
# For parallel make, src should be build before leim.
# For parallel make, src should be built before leim.
# "export PARALLEL=0" is for SGI's Make, to prevent it from
# running more than 1 process in the leim directory, especially for
# the $TIT files there.
@ -790,6 +790,7 @@ bootstrap-build: FRC
### Used for `bootstrap' to avoid deleting existing dumped Emacs executables.
bootstrap-clean-before: bootstrap-clean-before-fast FRC
(cd lisp; $(MAKE) $(MFLAGS) bootstrap-clean)
(cd leim; $(MAKE) $(MFLAGS) bootstrap-clean)
### Used for `bootfast' to avoid deleting existing dumped Emacs executables
### and compiled .elc files.

5
admin/ChangeLog
View file

@ -1,3 +1,8 @@
2006-11-06 Reiner Steib <Reiner.Steib@gmx.de>
* FOR-RELEASE (BUGS): Remove "Build failure under Suse 10.0" was
due to a local miss-configuration.
2006-10-28 Chong Yidong <cyd@stupidchicken.com>
* make-announcement (OLD): Remove LEIM references in announcement

6
admin/FOR-RELEASE
View file

@ -43,7 +43,11 @@ to the hack introduced on 2005-07-01 to fix some other Cleartype problem.
* BUGS
** david.reitter@gmail.com, Oct 16: url-retrieve may cause hang
** triska@gmx.at, Nov 2: EMACS environment variable.
** offby1@blarg.net, Nov 5: calendar gets wrong end for Daylight Savings Time
** CC mode defun-finding issues.
* DOCUMENTATION

3
configure.in
View file

@ -246,6 +246,9 @@ case "${canonical}" in
opsys=freebsd
case "${canonical}" in
alpha*-*-freebsd*) machine=alpha ;;
ia64-*-freebsd*) machine=ia64 ;;
sparc64-*-freebsd*) machine=sparc ;;
powerpc-*-freebsd*) machine=macppc ;;
i[3456]86-*-freebsd*) machine=intel386 ;;
amd64-*-freebsd*|x86_64-*-freebsd*) machine=amdx86-64 ;;
esac

5
etc/ChangeLog
View file

@ -1,3 +1,8 @@
2006-11-05 Slawomir Nowaczyk <slawek@cs.lth.se> (tiny change)
* emacs.py (eargs): Provide eldoc message for builtin types.
Make sure eargs always outputs sentinel, to avoid emacs freeze.
2006-10-22 Chong Yidong <cyd@stupidchicken.com>
* emacs.py (eargs): Return expected _emacs_out string even if

16
etc/PROBLEMS
View file

@ -1284,6 +1284,11 @@ be carried out at the same time:
For more about lbxproxy, see:
http://www.xfree86.org/4.3.0/lbxproxy.1.html
5) If copying and killing is slow, try to disable the interaction with the
native system's clipboard by adding these lines to your .emacs file:
(setq interprogram-cut-function nil)
(setq interprogram-paste-function nil)
*** Emacs gives the error, Couldn't find per display information.
This can result if the X server runs out of memory because Emacs uses
@ -2326,7 +2331,16 @@ This results from a bug in a VERY old version of GNU Sed. To solve
the problem, install the current version of GNU Sed, then rerun
Emacs's configure script.
*** Building the MS-Windows port with Cygwin GCC can fail.
*** Building the Cygwin port for MS-Windows can fail with some GCC version
Building Emacs 22 with Cygwin builds of GCC 3.4.4-1 and 3.4.4-2 is
reported to either fail or cause Emacs to segfault at run time. In
addition, the Cygwin GCC 3.4.4-2 has problems with generating debug
info. Cygwin users are advised not to use these versions of GCC for
compiling Emacs. GCC versions 4.0.3 and 4.1.1 reportedly build a
working Cygwin binary of Emacs, so we recommend these GCC versions.
*** Building the native MS-Windows port with Cygwin GCC can fail.
Emacs may not build using recent Cygwin builds of GCC, such as Cygwin
version 1.1.8, using the default configure settings. It appears to be

4
etc/emacs.py
View file

@ -50,11 +50,11 @@ def eargs (name, imports):
if len (parts) > 1:
exec 'import ' + parts[0] # might fail
func = eval (name)
if inspect.isbuiltin (func):
if inspect.isbuiltin (func) or type(func) is type:
doc = func.__doc__
if doc.find (' ->') != -1:
print '_emacs_out', doc.split (' ->')[0]
elif doc.find ('\n') != -1:
else:
print '_emacs_out', doc.split ('\n')[0]
return
if inspect.ismethod (func):

4
leim/ChangeLog
View file

@ -1,3 +1,7 @@
2006-11-04 Romain Francoise <romain@orebokech.com>
* Makefile.in (bootstrap-clean): New target.
2006-10-12 Kenichi Handa <handa@m17n.org>
* Makefile.in (install): Be sure to make ${INSTALLDIR} before `cd'

6
leim/Makefile.in
View file

@ -255,6 +255,12 @@ clean mostlyclean:
rm -f ${TIT-MISC} ${TIT-MISC:.elc=.el} \
leim-list.el changed.tit changed.misc
# The following target is needed because the `clean' target only removes
# TIT-generated files and doesn't touch compiled Quail packages. But
# bootstrapping should not leave non-fresh .elc files behind.
bootstrap-clean: clean
rm -f ${WORLD}
distclean: clean
if test -f stamp-subdir; then rm -rf ${SUBDIRS} stamp-subdir; fi
rm -f Makefile

502
lib-src/ChangeLog
View file

File diff suppressed because it is too large Load diff

5
lib-src/Makefile.in
View file

@ -94,6 +94,7 @@ gameuser=@gameuser@
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
# By default, we uphold the dignity of our programs.
INSTALL_STRIP =
@ -319,7 +320,7 @@ $(DESTDIR)${archlibdir}: all
if [ `(cd $(DESTDIR)${archlibdir} && /bin/pwd)` \
!= `(cd ${srcdir} && /bin/pwd)` ]; then \
for file in ${SCRIPTS}; do \
$(INSTALL_PROGRAM) ${srcdir}/$$file $(DESTDIR)${archlibdir}/$$file; \
$(INSTALL_SCRIPT) ${srcdir}/$$file $(DESTDIR)${archlibdir}/$$file; \
done ; \
fi
@ -331,7 +332,7 @@ install: $(DESTDIR)${archlibdir}
chmod a+rx $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'`; \
done
for file in ${INSTALLABLE_SCRIPTS} ; do \
$(INSTALL_PROGRAM) ${srcdir}/$${file} $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'` ; \
$(INSTALL_SCRIPT) ${srcdir}/$${file} $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'` ; \
chmod a+rx $(DESTDIR)${bindir}/`echo $${file} | sed '$(TRANSFORM)'`; \
done

670
lib-src/emacsclient.c
View file

@ -26,19 +26,49 @@ Boston, MA 02110-1301, USA. */
#include <config.h>
#endif
#ifdef WINDOWSNT
# include <malloc.h>
# include <stdlib.h>
# define HAVE_SOCKETS
# define HAVE_INET_SOCKETS
# define NO_SOCKETS_IN_FILE_SYSTEM
# define HSOCKET SOCKET
# define CLOSE_SOCKET closesocket
# define INITIALIZE() (initialize_sockets ())
#else /* !WINDOWSNT */
# ifdef HAVE_INET_SOCKETS
# include <netinet/in.h>
# endif
# define INVALID_SOCKET -1
# define HSOCKET int
# define CLOSE_SOCKET close
# define INITIALIZE()
#endif /* !WINDOWSNT */
#undef signal
#include <ctype.h>
#include <stdio.h>
#include <getopt.h>
#include "getopt.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef VMS
# include "vms-pwd.h"
#else
#else /* not VMS */
#ifdef WINDOWSNT
# include <io.h>
#else /* not WINDOWSNT */
# include <pwd.h>
#endif /* not WINDOWSNT */
#endif /* not VMS */
char *getenv (), *getwd ();
@ -48,6 +78,29 @@ char *(getcwd) ();
#define VERSION "unspecified"
#endif
#define SEND_STRING(data) (send_to_emacs (s, (data)))
#define SEND_QUOTED(data) (quote_file_name (s, (data)))
#ifndef EXIT_SUCCESS
#define EXIT_SUCCESS 0
#endif
#ifndef EXIT_FAILURE
#define EXIT_FAILURE 1
#endif
#ifndef FALSE
#define FALSE 0
#endif
#ifndef TRUE
#define TRUE 1
#endif
#ifndef NO_RETURN
#define NO_RETURN
#endif
/* Name used to invoke this program. */
char *progname;
@ -62,11 +115,14 @@ char *display = NULL;
/* If non-NULL, the name of an editor to fallback to if the server
is not running. --alternate-editor. */
const char * alternate_editor = NULL;
const char *alternate_editor = NULL;
/* If non-NULL, the filename of the UNIX socket. */
char *socket_name = NULL;
/* If non-NULL, the filename of the authentication file. */
char *server_file = NULL;
void print_help_and_exit () NO_RETURN;
struct option longopts[] =
@ -76,7 +132,10 @@ struct option longopts[] =
{ "help", no_argument, NULL, 'H' },
{ "version", no_argument, NULL, 'V' },
{ "alternate-editor", required_argument, NULL, 'a' },
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
{ "socket-name", required_argument, NULL, 's' },
#endif
{ "server-file", required_argument, NULL, 'f' },
{ "display", required_argument, NULL, 'd' },
{ 0, 0, 0, 0 }
};
@ -94,7 +153,12 @@ decode_options (argc, argv)
while (1)
{
int opt = getopt_long (argc, argv,
"VHnea:s:d:", longopts, 0);
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
"VHnea:s:f:d:",
#else
"VHnea:f:d:",
#endif
longopts, 0);
if (opt == EOF)
break;
@ -110,9 +174,15 @@ decode_options (argc, argv)
alternate_editor = optarg;
break;
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
case 's':
socket_name = optarg;
break;
#endif
case 'f':
server_file = optarg;
break;
case 'd':
display = optarg;
@ -156,9 +226,13 @@ The following OPTIONS are accepted:\n\
-H, --help Print this usage information message\n\
-n, --no-wait Don't wait for the server to return\n\
-e, --eval Evaluate the FILE arguments as ELisp expressions\n\
-d, --display=DISPLAY Visit the file in the given display\n\
-s, --socket-name=FILENAME\n\
Set the filename of the UNIX socket for communication\n\
-d, --display=DISPLAY Visit the file in the given display\n"
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
"-s, --socket-name=FILENAME\n\
Set the filename of the UNIX socket for communication\n"
#endif
"-f, --server-file=FILENAME\n\
Set the filename of the TCP configuration file\n\
-a, --alternate-editor=EDITOR\n\
Editor to fallback to if the server is not running\n\
\n\
@ -166,14 +240,112 @@ Report bugs to bug-gnu-emacs@gnu.org.\n", progname);
exit (EXIT_SUCCESS);
}
/*
Try to run a different command, or --if no alternate editor is
defined-- exit with an errorcode.
*/
void
fail (argc, argv)
int argc;
char **argv;
{
if (alternate_editor)
{
int i = optind - 1;
#ifdef WINDOWSNT
argv[i] = (char *)alternate_editor;
#endif
execvp (alternate_editor, argv + i);
fprintf (stderr, "%s: error executing alternate editor \"%s\"\n",
progname, alternate_editor);
}
exit (EXIT_FAILURE);
}
#if !defined (HAVE_SOCKETS) || !defined (HAVE_INET_SOCKETS)
int
main (argc, argv)
int argc;
char **argv;
{
fprintf (stderr, "%s: Sorry, the Emacs server is supported only\n",
argv[0]);
fprintf (stderr, "on systems with Berkeley sockets.\n");
fail (argc, argv);
}
#else /* HAVE_SOCKETS && HAVE_INET_SOCKETS */
#ifdef WINDOWSNT
# include <winsock2.h>
#else
# include <sys/types.h>
# include <sys/socket.h>
# include <sys/un.h>
# include <sys/stat.h>
# include <errno.h>
#endif
#define AUTH_KEY_LENGTH 64
#define SEND_BUFFER_SIZE 4096
extern char *strerror ();
extern int errno;
/* Buffer to accumulate data to send in TCP connections. */
char send_buffer[SEND_BUFFER_SIZE + 1];
int sblen = 0; /* Fill pointer for the send buffer. */
/* Let's send the data to Emacs when either
- the data ends in "\n", or
- the buffer is full (but this shouldn't happen)
Otherwise, we just accumulate it. */
void
send_to_emacs (s, data)
HSOCKET s;
char *data;
{
while (data)
{
int dlen = strlen (data);
if (dlen + sblen >= SEND_BUFFER_SIZE)
{
int part = SEND_BUFFER_SIZE - sblen;
strncpy (&send_buffer[sblen], data, part);
data += part;
sblen = SEND_BUFFER_SIZE;
}
else if (dlen)
{
strcpy (&send_buffer[sblen], data);
data = NULL;
sblen += dlen;
}
else
break;
if (sblen == SEND_BUFFER_SIZE
|| (sblen > 0 && send_buffer[sblen-1] == '\n'))
{
int sent = send (s, send_buffer, sblen, 0);
if (sent != sblen)
strcpy (send_buffer, &send_buffer[sent]);
sblen -= sent;
}
}
}
/* In NAME, insert a & before each &, each space, each newline, and
any initial -. Change spaces to underscores, too, so that the
return value never contains a space. */
void
quote_file_name (name, stream)
quote_file_name (s, name)
HSOCKET s;
char *name;
FILE *stream;
{
char *copy = (char *) malloc (strlen (name) * 2 + 1);
char *p, *q;
@ -203,73 +375,202 @@ quote_file_name (name, stream)
}
*q++ = 0;
fprintf (stream, "%s", copy);
SEND_STRING (copy);
free (copy);
}
/* Like malloc but get fatal error if memory is exhausted. */
long *
xmalloc (size)
unsigned int size;
int
file_name_absolute_p (filename)
const unsigned char *filename;
{
long *result = (long *) malloc (size);
if (result == NULL)
{
perror ("malloc");
exit (EXIT_FAILURE);
}
return result;
/* Sanity check, it shouldn't happen. */
if (! filename) return FALSE;
/* /xxx is always an absolute path. */
if (filename[0] == '/') return TRUE;
/* Empty filenames (which shouldn't happen) are relative. */
if (filename[0] == '\0') return FALSE;
#ifdef WINDOWSNT
/* X:\xxx is always absolute; X:xxx is an error and will fail. */
if (islower (tolower (filename[0]))
&& filename[1] == ':' && filename[2] == '\\')
return TRUE;
/* Both \xxx and \\xxx\yyy are absolute. */
if (filename[0] == '\\') return TRUE;
#endif
return FALSE;
}
#ifdef WINDOWSNT
/* Wrapper to make WSACleanup a cdecl, as required by atexit(). */
void
__cdecl close_winsock ()
{
WSACleanup ();
}
/* Initialize the WinSock2 library. */
void
initialize_sockets ()
{
WSADATA wsaData;
if (WSAStartup (MAKEWORD (2, 0), &wsaData))
{
fprintf (stderr, "%s: error initializing WinSock2", progname);
exit (EXIT_FAILURE);
}
atexit (close_winsock);
}
#endif /* WINDOWSNT */
/*
Try to run a different command, or --if no alternate editor is
defined-- exit with an errorcode.
* Read the information needed to set up a TCP comm channel with
* the Emacs server: host, port, pid and authentication string.
*/
void
fail (argc, argv)
int argc;
char **argv;
int
get_server_config (server, authentication)
struct sockaddr_in *server;
char *authentication;
{
if (alternate_editor)
char dotted[32];
char *port;
char *pid;
FILE *config = NULL;
if (file_name_absolute_p (server_file))
config = fopen (server_file, "rb");
else
{
int i = optind - 1;
execvp (alternate_editor, argv + i);
return;
char *home = getenv ("HOME");
if (home)
{
char *path = alloca (32 + strlen (home) + strlen (server_file));
sprintf (path, "%s/.emacs.d/server/%s", home, server_file);
config = fopen (path, "rb");
}
#ifdef WINDOWSNT
if (!config && (home = getenv ("APPDATA")))
{
char *path = alloca (32 + strlen (home) + strlen (server_file));
sprintf (path, "%s/.emacs.d/server/%s", home, server_file);
config = fopen (path, "rb");
}
#endif
}
if (! config)
return FALSE;
if (fgets (dotted, sizeof dotted, config)
&& (port = strchr (dotted, ':'))
&& (pid = strchr (port, ' ')))
{
*port++ = '\0';
*pid++ = '\0';
}
else
{
fprintf (stderr, "%s: invalid configuration info", progname);
exit (EXIT_FAILURE);
}
server->sin_family = AF_INET;
server->sin_addr.s_addr = inet_addr (dotted);
server->sin_port = htons (atoi (port));
if (! fread (authentication, AUTH_KEY_LENGTH, 1, config))
{
fprintf (stderr, "%s: cannot read authentication info", progname);
exit (EXIT_FAILURE);
}
fclose (config);
#ifdef WINDOWSNT
/*
Modern Windows restrict which processes can set the foreground window.
So, for emacsclient to be able to force Emacs into the foreground, we
have to call AllowSetForegroundWindow(). Unfortunately, older Windows
(W95, W98 and NT) don't have this function, so we have to check first.
We're doing this here because it has to be done before sending info
to Emacs, and otherwise we'll need a global variable just to pass around
the pid, which is also inelegant.
*/
{
HMODULE hUser32;
if (hUser32 = LoadLibrary ("user32.dll"))
{
void (*set_fg)(DWORD);
if (set_fg = GetProcAddress (hUser32, "AllowSetForegroundWindow"))
set_fg (atoi (pid));
FreeLibrary (hUser32);
}
}
#endif
return TRUE;
}
#if !defined (HAVE_SOCKETS) || defined (NO_SOCKETS_IN_FILE_SYSTEM)
int
main (argc, argv)
int argc;
char **argv;
HSOCKET
set_tcp_socket ()
{
fprintf (stderr, "%s: Sorry, the Emacs server is supported only\n",
argv[0]);
fprintf (stderr, "on systems with Berkeley sockets.\n");
HSOCKET s;
struct sockaddr_in server;
struct linger l_arg = {1, 1};
char auth_string[AUTH_KEY_LENGTH + 1];
fail (argc, argv);
if (! get_server_config (&server, auth_string))
return INVALID_SOCKET;
if (server.sin_addr.s_addr != inet_addr ("127.0.0.1"))
fprintf (stderr, "%s: connected to remote socket at %s\n",
progname, inet_ntoa (server.sin_addr));
/*
* Open up an AF_INET socket
*/
if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0)
{
fprintf (stderr, "%s: ", progname);
perror ("socket");
return INVALID_SOCKET;
}
/*
* Set up the socket
*/
if (connect (s, (struct sockaddr *) &server, sizeof server) < 0)
{
fprintf (stderr, "%s: ", progname);
perror ("connect");
return INVALID_SOCKET;
}
setsockopt (s, SOL_SOCKET, SO_LINGER, (char *) &l_arg, sizeof l_arg);
/*
* Send the authentication
*/
auth_string[AUTH_KEY_LENGTH] = '\0';
SEND_STRING ("-auth ");
SEND_STRING (auth_string);
SEND_STRING ("\n");
return s;
}
#else /* HAVE_SOCKETS */
#include <sys/types.h>
#include <sys/socket.h>
#include <sys/un.h>
#include <sys/stat.h>
#include <errno.h>
extern char *strerror ();
extern int errno;
#if !defined (NO_SOCKETS_IN_FILE_SYSTEM)
/* Three possibilities:
2 - can't be `stat'ed (sets errno)
@ -291,28 +592,11 @@ socket_status (socket_name)
return 0;
}
int
main (argc, argv)
int argc;
char **argv;
HSOCKET
set_local_socket ()
{
int s, i, needlf = 0;
FILE *out, *in;
HSOCKET s;
struct sockaddr_un server;
char *cwd, *str;
char string[BUFSIZ];
progname = argv[0];
/* Process options. */
decode_options (argc, argv);
if ((argc - optind < 1) && !eval)
{
fprintf (stderr, "%s: file name or argument required\n", progname);
fprintf (stderr, "Try `%s --help' for more information\n", progname);
exit (EXIT_FAILURE);
}
/*
* Open up an AF_UNIX socket in this person's home directory
@ -320,9 +604,9 @@ main (argc, argv)
if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0)
{
fprintf (stderr, "%s: ", argv[0]);
fprintf (stderr, "%s: ", progname);
perror ("socket");
fail (argc, argv);
return INVALID_SOCKET;
}
server.sun_family = AF_UNIX;
@ -352,7 +636,7 @@ main (argc, argv)
else
{
fprintf (stderr, "%s: socket-name %s too long",
argv[0], socket_name);
progname, socket_name);
exit (EXIT_FAILURE);
}
@ -387,7 +671,7 @@ main (argc, argv)
else
{
fprintf (stderr, "%s: socket-name %s too long",
argv[0], socket_name);
progname, socket_name);
exit (EXIT_FAILURE);
}
@ -399,61 +683,129 @@ main (argc, argv)
}
}
switch (sock_status)
{
case 1:
/* There's a socket, but it isn't owned by us. This is OK if
we are root. */
if (0 != geteuid ())
{
fprintf (stderr, "%s: Invalid socket owner\n", argv[0]);
fail (argc, argv);
}
break;
switch (sock_status)
{
case 1:
/* There's a socket, but it isn't owned by us. This is OK if
we are root. */
if (0 != geteuid ())
{
fprintf (stderr, "%s: Invalid socket owner\n", progname);
return INVALID_SOCKET;
}
break;
case 2:
/* `stat' failed */
if (saved_errno == ENOENT)
fprintf (stderr,
"%s: can't find socket; have you started the server?\n\
case 2:
/* `stat' failed */
if (saved_errno == ENOENT)
fprintf (stderr,
"%s: can't find socket; have you started the server?\n\
To start the server in Emacs, type \"M-x server-start\".\n",
argv[0]);
else
fprintf (stderr, "%s: can't stat %s: %s\n",
argv[0], server.sun_path, strerror (saved_errno));
fail (argc, argv);
break;
}
progname);
else
fprintf (stderr, "%s: can't stat %s: %s\n",
progname, server.sun_path, strerror (saved_errno));
return INVALID_SOCKET;
}
}
if (connect (s, (struct sockaddr *) &server, strlen (server.sun_path) + 2)
< 0)
{
fprintf (stderr, "%s: ", argv[0]);
fprintf (stderr, "%s: ", progname);
perror ("connect");
fail (argc, argv);
return INVALID_SOCKET;
}
/* We use the stream OUT to send our command to the server. */
if ((out = fdopen (s, "r+")) == NULL)
return s;
}
#endif /* ! NO_SOCKETS_IN_FILE_SYSTEM */
HSOCKET
set_socket ()
{
HSOCKET s;
INITIALIZE ();
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
/* Explicit --socket-name argument. */
if (socket_name)
{
fprintf (stderr, "%s: ", argv[0]);
perror ("fdopen");
fail (argc, argv);
s = set_local_socket ();
if ((s != INVALID_SOCKET) || alternate_editor)
return s;
fprintf (stderr, "%s: error accessing socket \"%s\"",
progname, socket_name);
exit (EXIT_FAILURE);
}
#endif
/* Explicit --server-file arg or EMACS_SERVER_FILE variable. */
if (!server_file)
server_file = getenv ("EMACS_SERVER_FILE");
if (server_file)
{
s = set_tcp_socket ();
if ((s != INVALID_SOCKET) || alternate_editor)
return s;
fprintf (stderr, "%s: error accessing server file \"%s\"",
progname, server_file);
exit (EXIT_FAILURE);
}
/* We use the stream IN to read the response.
We used to use just one stream for both output and input
on the socket, but reversing direction works nonportably:
on some systems, the output appears as the first input;
on other systems it does not. */
if ((in = fdopen (s, "r+")) == NULL)
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
/* Implicit local socket. */
s = set_local_socket ();
if (s != INVALID_SOCKET)
return s;
#endif
/* Implicit server file. */
server_file = "server";
s = set_tcp_socket ();
if ((s != INVALID_SOCKET) || alternate_editor)
return s;
/* No implicit or explicit socket, and no alternate editor. */
fprintf (stderr, "%s: No socket or alternate editor. Please use:\n\n"
#ifndef NO_SOCKETS_IN_FILE_SYSTEM
"\t--socket-name\n"
#endif
"\t--server-file (or environment variable EMACS_SERVER_FILE)\n\
\t--alternate-editor (or environment variable ALTERNATE_EDITOR)\n",
progname);
exit (EXIT_FAILURE);
}
int
main (argc, argv)
int argc;
char **argv;
{
HSOCKET s;
int i, rl, needlf = 0;
char *cwd;
char string[BUFSIZ+1];
progname = argv[0];
/* Process options. */
decode_options (argc, argv);
if ((argc - optind < 1) && !eval)
{
fprintf (stderr, "%s: ", argv[0]);
perror ("fdopen");
fail (argc, argv);
fprintf (stderr, "%s: file name or argument required\n", progname);
fprintf (stderr, "Try `%s --help' for more information\n", progname);
exit (EXIT_FAILURE);
}
if ((s = set_socket ()) == INVALID_SOCKET)
fail (argc, argv);
#ifdef HAVE_GETCWD
cwd = getcwd (string, sizeof string);
#else
@ -462,27 +814,26 @@ To start the server in Emacs, type \"M-x server-start\".\n",
if (cwd == 0)
{
/* getwd puts message in STRING if it fails. */
#ifdef HAVE_GETCWD
fprintf (stderr, "%s: %s (%s)\n", argv[0],
fprintf (stderr, "%s: %s (%s)\n", progname,
"Cannot get current working directory", strerror (errno));
#else
fprintf (stderr, "%s: %s (%s)\n", argv[0], string, strerror (errno));
fprintf (stderr, "%s: %s (%s)\n", progname, string, strerror (errno));
#endif
fail (argc, argv);
}
if (nowait)
fprintf (out, "-nowait ");
SEND_STRING ("-nowait ");
if (eval)
fprintf (out, "-eval ");
SEND_STRING ("-eval ");
if (display)
{
fprintf (out, "-display ");
quote_file_name (display, out);
fprintf (out, " ");
SEND_STRING ("-display ");
SEND_QUOTED (display);
SEND_STRING (" ");
}
if ((argc - optind > 0))
@ -497,61 +848,62 @@ To start the server in Emacs, type \"M-x server-start\".\n",
while (isdigit ((unsigned char) *p) || *p == ':') p++;
if (*p != 0)
{
quote_file_name (cwd, out);
fprintf (out, "/");
SEND_QUOTED (cwd);
SEND_STRING ("/");
}
}
else if (*argv[i] != '/')
else if (! file_name_absolute_p (argv[i]))
{
quote_file_name (cwd, out);
fprintf (out, "/");
SEND_QUOTED (cwd);
SEND_STRING ("/");
}
quote_file_name (argv[i], out);
fprintf (out, " ");
SEND_QUOTED (argv[i]);
SEND_STRING (" ");
}
}
else
{
while ((str = fgets (string, BUFSIZ, stdin)))
while (fgets (string, BUFSIZ, stdin))
{
quote_file_name (str, out);
SEND_QUOTED (string);
}
fprintf (out, " ");
SEND_STRING (" ");
}
fprintf (out, "\n");
fflush (out);
SEND_STRING ("\n");
/* Maybe wait for an answer. */
if (nowait)
return EXIT_SUCCESS;
if (!eval)
if (!nowait)
{
printf ("Waiting for Emacs...");
needlf = 2;
}
fflush (stdout);
if (!eval)
{
printf ("Waiting for Emacs...");
needlf = 2;
}
fflush (stdout);
/* Now, wait for an answer and print any messages. */
while ((str = fgets (string, BUFSIZ, in)))
{
if (needlf == 2)
printf ("\n");
printf ("%s", str);
needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
/* Now, wait for an answer and print any messages. */
while ((rl = recv (s, string, BUFSIZ, 0)) > 0)
{
string[rl] = '\0';
if (needlf == 2)
printf ("\n");
printf ("%s", string);
needlf = string[0] == '\0' ? needlf : string[strlen (string) - 1] != '\n';
}
if (needlf)
printf ("\n");
fflush (stdout);
}
if (needlf)
printf ("\n");
fflush (stdout);
CLOSE_SOCKET (s);
return EXIT_SUCCESS;
}
#endif /* HAVE_SOCKETS */
#endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */
#ifndef HAVE_STRERROR
char *
strerror (errnum)

45
lib-src/grep-changelog
View file

@ -36,22 +36,33 @@ use vars qw($author $regexp $exclude $from_date $to_date
@entries);
use Getopt::Long;
my $result = GetOptions ("author=s" => \$author,
"text=s" => \$regexp,
"exclude=s" => \$exclude,
"from-date=s" => \$from_date,
"to-date=s" => \$to_date,
"rcs-log" => \$rcs_log,
"with-date" => \$with_date,
"reverse!" => \$reverse,
"version" => \$version,
"help" => \$help);
# If date options are specified, check that they have the format
# YYYY-MM-DD.
my $result;
$result = 0 if $from_date && $from_date !~ /^\d\d\d\d-\d\d-\d\d$/;
$result = 0 if $to_date && $to_date !~ /^\d\d\d\d-\d\d-\d\d$/;
if (@ARGV == 0) {
# No arguments cannot posibly mean "show everything"!!
$result = 0;
} else {
$result = GetOptions ("author=s" => \$author,
"text=s" => \$regexp,
"exclude=s" => \$exclude,
"from-date=s" => \$from_date,
"to-date=s" => \$to_date,
"rcs-log" => \$rcs_log,
"with-date" => \$with_date,
"reverse!" => \$reverse,
"version" => \$version,
"help" => \$help);
# If date options are specified, check that they have the format
# YYYY-MM-DD.
$result = 0 if $from_date && $from_date !~ /^\d\d\d\d-\d\d-\d\d$/;
$result = 0 if $to_date && $to_date !~ /^\d\d\d\d-\d\d-\d\d$/;
}
# Print usage information and exit when necessary.
@ -77,7 +88,7 @@ Valid options are:
--help Print this help
If no CHANGELOG is specified scan the files "ChangeLog" and
"ChangeLog.1+" in the current directory. Old-style dates in ChangeLogs
"ChangeLog.N+" in the current directory. Old-style dates in ChangeLogs
are not recognized.
USAGE
exit !$help;
@ -86,7 +97,7 @@ USAGE
# Print version info and exit if `--version' was specified.
if ($version) {
print "0.2\n";
print "0.3\n";
exit 0;
}
@ -233,7 +244,7 @@ sub parse_changelog {
# If files were specified on the command line, parse those files in the
# order supplied by the user; otherwise parse default files ChangeLog and
# ChangeLog.1+ according to $reverse.
# ChangeLog.NNN according to $reverse.
unless (@ARGV > 0) {
@ARGV = ("ChangeLog");

27
lib-src/makefile.w32-in
View file

@ -20,7 +20,7 @@
# Boston, MA 02110-1301, USA.
#
ALL = make-docfile hexl ctags etags movemail ebrowse sorted-doc digest-doc
ALL = make-docfile hexl ctags etags movemail ebrowse sorted-doc digest-doc emacsclient
.PHONY: $(ALL)
@ -32,7 +32,6 @@ LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DSTDC_HEADERS=1 -DNO_LDAV=1 \
#
# $(BLD)/server.exe \
# $(BLD)/emacstool.exe \
# $(BLD)/emacsclient.exe \
# $(BLD)/cvtmail.exe \
LIBS = $(BASE_LIBS) $(ADVAPI32)
@ -59,6 +58,7 @@ movemail: $(BLD) $(BLD)/movemail.exe
fakemail: $(BLD) $(BLD)/fakemail.exe
sorted-doc: $(BLD) $(BLD)/sorted-doc.exe
digest-doc: $(BLD) $(BLD)/digest-doc.exe
emacsclient: $(BLD) $(BLD)/emacsclient.exe
test-distrib: $(BLD) $(BLD)/test-distrib.exe
"$(BLD)/test-distrib.exe" "$(SRC)/testfile"
@ -74,6 +74,19 @@ $(BLD)/movemail.exe: $(MOVEMAILOBJS) getopt.h
# put wsock32.lib before $(LIBS) to ensure we don't link to ws2_32.lib
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(MOVEMAILOBJS) $(WSOCK32) $(LIBS)
ECLIENT_CFLAGS = -DWINDOWSNT -DHAVE_GETCWD -DHAVE_STRERROR -c
ECLIENTOBJS = $(BLD)/emacsclient.$(O) \
$(BLD)/getopt.$(O) \
$(BLD)/getopt1.$(O) \
$(BLD)/ntlib.$(O)
$(BLD)/emacsclient.exe: $(ECLIENTOBJS)
# put wsock32.lib before $(LIBS) to ensure we don't link to ws2_32.lib
$(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(ECLIENTOBJS) $(WSOCK32) $(LIBS)
$(BLD)/emacsclient.$(O): emacsclient.c
$(CC) $(ECLIENT_CFLAGS) $(CC_OUT)$@ emacsclient.c
ETAGSOBJ = $(BLD)/etags.$(O) \
$(BLD)/getopt.$(O) \
$(BLD)/getopt1.$(O) \
@ -253,6 +266,15 @@ lisp2 = \
$(lispsource)window.elc \
$(lispsource)version.el
# This is needed the first time we build the tree, since temacs.exe
# does not exist yet, and the DOC rule needs it to rebuild DOC whenever
# Emacs is rebuilt.
../src/$(BLD)/temacs.exe:
- mkdir "../src/$(OBJDIR)"
- mkdir "../src/$(BLD)"
@echo temacs > temacs.exe
$(CP) temacs.exe ../src/$(BLD)
- $(DEL) temacs.exe
DOC = DOC
$(DOC): $(BLD) $(BLD)/make-docfile.exe ../src/$(BLD)/temacs.exe $(lisp1) $(lisp2)
@ -286,6 +308,7 @@ install: $(INSTALL_FILES)
$(CP) $(BLD)/movemail.exe $(INSTALL_DIR)/bin
$(CP) $(BLD)/sorted-doc.exe $(INSTALL_DIR)/bin
$(CP) $(BLD)/digest-doc.exe $(INSTALL_DIR)/bin
$(CP) $(BLD)/emacsclient.exe $(INSTALL_DIR)/bin
- mkdir "$(INSTALL_DIR)/etc"
$(CP) $(DOC) $(INSTALL_DIR)/etc

457
lisp/ChangeLog
View file

@ -1,15 +1,439 @@
2006-10-29 Stephen Leake <stephen_leake@stephe_leake.org>
2006-11-07 Chong Yidong <cyd@stupidchicken.com>
* whitespace.el (whitespace-buffer): Call remove-overlays after
overlay-recenter for performance. Suggested by Martin Rudalics.
2006-11-07 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-default-method): scp is the default method.
2006-11-07 Juanma Barranquero <lekktu@gmail.com>
* server.el (server-start): Save also the Emacs pid in the server file.
2006-11-07 Carsten Dominik <dominik@science.uva.nl>
* textmodes/reftex-cite.el (reftex-pop-to-bibtex-entry): Preserve
point when displaying a bibtex cross reference in the echo area.
2006-11-06 Juanma Barranquero <lekktu@gmail.com>
* international/mule.el (make-char): Fix typo in docstring.
(load-with-code-conversion, charsetp): Doc fixes.
* international/ja-dic-cnv.el (skkdic-convert):
* cus-edit.el (hook): Fix typo in docstring.
2006-11-06 Chong Yidong <cyd@stupidchicken.com>
* cus-edit.el (custom-mode-map): Move defvar above code using it.
(custom-mode-link-map): New variable.
(custom-group-link, custom-manual): Use follow-link.
2006-11-06 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
* textmodes/bibtex.el: Fix typo in name of author of bibtex.el,
"Mark Shapiro" -> "Marc Shapiro". Update his email address.
2006-11-06 Richard Stallman <rms@gnu.org>
* textmodes/flyspell.el (flyspell-correct-word-before-point):
New function broken out of flyspell-correct-word.
(flyspell-mode-map): Bind it to M-RET.
(flyspell-correct-word): Call it.
* textmodes/fill.el (fill-minibuffer-function): New function.
(fill-paragraph): Bind fill-paragraph-function to
fill-minibuffer-function.
* ruler-mode.el (ruler-mode-map): Add bindings for up-events
so that they aren't undefined.
* dired.el (dired-readin): Locally bind file-name-coding-system.
* bindings.el: Shorten and clarify usual mode line mouse help string.
* Makefile.in (autoloads): Don't include `obsolete'.
2006-11-06 Chong Yidong <cyd@stupidchicken.com>
* printing.el (pr-alist-custom-set, pr-ps-utility-custom-set)
(pr-ps-name-custom-set, pr-txt-name-custom-set): Don't update the
Printing menu if it's not initialized.
(pr-menu-bind): Act on menu-bar-file-menu directly.
2006-11-06 Juanma Barranquero <lekktu@gmail.com>
* help.el (view-emacs-news): Fix typo in error message.
* menu-bar.el (menu-bar-update-buffers): Fix typo in menu entry.
* shadowfile.el (shadow-define-regexp-group)
(shadow-literal-groups, shadow-insert-var): Doc fixes.
(shadow-read-files): Fix typo in message.
(shadow-inhibit-overload, shadow-find, shadow-suffix)
(shadow-site-match, shadow-write-todo-file, shadow-insert-var)
(shadow-suffix, shadow-site-match, shadow-expand-file-name)
(shadow-file-match): Fix typos in docstrings.
* terminal.el (terminal-emulator): Fix typo in message.
* emacs-lisp/authors.el (authors-fixed-entries): Fix typo.
* emacs-lisp/lselect.el (x-kill-primary-selection)
(x-delete-primary-selection, x-copy-primary-selection):
Fix typos in error messages.
* emulation/edt-mapper.el: Fix typo in interactive message.
* mail/emacsbug.el (report-emacs-bug): Fix typos in output message.
* textmodes/ispell.el (ispell, ispell-local-dictionary-alist)
(ispell-help): Fix typos in docstrings.
(ispell-help): Fix typo in output message.
* allout.el (allout-adjust-file-variable)
(allout-passphrase-verifier-string)
(allout-passphrase-hint-string)
(allout-toggle-current-subtree-encryption):
* apropos.el (apropos-synonyms):
* cus-edit.el (hook):
* emacs-lock.el (emacs-lock-from-exiting):
* follow.el (follow-avoid-tail-recenter-p):
* hexl.el (hexl-mode):
* mouse-copy.el (mouse-copy-work-around-drag-bug):
* mouse.el (mouse-set-font):
* resume.el (resume-emacs-args-file):
* rfn-eshadow.el (file-name-shadow-tty-properties):
* t-mouse.el (t-mouse-process, t-mouse-mode):
* emacs-lisp/cust-print.el (custom-print-install)
(custom-print-uninstall, custom-format):
* emacs-lisp/shadow.el (list-load-path-shadows):
* emulation/tpu-edt.el (tpu-help-text)
(tpu-save-all-buffers-kill-emacs, tpu-emacs-replace)
(tpu-reset-control-keys):
* emulation/vip.el (vip-emacs-local-map)
(vip-change-mode-to-emacs):
* emulation/viper.el (viper-mode, viper-set-hooks)
(viper-major-mode-modifier-list):
* emulation/viper-init.el (viper-emacs-state-cursor-color):
* emulation/viper-keym.el (viper-emacs-kbd-map)
(viper-toggle-key):
* mail/feedmail.el (feedmail-queue-reminder)
(feedmail-queue-reminder-alist, feedmail-confirm-outgoing)
(feedmail-confirm-outgoing-timeout, feedmail-nuke-bcc)
(feedmail-nuke-resent-bcc, feedmail-fill-to-cc-fill-column)
(feedmail-sender-line, feedmail-force-binary-write)
(feedmail-from-line, feedmail-deduce-envelope-from)
(feedmail-x-mailer-line, feedmail-message-id-generator)
(feedmail-date-generator, feedmail-fiddle-plex-user-list)
(feedmail-enable-spray, feedmail-spray-this-address)
(feedmail-spray-address-fiddle-plex-list, feedmail-enable-queue)
(feedmail-queue-runner-confirm-global)
(feedmail-ask-before-queue-prompt)
(feedmail-ask-before-queue-reprompt)
(feedmail-prompt-before-queue-standard-alist)
(feedmail-prompt-before-queue-user-alist)
(feedmail-prompt-before-queue-help-supplement)
(feedmail-queue-use-send-time-for-message-id)
(feedmail-queue-default-file-slug, feedmail-queue-fqm-suffix)
(feedmail-mail-send-hook-splitter, feedmail-mail-send-hook)
(feedmail-mail-send-hook-queued)
(feedmail-confirm-addresses-hook-example)
(feedmail-last-chance-hook, feedmail-before-fcc-hook)
(feedmail-queue-runner-mode-setter)
(feedmail-queue-alternative-mail-header-separator)
(feedmail-queue-runner-message-sender)
(feedmail-buffer-eating-function, feedmail-binmail-template)
(feedmail-run-the-queue-no-prompts)
(feedmail-run-the-queue-global-prompt)
(feedmail-queue-subject-slug-maker, feedmail-fiddle-header)
(feedmail-envelope-deducer, feedmail-fiddle-date)
(feedmail-default-message-id-generator)
(feedmail-fiddle-message-id, feedmail-fiddle-x-mailer)
(feedmail-fiddle-spray-address, feedmail-deduce-address-list):
* mail/vms-pmail.el (vms-pmail-save-and-exit, vms-pmail-abort)
(vms-pmail-setup):
* play/dunnet.el (dun-help):
* play/handwrite.el (handwrite):
* play/hanoi.el (hanoi-unix-64):
* progmodes/idlwave.el (idlwave-rescan-asynchronously):
* textmodes/enriched.el (fixed):
* textmodes/org.el (org-file-apps)
(org-emphasis-regexp-components, org-emphasis-alist):
* textmodes/texinfmt.el (batch-texinfo-format):
Fix typos in docstrings.
2006-11-05 Juanma Barranquero <lekktu@gmail.com>
* loadhist.el (read-feature): Don't complete features not loaded
from a file (which make `unload-feature' to fail).
2006-11-05 Reiner Steib <Reiner.Steib@gmx.de>
* add-log.el (add-log-time-zone-rule): Mark as safe-local-variable.
2006-11-05 Chong Yidong <cyd@stupidchicken.com>
* startup.el (command-line-1): Kill emacs if the last frame is
deleted while evaluating the command-line arguments.
2006-11-05 Richard Stallman <rms@gnu.org>
* startup.el (init-file-had-error): Add doc string.
(fancy-splash-text, fancy-splash-head, fancy-splash-tail):
Use fixed-width font for keyboard key descriptions.
* cus-edit.el (custom-save-all): Error if saving in .emacs
and it had an error when loaded.
* dired-aux.el (dired-copy-file-recursive): Catch errors
from recursive copies in the loop, around the recursive call.
2006-11-05 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org>
* battery.el (battery-linux-proc-acpi): Search an ac_adapter in
`/proc/acpi/ac_adapter/*'. Ditto for the thermometers in
`/proc/acpi/thermal_zone/*'.
(battery-search-for-one-match-in-files): New. Search a regexp in
the content of some files.
2006-11-05 Martin Rudalics <rudalics@gmx.at>
* window.el (mouse-autoselect-window-now): Remove variable.
(mouse-autoselect-window-state): New variable.
(mouse-autoselect-window-start, mouse-autoselect-window-cancel)
(mouse-autoselect-window-select, handle-select-window):
Rewritten to make mouse-autoselect-window-timer a one-shot timer.
Suspend delayed autoselection during menu or popup dialog.
* info-look.el (info-lookup-guess-custom-symbol): New function
for retrieving symbol at point in custom buffers.
(top level) <info-lookup-maybe-add-help>: Add backquote and
comma to ignored characters in regexps of help specifications
for emacs-lisp-mode and lisp-interaction-mode. This permits
looking up symbols in `...' and after a comma. Add help
specifications for custom-mode and help-mode.
2006-11-04 Eli Zaretskii <eliz@gnu.org>
* mail/rmail.el (rmail-redecode-body): New optional argument RAW.
Don't encode body if RAW is non-nil, or if the old encoding is
identical to the new encoding, or if the body contains only
eight-bit-* characters.
2006-11-04 Yoni Rabkin Katzenell <yoni-r@actcom.com> (tiny change)
* faces.el (faces-sample-overlay, describe-face): Revert last
changes.
(faces-sample-overlay): Remove variable.
(describe-face): Insert sample text in the face being described.
2006-11-04 Martin Rudalics <rudalics@gmx.at>
* whitespace.el (whitespace-indent-regexp): Make this match any
multiples of eight spaces near the beginning of a line.
(whitespace-buffer): Use `remove-overlays' instead of
`whitespace-unhighlight-the-space' and `overlay-recenter' to
speed up overlay handling.
(whitespace-buffer-leading, whitespace-buffer-trailing): Make
these functions highlight the text removed by
`whitespace-buffer-leading-cleanup' and
`whitespace-buffer-trailing-cleanup' respectively.
(whitespace-buffer-search): Use `with-local-quit'. Move
`format' out of loop to speed up scanning larger buffers.
(whitespace-unhighlight-the-space): Remove `remove-hook' since
that function is never added to a hook.
(whitespace-spacetab-regexp, whitespace-ateol-regexp)
(whitespace-buffer-leading-cleanup)
(whitespace-refresh-rescan-list): Fix docstrings.
2006-11-03 Ken Manheimer <ken.manheimer@gmail.com>
* allout.el (allout-during-yank-processing): Cue for inhibiting
aberrance processing during yanks.
(allout-doublecheck-at-and-shallower): Reduce the limit to reduce
the amount of yanked topics that can be aberrant.
(allout-do-doublecheck): Encapsulate this multiply-used recipe in
a function, and supplement with inihibition of doublechecking
during yanks.
(allout-beginning-of-line, allout-next-heading)
(allout-previous-heading, allout-goto-prefix-doublechecked)
(allout-back-to-current-heading, allout-next-visible-heading)
(allout-next-sibling): Use new allout-do-doublecheck function.
(allout-next-sibling): Ensure we made progress when returning
other than nil.
(allout-rebullet-heading): Preserve text property annotations
indicating the text was hidden, if it was.
(allout-kill-line): Remove any added was-hidden annotations.
(allout-kill-topic): Remove any added was-hidden annotations.
(allout-annotate-hidden): Inhibit adding was-hidden text
properties to the undo list.
(allout-deannotate-hidden): New function to remove was-hidden
annotation.
(allout-hide-by-annotation): Use new allout-deannotate-hidden.
(allout-remove-exposure-annotation): Replaced by
allout-deannotate-hidden.
(allout-yank-processing): Signal that yank processing is happening
with allout-during-yank-processing. Also, wrap
allout-unprotected's closer to the text changes, for easier
debugging. We need to inhibit-field-text-motion explicitly, in
lieu of the encompassing allout-unprotected.
(outlineify-sticky): Adjust criteria for triggering new outline
decorations to presence or absence of any topics, not just a topic
at the beginning of the buffer.
2006-11-03 Juanma Barranquero <lekktu@gmail.com>
* bs.el (bs--show-all, bs--redisplay):
* cus-edit.el (custom-unlispify-menu-entries)
(custom-unlispify-tag-names, custom-prompt-variable):
* expand.el (expand-pos):
* speedbar.el (speedbar-generic-list-tag-p):
* wid-edit.el (widget-image-enable):
* emacs-lisp/checkdoc.el (checkdoc-rogue-space-check-engine):
* emacs-lisp/find-func.el (find-function-noselect)
(find-function, find-variable-noselect, find-variable)
(find-definition-noselect, find-face-definition):
* mail/rmail-spam-filter.el (rsf-scanning-messages-now):
* net/eudc-vars.el (eudc-expansion-overwrites-query):
* progmodes/ada-xref.el (ada-find-in-ali):
* textmodes/flyspell.el (flyspell-check-tex-math-command):
* textmodes/org.el (org-copy-subtree):
* textmodes/table.el (table--row-column-insertion-point-p):
Use "non-nil" in docstrings.
2006-11-03 Mark Davies <mark@mcs.vuw.ac.nz>
* sort.el (sort-columns): Set the field separator to tab; on
NetBSD, sort complains if "\n" is used as field separator.
2006-11-03 NIIMI Satoshi <sa2c@sa2c.net>
* emacs-lisp/pp.el (pp-eval-last-sexp): Evaluate target sexp.
2006-11-02 Stefan Monnier <monnier@iro.umontreal.ca>
* server.el (server-auth-key): Remove. Replace by a process-property.
(server-start): Don't remove the file of the previous process, but
instead clear out the place for the new file.
(server-start): Set the :auth-key property.
(server-process-filter): Use the :auth-key property.
2006-11-02 Carsten Dominik <dominik@science.uva.nl>
* textmodes/org.el (org-mode-map): No longer copy
`outline-mode-map' explicitly - this is already done by
`define-derived-mode'.
2006-11-02 Juanma Barranquero <lekktu@gmail.com>
* server.el (server-visit-files): Use `when'.
(server-process-filter): When authentication fails, send error
message to client. Wrap `process-send-region' in `ignore-errors'
instead of `condition-case', and remove misleading comment.
2006-11-01 Juri Linkov <juri@jurta.org>
* simple.el (yank): Doc fix.
2006-11-01 Stefan Monnier <monnier@iro.umontreal.ca>
* server.el: Try and fit within 80 columns.
(server-start): Make the auth file unreadable by other users.
2006-10-31 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
* battery.el (battery-linux-proc-acpi): Prevent range error when
`full-capacity' is 0.
2006-10-31 Yoni Rabkin Katzenell <yoni-r@actcom.com> (tiny change)
* faces.el (faces-sample-overlay): New defvar.
(faces-sample-overlay): New function to show face sample text.
(describe-face): Use it.
2006-10-31 Stephen Leake <stephen_leake@stephe-leake.org>
* progmodes/ada-stmt.el: Change maintainer, apply
whitespace-cleanup, checkdoc.
(ada-func-or-proc-name): Add doc string.
* progmodes/ada-prj.el (ada-prj-new): Change maintainer, apply
whitespace-cleanup, checkdoc. Minor improvements to many doc
strings and comments.
(ada-prj-display-page): Change buffer name to more accurately
reflect function.
* progmodes/ada-xref.el: Change maintainer, apply
whitespace-cleanup, checkdoc. Minor improvements to many doc
strings and comments. Don't look for `gvd' or `ddd' debuggers.
(ada-compile-current): Don't add newlines to commands.
2006-10-31 Juanma Barranquero <lekktu@gmail.com>
* server.el: Add support for TCP sockets.
(server-use-tcp, server-host, server-auth-dir): New options.
(server-auth-key): New variable.
(server-ensure-safe-dir): Create nonexistent parent dirs.
Ignore Unix-style file modes on Windows.
(server-start): Crete a TCP or Unix socket according to the value
of `server-use-tcp'. For TCP sockets, create the id/auth file in
`server-auth-dir' directory.
(server-process-filter): Delete process if authentication
fails (which never happens for Unix sockets).
2006-10-30 David Kastrup <dak@gnu.org>
* subr.el (add-to-list): Don't continue checking if a match has
been found.
2006-10-30 Chong Yidong <cyd@stupidchicken.com>
* tutorial.el: Move defvars to avoid bytecomp warnings.
(tutorial--find-changed-keys): Check if viper-current-state is
bound before using it.
(help-with-tutorial): Check if viper-tutorial is defined before
using it.
2006-10-30 Lennart Borgman <lennart.borgman.073@student.lu.se>
* help-fns.el (help-with-tutorial): Moved to tutorial.el.
* tutorial.el: New file.
(help-with-tutorial): Moved here from help-fns.el. Added help for
rebound keys. Fixed resume of tutorial.
(tutorial--describe-nonstandard-key, tutorial--sort-keys)
(tutorial--find-changed-keys, tutorial--display-changes)
(tutorial--saved-dir, tutorial--saved-file)
(tutorial--save-tutorial): New functions to support the changes in
help-with-tutorial.
2006-10-30 Kenichi Handa <handa@m17n.org>
* files.el (revert-buffer): If a unibyte buffer is being reverted
with a coding system for multibyte, set buffer multibyte before
calling insert-file-contents.
2006-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
* server.el (server-select-display): Use a dummy buffer to detect when
the frame is later used.
(server-select-display): New function.
(server-process-filter): Use it to detect unused temp frames.
2006-10-29 Stephen Leake <stephen_leake@stephe-leake.org>
* progmodes/ada-mode.el: Change maintainer, apply
whitespace-clean, checkdoc. Minor improvements to many doc
strings.
whitespace-clean, checkdoc. Minor improvements to many doc strings.
(ada-mode-version): New function.
(ada-create-menu): Menu operations are available for all supported
compilers.
2006-10-29 Lars Hansen <larsh@soem.dk>
* net/tramp.el (with-parsed-tramp-file-name): Correct debug
spec. Highlight as keyword.
* net/tramp.el (with-parsed-tramp-file-name): Correct debug spec.
Highlight as keyword.
(tramp-do-copy-or-rename-file): Correct data for 'file-already-exists.
Don't call tramp-method-out-of-band-p for local files.
(tramp-touch): Quote file name.
@ -18,8 +442,7 @@
* calendar/calendar.el (cal-html-cursor-month)
(cal-html-cursor-year): Add autoloads for this new package.
(calendar-mode-map): Bind cal-html-cursor-month,
cal-html-cursor-year.
(calendar-mode-map): Bind cal-html-cursor-month, cal-html-cursor-year.
2006-10-28 Anna Bigatti <bigatti@dima.unige.it>
@ -64,7 +487,7 @@
* midnight.el (midnight-buffer-display-time): Doc fix.
(clean-buffer-list-kill-never-buffer-names): Add "*server*".
2006-10-22 martin rudalics <rudalics@gmx.at>
2006-10-22 Martin Rudalics <rudalics@gmx.at>
* textmodes/flyspell.el (flyspell-check-region-doublons):
Fix last fix.
@ -81,7 +504,7 @@
event to unread-command-events as (t . EVENT) so it will be added
to this-command-keys by read-key-sequence.
2006-10-22 martin rudalics <rudalics@gmx.at>
2006-10-22 Martin Rudalics <rudalics@gmx.at>
* textmodes/flyspell.el (flyspell-word): Skip past all previous
whitespace when checking doublons.
@ -1205,7 +1628,7 @@
* select.el (xselect-convert-to-string): If UTF8_STRING is requested
and the data doesn't look like UTF8, send STRING instead.
2006-09-16 Agustin Martin <agustin.martin@hispalinux.es>
2006-09-16 Agustin Martin <agustin.martin@hispalinux.es>
* textmodes/flyspell.el (flyspell-check-region-doublons):
New function to detect duplicated words.
@ -1271,8 +1694,8 @@
(allout-mode): Make allout-old-style-prefixes (ie, enabling use with
outline.el outlines) functional again. Change the primary bullet
along with the header-lead - level 1 new-style bullets now work.
Engage allout-before-change-handler in mainline emacs, not just
xemacs, to do undo handling.
Engage allout-before-change-handler in mainline Emacs, not just
XEmacs, to do undo handling.
(allout-before-change-handler): Expose undo changes occurring in
hidden regions. Use allout-get-invisibility-overlay instead of
reimplementing it inline.
@ -1666,7 +2089,7 @@
* net/ldap.el (ldap-search-internal): Handle `auth' key.
2006-09-07 Magnus Henoch <mange@freemail.hu>
2006-09-07 Magnus Henoch <mange@freemail.hu>
* net/rcirc.el (rcirc-activity-string): Don't quote value in case
clause.
@ -12248,7 +12671,7 @@
Add fset of allout-real-isearch-abort during compile to fix
byte-compilation warnings.
(allout-mode-p): Move definition of this macro above all uses, or
byte compilation in barren emacs (eg, during emacs build) will
byte compilation in barren Emacs (eg, during Emacs build) will
lack the definition.
(allout-mode): Move this variable above any uses, or byte
compilation will fail.
@ -13893,7 +14316,7 @@
2005-11-02 Mark A. Hershberger <mah@everybody.org>
* xml.el (xml-syntax-table): Allow xml.el to compile in xemacs.
* xml.el (xml-syntax-table): Allow xml.el to compile in XEmacs.
(xml-parse-tag): Join strings separated by a comment properly.
2005-11-02 Andreas Schwab <schwab@suse.de>
@ -18642,7 +19065,7 @@
2005-07-21 Kim F. Storm <storm@cua.dk>
* mail/emacsbug.el (report-emacs-bug): Request that backtraces are
included when reporting an emacs crash, and tell about the DEBUG file.
included when reporting an Emacs crash, and tell about the DEBUG file.
* image-file.el (insert-image-file): Add yank-handler.
(image-file-yank-handler): Yank handler to make unique copies of
@ -19597,7 +20020,7 @@
2005-07-06 Richard M. Stallman <rms@gnu.org>
* progmodes/flymake.el (flymake-float-time): Instead of
with-no-warnings, test for xemacs.
with-no-warnings, test for XEmacs.
(flymake-replace-regexp-in-string): Test fboundp of replace-in-string
to avoid warning.

2
lisp/ChangeLog.3
View file

@ -11829,7 +11829,7 @@
* dbx.el (run-dbx): Set dbx-process.
(dbx-stop-at): Use that to decide where to send the string.
1989-02-13 Marc Shapiro (shapiro@sor.inria.fr)
1989-02-13 Marc Shapiro (marc.shapiro@acm.org)
* bibtex.el (bibtex-clean-entry, bibtex-empty-field, bibtex-find-text,
bibtex-kill-optional-field, bibtex-next-field, bibtex-pop-next,

4
lisp/Makefile.in
View file

@ -76,6 +76,8 @@ setwins=subdirs=`(cd $$wd; find . -type d -print)`; \
esac; \
done
# Find all subdirectories except `obsolete'.
setwins_almost=subdirs=`(cd $$wd; find . -type d -print)`; \
for file in $$subdirs; do \
case $$file in */Old | */RCS | */CVS | */CVS/* | */.* | */.*/* | */=* | */obsolete | */term ) ;; \
@ -108,7 +110,7 @@ $(lisp)/loaddefs.el:
echo ";; End:" >> $@
echo ";;; loaddefs.el ends here" >> $@
autoloads: $(lisp)/loaddefs.el doit
wd=$(lisp); $(setwins); \
wd=$(lisp); $(setwins_almost); \
echo Directories: $$wins; \
LC_ALL=C $(EMACS) $(EMACSOPT) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins

2
lisp/add-log.el
View file

@ -293,6 +293,8 @@ Note: The search is conducted only within 10%, at the beginning of the file."
It takes the same format as the TZ argument of `set-time-zone-rule'.
If nil, use local time.
If t, use universal time.")
(put 'add-log-time-zone-rule 'safe-local-variable
'(lambda (x) (or (booleanp x) (stringp x))))
(defun add-log-iso8601-time-zone (&optional time)
(let* ((utc-offset (or (car (current-time-zone time)) 0))

344
lisp/allout.el
View file

@ -66,7 +66,7 @@
;;
;; The outline menubar additions provide quick reference to many of
;; the features, and see the docstring of the variable `allout-init'
;; for instructions on priming your emacs session for automatic
;; for instructions on priming your Emacs session for automatic
;; activation of allout-mode.
;;
;; See the docstring of the variables `allout-layout' and
@ -891,13 +891,18 @@ This is properly set by `set-allout-regexp'.")
(make-variable-buffer-local 'allout-plain-bullets-string-len)
;;;_ = allout-doublecheck-at-and-shallower
(defconst allout-doublecheck-at-and-shallower 3
"Verify apparent topics of this depth and shallower as being non-aberrant.
(defconst allout-doublecheck-at-and-shallower 2
"Validate apparent topics of this depth and shallower as being non-aberrant.
Verified with `allout-aberrant-container-p'. This check's usefulness is
limited to shallow prospects, because the determination of aberrance
depends on the mistaken item being followed by a legitimate item of
excessively greater depth.")
excessively greater depth.
A level of 2 is safest, so that yanks, which must ignore
aberrance while rectifying the yanked text to their new location,
is least likely to be fooled by aberrant topics in the yanked
text.")
;;;_ X allout-reset-header-lead (header-lead)
(defun allout-reset-header-lead (header-lead)
"*Reset the leading string used to identify topic headers."
@ -1380,7 +1385,7 @@ are random binary characters to avoid exposing greater susceptibility to
search attacks.
The verifier string is retained as an Emacs file variable, as well as in
the emacs buffer state, if file variable adjustments are enabled. See
the Emacs buffer state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-verifier-string)
;;;###autoload
@ -1392,7 +1397,7 @@ the emacs buffer state, if file variable adjustments are enabled. See
See the description of `allout-passphrase-hint-handling' for details about how
the reminder is deployed.
The hint is retained as an Emacs file variable, as well as in the emacs buffer
The hint is retained as an Emacs file variable, as well as in the Emacs buffer
state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-hint-string)
@ -1506,6 +1511,13 @@ and the place for the cursor after the decryption is done."
(goto-char (cadr allout-after-save-decrypt))
(setq allout-after-save-decrypt nil))
)
;;;_ = allout-during-yank-processing nil
;; XXX allout yanks adjust the level of the topic being pasted to that of
;; their target location. aberrance must be inhibited to allow that
;; reconciliation. (this means that actually aberrant topics won't be
;; treated specially while being pasted.)
(defvar allout-during-yank-processing nil
"Internal state, inhibits aberrance doublecheck while adjusting yanks.")
;;;_ #2 Mode activation
;;;_ = allout-explicitly-deactivated
@ -2194,27 +2206,16 @@ to return the current depth of the most recently matched topic."
;;;_ - Position Assessment
;;;_ : Location Predicates
;;;_ > allout-on-current-heading-p ()
(defun allout-on-current-heading-p ()
"Return non-nil if point is on current visible topics' header line.
Actually, returns prefix beginning point."
(save-excursion
(allout-beginning-of-current-line)
(and (looking-at allout-regexp)
(allout-prefix-data)
(or (> allout-recent-depth allout-doublecheck-at-and-shallower)
(not (allout-aberrant-container-p))))))
;;;_ > allout-on-heading-p ()
(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
;;;_ > allout-e-o-prefix-p ()
(defun allout-e-o-prefix-p ()
"True if point is located where current topic prefix ends, heading begins."
(and (save-excursion (let ((inhibit-field-text-motion t))
(beginning-of-line))
(looking-at allout-regexp))
(= (point)(save-excursion (allout-end-of-prefix)(point)))))
;;;_ > allout-aberrant-container-p ()
;;;_ > allout-do-doublecheck ()
(defsubst allout-do-doublecheck ()
"True if current item conditions qualify for checking on topic aberrance."
(and
;; presume integrity of outline and yanked content during yank - necessary,
;; to allow for level disparity of yank location and yanked text:
(not allout-during-yank-processing)
;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
(<= allout-recent-depth allout-doublecheck-at-and-shallower)))
;;;_ > allout-aberrant-container-p ()
(defun allout-aberrant-container-p ()
"True if topic, or next sibling with children, contains them discontinuously.
@ -2247,7 +2248,7 @@ exceeds the topic by more than one."
(goto-char allout-recent-prefix-beginning)
(cond
;; sibling - continue:
((eq allout-recent-depth depth))
((eq allout-recent-depth depth))
;; first offspring is excessive - aberrant:
((> allout-recent-depth (1+ depth))
(setq done t aberrant t))
@ -2259,6 +2260,26 @@ exceeds the topic by more than one."
;; recalibrate allout-recent-*
(allout-depth)
nil)))
;;;_ > allout-on-current-heading-p ()
(defun allout-on-current-heading-p ()
"Return non-nil if point is on current visible topics' header line.
Actually, returns prefix beginning point."
(save-excursion
(allout-beginning-of-current-line)
(and (looking-at allout-regexp)
(allout-prefix-data)
(or (not (allout-do-doublecheck))
(not (allout-aberrant-container-p))))))
;;;_ > allout-on-heading-p ()
(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
;;;_ > allout-e-o-prefix-p ()
(defun allout-e-o-prefix-p ()
"True if point is located where current topic prefix ends, heading begins."
(and (save-excursion (let ((inhibit-field-text-motion t))
(beginning-of-line))
(looking-at allout-regexp))
(= (point)(save-excursion (allout-end-of-prefix)(point)))))
;;;_ : Location attributes
;;;_ > allout-depth ()
(defun allout-depth ()
@ -2390,8 +2411,7 @@ Outermost is first."
(allout-depth)
(let ((beginning-of-body
(save-excursion
(while (and (<= allout-recent-depth
allout-doublecheck-at-and-shallower)
(while (and (allout-do-doublecheck)
(allout-aberrant-container-p)
(allout-previous-visible-heading 1)))
(allout-beginning-of-current-entry)
@ -2443,7 +2463,7 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
(when (re-search-forward allout-line-boundary-regexp nil 0)
(allout-prefix-data)
(and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
(and (allout-do-doublecheck)
;; this will set allout-recent-* on the first non-aberrant topic,
;; whether it's the current one or one that disqualifies it:
(allout-aberrant-container-p))
@ -2464,13 +2484,13 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
(if (bobp)
nil
;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
(let ((start-point (point)))
;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
(allout-goto-prefix)
(when (or (re-search-backward allout-line-boundary-regexp nil 0)
(looking-at allout-bob-regexp))
(goto-char (allout-prefix-data))
(if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
(if (and (allout-do-doublecheck)
(allout-aberrant-container-p))
(or (allout-previous-heading)
(and (goto-char start-point)
@ -2705,11 +2725,11 @@ Like `allout-goto-prefix', but shallow topics \(according to
`allout-doublecheck-at-and-shallower') are checked and
disqualified for child containment discontinuity, according to
`allout-aberrant-container-p'."
(allout-goto-prefix)
(if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
(allout-aberrant-container-p))
(allout-previous-heading)
(point)))
(if (allout-goto-prefix)
(if (and (allout-do-doublecheck)
(allout-aberrant-container-p))
(allout-previous-heading)
(point))))
;;;_ > allout-end-of-prefix ()
(defun allout-end-of-prefix (&optional ignore-decorations)
@ -2745,13 +2765,13 @@ of (before any) topics, in which case we return nil."
(allout-beginning-of-current-line)
(let ((bol-point (point)))
(allout-goto-prefix-doublechecked)
(if (<= (point) bol-point)
(if (interactive-p)
(allout-end-of-prefix)
(point))
(goto-char (point-min))
nil)))
(if (allout-goto-prefix-doublechecked)
(if (<= (point) bol-point)
(if (interactive-p)
(allout-end-of-prefix)
(point))
(goto-char (point-min))
nil))))
;;;_ > allout-back-to-heading ()
(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
;;;_ > allout-pre-next-prefix ()
@ -2918,6 +2938,7 @@ Return the start point of the new topic if successful, nil otherwise."
nil
(let ((target-depth (or depth (allout-depth)))
(start-point (point))
(start-prefix-beginning allout-recent-prefix-beginning)
(count 0)
leaping
last-depth)
@ -2941,7 +2962,9 @@ Return the start point of the new topic if successful, nil otherwise."
nil)))
((and (not (eobp))
(and (> (or last-depth (allout-depth)) 0)
(= allout-recent-depth target-depth)))
(= allout-recent-depth target-depth))
(not (= start-prefix-beginning
allout-recent-prefix-beginning)))
allout-recent-prefix-beginning)
(t
(goto-char start-point)
@ -3067,8 +3090,7 @@ Move to buffer limit in indicated direction if headings are exhausted."
;; not a header line, keep looking:
t
(allout-prefix-data)
(if (and (<= allout-recent-depth
allout-doublecheck-at-and-shallower)
(if (and (allout-do-doublecheck)
(allout-aberrant-container-p))
;; skip this aberrant prospective header line:
t
@ -3480,7 +3502,7 @@ case.)
If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
Runs
Runs
Nuances:
@ -3828,6 +3850,7 @@ this function."
(mb allout-recent-prefix-beginning)
(me allout-recent-prefix-end)
(current-bullet (buffer-substring-no-properties (- me 1) me))
(has-annotation (get-text-property mb 'allout-was-hidden))
(new-prefix (allout-make-topic-prefix current-bullet
nil
new-depth
@ -3854,6 +3877,11 @@ this function."
(allout-unprotected
(delete-region (match-beginning 0)(match-end 0))))
;; convey 'allout-was-hidden annotation, if original had it:
(if has-annotation
(put-text-property 0 (length new-prefix) 'allout-was-hidden t
new-prefix))
; Put in new prefix:
(allout-unprotected (insert new-prefix))
@ -4183,10 +4211,11 @@ subtopics into siblings of the item."
(depth (allout-depth)))
(allout-annotate-hidden beg end)
(if (and (not beg-hidden) (not end-hidden))
(allout-unprotected (kill-line arg))
(kill-line arg))
(allout-deannotate-hidden beg end)
(if allout-numbered-bullet
(save-excursion ; Renumber subsequent topics if needed:
(if (not (looking-at allout-regexp))
@ -4218,6 +4247,7 @@ allout-yank-processing for exposure recovery."
(interactive)
(let* ((inhibit-field-text-motion t)
(beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
end
(depth allout-recent-depth))
(allout-end-of-current-subtree)
(if (and (/= (current-column) 0) (not (eobp)))
@ -4231,9 +4261,13 @@ allout-yank-processing for exposure recovery."
(string= (buffer-substring (- beg 2) beg) "\n\n"))))
(forward-char 1)))
(allout-annotate-hidden beg (point))
(allout-annotate-hidden beg (setq end (point)))
(unwind-protect
(allout-unprotected (kill-region beg end))
(if buffer-read-only
;; eg, during copy-as-kill.
(allout-deannotate-hidden beg end)))
(allout-unprotected (kill-region beg (point)))
(save-excursion
(allout-renumber-to-depth depth))
(run-hook-with-args 'allout-structure-deleted-hook depth (point))))
@ -4251,8 +4285,7 @@ allout-yank-processing for exposure recovery."
(let ((was-modified (buffer-modified-p))
(buffer-read-only nil))
(allout-unprotected
(remove-text-properties begin end '(allout-was-hidden t)))
(allout-deannotate-hidden begin end)
(save-excursion
(goto-char begin)
(let (done next prev overlay)
@ -4279,9 +4312,19 @@ allout-yank-processing for exposure recovery."
(when next
(goto-char next)
(allout-unprotected
(put-text-property (overlay-start overlay) next
'allout-was-hidden t))))))))
(let ((buffer-undo-list t))
(put-text-property (overlay-start overlay) next
'allout-was-hidden t)))))))))
(set-buffer-modified-p was-modified)))
;;;_ > allout-deannotate-hidden (begin end)
(defun allout-deannotate-hidden (begin end)
"Remove allout hidden-text annotation between BEGIN and END."
(allout-unprotected
(let ((inhibit-read-only t)
(buffer-undo-list t))
;(remove-text-properties begin end '(allout-was-hidden t))
)))
;;;_ > allout-hide-by-annotation (begin end)
(defun allout-hide-by-annotation (begin end)
"Translate text properties indicating exposure status into actual exposure."
@ -4309,16 +4352,10 @@ allout-yank-processing for exposure recovery."
nil end))
(overlay-put (make-overlay prev next)
'category 'allout-exposure-category)
(allout-unprotected
(remove-text-properties prev next '(allout-was-hidden t)))
(allout-deannotate-hidden prev next)
(setq prev next)
(if next (goto-char next)))))
(set-buffer-modified-p was-modified))))
;;;_ > allout-remove-exposure-annotation (begin end)
(defun allout-remove-exposure-annotation (begin end)
"Remove text properties indicating exposure status."
(remove-text-properties begin end '(allout-was-hidden t)))
;;;_ > allout-yank-processing ()
(defun allout-yank-processing (&optional arg)
@ -4345,108 +4382,117 @@ however, are left exactly like normal, non-allout-specific yanks."
; region around subject:
(if (< (allout-mark-marker t) (point))
(exchange-point-and-mark))
(allout-unprotected
(let* ((subj-beg (point))
(into-bol (bolp))
(subj-end (allout-mark-marker t))
;; 'resituate' if yanking an entire topic into topic header:
(resituate (and (allout-e-o-prefix-p)
(looking-at allout-regexp)
(allout-prefix-data)))
;; `rectify-numbering' if resituating (where several topics may
;; be resituating) or yanking a topic into a topic slot (bol):
(rectify-numbering (or resituate
(and into-bol (looking-at allout-regexp)))))
(if resituate
(let* ( ;; inhibit aberrance doublecheck while reconciling disparate pastes:
(allout-during-yank-processing t)
(subj-beg (point))
(into-bol (bolp))
(subj-end (allout-mark-marker t))
;; 'resituate' if yanking an entire topic into topic header:
(resituate (and (allout-e-o-prefix-p)
(looking-at allout-regexp)
(allout-prefix-data)))
;; `rectify-numbering' if resituating (where several topics may
;; be resituating) or yanking a topic into a topic slot (bol):
(rectify-numbering (or resituate
(and into-bol (looking-at allout-regexp)))))
(if resituate
; The yanked stuff is a topic:
(let* ((prefix-len (- (match-end 1) subj-beg))
(subj-depth allout-recent-depth)
(prefix-bullet (allout-recent-bullet))
(adjust-to-depth
;; Nil if adjustment unnecessary, otherwise depth to which
;; adjustment should be made:
(save-excursion
(and (goto-char subj-end)
(eolp)
(goto-char subj-beg)
(and (looking-at allout-regexp)
(progn
(beginning-of-line)
(not (= (point) subj-beg)))
(looking-at allout-regexp)
(allout-prefix-data))
allout-recent-depth)))
(more t))
(setq rectify-numbering allout-numbered-bullet)
(if adjust-to-depth
(let* ((inhibit-field-text-motion t)
(prefix-len (if (not (match-end 1))
1
(- (match-end 1) subj-beg)))
(subj-depth allout-recent-depth)
(prefix-bullet (allout-recent-bullet))
(adjust-to-depth
;; Nil if adjustment unnecessary, otherwise depth to which
;; adjustment should be made:
(save-excursion
(and (goto-char subj-end)
(eolp)
(goto-char subj-beg)
(and (looking-at allout-regexp)
(progn
(beginning-of-line)
(not (= (point) subj-beg)))
(looking-at allout-regexp)
(allout-prefix-data))
allout-recent-depth)))
(more t))
(setq rectify-numbering allout-numbered-bullet)
(if adjust-to-depth
; Do the adjustment:
(progn
(save-restriction
(narrow-to-region subj-beg subj-end)
(progn
(save-restriction
(narrow-to-region subj-beg subj-end)
; Trim off excessive blank
; line at end, if any:
(goto-char (point-max))
(if (looking-at "^$")
(allout-unprotected (delete-char -1)))
(goto-char (point-max))
(if (looking-at "^$")
(allout-unprotected (delete-char -1)))
; Work backwards, with each
; shallowest level,
; successively excluding the
; last processed topic from
; the narrow region:
(while more
(allout-back-to-current-heading)
(while more
(allout-back-to-current-heading)
; go as high as we can in each bunch:
(while (allout-ascend))
(save-excursion
(while (allout-ascend))
(save-excursion
(allout-unprotected
(allout-rebullet-topic-grunt (- adjust-to-depth
subj-depth))
(allout-depth))
(if (setq more (not (bobp)))
(progn (widen)
(forward-char -1)
(narrow-to-region subj-beg (point))))))
;; Preserve new bullet if it's a distinctive one, otherwise
;; use old one:
(if (string-match (regexp-quote prefix-bullet)
allout-distinctive-bullets-string)
subj-depth)))
(allout-depth))
(if (setq more (not (bobp)))
(progn (widen)
(forward-char -1)
(narrow-to-region subj-beg (point))))))
;; Preserve new bullet if it's a distinctive one, otherwise
;; use old one:
(if (string-match (regexp-quote prefix-bullet)
allout-distinctive-bullets-string)
; Delete from bullet of old to
; before bullet of new:
(progn
(beginning-of-line)
(delete-region (point) subj-beg)
(set-marker (allout-mark-marker t) subj-end)
(goto-char subj-beg)
(allout-end-of-prefix))
(progn
(beginning-of-line)
(allout-unprotected
(delete-region (point) subj-beg))
(set-marker (allout-mark-marker t) subj-end)
(goto-char subj-beg)
(allout-end-of-prefix))
; Delete base subj prefix,
; leaving old one:
(delete-region (point) (+ (point)
prefix-len
(- adjust-to-depth subj-depth)))
(allout-unprotected
(progn
(delete-region (point) (+ (point)
prefix-len
(- adjust-to-depth subj-depth)))
; and delete residual subj
; prefix digits and space:
(while (looking-at "[0-9]") (delete-char 1))
(if (looking-at " ") (delete-char 1))))
(exchange-point-and-mark))))
(if rectify-numbering
(progn
(save-excursion
(while (looking-at "[0-9]") (delete-char 1))
(if (looking-at " ") (delete-char 1))))))
(exchange-point-and-mark))))
(if rectify-numbering
(progn
(save-excursion
; Give some preliminary feedback:
(message "... reconciling numbers")
(message "... reconciling numbers")
; ... and renumber, in case necessary:
(goto-char subj-beg)
(if (allout-goto-prefix-doublechecked)
(goto-char subj-beg)
(if (allout-goto-prefix-doublechecked)
(allout-unprotected
(allout-rebullet-heading nil ;;; solicit
(allout-depth) ;;; depth
nil ;;; number-control
nil ;;; index
t))
(message ""))))
(if (or into-bol resituate)
(allout-hide-by-annotation (point) (allout-mark-marker t))
(allout-remove-exposure-annotation (allout-mark-marker t) (point)))
(if (not resituate)
(exchange-point-and-mark))
(run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
(allout-depth) ;;; depth
nil ;;; number-control
nil ;;; index
t)))
(message ""))))
(if (or into-bol resituate)
(allout-hide-by-annotation (point) (allout-mark-marker t))
(allout-deannotate-hidden (allout-mark-marker t) (point)))
(if (not resituate)
(exchange-point-and-mark))
(run-hook-with-args 'allout-structure-added-hook subj-beg subj-end)))
;;;_ > allout-yank (&optional arg)
(defun allout-yank (&optional arg)
"`allout-mode' yank, with depth and numbering adjustment of yanked topics.
@ -5671,7 +5717,7 @@ If allout customization var `allout-passphrase-verifier-handling' is
non-nil, an entry for `allout-passphrase-verifier-string' and its value is
added to an Emacs 'local variables' section at the end of the file, which
is created if necessary. That setting is for retention of the passphrase
verifier across emacs sessions.
verifier across Emacs sessions.
Similarly, `allout-passphrase-hint-string' stores a user-provided reminder
about their passphrase, and `allout-passphrase-hint-handling' specifies
@ -6356,7 +6402,7 @@ setup for auto-startup."
(save-excursion
(goto-char (point-min))
(if (looking-at allout-regexp)
(if (allout-goto-prefix)
t
(allout-open-topic 2)
(insert (concat "Dummy outline topic header - see"
@ -6393,7 +6439,7 @@ Returns list `(beginning-point prefix-string suffix-string)'."
)
;;;_ > allout-adjust-file-variable (varname value)
(defun allout-adjust-file-variable (varname value)
"Adjust the setting of an emacs file variable named VARNAME to VALUE.
"Adjust the setting of an Emacs file variable named VARNAME to VALUE.
This activity is inhibited if either `enable-local-variables'
`allout-enable-file-variable-adjustment' are nil.
@ -6404,7 +6450,7 @@ variables, itself, is created if not already present. When created, the
section lines \(including the section line) exist as second-level topics in
a top-level topic at the end of the file.
enable-local-variables must be true for any of this to happen."
`enable-local-variables' must be true for any of this to happen."
(if (not (and enable-local-variables
allout-enable-file-variable-adjustment))
nil

2
lisp/apropos.el
View file

@ -171,7 +171,7 @@ If value is `verbose', the computed score is shown for each match."
("yank" "paste")
("region" "selection"))
"List of synonyms known by apropos.
Each element is a list of words where the first word is the standard emacs
Each element is a list of words where the first word is the standard Emacs
term, and the rest of the words are alternative terms.")

66
lisp/battery.el
View file

@ -49,8 +49,8 @@
(file-directory-p "/proc/acpi/battery"))
'battery-linux-proc-acpi)
((and (eq system-type 'darwin)
(condition-case nil
(with-temp-buffer
(condition-case nil
(with-temp-buffer
(and (eq (call-process "pmset" nil t nil "-g" "ps") 0)
(> (buffer-size) 0)))
(error nil)))
@ -355,45 +355,19 @@ The following %-sequences are provided:
60)))
hours (/ minutes 60)))
(list (cons ?c (or (and capacity (number-to-string capacity)) "N/A"))
(cons ?L (or (when (file-exists-p "/proc/acpi/ac_adapter/AC/state")
(with-temp-buffer
(insert-file-contents
"/proc/acpi/ac_adapter/AC/state")
(when (re-search-forward "state: +\\(.*\\)$" nil t)
(match-string 1))))
(cons ?L (or (battery-search-for-one-match-in-files
(mapcar (lambda (e) (concat e "/state"))
(directory-files "/proc/acpi/ac_adapter/"
t "\\`[^.]"))
"state: +\\(.*\\)$" 1)
"N/A"))
(cons ?d (or (when (file-exists-p
"/proc/acpi/thermal_zone/THRM/temperature")
(with-temp-buffer
(insert-file-contents
"/proc/acpi/thermal_zone/THRM/temperature")
(when (re-search-forward
"temperature: +\\([0-9]+\\) C$" nil t)
(match-string 1))))
(when (file-exists-p
"/proc/acpi/thermal_zone/THM/temperature")
(with-temp-buffer
(insert-file-contents
"/proc/acpi/thermal_zone/THM/temperature")
(when (re-search-forward
"temperature: +\\([0-9]+\\) C$" nil t)
(match-string 1))))
(when (file-exists-p
"/proc/acpi/thermal_zone/THM0/temperature")
(with-temp-buffer
(insert-file-contents
"/proc/acpi/thermal_zone/THM0/temperature")
(when (re-search-forward
"temperature: +\\([0-9]+\\) C$" nil t)
(match-string 1))))
(when (file-exists-p
"/proc/acpi/thermal_zone/THR2/temperature")
(with-temp-buffer
(insert-file-contents
"/proc/acpi/thermal_zone/THR2/temperature")
(when (re-search-forward
"temperature: +\\([0-9]+\\) C$" nil t)
(match-string 1))))
(cons ?d (or (battery-search-for-one-match-in-files
(mapcar (lambda (e) (concat e "/temperature"))
(directory-files "/proc/acpi/thermal_zone/"
t "\\`[^.]"))
"temperature: +\\([0-9]+\\) C$" 1)
"N/A"))
(cons ?r (or (and rate (concat (number-to-string rate) " "
rate-type)) "N/A"))
@ -408,6 +382,7 @@ The following %-sequences are provided:
(format "%d:%02d" hours (- minutes (* 60 hours))))
"N/A"))
(cons ?p (or (and full-capacity capacity
(> full-capacity 0)
(number-to-string
(floor (/ capacity
(/ (float full-capacity) 100)))))
@ -478,6 +453,17 @@ The following %-sequences are provided:
(or (cdr (assoc char alist)) ""))))
format t t))
(defun battery-search-for-one-match-in-files (files regexp match-num)
"Search REGEXP in the content of the files listed in FILES.
If a match occured, return the parenthesized expression numbered by
MATCH-NUM in the match. Otherwise, return nil."
(with-temp-buffer
(catch 'found
(dolist (file files)
(and (ignore-errors (insert-file-contents file nil nil nil 'replace))
(re-search-forward regexp nil t)
(throw 'found (match-string match-num)))))))
(provide 'battery)

2
lisp/bindings.el
View file

@ -279,7 +279,7 @@ Keymap to display on minor modes.")
;; "\
;; mouse-1: select window, mouse-2: delete others, mouse-3: delete,
;; drag-mouse-1: resize, C-mouse-2: split horizontally"
"mouse-1: select (drag to resize), mouse-2: delete others, mouse-3: delete this")
"mouse-1: select (drag to resize), mouse-2 = C-x 1, mouse-3 = C-x 0")
(dashes (propertize "--" 'help-echo help-echo))
(standard-mode-line-format
(list

4
lisp/bs.el
View file

@ -441,7 +441,7 @@ naming a sort behavior. Default is \"by nothing\" which means no sorting."
(defvar bs--show-all nil
"Flag whether showing all buffers regardless of current configuration.
Non nil means to show all buffers. Otherwise show buffers
Non-nil means to show all buffers. Otherwise show buffers
defined by current configuration `bs-current-configuration'.")
(defvar bs--window-config-coming-from nil
@ -583,7 +583,7 @@ a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'."
(defun bs--redisplay (&optional keep-line-p sort-description)
"Redisplay whole Buffer Selection Menu.
If KEEP-LINE-P is non nil the point will stay on current line.
If KEEP-LINE-P is non-nil the point will stay on current line.
SORT-DESCRIPTION is an element of `bs-sort-functions'"
(let ((line (1+ (count-lines 1 (point)))))
(bs-show-in-buffer (bs-buffer-list nil sort-description))

66
lisp/cus-edit.el
View file

@ -466,6 +466,37 @@
:version "22.1"
:prefix "mac-")
;;; Custom mode keymaps
(defvar custom-mode-map
;; This keymap should be dense, but a dense keymap would prevent inheriting
;; "\r" bindings from the parent map.
;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26.
(let ((map (make-keymap)))
(set-keymap-parent map widget-keymap)
(define-key map [remap self-insert-command] 'Custom-no-edit)
(define-key map "\^m" 'Custom-newline)
(define-key map " " 'scroll-up)
(define-key map "\177" 'scroll-down)
(define-key map "\C-c\C-c" 'Custom-set)
(define-key map "\C-x\C-s" 'Custom-save)
(define-key map "q" 'Custom-buffer-done)
(define-key map "u" 'Custom-goto-parent)
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
map)
"Keymap for `custom-mode'.")
(defvar custom-mode-link-map
(let ((map (make-keymap)))
(set-keymap-parent map custom-mode-map)
(define-key map [down-mouse-2] nil)
(define-key map [down-mouse-1] 'mouse-drag-region)
(define-key map [mouse-2] 'widget-move-and-invoke)
map)
"Local keymap for links in `custom-mode'.")
;;; Utilities.
(defun custom-split-regexp-maybe (regexp)
@ -521,7 +552,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
"List of prefixes that should be ignored by `custom-unlispify'.")
(defcustom custom-unlispify-menu-entries t
"Display menu entries as words instead of symbols if non nil."
"Display menu entries as words instead of symbols if non-nil."
:group 'custom-menu
:type 'boolean)
@ -568,7 +599,7 @@ WIDGET is the widget to apply the filter entries of MENU on."
(buffer-string)))))
(defcustom custom-unlispify-tag-names t
"Display tag names as words instead of symbols if non nil."
"Display tag names as words instead of symbols if non-nil."
:group 'custom-buffer
:type 'boolean)
@ -846,7 +877,7 @@ it were the arg to `interactive' (which see) to interactively read the value.
If the variable has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.
If optional COMMENT argument is non nil, also prompt for a comment and return
If optional COMMENT argument is non-nil, also prompt for a comment and return
it as the third element in the list."
(let* ((var (read-variable prompt-var))
(minibuffer-help-form '(describe-variable var))
@ -1781,6 +1812,8 @@ item in another window.\n\n"))
(define-widget 'custom-manual 'info-link
"Link to the manual entry for this customization option."
:help-echo "Read the manual entry for this option."
:keymap custom-mode-link-map
:follow-link 'mouse-face
:button-face 'custom-link
:mouse-face 'highlight
:pressed-face 'highlight
@ -3631,7 +3664,7 @@ restoring it to the state of a face that has never been customized."
;;; The `hook' Widget.
(define-widget 'hook 'list
"A emacs lisp hook"
"An Emacs Lisp hook."
:value-to-internal (lambda (widget value)
(if (and value (symbolp value))
(list value)
@ -3673,6 +3706,8 @@ restoring it to the state of a face that has never been customized."
:mouse-face 'highlight
:pressed-face 'highlight
:help-echo "Create customization buffer for this group."
:keymap custom-mode-link-map
:follow-link 'mouse-face
:action 'custom-group-link-action)
(defun custom-group-link-action (widget &rest ignore)
@ -4149,6 +4184,8 @@ if only the first line of the docstring is shown."))
;;;###autoload
(defun custom-save-all ()
"Save all customizations in `custom-file'."
(when (and (null custom-file) init-file-had-error)
(error "Cannot save customizations; init file was not fully loaded"))
(let* ((filename (custom-file))
(recentf-exclude (if recentf-mode
(cons (concat "\\`"
@ -4267,7 +4304,7 @@ This function does not save the buffer."
(eq (get symbol 'force-value)
'rogue))))
(comment (get symbol 'saved-variable-comment)))
;; Check REQUESTS for validity.
;; Check REQUESTS for validity.
(dolist (request requests)
(when (and (symbolp request) (not (featurep request)))
(message "Unknown requested feature: %s" request)
@ -4449,25 +4486,6 @@ The format is suitable for use with `easy-menu-define'."
;;; The Custom Mode.
(defvar custom-mode-map
;; This keymap should be dense, but a dense keymap would prevent inheriting
;; "\r" bindings from the parent map.
;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26.
(let ((map (make-keymap)))
(set-keymap-parent map widget-keymap)
(define-key map [remap self-insert-command] 'Custom-no-edit)
(define-key map "\^m" 'Custom-newline)
(define-key map " " 'scroll-up)
(define-key map "\177" 'scroll-down)
(define-key map "\C-c\C-c" 'Custom-set)
(define-key map "\C-x\C-s" 'Custom-save)
(define-key map "q" 'Custom-buffer-done)
(define-key map "u" 'Custom-goto-parent)
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
map)
"Keymap for `custom-mode'.")
(defun Custom-no-edit (pos &optional event)
"Invoke button at POS, or refuse to allow editing of Custom buffer."
(interactive "@d")

26
lisp/dired-aux.el
View file

@ -1182,12 +1182,20 @@ Special value `always' suppresses confirmation."
dired-create-files-failures)
(setq files nil)
(dired-log "Copying error for %s:\n%s\n" from err)))))
(while files
(dired-copy-file-recursive
(expand-file-name (car files) from)
(expand-file-name (car files) to)
ok-flag preserve-time nil recursive)
(pop files)))
(dolist (file files)
(let ((thisfrom (expand-file-name file from))
(thisto (expand-file-name file to)))
;; Catch errors copying within a directory,
;; and report them through the dired log mechanism
;; just as our caller will do for the top level files.
(condition-case err
(dired-copy-file-recursive
thisfrom thisto
ok-flag preserve-time nil recursive)
(file-error
(push (dired-make-relative thisfrom)
dired-create-files-failures)
(dired-log "Copying error for %s:\n%s\n" thisfrom err))))))
;; Not a directory.
(or top (dired-handle-overwrite to))
(condition-case err
@ -1198,11 +1206,7 @@ Special value `always' suppresses confirmation."
(file-date-error
(push (dired-make-relative from)
dired-create-files-failures)
(dired-log "Can't set date on %s:\n%s\n" from err))
(file-error
(push (dired-make-relative from)
dired-create-files-failures)
(dired-log "Copying error for %s:\n%s\n" from err))))))
(dired-log "Can't set date on %s:\n%s\n" from err))))))
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)

3
lisp/dired.el
View file

@ -791,6 +791,9 @@ wildcards, erases the buffer, and builds the subdir-alist anew
(run-hooks 'dired-before-readin-hook)
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
(make-local-variable 'file-name-coding-system)
(setq file-name-coding-system
(or coding-system-for-read file-name-coding-system))
(let (buffer-read-only
;; Don't make undo entries for readin.
(buffer-undo-list t))

2
lisp/emacs-lisp/authors.el
View file

@ -176,7 +176,7 @@ listed.")
Changes to files in this list are not listed.")
(defconst authors-fixed-entries
'(("Richard M. Stallman" :wrote "[The original GNU emacs and numerous files]")
'(("Richard M. Stallman" :wrote "[The original GNU Emacs and numerous files]")
("Joseph Arceneaux" :wrote "xrdb.c")
("Blitz Product Development Corporation" :wrote "ispell.el")
("Frank Bresz" :wrote "diff.el")

2
lisp/emacs-lisp/checkdoc.el
View file

@ -2155,7 +2155,7 @@ before using the Ispell engine on it."
(defun checkdoc-rogue-space-check-engine (&optional start end interact)
"Return a message list if there is a line with white space at the end.
If `checkdoc-autofix-flag' permits, delete that whitespace instead.
If optional arguments START and END are non nil, bound the check to
If optional arguments START and END are non-nil, bound the check to
this region.
Optional argument INTERACT may permit the user to fix problems on the fly."
(let ((p (point))

6
lisp/emacs-lisp/cust-print.el
View file

@ -256,7 +256,7 @@ Any pair that has the same PREDICATE is first removed."
(defun custom-print-install ()
"Replace print functions with general, customizable, Lisp versions.
The emacs subroutines are saved away, and you can reinstall them
The Emacs subroutines are saved away, and you can reinstall them
by running `custom-print-uninstall'."
(interactive)
(mapcar 'cust-print-set-function-cell
@ -271,7 +271,7 @@ by running `custom-print-uninstall'."
t)
(defun custom-print-uninstall ()
"Reset print functions to their emacs subroutines."
"Reset print functions to their Emacs subroutines."
(interactive)
(mapcar 'cust-print-set-function-cell
'((prin1 cust-print-original-prin1)
@ -375,7 +375,7 @@ The argument used by %s must be a string or a symbol;
the argument used by %d, %b, %o, %x or %c must be a number.
This is the custom-print replacement for the standard `format'. It
calls the emacs `format' after first making strings for list,
calls the Emacs `format' after first making strings for list,
vector, or symbol args. The format specification for such args should
be `%s' in any case, so a string argument will also work. The string
is generated with `custom-prin1-to-string', which quotes quotable

12
lisp/emacs-lisp/find-func.el
View file

@ -264,7 +264,7 @@ not selected. If the function definition can't be found in
the buffer, returns (BUFFER).
If the file where FUNCTION is defined is not known, then it is
searched for in `find-function-source-path' if non nil, otherwise
searched for in `find-function-source-path' if non-nil, otherwise
in `load-path'."
(if (not function)
(error "You didn't specify a function"))
@ -357,7 +357,7 @@ places point before the definition.
Set mark before moving, if the buffer already existed.
The library where FUNCTION is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
`find-function-source-path', if non-nil, otherwise in `load-path'.
See also `find-function-recenter-line' and `find-function-after-hook'."
(interactive (find-function-read))
(find-function-do-it function nil 'switch-to-buffer))
@ -387,7 +387,7 @@ the point of the definition. The buffer is not selected.
If the variable's definition can't be found in the buffer, return (BUFFER).
The library where VARIABLE is defined is searched for in FILE or
`find-function-source-path', if non nil, otherwise in `load-path'."
`find-function-source-path', if non-nil, otherwise in `load-path'."
(if (not variable)
(error "You didn't specify a variable")
(let ((library (or file
@ -406,7 +406,7 @@ places point before the definition.
Set mark before moving, if the buffer already existed.
The library where VARIABLE is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
`find-function-source-path', if non-nil, otherwise in `load-path'.
See also `find-function-recenter-line' and `find-function-after-hook'."
(interactive (find-function-read 'defvar))
(find-function-do-it variable 'defvar 'switch-to-buffer))
@ -436,7 +436,7 @@ variable, `defface' for a face. This function does not switch to the
buffer nor display it.
The library where SYMBOL is defined is searched for in FILE or
`find-function-source-path', if non nil, otherwise in `load-path'."
`find-function-source-path', if non-nil, otherwise in `load-path'."
(cond
((not symbol)
(error "You didn't specify a symbol"))
@ -461,7 +461,7 @@ places point before the definition.
Set mark before moving, if the buffer already existed.
The library where FACE is defined is searched for in
`find-function-source-path', if non nil, otherwise in `load-path'.
`find-function-source-path', if non-nil, otherwise in `load-path'.
See also `find-function-recenter-line' and `find-function-after-hook'."
(interactive (find-function-read 'defface))
(find-function-do-it face 'defface 'switch-to-buffer))

6
lisp/emacs-lisp/lselect.el
View file

@ -191,7 +191,7 @@ secondary selection instead of the primary selection."
"If there is a selection, delete the text it covers, and copy it to
both the kill ring and the Clipboard."
(interactive)
(or (x-selection-owner-p) (error "emacs does not own the primary selection"))
(or (x-selection-owner-p) (error "Emacs does not own the primary selection"))
(setq last-command nil)
(or primary-selection-extent
(error "the primary selection is not an extent?"))
@ -205,7 +205,7 @@ both the kill ring and the Clipboard."
"If there is a selection, delete the text it covers *without* copying it to
the kill ring or the Clipboard."
(interactive)
(or (x-selection-owner-p) (error "emacs does not own the primary selection"))
(or (x-selection-owner-p) (error "Emacs does not own the primary selection"))
(setq last-command nil)
(or primary-selection-extent
(error "the primary selection is not an extent?"))
@ -219,7 +219,7 @@ the kill ring or the Clipboard."
"If there is a selection, copy it to both the kill ring and the Clipboard."
(interactive)
(setq last-command nil)
(or (x-selection-owner-p) (error "emacs does not own the primary selection"))
(or (x-selection-owner-p) (error "Emacs does not own the primary selection"))
(or primary-selection-extent
(error "the primary selection is not an extent?"))
(save-excursion

2
lisp/emacs-lisp/pp.el
View file

@ -161,7 +161,7 @@ Ignores leading comment characters."
(set-syntax-table stab)
(if arg
(insert (pp-to-string (eval exp)))
(pp-eval-expression exp))))
(pp-eval-expression (eval exp)))))
;;; Test cases for quote
;; (pp-eval-expression ''(quote quote))

14
lisp/emacs-lisp/shadow.el
View file

@ -184,17 +184,17 @@ and that each of these directories contains a file called XXX.el. Then
XXX.el in the site-lisp directory is referred to by all of:
\(require 'XXX\), \(autoload .... \"XXX\"\), \(load-library \"XXX\"\) etc.
The first XXX.el file prevents emacs from seeing the second \(unless
the second is loaded explicitly via load-file\).
The first XXX.el file prevents Emacs from seeing the second \(unless
the second is loaded explicitly via `load-file'\).
When not intended, such shadowings can be the source of subtle
problems. For example, the above situation may have arisen because the
XXX package was not distributed with versions of emacs prior to
19.30. An emacs maintainer downloaded XXX from elsewhere and installed
it. Later, XXX was updated and included in the emacs distribution.
Unless the emacs maintainer checks for this, the new version of XXX
XXX package was not distributed with versions of Emacs prior to
19.30. An Emacs maintainer downloaded XXX from elsewhere and installed
it. Later, XXX was updated and included in the Emacs distribution.
Unless the Emacs maintainer checks for this, the new version of XXX
will be hidden behind the old \(which may no longer work with the new
emacs version\).
Emacs version\).
This function performs these checks and flags all possible
shadowings. Because a .el file may exist without a corresponding .elc

2
lisp/emacs-lock.el
View file

@ -38,7 +38,7 @@
;;; Code:
(defvar emacs-lock-from-exiting nil
"Whether emacs is locked to prevent exiting. See `check-emacs-lock'.")
"Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.")
(make-variable-buffer-local 'emacs-lock-from-exiting)
(defvar emacs-lock-buffer-locked nil

2
lisp/emulation/edt-mapper.el
View file

@ -202,7 +202,7 @@
Sometimes, edt-mapper will ignore a key you press, and just continue to
prompt for the same key. This can happen when your window manager sucks
up the key and doesn't pass it on to emacs, or it could be an emacs bug.
up the key and doesn't pass it on to Emacs, or it could be an Emacs bug.
Either way, there's nothing that edt-mapper can do about it. You must
press RETURN, to skip the current key and continue. Later, you and/or
your local system guru can try to figure out why the key is being ignored.

14
lisp/emulation/tpu-edt.el
View file

@ -432,7 +432,7 @@ CSI is DEC's name for the sequence <ESC>[.")
(let ((map (make-keymap)))
(define-key map "\e[" GOLD-CSI-map) ; GOLD-CSI map
(define-key map "\eO" GOLD-SS3-map) ; GOLD-SS3 map
;;
;;
(define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A
(define-key map "\C-B" 'nil) ; ^B
(define-key map "\C-C" 'nil) ; ^C
@ -557,7 +557,7 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
(defvar SS3-map
(let ((map (make-sparse-keymap)))
(define-key map "P" GOLD-map) ; GOLD map
;;
;;
(define-key map "A" 'tpu-previous-line) ; up
(define-key map "B" 'tpu-next-line) ; down
(define-key map "C" 'tpu-forward-char) ; right
@ -1141,7 +1141,7 @@ This is useful for inserting control characters."
R Toggle rectangular mode for remove and insert
S Search and substitute - line mode REPLACE command
^T Toggle control key bindings between TPU and emacs
^T Toggle control key bindings between TPU and Emacs
U Undo - undo the last edit
W Write - save current buffer
X Exit - save all modified buffers and exit
@ -1292,7 +1292,7 @@ kills modified buffers without asking."
(kill-buffer (current-buffer)))
(defun tpu-save-all-buffers-kill-emacs nil
"Save all buffers and exit emacs."
"Save all buffers and exit Emacs."
(interactive)
(let ((delete-old-versions t))
(save-buffers-kill-emacs t)))
@ -1852,8 +1852,8 @@ A negative argument means replace all occurrences of the search string."
(message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" ""))))
(defun tpu-emacs-replace (&optional dont-ask)
"A TPU-edt interface to the emacs replace functions. If TPU-edt is
currently in regular expression mode, the emacs regular expression
"A TPU-edt interface to the Emacs replace functions. If TPU-edt is
currently in regular expression mode, the Emacs regular expression
replace functions are used. If an argument is supplied, replacements
are performed without asking. Only works in forward direction."
(interactive "P")
@ -2285,7 +2285,7 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll."
(setq tpu-control-keys t))
(defun tpu-reset-control-keys (tpu-style)
"Set control keys to TPU or emacs style functions."
"Set control keys to TPU or Emacs style functions."
(let* ((tpu (and tpu-style (not tpu-control-keys)))
(emacs (and (not tpu-style) tpu-control-keys))
(doit (or tpu emacs)))

4
lisp/emulation/vip.el
View file

@ -45,7 +45,7 @@
;; external variables
(defvar vip-emacs-local-map nil
"Local map used in emacs mode. (Buffer-specific.)")
"Local map used in Emacs mode. (Buffer-specific.)")
(defvar vip-insert-local-map nil
"Local map used in insert command mode. (Buffer-specific.)")
@ -447,7 +447,7 @@ Type `n' to quit this window for now.\n")
(vip-change-mode 'insert-mode))
(defun vip-change-mode-to-emacs ()
"Change mode to emacs mode."
"Change mode to Emacs mode."
(interactive)
(vip-change-mode 'emacs-mode))

2
lisp/emulation/viper-init.el
View file

@ -438,7 +438,7 @@ delete the text being replaced, as in standard Vi."
;; confused in some cases. So, this var is nulled for now.
;; (defcustom viper-emacs-state-cursor-color "Magenta"
(defcustom viper-emacs-state-cursor-color nil
"Cursor color when Viper is in emacs state."
"Cursor color when Viper is in Emacs state."
:type 'string
:group 'viper)
(if (fboundp 'make-variable-frame-local)

6
lisp/emulation/viper-keym.el
View file

@ -144,7 +144,7 @@ viper-insert-basic-map. Not recommended, except for novice users.")
"Auxiliary map for global user-defined bindings in Emacs state.")
(defvar viper-emacs-kbd-map (make-sparse-keymap)
"This keymap keeps Vi-style kbd macros for emacs mode.")
"This keymap keeps Vi-style kbd macros for Emacs mode.")
(viper-deflocalvar viper-emacs-local-user-map (make-sparse-keymap)
"Auxiliary map for local user-defined bindings in Emacs state.")
@ -160,10 +160,10 @@ viper-insert-basic-map. Not recommended, except for novice users.")
;; Some important keys used in viper
(defcustom viper-toggle-key [(control ?z)] ; "\C-z"
"The key used to change states from emacs to Vi and back.
"The key used to change states from Emacs to Vi and back.
In insert mode, this key also functions as Meta.
Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]."
Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]."
:type 'sexp
:group 'viper
:set (lambda (symbol value)

14
lisp/emulation/viper.el
View file

@ -359,7 +359,7 @@ user decide when to invoke Viper in a major mode."
(defcustom viper-mode (cond (noninteractive nil)
(t 'ask))
"To Viperize or not to Viperize.
If t, viperize emacs. If nil -- don't. If `ask', ask the user.
If t, viperize Emacs. If nil -- don't. If `ask', ask the user.
This variable is used primatily when Viper is being loaded.
Must be set in `~/.emacs' before Viper is loaded.
@ -502,10 +502,10 @@ unless it is coming up in a wrong Viper state."
The list has the structure: ((mode viper-state keymap) (mode viper-state
keymap) ...). If `mode' is on the list, the `kemap' will be made active (on
the minor-mode-map-alist) in the specified viper state.
If you change this list, have to restart emacs for the change to take effect.
However, if you did the change through the customization widget, then emacs
If you change this list, have to restart Emacs for the change to take effect.
However, if you did the change through the customization widget, then Emacs
needs to be restarted only if you deleted a triple mode-state-keymap from the
list. No need to restart emacs in case of insertion or modification of an
list. No need to restart Emacs in case of insertion or modification of an
existing triple."
:type '(repeat
(list symbol
@ -891,7 +891,7 @@ It also can't undo some Viper settings."
(eval-after-load
"passwd"
'(defadvice read-passwd-1 (before viper-passwd-ad activate)
"Switch to emacs state while reading password."
"Switch to Emacs state while reading password."
(viper-change-state-to-emacs)))
(defadvice self-insert-command (around viper-self-insert-ad activate)
@ -939,7 +939,7 @@ It also can't undo some Viper settings."
(eval-after-load
"rmailedit"
'(defadvice rmail-cease-edit (after viper-rmail-advice activate)
"Switch to emacs state when done editing message."
"Switch to Emacs state when done editing message."
(viper-change-state-to-emacs)))
;; In case RMAIL was loaded before Viper.
(defadvice rmail-cease-edit (after viper-rmail-advice activate)
@ -1121,7 +1121,7 @@ It also can't undo some Viper settings."
(save-window-excursion
(with-output-to-temp-buffer " *viper-info*"
(princ "
You have loaded Viper, and are about to Viperize your emacs!
You have loaded Viper, and are about to Viperize your Emacs!
Viper is a Package for Emacs Rebels and a venomous VI PERil,

34
lisp/erc/ChangeLog
View file

@ -1,3 +1,11 @@
2006-11-06 Juanma Barranquero <lekktu@gmail.com>
* erc-dcc.el (erc-dcc-send-file): Fix typo in error message.
* erc.el (read-passwd):
* erc-autoaway.el (erc-autoaway-reestablish-idletimer):
* erc-truncate.el (truncate): Fix typo in docstring.
2006-08-13 Romain Francoise <romain@orebokech.com>
* erc-match.el (erc-log-matches-make-buffer): End `y-or-n-p'
@ -256,7 +264,7 @@
2006-05-01 Edward O'Connor <ted@oconnor.cx>
* erc-goodies.el: (erc-handle-irc-url): New function, suitable as
* erc-goodies.el (erc-handle-irc-url): New function, suitable as
a value for `url-irc-function'.
2006-04-18 Diane Murray <disumu@x3y2z1.net>
@ -360,14 +368,14 @@
2006-02-12 Michael Olson <mwolson@gnu.org>
* erc-autoaway.el, erc-dcc.el, erc-ezbounce.el, erc-fill.el,
erc-goodies.el, erc-hecomplete.el, erc-ibuffer.el, erc-identd.el,
erc-imenu.el, erc-join.el, erc-lang.el, erc-list.el, erc-log.el,
erc-match.el, erc-menu.el, erc-netsplit.el, erc-networks.el,
erc-notify.el, erc-page.el, erc-pcomplete.el, erc-replace.el,
erc-ring.el, erc-services.el, erc-sound.el, erc-speedbar.el,
erc-spelling.el, erc-track.el, erc-truncate.el, erc-xdcc.el: Add
2006 to copyright years, to comply with the changed guidelines.
* erc-autoaway.el, erc-dcc.el, erc-ezbounce.el, erc-fill.el
* erc-goodies.el, erc-hecomplete.el, erc-ibuffer.el, erc-identd.el
* erc-imenu.el, erc-join.el, erc-lang.el, erc-list.el, erc-log.el
* erc-match.el, erc-menu.el, erc-netsplit.el, erc-networks.el
* erc-notify.el, erc-page.el, erc-pcomplete.el, erc-replace.el
* erc-ring.el, erc-services.el, erc-sound.el, erc-speedbar.el
* erc-spelling.el, erc-track.el, erc-truncate.el, erc-xdcc.el:
Add 2006 to copyright years, to comply with the changed guidelines.
2006-02-11 Michael Olson <mwolson@gnu.org>
@ -528,7 +536,7 @@
2006-01-29 Edward O'Connor <ted@oconnor.cx>
* erc-viper.el: Remove. Now that ERC is included in Emacs, these
* erc-viper.el: Remove. Now that ERC is included in Emacs, these
work-arounds live in Viper itself.
2006-01-28 Michael Olson <mwolson@gnu.org>
@ -669,10 +677,10 @@
2006-01-22 Johan Bockgård <bojohan@users.sourceforge.net>
* erc-track.el: Use `(eval-when-compile (require 'cl))' (for
`case'). Doc fixes.
`case'). Doc fixes.
(erc-find-parsed-property): Simplify.
(erc-track-get-active-buffer): Fix logic. Simplify.
(erc-track-switch-buffer): Remove unused variable `dir'. Simplify.
(erc-track-get-active-buffer): Fix logic. Simplify.
(erc-track-switch-buffer): Remove unused variable `dir'. Simplify.
* erc-speak.el: Doc fixes.
(erc-speak-region): `propertize' --> `erc-propertize'.

2
lisp/erc/erc-autoaway.el
View file

@ -136,7 +136,7 @@ See `erc-auto-discard-away'."
(eval-when-compile (defvar erc-autoaway-idle-seconds))
(defun erc-autoaway-reestablish-idletimer ()
"Reestablish the emacs idletimer.
"Reestablish the Emacs idletimer.
If `erc-autoaway-idle-method' is 'emacs, you must call this
function each time you change `erc-autoaway-idle-seconds'."
(interactive)

2
lisp/erc/erc-dcc.el
View file

@ -808,7 +808,7 @@ other client."
(erc-ip-to-decimal (nth 0 contact))
(nth 1 contact)
size)))
(error "`make-network-process' not supported by your emacs.")))
(error "`make-network-process' not supported by your Emacs")))
;;; GET handling

2
lisp/erc/erc-truncate.el
View file

@ -48,7 +48,7 @@ Used only when auto-truncation is enabled.
(define-erc-module truncate nil
"Truncate a query buffer if it gets too large.
This prevents the query buffer from getting too large, which can
bring any grown emacs to its knees after a few days worth of
bring any grown Emacs to its knees after a few days worth of
tracking heavy-traffic channels."
;;enable
((add-hook 'erc-insert-post-hook 'erc-truncate-buffer))

2
lisp/erc/erc.el
View file

@ -2002,7 +2002,7 @@ If no buffer matches, return nil."
(if (not (fboundp 'read-passwd))
(defun read-passwd (prompt)
"Substitute for read-passwd in early emacsen"
"Substitute for `read-passwd' in early emacsen."
(read-from-minibuffer prompt)))
(defcustom erc-before-connect nil

2
lisp/expand.el
View file

@ -296,7 +296,7 @@ If ARG is omitted, point is placed at the end of the expanded text."
(defvar expand-list nil "Temporary variable used by the Expand package.")
(defvar expand-pos nil
"If non nil, stores a vector containing markers to positions defined by the last expansion.
"If non-nil, stores a vector containing markers to positions defined by the last expansion.
This variable is local to a buffer.")
(make-variable-buffer-local 'expand-pos)

1
lisp/faces.el
View file

@ -1351,6 +1351,7 @@ If FRAME is omitted or nil, use the selected frame."
(insert " undefined face.\n")
(let ((customize-label "customize this face")
file-name)
(insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
(princ (concat " (" customize-label ")\n"))
(insert "Documentation: "
(or (face-documentation f)

2
lisp/ffap.el
View file

@ -4,7 +4,7 @@
;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
;; Maintainer: Rajesh Vaidheeswarran <rv@gnu.org>
;; Maintainer: FSF
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse, convenience
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/

9
lisp/files.el
View file

@ -4094,6 +4094,15 @@ non-nil, it is called instead of rereading visited file contents."
(if auto-save-p 'auto-save-coding
(or coding-system-for-read
buffer-file-coding-system-explicit))))
(if (and (not enable-multibyte-characters)
(not (memq (coding-system-base
coding-system-for-read)
'(no-conversion raw-text))))
;; As a coding system suitable for multibyte
;; buffer is specified, make the current
;; buffer multibyte.
(set-buffer-multibyte t))
;; This force after-insert-file-set-coding
;; (called from insert-file-contents) to set
;; buffer-file-coding-system to a proper value.

4
lisp/follow.el
View file

@ -449,7 +449,7 @@ After that, changing the prefix key requires manipulating keymaps."
(if follow-mode
menu
'(["Activate " follow-mode t]))))
mainmap)
"Minor mode keymap for Follow mode.")
@ -473,7 +473,7 @@ are \" Fw\", or simply \"\"."
:group 'follow)
(defvar follow-avoid-tail-recenter-p (not (featurep 'xemacs))
"*When non-nil, patch emacs so that tail windows won't be recentered.
"*When non-nil, patch Emacs so that tail windows won't be recentered.
A \"tail window\" is a window that displays only the end of
the buffer. Normally it is practical for the user that empty

22
lisp/gnus/ChangeLog
View file

@ -1,7 +1,23 @@
2006-11-03 Juanma Barranquero <lekktu@gmail.com>
* gnus-diary.el (gnus-diary-delay-format-function):
* nndiary.el (nndiary-reminders):
* nnsoup.el (nnsoup-always-save): Use "non-nil" in docstrings.
2006-11-01 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-art.el (article-hide-boring-headers): Fetch date from
gnus-original-article-buffer to avoid problems with localized date
strings.
2006-10-30 Katsumi Yamaoka <yamaoka@jpl.org>
* html2text.el (html2text-format-tags): Avoid infloop on open tags.
2006-10-29 Reiner Steib <Reiner.Steib@gmx.de>
* mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): New
variables.
* mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list):
New variables.
(mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions.
(mm-charset-synonym-alist): Move some entries to
mm-codepage-iso-8859-list.
@ -610,7 +626,7 @@
(rfc2231-encode-string): Be sure to work on multibyte buffer at
first, and after mm-encode-body, change the buffer to unibyte.
2006-03-21 Daniel Pittman <daniel@rimspace.net>
2006-03-21 Daniel Pittman <daniel@rimspace.net>
* nnimap.el (nnimap-request-update-info-internal): Optimize.
Don't `gnus-uncompress-range' to avoid excessive memory usage.

6
lisp/gnus/gnus-art.el
View file

@ -1917,7 +1917,11 @@ always hide."
'string<))))
(gnus-article-hide-header "reply-to")))))
((eq elem 'date)
(let ((date (message-fetch-field "date")))
(let ((date (with-current-buffer gnus-original-article-buffer
;; If date in `gnus-article-buffer' is localized
;; (`gnus-treat-date-user-defined'),
;; `days-between' might fail.
(message-fetch-field "date"))))
(when (and date
(< (days-between (current-time-string) date)
4))

2
lisp/gnus/gnus-diary.el
View file

@ -121,7 +121,7 @@ Please refer to `format-time-string' for information on possible values."
(defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english
"*Function called to format a diary delay string.
It is passed two arguments. The first one is non nil if the delay is in
It is passed two arguments. The first one is non-nil if the delay is in
the past. The second one is of the form ((NUM . UNIT) ...) where NUM is
an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute.
It should return strings like \"In 2 months, 3 weeks\", \"3 hours,

4
lisp/gnus/html2text.el
View file

@ -423,7 +423,9 @@ See the documentation for that variable."
(p3) (p4))
(search-backward "<" (point-min) t)
(setq p1 (point))
(re-search-forward (format "</%s>" tag) (point-max) t)
(unless (search-forward (format "</%s>" tag) (point-max) t)
(goto-char p2)
(insert (format "</%s>" tag)))
(setq p4 (point))
(search-backward "</" (point-min) t)
(setq p3 (point))

2
lisp/gnus/nndiary.el
View file

@ -263,7 +263,7 @@ not 'century, sorry).
NOTE: the units of measure actually express dates, not durations: if you
use 'week, messages will pop up on Sundays at 00:00 (or Mondays if
`nndiary-week-starts-on-monday' is non nil) and *not* 7 days before the
`nndiary-week-starts-on-monday' is non-nil) and *not* 7 days before the
appointement, if you use 'month, messages will pop up on the first day of
each months, at 00:00 and so on.

2
lisp/gnus/nnsoup.el
View file

@ -75,7 +75,7 @@ The SOUP packet file name will be inserted at the %s.")
"*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
(defvoo nnsoup-always-save t
"If non nil commit the reply buffer on each message send.
"If non-nil commit the reply buffer on each message send.
This is necessary if using message mode outside Gnus with nnsoup as a
backend for the messages.")

66
lisp/help-fns.el
View file

@ -35,72 +35,6 @@
(require 'help-mode)
;;;###autoload
(defun help-with-tutorial (&optional arg)
"Select the Emacs learn-by-doing tutorial.
If there is a tutorial version written in the language
of the selected language environment, that version is used.
If there's no tutorial in that language, `TUTORIAL' is selected.
With ARG, you are asked to choose which language."
(interactive "P")
(let ((lang (if arg
(let ((minibuffer-setup-hook minibuffer-setup-hook))
(add-hook 'minibuffer-setup-hook
'minibuffer-completion-help)
(read-language-name 'tutorial "Language: " "English"))
(if (get-language-info current-language-environment 'tutorial)
current-language-environment
"English")))
file filename)
(setq filename (get-language-info lang 'tutorial))
(setq file (expand-file-name (concat "~/" filename)))
(delete-other-windows)
(if (get-file-buffer file)
(switch-to-buffer (get-file-buffer file))
(switch-to-buffer (create-file-buffer file))
(setq buffer-file-name file)
(setq default-directory (expand-file-name "~/"))
(setq buffer-auto-save-file-name nil)
(insert-file-contents (expand-file-name filename data-directory))
(hack-local-variables)
(goto-char (point-min))
(search-forward "\n<<")
(beginning-of-line)
;; Convert the <<...>> line to the proper [...] line,
;; or just delete the <<...>> line if a [...] line follows.
(cond ((save-excursion
(forward-line 1)
(looking-at "\\["))
(delete-region (point) (progn (forward-line 1) (point))))
((looking-at "<<Blank lines inserted.*>>")
(replace-match "[Middle of page left blank for didactic purposes. Text continues below]"))
(t
(looking-at "<<")
(replace-match "[")
(search-forward ">>")
(replace-match "]")))
(beginning-of-line)
(let ((n (- (window-height (selected-window))
(count-lines (point-min) (point))
6)))
(if (< n 8)
(progn
;; For a short gap, we don't need the [...] line,
;; so delete it.
(delete-region (point) (progn (end-of-line) (point)))
(newline n))
;; Some people get confused by the large gap.
(newline (/ n 2))
;; Skip the [...] line (don't delete it).
(forward-line 1)
(newline (- n (/ n 2)))))
(goto-char (point-min))
(setq buffer-undo-list nil)
(set-buffer-modified-p nil))))
;; Functions
;;;###autoload

2
lisp/help.el
View file

@ -361,7 +361,7 @@ With argument, display info only for the selected version."
((<= version 18)
(setq version (format "%d" version)))
((> version emacs-major-version)
(error "No news about emacs %d (yet)" version))))
(error "No news about Emacs %d (yet)" version))))
(let* ((vn (if (stringp version)
(string-to-number version)
version))

2
lisp/hexl.el
View file

@ -169,7 +169,7 @@ A sample format:
000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character
000000c0: 7265 6769 6f6e 2e0a region..
Movement is as simple as movement in a normal emacs text buffer. Most
Movement is as simple as movement in a normal Emacs text buffer. Most
cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
to move the cursor left, right, down, and up).

65
lisp/info-look.el
View file

@ -250,10 +250,10 @@ system."
;;;###autoload
(defun info-lookup-symbol (symbol &optional mode)
"Display the definition of SYMBOL, as found in the relevant manual.
When this command is called interactively, it reads SYMBOL from the minibuffer.
In the minibuffer, use M-n to yank the default argument value
into the minibuffer so you can edit it.
The default symbol is the one found at point.
When this command is called interactively, it reads SYMBOL from the
minibuffer. In the minibuffer, use M-n to yank the default argument
value into the minibuffer so you can edit it. The default symbol is the
one found at point.
With prefix arg a query for the symbol help mode is offered."
(interactive
@ -566,6 +566,45 @@ Return nil if there is nothing appropriate in the buffer near point."
(concat prefix name))))
(error nil)))
(defun info-lookup-guess-custom-symbol ()
"Get symbol at point in custom buffers."
(condition-case nil
(save-excursion
(let ((case-fold-search t)
(ignored-chars "][()`',:.\" \t\n")
(significant-chars "^][()`',:.\" \t\n")
beg end)
(cond
((and (memq (get-char-property (point) 'face)
'(custom-variable-tag custom-variable-tag-face))
(setq beg (previous-single-char-property-change
(point) 'face nil (line-beginning-position)))
(setq end (next-single-char-property-change
(point) 'face nil (line-end-position)))
(> end beg))
(subst-char-in-string
?\ ?\- (buffer-substring-no-properties beg end)))
((or (and (looking-at (concat "[" significant-chars "]"))
(save-excursion
(skip-chars-backward significant-chars)
(setq beg (point)))
(skip-chars-forward significant-chars)
(setq end (point))
(> end beg))
(and (looking-at "[ \t\n]")
(looking-back (concat "[" significant-chars "]"))
(setq end (point))
(skip-chars-backward significant-chars)
(setq beg (point))
(> end beg))
(and (skip-chars-forward ignored-chars)
(setq beg (point))
(skip-chars-forward significant-chars)
(setq end (point))
(> end beg)))
(buffer-substring-no-properties beg end)))))
(error nil)))
;;;###autoload
(defun info-complete-symbol (&optional mode)
"Perform completion on symbol preceding point."
@ -789,7 +828,7 @@ Return nil if there is nothing appropriate in the buffer near point."
(info-lookup-maybe-add-help
:mode 'emacs-lisp-mode
:regexp "[^][()'\" \t\n]+"
:regexp "[^][()`',\" \t\n]+"
:doc-spec '(;; Commands with key sequences appear in nodes as `foo' and
;; those without as `M-x foo'.
("(emacs)Command Index" nil "`\\(M-x[ \t\n]+\\)?" "'")
@ -806,13 +845,13 @@ Return nil if there is nothing appropriate in the buffer near point."
(info-lookup-maybe-add-help
:mode 'lisp-interaction-mode
:regexp "[^][()'\" \t\n]+"
:regexp "[^][()`',\" \t\n]+"
:parse-rule 'ignore
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
:mode 'lisp-mode
:regexp "[^()'\" \t\n]+"
:regexp "[^()`',\" \t\n]+"
:parse-rule 'ignore
:other-modes '(emacs-lisp-mode))
@ -913,6 +952,18 @@ Return nil if there is nothing appropriate in the buffer near point."
;; This gets functions in evaluated classes. Other
;; possible patterns don't seem to work too well.
"`" "(")))
(info-lookup-maybe-add-help
:mode 'custom-mode
:ignore-case t
:regexp "[^][()`',:\" \t\n]+"
:parse-rule 'info-lookup-guess-custom-symbol
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
:mode 'help-mode
:regexp "[^][()`',:\" \t\n]+"
:other-modes '(emacs-lisp-mode))
(provide 'info-look)

2
lisp/international/ja-dic-cnv.el
View file

@ -345,7 +345,7 @@
(insert ")\n\n")))
(defun skkdic-convert (filename &optional dirname)
"Generate Emacs lisp file form Japanese dictionary file FILENAME.
"Generate Emacs Lisp file form Japanese dictionary file FILENAME.
The format of the dictionary file should be the same as SKK dictionaries.
Optional argument DIRNAME if specified is the directory name under which
the generated Emacs Lisp is saved.

11
lisp/international/mule.el
View file

@ -296,10 +296,10 @@ attribute."
(defun load-with-code-conversion (fullname file &optional noerror nomessage)
"Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
The file contents are decoded before evaluation if necessary.
If optional second arg NOERROR is non-nil,
If optional third arg NOERROR is non-nil,
report no error if FILE doesn't exist.
Print messages at start and end of loading unless
optional third arg NOMESSAGE is non-nil.
optional fourth arg NOMESSAGE is non-nil.
Return t if file exists."
(if (null (file-readable-p fullname))
(and (null noerror)
@ -358,7 +358,7 @@ Return t if file exists."
(kill-buffer buffer)))
(unless purify-flag
(do-after-load-evaluation fullname))
(unless (or nomessage noninteractive)
(if source
(message "Loading %s (source)...done" file)
@ -1665,8 +1665,7 @@ cons (CODING . SOURCE), where CODING is the specified coding
system and SOURCE is a symbol `auto-coding-alist',
`auto-coding-regexp-alist', `coding:', or `auto-coding-functions'
indicating by what CODING is specified. Note that the validity
of CODING is not checked; it's callers responsibility to check
it.
of CODING is not checked; it's callers responsibility to check it.
If nothing is specified, the return value is nil."
(or (let ((coding-system (auto-coding-alist-lookup filename)))
@ -1687,7 +1686,7 @@ If nothing is specified, the return value is nil."
;; and for "unibyte:" at the head and tail of SIZE bytes.
(setq head-found (or (search-forward "coding:" head-end t)
(search-forward "unibyte:" head-end t)
(search-forward "enable-character-translation:"
(search-forward "enable-character-translation:"
head-end t)))
(if (and head-found (> head-found tail-start))
;; Head and tail are overlapped.

4
lisp/loadhist.el
View file

@ -119,7 +119,9 @@ return the feature \(symbol\)."
(mapcar (lambda (feature)
(list (symbol-name feature)))
features)
nil t)))
;; Complete only features loaded from a file
#'(lambda (f) (feature-file (intern (car f))))
t)))
(defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks)
(defvar unload-feature-special-hooks

2
lisp/mail/emacsbug.el
View file

@ -126,7 +126,7 @@ usually do not have translators to read other languages for them.\n\n")
(setq user-point (point))
(insert "\n\n")
(insert "If emacs crashed, and you have the emacs process in the gdb debugger,\n"
(insert "If Emacs crashed, and you have the Emacs process in the gdb debugger,\n"
"please include the output from the following gdb commands:\n"
" `bt full' and `xbacktrace'.\n")

156
lisp/mail/feedmail.el
View file

@ -330,11 +330,11 @@ This is done after the message is completely prepped, and you'll be
looking at the top of the message in a buffer when you get the prompt.
If set to the symbol 'queued, give the confirmation prompt only while
running the queue (however, the prompt is always suppressed if you are
processing the queue via feedmail-run-the-queue-no-prompts). If set
processing the queue via `feedmail-run-the-queue-no-prompts'). If set
to the symbol 'immediate, give the confirmation prompt only when
sending immediately. For any other non-nil value, prompt in both
cases. You can give a timeout for the prompt; see variable
feedmail-confirm-outgoing-timeout."
`feedmail-confirm-outgoing-timeout'."
:group 'feedmail-misc
:type 'boolean
)
@ -344,7 +344,7 @@ feedmail-confirm-outgoing-timeout."
"*If non-nil, a timeout in seconds at the send confirmation prompt.
If a positive number, it's a timeout before sending. If a negative
number, it's a timeout before not sending. This will not work if your
version of Emacs doesn't include the function y-or-n-p-with-timeout
version of Emacs doesn't include the function `y-or-n-p-with-timeout'
\(e.g., some versions of XEmacs\)."
:group 'feedmail-misc
:type '(choice (const nil) integer)
@ -355,7 +355,7 @@ version of Emacs doesn't include the function y-or-n-p-with-timeout
"*If non-nil remove Bcc: lines from the message headers.
In any case, the Bcc: lines do participate in the composed address
list. You may want to leave them in if you're using sendmail
\(see feedmail-buffer-eating-function\)."
\(see `feedmail-buffer-eating-function'\)."
:group 'feedmail-headers
:type 'boolean
)
@ -365,7 +365,7 @@ list. You may want to leave them in if you're using sendmail
"*If non-nil remove Resent-Bcc: lines from the message headers.
In any case, the Resent-Bcc: lines do participate in the composed
address list. You may want to leave them in if you're using sendmail
\(see feedmail-buffer-eating-function\)."
\(see `feedmail-buffer-eating-function'\)."
:group 'feedmail-headers
:type 'boolean
)
@ -410,7 +410,7 @@ as-is. The filling is done after mail address alias expansion."
(defcustom feedmail-fill-to-cc-fill-column default-fill-column
"*Fill column used by feedmail-fill-to-cc."
"*Fill column used by `feedmail-fill-to-cc'."
:group 'feedmail-headers
:type 'integer
)
@ -481,7 +481,7 @@ another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable feedmail-fiddle-plex-blurb. In all
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"X-Sender\" or \"X-Resent-Sender\".
@ -498,7 +498,7 @@ header is fiddled after the From: header is fiddled."
"*If non-nil, force writing file as binary (this applies to queues and Fcc:).
On systems where there is a difference between binary and text files,
feedmail will temporarily manipulate the values of `buffer-file-type'
and/or default-buffer-file-type to make the writing as binary. If
and/or `default-buffer-file-type' to make the writing as binary. If
nil, writing will be in text mode. On systems where there is no
distinction or where it is controlled by other variables or other
means, this option has no effect."
@ -521,7 +521,7 @@ another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable feedmail-fiddle-plex-blurb. In all
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"X-From\" or \"X-Resent-From\".
@ -544,7 +544,7 @@ change the value of `user-mail-address' to be the same while the message
is being sent. If there is no Sender: header, use the From: header,
if any. Address values are taken from the actual message just before
it is sent, and the process is independent of the values of
feedmail-from-line and/or feedmail-sender-line.
`feedmail-from-line' and/or `feedmail-sender-line'.
There are many and good reasons for having the message header
From:/Sender: be different from the message envelope \"from\"
@ -595,7 +595,7 @@ another function, but let's not be ridiculous). If a string, it
should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with no arguments. For an explanation of fiddle-plexes, see the
documentation for the variable feedmail-fiddle-plex-blurb. In all
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"X-Mailer\" or \"X-Resent-Mailer\"."
:group 'feedmail-headers
@ -619,7 +619,7 @@ should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with one argument: the possibly-nil name of the file associated with
the message buffer. For an explanation of fiddle-plexes, see the
documentation for the variable feedmail-fiddle-plex-blurb. In all
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"Message-Id\" or \"Resent-Message-Id\".
@ -655,7 +655,7 @@ If nil, nothing is done about Date:.
If t, a Date: header of a predetermined format is produced, but only
if there is not already a Date: in the message. A value of t is
equivalent to using the function feedmail-default-date-generator.
equivalent to using the function `feedmail-default-date-generator'.
If neither nil nor t, it may be a string, a fiddle-plex, or a function
which returns either nil, t, a string, or a fiddle-plex (or, in fact,
@ -664,7 +664,7 @@ should be just the contents of the header, not the name of the header
itself nor the trailing newline. If a function, it will be called
with one argument: the possibly-nil name of the file associated with
the message buffer. For an explanation of fiddle-plexes, see the
documentation for the variable feedmail-fiddle-plex-blurb. In all
documentation for the variable `feedmail-fiddle-plex-blurb'. In all
cases the name element of the fiddle-plex is ignored and is hardwired
by feedmail to either \"Date\" or \"Resent-Date\".
@ -700,10 +700,10 @@ fiddle-plex.
feedmail will use this list of fiddle-plexes to manipulate user-specified
message header fields. It does this after it has completed all normal
message header field manipulation and before calling feedmail-last-chance-hook.
message header field manipulation and before calling `feedmail-last-chance-hook'.
For an explanation of fiddle-plexes, see the documentation for the
variable feedmail-fiddle-plex-blurb. In contrast to some other fiddle-plex
variable `feedmail-fiddle-plex-blurb'. In contrast to some other fiddle-plex
manipulation functions, in this context, it makes no sense to have an element
which is nil, t, or a simple string."
:group 'feedmail-headers
@ -727,7 +727,7 @@ it, you should avoid it since it is inherently less efficient than normal
multiple delivery. One reason to use it is to overcome mis-featured mail
transports which betray your trust by revealing Bcc: addressees in the
headers of a message. Another use is to do a crude form of mailmerge, for
which see feedmail-spray-address-fiddle-plex-list.
which see `feedmail-spray-address-fiddle-plex-list'.
If one of the calls to the buffer-eating function results in an error,
what happens next is carelessly defined, so beware."
@ -736,12 +736,12 @@ what happens next is carelessly defined, so beware."
)
(defvar feedmail-spray-this-address nil
"Do not set or change this variable. See feedmail-spray-address-fiddle-plex-list.")
"Do not set or change this variable. See `feedmail-spray-address-fiddle-plex-list'.")
(defcustom feedmail-spray-address-fiddle-plex-list nil
"User-supplied specification for a crude form of mailmerge capability.
When spraying is enabled, feedmail composes a list of envelope addresses.
In turn, feedmail-spray-this-address is temporarily set to each address
In turn, `feedmail-spray-this-address' is temporarily set to each address
\(stripped of any comments and angle brackets\) and calls a function which
fiddles message headers according to this variable. See the documentation for
`feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures.
@ -772,15 +772,15 @@ For example,
The idea of the example is that, during spray mode, as each message is
about to be transmitted to an individual address, the function will be
called and will consult feedmail-spray-this-address to find the
called and will consult `feedmail-spray-this-address' to find the
stripped envelope email address (no comments or angle brackets). The
function should return an embellished form of the address.
The recipe for sending form letters is: (1) create a message with all
addressees on Bcc: headers; (2) tell feedmail to remove Bcc: headers
before sending the message; (3) create a function which will embellish
stripped addresses, if desired; (4) define feedmail-spray-address-fiddle-plex-list
appropriately; (5) send the message with feedmail-enable-spray set
stripped addresses, if desired; (4) define `feedmail-spray-address-fiddle-plex-list'
appropriately; (5) send the message with `feedmail-enable-spray' set
non-nil; (6) stand back and watch co-workers wonder at how efficient
you are at accomplishing inherently inefficient things."
:group 'feedmail-spray
@ -809,7 +809,7 @@ versa by pretending to send it and then selecting whichever queue
directory you want at the prompt. The right thing will happen.
To transmit all the messages in the queue, invoke the command
feedmail-run-the-queue or feedmail-run-the-queue-no-prompts."
`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'."
:group 'feedmail-queue
:type 'boolean
)
@ -818,7 +818,7 @@ feedmail-run-the-queue or feedmail-run-the-queue-no-prompts."
(defcustom feedmail-queue-runner-confirm-global nil
"*If non-nil, give a y-or-n confirmation prompt before running the queue.
Prompt even if the queue is about to be processed as a result of a call to
feedmail-run-the-queue-no-prompts. This gives you a way to bail out
`feedmail-run-the-queue-no-prompts'. This gives you a way to bail out
without having to answer no to the individual message prompts."
:group 'feedmail-queue
:type 'boolean)
@ -868,7 +868,7 @@ without a prompt."
(defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: "
"*A string which will be used for the message action prompt.
If it contains a \"%s\", that will be replaced with the value of
feedmail-ask-before-queue-default."
`feedmail-ask-before-queue-default'."
:group 'feedmail-queue
:type 'string
)
@ -877,7 +877,7 @@ feedmail-ask-before-queue-default."
(defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: "
"*A string which will be used for repompting after invalid input.
If it contains a \"%s\", that will be replaced with the value of
feedmail-ask-before-queue-default."
`feedmail-ask-before-queue-default'."
:group 'feedmail-queue
:type 'string
)
@ -921,7 +921,7 @@ the help for the message action prompt."
All of the values are function names, except help, which is a special
symbol that calls up help for the prompt (the help describes the
actions from the standard alist). To customize your own choices,
define a similar alist called feedmail-prompt-before-queue-user-alist.
define a similar alist called `feedmail-prompt-before-queue-user-alist'.
The actual alist used for message action will be the standard alist
overlaid with the user-alist. To neutralize an item in the standard
alist without providing a replacement, define an appropriate element
@ -929,7 +929,7 @@ in the user alist with a value of nil." )
(defcustom feedmail-prompt-before-queue-user-alist nil
"See feedmail-prompt-before-queue-standard-alist."
"See `feedmail-prompt-before-queue-standard-alist'."
:group 'feedmail-queue
:type '(repeat (cons character function))
)
@ -940,10 +940,10 @@ in the user alist with a value of nil." )
When the message action prompt is shown, the user can as for verbose help,
at which point a buffer pops up describing the meaning of possible
responses to the prompt. Through various customizations (see, for
example, feedmail-prompt-before-queue-user-alist), the available responses
example, `feedmail-prompt-before-queue-user-alist'), the available responses
and the prompt itself can be changed. If this variable is set to a string
value, that string is written to the help buffer after the standard info.
It may contain embedded line breaks. It will be printed via princ."
It may contain embedded line breaks. It will be printed via `princ'."
:group 'feedmail-queue
:type '(choice (const nil) string)
)
@ -955,7 +955,7 @@ It may contain embedded line breaks. It will be printed via princ."
(after-draft . feedmail-queue-reminder-medium)
(after-run . feedmail-queue-reminder-brief)
(on-demand . feedmail-run-the-queue-global-prompt))
"See feedmail-queue-reminder."
"See `feedmail-queue-reminder'."
:group 'feedmail-queue
:type '(repeat (cons (choice :tag "Event"
(const on-demand)
@ -1017,7 +1017,7 @@ used."
(defcustom feedmail-queue-use-send-time-for-message-id nil
"*If non-nil, use send time for the Message-Id: header value.
This variable is used by the default Message-Id: generating function,
feedmail-default-message-id-generator. If nil, the default, the
`feedmail-default-message-id-generator'. If nil, the default, the
last-modified timestamp of the queue file is used to create the
message Message-Id: header; if there is no queue file, the current time is
used."
@ -1061,7 +1061,7 @@ any."
When feedmail queues a message, it creates a unique file name. By default,
the file name is based in part on the subject of the message being queued.
If there is no subject, consult this variable. See documentation for the
function feedmail-queue-subject-slug-maker.
function `feedmail-queue-subject-slug-maker'.
If t, an innocuous default is used.
@ -1083,8 +1083,8 @@ it's not expected to be a complete filename."
"*The FQM suffix used to distinguish feedmail queued message files.
You probably want this to be a period followed by some letters and/or
digits. The distinction is to be able to tell them from other random
files that happen to be in the feedmail-queue-directory or
feedmail-queue-draft-directory. By the way, FQM stands for feedmail
files that happen to be in the `feedmail-queue-directory' or
`feedmail-queue-draft-directory'. By the way, FQM stands for feedmail
queued message."
:group 'feedmail-queue
:type 'string
@ -1133,20 +1133,20 @@ variable, but may depend on its value as described here.")
(defun feedmail-mail-send-hook-splitter ()
"Facilitate dividing mail-send-hook things into queued and immediate cases.
If you have mail-send-hook functions that should only be called for sending/
"Facilitate dividing `mail-send-hook' things into queued and immediate cases.
If you have `mail-send-hook' functions that should only be called for sending/
queueing messages or only be called for the sending of queued messages, this is
for you. Add this function to mail-send-hook with something like this:
for you. Add this function to `mail-send-hook' with something like this:
(add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
Then add the functions you want called to either feedmail-mail-send-hook-queued
or feedmail-mail-send-hook, as apprpriate. The distinction is that
feedmail-mail-send-hook will be called when you send mail from a composition
Then add the functions you want called to either `feedmail-mail-send-hook-queued'
or `feedmail-mail-send-hook', as apprpriate. The distinction is that
`feedmail-mail-send-hook' will be called when you send mail from a composition
buffer (typically by typing C-c C-c), whether the message is sent immediately
or placed in the queue or drafts directory. feedmail-mail-send-hook-queued is
or placed in the queue or drafts directory. `feedmail-mail-send-hook-queued' is
called when messages are being sent from the queue directory, typically via a
call to feedmail-run-the-queue."
call to `feedmail-run-the-queue'."
(if feedmail-queue-runner-is-active
(run-hooks 'feedmail-mail-send-hook-queued)
(run-hooks 'feedmail-mail-send-hook))
@ -1154,15 +1154,15 @@ call to feedmail-run-the-queue."
(defvar feedmail-mail-send-hook nil
"*See documentation for feedmail-mail-send-hook-splitter.")
"*See documentation for `feedmail-mail-send-hook-splitter'.")
(defvar feedmail-mail-send-hook-queued nil
"*See documentation for feedmail-mail-send-hook-splitter.")
"*See documentation for `feedmail-mail-send-hook-splitter'.")
(defun feedmail-confirm-addresses-hook-example ()
"An example of a feedmail-last-chance-hook.
"An example of a `feedmail-last-chance-hook'.
It shows the simple addresses and gets a confirmation. Use as:
(setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)."
(save-window-excursion
@ -1179,10 +1179,10 @@ It shows the simple addresses and gets a confirmation. Use as:
It has already had all the header prepping from the standard package.
The next step after running the hook will be to push the buffer into a
subprocess that mails the mail. The hook might be interested in
these: (1) feedmail-prepped-text-buffer contains the header and body
of the message, ready to go; (2) feedmail-address-list contains a list
these: (1) `feedmail-prepped-text-buffer' contains the header and body
of the message, ready to go; (2) `feedmail-address-list' contains a list
of simplified recipients of addresses which are to be given to the
subprocess (the hook may change the list); (3) feedmail-error-buffer
subprocess (the hook may change the list); (3) `feedmail-error-buffer'
is an empty buffer intended to soak up errors for display to the user.
If the hook allows interactive activity, the user should not send more
mail while in the hook since some of the internal buffers will be
@ -1197,10 +1197,10 @@ reused and things will get confused."
It has already had all the header prepping from the standard package.
The next step after running the hook will be to save the message via
Fcc: processing. The hook might be interested in these: (1)
feedmail-prepped-text-buffer contains the header and body of the
message, ready to go; (2) feedmail-address-list contains a list of
`feedmail-prepped-text-buffer' contains the header and body of the
message, ready to go; (2) `feedmail-address-list' contains a list of
simplified recipients of addressees to whom the message was sent (3)
feedmail-error-buffer is an empty buffer intended to soak up errors
`feedmail-error-buffer' is an empty buffer intended to soak up errors
for display to the user. If the hook allows interactive activity, the
user should not send more mail while in the hook since some of the
internal buffers will be reused and things will get confused."
@ -1213,7 +1213,7 @@ internal buffers will be reused and things will get confused."
"*A function to set the proper mode of a message file.
Called when the message is read back out of the queue directory with a single
argument, the optional argument used in the call to
feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'.
Most people want `mail-mode', so the default value is an anonymous
function which is just a wrapper to ignore the supplied argument when
@ -1235,7 +1235,7 @@ When trying to send a queued message, if the value of this variable is
non-nil, feedmail will first try to send the message using the value
of `mail-header-separator'. If it can't find that, it will temporarily
set `mail-header-separator' to the value of
feedmail-queue-alternative-mail-header-separator and try again."
`feedmail-queue-alternative-mail-header-separator' and try again."
:group 'feedmail-queue
:type '(choice (const nil) string)
)
@ -1245,11 +1245,11 @@ feedmail-queue-alternative-mail-header-separator and try again."
"*Function to initiate sending a message file.
Called for each message read back out of the queue directory with a
single argument, the optional argument used in the call to
feedmail-run-the-queue or feedmail-run-the-queue-no-prompts.
`feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'.
Interactively, that argument will be the prefix argument. Most people
want mail-send-and-exit (bound to C-c C-c in mail-mode), but here's
your chance to have something different. Called with funcall, not
call-interactively."
want `mail-send-and-exit' (bound to C-c C-c in mail-mode), but here's
your chance to have something different. Called with `funcall', not
`call-interactively'."
:group 'feedmail-queue
:type 'function
)
@ -1291,11 +1291,11 @@ The function's three (mandatory) arguments are: (1) the buffer
containing the prepped message; (2) a buffer where errors should be
directed; and (3) a list containing the addresses individually as
strings. Three popular choices for this are
feedmail-buffer-to-binmail, feedmail-buffer-to-smtpmail, and
feedmail-buffer-to-sendmail. If you use the sendmail form, you
probably want to set feedmail-nuke-bcc and/or feedmail-nuke-resent-bcc
`feedmail-buffer-to-binmail', `feedmail-buffer-to-smtpmail', and
`feedmail-buffer-to-sendmail'. If you use the sendmail form, you
probably want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc'
to nil. If you use the binmail form, check the value of
feedmail-binmail-template."
`feedmail-binmail-template'."
:group 'feedmail-misc
:type 'function
)
@ -1306,7 +1306,7 @@ feedmail-binmail-template."
It can result in any command understandable by /bin/sh. Might not
work at all in non-Unix environments. The single '%s', if present,
gets replaced by the space-separated, simplified list of addressees.
Used in feedmail-buffer-to-binmail to form the shell command which
Used in `feedmail-buffer-to-binmail' to form the shell command which
will receive the contents of the prepped buffer as stdin. If you'd
like your errors to come back as mail instead of immediately in a
buffer, try /bin/rmail instead of /bin/mail (this can be accomplished
@ -1535,13 +1535,13 @@ with various lower-level mechanisms to provide features such as queueing."
;;;###autoload
(defun feedmail-run-the-queue-no-prompts (&optional arg)
"Like feedmail-run-the-queue, but suppress confirmation prompts."
"Like `feedmail-run-the-queue', but suppress confirmation prompts."
(interactive "p")
(let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg)))
;;;###autoload
(defun feedmail-run-the-queue-global-prompt (&optional arg)
"Like feedmail-run-the-queue, but with a global confirmation prompt.
"Like `feedmail-run-the-queue', but with a global confirmation prompt.
This is generally most useful if run non-interactively, since you can
bail out with an appropriate answer to the global confirmation prompt."
(interactive "p")
@ -1678,7 +1678,7 @@ backup file names and the like)."
"Perform some kind of reminder activity about queued and draft messages.
Called with an optional symbol argument which says what kind of event
is triggering the reminder activity. The default is 'on-demand, which
is what you typically would use if you were putting this in your emacs start-up
is what you typically would use if you were putting this in your Emacs start-up
or mail hook code. Other recognized values for WHAT-EVENT (these are passed
internally by feedmail):
@ -1687,11 +1687,11 @@ internally by feedmail):
after-draft (a message has just been placed in the draft directory)
after-run (the queue has just been run, possibly sending messages)
WHAT-EVENT is used as a key into the table feedmail-queue-reminder-alist. If
WHAT-EVENT is used as a key into the table `feedmail-queue-reminder-alist'. If
the associated value is a function, it is called without arguments and is expected
to perform the reminder activity. You can supply your own reminder functions
by redefining feedmail-queue-reminder-alist. If you don't want any reminders,
you can set feedmail-queue-reminder-alist to nil."
by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders,
you can set `feedmail-queue-reminder-alist' to nil."
(interactive "p")
(let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
(setq entry (assoc key feedmail-queue-reminder-alist))
@ -1871,7 +1871,7 @@ the counts."
Optional argument QUEUE-DIRECTORY specifies into which directory the
file will be placed. The name is based on the Subject: header (if
there is one). If there is no subject,
feedmail-queue-default-file-slug is consulted Special characters are
`feedmail-queue-default-file-slug' is consulted. Special characters are
mapped to mostly alphanumerics for safety."
(let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
(setq eoh-marker (feedmail-find-eoh))
@ -2152,7 +2152,7 @@ mapped to mostly alphanumerics for safety."
"Internal feedmail function for jamming fields into message header.
NAME, VALUE, ACTION, and FOLDING are the four elements of a
fiddle-plex, as described in the documentation for the variable
feedmail-fiddle-plex-blurb."
`feedmail-fiddle-plex-blurb'."
(let ((case-fold-search t)
(header-colon (concat (regexp-quote name) ":"))
header-regexp eoh-marker has-like ag-like val-like that-point)
@ -2249,7 +2249,7 @@ feedmail-fiddle-plex-blurb."
(defun feedmail-envelope-deducer (eoh-marker)
"If feedmail-deduce-envelope-from is false, simply return `user-mail-address'.
"If `feedmail-deduce-envelope-from' is false, simply return `user-mail-address'.
Else, look for Sender: or From: (or Resent-*) and
return that value."
(if (not feedmail-deduce-envelope-from)
@ -2345,7 +2345,7 @@ return that value."
(defun feedmail-fiddle-date (maybe-file)
"Fiddle Date:. See documentation of feedmail-date-generator."
"Fiddle Date:. See documentation of `feedmail-date-generator'."
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@ -2377,7 +2377,7 @@ return that value."
(defun feedmail-default-message-id-generator (maybe-file)
"Default function for generating Message-Id: header contents.
Based on a date and a sort of random number for tie breaking. Unless
feedmail-message-id-suffix is defined, uses `user-mail-address', so be
`feedmail-message-id-suffix' is defined, uses `user-mail-address', so be
sure it's set."
(let ((date-time)
(end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address)))
@ -2395,7 +2395,7 @@ sure it's set."
)
(defun feedmail-fiddle-message-id (maybe-file)
"Fiddle Message-Id:. See documentation of feedmail-message-id-generator."
"Fiddle Message-Id:. See documentation of `feedmail-message-id-generator'."
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@ -2436,7 +2436,7 @@ sure it's set."
(defun feedmail-fiddle-x-mailer ()
"Fiddle X-Mailer:. See documentation of feedmail-x-mailer-line."
"Fiddle X-Mailer:. See documentation of `feedmail-x-mailer-line'."
;; default is to fall off the end of the list and do nothing
(cond
;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse
@ -2464,7 +2464,7 @@ sure it's set."
(defun feedmail-fiddle-spray-address (addy-plex)
"Fiddle header for single spray address. Uses feedmail-spray-this-address."
"Fiddle header for single spray address. Uses `feedmail-spray-this-address'."
;; default is to fall off the end of the list and do nothing
(cond
;; nil means do nothing
@ -2607,7 +2607,7 @@ Resent-To:, Resent-Cc:, and Resent-Bcc:."
(defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list)
"Get address list with all comments and other excitement trimmed.
Addresses are collected only from headers whose names match the fourth
argument Returns a list of strings. Duplicate addresses will have
argument. Returns a list of strings. Duplicate addresses will have
been weeded out."
(let ((simple-address)
(address-blob)

2
lisp/mail/rmail-spam-filter.el
View file

@ -211,7 +211,7 @@ specify 'this\\&that' in the appropriate spam definition field."
:group 'rmail-spam-filter)
(defvar rsf-scanning-messages-now nil
"Non nil when `rmail-spam-filter' scans messages.
"Non-nil when `rmail-spam-filter' scans messages.
This is for interaction with `rsf-bbdb-auto-delete-spam-entries'.")
;; the advantage over the automatic filter definitions is the AND conjunction

32
lisp/mail/rmail.el
View file

@ -2828,7 +2828,7 @@ If summary buffer is currently displayed, update current message there also."
(if blurb
(message blurb))))))
(defun rmail-redecode-body (coding)
(defun rmail-redecode-body (coding &optional raw)
"Decode the body of the current message using coding system CODING.
This is useful with mail messages that have malformed or missing
charset= headers.
@ -2838,6 +2838,16 @@ and displayed in the RMAIL buffer, but the coding system used to
decode it was incorrect. It then encodes the message back to its
original form, and decodes it again, using the coding system CODING.
Optional argument RAW, if non-nil, means don't encode the message
before decoding it with the new CODING. This is useful if the current
message text was produced by some function which invokes `insert',
since `insert' leaves unibyte character codes 128 through 255 unconverted
to multibyte. One example of such a situation is when the text was
produced by `base64-decode-region'.
Interactively, invoke the function with a prefix argument to set RAW
non-nil.
Note that if Emacs erroneously auto-detected one of the iso-2022
encodings in the message, this function might fail because the escape
sequences that switch between character sets and also single-shift and
@ -2849,7 +2859,8 @@ iso-8859, koi8-r, etc."
(or (eq major-mode 'rmail-mode)
(switch-to-buffer rmail-buffer))
(save-excursion
(let ((pruned (rmail-msg-is-pruned)))
(let ((pruned (rmail-msg-is-pruned))
(raw (or raw current-prefix-arg)))
(unwind-protect
(let ((msgbeg (rmail-msgbeg rmail-current-message))
(msgend (rmail-msgend rmail-current-message))
@ -2883,7 +2894,22 @@ iso-8859, koi8-r, etc."
(car (find-coding-systems-region msgbeg msgend))))
(setq x-coding-header (point-marker))
(narrow-to-region msgbeg msgend)
(encode-coding-region (point) msgend old-coding)
(and (null raw)
;; If old and new encoding are the same, it
;; clearly doesn't make sense to encode.
(not (coding-system-equal
(coding-system-base old-coding)
(coding-system-base coding)))
;; If the body includes only eight-bit-*
;; characters, encoding might fail, e.g. with
;; UTF-8, and isn't needed anyway.
(> (length (delq 'ascii
(delq 'eight-bit-graphic
(delq 'eight-bit-control
(find-charset-region
msgbeg msgend)))))
0)
(encode-coding-region (point) msgend old-coding))
(decode-coding-region (point) msgend coding)
(setq last-coding-system-used coding)
;; Rewrite the coding-system header according

10
lisp/mail/vms-pmail.el
View file

@ -40,9 +40,9 @@
;;; then execute them as though emacs were just starting up.
;;;
(defun vms-pmail-save-and-exit ()
"Save current buffer and exit emacs.
If this emacs cannot be suspended, you will be prompted about modified
buffers other than the mail buffer. BEWARE --- suspending emacs without
"Save current buffer and exit Emacs.
If this Emacs cannot be suspended, you will be prompted about modified
buffers other than the mail buffer. BEWARE --- suspending Emacs without
saving your mail buffer causes mail to abort the send (potentially useful
since the mail buffer is still here)."
(interactive)
@ -55,7 +55,7 @@ since the mail buffer is still here)."
(suspend-emacs)))
(defun vms-pmail-abort ()
"Mark buffer as unmodified and exit emacs.
"Mark buffer as unmodified and exit Emacs.
When the editor is exited without saving its buffer, VMS mail does not
send a message. If you have other modified buffers you will be
prompted for what to do with them."
@ -78,7 +78,7 @@ following bindings are established.
\\[vms-pmail-save-and-exit] vms-pmail-save-and-exit
\\[vms-pmail-abort] vms-pmail-abort
All other emacs commands are still available."
All other Emacs commands are still available."
(interactive)
(auto-save-mode -1)
(text-mode)

2
lisp/menu-bar.el
View file

@ -1669,7 +1669,7 @@ Buffers menu is regenerated."
'menu-item
"List All Buffers"
'list-buffers
:help "Pop up a window listing all emacs buffers"
:help "Pop up a window listing all Emacs buffers"
))))
(setq buffers-menu
(nconc buffers-menu menu-bar-buffers-menu-command-entries))

4
lisp/mouse-copy.el
View file

@ -111,9 +111,9 @@
See `mouse-copy-work-around-drag-bug' for details.")
(defun mouse-copy-work-around-drag-bug (start-event end-event)
"Code to work around a bug in post-19.29 emacs: it drops mouse-drag events.
"Code to work around a bug in post-19.29 Emacs: it drops mouse-drag events.
The problem occurs under XFree86-3.1.1 (X11R6pl11) but not under X11R5,
and under post-19.29 but not early versions of emacs.
and under post-19.29 but not early versions of Emacs.
19.29 and 19.30 seems to drop mouse drag events
sometimes. (Reproducible under XFree86-3.1.1 (X11R6pl11) and

10
lisp/mouse.el
View file

@ -846,7 +846,7 @@ at the same position."
;; Should we instead decide that `action' takes a `posn'?
(if (consp pos)
(with-current-buffer (window-buffer (posn-window pos))
(funcall action (posn-point pos)))
(funcall action (posn-point pos)))
(funcall action pos)))
(t action))))
@ -889,7 +889,7 @@ at the same position."
(let ((range (mouse-start-end start end mode)))
(move-overlay ol (car range) (nth 1 range))))
(defun mouse-drag-track (start-event &optional
(defun mouse-drag-track (start-event &optional
do-mouse-drag-region-post-process)
"Track mouse drags by highlighting area between point and cursor.
The region will be defined with mark and point, and the overlay
@ -983,8 +983,8 @@ should only be used by mouse-drag-region."
(let* ((fun (key-binding (vector (car event))))
(do-multi-click (and (> (event-click-count event) 0)
(functionp fun)
(not (memq fun
'(mouse-set-point
(not (memq fun
'(mouse-set-point
mouse-set-region))))))
;; Run the binding of the terminating up-event, if possible.
(if (and (not (= (overlay-start mouse-drag-overlay)
@ -2377,7 +2377,7 @@ and selects that window."
"X fonts suitable for use in Emacs.")
(defun mouse-set-font (&rest fonts)
"Select an emacs font from a list of known good fonts and fontsets."
"Select an Emacs font from a list of known good fonts and fontsets."
(interactive
(progn (unless (display-multi-font-p)
(error "Cannot change fonts on this display"))

2
lisp/net/eudc-vars.el
View file

@ -165,7 +165,7 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and
:group 'eudc)
(defcustom eudc-expansion-overwrites-query t
"*If non nil, expanding a query overwrites the query string."
"*If non-nil, expanding a query overwrites the query string."
:type 'boolean
:group 'eudc)

2
lisp/net/tramp.el
View file

@ -676,7 +676,7 @@ various functions for details."
(if (and (fboundp 'executable-find)
(executable-find "plink"))
"plink"
"ssh")
"scp")
"*Default method to use for transferring files.
See `tramp-methods' for possibilities.
Also see `tramp-default-method-alist'."

2
lisp/play/dunnet.el
View file

@ -935,7 +935,7 @@ or more clues in here):
- If you go down a hole in the floor without an aid such as a ladder,
you probably won't be able to get back up the way you came, if at all.
- To run this game in batch mode (no emacs window), use:
- To run this game in batch mode (no Emacs window), use:
emacs -batch -l dunnet
NOTE: This game *should* be run in batch mode!

2
lisp/play/handwrite.el
View file

@ -77,7 +77,7 @@
;; Variables
(defgroup handwrite nil
"Turns your emacs buffer into a handwritten document."
"Turns your Emacs buffer into a handwritten document."
:prefix "handwrite-"
:group 'games)

4
lisp/play/hanoi.el
View file

@ -133,7 +133,7 @@ Repent before ring 31 moves."
;;;###autoload
(defun hanoi-unix-64 ()
"Like hanoi-unix, but pretend to have a 64-bit clock.
This is, necessarily (as of emacs 20.3), a crock. When the
This is, necessarily (as of Emacs 20.3), a crock. When the
current-time interface is made s2G-compliant, hanoi.el will need
to be updated."
(interactive)
@ -152,7 +152,7 @@ BITS must be of length nrings. Start at START-TIME."
(buffer-disable-undo (current-buffer))
(unwind-protect
(let*
(;; These lines can cause emacs to crash if you ask for too
(;; These lines can cause Emacs to crash if you ask for too
;; many rings. If you uncomment them, on most systems you
;; can get 10,000+ rings.
;;(max-specpdl-size (max max-specpdl-size (* nrings 15)))

36
lisp/printing.el
View file

@ -1144,6 +1144,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
"Set the value of custom variables for printer & utility selection."
(set symbol value)
(and (featurep 'printing) ; update only after printing is loaded
(not pr-menu-print-item)
(pr-update-menus t)))
@ -1151,6 +1152,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
"Update utility menu entry."
(set symbol value)
(and (featurep 'printing) ; update only after printing is loaded
(not pr-menu-print-item)
(pr-menu-set-utility-title value)))
@ -1158,6 +1160,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
"Update `PostScript Printer:' menu entry."
(set symbol value)
(and (featurep 'printing) ; update only after printing is loaded
(not pr-menu-print-item)
(pr-menu-set-ps-title value)))
@ -1165,6 +1168,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
"Update `Text Printer:' menu entry."
(set symbol value)
(and (featurep 'printing) ; update only after printing is loaded
(not pr-menu-print-item)
(pr-menu-set-txt-title value)))
@ -3096,23 +3100,21 @@ Calls `pr-update-menus' to adjust menus."
(pr-get-symbol "Printing")))))
;; Emacs 21 & 22
(t
(let* ((has-file (lookup-key global-map (vector 'menu-bar 'file)))
(item-file (if has-file '("file") '("files"))))
(cond
(pr-menu-print-item
(easy-menu-change item-file "Print" pr-menu-spec "print-buffer")
(let ((items '("print-buffer" "print-region"
"ps-print-buffer-faces" "ps-print-region-faces"
"ps-print-buffer" "ps-print-region")))
(while items
(easy-menu-remove-item nil item-file (car items))
(setq items (cdr items)))
(setq pr-menu-print-item nil
pr-menu-bar (vector 'menu-bar
(if has-file 'file 'files)
(pr-get-symbol "Print")))))
(t
(easy-menu-change item-file "Print" pr-menu-spec))))))))
(cond
(pr-menu-print-item
(easy-menu-add-item menu-bar-file-menu nil
(easy-menu-create-menu "Print" pr-menu-spec)
"print-buffer")
(dolist (item '("print-buffer" "print-region"
"ps-print-buffer-faces" "ps-print-region-faces"
"ps-print-buffer" "ps-print-region"))
(easy-menu-remove-item menu-bar-file-menu nil item))
(setq pr-menu-print-item nil
pr-menu-bar (vector 'menu-bar
'file
(pr-get-symbol "Print"))))
(t
(easy-menu-change '("file") "Print" pr-menu-spec)))))))
(pr-update-menus t))

62
lisp/progmodes/ada-prj.el
View file

@ -1,9 +1,10 @@
;;; ada-prj.el --- easy editing of project files for the ada-mode
;;; ada-prj.el --- GUI editing of project files for the ada-mode
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
;; Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: languages, ada, project file
;; This file is part of GNU Emacs.
@ -33,6 +34,10 @@
;;; Internally, a project file is represented as a property list, with each
;;; field of the project file matching one property of the list.
;;; History:
;;
;;; Code:
@ -64,7 +69,7 @@
;; ----- Functions --------------------------------------------------------
(defun ada-prj-new ()
"Open a new project file"
"Open a new project file."
(interactive)
(let* ((prj
(if (and ada-prj-default-project-file
@ -93,7 +98,7 @@ If there is none, opens a new project file"
"Set SYMBOL to the property list of the project file FILENAME.
If FILENAME is null, read the file associated with ADA-BUFFER. If no
project file is found, returns the default values."
;; FIXME: rationalize arguments; make ada-buffer optional?
(if (and filename
(not (string= filename ""))
(assoc filename ada-xref-project-files))
@ -108,7 +113,7 @@ project file is found, returns the default values."
(defun ada-prj-save-specific-option (field)
"Returns the string to print in the project file to save FIELD.
"Return the string to print in the project file to save FIELD.
If the current value of FIELD is the default value, returns an empty string."
(if (string= (plist-get ada-prj-current-values field)
(plist-get ada-prj-default-values field))
@ -170,7 +175,7 @@ If the current value of FIELD is the default value, returns an empty string."
(kill-buffer nil)
;; kill the editor buffer
(kill-buffer "*Customize Ada Mode*")
(kill-buffer "*Edit Ada Mode Project*")
;; automatically set the new project file as the active one
(set 'ada-prj-default-project-file file-name)
@ -208,7 +213,7 @@ If the current value of FIELD is the default value, returns an empty string."
))
(defun ada-prj-subdirs-of (dir)
"Returns a list of all the subdirectories of dir, recursively."
"Return a list of all the subdirectories of DIR, recursively."
(let ((subdirs (directory-files dir t "^[^.].*"))
(dirlist (list dir)))
(while subdirs
@ -220,7 +225,7 @@ If the current value of FIELD is the default value, returns an empty string."
dirlist))
(defun ada-prj-load-directory (field &optional file-name)
"Append the content of FILE-NAME to FIELD in the current project file.
"Append to FIELD in the current project the subdirectories of FILE-NAME.
If FILE-NAME is nil, ask the user for the name."
;; Do not use an external dialog for this, since it wouldn't allow
@ -238,8 +243,7 @@ If FILE-NAME is nil, ask the user for the name."
(ada-prj-display-page 2))
(defun ada-prj-display-page (tab-num)
"Display one of the pages available in the notebook. TAB-NUM should have
a value between 1 and the maximum number of pages.
"Display page TAB-NUM in the notebook.
The current buffer must be the project editing buffer."
(let ((inhibit-read-only t))
@ -255,7 +259,7 @@ The current buffer must be the project editing buffer."
;; Display the tabs
(widget-insert "\n Project and Editor configuration.\n
(widget-insert "\n Project configuration.\n
___________ ____________ ____________ ____________ ____________\n / ")
(widget-create 'push-button :notify
(lambda (&rest dummy) (ada-prj-display-page 1)) "General")
@ -346,9 +350,9 @@ Note that src_dir includes both the build directory
and the standard runtime."
t t
(mapconcat (lambda(x)
(concat " " x))
ada-xref-runtime-library-specs-path
"\n")
(concat " " x))
ada-xref-runtime-library-specs-path
"\n")
)
(widget-insert "\n\n")
@ -361,9 +365,9 @@ Note that obj_dir includes both the build directory
and the standard runtime."
t t
(mapconcat (lambda(x)
(concat " " x))
ada-xref-runtime-library-ali-path
"\n")
(concat " " x))
ada-xref-runtime-library-ali-path
"\n")
)
(widget-insert "\n\n")
)
@ -512,7 +516,7 @@ If FILENAME is given, edit that file."
(ada-reread-prj-file)))
;; Else start the interactive editor
(switch-to-buffer "*Customize Ada Mode*")
(switch-to-buffer "*Edit Ada Mode Project*")
(ada-xref-set-default-prj-values 'ada-prj-default-values ada-buffer)
(ada-prj-initialize-values 'ada-prj-current-values
@ -536,30 +540,30 @@ If FILENAME is given, edit that file."
;; ---------------- Utilities --------------------------------
(defun ada-prj-set-list (string ada-list &optional is-directory)
"Join the strings in ADA-LIST into a single string.
Each name is put on a separate line that begins with STRING.
If IS-DIRECTORY is non-nil, each name is explicitly converted to a
directory name."
"Prepend STRING to strings in ADA-LIST, return new-line separated string.
If IS-DIRECTORY is non-nil, each element of ADA-LIST is explicitly
converted to a directory name."
(mapconcat (lambda (x) (concat string "="
(if is-directory
(file-name-as-directory x)
x)))
ada-list "\n"))
ada-list "\n"))
(defun ada-prj-field-modified (widget &rest dummy)
"Callback called each time the value of WIDGET is modified. Save the
change in ada-prj-current-values so that selecting another page and coming
back keeps the new value."
"Callback for modification of WIDGET.
Remaining args DUMMY are ignored.
Save the change in `ada-prj-current-values' so that selecting
another page and coming back keeps the new value."
(set 'ada-prj-current-values
(plist-put ada-prj-current-values
(widget-get widget ':prj-field)
(widget-value widget))))
(defun ada-prj-display-help (widget widget-modified event)
"An help button in WIDGET was clicked on. The parameters are so that
this function can be used as :notify for the widget."
"Callback for help button in WIDGET.
Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
(let ((text (widget-get widget 'prj-help)))
(if event
;; If we have a mouse-event, popup a menu
@ -575,6 +579,8 @@ this function can be used as :notify for the widget."
)))
(defun ada-prj-show-value (widget widget-modified event)
"Show the current field value in WIDGET.
Parameters WIDGET-MODIFIED, EVENT match :notify for the widget."
(let* ((field (widget-get widget ':prj-field))
(value (plist-get ada-prj-current-values field))
(inhibit-read-only t)

7
lisp/progmodes/ada-stmt.el
View file

@ -6,9 +6,8 @@
;; This file is part of GNU Emacs.
;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de>
;; Maintainer: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: languages, ada
;; Rolf Ebert's version: 2.26
;;; Commentary:
;; This file is now automatically loaded from ada-mode.el, and creates a submenu
@ -64,7 +63,7 @@
(require 'ada-mode)
(defun ada-func-or-proc-name ()
;; Get the name of the current function or procedure."
"Return the name of the current function or procedure."
(save-excursion
(let ((case-fold-search t))
(if (re-search-backward ada-procedure-start-regexp nil t)
@ -305,7 +304,7 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'."
(backward-char 1)
(forward-sexp 1)))
(if (looking-at ";")
(delete-char 1)))
(delete-char 1)))
" is" \n
_ \n
< "begin" \n

483
lisp/progmodes/ada-xref.el
View file

@ -1,4 +1,4 @@
;;; ada-xref.el --- for lookup and completion in Ada mode
;; ada-xref.el --- for lookup and completion in Ada mode
;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
;; 2004, 2005, 2006 Free Software Foundation, Inc.
@ -6,8 +6,7 @@
;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;; Rolf Ebert <ebert@inf.enst.fr>
;; Emmanuel Briot <briot@gnat.com>
;; Maintainer: Emmanuel Briot <briot@gnat.com>
;; Ada Core Technologies's version: Revision: 1.181
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
;; Keywords: languages ada xref
;; This file is part of GNU Emacs.
@ -38,6 +37,10 @@
;;; You need Emacs >= 20.2 to run this package
;;; History:
;;
;;; Code:
;; ----- Requirements -----------------------------------------------------
@ -47,7 +50,7 @@
(require 'find-file)
(require 'ada-mode)
;; ------ Use variables
;; ------ User variables
(defcustom ada-xref-other-buffer t
"*If nil, always display the cross-references in the same buffer.
Otherwise create either a new buffer or a new frame."
@ -59,7 +62,7 @@ If nil, the cross-reference mode never runs gcc."
:type 'boolean :group 'ada)
(defcustom ada-xref-confirm-compile nil
"*If non-nil, ask for confirmation before compiling or running the application."
"*Non-nil means ask for confirmation before compiling or running the application."
:type 'boolean :group 'ada)
(defcustom ada-krunch-args "0"
@ -105,26 +108,25 @@ The command `gnatfind' is used every time you choose the menu
(concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs"
" ${comp_opt}")
"*Default command to be used to compile a single file.
Emacs will add the filename at the end of this command. This is the same
syntax as in the project file."
Emacs will substitute the current filename for ${full_current}, or add
the filename at the end. This is the same syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-debugger "${cross_prefix}gdb"
"*Default name of the debugger. We recommend either `gdb',
`gdb --emacs_gdbtk' or `ddd --tty -fullname'."
"*Default name of the debugger."
:type 'string :group 'ada)
(defcustom ada-prj-default-make-cmd
(concat "${cross_prefix}gnatmake -o ${main} ${main_unit} ${gnatmake_opt} "
"-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
"-cargs ${comp_opt} -bargs ${bind_opt} -largs ${link_opt}")
"*Default command to be used to compile the application.
This is the same syntax as in the project file."
:type 'string :group 'ada)
(defcustom ada-prj-default-project-file ""
"*Name of the project file to use for every Ada file.
Emacs will not try to use the standard algorithm to find the project file if
this string is not empty."
"*Name of the current project file.
Emacs will not try to use the search algorithm to find the project file if
this string is not empty. It is set whenever a project file is found."
:type '(file :must-match t) :group 'ada)
(defcustom ada-gnatstub-opts "-q -I${src_dir}"
@ -238,7 +240,7 @@ As always, the values of the project file are defined through properties.")
(defmacro ada-set-on-declaration (ident value) (list 'aset ident 7 value))
(defsubst ada-get-ali-buffer (file)
"Reads the ali file into a new buffer, and returns this buffer's name"
"Read the ali file FILE into a new buffer, and return the buffer's name."
(find-file-noselect (ada-get-ali-file-name file)))
@ -250,7 +252,7 @@ As always, the values of the project file are defined through properties.")
(defun ada-initialize-runtime-library (cross-prefix)
"Initialize the variables for the runtime library location.
CROSS-PREFIX is the prefix to use for the gnatls command."
CROSS-PREFIX is the prefix to use for the `gnatls' command."
(save-excursion
(setq ada-xref-runtime-library-specs-path '()
ada-xref-runtime-library-ali-path '())
@ -305,9 +307,9 @@ CROSS-PREFIX is the prefix to use for the gnatls command."
(defun ada-treat-cmd-string (cmd-string)
"Replace meta-sequences like ${...} in CMD-STRING with the appropriate value.
The project file must have been loaded first.
As a special case, ${current} is replaced with the name of the currently
edited file, minus extension but with directory, and ${full_current} is
Assumes project exists.
As a special case, ${current} is replaced with the name of the current
file, minus extension but with directory, and ${full_current} is
replaced by the name including the extension."
(while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)
@ -349,9 +351,8 @@ replaced by the name including the extension."
(set-buffer ada-buffer)
(set 'plist
;; Try hard to find a default value for filename, so that the user
;; can edit his project file even if the current buffer is not an
;; Ada file or not even associated with a file
;; Try hard to find a project file, even if the current
;; buffer is not an Ada file or not associated with a file
(list 'filename (expand-file-name
(cond
(ada-prj-default-project-file
@ -403,8 +404,7 @@ replaced by the name including the extension."
(defun ada-xref-get-project-field (field)
"Extract the value of FIELD from the current project file.
The project file must have been loaded first.
A default value is returned if the file was not found.
Project variables are substituted.
Note that for src_dir and obj_dir, you should rather use
`ada-xref-get-src-dir-field' or `ada-xref-get-obj-dir-field' which will in
@ -443,7 +443,6 @@ addition return the default paths."
)
))
(defun ada-xref-get-src-dir-field ()
"Return the full value for src_dir, including the default directories.
All the directories are returned as absolute directories."
@ -529,6 +528,7 @@ All the directories are returned as absolute directories."
"Completion function when reading a file from the minibuffer.
Completion is attempted in all the directories in the source path, as
defined in the project file."
;; FIXME: doc arguments
(let (list
(dirs (ada-xref-get-src-dir-field)))
@ -547,7 +547,7 @@ defined in the project file."
;;;###autoload
(defun ada-find-file (filename)
"Open a file anywhere in the source path.
"Open FILENAME, from anywhere in the source path.
Completion is available."
(interactive
(list (completing-read "File: " 'ada-do-file-completion)))
@ -582,9 +582,10 @@ Completion is available."
(goto-char (car pos)))))
(defun ada-convert-file-name (name)
"Converts from NAME to a name that can be used by the compilation commands.
"Convert from NAME to a name that can be used by the compilation commands.
This is overriden on VMS to convert from VMS filenames to Unix filenames."
name)
;; FIXME: use convert-standard-filename instead
(defun ada-set-default-project-file (name &optional keep-existing)
"Set the file whose name is NAME as the default project file.
@ -694,12 +695,12 @@ file. If none is set, return nil."
(defun ada-parse-prj-file (prj-file)
"Reads and parses the PRJ-FILE file if it was found.
The current buffer should be the ada-file buffer."
"Read PRJ-FILE, set it as the active project."
;; FIXME: doc nil, search, etc.
(if prj-file
(let (project src_dir obj_dir make_cmd comp_cmd check_cmd casing
run_cmd debug_pre_cmd debug_post_cmd
(ada-buffer (current-buffer)))
(ada-buffer (current-buffer)))
(setq prj-file (expand-file-name prj-file))
;; Set the project file as the active one.
@ -728,6 +729,8 @@ The current buffer should be the ada-file buffer."
(while (not (eobp))
(if (looking-at "^\\([^=]+\\)=\\(.*\\)")
(cond
;; fields that are lists or paths require special processing
;; FIXME: strip trailing spaces
((string= (match-string 1) "src_dir")
(add-to-list 'src_dir
(file-name-as-directory (match-string 2))))
@ -753,6 +756,7 @@ The current buffer should be the ada-file buffer."
((string= (match-string 1) "debug_post_cmd")
(add-to-list 'debug_post_cmd (match-string 2)))
(t
;; any other field in the file is just copied
(set 'project (plist-put project (intern (match-string 1))
(match-string 2))))))
(forward-line 1))
@ -783,20 +787,20 @@ The current buffer should be the ada-file buffer."
;; Else the file wasn't readable (probably the default project).
;; We initialize it with the current environment variables.
;; We need to add the startup directory in front so that
;; files locally redefined are properly found. We cannot
;; add ".", which varies too much depending on what the
;; current buffer is.
;; We need to add the startup directory in front so that
;; files locally redefined are properly found. We cannot
;; add ".", which varies too much depending on what the
;; current buffer is.
(set 'project
(plist-put project 'src_dir
(append
(list command-line-default-directory)
(list command-line-default-directory)
(split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
(list "." default-directory))))
(set 'project
(plist-put project 'obj_dir
(append
(list command-line-default-directory)
(list command-line-default-directory)
(split-string (or (getenv "ADA_OBJECTS_PATH") "") ":")
(list "." default-directory))))
)
@ -817,11 +821,11 @@ The current buffer should be the ada-file buffer."
;; go to the source of the errors in a compilation buffer
(setq compilation-search-path (ada-xref-get-src-dir-field))
;; Set the casing exceptions file list
(if casing
(progn
(setq ada-case-exception-file (reverse casing))
(ada-case-read-exceptions)))
;; Set the casing exceptions file list
(if casing
(progn
(setq ada-case-exception-file (reverse casing))
(ada-case-read-exceptions)))
;; Add the directories to the search path for ff-find-other-file
;; Do not add the '/' or '\' at the end
@ -850,21 +854,21 @@ If LOCAL-ONLY is t, only the declarations in the current file are returned."
(ada-require-project-file)
(let* ((identlist (ada-read-identifier pos))
(alifile (ada-get-ali-file-name (ada-file-of identlist)))
(alifile (ada-get-ali-file-name (ada-file-of identlist)))
(process-environment (ada-set-environment)))
(set-buffer (get-file-buffer (ada-file-of identlist)))
;; if the file is more recent than the executable
(if (or (buffer-modified-p (current-buffer))
(file-newer-than-file-p (ada-file-of identlist) alifile))
(ada-find-any-references (ada-name-of identlist)
(ada-file-of identlist)
nil nil local-only arg)
(file-newer-than-file-p (ada-file-of identlist) alifile))
(ada-find-any-references (ada-name-of identlist)
(ada-file-of identlist)
nil nil local-only arg)
(ada-find-any-references (ada-name-of identlist)
(ada-file-of identlist)
(ada-line-of identlist)
(ada-column-of identlist) local-only arg)))
(ada-file-of identlist)
(ada-line-of identlist)
(ada-column-of identlist) local-only arg)))
)
(defun ada-find-local-references (&optional pos arg)
@ -897,9 +901,9 @@ buffer `*gnatfind*', if there is one."
(switches (ada-xref-get-project-field 'gnatfind_opt))
(command (concat "gnat find " switches " "
quote-entity
(if file (concat ":" (file-name-nondirectory file)))
(if line (concat ":" line))
(if column (concat ":" column))
(if file (concat ":" (file-name-nondirectory file)))
(if line (concat ":" line))
(if column (concat ":" column))
(if local-only (concat " " (file-name-nondirectory file)))
))
old-contents)
@ -907,10 +911,10 @@ buffer `*gnatfind*', if there is one."
;; If a project file is defined, use it
(if (and ada-prj-default-project-file
(not (string= ada-prj-default-project-file "")))
(if (string-equal (file-name-extension ada-prj-default-project-file)
"gpr")
(setq command (concat command " -P" ada-prj-default-project-file))
(setq command (concat command " -p" ada-prj-default-project-file))))
(if (string-equal (file-name-extension ada-prj-default-project-file)
"gpr")
(setq command (concat command " -P" ada-prj-default-project-file))
(setq command (concat command " -p" ada-prj-default-project-file))))
(if (and append (get-buffer "*gnatfind*"))
(save-excursion
@ -937,21 +941,19 @@ buffer `*gnatfind*', if there is one."
;; ----- Identifier Completion --------------------------------------------
(defun ada-complete-identifier (pos)
"Tries to complete the identifier around POS.
The feature is only available if the files where compiled without
the option `-gnatx'."
"Try to complete the identifier around POS, using compiler cross-reference information."
(interactive "d")
(ada-require-project-file)
;; Initialize function-local variables and jump to the .ali buffer
;; Note that for regexp search is case insensitive too
(let* ((curbuf (current-buffer))
(identlist (ada-read-identifier pos))
(sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\("
(regexp-quote (ada-name-of identlist))
"[a-zA-Z0-9_]*\\)"))
(completed nil)
(symalist nil))
(identlist (ada-read-identifier pos))
(sofar (concat "^[0-9]+[a-zA-Z][0-9]+[ *]\\("
(regexp-quote (ada-name-of identlist))
"[a-zA-Z0-9_]*\\)"))
(completed nil)
(symalist nil))
;; Open the .ali file
(set-buffer (ada-get-ali-buffer (buffer-file-name)))
@ -990,6 +992,7 @@ the option `-gnatx'."
(defun ada-goto-body (pos &optional other-frame)
"Display the body of the entity around POS.
OTHER-FRAME non-nil means display in another frame.
If the entity doesn't have a body, display its declaration.
As a side effect, the buffer for the declaration is also open."
(interactive "d")
@ -1023,7 +1026,7 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
;; entity, whose references are not given by GNAT
(if (and (file-exists-p ali-file)
(file-newer-than-file-p ali-file (ada-file-of identlist)))
(message "No cross-reference found--may be a predefined entity.")
(message "No cross-reference found -- may be a predefined entity.")
;; Else, look in every ALI file, except if the user doesn't want that
(if ada-xref-search-with-egrep
@ -1048,8 +1051,8 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil."
command))))
(defun ada-get-absolute-dir-list (dir-list root-dir)
"Returns the list of absolute directories found in dir-list.
If a directory is a relative directory, add the value of ROOT-DIR in front."
"Return the list of absolute directories found in DIR-LIST.
If a directory is a relative directory, ROOT-DIR is prepended."
(mapcar (lambda (x) (expand-file-name x root-dir)) dir-list))
(defun ada-set-environment ()
@ -1134,12 +1137,6 @@ command, and should be either comp_cmd (default) or check_cmd."
(if (or ada-xref-confirm-compile arg)
(setq cmd (read-from-minibuffer "enter command to compile: " cmd)))
;; Insert newlines so as to separate the name of the commands to run
;; and the output of the commands. This doesn't work with cmdproxy.exe,
;; which gets confused by newline characters.
(if (not (string-match ".exe" shell-file-name))
(setq cmd (concat cmd "\n\n")))
(compile (ada-quote-cmd cmd))))
(defun ada-check-current (&optional arg)
@ -1162,7 +1159,7 @@ if ARG is not-nil, ask for user confirmation."
;; Guess the command if it wasn't specified
(if (not command)
(set 'command (list (file-name-sans-extension (buffer-name)))))
(set 'command (list (file-name-sans-extension (buffer-name)))))
;; Modify the command to run remotely
(setq command (ada-remote (mapconcat 'identity command
@ -1197,9 +1194,9 @@ if ARG is not-nil, ask for user confirmation."
(defun ada-gdb-application (&optional arg executable-name)
"Start the debugger on the application.
If ARG is non-nil, ask the user to confirm the command.
EXECUTABLE-NAME, if non-nil, is debugged instead of the file specified in the
project file.
If ARG is non-nil, ask the user to confirm the command."
project file."
(interactive "P")
(let ((buffer (current-buffer))
cmd pre-cmd post-cmd)
@ -1303,13 +1300,8 @@ If ARG is non-nil, ask the user to confirm the command."
(switch-to-buffer buffer)
)))
(defun ada-reread-prj-file (&optional filename)
"Forces Emacs to read either FILENAME or the project file associated
with the current buffer.
Otherwise, this file is only read once, and never read again.
Since the information in the project file is shared between all buffers, this
automatically modifies the setup for all the Ada buffer that use this file."
"Reread either the current project, or FILENAME if non-nil."
(interactive "P")
(if filename
(ada-parse-prj-file filename)
@ -1330,7 +1322,7 @@ the cross-reference information. Note that the ali file can then be deduced by
replacing the file extension with `.ali'."
;; kill old buffer
(if (and ali-file-name
(get-file-buffer ali-file-name))
(get-file-buffer ali-file-name))
(kill-buffer (get-file-buffer ali-file-name)))
(let* ((name (ada-convert-file-name file))
@ -1375,15 +1367,15 @@ replacing the file extension with `.ali'."
found))
(defun ada-find-ali-file-in-dir (file)
"Find an .ali file in obj_dir. The current buffer must be the Ada file.
"Find the ali file FILE, searching obj_dir for the current project.
Adds build_dir in front of the search path to conform to gnatmake's behavior,
and the standard runtime location at the end."
(ada-find-file-in-dir file (ada-xref-get-obj-dir-field)))
(defun ada-find-src-file-in-dir (file)
"Find a source file in src_dir. The current buffer must be the Ada file.
Adds src_dir in front of the search path to conform to gnatmake's behavior,
and the standard runtime location at the end."
"Find the source file FILE, searching src_dir for the current project.
Adds the standard runtime location at the end of the search path to conform
to gnatmake's behavior."
(ada-find-file-in-dir file (ada-xref-get-src-dir-field)))
(defun ada-get-ali-file-name (file)
@ -1414,9 +1406,9 @@ the project file."
(save-excursion
(set-buffer (get-file-buffer file))
(let ((short-ali-file-name
(concat (file-name-sans-extension (file-name-nondirectory file))
".ali"))
ali-file-name
(concat (file-name-sans-extension (file-name-nondirectory file))
".ali"))
ali-file-name
is-spec)
;; If we have a non-standard file name, and this is a spec, we first
@ -1514,15 +1506,15 @@ file for possible paths."
;; return the absolute file name
(let ((filename (ada-find-src-file-in-dir file)))
(if filename
(expand-file-name filename)
(error (concat
(file-name-nondirectory file)
" not found in src_dir; please check your project file")))
(expand-file-name filename)
(error (concat
(file-name-nondirectory file)
" not found in src_dir; please check your project file")))
)))
(defun ada-find-file-number-in-ali (file)
"Returns the file number for FILE in the associated ali file."
"Return the file number for FILE in the associated ali file."
(set-buffer (ada-get-ali-buffer file))
(goto-char (point-min))
@ -1532,7 +1524,7 @@ file for possible paths."
(count-lines begin (point))))
(defun ada-read-identifier (pos)
"Returns the identlist around POS and switch to the .ali buffer.
"Return the identlist around POS and switch to the .ali buffer.
The returned list represents the entity, and can be manipulated through the
macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
@ -1553,7 +1545,7 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
;; Just in front of a string => we could have an operator declaration,
;; as in "+", "-", ..
(if (= (char-after) ?\")
(forward-char 1))
(forward-char 1))
;; if looking at an operator
;; This is only true if:
@ -1563,19 +1555,19 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
(or (not (= (char-syntax (char-after)) ?w))
(not (or (= (char-syntax (char-after (match-end 0))) ?w)
(= (char-after (match-end 0)) ?_)))))
(progn
(if (and (= (char-before) ?\")
(= (char-after (+ (length (match-string 0)) (point))) ?\"))
(forward-char -1))
(set 'identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
(progn
(if (and (= (char-before) ?\")
(= (char-after (+ (length (match-string 0)) (point))) ?\"))
(forward-char -1))
(set 'identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
(if (ada-in-string-p)
(error "Inside string or character constant"))
(error "Inside string or character constant"))
(if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
(error "No cross-reference available for reserved keyword"))
(error "No cross-reference available for reserved keyword"))
(if (looking-at "[a-zA-Z0-9_]+")
(set 'identifier (match-string 0))
(error "No identifier around")))
(set 'identifier (match-string 0))
(error "No identifier around")))
;; Build the identlist
(set 'identlist (ada-make-identlist))
@ -1589,8 +1581,8 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
))
(defun ada-get-all-references (identlist)
"Completes and returns IDENTLIST with the information extracted
from the ali file (definition file and places where it is referenced)."
"Complete IDENTLIST with definition file and places where it is referenced.
Information is extracted from the ali file."
(let ((ali-buffer (ada-get-ali-buffer (ada-file-of identlist)))
declaration-found)
@ -1605,8 +1597,8 @@ from the ali file (definition file and places where it is referenced)."
(if (re-search-forward
(concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
nil t)
(let ((bound (save-excursion (re-search-forward "^X " nil t))))
(set 'declaration-found
(let ((bound (save-excursion (re-search-forward "^X " nil t))))
(set 'declaration-found
(re-search-forward
(concat "^" (ada-line-of identlist)
"." (ada-column-of identlist)
@ -1636,10 +1628,10 @@ from the ali file (definition file and places where it is referenced)."
(ada-column-of identlist) "\\>")
nil t)
;; if we did not find it, it may be because the first reference
;; is not required to have a 'unit_number|' item included.
;; Or maybe we are already on the declaration...
(unless (re-search-forward
;; if we did not find it, it may be because the first reference
;; is not required to have a 'unit_number|' item included.
;; Or maybe we are already on the declaration...
(unless (re-search-forward
(concat
"^[0-9]+.[0-9]+[ *]"
(ada-name-of identlist)
@ -1653,7 +1645,7 @@ from the ali file (definition file and places where it is referenced)."
;; or the source file has been modified since the ali file was
;; created
(set 'declaration-found nil)
)
)
)
;; Last check to be completly sure we have found the correct line (the
@ -1688,15 +1680,15 @@ from the ali file (definition file and places where it is referenced)."
;; information available
(beginning-of-line)
(if declaration-found
(let ((current-line (buffer-substring
(let ((current-line (buffer-substring
(point) (save-excursion (end-of-line) (point)))))
(save-excursion
(next-line 1)
(beginning-of-line)
(while (looking-at "^\\.\\(.*\\)")
(set 'current-line (concat current-line (match-string 1)))
(next-line 1))
)
(save-excursion
(next-line 1)
(beginning-of-line)
(while (looking-at "^\\.\\(.*\\)")
(set 'current-line (concat current-line (match-string 1)))
(next-line 1))
)
(if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
@ -1725,7 +1717,7 @@ This function is disabled for operators, and only works for identifiers."
(unless (= (string-to-char (ada-name-of identlist)) ?\")
(progn
(let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
(let ((declist '()) ;;; ( (line_in_ali_file line_in_ada) ( ... ))
(my-regexp (concat "[ *]"
(regexp-quote (ada-name-of identlist)) " "))
(line-ada "--")
@ -1735,43 +1727,43 @@ This function is disabled for operators, and only works for identifiers."
(choice 0)
(ali-buffer (current-buffer)))
(goto-char (point-max))
(while (re-search-backward my-regexp nil t)
(save-excursion
(set 'line-ali (count-lines 1 (point)))
(beginning-of-line)
;; have a look at the line and column numbers
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
(progn
(setq line-ada (match-string 1))
(setq col-ada (match-string 2)))
(setq line-ada "--")
(setq col-ada "--")
)
;; construct a list with the file names and the positions within
(if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t)
(goto-char (point-max))
(while (re-search-backward my-regexp nil t)
(save-excursion
(set 'line-ali (count-lines 1 (point)))
(beginning-of-line)
;; have a look at the line and column numbers
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
(progn
(setq line-ada (match-string 1))
(setq col-ada (match-string 2)))
(setq line-ada "--")
(setq col-ada "--")
)
;; construct a list with the file names and the positions within
(if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9._-]+\\)" nil t)
(add-to-list
'declist (list line-ali (match-string 1) line-ada col-ada))
)
)
)
)
)
)
;; how many possible declarations have we found ?
(setq len (length declist))
(cond
;; none => error
((= len 0)
(kill-buffer (current-buffer))
(error (concat "No declaration of "
(ada-name-of identlist)
" recorded in .ali file")))
;; how many possible declarations have we found ?
(setq len (length declist))
(cond
;; none => error
((= len 0)
(kill-buffer (current-buffer))
(error (concat "No declaration of "
(ada-name-of identlist)
" recorded in .ali file")))
;; one => should be the right one
((= len 1)
(goto-line (caar declist)))
;; one => should be the right one
((= len 1)
(goto-line (caar declist)))
;; more than one => display choice list
(t
;; more than one => display choice list
(t
(save-window-excursion
(with-output-to-temp-buffer "*choice list*"
@ -1782,13 +1774,13 @@ This function is disabled for operators, and only works for identifiers."
(let ((counter 0))
(while (< counter len)
(princ (format " %2d) %-21s %4s %4s\n"
(1+ counter)
(1+ counter)
(ada-get-ada-file-name
(nth 1 (nth counter declist))
(ada-file-of identlist))
(nth 2 (nth counter declist))
(nth 3 (nth counter declist))
))
(nth 2 (nth counter declist))
(nth 3 (nth counter declist))
))
(setq counter (1+ counter))
) ; end of while
) ; end of let
@ -1804,13 +1796,13 @@ This function is disabled for operators, and only works for identifiers."
(read-from-minibuffer "Enter No. of your choice: "))))
)
(set-buffer ali-buffer)
(goto-line (car (nth (1- choice) declist)))
))))))
(goto-line (car (nth (1- choice) declist)))
))))))
(defun ada-find-in-ali (identlist &optional other-frame)
"Look in the .ali file for the definition of the identifier in IDENTLIST.
If OTHER-FRAME is non nil, and `ada-xref-other-buffer' is non nil,
If OTHER-FRAME is non-nil, and `ada-xref-other-buffer' is non-nil,
opens a new window to show the declaration."
(ada-get-all-references identlist)
@ -1899,7 +1891,7 @@ This command requires the external `egrep' program to be available.
This works well when one is using an external librarie and wants
to find the declaration and documentation of the subprograms one is
is using."
;; FIXME: what does this function do?
(let (list
(dirs (ada-xref-get-obj-dir-field))
(regexp (concat "[ *]" (ada-name-of identlist)))
@ -2020,12 +2012,12 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
;; Select and display the destination buffer
(if ada-xref-other-buffer
(if other-frame
(find-file-other-frame file)
(set 'declaration-buffer (find-file-noselect file))
(set-buffer declaration-buffer)
(switch-to-buffer-other-window declaration-buffer)
)
(if other-frame
(find-file-other-frame file)
(set 'declaration-buffer (find-file-noselect file))
(set-buffer declaration-buffer)
(switch-to-buffer-other-window declaration-buffer)
)
(find-file file)
)
@ -2043,11 +2035,11 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
(defun ada-xref-search-nearest (name)
"Searches for NAME nearest to the position recorded in the Xref file.
It returns the position of the declaration in the buffer or nil if not found."
"Search for NAME nearest to the position recorded in the Xref file.
Return the position of the declaration in the buffer, or nil if not found."
(let ((orgpos (point))
(newpos nil)
(diff nil))
(newpos nil)
(diff nil))
(goto-char (point-max))
@ -2056,33 +2048,33 @@ It returns the position of the declaration in the buffer or nil if not found."
;; check if it really is a complete Ada identifier
(if (and
(not (save-excursion
(goto-char (match-end 0))
(looking-at "_")))
(not (ada-in-string-or-comment-p))
(or
;; variable declaration ?
(save-excursion
(skip-chars-forward "a-zA-Z_0-9" )
(ada-goto-next-non-ws)
(looking-at ":[^=]"))
;; procedure, function, task or package declaration ?
(save-excursion
(ada-goto-previous-word)
(looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>"))))
(not (save-excursion
(goto-char (match-end 0))
(looking-at "_")))
(not (ada-in-string-or-comment-p))
(or
;; variable declaration ?
(save-excursion
(skip-chars-forward "a-zA-Z_0-9" )
(ada-goto-next-non-ws)
(looking-at ":[^=]"))
;; procedure, function, task or package declaration ?
(save-excursion
(ada-goto-previous-word)
(looking-at "\\<[pP][rR][oO][cC][eE][dD][uU][rR][eE]\\>\\|\\<[fF][uU][nN][cC][tT][iI][oO][nN]\\>\\|\\<[tT][yY][pP][eE]\\>\\|\\<[tT][aA][sS][kK]\\>\\|\\<[pP][aA][cC][kK][aA][gG][eE]\\>\\|\\<[bB][oO][dD][yY]\\>"))))
;; check if it is nearer than the ones before if any
(if (or (not diff)
(< (abs (- (point) orgpos)) diff))
(progn
(setq newpos (point)
;; check if it is nearer than the ones before if any
(if (or (not diff)
(< (abs (- (point) orgpos)) diff))
(progn
(setq newpos (point)
diff (abs (- newpos orgpos))))))
)
(if newpos
(progn
(message "ATTENTION: this declaration is only a (good) guess ...")
(goto-char newpos))
(progn
(message "ATTENTION: this declaration is only a (good) guess ...")
(goto-char newpos))
nil)))
@ -2093,26 +2085,26 @@ It returns the position of the declaration in the buffer or nil if not found."
(ada-require-project-file)
(let ((buffer (ada-get-ali-buffer (buffer-file-name)))
(unit-name nil)
(body-name nil)
(ali-name nil))
(unit-name nil)
(body-name nil)
(ali-name nil))
(save-excursion
(set-buffer buffer)
(goto-char (point-min))
(re-search-forward "^U \\([^ \t%]+\\)%[bs][ \t]+\\([^ \t]+\\)")
(setq unit-name (match-string 1))
(if (not (string-match "\\(.*\\)\\.[^.]+" unit-name))
(progn
(kill-buffer buffer)
(error "No parent unit !"))
(setq unit-name (match-string 1 unit-name))
)
(progn
(kill-buffer buffer)
(error "No parent unit !"))
(setq unit-name (match-string 1 unit-name))
)
;; look for the file name for the parent unit specification
(goto-char (point-min))
(re-search-forward (concat "^W " unit-name
"%s[ \t]+\\([^ \t]+\\)[ \t]+"
"\\([^ \t\n]+\\)"))
"%s[ \t]+\\([^ \t]+\\)[ \t]+"
"\\([^ \t\n]+\\)"))
(setq body-name (match-string 1))
(setq ali-name (match-string 2))
(kill-buffer buffer)
@ -2123,15 +2115,15 @@ It returns the position of the declaration in the buffer or nil if not found."
(save-excursion
;; Tries to open the new ali file to find the spec file
(if ali-name
(progn
(find-file ali-name)
(goto-char (point-min))
(re-search-forward (concat "^U " unit-name "%s[ \t]+"
"\\([^ \t]+\\)"))
(setq body-name (match-string 1))
(kill-buffer (current-buffer))
)
)
(progn
(find-file ali-name)
(goto-char (point-min))
(re-search-forward (concat "^U " unit-name "%s[ \t]+"
"\\([^ \t]+\\)"))
(setq body-name (match-string 1))
(kill-buffer (current-buffer))
)
)
)
(find-file body-name)
@ -2146,14 +2138,14 @@ This is a GNAT specific function that uses gnatkrunch."
(set-buffer krunch-buf)
;; send adaname to external process `gnatkr'.
(call-process "gnatkr" nil krunch-buf nil
adaname ada-krunch-args)
adaname ada-krunch-args)
;; fetch output of that process
(setq adaname (buffer-substring
(point-min)
(progn
(goto-char (point-min))
(end-of-line)
(point))))
(point-min)
(progn
(goto-char (point-min))
(end-of-line)
(point))))
(kill-buffer krunch-buf)))
adaname
)
@ -2187,10 +2179,10 @@ This function typically is to be hooked into `ff-file-created-hooks'."
;; Call the external process gnatstub
(let* ((gnatstub-opts (ada-treat-cmd-string ada-gnatstub-opts))
(filename (buffer-file-name (car (buffer-list))))
(output (concat (file-name-sans-extension filename) ".adb"))
(gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename))
(buffer (get-buffer-create "*gnatstub*")))
(filename (buffer-file-name (car (buffer-list))))
(output (concat (file-name-sans-extension filename) ".adb"))
(gnatstub-cmd (concat "gnatstub " gnatstub-opts " " filename))
(buffer (get-buffer-create "*gnatstub*")))
(save-excursion
(set-buffer buffer)
@ -2203,25 +2195,25 @@ This function typically is to be hooked into `ff-file-created-hooks'."
(call-process shell-file-name nil buffer nil "-c" gnatstub-cmd)
(if (save-excursion
(set-buffer buffer)
(goto-char (point-min))
(search-forward "command not found" nil t))
(progn
(message "gnatstub was not found -- using the basic algorithm")
(sleep-for 2)
(kill-buffer buffer)
(ada-make-body))
(set-buffer buffer)
(goto-char (point-min))
(search-forward "command not found" nil t))
(progn
(message "gnatstub was not found -- using the basic algorithm")
(sleep-for 2)
(kill-buffer buffer)
(ada-make-body))
;; Else clean up the output
(if (file-exists-p output)
(progn
(find-file output)
(kill-buffer buffer))
(progn
(find-file output)
(kill-buffer buffer))
;; display the error buffer
(display-buffer buffer)
)
;; display the error buffer
(display-buffer buffer)
)
)))
(defun ada-xref-initialize ()
@ -2237,22 +2229,9 @@ find-file...."
(ada-xref-update-project-menu)
)
;; ----- Add to ada-mode-hook ---------------------------------------------
;; Use gvd or ddd as the default debugger if it was found
;; On windows, do not use the --tty switch for GVD, since this is
;; not supported. Actually, we do not use this on Unix either,
;; since otherwise there is no console window left in GVD,
;; and people have to use the Emacs one.
;; This must be done before initializing the Ada menu.
(if (ada-find-file-in-dir "gvd" exec-path)
(set 'ada-prj-default-debugger "gvd ")
(if (ada-find-file-in-dir "gvd.exe" exec-path)
(set 'ada-prj-default-debugger "gvd ")
(if (ada-find-file-in-dir "ddd" exec-path)
(set 'ada-prj-default-debugger "ddd --tty -fullname -toolbar"))))
(add-hook 'ada-mode-hook 'ada-xref-initialize)
;; Initializes the cross references to the runtime library

2
lisp/progmodes/idlwave.el
View file

@ -4387,7 +4387,7 @@ Does not run after automatic updates of buffer or the shell.")
(idlwave-update-routine-info '(16)))
(defun idlwave-rescan-asynchronously ()
"Dispatch another emacs instance to update the idlwave catalog.
"Dispatch another Emacs instance to update the idlwave catalog.
After the process finishes normally, the first access to routine info
will re-read the catalog."
(interactive)

2
lisp/resume.el
View file

@ -49,7 +49,7 @@
;;; Code:
(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args")
"*This file is where arguments are placed for a suspended emacs job.")
"*This file is where arguments are placed for a suspended Emacs job.")
(defvar resume-emacs-args-buffer " *Command Line Args*"
"Buffer that is used by resume-process-args.")

4
lisp/rfn-eshadow.el
View file

@ -106,8 +106,8 @@ If Emacs is not running under a window system,
(defcustom file-name-shadow-tty-properties
'(before-string "{" after-string "} " field shadow)
"Properties given to the `shadowed' part of a filename in the minibuffer.
Only used when `file-name-shadow-mode' is active and emacs
is not running under a window-system; if emacs is running under a window
Only used when `file-name-shadow-mode' is active and Emacs
is not running under a window-system; if Emacs is running under a window
system, `file-name-shadow-properties' is used instead."
:type file-name-shadow-properties-custom-type
:group 'minibuffer

10
lisp/ruler-mode.el
View file

@ -526,6 +526,16 @@ START-EVENT is the mouse click event."
#'ruler-mode-mouse-del-tab-stop)
(define-key km [header-line (control down-mouse-2)]
#'ruler-mode-toggle-show-tab-stops)
(define-key km [header-line (shift mouse-1)]
'ignore)
(define-key km [header-line (shift mouse-3)]
'ignore)
(define-key km [header-line (control mouse-1)]
'ignore)
(define-key km [header-line (control mouse-3)]
'ignore)
(define-key km [header-line (control mouse-2)]
'ignore)
km)
"Keymap for ruler minor mode.")

391
lisp/server.el
View file

@ -82,6 +82,36 @@
"Emacs running as a server process."
:group 'external)
(defcustom server-use-tcp nil
"If non-nil, use TCP sockets instead of local sockets."
:set #'(lambda (sym val)
(unless (featurep 'make-network-process '(:family local))
(setq val t)
(unless load-in-progress
(message "Local sockets unsupported, using TCP sockets")))
(when val (random t))
(set-default sym val))
:group 'server
:type 'boolean
:version "22.1")
(defcustom server-host nil
"The name or IP address to use as host address of the server process.
If set, the server accepts remote connections; otherwise it is local."
:group 'server
:type '(choice
(string :tag "Name or IP address")
(const :tag "Local" nil))
:version "22.1")
(put 'server-host 'risky-local-variable t)
(defcustom server-auth-dir "~/.emacs.d/server/"
"Directory for server authentication files."
:group 'server
:type 'directory
:version "22.1")
(put 'server-auth-dir 'risky-local-variable t)
(defcustom server-visit-hook nil
"*Hook run when visiting a file for the Emacs server."
:group 'server
@ -151,7 +181,7 @@ this way."
:version "21.1")
(or (assq 'server-buffer-clients minor-mode-alist)
(setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist)))
(push '(server-buffer-clients " Server") minor-mode-alist))
(defvar server-existing-buffer nil
"Non-nil means the buffer existed before the server was asked to visit it.
@ -166,13 +196,13 @@ are done with it in the server.")
(defun server-log (string &optional client)
"If a *server* buffer exists, write STRING to it for logging purposes."
(if (get-buffer "*server*")
(with-current-buffer "*server*"
(goto-char (point-max))
(insert (current-time-string)
(if client (format " %s:" client) " ")
string)
(or (bolp) (newline)))))
(when (get-buffer "*server*")
(with-current-buffer "*server*"
(goto-char (point-max))
(insert (current-time-string)
(if client (format " %s:" client) " ")
string)
(or (bolp) (newline)))))
(defun server-sentinel (proc msg)
(let ((client (assq proc server-clients)))
@ -194,6 +224,12 @@ are done with it in the server.")
(when (and (eq (process-status proc) 'open)
(process-query-on-exit-flag proc))
(set-process-query-on-exit-flag proc nil))
;; Delete the associated connection file, if applicable.
;; This is actually problematic: the file may have been overwritten by
;; another Emacs server in the mean time, so it's not ours any more.
;; (and (process-contact proc :server)
;; (eq (process-status proc) 'closed)
;; (ignore-errors (delete-file (process-get proc :server-file))))
(server-log (format "Status changed to %s" (process-status proc)) proc))
(defun server-select-display (display)
@ -205,12 +241,34 @@ are done with it in the server.")
(select-frame frame)))
;; If there's no frame on that display yet, create and select one.
(unless (equal (frame-parameter (selected-frame) 'display) display)
(select-frame
(make-frame-on-display
display
;; This frame may be deleted later (see server-process-filter)
;; so we want it to be as unobtrusive as possible.
'((visibility . nil)))))))
(let* ((buffer (generate-new-buffer " *server-dummy*"))
(frame (make-frame-on-display
display
;; Make it display (and remember) some dummy buffer, so
;; we can detect later if the frame is in use or not.
`((server-dummmy-buffer . ,buffer)
;; This frame may be deleted later (see
;; server-unselect-display) so we want it to be as
;; unobtrusive as possible.
(visibility . nil)))))
(select-frame frame)
(set-window-buffer (selected-window) buffer)))))
(defun server-unselect-display (frame)
;; If the temporary frame is in use (displays something real), make it
;; visible. If not (which can happen if the user's customizations call
;; pop-to-buffer etc.), delete it to avoid preserving the connection after
;; the last real frame is deleted.
(if (and (eq (frame-first-window frame)
(next-window (frame-first-window frame) 'nomini))
(eq (window-buffer (frame-first-window frame))
(frame-parameter frame 'server-dummy-buffer)))
;; The temp frame still only shows one buffer, and that is the
;; internal temp buffer.
(delete-frame frame)
(set-frame-parameter frame 'visibility t))
(kill-buffer (frame-parameter frame 'server-dummy-buffer))
(set-frame-parameter frame 'server-dummy-buffer nil))
(defun server-unquote-arg (arg)
(replace-regexp-in-string
@ -231,11 +289,12 @@ Creates the directory if necessary and makes sure:
(setq dir (directory-file-name dir))
(let ((attrs (file-attributes dir)))
(unless attrs
(letf (((default-file-modes) ?\700)) (make-directory dir))
(letf (((default-file-modes) ?\700)) (make-directory dir t))
(setq attrs (file-attributes dir)))
;; Check that it's safe for use.
(unless (and (eq t (car attrs)) (eq (nth 2 attrs) (user-uid))
(zerop (logand ?\077 (file-modes dir))))
(or (eq system-type 'windows-nt)
(zerop (logand ?\077 (file-modes dir)))))
(error "The directory %s is unsafe" dir))))
;;;###autoload
@ -248,33 +307,61 @@ Emacs distribution as your standard \"editor\".
Prefix arg means just kill any existing server communications subprocess."
(interactive "P")
;; kill it dead!
(if server-process
(condition-case () (delete-process server-process) (error nil)))
;; Delete the socket files made by previous server invocations.
(condition-case ()
(delete-file (expand-file-name server-name server-socket-dir))
(error nil))
(when server-process
;; kill it dead!
(ignore-errors (delete-process server-process)))
;; If this Emacs already had a server, clear out associated status.
(while server-clients
(let ((buffer (nth 1 (car server-clients))))
(server-buffer-done buffer)))
;; Now any previous server is properly stopped.
(unless leave-dead
;; Make sure there is a safe directory in which to place the socket.
(server-ensure-safe-dir server-socket-dir)
(if server-process
(server-log (message "Restarting server")))
(letf (((default-file-modes) ?\700))
(setq server-process
(make-network-process
:name "server" :family 'local :server t :noquery t
:service (expand-file-name server-name server-socket-dir)
:sentinel 'server-sentinel :filter 'server-process-filter
;; We must receive file names without being decoded.
;; Those are decoded by server-process-filter according
;; to file-name-coding-system.
:coding 'raw-text)))))
(let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
(server-file (expand-file-name server-name server-dir)))
;; Make sure there is a safe directory in which to place the socket.
(server-ensure-safe-dir server-dir)
;; Remove any leftover socket or authentication file.
(ignore-errors (delete-file server-file))
(when server-process
(server-log (message "Restarting server")))
(letf (((default-file-modes) ?\700))
(setq server-process
(apply #'make-network-process
:name server-name
:server t
:noquery t
:sentinel 'server-sentinel
:filter 'server-process-filter
;; We must receive file names without being decoded.
;; Those are decoded by server-process-filter according
;; to file-name-coding-system.
:coding 'raw-text
;; The rest of the args depends on the kind of socket used.
(if server-use-tcp
(list :family nil
:service t
:host (or server-host 'local)
:plist '(:authenticated nil))
(list :family 'local
:service server-file
:plist '(:authenticated t)))))
(unless server-process (error "Could not start server process"))
(when server-use-tcp
(let ((auth-key
(loop
;; The auth key is a 64-byte string of random chars in the
;; range `!'..`~'.
for i below 64
collect (+ 33 (random 94)) into auth
finally return (concat auth))))
(process-put server-process :auth-key auth-key)
(with-temp-file server-file
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'no-conversion)
(insert (format-network-address
(process-contact server-process :local))
" " (int-to-string (emacs-pid))
"\n" auth-key))))))))
;;;###autoload
(define-minor-mode server-mode
@ -289,14 +376,27 @@ Server mode runs a process that accepts commands from the
;; nothing if there is one (for multiple Emacs sessions)?
(server-start (not server-mode)))
(defun server-process-filter (proc string)
(defun* server-process-filter (proc string)
"Process a request from the server to edit some files.
PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
;; First things first: let's check the authentication
(unless (process-get proc :authenticated)
(if (and (string-match "-auth \\(.*?\\)\n" string)
(equal (match-string 1 string) (process-get proc :auth-key)))
(progn
(setq string (substring string (match-end 0)))
(process-put proc :authenticated t)
(server-log "Authentication successful" proc))
(server-log "Authentication failed" proc)
(process-send-string proc "Authentication failed")
(delete-process proc)
;; We return immediately
(return-from server-process-filter)))
(server-log string proc)
(let ((prev (process-get proc 'previous-string)))
(let ((prev (process-get proc :previous-string)))
(when prev
(setq string (concat prev string))
(process-put proc 'previous-string nil)))
(process-put proc :previous-string nil)))
;; If the input is multiple lines,
;; process each line individually.
(while (string-match "\n" string)
@ -307,7 +407,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
client nowait eval
(files nil)
(lineno 1)
(tmp-frame nil) ; Sometimes used to embody the selected display.
(tmp-frame nil) ;; Sometimes used to embody the selected display.
(columnno 0))
;; Remove this line from STRING.
(setq string (substring string (match-end 0)))
@ -316,51 +416,48 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(let ((arg (substring request (match-beginning 0) (1- (match-end 0)))))
(setq request (substring request (match-end 0)))
(cond
((equal "-nowait" arg) (setq nowait t))
((equal "-eval" arg) (setq eval t))
((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
(let ((display (server-unquote-arg (match-string 1 request))))
(setq request (substring request (match-end 0)))
(condition-case err
(setq tmp-frame (server-select-display display))
(error (process-send-string proc (nth 1 err))
(setq request "")))))
;; ARG is a line number option.
((string-match "\\`\\+[0-9]+\\'" arg)
(setq lineno (string-to-number (substring arg 1))))
;; ARG is line number:column option.
((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
(setq lineno (string-to-number (match-string 1 arg))
columnno (string-to-number (match-string 2 arg))))
(t
;; Undo the quoting that emacsclient does
;; for certain special characters.
(setq arg (server-unquote-arg arg))
;; Now decode the file name if necessary.
(if coding-system
(setq arg (decode-coding-string arg coding-system)))
(if eval
(let* (errorp
(v (condition-case errobj
(eval (car (read-from-string arg)))
(error (setq errorp t) errobj))))
(when v
(with-temp-buffer
(let ((standard-output (current-buffer)))
(if errorp (princ "error: "))
(pp v)
;; Suppress the error rose when the pipe to PROC is closed.
(condition-case err
(process-send-region proc (point-min) (point-max))
(file-error nil)
(error nil))
))))
;; ARG is a file name.
;; Collapse multiple slashes to single slashes.
(setq arg (command-line-normalize-file-name arg))
(push (list arg lineno columnno) files))
(setq lineno 1)
(setq columnno 0)))))
((equal "-nowait" arg) (setq nowait t))
((equal "-eval" arg) (setq eval t))
((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
(let ((display (server-unquote-arg (match-string 1 request))))
(setq request (substring request (match-end 0)))
(condition-case err
(setq tmp-frame (server-select-display display))
(error (process-send-string proc (nth 1 err))
(setq request "")))))
;; ARG is a line number option.
((string-match "\\`\\+[0-9]+\\'" arg)
(setq lineno (string-to-number (substring arg 1))))
;; ARG is line number:column option.
((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
(setq lineno (string-to-number (match-string 1 arg))
columnno (string-to-number (match-string 2 arg))))
(t
;; Undo the quoting that emacsclient does
;; for certain special characters.
(setq arg (server-unquote-arg arg))
;; Now decode the file name if necessary.
(when coding-system
(setq arg (decode-coding-string arg coding-system)))
(if eval
(let* (errorp
(v (condition-case errobj
(eval (car (read-from-string arg)))
(error (setq errorp t) errobj))))
(when v
(with-temp-buffer
(let ((standard-output (current-buffer)))
(when errorp (princ "error: "))
(pp v)
(ignore-errors
(process-send-region proc (point-min) (point-max)))
))))
;; ARG is a file name.
;; Collapse multiple slashes to single slashes.
(setq arg (command-line-normalize-file-name arg))
(push (list arg lineno columnno) files))
(setq lineno 1)
(setq columnno 0)))))
(when files
(run-hooks 'pre-command-hook)
(server-visit-files files client nowait)
@ -378,24 +475,20 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(run-hooks 'server-switch-hook)
(unless nowait
(message "%s" (substitute-command-keys
"When done with a buffer, type \\[server-edit]")))))
;; If the temporary frame is still the selected frame, make it
;; real. If not (which can happen if the user's customizations
;; call pop-to-buffer etc.), delete it to avoid preserving the
;; connection after the last real frame is deleted.
(if tmp-frame
(if (eq (selected-frame) tmp-frame)
(set-frame-parameter tmp-frame 'visibility t)
(delete-frame tmp-frame)))))
"When done with a buffer, type \\[server-edit]")))))
(when (frame-live-p tmp-frame)
;; Delete tmp-frame or make it visible depending on whether it's
;; been used or not.
(server-unselect-display tmp-frame))))
;; Save for later any partial line that remains.
(when (> (length string) 0)
(process-put proc 'previous-string string)))
(process-put proc :previous-string string)))
(defun server-goto-line-column (file-line-col)
(goto-line (nth 1 file-line-col))
(let ((column-number (nth 2 file-line-col)))
(if (> column-number 0)
(move-to-column (1- column-number)))))
(when (> column-number 0)
(move-to-column (1- column-number)))))
(defun server-visit-files (files client &optional nowait)
"Find FILES and return the list CLIENT with the buffers nconc'd.
@ -418,14 +511,14 @@ so don't mark these buffers specially, just visit them normally."
(if (and obuf (set-buffer obuf))
(progn
(cond ((file-exists-p filen)
(if (not (verify-visited-file-modtime obuf))
(revert-buffer t nil)))
(when (not (verify-visited-file-modtime obuf))
(revert-buffer t nil)))
(t
(if (y-or-n-p
(concat "File no longer exists: "
filen
", write buffer to file? "))
(write-file filen))))
(when (y-or-n-p
(concat "File no longer exists: "
filen
", write buffer to file? "))
(write-file filen))))
(setq server-existing-buffer t)
(server-goto-line-column file))
(set-buffer (find-file-noselect filen))
@ -467,33 +560,33 @@ FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
(server-log "Close" (car client))
(setq server-clients (delq client server-clients))))
(setq old-clients (cdr old-clients)))
(if (and (bufferp buffer) (buffer-name buffer))
;; We may or may not kill this buffer;
;; if we do, do not call server-buffer-done recursively
;; from kill-buffer-hook.
(let ((server-kill-buffer-running t))
(with-current-buffer buffer
(setq server-buffer-clients nil)
(run-hooks 'server-done-hook))
;; Notice whether server-done-hook killed the buffer.
(if (null (buffer-name buffer))
(when (and (bufferp buffer) (buffer-name buffer))
;; We may or may not kill this buffer;
;; if we do, do not call server-buffer-done recursively
;; from kill-buffer-hook.
(let ((server-kill-buffer-running t))
(with-current-buffer buffer
(setq server-buffer-clients nil)
(run-hooks 'server-done-hook))
;; Notice whether server-done-hook killed the buffer.
(if (null (buffer-name buffer))
(setq killed t)
;; Don't bother killing or burying the buffer
;; when we are called from kill-buffer.
(unless for-killing
(when (and (not killed)
server-kill-new-buffers
(with-current-buffer buffer
(not server-existing-buffer)))
(setq killed t)
;; Don't bother killing or burying the buffer
;; when we are called from kill-buffer.
(unless for-killing
(when (and (not killed)
server-kill-new-buffers
(with-current-buffer buffer
(not server-existing-buffer)))
(setq killed t)
(bury-buffer buffer)
(kill-buffer buffer))
(unless killed
(if (server-temp-file-p buffer)
(progn
(kill-buffer buffer)
(setq killed t))
(bury-buffer buffer)))))))
(bury-buffer buffer)
(kill-buffer buffer))
(unless killed
(if (server-temp-file-p buffer)
(progn
(kill-buffer buffer)
(setq killed t))
(bury-buffer buffer)))))))
(list next-buffer killed)))
(defun server-temp-file-p (&optional buffer)
@ -520,10 +613,10 @@ specifically for the clients and did not exist before their request for it."
(let ((version-control nil)
(buffer-backed-up nil))
(save-buffer))
(if (and (buffer-modified-p)
buffer-file-name
(y-or-n-p (concat "Save file " buffer-file-name "? ")))
(save-buffer)))
(when (and (buffer-modified-p)
buffer-file-name
(y-or-n-p (concat "Save file " buffer-file-name "? ")))
(save-buffer)))
(server-buffer-done (current-buffer))))
;; Ask before killing a server buffer.
@ -543,8 +636,8 @@ specifically for the clients and did not exist before their request for it."
(tail server-clients))
;; See if any clients have any buffers that are still alive.
(while tail
(if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
(setq live-client t))
(when (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
(setq live-client t))
(setq tail (cdr tail)))
(or (not live-client)
(yes-or-no-p "Server buffers still have clients; exit anyway? "))))
@ -579,12 +672,12 @@ If invoked with a prefix argument, or if there is no server process running,
starts server process and that is all. Invoked by \\[server-edit]."
(interactive "P")
(cond
((or arg
(not server-process)
(memq (process-status server-process) '(signal exit)))
(server-mode 1))
(server-clients (apply 'server-switch-buffer (server-done)))
(t (message "No server editing buffers exist"))))
((or arg
(not server-process)
(memq (process-status server-process) '(signal exit)))
(server-mode 1))
(server-clients (apply 'server-switch-buffer (server-done)))
(t (message "No server editing buffers exist"))))
(defun server-switch-buffer (&optional next-buffer killed-one)
"Switch to another buffer, preferably one that has a client.
@ -610,8 +703,8 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
(if (and win (not server-window))
;; The buffer is already displayed: just reuse the window.
(let ((frame (window-frame win)))
(if (eq (frame-visible-p frame) 'icon)
(raise-frame frame))
(when (eq (frame-visible-p frame) 'icon)
(raise-frame frame))
(select-window win)
(set-buffer next-buffer))
;; Otherwise, let's find an appropriate window.
@ -619,11 +712,11 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
(window-live-p server-window))
(select-window server-window))
((framep server-window)
(if (not (frame-live-p server-window))
(setq server-window (make-frame)))
(unless (frame-live-p server-window)
(setq server-window (make-frame)))
(select-window (frame-selected-window server-window))))
(if (window-minibuffer-p (selected-window))
(select-window (next-window nil 'nomini 0)))
(when (window-minibuffer-p (selected-window))
(select-window (next-window nil 'nomini 0)))
;; Move to a non-dedicated window, if we have one.
(when (window-dedicated-p (selected-window))
(select-window

32
lisp/shadowfile.el
View file

@ -97,12 +97,12 @@ is no buffer currently visiting the file."
:group 'shadow)
(defcustom shadow-inhibit-message nil
"*If nonnil, do not display a message when a file needs copying."
"*If non-nil, do not display a message when a file needs copying."
:type 'boolean
:group 'shadow)
(defcustom shadow-inhibit-overload nil
"If nonnil, shadowfile won't redefine \\[save-buffers-kill-emacs].
"If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs].
Normally it overloads the function `save-buffers-kill-emacs' to check
for files have been changed and need to be copied to other systems."
:type 'boolean
@ -146,7 +146,7 @@ Default: ~/.shadow_todo"
(defvar shadow-literal-groups nil
"List of files that are shared between hosts.
This list contains shadow structures with literal filenames, created by
shadow-define-group.")
`shadow-define-literal-group'.")
(defvar shadow-regexp-groups nil
"List of file types that are shared between hosts.
@ -178,7 +178,7 @@ created by `shadow-define-regexp-group'.")
(shadow-union (cdr a) (cons (car a) b)))))
(defun shadow-find (func list)
"If FUNC applied to some element of LIST is nonnil, return first such element."
"If FUNC applied to some element of LIST is non-nil, return first such element."
(while (and list (not (funcall func (car list))))
(setq list (cdr list)))
(car list))
@ -205,7 +205,7 @@ This makes sure regexp matches nothing but STRING."
(defun shadow-suffix (prefix string)
"If PREFIX begins STRING, return the rest.
Return value is nonnil if PREFIX and STRING are string= up to the length of
Return value is non-nil if PREFIX and STRING are `string=' up to the length of
PREFIX."
(let ((lp (length prefix))
(ls (length string)))
@ -285,9 +285,9 @@ information defining the cluster. For interactive use, call
ans)))
(defun shadow-site-match (site1 site2)
"Nonnil iff SITE1 is or includes SITE2.
Each may be a host or cluster name; if they are clusters, regexp of site1 will
be matched against the primary of site2."
"Non-nil iff SITE1 is or includes SITE2.
Each may be a host or cluster name; if they are clusters, regexp of SITE1 will
be matched against the primary of SITE2."
(or (string-equal site1 site2) ; quick check
(let* ((cluster1 (shadow-get-cluster site1))
(primary2 (shadow-site-primary site2)))
@ -355,7 +355,7 @@ Will return the name bare if it is a local file."
(nth 2 hup))))))
(defun shadow-expand-file-name (file &optional default)
"Expand file name and get file's true name."
"Expand file name and get FILE's true name."
(file-truename (expand-file-name file default)))
(defun shadow-contract-file-name (file)
@ -398,7 +398,7 @@ local filename."
"Return t if PATTERN matches FILE.
If REGEXP is supplied and non-nil, the file part of the pattern is a regular
expression, otherwise it must match exactly. The sites and usernames must
match---see shadow-same-site. The pattern must be in full ange-ftp format, but
match---see `shadow-same-site'. The pattern must be in full ange-ftp format, but
the file can be any valid filename. This function does not do any filename
expansion or contraction, you must do that yourself first."
(let* ((pattern-sup (shadow-parse-fullname pattern))
@ -475,7 +475,7 @@ specific hostnames, or names of clusters \(see `shadow-define-cluster')."
"Make each of a group of files be shared between hosts.
Prompts for regular expression; files matching this are shared between a list
of sites, which are also prompted for. The filenames must be identical on all
hosts \(if they aren't, use shadow-define-group instead of this function).
hosts \(if they aren't, use `shadow-define-literal-group' instead of this function).
Each site can be either a hostname or the name of a cluster \(see
`shadow-define-cluster')."
(interactive)
@ -661,7 +661,7 @@ Returns t unless files were locked; then returns nil."
(or (stringp (file-locked-p shadow-info-file))
(stringp (file-locked-p shadow-todo-file))))
(progn
(message "Shadowfile is running in another emacs; can't have two.")
(message "Shadowfile is running in another Emacs; can't have two.")
(beep)
(sit-for 3)
nil)
@ -707,8 +707,8 @@ defined, the old hashtable info is invalid."
(shadow-insert-var 'shadow-regexp-groups))))
(defun shadow-write-todo-file (&optional save)
"Write out information to shadow-todo-file.
With nonnil argument also saves the buffer."
"Write out information to `shadow-todo-file'.
With non-nil argument also saves the buffer."
(save-excursion
(if (not shadow-todo-buffer)
(setq shadow-todo-buffer (find-file-noselect shadow-todo-file)))
@ -731,9 +731,9 @@ With nonnil argument also saves the buffer."
(setq shadow-hashtable (make-vector 37 0)))
(defun shadow-insert-var (variable)
"Prettily insert a setq command for VARIABLE.
"Prettily insert a `setq' command for VARIABLE,
which, when later evaluated, will restore it to its current setting.
SYMBOL must be the name of a variable whose value is a list."
VARIABLE must be the name of a variable whose value is a list."
(let ((standard-output (current-buffer)))
(insert (format "(setq %s" variable))
(cond ((consp (eval variable))

2
lisp/simple.el
View file

@ -2725,7 +2725,7 @@ When this command inserts killed text into the buffer, it honors
`yank-excluded-properties' and `yank-handler' as described in the
doc string for `insert-for-yank-1', which see.
See also the command \\[yank-pop]."
See also the command `yank-pop' (\\[yank-pop])."
(interactive "*P")
(setq yank-window-start (window-start))
;; If we don't get all the way thru, make last-command indicate that

5
lisp/sort.el
View file

@ -505,8 +505,9 @@ Use \\[untabify] to convert tabs to spaces before sorting."
;; Use the sort utility if we can; it is 4 times as fast.
;; Do not use it if there are any non-font-lock properties
;; in the region, since the sort utility would lose the
;; properties.
(let ((sort-args (list (if reverse "-rt\n" "-t\n")
;; properties. Tabs are used as field separator; on NetBSD,
;; sort complains if "\n" is used as field separator.
(let ((sort-args (list (if reverse "-rt\t" "-t\t")
(format "-k1.%d,1.%d"
(1+ col-start)
(1+ col-end)))))

2
lisp/speedbar.el
View file

@ -2157,7 +2157,7 @@ Groups may optionally contain a position."
))))
(defun speedbar-generic-list-tag-p (sublst)
"Non nil if SUBLST is a tag."
"Non-nil if SUBLST is a tag."
(and (stringp (car-safe sublst))
(or (and (number-or-marker-p (cdr-safe sublst))
(not (cdr-safe (cdr-safe sublst))))

51
lisp/startup.el
View file

@ -283,7 +283,8 @@ from being initialized."
(defvar init-file-debug nil)
(defvar init-file-had-error nil)
(defvar init-file-had-error nil
"Non-nil if there was an error loading the user's init file.")
(defvar normal-top-level-add-subdirs-inode-list nil)
@ -1150,8 +1151,16 @@ Getting New Versions\tHow to obtain the latest version of Emacs
More Manuals / Ordering Manuals Buying printed manuals from the FSF\n")
(:face (variable-pitch :weight bold)
"Useful File menu items:\n"
:face variable-pitch "\
Exit Emacs\t\t(Or type Control-x followed by Control-c)
:face variable-pitch
"Exit Emacs\t\t(Or type "
:face default
"Control-x"
:face variable-pitch
" followed by "
:face default
"Control-c"
:face variable-pitch
")
Recover Crashed Session\tRecover files you were editing before a crash
@ -1269,16 +1278,19 @@ where FACE is a valid face specification, as it can be used with
:face 'variable-pitch
"You can do basic editing with the menu bar and scroll bar \
using the mouse.\n\n")
(if fancy-splash-outer-buffer
(fancy-splash-insert
:face 'variable-pitch
(substitute-command-keys
(concat
"Type \\[recenter] to begin editing"
(if (equal (buffer-name fancy-splash-outer-buffer)
"*scratch*")
".\n"
" your file.\n"))))))
(when fancy-splash-outer-buffer
(fancy-splash-insert
:face 'variable-pitch
"Type "
:face 'default
(substitute-command-keys
"\\[recenter]")
:face 'variable-pitch
" to begin editing"
(if (equal (buffer-name fancy-splash-outer-buffer)
"*scratch*")
".\n"
" your file.\n"))))
(defun fancy-splash-tail ()
"Insert the tail part of the splash screen into the current buffer."
@ -1305,7 +1317,11 @@ using the mouse.\n\n")
t)
(fancy-splash-insert :face '(variable-pitch :foreground "red")
"\n\nIf an Emacs session crashed recently, "
"type Meta-x recover-session RET\nto recover"
"type "
:face '(fixed-pitch :foreground "red")
"Meta-x recover-session RET"
:face '(variable-pitch :foreground "red")
"\nto recover"
" the files you were editing."))))
(defun fancy-splash-screens-1 (buffer)
@ -1881,7 +1897,12 @@ With a prefix argument, any user input hides the splash screen."
(setq line 0)
(unless (< column 1)
(move-to-column (1- column)))
(setq column 0))))))))
(setq column 0))))))
;; In unusual circumstances, the execution of Lisp code due
;; to command-line options can cause the last visible frame
;; to be deleted. In this case, kill emacs to avoid an
;; abort later.
(unless (frame-live-p (selected-frame)) (kill-emacs nil))))
;; If 3 or more files visited, and not all visible,
;; show user what they all are. But leave the last one current.

10
lisp/subr.el
View file

@ -1108,11 +1108,11 @@ other hooks, such as major mode hooks, can do the job."
((eq compare-fn 'eql)
(memql element (symbol-value list-var)))
(t
(let (present)
(dolist (elt (symbol-value list-var))
(if (funcall compare-fn element elt)
(setq present t)))
present)))
(let ((lst (symbol-value list-var)))
(while (and lst
(not (funcall compare-fn element (car lst))))
(setq lst (cdr lst)))
lst)))
(symbol-value list-var)
(set list-var
(if append

14
lisp/t-mouse.el
View file

@ -38,7 +38,7 @@
;; now position sensitive.
(defvar t-mouse-process nil
"Embeds the process which passes mouse events to emacs.
"Embeds the process which passes mouse events to Emacs.
It is used by the program t-mouse.")
(defvar t-mouse-filter-accumulator ""
@ -123,7 +123,7 @@ For example, \"2\" for /dev/tty2."
(if (null l1) l2
(append (mapcar (function (lambda (x) (append (nth 0 l1) x))) l2)
(t-mouse-cartesian (cdr l1) l2))))
(let* ((modifier-sets (t-mouse-powerset '(control meta shift)))
(typed-sets (t-mouse-cartesian '((down) (drag))
'((mouse-1) (mouse-2) (mouse-3))))
@ -178,9 +178,9 @@ Also trim the accumulator by all the data used to build the event."
((event-name-string (symbol-name event-type))
end-of-root-event-name
new-event-name-string)
(if (string-match "-\\(21\\|\\12\\)$" event-name-string)
;;Transform the name to what it should have been.
(progn
(setq end-of-root-event-name (match-beginning 0))
@ -188,12 +188,12 @@ Also trim the accumulator by all the data used to build the event."
(concat (substring
event-name-string 0
end-of-root-event-name) "-3"))
;;Change the event to the symbol that corresponds to the
;;name we made. The proper symbol already exists.
(setq event-type
(intern new-event-name-string))))))
;;store current position for mouse-position
(setq t-mouse-current-xy (nth 0 current-xy-avec-time))
@ -269,7 +269,7 @@ The (secret) scrollbar interface is not implemented yet."
"Toggle t-mouse mode.
With prefix arg, turn t-mouse mode on iff arg is positive.
Turn it on to use emacs mouse commands, and off to use t-mouse commands."
Turn it on to use Emacs mouse commands, and off to use t-mouse commands."
nil " Mouse" nil :global t
(if t-mouse-mode
;; Turn it on

2
lisp/terminal.el
View file

@ -1162,7 +1162,7 @@ subprocess started."
(setq inhibit-quit t) ;sport death
(use-local-map terminal-map)
(run-hooks 'terminal-mode-hook)
(message "Entering emacs terminal-emulator... Type %s %s for help"
(message "Entering Emacs terminal-emulator... Type %s %s for help"
(single-key-description terminal-escape-char)
(mapconcat 'single-key-description
(where-is-internal 'te-escape-help terminal-escape-map t)

2
lisp/textmodes/bibtex.el
View file

@ -5,7 +5,7 @@
;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
;; Bengt Martensson <bengt@mathematik.uni-Bremen.de>
;; Mark Shapiro <shapiro@corto.inria.fr>
;; Marc Shapiro <marc.shapiro@acm.org>
;; Mike Newton <newton@gumby.cs.caltech.edu>
;; Aaron Larson <alarson@src.honeywell.com>
;; Dirk Herrmann <D.Herrmann@tu-bs.de>

2
lisp/textmodes/enriched.el
View file

@ -66,7 +66,7 @@
(defface fixed
'((t (:weight bold)))
"Face used for text that must be shown in fixed width.
Currently, emacs can only display fixed-width fonts, but this may change.
Currently, Emacs can only display fixed-width fonts, but this may change.
This face is used for text specifically marked as fixed-width, for example
in text/enriched files."
:group 'enriched)

15
lisp/textmodes/fill.el
View file

@ -746,6 +746,12 @@ space does not end a sentence, so don't break a line there."
(looking-at (regexp-quote prefix))))
(goto-char (match-end 0))))
(defun fill-minibuffer-function (arg)
"Fill a paragraph in the minibuffer, ignoring the prompt."
(save-restriction
(narrow-to-region (minibuffer-prompt-end) (point-max))
(fill-paragraph arg)))
(defun fill-paragraph (arg)
"Fill paragraph at or after point. Prefix ARG means justify as well.
If `sentence-end-double-space' is non-nil, then period followed by one
@ -760,8 +766,13 @@ If `fill-paragraph-function' is nil, return the `fill-prefix' used for filling."
(barf-if-buffer-read-only)
(list (if current-prefix-arg 'full))))
;; First try fill-paragraph-function.
(or (and fill-paragraph-function
(let ((function fill-paragraph-function)
(or (and (or fill-paragraph-function
(and (window-minibuffer-p (selected-window))
(= 1 (point-min))))
(let ((function (or fill-paragraph-function
;; In the minibuffer, don't count the width
;; of the prompt.
'fill-minibuffer-function))
;; If fill-paragraph-function is set, it probably takes care
;; of comments and stuff. If not, it will have to set
;; fill-paragraph-handle-comment back to t explicitly or

93
lisp/textmodes/flyspell.el
View file

@ -189,7 +189,7 @@ Ispell's ultimate default dictionary."
:type 'string)
(defcustom flyspell-check-tex-math-command nil
"Non nil means check even inside TeX math environment.
"Non-nil means check even inside TeX math environment.
TeX math environments are discovered by the TEXMATHP that implemented
inside the texmathp.el Emacs package. That package may be found at:
http://strw.leidenuniv.nl/~dominik/Tools"
@ -412,6 +412,7 @@ property of the major mode name.")
(define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
(define-key map [(control ?\,)] 'flyspell-goto-next-error)
(define-key map [(control ?\.)] 'flyspell-auto-correct-word)
(define-key map [(meta ?\^m)] 'flyspell-correct-word-before-point)
map)
"Minor mode keymap for Flyspell mode--for the whole buffer.")
@ -1999,52 +2000,62 @@ But don't look beyond what's visible on the screen."
;;*---------------------------------------------------------------------*/
;;* flyspell-correct-word ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-correct-word (event)
"Pop up a menu of possible corrections for a misspelled word.
The word checked is the word at the mouse position."
(interactive "e")
;; use the correct dictionary
(flyspell-accept-buffer-local-defs)
;; retain cursor location (I don't know why but save-excursion here fails).
(let ((save (point)))
(mouse-set-point event)
(let ((cursor-location (point))
(word (flyspell-get-word nil)))
(if (consp word)
(let ((start (car (cdr word)))
(end (car (cdr (cdr word))))
(word (car word))
poss ispell-filter)
;; now check spelling of word.
(ispell-send-string "%\n") ;put in verbose mode
(ispell-send-string (concat "^" word "\n"))
;; wait until ispell has processed word
(while (progn
(accept-process-output ispell-process)
(not (string= "" (car ispell-filter)))))
;; Remove leading empty element
(setq ispell-filter (cdr ispell-filter))
;; ispell process should return something after word is sent.
;; Tag word as valid (i.e., skip) otherwise
(or ispell-filter
(setq ispell-filter '(*)))
(if (consp ispell-filter)
(setq poss (ispell-parse-output (car ispell-filter))))
(cond
((or (eq poss t) (stringp poss))
;; don't correct word
t)
((null poss)
;; ispell error
(error "Ispell: error in Ispell process"))
((featurep 'xemacs)
(flyspell-xemacs-popup
poss word cursor-location start end save))
(t
;; The word is incorrect, we have to propose a replacement.
(flyspell-do-correct (flyspell-emacs-popup event poss word)
poss word cursor-location start end save)))
(ispell-pdict-save t))))))
(flyspell-correct-word-before-point event save)))
(defun flyspell-correct-word-before-point (&optional event opoint)
"Pop up a menu of possible corrections for misspelled word before point.
If EVENT is non-nil, it is the mouse event that invoked this operation;
that controls where to put the menu.
If OPOINT is non-nil, restore point there after adjusting it for replacement."
(interactive)
(unless (mouse-position)
(error "Pop-up menus do not work on this terminal"))
;; use the correct dictionary
(flyspell-accept-buffer-local-defs)
(let ((cursor-location (point))
(word (flyspell-get-word nil)))
(if (consp word)
(let ((start (car (cdr word)))
(end (car (cdr (cdr word))))
(word (car word))
poss ispell-filter)
;; now check spelling of word.
(ispell-send-string "%\n") ;put in verbose mode
(ispell-send-string (concat "^" word "\n"))
;; wait until ispell has processed word
(while (progn
(accept-process-output ispell-process)
(not (string= "" (car ispell-filter)))))
;; Remove leading empty element
(setq ispell-filter (cdr ispell-filter))
;; ispell process should return something after word is sent.
;; Tag word as valid (i.e., skip) otherwise
(or ispell-filter
(setq ispell-filter '(*)))
(if (consp ispell-filter)
(setq poss (ispell-parse-output (car ispell-filter))))
(cond
((or (eq poss t) (stringp poss))
;; don't correct word
t)
((null poss)
;; ispell error
(error "Ispell: error in Ispell process"))
((featurep 'xemacs)
(flyspell-xemacs-popup
poss word cursor-location start end opoint))
(t
;; The word is incorrect, we have to propose a replacement.
(flyspell-do-correct (flyspell-emacs-popup event poss word)
poss word cursor-location start end opoint)))
(ispell-pdict-save t)))))
;;*---------------------------------------------------------------------*/
;;* flyspell-do-correct ... */

12
lisp/textmodes/ispell.el
View file

@ -217,7 +217,7 @@
"Empty replacement for defgroup when not supplied.")))
(defgroup ispell nil
"User variables for emacs ispell interface."
"User variables for Emacs ispell interface."
:group 'applications)
(if (not (fboundp 'buffer-substring-no-properties))
@ -496,7 +496,7 @@ These can override the values in `ispell-dictionary-alist'.
To make permanent changes to your dictionary definitions, you
will need to make your changes in this variable, save, and then
re-start emacs."
re-start Emacs."
:type '(repeat (list (choice :tag "Dictionary"
(string :tag "Dictionary name")
(const :tag "default" nil))
@ -900,13 +900,13 @@ and added as a submenu of the \"Edit\" menu.")
(buffer-string))))
;; Search for the named dictionaries.
(found
(delq nil
(delq nil
(mapcar #'ispell-aspell-find-dictionary dictionaries))))
;; Ensure aspell's alias dictionary will override standard
;; definitions.
(setq found (ispell-aspell-add-aliases found))
;; Merge into FOUND any elements from the standard ispell-dictionary-alist
;; which have no element in FOUND at all.
;; which have no element in FOUND at all.
(dolist (dict ispell-dictionary-alist)
(unless (assoc (car dict) found)
(setq found (nconc found (list dict)))))
@ -2074,7 +2074,7 @@ SPC: Accept word this time.
`m': Place typed-in value in personal dictionary, then recheck current word.
`C-l': redraws screen
`C-r': recursive edit
`C-z': suspend emacs or iconify frame"
`C-z': suspend Emacs or iconify frame"
(if (equal ispell-help-in-bufferp 'electric)
(progn
@ -2106,7 +2106,7 @@ SPC: Accept word this time.
`m': Place typed-in value in personal dictionary, then recheck current word.
`C-l': redraws screen
`C-r': recursive edit
`C-z': suspend emacs or iconify frame")
`C-z': suspend Emacs or iconify frame")
nil ;undocumented requirement of with-electric-help
))))

76
lisp/textmodes/org.el
View file

@ -1103,7 +1103,7 @@ for some files for which the OS does not have a good default.
See `org-file-apps'.")
(defconst org-file-apps-defaults-windowsnt
(list
(list
'(remote . emacs)
(cons t
(list (if (featurep 'xemacs)
@ -1132,7 +1132,7 @@ file identifier are
\"ext\" A string identifying an extension
`directory' Matches a directory
`remote' Matches a remote file, accessible through tramp or efs.
Remote files most likely should be visited through emacs
Remote files most likely should be visited through Emacs
because external applications cannot handle such paths.
t Default for all remaining files
@ -2342,7 +2342,7 @@ stacked Non-nil means, allow stacked styles. This works only in HTML
export. When this is set, all marker characters (as given in
`org-emphasis-alist') will be allowed as pre/post, aiding
inside-out matching.
Use customize to modify this, or restart emacs after changing it."
Use customize to modify this, or restart Emacs after changing it."
:group 'org-font-lock
:set 'org-set-emph-re
:type '(list
@ -2360,12 +2360,12 @@ Use customize to modify this, or restart emacs after changing it."
("=" shadow "<code>" "</code>")
("+" (:strike-through t) "<del>" "</del>")
)
"Special syntax for emphasised text.
"Special syntax for emphasized text.
Text starting and ending with a special character will be emphasized, for
example *bold*, _underlined_ and /italic/. This variable sets the marker
characters, the face to bbe used by font-lock for highlighting in Org-mode
emacs buffers, and the HTML tags to be used for this.
Use customize to modify this, or restart emacs after changing it."
Emacs buffers, and the HTML tags to be used for this.
Use customize to modify this, or restart Emacs after changing it."
:group 'org-font-lock
:set 'org-set-emph-re
:type '(repeat
@ -2897,11 +2897,8 @@ Also put tags into group 4 if tags are present.")
;;; Define the mode
(defvar org-mode-map
(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
(error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22.")
(copy-keymap outline-mode-map))
"Keymap for Org-mode.")
(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
(error "Conflict with outdated version of allout.el. Load org.el before allout.el, or ugrade to newer allout, for example by switching to Emacs 22."))
(defvar org-struct-menu) ; defined later in this file
(defvar org-org-menu) ; defined later in this file
@ -2913,6 +2910,7 @@ Also put tags into group 4 if tags are present.")
"Indicates that a table might need an update.
This variable is set by `org-before-change-function'.
`org-table-align' sets it back to nil.")
(defvar org-mode-map)
(defvar org-mode-hook nil)
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
@ -3453,7 +3451,7 @@ between words."
(call-interactively 'org-table-next-field)))))
((eq arg t) ;; Global cycling
(cond
((and (eq last-command this-command)
(eq org-cycle-global-status 'overview))
@ -3953,7 +3951,7 @@ would end up with no indentation after the change, nothing at all is done."
(let ((end (save-excursion (outline-next-heading)
(point-marker)))
(prohibit (if (> diff 0)
"^\\S-"
"^\\S-"
(concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
col)
(unless (save-excursion (re-search-forward prohibit end t))
@ -4029,7 +4027,7 @@ This is a short-hand for marking the subtree and then cutting it."
(defun org-copy-subtree (&optional cut)
"Cut the current subtree into the clipboard.
This is a short-hand for marking the subtree and then copying it.
If CUT is non nil, actually cut the subtree."
If CUT is non-nil, actually cut the subtree."
(interactive)
(let (beg end folded)
(org-back-to-heading)
@ -4217,7 +4215,7 @@ If optional TXT is given, check this string instead of the current kill."
(setq status (equal (match-string 0) "[X]"))
(when (eq firstnew 'unknown)
(setq firstnew (not status)))
(replace-match
(replace-match
(if (if arg (not status) firstnew) "[X]" "[ ]") t t))
(beginning-of-line 2))))))
@ -4513,7 +4511,7 @@ this heading. "
(if find-done
(org-archive-all-done)
;; Save all relevant TODO keyword-relatex variables
(let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
(tr-org-todo-keywords org-todo-keywords)
(tr-org-todo-interpretation org-todo-interpretation)
@ -4620,7 +4618,7 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(if (org-on-heading-p)
(progn
(setq re1 (concat "^" (regexp-quote
(make-string
(make-string
(1+ (- (match-end 0) (match-beginning 0)))
?*))
" "))
@ -4751,7 +4749,7 @@ the children that do not contain any open TODO items."
(org-end-of-subtree)
(throw :skip t))
(if (equal (char-after p) ?#) (throw :skip t))))
(defun org-agenda-toggle-archive-tag ()
"Toggle the archive tag for the current entry."
(interactive)
@ -6192,12 +6190,12 @@ the returned times will be formatted strings."
(apply 'encode-time (org-parse-time-string te)))))
(move-marker ins (point))
(setq ipos (point))
(insert-before-markers "Clock summary at ["
(insert-before-markers "Clock summary at ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
"]."
(if block
(if block
(format " Considered range is /%s/." block)
"")
"\n\n|L|Headline|Time|\n")
@ -6223,7 +6221,7 @@ the returned times will be formatted strings."
(goto-char ins)
(if (= level 1) (insert-before-markers "|-\n"))
(insert-before-markers
"| " (int-to-string level) "|" hlc hdl hlc " |"
"| " (int-to-string level) "|" hlc hdl hlc " |"
(make-string (1- level) ?|)
hlc
(format "%d:%02d" h m)
@ -8818,7 +8816,7 @@ With prefix ARG, realign all tags in headings in the current buffer."
nil nil current 'org-tags-history))))
(while (string-match "[-+&]+" tags)
(setq tags (replace-match ":" t t tags))))
(unless (setq empty (string-match "\\`[\t ]*\\'" tags))
(unless (string-match ":$" tags) (setq tags (concat tags ":")))
(unless (string-match "^:" tags) (setq tags (concat ":" tags))))
@ -9971,7 +9969,7 @@ For file links, arg negates `org-context-in-file-links'."
((eq major-mode 'image-mode)
(setq cpltxt (concat "file:"
(abbreviate-file-name buffer-file-name))
link (org-make-link cpltxt)))
link (org-make-link cpltxt)))
((org-mode-p)
;; Just link to current headline
@ -13354,7 +13352,7 @@ translations. There is currently no way for users to extend this.")
;; Convert LaTeX fragments to images
(when (memq :LaTeX-fragments parameters)
(org-format-latex
(org-format-latex
(concat "ltxpng/" (file-name-sans-extension
(file-name-nondirectory
org-current-export-file)))
@ -13873,7 +13871,7 @@ org-mode's default settings, but still inferior to file-local settings."
(all_lines
(org-skip-comments (org-split-string
(org-cleaned-string-for-export
region :emph-multiline
region :emph-multiline
(if (plist-get opt-plist :LaTeX-fragments)
:LaTeX-fragments))
"[\r\n]")))
@ -14137,7 +14135,7 @@ lang=\"%s\" xml:lang=\"%s\">
(setq valid
(if (functionp link-validate)
(funcall link-validate filename current-dir)
t))
t))
(setq file-is-image-p
(string-match (org-image-file-name-regexp) filename))
(setq thefile (if abs-p (expand-file-name filename) filename))
@ -14993,7 +14991,7 @@ a time), or the day by one (if it does not contain a time)."
(defvar org-cdlatex-texmathp-advice-is-done nil
"Flag remembering if we have applied the advice to texmathp already.")
(define-minor-mode org-cdlatex-mode
(define-minor-mode org-cdlatex-mode
"Toggle the minor `org-cdlatex-mode'.
This mode supports entering LaTeX environment and math in LaTeX fragments
in Org-mode.
@ -15121,7 +15119,7 @@ Revert to the normal definition outside of these fragments."
If the cursor is in a LaTeX fragment, create the image and overlay
it over the source code. If there is no fragment at point, display
all fragments in the current text, from one headline to the next. With
prefix SUBTREE, display all fragments in the current subtree. With a
prefix SUBTREE, display all fragments in the current subtree. With a
double prefix `C-u C-u', or when the cursor is before the first headline,
display all fragments in the buffer.
The images can be removed again with \\[org-ctrl-c-ctrl-c]."
@ -15209,16 +15207,16 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
(progn
(org-overlay-put ov 'invisible t)
(org-overlay-put
ov 'end-glyph
ov 'end-glyph
(make-glyph (vector 'png :file movefile))))
(org-overlay-put
ov 'display
(org-overlay-put
ov 'display
(list 'image :type 'png :file movefile :ascent 'center)))
(push ov org-latex-fragment-image-overlays)
(goto-char end))
(delete-region beg end)
(insert link))))))))
;; This function borrows from Ganesh Swami's latex2png.el
(defun org-create-formula-image (string tofile options)
(let* ((tmpdir (if (featurep 'xemacs)
@ -15870,7 +15868,7 @@ See the individual commands for more information."
:style toggle :selected (not org-agenda-skip-archived-trees)]
"--"
["Move Subtree to Archive" org-archive-subtree t]
["Check and Move Children" (org-archive-subtree '(4))
["Check and Move Children" (org-archive-subtree '(4))
:active t :keys "C-u C-c $"])
"--"
("TODO Lists"
@ -15940,14 +15938,14 @@ See the individual commands for more information."
"--"
["Export/Publish" org-export t]
("LaTeX"
["Org CDLaTeX mode" org-cdlatex-mode :style toggle
["Org CDLaTeX mode" org-cdlatex-mode :style toggle
:selected org-cdlatex-mode]
["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
["Modify math symbol" org-cdlatex-math-modify
(org-inside-LaTeX-fragment-p)]
["Export LaTeX fragments as images"
(setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments))
(setq org-export-with-LaTeX-fragments (not org-export-with-LaTeX-fragments))
:style toggle :selected org-export-with-LaTeX-fragments])
"--"
("Documentation"
@ -16097,13 +16095,13 @@ and :keyword."
(push (org-point-in-group p 0 :radio-target) clist))
(goto-char p))
((setq o (car (delq nil
(mapcar
(mapcar
(lambda (x)
(if (memq x org-latex-fragment-image-overlays) x))
(org-overlays-at (point))))))
(push (list :latex-fragment
(push (list :latex-fragment
(org-overlay-start o) (org-overlay-end o)) clist)
(push (list :latex-preview
(push (list :latex-preview
(org-overlay-start o) (org-overlay-end o)) clist))
((org-inside-LaTeX-fragment-p)
;; FIXME: positions wring.
@ -16413,7 +16411,7 @@ Show the heading too, if it is currently invisible."
;;; Finish up
(provide 'org)
(run-hooks 'org-load-hook)

Some files were not shown because too many files have changed in this diff Show more