AC_PREREQ(2.65)
dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el.
-AC_INIT(GNU Emacs, 25.0.92, bug-gnu-emacs@gnu.org)
+AC_INIT(GNU Emacs, 25.1.50, bug-gnu-emacs@gnu.org)
dnl Set emacs_config_options to the options of 'configure', quoted for the shell,
dnl and then quoted again for a C string. Separate options with spaces.
[Show Gtk+/Gdk deprecation warnings for Gtk+ >= 3.0])],
[ac_enable_gtk_deprecation_warnings="${enableval}"],[])
+BUILD_DETAILS=
+AC_ARG_ENABLE([build-details],
+ [AS_HELP_STRING([--disable-build-details],
+ [Make the build more deterministic by omitting host
+ names, time stamps, etc. from the output.])],
+ [test "$enableval" = no && BUILD_DETAILS=--no-build-details])
+AC_SUBST([BUILD_DETAILS])
+
dnl This used to use changequote, but, apart from 'changequote is evil'
dnl per the autoconf manual, we can speed up autoconf somewhat by quoting
dnl the great gob of text. Thus it's not processed for possible expansion.
* ) unported=yes ;;
esac
opsys=darwin
- ## Use fink packages if available.
- ## FIXME find a better way to do this: http://debbugs.gnu.org/11507
-## if test -d /sw/include && test -d /sw/lib; then
-## GCC_TEST_OPTIONS="-I/sw/include -L/sw/lib"
-## NON_GCC_TEST_OPTIONS=${GCC_TEST_OPTIONS}
-## fi
+ ## FIXME: Find a way to use Fink if available (Bug#11507).
;;
## Chromium Native Client
opsys=aix4-2
;;
- ## Silicon Graphics machines
- ## Iris 4D
- mips-sgi-irix6.5 )
- opsys=irix6-5
- # Without defining _LANGUAGE_C, things get masked out in the headers
- # so that, for instance, grepping for 'free' in stdlib.h fails and
- # AC_HEADER_STD_C fails. (MIPSPro 7.2.1.2m compilers, Irix 6.5.3m).
- NON_GCC_TEST_OPTIONS="-D_LANGUAGE_C"
- ;;
-
## Suns
*-sun-solaris* \
| i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \
if test x$GCC = xyes; then
test "x$GCC_TEST_OPTIONS" != x && CC="$CC $GCC_TEST_OPTIONS"
-else
- test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS"
fi
dnl This is used in lib/Makefile.am to use nt/gnulib.mk, the
nw="$nw -Wvla" # Emacs uses <vla.h>.
nw="$nw -Wswitch-default" # Too many warnings for now
nw="$nw -Winline" # OK to ignore 'inline'
- nw="$nw -Wjump-misses-init" # We sometimes safely jump over init.
nw="$nw -Wstrict-overflow" # OK to optimize assuming that
# signed overflow has undefined behavior
nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
dnl We need -znocombreloc if we're using a relatively recent GNU ld.
dnl If we can link with the flag, it shouldn't do any harm anyhow.
-dnl (Don't use '-z nocombreloc' as -z takes no arg on Irix.)
dnl Treat GCC specially since it just gives a non-fatal 'unrecognized option'
dnl if not built to support GNU ld.
dnl Current possibilities handled by sed (aix4-2 -> aix,
dnl gnu-linux -> gnu/linux, etc.):
-dnl gnu, gnu/linux, gnu/kfreebsd, aix, cygwin, darwin, hpux, irix.
+dnl gnu, gnu/linux, gnu/kfreebsd, aix, cygwin, darwin, hpux.
dnl And special cases: berkeley-unix, usg-unix-v, ms-dos, windows-nt.
SYSTEM_TYPE=`echo $opsys | sed -e 's/[[0-9]].*//' -e 's|-|/|'`
dnl checks for header files
AC_CHECK_HEADERS_ONCE(
+ malloc.h
sys/systeminfo.h
sys/sysinfo.h
coff.h pty.h
cygwin) hybrid_malloc=yes;;
esac
+if test "${system_malloc}" != yes && test "${doug_lea_malloc}" != yes \
+ && test "${UNEXEC_OBJ}" = unexelf.o; then
+ hybrid_malloc=yes
+fi
+
GMALLOC_OBJ=
+HYBRID_MALLOC=
if test "${system_malloc}" = "yes"; then
AC_DEFINE([SYSTEM_MALLOC], 1,
[Define to 1 to use the system memory allocator, even if it is not
elif test "$hybrid_malloc" = yes; then
AC_DEFINE(HYBRID_MALLOC, 1,
[Define to use gmalloc before dumping and the system malloc after.])
+ HYBRID_MALLOC=1
GNU_MALLOC=
GNU_MALLOC_reason="only before dumping"
GMALLOC_OBJ=gmalloc.o
of the main data segment.])
fi
fi
+AC_SUBST([HYBRID_MALLOC])
+AM_CONDITIONAL([HYBRID_MALLOC_LIB], [test -n "$HYBRID_MALLOC"])
AC_SUBST(GMALLOC_OBJ)
AC_SUBST(VMLIMIT_OBJ)
-if test "$doug_lea_malloc" = "yes" ; then
+if test "$doug_lea_malloc" = "yes" && test "$hybrid_malloc" != yes; then
if test "$GNU_MALLOC" = yes ; then
GNU_MALLOC_reason="
(Using Doug Lea's new malloc from the GNU C Library.)"
use_mmap_for_buffers=no
case "$opsys" in
- cygwin|mingw32|freebsd|irix6-5) use_mmap_for_buffers=yes ;;
+ cygwin|mingw32) use_mmap_for_buffers=yes ;;
esac
AC_FUNC_MMAP
OLD_LIBS=$LIBS
CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS"
LIBS="$IMAGEMAGICK_LIBS $LIBS"
- AC_CHECK_FUNCS(MagickExportImagePixels MagickMergeImageLayers)
+ AC_CHECK_FUNCS(MagickExportImagePixels MagickMergeImageLayers MagickAutoOrientImage)
CFLAGS=$OLD_CFLAGS
LIBS=$OLD_LIBS
fi
fi
fi
+AC_CHECK_LIB(anl, getaddrinfo_a, HAVE_GETADDRINFO_A=yes)
+if test "${HAVE_GETADDRINFO_A}" = "yes"; then
+ AC_DEFINE(HAVE_GETADDRINFO_A, 1,
+[Define to 1 if you have getaddrinfo_a for asynchronous DNS resolution.])
+ GETADDRINFO_A_LIBS="-lanl"
+ AC_SUBST(GETADDRINFO_A_LIBS)
+fi
HAVE_GTK=no
GTK_OBJ=
fi
fi
if test $HAVE_XRANDR = yes; then
- SAVE_CFLAGS="$CFLAGS"
- SAVE_LIBS="$LIBS"
- CFLAGS="$XRANDR_CFLAGS $CFLAGS"
- LIBS="$XRANDR_LIBS $LIBS"
- AC_CHECK_FUNCS(XRRGetOutputPrimary XRRGetScreenResourcesCurrent)
- CFLAGS="$SAVE_CFLAGS"
- LIBS="$SAVE_LIBS"
-
AC_DEFINE(HAVE_XRANDR, 1, [Define to 1 if you have the XRandr extension.])
fi
fi
AC_SUBST(LIBXML2_LIBS)
AC_SUBST(LIBXML2_CFLAGS)
-# If netdb.h doesn't declare h_errno, we must declare it by hand.
-# On MinGW, that is provided by nt/inc/sys/socket.h and w32.c.
-if test "${opsys}" = "mingw32"; then
- emacs_cv_netdb_declares_h_errno=yes
-fi
-AC_CACHE_CHECK(whether netdb declares h_errno,
- emacs_cv_netdb_declares_h_errno,
-[AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netdb.h>]],
- [[return h_errno;]])],
- emacs_cv_netdb_declares_h_errno=yes, emacs_cv_netdb_declares_h_errno=no)])
-if test $emacs_cv_netdb_declares_h_errno = yes; then
- AC_DEFINE(HAVE_H_ERRNO, 1, [Define to 1 if netdb.h declares h_errno.])
-fi
-
# Check for mail-locking functions in a "mail" library. Probably this should
# have the same check as for liblockfile below.
AC_CHECK_LIB(mail, maillock, have_mail=yes, have_mail=no)
case "$opsys" in
aix4-2) mail_lock="lockf" ;;
- gnu|freebsd|dragonfly|netbsd|openbsd|darwin|irix6-5) mail_lock="flock" ;;
+ gnu|freebsd|dragonfly|netbsd|openbsd|darwin) mail_lock="flock" ;;
## On GNU/Linux systems, both methods are used by various mail programs.
## I assume most people are using newer mailers that have heard of flock.
getrusage get_current_dir_name \
lrand48 random rint \
select getpagesize setlocale newlocale \
-getrlimit setrlimit shutdown getaddrinfo \
+getrlimit setrlimit shutdown \
pthread_sigmask strsignal setitimer \
sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \
gai_strerror sync \
dnl No need to check for posix_memalign if aligned_alloc works.
AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break])
+AC_CHECK_DECLS([aligned_alloc], [], [], [[#include <stdlib.h>]])
dnl Cannot use AC_CHECK_FUNCS
AC_CACHE_CHECK([for __builtin_unwind_init],
[emacs_cv_alternate_stack=yes],
[emacs_cv_alternate_stack=no])])
-# Do we have res_init, for detecting changes in /etc/resolv.conf?
-# On Darwin, res_init appears not to be useful: see bug#562 and
-# http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html
-resolv=no
-
-if test $opsys != darwin; then
-
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
-#include <arpa/nameser.h>
-#include <resolv.h>]],
- [[return res_init();]])],
- have_res_init=yes, have_res_init=no)
- if test "$have_res_init" = no; then
- OLIBS="$LIBS"
- LIBS="$LIBS -lresolv"
- AC_MSG_CHECKING(for res_init with -lresolv)
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <netinet/in.h>
-#include <arpa/nameser.h>
-#include <resolv.h>]],
- [[return res_init();]])],
- have_res_init=yes, have_res_init=no)
- AC_MSG_RESULT($have_res_init)
- if test "$have_res_init" = yes ; then
- resolv=yes
- fi
- LIBS="$OLIBS"
- fi
-
- if test "$have_res_init" = yes; then
- AC_DEFINE(HAVE_RES_INIT, 1, [Define to 1 if res_init is available.])
- fi
-fi dnl !darwin
-
# Do we need the Hesiod library to provide the support routines?
dnl FIXME? Should we be skipping this on Darwin too?
LIBHESIOD=
+LIBRESOLV=
if test "$with_hesiod" != no ; then
# Don't set $LIBS here -- see comments above. FIXME which comments?
+ resolv=no
AC_CHECK_FUNC(res_send, , [AC_CHECK_FUNC(__res_send, ,
[AC_CHECK_LIB(resolv, res_send, resolv=yes,
[AC_CHECK_LIB(resolv, __res_send, resolv=yes)])])])
else
RESOLVLIB=
fi
+ hesiod=no
AC_CHECK_FUNC(hes_getmailhost, , [AC_CHECK_LIB(hesiod, hes_getmailhost,
hesiod=yes, :, $RESOLVLIB)])
if test x"$hesiod" = xyes; then
LIBHESIOD=-lhesiod
+ LIBRESOLV=$RESOLVLIB
fi
fi
AC_SUBST(LIBHESIOD)
-
-# Do we need libresolv (due to res_init or Hesiod)?
-if test "$resolv" = yes && test $opsys != darwin; then
- LIBRESOLV=-lresolv
-else
- LIBRESOLV=
-fi
AC_SUBST(LIBRESOLV)
# These tell us which Kerberos-related libraries to use.
SEPCHAR=':'
fi
AC_DEFINE_UNQUOTED(SEPCHAR, ['$SEPCHAR'], [Character that separates PATH elements.])
-dnl This is for MinGW, and is used in test/automated/Makefile.in.
+dnl This is for MinGW, and is used in test/Makefile.in.
dnl The MSYS Bash has heuristics for replacing ':' with ';' when it
dnl decides that a command-line argument to be passed to a MinGW program
dnl is a PATH-style list of directories. But that heuristics plays it
case $opsys in
- irix6-5 | sol2* | unixware )
+ sol2* | unixware )
dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments;
dnl instead, there's a system variable _sys_nsig. Unfortunately, we
dnl need the constant to dimension an array. So wire in the appropriate
case $opsys in
dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
dnl See eg <http://article.gmane.org/gmane.os.openbsd.ports/46831>.
- hpux* | irix6-5 | nacl | openbsd | sol2* | unixware )
+ hpux* | nacl | openbsd | sol2* | unixware )
emacs_broken_SIGIO=yes
;;
dnl NARROWPROTO, we will see the wrong function prototypes for X functions
dnl taking float or double parameters.
case $opsys in
- cygwin|gnu|gnu-linux|gnu-kfreebsd|irix6-5|freebsd|netbsd|openbsd)
+ cygwin|gnu|gnu-linux|gnu-kfreebsd|freebsd|netbsd|openbsd)
AC_DEFINE(NARROWPROTO, 1, [Define if system's imake configuration
file defines 'NeedWidePrototypes' as 'NO'.])
;;
dnl Used in process.c, this must be a loop, even if it only runs once.
-dnl (Except on SGI; see below. Take that, clarity and consistency!)
AH_TEMPLATE(PTY_ITERATION, [How to iterate over PTYs.])
dnl Only used if !PTY_ITERATION. Iterate from FIRST_PTY_LETTER to z,
dnl trying suffixes 0-16.
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);])
;;
- irix6-5 )
- dnl It looks like this cannot be right, because it is not a loop.
- dnl However, process.c actually does this:
- dnl # ifndef __sgi
- dnl continue;
- dnl # else
- dnl return -1;
- dnl # endif
- dnl which presumably makes it OK, since irix == sgi (?).
- dnl FIXME it seems like this special treatment is unnecessary?
- dnl Why can't irix use a single-trip loop like eg cygwin?
- AC_DEFINE(PTY_ITERATION, [])
- dnl Not used, because PTY_ITERATION is defined.
- AC_DEFINE(FIRST_PTY_LETTER, ['q'])
- AC_DEFINE(PTY_OPEN, [ { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCHLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCHLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }])
- dnl No need to get the pty name at all.
- AC_DEFINE(PTY_NAME_SPRINTF, [])
- dnl No need to use sprintf to get the tty name--we get that from _getpty.
- AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
- ;;
-
sol2* )
dnl On SysVr4, grantpt(3) forks a subprocess, so do not use
dnl O_CLOEXEC when opening the pty, and keep the SIGCHLD handler
case $opsys in
dnl Perry Smith <pedz@ddivt1.austin.ibm.com> says this is correct for AIX.
- dnl thomas@mathematik.uni-bremen.de says this is needed for IRIX.
- aix4-2 | cygwin | gnu | irix6-5 | dragonfly | freebsd | netbsd | openbsd | darwin )
+ aix4-2 | cygwin | gnu | dragonfly | freebsd | netbsd | openbsd | darwin )
AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1)
;;
AC_DEFINE(GC_SETJMP_WORKS, 1)
else
case $opsys in
- dnl irix: Tested on Irix 6.5. SCM worked on earlier versions.
- aix* | dragonfly | freebsd | netbsd | openbsd | irix6-5 | sol2* )
+ aix* | dragonfly | freebsd | netbsd | openbsd | sol2* )
AC_DEFINE(GC_SETJMP_WORKS, 1)
;;
esac
AC_DEFINE(HPUX, [], [Define if the system is HPUX.])
;;
- irix6-5)
- AC_DEFINE(USG, [])
- AC_DEFINE(USG5_4, [])
- AC_DEFINE(IRIX6_5, [], [Define if the system is IRIX.])
- ;;
-
mingw32)
AC_DEFINE(DOS_NT, [])
AC_DEFINE(WINDOWSNT, 1, [Define if compiling for native MS Windows.])
reopen it in the child.])
;;
- irix6-5)
- AC_DEFINE(PREFER_VSUSP, 1, [Define if process_send_signal should
- use VSUSP instead of VSWTCH.])
- ;;
-
sol2-10)
AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes
on Solaris.])
AC_SUBST(RALLOC_OBJ)
if test "$opsys" = "cygwin"; then
- CYGWIN_OBJ="sheap.o cygw32.o"
+ CYGWIN_OBJ="cygw32.o"
## Cygwin differs because of its unexec().
PRE_ALLOC_OBJ=
POST_ALLOC_OBJ=lastfile.o
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
leim/Makefile nextstep/Makefile nt/Makefile])
dnl test/ is not present in release tarfiles.
-opt_makefile=test/automated/Makefile
+opt_makefile=test/Makefile
if test -f "$srcdir/$opt_makefile.in"; then
SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
dnl Again, it's best not to use a variable. Though you can add
dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
- AC_CONFIG_FILES([test/automated/Makefile])
+ AC_CONFIG_FILES([test/Makefile])
fi
[\|\-\-parse\-stdin=\fIfile\fP\|]
.br
[\|\-\-append\|] [\|\-\-no\-defines\|] [\|\-\-globals\|]
-[\|\-\-no\-globals\|] [\|\-\-no\-line\-directive\|] [\|\-\-include=\fIfile\fP\|]
+[\|\-\-no\-globals\|] [\|\-\-include=\fIfile\fP\|]
[\|\-\-ignore\-indentation\|] [\|\-\-language=\fIlanguage\fP\|]
[\|\-\-members\|] [\|\-\-no\-members\|] [\|\-\-output=\fItagfile\fP\|]
[\|\-\-class\-qualify\|]
[\|\-\-parse\-stdin=\fIfile\fP\|]
.br
[\|\-\-append\|] [\|\-\-backward\-search\|]
-[\|\-\-cxref\|] [\|\-\-no\-defines\|] [\|\-\-globals\|]
-[\|\-\-no\-globals\|] [\|\-\-no\-line\-directive\|] [\|\-\-ignore\-indentation\|]
+[\|\-\-cxref\|] [\|\-\-no\-defines\|]
+[\|\-\-globals\|] [\|\-\-no\-globals\|] [\|\-\-ignore\-indentation\|]
[\|\-\-language=\fIlanguage\fP\|] [\|\-\-members\|] [\|\-\-no\-members\|]
[\|\-\-class\-qualify\|]
[\|\-\-output=\fItagfile\fP\|] [\|\-\-regex=\fIregexp\fP\|]
Do not tag global variables in C and derived languages. Typically this
reduces the file size by one fourth.
.TP
-.B \-\-no\-line\-directive
-Ignore \fB#line\fP preprocessor directives in C and derived languages. The
-default is to honor those directives, and record the tags as if the
-file scanned was the one named in the \fB#line\fP directive. This switch is
-useful when the original file named by \fB#line\fP is no longer available.
-.TP
\fB\-i\fP \fIfile\fP, \fB\-\-include=\fIfile\fP
Include a note in the tag file indicating that, when searching for a
tag, one should also consult the tags file \fIfile\fP after checking the
\fBetags\fP will read from standard input and mark the produced tags
as belonging to the file \fBFILE\fP.
.TP
- \fB\-\-class\-qualify\fP
- Qualify tag names with their class name in C++, ObjC, and Java.
+ \fB \-Q, \-\-class\-qualify\fP
+ Qualify tag names with their class name in C++, ObjC, Java, and Perl.
This produces tag names of the form \fIclass\fP\fB::\fP\fImember\fP
- for C++,
+ for C++ and Perl,
\fIclass\fP\fB(\fP\fIcategory\fP\fB)\fP for Objective C, and \fIclass\fP\fB.\fP\fImember\fP for Java.
For Objective C, this also produces class methods qualified with
their arguments, as in \fIfoo\fP\fB:\fP\fIbar\fP\fB:\fP\fIbaz\fP\fB:\fP\fImore\fP.
When you add a new item, use the appropriate mark if you are sure it applies,
otherwise leave it unmarked.
+\f
+* Installation Changes in Emacs 25.2
+
++++
+** New configure option ‘--disable-build-details’ attempts to build an
+Emacs that is more likely to be reproducible; that is, if you build
+and install Emacs twice, the second Emacs is a copy of the first.
+Deterministic builds omit the build date from the output of the
+emacs-version and erc-cmd-SV functions, and the leave the following
+variables nil: emacs-build-system, emacs-build-time,
+erc-emacs-build-time.
+
+** Emacs no longer works on IRIX. We expect that Emacs users are not
+affected by this, as SGI stopped supporting IRIX in December 2013.
+
+\f
+* Startup Changes in Emacs 25.2
+
+\f
+* Changes in Emacs 25.2
+
++++
+** A number of accessors for the value returned by `file-attributes'
+has been added. They are: `file-attribute-type',
+`file-attribute-link-number', `file-attribute-user-id',
+`file-attribute-group-id', `file-attribute-access-time',
+`file-attribute-modification-time',
+`file-attribute-status-change-time', `file-attribute-size',
+`file-attribute-modes', `file-attribute-inode-number', and
+`file-attribute-device-number'
+
+---
+** `align-regexp' has a separate history for its interactive argument
+`align-regexp' no longer shares its history with all other
+history-less functions that use `read-string'
+
++++
+** The networking code has been reworked so that it's more
+asynchronous than it was (when specifying :nowait t in
+`make-network-process'). How asynchronous it is varies based on the
+capabilities of the system, but on a typical GNU/Linux system the DNS
+resolution, the connection, and (for TLS streams) the TLS negotiation
+are all done without blocking the main Emacs thread. To get
+asynchronous TLS, the TLS boot parameters have to be passed in (see
+the manual for details).
+
+Certain process oriented functions (like `process-datagram-address')
+will block until socket setup has been performed. The recommended way
+to deal with asynchronous sockets is to avoid interacting with them
+until they have changed status to "run". This is most easily done
+from a process sentinel.
+
+** ‘make-network-process’ and ‘open-network-stream’ sometimes allowed
+:service to be an integer string (e.g., :service "993") and sometimes
+required an integer (e.g., :service 993). This difference has been
+eliminated, and integer strings work everywhere.
+
+** It is possible to disable attempted recovery on fatal signals
+
+Two new variables allow to disable attempts to recover from stack
+overflow and to avoid automatic auto-save when Emacs is delivered a
+fatal signal. `attempt-stack-overflow-recovery', if set to `nil',
+will disable attempts to recover from C stack overflows; Emacs will
+then crash as with any other fatal signal.
+`attempt-orderly-shutdown-on-fatal-signal', if set to `nil', will
+disable attempts to auto-save the session and shut down in an orderly
+fashion when Emacs receives a fatal signal; instead, Emacs will
+terminate immediately. Both variables are non-`nil' by default.
+These variables are for users who would like to avoid the small
+probability of data corruption due to techniques Emacs uses to recover
+in these situations.
+
+\f
+* Editing Changes in Emacs 25.2
+
+\f
+* Changes in Specialized Modes and Packages in Emacs 25.2
+
+** eww
+
++++
+*** A new `s' command for switching to another eww buffer via the minibuffer.
+
+---
+*** The `o' command (`shr-save-contents') has moved to `O' to avoid collision
+with the `o' command from `image-map'.
+
++++
+** The commands that add ChangeLog entries now prefer a VCS root directory
+for the ChangeLog file, if none already exists. Customize
+`change-log-directory-files' to nil for the old behavior.
+
+---
+** Support for non-string values of `time-stamp-format' has been removed.
+
+** Tramp
+
++++
+*** New connection method "sg", which allows to edit files under
+different group ID.
+
++++
+*** New connection method "doas" for OpenBSD hosts.
+
+---
+** `auto-revert-use-notify' is set back to t in `global-auto-revert-mode'.
+
+\f
+* New Modes and Packages in Emacs 25.2
+
+\f
+* Incompatible Lisp Changes in Emacs 25.2
+
++++
+** Resizing a frame no longer runs `window-configuration-change-hook'.
+Put your function on `window-size-change-functions' instead.
+
+\f
+* Lisp Changes in Emacs 25.2
+
+** New var syntax-ppss-table to control the syntax-table used in syntax-ppss
+
+** Autoload files can be generated without timestamps,
+by setting `autoload-timestamps' to nil.
+FIXME As an experiment, nil is the current default.
+If no insurmountable problems before next release, it can stay that way.
+
+** `ert-with-function-mocked' of 'ert-x package allows mocking of functions
+in unit tests.
+
+---
+** `gnutls-boot' now takes a parameter :complete-negotiation that says
+that negotiation should complete even on non-blocking sockets.
+
++++
+** New functions `window-pixel-width-before-size-change' and
+`window-pixel-height-before-size-change' allow to detect which window
+changed size when `window-size-change-functions' are run.
+
++++
+** New function `display-buffer-reuse-mode-window' is an action function
+suitable for use in `display-buffer-alist'. For example, to avoid creating
+a new window when opening man pages when there's already one, use
+(add-to-list 'display-buffer-alist
+ '("\\`\\*Man .*\\*\\'" .
+ (display-buffer-reuse-mode-window
+ (inhibit-same-window . nil)
+ (mode . Man-mode))))
+
+\f
+* Changes in Emacs 25.2 on Non-Free Operating Systems
+
+** Intercepting hotkeys on Windows 7 and later now works better.
+The new keyboard hooking code properly grabs system hotkeys such as
+Win-* and Alt-TAB, in a way that Emacs can get at them before the
+system. This makes the `w32-register-hot-key' functionality work
+again on all versions of MS-Windows starting with Windows 7. On
+Windows NT and later you can now register any hotkey combination. (On
+Windows 9X, the previous limitations, spelled out in the Emacs manual,
+still apply.)
+
\f
* Installation Changes in Emacs 25.1
by default, and must be enabled by using the `--with-modules' option
at configure time.
++++
+** A second dir-local file (.dir-locals-2.el) is now accepted.
+See the variable `dir-locals-file-2' for more information.
+
+++
** Network security (TLS/SSL certificate validity and the like) is
added via the new Network Security Manager (NSM) and controlled via
the `network-security-level' variable.
+---
+** International domain names (IDNA) are now encoded via the new
+puny.el library, so that one can visit web sites like
+"http://méxico.icom.museum".
+
+++
** C-h l now also lists the commands that were run.
+** The new M-s M-w key binding uses eww to search the web for the
+text in the region.
+
+++
-** x-select-enable-clipboard is renamed select-enable-clipboard
-and x-select-enable-primary is renamed select-enable-primary.
+** The new `timer-list' command lists all active timers in a buffer
+where you can cancel them with the `c' command.
+
+** M-x suggests shorthands and ignores obsolete commands for completion.
+** x-select-enable-clipboard is renamed select-enable-clipboard.
+x-select-enable-primary and renamed select-enable-primary.
Additionally they both now apply to all systems (OSX, GNUstep, Windows, you
name it), with the proviso that on some systems (e.g. Windows)
select-enable-primary is ineffective since the system doesn't
** The option `even-window-heights' has been renamed to
`even-window-sizes' and now handles window widths as well.
++++
+** New function `read-multiple-choice' use to prompt for
+multiple-choice questions, with a handy way to display help texts.
+
+++
** terpri gets an optional arg ENSURE to conditionally output a newline.
hiding character but the default `.' can be used by let-binding the
variable `read-hide-char'.
-+++
-** The Emacs pseudo-random number generator can be securely seeded.
-On system where Emacs can access the system entropy or some other
-cryptographically secure random stream, it now uses that when `random'
-is called with its argument `t'. This allows cryptographically strong
-random values; in particular, the Emacs server now uses this facility
-to produce its authentication key.
-
---
** New input methods: `tamil-dvorak' and `programmer-dvorak'.
in favor of the global `M-s h' bindings introduced in Emacs-23.1.
They'll disappear soon.
++++
+** New bindings for 'query-replace-map'.
+`undo', undo the last replacement; bound to `u'.
+`undo-all', undo all replacements; bound to `U'.
+
\f
* Changes in Specialized Modes and Packages in Emacs 25.1
`erc-network-hide-list' and `erc-channel-hide-list' will only hide the
specified message types for the respective specified targets.
+*** New variable `erc-default-port-tls' used to connect to TLS IRC
+servers.
+
---
*** Reconnection is now asynchronous.
+++
*** `isearch' and `query-replace' can now perform character folding in matches.
- Isearch does that by default, while `query-replace' will do that if
- the new variable `replace-character-fold' is customized to a non-nil
- value. This is analogous to case folding, but instead of disregarding
- case variants, it disregards wider classes of distinctions between
- similar characters. (Case folding is a special case of character
- folding.) This means many characters in the search string will match
- entire groups of characters instead of just themselves.
-
- For instance, the " will match all variants of double quotes (like “
- and ”), and the letter a will match all of its accented cousins, even
- those composed of multiple characters, as well as many other symbols
- like ℀, ℁, ⒜, and ⓐ.
+ This is analogous to case folding, but instead of disregarding case
+ variants, it disregards wider classes of distinctions between similar
+ characters. (Case folding is a special case of character folding.)
+ This means many characters in the search string will match entire
+ groups of characters instead of just themselves.
+
+ For instance, the ASCII double quote character " will match all
+ variants of double quotes (like “ and ”), and the letter a will match
+ all of its accented cousins, even those composed of multiple
+ characters, as well as many other symbols like ℀, ℁, ⒜, and ⓐ.
Character folding is enabled by customizing `search-default-mode' to
- the value `character-fold-to-regexp'. If you want to turn character
- folding off, customize the value of `search-default-mode' to the `nil'
- value. You can also toggle character folding in the middle of a
- search by typing `M-s ''.
+ the value `character-fold-to-regexp'. You can also toggle character
+ folding in the middle of a search by typing `M-s ''.
+
+ `query-replace' honors character folding if the new variable
+ `replace-character-fold' is customized to a non-nil value.
+++
*** New user option `search-default-mode'.
This option specifies the default mode for Isearch. The default
- value, `character-fold-to-regexp' specifies that Isearch should fold
- characters when searching.
+ value, nil specifies that Isearch does literal searches (however,
+ `case-fold-search' and `isearch-lax-whitespace' may still be applied,
+ as in previous Emacs versions).
+++
*** New function `character-fold-to-regexp' can be used
whether to use variable-pitch fonts or not. The user can also
customize the `shr-use-fonts' variable.
++++
+*** A new command `C' (`eww-toggle-colors') can be used to toggle
+whether to use the HTML-specified colors or not. The user can also
+customize the `shr-use-colors' variable.
+
+++
*** A new command `R' (`eww-readable') will try do identify the main
textual parts of a web page and display only that, leaving menus and
*** A new command `D' (`eww-toggle-paragraph-direction') allows you to
toggle the paragraph direction between left-to-right and right-to-left.
+---
+*** Images that are being loaded are now marked with grey
+"placeholder" images of the size specified by the HTML. They are then
+replaced by the real images asynchronously, which will also now
+respect width/height HTML specs (unless they specify widths/heights
+bigger than the current window).
+
---
*** You can now use several eww buffers in parallel by renaming eww
buffers you want to keep separate.
*** text/html messages that contain inline image parts will be
transformed into multipart/related messages before sending.
+---
+*** The `message-valid-fqdn-regexp' variable has been removed, since
+there are now top-level domains added all the time. Message will no
+longer warn about sending emails to top-level domains it hasn't heard
+about.
+
+*** `message-beginning-of-line' (bound to C-a) understands folded headers.
+In `visual-line-mode' it will look for the true beginning of a header
+while in non-`visual-line-mode' it will move the point to the indented
+header’s value.
+
+++
** In Show Paren Mode, a parenthesis can be highlighted when point
stands inside it, and certain parens can be highlighted when point is
** If gpg2 exists on the system, it is now used as the default value
of `epg-gpg-program' (instead of gpg).
+** Images
+
++++
+*** Images are automatically scaled before displaying based on the
+`image-scaling-factor' variable (if Emacs supports scaling the images
+in question).
+
++++
+*** Images inserted with `insert-image' and related functions get a
+keymap put into the text properties (or overlays) that span the
+image. This keymap binds keystrokes for manipulating size and
+rotation, as well as saving the image to a file. These commands are
+also available in `image-mode'.
+
++++
+*** A new library for creating and manipulating SVG images has been
+added. See the "SVG Images" section in the lispref manual for
+details.
+
++++
+*** New setf-able function to access and set image parameters is
+provided: `image-property'.
+
+
** Lisp mode
---
---
** New js.el option `js-indent-first-init'.
+It was renamed from `js-indent-first-initialiser', to avoid issues
+with American vs British spelling.
** Info
plist will contain a :peer element that has the output of
`gnutls-peer-status' (if Emacs is built with GnuTLS support).
++++
+*** The new function `url-cookie-delete-cookie' can be used to
+programmatically delete all cookies, or cookies from a specific
+domain.
+
** Tramp
+++
outside Emacs (e.g., from the shell prompt), or if you switch the VC
back-end for the buffer's file, or remove it from version control.
+---
+*** The VC state indicator in the mode line now defaults to more
+colorful faces to make it more obvious to the user what the state is.
+See the `vc-faces' customization group.
+
+++
*** New option `vc-annotate-background-mode' controls whether
the color range from `vc-annotate-color-map' is applied to the
`dired-compress-files-alist' variable.
+++
+*** In wdired, when editing files to contain slash characters,
+the resulting directories are automatically created. Whether
+to do this or not is controlled by the
+`wdired-create-parent-directories' variable.
+
++++
+*** `W' is now bound to `browse-url-of-dired-file', and is useful for
+viewing HTML files and the like.
+
*** New user interface for the `A' and `Q' commands.
These keys, now bound to `dired-do-find-regexp' and
`dired-do-find-regexp-and-replace', work similarly to `xref-find-apropos'
Removed font-lock-beginning-of-syntax-function and the SYNTAX-BEGIN
slot in font-lock-defaults.
-+++
-** The new implementation of Subword mode affects word movement everywhere.
-When Subword mode is turned on, `forward-word', `backward-word', and
-everything that uses them will move by sub-words, effectively
-overriding the buffer's syntax table. Lisp programs that shouldn't be
-affected by Subword mode should call the new functions
-`forward-word-strictly' and `backward-word-strictly' instead.
-
+++
** `package-initialize' now sets `package-enable-at-startup' to nil if
called during startup. Users who call this function in their init
** Comint, term, and compile do not set the EMACS env var any more.
Use the INSIDE_EMACS environment variable instead.
+** `C-up', `C-down', `C-left' and `C-right' are now defined in term
+mode to send the same escape sequences that xterm does. This makes
+things like forward-word in readline work.
+
+---
+** hideshow mode got four key bindings that are analogous to outline
+mode bindings: `C-c @ C-a', `C-c @ C-t', `C-c @ C-d', and `C-c @ C-e.'
+
+++
** `save-excursion' does not save&restore the mark any more.
Use `save-mark-and-excursion' if you want the old behavior.
dynamically. Any third-party code that changes these templates should
be updated accordingly.
+** The grep/rgrep/lgrep functions will now ask about saving files
+before running. This is controlled by the `grep-save-buffers'
+variable.
+
+++
** ‘(/ N)’ is now equivalent to ‘(/ 1 N)’ rather than to ‘(/ N 1)’.
The new behavior is compatible with Common Lisp and with XEmacs.
It should be placed right where the docstring would be, and FORM is then
evaluated (and should return a string) when the closure is built.
+---
+** The new command `fortune-message' has been added, which displays
+fortunes in the echo area.
+
+++
** define-inline provides a new way to define inlinable functions.
systems and for MS-Windows, for other systems they fall back to their
counterparts `string-lessp' and `string-equal'.
++++
+** The new function `string-version-lessp' compares strings by
+interpreting consecutive runs of numerical characters as numbers, and
+compares their numerical values. According to this predicate,
+"foo2.png" is smaller than "foo12.png".
+
---
*** The ls-lisp package uses `string-collate-lessp' to sort file names.
The effect is that, on systems that use ls-lisp for Dired, the default
** New possible value for `system-type': `nacl'.
This is used by Google's Native Client (NaCl).
+---
+** `read-color' will now display the color names using the color itself
+as the background color.
+
+---
+** There is now a new variable `flyspell-sort-corrections-function'
+that allows changing the way corrections are sorted.
+
** Miscellaneous name change
---
+++
*** etags no longer qualifies class members by default.
- By default, `etags' will not qualify class members for C-like
+ By default, `etags' will not qualify class members for Perl and C-like
object-oriented languages with their class names and namespaces, and
will remove qualifications used explicitly in the code from the tag
names it puts in TAGS files. This is so the etags.el back-end for
positives.
Use --class-qualify (-Q) if you want the old default behavior of
- qualifying class members in C++, Java, and Objective C. Note that
- using -Q might make some class members become "unknown" to `M-.'
+ qualifying class members in C++, Java, Objective C, and Perl. Note
+ that using -Q might make some class members become "unknown" to `M-.'
(`xref-find-definitions'); if so, you can use `C-u M-.' to specify the
qualified names by hand.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
static const char Objc_help [] =
"In Objective C code, tags include Objective C definitions for classes,\n\
class categories, methods and protocols. Tags for variables and\n\
- functions in classes are named 'CLASS::VARIABLE' and 'CLASS::FUNCTION'.\n\
- (Use --help --lang=c --lang=objc --lang=java for full help.)";
+ functions in classes are named 'CLASS::VARIABLE' and 'CLASS::FUNCTION'.\
+ \n(Use --help --lang=c --lang=objc --lang=java for full help.)";
static const char *Pascal_suffixes [] =
{ "p", "pas", NULL };
Do not create tag entries for global variables in some\n\
languages. This makes the tags file smaller.");
- puts ("--no-line-directive\n\
+ if (PRINT_UNDOCUMENTED_OPTIONS_HELP)
+ puts ("--no-line-directive\n\
Ignore #line preprocessor directives in C and derived languages.");
if (CTAGS)
in some languages.");
puts ("-Q, --class-qualify\n\
- Qualify tag names with their class name in C++, ObjC, and Java.\n\
+ Qualify tag names with their class name in C++, ObjC, Java, and Perl.\n\
This produces tag names of the form \"class::member\" for C++,\n\
\"class(category)\" for Objective C, and \"class.member\" for Java.\n\
For Objective C, this also produces class methods qualified with\n\
- their arguments, as in \"foo:bar:baz:more\".");
+ their arguments, as in \"foo:bar:baz:more\".\n\
+ For Perl, this produces \"package::member\".");
puts ("-r REGEXP, --regex=REGEXP or --regex=@regexfile\n\
Make a tag for each line matching a regular expression pattern\n\
in the following files. {LANGUAGE}REGEXP uses REGEXP for LANGUAGE\n\
continue; /* nothing found */
pos = strchr (sp, ':');
if (pos && pos < cp && pos[1] == ':')
- /* The name is already qualified. */
- make_tag (sp, cp - sp, true,
- lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
- else
+ {
+ /* The name is already qualified. */
+ if (!class_qualify)
+ {
+ char *q = pos + 2, *qpos;
+ while ((qpos = strchr (q, ':')) != NULL
+ && qpos < cp
+ && qpos[1] == ':')
+ q = qpos + 2;
+ sp = q;
+ }
+ make_tag (sp, cp - sp, true,
+ lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+ }
+ else if (class_qualify)
/* Qualify it. */
{
char savechar, *name;
lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
free (name);
}
+ else
+ make_tag (sp, cp - sp, true,
+ lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
}
else if (LOOKING_AT (cp, "use constant")
|| LOOKING_AT (cp, "use constant::defer"))
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <sys/types.h>
#ifdef WINDOWSNT
#include "ntlib.h"
-#include <winsock.h>
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0501 /* for getaddrinfo stuff */
+#include <winsock2.h>
+#include <ws2tcpip.h>
+#undef getaddrinfo
+#define getaddrinfo sys_getaddrinfo
+#undef freeaddrinfo
+#define freeaddrinfo sys_freeaddrinfo
+int sys_getaddrinfo (const char * node, const char * service,
+ const struct addrinfo * hints, struct addrinfo ** res);
+void sys_freeaddrinfo (struct addrinfo * ai);
#undef SOCKET_ERROR
#define RECV(s,buf,len,flags) recv (s,buf,len,flags)
#define SEND(s,buf,len,flags) send (s,buf,len,flags)
#endif /* ! KERBEROS5 */
#endif /* KERBEROS */
-#ifndef WINDOWSNT
-#ifndef HAVE_H_ERRNO
-extern int h_errno;
-#endif
-#endif
-
static int socket_connection (char *, int);
static int pop_getline (popserver, char **);
static int sendline (popserver, const char *);
static int
socket_connection (char *host, int flags)
{
-#ifdef HAVE_GETADDRINFO
struct addrinfo *res, *it;
struct addrinfo hints;
int ret;
-#else /* !HAVE_GETADDRINFO */
- struct hostent *hostent;
-#endif
struct servent *servent;
struct sockaddr_in addr;
char found_port = 0;
}
-#ifdef HAVE_GETADDRINFO
memset (&hints, 0, sizeof (hints));
hints.ai_socktype = SOCK_STREAM;
hints.ai_flags = AI_CANONNAME;
}
freeaddrinfo (res);
-#else /* !HAVE_GETADDRINFO */
- do
- {
- hostent = gethostbyname (host);
- try_count++;
- if ((! hostent) && ((h_errno != TRY_AGAIN) || (try_count == 5)))
- {
- strcpy (pop_error, "Could not determine POP server's address");
- return (-1);
- }
- } while (! hostent);
-
- while (*hostent->h_addr_list)
- {
- memcpy (&addr.sin_addr, *hostent->h_addr_list, hostent->h_length);
- if (! connect (sock, (struct sockaddr *) &addr, sizeof (addr)))
- break;
- hostent->h_addr_list++;
- }
- connect_ok = *hostent->h_addr_list != NULL;
- if (! connect_ok)
- {
- realhost = alloca (strlen (hostent->h_name) + 1);
- strcpy (realhost, hostent->h_name);
- }
-
-#endif /* !HAVE_GETADDRINFO */
-
#define CONNECT_ERROR "Could not connect to POP server: "
if (! connect_ok)
return (0);
}
+#ifdef WINDOWSNT
+/* The following 2 functions are only available since XP, so we load
+ them dynamically and provide fallbacks. */
+
+int (WINAPI *pfn_getaddrinfo) (const char *, const char *,
+ const struct addrinfo *, struct addrinfo **);
+void (WINAPI *pfn_freeaddrinfo) (struct addrinfo *);
+
+static int
+load_ws2 (void)
+{
+ static int ws2_loaded = 0;
+
+ if (!ws2_loaded)
+ {
+ HANDLE ws2_lib = LoadLibrary ("Ws2_32.dll");
+
+ if (ws2_lib != NULL)
+ {
+ ws2_loaded = 1;
+ pfn_getaddrinfo = (void *) GetProcAddress (ws2_lib, "getaddrinfo");
+ pfn_freeaddrinfo = (void *) GetProcAddress (ws2_lib, "freeaddrinfo");
+ /* Paranoia: these two functions should go together, so if
+ one is absent, we cannot use the other. */
+ if (pfn_getaddrinfo == NULL)
+ pfn_freeaddrinfo = NULL;
+ else if (pfn_freeaddrinfo == NULL)
+ pfn_getaddrinfo = NULL;
+ }
+ }
+ if (!ws2_loaded)
+ {
+ errno = ENETDOWN;
+ return -1;
+ }
+ return 0;
+}
+
+
+int
+sys_getaddrinfo (const char *node, const char *service,
+ const struct addrinfo *hints, struct addrinfo **res)
+{
+ int rc;
+
+ if (load_ws2 () != 0)
+ {
+ errno = ENETDOWN;
+ return WSANO_RECOVERY;
+ }
+
+ if (pfn_getaddrinfo)
+ rc = pfn_getaddrinfo (node, service, hints, res);
+ else
+ {
+ int port = 0;
+ struct hostent *host_info;
+ struct gai_storage {
+ struct addrinfo addrinfo;
+ struct sockaddr_in sockaddr_in;
+ } *gai_storage;
+
+ /* We don't support any flags besides AI_CANONNAME. */
+ if (hints && (hints->ai_flags & ~(AI_CANONNAME)) != 0)
+ return WSAEINVAL;
+ /* NODE cannot be NULL, since pop.c has fallbacks for that. */
+ if (!node)
+ return WSAHOST_NOT_FOUND;
+
+ if (service)
+ {
+ const char *protocol =
+ (hints && hints->ai_socktype == SOCK_DGRAM) ? "udp" : "tcp";
+ struct servent *srv = getservbyname (service, protocol);
+
+ if (srv)
+ port = srv->s_port;
+ else
+ return WSAHOST_NOT_FOUND;
+ }
+
+ gai_storage = calloc (1, sizeof *gai_storage);
+ gai_storage->sockaddr_in.sin_port = port;
+ host_info = gethostbyname (node);
+ if (host_info)
+ {
+ memcpy (&gai_storage->sockaddr_in.sin_addr,
+ host_info->h_addr, host_info->h_length);
+ gai_storage->sockaddr_in.sin_family = host_info->h_addrtype;
+ }
+ else
+ {
+ free (gai_storage);
+ return WSAHOST_NOT_FOUND;
+ }
+
+ gai_storage->addrinfo.ai_addr =
+ (struct sockaddr *)&gai_storage->sockaddr_in;
+ gai_storage->addrinfo.ai_addrlen = sizeof (gai_storage->sockaddr_in);
+ if (hints && (hints->ai_flags & AI_CANONNAME) != 0)
+ {
+ gai_storage->addrinfo.ai_canonname = strdup (host_info->h_name);
+ if (!gai_storage->addrinfo.ai_canonname)
+ {
+ free (gai_storage);
+ return WSA_NOT_ENOUGH_MEMORY;
+ }
+ }
+ gai_storage->addrinfo.ai_protocol = (hints) ? hints->ai_protocol : 0;
+ gai_storage->addrinfo.ai_socktype = (hints) ? hints->ai_socktype : 0;
+ gai_storage->addrinfo.ai_family = gai_storage->sockaddr_in.sin_family;
+ gai_storage->addrinfo.ai_next = NULL;
+
+ *res = &gai_storage->addrinfo;
+ rc = 0;
+ }
+
+ return rc;
+}
+
+void
+sys_freeaddrinfo (struct addrinfo *ai)
+{
+ if (load_ws2 () != 0)
+ {
+ errno = ENETDOWN;
+ return;
+ }
+
+ if (pfn_freeaddrinfo)
+ pfn_freeaddrinfo (ai);
+ else
+ {
+ if (ai->ai_canonname)
+ free (ai->ai_canonname);
+ free (ai);
+ }
+}
+#endif /* WINDOWSNT */
#endif /* MAIL_USE_POP */
(defvar lisp-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
+(defconst lisp-prettify-symbols-alist '(("lambda" . ?λ))
+ "Alist of symbol/\"pretty\" characters to be displayed.")
;;;; Font-lock support.
;; Words inside \\[] tend to be for `substitute-command-keys'.
(,(concat "\\\\\\\\\\[\\(" lisp-mode-symbol-regexp "\\)\\]")
(1 font-lock-constant-face prepend))
- ;; Words inside ‘’ and '' and `' tend to be symbol names.
- (,(concat "['`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
+ ;; Words inside ‘’ and `' tend to be symbol names.
+ (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
lisp-mode-symbol-regexp "\\)['’]")
(1 font-lock-constant-face prepend))
;; Constant values.
;; Erroneous structures.
(,(concat "(" cl-errs-re "\\_>")
(1 font-lock-warning-face))
- ;; Words inside ‘’ and '' and `' tend to be symbol names.
- (,(concat "['`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
+ ;; Words inside ‘’ and `' tend to be symbol names.
+ (,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
lisp-mode-symbol-regexp "\\)['’]")
(1 font-lock-constant-face prepend))
;; Constant values.
(font-lock-extra-managed-props help-echo)
(font-lock-syntactic-face-function
. lisp-font-lock-syntactic-face-function)))
- (setq-local prettify-symbols-alist lisp--prettify-symbols-alist)
+ (setq-local prettify-symbols-alist lisp-prettify-symbols-alist)
(setq-local electric-pair-skip-whitespace 'chomp)
(setq-local electric-pair-open-newline-between-pairs nil))
:type 'hook
:group 'lisp)
-(defconst lisp--prettify-symbols-alist
- '(("lambda" . ?λ)))
-
;;; Generic Lisp mode.
(defvar lisp-mode-map
(error
;; The file's content might be invalid (e.g. have a merge conflict), but
;; that shouldn't prevent the user from opening the file.
- (message ".dir-locals error: %s" (error-message-string err))
+ (message "%s error: %s" dir-locals-file (error-message-string err))
nil))))
(defun dir-locals-set-directory-class (directory class &optional mtime)
(defconst dir-locals-file ".dir-locals.el"
"File that contains directory-local variables.
-It has to be constant to enforce uniform values
-across different environments and users.")
+It has to be constant to enforce uniform values across different
+environments and users.
+See also `dir-locals-file-2', whose values override this one's.
+See Info node `(elisp)Directory Local Variables' for details.")
+
+(defconst dir-locals-file-2 ".dir-locals-2.el"
+ "File that contains directory-local variables.
+This essentially a second file that can be used like
+`dir-locals-file', so that users can have specify their personal
+dir-local variables even if the current directory already has a
+`dir-locals-file' that is shared with other users (such as in a
+git repository).
+See Info node `(elisp)Directory Local Variables' for details.")
+
+(defun dir-locals--all-files (directory)
+ "Return a list of all readable dir-locals files in DIRECTORY.
+The returned list is sorted by increasing priority. That is,
+values specified in the last file should take precedence over
+those in the first."
+ (when (file-readable-p directory)
+ (let* ((file-1 (expand-file-name (if (eq system-type 'ms-dos)
+ (dosified-file-name dir-locals-file)
+ dir-locals-file)
+ directory))
+ (file-2 (when (string-match "\\.el\\'" file-1)
+ (replace-match "-2.el" t nil file-1)))
+ (out nil))
+ ;; The order here is important.
+ (dolist (f (list file-2 file-1))
+ (when (and f
+ (file-readable-p f)
+ (file-regular-p f)
+ (not (file-directory-p f)))
+ (push f out)))
+ out)))
(defun dir-locals-find-file (file)
"Find the directory-local variables for FILE.
time stored in the cache matches the current file modification time.
If not, the cache entry is cleared so that the file will be re-read.
-This function returns either nil (no directory local variables found),
-or the matching entry from `dir-locals-directory-cache' (a list),
-or the full path to the `dir-locals-file' (a string) in the case
-of no valid cache entry."
+This function returns either:
+ - nil (no directory local variables found),
+ - the matching entry from `dir-locals-directory-cache' (a list),
+ - or the full path to the directory (a string) containing at
+ least one `dir-locals-file' in the case of no valid cache
+ entry."
(setq file (expand-file-name file))
- (let* ((dir-locals-file-name
- (if (eq system-type 'ms-dos)
- (dosified-file-name dir-locals-file)
- dir-locals-file))
- (locals-file (locate-dominating-file file dir-locals-file-name))
- (dir-elt nil))
+ (let* ((locals-dir (locate-dominating-file (file-name-directory file)
+ #'dir-locals--all-files))
+ dir-elt)
;; `locate-dominating-file' may have abbreviated the name.
- (and locals-file
- (setq locals-file (expand-file-name dir-locals-file-name locals-file)))
- ;; Let dir-locals-read-from-file inform us via demoted-errors
- ;; about unreadable files, etc.
- ;; Maybe we'd want to keep searching though - that is
- ;; a locate-dominating-file issue.
-;;; (or (not (file-readable-p locals-file))
-;;; (not (file-regular-p locals-file)))
-;;; (setq locals-file nil))
+ (when locals-dir
+ (setq locals-dir (expand-file-name locals-dir)))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
(when (and (string-prefix-p (car elt) file
- (memq system-type
- '(windows-nt cygwin ms-dos)))
- (> (length (car elt)) (length (car dir-elt))))
- (setq dir-elt elt)))
+ (memq system-type
+ '(windows-nt cygwin ms-dos)))
+ (> (length (car elt)) (length (car dir-elt))))
+ (setq dir-elt elt)))
(if (and dir-elt
- (or (null locals-file)
- (<= (length (file-name-directory locals-file))
- (length (car dir-elt)))))
- ;; Found a potential cache entry. Check validity.
- ;; A cache entry with no MTIME is assumed to always be valid
- ;; (ie, set directly, not from a dir-locals file).
- ;; Note, we don't bother to check that there is a matching class
- ;; element in dir-locals-class-alist, since that's done by
- ;; dir-locals-set-directory-class.
- (if (or (null (nth 2 dir-elt))
- (let ((cached-file (expand-file-name dir-locals-file-name
- (car dir-elt))))
- (and (file-readable-p cached-file)
- (equal (nth 2 dir-elt)
- (nth 5 (file-attributes cached-file))))))
- ;; This cache entry is OK.
- dir-elt
- ;; This cache entry is invalid; clear it.
- (setq dir-locals-directory-cache
- (delq dir-elt dir-locals-directory-cache))
- ;; Return the first existing dir-locals file. Might be the same
- ;; as dir-elt's, might not (eg latter might have been deleted).
- locals-file)
+ (or (null locals-dir)
+ (<= (length locals-dir)
+ (length (car dir-elt)))))
+ ;; Found a potential cache entry. Check validity.
+ ;; A cache entry with no MTIME is assumed to always be valid
+ ;; (ie, set directly, not from a dir-locals file).
+ ;; Note, we don't bother to check that there is a matching class
+ ;; element in dir-locals-class-alist, since that's done by
+ ;; dir-locals-set-directory-class.
+ (if (or (null (nth 2 dir-elt))
+ (let ((cached-files (dir-locals--all-files (car dir-elt))))
+ ;; The entry MTIME should match the most recent
+ ;; MTIME among matching files.
+ (and cached-files
+ (= (time-to-seconds (nth 2 dir-elt))
+ (apply #'max (mapcar (lambda (f) (time-to-seconds (nth 5 (file-attributes f))))
+ cached-files))))))
+ ;; This cache entry is OK.
+ dir-elt
+ ;; This cache entry is invalid; clear it.
+ (setq dir-locals-directory-cache
+ (delq dir-elt dir-locals-directory-cache))
+ ;; Return the first existing dir-locals file. Might be the same
+ ;; as dir-elt's, might not (eg latter might have been deleted).
+ locals-dir)
;; No cache entry.
- locals-file)))
-
-(defun dir-locals-read-from-file (file)
- "Load a variables FILE and register a new class and instance.
-FILE is the name of the file holding the variables to apply.
-The new class name is the same as the directory in which FILE
-is found. Returns the new class name."
- (with-temp-buffer
+ locals-dir)))
+
+(defun dir-locals-read-from-dir (dir)
+ "Load all variables files in DIR and register a new class and instance.
+DIR is the absolute name of a directory which must contain at
+least one dir-local file (which is a file holding variables to
+apply).
+Return the new class name, which is a symbol named DIR."
+ (require 'map)
+ (let* ((class-name (intern dir))
+ (files (dir-locals--all-files dir))
+ (read-circle nil)
+ (success nil)
+ (variables))
(with-demoted-errors "Error reading dir-locals: %S"
- (insert-file-contents file)
- (unless (zerop (buffer-size))
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name)))))
+ (dolist (file files)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (condition-case-unless-debug nil
+ (setq variables
+ (map-merge-with 'list (lambda (a b) (map-merge 'list a b))
+ variables
+ (read (current-buffer))))
+ (end-of-file nil))))
+ (setq success t))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class
+ dir class-name
+ (seconds-to-time
+ (if success
+ (apply #'max (mapcar (lambda (file)
+ (time-to-seconds (nth 5 (file-attributes file))))
+ files))
+ ;; If there was a problem, use the values we could get but
+ ;; don't let the cache prevent future reads.
+ 0)))
+ class-name))
+
+(define-obsolete-function-alias 'dir-locals-read-from-file
+ 'dir-locals-read-from-dir "25.1")
(defcustom enable-remote-dir-locals nil
"Non-nil means dir-local variables will be applied to remote files."
(not (file-remote-p (or (buffer-file-name)
default-directory)))))
;; Find the variables file.
- (let ((variables-file (dir-locals-find-file
- (or (buffer-file-name) default-directory)))
+ (let ((dir-or-cache (dir-locals-find-file
+ (or (buffer-file-name) default-directory)))
(class nil)
(dir-name nil))
(cond
- ((stringp variables-file)
- (setq dir-name (file-name-directory variables-file)
- class (dir-locals-read-from-file variables-file)))
- ((consp variables-file)
- (setq dir-name (nth 0 variables-file))
- (setq class (nth 1 variables-file))))
+ ((stringp dir-or-cache)
+ (setq dir-name dir-or-cache
+ class (dir-locals-read-from-dir dir-or-cache)))
+ ((consp dir-or-cache)
+ (setq dir-name (nth 0 dir-or-cache))
+ (setq class (nth 1 dir-or-cache))))
(when class
(let ((variables
(dir-locals-collect-variables
(setq error-lines (nreverse error-lines))
;; Now read the numeric positions of file names.
(goto-char linebeg)
- (forward-word-strictly 1)
+ (forward-word 1)
(forward-char 3)
(while (< (point) end)
(let ((start (insert-directory-adj-pos
(cond ((= char ?r) #o0444)
((= char ?w) #o0222)
((= char ?x) #o0111)
- ((= char ?s) #o1000)
- ((= char ?t) #o6000)
+ ((= char ?s) #o6000)
+ ((= char ?t) #o1000)
;; Rights relative to the previous file modes.
((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((= char ?u) (let ((uright (logand #o4700 from)))
(mapcar 'file-modes-char-to-who
(match-string 1 modes)))))
(when (= num-who 0)
- (setq num-who (default-file-modes)))
+ (setq num-who (logior #o7000 (default-file-modes))))
(setq num-modes
(file-modes-rights-to-number (substring modes (match-end 1))
num-who num-modes)
(let ((delete-by-moving-to-trash nil))
(rename-file fn new-fn)))))))))
+(defsubst file-attribute-type (attributes)
+ "The type field in ATTRIBUTES returned by `file-attribute'.
+The value is either t for directory, string (name linked to) for
+symbolic link, or nil."
+ (nth 0 attributes))
+
+(defsubst file-attribute-link-number (attributes)
+ "Return the number of links in ATTRIBUTES returned by `file-attribute'."
+ (nth 1 attributes))
+
+(defsubst file-attribute-user-id (attributes)
+ "The UID field in ATTRIBUTES returned by `file-attribute'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 2 attributes))
+
+(defsubst file-attribute-group-id (attributes)
+ "The GID field in ATTRIBUTES returned by `file-attribute'.
+This is either a string or a number. If a string value cannot be
+looked up, a numeric value, either an integer or a float, is
+returned."
+ (nth 3 attributes))
+
+(defsubst file-attribute-access-time (attributes)
+ "The last access time in ATTRIBUTES returned by `file-attribute'.
+This a list of integers (HIGH LOW USEC PSEC) in the same style
+as (current-time)."
+ (nth 4 attributes))
+
+(defsubst file-attribute-modification-time (attributes)
+ "The modification time in ATTRIBUTES returned by `file-attribute'.
+This is the time of the last change to the file's contents, and
+is a list of integers (HIGH LOW USEC PSEC) in the same style
+as (current-time)."
+ (nth 5 attributes))
+
+(defsubst file-attribute-status-change-time (attributes)
+ "The status modification time in ATTRIBUTES returned by `file-attribute'.
+This is the time of last change to the file's attributes: owner
+and group, access mode bits, etc, and is a list of integers (HIGH
+LOW USEC PSEC) in the same style as (current-time)."
+ (nth 6 attributes))
+
+(defsubst file-attribute-size (attributes)
+ "The size (in bytes) in ATTRIBUTES returned by `file-attribute'.
+This is a floating point number if the size is too large for an integer."
+ (nth 7 attributes))
+
+(defsubst file-attribute-modes (attributes)
+ "The file modes in ATTRIBUTES returned by `file-attribute'.
+This is a string of ten letters or dashes as in ls -l."
+ (nth 8 attributes))
+
+(defsubst file-attribute-inode-number (attributes)
+ "The inode number in ATTRIBUTES returned by `file-attribute'.
+If it is larger than what an Emacs integer can hold, this is of
+the form (HIGH . LOW): first the high bits, then the low 16 bits.
+If even HIGH is too large for an Emacs integer, this is instead
+of the form (HIGH MIDDLE . LOW): first the high bits, then the
+middle 24 bits, and finally the low 16 bits."
+ (nth 10 attributes))
+
+(defsubst file-attribute-device-number (attributes)
+ "The file system device number in ATTRIBUTES returned by `file-attribute'.
+If it is larger than what an Emacs integer can hold, this is of
+the form (HIGH . LOW): first the high bits, then the low 16 bits.
+If even HIGH is too large for an Emacs integer, this is instead
+of the form (HIGH MIDDLE . LOW): first the high bits, then the
+middle 24 bits, and finally the low 16 bits."
+ (nth 11 attributes))
+
\f
(define-key ctl-x-map "\C-f" 'find-file)
(define-key ctl-x-map "\C-r" 'find-file-read-only)
(require 'mail-utils)
(require 'rfc2047)
+(require 'rmail-loaddefs)
+
(declare-function compilation--message->loc "compile" (cl-x) t)
(declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset))
(put 'rmail-spool-directory 'standard-value
'((cond ((file-exists-p "/var/mail") "/var/mail/")
((file-exists-p "/var/spool/mail") "/var/spool/mail/")
- ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+ ((memq system-type '(hpux usg-unix-v)) "/usr/mail/")
(t "/usr/spool/mail/"))))
;;;###autoload
"/var/mail/")
;; Many GNU/Linux systems use this name.
((file-exists-p "/var/spool/mail") "/var/spool/mail/")
- ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+ ((memq system-type '(hpux usg-unix-v)) "/usr/mail/")
(t "/usr/spool/mail/")))
"Name of directory used by system mailer for delivering new mail.
Its name should end with a slash."
(declare-function mail-dont-reply-to "mail-utils" (destinations))
(declare-function rmail-update-summary "rmailsum" (&rest ignore))
(declare-function rmail-mime-toggle-hidden "rmailmm" ())
+(declare-function rmail-mime-entity-truncated "rmailmm" (entity))
(defun rmail-probe (prog)
"Determine what flavor of movemail PROG is.
;; rmail-header-style based on the binding in effect when
;; this function is called; `rmail-toggle-headers' can
;; inspect this value to determine how to toggle.
- (set (make-local-variable 'rmail-header-style) header-style))
+ (set (make-local-variable 'rmail-header-style) header-style)
+ ;; In case viewing the previous message sets the paragraph
+ ;; direction non-nil, we reset it here to allow independent
+ ;; dynamic determination of paragraph direction in every
+ ;; message.
+ (setq bidi-paragraph-direction nil))
(if (and rmail-enable-mime
rmail-show-mime-function
(re-search-forward "mime-version: 1.0" nil t))
(set-syntax-table mail-abbrev-syntax-table)
(goto-char before)
(while (and (< (point) end)
- (progn (forward-word-strictly 1)
+ (progn (forward-word 1)
(<= (point) end)))
(expand-abbrev))
(set-syntax-table old-syntax-table))
;; There doesn't really seem to be an appropriate menu.
;; Eg the edit command is not in a menu either.
+(defvar rmail-mime-render-html-function) ; defcustom in rmailmm
(defun rmail-epa-decrypt ()
"Decrypt GnuPG or OpenPGP armors in current message."
(interactive)
(setq buffer-file-coding-system rmail-message-encoding))))
(add-hook 'after-save-hook 'rmail-after-save-hook)
-\f
-;;; Start of automatically extracted autoloads.
-\f
-;;;### (autoloads nil "rmailedit" "rmailedit.el" "03eb8c36b3c57d58eecedb9eeffa623e")
-;;; Generated autoloads from rmailedit.el
-
-(autoload 'rmail-edit-current-message "rmailedit" "\
-Edit the contents of this message.
-
-\(fn)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "rmailkwd" "rmailkwd.el" "4e1b251929961e2b9d3b126301d697d0")
-;;; Generated autoloads from rmailkwd.el
-
-(autoload 'rmail-add-label "rmailkwd" "\
-Add LABEL to labels associated with current RMAIL message.
-Completes (see `rmail-read-label') over known labels when reading.
-LABEL may be a symbol or string. Only one label is allowed.
-
-\(fn LABEL)" t nil)
-
-(autoload 'rmail-kill-label "rmailkwd" "\
-Remove LABEL from labels associated with current RMAIL message.
-Completes (see `rmail-read-label') over known labels when reading.
-LABEL may be a symbol or string. Only one label is allowed.
-
-\(fn LABEL)" t nil)
-
-(autoload 'rmail-read-label "rmailkwd" "\
-Read a label with completion, prompting with PROMPT.
-Completions are chosen from `rmail-label-obarray'. The default
-is `rmail-last-label', if that is non-nil. Updates `rmail-last-label'
-according to the choice made, and returns a symbol.
-
-\(fn PROMPT)" nil nil)
-
-(autoload 'rmail-previous-labeled-message "rmailkwd" "\
-Show previous message with one of the labels LABELS.
-LABELS should be a comma-separated list of label names.
-If LABELS is empty, the last set of labels specified is used.
-With prefix argument N moves backward N messages with these labels.
-
-\(fn N LABELS)" t nil)
-
-(autoload 'rmail-next-labeled-message "rmailkwd" "\
-Show next message with one of the labels LABELS.
-LABELS should be a comma-separated list of label names.
-If LABELS is empty, the last set of labels specified is used.
-With prefix argument N moves forward N messages with these labels.
-
-\(fn N LABELS)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "rmailmm" "rmailmm.el" "7ab6ab96dfdeeec6bc8f4620295b7119")
-;;; Generated autoloads from rmailmm.el
-
-(autoload 'rmail-mime "rmailmm" "\
-Toggle the display of a MIME message.
-
-The actual behavior depends on the value of `rmail-enable-mime'.
-
-If `rmail-enable-mime' is non-nil (the default), this command toggles
-the display of a MIME message between decoded presentation form and
-raw data. With optional prefix argument ARG, it toggles the display only
-of the MIME entity at point, if there is one. The optional argument
-STATE forces a particular display state, rather than toggling.
-`raw' forces raw mode, any other non-nil value forces decoded mode.
-
-If `rmail-enable-mime' is nil, this creates a temporary \"*RMAIL*\"
-buffer holding a decoded copy of the message. Inline content-types are
-handled according to `rmail-mime-media-type-handlers-alist'.
-By default, this displays text and multipart messages, and offers to
-download attachments as specified by `rmail-mime-attachment-dirs-alist'.
-The arguments ARG and STATE have no effect in this case.
-
-\(fn &optional ARG STATE)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "rmailmsc" "rmailmsc.el" "471c370ff9f183806c8d749961ec9d79")
-;;; Generated autoloads from rmailmsc.el
-
-(autoload 'set-rmail-inbox-list "rmailmsc" "\
-Set the inbox list of the current RMAIL file to FILE-NAME.
-You can specify one file name, or several names separated by commas.
-If FILE-NAME is empty, remove any existing inbox list.
-
-This applies only to the current session.
-
-\(fn FILE-NAME)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "rmailsort" "rmailsort.el" "2c8e39f7bae6fcc465a83ebccd46c8a4")
-;;; Generated autoloads from rmailsort.el
-
-(autoload 'rmail-sort-by-date "rmailsort" "\
-Sort messages of current Rmail buffer by \"Date\" header.
-If prefix argument REVERSE is non-nil, sorts in reverse order.
-
-\(fn REVERSE)" t nil)
-
-(autoload 'rmail-sort-by-subject "rmailsort" "\
-Sort messages of current Rmail buffer by \"Subject\" header.
-Ignores any \"Re: \" prefix. If prefix argument REVERSE is
-non-nil, sorts in reverse order.
-
-\(fn REVERSE)" t nil)
-
-(autoload 'rmail-sort-by-author "rmailsort" "\
-Sort messages of current Rmail buffer by author.
-This uses either the \"From\" or \"Sender\" header, downcased.
-If prefix argument REVERSE is non-nil, sorts in reverse order.
-
-\(fn REVERSE)" t nil)
-
-(autoload 'rmail-sort-by-recipient "rmailsort" "\
-Sort messages of current Rmail buffer by recipient.
-This uses either the \"To\" or \"Apparently-To\" header, downcased.
-If prefix argument REVERSE is non-nil, sorts in reverse order.
-
-\(fn REVERSE)" t nil)
-
-(autoload 'rmail-sort-by-correspondent "rmailsort" "\
-Sort messages of current Rmail buffer by other correspondent.
-This uses either the \"From\", \"Sender\", \"To\", or
-\"Apparently-To\" header, downcased. Uses the first header not
-excluded by `mail-dont-reply-to-names'. If prefix argument
-REVERSE is non-nil, sorts in reverse order.
-
-\(fn REVERSE)" t nil)
-
-(autoload 'rmail-sort-by-lines "rmailsort" "\
-Sort messages of current Rmail buffer by the number of lines.
-If prefix argument REVERSE is non-nil, sorts in reverse order.
-
-\(fn REVERSE)" t nil)
-
-(autoload 'rmail-sort-by-labels "rmailsort" "\
-Sort messages of current Rmail buffer by labels.
-LABELS is a comma-separated list of labels. The order of these
-labels specifies the order of messages: messages with the first
-label come first, messages with the second label come second, and
-so on. Messages that have none of these labels come last.
-If prefix argument REVERSE is non-nil, sorts in reverse order.
-
-\(fn REVERSE LABELS)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "rmailsum" "rmailsum.el" "8205e67c8188aa5c01715e79e10667c1")
-;;; Generated autoloads from rmailsum.el
-
-(autoload 'rmail-summary "rmailsum" "\
-Display a summary of all messages, one line per message.
-
-\(fn)" t nil)
-
-(autoload 'rmail-summary-by-labels "rmailsum" "\
-Display a summary of all messages with one or more LABELS.
-LABELS should be a string containing the desired labels, separated by commas.
-
-\(fn LABELS)" t nil)
-
-(autoload 'rmail-summary-by-recipients "rmailsum" "\
-Display a summary of all messages with the given RECIPIENTS.
-Normally checks the To, From and Cc fields of headers;
-but if PRIMARY-ONLY is non-nil (prefix arg given),
- only look in the To and From fields.
-RECIPIENTS is a regular expression.
-
-\(fn RECIPIENTS &optional PRIMARY-ONLY)" t nil)
-
-(autoload 'rmail-summary-by-regexp "rmailsum" "\
-Display a summary of all messages according to regexp REGEXP.
-If the regular expression is found in the header of the message
-\(including in the date and other lines, as well as the subject line),
-Emacs will list the message in the summary.
-
-\(fn REGEXP)" t nil)
-
-(autoload 'rmail-summary-by-topic "rmailsum" "\
-Display a summary of all messages with the given SUBJECT.
-Normally checks just the Subject field of headers; but with prefix
-argument WHOLE-MESSAGE is non-nil, looks in the whole message.
-SUBJECT is a regular expression.
-
-\(fn SUBJECT &optional WHOLE-MESSAGE)" t nil)
-
-(autoload 'rmail-summary-by-senders "rmailsum" "\
-Display a summary of all messages whose \"From\" field matches SENDERS.
-SENDERS is a regular expression.
-
-\(fn SENDERS)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "undigest" "undigest.el" "20561f083496eb113fa9e501902bfcc3")
-;;; Generated autoloads from undigest.el
-
-(autoload 'undigestify-rmail-message "undigest" "\
-Break up a digest message into its constituent messages.
-Leaves original message, deleted, before the undigestified messages.
-
-\(fn)" t nil)
-
-(autoload 'unforward-rmail-message "undigest" "\
-Extract a forwarded message from the containing message.
-This puts the forwarded message into a separate rmail message following
-the containing message. This command is only useful when messages are
-forwarded with `rmail-enable-mime-composing' set to nil.
-
-\(fn)" t nil)
-
-;;;***
-\f
-;;; End of automatically extracted autoloads.
-
(provide 'rmail)
determined. Otherwise, return nil."
(cl-assert (looking-at "\\_<function\\_>"))
(let ((name t))
- (forward-word-strictly)
+ (forward-word)
(forward-comment most-positive-fixnum)
(when (eq (char-after) ?*)
(forward-char)
(eq (char-after) ??))))
(not (and
(eq (char-after) ?*)
- (looking-at (concat "\\* *" js--name-re " *("))
+ ;; Generator method (possibly using computed property).
+ (looking-at (concat "\\* *\\(?:\\[\\|" js--name-re " *(\\)"))
(save-excursion
- (goto-char (1- (match-end 0)))
- (let (forward-sexp-function) (forward-sexp))
- (js--forward-syntactic-ws)
- (eq (char-after) ?{)))))))
+ (js--backward-syntactic-ws)
+ ;; We might misindent some expressions that would
+ ;; return NaN anyway. Shouldn't be a problem.
+ (memq (char-before) '(?, ?} ?{))))))))
(defun js--continued-expression-p ()
"Return non-nil if the current line continues an expression."
(defun ruby-smie--bosp ()
(save-excursion (skip-chars-backward " \t")
- (or (bolp) (memq (char-before) '(?\; ?=)))))
+ (or (and (bolp)
+ ;; Newline is escaped.
+ (not (eq (char-before (1- (point))) ?\\)))
+ (memq (char-before) '(?\; ?=)))))
(defun ruby-smie--implicit-semi-p ()
(save-excursion
(not (or (bolp)
(memq (char-before) '(?\[ ?\())
(and (memq (char-before)
- '(?\; ?- ?+ ?* ?/ ?: ?. ?, ?\\ ?& ?> ?< ?% ?~ ?^))
- ;; Not a binary operator symbol.
- (not (eq (char-before (1- (point))) ?:))
- ;; Not the end of a regexp or a percent literal.
- (not (memq (car (syntax-after (1- (point)))) '(7 15))))
- (and (eq (char-before) ?\?)
- (equal (save-excursion (ruby-smie--backward-token)) "?"))
- (and (eq (char-before) ?=)
- ;; Not a symbol :==, :!=, or a foo= method.
- (string-match "\\`\\s." (save-excursion
- (ruby-smie--backward-token))))
+ '(?\; ?- ?+ ?* ?/ ?: ?. ?, ?\\ ?& ?> ?< ?% ?~ ?^ ?= ??))
+ ;; Not a binary operator symbol like :+ or :[]=.
+ ;; Or a (method or symbol) name ending with ?.
+ ;; Or the end of a regexp or a percent literal.
+ (not (memq (car (syntax-after (1- (point)))) '(3 7 15))))
(and (eq (char-before) ?|)
(member (save-excursion (ruby-smie--backward-token))
'("|" "||")))
(defun ruby-smie--redundant-do-p (&optional skip)
(save-excursion
- (if skip (backward-word-strictly 1))
+ (if skip (backward-word 1))
(member (nth 2 (smie-backward-sexp ";")) '("while" "until" "for"))))
(defun ruby-smie--opening-pipe-p ()
"else" "elsif" "do" "end" "and")
'symbols))))
(memq (car (syntax-after pos)) '(7 15))
- (looking-at "[([]\\|[-+!~]\\sw\\|:\\(?:\\sw\\|\\s.\\)")))))
+ (looking-at "[([]\\|[-+!~:]\\(?:\\sw\\|\\s_\\)")))))
- (defun ruby-smie--at-dot-call ()
+ (defun ruby-smie--before-method-name ()
+ ;; Only need to be accurate when method has keyword name.
(and (eq ?w (char-syntax (following-char)))
- (eq (char-before) ?.)
- (not (eq (char-before (1- (point))) ?.))))
+ (or
+ (and
+ (eq (char-before) ?.)
+ (not (eq (char-before (1- (point))) ?.)))
+ (looking-back "^\\s *def\\s +\\=" (line-beginning-position)))))
(defun ruby-smie--forward-token ()
(let ((pos (point)))
(save-excursion
(ruby-smie--args-separator-p (prog1 (point) (goto-char pos)))))
" @ ")
- ((looking-at ":\\s.+")
- (goto-char (match-end 0)) (match-string 0)) ;bug#15208.
((looking-at "\\s\"") "") ;A string.
(t
- (let ((dot (ruby-smie--at-dot-call))
+ (let ((dot (ruby-smie--before-method-name))
(tok (smie-default-forward-token)))
(when dot
(setq tok (concat "." tok)))
(cond
((member tok '("unless" "if" "while" "until"))
- (if (save-excursion (forward-word-strictly -1) (ruby-smie--bosp))
+ (if (save-excursion (forward-word -1) (ruby-smie--bosp))
tok "iuwu-mod"))
((string-match-p "\\`|[*&]?\\'" tok)
(forward-char (- 1 (length tok)))
" @ ")
(t
(let ((tok (smie-default-backward-token))
- (dot (ruby-smie--at-dot-call)))
+ (dot (ruby-smie--before-method-name)))
(when dot
(setq tok (concat "." tok)))
- (when (and (eq ?: (char-before)) (string-match "\\`\\s." tok))
- (forward-char -1) (setq tok (concat ":" tok))) ;; bug#15208.
(cond
((member tok '("unless" "if" "while" "until"))
(if (ruby-smie--bosp)
((equal tok "do")
(cond
((not (ruby-smie--redundant-do-p)) tok)
- ((> (save-excursion (forward-word-strictly 1)
+ ((> (save-excursion (forward-word 1)
(forward-comment (point-max)) (point))
(line-end-position))
(ruby-smie--backward-token)) ;Fully redundant.
;; Align to the previous `when', but look up the virtual
;; indentation of `case'.
(if (smie-rule-sibling-p) 0 (smie-rule-parent)))
- (`(:after . ,(or "=" "iuwu-mod" "+" "-" "*" "/" "&&" "||" "%" "**" "^" "&"
+ (`(:after . ,(or "=" "+" "-" "*" "/" "&&" "||" "%" "**" "^" "&"
"<=>" ">" "<" ">=" "<=" "==" "===" "!=" "<<" ">>"
"+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^=" "|"
"<<=" ">>=" "&&=" "||=" "and" "or"))
(if (ruby-smie--indent-to-stmt-p token)
(ruby-smie--indent-to-stmt)
(cons 'column (current-column)))))
+ (`(:before . "iuwu-mod")
+ (smie-rule-parent ruby-indent-level))
))
(defun ruby--at-indentation-p (&optional point)
((and (eq c ?:) (or (not b) (eq (char-syntax b) ? ))))
((eq c ?\\) (eq b ??)))))
- (defun ruby-singleton-class-p (&optional pos)
+ (defun ruby-verify-heredoc (&optional pos)
(save-excursion
(when pos (goto-char pos))
- (forward-word -1)
- (and (or (bolp) (not (eq (char-before (point)) ?_)))
- (looking-at ruby-singleton-class-re))))
+ ;; Not right after a symbol or prefix character.
+ ;; Method names are only allowed when separated by
+ ;; whitespace. Not a limitation in Ruby, but it's hard for
+ ;; us to do better.
+ (when (not (memq (car (syntax-after (1- (point)))) '(2 3 6 10)))
+ (or (not (memq (char-before) '(?\s ?\t)))
- (ignore (forward-word-strictly -1))
++ (ignore (forward-word -1))
+ (eq (char-before) ?_)
+ (not (looking-at ruby-singleton-class-re))))))
(defun ruby-expr-beg (&optional option)
"Check if point is possibly at the beginning of an expression.
nil)
((looking-at ruby-operator-re))
((eq option 'heredoc)
- (and (< space 0) (not (ruby-singleton-class-p start))))
+ (and (< space 0) (ruby-verify-heredoc start)))
((or (looking-at "[\\[({,;]")
(and (looking-at "[!?]")
(or (not (eq option 'modifier))
((let ((s (ruby-parse-region (point) ruby-indent-point)))
(and (nth 2 s) (> (nth 2 s) 0)
(or (goto-char (cdr (nth 1 s))) t)))
- (forward-word-strictly -1)
+ (forward-word -1)
(setq indent (ruby-indent-size (current-column)
(nth 2 state))))
(t
(if (null (cdr (nth 1 state)))
(error "Invalid nesting"))
(goto-char (cdr (nth 1 state)))
- (forward-word-strictly -1) ; skip back a keyword
+ (forward-word -1) ; skip back a keyword
(setq begin (point))
(cond
((looking-at "do\\>[^_]") ; iter block is a special case
(forward-char -1)
(not (looking-at "{")))
(progn
- (forward-word-strictly -1)
+ (forward-word -1)
(not (looking-at "do\\>[^_]")))))
(t t))))
(not (eq ?, c))
(not (eq (char-before (point)) ?.))
(not (eq (char-before (point)) ?:)))
(ruby-end-of-block)
- (forward-word-strictly 1))
+ (forward-word 1))
((looking-at "\\(\\$\\|@@?\\)?\\sw")
(while (progn
- (while (progn (forward-word-strictly 1)
- (looking-at "_")))
+ (while (progn (forward-word 1) (looking-at "_")))
(cond ((looking-at "::") (forward-char 2) t)
((> (skip-chars-forward ".") 0))
((looking-at "\\?\\|!\\(=[~=>]\\|[^~=]\\)")
(skip-chars-forward "<"))
(not expr))))
(setq i (1- i)))
- ((error) (forward-word-strictly 1)))
+ ((error) (forward-word 1)))
i))))
(defun ruby-backward-sexp (&optional arg)
((looking-at "\\s(") nil)
(t
(forward-char 1)
- (while (progn (forward-word-strictly -1)
+ (while (progn (forward-word -1)
(pcase (char-before)
(`?_ t)
(`?. (forward-char -1) t)
(syntax-propertize-rules
;; $' $" $` .... are variables.
;; ?' ?" ?` are character literals (one-char strings in 1.9+).
- ("\\([?$]\\)[#\"'`]"
+ ("\\([?$]\\)[#\"'`:?]"
(1 (if (save-excursion
(nth 3 (syntax-ppss (match-beginning 0))))
;; Within a string, skip.
- (goto-char (match-end 1))
- (string-to-syntax "\\"))))
- ;; Part of symbol when at the end of a method name.
+ (ignore
+ (goto-char (match-end 1)))
+ (put-text-property (match-end 1) (match-end 0)
+ 'syntax-table (string-to-syntax "_"))
+ (string-to-syntax "'"))))
+ ;; Symbols with special characters.
+ ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\)\\)"
+ (3 (string-to-syntax "_")))
+ ;; Part of method name when at the end of it.
("[!?]"
(0 (unless (save-excursion
(or (nth 8 (syntax-ppss (match-beginning 0)))
- (eq (char-before) ?:)
(let (parse-sexp-lookup-properties)
(zerop (skip-syntax-backward "w_")))
(memq (preceding-char) '(?@ ?$))))
("^\\(=\\)begin\\_>" (1 "!"))
;; Handle here documents.
((concat ruby-here-doc-beg-re ".*\\(\n\\)")
- (7 (unless (or (nth 8 (save-excursion
- (syntax-ppss (match-beginning 0))))
- (ruby-singleton-class-p (match-beginning 0)))
+ (7 (when (and (not (nth 8 (save-excursion
+ (syntax-ppss (match-beginning 0)))))
+ (ruby-verify-heredoc (match-beginning 0)))
(put-text-property (match-beginning 7) (match-end 7)
'syntax-table (string-to-syntax "\""))
(ruby-syntax-propertize-heredoc end))))
;; Handle percent literals: %w(), %q{}, etc.
- ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re)
- (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end)))))
+ ((concat "\\(?:^\\|[[ \t\n<+(,=*]\\)" ruby-percent-literal-beg-re)
+ (1 (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 1))))
+ ;; Not inside a string, a comment, or a percent literal.
+ (ruby-syntax-propertize-percent-literal end)
+ (string-to-syntax "|")))))
(point) end)))
(define-obsolete-function-alias
(beginning-of-line)
(while (re-search-forward ruby-here-doc-beg-re
(line-end-position) t)
- (unless (ruby-singleton-class-p (match-beginning 0))
+ (when (ruby-verify-heredoc (match-beginning 0))
(push (concat (ruby-here-doc-end-match) "\n") res))))
(save-excursion
;; With multiple openers on the same line, we don't know in which
(defun ruby-syntax-propertize-percent-literal (limit)
(goto-char (match-beginning 2))
- ;; Not inside a simple string or comment.
- (when (eq t (nth 3 (syntax-ppss)))
- (let* ((op (char-after))
- (ops (char-to-string op))
- (cl (or (cdr (aref (syntax-table) op))
- (cdr (assoc op '((?< . ?>))))))
- parse-sexp-lookup-properties)
- (save-excursion
- (condition-case nil
- (progn
- (if cl ; Paired delimiters.
- ;; Delimiter pairs of the same kind can be nested
- ;; inside the literal, as long as they are balanced.
- ;; Create syntax table that ignores other characters.
- (with-syntax-table (make-char-table 'syntax-table nil)
- (modify-syntax-entry op (concat "(" (char-to-string cl)))
- (modify-syntax-entry cl (concat ")" ops))
- (modify-syntax-entry ?\\ "\\")
- (save-restriction
- (narrow-to-region (point) limit)
- (forward-list))) ; skip to the paired character
- ;; Single character delimiter.
- (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*"
- (regexp-quote ops)) limit nil))
- ;; Found the closing delimiter.
- (put-text-property (1- (point)) (point) 'syntax-table
- (string-to-syntax "|")))
- ;; Unclosed literal, do nothing.
- ((scan-error search-failed)))))))
+ (let* ((op (char-after))
+ (ops (char-to-string op))
+ (cl (or (cdr (aref (syntax-table) op))
+ (cdr (assoc op '((?< . ?>))))))
+ parse-sexp-lookup-properties)
+ (save-excursion
+ (condition-case nil
+ (progn
+ (if cl ; Paired delimiters.
+ ;; Delimiter pairs of the same kind can be nested
+ ;; inside the literal, as long as they are balanced.
+ ;; Create syntax table that ignores other characters.
+ (with-syntax-table (make-char-table 'syntax-table nil)
+ (modify-syntax-entry op (concat "(" (char-to-string cl)))
+ (modify-syntax-entry cl (concat ")" ops))
+ (modify-syntax-entry ?\\ "\\")
+ (save-restriction
+ (narrow-to-region (point) limit)
+ (forward-list))) ; skip to the paired character
+ ;; Single character delimiter.
+ (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*"
+ (regexp-quote ops)) limit nil))
+ ;; Found the closing delimiter.
+ (put-text-property (1- (point)) (point) 'syntax-table
+ (string-to-syntax "|")))
+ ;; Unclosed literal, do nothing.
+ ((scan-error search-failed))))))
(defun ruby-syntax-propertize-expansion ()
;; Save the match data to a text property, for font-locking later.
(1 font-lock-builtin-face))
;; Here-doc beginnings.
(,ruby-here-doc-beg-re
- (0 (unless (ruby-singleton-class-p (match-beginning 0))
+ (0 (when (ruby-verify-heredoc (match-beginning 0))
'font-lock-string-face)))
;; Perl-ish keywords.
"\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$"
;; Keywords that evaluate to certain values.
("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>"
(0 font-lock-builtin-face))
- ;; Symbols with symbol characters.
+ ;; Symbols.
("\\(^\\|[^:]\\)\\(:@?\\(?:\\w\\|_\\)+\\)\\([!?=]\\)?"
(2 font-lock-constant-face)
(3 (unless (and (eq (char-before (match-end 3)) ?=)
(eq (char-after (match-end 3)) ?>))
- ;; bug#18466
+ ;; bug#18644
font-lock-constant-face)
nil t))
- ;; Symbols with special characters.
- ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
- 2 font-lock-constant-face)
;; Special globals.
(,(concat "\\$\\(?:[:\"!@;,/\\._><\\$?~=*&`'+0-9]\\|-[0adFiIlpvw]\\|"
(regexp-opt '("LOAD_PATH" "LOADED_FEATURES" "PROGRAM_NAME"
1 font-lock-negation-char-face)
;; Character literals.
;; FIXME: Support longer escape sequences.
- ("\\_<\\?\\\\?\\S " 0 font-lock-string-face)
+ ("\\?\\\\?\\_<.\\_>" 0 font-lock-string-face)
;; Regexp options.
("\\(?:\\s|\\|/\\)\\([imxo]+\\)"
1 (when (save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
- (while (forward-word-strictly 1)
+ (while (forward-word 1)
(setq words (1+ words)))))
words))
((use-region-p)
"Execute string COMMAND in inferior shell; display output, if any.
With prefix argument, insert the COMMAND's output at point.
+ Interactively, prompt for COMMAND in the minibuffer.
+
If COMMAND ends in `&', execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode. You can also use
(defun process-menu-delete-process ()
"Kill process at point in a `list-processes' buffer."
(interactive)
- (delete-process (tabulated-list-get-id))
- (revert-buffer))
+ (let ((pos (point)))
+ (delete-process (tabulated-list-get-id))
+ (revert-buffer)
+ (goto-char (min pos (point-max)))
+ (if (eobp)
+ (forward-line -1)
+ (beginning-of-line))))
(defun list-processes--refresh ()
"Recompute the list of processes for the Process List buffer.
:version "24.3"
:group 'wdired)
+(defcustom wdired-create-parent-directories t
+ "If non-nil, create parent directories of destination files.
+If non-nil, when you rename a file to a destination path within a
+nonexistent directory, wdired will create any parent directories
+necessary. When nil, attempts to rename a file into a
+nonexistent directory will fail."
+ :version "25.2"
+ :type 'boolean
+ :group 'wdired)
+
(defvar wdired-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-s" 'wdired-finish-edit)
(put-text-property b-protection (point-max) 'read-only t))))
;; This code is a copy of some dired-get-filename lines.
- (defsubst wdired-normalize-filename (file)
- (setq file
- ;; FIXME: shouldn't we check for a `b' argument or somesuch before
- ;; doing such unquoting? --Stef
- (read (concat
- "\"" (replace-regexp-in-string
- "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
- "\"")))
+ (defsubst wdired-normalize-filename (file unquotep)
+ (when unquotep
+ (setq file
+ ;; FIXME: shouldn't we check for a `b' argument or somesuch before
+ ;; doing such unquoting? --Stef
+ (read (concat
+ "\"" (replace-regexp-in-string
+ "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
+ "\""))))
(and file buffer-file-coding-system
(not file-name-coding-system)
(not default-file-name-coding-system)
;; deletion.
(setq end (next-single-property-change beg 'end-name))
(setq file (buffer-substring-no-properties (1+ beg) end)))
- (and file (setq file (wdired-normalize-filename file))))
+ ;; Don't unquote the old name, it wasn't quoted in the first place
+ (and file (setq file (wdired-normalize-filename file (not old)))))
(if (or no-dir old)
file
(and file (> (length file) 0)
(require 'dired-aux)
(condition-case err
(let ((dired-backup-overwrite nil))
+ (and wdired-create-parent-directories
+ (wdired-create-parentdirs file-new))
(dired-rename-file file-ori file-new
overwrite))
(error
err)))))))))
errors))
+(defun wdired-create-parentdirs (file-new)
+ "Create parent directories for FILE-NEW if they don't exist."
+ (and (not (file-exists-p (file-name-directory file-new)))
+ (message "Creating directory for file %s" file-new)
+ (make-directory (file-name-directory file-new) t)))
(defun wdired-exit ()
"Exit wdired and return to dired mode.
(setq end (next-single-property-change beg 'end-link))
(setq target (buffer-substring-no-properties (1+ beg) end)))
(if move (goto-char (1- beg)))))
- (and target (wdired-normalize-filename target))))
+ (and target (wdired-normalize-filename target t))))
(declare-function make-symbolic-link "fileio.c")
(funcall command 1)
(setq arg (1- arg)))
(error
- (if (forward-word-strictly)
+ (if (forward-word)
;; Skip any non-word characters to avoid triggering a read-only
;; error which would cause skipping the next word characters too.
(skip-syntax-forward "^w")
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
supply the 2nd arg correctly, so don't use _setjmp directly in that
case. */
#undef HAVE__SETJMP
+
+/* Unlike MS and mingw.org, MinGW64 doesn't define gai_strerror as an
+ inline function in a system header file, and instead seems to
+ require to link against ws2_32.a. But we don't want to link with
+ -lws2_32, as that would make Emacs dependent on the respective DLL.
+ So MinGW64 is amply punished here by the following: */
+#undef HAVE_GAI_STRERROR
#endif
/* The following is needed for recovery from C stack overflows. */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#define accept sys_accept
#define recvfrom sys_recvfrom
#define sendto sys_sendto
+#define getaddrinfo sys_getaddrinfo
+#define freeaddrinfo sys_freeaddrinfo
int sys_socket(int af, int type, int protocol);
int sys_bind (int s, const struct sockaddr *addr, int namelen);
struct sockaddr *from, int * fromlen);
int sys_sendto (int s, const char * buf, int len, int flags,
const struct sockaddr *to, int tolen);
+int sys_getaddrinfo (const char * node, const char * service,
+ const struct addrinfo * hints, struct addrinfo ** res);
+void sys_freeaddrinfo (struct addrinfo * ai);
/* In addition to wrappers for the winsock functions, we also provide
an fcntl function, for setting sockets to non-blocking mode. */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
-
-#ifdef ENABLE_CHECKING
-#include <signal.h> /* For SIGABRT. */
-#endif
+#include <signal.h> /* For SIGABRT, SIGDANGER. */
#ifdef HAVE_PTHREAD
#include <pthread.h>
#include "dispextern.h"
#include "intervals.h"
#include "puresize.h"
+#include "sheap.h"
#include "systime.h"
#include "character.h"
#include "buffer.h"
#include "dosfns.h" /* For dos_memory_info. */
#endif
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
+#endif
+
#if (defined ENABLE_CHECKING \
&& defined HAVE_VALGRIND_VALGRIND_H \
&& !defined USE_VALGRIND)
#ifdef DOUG_LEA_MALLOC
-#include <malloc.h>
-
/* Specify maximum number of areas to mmap. It would be nice to use a
value that explicitly means "no limit". */
inside glibc's malloc. */
static void *malloc_state_ptr;
-/* Get and free this pointer; useful around unexec. */
-void
-alloc_unexec_pre (void)
-{
- malloc_state_ptr = malloc_get_state ();
-}
-void
-alloc_unexec_post (void)
-{
- free (malloc_state_ptr);
-}
-
/* Restore the dumped malloc state. Because malloc can be invoked
even before main (e.g. by the dynamic linker), the dumped malloc
state must be restored as early as possible using this special hook. */
}
}
+/* Declare the malloc initialization hook, which runs before 'main' starts.
+ EXTERNALLY_VISIBLE works around Bug#22522. */
# ifndef __MALLOC_HOOK_VOLATILE
# define __MALLOC_HOOK_VOLATILE
# endif
-voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook
+voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE
= malloc_initialize_hook;
#endif
+/* Allocator-related actions to do just before and after unexec. */
+
+void
+alloc_unexec_pre (void)
+{
+#ifdef DOUG_LEA_MALLOC
+ malloc_state_ptr = malloc_get_state ();
+#endif
+#ifdef HYBRID_MALLOC
+ bss_sbrk_did_unexec = true;
+#endif
+}
+
+void
+alloc_unexec_post (void)
+{
+#ifdef DOUG_LEA_MALLOC
+ free (malloc_state_ptr);
+#endif
+#ifdef HYBRID_MALLOC
+ bss_sbrk_did_unexec = false;
+#endif
+}
+
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
Malloc
************************************************************************/
+#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC)
+
/* Function malloc calls this if it finds we are near exhausting storage. */
void
pending_malloc_warning = str;
}
+#endif
/* Display an already-pending malloc warning. */
unexmacosx.c, so don't use it on Darwin. */
#if ! ADDRESS_SANITIZER && !defined DARWIN_OS
-# if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC
-# define USE_ALIGNED_ALLOC 1
-# ifndef HAVE_ALIGNED_ALLOC
-/* Defined in gmalloc.c. */
-void *aligned_alloc (size_t, size_t);
-# endif
-# elif defined HYBRID_MALLOC
-# if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
-# define USE_ALIGNED_ALLOC 1
-# define aligned_alloc hybrid_aligned_alloc
-/* Defined in gmalloc.c. */
-void *aligned_alloc (size_t, size_t);
-# endif
-# elif defined HAVE_ALIGNED_ALLOC
+# if (defined HAVE_ALIGNED_ALLOC \
+ || (defined HYBRID_MALLOC \
+ ? defined HAVE_POSIX_MEMALIGN \
+ : !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC))
# define USE_ALIGNED_ALLOC 1
-# elif defined HAVE_POSIX_MEMALIGN
+# elif !defined HYBRID_MALLOC && defined HAVE_POSIX_MEMALIGN
# define USE_ALIGNED_ALLOC 1
+# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */
static void *
aligned_alloc (size_t alignment, size_t size)
{
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
See also the function `vector'. */)
- (register Lisp_Object length, Lisp_Object init)
+ (Lisp_Object length, Lisp_Object init)
{
- Lisp_Object vector;
- register ptrdiff_t sizei;
- register ptrdiff_t i;
- register struct Lisp_Vector *p;
-
CHECK_NATNUM (length);
-
- p = allocate_vector (XFASTINT (length));
- sizei = XFASTINT (length);
- for (i = 0; i < sizei; i++)
+ struct Lisp_Vector *p = allocate_vector (XFASTINT (length));
+ for (ptrdiff_t i = 0; i < XFASTINT (length); i++)
p->contents[i] = init;
-
- XSETVECTOR (vector, p);
- return vector;
+ return make_lisp_ptr (p, Lisp_Vectorlike);
}
DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
usage: (vector &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i;
- register Lisp_Object val = make_uninit_vector (nargs);
- register struct Lisp_Vector *p = XVECTOR (val);
-
- for (i = 0; i < nargs; i++)
- p->contents[i] = args[i];
+ Lisp_Object val = make_uninit_vector (nargs);
+ struct Lisp_Vector *p = XVECTOR (val);
+ memcpy (p->contents, args, nargs * sizeof *args);
return val;
}
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- ptrdiff_t i;
- register Lisp_Object val = make_uninit_vector (nargs);
- register struct Lisp_Vector *p = XVECTOR (val);
+ Lisp_Object val = make_uninit_vector (nargs);
+ struct Lisp_Vector *p = XVECTOR (val);
/* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
just wasteful and other times plainly wrong (e.g. those free vars may want
to be setcar'd). */
- for (i = 0; i < nargs; i++)
- p->contents[i] = args[i];
+ memcpy (p->contents, args, nargs * sizeof *args);
make_byte_code (p);
XSETCOMPILED (val, p);
return val;
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
doc: /* Return a string that is the name of no existing buffer based on NAME.
If there is no live buffer named NAME, then return NAME.
Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
- (starting at 2) until an unused name is found, and then return that name.
+ \(starting at 2) until an unused name is found, and then return that name.
Optional second argument IGNORE specifies a name that is okay to use (if
it is in the sequence to be tried) even if a buffer with that name exists.
/* To select a nonfundamental mode,
select the buffer temporarily and then call the mode function. */
- record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ record_unwind_current_buffer ();
Fset_buffer (buffer);
call0 (function);
BEG and END may be integers or markers.
The fourth arg FRONT-ADVANCE, if non-nil, makes the marker
for the front of the overlay advance when text is inserted there
- (which means the text *is not* included in the overlay).
+ \(which means the text *is not* included in the overlay).
The fifth arg REAR-ADVANCE, if non-nil, makes the marker
for the rear of the overlay advance when text is inserted there
- (which means the text *is* included in the overlay). */)
+ \(which means the text *is* included in the overlay). */)
(Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
Lisp_Object front_advance, Lisp_Object rear_advance)
{
if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
Fset_buffer_multibyte (Qnil);
- pwd = get_current_dir_name ();
+ pwd = emacs_get_current_dir_name ();
if (!pwd)
{
doc: /* List of functions to call before each text change.
Two arguments are passed to each function: the positions of
the beginning and end of the range of old text to be changed.
- (For an insertion, the beginning and end are at the same place.)
+ \(For an insertion, the beginning and end are at the same place.)
No information is given about the length of the text after the change.
Buffer changes made while executing the `before-change-functions'
Three arguments are passed to each function: the positions of
the beginning and end of the range of changed text,
and the length in chars of the pre-change text replaced by that range.
- (For an insertion, the pre-change length is zero;
+ \(For an insertion, the pre-change length is zero;
for a deletion, that length is the number of chars deleted,
and the post-change beginning and end are at the same place.)
and VALUE is the old value.
An entry (apply FUN-NAME . ARGS) means undo the change with
- (apply FUN-NAME ARGS).
+ \(apply FUN-NAME ARGS).
An entry (apply DELTA BEG END FUN-NAME . ARGS) supports selective undo
in the active region. BEG and END is the range affected by this entry
doc: /* Non-nil means show a cursor in non-selected windows.
If nil, only shows a cursor in the selected window.
If t, displays a cursor related to the usual cursor type
- (a solid box becomes hollow, a bar becomes a narrower bar).
+ \(a solid box becomes hollow, a bar becomes a narrower bar).
You can also specify the cursor type as in the `cursor-type' variable.
Use Custom to set this variable and update the display. */);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
bool
setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
{
- int i;
-
if (! NILP (ccl_prog))
{
struct Lisp_Vector *vp;
}
}
ccl->ic = CCL_HEADER_MAIN;
- for (i = 0; i < 8; i++)
- ccl->reg[i] = 0;
+ memset (ccl->reg, 0, sizeof ccl->reg);
ccl->last_block = false;
ccl->status = 0;
ccl->stack_idx = 0;
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
/* Here, we just copy the parent's fast_map. It's not accurate,
but at least it works for quickly detecting which character
DOESN'T belong to this charset. */
- for (i = 0; i < 190; i++)
- charset.fast_map[i] = parent_charset->fast_map[i];
+ memcpy (charset.fast_map, parent_charset->fast_map,
+ sizeof charset.fast_map);
/* We also copy these for parents. */
charset.min_char = parent_charset->min_char;
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
else if (EQ (eol_type, Qdos))
{
ptrdiff_t n = 0;
+ ptrdiff_t pos = coding->dst_pos;
+ ptrdiff_t pos_byte = coding->dst_pos_byte;
+ ptrdiff_t pos_end = pos_byte + coding->produced - 1;
- if (NILP (coding->dst_object))
- {
- /* Start deleting '\r' from the tail to minimize the memory
- movement. */
- for (p = pend - 2; p >= pbeg; p--)
- if (*p == '\r')
- {
- memmove (p, p + 1, pend-- - p - 1);
- n++;
- }
- }
- else
- {
- ptrdiff_t pos = coding->dst_pos;
- ptrdiff_t pos_byte = coding->dst_pos_byte;
- ptrdiff_t pos_end = pos_byte + coding->produced - 1;
+ /* This assertion is here instead of code, now deleted, that
+ handled the NILP case, which no longer happens with the
+ current codebase. */
+ eassert (!NILP (coding->dst_object));
- while (pos_byte < pos_end)
+ while (pos_byte < pos_end)
+ {
+ p = BYTE_POS_ADDR (pos_byte);
+ if (*p == '\r' && p[1] == '\n')
{
- p = BYTE_POS_ADDR (pos_byte);
- if (*p == '\r' && p[1] == '\n')
- {
- del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0);
- n++;
- pos_end--;
- }
- pos++;
- if (coding->dst_multibyte)
- pos_byte += BYTES_BY_CHAR_HEAD (*p);
- else
- pos_byte++;
+ del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0);
+ n++;
+ pos_end--;
}
+ pos++;
+ if (coding->dst_multibyte)
+ pos_byte += BYTES_BY_CHAR_HEAD (*p);
+ else
+ pos_byte++;
}
coding->produced -= n;
coding->produced_char -= n;
doc: /* Choose a coding system for an operation based on the target name.
The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM).
DECODING-SYSTEM is the coding system to use for decoding
- (in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
+ \(in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
for encoding (in case OPERATION does encoding).
The first argument OPERATION specifies an I/O primitive:
Table of extra Latin codes in the range 128..159 (inclusive).
This is a vector of length 256.
If Nth element is non-nil, the existence of code N in a file
- (or output of subprocess) doesn't prevent it to be detected as
+ \(or output of subprocess) doesn't prevent it to be detected as
a coding system of ISO 2022 variant which has a flag
`accept-latin-extra-code' t (e.g. iso-latin-1) on reading a file
or reading output of a subprocess.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#ifdef emacs
#define malloc hybrid_malloc
#define realloc hybrid_realloc
+#define aligned_alloc hybrid_aligned_alloc
#define calloc hybrid_calloc
#define free hybrid_free
-#if defined HAVE_GET_CURRENT_DIR_NAME && !defined BROKEN_GET_CURRENT_DIR_NAME
-#define HYBRID_GET_CURRENT_DIR_NAME 1
-#define get_current_dir_name hybrid_get_current_dir_name
-#endif
#endif
#endif /* HYBRID_MALLOC */
#undef HAVE_RINT
#endif /* HPUX */
-#ifdef IRIX6_5
-#ifdef emacs
-char *_getpty();
-#endif
-#define INET6 /* Needed for struct sockaddr_in6. */
-#undef HAVE_GETADDRINFO /* IRIX has getaddrinfo but not struct addrinfo. */
-#endif /* IRIX6_5 */
-
#ifdef MSDOS
#ifndef __DJGPP__
You lose; /* Emacs for DOS must be compiled with DJGPP */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
default, but we plan to change that, so you should specify a non-nil value
for ID-FORMAT if you use the returned uid or gid.
+To access the elements returned, the following access functions are
+provided: `file-attribute-type', `file-attribute-link-number',
+`file-attribute-user-id', `file-attribute-group-id',
+`file-attribute-access-time', `file-attribute-modification-time',
+`file-attribute-status-change-time', `file-attribute-size',
+`file-attribute-modes', `file-attribute-inode-number', and
+`file-attribute-device-number'.
+
Elements of the attribute list are:
0. t for directory, string (name linked to) for symbolic link, or nil.
1. Number of links to file.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
int width = w->total_cols;
double d = max (0, margin);
d = min (width / 2 - 1, d);
- /* Since MARGIN is positive, we cannot possibly have less than
- one glyph for the marginal area. */
- return max (1, (int) ((double) total_glyphs / width * d));
+ return (int) ((double) total_glyphs / width * d);
}
return 0;
}
SECONDS may be a floating-point value, meaning that you can wait for a
fraction of a second. Optional second arg MILLISECONDS specifies an
additional wait period, in milliseconds; this is for backwards compatibility.
- (Not all operating systems support waiting for a fraction of a second.) */)
+ \(Not all operating systems support waiting for a fraction of a second.) */)
(Lisp_Object seconds, Lisp_Object milliseconds)
{
double duration = extract_float (seconds);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#endif
if (fd < 0)
{
+ if (errno == EMFILE || errno == ENFILE)
+ report_file_error ("Read error on documentation file", file);
+
SAFE_FREE ();
AUTO_STRING (cannot_open, "Cannot open doc string file \"");
AUTO_STRING (quote_nl, "\"\n");
Each substring of the form \\=\\{MAPVAR} is replaced by a summary of
the value of MAPVAR as a keymap. This summary is similar to the one
produced by `describe-bindings'. The summary ends in two newlines
- (used by the helper function `help-make-xrefs' to find the end of the
+ \(used by the helper function `help-make-xrefs' to find the end of the
summary).
Each substring of the form \\=\\<MAPVAR> specifies the use of MAPVAR
\<foo> just sets the keymap used for \[cmd]. */
else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
{
- struct buffer *oldbuf;
- ptrdiff_t start_idx;
+ {
/* This is for computing the SHADOWS arg for describe_map_tree. */
Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
- Lisp_Object earlier_maps;
ptrdiff_t count = SPECPDL_INDEX ();
strp += 2; /* skip \{ or \< */
start = strp;
- start_idx = start - SDATA (string);
+ ptrdiff_t start_idx = start - SDATA (string);
while ((strp - SDATA (string) < SBYTES (string))
&& *strp != '}' && *strp != '>')
}
/* Now switch to a temp buffer. */
- oldbuf = current_buffer;
+ struct buffer *oldbuf = current_buffer;
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
/* This is for an unusual case where some after-change
function uses 'format' or 'prin1' or something else that
{
/* Get the list of active keymaps that precede this one.
If this one's not active, get nil. */
- earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
+ Lisp_Object earlier_maps
+ = Fcdr (Fmemq (tem, Freverse (active_maps)));
describe_map_tree (tem, 1, Fnreverse (earlier_maps),
Qnil, 0, 1, 0, 0, 1);
}
Ferase_buffer ();
set_buffer_internal (oldbuf);
unbind_to (count, Qnil);
+ }
subst_string:
start = SDATA (tem);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
doc: /* Return the current time, as a float number of seconds since the epoch.
If SPECIFIED-TIME is given, it is the time to convert to float
instead of the current time. The argument should have the form
- (HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
+ \(HIGH LOW) or (HIGH LOW USEC) or (HIGH LOW USEC PSEC). Thus,
you can use times from `current-time' and from `file-attributes'.
SPECIFIED-TIME can also have the form (HIGH . LOW), but this is
considered obsolete.
NAME is a string giving the name of the time zone.
If SPECIFIED-TIME is given, the time zone offset is determined from it
instead of using the current time. The argument should have the form
- (HIGH LOW . IGNORED). Thus, you can use times obtained from
+ \(HIGH LOW . IGNORED). Thus, you can use times obtained from
`current-time' and from `file-attributes'. SPECIFIED-TIME can also
have the form (HIGH . LOW), but this is considered obsolete.
Optional second arg ZONE is omitted or nil for the local time zone, or
DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
doc: /* Execute BODY, saving and restoring current buffer's restrictions.
The buffer's restrictions make parts of the beginning and end invisible.
- (They are set up with `narrow-to-region' and eliminated with `widen'.)
+ \(They are set up with `narrow-to-region' and eliminated with `widen'.)
This special form, `save-restriction', saves the current buffer's restrictions
when it is entered, and restores them when it is exited.
So any `narrow-to-region' within BODY lasts only until the end of the form.
start2_addr = BYTE_POS_ADDR (start2_byte);
memcpy (temp, start1_addr, len1_byte);
memcpy (start1_addr, start2_addr, len2_byte);
- memcpy (start1_addr + len2_byte, start1_addr + len1_byte, len_mid);
+ memmove (start1_addr + len2_byte, start1_addr + len1_byte, len_mid);
memcpy (start1_addr + len2_byte + len_mid, temp, len1_byte);
SAFE_FREE ();
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
&& INTPTR_MAX == EMACS_INT_MAX)
};
+/* Function prototype for the module init function. */
+typedef int (*emacs_init_function) (struct emacs_runtime *);
+
+/* Function prototype for the module Lisp functions. */
+typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
+ emacs_value [], void *);
+
/* Function prototype for module user-pointer finalizers. These
should not throw C++ exceptions, so emacs-module.h declares the
corresponding interfaces with EMACS_NOEXCEPT. There is only C code
static void check_main_thread (void);
static void finalize_environment (struct emacs_env_private *);
static void initialize_environment (emacs_env *, struct emacs_env_private *priv);
-static void module_args_out_of_range (emacs_env *, Lisp_Object, Lisp_Object);
static void module_handle_signal (emacs_env *, Lisp_Object);
static void module_handle_throw (emacs_env *, Lisp_Object);
static void module_non_local_exit_signal_1 (emacs_env *, Lisp_Object, Lisp_Object);
static void module_non_local_exit_throw_1 (emacs_env *, Lisp_Object, Lisp_Object);
static void module_out_of_memory (emacs_env *);
static void module_reset_handlerlist (const int *);
-static void module_wrong_type (emacs_env *, Lisp_Object, Lisp_Object);
/* We used to return NULL when emacs_value was a different type from
Lisp_Object, but nowadays we just use Qnil instead. Although they
return error_retval; \
MODULE_HANDLE_NONLOCAL_EXIT (error_retval)
+static void
+CHECK_USER_PTR (Lisp_Object obj)
+{
+ CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj);
+}
+
/* Catch signals and throws only if the code can actually signal or
throw. If checking is enabled, abort if the current thread is not
the Emacs main thread. */
{
Lisp_Object value = HASH_VALUE (h, i);
EMACS_INT refcount = XFASTINT (value) + 1;
- if (refcount > MOST_POSITIVE_FIXNUM)
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
+ if (MOST_POSITIVE_FIXNUM < refcount)
+ xsignal0 (Qoverflow_error);
value = make_natnum (refcount);
set_hash_value_slot (h, i, value);
}
first arg, because that's what Ffuncall takes. */
Lisp_Object *newargs;
USE_SAFE_ALLOCA;
+ if (nargs == PTRDIFF_MAX)
+ xsignal0 (Qoverflow_error);
SAFE_ALLOCA_LISP (newargs, nargs + 1);
newargs[0] = value_to_lisp (fun);
for (ptrdiff_t i = 0; i < nargs; i++)
{
MODULE_FUNCTION_BEGIN (0);
Lisp_Object l = value_to_lisp (n);
- if (! INTEGERP (l))
- {
- module_wrong_type (env, Qintegerp, l);
- return 0;
- }
+ CHECK_NUMBER (l);
return XINT (l);
}
module_make_integer (emacs_env *env, intmax_t n)
{
MODULE_FUNCTION_BEGIN (module_nil);
- if (! (MOST_NEGATIVE_FIXNUM <= n && n <= MOST_POSITIVE_FIXNUM))
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
+ if (FIXNUM_OVERFLOW_P (n))
+ xsignal0 (Qoverflow_error);
return lisp_to_value (make_number (n));
}
{
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lisp = value_to_lisp (f);
- if (! FLOATP (lisp))
- {
- module_wrong_type (env, Qfloatp, lisp);
- return 0;
- }
+ CHECK_TYPE (FLOATP (lisp), Qfloatp, lisp);
return XFLOAT_DATA (lisp);
}
{
MODULE_FUNCTION_BEGIN (false);
Lisp_Object lisp_str = value_to_lisp (value);
- if (! STRINGP (lisp_str))
- {
- module_wrong_type (env, Qstringp, lisp_str);
- return false;
- }
+ CHECK_STRING (lisp_str);
Lisp_Object lisp_str_utf8 = ENCODE_UTF_8 (lisp_str);
ptrdiff_t raw_size = SBYTES (lisp_str_utf8);
- if (raw_size == PTRDIFF_MAX)
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return false;
- }
ptrdiff_t required_buf_size = raw_size + 1;
eassert (length != NULL);
if (*length < required_buf_size)
{
*length = required_buf_size;
- module_non_local_exit_signal_1 (env, Qargs_out_of_range, Qnil);
- return false;
+ xsignal0 (Qargs_out_of_range);
}
*length = required_buf_size;
module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
{
MODULE_FUNCTION_BEGIN (module_nil);
- if (length > STRING_BYTES_BOUND)
- {
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
Lisp_Object lstr = make_unibyte_string (str, length);
return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
}
{
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- {
- module_wrong_type (env, Quser_ptr, lisp);
- return NULL;
- }
+ CHECK_USER_PTR (lisp);
return XUSER_PTR (lisp)->p;
}
{
/* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
- check_main_thread ();
- if (module_non_local_exit_check (env) != emacs_funcall_exit_return)
- return;
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- module_wrong_type (env, Quser_ptr, lisp);
+ CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->p = ptr;
}
{
MODULE_FUNCTION_BEGIN (NULL);
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- {
- module_wrong_type (env, Quser_ptr, lisp);
- return NULL;
- }
+ CHECK_USER_PTR (lisp);
return XUSER_PTR (lisp)->finalizer;
}
/* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lisp = value_to_lisp (uptr);
- if (! USER_PTRP (lisp))
- module_wrong_type (env, Quser_ptr, lisp);
+ CHECK_USER_PTR (lisp);
XUSER_PTR (lisp)->finalizer = fin;
}
/* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lvec = value_to_lisp (vec);
- if (! VECTORP (lvec))
- {
- module_wrong_type (env, Qvectorp, lvec);
- return;
- }
- if (! (0 <= i && i < ASIZE (lvec)))
- {
- if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
- module_args_out_of_range (env, lvec, make_number (i));
- else
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return;
- }
+ CHECK_VECTOR (lvec);
+ CHECK_RANGED_INTEGER (make_number (i), 0, ASIZE (lvec) - 1);
ASET (lvec, i, value_to_lisp (val));
}
{
MODULE_FUNCTION_BEGIN (module_nil);
Lisp_Object lvec = value_to_lisp (vec);
- if (! VECTORP (lvec))
- {
- module_wrong_type (env, Qvectorp, lvec);
- return module_nil;
- }
- if (! (0 <= i && i < ASIZE (lvec)))
- {
- if (MOST_NEGATIVE_FIXNUM <= i && i <= MOST_POSITIVE_FIXNUM)
- module_args_out_of_range (env, lvec, make_number (i));
- else
- module_non_local_exit_signal_1 (env, Qoverflow_error, Qnil);
- return module_nil;
- }
+ CHECK_VECTOR (lvec);
+ CHECK_RANGED_INTEGER (make_number (i), 0, ASIZE (lvec) - 1);
return lisp_to_value (AREF (lvec, i));
}
/* FIXME: Return a sentinel value (e.g., -1) on error. */
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lvec = value_to_lisp (vec);
- if (! VECTORP (lvec))
- {
- module_wrong_type (env, Qvectorp, lvec);
- return 0;
- }
+ CHECK_VECTOR (lvec);
return ASIZE (lvec);
}
}
}
-/* Module version of `wrong_type_argument'. */
-static void
-module_wrong_type (emacs_env *env, Lisp_Object predicate, Lisp_Object value)
-{
- module_non_local_exit_signal_1 (env, Qwrong_type_argument,
- list2 (predicate, value));
-}
-
/* Signal an out-of-memory condition to the caller. */
static void
module_out_of_memory (emacs_env *env)
XCDR (Vmemory_signal_data));
}
-/* Signal arguments are out of range. */
-static void
-module_args_out_of_range (emacs_env *env, Lisp_Object a1, Lisp_Object a2)
-{
- module_non_local_exit_signal_1 (env, Qargs_out_of_range, list2 (a1, a2));
-}
-
\f
/* Value conversion. */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
BEWARE: Do not assume NULL is a valid value! */
typedef struct emacs_value_tag *emacs_value;
-enum emacs_arity { emacs_variadic_function = -2 };
+enum { emacs_variadic_function = -2 };
/* Struct passed to a module init function (emacs_module_init). */
struct emacs_runtime
};
-/* Function prototype for the module init function. */
-typedef int (*emacs_init_function) (struct emacs_runtime *ert);
-
-/* Function prototype for the module Lisp functions. */
-typedef emacs_value (*emacs_subr) (emacs_env *env, ptrdiff_t nargs,
- emacs_value args[], void *data);
-
/* Possible Emacs function call outcomes. */
enum emacs_funcall_exit
{
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include "composite.h"
#include "dispextern.h"
#include "regex.h"
+#include "sheap.h"
#include "syntax.h"
#include "sysselect.h"
#include "systime.h"
bool initialized;
/* Set to true if this instance of Emacs might dump. */
+#ifndef DOUG_LEA_MALLOC
+static
+#endif
bool might_dump;
#ifdef DARWIN_OS
extern void unexec_init_emacs_zone (void);
#endif
-extern void malloc_enable_thread (void);
-
/* If true, Emacs should not attempt to use a window-specific code,
but instead should use the virtual terminal under which it was started. */
bool inhibit_window_system;
/* True means remove site-lisp directories from load-path. */
bool no_site_lisp;
+/* True means put details like time stamps into builds. */
+bool build_details;
+
/* Name for the server started by the daemon.*/
static char *daemon_name;
--display, -d DISPLAY use X server DISPLAY\n\
",
"\
+--no-build-details do not add build details such as time stamps\n\
--no-desktop do not load a saved desktop\n\
--no-init-file, -q load neither ~/.emacs nor default.el\n\
--no-loadup, -nl do not load loadup.el into bare Emacs\n\
{
signal (sig, SIG_DFL);
- /* If fatal error occurs in code below, avoid infinite recursion. */
- if (! fatal_error_in_progress)
+ if (attempt_orderly_shutdown_on_fatal_signal)
{
- fatal_error_in_progress = 1;
+ /* If fatal error occurs in code below, avoid infinite recursion. */
+ if (! fatal_error_in_progress)
+ {
+ fatal_error_in_progress = 1;
- totally_unblock_input ();
- if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
- Fkill_emacs (make_number (sig));
+ totally_unblock_input ();
+ if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
+ Fkill_emacs (make_number (sig));
- shut_down_emacs (sig, Qnil);
- emacs_backtrace (backtrace_limit);
+ shut_down_emacs (sig, Qnil);
+ emacs_backtrace (backtrace_limit);
+ }
}
/* Signal the same code; this time it will really be fatal.
filename_from_ansi (ch_to_dir, newdir);
ch_to_dir = newdir;
#endif
- original_pwd = get_current_dir_name ();
+ original_pwd = emacs_get_current_dir_name ();
if (chdir (ch_to_dir) != 0)
{
fprintf (stderr, "%s: Can't chdir to %s: %s\n",
no_site_lisp
= argmatch (argv, argc, "-nsl", "--no-site-lisp", 11, NULL, &skip_args);
+ build_details = ! argmatch (argv, argc, "-no-build-details",
+ "--no-build-details", 7, NULL, &skip_args);
+
#ifdef HAVE_NS
ns_pool = ns_alloc_autorelease_pool ();
#ifdef NS_IMPL_GNUSTEP
{ "-help", "--help", 90, 0 },
{ "-nl", "--no-loadup", 70, 0 },
{ "-nsl", "--no-site-lisp", 65, 0 },
+ { "-no-build-details", "--no-build-details", 63, 0 },
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
{ "-display", 0, 60, 1 },
tem = Vpurify_flag;
Vpurify_flag = Qnil;
+#ifdef HYBRID_MALLOC
+ {
+ static char const fmt[] = "%d of %d static heap bytes used";
+ char buf[sizeof fmt + 2 * (INT_STRLEN_BOUND (int) - 2)];
+ int max_usage = max_bss_sbrk_ptr - bss_sbrk_buffer;
+ sprintf (buf, fmt, max_usage, STATIC_HEAP_SIZE);
+ /* Don't log messages, because at this point buffers cannot be created. */
+ message1_nolog (buf);
+ }
+#endif
+
fflush (stdout);
/* Tell malloc where start of impure now is. */
/* Also arrange for warnings when nearly out of space. */
`ms-dos' compiled as an MS-DOS application.
`windows-nt' compiled as a native W32 application.
`cygwin' compiled using the Cygwin library.
-Anything else (in Emacs 24.1, the possibilities are: aix, berkeley-unix,
-hpux, irix, usg-unix-v) indicates some sort of Unix system. */);
+Anything else (in Emacs 26, the possibilities are: aix, berkeley-unix,
+hpux, usg-unix-v) indicates some sort of Unix system. */);
Vsystem_type = intern_c_string (SYSTEM_TYPE);
/* See configure.ac for the possible SYSTEM_TYPEs. */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
When a handler handles an error, control returns to the `condition-case'
and it executes the handler's BODY...
with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
- (If VAR is nil, the handler can't access that information.)
+ \(If VAR is nil, the handler can't access that information.)
Then the value of the last BODY form is returned from the `condition-case'
expression.
}
-/* Dump an error message; called like vprintf. */
-void
-verror (const char *m, va_list ap)
+/* Format and return a string; called like vprintf. */
+Lisp_Object
+vformat_string (const char *m, va_list ap)
{
char buf[4000];
ptrdiff_t size = sizeof buf;
if (buffer != buf)
xfree (buffer);
- xsignal1 (Qerror, string);
+ return string;
+}
+
+/* Dump an error message; called like vprintf. */
+void
+verror (const char *m, va_list ap)
+{
+ xsignal1 (Qerror, vformat_string (m, ap));
}
function in order with arguments ARGS, stopping at the first
one that returns nil, and return nil. Otherwise (if all functions
return non-nil, or if there are no functions to call), return non-nil
- (do not rely on the precise return value in this case).
+ \(do not rely on the precise return value in this case).
Do not use `make-local-variable' to make a hook variable buffer-local.
Instead, use `add-hook' and specify t for the LOCAL argument.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
struct utmp ut, *utp;
if (filename)
- {
- /* On some versions of IRIX, opening a nonexistent file name
- is likely to crash in the utmp routines. */
- if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0)
- return;
-
- utmpname (filename);
- }
+ utmpname (filename);
setutent ();
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <config.h>
#include <unistd.h>
+#include <filevercmp.h>
#include <intprops.h>
#include <vla.h>
+#include <errno.h>
#include "lisp.h"
#include "character.h"
The arguments START1, END1, START2, and END2, if non-nil, are
positions specifying which parts of STR1 or STR2 to compare. In
string STR1, compare the part between START1 (inclusive) and END1
- (exclusive). If START1 is nil, it defaults to 0, the beginning of
+ \(exclusive). If START1 is nil, it defaults to 0, the beginning of
the string; if END1 is nil, it defaults to the length of the string.
Likewise, in string STR2, compare the part between START2 and END2.
Like in `substring', negative values are counted from the end.
return i1 < SCHARS (string2) ? Qt : Qnil;
}
+DEFUN ("string-version-lessp", Fstring_version_lessp,
+ Sstring_version_lessp, 2, 2, 0,
+ doc: /* Return non-nil if S1 is less than S2, as version strings.
+
+This function compares version strings S1 and S2:
+ 1) By prefix lexicographically.
+ 2) Then by version (similarly to version comparison of Debian's dpkg).
+ Leading zeros in version numbers are ignored.
+ 3) If both prefix and version are equal, compare as ordinary strings.
+
+For example, \"foo2.png\" compares less than \"foo12.png\".
+Case is significant.
+Symbols are also allowed; their print names are used instead. */)
+ (Lisp_Object string1, Lisp_Object string2)
+{
+ if (SYMBOLP (string1))
+ string1 = SYMBOL_NAME (string1);
+ if (SYMBOLP (string2))
+ string2 = SYMBOL_NAME (string2);
+ CHECK_STRING (string1);
+ CHECK_STRING (string2);
+
+ char *p1 = SSDATA (string1);
+ char *p2 = SSDATA (string2);
+ char *lim1 = p1 + SBYTES (string1);
+ char *lim2 = p2 + SBYTES (string2);
+ int cmp;
+
+ while ((cmp = filevercmp (p1, p2)) == 0)
+ {
+ /* If the strings are identical through their first null bytes,
+ skip past identical prefixes and try again. */
+ ptrdiff_t size = strlen (p1) + 1;
+ p1 += size;
+ p2 += size;
+ if (lim1 < p1)
+ return lim2 < p2 ? Qnil : Qt;
+ if (lim2 < p2)
+ return Qnil;
+ }
+
+ return cmp < 0 ? Qt : Qnil;
+}
+
DEFUN ("string-collate-lessp", Fstring_collate_lessp, Sstring_collate_lessp, 2, 4, 0,
doc: /* Return t if first arg string is less than second in collation order.
Symbols are also allowed; their print names are used instead.
locale settings. For example, punctuation and whitespace characters
might be considered less significant for sorting:
- (sort \\='("11" "12" "1 1" "1 2" "1.1" "1.2") \\='string-collate-lessp)
+ \(sort \\='("11" "12" "1 1" "1 2" "1.1" "1.2") \\='string-collate-lessp)
=> ("11" "1 1" "1.1" "12" "1 2" "1.2")
The optional argument LOCALE, a string, overrides the setting of your
the same meaning might be considered as equal, like different grave
accent Unicode characters:
- (string-collate-equalp (string ?\\uFF40) (string ?\\u1FEF))
+ \(string-collate-equalp (string ?\\uFF40) (string ?\\u1FEF))
=> t
The optional argument LOCALE, a string, overrides the setting of your
newly created string with no text properties. If STRING is multibyte
or entirely ASCII, it is returned unchanged. In particular, when
STRING is unibyte and entirely ASCII, the returned string is unibyte.
- (When the characters are all ASCII, Emacs primitives will treat the
+ \(When the characters are all ASCII, Emacs primitives will treat the
string the same way whether it is unibyte or multibyte.) */)
(Lisp_Object string)
{
DEFUN ("substring", Fsubstring, Ssubstring, 1, 3, 0,
doc: /* Return a new string whose contents are a substring of STRING.
The returned string consists of the characters between index FROM
- (inclusive) and index TO (exclusive) of STRING. FROM and TO are
+ \(inclusive) and index TO (exclusive) of STRING. FROM and TO are
zero-indexed: 0 means the first character of STRING. Negative values
are counted from the end of STRING. If TO is nil, the substring runs
to the end of STRING.
The STRING argument may also be a vector. In that case, the return
value is a new vector that contains the elements between index FROM
- (inclusive) and index TO (exclusive) of that vector argument.
+ \(inclusive) and index TO (exclusive) of that vector argument.
With one argument, just copy STRING (with properties, if any). */)
(Lisp_Object string, Lisp_Object from, Lisp_Object to)
(register Lisp_Object elt, Lisp_Object list)
{
register Lisp_Object tail;
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
if (!FLOATP (elt))
return Fmemq (elt, list);
- for (tail = list; CONSP (tail); tail = XCDR (tail))
+ for (tail = list; !NILP (tail); tail = XCDR (tail))
{
register Lisp_Object tem;
CHECK_LIST_CONS (tail, list);
{
Lisp_Object tail, prev;
- for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail))
+ for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail))
{
CHECK_LIST_CONS (tail, seq);
DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
doc: /* Extract a value from a property list.
PLIST is a property list, which is a list of the form
- (PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
+ \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
corresponding to the given PROP, or nil if PROP is not one of the
properties on the list. This function never signals an error. */)
(Lisp_Object plist, Lisp_Object prop)
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
doc: /* Change value in PLIST of PROP to VAL.
PLIST is a property list, which is a list of the form
- (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.
+ \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.
If PROP is already a property on the list, its value is set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (plist-put x prop val))' to be sure to use the new value.
DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
doc: /* Extract a value from a property list, comparing with `equal'.
PLIST is a property list, which is a list of the form
- (PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
+ \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
corresponding to the given PROP, or nil if PROP is not
one of the properties on the list. */)
(Lisp_Object plist, Lisp_Object prop)
DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'.
PLIST is a property list, which is a list of the form
- (PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects.
+ \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects.
If PROP is already a property on the list, its value is set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
doc: /* Return non-nil if PLIST has the property PROP.
PLIST is a property list, which is a list of the form
- (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol.
+ \(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol.
Unlike `plist-get', this allows you to distinguish between a missing
property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
defsubr (&Sstring_equal);
defsubr (&Scompare_strings);
defsubr (&Sstring_lessp);
+ defsubr (&Sstring_version_lessp);
defsubr (&Sstring_collate_lessp);
defsubr (&Sstring_collate_equalp);
defsubr (&Sappend);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
An element of a base fontset is a vector of FONT-DEFs which themselves
are vectors of the form [ FONT-SPEC ENCODING REPERTORY ].
- An element of a realized fontset is nil, t, 0, or a vector of this
- form:
+ An element of a realized fontset is nil, t, 0, or a cons that has
+ this from:
- [ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ]
+ (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
+
+ CHARSET_ORDERED_LIST_TICK is the same as charset_ordered_list_tick or -1.
+
+ FONT-GROUP is a vector of elements that have this form:
+
+ [ RFONT-DEF0 RFONT-DEF1 ... ]
Each RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
[ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
- RFONT-DEFn are automatically reordered by the current charset
- priority list.
+ RFONT-DEFn are automatically reordered considering the current
+ charset priority list, the current language environment, and
+ priorities determined by font-backends.
+
+ RFONT-DEFn may not be a vector in the following cases.
The value nil means that we have not yet generated the above vector
from the base of the fontset.
The value 0 means that no font is available for the corresponding
range of characters in this fontset, but may be available in the
- default fontset.
+ fallback font-group or in the default fontset.
A fontset has 8 extra slots.
if (! NILP (encoding))
{
+ /* This spec specifies an encoding by a charset set
+ name. Reflect the preference order of that charset
+ in the upper bits of SCORE. */
Lisp_Object tail;
for (tail = Vcharset_ordered_list;
}
else
{
+ /* This spec does not specify an encoding. If the spec
+ specifies a language, and the language is not for the
+ current language environment, make the score
+ larger. */
Lisp_Object lang = Ffont_get (font_spec, QClang);
if (! NILP (lang)
XSETCAR (font_group, make_number (low_tick_bits));
}
-/* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
- character C in FONTSET. If C is -1, return a fallback font-group.
- If C is not -1, the value may be Qt (FONTSET doesn't have a font
- for C even in the fallback group), or 0 (a font for C may be found
- only in the fallback group). */
+/* Return a font-group (actually a cons (CHARSET_ORDERED_LIST_TICK
+ . FONT-GROUP)) for character C or a fallback font-group in the
+ realized fontset FONTSET. The elements of FONT-GROUP are
+ RFONT-DEFs. The value may not be a cons. See the comment at the
+ head of this file for the detail of the return value. */
static Lisp_Object
fontset_get_font_group (Lisp_Object fontset, int c)
else
font_group = FONTSET_FALLBACK (fontset);
if (! NILP (font_group))
+ /* We have already realized FONT-DEFs of this font group for C or
+ for fallback (FONT_GROUP is a cons), or we have already found
+ that no appropriate font was found (FONT_GROUP is t or 0). */
return font_group;
base_fontset = FONTSET_BASE (fontset);
if (NILP (base_fontset))
+ /* Actually we never come here because FONTSET is a realized one,
+ and thus it should have a base. */
font_group = Qnil;
else if (c >= 0)
font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
else
font_group = FONTSET_FALLBACK (base_fontset);
+
+ /* FONT_GROUP not being a vector means that no fonts are specified
+ for C, or the fontset does not have fallback fonts. */
if (NILP (font_group))
{
font_group = make_number (0);
if (c >= 0)
+ /* Record that FONTSET does not specify fonts for C. As
+ there's a possibility that a font is found in a fallback
+ font group, we set 0 at the moment. */
char_table_set_range (fontset, from, to, font_group);
return font_group;
}
if (!VECTORP (font_group))
return font_group;
+
+ /* Now realize FONT-DEFs of this font group, and update the realized
+ fontset FONTSET. */
font_group = Fcopy_sequence (font_group);
for (i = 0; i < ASIZE (font_group); i++)
if (! NILP (AREF (font_group, i)))
}
/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
- character C. If no font is found, return Qnil if there's a
+ character C. If no font is found, return Qnil or 0 if there's a
possibility that the default fontset or the fallback font groups
have a proper font, and return Qt if not.
If a font is found but is not yet opened, open it (if FACE is not
NULL) or return Qnil (if FACE is NULL).
- ID is a charset-id that must be preferred, or -1 meaning no
+ CHARSET_ID is a charset-id that must be preferred, or -1 meaning no
preference.
If FALLBACK, search only fallback fonts. */
static Lisp_Object
-fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
- bool fallback)
+fontset_find_font (Lisp_Object fontset, int c, struct face *face,
+ int charset_id, bool fallback)
{
Lisp_Object vec, font_group;
int i, charset_matched = 0, found_index;
/* We have just created the font-group,
or the charset priorities were changed. */
reorder_font_vector (font_group, face->ascii_face->font);
- if (id >= 0)
- /* Find a spec matching with the charset ID to try at
+ if (charset_id >= 0)
+ /* Find a spec matching with CHARSET_ID to try it at
first. */
for (i = 0; i < ASIZE (vec); i++)
{
break;
repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
- if (XINT (repertory) == id)
+ if (XINT (repertory) == charset_id)
{
charset_matched = i;
break;
}
}
- /* Find the first available font in the vector of RFONT-DEF. */
+ /* Find the first available font in the vector of RFONT-DEF. If
+ CHARSET_MATCHED > 0, try the corresponding RFONT-DEF first, then
+ try the rest. */
for (i = 0; i < ASIZE (vec); i++)
{
Lisp_Object font_def;
{
if (charset_matched > 0)
{
- /* Try the element matching with the charset ID at first. */
+ /* Try the element matching with CHARSET_ID at first. */
found_index = charset_matched;
/* Make this negative so that we don't come here in the
next loop. */
charset_matched = - charset_matched;
/* We must try the first element in the next loop. */
- i--;
+ i = -1;
}
}
else if (i == - charset_matched)
if (NILP (font_object))
{
/* Something strange happened, perhaps because of a
- Font-backend problem. Too avoid crashing, record
+ Font-backend problem. To avoid crashing, record
that this spec is unusable. It may be better to find
another font of the same spec, but currently we don't
- have such an API. */
+ have such an API in font-backend. */
RFONT_DEF_SET_FACE (rfont_def, -1);
continue;
}
i = found_index;
}
+ /* Record that no font in this font group supports C. */
FONTSET_SET (fontset, make_number (c), make_number (0));
return Qnil;
}
+/* Return RFONT-DEF (vector) corresponding to the font for character
+ C. The value is not a vector if no font is found for C. */
+
static Lisp_Object
fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
{
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
|| new_pixel_height != old_pixel_height);
unblock_input ();
-
- run_window_configuration_change_hook (f);
}
/* Allocate basically initialized frame. */
`vertical-scroll-bars'.
The default value is \\='(tool-bar-lines) on Lucid, Motif and Windows
- (which means that adding/removing a tool bar does not change the frame
+ \(which means that adding/removing a tool bar does not change the frame
height), nil on all other window systems including GTK+ (which means
that changing any of the parameters listed above may change the size of
the frame), and t otherwise (which means the frame size never changes
in a more readable form. */);
frame_size_history = Qnil;
+ DEFVAR_BOOL ("tooltip-reuse-hidden-frame", tooltip_reuse_hidden_frame,
+ doc: /* Non-nil means reuse hidden tooltip frames.
+When this is nil, delete a tooltip frame when hiding the associated
+tooltip. When this is non-nil, make the tooltip frame invisible only,
+so it can be reused when the next tooltip is shown.
+
+Setting this to non-nil may drastically reduce the consing overhead
+incurred by creating new tooltip frames. However, a value of non-nil
+means also that intermittent changes of faces or `default-frame-alist'
+are not applied when showing a tooltip in a reused frame.
+
+This variable is effective only with the X toolkit (and there only when
+Gtk+ tooltips are not used) and on Windows. */);
+ tooltip_reuse_hidden_frame = false;
+
staticpro (&Vframe_list);
defsubr (&Sframep);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
cleared. */
bool_bf explicit_name : 1;
- /* True if size of some window on this frame has changed. */
- bool_bf window_sizes_changed : 1;
+ /* True if configuration of windows on this frame has changed since
+ last call of run_window_size_change_functions. */
+ bool_bf window_configuration_changed : 1;
/* True if the mouse has moved on this display device
since the last time we checked. */
are frozen on frame F. */
#define FRAME_WINDOWS_FROZEN(f) (f)->frozen_window_starts
-/* True if a size change has been requested for frame F
- but not yet really put into effect. This can be true temporarily
- when an X event comes in at a bad time. */
-#define FRAME_WINDOW_SIZES_CHANGED(f) (f)->window_sizes_changed
+/* True if the frame's window configuration has changed since last call
+ of run_window_size_change_functions. */
+#define FRAME_WINDOW_CONFIGURATION_CHANGED(f) \
+ (f)->window_configuration_changed
/* The minibuffer window of frame F, if it has one; otherwise nil. */
#define FRAME_MINIBUF_WINDOW(f) f->minibuffer_window
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
message ("gnutls.c: [%d] %s %d", level, string, extra);
}
+int
+gnutls_try_handshake (struct Lisp_Process *proc)
+{
+ gnutls_session_t state = proc->gnutls_state;
+ int ret;
+ bool non_blocking = proc->is_non_blocking_client;
+
+ if (proc->gnutls_complete_negotiation_p)
+ non_blocking = false;
+
+ if (non_blocking)
+ proc->gnutls_p = true;
+
+ do
+ {
+ ret = gnutls_handshake (state);
+ emacs_gnutls_handle_error (state, ret);
+ QUIT;
+ }
+ while (ret < 0
+ && gnutls_error_is_fatal (ret) == 0
+ && ! non_blocking);
+
+ proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
+
+ if (ret == GNUTLS_E_SUCCESS)
+ {
+ /* Here we're finally done. */
+ proc->gnutls_initstage = GNUTLS_STAGE_READY;
+ }
+ else
+ {
+ /* check_memory_full (gnutls_alert_send_appropriate (state, ret)); */
+ }
+ return ret;
+}
+
static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
{
gnutls_session_t state = proc->gnutls_state;
- int ret;
if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
return -1;
proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
}
- do
- {
- ret = gnutls_handshake (state);
- emacs_gnutls_handle_error (state, ret);
- QUIT;
- }
- while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
-
- proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
-
- if (ret == GNUTLS_E_SUCCESS)
- {
- /* Here we're finally done. */
- proc->gnutls_initstage = GNUTLS_STAGE_READY;
- }
- else
- {
- check_memory_full (gnutls_alert_send_appropriate (state, ret));
- }
- return ret;
+ return gnutls_try_handshake (proc);
}
ptrdiff_t
ssize_t rtnval;
gnutls_session_t state = proc->gnutls_state;
- int log_level = proc->gnutls_log_level;
-
if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
{
- /* If the handshake count is under the limit, try the handshake
- again and increment the handshake count. This count is kept
- per process (connection), not globally. */
- if (proc->gnutls_handshakes_tried < GNUTLS_EMACS_HANDSHAKES_LIMIT)
- {
- proc->gnutls_handshakes_tried++;
- emacs_gnutls_handshake (proc);
- GNUTLS_LOG2i (5, log_level, "Retried handshake",
- proc->gnutls_handshakes_tried);
- return -1;
- }
-
- GNUTLS_LOG (2, log_level, "Giving up on handshake; resetting retries");
- proc->gnutls_handshakes_tried = 0;
- return 0;
+ errno = EAGAIN;
+ return -1;
}
+
rtnval = gnutls_record_recv (state, buf, nbyte);
if (rtnval >= 0)
return rtnval;
CHECK_PROCESS (proc);
- if (XPROCESS (proc)->gnutls_p == 0)
+ if (! XPROCESS (proc)->gnutls_p)
return Qnil;
log_level = XPROCESS (proc)->gnutls_log_level;
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
}
- XPROCESS (proc)->gnutls_p = 0;
+ XPROCESS (proc)->gnutls_p = false;
return Qt;
}
+DEFUN ("gnutls-asynchronous-parameters", Fgnutls_asynchronous_parameters,
+ Sgnutls_asynchronous_parameters, 2, 2, 0,
+ doc: /* Mark this process as being a pre-init GnuTLS process.
+The second parameter is the list of parameters to feed to gnutls-boot
+to finish setting up the connection. */)
+ (Lisp_Object proc, Lisp_Object params)
+{
+ CHECK_PROCESS (proc);
+
+ XPROCESS (proc)->gnutls_boot_parameters = params;
+ return Qnil;
+}
+
DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
doc: /* Return the GnuTLS init stage of process PROC.
See also `gnutls-boot'. */)
attributes: const)
(Lisp_Object err)
{
- if (EQ (err, Qt)) return Qnil;
+ if (EQ (err, Qt)
+ || EQ (err, Qgnutls_e_again))
+ return Qnil;
return Qt;
}
CHECK_PROCESS (proc);
- if (GNUTLS_INITSTAGE (proc) < GNUTLS_STAGE_INIT)
+ if (GNUTLS_INITSTAGE (proc) != GNUTLS_STAGE_READY)
return Qnil;
/* Then collect any warnings already computed by the handshake. */
}
#endif
+static void ATTRIBUTE_FORMAT_PRINTF (2, 3)
+boot_error (struct Lisp_Process *p, const char *m, ...)
+{
+ va_list ap;
+ va_start (ap, m);
+ if (p->is_non_blocking_client)
+ pset_status (p, list2 (Qfailed, vformat_string (m, ap)));
+ else
+ verror (m, ap);
+}
+
+Lisp_Object
+gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
+{
+ int ret;
+ struct Lisp_Process *p = XPROCESS (proc);
+ gnutls_session_t state = p->gnutls_state;
+ unsigned int peer_verification;
+ Lisp_Object warnings;
+ int max_log_level = p->gnutls_log_level;
+ Lisp_Object hostname, verify_error;
+ bool verify_error_all = false;
+ char *c_hostname;
+
+ if (NILP (proplist))
+ proplist = Fcdr (Fplist_get (p->childp, QCtls_parameters));
+
+ verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error);
+ hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
+
+ if (EQ (verify_error, Qt))
+ verify_error_all = true;
+ else if (NILP (Flistp (verify_error)))
+ {
+ boot_error (p,
+ "gnutls-boot: invalid :verify_error parameter (not a list)");
+ return Qnil;
+ }
+
+ if (!STRINGP (hostname))
+ {
+ boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
+ return Qnil;
+ }
+ c_hostname = SSDATA (hostname);
+
+ /* Now verify the peer, following
+ http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+ The peer should present at least one certificate in the chain; do a
+ check of the certificate's hostname with
+ gnutls_x509_crt_check_hostname against :hostname. */
+
+ ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+ if (ret < GNUTLS_E_SUCCESS)
+ return gnutls_make_error (ret);
+
+ XPROCESS (proc)->gnutls_peer_verification = peer_verification;
+
+ warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings"));
+ if (!NILP (warnings))
+ {
+ for (Lisp_Object tail = warnings; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object warning = XCAR (tail);
+ Lisp_Object message = Fgnutls_peer_status_warning_describe (warning);
+ if (!NILP (message))
+ GNUTLS_LOG2 (1, max_log_level, "verification:", SSDATA (message));
+ }
+ }
+
+ if (peer_verification != 0)
+ {
+ if (verify_error_all
+ || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
+ {
+ emacs_gnutls_deinit (proc);
+ boot_error (p,
+ "Certificate validation failed %s, verification code %x",
+ c_hostname, peer_verification);
+ return Qnil;
+ }
+ else
+ {
+ GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+ c_hostname);
+ }
+ }
+
+ /* Up to here the process is the same for X.509 certificates and
+ OpenPGP keys. From now on X.509 certificates are assumed. This
+ can be easily extended to work with openpgp keys as well. */
+ if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+ {
+ gnutls_x509_crt_t gnutls_verify_cert;
+ const gnutls_datum_t *gnutls_verify_cert_list;
+ unsigned int gnutls_verify_cert_list_size;
+
+ ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+ if (ret < GNUTLS_E_SUCCESS)
+ return gnutls_make_error (ret);
+
+ gnutls_verify_cert_list
+ = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+ if (gnutls_verify_cert_list == NULL)
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ emacs_gnutls_deinit (proc);
+ boot_error (p, "No x509 certificate was found\n");
+ return Qnil;
+ }
+
+ /* Check only the first certificate in the given chain. */
+ ret = gnutls_x509_crt_import (gnutls_verify_cert,
+ &gnutls_verify_cert_list[0],
+ GNUTLS_X509_FMT_DER);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ return gnutls_make_error (ret);
+ }
+
+ XPROCESS (proc)->gnutls_certificate = gnutls_verify_cert;
+
+ int err = gnutls_x509_crt_check_hostname (gnutls_verify_cert,
+ c_hostname);
+ check_memory_full (err);
+ if (!err)
+ {
+ XPROCESS (proc)->gnutls_extra_peer_verification
+ |= CERTIFICATE_NOT_MATCHING;
+ if (verify_error_all
+ || !NILP (Fmember (QCgnutls_bootprop_hostname, verify_error)))
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ emacs_gnutls_deinit (proc);
+ boot_error (p, "The x509 certificate does not match \"%s\"",
+ c_hostname);
+ return Qnil;
+ }
+ else
+ GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+ c_hostname);
+ }
+ }
+
+ /* Set this flag only if the whole initialization succeeded. */
+ XPROCESS (proc)->gnutls_p = true;
+
+ return gnutls_make_error (ret);
+}
+
DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
Currently only client mode is supported. Return a success/failure
:min-prime-bits is the minimum accepted number of bits the client will
accept in Diffie-Hellman key exchange.
+:complete-negotiation, if non-nil, will make negotiation complete
+before returning even on non-blocking sockets.
+
The debug level will be set for this process AND globally for GnuTLS.
So if you set it higher or lower at any point, it affects global
debugging.
{
int ret = GNUTLS_E_SUCCESS;
int max_log_level = 0;
- bool verify_error_all = 0;
gnutls_session_t state;
gnutls_certificate_credentials_t x509_cred = NULL;
gnutls_anon_client_credentials_t anon_cred = NULL;
Lisp_Object global_init;
char const *priority_string_ptr = "NORMAL"; /* default priority string. */
- unsigned int peer_verification;
char *c_hostname;
/* Placeholders for the property list elements. */
/* Lisp_Object callbacks; */
Lisp_Object loglevel;
Lisp_Object hostname;
- Lisp_Object verify_error;
Lisp_Object prime_bits;
- Lisp_Object warnings;
+ struct Lisp_Process *p = XPROCESS (proc);
CHECK_PROCESS (proc);
CHECK_SYMBOL (type);
CHECK_LIST (proplist);
if (NILP (Fgnutls_available_p ()))
- error ("GnuTLS not available");
+ {
+ boot_error (p, "GnuTLS not available");
+ return Qnil;
+ }
if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
- error ("Invalid GnuTLS credential type");
+ {
+ boot_error (p, "Invalid GnuTLS credential type");
+ return Qnil;
+ }
hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
- verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error);
prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
- if (EQ (verify_error, Qt))
- {
- verify_error_all = 1;
- }
- else if (NILP (Flistp (verify_error)))
+ if (!STRINGP (hostname))
{
- error ("gnutls-boot: invalid :verify_error parameter (not a list)");
+ boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
+ return Qnil;
}
-
- if (!STRINGP (hostname))
- error ("gnutls-boot: invalid :hostname parameter (not a string)");
c_hostname = SSDATA (hostname);
state = XPROCESS (proc)->gnutls_state;
else
{
emacs_gnutls_deinit (proc);
- error ("Invalid trustfile");
+ boot_error (p, "Invalid trustfile");
+ return Qnil;
}
}
else
{
emacs_gnutls_deinit (proc);
- error ("Invalid CRL file");
+ boot_error (p, "Invalid CRL file");
+ return Qnil;
}
}
else
{
emacs_gnutls_deinit (proc);
- error (STRINGP (keyfile) ? "Invalid client cert file"
- : "Invalid client key file");
+ boot_error (p, STRINGP (keyfile) ? "Invalid client cert file"
+ : "Invalid client key file");
+ return Qnil;
}
}
}
return gnutls_make_error (ret);
}
+ XPROCESS (proc)->gnutls_complete_negotiation_p =
+ !NILP (Fplist_get (proplist, QCgnutls_complete_negotiation));
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
ret = emacs_gnutls_handshake (XPROCESS (proc));
if (ret < GNUTLS_E_SUCCESS)
return gnutls_make_error (ret);
- /* Now verify the peer, following
- http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
- The peer should present at least one certificate in the chain; do a
- check of the certificate's hostname with
- gnutls_x509_crt_check_hostname against :hostname. */
-
- ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
- if (ret < GNUTLS_E_SUCCESS)
- return gnutls_make_error (ret);
-
- XPROCESS (proc)->gnutls_peer_verification = peer_verification;
-
- warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings"));
- if (!NILP (warnings))
- {
- Lisp_Object tail;
- for (tail = warnings; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object warning = XCAR (tail);
- Lisp_Object message = Fgnutls_peer_status_warning_describe (warning);
- if (!NILP (message))
- GNUTLS_LOG2 (1, max_log_level, "verification:", SSDATA (message));
- }
- }
-
- if (peer_verification != 0)
- {
- if (verify_error_all
- || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
- {
- emacs_gnutls_deinit (proc);
- error ("Certificate validation failed %s, verification code %x",
- c_hostname, peer_verification);
- }
- else
- {
- GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
- c_hostname);
- }
- }
-
- /* Up to here the process is the same for X.509 certificates and
- OpenPGP keys. From now on X.509 certificates are assumed. This
- can be easily extended to work with openpgp keys as well. */
- if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
- {
- gnutls_x509_crt_t gnutls_verify_cert;
- const gnutls_datum_t *gnutls_verify_cert_list;
- unsigned int gnutls_verify_cert_list_size;
-
- ret = gnutls_x509_crt_init (&gnutls_verify_cert);
- if (ret < GNUTLS_E_SUCCESS)
- return gnutls_make_error (ret);
-
- gnutls_verify_cert_list =
- gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
-
- if (gnutls_verify_cert_list == NULL)
- {
- gnutls_x509_crt_deinit (gnutls_verify_cert);
- emacs_gnutls_deinit (proc);
- error ("No x509 certificate was found\n");
- }
-
- /* We only check the first certificate in the given chain. */
- ret = gnutls_x509_crt_import (gnutls_verify_cert,
- &gnutls_verify_cert_list[0],
- GNUTLS_X509_FMT_DER);
-
- if (ret < GNUTLS_E_SUCCESS)
- {
- gnutls_x509_crt_deinit (gnutls_verify_cert);
- return gnutls_make_error (ret);
- }
-
- XPROCESS (proc)->gnutls_certificate = gnutls_verify_cert;
-
- int err = gnutls_x509_crt_check_hostname (gnutls_verify_cert,
- c_hostname);
- check_memory_full (err);
- if (!err)
- {
- XPROCESS (proc)->gnutls_extra_peer_verification |=
- CERTIFICATE_NOT_MATCHING;
- if (verify_error_all
- || !NILP (Fmember (QCgnutls_bootprop_hostname, verify_error)))
- {
- gnutls_x509_crt_deinit (gnutls_verify_cert);
- emacs_gnutls_deinit (proc);
- error ("The x509 certificate does not match \"%s\"", c_hostname);
- }
- else
- {
- GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
- c_hostname);
- }
- }
- }
-
- /* Set this flag only if the whole initialization succeeded. */
- XPROCESS (proc)->gnutls_p = 1;
-
- return gnutls_make_error (ret);
+ return gnutls_verify_boot (proc, proplist);
}
DEFUN ("gnutls-bye", Fgnutls_bye,
DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
+ DEFSYM (QCgnutls_complete_negotiation, ":complete-negotiation");
DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error");
make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
defsubr (&Sgnutls_get_initstage);
+ defsubr (&Sgnutls_asynchronous_parameters);
defsubr (&Sgnutls_errorp);
defsubr (&Sgnutls_error_fatalp);
defsubr (&Sgnutls_error_string);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include "lisp.h"
-/* This limits the attempts to handshake per process (connection). */
-#define GNUTLS_EMACS_HANDSHAKES_LIMIT 100
+/* This limits the attempts to handshake per process (connection). It
+ should work out to about one minute in asynchronous cases. */
+#define GNUTLS_EMACS_HANDSHAKES_LIMIT 6000
typedef enum
{
#endif
extern Lisp_Object emacs_gnutls_deinit (Lisp_Object);
extern Lisp_Object emacs_gnutls_global_init (void);
+extern int gnutls_try_handshake (struct Lisp_Process *p);
+extern Lisp_Object gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist);
#endif
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
{
Lisp_Object value;
int desired_width, desired_height;
+ double scale = 1;
+
+ value = image_spec_value (spec, QCscale, NULL);
+ if (NUMBERP (value))
+ scale = extract_float (value);
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
value = image_spec_value (spec, QCwidth, NULL);
- desired_width = NATNUMP (value) ? min (XFASTINT (value), INT_MAX) : -1;
+ desired_width = NATNUMP (value) ?
+ min (XFASTINT (value) * scale, INT_MAX) : -1;
value = image_spec_value (spec, QCheight, NULL);
- desired_height = NATNUMP (value) ? min (XFASTINT (value), INT_MAX) : -1;
+ desired_height = NATNUMP (value) ?
+ min (XFASTINT (value) * scale, INT_MAX) : -1;
+
+ width = width * scale;
+ height = height * scale;
if (desired_width == -1)
{
/* h known, calculate w. */
desired_width = scale_image_size (desired_height, height, width);
+ /* We have no width/height settings, so just apply the scale. */
+ if (desired_width == -1 && desired_height == -1)
+ {
+ desired_width = width;
+ desired_height = height;
+ }
+
*d_width = desired_width;
*d_height = desired_height;
}
return 0;
}
+#ifdef HAVE_MAGICKAUTOORIENTIMAGE
+ /* If no :rotation is explicitly specified, apply the automatic
+ rotation from EXIF. */
+ if (NILP (image_spec_value (img->spec, QCrotation, NULL)))
+ if (MagickAutoOrientImage (image_wand) == MagickFalse)
+ {
+ image_error ("Error applying automatic orientation in image `%s'", img->spec);
+ DestroyMagickWand (image_wand);
+ return 0;
+ }
+#endif
+
if (ino < 0 || ino >= MagickGetNumberImages (image_wand))
{
image_error ("Invalid image number `%s' in image `%s'", image, img->spec);
eassert (gdk_pixbuf_get_has_alpha (pixbuf));
eassert (gdk_pixbuf_get_bits_per_sample (pixbuf) == 8);
-#ifdef USE_CAIRO
{
+#ifdef USE_CAIRO
unsigned char *data = (unsigned char *) xmalloc (width*height*4);
uint32_t bgcolor = get_spec_bg_or_alpha_as_argb (img, f);
create_cairo_image_surface (img, data, width, height);
g_object_unref (pixbuf);
- }
#else
- /* Try to create a x pixmap to hold the svg pixmap. */
- XImagePtr ximg;
- if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0))
- {
- g_object_unref (pixbuf);
- return 0;
- }
+ /* Try to create a x pixmap to hold the svg pixmap. */
+ XImagePtr ximg;
+ if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0))
+ {
+ g_object_unref (pixbuf);
+ return 0;
+ }
- init_color_table ();
+ init_color_table ();
- /* Handle alpha channel by combining the image with a background
- color. */
- XColor background;
- Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL);
- if (!STRINGP (specified_bg)
- || !x_defined_color (f, SSDATA (specified_bg), &background, 0))
- x_query_frame_background_color (f, &background);
-
- /* SVG pixmaps specify transparency in the last byte, so right
- shift 8 bits to get rid of it, since emacs doesn't support
- transparency. */
- background.red >>= 8;
- background.green >>= 8;
- background.blue >>= 8;
-
- /* This loop handles opacity values, since Emacs assumes
- non-transparent images. Each pixel must be "flattened" by
- calculating the resulting color, given the transparency of the
- pixel, and the image background color. */
- for (int y = 0; y < height; ++y)
- {
- for (int x = 0; x < width; ++x)
- {
- int red;
- int green;
- int blue;
- int opacity;
-
- red = *pixels++;
- green = *pixels++;
- blue = *pixels++;
- opacity = *pixels++;
-
- red = ((red * opacity)
- + (background.red * ((1 << 8) - opacity)));
- green = ((green * opacity)
- + (background.green * ((1 << 8) - opacity)));
- blue = ((blue * opacity)
- + (background.blue * ((1 << 8) - opacity)));
-
- XPutPixel (ximg, x, y, lookup_rgb_color (f, red, green, blue));
- }
+ /* Handle alpha channel by combining the image with a background
+ color. */
+ XColor background;
+ Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL);
+ if (!STRINGP (specified_bg)
+ || !x_defined_color (f, SSDATA (specified_bg), &background, 0))
+ x_query_frame_background_color (f, &background);
+
+ /* SVG pixmaps specify transparency in the last byte, so right
+ shift 8 bits to get rid of it, since emacs doesn't support
+ transparency. */
+ background.red >>= 8;
+ background.green >>= 8;
+ background.blue >>= 8;
+
+ /* This loop handles opacity values, since Emacs assumes
+ non-transparent images. Each pixel must be "flattened" by
+ calculating the resulting color, given the transparency of the
+ pixel, and the image background color. */
+ for (int y = 0; y < height; ++y)
+ {
+ for (int x = 0; x < width; ++x)
+ {
+ int red = *pixels++;
+ int green = *pixels++;
+ int blue = *pixels++;
+ int opacity = *pixels++;
+
+ red = ((red * opacity)
+ + (background.red * ((1 << 8) - opacity)));
+ green = ((green * opacity)
+ + (background.green * ((1 << 8) - opacity)));
+ blue = ((blue * opacity)
+ + (background.blue * ((1 << 8) - opacity)));
+
+ XPutPixel (ximg, x, y, lookup_rgb_color (f, red, green, blue));
+ }
- pixels += rowstride - 4 * width;
- }
+ pixels += rowstride - 4 * width;
+ }
#ifdef COLOR_TABLE_SUPPORT
- /* Remember colors allocated for this image. */
- img->colors = colors_in_color_table (&img->ncolors);
- free_color_table ();
+ /* Remember colors allocated for this image. */
+ img->colors = colors_in_color_table (&img->ncolors);
+ free_color_table ();
#endif /* COLOR_TABLE_SUPPORT */
- g_object_unref (pixbuf);
+ g_object_unref (pixbuf);
- img->width = width;
- img->height = height;
+ img->width = width;
+ img->height = height;
- /* Maybe fill in the background field while we have ximg handy.
- Casting avoids a GCC warning. */
- IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
+ /* Maybe fill in the background field while we have ximg handy.
+ Casting avoids a GCC warning. */
+ IMAGE_BACKGROUND (img, f, (XImagePtr_or_DC)ximg);
- /* Put ximg into the image. */
- image_put_x_image (f, img, ximg, 0);
+ /* Put ximg into the image. */
+ image_put_x_image (f, img, ximg, 0);
#endif /* ! USE_CAIRO */
+ }
return 1;
DEFSYM (QCcrop, ":crop");
DEFSYM (QCrotation, ":rotation");
DEFSYM (QCmatrix, ":matrix");
+ DEFSYM (QCscale, ":scale");
DEFSYM (QCcolor_adjustment, ":color-adjustment");
DEFSYM (QCmask, ":mask");
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
}
#endif
-
#if defined HAVE_INOTIFY || defined HAVE_KQUEUE || defined HAVE_GFILENOTIFY
case FILE_NOTIFY_EVENT:
{
is used. Note that [Enter] is not echoed by dos. */
cursor_to (SELECTED_FRAME (), 0, 0);
#endif
+
+ write_stdout ("Emacs is resuming after an emergency escape.\n");
+
/* It doesn't work to autosave while GC is in progress;
the code used for auto-saving doesn't cope with the mark bit. */
if (!gc_in_progress)
DEFVAR_BOOL ("cannot-suspend", cannot_suspend,
doc: /* Non-nil means to always spawn a subshell instead of suspending.
- (Even if the operating system has support for stopping a process.) */);
+ \(Even if the operating system has support for stopping a process.) */);
cannot_suspend = false;
DEFVAR_BOOL ("menu-prompting", menu_prompting,
DEFVAR_LISP ("input-method-function", Vinput_method_function,
doc: /* If non-nil, the function that implements the current input method.
It's called with one argument, a printing character that was just read.
- (That means a character with code 040...0176.)
+ \(That means a character with code 040...0176.)
Typically this function uses `read-event' to read additional events.
When it does so, it should first bind `input-method-function' to nil
so it will not be called recursively.
variable are `sigusr1' and `sigusr2'. */);
Vdebug_on_event = intern_c_string ("sigusr2");
+ DEFVAR_BOOL ("attempt-stack-overflow-recovery",
+ attempt_stack_overflow_recovery,
+ doc: /* If non-nil, attempt to recover from C stack
+overflow. This recovery is unsafe and may lead to deadlocks or data
+corruption, but it usually works and may preserve modified buffers
+that would otherwise be lost. If nil, treat stack overflow like any
+other kind of crash. */);
+ attempt_stack_overflow_recovery = true;
+
+ DEFVAR_BOOL ("attempt-orderly-shutdown-on-fatal-signal",
+ attempt_orderly_shutdown_on_fatal_signal,
+ doc: /* If non-nil, attempt to perform an orderly
+shutdown when Emacs receives a fatal signal (e.g., a crash).
+This cleanup is unsafe and may lead to deadlocks or data corruption,
+but it usually works and may preserve modified buffers that would
+otherwise be lost. If nil, crash immediately in response to fatal
+signals. */);
+ attempt_orderly_shutdown_on_fatal_signal = true;
+
/* Create the initial keyboard. Qt means 'unset'. */
initial_kboard = allocate_kboard (Qt);
}
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include "keyboard.h"
#include "process.h"
+#ifdef HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
+#endif /* HAVE_SYS_RESOURCE_H */
+
\f
/* File handle for kqueue. */
static int kqueuefd = -1;
/* Generate a file notification event. */
static void
- kqueue_generate_event
- (Lisp_Object watch_object, Lisp_Object actions,
- Lisp_Object file, Lisp_Object file1)
+ kqueue_generate_event (Lisp_Object watch_object, Lisp_Object actions,
+ Lisp_Object file, Lisp_Object file1)
{
Lisp_Object flags, action, entry;
struct input_event event;
replaced by the new directory listing at the end of this
function. */
static void
- kqueue_compare_dir_list
- (Lisp_Object watch_object)
+ kqueue_compare_dir_list (Lisp_Object watch_object)
{
Lisp_Object dir, pending_dl, deleted_dl;
Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl;
(Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
{
Lisp_Object watch_object, dir_list;
- int fd, oflags;
+ int maxfd, fd, oflags;
u_short fflags = 0;
struct kevent kev;
+#ifdef HAVE_GETRLIMIT
+ struct rlimit rlim;
+#endif /* HAVE_GETRLIMIT */
/* Check parameters. */
CHECK_STRING (file);
if (! FUNCTIONP (callback))
wrong_type_argument (Qinvalid_function, callback);
+ /* Check available file descriptors. */
+#ifdef HAVE_GETRLIMIT
+ if (! getrlimit (RLIMIT_NOFILE, &rlim))
+ maxfd = rlim.rlim_cur;
+ else
+#endif /* HAVE_GETRLIMIT */
+ maxfd = 256;
+
+ /* We assume 50 file descriptors are sufficient for the rest of Emacs. */
+ if ((maxfd - 50) < XINT (Flength (watch_list)))
+ xsignal2
+ (Qfile_notify_error,
+ build_string ("File watching not possible, no file descriptor left"),
+ Flength (watch_list));
+
if (kqueuefd < 0)
{
/* Create kqueue descriptor. */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include "lisp.h"
+#if ((!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC) \
+ || defined WINDOWSNT || defined CYGWIN || defined DARWIN_OS)
char my_edata[] = "End of Emacs initialized data";
+#endif
/* Help unexec locate the end of the .bss area used by Emacs (which
isn't always a separate section in NT executables). */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
/* Defined in emacs.c. */
+#ifdef DOUG_LEA_MALLOC
extern bool might_dump;
+#endif
/* True means Emacs has already been initialized.
Used during startup to detect startup of dumped Emacs. */
extern bool initialized;
#if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
extern void refill_memory_reserve (void);
#endif
-#ifdef DOUG_LEA_MALLOC
extern void alloc_unexec_pre (void);
extern void alloc_unexec_post (void);
-#else
-INLINE void alloc_unexec_pre (void) {}
-INLINE void alloc_unexec_post (void) {}
-#endif
extern const char *pending_malloc_warning;
extern Lisp_Object zero_vector;
extern Lisp_Object *stack_base;
INLINE void (check_cons_list) (void) { lisp_h_check_cons_list (); }
#endif
+/* Defined in gmalloc.c. */
+#if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC
+extern size_t __malloc_extra_blocks;
+#endif
+#if !HAVE_DECL_ALIGNED_ALLOC
+extern void *aligned_alloc (size_t, size_t) ATTRIBUTE_MALLOC_SIZE ((2));
+#endif
+extern void malloc_enable_thread (void);
+
#ifdef REL_ALLOC
/* Defined in ralloc.c. */
extern void *r_alloc (void **, size_t) ATTRIBUTE_ALLOC_SIZE ((2));
extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern _Noreturn void verror (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
+extern Lisp_Object vformat_string (const char *, va_list)
+ ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern void un_autoload (Lisp_Object);
extern Lisp_Object call_debugger (Lisp_Object arg);
extern void *near_C_stack_top (void);
/* True means remove site-lisp directories from load-path. */
extern bool no_site_lisp;
+/* True means put details like time stamps into builds. */
+extern bool build_details;
+
/* Pipe used to send exit notification to the daemon parent at
startup. On Windows, we use a kernel event instead. */
#ifndef WINDOWSNT
struct terminal;
/* Defined in sysdep.c. */
-#ifndef HAVE_GET_CURRENT_DIR_NAME
-extern char *get_current_dir_name (void);
-#endif
+extern char *emacs_get_current_dir_name (void);
extern void stuff_char (char c);
extern void init_foreground_group (void);
extern void sys_subshell (void);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
# include <sys/stropts.h>
#endif
-#ifdef HAVE_RES_INIT
-#include <arpa/nameser.h>
-#include <resolv.h>
-#endif
-
#ifdef HAVE_UTIL_H
#include <util.h>
#endif
#endif
#endif
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+/* This is 0.1s in nanoseconds. */
+#define ASYNC_RETRY_NSEC 100000000
+#endif
+
#ifdef WINDOWSNT
extern int sys_select (int, fd_set *, fd_set *, fd_set *,
struct timespec *, void *);
/* Indexed by descriptor, gives the process (if any) for that descriptor. */
static Lisp_Object chan_process[FD_SETSIZE];
+static void wait_for_socket_fds (Lisp_Object, char const *);
/* Alist of elements (NAME . PROCESS). */
static Lisp_Object Vprocess_alist;
/* Table of `partner address' for datagram sockets. */
static struct sockaddr_and_len {
struct sockaddr *sa;
- int len;
+ ptrdiff_t len;
} datagram_address[FD_SETSIZE];
#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
#define DATAGRAM_CONN_P(proc) \
p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
}
static void
-pset_status (struct Lisp_Process *p, Lisp_Object val)
-{
- p->status = val;
-}
-static void
pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
{
p->tty_name = val;
#ifdef HAVE_GNUTLS
p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
+ p->gnutls_boot_parameters = Qnil;
#endif
/* If name is already in use, modify it until it is unused. */
deactivate_process (proc);
}
+#ifdef HAVE_GETADDRINFO_A
+static void
+free_dns_request (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+
+ if (p->dns_request->ar_result)
+ freeaddrinfo (p->dns_request->ar_result);
+ xfree (p->dns_request);
+ p->dns_request = NULL;
+}
+#endif
+
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
doc: /* Return t if OBJECT is a process. */)
process = get_process (process);
p = XPROCESS (process);
+#ifdef HAVE_GETADDRINFO_A
+ if (p->dns_request)
+ {
+ /* Cancel the request. Unless shutting down, wait until
+ completion. Free the request if completely canceled. */
+
+ bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
+ if (!canceled && !inhibit_sentinels)
+ {
+ struct gaicb const *req = p->dns_request;
+ while (gai_suspend (&req, 1, NULL) != 0)
+ continue;
+ canceled = true;
+ }
+ if (canceled)
+ free_dns_request (process);
+ }
+#endif
+
p->raw_status_new = 0;
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
{
This is a list of strings, the first string being the program executed
and the rest of the strings being the arguments given to it.
For a network or serial process, this is nil (process is running) or t
- (process is stopped). */)
+ \(process is stopped). */)
(register Lisp_Object process)
{
CHECK_PROCESS (process);
return XPROCESS (process)->mark;
}
+static void
+set_process_filter_masks (struct Lisp_Process *p)
+{
+ if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
+ {
+ FD_CLR (p->infd, &input_wait_mask);
+ FD_CLR (p->infd, &non_keyboard_wait_mask);
+ }
+ else if (EQ (p->filter, Qt)
+ /* Network or serial process not stopped: */
+ && !EQ (p->command, Qt))
+ {
+ FD_SET (p->infd, &input_wait_mask);
+ FD_SET (p->infd, &non_keyboard_wait_mask);
+ }
+}
+
DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
2, 2, 0,
doc: /* Give PROCESS the filter function FILTER; nil means default.
- if `default-enable-multibyte-characters' is nil, it is a unibyte
string (the result of converting the decoded input multibyte
string to unibyte with `string-make-unibyte'). */)
- (register Lisp_Object process, Lisp_Object filter)
+ (Lisp_Object process, Lisp_Object filter)
{
- struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
/* Don't signal an error if the process's input file descriptor
is closed. This could make debugging Lisp more difficult,
if (NILP (filter))
filter = Qinternal_default_process_filter;
+ pset_filter (p, filter);
+
if (p->infd >= 0)
- {
- if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
- {
- FD_CLR (p->infd, &input_wait_mask);
- FD_CLR (p->infd, &non_keyboard_wait_mask);
- }
- else if (EQ (p->filter, Qt)
- /* Network or serial process not stopped: */
- && !EQ (p->command, Qt))
- {
- FD_SET (p->infd, &input_wait_mask);
- FD_SET (p->infd, &non_keyboard_wait_mask);
- }
- }
+ set_process_filter_masks (p);
- pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
- if (XPROCESS (process)->infd < 0
+ if (NETCONN_P (process)
+ || XPROCESS (process)->infd < 0
|| (set_window_size (XPROCESS (process)->infd,
XINT (height), XINT (width))
< 0))
connection. If KEY is t, the complete contact information for the
connection is returned, else the specific value for the keyword KEY is
returned. See `make-network-process' or `make-serial-process' for a
-list of keywords. */)
- (register Lisp_Object process, Lisp_Object key)
+list of keywords.
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
+ (Lisp_Object process, Lisp_Object key)
{
Lisp_Object contact;
contact = XPROCESS (process)->childp;
#ifdef DATAGRAM_SOCKETS
+
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "process-contact");
+
if (DATAGRAM_CONN_P (process)
&& (EQ (key, Qt) || EQ (key, QCremote)))
contact = Fplist_put (contact, QCremote,
DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
2, 2, 0,
- doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
- (register Lisp_Object process, Lisp_Object plist)
+ doc: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
+ (Lisp_Object process, Lisp_Object plist)
{
CHECK_PROCESS (process);
CHECK_LIST (plist);
An 8 or 9 element vector represents an IPv6 address (with port number).
If optional second argument OMIT-PORT is non-nil, don't include a port
number in the string, even when present in ADDRESS.
-Returns nil if format of ADDRESS is invalid. */)
+Return nil if format of ADDRESS is invalid. */)
(Lisp_Object address, Lisp_Object omit_port)
{
if (NILP (address))
The address family of sa is not included in the result. */
Lisp_Object
-conv_sockaddr_to_lisp (struct sockaddr *sa, int len)
+conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
{
Lisp_Object address;
- int i;
+ ptrdiff_t i;
unsigned char *cp;
- register struct Lisp_Vector *p;
+ struct Lisp_Vector *p;
/* Workaround for a bug in getsockname on BSD: Names bound to
sockets in the UNIX domain are inaccessible; getsockname returns
/* Get family and required size for sockaddr structure to hold ADDRESS. */
-static int
+static ptrdiff_t
get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
{
- register struct Lisp_Vector *p;
+ struct Lisp_Vector *p;
if (VECTORP (address))
{
#ifdef DATAGRAM_SOCKETS
DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
1, 1, 0,
- doc: /* Get the current datagram address associated with PROCESS. */)
+ doc: /* Get the current datagram address associated with PROCESS.
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process)
{
int channel;
CHECK_PROCESS (process);
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "process-datagram-address");
+
if (!DATAGRAM_CONN_P (process))
return Qnil;
DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2, 2, 0,
doc: /* Set the datagram address for PROCESS to ADDRESS.
-Returns nil upon error setting address, ADDRESS otherwise. */)
+Return nil upon error setting address, ADDRESS otherwise.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object address)
{
int channel;
- int family, len;
+ int family;
+ ptrdiff_t len;
CHECK_PROCESS (process);
+ if (NETCONN_P (process))
+ wait_for_socket_fds (process, "set-process-datagram-address");
+
if (!DATAGRAM_CONN_P (process))
return Qnil;
/* Set option OPT to value VAL on socket S.
- Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
+ Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
Signals an error if setting a known option fails.
*/
doc: /* For network process PROCESS set option OPTION to value VALUE.
See `make-network-process' for a list of options and values.
If optional fourth arg NO-ERROR is non-nil, don't signal an error if
-OPTION is not a supported option, return nil instead; otherwise return t. */)
+OPTION is not a supported option, return nil instead; otherwise return t.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
{
int s;
if (!NETCONN1_P (p))
error ("Process is not a network process");
+ wait_for_socket_fds (process, "set-network-process-option");
+
s = p->infd;
if (s < 0)
error ("Process is not running");
:flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
flowcontrol to be used, which is either nil (don't use flowcontrol),
the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
- (use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
+ \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
flowcontrol is used.
`serial-process-configure' is called by `make-serial-process' for the
Examples:
- (serial-process-configure :process "/dev/ttyS0" :speed 1200)
+ \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
- (serial-process-configure
+ \(serial-process-configure
:buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
- (serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
+ \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
usage: (serial-process-configure &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
Examples:
- (make-serial-process :port "/dev/ttyS0" :speed 9600)
+ \(make-serial-process :port "/dev/ttyS0" :speed 9600)
- (make-serial-process :port "COM1" :speed 115200 :stopbits 2)
+ \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
- (make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
+ \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
- (make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
+ \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
usage: (make-serial-process &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
return proc;
}
-/* Create a network stream/datagram client/server process. Treated
- exactly like a normal process when reading and writing. Primary
- differences are in status display and process deletion. A network
- connection has no PID; you cannot signal it. All you can do is
- stop/continue it and deactivate/close it via delete-process. */
+static void
+set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
+ Lisp_Object service, Lisp_Object name)
+{
+ Lisp_Object tem;
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ Lisp_Object coding_systems = Qt;
+ Lisp_Object val;
-DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
- 0, MANY, 0,
- doc: /* Create and return a network server or client process.
+ tem = Fplist_member (contact, QCcoding);
+ if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
+ tem = Qnil; /* No error message (too late!). */
-In Emacs, network connections are represented by process objects, so
-input and output work as for subprocesses and `delete-process' closes
-a network connection. However, a network process has no process id,
-it cannot be signaled, and the status codes are different from normal
-processes.
+ /* Setup coding systems for communicating with the network stream. */
+ /* Qt denotes we have not yet called Ffind_operation_coding_system. */
-Arguments are specified as keyword/argument pairs. The following
-arguments are defined:
+ if (!NILP (tem))
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCAR (val);
+ }
+ else if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else if ((!NILP (p->buffer)
+ && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
+ || (NILP (p->buffer)
+ && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
+ /* We dare not decode end-of-line format by setting VAL to
+ Qraw_text, because the existing Emacs Lisp libraries
+ assume that they receive bare code including a sequence of
+ CR LF. */
+ val = Qnil;
+ else
+ {
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, p->buffer,
+ host, service);
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCAR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_decode_coding_system (p, val);
-:name NAME -- NAME is name for process. It is modified if necessary
-to make it unique.
+ if (!NILP (tem))
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCDR (val);
+ }
+ else if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ val = Qnil;
+ else
+ {
+ if (EQ (coding_systems, Qt))
+ {
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ coding_systems = CALLN (Ffind_operation_coding_system,
+ Qopen_network_stream, name, p->buffer,
+ host, service);
+ }
+ if (CONSP (coding_systems))
+ val = XCDR (coding_systems);
+ else if (CONSP (Vdefault_process_coding_system))
+ val = XCDR (Vdefault_process_coding_system);
+ else
+ val = Qnil;
+ }
+ pset_encode_coding_system (p, val);
-:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
-with the process. Process output goes at end of that buffer, unless
-you specify an output stream or filter function to handle the output.
-BUFFER may be also nil, meaning that this process is not associated
-with any buffer.
+ pset_decoding_buf (p, empty_unibyte_string);
+ p->decoding_carryover = 0;
+ pset_encoding_buf (p, empty_unibyte_string);
-:host HOST -- HOST is name of the host to connect to, or its IP
-address. The symbol `local' specifies the local host. If specified
-for a server process, it must be a valid name or address for the local
-host, and only clients connecting to that address will be accepted.
+ p->inherit_coding_system_flag
+ = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
+}
-:service SERVICE -- SERVICE is name of the service desired, or an
-integer specifying a port number to connect to. If SERVICE is t,
-a random port number is selected for the server. (If Emacs was
-compiled with getaddrinfo, a port number can also be specified as a
-string, e.g. "80", as well as an integer. This is not portable.)
+#ifdef HAVE_GNUTLS
+static void
+finish_after_tls_connection (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ Lisp_Object result = Qt;
-:type TYPE -- TYPE is the type of connection. The default (nil) is a
-stream type connection, `datagram' creates a datagram type connection,
-`seqpacket' creates a reliable datagram connection.
+ if (!NILP (Ffboundp (Qnsm_verify_connection)))
+ result = call3 (Qnsm_verify_connection,
+ proc,
+ Fplist_get (contact, QChost),
+ Fplist_get (contact, QCservice));
-:family FAMILY -- FAMILY is the address (and protocol) family for the
-service specified by HOST and SERVICE. The default (nil) is to use
-whatever address family (IPv4 or IPv6) that is defined for the host
-and port number specified by HOST and SERVICE. Other address families
-supported are:
- local -- for a local (i.e. UNIX) address specified by SERVICE.
- ipv4 -- use IPv4 address family only.
- ipv6 -- use IPv6 address family only.
+ if (NILP (result))
+ {
+ pset_status (p, list2 (Qfailed,
+ build_string ("The Network Security Manager stopped the connections")));
+ deactivate_process (proc);
+ }
+ else
+ {
+ /* If we cleared the connection wait mask before we did
+ the TLS setup, then we have to say that the process
+ is finally "open" here. */
+ if (! FD_ISSET (p->outfd, &connect_wait_mask))
+ {
+ pset_status (p, Qrun);
+ /* Execute the sentinel here. If we had relied on
+ status_notify to do it later, it will read input
+ from the process before calling the sentinel. */
+ exec_sentinel (proc, build_string ("open\n"));
+ }
+ }
+}
+#endif
-:local ADDRESS -- ADDRESS is the local address used for the connection.
-This parameter is ignored when opening a client process. When specified
-for a server process, the FAMILY, HOST and SERVICE args are ignored.
+static void
+connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count1;
+ int s = -1, outch, inch;
+ int xerrno = 0;
+ Lisp_Object ip_address;
+ int family;
+ struct sockaddr *sa = NULL;
+ int ret;
+ ptrdiff_t addrlen;
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object contact = p->childp;
+ int optbits = 0;
-:remote ADDRESS -- ADDRESS is the remote partner's address for the
-connection. This parameter is ignored when opening a stream server
-process. For a datagram server process, it specifies the initial
-setting of the remote datagram address. When specified for a client
-process, the FAMILY, HOST, and SERVICE args are ignored.
+ /* Do this in case we never enter the while-loop below. */
+ count1 = SPECPDL_INDEX ();
+ s = -1;
-The format of ADDRESS depends on the address family:
-- An IPv4 address is represented as an vector of integers [A B C D P]
-corresponding to numeric IP address A.B.C.D and port number P.
-- A local address is represented as a string with the address in the
-local address space.
-- An "unsupported family" address is represented by a cons (F . AV)
-where F is the family number and AV is a vector containing the socket
-address data with one element per address data byte. Do not rely on
-this format in portable code, as it may depend on implementation
-defined constants, data sizes, and data structure alignment.
+ while (!NILP (ip_addresses))
+ {
+ ip_address = XCAR (ip_addresses);
+ ip_addresses = XCDR (ip_addresses);
-:coding CODING -- If CODING is a symbol, it specifies the coding
-system used for both reading and writing for this process. If CODING
-is a cons (DECODING . ENCODING), DECODING is used for reading, and
-ENCODING is used for writing.
+#ifdef WINDOWSNT
+ retry_connect:
+#endif
-:nowait BOOL -- If BOOL is non-nil for a stream type client process,
-return without waiting for the connection to complete; instead, the
-sentinel function will be called with second arg matching "open" (if
-successful) or "failed" when the connect completes. Default is to use
-a blocking connect (i.e. wait) for stream type connections.
+ addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
+ if (sa)
+ free (sa);
+ sa = xmalloc (addrlen);
+ conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
-:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
-running when Emacs is exited.
+ s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol);
+ if (s < 0)
+ {
+ xerrno = errno;
+ continue;
+ }
-:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
-In the stopped state, a server process does not accept new
-connections, and a client process does not handle incoming traffic.
-The stopped state is cleared by `continue-process' and set by
-`stop-process'.
+#ifdef DATAGRAM_SOCKETS
+ if (!p->is_server && p->socktype == SOCK_DGRAM)
+ break;
+#endif /* DATAGRAM_SOCKETS */
-:filter FILTER -- Install FILTER as the process filter.
+#ifdef NON_BLOCKING_CONNECT
+ if (p->is_non_blocking_client)
+ {
+ ret = fcntl (s, F_SETFL, O_NONBLOCK);
+ if (ret < 0)
+ {
+ xerrno = errno;
+ emacs_close (s);
+ s = -1;
+ continue;
+ }
+ }
+#endif
-:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
-process filter are multibyte, otherwise they are unibyte.
-If this keyword is not specified, the strings are multibyte if
-the default value of `enable-multibyte-characters' is non-nil.
+ /* Make us close S if quit. */
+ record_unwind_protect_int (close_file_unwind, s);
-:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+ /* Parse network options in the arg list. We simply ignore anything
+ which isn't a known option (including other keywords). An error
+ is signaled if setting a known option fails. */
+ {
+ Lisp_Object params = contact, key, val;
-:log LOG -- Install LOG as the server process log function. This
-function is called when the server accepts a network connection from a
-client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
-is the server process, CLIENT is the new process for the connection,
-and MESSAGE is a string.
+ while (!NILP (params))
+ {
+ key = XCAR (params);
+ params = XCDR (params);
+ val = XCAR (params);
+ params = XCDR (params);
+ optbits |= set_socket_option (s, key, val);
+ }
+ }
-:plist PLIST -- Install PLIST as the new process's initial plist.
+ if (p->is_server)
+ {
+ /* Configure as a server socket. */
-:server QLEN -- if QLEN is non-nil, create a server process for the
-specified FAMILY, SERVICE, and connection type (stream or datagram).
-If QLEN is an integer, it is used as the max. length of the server's
-pending connection queue (also known as the backlog); the default
-queue length is 5. Default is to create a client process.
+ /* SO_REUSEADDR = 1 is default for server sockets; must specify
+ explicit :reuseaddr key to override this. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ if (!(optbits & (1 << OPIX_REUSEADDR)))
+ {
+ int optval = 1;
+ if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
+ report_file_error ("Cannot set reuse option on server socket", Qnil);
+ }
-The following network options can be specified for this connection:
+ if (bind (s, sa, addrlen))
+ report_file_error ("Cannot bind server socket", Qnil);
-:broadcast BOOL -- Allow send and receive of datagram broadcasts.
-:dontroute BOOL -- Only send to directly connected hosts.
-:keepalive BOOL -- Send keep-alive messages on network stream.
+#ifdef HAVE_GETSOCKNAME
+ if (p->port == 0)
+ {
+ struct sockaddr_in sa1;
+ socklen_t len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ {
+ Lisp_Object service;
+ service = make_number (ntohs (sa1.sin_port));
+ contact = Fplist_put (contact, QCservice, service);
+ /* Save the port number so that we can stash it in
+ the process object later. */
+ ((struct sockaddr_in *)sa)->sin_port = sa1.sin_port;
+ }
+ }
+#endif
+
+ if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
+ report_file_error ("Cannot listen on server socket", Qnil);
+
+ break;
+ }
+
+ immediate_quit = 1;
+ QUIT;
+
+ ret = connect (s, sa, addrlen);
+ xerrno = errno;
+
+ if (ret == 0 || xerrno == EISCONN)
+ {
+ /* The unwind-protect will be discarded afterwards.
+ Likewise for immediate_quit. */
+ break;
+ }
+
+#ifdef NON_BLOCKING_CONNECT
+#ifdef EINPROGRESS
+ if (p->is_non_blocking_client && xerrno == EINPROGRESS)
+ break;
+#else
+#ifdef EWOULDBLOCK
+ if (p->is_non_blocking_client && xerrno == EWOULDBLOCK)
+ break;
+#endif
+#endif
+#endif
+
+#ifndef WINDOWSNT
+ if (xerrno == EINTR)
+ {
+ /* Unlike most other syscalls connect() cannot be called
+ again. (That would return EALREADY.) The proper way to
+ wait for completion is pselect(). */
+ int sc;
+ socklen_t len;
+ fd_set fdset;
+ retry_select:
+ FD_ZERO (&fdset);
+ FD_SET (s, &fdset);
+ QUIT;
+ sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
+ if (sc == -1)
+ {
+ if (errno == EINTR)
+ goto retry_select;
+ else
+ report_file_error ("Failed select", Qnil);
+ }
+ eassert (sc > 0);
+
+ len = sizeof xerrno;
+ eassert (FD_ISSET (s, &fdset));
+ if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
+ report_file_error ("Failed getsockopt", Qnil);
+ if (xerrno)
+ report_file_errno ("Failed connect", Qnil, xerrno);
+ break;
+ }
+#endif /* !WINDOWSNT */
+
+ immediate_quit = 0;
+
+ /* Discard the unwind protect closing S. */
+ specpdl_ptr = specpdl + count1;
+ emacs_close (s);
+ s = -1;
+
+#ifdef WINDOWSNT
+ if (xerrno == EINTR)
+ goto retry_connect;
+#endif
+ }
+
+ if (s >= 0)
+ {
+#ifdef DATAGRAM_SOCKETS
+ if (p->socktype == SOCK_DGRAM)
+ {
+ if (datagram_address[s].sa)
+ emacs_abort ();
+
+ datagram_address[s].sa = xmalloc (addrlen);
+ datagram_address[s].len = addrlen;
+ if (p->is_server)
+ {
+ Lisp_Object remote;
+ memset (datagram_address[s].sa, 0, addrlen);
+ if (remote = Fplist_get (contact, QCremote), !NILP (remote))
+ {
+ int rfamily;
+ ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
+ if (rlen != 0 && rfamily == family
+ && rlen == addrlen)
+ conv_lisp_to_sockaddr (rfamily, remote,
+ datagram_address[s].sa, rlen);
+ }
+ }
+ else
+ memcpy (datagram_address[s].sa, sa, addrlen);
+ }
+#endif
+
+ contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
+ conv_sockaddr_to_lisp (sa, addrlen));
+#ifdef HAVE_GETSOCKNAME
+ if (!p->is_server)
+ {
+ struct sockaddr_in sa1;
+ socklen_t len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
+ }
+#endif
+ }
+
+ immediate_quit = 0;
+
+ if (s < 0)
+ {
+ /* If non-blocking got this far - and failed - assume non-blocking is
+ not supported after all. This is probably a wrong assumption, but
+ the normal blocking calls to open-network-stream handles this error
+ better. */
+ if (p->is_non_blocking_client)
+ return;
+
+ report_file_errno ((p->is_server
+ ? "make server process failed"
+ : "make client process failed"),
+ contact, xerrno);
+ }
+
+ inch = s;
+ outch = s;
+
+ chan_process[inch] = proc;
+
+ fcntl (inch, F_SETFL, O_NONBLOCK);
+
+ p = XPROCESS (proc);
+ p->open_fd[SUBPROCESS_STDIN] = inch;
+ p->infd = inch;
+ p->outfd = outch;
+
+ /* Discard the unwind protect for closing S, if any. */
+ specpdl_ptr = specpdl + count1;
+
+ /* Unwind bind_polling_period and request_sigio. */
+ unbind_to (count, Qnil);
+
+ if (p->is_server && p->socktype != SOCK_DGRAM)
+ pset_status (p, Qlisten);
+
+ /* Make the process marker point into the process buffer (if any). */
+ if (BUFFERP (p->buffer))
+ set_marker_both (p->mark, p->buffer,
+ BUF_ZV (XBUFFER (p->buffer)),
+ BUF_ZV_BYTE (XBUFFER (p->buffer)));
+
+#ifdef NON_BLOCKING_CONNECT
+ if (p->is_non_blocking_client)
+ {
+ /* We may get here if connect did succeed immediately. However,
+ in that case, we still need to signal this like a non-blocking
+ connection. */
+ pset_status (p, Qconnect);
+ if (!FD_ISSET (inch, &connect_wait_mask))
+ {
+ FD_SET (inch, &connect_wait_mask);
+ FD_SET (inch, &write_mask);
+ num_pending_connects++;
+ }
+ }
+ else
+#endif
+ /* A server may have a client filter setting of Qt, but it must
+ still listen for incoming connects unless it is stopped. */
+ if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
+ || (EQ (p->status, Qlisten) && NILP (p->command)))
+ {
+ FD_SET (inch, &input_wait_mask);
+ FD_SET (inch, &non_keyboard_wait_mask);
+ }
+
+ if (inch > max_process_desc)
+ max_process_desc = inch;
+
+ /* Set up the masks based on the process filter. */
+ set_process_filter_masks (p);
+
+ setup_process_coding_systems (proc);
+
+#ifdef HAVE_GNUTLS
+ /* Continue the asynchronous connection. */
+ if (!NILP (p->gnutls_boot_parameters))
+ {
+ Lisp_Object boot, params = p->gnutls_boot_parameters;
+
+ boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
+ p->gnutls_boot_parameters = Qnil;
+
+ if (p->gnutls_initstage == GNUTLS_STAGE_READY)
+ /* Run sentinels, etc. */
+ finish_after_tls_connection (proc);
+ else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
+ {
+ deactivate_process (proc);
+ if (NILP (boot))
+ pset_status (p, list2 (Qfailed,
+ build_string ("TLS negotiation failed")));
+ else
+ pset_status (p, list2 (Qfailed, boot));
+ }
+ }
+#endif
+
+}
+
+/* Create a network stream/datagram client/server process. Treated
+ exactly like a normal process when reading and writing. Primary
+ differences are in status display and process deletion. A network
+ connection has no PID; you cannot signal it. All you can do is
+ stop/continue it and deactivate/close it via delete-process. */
+
+DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
+ 0, MANY, 0,
+ doc: /* Create and return a network server or client process.
+
+In Emacs, network connections are represented by process objects, so
+input and output work as for subprocesses and `delete-process' closes
+a network connection. However, a network process has no process id,
+it cannot be signaled, and the status codes are different from normal
+processes.
+
+Arguments are specified as keyword/argument pairs. The following
+arguments are defined:
+
+:name NAME -- NAME is name for process. It is modified if necessary
+to make it unique.
+
+:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
+with the process. Process output goes at end of that buffer, unless
+you specify an output stream or filter function to handle the output.
+BUFFER may be also nil, meaning that this process is not associated
+with any buffer.
+
+:host HOST -- HOST is name of the host to connect to, or its IP
+address. The symbol `local' specifies the local host. If specified
+for a server process, it must be a valid name or address for the local
+host, and only clients connecting to that address will be accepted.
+
+:service SERVICE -- SERVICE is name of the service desired, or an
+integer specifying a port number to connect to. If SERVICE is t,
+a random port number is selected for the server. A port number can
+be specified as an integer string, e.g., "80", as well as an integer.
+
+:type TYPE -- TYPE is the type of connection. The default (nil) is a
+stream type connection, `datagram' creates a datagram type connection,
+`seqpacket' creates a reliable datagram connection.
+
+:family FAMILY -- FAMILY is the address (and protocol) family for the
+service specified by HOST and SERVICE. The default (nil) is to use
+whatever address family (IPv4 or IPv6) that is defined for the host
+and port number specified by HOST and SERVICE. Other address families
+supported are:
+ local -- for a local (i.e. UNIX) address specified by SERVICE.
+ ipv4 -- use IPv4 address family only.
+ ipv6 -- use IPv6 address family only.
+
+:local ADDRESS -- ADDRESS is the local address used for the connection.
+This parameter is ignored when opening a client process. When specified
+for a server process, the FAMILY, HOST and SERVICE args are ignored.
+
+:remote ADDRESS -- ADDRESS is the remote partner's address for the
+connection. This parameter is ignored when opening a stream server
+process. For a datagram server process, it specifies the initial
+setting of the remote datagram address. When specified for a client
+process, the FAMILY, HOST, and SERVICE args are ignored.
+
+The format of ADDRESS depends on the address family:
+- An IPv4 address is represented as an vector of integers [A B C D P]
+corresponding to numeric IP address A.B.C.D and port number P.
+- A local address is represented as a string with the address in the
+local address space.
+- An "unsupported family" address is represented by a cons (F . AV)
+where F is the family number and AV is a vector containing the socket
+address data with one element per address data byte. Do not rely on
+this format in portable code, as it may depend on implementation
+defined constants, data sizes, and data structure alignment.
+
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process. If CODING
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
+ENCODING is used for writing.
+
+:nowait BOOL -- If NOWAIT is non-nil for a stream type client
+process, return without waiting for the connection to complete;
+instead, the sentinel function will be called with second arg matching
+"open" (if successful) or "failed" when the connect completes.
+Default is to use a blocking connect (i.e. wait) for stream type
+connections.
+
+:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
+running when Emacs is exited.
+
+:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
+In the stopped state, a server process does not accept new
+connections, and a client process does not handle incoming traffic.
+The stopped state is cleared by `continue-process' and set by
+`stop-process'.
+
+:filter FILTER -- Install FILTER as the process filter.
+
+:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
+process filter are multibyte, otherwise they are unibyte.
+If this keyword is not specified, the strings are multibyte if
+the default value of `enable-multibyte-characters' is non-nil.
+
+:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+
+:log LOG -- Install LOG as the server process log function. This
+function is called when the server accepts a network connection from a
+client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
+is the server process, CLIENT is the new process for the connection,
+and MESSAGE is a string.
+
+:plist PLIST -- Install PLIST as the new process's initial plist.
+
+:tls-parameters LIST -- is a list that should be supplied if you're
+opening a TLS connection. The first element is the TLS type (either
+`gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
+be a keyword list accepted by gnutls-boot (as returned by
+`gnutls-boot-parameters').
+
+:server QLEN -- if QLEN is non-nil, create a server process for the
+specified FAMILY, SERVICE, and connection type (stream or datagram).
+If QLEN is an integer, it is used as the max. length of the server's
+pending connection queue (also known as the backlog); the default
+queue length is 5. Default is to create a client process.
+
+The following network options can be specified for this connection:
+
+:broadcast BOOL -- Allow send and receive of datagram broadcasts.
+:dontroute BOOL -- Only send to directly connected hosts.
+:keepalive BOOL -- Send keep-alive messages on network stream.
:linger BOOL or TIMEOUT -- Send queued messages before closing.
:oobinline BOOL -- Place out-of-band data in receive data stream.
:priority INT -- Set protocol defined priority for sent packets.
Lisp_Object proc;
Lisp_Object contact;
struct Lisp_Process *p;
-#ifdef HAVE_GETADDRINFO
- struct addrinfo ai, *res, *lres;
- struct addrinfo hints;
const char *portstring;
- char portbuf[128];
-#else /* HAVE_GETADDRINFO */
- struct _emacs_addrinfo
- {
- int ai_family;
- int ai_socktype;
- int ai_protocol;
- int ai_addrlen;
- struct sockaddr *ai_addr;
- struct _emacs_addrinfo *ai_next;
- } ai, *res, *lres;
-#endif /* HAVE_GETADDRINFO */
- struct sockaddr_in address_in;
+ ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
+ char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un address_un;
#endif
- int port;
- int ret = 0;
- int xerrno = 0;
- int s = -1, outch, inch;
- ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t count1;
- Lisp_Object colon_address; /* Either QClocal or QCremote. */
+ EMACS_INT port = 0;
Lisp_Object tem;
Lisp_Object name, buffer, host, service, address;
Lisp_Object filter, sentinel;
- bool is_non_blocking_client = 0;
- bool is_server = 0;
- int backlog = 5;
+ Lisp_Object ip_addresses = Qnil;
int socktype;
int family = -1;
+ int ai_protocol = 0;
+#ifdef HAVE_GETADDRINFO_A
+ struct gaicb *dns_request = NULL;
+#endif
+ ptrdiff_t count = SPECPDL_INDEX ();
if (nargs == 0)
return Qnil;
/* :type TYPE (nil: stream, datagram */
tem = Fplist_get (contact, QCtype);
- if (NILP (tem))
- socktype = SOCK_STREAM;
-#ifdef DATAGRAM_SOCKETS
- else if (EQ (tem, Qdatagram))
- socktype = SOCK_DGRAM;
-#endif
-#ifdef HAVE_SEQPACKET
- else if (EQ (tem, Qseqpacket))
- socktype = SOCK_SEQPACKET;
-#endif
- else
- error ("Unsupported connection type");
-
- /* :server BOOL */
- tem = Fplist_get (contact, QCserver);
- if (!NILP (tem))
- {
- /* Don't support network sockets when non-blocking mode is
- not available, since a blocked Emacs is not useful. */
- is_server = 1;
- if (TYPE_RANGED_INTEGERP (int, tem))
- backlog = XINT (tem);
- }
-
- /* Make colon_address an alias for :local (server) or :remote (client). */
- colon_address = is_server ? QClocal : QCremote;
-
- /* :nowait BOOL */
- if (!is_server && socktype != SOCK_DGRAM
- && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
- {
-#ifndef NON_BLOCKING_CONNECT
- error ("Non-blocking connect not supported");
-#else
- is_non_blocking_client = 1;
+ if (NILP (tem))
+ socktype = SOCK_STREAM;
+#ifdef DATAGRAM_SOCKETS
+ else if (EQ (tem, Qdatagram))
+ socktype = SOCK_DGRAM;
#endif
- }
+#ifdef HAVE_SEQPACKET
+ else if (EQ (tem, Qseqpacket))
+ socktype = SOCK_SEQPACKET;
+#endif
+ else
+ error ("Unsupported connection type");
name = Fplist_get (contact, QCname);
buffer = Fplist_get (contact, QCbuffer);
CHECK_STRING (name);
- /* Initialize addrinfo structure in case we don't use getaddrinfo. */
- ai.ai_socktype = socktype;
- ai.ai_protocol = 0;
- ai.ai_next = NULL;
- res = &ai;
-
/* :local ADDRESS or :remote ADDRESS */
- address = Fplist_get (contact, colon_address);
+ tem = Fplist_get (contact, QCserver);
+ if (!NILP (tem))
+ address = Fplist_get (contact, QCremote);
+ else
+ address = Fplist_get (contact, QClocal);
if (!NILP (address))
{
host = service = Qnil;
- if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
+ if (!get_lisp_to_sockaddr_size (address, &family))
error ("Malformed :address");
- ai.ai_family = family;
- ai.ai_addr = alloca (ai.ai_addrlen);
- conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
+
+ ip_addresses = list1 (address);
goto open_socket;
}
tem = Fplist_get (contact, QCfamily);
if (NILP (tem))
{
-#if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
+#ifdef AF_INET6
family = AF_UNSPEC;
#else
family = AF_INET;
else
error ("Unknown address family");
- ai.ai_family = family;
-
/* :service SERVICE -- string, integer (port number), or t (random port). */
service = Fplist_get (contact, QCservice);
/* :host HOST -- hostname, ip address, or 'local for localhost. */
host = Fplist_get (contact, QChost);
- if (!NILP (host))
+ if (NILP (host))
+ {
+ /* The "connection" function gets it bind info from the address we're
+ given, so use this dummy address if nothing is specified. */
+#ifdef HAVE_LOCAL_SOCKETS
+ if (family != AF_LOCAL)
+#endif
+ host = build_string ("127.0.0.1");
+ }
+ else
{
if (EQ (host, Qlocal))
/* Depending on setup, "localhost" may map to different IPv4 and/or
host = Qnil;
}
CHECK_STRING (service);
- memset (&address_un, 0, sizeof address_un);
- address_un.sun_family = AF_LOCAL;
if (sizeof address_un.sun_path <= SBYTES (service))
error ("Service name too long");
- lispstpcpy (address_un.sun_path, service);
- ai.ai_addr = (struct sockaddr *) &address_un;
- ai.ai_addrlen = sizeof address_un;
+ ip_addresses = list1 (service);
goto open_socket;
}
#endif
}
#endif
-#ifdef HAVE_GETADDRINFO
- /* If we have a host, use getaddrinfo to resolve both host and service.
- Otherwise, use getservbyname to lookup the service. */
if (!NILP (host))
{
-
/* SERVICE can either be a string or int.
Convert to a C string for later use by getaddrinfo. */
if (EQ (service, Qt))
- portstring = "0";
+ {
+ portstring = "0";
+ portstringlen = 1;
+ }
else if (INTEGERP (service))
{
- sprintf (portbuf, "%"pI"d", XINT (service));
portstring = portbuf;
+ portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
}
else
{
CHECK_STRING (service);
portstring = SSDATA (service);
+ portstringlen = SBYTES (service);
}
+ }
- immediate_quit = 1;
- QUIT;
- memset (&hints, 0, sizeof (hints));
- hints.ai_flags = 0;
- hints.ai_family = family;
- hints.ai_socktype = socktype;
- hints.ai_protocol = 0;
-
-#ifdef HAVE_RES_INIT
- res_init ();
-#endif
-
- ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
+#ifdef HAVE_GETADDRINFO_A
+ if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
+ {
+ ptrdiff_t hostlen = SBYTES (host);
+ struct req
+ {
+ struct gaicb gaicb;
+ struct addrinfo hints;
+ char str[FLEXIBLE_ARRAY_MEMBER];
+ } *req = xmalloc (offsetof (struct req, str)
+ + hostlen + 1 + portstringlen + 1);
+ dns_request = &req->gaicb;
+ dns_request->ar_name = req->str;
+ dns_request->ar_service = req->str + hostlen + 1;
+ dns_request->ar_request = &req->hints;
+ dns_request->ar_result = NULL;
+ memset (&req->hints, 0, sizeof req->hints);
+ req->hints.ai_family = family;
+ req->hints.ai_socktype = socktype;
+ strcpy (req->str, SSDATA (host));
+ strcpy (req->str + hostlen + 1, portstring);
+
+ int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
if (ret)
-#ifdef HAVE_GAI_STRERROR
- error ("%s/%s %s", SSDATA (host), portstring, gai_strerror (ret));
-#else
- error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
-#endif
- immediate_quit = 0;
+ error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
goto open_socket;
}
-#endif /* HAVE_GETADDRINFO */
-
- /* We end up here if getaddrinfo is not defined, or in case no hostname
- has been specified (e.g. for a local server process). */
-
- if (EQ (service, Qt))
- port = 0;
- else if (INTEGERP (service))
- port = htons ((unsigned short) XINT (service));
- else
- {
- struct servent *svc_info;
- CHECK_STRING (service);
- svc_info = getservbyname (SSDATA (service),
- (socktype == SOCK_DGRAM ? "udp" : "tcp"));
- if (svc_info == 0)
- error ("Unknown service: %s", SDATA (service));
- port = svc_info->s_port;
- }
+#endif /* HAVE_GETADDRINFO_A */
- memset (&address_in, 0, sizeof address_in);
- address_in.sin_family = family;
- address_in.sin_addr.s_addr = INADDR_ANY;
- address_in.sin_port = port;
+ /* If we have a host, use getaddrinfo to resolve both host and service.
+ Otherwise, use getservbyname to lookup the service. */
-#ifndef HAVE_GETADDRINFO
if (!NILP (host))
{
- struct hostent *host_info_ptr;
-
- /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
- as it may `hang' Emacs for a very long time. */
- immediate_quit = 1;
- QUIT;
-
-#ifdef HAVE_RES_INIT
- res_init ();
-#endif
-
- host_info_ptr = gethostbyname (SDATA (host));
- immediate_quit = 0;
-
- if (host_info_ptr)
- {
- memcpy (&address_in.sin_addr, host_info_ptr->h_addr,
- host_info_ptr->h_length);
- family = host_info_ptr->h_addrtype;
- address_in.sin_family = family;
- }
- else
- /* Attempt to interpret host as numeric inet address. */
- {
- unsigned long numeric_addr;
- numeric_addr = inet_addr (SSDATA (host));
- if (numeric_addr == -1)
- error ("Unknown host \"%s\"", SDATA (host));
-
- memcpy (&address_in.sin_addr, &numeric_addr,
- sizeof (address_in.sin_addr));
- }
-
- }
-#endif /* not HAVE_GETADDRINFO */
-
- ai.ai_family = family;
- ai.ai_addr = (struct sockaddr *) &address_in;
- ai.ai_addrlen = sizeof address_in;
-
- open_socket:
-
- /* Do this in case we never enter the for-loop below. */
- count1 = SPECPDL_INDEX ();
- s = -1;
-
- for (lres = res; lres; lres = lres->ai_next)
- {
- ptrdiff_t optn;
- int optbits;
-
-#ifdef WINDOWSNT
- retry_connect:
-#endif
-
- s = socket (lres->ai_family, lres->ai_socktype | SOCK_CLOEXEC,
- lres->ai_protocol);
- if (s < 0)
- {
- xerrno = errno;
- continue;
- }
-
-#ifdef DATAGRAM_SOCKETS
- if (!is_server && socktype == SOCK_DGRAM)
- break;
-#endif /* DATAGRAM_SOCKETS */
-
-#ifdef NON_BLOCKING_CONNECT
- if (is_non_blocking_client)
- {
- ret = fcntl (s, F_SETFL, O_NONBLOCK);
- if (ret < 0)
- {
- xerrno = errno;
- emacs_close (s);
- s = -1;
- continue;
- }
- }
-#endif
-
- /* Make us close S if quit. */
- record_unwind_protect_int (close_file_unwind, s);
-
- /* Parse network options in the arg list.
- We simply ignore anything which isn't a known option (including other keywords).
- An error is signaled if setting a known option fails. */
- for (optn = optbits = 0; optn < nargs - 1; optn += 2)
- optbits |= set_socket_option (s, args[optn], args[optn + 1]);
-
- if (is_server)
- {
- /* Configure as a server socket. */
-
- /* SO_REUSEADDR = 1 is default for server sockets; must specify
- explicit :reuseaddr key to override this. */
-#ifdef HAVE_LOCAL_SOCKETS
- if (family != AF_LOCAL)
-#endif
- if (!(optbits & (1 << OPIX_REUSEADDR)))
- {
- int optval = 1;
- if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
- report_file_error ("Cannot set reuse option on server socket", Qnil);
- }
-
- if (bind (s, lres->ai_addr, lres->ai_addrlen))
- report_file_error ("Cannot bind server socket", Qnil);
-
-#ifdef HAVE_GETSOCKNAME
- if (EQ (service, Qt))
- {
- struct sockaddr_in sa1;
- socklen_t len1 = sizeof (sa1);
- if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
- {
- ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
- service = make_number (ntohs (sa1.sin_port));
- contact = Fplist_put (contact, QCservice, service);
- }
- }
-#endif
-
- if (socktype != SOCK_DGRAM && listen (s, backlog))
- report_file_error ("Cannot listen on server socket", Qnil);
-
- break;
- }
+ struct addrinfo *res, *lres;
+ int ret;
immediate_quit = 1;
QUIT;
- ret = connect (s, lres->ai_addr, lres->ai_addrlen);
- xerrno = errno;
+ struct addrinfo hints;
+ memset (&hints, 0, sizeof hints);
+ hints.ai_family = family;
+ hints.ai_socktype = socktype;
- if (ret == 0 || xerrno == EISCONN)
+ ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
+ if (ret)
+#ifdef HAVE_GAI_STRERROR
{
- /* The unwind-protect will be discarded afterwards.
- Likewise for immediate_quit. */
- break;
+ synchronize_system_messages_locale ();
+ char const *str = gai_strerror (ret);
+ if (! NILP (Vlocale_coding_system))
+ str = SSDATA (code_convert_string_norecord
+ (build_string (str), Vlocale_coding_system, 0));
+ error ("%s/%s %s", SSDATA (host), portstring, str);
}
-
-#ifdef NON_BLOCKING_CONNECT
-#ifdef EINPROGRESS
- if (is_non_blocking_client && xerrno == EINPROGRESS)
- break;
#else
-#ifdef EWOULDBLOCK
- if (is_non_blocking_client && xerrno == EWOULDBLOCK)
- break;
-#endif
-#endif
+ error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
+ immediate_quit = 0;
-#ifndef WINDOWSNT
- if (xerrno == EINTR)
+ for (lres = res; lres; lres = lres->ai_next)
{
- /* Unlike most other syscalls connect() cannot be called
- again. (That would return EALREADY.) The proper way to
- wait for completion is pselect(). */
- int sc;
- socklen_t len;
- fd_set fdset;
- retry_select:
- FD_ZERO (&fdset);
- FD_SET (s, &fdset);
- QUIT;
- sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
- if (sc == -1)
- {
- if (errno == EINTR)
- goto retry_select;
- else
- report_file_error ("Failed select", Qnil);
- }
- eassert (sc > 0);
-
- len = sizeof xerrno;
- eassert (FD_ISSET (s, &fdset));
- if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
- report_file_error ("Failed getsockopt", Qnil);
- if (xerrno)
- report_file_errno ("Failed connect", Qnil, xerrno);
- break;
+ ip_addresses = Fcons (conv_sockaddr_to_lisp
+ (lres->ai_addr, lres->ai_addrlen),
+ ip_addresses);
+ ai_protocol = lres->ai_protocol;
}
-#endif /* !WINDOWSNT */
- immediate_quit = 0;
+ ip_addresses = Fnreverse (ip_addresses);
- /* Discard the unwind protect closing S. */
- specpdl_ptr = specpdl + count1;
- emacs_close (s);
- s = -1;
+ freeaddrinfo (res);
-#ifdef WINDOWSNT
- if (xerrno == EINTR)
- goto retry_connect;
-#endif
+ goto open_socket;
}
- if (s >= 0)
+ /* No hostname has been specified (e.g., a local server process). */
+
+ if (EQ (service, Qt))
+ port = 0;
+ else if (INTEGERP (service))
+ port = XINT (service);
+ else
{
-#ifdef DATAGRAM_SOCKETS
- if (socktype == SOCK_DGRAM)
+ CHECK_STRING (service);
+
+ port = -1;
+ if (SBYTES (service) != 0)
{
- if (datagram_address[s].sa)
- emacs_abort ();
- datagram_address[s].sa = xmalloc (lres->ai_addrlen);
- datagram_address[s].len = lres->ai_addrlen;
- if (is_server)
+ /* Allow the service to be a string containing the port number,
+ because that's allowed if you have getaddrbyname. */
+ char *service_end;
+ long int lport = strtol (SSDATA (service), &service_end, 10);
+ if (service_end == SSDATA (service) + SBYTES (service))
+ port = lport;
+ else
{
- Lisp_Object remote;
- memset (datagram_address[s].sa, 0, lres->ai_addrlen);
- if (remote = Fplist_get (contact, QCremote), !NILP (remote))
- {
- int rfamily, rlen;
- rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
- if (rlen != 0 && rfamily == lres->ai_family
- && rlen == lres->ai_addrlen)
- conv_lisp_to_sockaddr (rfamily, remote,
- datagram_address[s].sa, rlen);
- }
+ struct servent *svc_info
+ = getservbyname (SSDATA (service),
+ socktype == SOCK_DGRAM ? "udp" : "tcp");
+ if (svc_info)
+ port = ntohs (svc_info->s_port);
}
- else
- memcpy (datagram_address[s].sa, lres->ai_addr, lres->ai_addrlen);
- }
-#endif
- contact = Fplist_put (contact, colon_address,
- conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
-#ifdef HAVE_GETSOCKNAME
- if (!is_server)
- {
- struct sockaddr_in sa1;
- socklen_t len1 = sizeof (sa1);
- if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
- contact = Fplist_put (contact, QClocal,
- conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
}
-#endif
- }
-
- immediate_quit = 0;
-
-#ifdef HAVE_GETADDRINFO
- if (res != &ai)
- {
- block_input ();
- freeaddrinfo (res);
- unblock_input ();
}
-#endif
-
- if (s < 0)
- {
- /* If non-blocking got this far - and failed - assume non-blocking is
- not supported after all. This is probably a wrong assumption, but
- the normal blocking calls to open-network-stream handles this error
- better. */
- if (is_non_blocking_client)
- return Qnil;
- report_file_errno ((is_server
- ? "make server process failed"
- : "make client process failed"),
- contact, xerrno);
+ if (! (0 <= port && port < 1 << 16))
+ {
+ AUTO_STRING (unknown_service, "Unknown service: %s");
+ xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
}
- inch = s;
- outch = s;
+ open_socket:
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
proc = make_process (name);
-
- chan_process[inch] = proc;
-
- fcntl (inch, F_SETFL, O_NONBLOCK);
-
p = XPROCESS (proc);
-
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_type (p, Qnetwork);
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
pset_command (p, Qt);
p->pid = 0;
+ p->backlog = 5;
+ p->is_non_blocking_client = 0;
+ p->is_server = 0;
+ p->port = port;
+ p->socktype = socktype;
+ p->ai_protocol = ai_protocol;
+#ifdef HAVE_GETADDRINFO_A
+ p->dns_request = NULL;
+#endif
+#ifdef HAVE_GNUTLS
+ tem = Fplist_get (contact, QCtls_parameters);
+ CHECK_LIST (tem);
+ p->gnutls_boot_parameters = tem;
+#endif
- p->open_fd[SUBPROCESS_STDIN] = inch;
- p->infd = inch;
- p->outfd = outch;
-
- /* Discard the unwind protect for closing S, if any. */
- specpdl_ptr = specpdl + count1;
+ set_network_socket_coding_system (proc, service, host, name);
- /* Unwind bind_polling_period and request_sigio. */
unbind_to (count, Qnil);
- if (is_server && socktype != SOCK_DGRAM)
- pset_status (p, Qlisten);
+ /* :server BOOL */
+ tem = Fplist_get (contact, QCserver);
+ if (!NILP (tem))
+ {
+ /* Don't support network sockets when non-blocking mode is
+ not available, since a blocked Emacs is not useful. */
+ p->is_server = 1;
+ if (TYPE_RANGED_INTEGERP (int, tem))
+ p->backlog = XINT (tem);
+ }
- /* Make the process marker point into the process buffer (if any). */
- if (BUFFERP (buffer))
- set_marker_both (p->mark, buffer,
- BUF_ZV (XBUFFER (buffer)),
- BUF_ZV_BYTE (XBUFFER (buffer)));
+ /* :nowait BOOL */
+ if (!p->is_server && socktype != SOCK_DGRAM
+ && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
+ {
+#ifndef NON_BLOCKING_CONNECT
+ error ("Non-blocking connect not supported");
+#else
+ p->is_non_blocking_client = 1;
+#endif
+ }
-#ifdef NON_BLOCKING_CONNECT
- if (is_non_blocking_client)
+#ifdef HAVE_GETADDRINFO_A
+ /* With async address resolution, the list of addresses is empty, so
+ postpone connecting to the server. */
+ if (!p->is_server && NILP (ip_addresses))
{
- /* We may get here if connect did succeed immediately. However,
- in that case, we still need to signal this like a non-blocking
- connection. */
- pset_status (p, Qconnect);
- if (!FD_ISSET (inch, &connect_wait_mask))
- {
- FD_SET (inch, &connect_wait_mask);
- FD_SET (inch, &write_mask);
- num_pending_connects++;
- }
+ p->dns_request = dns_request;
+ p->status = Qconnect;
+ return proc;
}
- else
#endif
- /* A server may have a client filter setting of Qt, but it must
- still listen for incoming connects unless it is stopped. */
- if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
- || (EQ (p->status, Qlisten) && NILP (p->command)))
- {
- FD_SET (inch, &input_wait_mask);
- FD_SET (inch, &non_keyboard_wait_mask);
- }
-
- if (inch > max_process_desc)
- max_process_desc = inch;
-
- tem = Fplist_member (contact, QCcoding);
- if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
- tem = Qnil; /* No error message (too late!). */
-
- {
- /* Setup coding systems for communicating with the network stream. */
- /* Qt denotes we have not yet called Ffind_operation_coding_system. */
- Lisp_Object coding_systems = Qt;
- Lisp_Object val;
-
- if (!NILP (tem))
- {
- val = XCAR (XCDR (tem));
- if (CONSP (val))
- val = XCAR (val);
- }
- else if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
- else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
- || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
- /* We dare not decode end-of-line format by setting VAL to
- Qraw_text, because the existing Emacs Lisp libraries
- assume that they receive bare code including a sequence of
- CR LF. */
- val = Qnil;
- else
- {
- if (NILP (host) || NILP (service))
- coding_systems = Qnil;
- else
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- if (CONSP (coding_systems))
- val = XCAR (coding_systems);
- else if (CONSP (Vdefault_process_coding_system))
- val = XCAR (Vdefault_process_coding_system);
- else
- val = Qnil;
- }
- pset_decode_coding_system (p, val);
-
- if (!NILP (tem))
- {
- val = XCAR (XCDR (tem));
- if (CONSP (val))
- val = XCDR (val);
- }
- else if (!NILP (Vcoding_system_for_write))
- val = Vcoding_system_for_write;
- else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- val = Qnil;
- else
- {
- if (EQ (coding_systems, Qt))
- {
- if (NILP (host) || NILP (service))
- coding_systems = Qnil;
- else
- coding_systems = CALLN (Ffind_operation_coding_system,
- Qopen_network_stream, name, buffer,
- host, service);
- }
- if (CONSP (coding_systems))
- val = XCDR (coding_systems);
- else if (CONSP (Vdefault_process_coding_system))
- val = XCDR (Vdefault_process_coding_system);
- else
- val = Qnil;
- }
- pset_encode_coding_system (p, val);
- }
- setup_process_coding_systems (proc);
-
- pset_decoding_buf (p, empty_unibyte_string);
- p->decoding_carryover = 0;
- pset_encoding_buf (p, empty_unibyte_string);
-
- p->inherit_coding_system_flag
- = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
+ connect_network_socket (proc, ip_addresses);
return proc;
}
exec_sentinel (proc, concat3 (open_from, host_string, nl));
}
+#ifdef HAVE_GETADDRINFO_A
+static Lisp_Object
+check_for_dns (Lisp_Object proc)
+{
+ struct Lisp_Process *p = XPROCESS (proc);
+ Lisp_Object ip_addresses = Qnil;
+
+ /* Sanity check. */
+ if (! p->dns_request)
+ return Qnil;
+
+ int ret = gai_error (p->dns_request);
+ if (ret == EAI_INPROGRESS)
+ return Qt;
+
+ /* We got a response. */
+ if (ret == 0)
+ {
+ struct addrinfo *res;
+
+ for (res = p->dns_request->ar_result; res; res = res->ai_next)
+ {
+ ip_addresses = Fcons (conv_sockaddr_to_lisp
+ (res->ai_addr, res->ai_addrlen),
+ ip_addresses);
+ }
+
+ ip_addresses = Fnreverse (ip_addresses);
+ }
+ /* The DNS lookup failed. */
+ else if (EQ (p->status, Qconnect))
+ {
+ deactivate_process (proc);
+ pset_status (p, (list2
+ (Qfailed,
+ concat3 (build_string ("Name lookup of "),
+ build_string (p->dns_request->ar_name),
+ build_string (" failed")))));
+ }
+
+ free_dns_request (proc);
+
+ /* This process should not already be connected (or killed). */
+ if (!EQ (p->status, Qconnect))
+ return Qnil;
+
+ return ip_addresses;
+}
+
+#endif /* HAVE_GETADDRINFO_A */
+
+static void
+wait_for_socket_fds (Lisp_Object process, char const *name)
+{
+ while (XPROCESS (process)->infd < 0
+ && EQ (XPROCESS (process)->status, Qconnect))
+ {
+ add_to_log ("Waiting for socket from %s...", build_string (name));
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+}
+
+static void
+wait_while_connecting (Lisp_Object process)
+{
+ while (EQ (XPROCESS (process)->status, Qconnect))
+ {
+ add_to_log ("Waiting for connection...");
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+}
+
+static void
+wait_for_tls_negotiation (Lisp_Object process)
+{
+#ifdef HAVE_GNUTLS
+ while (XPROCESS (process)->gnutls_p
+ && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
+ {
+ add_to_log ("Waiting for TLS...");
+ wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
+ }
+#endif
+}
+
/* This variable is different from waiting_for_input in keyboard.c.
It is used to communicate to a lisp process-filter/sentinel (via the
function Fwaiting_for_user_input_p below) whether Emacs was waiting
struct timespec got_output_end_time = invalid_timespec ();
enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
int got_some_output = -1;
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ bool retry_for_async;
+#endif
ptrdiff_t count = SPECPDL_INDEX ();
/* Close to the current time if known, an invalid timespec otherwise. */
if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
break;
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ {
+ Lisp_Object process_list_head, aproc;
+ struct Lisp_Process *p;
+
+ retry_for_async = false;
+ FOR_EACH_PROCESS(process_list_head, aproc)
+ {
+ p = XPROCESS (aproc);
+
+ if (! wait_proc || p == wait_proc)
+ {
+#ifdef HAVE_GETADDRINFO_A
+ /* Check for pending DNS requests. */
+ if (p->dns_request)
+ {
+ Lisp_Object ip_addresses = check_for_dns (aproc);
+ if (!NILP (ip_addresses) && !EQ (ip_addresses, Qt))
+ connect_network_socket (aproc, ip_addresses);
+ else
+ retry_for_async = true;
+ }
+#endif
+#ifdef HAVE_GNUTLS
+ /* Continue TLS negotiation. */
+ if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
+ && p->is_non_blocking_client)
+ {
+ gnutls_try_handshake (p);
+ p->gnutls_handshakes_tried++;
+
+ if (p->gnutls_initstage == GNUTLS_STAGE_READY)
+ {
+ gnutls_verify_boot (aproc, Qnil);
+ finish_after_tls_connection (aproc);
+ }
+ else
+ {
+ retry_for_async = true;
+ if (p->gnutls_handshakes_tried
+ > GNUTLS_EMACS_HANDSHAKES_LIMIT)
+ {
+ deactivate_process (aproc);
+ pset_status (p, list2 (Qfailed,
+ build_string ("TLS negotiation failed")));
+ }
+ }
+ }
+#endif
+ }
+ }
+ }
+#endif /* GETADDRINFO_A or GNUTLS */
+
/* Compute time from now till when time limit is up. */
/* Exit if already run out. */
if (wait == TIMEOUT)
if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
now = invalid_timespec ();
+#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
+ if (retry_for_async
+ && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
+ {
+ timeout.tv_sec = 0;
+ timeout.tv_nsec = ASYNC_RETRY_NSEC;
+ }
+#endif
+
#if defined (HAVE_NS)
nfds = ns_select
#elif defined (HAVE_GLIB)
}
else
{
- pset_status (p, Qrun);
- /* Execute the sentinel here. If we had relied on
- status_notify to do it later, it will read input
- from the process before calling the sentinel. */
- exec_sentinel (proc, build_string ("open\n"));
+#ifdef HAVE_GNUTLS
+ /* If we have an incompletely set up TLS connection,
+ then defer the sentinel signalling until
+ later. */
+ if (NILP (p->gnutls_boot_parameters)
+ && !p->gnutls_p)
+#endif
+ {
+ pset_status (p, Qrun);
+ /* Execute the sentinel here. If we had relied on
+ status_notify to do it later, it will read input
+ from the process before calling the sentinel. */
+ exec_sentinel (proc, build_string ("open\n"));
+ }
+
if (0 <= p->infd && !EQ (p->filter, Qt)
&& !EQ (p->command, Qt))
{
ssize_t rv;
struct coding_system *coding;
+ if (NETCONN_P (proc))
+ {
+ wait_while_connecting (proc);
+ wait_for_tls_negotiation (proc);
+ }
+
if (p->raw_status_new)
update_status (p);
if (! EQ (p->status, Qrun))
Called from program, takes three arguments, PROCESS, START and END.
If the region is more than 500 characters long,
it is sent in several bunches. This may happen even for shorter regions.
-Output from processes can arrive in between bunches. */)
+Output from processes can arrive in between bunches.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object start, Lisp_Object end)
{
Lisp_Object proc = get_process (process);
if (XINT (start) < GPT && XINT (end) > GPT)
move_gap_both (XINT (start), start_byte);
+ if (NETCONN_P (proc))
+ wait_while_connecting (proc);
+
send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
end_byte - start_byte, Fcurrent_buffer ());
nil, indicating the current buffer's process.
If STRING is more than 500 characters long,
it is sent in several bunches. This may happen even for shorter strings.
-Output from processes can arrive in between bunches. */)
+Output from processes can arrive in between bunches.
+
+If PROCESS is a non-blocking network process that hasn't been fully
+set up yet, this function will block until socket setup has completed. */)
(Lisp_Object process, Lisp_Object string)
{
- Lisp_Object proc;
CHECK_STRING (string);
- proc = get_process (process);
+ Lisp_Object proc = get_process (process);
send_process (proc, SSDATA (string),
SBYTES (string), string);
return Qnil;
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- pid_t gid;
- Lisp_Object proc;
- struct Lisp_Process *p;
-
- proc = get_process (process);
- p = XPROCESS (proc);
+ Lisp_Object proc = get_process (process);
+ struct Lisp_Process *p = XPROCESS (proc);
if (!EQ (p->type, Qreal))
error ("Process %s is not a subprocess",
error ("Process %s is not active",
SDATA (p->name));
- gid = emacs_get_tty_pgrp (p);
+ pid_t gid = emacs_get_tty_pgrp (p);
if (gid == p->pid)
return Qnil;
break;
case SIGTSTP:
-#if defined (VSWTCH) && !defined (PREFER_VSUSP)
+#ifdef VSWTCH
sig_char = &t.c_cc[VSWTCH];
#else
sig_char = &t.c_cc[VSUSP];
struct coding_system *coding = NULL;
int outfd;
- if (DATAGRAM_CONN_P (process))
+ proc = get_process (process);
+
+ if (NETCONN_P (proc))
+ wait_while_connecting (proc);
+
+ if (DATAGRAM_CONN_P (proc))
return process;
- proc = get_process (process);
+
outfd = XPROCESS (proc)->outfd;
if (outfd >= 0)
coding = proc_encode_coding_system[outfd];
Sset_process_coding_system, 1, 3, 0,
doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
DECODING will be used to decode subprocess output and ENCODING to
-encode subprocess input. */)
- (register Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
+encode subprocess input. */)
+ (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
{
- register struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
- if (p->infd < 0)
- error ("Input file descriptor of %s closed", SDATA (p->name));
- if (p->outfd < 0)
- error ("Output file descriptor of %s closed", SDATA (p->name));
+
+ struct Lisp_Process *p = XPROCESS (process);
+
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
encoding = coding_inherit_eol_type (encoding, Qnil);
pset_decode_coding_system (p, decoding);
pset_encode_coding_system (p, encoding);
+
+ /* If the sockets haven't been set up yet, the final setup part of
+ this will be called asynchronously. */
+ if (p->infd < 0 || p->outfd < 0)
+ return Qnil;
+
setup_process_coding_systems (process);
return Qnil;
suppressed. */)
(Lisp_Object process, Lisp_Object flag)
{
- register struct Lisp_Process *p;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
+
+ struct Lisp_Process *p = XPROCESS (process);
if (NILP (flag))
pset_decode_coding_system
(p, raw_text_coding_system (p->decode_coding_system));
+
+ /* If the sockets haven't been set up yet, the final setup part of
+ this will be called asynchronously. */
+ if (p->infd < 0 || p->outfd < 0)
+ return Qnil;
+
setup_process_coding_systems (process);
return Qnil;
doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
(Lisp_Object process)
{
- register struct Lisp_Process *p;
- struct coding_system *coding;
-
CHECK_PROCESS (process);
- p = XPROCESS (process);
+ struct Lisp_Process *p = XPROCESS (process);
if (p->infd < 0)
return Qnil;
- coding = proc_decode_coding_system[p->infd];
+ struct coding_system *coding = proc_decode_coding_system[p->infd];
return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
}
DEFSYM (QCserver, ":server");
DEFSYM (QCnowait, ":nowait");
DEFSYM (QCsentinel, ":sentinel");
+ DEFSYM (QCtls_parameters, ":tls-parameters");
+ DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
DEFSYM (QClog, ":log");
DEFSYM (QCnoquery, ":noquery");
DEFSYM (QCstop, ":stop");
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#ifdef HAVE_GNUTLS
Lisp_Object gnutls_cred_type;
+ Lisp_Object gnutls_boot_parameters;
#endif
/* Pipe process attached to the standard error of this process. */
flag indicates that `raw_status' contains a new status that still
needs to be synced to `status'. */
bool_bf raw_status_new : 1;
+ /* Whether this is a nonblocking socket. */
+ bool_bf is_non_blocking_client : 1;
+ /* Whether this is a server or a client socket. */
+ bool_bf is_server : 1;
int raw_status;
+ /* The length of the socket backlog. */
+ int backlog;
+ /* The port number. */
+ int port;
+ /* The socket type. */
+ int socktype;
+ /* The socket protocol. */
+ int ai_protocol;
+
+#ifdef HAVE_GETADDRINFO_A
+ /* Whether the socket is waiting for response from an asynchronous
+ DNS call. */
+ struct gaicb *dns_request;
+#endif
#ifdef HAVE_GNUTLS
gnutls_initstage_t gnutls_initstage;
int gnutls_log_level;
int gnutls_handshakes_tried;
bool_bf gnutls_p : 1;
+ bool_bf gnutls_complete_negotiation_p : 1;
#endif
};
p->childp = val;
}
+INLINE void
+pset_status (struct Lisp_Process *p, Lisp_Object val)
+{
+ p->status = val;
+}
+
#ifdef HAVE_GNUTLS
INLINE void
pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)
extern void record_deleted_pid (pid_t, Lisp_Object);
struct sockaddr;
-extern Lisp_Object conv_sockaddr_to_lisp (struct sockaddr *, int);
+extern Lisp_Object conv_sockaddr_to_lisp (struct sockaddr *, ptrdiff_t);
extern void hold_keyboard_input (void);
extern void unhold_keyboard_input (void);
extern bool kbd_on_hold_p (void);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
rather than all of them. This means allowing for a possible
hole between the first bloc and the end of malloc storage. */
-#ifdef emacs
-
#include <config.h>
-#include "lisp.h" /* Needed for VALBITS. */
-#include "blockinput.h"
-
-#include <unistd.h>
-
-#ifdef DOUG_LEA_MALLOC
-#define M_TOP_PAD -2
-extern int mallopt (int, int);
-#else /* not DOUG_LEA_MALLOC */
-#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
-extern size_t __malloc_extra_blocks;
-#endif /* not SYSTEM_MALLOC and not HYBRID_MALLOC */
-#endif /* not DOUG_LEA_MALLOC */
-
-#else /* not emacs */
-
#include <stddef.h>
-#include <malloc.h>
-
-#endif /* not emacs */
+#ifdef emacs
+# include "lisp.h"
+# include "blockinput.h"
+# include <unistd.h>
+#endif
#include "getpagesize.h"
/* The hook `malloc' uses for the function which gets more space
from the system. */
-#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
+#else
extern void *(*__morecore) (ptrdiff_t);
#endif
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+
+#include "sheap.h"
+
#include <stdio.h>
#include "lisp.h"
#include <unistd.h>
#include <stdlib.h> /* for exit */
-#ifdef ENABLE_CHECKING
-#define STATIC_HEAP_SIZE (28 * 1024 * 1024)
-#else
-#define STATIC_HEAP_SIZE (19 * 1024 * 1024)
-#endif
-
-int debug_sheap = 0;
-
-#define BLOCKSIZE 4096
+static int debug_sheap;
char bss_sbrk_buffer[STATIC_HEAP_SIZE];
-/* The following is needed in gmalloc.c */
-void *bss_sbrk_buffer_end = bss_sbrk_buffer + STATIC_HEAP_SIZE;
-char *bss_sbrk_ptr;
char *max_bss_sbrk_ptr;
-int bss_sbrk_did_unexec;
+bool bss_sbrk_did_unexec;
void *
bss_sbrk (ptrdiff_t request_size)
{
+ static char *bss_sbrk_ptr;
+
if (!bss_sbrk_ptr)
{
max_bss_sbrk_ptr = bss_sbrk_ptr = bss_sbrk_buffer;
#ifdef CYGWIN
- sbrk (BLOCKSIZE); /* force space for fork to work */
+ /* Force space for fork to work. */
+ sbrk (4096);
#endif
}
- if (!(int) request_size)
- {
- return (bss_sbrk_ptr);
- }
- else if (bss_sbrk_ptr + (int) request_size < bss_sbrk_buffer)
+ int used = bss_sbrk_ptr - bss_sbrk_buffer;
+
+ if (request_size < -used)
{
- printf
- ("attempt to free too much: avail %d used %d failed request %d\n",
- STATIC_HEAP_SIZE, bss_sbrk_ptr - bss_sbrk_buffer,
- (int) request_size);
+ printf (("attempt to free too much: "
+ "avail %d used %d failed request %"pD"d\n"),
+ STATIC_HEAP_SIZE, used, request_size);
exit (-1);
return 0;
}
- else if (bss_sbrk_ptr + (int) request_size >
- bss_sbrk_buffer + STATIC_HEAP_SIZE)
+ else if (STATIC_HEAP_SIZE - used < request_size)
{
- printf ("static heap exhausted: avail %d used %d failed request %d\n",
- STATIC_HEAP_SIZE,
- bss_sbrk_ptr - bss_sbrk_buffer, (int) request_size);
+ printf ("static heap exhausted: avail %d used %d failed request %"pD"d\n",
+ STATIC_HEAP_SIZE, used, request_size);
exit (-1);
return 0;
}
- else if ((int) request_size < 0)
- {
- bss_sbrk_ptr += (int) request_size;
- if (debug_sheap)
- printf ("freed size %d\n", request_size);
- return bss_sbrk_ptr;
- }
- else
+
+ void *ret = bss_sbrk_ptr;
+ bss_sbrk_ptr += request_size;
+ if (max_bss_sbrk_ptr < bss_sbrk_ptr)
+ max_bss_sbrk_ptr = bss_sbrk_ptr;
+ if (debug_sheap)
{
- char *ret = bss_sbrk_ptr;
- if (debug_sheap)
- printf ("allocated 0x%08x size %d\n", ret, request_size);
- bss_sbrk_ptr += (int) request_size;
- if (bss_sbrk_ptr > max_bss_sbrk_ptr)
- max_bss_sbrk_ptr = bss_sbrk_ptr;
- return ret;
+ if (request_size < 0)
+ printf ("freed size %"pD"d\n", request_size);
+ else
+ printf ("allocated %p size %"pD"d\n", ret, request_size);
}
-}
-
-void
-report_sheap_usage (int die_if_pure_storage_exceeded)
-{
- char buf[200];
- sprintf (buf, "Maximum static heap usage: %d of %d bytes",
- max_bss_sbrk_ptr - bss_sbrk_buffer, STATIC_HEAP_SIZE);
- /* Don't log messages, cause at this point, we're not allowed to create
- buffers. */
- message1_nolog (buf);
+ return ret;
}
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
POS and LIMIT are character positions in the current buffer.
If POS is less than LIMIT, POS is at the first character of a word,
-and the return value of a function should be a position after the
-last character of that word.
+and the return value of a function is a position after the last
+character of that word.
If POS is not less than LIMIT, POS is at the last character of a word,
-and the return value of a function should be a position at the first
+and the return value of a function is a position at the first
character of that word.
In both cases, LIMIT bounds the search. */);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <config.h>
-/* If HYBRID_GET_CURRENT_DIR_NAME is defined in conf_post.h, then we
- need the following before including unistd.h, in order to pick up
- the right prototype for gget_current_dir_name. */
-#ifdef HYBRID_GET_CURRENT_DIR_NAME
-#undef get_current_dir_name
-#define get_current_dir_name gget_current_dir_name
-#endif
-
#include <execinfo.h>
#include "sysstdio.h"
#ifdef HAVE_PWD_H
#include <utimens.h>
#include "lisp.h"
+#include "sheap.h"
#include "sysselect.h"
#include "blockinput.h"
1800, 2400, 4800, 9600, 19200, 38400
};
-#if !defined HAVE_GET_CURRENT_DIR_NAME || defined BROKEN_GET_CURRENT_DIR_NAME \
- || (defined HYBRID_GET_CURRENT_DIR_NAME)
-/* Return the current working directory. Returns NULL on errors.
- Any other returned value must be freed with free. This is used
- only when get_current_dir_name is not defined on the system. */
+/* Return the current working directory. The result should be freed
+ with 'free'. Return NULL on errors. */
char *
-get_current_dir_name (void)
+emacs_get_current_dir_name (void)
{
+# if HAVE_GET_CURRENT_DIR_NAME && !BROKEN_GET_CURRENT_DIR_NAME
+# ifdef HYBRID_MALLOC
+ bool use_libc = bss_sbrk_did_unexec;
+# else
+ bool use_libc = true;
+# endif
+ if (use_libc)
+ return get_current_dir_name ();
+# endif
+
char *buf;
char *pwd = getenv ("PWD");
struct stat dotstat, pwdstat;
}
return buf;
}
-#endif
\f
/* Discard pending input on all input descriptors. */
void
init_system_name (void)
{
+ if (!build_details)
+ {
+ /* Set system-name to nil so that the build is deterministic. */
+ Vsystem_name = Qnil;
+ return;
+ }
char *hostname_alloc = NULL;
char *hostname;
#ifndef HAVE_GETHOSTNAME
static bool
stack_overflow (siginfo_t *siginfo)
{
+ if (!attempt_stack_overflow_recovery)
+ return false;
+
/* In theory, a more-accurate heuristic can be obtained by using
GNU/Linux pthread_getattr_np along with POSIX pthread_attr_getstack
and pthread_attr_getguardsize to find the location and size of the
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#define DOTEXE ".exe"
-extern void report_sheap_usage (int);
-
-extern int bss_sbrk_did_unexec;
-
/*
** header for Windows executable files
*/
int ret;
int ret2;
- report_sheap_usage (1);
-
infile = add_exe_suffix_if_necessary (infile, infile_buffer);
outfile = add_exe_suffix_if_necessary (outfile, outfile_buffer);
ret = emacs_close (fd_in);
assert (ret == 0);
- bss_sbrk_did_unexec = 1;
fixup_executable (fd_out);
- bss_sbrk_did_unexec = 0;
ret = emacs_close (fd_out);
assert (ret == 0);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
|| !strcmp (old_section_names + new_shdr->sh_name, ".sdata")
|| !strcmp (old_section_names + new_shdr->sh_name, ".lit4")
|| !strcmp (old_section_names + new_shdr->sh_name, ".lit8")
- /* The conditional bit below was in Oliva's original code
- (1999-08-25) and seems to have been dropped by mistake
- subsequently. It prevents a crash at startup under X in
- `IRIX64 6.5 6.5.17m', whether compiled on that release or
- an earlier one. It causes no trouble on the other ELF
- platforms I could test (Irix 6.5.15m, Solaris 8, Debian
- Potato x86, Debian Woody SPARC); however, it's reported
- to cause crashes under some version of GNU/Linux. It's
- not yet clear what's changed in that Irix version to
- cause the problem, or why the fix sometimes fails under
- GNU/Linux. There's probably no good reason to have
- something Irix-specific here, but this will have to do
- for now. IRIX6_5 is the most specific macro we have to
- test. -- fx 2002-10-01
-
- The issue _looks_ as though it's gone away on 6.5.18m,
- but maybe it's still lurking, to be triggered by some
- change in the binary. It appears to concern the dynamic
- loader, but I never got anywhere with an SGI support call
- seeking clues. -- fx 2002-11-29. */
-#ifdef IRIX6_5
- || !strcmp (old_section_names + new_shdr->sh_name, ".got")
-#endif
|| !strcmp (old_section_names + new_shdr->sh_name, ".sdata1")
|| !strcmp (old_section_names + new_shdr->sh_name, ".data1"))
src = (caddr_t) old_shdr->sh_addr;
|| !strcmp (old_section_names + shdr->sh_name, ".sdata")
|| !strcmp (old_section_names + shdr->sh_name, ".lit4")
|| !strcmp (old_section_names + shdr->sh_name, ".lit8")
-#ifdef IRIX6_5 /* see above */
- || !strcmp (old_section_names + shdr->sh_name, ".got")
-#endif
|| !strcmp (old_section_names + shdr->sh_name, ".sdata1")
|| !strcmp (old_section_names + shdr->sh_name, ".data1"))
{
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
# endif
#endif
-/* From gmalloc.c. */
-extern void (* __after_morecore_hook) (void);
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
+#endif
+#ifndef __MALLOC_HOOK_VOLATILE
+# define __MALLOC_HOOK_VOLATILE volatile
+#endif
+#ifndef HAVE_MALLOC_H
extern void *(*__morecore) (ptrdiff_t);
+extern void (*__MALLOC_HOOK_VOLATILE __after_morecore_hook) (void);
+#endif
/* From ralloc.c. */
#ifdef REL_ALLOC
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
int (PASCAL *pfn_sendto) (SOCKET s, const char * buf, int len, int flags,
const struct sockaddr * to, int tolen);
+int (PASCAL *pfn_getaddrinfo) (const char *, const char *,
+ const struct addrinfo *, struct addrinfo **);
+void (PASCAL *pfn_freeaddrinfo) (struct addrinfo *);
+
/* SetHandleInformation is only needed to make sockets non-inheritable. */
BOOL (WINAPI *pfn_SetHandleInformation) (HANDLE object, DWORD mask, DWORD flags);
#ifndef HANDLE_FLAG_INHERIT
LOAD_PROC (sendto);
#undef LOAD_PROC
+ /* Try loading functions not available before XP. */
+ pfn_getaddrinfo = (void *) GetProcAddress (winsock_lib, "getaddrinfo");
+ pfn_freeaddrinfo = (void *) GetProcAddress (winsock_lib, "freeaddrinfo");
+ /* Paranoia: these two functions should go together, so if one
+ is absent, we cannot use the other. */
+ if (pfn_getaddrinfo == NULL)
+ pfn_freeaddrinfo = NULL;
+ else if (pfn_freeaddrinfo == NULL)
+ pfn_getaddrinfo = NULL;
+
/* specify version 1.1 of winsock */
if (pfn_WSAStartup (0x101, &winsockData) == 0)
{
return SOCKET_ERROR;
}
+int
+sys_getaddrinfo (const char *node, const char *service,
+ const struct addrinfo *hints, struct addrinfo **res)
+{
+ int rc;
+
+ if (winsock_lib == NULL)
+ {
+ errno = ENETDOWN;
+ return SOCKET_ERROR;
+ }
+
+ check_errno ();
+ if (pfn_getaddrinfo)
+ rc = pfn_getaddrinfo (node, service, hints, res);
+ else
+ {
+ int port = 0;
+ struct hostent *host_info;
+ struct gai_storage {
+ struct addrinfo addrinfo;
+ struct sockaddr_in sockaddr_in;
+ } *gai_storage;
+
+ /* We don't (yet) support any flags, as Emacs doesn't need that. */
+ if (hints && hints->ai_flags != 0)
+ return WSAEINVAL;
+ /* NODE cannot be NULL, since process.c has fallbacks for that. */
+ if (!node)
+ return WSAHOST_NOT_FOUND;
+
+ if (service)
+ {
+ const char *protocol =
+ (hints && hints->ai_socktype == SOCK_DGRAM) ? "udp" : "tcp";
+ struct servent *srv = sys_getservbyname (service, protocol);
+
+ if (srv)
+ port = srv->s_port;
+ else if (*service >= '0' && *service <= '9')
+ {
+ char *endp;
+
+ port = strtoul (service, &endp, 10);
+ if (*endp || port > 65536)
+ return WSAHOST_NOT_FOUND;
+ port = sys_htons ((unsigned short) port);
+ }
+ else
+ return WSAHOST_NOT_FOUND;
+ }
+
+ gai_storage = xzalloc (sizeof *gai_storage);
+ gai_storage->sockaddr_in.sin_port = port;
+ host_info = sys_gethostbyname (node);
+ if (host_info)
+ {
+ memcpy (&gai_storage->sockaddr_in.sin_addr,
+ host_info->h_addr, host_info->h_length);
+ gai_storage->sockaddr_in.sin_family = host_info->h_addrtype;
+ }
+ else
+ {
+ /* Attempt to interpret host as numeric inet address. */
+ unsigned long numeric_addr = sys_inet_addr (node);
+
+ if (numeric_addr == -1)
+ {
+ free (gai_storage);
+ return WSAHOST_NOT_FOUND;
+ }
+
+ memcpy (&gai_storage->sockaddr_in.sin_addr, &numeric_addr,
+ sizeof (gai_storage->sockaddr_in.sin_addr));
+ gai_storage->sockaddr_in.sin_family = (hints) ? hints->ai_family : 0;
+ }
+
+ gai_storage->addrinfo.ai_addr =
+ (struct sockaddr *)&gai_storage->sockaddr_in;
+ gai_storage->addrinfo.ai_addrlen = sizeof (gai_storage->sockaddr_in);
+ gai_storage->addrinfo.ai_protocol = (hints) ? hints->ai_protocol : 0;
+ gai_storage->addrinfo.ai_socktype = (hints) ? hints->ai_socktype : 0;
+ gai_storage->addrinfo.ai_family = gai_storage->sockaddr_in.sin_family;
+ gai_storage->addrinfo.ai_next = NULL;
+
+ *res = &gai_storage->addrinfo;
+ rc = 0;
+ }
+
+ return rc;
+}
+
+void
+sys_freeaddrinfo (struct addrinfo *ai)
+{
+ if (winsock_lib == NULL)
+ {
+ errno = ENETDOWN;
+ return;
+ }
+
+ check_errno ();
+ if (pfn_freeaddrinfo)
+ pfn_freeaddrinfo (ai);
+ else
+ {
+ eassert (ai->ai_next == NULL);
+ xfree (ai);
+ }
+}
+
int
sys_shutdown (int s, int how)
{
unsigned long nblock = 0;
if (winsock_lib == NULL) emacs_abort ();
+ child_process *cp = fd_info[fd].cp;
+
+ /* If this is a non-blocking socket whose connection is in
+ progress or terminated with an error already, return the
+ proper error code to the caller. */
+ if (cp != NULL && (fd_info[fd].flags & FILE_CONNECT) != 0)
+ {
+ /* In case connection is in progress, ENOTCONN that would
+ result from calling pfn_send is not what callers expect. */
+ if (cp->status != STATUS_CONNECT_FAILED)
+ {
+ errno = EWOULDBLOCK;
+ return -1;
+ }
+ /* In case connection failed, use the actual error code
+ stashed by '_sys_wait_connect' in cp->errcode. */
+ else if (cp->errcode != 0)
+ {
+ pfn_WSASetLastError (cp->errcode);
+ set_errno ();
+ return -1;
+ }
+ }
+
/* TODO: implement select() properly so non-blocking I/O works. */
/* For now, make sure the write blocks. */
if (fd_info[fd].flags & FILE_NDELAY)
nchars = pfn_send (SOCK_HANDLE (fd), buffer, count, 0);
+ if (nchars == SOCKET_ERROR)
+ {
+ set_errno ();
+ DebPrint (("sys_write.send failed with error %d on socket %ld\n",
+ pfn_WSAGetLastError (), SOCK_HANDLE (fd)));
+ }
+
/* Set the socket back to non-blocking if it was before,
for other operations that support it. */
if (fd_info[fd].flags & FILE_NDELAY)
nblock = 1;
pfn_ioctlsocket (SOCK_HANDLE (fd), FIONBIO, &nblock);
}
-
- if (nchars == SOCKET_ERROR)
- {
- DebPrint (("sys_write.send failed with error %d on socket %ld\n",
- pfn_WSAGetLastError (), SOCK_HANDLE (fd)));
- set_errno ();
- }
}
else
{
\f
/* Emulation of SIOCGIFCONF and getifaddrs, see process.c. */
-extern Lisp_Object conv_sockaddr_to_lisp (struct sockaddr *, int);
+extern Lisp_Object conv_sockaddr_to_lisp (struct sockaddr *, ptrdiff_t);
/* Return information about network interface IFNAME, or about all
interfaces (if IFNAME is nil). */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
/* Setup w32_display_info structure for this frame. */
w32_initialize_display_info (build_string ("Console"));
+
+ /* Set up the keyboard hook. */
+ setup_w32_kbdhook ();
}
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
/* Added by Kevin Gallo */
#include <config.h>
+/* Override API version to get the latest functionality. */
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
#include <signal.h>
#include <stdio.h>
#include "coding.h"
#include "w32common.h"
+#include "w32inevt.h"
#ifdef WINDOWSNT
#include <mbstring.h>
#include "w32.h"
#endif
+#include <basetyps.h>
+#include <unknwn.h>
#include <commctrl.h>
#include <commdlg.h>
#include <shellapi.h>
static unsigned int sound_type = 0xFFFFFFFF;
#define MB_EMACS_SILENT (0xFFFFFFFF - 1)
+/* Special virtual key code for indicating "any" key. */
+#define VK_ANY 0xFF
+
+#ifndef WM_WTSSESSION_CHANGE
+/* 32-bit MinGW does not define these constants. */
+# define WM_WTSSESSION_CHANGE 0x02B1
+# define WTS_SESSION_LOCK 0x7
+#endif
+
+/* Keyboard hook state data. */
+static struct
+{
+ int hook_count; /* counter, if several windows are created */
+ HHOOK hook; /* hook handle */
+ HWND console; /* console window handle */
+
+ int lwindown; /* Left Windows key currently pressed (and hooked) */
+ int rwindown; /* Right Windows key currently pressed (and hooked) */
+ int winsdown; /* Number of handled keys currently pressed */
+ int send_win_up; /* Pass through the keyup for this Windows key press? */
+ int suppress_lone; /* Suppress simulated Windows keydown-keyup for this press? */
+ int winseen; /* Windows keys seen during this press? */
+
+ char alt_hooked[256]; /* hook Alt+[this key]? */
+ char lwin_hooked[256]; /* hook left Win+[this key]? */
+ char rwin_hooked[256]; /* hook right Win+[this key]? */
+} kbdhook;
+typedef HWND (WINAPI *GetConsoleWindow_Proc) (void);
+
+/* stdin, from w32console.c */
+extern HANDLE keyboard_handle;
+
/* Let the user specify a display with a frame.
nil stands for the selected frame--or, if that is not a w32 frame,
the first display on the list. */
post_msg (wmsg);
}
+#ifdef WINDOWSNT
+/* The Windows keyboard hook callback. */
+static LRESULT CALLBACK
+funhook (int code, WPARAM w, LPARAM l)
+{
+ INPUT inputs[2];
+ HWND focus = GetFocus ();
+ int console = 0;
+ KBDLLHOOKSTRUCT const *hs = (KBDLLHOOKSTRUCT*)l;
+
+ if (code < 0 || (hs->flags & LLKHF_INJECTED))
+ return CallNextHookEx (0, code, w, l);
+
+ /* The keyboard hook sees keyboard input on all processes (except
+ elevated ones, when Emacs itself is not elevated). As such,
+ care must be taken to only filter out keyboard input when Emacs
+ itself is on the foreground.
+
+ GetFocus returns a non-NULL window if another application is active,
+ and always for a console Emacs process. For a console Emacs, determine
+ focus by checking if the current foreground window is the process's
+ console window. */
+ if (focus == NULL && kbdhook.console != NULL)
+ {
+ if (GetForegroundWindow () == kbdhook.console)
+ {
+ focus = kbdhook.console;
+ console = 1;
+ }
+ }
+
+ /* First, check hooks for the left and right Windows keys. */
+ if (hs->vkCode == VK_LWIN || hs->vkCode == VK_RWIN)
+ {
+ if (focus != NULL && (w == WM_KEYDOWN || w == WM_SYSKEYDOWN))
+ {
+ /* The key is being pressed in an Emacs window. */
+ if (hs->vkCode == VK_LWIN && !kbdhook.lwindown)
+ {
+ kbdhook.lwindown = 1;
+ kbdhook.winseen = 1;
+ kbdhook.winsdown++;
+ }
+ else if (hs->vkCode == VK_RWIN && !kbdhook.rwindown)
+ {
+ kbdhook.rwindown = 1;
+ kbdhook.winseen = 1;
+ kbdhook.winsdown++;
+ }
+ /* Returning 1 here drops the keypress without further processing.
+ If the keypress was allowed to go through, the normal Windows
+ hotkeys would take over. */
+ return 1;
+ }
+ else if (kbdhook.winsdown > 0 && (w == WM_KEYUP || w == WM_SYSKEYUP))
+ {
+ /* A key that has been captured earlier is being released now. */
+ if (hs->vkCode == VK_LWIN && kbdhook.lwindown)
+ {
+ kbdhook.lwindown = 0;
+ kbdhook.winsdown--;
+ }
+ else if (hs->vkCode == VK_RWIN && kbdhook.rwindown)
+ {
+ kbdhook.rwindown = 0;
+ kbdhook.winsdown--;
+ }
+ if (kbdhook.winsdown == 0 && kbdhook.winseen)
+ {
+ if (!kbdhook.suppress_lone)
+ {
+ /* The Windows key was pressed, then released,
+ without any other key pressed simultaneously.
+ Normally, this opens the Start menu, but the user
+ can prevent this by setting the
+ w32-pass-[lr]window-to-system variable to
+ NIL. */
+ if (hs->vkCode == VK_LWIN && !NILP (Vw32_pass_lwindow_to_system) ||
+ hs->vkCode == VK_RWIN && !NILP (Vw32_pass_rwindow_to_system))
+ {
+ /* Not prevented - Simulate the keypress to the system. */
+ memset (inputs, 0, sizeof (inputs));
+ inputs[0].type = INPUT_KEYBOARD;
+ inputs[0].ki.wVk = hs->vkCode;
+ inputs[0].ki.wScan = hs->vkCode;
+ inputs[0].ki.dwFlags = KEYEVENTF_EXTENDEDKEY;
+ inputs[0].ki.time = 0;
+ inputs[1].type = INPUT_KEYBOARD;
+ inputs[1].ki.wVk = hs->vkCode;
+ inputs[1].ki.wScan = hs->vkCode;
+ inputs[1].ki.dwFlags
+ = KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP;
+ inputs[1].ki.time = 0;
+ SendInput (2, inputs, sizeof (INPUT));
+ }
+ else if (focus != NULL)
+ {
+ /* When not passed to system, must simulate privately to Emacs. */
+ PostMessage (focus, WM_SYSKEYDOWN, hs->vkCode, 0);
+ PostMessage (focus, WM_SYSKEYUP, hs->vkCode, 0);
+ }
+ }
+ }
+ if (kbdhook.winsdown == 0)
+ {
+ /* No Windows keys pressed anymore - clear the state flags. */
+ kbdhook.suppress_lone = 0;
+ kbdhook.winseen = 0;
+ }
+ if (!kbdhook.send_win_up)
+ {
+ /* Swallow this release message, as not to confuse
+ applications who did not get to see the original
+ WM_KEYDOWN message either. */
+ return 1;
+ }
+ kbdhook.send_win_up = 0;
+ }
+ }
+ else if (kbdhook.winsdown > 0)
+ {
+ /* Some other key was pressed while a captured Win key is down.
+ This is either an Emacs registered hotkey combination, or a
+ system hotkey. */
+ if (kbdhook.lwindown && kbdhook.lwin_hooked[hs->vkCode] ||
+ kbdhook.rwindown && kbdhook.rwin_hooked[hs->vkCode])
+ {
+ /* Hooked Win-x combination, do not pass the keypress to Windows. */
+ kbdhook.suppress_lone = 1;
+ }
+ else if (!kbdhook.suppress_lone)
+ {
+ /* Unhooked S-x combination; simulate the combination now
+ (will be seen by the system). */
+ memset (inputs, 0, sizeof (inputs));
+ inputs[0].type = INPUT_KEYBOARD;
+ inputs[0].ki.wVk = kbdhook.lwindown ? VK_LWIN : VK_RWIN;
+ inputs[0].ki.wScan = kbdhook.lwindown ? VK_LWIN : VK_RWIN;
+ inputs[0].ki.dwFlags = KEYEVENTF_EXTENDEDKEY;
+ inputs[0].ki.time = 0;
+ inputs[1].type = INPUT_KEYBOARD;
+ inputs[1].ki.wVk = hs->vkCode;
+ inputs[1].ki.wScan = hs->scanCode;
+ inputs[1].ki.dwFlags =
+ (hs->flags & LLKHF_EXTENDED) ? KEYEVENTF_EXTENDEDKEY : 0;
+ inputs[1].ki.time = 0;
+ SendInput (2, inputs, sizeof (INPUT));
+ /* Stop processing of this Win sequence here; the
+ corresponding keyup messages will come through the normal
+ channel when the keys are released. */
+ kbdhook.suppress_lone = 1;
+ kbdhook.send_win_up = 1;
+ /* Swallow the original keypress (as we want the Win key
+ down message simulated above to precede this real message). */
+ return 1;
+ }
+ }
+
+ /* Next, handle the registered Alt-* combinations. */
+ if ((w == WM_SYSKEYDOWN || w == WM_KEYDOWN)
+ && kbdhook.alt_hooked[hs->vkCode]
+ && focus != NULL
+ && (GetAsyncKeyState (VK_MENU) & 0x8000))
+ {
+ /* Prevent the system from getting this Alt-* key - suppress the
+ message and post as a normal keypress to Emacs. */
+ if (console)
+ {
+ INPUT_RECORD rec;
+ DWORD n;
+ rec.EventType = KEY_EVENT;
+ rec.Event.KeyEvent.bKeyDown = TRUE;
+ rec.Event.KeyEvent.wVirtualKeyCode = hs->vkCode;
+ rec.Event.KeyEvent.wVirtualScanCode = hs->scanCode;
+ rec.Event.KeyEvent.uChar.UnicodeChar = 0;
+ rec.Event.KeyEvent.dwControlKeyState =
+ ((GetAsyncKeyState (VK_LMENU) & 0x8000) ? LEFT_ALT_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_RMENU) & 0x8000) ? RIGHT_ALT_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_LCONTROL) & 0x8000) ? LEFT_CTRL_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_RCONTROL) & 0x8000) ? RIGHT_CTRL_PRESSED : 0)
+ | ((GetAsyncKeyState (VK_SHIFT) & 0x8000) ? SHIFT_PRESSED : 0)
+ | ((hs->flags & LLKHF_EXTENDED) ? ENHANCED_KEY : 0);
+ if (w32_console_unicode_input)
+ WriteConsoleInputW (keyboard_handle, &rec, 1, &n);
+ else
+ WriteConsoleInputA (keyboard_handle, &rec, 1, &n);
+ }
+ else
+ PostMessage (focus, w, hs->vkCode, 1 | (1<<29));
+ return 1;
+ }
+
+ /* The normal case - pass the message through. */
+ return CallNextHookEx (0, code, w, l);
+}
+
+/* Set up the hook; can be called several times, with matching
+ remove_w32_kbdhook calls. */
+void
+setup_w32_kbdhook (void)
+{
+ kbdhook.hook_count++;
+
+ /* Hooking is only available on NT architecture systems, as
+ indicated by the w32_kbdhook_active variable. */
+ if (kbdhook.hook_count == 1 && w32_kbdhook_active)
+ {
+ /* Get the handle of the Emacs console window. As the
+ GetConsoleWindow function is only available on Win2000+, a
+ hackish workaround described in Microsoft KB article 124103
+ (https://support.microsoft.com/en-us/kb/124103) is used for
+ NT 4 systems. */
+ GetConsoleWindow_Proc get_console = (GetConsoleWindow_Proc)
+ GetProcAddress (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow");
+
+ if (get_console != NULL)
+ kbdhook.console = get_console ();
+ else
+ {
+ GUID guid;
+ wchar_t *oldTitle = malloc (1024 * sizeof(wchar_t));
+ wchar_t newTitle[64];
+ int i;
+
+ CoCreateGuid (&guid);
+ StringFromGUID2 (&guid, newTitle, 64);
+ if (newTitle != NULL)
+ {
+ GetConsoleTitleW (oldTitle, 1024);
+ SetConsoleTitleW (newTitle);
+ for (i = 0; i < 25; i++)
+ {
+ Sleep (40);
+ kbdhook.console = FindWindowW (NULL, newTitle);
+ if (kbdhook.console != NULL)
+ break;
+ }
+ SetConsoleTitleW (oldTitle);
+ }
+ free (oldTitle);
+ }
+
+ /* Set the hook. */
+ kbdhook.hook = SetWindowsHookEx (WH_KEYBOARD_LL, funhook,
+ GetModuleHandle (NULL), 0);
+ }
+}
+
+/* Remove the hook. */
+void
+remove_w32_kbdhook (void)
+{
+ kbdhook.hook_count--;
+ if (kbdhook.hook_count == 0 && w32_kbdhook_active)
+ {
+ UnhookWindowsHookEx (kbdhook.hook);
+ kbdhook.hook = NULL;
+ }
+}
+#endif /* WINDOWSNT */
+
+/* Mark a specific key combination as hooked, preventing it to be
+ handled by the system. */
+void
+hook_w32_key (int hook, int modifier, int vkey)
+{
+ char *tbl = NULL;
+
+ switch (modifier)
+ {
+ case VK_MENU:
+ tbl = kbdhook.alt_hooked;
+ break;
+ case VK_LWIN:
+ tbl = kbdhook.lwin_hooked;
+ break;
+ case VK_RWIN:
+ tbl = kbdhook.rwin_hooked;
+ break;
+ }
+
+ if (tbl != NULL && vkey >= 0 && vkey <= 255)
+ {
+ /* VK_ANY hooks all keys for this modifier */
+ if (vkey == VK_ANY)
+ memset (tbl, (char)hook, 256);
+ else
+ tbl[vkey] = (char)hook;
+ /* Alt-<modifier>s should go through */
+ kbdhook.alt_hooked[VK_MENU] = 0;
+ kbdhook.alt_hooked[VK_LMENU] = 0;
+ kbdhook.alt_hooked[VK_RMENU] = 0;
+ kbdhook.alt_hooked[VK_CONTROL] = 0;
+ kbdhook.alt_hooked[VK_LCONTROL] = 0;
+ kbdhook.alt_hooked[VK_RCONTROL] = 0;
+ kbdhook.alt_hooked[VK_SHIFT] = 0;
+ kbdhook.alt_hooked[VK_LSHIFT] = 0;
+ kbdhook.alt_hooked[VK_RSHIFT] = 0;
+ }
+}
+
+/* Check the current Win key pressed state. */
+int
+check_w32_winkey_state (int vkey)
+{
+ /* The hook code handles grabbing of the Windows keys and Alt-* key
+ combinations reserved by the system. Handling Alt is a bit
+ easier, as Windows intends Alt-* shortcuts for application use in
+ Windows; hotkeys such as Alt-tab and Alt-escape are special
+ cases. Win-* hotkeys, on the other hand, are primarily meant for
+ system use.
+
+ As a result, when we want Emacs to be able to grab the Win-*
+ keys, we must swallow all Win key presses in a low-level keyboard
+ hook. Unfortunately, this means that the Emacs window procedure
+ (and console input handler) never see the keypresses either.
+ Thus, to check the modifier states properly, Emacs code must use
+ the check_w32_winkey_state function that uses the flags directly
+ updated by the hook callback. */
+ switch (vkey)
+ {
+ case VK_LWIN:
+ return kbdhook.lwindown;
+ case VK_RWIN:
+ return kbdhook.rwindown;
+ }
+ return 0;
+}
+
+/* Reset the keyboard hook state. Locking the workstation with Win-L
+ leaves the Win key(s) "down" from the hook's point of view - the
+ keyup event is never seen. Thus, this function must be called when
+ the system is locked. */
+void
+reset_w32_kbdhook_state (void)
+{
+ kbdhook.lwindown = 0;
+ kbdhook.rwindown = 0;
+ kbdhook.winsdown = 0;
+ kbdhook.send_win_up = 0;
+ kbdhook.suppress_lone = 0;
+ kbdhook.winseen = 0;
+}
+
/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
between left and right keys as advertised. We test for this
support dynamically, and set a flag when the support is absent. If
else
return (GetKeyState (vkey) & 0x1);
}
+ if (w32_kbdhook_active && (vkey == VK_LWIN || vkey == VK_RWIN))
+ return check_w32_winkey_state (vkey);
if (!modifiers_recorded)
return (GetKeyState (vkey) & 0x8000);
/* List of special key combinations which w32 would normally capture,
but Emacs should grab instead. Not directly visible to lisp, to
simplify synchronization. Each item is an integer encoding a virtual
- key code and modifier combination to capture. */
+ key code and modifier combination to capture.
+ Note: This code is not used if keyboard hooks are active
+ (Windows 2000 and later). */
static Lisp_Object w32_grabbed_keys;
#define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
switch (wParam)
{
case VK_LWIN:
- if (NILP (Vw32_pass_lwindow_to_system))
+ if (!w32_kbdhook_active && NILP (Vw32_pass_lwindow_to_system))
{
/* Prevent system from acting on keyup (which opens the
Start menu if no other key was pressed) by simulating a
return 0;
break;
case VK_RWIN:
- if (NILP (Vw32_pass_rwindow_to_system))
+ if (!w32_kbdhook_active && NILP (Vw32_pass_rwindow_to_system))
{
if (GetAsyncKeyState (wParam) & 1)
{
case WM_SETFOCUS:
dpyinfo->faked_key = 0;
reset_modifiers ();
- register_hot_keys (hwnd);
+ if (!w32_kbdhook_active)
+ register_hot_keys (hwnd);
goto command;
case WM_KILLFOCUS:
- unregister_hot_keys (hwnd);
+ if (!w32_kbdhook_active)
+ unregister_hot_keys (hwnd);
button_state = 0;
ReleaseCapture ();
/* Relinquish the system caret. */
my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
goto dflt;
+#ifdef WINDOWSNT
+ case WM_CREATE:
+ setup_w32_kbdhook ();
+ goto dflt;
+#endif
+
case WM_DESTROY:
+#ifdef WINDOWSNT
+ remove_w32_kbdhook ();
+#endif
CoUninitialize ();
return 0;
+ case WM_WTSSESSION_CHANGE:
+ if (wParam == WTS_SESSION_LOCK)
+ reset_w32_kbdhook_state ();
+ goto dflt;
+
case WM_CLOSE:
wmsg.dwModifiers = w32_get_modifiers ();
my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
doc: /* Internal function called by `color-defined-p', which see.
- (Note that the Nextstep version of this function ignores FRAME.) */)
+ \(Note that the Nextstep version of this function ignores FRAME.) */)
(Lisp_Object color, Lisp_Object frame)
{
XColor foo;
DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
doc: /* Return the "vendor ID" string of the GUI software on TERMINAL.
- (Labeling every distributor as a "vendor" embodies the false assumption
+ \(Labeling every distributor as a "vendor" embodies the false assumption
that operating systems cannot be developed and distributed noncommercially.)
For GNU and Unix systems, this queries the X server software; for
Optional second arg XRM-STRING is a string of resources in xrdb format.
If the optional third arg MUST-SUCCEED is non-nil,
terminate Emacs if we can't open the connection.
- (In the Nextstep version, the last two arguments are currently ignored.) */)
+ \(In the Nextstep version, the last two arguments are currently ignored.) */)
(Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
{
char *xrm_option;
Tool tips
***********************************************************************/
-static Lisp_Object x_create_tip_frame (struct w32_display_info *,
- Lisp_Object, Lisp_Object);
static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, int, int, int *, int *);
/* Create a frame for a tooltip on the display described by DPYINFO.
- PARMS is a list of frame parameters. TEXT is the string to
- display in the tip frame. Value is the frame.
+ PARMS is a list of frame parameters. Value is the frame.
Note that functions called here, esp. x_default_parameter can
signal errors, for instance when a specified color name is
when this happens. */
static Lisp_Object
-x_create_tip_frame (struct w32_display_info *dpyinfo,
- Lisp_Object parms, Lisp_Object text)
+x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
{
struct frame *f;
Lisp_Object frame;
ptrdiff_t count = SPECPDL_INDEX ();
struct kboard *kb;
bool face_change_before = face_change;
- Lisp_Object buffer;
- struct buffer *old_buffer;
int x_width = 0, x_height = 0;
/* Use this general default value to start with until we know if
frame = Qnil;
/* Make a frame without minibuffer nor mode-line. */
f = make_frame (false);
- f->wants_modeline = 0;
+ f->wants_modeline = false;
XSETFRAME (frame, f);
- AUTO_STRING (tip, " *tip*");
- buffer = Fget_buffer_create (tip);
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
- old_buffer = current_buffer;
- set_buffer_internal_1 (XBUFFER (buffer));
- bset_truncate_lines (current_buffer, Qnil);
- specbind (Qinhibit_read_only, Qt);
- specbind (Qinhibit_modification_hooks, Qt);
- Ferase_buffer ();
- Finsert (1, &text);
- set_buffer_internal_1 (old_buffer);
-
record_unwind_protect (unwind_create_tip_frame, frame);
/* By setting the output method, we're essentially saying that
{
fset_name (f, name);
f->explicit_name = true;
- /* use the frame's title when getting resources for this frame. */
+ /* Use the frame's title when getting resources for this frame. */
specbind (Qx_resource_name, name);
}
parms = Fcons (Fcons (Qinternal_border_width, value),
parms);
}
+
x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
"internalBorderWidth", "internalBorderWidth",
RES_TYPE_NUMBER);
- x_default_parameter (f, parms, Qright_divider_width, make_number (0),
- NULL, NULL, RES_TYPE_NUMBER);
- x_default_parameter (f, parms, Qbottom_divider_width, make_number (0),
- NULL, NULL, RES_TYPE_NUMBER);
-
/* Also do the stuff which must be set before the window exists. */
x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
"foreground", "Foreground", RES_TYPE_STRING);
f->fringe_cols = 0;
f->left_fringe_width = 0;
f->right_fringe_width = 0;
+ /* No dividers on tip frame. */
+ f->right_divider_width = 0;
+ f->bottom_divider_width = 0;
block_input ();
my_create_tip_window (f);
SET_FRAME_LINES (f, 0);
adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
-
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
Lisp_Object fg = Fframe_parameter (frame, Qforeground_color);
Lisp_Object colors = Qnil;
- /* Set tip_frame here, so that */
- tip_frame = frame;
call2 (Qface_set_after_frame_default, frame, Qnil);
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
*root_x = min_x;
}
+/* Hide tooltip. Delete its frame if DELETE is true. */
+static Lisp_Object
+x_hide_tip (bool delete)
+{
+ if (!NILP (tip_timer))
+ {
+ call1 (Qcancel_timer, tip_timer);
+ tip_timer = Qnil;
+ }
+
+ if (NILP (tip_frame)
+ || (!delete && FRAMEP (tip_frame)
+ && !FRAME_VISIBLE_P (XFRAME (tip_frame))))
+ return Qnil;
+ else
+ {
+ ptrdiff_t count;
+ Lisp_Object was_open = Qnil;
+
+ count = SPECPDL_INDEX ();
+ specbind (Qinhibit_redisplay, Qt);
+ specbind (Qinhibit_quit, Qt);
+
+ if (FRAMEP (tip_frame))
+ {
+ if (delete)
+ {
+ delete_frame (tip_frame, Qnil);
+ tip_frame = Qnil;
+ }
+ else
+ x_make_frame_invisible (XFRAME (tip_frame));
+
+ was_open = Qt;
+ }
+ else
+ tip_frame = Qnil;
+
+ return unbind_to (count, was_open);
+ }
+}
+
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
Text larger than the specified size is clipped. */)
(Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
{
- struct frame *f;
+ struct frame *f, *tip_f;
struct window *w;
int root_x, root_y;
struct buffer *old_buffer;
struct text_pos pos;
int i, width, height;
- bool seen_reversed_p;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count_1;
+ Lisp_Object window, size;
specbind (Qinhibit_redisplay, Qt);
if (NILP (last_show_tip_args))
last_show_tip_args = Fmake_vector (make_number (3), Qnil);
- if (!NILP (tip_frame))
+ if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)))
{
Lisp_Object last_string = AREF (last_show_tip_args, 0);
Lisp_Object last_frame = AREF (last_show_tip_args, 1);
Lisp_Object last_parms = AREF (last_show_tip_args, 2);
- if (EQ (frame, last_frame)
- && !NILP (Fequal (last_string, string))
+ if (FRAME_VISIBLE_P (XFRAME (tip_frame))
+ && EQ (frame, last_frame)
+ && !NILP (Fequal_including_properties (last_string, string))
&& !NILP (Fequal (last_parms, parms)))
{
- struct frame *f = XFRAME (tip_frame);
-
/* Only DX and DY have changed. */
+ tip_f = XFRAME (tip_frame);
if (!NILP (tip_timer))
{
Lisp_Object timer = tip_timer;
+
tip_timer = Qnil;
call1 (Qcancel_timer, timer);
}
block_input ();
- compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
- FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
+ compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f),
+ FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y);
/* Put tooltip in topmost group and in position. */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOPMOST,
root_x, root_y, 0, 0,
SWP_NOSIZE | SWP_NOACTIVATE | SWP_NOOWNERZORDER);
/* Ensure tooltip is on top of other topmost windows (eg menus). */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOP,
0, 0, 0, 0,
SWP_NOMOVE | SWP_NOSIZE
| SWP_NOACTIVATE | SWP_NOOWNERZORDER);
+ /* Let redisplay know that we have made the frame visible already. */
+ SET_FRAME_VISIBLE (tip_f, 1);
+ ShowWindow (FRAME_W32_WINDOW (tip_f), SW_SHOWNOACTIVATE);
unblock_input ();
+
goto start_timer;
}
- }
+ else if (tooltip_reuse_hidden_frame && EQ (frame, last_frame))
+ {
+ bool delete = false;
+ Lisp_Object tail, elt, parm, last;
+
+ /* Check if every parameter in PARMS has the same value in
+ last_parms. This may destruct last_parms which, however,
+ will be recreated below. */
+ for (tail = parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = Fcar (elt);
+ /* The left, top, right and bottom parameters are handled
+ by compute_tip_xy so they can be ignored here. */
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop)
+ && !EQ (parm, Qright) && !EQ (parm, Qbottom))
+ {
+ last = Fassq (parm, last_parms);
+ if (NILP (Fequal (Fcdr (elt), Fcdr (last))))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
- /* Hide a previous tip, if any. */
- Fx_hide_tip ();
+ /* Now check if there's a parameter left in last_parms with a
+ non-nil value. */
+ for (tail = last_parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = Fcar (elt);
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright)
+ && !EQ (parm, Qbottom) && !NILP (Fcdr (elt)))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ }
+
+ x_hide_tip (delete);
+ }
+ else
+ x_hide_tip (true);
+ }
+ else
+ x_hide_tip (true);
ASET (last_show_tip_args, 0, string);
ASET (last_show_tip_args, 1, frame);
ASET (last_show_tip_args, 2, parms);
- /* Add default values to frame parameters. */
- if (NILP (Fassq (Qname, parms)))
- parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
- if (NILP (Fassq (Qinternal_border_width, parms)))
- parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
- if (NILP (Fassq (Qright_divider_width, parms)))
- parms = Fcons (Fcons (Qright_divider_width, make_number (0)), parms);
- if (NILP (Fassq (Qbottom_divider_width, parms)))
- parms = Fcons (Fcons (Qbottom_divider_width, make_number (0)), parms);
- if (NILP (Fassq (Qborder_width, parms)))
- parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
- if (NILP (Fassq (Qborder_color, parms)))
- parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
- if (NILP (Fassq (Qbackground_color, parms)))
- parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
- parms);
-
/* Block input until the tip has been fully drawn, to avoid crashes
when drawing tips in menus. */
block_input ();
- /* Create a frame for the tooltip, and record it in the global
- variable tip_frame. */
- frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, string);
- f = XFRAME (frame);
+ if (!FRAMEP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame)))
+ {
+ /* Add default values to frame parameters. */
+ if (NILP (Fassq (Qname, parms)))
+ parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
+ if (NILP (Fassq (Qinternal_border_width, parms)))
+ parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
+ if (NILP (Fassq (Qborder_width, parms)))
+ parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
+ if (NILP (Fassq (Qborder_color, parms)))
+ parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
+ if (NILP (Fassq (Qbackground_color, parms)))
+ parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
+ parms);
+
+ /* Create a frame for the tooltip, and record it in the global
+ variable tip_frame. */
+ if (NILP (tip_frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms)))
+ {
+ /* Creating the tip frame failed. */
+ unblock_input ();
+ return unbind_to (count, Qnil);
+ }
+ }
+
+ tip_f = XFRAME (tip_frame);
+ window = FRAME_ROOT_WINDOW (tip_f);
+ AUTO_STRING (tip, " *tip*");
+ set_window_buffer (window, Fget_buffer_create (tip), false, false);
+ w = XWINDOW (window);
+ w->pseudo_window_p = true;
- /* Set up the frame's root window. */
- w = XWINDOW (FRAME_ROOT_WINDOW (f));
+ /* Set up the frame's root window. Note: The following code does not
+ try to size the window or its frame correctly. Its only purpose is
+ to make the subsequent text size calculations work. The right
+ sizes should get installed when the toolkit gets back to us. */
w->left_col = 0;
w->top_line = 0;
w->pixel_left = 0;
w->pixel_top = 0;
if (CONSP (Vx_max_tooltip_size)
- && INTEGERP (XCAR (Vx_max_tooltip_size))
- && XINT (XCAR (Vx_max_tooltip_size)) > 0
- && INTEGERP (XCDR (Vx_max_tooltip_size))
- && XINT (XCDR (Vx_max_tooltip_size)) > 0)
+ && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX)
+ && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX))
{
w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size));
w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size));
w->total_lines = 40;
}
- w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (f);
- w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (f);
-
- FRAME_TOTAL_COLS (f) = WINDOW_TOTAL_COLS (w);
- adjust_frame_glyphs (f);
- w->pseudo_window_p = true;
+ w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (tip_f);
+ w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (tip_f);
+ FRAME_TOTAL_COLS (tip_f) = WINDOW_TOTAL_COLS (w);
+ adjust_frame_glyphs (tip_f);
- /* Display the tooltip text in a temporary buffer. */
+ /* Insert STRING into the root window's buffer and fit the frame to
+ the buffer. */
+ count_1 = SPECPDL_INDEX ();
old_buffer = current_buffer;
- set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
+ set_buffer_internal_1 (XBUFFER (w->contents));
bset_truncate_lines (current_buffer, Qnil);
+ specbind (Qinhibit_read_only, Qt);
+ specbind (Qinhibit_modification_hooks, Qt);
+ specbind (Qinhibit_point_motion_hooks, Qt);
+ Ferase_buffer ();
+ Finsert (1, &string);
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
- try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
-
- /* Compute width and height of the tooltip. */
- width = height = 0;
- seen_reversed_p = false;
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- /* Stop at the first empty row at the end. */
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
-
- /* Let the row go over the full width of the frame. */
- row->full_width_p = true;
-
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA])
- {
- if (!row->reversed_p)
- {
- /* There's a glyph at the end of rows that is used to
- place the cursor there. Don't include the width of
- this glyph. */
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
- else
- {
- /* There could be a stretch glyph at the beginning of R2L
- rows that is produced by extend_face_to_end_of_line.
- Don't count that glyph. */
- struct glyph *g = row->glyphs[TEXT_AREA];
-
- if (g->type == STRETCH_GLYPH && NILP (g->object))
- {
- row_width -= g->pixel_width;
- seen_reversed_p = true;
- }
- }
- }
-
- height += row->height;
- width = max (width, row_width);
- }
-
- /* If we've seen partial-length R2L rows, we need to re-adjust the
- tool-tip frame width and redisplay it again, to avoid over-wide
- tips due to the stretch glyph that extends R2L lines to full
- width of the frame. */
- if (seen_reversed_p)
- {
- /* PXW: Why do we do the pixel-to-cols conversion only if
- seen_reversed_p holds? Don't we have to set other fields of
- the window/frame structure?
-
- w->total_cols and FRAME_TOTAL_COLS want the width in columns,
- not in pixels. */
- w->pixel_width = width;
- width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = width;
- FRAME_TOTAL_COLS (f) = width;
- SET_FRAME_WIDTH (f, width);
- adjust_frame_glyphs (f);
- w->pseudo_window_p = 1;
- clear_glyph_matrix (w->desired_matrix);
- clear_glyph_matrix (w->current_matrix);
- try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
- width = height = 0;
- /* Recompute width and height of the tooltip. */
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
- row->full_width_p = true;
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA] && !row->reversed_p)
- {
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
-
- height += row->height;
- width = max (width, row_width);
- }
- }
-
- /* Add the frame's internal border to the width and height the w32
- window should have. */
- height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
- width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
-
- /* Move the tooltip window where the mouse pointer is. Resize and
- show it.
-
- PXW: This should use the frame's pixel coordinates. */
- compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
-
+ try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
+ /* Calculate size of tooltip window. */
+ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil,
+ make_number (w->pixel_height), Qnil);
+ /* Add the frame's internal border to calculated size. */
+ width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+ height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+ /* Calculate position of tooltip frame. */
+ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y);
+
+ /* Show tooltip frame. */
{
- /* Adjust Window size to take border into account. */
RECT rect;
+ int pad = (NUMBERP (Vw32_tooltip_extra_pixels)
+ ? max (0, XINT (Vw32_tooltip_extra_pixels))
+ : FRAME_COLUMN_WIDTH (tip_f));
+
rect.left = rect.top = 0;
rect.right = width;
rect.bottom = height;
- AdjustWindowRect (&rect, f->output_data.w32->dwStyle, false);
-
- /* Position and size tooltip, and put it in the topmost group.
- The add-on of FRAME_COLUMN_WIDTH to the 5th argument is a
- peculiarity of w32 display: without it, some fonts cause the
- last character of the tip to be truncated or wrapped around to
- the next line. */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
+ AdjustWindowRect (&rect, tip_f->output_data.w32->dwStyle,
+ FRAME_EXTERNAL_MENU_BAR (tip_f));
+
+ /* Position and size tooltip and put it in the topmost group. */
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOPMOST,
root_x, root_y,
- rect.right - rect.left + FRAME_COLUMN_WIDTH (f),
+ rect.right - rect.left + pad,
rect.bottom - rect.top, SWP_NOACTIVATE | SWP_NOOWNERZORDER);
/* Ensure tooltip is on top of other topmost windows (eg menus). */
- SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
+ SetWindowPos (FRAME_W32_WINDOW (tip_f), HWND_TOP,
0, 0, 0, 0,
SWP_NOMOVE | SWP_NOSIZE
| SWP_NOACTIVATE | SWP_NOOWNERZORDER);
/* Let redisplay know that we have made the frame visible already. */
- SET_FRAME_VISIBLE (f, 1);
+ SET_FRAME_VISIBLE (tip_f, 1);
- ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
+ ShowWindow (FRAME_W32_WINDOW (tip_f), SW_SHOWNOACTIVATE);
}
- /* Draw into the window. */
w->must_be_updated_p = true;
update_single_window (w);
-
- unblock_input ();
-
- /* Restore original current buffer. */
set_buffer_internal_1 (old_buffer);
+ unbind_to (count_1, Qnil);
+ unblock_input ();
windows_or_buffers_changed = old_windows_or_buffers_changed;
start_timer:
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- ptrdiff_t count;
- Lisp_Object deleted, frame, timer;
-
- /* Return quickly if nothing to do. */
- if (NILP (tip_timer) && NILP (tip_frame))
- return Qnil;
-
- frame = tip_frame;
- timer = tip_timer;
- tip_frame = tip_timer = deleted = Qnil;
-
- count = SPECPDL_INDEX ();
- specbind (Qinhibit_redisplay, Qt);
- specbind (Qinhibit_quit, Qt);
-
- if (!NILP (timer))
- call1 (Qcancel_timer, timer);
-
- if (FRAMEP (frame))
- {
- delete_frame (frame, Qnil);
- deleted = Qt;
- }
-
- return unbind_to (count, deleted);
+ return x_hide_tip (!tooltip_reuse_hidden_frame);
}
\f
/***********************************************************************
&& strcmp (lispy_function_keys[i], key) == 0)
return i;
+ if (w32_kbdhook_active)
+ {
+ /* Alphanumerics map to themselves. */
+ if (key[1] == 0)
+ {
+ if (key[0] >= 'A' && key[0] <= 'Z' ||
+ key[0] >= '0' && key[0] <= '9')
+ return key[0];
+ if (key[0] >= 'a' && key[0] <= 'z')
+ return toupper(key[0]);
+ }
+ }
+
return -1;
}
/* Convert a one-element vector style key sequence to a hot key
definition. */
static Lisp_Object
-w32_parse_hot_key (Lisp_Object key)
+w32_parse_and_hook_hot_key (Lisp_Object key, int hook)
{
/* Copied from Fdefine_key and store_in_keymap. */
register Lisp_Object c;
int vk_code;
int lisp_modifiers;
int w32_modifiers;
+ Lisp_Object res = Qnil;
+ char* vkname;
CHECK_VECTOR (key);
c = Fcar (c);
if (!SYMBOLP (c))
emacs_abort ();
- vk_code = lookup_vk_code (SSDATA (SYMBOL_NAME (c)));
+ vkname = SSDATA (SYMBOL_NAME (c));
+ /* [s-], [M-], [h-]: Register all keys for this modifier */
+ if (w32_kbdhook_active && vkname[0] == 0)
+ vk_code = VK_ANY;
+ else
+ vk_code = lookup_vk_code (vkname);
}
else if (INTEGERP (c))
{
#define MOD_WIN 0x0008
#endif
- /* Convert lisp modifiers to Windows hot-key form. */
- w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
- w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
- w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
- w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
+ if (w32_kbdhook_active)
+ {
+ /* Register Alt-x combinations. */
+ if (lisp_modifiers & alt_modifier)
+ {
+ hook_w32_key (hook, VK_MENU, vk_code);
+ res = Qt;
+ }
+ /* Register Win-x combinations based on modifier mappings. */
+ if (((lisp_modifiers & hyper_modifier)
+ && EQ (Vw32_lwindow_modifier, Qhyper))
+ || ((lisp_modifiers & super_modifier)
+ && EQ (Vw32_lwindow_modifier, Qsuper)))
+ {
+ hook_w32_key (hook, VK_LWIN, vk_code);
+ res = Qt;
+ }
+ if (((lisp_modifiers & hyper_modifier)
+ && EQ (Vw32_rwindow_modifier, Qhyper))
+ || ((lisp_modifiers & super_modifier)
+ && EQ (Vw32_rwindow_modifier, Qsuper)))
+ {
+ hook_w32_key (hook, VK_RWIN, vk_code);
+ res = Qt;
+ }
+ return res;
+ }
+ else
+ {
+ /* Convert lisp modifiers to Windows hot-key form. */
+ w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
+ w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
+ w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
+ w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
- return HOTKEY (vk_code, w32_modifiers);
+ return HOTKEY (vk_code, w32_modifiers);
+ }
}
DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
Sw32_register_hot_key, 1, 1, 0,
doc: /* Register KEY as a hot-key combination.
-Certain key combinations like Alt-Tab are reserved for system use on
-Windows, and therefore are normally intercepted by the system. However,
-most of these key combinations can be received by registering them as
-hot-keys, overriding their special meaning.
-
-KEY must be a one element key definition in vector form that would be
-acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
-modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
-is always interpreted as the Windows modifier keys.
-
-The return value is the hotkey-id if registered, otherwise nil. */)
+Certain key combinations like Alt-Tab and Win-R are reserved for
+system use on Windows, and therefore are normally intercepted by the
+system. These key combinations can be received by registering them
+as hot-keys, except for Win-L which always locks the computer.
+
+On Windows 98 and ME, KEY must be a one element key definition in
+vector form that would be acceptable to `define-key' (e.g. [A-tab] for
+Alt-Tab). The meta modifier is interpreted as Alt if
+`w32-alt-is-meta' is t, and hyper is always interpreted as the Windows
+modifier keys. The return value is the hotkey-id if registered, otherwise nil.
+
+On Windows versions since NT, KEY can also be specified as [M-], [s-] or
+[h-] to indicate that all combinations of that key should be processed
+by Emacs instead of the operating system. The super and hyper
+modifiers are interpreted according to the current values of
+`w32-lwindow-modifier' and `w32-rwindow-modifier'. For instance,
+setting `w32-lwindow-modifier' to `super' and then calling
+`(register-hot-key [s-])' grabs all combinations of the left Windows
+key to Emacs, but leaves the right Windows key free for the operating
+system keyboard shortcuts. The return value is t if the call affected
+any key combinations, otherwise nil. */)
(Lisp_Object key)
{
- key = w32_parse_hot_key (key);
+ key = w32_parse_and_hook_hot_key (key, 1);
- if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
+ if (!w32_kbdhook_active
+ && !NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
{
/* Reuse an empty slot if possible. */
Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
Lisp_Object item;
if (!INTEGERP (key))
- key = w32_parse_hot_key (key);
+ key = w32_parse_and_hook_hot_key (key, 0);
+
+ if (w32_kbdhook_active)
+ return key;
item = Fmemq (key, w32_grabbed_keys);
Sw32_set_mouse_absolute_pixel_position, 2, 2, 0,
doc: /* Move mouse pointer to absolute pixel position (X, Y).
The coordinates X and Y are interpreted in pixels relative to a position
- (0, 0) of the selected frame's display. */)
+ \(0, 0) of the selected frame's display. */)
(Lisp_Object x, Lisp_Object y)
{
UINT trail_num = 0;
DEFSYM (Qmm_size, "mm-size");
DEFSYM (Qframes, "frames");
DEFSYM (Qtip_frame, "tip-frame");
+ DEFSYM (Qassq_delete_all, "assq-delete-all");
DEFSYM (Qunicode_sip, "unicode-sip");
#if defined WINDOWSNT && !defined HAVE_DBUS
DEFSYM (QCicon, ":icon");
If you set this to nil, the left \"Windows\" key is processed by Emacs
according to the value of `w32-lwindow-modifier', which see.
-Note that some combinations of the left \"Windows\" key with other keys are
-caught by Windows at low level, and so binding them in Emacs will have no
-effect. For example, <lwindow>-r always pops up the Windows Run dialog,
-<lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
-the doc string of `w32-phantom-key-code'. */);
+Note that some combinations of the left \"Windows\" key with other
+keys are caught by Windows at low level. For example, <lwindow>-r
+pops up the Windows Run dialog, <lwindow>-<Pause> pops up the "System
+Properties" dialog, etc. On Windows 10, no \"Windows\" key
+combinations are normally handed to applications. To enable Emacs to
+process \"Windows\" key combinations, use the function
+`w32-register-hot-key`.
+
+For Windows 98/ME, see the doc string of `w32-phantom-key-code'. */);
Vw32_pass_lwindow_to_system = Qt;
DEFVAR_LISP ("w32-pass-rwindow-to-system",
If you set this to nil, the right \"Windows\" key is processed by Emacs
according to the value of `w32-rwindow-modifier', which see.
-Note that some combinations of the right \"Windows\" key with other keys are
-caught by Windows at low level, and so binding them in Emacs will have no
-effect. For example, <rwindow>-r always pops up the Windows Run dialog,
-<rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
-the doc string of `w32-phantom-key-code'. */);
+Note that some combinations of the right \"Windows\" key with other
+keys are caught by Windows at low level. For example, <rwindow>-r
+pops up the Windows Run dialog, <rwindow>-<Pause> pops up the "System
+Properties" dialog, etc. On Windows 10, no \"Windows\" key
+combinations are normally handed to applications. To enable Emacs to
+process \"Windows\" key combinations, use the function
+`w32-register-hot-key`.
+
+For Windows 98/ME, see the doc string of `w32-phantom-key-code'. */);
Vw32_pass_rwindow_to_system = Qt;
DEFVAR_LISP ("w32-phantom-key-code",
Phantom key presses are generated in order to stop the system from
acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
-`w32-pass-rwindow-to-system' is nil. */);
+`w32-pass-rwindow-to-system' is nil.
+
+This variable is only used on Windows 98 and ME. For other Windows
+versions, see the documentation of the `w32-register-hot-key`
+function. */);
/* Although 255 is technically not a valid key code, it works and
means that this hack won't interfere with any real key code. */
XSETINT (Vw32_phantom_key_code, 255);
doc: /* Modifier to use for the left \"Windows\" key.
The value can be hyper, super, meta, alt, control or shift for the
respective modifier, or nil to appear as the `lwindow' key.
-Any other value will cause the key to be ignored. */);
+Any other value will cause the key to be ignored.
+
+Also see the documentation of the `w32-register-hot-key` function. */);
Vw32_lwindow_modifier = Qnil;
DEFVAR_LISP ("w32-rwindow-modifier",
doc: /* Modifier to use for the right \"Windows\" key.
The value can be hyper, super, meta, alt, control or shift for the
respective modifier, or nil to appear as the `rwindow' key.
-Any other value will cause the key to be ignored. */);
+Any other value will cause the key to be ignored.
+
+Also see the documentation of the `w32-register-hot-key` function. */);
Vw32_rwindow_modifier = Qnil;
DEFVAR_LISP ("w32-apps-modifier",
This variable has effect only on Windows Vista and later. */);
w32_disable_new_uniscribe_apis = 0;
+ DEFVAR_LISP ("w32-tooltip-extra-pixels",
+ Vw32_tooltip_extra_pixels,
+ doc: /* Number of pixels added after tooltip text.
+On Windows some fonts may cause the last character of a tooltip be
+truncated or wrapped around to the next line. Adding some extra space
+at the end of the toooltip works around this problem.
+
+This variable specifies the number of pixels that shall be added. The
+default value t means to add the width of one canonical character of the
+tip frame. */);
+ Vw32_tooltip_extra_pixels = Qt;
+
#if 0 /* TODO: Port to W32 */
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include "termchar.h" /* for Mouse_HLInfo, tty_display_info */
#include "w32term.h"
#include "w32inevt.h"
+#include "w32common.h"
/* stdin, from w32console.c */
extern HANDLE keyboard_handle;
switch (event->wVirtualKeyCode)
{
case VK_LWIN:
- mod_key_state &= ~LEFT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state &= ~LEFT_WIN_PRESSED;
break;
case VK_RWIN:
- mod_key_state &= ~RIGHT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state &= ~RIGHT_WIN_PRESSED;
break;
case VK_APPS:
mod_key_state &= ~APPS_PRESSED;
keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0);
}
}
- mod_key_state |= LEFT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state |= LEFT_WIN_PRESSED;
if (!NILP (Vw32_lwindow_modifier))
return 0;
break;
keybd_event (faked_key, (BYTE) MapVirtualKey (faked_key, 0), 0, 0);
}
}
- mod_key_state |= RIGHT_WIN_PRESSED;
+ if (!w32_kbdhook_active)
+ mod_key_state |= RIGHT_WIN_PRESSED;
if (!NILP (Vw32_rwindow_modifier))
return 0;
break;
/* Recognize state of Windows and Apps keys. */
event->dwControlKeyState |= mod_key_state;
+ if (w32_kbdhook_active)
+ {
+ if (check_w32_winkey_state (VK_LWIN))
+ event->dwControlKeyState |= LEFT_WIN_PRESSED;
+ if (check_w32_winkey_state (VK_RWIN))
+ event->dwControlKeyState |= RIGHT_WIN_PRESSED;
+ }
/* Distinguish numeric keypad keys from extended keys. */
event->wVirtualKeyCode =
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
extern void w32_initialize_display_info (Lisp_Object);
extern void initialize_w32_display (struct terminal *, int *, int *);
+#ifdef WINDOWSNT
+/* Keyboard hooks. */
+extern void setup_w32_kbdhook (void);
+extern void remove_w32_kbdhook (void);
+extern int check_w32_winkey_state (int);
+#define w32_kbdhook_active (os_subtype != OS_9X)
+#else
+#define w32_kbdhook_active 0
+#endif
+
/* Keypad command key support. W32 doesn't have virtual keys defined
for the function keys on the keypad (they are mapped to the standard
function keys), so we define our own. */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
static bool window_resize_check (struct window *, bool);
static void window_resize_apply (struct window *, bool);
static void select_window_1 (Lisp_Object, bool);
+static void run_window_configuration_change_hook (struct frame *);
static struct window *set_window_fringes (struct window *, Lisp_Object,
Lisp_Object, Lisp_Object);
WINDOW must be a valid window used in horizontal or vertical combination.
If LIMIT is nil, child windows of WINDOW can be recombined with WINDOW's
siblings. LIMIT t means that child windows of WINDOW are never
- (re-)combined with WINDOW's siblings. Other values are reserved for
+ \(re-)combined with WINDOW's siblings. Other values are reserved for
future use. */)
(Lisp_Object window, Lisp_Object limit)
{
return make_number (decode_valid_window (window)->pixel_height);
}
+DEFUN ("window-pixel-width-before-size-change",
+ Fwindow_pixel_width_before_size_change,
+ Swindow_pixel_width_before_size_change, 0, 1, 0,
+ doc: /* Return pixel width of window WINDOW before last size changes.
+WINDOW must be a valid window and defaults to the selected one.
+
+The return value is the pixel width of WINDOW at the last time
+`window-size-change-functions' was run. It's zero if WINDOW was made
+after that. */)
+ (Lisp_Object window)
+{
+ return (make_number
+ (decode_valid_window (window)->pixel_width_before_size_change));
+}
+
+DEFUN ("window-pixel-height-before-size-change",
+ Fwindow_pixel_height_before_size_change,
+ Swindow_pixel_height_before_size_change, 0, 1, 0,
+ doc: /* Return pixel height of window WINDOW before last size changes.
+WINDOW must be a valid window and defaults to the selected one.
+
+The return value is the pixel height of WINDOW at the last time
+`window-size-change-functions' was run. It's zero if WINDOW was made
+after that. */)
+ (Lisp_Object window)
+{
+ return (make_number
+ (decode_valid_window (window)->pixel_height_before_size_change));
+}
+
DEFUN ("window-total-height", Fwindow_total_height, Swindow_total_height, 0, 2, 0,
doc: /* Return the height of window WINDOW in lines.
WINDOW must be a valid window and defaults to the selected one.
WINDOW must be a live window and defaults to the selected one.
COORDINATES is a cons of the form (X . Y), X and Y being distances
measured in characters from the upper-left corner of the frame.
- (0 . 0) denotes the character in the upper left corner of the
+ \(0 . 0) denotes the character in the upper left corner of the
frame.
If COORDINATES are in the text portion of WINDOW,
the coordinates relative to the window are returned.
POS is fully visible; otherwise, RTOP and RBOT are the number of pixels
off-window at the top and bottom of the screen line ("row") containing
POS, ROWH is the visible height of that row, and VPOS is the row number
- (zero-based). */)
+ \(zero-based). */)
(Lisp_Object pos, Lisp_Object window, Lisp_Object partially)
{
struct window *w;
Lisp_Object sibling, pwindow, swindow IF_LINT (= Qnil), delta;
ptrdiff_t startpos IF_LINT (= 0), startbyte IF_LINT (= 0);
int top IF_LINT (= 0), new_top;
+ bool resize_failed = false;
w = decode_valid_window (window);
XSETWINDOW (window, w);
fset_redisplay (f);
Vwindow_list = Qnil;
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
- bool resize_failed = false;
if (!WINDOW_LEAF_P (w))
{
Fselect_frame (frame, Qt);
}
-void
+static void
run_window_configuration_change_hook (struct frame *f)
{
ptrdiff_t count = SPECPDL_INDEX ();
return Qnil;
}
+
+/* Compare old and present pixel sizes of windows in tree rooted at W.
+ Return true iff any of these windows differs in size. */
+
+static bool
+window_size_changed (struct window *w)
+{
+ if (w->pixel_width != w->pixel_width_before_size_change
+ || w->pixel_height != w->pixel_height_before_size_change)
+ return true;
+
+ if (WINDOW_INTERNAL_P (w))
+ {
+ w = XWINDOW (w->contents);
+ while (w)
+ {
+ if (window_size_changed (w))
+ return true;
+
+ w = NILP (w->next) ? 0 : XWINDOW (w->next);
+ }
+ }
+
+ return false;
+}
+
+/* Set before size change pixel sizes of windows in tree rooted at W to
+ their present pixel sizes. */
+
+static void
+window_set_before_size_change_sizes (struct window *w)
+{
+ w->pixel_width_before_size_change = w->pixel_width;
+ w->pixel_height_before_size_change = w->pixel_height;
+
+ if (WINDOW_INTERNAL_P (w))
+ {
+ w = XWINDOW (w->contents);
+ while (w)
+ {
+ window_set_before_size_change_sizes (w);
+ w = NILP (w->next) ? 0 : XWINDOW (w->next);
+ }
+ }
+}
+
+
+void
+run_window_size_change_functions (Lisp_Object frame)
+{
+ struct frame *f = XFRAME (frame);
+ struct window *r = XWINDOW (FRAME_ROOT_WINDOW (f));
+ Lisp_Object functions = Vwindow_size_change_functions;
+
+ if (FRAME_WINDOW_CONFIGURATION_CHANGED (f)
+ || window_size_changed (r))
+ {
+ while (CONSP (functions))
+ {
+ if (!EQ (XCAR (functions), Qt))
+ call1 (XCAR (functions), frame);
+ functions = XCDR (functions);
+ }
+
+ window_set_before_size_change_sizes (r);
+ FRAME_WINDOW_CONFIGURATION_CHANGED (f) = false;
+ }
+}
+
+
/* Make WINDOW display BUFFER. RUN_HOOKS_P means it's allowed
to run hooks. See make_frame for a case where it's not allowed.
KEEP_MARGINS_P means that the current margins, fringes, and
if (!(keep_margins_p && samebuf))
{ /* If we're not actually changing the buffer, don't reset hscroll
- and vscroll. This case happens for example when called from
- change_frame_size_1, where we use a dummy call to
- Fset_window_buffer on the frame's selected window (and no
- other) just in order to run window-configuration-change-hook
- (no longer true since change_frame_size_1 directly calls
- run_window_configuration_change_hook). Resetting hscroll and
- vscroll here is problematic for things like image-mode and
- doc-view-mode since it resets the image's position whenever we
- resize the frame. */
+ and vscroll. Resetting hscroll and vscroll here is problematic
+ for things like image-mode and doc-view-mode since it resets
+ the image's position whenever we resize the frame. */
w->hscroll = w->min_hscroll = w->hscroll_whole = 0;
w->suspend_auto_hscroll = false;
w->vscroll = 0;
w->start_at_line_beg = false;
w->force_start = false;
}
- /* Maybe we could move this into the `if' but it's not obviously safe and
- I doubt it's worth the trouble. */
- wset_redisplay (w);
+ wset_redisplay (w);
wset_update_mode_line (w);
/* We must select BUFFER to run the window-scroll-functions and to look up
if (run_hooks_p)
{
- if (! NILP (Vwindow_scroll_functions))
+ if (!NILP (Vwindow_scroll_functions))
run_hook_with_args_2 (Qwindow_scroll_functions, window,
Fmarker_position (w->start));
if (!samebuf)
w->phys_cursor_width = -1;
#endif
w->sequence_number = ++sequence_number;
+ w->pixel_width_before_size_change = 0;
+ w->pixel_height_before_size_change = 0;
w->scroll_bar_width = -1;
w->scroll_bar_height = -1;
w->column_number_displayed = -1;
window_resize_apply (r, horflag);
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
}
-/* Resize frame F's windows when F's width or height is set to SIZE.
- If HORFLAG is zero, F's width was set to SIZE, otherwise its height
- was set. SIZE is interpreted in F's canonical character units
- (a.k.a. "columns" or "lines"), unless PIXELWISE is non-zero, which
- means to interpret SIZE in pixel units. */
+/* Resize frame F's windows when number of lines of F is set to SIZE.
+ HORFLAG means resize windows when number of columns of F is set to
+ SIZE. PIXELWISE means to interpret SIZE as pixels. */
void
resize_frame_windows (struct frame *f, int size, bool horflag, bool pixelwise)
{
m = XWINDOW (mini);
if (horflag)
{
- m->total_cols = new_size;
+ m->total_cols = size;
m->pixel_width = new_pixel_size;
}
else
}
}
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
fset_redisplay (f);
}
p = XWINDOW (o->parent);
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
new = make_window ();
n = XWINDOW (new);
wset_frame (n, frame);
fset_redisplay (f);
Vwindow_list = Qnil;
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
wset_next (w, Qnil); /* Don't delete w->next too. */
free_window_matrices (w);
}
else
unblock_input ();
-
- /* Must be run by the caller:
- run_window_configuration_change_hook (f); */
}
else
/* We failed: Relink WINDOW into window tree. */
/* Enforce full redisplay of the frame. */
/* FIXME: Shouldn't window--resize-root-window-vertically do it? */
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
}
/* Enforce full redisplay of the frame. */
/* FIXME: Shouldn't window--resize-root-window-vertically do it? */
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
}
w->top_line = r->top_line + r->total_lines;
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
adjust_frame_glyphs (f);
unblock_input ();
return Qt;
Lisp_Object window, buffer, start, pointm, old_pointm;
Lisp_Object pixel_left, pixel_top, pixel_height, pixel_width;
+ Lisp_Object pixel_height_before_size_change, pixel_width_before_size_change;
Lisp_Object left_col, top_line, total_cols, total_lines;
Lisp_Object normal_cols, normal_lines;
Lisp_Object hscroll, min_hscroll, hscroll_whole, suspend_auto_hscroll;
struct window *root_window;
struct window **leaf_windows;
ptrdiff_t i, k, n_leaf_windows;
+ /* Records whether a window has been added or removed wrt the
+ original configuration. */
+ bool window_changed = false;
+ /* Records whether a window has changed its buffer wrt the
+ original configuration. */
+ bool buffer_changed = false;
/* Don't do this within the main loop below: This may call Lisp
code and is thus potentially unsafe while input is blocked. */
p = SAVED_WINDOW_N (saved_windows, k);
window = p->window;
w = XWINDOW (window);
+
+ if (NILP (w->contents))
+ /* A dead window that will be resurrected, the window
+ configuration will change. */
+ window_changed = true;
+
if (BUFFERP (w->contents)
&& !EQ (w->contents, p->buffer)
&& BUFFER_LIVE_P (XBUFFER (p->buffer)))
}
fset_redisplay (f);
- FRAME_WINDOW_SIZES_CHANGED (f) = true;
/* Problem: Freeing all matrices and later allocating them again
is a serious redisplay flickering problem. What we would
w->pixel_top = XFASTINT (p->pixel_top);
w->pixel_width = XFASTINT (p->pixel_width);
w->pixel_height = XFASTINT (p->pixel_height);
+ w->pixel_width_before_size_change
+ = XFASTINT (p->pixel_width_before_size_change);
+ w->pixel_height_before_size_change
+ = XFASTINT (p->pixel_height_before_size_change);
w->left_col = XFASTINT (p->left_col);
w->top_line = XFASTINT (p->top_line);
w->total_cols = XFASTINT (p->total_cols);
if (BUFFERP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
/* If saved buffer is alive, install it. */
{
+ if (!EQ (w->contents, p->buffer))
+ /* Record buffer configuration change. */
+ buffer_changed = true;
wset_buffer (w, p->buffer);
w->start_at_line_beg = !NILP (p->start_at_line_beg);
set_marker_restricted (w->start, p->start, w->contents);
else if (!NILP (w->start))
/* Leaf window has no live buffer, get one. */
{
+ /* Record buffer configuration change. */
+ buffer_changed = true;
/* Get the buffer via other_buffer_safely in order to
avoid showing an unimportant buffer and, if necessary, to
recreate *scratch* in the course (part of Juanma's bs-show
/* Now, free glyph matrices in windows that were not reused. */
for (i = 0; i < n_leaf_windows; i++)
if (NILP (leaf_windows[i]->contents))
- free_window_matrices (leaf_windows[i]);
+ {
+ free_window_matrices (leaf_windows[i]);
+ window_changed = true;
+ }
/* Allow x_set_window_size again and apply frame size changes if
needed. */
/* Record the selected window's buffer here. The window should
already be the selected one from the call above. */
- select_window (data->current_window, Qnil, false);
+ if (WINDOW_LIVE_P (data->current_window))
+ select_window (data->current_window, Qnil, false);
/* Fselect_window will have made f the selected frame, so we
reselect the proper frame here. Fhandle_switch_frame will change the
if (FRAME_LIVE_P (XFRAME (data->selected_frame)))
do_switch_frame (data->selected_frame, 0, 0, Qnil);
- run_window_configuration_change_hook (f);
+ if (window_changed)
+ /* At least one window has been added or removed. Run
+ `window-configuration-change-hook' and make sure
+ `window-size-change-functions' get run later.
+
+ We have to do this in order to capture the following
+ scenario: Suppose our frame contains two live windows W1 and
+ W2 and ‘set-window-configuration’ replaces them by two
+ windows W3 and W4 that were dead the last time
+ run_window_size_change_functions was run. If W3 and W4 have
+ the same values for their old and new pixel sizes but these
+ values differ from those of W1 and W2, the sizes of our
+ frame's two live windows changed but window_size_changed has
+ no means to detect that fact.
+
+ Obviously, this will get us false positives, for example,
+ when we restore the original configuration with W1 and W2
+ before run_window_size_change_functions gets called. */
+ {
+ run_window_configuration_change_hook (f);
+ FRAME_WINDOW_CONFIGURATION_CHANGED (f) = true;
+ }
+ else if (buffer_changed)
+ /* At least one window has changed its buffer. Run
+ `window-configuration-change-hook' only. */
+ run_window_configuration_change_hook (f);
}
if (!NILP (new_current_buffer))
p->pixel_top = make_number (w->pixel_top);
p->pixel_width = make_number (w->pixel_width);
p->pixel_height = make_number (w->pixel_height);
+ p->pixel_width_before_size_change
+ = make_number (w->pixel_width_before_size_change);
+ p->pixel_height_before_size_change
+ = make_number (w->pixel_height_before_size_change);
p->left_col = make_number (w->left_col);
p->top_line = make_number (w->top_line);
p->total_cols = make_number (w->total_cols);
with the relevant frame selected. */);
Vwindow_configuration_change_hook = Qnil;
+ DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions,
+ doc: /* Functions called during redisplay, if window sizes have changed.
+The value should be a list of functions that take one argument.
+During the first part of redisplay, for each frame, if any of its windows
+have changed size since the last redisplay, or have been split or deleted,
+all the functions in the list are called, with the frame as argument.
+If redisplay decides to resize the minibuffer window, it calls these
+functions on behalf of that as well. */);
+ Vwindow_size_change_functions = Qnil;
+
DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay,
doc: /* Non-nil means `recenter' redraws entire frame.
If this option is non-nil, then the `recenter' command with a nil
defsubr (&Swindow_use_time);
defsubr (&Swindow_pixel_width);
defsubr (&Swindow_pixel_height);
+ defsubr (&Swindow_pixel_width_before_size_change);
+ defsubr (&Swindow_pixel_height_before_size_change);
defsubr (&Swindow_total_width);
defsubr (&Swindow_total_height);
defsubr (&Swindow_normal_size);
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
int pixel_width;
int pixel_height;
+ /* The pixel sizes of the window at the last time
+ `window-size-change-functions' was run. */
+ int pixel_width_before_size_change;
+ int pixel_height_before_size_change;
+
/* The size of the window. */
int total_cols;
int total_lines;
#define WINDOW_LEAF_P(W) \
(BUFFERP ((W)->contents))
-/* True if W is a member of horizontal combination. */
+/* Non-nil if W is internal. */
+#define WINDOW_INTERNAL_P(W) \
+ (WINDOWP ((W)->contents))
+/* True if W is a member of horizontal combination. */
#define WINDOW_HORIZONTAL_COMBINATION_P(W) \
- (WINDOWP ((W)->contents) && (W)->horizontal)
+ (WINDOW_INTERNAL_P (W) && (W)->horizontal)
/* True if W is a member of vertical combination. */
-
#define WINDOW_VERTICAL_COMBINATION_P(W) \
- (WINDOWP ((W)->contents) && !(W)->horizontal)
+ (WINDOW_INTERNAL_P (W) && !(W)->horizontal)
/* WINDOW's XFRAME. */
#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W))))
extern void shrink_mini_window (struct window *, bool);
extern int window_relative_x_coord (struct window *, enum window_part, int);
-void run_window_configuration_change_hook (struct frame *f);
+void run_window_size_change_functions (Lisp_Object);
/* Make WINDOW display BUFFER. RUN_HOOKS_P means it's allowed
to run hooks. See make_frame for a case where it's not allowed. */
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
The optional argument FROM, if non-nil, specifies the first text
position and defaults to the minimum accessible position of the buffer.
-If FROM is t, use the minimum accessible position that is not a newline
-character. TO, if non-nil, specifies the last text position and
+If FROM is t, use the minimum accessible position that starts a
+non-empty line. TO, if non-nil, specifies the last text position and
defaults to the maximum accessible position of the buffer. If TO is t,
-use the maximum accessible position that is not a newline character.
+use the maximum accessible position that ends a non-empty line.
The optional argument X-LIMIT, if non-nil, specifies the maximum text
width that can be returned. X-LIMIT nil or omitted, means to use the
-pixel-width of WINDOW's body; use this if you do not intend to change
-the width of WINDOW. Use the maximum width WINDOW may assume if you
-intend to change WINDOW's width. In any case, text whose x-coordinate
-is beyond X-LIMIT is ignored. Since calculating the width of long lines
-can take some time, it's always a good idea to make this argument as
-small as possible; in particular, if the buffer contains long lines that
-shall be truncated anyway.
+pixel-width of WINDOW's body; use this if you want to know how high
+WINDOW should be become in order to fit all of its buffer's text with
+the width of WINDOW unaltered. Use the maximum width WINDOW may assume
+if you intend to change WINDOW's width. In any case, text whose
+x-coordinate is beyond X-LIMIT is ignored. Since calculating the width
+of long lines can take some time, it's always a good idea to make this
+argument as small as possible; in particular, if the buffer contains
+long lines that shall be truncated anyway.
The optional argument Y-LIMIT, if non-nil, specifies the maximum text
-height that can be returned. Text lines whose y-coordinate is beyond
-Y-LIMIT are ignored. Since calculating the text height of a large
-buffer can take some time, it makes sense to specify this argument if
-the size of the buffer is unknown.
+height (exluding the height of the mode- or header-line, if any) that
+can be returned. Text lines whose y-coordinate is beyond Y-LIMIT are
+ignored. Since calculating the text height of a large buffer can take
+some time, it makes sense to specify this argument if the size of the
+buffer is large or unknown.
Optional argument MODE-AND-HEADER-LINE nil or omitted means do not
include the height of the mode- or header-line of WINDOW in the return
ptrdiff_t start, end, pos;
struct text_pos startp;
void *itdata = NULL;
- int c, max_y = -1, x = 0, y = 0;
+ int c, max_x = 0, max_y = 0, x = 0, y = 0;
CHECK_BUFFER (buffer);
b = XBUFFER (buffer);
end = max (start, min (XINT (to), ZV));
}
- if (!NILP (y_limit))
- {
- CHECK_NUMBER (y_limit);
- max_y = min (XINT (y_limit), INT_MAX);
- }
+ if (!NILP (x_limit) && RANGED_INTEGERP (0, x_limit, INT_MAX))
+ max_x = XINT (x_limit);
+
+ if (NILP (y_limit))
+ max_y = INT_MAX;
+ else if (RANGED_INTEGERP (0, y_limit, INT_MAX))
+ max_y = XINT (y_limit);
itdata = bidi_shelve_cache ();
SET_TEXT_POS (startp, start, CHAR_TO_BYTE (start));
x = move_it_to (&it, end, -1, max_y, -1, MOVE_TO_POS | MOVE_TO_Y);
else
{
- CHECK_NUMBER (x_limit);
- it.last_visible_x = min (XINT (x_limit), INFINITY);
+ it.last_visible_x = max_x;
/* Actually, we never want move_it_to stop at to_x. But to make
sure that move_it_in_display_line_to always moves far enough,
- we set it to INT_MAX and specify MOVE_TO_X. */
- x = move_it_to (&it, end, INT_MAX, max_y, -1,
- MOVE_TO_POS | MOVE_TO_X | MOVE_TO_Y);
+ we set it to INT_MAX and specify MOVE_TO_X. Also bound width
+ value by X-LIMIT. */
+ x = min (move_it_to (&it, end, INT_MAX, max_y, -1,
+ MOVE_TO_POS | MOVE_TO_X | MOVE_TO_Y),
+ max_x);
}
- y = it.current_y + it.max_ascent + it.max_descent;
+ /* Subtract height of header-line which was counted automatically by
+ start_display. */
+ y = min (it.current_y + it.max_ascent + it.max_descent
+ - WINDOW_HEADER_LINE_HEIGHT (w),
+ max_y);
- if (!EQ (mode_and_header_line, Qheader_line)
- && !EQ (mode_and_header_line, Qt))
- /* Do not count the header-line which was counted automatically by
- start_display. */
- y = y - WINDOW_HEADER_LINE_HEIGHT (w);
+ if (EQ (mode_and_header_line, Qheader_line)
+ || EQ (mode_and_header_line, Qt))
+ /* Re-add height of header-line as requested. */
+ y = y + WINDOW_HEADER_LINE_HEIGHT (w);
if (EQ (mode_and_header_line, Qmode_line)
|| EQ (mode_and_header_line, Qt))
- /* Do count the mode-line which is not included automatically by
- start_display. */
+ /* Add height of mode-line as requested. */
y = y + WINDOW_MODE_LINE_HEIGHT (w);
bidi_unshelve_cache (itdata, false);
&& !XBUFFER (w->contents)->text->redisplay)
continue;
- /* If a window on this frame changed size, report that to
- the user and clear the size-change flag. */
- if (FRAME_WINDOW_SIZES_CHANGED (f))
- {
- Lisp_Object functions;
-
- /* Clear flag first in case we get an error below. */
- FRAME_WINDOW_SIZES_CHANGED (f) = false;
- functions = Vwindow_size_change_functions;
-
- while (CONSP (functions))
- {
- if (!EQ (XCAR (functions), Qt))
- call1 (XCAR (functions), frame);
- functions = XCDR (functions);
- }
- }
-
+ run_window_size_change_functions (frame);
menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
#ifdef HAVE_WINDOW_SYSTEM
update_tool_bar (f, false);
it's too late for the hooks in window-size-change-functions,
which have been examined already in prepare_menu_bars. So in
that case we call the hooks here only for the selected frame. */
- if (sf->redisplay && FRAME_WINDOW_SIZES_CHANGED (sf))
+ if (sf->redisplay)
{
- Lisp_Object functions;
ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_save_match_data ();
-
- /* Clear flag first in case we get an error below. */
- FRAME_WINDOW_SIZES_CHANGED (sf) = false;
- functions = Vwindow_size_change_functions;
-
- while (CONSP (functions))
- {
- if (!EQ (XCAR (functions), Qt))
- call1 (XCAR (functions), selected_frame);
- functions = XCDR (functions);
- }
-
+ run_window_size_change_functions (selected_frame);
unbind_to (count1, Qnil);
}
{
if (sf->redisplay)
{
- Lisp_Object functions;
ptrdiff_t count1 = SPECPDL_INDEX ();
record_unwind_save_match_data ();
-
- /* Clear flag first in case we get an error below. */
- FRAME_WINDOW_SIZES_CHANGED (sf) = false;
- functions = Vwindow_size_change_functions;
-
- while (CONSP (functions))
- {
- if (!EQ (XCAR (functions), Qt))
- call1 (XCAR (functions), selected_frame);
- functions = XCDR (functions);
- }
-
+ run_window_size_change_functions (selected_frame);
unbind_to (count1, Qnil);
}
}
else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
{
- Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf);
- struct frame *mini_frame;
-
displayed_buffer = XBUFFER (XWINDOW (selected_window)->contents);
/* Use list_of_error, not Qerror, so that
we catch only errors and don't run the debugger. */
list_of_error,
redisplay_window_error);
if (update_miniwindow_p)
- internal_condition_case_1 (redisplay_window_1, mini_window,
- list_of_error,
+ internal_condition_case_1 (redisplay_window_1,
+ FRAME_MINIBUF_WINDOW (sf), list_of_error,
redisplay_window_error);
/* Compare desired and current matrices, perform output. */
have put text on a frame other than the selected one, so the
above call to update_frame would not have caught it. Catch
it here. */
- mini_window = FRAME_MINIBUF_WINDOW (sf);
- mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window)));
+ Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf);
+ struct frame *mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window)));
if (mini_frame != sf && FRAME_WINDOW_P (mini_frame))
{
bool last_line_misfit = false;
ptrdiff_t beg_unchanged, end_unchanged;
int frame_line_height;
+ bool use_desired_matrix;
SET_TEXT_POS (lpoint, PT, PT_BYTE);
opoint = lpoint;
startp = run_window_scroll_functions (window, it.current.pos);
/* Redisplay the window. */
- bool use_desired_matrix = false;
+ use_desired_matrix = false;
if (!current_matrix_up_to_date_p
|| windows_or_buffers_changed
|| f->cursor_type_changed
DEFVAR_LISP ("frame-title-format", Vframe_title_format,
doc: /* Template for displaying the title bar of visible frames.
- (Assuming the window manager supports this feature.)
+ \(Assuming the window manager supports this feature.)
This variable has the same structure as `mode-line-format', except that
the %c and %l constructs are ignored. It is used only on frames for
DEFVAR_LISP ("icon-title-format", Vicon_title_format,
doc: /* Template for displaying the title bar of an iconified frame.
- (Assuming the window manager supports this feature.)
+ \(Assuming the window manager supports this feature.)
This variable has the same structure as `mode-line-format' (which see),
and is used only on frames for which no explicit name has been set
- (see `modify-frame-parameters'). */);
+ \(see `modify-frame-parameters'). */);
Vicon_title_format
= Vframe_title_format
= listn (CONSTYPE_PURE, 3,
the buffer when it becomes large. */);
Vmessage_log_max = make_number (1000);
- DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions,
- doc: /* Functions called during redisplay, if window sizes have changed.
-The value should be a list of functions that take one argument.
-During the first part of redisplay, for each frame, if any of its windows
-have changed size since the last redisplay, or have been split or deleted,
-all the functions in the list are called, with the frame as argument.
-If redisplay decides to resize the minibuffer window, it calls these
-functions on behalf of that as well. */);
- Vwindow_size_change_functions = Qnil;
-
DEFVAR_LISP ("window-scroll-functions", Vwindow_scroll_functions,
doc: /* List of functions to call before redisplaying a window with scrolling.
Each function is called with two arguments, the window and its new
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
}
#endif /* not USE_X_TOOLKIT && not USE_GTK */
adjust_frame_glyphs (f);
- run_window_configuration_change_hook (f);
}
\f
DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
doc: /* Internal function called by `color-defined-p', which see.
- (Note that the Nextstep version of this function ignores FRAME.) */)
+ \(Note that the Nextstep version of this function ignores FRAME.) */)
(Lisp_Object color, Lisp_Object frame)
{
XColor foo;
DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
doc: /* Return the "vendor ID" string of the GUI software on TERMINAL.
- (Labeling every distributor as a "vendor" embodies the false assumption
+ \(Labeling every distributor as a "vendor" embodies the false assumption
that operating systems cannot be developed and distributed noncommercially.)
The optional argument TERMINAL specifies which display to ask about.
RROutput pxid = None;
struct MonitorInfo *monitors;
- #ifdef HAVE_XRRGETSCREENRESOURCESCURRENT
- resources = XRRGetScreenResourcesCurrent (dpy, dpyinfo->root_window);
+ #define RANDR13_LIBRARY \
+ (RANDR_MAJOR > 1 || (RANDR_MAJOR == 1 && RANDR_MINOR >= 3))
+
+ #if RANDR13_LIBRARY
+ /* Check if the display supports 1.3 too. */
+ bool randr13_avail = (dpyinfo->xrandr_major_version > 1
+ || (dpyinfo->xrandr_major_version == 1
+ && dpyinfo->xrandr_minor_version >= 3));
+
+ if (randr13_avail)
+ resources = XRRGetScreenResourcesCurrent (dpy, dpyinfo->root_window);
+ else
+ resources = XRRGetScreenResources (dpy, dpyinfo->root_window);
#else
resources = XRRGetScreenResources (dpy, dpyinfo->root_window);
#endif
n_monitors = resources->noutput;
monitors = xzalloc (n_monitors * sizeof *monitors);
- #ifdef HAVE_XRRGETOUTPUTPRIMARY
- pxid = XRRGetOutputPrimary (dpy, dpyinfo->root_window);
+ #ifdef RANDR13_LIBRARY
+ if (randr13_avail)
+ pxid = XRRGetOutputPrimary (dpy, dpyinfo->root_window);
#endif
for (i = 0; i < n_monitors; ++i)
xrr_ok = XRRQueryExtension (dpy, &xrr_event_base, &xrr_error_base);
if (xrr_ok)
{
- int xrr_major, xrr_minor;
- XRRQueryVersion (dpy, &xrr_major, &xrr_minor);
- xrr_ok = (xrr_major == 1 && xrr_minor >= 2) || xrr_major > 1;
+ XRRQueryVersion (dpy, &dpyinfo->xrandr_major_version,
+ &dpyinfo->xrandr_minor_version);
+ xrr_ok = ((dpyinfo->xrandr_major_version == 1
+ && dpyinfo->xrandr_minor_version >= 2)
+ || dpyinfo->xrandr_major_version > 1);
}
if (xrr_ok)
Sx_set_mouse_absolute_pixel_position, 2, 2, 0,
doc: /* Move mouse pointer to absolute pixel position (X, Y).
The coordinates X and Y are interpreted in pixels relative to a position
- (0, 0) of the selected frame's display. */)
+ \(0, 0) of the selected frame's display. */)
(Lisp_Object x, Lisp_Object y)
{
struct frame *f = SELECTED_FRAME ();
Optional second arg XRM-STRING is a string of resources in xrdb format.
If the optional third arg MUST-SUCCEED is non-nil,
terminate Emacs if we can't open the connection.
- (In the Nextstep version, the last two arguments are currently ignored.) */)
+ \(In the Nextstep version, the last two arguments are currently ignored.) */)
(Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed)
{
char *xrm_option;
Tool tips
***********************************************************************/
-static Lisp_Object x_create_tip_frame (struct x_display_info *,
- Lisp_Object, Lisp_Object);
static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, int, int, int *, int *);
when this happens. */
static Lisp_Object
-x_create_tip_frame (struct x_display_info *dpyinfo,
- Lisp_Object parms,
- Lisp_Object text)
+x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
{
struct frame *f;
Lisp_Object frame;
int width, height;
ptrdiff_t count = SPECPDL_INDEX ();
bool face_change_before = face_change;
- Lisp_Object buffer;
- struct buffer *old_buffer;
int x_width = 0, x_height = 0;
if (!dpyinfo->terminal->name)
error ("Invalid frame name--not a string or nil");
frame = Qnil;
- f = make_frame (true);
+ f = make_frame (false);
+ f->wants_modeline = false;
XSETFRAME (frame, f);
-
- AUTO_STRING (tip, " *tip*");
- buffer = Fget_buffer_create (tip);
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, false, false);
- old_buffer = current_buffer;
- set_buffer_internal_1 (XBUFFER (buffer));
- bset_truncate_lines (current_buffer, Qnil);
- specbind (Qinhibit_read_only, Qt);
- specbind (Qinhibit_modification_hooks, Qt);
- Ferase_buffer ();
- Finsert (1, &text);
- set_buffer_internal_1 (old_buffer);
-
record_unwind_protect (unwind_create_tip_frame, frame);
f->terminal = dpyinfo->terminal;
{
Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
- /* Set tip_frame here, so that */
- tip_frame = frame;
call2 (Qface_set_after_frame_default, frame, Qnil);
if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
}
+/* Hide tooltip. Delete its frame if DELETE is true. */
+static Lisp_Object
+x_hide_tip (bool delete)
+{
+ if (!NILP (tip_timer))
+ {
+ call1 (Qcancel_timer, tip_timer);
+ tip_timer = Qnil;
+ }
+
+
+ if (NILP (tip_frame)
+ || (!delete && FRAMEP (tip_frame)
+ && !FRAME_VISIBLE_P (XFRAME (tip_frame))))
+ return Qnil;
+ else
+ {
+ ptrdiff_t count;
+ Lisp_Object was_open = Qnil;
+
+ count = SPECPDL_INDEX ();
+ specbind (Qinhibit_redisplay, Qt);
+ specbind (Qinhibit_quit, Qt);
+
+#ifdef USE_GTK
+ {
+ /* When using system tooltip, tip_frame is the Emacs frame on
+ which the tip is shown. */
+ struct frame *f = XFRAME (tip_frame);
+
+ if (FRAME_LIVE_P (f) && xg_hide_tooltip (f))
+ {
+ tip_frame = Qnil;
+ was_open = Qt;
+ }
+ }
+#endif
+
+ if (FRAMEP (tip_frame))
+ {
+ if (delete)
+ {
+ delete_frame (tip_frame, Qnil);
+ tip_frame = Qnil;
+ }
+ else
+ x_make_frame_invisible (XFRAME (tip_frame));
+
+ was_open = Qt;
+
+#ifdef USE_LUCID
+ /* Bloodcurdling hack alert: The Lucid menu bar widget's
+ redisplay procedure is not called when a tip frame over
+ menu items is unmapped. Redisplay the menu manually... */
+ {
+ Widget w;
+ struct frame *f = SELECTED_FRAME ();
+ if (FRAME_X_P (f) && FRAME_LIVE_P (f))
+ {
+ w = f->output_data.x->menubar_widget;
+
+ if (!DoesSaveUnders (FRAME_DISPLAY_INFO (f)->screen)
+ && w != NULL)
+ {
+ block_input ();
+ xlwmenu_redisplay (w);
+ unblock_input ();
+ }
+ }
+ }
+#endif /* USE_LUCID */
+ }
+ else
+ tip_frame = Qnil;
+
+ return unbind_to (count, was_open);
+ }
+}
+
DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
doc: /* Show STRING in a "tooltip" window on frame FRAME.
A tooltip window is a small X window displaying a string.
Text larger than the specified size is clipped. */)
(Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy)
{
- struct frame *f;
+ struct frame *f, *tip_f;
struct window *w;
int root_x, root_y;
struct buffer *old_buffer;
struct text_pos pos;
- int i, width, height;
- bool seen_reversed_p;
+ int width, height;
int old_windows_or_buffers_changed = windows_or_buffers_changed;
ptrdiff_t count = SPECPDL_INDEX ();
+ ptrdiff_t count_1;
+ Lisp_Object window, size;
+ AUTO_STRING (tip, " *tip*");
specbind (Qinhibit_redisplay, Qt);
if (NILP (last_show_tip_args))
last_show_tip_args = Fmake_vector (make_number (3), Qnil);
- if (!NILP (tip_frame))
+ if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame)))
{
Lisp_Object last_string = AREF (last_show_tip_args, 0);
Lisp_Object last_frame = AREF (last_show_tip_args, 1);
Lisp_Object last_parms = AREF (last_show_tip_args, 2);
- if (EQ (frame, last_frame)
- && !NILP (Fequal (last_string, string))
+ if (FRAME_VISIBLE_P (XFRAME (tip_frame))
+ && EQ (frame, last_frame)
+ && !NILP (Fequal_including_properties (last_string, string))
&& !NILP (Fequal (last_parms, parms)))
{
- struct frame *tip_f = XFRAME (tip_frame);
-
/* Only DX and DY have changed. */
+ tip_f = XFRAME (tip_frame);
if (!NILP (tip_timer))
{
Lisp_Object timer = tip_timer;
+
tip_timer = Qnil;
call1 (Qcancel_timer, timer);
}
XMoveWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y);
unblock_input ();
+
goto start_timer;
}
- }
+ else if (tooltip_reuse_hidden_frame && EQ (frame, last_frame))
+ {
+ bool delete = false;
+ Lisp_Object tail, elt, parm, last;
+
+ /* Check if every parameter in PARMS has the same value in
+ last_parms unless it should be ignored by means of
+ Vtooltip_reuse_hidden_frame_parameters. This may destruct
+ last_parms which, however, will be recreated below. */
+ for (tail = parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = Fcar (elt);
+ /* The left, top, right and bottom parameters are handled
+ by compute_tip_xy so they can be ignored here. */
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop)
+ && !EQ (parm, Qright) && !EQ (parm, Qbottom))
+ {
+ last = Fassq (parm, last_parms);
+ if (NILP (Fequal (Fcdr (elt), Fcdr (last))))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
+ else
+ last_parms = call2 (Qassq_delete_all, parm, last_parms);
+ }
- /* Hide a previous tip, if any. */
- Fx_hide_tip ();
+ /* Now check if every parameter in what is left of last_parms
+ with a non-nil value has an association in PARMS unless it
+ should be ignored by means of
+ Vtooltip_reuse_hidden_frame_parameters. */
+ for (tail = last_parms; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ parm = Fcar (elt);
+ if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright)
+ && !EQ (parm, Qbottom) && !NILP (Fcdr (elt)))
+ {
+ /* We lost, delete the old tooltip. */
+ delete = true;
+ break;
+ }
+ }
+
+ x_hide_tip (delete);
+ }
+ else
+ x_hide_tip (true);
+ }
+ else
+ x_hide_tip (true);
ASET (last_show_tip_args, 0, string);
ASET (last_show_tip_args, 1, frame);
ASET (last_show_tip_args, 2, parms);
- /* Add default values to frame parameters. */
- if (NILP (Fassq (Qname, parms)))
- parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
- if (NILP (Fassq (Qinternal_border_width, parms)))
- parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
- if (NILP (Fassq (Qborder_width, parms)))
- parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
- if (NILP (Fassq (Qbottom_divider_width, parms)))
- parms = Fcons (Fcons (Qbottom_divider_width, make_number (0)), parms);
- if (NILP (Fassq (Qright_divider_width, parms)))
- parms = Fcons (Fcons (Qright_divider_width, make_number (0)), parms);
- if (NILP (Fassq (Qborder_color, parms)))
- parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
- if (NILP (Fassq (Qbackground_color, parms)))
- parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
- parms);
-
- /* Create a frame for the tooltip, and record it in the global
- variable tip_frame. */
- frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms, string);
- f = XFRAME (frame);
-
- /* Set up the frame's root window. */
- w = XWINDOW (FRAME_ROOT_WINDOW (f));
+ if (!FRAMEP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame)))
+ {
+ /* Add default values to frame parameters. */
+ if (NILP (Fassq (Qname, parms)))
+ parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
+ if (NILP (Fassq (Qinternal_border_width, parms)))
+ parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
+ if (NILP (Fassq (Qborder_width, parms)))
+ parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
+ if (NILP (Fassq (Qborder_color, parms)))
+ parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
+ if (NILP (Fassq (Qbackground_color, parms)))
+ parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
+ parms);
+
+ /* Create a frame for the tooltip, and record it in the global
+ variable tip_frame. */
+ if (NILP (tip_frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms)))
+ /* Creating the tip frame failed. */
+ return unbind_to (count, Qnil);
+ }
+
+ tip_f = XFRAME (tip_frame);
+ window = FRAME_ROOT_WINDOW (tip_f);
+ set_window_buffer (window, Fget_buffer_create (tip), false, false);
+ w = XWINDOW (window);
+ w->pseudo_window_p = true;
+
+ /* Set up the frame's root window. Note: The following code does not
+ try to size the window or its frame correctly. Its only purpose is
+ to make the subsequent text size calculations work. The right
+ sizes should get installed when the toolkit gets back to us. */
w->left_col = 0;
w->top_line = 0;
w->pixel_left = 0;
w->total_lines = 40;
}
- w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (f);
- w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (f);
-
- FRAME_TOTAL_COLS (f) = w->total_cols;
- adjust_frame_glyphs (f);
- w->pseudo_window_p = true;
+ w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (tip_f);
+ w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (tip_f);
+ FRAME_TOTAL_COLS (tip_f) = w->total_cols;
+ adjust_frame_glyphs (tip_f);
- /* Display the tooltip text in a temporary buffer. */
+ /* Insert STRING into root window's buffer and fit the frame to the
+ buffer. */
+ count_1 = SPECPDL_INDEX ();
old_buffer = current_buffer;
- set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->contents));
+ set_buffer_internal_1 (XBUFFER (w->contents));
bset_truncate_lines (current_buffer, Qnil);
+ specbind (Qinhibit_read_only, Qt);
+ specbind (Qinhibit_modification_hooks, Qt);
+ specbind (Qinhibit_point_motion_hooks, Qt);
+ Ferase_buffer ();
+ Finsert (1, &string);
clear_glyph_matrix (w->desired_matrix);
clear_glyph_matrix (w->current_matrix);
SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
- try_window (FRAME_ROOT_WINDOW (f), pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
-
- /* Compute width and height of the tooltip. */
- width = height = 0;
- seen_reversed_p = false;
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- /* Stop at the first empty row at the end. */
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
-
- /* Let the row go over the full width of the frame. */
- row->full_width_p = true;
-
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA])
- {
- /* There's a glyph at the end of rows that is used to place
- the cursor there. Don't include the width of this glyph. */
- if (!row->reversed_p)
- {
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
- else
- {
- /* There could be a stretch glyph at the beginning of R2L
- rows that is produced by extend_face_to_end_of_line.
- Don't count that glyph. */
- struct glyph *g = row->glyphs[TEXT_AREA];
-
- if (g->type == STRETCH_GLYPH && NILP (g->object))
- {
- row_width -= g->pixel_width;
- seen_reversed_p = true;
- }
- }
- }
-
- height += row->height;
- width = max (width, row_width);
- }
-
- /* If we've seen partial-length R2L rows, we need to re-adjust the
- tool-tip frame width and redisplay it again, to avoid over-wide
- tips due to the stretch glyph that extends R2L lines to full
- width of the frame. */
- if (seen_reversed_p)
- {
- /* w->total_cols and FRAME_TOTAL_COLS want the width in columns,
- not in pixels. */
- w->pixel_width = width;
- width /= WINDOW_FRAME_COLUMN_WIDTH (w);
- w->total_cols = width;
- FRAME_TOTAL_COLS (f) = width;
- SET_FRAME_WIDTH (f, width);
- adjust_frame_glyphs (f);
- clear_glyph_matrix (w->desired_matrix);
- clear_glyph_matrix (w->current_matrix);
- try_window (FRAME_ROOT_WINDOW (f), pos, 0);
- width = height = 0;
- /* Recompute width and height of the tooltip. */
- for (i = 0; i < w->desired_matrix->nrows; ++i)
- {
- struct glyph_row *row = &w->desired_matrix->rows[i];
- struct glyph *last;
- int row_width;
-
- if (!row->enabled_p || !MATRIX_ROW_DISPLAYS_TEXT_P (row))
- break;
- row->full_width_p = true;
- row_width = row->pixel_width;
- if (row->used[TEXT_AREA] && !row->reversed_p)
- {
- last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
- if (NILP (last->object))
- row_width -= last->pixel_width;
- }
-
- height += row->height;
- width = max (width, row_width);
- }
- }
-
- /* Add the frame's internal border to the width and height the X
- window should have. */
- height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
- width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
-
- /* Move the tooltip window where the mouse pointer is. Resize and
- show it. */
- compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
-
+ try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE);
+ /* Calculate size of tooltip window. */
+ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil,
+ make_number (w->pixel_height), Qnil);
+ /* Add the frame's internal border to calculated size. */
+ width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+ height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f);
+
+ /* Calculate position of tooltip frame. */
+ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y);
+
+ /* Show tooltip frame. */
block_input ();
- XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y, width, height);
- XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
+ XMapRaised (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f));
unblock_input ();
- /* Draw into the window. */
w->must_be_updated_p = true;
update_single_window (w);
-
- /* Restore original current buffer. */
set_buffer_internal_1 (old_buffer);
+ unbind_to (count_1, Qnil);
windows_or_buffers_changed = old_windows_or_buffers_changed;
start_timer:
Value is t if tooltip was open, nil otherwise. */)
(void)
{
- ptrdiff_t count;
- Lisp_Object deleted, frame, timer;
-
- /* Return quickly if nothing to do. */
- if (NILP (tip_timer) && NILP (tip_frame))
- return Qnil;
-
- frame = tip_frame;
- timer = tip_timer;
- tip_frame = tip_timer = deleted = Qnil;
-
- count = SPECPDL_INDEX ();
- specbind (Qinhibit_redisplay, Qt);
- specbind (Qinhibit_quit, Qt);
-
- if (!NILP (timer))
- call1 (Qcancel_timer, timer);
-
-#ifdef USE_GTK
- {
- /* When using system tooltip, tip_frame is the Emacs frame on which
- the tip is shown. */
- struct frame *f = XFRAME (frame);
- if (FRAME_LIVE_P (f) && xg_hide_tooltip (f))
- frame = Qnil;
- }
-#endif
-
- if (FRAMEP (frame))
- {
- delete_frame (frame, Qnil);
- deleted = Qt;
-
-#ifdef USE_LUCID
- /* Bloodcurdling hack alert: The Lucid menu bar widget's
- redisplay procedure is not called when a tip frame over menu
- items is unmapped. Redisplay the menu manually... */
- {
- Widget w;
- struct frame *f = SELECTED_FRAME ();
- if (FRAME_X_P (f) && FRAME_LIVE_P (f))
- {
- w = f->output_data.x->menubar_widget;
-
- if (!DoesSaveUnders (FRAME_DISPLAY_INFO (f)->screen)
- && w != NULL)
- {
- block_input ();
- xlwmenu_redisplay (w);
- unblock_input ();
- }
- }
- }
-#endif /* USE_LUCID */
- }
-
- return unbind_to (count, deleted);
+ return x_hide_tip (!tooltip_reuse_hidden_frame);
}
-
\f
/***********************************************************************
File selection dialog
DEFSYM (Qcancel_timer, "cancel-timer");
DEFSYM (Qfont_param, "font-parameter");
DEFSYM (Qmono, "mono");
+ DEFSYM (Qassq_delete_all, "assq-delete-all");
#ifdef USE_CAIRO
DEFSYM (Qpdf, "pdf");
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
props[props_idx]->vals[0].value = SDATA (user_login_name);
++props_idx;
- char *cwd = get_current_dir_name ();
+ char *cwd = emacs_get_current_dir_name ();
if (cwd)
{
props[props_idx] = &prop_ptr[props_idx];
ptrdiff_t name_len = 0;
/* libSM seems to crash if pwd is missing - see bug#18851. */
- if (! get_current_dir_name ())
+ if (! emacs_get_current_dir_name ())
{
fprintf (stderr, "Disabling session management due to pwd error: %s\n",
emacs_strerror (errno));
(ert-deftest ruby-no-heredoc-inside-quotes ()
(ruby-assert-state "\"<<\", \"\",\nfoo" 3 nil))
+ (ert-deftest ruby-no-heredoc-left-shift ()
+ ;; We can't really detect the left shift operator (like in similar
+ ;; cases, it depends on the type of foo), so we just require for <<
+ ;; to be preceded by a character from a known set.
+ (ruby-assert-state "foo(a<<b)" 3 nil))
+
+ (ert-deftest ruby-no-heredoc-class-self ()
+ (ruby-assert-state "class <<self\nend" 3 nil))
+
(ert-deftest ruby-exit!-font-lock ()
(ruby-assert-face "exit!" 5 font-lock-builtin-face))
(ruby-assert-face "%S{foo}" 4 nil)
(ruby-assert-face "%R{foo}" 4 nil))
+ (ert-deftest ruby-no-nested-percent-literals ()
+ (ruby-with-temp-buffer "a = %w[b %()]"
+ (syntax-propertize (point))
+ (should (null (nth 8 (syntax-ppss))))
+ (should (eq t (nth 3 (syntax-ppss (1- (point-max))))))
+ (search-backward "[")
+ (should (eq t (nth 3 (syntax-ppss))))))
+
(ert-deftest ruby-add-log-current-method-examples ()
(let ((pairs '(("foo" . "#foo")
("C.foo" . ".foo")
BYTE_MARK_STACK c-src/emacs/src/lisp.h 3181
Bar lua-src/test.lua /^function Square.something:Bar ()$/
Bar perl-src/kai-test.pl /^package Bar;$/
- Bar::f4 perl-src/kai-test.pl /^sub Bar::f4 {$/
- Bar::f5 perl-src/kai-test.pl /^sub f5 {$/
Barrier_Function_Pointer/t ada-src/etags-test-for.ada /^ type Barrier_Function_Pointer is access$/
Bidule/b ada-src/etags-test-for.ada /^ protected body Bidule is$/
Bidule/b ada-src/waroquiers.ada /^ protected body Bidule is$/
First100Chars pas-src/common.pas /^procedure First100Chars; (*($/
Foo perl-src/kai-test.pl /^package Foo;$/
Foo::Bar perl-src/kai-test.pl /^package Foo::Bar;$/
- Foo::Bar::f6 perl-src/kai-test.pl /^sub f6 {$/
- Foo::f3 perl-src/kai-test.pl /^sub f3 {$/
Forth_help c-src/etags.c 573
Forth_suffixes c-src/etags.c 571
Forth_words c-src/etags.c /^Forth_words (FILE *inf)$/
f cp-src/fail.C /^ int f() { return 5; }$/
f cp-src/fail.C /^int A::B::f() { return 2; }$/
f1 c.c /^ f1 () { \/* Do something. *\/; }$/
+ f1 perl-src/kai-test.pl /^sub f1 {$/
f2 c.c /^void f2 () { \/* Do something. *\/; }$/
+ f2 perl-src/kai-test.pl /^sub main::f2 {$/
+ f3 perl-src/kai-test.pl /^sub f3 {$/
+ f4 perl-src/kai-test.pl /^sub Bar::f4 {$/
+ f5 perl-src/kai-test.pl /^sub f5 {$/
+ f6 perl-src/kai-test.pl /^sub f6 {$/
+ f7 perl-src/kai-test.pl /^sub f7 {$/
fast_string_match_ignore_case c-src/emacs/src/lisp.h /^fast_string_match_ignore_case (Lisp_Object regexp,/
fastctags make-src/Makefile /^fastctags:$/
fastetags make-src/Makefile /^fastetags:$/
file-of-tag el-src/emacs/lisp/progmodes/etags.el /^(defun file-of-tag (&optional relative)$/
file-of-tag-function el-src/emacs/lisp/progmodes/etags.el /^(defvar file-of-tag-function nil$/
fileJoin php-src/lce_functions.php /^ function fileJoin()$/
+ file_end perl-src/htlmify-cystic /^sub file_end ()$/
file_index perl-src/htlmify-cystic 33
file_tocs perl-src/htlmify-cystic 30
filename_is_absolute c-src/etags.c /^filename_is_absolute (char *fn)$/
find_entries c-src/etags.c /^find_entries (FILE *inf)$/
find_user_signal_name c-src/emacs/src/keyboard.c /^find_user_signal_name (int sig)$/
findcats prol-src/natded.prolog /^findcats([],Left,Left).$/
+ finish_appendices perl-src/htlmify-cystic /^sub finish_appendices ()$/
+ finish_sections perl-src/htlmify-cystic /^sub finish_sections ()$/
+ finish_subsections perl-src/htlmify-cystic /^sub finish_subsections ()$/
+ finish_subsubsections perl-src/htlmify-cystic /^sub finish_subsubsections ()$/
finlist c-src/etags.c 2414
first c-src/emacs/src/gmalloc.c 151
fitchtreelist prol-src/natded.prolog /^fitchtreelist([]).$/
get_tag c-src/etags.c /^get_tag (register char *bp, char **namepp)$/
get_word c-src/tab.c /^static char *get_word(char **str, char delim)$/
getcjmp c-src/emacs/src/keyboard.c 147
+ getopt perl-src/yagrip.pl /^sub getopt {$/
getopt.o make-src/Makefile /^getopt.o: emacs\/lib-src\/getopt.c$/
getopt1.o make-src/Makefile /^getopt1.o: emacs\/lib-src\/getopt1.c$/
getptys objc-src/Subprocess.m /^getptys (int *master, int *slave)$/
mach_task_self c-src/machsyscalls.h /^SYSCALL (mach_task_self, -28,$/
mach_thread_self c-src/machsyscalls.h /^SYSCALL (mach_thread_self, -27,$/
magic c-src/emacs/src/gmalloc.c 1863
- main::f1 perl-src/kai-test.pl /^sub f1 {$/
- main::f2 perl-src/kai-test.pl /^sub main::f2 {$/
- main::f7 perl-src/kai-test.pl /^sub f7 {$/
- main::file_end perl-src/htlmify-cystic /^sub file_end ()$/
- main::finish_appendices perl-src/htlmify-cystic /^sub finish_appendices ()$/
- main::finish_sections perl-src/htlmify-cystic /^sub finish_sections ()$/
- main::finish_subsections perl-src/htlmify-cystic /^sub finish_subsections ()$/
- main::finish_subsubsections perl-src/htlmify-cystic /^sub finish_subsubsections ()$/
- main::getopt perl-src/yagrip.pl /^sub getopt {$/
- main::read_toc perl-src/htlmify-cystic /^sub read_toc ()$/
- main::section_href perl-src/htlmify-cystic /^sub section_href ($)$/
- main::section_name perl-src/htlmify-cystic /^sub section_name ($)$/
- main::section_url perl-src/htlmify-cystic /^sub section_url ()$/
- main::section_url_base perl-src/htlmify-cystic /^sub section_url_base ()$/
- main::section_url_name perl-src/htlmify-cystic /^sub section_url_name ()$/
- main::toc_line perl-src/htlmify-cystic /^sub toc_line ($)$/
- main::usage perl-src/yagrip.pl /^sub usage {$/
maintaining.info make-src/Makefile /^maintaining.info: maintaining.texi$/
make-abbrev-table c-src/abbrev.c /^DEFUN ("make-abbrev-table", Fmake_abbrev_table, Sm/
make_C_tag c-src/etags.c /^make_C_tag (bool isfun)$/
read_key_sequence_remapped c-src/emacs/src/keyboard.c 233
read_key_sequence_vs c-src/emacs/src/keyboard.c /^read_key_sequence_vs (Lisp_Object prompt, Lisp_Obj/
read_menu_command c-src/emacs/src/keyboard.c /^read_menu_command (void)$/
+ read_toc perl-src/htlmify-cystic /^sub read_toc ()$/
readable_events c-src/emacs/src/keyboard.c /^readable_events (int flags)$/
readline c-src/etags.c /^readline (linebuffer *lbp, FILE *stream)$/
readline_internal c-src/etags.c /^readline_internal (linebuffer *lbp, register FILE /
sec=\relax tex-src/texinfo.tex /^\\let\\appendixsec=\\relax$/
section perl-src/htlmify-cystic 25
section=\relax tex-src/texinfo.tex /^\\let\\appendixsection=\\relax$/
+ section_href perl-src/htlmify-cystic /^sub section_href ($)$/
section_name perl-src/htlmify-cystic 12
+ section_name perl-src/htlmify-cystic /^sub section_name ($)$/
section_toc perl-src/htlmify-cystic 15
+ section_url perl-src/htlmify-cystic /^sub section_url ()$/
+ section_url_base perl-src/htlmify-cystic /^sub section_url_base ()$/
+ section_url_name perl-src/htlmify-cystic /^sub section_url_name ()$/
select prol-src/natded.prolog /^select(X,[X|Xs],Xs).$/
select-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun select-tags-table ()$/
select-tags-table-mode el-src/emacs/lisp/progmodes/etags.el /^(define-derived-mode select-tags-table-mode specia/
tinbody c-src/etags.c 2431
tkeyseen c-src/etags.c 2429
tnone c-src/etags.c 2428
+ toc_line perl-src/htlmify-cystic /^sub toc_line ($)$/
toggleDescription objc-src/PackInsp.m /^-toggleDescription$/
tok c-src/etags.c 2491
token c-src/etags.c 2508
unsignedp y-src/cccp.y 112
uprintmax_t c-src/emacs/src/lisp.h 149
uprintmax_t c-src/emacs/src/lisp.h 154
+ usage perl-src/yagrip.pl /^sub usage {$/
usecharno c-src/etags.c 210
used c-src/emacs/src/regex.h 347
used_syntax c-src/emacs/src/regex.h 398
test \7f4,26
foo(\7f16,200
\f
- perl-src/htlmify-cystic,1443
+ perl-src/htlmify-cystic,1197
my @section_name;\7fsection_name\ 112,236
my @appendix_name;\7fappendix_name\ 113,254
my @section_toc;\7fsection_toc\ 115,274
my $line;\7fline\ 137,574
my $subsection_marker;\7fsubsection_marker\ 1161,3883
my $new;\7fnew\ 1163,3907
- sub read_toc \7fmain::read_toc\ 1165,3917
+ sub read_toc \7f165,3917
my $entry \7fentry\ 1218,5621
my $entry \7fentry\ 1234,6077
my $entry \7fentry\ 1245,6351
my $entry \7fentry\ 1276,7204
my $entry \7fentry\ 1281,7328
my $entry \7fentry\ 1296,7698
- sub finish_subsubsections \7fmain::finish_subsubsections\ 1302,7805
- sub finish_subsections \7fmain::finish_subsections\ 1309,7987
- sub finish_sections \7fmain::finish_sections\ 1320,8310
- sub finish_appendices \7fmain::finish_appendices\ 1331,8599
- sub section_url_base \7fmain::section_url_base\ 1337,8724
- sub section_url_name \7fmain::section_url_name\ 1342,8922
- sub section_url \7fmain::section_url\ 1355,9284
+ sub finish_subsubsections \7f302,7805
+ sub finish_subsections \7f309,7987
+ sub finish_sections \7f320,8310
+ sub finish_appendices \7f331,8599
+ sub section_url_base \7f337,8724
+ sub section_url_name \7f342,8922
+ sub section_url \7f355,9284
my $name \7fname\ 1357,9336
- sub section_href \7fmain::section_href\ 1364,9452
- sub section_name \7fmain::section_name\ 1368,9551
- sub toc_line \7fmain::toc_line\ 1372,9655
- sub file_end \7fmain::file_end\ 1375,9750
+ sub section_href \7f364,9452
+ sub section_name \7f368,9551
+ sub toc_line \7f372,9655
+ sub file_end \7f375,9750
\f
- perl-src/yagrip.pl,258
- sub getopt \7fmain::getopt\ 17,156
+ perl-src/yagrip.pl,233
+ sub getopt \7f7,156
local($_,$flag,$opt,$f,$r,@temp)\7f($_,$flag,$opt,$f,$r,@temp\ 18,169
- sub usage \7fmain::usage\ 138,856
+ sub usage \7f38,856
local($prog,$_,@list)\7f($prog,$_,@list\ 139,868
local($string,$flag,@string,@temp,@last)\7f($string,$flag,@string,@temp,@last\ 140,897
\f
- perl-src/kai-test.pl,244
- sub f1 \7fmain::f1\ 12,16
- sub main::f2 \7f6,50
+ perl-src/kai-test.pl,203
+ sub f1 \7f2,16
+ sub main::f2 \7ff2\ 16,50
package Foo;\7f10,90
- sub f3 \7fFoo::f3\ 112,104
- sub Bar::f4 \7f16,138
+ sub f3 \7f12,104
+ sub Bar::f4 \7ff4\ 116,138
package Bar;\7f20,177
- sub f5 \7fBar::f5\ 122,191
+ sub f5 \7f22,191
package Foo::Bar;\7f26,225
- sub f6 \7fFoo::Bar::f6\ 128,244
+ sub f6 \7f28,244
package main;\7f32,278
- sub f7 \7fmain::f7\ 134,293
+ sub f7 \7f34,293
\f
ps-src/rfc1245.ps,2478
/FMversion \7f12,311
test \7f4,26
foo(\7f16,200
\f
- perl-src/htlmify-cystic,1443
+ perl-src/htlmify-cystic,1197
my @section_name;\7fsection_name\ 112,236
my @appendix_name;\7fappendix_name\ 113,254
my @section_toc;\7fsection_toc\ 115,274
my $line;\7fline\ 137,574
my $subsection_marker;\7fsubsection_marker\ 1161,3883
my $new;\7fnew\ 1163,3907
- sub read_toc \7fmain::read_toc\ 1165,3917
+ sub read_toc \7f165,3917
my $entry \7fentry\ 1218,5621
my $entry \7fentry\ 1234,6077
my $entry \7fentry\ 1245,6351
my $entry \7fentry\ 1276,7204
my $entry \7fentry\ 1281,7328
my $entry \7fentry\ 1296,7698
- sub finish_subsubsections \7fmain::finish_subsubsections\ 1302,7805
- sub finish_subsections \7fmain::finish_subsections\ 1309,7987
- sub finish_sections \7fmain::finish_sections\ 1320,8310
- sub finish_appendices \7fmain::finish_appendices\ 1331,8599
- sub section_url_base \7fmain::section_url_base\ 1337,8724
- sub section_url_name \7fmain::section_url_name\ 1342,8922
- sub section_url \7fmain::section_url\ 1355,9284
+ sub finish_subsubsections \7f302,7805
+ sub finish_subsections \7f309,7987
+ sub finish_sections \7f320,8310
+ sub finish_appendices \7f331,8599
+ sub section_url_base \7f337,8724
+ sub section_url_name \7f342,8922
+ sub section_url \7f355,9284
my $name \7fname\ 1357,9336
- sub section_href \7fmain::section_href\ 1364,9452
- sub section_name \7fmain::section_name\ 1368,9551
- sub toc_line \7fmain::toc_line\ 1372,9655
- sub file_end \7fmain::file_end\ 1375,9750
+ sub section_href \7f364,9452
+ sub section_name \7f368,9551
+ sub toc_line \7f372,9655
+ sub file_end \7f375,9750
\f
- perl-src/yagrip.pl,258
- sub getopt \7fmain::getopt\ 17,156
+ perl-src/yagrip.pl,233
+ sub getopt \7f7,156
local($_,$flag,$opt,$f,$r,@temp)\7f($_,$flag,$opt,$f,$r,@temp\ 18,169
- sub usage \7fmain::usage\ 138,856
+ sub usage \7f38,856
local($prog,$_,@list)\7f($prog,$_,@list\ 139,868
local($string,$flag,@string,@temp,@last)\7f($string,$flag,@string,@temp,@last\ 140,897
\f
- perl-src/kai-test.pl,244
- sub f1 \7fmain::f1\ 12,16
- sub main::f2 \7f6,50
+ perl-src/kai-test.pl,203
+ sub f1 \7f2,16
+ sub main::f2 \7ff2\ 16,50
package Foo;\7f10,90
- sub f3 \7fFoo::f3\ 112,104
- sub Bar::f4 \7f16,138
+ sub f3 \7f12,104
+ sub Bar::f4 \7ff4\ 116,138
package Bar;\7f20,177
- sub f5 \7fBar::f5\ 122,191
+ sub f5 \7f22,191
package Foo::Bar;\7f26,225
- sub f6 \7fFoo::Bar::f6\ 128,244
+ sub f6 \7f28,244
package main;\7f32,278
- sub f7 \7fmain::f7\ 134,293
+ sub f7 \7f34,293
\f
ps-src/rfc1245.ps,2478
/FMversion \7f12,311
var $test\7f12,176
foo(\7f16,200
\f
- perl-src/htlmify-cystic,1443
+ perl-src/htlmify-cystic,1197
my @section_name;\7fsection_name\ 112,236
my @appendix_name;\7fappendix_name\ 113,254
my @section_toc;\7fsection_toc\ 115,274
my $line;\7fline\ 137,574
my $subsection_marker;\7fsubsection_marker\ 1161,3883
my $new;\7fnew\ 1163,3907
- sub read_toc \7fmain::read_toc\ 1165,3917
+ sub read_toc \7f165,3917
my $entry \7fentry\ 1218,5621
my $entry \7fentry\ 1234,6077
my $entry \7fentry\ 1245,6351
my $entry \7fentry\ 1276,7204
my $entry \7fentry\ 1281,7328
my $entry \7fentry\ 1296,7698
- sub finish_subsubsections \7fmain::finish_subsubsections\ 1302,7805
- sub finish_subsections \7fmain::finish_subsections\ 1309,7987
- sub finish_sections \7fmain::finish_sections\ 1320,8310
- sub finish_appendices \7fmain::finish_appendices\ 1331,8599
- sub section_url_base \7fmain::section_url_base\ 1337,8724
- sub section_url_name \7fmain::section_url_name\ 1342,8922
- sub section_url \7fmain::section_url\ 1355,9284
+ sub finish_subsubsections \7f302,7805
+ sub finish_subsections \7f309,7987
+ sub finish_sections \7f320,8310
+ sub finish_appendices \7f331,8599
+ sub section_url_base \7f337,8724
+ sub section_url_name \7f342,8922
+ sub section_url \7f355,9284
my $name \7fname\ 1357,9336
- sub section_href \7fmain::section_href\ 1364,9452
- sub section_name \7fmain::section_name\ 1368,9551
- sub toc_line \7fmain::toc_line\ 1372,9655
- sub file_end \7fmain::file_end\ 1375,9750
+ sub section_href \7f364,9452
+ sub section_name \7f368,9551
+ sub toc_line \7f372,9655
+ sub file_end \7f375,9750
\f
- perl-src/yagrip.pl,258
- sub getopt \7fmain::getopt\ 17,156
+ perl-src/yagrip.pl,233
+ sub getopt \7f7,156
local($_,$flag,$opt,$f,$r,@temp)\7f($_,$flag,$opt,$f,$r,@temp\ 18,169
- sub usage \7fmain::usage\ 138,856
+ sub usage \7f38,856
local($prog,$_,@list)\7f($prog,$_,@list\ 139,868
local($string,$flag,@string,@temp,@last)\7f($string,$flag,@string,@temp,@last\ 140,897
\f
- perl-src/kai-test.pl,244
- sub f1 \7fmain::f1\ 12,16
- sub main::f2 \7f6,50
+ perl-src/kai-test.pl,203
+ sub f1 \7f2,16
+ sub main::f2 \7ff2\ 16,50
package Foo;\7f10,90
- sub f3 \7fFoo::f3\ 112,104
- sub Bar::f4 \7f16,138
+ sub f3 \7f12,104
+ sub Bar::f4 \7ff4\ 116,138
package Bar;\7f20,177
- sub f5 \7fBar::f5\ 122,191
+ sub f5 \7f22,191
package Foo::Bar;\7f26,225
- sub f6 \7fFoo::Bar::f6\ 128,244
+ sub f6 \7f28,244
package main;\7f32,278
- sub f7 \7fmain::f7\ 134,293
+ sub f7 \7f34,293
\f
ps-src/rfc1245.ps,2478
/FMversion \7f12,311
test \7f4,26
foo(\7f16,200
\f
- perl-src/htlmify-cystic,1443
+ perl-src/htlmify-cystic,1197
my @section_name;\7fsection_name\ 112,236
my @appendix_name;\7fappendix_name\ 113,254
my @section_toc;\7fsection_toc\ 115,274
my $line;\7fline\ 137,574
my $subsection_marker;\7fsubsection_marker\ 1161,3883
my $new;\7fnew\ 1163,3907
- sub read_toc \7fmain::read_toc\ 1165,3917
+ sub read_toc \7f165,3917
my $entry \7fentry\ 1218,5621
my $entry \7fentry\ 1234,6077
my $entry \7fentry\ 1245,6351
my $entry \7fentry\ 1276,7204
my $entry \7fentry\ 1281,7328
my $entry \7fentry\ 1296,7698
- sub finish_subsubsections \7fmain::finish_subsubsections\ 1302,7805
- sub finish_subsections \7fmain::finish_subsections\ 1309,7987
- sub finish_sections \7fmain::finish_sections\ 1320,8310
- sub finish_appendices \7fmain::finish_appendices\ 1331,8599
- sub section_url_base \7fmain::section_url_base\ 1337,8724
- sub section_url_name \7fmain::section_url_name\ 1342,8922
- sub section_url \7fmain::section_url\ 1355,9284
+ sub finish_subsubsections \7f302,7805
+ sub finish_subsections \7f309,7987
+ sub finish_sections \7f320,8310
+ sub finish_appendices \7f331,8599
+ sub section_url_base \7f337,8724
+ sub section_url_name \7f342,8922
+ sub section_url \7f355,9284
my $name \7fname\ 1357,9336
- sub section_href \7fmain::section_href\ 1364,9452
- sub section_name \7fmain::section_name\ 1368,9551
- sub toc_line \7fmain::toc_line\ 1372,9655
- sub file_end \7fmain::file_end\ 1375,9750
+ sub section_href \7f364,9452
+ sub section_name \7f368,9551
+ sub toc_line \7f372,9655
+ sub file_end \7f375,9750
\f
- perl-src/yagrip.pl,258
- sub getopt \7fmain::getopt\ 17,156
+ perl-src/yagrip.pl,233
+ sub getopt \7f7,156
local($_,$flag,$opt,$f,$r,@temp)\7f($_,$flag,$opt,$f,$r,@temp\ 18,169
- sub usage \7fmain::usage\ 138,856
+ sub usage \7f38,856
local($prog,$_,@list)\7f($prog,$_,@list\ 139,868
local($string,$flag,@string,@temp,@last)\7f($string,$flag,@string,@temp,@last\ 140,897
\f
- perl-src/kai-test.pl,244
- sub f1 \7fmain::f1\ 12,16
- sub main::f2 \7f6,50
+ perl-src/kai-test.pl,203
+ sub f1 \7f2,16
+ sub main::f2 \7ff2\ 16,50
package Foo;\7f10,90
- sub f3 \7fFoo::f3\ 112,104
- sub Bar::f4 \7f16,138
+ sub f3 \7f12,104
+ sub Bar::f4 \7ff4\ 116,138
package Bar;\7f20,177
- sub f5 \7fBar::f5\ 122,191
+ sub f5 \7f22,191
package Foo::Bar;\7f26,225
- sub f6 \7fFoo::Bar::f6\ 128,244
+ sub f6 \7f28,244
package main;\7f32,278
- sub f7 \7fmain::f7\ 134,293
+ sub f7 \7f34,293
\f
ps-src/rfc1245.ps,2478
/FMversion \7f12,311
var $test\7f12,176
foo(\7f16,200
\f
- perl-src/htlmify-cystic,1443
+ perl-src/htlmify-cystic,1197
my @section_name;\7fsection_name\ 112,236
my @appendix_name;\7fappendix_name\ 113,254
my @section_toc;\7fsection_toc\ 115,274
my $line;\7fline\ 137,574
my $subsection_marker;\7fsubsection_marker\ 1161,3883
my $new;\7fnew\ 1163,3907
- sub read_toc \7fmain::read_toc\ 1165,3917
+ sub read_toc \7f165,3917
my $entry \7fentry\ 1218,5621
my $entry \7fentry\ 1234,6077
my $entry \7fentry\ 1245,6351
my $entry \7fentry\ 1276,7204
my $entry \7fentry\ 1281,7328
my $entry \7fentry\ 1296,7698
- sub finish_subsubsections \7fmain::finish_subsubsections\ 1302,7805
- sub finish_subsections \7fmain::finish_subsections\ 1309,7987
- sub finish_sections \7fmain::finish_sections\ 1320,8310
- sub finish_appendices \7fmain::finish_appendices\ 1331,8599
- sub section_url_base \7fmain::section_url_base\ 1337,8724
- sub section_url_name \7fmain::section_url_name\ 1342,8922
- sub section_url \7fmain::section_url\ 1355,9284
+ sub finish_subsubsections \7f302,7805
+ sub finish_subsections \7f309,7987
+ sub finish_sections \7f320,8310
+ sub finish_appendices \7f331,8599
+ sub section_url_base \7f337,8724
+ sub section_url_name \7f342,8922
+ sub section_url \7f355,9284
my $name \7fname\ 1357,9336
- sub section_href \7fmain::section_href\ 1364,9452
- sub section_name \7fmain::section_name\ 1368,9551
- sub toc_line \7fmain::toc_line\ 1372,9655
- sub file_end \7fmain::file_end\ 1375,9750
+ sub section_href \7f364,9452
+ sub section_name \7f368,9551
+ sub toc_line \7f372,9655
+ sub file_end \7f375,9750
\f
- perl-src/yagrip.pl,258
- sub getopt \7fmain::getopt\ 17,156
+ perl-src/yagrip.pl,233
+ sub getopt \7f7,156
local($_,$flag,$opt,$f,$r,@temp)\7f($_,$flag,$opt,$f,$r,@temp\ 18,169
- sub usage \7fmain::usage\ 138,856
+ sub usage \7f38,856
local($prog,$_,@list)\7f($prog,$_,@list\ 139,868
local($string,$flag,@string,@temp,@last)\7f($string,$flag,@string,@temp,@last\ 140,897
\f
- perl-src/kai-test.pl,244
- sub f1 \7fmain::f1\ 12,16
- sub main::f2 \7f6,50
+ perl-src/kai-test.pl,203
+ sub f1 \7f2,16
+ sub main::f2 \7ff2\ 16,50
package Foo;\7f10,90
- sub f3 \7fFoo::f3\ 112,104
- sub Bar::f4 \7f16,138
+ sub f3 \7f12,104
+ sub Bar::f4 \7ff4\ 116,138
package Bar;\7f20,177
- sub f5 \7fBar::f5\ 122,191
+ sub f5 \7f22,191
package Foo::Bar;\7f26,225
- sub f6 \7fFoo::Bar::f6\ 128,244
+ sub f6 \7f28,244
package main;\7f32,278
- sub f7 \7fmain::f7\ 134,293
+ sub f7 \7f34,293
\f
ps-src/rfc1245.ps,2478
/FMversion \7f12,311
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
+ the Free Software Foundation, either version 3 of the License, or (at
+ your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
static const char Objc_help [] =
"In Objective C code, tags include Objective C definitions for classes,\n\
class categories, methods and protocols. Tags for variables and\n\
- functions in classes are named `CLASS::VARIABLE' and `CLASS::FUNCTION'.\n\
- (Use --help --lang=c --lang=objc --lang=java for full help.)";
+ functions in classes are named `CLASS::VARIABLE' and `CLASS::FUNCTION'.\
+ \n(Use --help --lang=c --lang=objc --lang=java for full help.)";
static const char *Pascal_suffixes [] =
{ "p", "pas", NULL };
class A {
* x() {
return 1
- * 2;
+ * a(2);
+ }
+
+ *[Symbol.iterator]() {
+ yield "Foo";
+ yield "Bar";
}
}
something
end
+ qux :+,
+ bar,
+ :[]=,
+ bar,
+ :a
+
+ b = $:
+ c = ??
+
# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html
d = 4 + 5 + # no '\' needed
6 + 7
self.end
D.new.class
end
+
+ def begin
+ end
end
a = foo(j, k) -
foo if
bar
+ fail "stuff" \
+ unless all_fine?
+
if foo?
bar
end