aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorK. Handa2016-06-01 08:07:18 +0900
committerK. Handa2016-06-01 08:07:18 +0900
commit4efef3db2fb1c3a20b83a67948e614d9b0c258dd (patch)
treec0c08fc308869f7ba3d988594e4a51b69a70325b
parent694d5e5b56a9d55023ffc292188bd88f6f6cbca6 (diff)
parent01030eed9395f5004e7d0721394697d1ca90cc2f (diff)
downloademacs-4efef3db2fb1c3a20b83a67948e614d9b0c258dd.tar.gz
emacs-4efef3db2fb1c3a20b83a67948e614d9b0c258dd.zip
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
-rw-r--r--configure.ac2
-rw-r--r--doc/misc/texinfo.tex203
-rw-r--r--etc/NEWS9
-rw-r--r--lib-src/emacsclient.c2
-rw-r--r--lib-src/movemail.c2
-rw-r--r--lib/secure_getenv.c29
-rw-r--r--lib/verify.h2
-rw-r--r--lisp/emacs-lisp/autoload.el88
-rw-r--r--lisp/emacs-lisp/pcase.el1
-rw-r--r--lisp/emacs-lisp/radix-tree.el188
-rw-r--r--lisp/gnus/message.el32
-rw-r--r--lisp/gnus/mml.el61
-rw-r--r--lisp/mail/rmail.el23
-rw-r--r--lisp/net/tramp-adb.el32
-rw-r--r--lisp/net/tramp-gvfs.el455
-rw-r--r--lisp/net/tramp-sh.el263
-rw-r--r--lisp/net/tramp-smb.el37
-rw-r--r--lisp/net/tramp.el37
-rw-r--r--lisp/progmodes/cc-engine.el64
-rw-r--r--lisp/progmodes/cc-langs.el13
-rw-r--r--lisp/progmodes/cc-mode.el103
-rw-r--r--lisp/recentf.el1
-rw-r--r--lisp/simple.el8
-rw-r--r--lisp/wid-edit.el8
-rw-r--r--m4/secure_getenv.m41
-rw-r--r--src/buffer.c6
-rw-r--r--src/casefiddle.c2
-rw-r--r--src/charset.c2
-rw-r--r--src/coding.c8
-rw-r--r--src/conf_post.h5
-rw-r--r--src/cygw32.c4
-rw-r--r--src/data.c12
-rw-r--r--src/frame.c4
-rw-r--r--src/image.c20
-rw-r--r--src/keyboard.c15
-rw-r--r--src/regex.c13
-rw-r--r--src/syntax.c2
-rw-r--r--src/unexcw.c6
-rw-r--r--src/window.c2
-rw-r--r--src/xdisp.c13
-rw-r--r--src/xfaces.c2
-rw-r--r--src/xterm.c9
-rw-r--r--test/lisp/net/tramp-tests.el44
43 files changed, 1079 insertions, 754 deletions
diff --git a/configure.ac b/configure.ac
index e88a3a943ac..37a159f4117 100644
--- a/configure.ac
+++ b/configure.ac
@@ -997,7 +997,7 @@ AS_IF([test $gl_gcc_warnings = no],
997 gl_WARN_ADD([-Wno-pointer-sign]) 997 gl_WARN_ADD([-Wno-pointer-sign])
998 fi 998 fi
999 999
1000 AC_DEFINE([lint], [1], [Define to 1 if the compiler is checking for lint.]) 1000 AC_DEFINE([GCC_LINT], [1], [Define to 1 if --enable-gcc-warnings.])
1001 AC_DEFINE([GNULIB_PORTCHECK], [1], [enable some gnulib portability checks]) 1001 AC_DEFINE([GNULIB_PORTCHECK], [1], [enable some gnulib portability checks])
1002 AH_VERBATIM([GNULIB_PORTCHECK_FORTIFY_SOURCE], 1002 AH_VERBATIM([GNULIB_PORTCHECK_FORTIFY_SOURCE],
1003 [/* Enable compile-time and run-time bounds-checking, and some warnings, 1003 [/* Enable compile-time and run-time bounds-checking, and some warnings,
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index d7e6b1f6b80..85846f4da41 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
3% Load plain if necessary, i.e., if running under initex. 3% Load plain if necessary, i.e., if running under initex.
4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi 4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
5% 5%
6\def\texinfoversion{2016-05-26.20} 6\def\texinfoversion{2016-05-28.16}
7% 7%
8% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 8% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
9% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 9% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -4609,11 +4609,23 @@ end
4609% Like \expandablevalue, but completely expandable (the \message in the 4609% Like \expandablevalue, but completely expandable (the \message in the
4610% definition above operates at the execution level of TeX). Used when 4610% definition above operates at the execution level of TeX). Used when
4611% writing to auxiliary files, due to the expansion that \write does. 4611% writing to auxiliary files, due to the expansion that \write does.
4612% If flag is undefined, pass through an unexpanded @value command: maybe it
4613% will be set by the time it is read back in.
4612% 4614%
4613% NB flag names containing - or _ may not work here. 4615% NB flag names containing - or _ may not work here.
4614\def\dummyvalue#1{% 4616\def\dummyvalue#1{%
4615 \expandafter\ifx\csname SET#1\endcsname\relax 4617 \expandafter\ifx\csname SET#1\endcsname\relax
4616 [No value for ``#1'']% 4618 \noexpand\value{#1}%
4619 \else
4620 \csname SET#1\endcsname
4621 \fi
4622}
4623
4624% Used for @value's in index entries to form the sort key: expand the @value
4625% if possible, otherwise sort late.
4626\def\indexnofontsvalue#1{%
4627 \expandafter\ifx\csname SET#1\endcsname\relax
4628 ZZZZZZZ
4617 \else 4629 \else
4618 \csname SET#1\endcsname 4630 \csname SET#1\endcsname
4619 \fi 4631 \fi
@@ -4760,7 +4772,7 @@ end
4760 4772
4761% Define \doindex, the driver for all index macros. 4773% Define \doindex, the driver for all index macros.
4762% Argument #1 is generated by the calling \fooindex macro, 4774% Argument #1 is generated by the calling \fooindex macro,
4763% and it the two-letter name of the index. 4775% and it is the two-letter name of the index.
4764 4776
4765\def\doindex#1{\edef\indexname{#1}\parsearg\doindexxxx} 4777\def\doindex#1{\edef\indexname{#1}\parsearg\doindexxxx}
4766\def\doindexxxx #1{\doind{\indexname}{#1}} 4778\def\doindexxxx #1{\doind{\indexname}{#1}}
@@ -4769,6 +4781,7 @@ end
4769\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx} 4781\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx}
4770\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}} 4782\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}}
4771 4783
4784
4772% Used when writing an index entry out to an index file to prevent 4785% Used when writing an index entry out to an index file to prevent
4773% expansion of Texinfo commands that can appear in an index entry. 4786% expansion of Texinfo commands that can appear in an index entry.
4774% 4787%
@@ -4787,9 +4800,11 @@ end
4787 \def\}{{\tt\char125}}% 4800 \def\}{{\tt\char125}}%
4788 % 4801 %
4789 % Do the redefinitions. 4802 % Do the redefinitions.
4790 \commondummies 4803 \definedummies
4791} 4804}
4792 4805
4806% Used for the aux and toc files, where @ is the escape character.
4807%
4793% For the aux and toc files, @ is the escape character. So we want to 4808% For the aux and toc files, @ is the escape character. So we want to
4794% redefine everything using @ as the escape character (instead of 4809% redefine everything using @ as the escape character (instead of
4795% \realbackslash, still used for index files). When everything uses @, 4810% \realbackslash, still used for index files). When everything uses @,
@@ -4802,30 +4817,35 @@ end
4802 \let\} = \rbraceatcmd 4817 \let\} = \rbraceatcmd
4803 % 4818 %
4804 % Do the redefinitions. 4819 % Do the redefinitions.
4805 \commondummies 4820 \definedummies
4806 \otherbackslash 4821 \otherbackslash
4807} 4822}
4808 4823
4809% Called from \indexdummies and \atdummies. 4824% \definedummyword defines \#1 as \string\#1\space, thus effectively
4825% preventing its expansion. This is used only for control words,
4826% not control letters, because the \space would be incorrect for
4827% control characters, but is needed to separate the control word
4828% from whatever follows.
4810% 4829%
4811\def\commondummies{% 4830% These can be used both for control words that take an argument and
4812 % \definedummyword defines \#1 as \string\#1\space, thus effectively 4831% those that do not. If it is followed by {arg} in the input, then
4813 % preventing its expansion. This is used only for control words, 4832% that will dutifully get written to the index (or wherever).
4814 % not control letters, because the \space would be incorrect for 4833%
4815 % control characters, but is needed to separate the control word 4834% For control letters, we have \definedummyletter, which omits the
4816 % from whatever follows. 4835% space.
4817 % 4836%
4818 % For control letters, we have \definedummyletter, which omits the 4837\def\definedummyword #1{\def#1{\string#1\space}}%
4819 % space. 4838\def\definedummyletter#1{\def#1{\string#1}}%
4820 % 4839\let\definedummyaccent\definedummyletter
4821 % These can be used both for control words that take an argument and 4840
4822 % those that do not. If it is followed by {arg} in the input, then 4841% Called from \indexdummies and \atdummies, to effectively prevent
4823 % that will dutifully get written to the index (or wherever). 4842% the expansion of commands.
4824 % 4843%
4825 \def\definedummyword ##1{\def##1{\string##1\space}}% 4844\def\definedummies{%
4826 \def\definedummyletter##1{\def##1{\string##1}}%
4827 \let\definedummyaccent\definedummyletter
4828 % 4845 %
4846 \let\commondummyword\definedummyword
4847 \let\commondummyletter\definedummyletter
4848 \let\commondummyaccent\definedummyaccent
4829 \commondummiesnofonts 4849 \commondummiesnofonts
4830 % 4850 %
4831 \definedummyletter\_% 4851 \definedummyletter\_%
@@ -4910,77 +4930,77 @@ end
4910 \normalturnoffactive 4930 \normalturnoffactive
4911} 4931}
4912 4932
4913% \commondummiesnofonts: common to \commondummies and \indexnofonts. 4933% \commondummiesnofonts: common to \definedummies and \indexnofonts.
4914% Define \definedumyletter, \definedummyaccent and \definedummyword before 4934% Define \commondummyletter, \commondummyaccent and \commondummyword before
4915% using. 4935% using. Used for accents, font commands, and various control letters.
4916% 4936%
4917\def\commondummiesnofonts{% 4937\def\commondummiesnofonts{%
4918 % Control letters and accents. 4938 % Control letters and accents.
4919 \definedummyletter\!% 4939 \commondummyletter\!%
4920 \definedummyaccent\"% 4940 \commondummyaccent\"%
4921 \definedummyaccent\'% 4941 \commondummyaccent\'%
4922 \definedummyletter\*% 4942 \commondummyletter\*%
4923 \definedummyaccent\,% 4943 \commondummyaccent\,%
4924 \definedummyletter\.% 4944 \commondummyletter\.%
4925 \definedummyletter\/% 4945 \commondummyletter\/%
4926 \definedummyletter\:% 4946 \commondummyletter\:%
4927 \definedummyaccent\=% 4947 \commondummyaccent\=%
4928 \definedummyletter\?% 4948 \commondummyletter\?%
4929 \definedummyaccent\^% 4949 \commondummyaccent\^%
4930 \definedummyaccent\`% 4950 \commondummyaccent\`%
4931 \definedummyaccent\~% 4951 \commondummyaccent\~%
4932 \definedummyword\u 4952 \commondummyword\u
4933 \definedummyword\v 4953 \commondummyword\v
4934 \definedummyword\H 4954 \commondummyword\H
4935 \definedummyword\dotaccent 4955 \commondummyword\dotaccent
4936 \definedummyword\ogonek 4956 \commondummyword\ogonek
4937 \definedummyword\ringaccent 4957 \commondummyword\ringaccent
4938 \definedummyword\tieaccent 4958 \commondummyword\tieaccent
4939 \definedummyword\ubaraccent 4959 \commondummyword\ubaraccent
4940 \definedummyword\udotaccent 4960 \commondummyword\udotaccent
4941 \definedummyword\dotless 4961 \commondummyword\dotless
4942 % 4962 %
4943 % Texinfo font commands. 4963 % Texinfo font commands.
4944 \definedummyword\b 4964 \commondummyword\b
4945 \definedummyword\i 4965 \commondummyword\i
4946 \definedummyword\r 4966 \commondummyword\r
4947 \definedummyword\sansserif 4967 \commondummyword\sansserif
4948 \definedummyword\sc 4968 \commondummyword\sc
4949 \definedummyword\slanted 4969 \commondummyword\slanted
4950 \definedummyword\t 4970 \commondummyword\t
4951 % 4971 %
4952 % Commands that take arguments. 4972 % Commands that take arguments.
4953 \definedummyword\abbr 4973 \commondummyword\abbr
4954 \definedummyword\acronym 4974 \commondummyword\acronym
4955 \definedummyword\anchor 4975 \commondummyword\anchor
4956 \definedummyword\cite 4976 \commondummyword\cite
4957 \definedummyword\code 4977 \commondummyword\code
4958 \definedummyword\command 4978 \commondummyword\command
4959 \definedummyword\dfn 4979 \commondummyword\dfn
4960 \definedummyword\dmn 4980 \commondummyword\dmn
4961 \definedummyword\email 4981 \commondummyword\email
4962 \definedummyword\emph 4982 \commondummyword\emph
4963 \definedummyword\env 4983 \commondummyword\env
4964 \definedummyword\file 4984 \commondummyword\file
4965 \definedummyword\image 4985 \commondummyword\image
4966 \definedummyword\indicateurl 4986 \commondummyword\indicateurl
4967 \definedummyword\inforef 4987 \commondummyword\inforef
4968 \definedummyword\kbd 4988 \commondummyword\kbd
4969 \definedummyword\key 4989 \commondummyword\key
4970 \definedummyword\math 4990 \commondummyword\math
4971 \definedummyword\option 4991 \commondummyword\option
4972 \definedummyword\pxref 4992 \commondummyword\pxref
4973 \definedummyword\ref 4993 \commondummyword\ref
4974 \definedummyword\samp 4994 \commondummyword\samp
4975 \definedummyword\strong 4995 \commondummyword\strong
4976 \definedummyword\tie 4996 \commondummyword\tie
4977 \definedummyword\U 4997 \commondummyword\U
4978 \definedummyword\uref 4998 \commondummyword\uref
4979 \definedummyword\url 4999 \commondummyword\url
4980 \definedummyword\var 5000 \commondummyword\var
4981 \definedummyword\verb 5001 \commondummyword\verb
4982 \definedummyword\w 5002 \commondummyword\w
4983 \definedummyword\xref 5003 \commondummyword\xref
4984} 5004}
4985 5005
4986% For testing: output @{ and @} in index sort strings as \{ and \}. 5006% For testing: output @{ and @} in index sort strings as \{ and \}.
@@ -5036,11 +5056,11 @@ end
5036% 5056%
5037\def\indexnofonts{% 5057\def\indexnofonts{%
5038 % Accent commands should become @asis. 5058 % Accent commands should become @asis.
5039 \def\definedummyaccent##1{\let##1\asis}% 5059 \def\commondummyaccent##1{\let##1\asis}%
5040 % We can just ignore other control letters. 5060 % We can just ignore other control letters.
5041 \def\definedummyletter##1{\let##1\empty}% 5061 \def\commondummyletter##1{\let##1\empty}%
5042 % All control words become @asis by default; overrides below. 5062 % All control words become @asis by default; overrides below.
5043 \let\definedummyword\definedummyaccent 5063 \let\commondummyword\commondummyaccent
5044 \commondummiesnofonts 5064 \commondummiesnofonts
5045 % 5065 %
5046 % Don't no-op \tt, since it isn't a user-level command 5066 % Don't no-op \tt, since it isn't a user-level command
@@ -5125,8 +5145,11 @@ end
5125 % goes to end-of-line is not handled. 5145 % goes to end-of-line is not handled.
5126 % 5146 %
5127 \macrolist 5147 \macrolist
5148 \let\value\indexnofontsvalue
5128} 5149}
5129 5150
5151
5152
5130 5153
5131\let\SETmarginindex=\relax % put index entries in margin (undocumented)? 5154\let\SETmarginindex=\relax % put index entries in margin (undocumented)?
5132 5155
diff --git a/etc/NEWS b/etc/NEWS
index b2e42e3f91b..80b8036bbd1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -276,6 +276,13 @@ for the ChangeLog file, if none already exists. Customize
276built-in IDNA support now). 276built-in IDNA support now).
277 277
278--- 278---
279*** When sending HTML messages with embedded images, and you have
280exiftool installed, and you rotate images with EXIF data (i.e.,
281JPEGs), the rotational information will be inserted into the outgoing
282image in the message. (The original image will not have its
283orientation affected.)
284
285---
279*** The 'message-valid-fqdn-regexp' variable has been removed, since 286*** The 'message-valid-fqdn-regexp' variable has been removed, since
280there are now top-level domains added all the time. Message will no 287there are now top-level domains added all the time. Message will no
281longer warn about sending emails to top-level domains it hasn't heard 288longer warn about sending emails to top-level domains it hasn't heard
@@ -353,6 +360,8 @@ See the 'vc-faces' customization group.
353 360
354* New Modes and Packages in Emacs 25.2 361* New Modes and Packages in Emacs 25.2
355 362
363** New Elisp data-structure library `radix-tree'.
364
356 365
357* Incompatible Lisp Changes in Emacs 25.2 366* Incompatible Lisp Changes in Emacs 25.2
358 367
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index aab9c4b62f5..7792d0a2c74 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -1195,7 +1195,7 @@ set_local_socket (const char *local_socket_name)
1195 int use_tmpdir = 0; 1195 int use_tmpdir = 0;
1196 int saved_errno; 1196 int saved_errno;
1197 const char *server_name = local_socket_name; 1197 const char *server_name = local_socket_name;
1198 const char *tmpdir IF_LINT ( = NULL); 1198 const char *tmpdir;
1199 char *tmpdir_storage = NULL; 1199 char *tmpdir_storage = NULL;
1200 char *socket_name_storage = NULL; 1200 char *socket_name_storage = NULL;
1201 1201
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index 90e683ed855..45779dae5c2 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -338,7 +338,7 @@ main (int argc, char **argv)
338 int lockcount = 0; 338 int lockcount = 0;
339 int status = 0; 339 int status = 0;
340#if defined (MAIL_USE_MAILLOCK) && defined (HAVE_TOUCHLOCK) 340#if defined (MAIL_USE_MAILLOCK) && defined (HAVE_TOUCHLOCK)
341 time_t touched_lock IF_LINT (= 0); 341 time_t touched_lock;
342#endif 342#endif
343 343
344 if (setuid (getuid ()) < 0 || setregid (-1, real_gid) < 0) 344 if (setuid (getuid ()) < 0 || setregid (-1, real_gid) < 0)
diff --git a/lib/secure_getenv.c b/lib/secure_getenv.c
index f359ab2173b..88a60dc33c3 100644
--- a/lib/secure_getenv.c
+++ b/lib/secure_getenv.c
@@ -1,4 +1,4 @@
1/* Look up an environment variable more securely. 1/* Look up an environment variable, returning NULL in insecure situations.
2 2
3 Copyright 2013-2016 Free Software Foundation, Inc. 3 Copyright 2013-2016 Free Software Foundation, Inc.
4 4
@@ -20,22 +20,35 @@
20#include <stdlib.h> 20#include <stdlib.h>
21 21
22#if !HAVE___SECURE_GETENV 22#if !HAVE___SECURE_GETENV
23# if HAVE_ISSETUGID 23# if HAVE_ISSETUGID || (HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID)
24# include <unistd.h> 24# include <unistd.h>
25# else
26# undef issetugid
27# define issetugid() 1
28# endif 25# endif
29#endif 26#endif
30 27
31char * 28char *
32secure_getenv (char const *name) 29secure_getenv (char const *name)
33{ 30{
34#if HAVE___SECURE_GETENV 31#if HAVE___SECURE_GETENV /* glibc */
35 return __secure_getenv (name); 32 return __secure_getenv (name);
36#else 33#elif HAVE_ISSETUGID /* OS X, FreeBSD, NetBSD, OpenBSD */
37 if (issetugid ()) 34 if (issetugid ())
38 return 0; 35 return NULL;
36 return getenv (name);
37#elif HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID /* other Unix */
38 if (geteuid () != getuid () || getegid () != getgid ())
39 return NULL;
39 return getenv (name); 40 return getenv (name);
41#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ /* native Windows */
42 /* On native Windows, there is no such concept as setuid or setgid binaries.
43 - Programs launched as system services have high privileges, but they don't
44 inherit environment variables from a user.
45 - Programs launched by a user with "Run as Administrator" have high
46 privileges and use the environment variables, but the user has been asked
47 whether he agrees.
48 - Programs launched by a user without "Run as Administrator" cannot gain
49 high privileges, therefore there is no risk. */
50 return getenv (name);
51#else
52 return NULL;
40#endif 53#endif
41} 54}
diff --git a/lib/verify.h b/lib/verify.h
index 2f4383743bb..5c8381d2906 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -263,7 +263,7 @@ template <int w>
263# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) 263# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
264#elif 1200 <= _MSC_VER 264#elif 1200 <= _MSC_VER
265# define assume(R) __assume (R) 265# define assume(R) __assume (R)
266#elif (defined lint \ 266#elif ((defined GCC_LINT || defined lint) \
267 && (__has_builtin (__builtin_trap) \ 267 && (__has_builtin (__builtin_trap) \
268 || 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)))) 268 || 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))))
269 /* Doing it this way helps various packages when configured with 269 /* Doing it this way helps various packages when configured with
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 11316f1d9d6..424b8e31936 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -500,41 +500,26 @@ Return non-nil in the case where no autoloads were added at point."
500 (let ((generated-autoload-file buffer-file-name)) 500 (let ((generated-autoload-file buffer-file-name))
501 (autoload-generate-file-autoloads file (current-buffer)))) 501 (autoload-generate-file-autoloads file (current-buffer))))
502 502
503(defun autoload--split-prefixes-1 (strs)
504 (let ((prefixes ()))
505 (dolist (str strs)
506 (string-match "\\`[^-:/_]*[-:/_]*" str)
507 (let* ((prefix (match-string 0 str))
508 (tail (substring str (match-end 0)))
509 (cell (assoc prefix prefixes)))
510 (cond
511 ((null cell) (push (list prefix tail) prefixes))
512 ((equal (cadr cell) tail) nil)
513 (t (setcdr cell (cons tail (cdr cell)))))))
514 prefixes))
515
516(defvar autoload-compute-prefixes t 503(defvar autoload-compute-prefixes t
517 "If non-nil, autoload will add code to register the prefixes used in a file. 504 "If non-nil, autoload will add code to register the prefixes used in a file.
518Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines 505Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
519variables or functions that use \"foo-\" as prefix, that will not be registered. 506variables or functions that use \"foo-\" as prefix, that will not be registered.
520But all other prefixes will be included.") 507But all other prefixes will be included.")
521 508
522(defconst autoload-defs-autoload-max-size 5 509(defconst autoload-def-prefixes-max-entries 5
523 "Target length of the list of definition prefixes per file. 510 "Target length of the list of definition prefixes per file.
524If set too small, the prefixes will be too generic (i.e. they'll use little 511If set too small, the prefixes will be too generic (i.e. they'll use little
525memory, we'll end up looking in too many files when we need a particular 512memory, we'll end up looking in too many files when we need a particular
526prefix), and if set too large, they will be too specific (i.e. they will 513prefix), and if set too large, they will be too specific (i.e. they will
527cost more memory use).") 514cost more memory use).")
528 515
529(defvar autoload-popular-prefixes nil) 516(defconst autoload-def-prefixes-max-length 12
517 "Target size of definition prefixes.
518Don't try to split prefixes that are already longer than that.")
519
520(require 'radix-tree)
530 521
531(defun autoload--make-defs-autoload (defs file) 522(defun autoload--make-defs-autoload (defs file)
532 ;; FIXME: avoid redundant entries. E.g. opascal currently has
533 ;; "opascal-" "opascal--literal-start-re" "opascal--syntax-propertize"
534 ;; where only the first one should be kept.
535 ;; FIXME: Avoid keeping too-long-prefixes. E.g. ob-scheme currently has
536 ;; "org-babel-scheme-" "org-babel-default-header-args:scheme"
537 ;; "org-babel-expand-body:scheme" "org-babel-execute:scheme".
538 523
539 ;; Remove the defs that obey the rule that file foo.el (or 524 ;; Remove the defs that obey the rule that file foo.el (or
540 ;; foo-mode.el) uses "foo-" as prefix. 525 ;; foo-mode.el) uses "foo-" as prefix.
@@ -548,39 +533,32 @@ cost more memory use).")
548 533
549 ;; Then compute a small set of prefixes that cover all the 534 ;; Then compute a small set of prefixes that cover all the
550 ;; remaining definitions. 535 ;; remaining definitions.
551 (let ((prefixes (autoload--split-prefixes-1 defs)) 536 (let* ((tree (let ((tree radix-tree-empty))
552 (again t)) 537 (dolist (def defs)
553 ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes)) 538 (setq tree (radix-tree-insert tree def t)))
554 (while again 539 tree))
555 (setq again nil) 540 (prefixes (list (cons "" tree))))
556 (let ((newprefixes 541 (while
557 (sort 542 (let ((newprefixes nil)
558 (mapcar (lambda (cell) 543 (changes nil))
559 (cons cell 544 (dolist (pair prefixes)
560 (autoload--split-prefixes-1 (cdr cell)))) 545 (let ((prefix (car pair)))
561 prefixes) 546 (if (or (> (length prefix) autoload-def-prefixes-max-length)
562 (lambda (x y) (< (length (cdr x)) (length (cdr y))))))) 547 (radix-tree-lookup (cdr pair) ""))
563 (setq prefixes nil) 548 ;; No point splitting it any further.
564 (while newprefixes 549 (push pair newprefixes)
565 (let ((x (pop newprefixes))) 550 (setq changes t)
566 (if (or (equal '("") (cdar x)) 551 (radix-tree-iter-subtrees
567 (and (cddr x) 552 (cdr pair) (lambda (sprefix subtree)
568 (not (member (caar x) 553 (push (cons (concat prefix sprefix) subtree)
569 autoload-popular-prefixes)) 554 newprefixes))))))
570 (> (+ (length prefixes) (length newprefixes) 555 (and changes
571 (length (cdr x))) 556 (or (and (null (cdr prefixes)) (equal "" (caar prefixes)))
572 autoload-defs-autoload-max-size))) 557 (<= (length newprefixes)
573 ;; Nothing to split or would split too deep. 558 autoload-def-prefixes-max-entries))
574 (push (car x) prefixes) 559 (setq prefixes newprefixes)
575 ;; (message "Expand %S to %S" (caar x) (cdr x)) 560 (< (length prefixes) autoload-def-prefixes-max-entries))))
576 (setq again t) 561
577 (setq prefixes
578 (nconc (mapcar (lambda (cell)
579 (cons (concat (caar x)
580 (car cell))
581 (cdr cell)))
582 (cdr x))
583 prefixes)))))))
584 ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) 562 ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
585 (when prefixes 563 (when prefixes
586 `(if (fboundp 'register-definition-prefixes) 564 `(if (fboundp 'register-definition-prefixes)
@@ -989,7 +967,7 @@ write its autoloads into the specified file instead."
989 t files-re)) 967 t files-re))
990 dirs))) 968 dirs)))
991 (done ()) ;Files processed; to remove duplicates. 969 (done ()) ;Files processed; to remove duplicates.
992 (changed nil) ;Non-nil if some change occured. 970 (changed nil) ;Non-nil if some change occurred.
993 (last-time) 971 (last-time)
994 ;; Files with no autoload cookies or whose autoloads go to other 972 ;; Files with no autoload cookies or whose autoloads go to other
995 ;; files because of file-local autoload-generated-file settings. 973 ;; files because of file-local autoload-generated-file settings.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 7e164c0fe5c..0b8dddfacc9 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -509,6 +509,7 @@ MATCH is the pattern that needs to be matched, of the form:
509 (numberp . stringp) 509 (numberp . stringp)
510 (numberp . byte-code-function-p) 510 (numberp . byte-code-function-p)
511 (consp . arrayp) 511 (consp . arrayp)
512 (consp . atom)
512 (consp . vectorp) 513 (consp . vectorp)
513 (consp . stringp) 514 (consp . stringp)
514 (consp . byte-code-function-p) 515 (consp . byte-code-function-p)
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
new file mode 100644
index 00000000000..d4b5cd211e4
--- /dev/null
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -0,0 +1,188 @@
1;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2016 Free Software Foundation, Inc.
4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6;; Keywords:
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software: you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23;;; Commentary:
24
25;; There are many different options for how to represent radix trees
26;; in Elisp. Here I chose a very simple one. A radix-tree can be either:
27;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string
28;; meaning that everything that starts with PREFIX is in PTREE,
29;; and everything else in RTREE. It also has the property that
30;; everything that starts with the first letter of PREFIX but not with
31;; that whole PREFIX is not in RTREE (i.e. is not in the tree at all).
32;; - anything else is taken as the value to associate with the empty string.
33;; So every node is basically an (improper) alist where each mapping applies
34;; to a different leading letter.
35;;
36;; The main downside of this representation is that the lookup operation
37;; is slower because each level of the tree is an alist rather than some kind
38;; of array, so every level's lookup is O(N) rather than O(1). We could easily
39;; solve this by using char-tables instead of alists, but that would make every
40;; level take up a lot more memory, and it would make the resulting
41;; data structure harder to read (by a human) when printed out.
42
43;;; Code:
44
45(defun radix-tree--insert (tree key val i)
46 (pcase tree
47 (`((,prefix . ,ptree) . ,rtree)
48 (let* ((ni (+ i (length prefix)))
49 (cmp (compare-strings prefix nil nil key i ni)))
50 (if (eq t cmp)
51 (let ((nptree (radix-tree--insert ptree key val ni)))
52 `((,prefix . ,nptree) . ,rtree))
53 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
54 (if (zerop n)
55 (let ((nrtree (radix-tree--insert rtree key val i)))
56 `((,prefix . ,ptree) . ,nrtree))
57 (let* ((nprefix (substring prefix 0 n))
58 (kprefix (substring key (+ i n)))
59 (pprefix (substring prefix n))
60 (ktree (if (equal kprefix "") val
61 `((,kprefix . ,val)))))
62 `((,nprefix
63 . ((,pprefix . ,ptree) . ,ktree))
64 . ,rtree)))))))
65 (_
66 (if (= (length key) i) val
67 (let ((prefix (substring key i)))
68 `((,prefix . ,val) . ,tree))))))
69
70(defun radix-tree--remove (tree key i)
71 (pcase tree
72 (`((,prefix . ,ptree) . ,rtree)
73 (let* ((ni (+ i (length prefix)))
74 (cmp (compare-strings prefix nil nil key i ni)))
75 (if (eq t cmp)
76 (pcase (radix-tree--remove ptree key ni)
77 (`nil rtree)
78 (`((,pprefix . ,pptree))
79 `((,(concat prefix pprefix) . ,pptree) . ,rtree))
80 (nptree `((,prefix . ,nptree) . ,rtree)))
81 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
82 (if (zerop n)
83 (let ((nrtree (radix-tree--remove rtree key i)))
84 `((,prefix . ,ptree) . ,nrtree))
85 tree)))))
86 (_
87 (if (= (length key) i) nil tree))))
88
89
90(defun radix-tree--lookup (tree string i)
91 (pcase tree
92 (`((,prefix . ,ptree) . ,rtree)
93 (let* ((ni (+ i (length prefix)))
94 (cmp (compare-strings prefix nil nil string i ni)))
95 (if (eq t cmp)
96 (radix-tree--lookup ptree string ni)
97 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
98 (if (zerop n)
99 (radix-tree--lookup rtree string i)
100 (+ i n))))))
101 (val
102 (if (and val (equal (length string) i))
103 (if (integerp val) `(t . ,val) val)
104 i))))
105
106(defun radix-tree--subtree (tree string i)
107 (if (equal (length string) i) tree
108 (pcase tree
109 (`((,prefix . ,ptree) . ,rtree)
110 (let* ((ni (+ i (length prefix)))
111 (cmp (compare-strings prefix nil nil string i ni)))
112 (if (eq t cmp)
113 (radix-tree--subtree ptree string ni)
114 (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
115 (cond
116 ((zerop n) (radix-tree--subtree rtree string i))
117 ((equal (+ n i) (length string))
118 (let ((nprefix (substring prefix n)))
119 `((,nprefix . ,ptree))))
120 (t nil))))))
121 (_ nil))))
122
123;;; Entry points
124
125(defconst radix-tree-empty nil
126 "The empty radix-tree.")
127
128(defun radix-tree-insert (tree key val)
129 "Insert a mapping from KEY to VAL in radix TREE."
130 (when (consp val) (setq val `(t . ,val)))
131 (if val (radix-tree--insert tree key val 0)
132 (radix-tree--remove tree key 0)))
133
134(defun radix-tree-lookup (tree key)
135 "Return the value associated to KEY in radix TREE.
136If not found, return nil."
137 (pcase (radix-tree--lookup tree key 0)
138 (`(t . ,val) val)
139 ((pred numberp) nil)
140 (val val)))
141
142(defun radix-tree-subtree (tree string)
143 "Return the subtree of TREE rooted at the prefix STRING."
144 (radix-tree--subtree tree string 0))
145
146(eval-and-compile
147 (pcase-defmacro radix-tree-leaf (vpat)
148 ;; FIXME: We'd like to use a negative pattern (not consp), but pcase
149 ;; doesn't support it. Using `atom' works but generates sub-optimal code.
150 `(or `(t . ,,vpat) (and (pred atom) ,vpat))))
151
152(defun radix-tree-iter-subtrees (tree fun)
153 "Apply FUN to every immediate subtree of radix TREE.
154FUN is called with two arguments: PREFIX and SUBTREE.
155You can test if SUBTREE is a leaf (and extract its value) with the
156pcase pattern (radix-tree-leaf PAT)."
157 (while tree
158 (pcase tree
159 (`((,prefix . ,ptree) . ,rtree)
160 (funcall fun prefix ptree)
161 (setq tree rtree))
162 (_ (funcall fun "" tree)
163 (setq tree nil)))))
164
165(defun radix-tree-iter-mappings (tree fun &optional prefix)
166 "Apply FUN to every mapping in TREE.
167FUN is called with two arguments: KEY and VAL.
168PREFIX is only used internally."
169 (radix-tree-iter-subtrees
170 tree
171 (lambda (p s)
172 (let ((nprefix (concat prefix p)))
173 (pcase s
174 ((radix-tree-leaf v) (funcall fun nprefix v))
175 (_ (radix-tree-iter-mappings s fun nprefix)))))))
176
177;; (defun radix-tree->alist (tree)
178;; (let ((al nil))
179;; (radix-tree-iter-mappings tree (lambda (p v) (push (cons p v) al)))
180;; al))
181
182(defun radix-tree-count (tree)
183 (let ((i 0))
184 (radix-tree-iter-mappings tree (lambda (_ _) (setq i (1+ i))))
185 i))
186
187(provide 'radix-tree)
188;;; radix-tree.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 1ca7c5cafef..03ce789e9eb 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4545,7 +4545,7 @@ This function could be useful in `message-setup-hook'."
4545 (setq message-options options) 4545 (setq message-options options)
4546 ;; Avoid copying text props (except hard newlines). 4546 ;; Avoid copying text props (except hard newlines).
4547 (insert (with-current-buffer mailbuf 4547 (insert (with-current-buffer mailbuf
4548 (mml-buffer-substring-no-properties-except-hard-newlines 4548 (mml-buffer-substring-no-properties-except-some
4549 (point-min) (point-max)))) 4549 (point-min) (point-max))))
4550 ;; Remove some headers. 4550 ;; Remove some headers.
4551 (message-encode-message-body) 4551 (message-encode-message-body)
@@ -4909,7 +4909,7 @@ Otherwise, generate and save a value for `canlock-password' first."
4909 ;; Avoid copying text props (except hard newlines). 4909 ;; Avoid copying text props (except hard newlines).
4910 (insert 4910 (insert
4911 (with-current-buffer messbuf 4911 (with-current-buffer messbuf
4912 (mml-buffer-substring-no-properties-except-hard-newlines 4912 (mml-buffer-substring-no-properties-except-some
4913 (point-min) (point-max)))) 4913 (point-min) (point-max))))
4914 (message-encode-message-body) 4914 (message-encode-message-body)
4915 ;; Remove some headers. 4915 ;; Remove some headers.
@@ -8386,30 +8386,32 @@ Used in `message-simplify-recipients'."
8386(defun message-toggle-image-thumbnails () 8386(defun message-toggle-image-thumbnails ()
8387 "For any included image files, insert a thumbnail of that image." 8387 "For any included image files, insert a thumbnail of that image."
8388 (interactive) 8388 (interactive)
8389 (let ((overlays (overlays-in (point-min) (point-max))) 8389 (let ((displayed nil))
8390 (displayed nil)) 8390 (save-excursion
8391 (while overlays 8391 (goto-char (point-min))
8392 (let ((overlay (car overlays))) 8392 (while (not (eobp))
8393 (when (overlay-get overlay 'put-image) 8393 (when-let ((props (get-text-property (point) 'display)))
8394 (delete-overlay overlay) 8394 (when (and (consp props)
8395 (setq displayed t))) 8395 (eq (car props) 'image))
8396 (setq overlays (cdr overlays))) 8396 (put-text-property (point) (1+ (point)) 'display nil)
8397 (setq displayed t)))))
8397 (unless displayed 8398 (unless displayed
8398 (save-excursion 8399 (save-excursion
8399 (goto-char (point-min)) 8400 (goto-char (point-min))
8400 (while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t) 8401 (while (re-search-forward "<img.*src=\"\\([^\"]+\\).*>" nil t)
8401 (let ((file (match-string 1)) 8402 (let ((string (match-string 0))
8403 (file (match-string 1))
8402 (edges (window-inside-pixel-edges 8404 (edges (window-inside-pixel-edges
8403 (get-buffer-window (current-buffer))))) 8405 (get-buffer-window (current-buffer)))))
8404 (put-image 8406 (delete-region (match-beginning 0) (match-end 0))
8407 (insert-image
8405 (create-image 8408 (create-image
8406 file 'imagemagick nil 8409 file 'imagemagick nil
8407 :max-width (truncate 8410 :max-width (truncate
8408 (* 0.7 (- (nth 2 edges) (nth 0 edges)))) 8411 (* 0.7 (- (nth 2 edges) (nth 0 edges))))
8409 :max-height (truncate 8412 :max-height (truncate
8410 (* 0.5 (- (nth 3 edges) (nth 1 edges))))) 8413 (* 0.5 (- (nth 3 edges) (nth 1 edges)))))
8411 (match-beginning 0) 8414 string)))))))
8412 " ")))))))
8413 8415
8414(provide 'message) 8416(provide 'message)
8415 8417
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 97cc87d06e3..eae4c61be82 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -413,12 +413,21 @@ A message part needs to be split into %d charset parts. Really send? "
413 (setq contents (append (list (cons 'tag-location orig-point)) contents)) 413 (setq contents (append (list (cons 'tag-location orig-point)) contents))
414 (cons (intern name) (nreverse contents)))) 414 (cons (intern name) (nreverse contents))))
415 415
416(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) 416(defun mml-buffer-substring-no-properties-except-some (start end)
417 (let ((str (buffer-substring-no-properties start end)) 417 (let ((str (buffer-substring-no-properties start end))
418 (bufstart start) tmp) 418 (bufstart start)
419 (while (setq tmp (text-property-any start end 'hard 't)) 419 tmp)
420 (set-text-properties (- tmp bufstart) (- tmp bufstart -1) 420 ;; Copy over all hard newlines.
421 '(hard t) str) 421 (while (setq tmp (text-property-any start end 'hard t))
422 (put-text-property (- tmp bufstart) (- tmp bufstart -1)
423 'hard t str)
424 (setq start (1+ tmp)))
425 ;; Copy over all `display' properties (which are usually images).
426 (setq start bufstart)
427 (while (setq tmp (text-property-not-all start end 'display nil))
428 (put-text-property (- tmp bufstart) (- tmp bufstart -1)
429 'display (get-text-property tmp 'display)
430 str)
422 (setq start (1+ tmp))) 431 (setq start (1+ tmp)))
423 str)) 432 str))
424 433
@@ -435,21 +444,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
435 (if (re-search-forward "<#\\(/\\)?mml." nil t) 444 (if (re-search-forward "<#\\(/\\)?mml." nil t)
436 (setq count (+ count (if (match-beginning 1) -1 1))) 445 (setq count (+ count (if (match-beginning 1) -1 1)))
437 (goto-char (point-max)))) 446 (goto-char (point-max))))
438 (mml-buffer-substring-no-properties-except-hard-newlines 447 (mml-buffer-substring-no-properties-except-some
439 beg (if (> count 0) 448 beg (if (> count 0)
440 (point) 449 (point)
441 (match-beginning 0)))) 450 (match-beginning 0))))
442 (if (re-search-forward 451 (if (re-search-forward
443 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) 452 "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
444 (prog1 453 (prog1
445 (mml-buffer-substring-no-properties-except-hard-newlines 454 (mml-buffer-substring-no-properties-except-some
446 beg (match-beginning 0)) 455 beg (match-beginning 0))
447 (if (or (not (match-beginning 1)) 456 (if (or (not (match-beginning 1))
448 (equal (match-string 2) "multipart")) 457 (equal (match-string 2) "multipart"))
449 (goto-char (match-beginning 0)) 458 (goto-char (match-beginning 0))
450 (when (looking-at "[ \t]*\n") 459 (when (looking-at "[ \t]*\n")
451 (forward-line 1)))) 460 (forward-line 1))))
452 (mml-buffer-substring-no-properties-except-hard-newlines 461 (mml-buffer-substring-no-properties-except-some
453 beg (goto-char (point-max))))))) 462 beg (goto-char (point-max)))))))
454 463
455(defvar mml-boundary nil) 464(defvar mml-boundary nil)
@@ -514,7 +523,9 @@ be \"related\" or \"alternate\"."
514 (when (search-forward (url-filename parsed) end t) 523 (when (search-forward (url-filename parsed) end t)
515 (let ((cid (format "fsf.%d" cid))) 524 (let ((cid (format "fsf.%d" cid)))
516 (replace-match (concat "cid:" cid) t t) 525 (replace-match (concat "cid:" cid) t t)
517 (push (list cid (url-filename parsed)) new-parts)) 526 (push (list cid (url-filename parsed)
527 (get-text-property start 'display))
528 new-parts))
518 (setq cid (1+ cid))))))) 529 (setq cid (1+ cid)))))))
519 ;; We have local images that we want to include. 530 ;; We have local images that we want to include.
520 (if (not new-parts) 531 (if (not new-parts)
@@ -527,11 +538,41 @@ be \"related\" or \"alternate\"."
527 (setq cont 538 (setq cont
528 (nconc cont 539 (nconc cont
529 (list `(part (type . "image/png") 540 (list `(part (type . "image/png")
530 (filename . ,(nth 1 new-part)) 541 ,@(mml--possibly-alter-image
542 (nth 1 new-part)
543 (nth 2 new-part))
531 (id . ,(concat "<" (nth 0 new-part) 544 (id . ,(concat "<" (nth 0 new-part)
532 ">"))))))) 545 ">")))))))
533 cont)))) 546 cont))))
534 547
548(defun mml--possibly-alter-image (file-name image)
549 (if (or (null image)
550 (not (consp image))
551 (not (eq (car image) 'image))
552 (not (image-property image :rotation))
553 (not (executable-find "exiftool")))
554 `((filename . ,file-name))
555 `((filename . ,file-name)
556 (buffer
557 .
558 ,(with-current-buffer (mml-generate-new-buffer " *mml rotation*")
559 (set-buffer-multibyte nil)
560 (call-process "exiftool"
561 file-name
562 (list (current-buffer) nil)
563 nil
564 (format "-Orientation#=%d"
565 (cl-case (truncate
566 (image-property image :rotation))
567 (0 0)
568 (90 6)
569 (180 3)
570 (270 8)
571 (otherwise 0)))
572 "-o" "-"
573 "-")
574 (current-buffer))))))
575
535(defun mml-generate-mime-1 (cont) 576(defun mml-generate-mime-1 (cont)
536 (let ((mm-use-ultra-safe-encoding 577 (let ((mm-use-ultra-safe-encoding
537 (or mm-use-ultra-safe-encoding (assq 'sign cont)))) 578 (or mm-use-ultra-safe-encoding (assq 'sign cont))))
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 734155e217d..e9882253c70 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1818,9 +1818,21 @@ not be a new one). It returns non-nil if it got any new messages."
1818 ;; Read in the contents of the inbox files, renaming them as 1818 ;; Read in the contents of the inbox files, renaming them as
1819 ;; necessary, and adding to the list of files to delete 1819 ;; necessary, and adding to the list of files to delete
1820 ;; eventually. 1820 ;; eventually.
1821 (if file-name 1821 (unwind-protect
1822 (rmail-insert-inbox-text files nil) 1822 (progn
1823 (setq delete-files (rmail-insert-inbox-text files t))) 1823 ;; Set modified now to lock the file, so that we don't
1824 ;; encounter locking problems later in the middle of
1825 ;; reading the mail.
1826 (set-buffer-modified-p t)
1827 (if file-name
1828 (rmail-insert-inbox-text files nil)
1829 (setq delete-files (rmail-insert-inbox-text files t))))
1830 ;; If there was no new mail, or we aborted before actually
1831 ;; trying to get any, mark buffer unmodified. Otherwise the
1832 ;; buffer is correctly marked modified and the file locked
1833 ;; until we save out the new mail.
1834 (if (= (point-min) (point-max))
1835 (set-buffer-modified-p nil)))
1824 ;; Scan the new text and convert each message to 1836 ;; Scan the new text and convert each message to
1825 ;; Rmail/mbox format. 1837 ;; Rmail/mbox format.
1826 (goto-char (point-min)) 1838 (goto-char (point-min))
@@ -1969,11 +1981,6 @@ Value is the size of the newly read mail after conversion."
1969 size)) 1981 size))
1970 1982
1971(defun rmail-insert-inbox-text (files renamep) 1983(defun rmail-insert-inbox-text (files renamep)
1972 ;; Detect a locked file now, so that we avoid moving mail
1973 ;; out of the real inbox file. (That could scare people.)
1974 (or (memq (file-locked-p buffer-file-name) '(nil t))
1975 (error "RMAIL file %s is locked"
1976 (file-name-nondirectory buffer-file-name)))
1977 (let (file tofile delete-files popmail got-password password) 1984 (let (file tofile delete-files popmail got-password password)
1978 (while files 1985 (while files
1979 ;; Handle remote mailbox names specially; don't expand as filenames 1986 ;; Handle remote mailbox names specially; don't expand as filenames
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 5940b713958..1281dbbd72d 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -535,7 +535,7 @@ Emacs dired can't find files."
535 "Like `file-name-all-completions' for Tramp files." 535 "Like `file-name-all-completions' for Tramp files."
536 (all-completions 536 (all-completions
537 filename 537 filename
538 (with-parsed-tramp-file-name directory nil 538 (with-parsed-tramp-file-name (expand-file-name directory) nil
539 (with-tramp-file-property v localname "file-name-all-completions" 539 (with-tramp-file-property v localname "file-name-all-completions"
540 (save-match-data 540 (save-match-data
541 (tramp-adb-send-command 541 (tramp-adb-send-command
@@ -934,20 +934,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
934 (unless (stringp program) 934 (unless (stringp program)
935 (tramp-error v 'file-error "PROGRAM must be a string")) 935 (tramp-error v 'file-error "PROGRAM must be a string"))
936 936
937 (let ((command 937 (let* ((buffer
938 (format "cd %s; %s" 938 (if buffer
939 (tramp-shell-quote-argument localname) 939 (get-buffer-create buffer)
940 (mapconcat 'tramp-shell-quote-argument 940 ;; BUFFER can be nil. We use a temporary buffer.
941 (cons program args) " "))) 941 (generate-new-buffer tramp-temp-buffer-name)))
942 (tramp-process-connection-type 942 (command
943 (or (null program) tramp-process-connection-type)) 943 (format "cd %s; %s"
944 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) 944 (tramp-shell-quote-argument localname)
945 (name1 name) 945 (mapconcat 'tramp-shell-quote-argument
946 (i 0)) 946 (cons program args) " ")))
947 947 (tramp-process-connection-type
948 (unless buffer 948 (or (null program) tramp-process-connection-type))
949 ;; BUFFER can be nil. We use a temporary buffer. 949 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
950 (setq buffer (generate-new-buffer tramp-temp-buffer-name))) 950 (name1 name)
951 (i 0))
952
951 (while (get-process name1) 953 (while (get-process name1)
952 ;; NAME must be unique as process name. 954 ;; NAME must be unique as process name.
953 (setq i (1+ i) 955 (setq i (1+ i)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 098d40e7cc0..ac390e5d5a6 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -407,6 +407,42 @@ Every entry is a list (NAME ADDRESS).")
407(defconst tramp-hal-interface-device "org.freedesktop.Hal.Device" 407(defconst tramp-hal-interface-device "org.freedesktop.Hal.Device"
408 "The device interface of the HAL daemon.") 408 "The device interface of the HAL daemon.")
409 409
410(defconst tramp-gvfs-file-attributes
411 '("type"
412 "standard::display-name"
413 ;; We don't need this one. It is used as delimiter in case the
414 ;; display name contains spaces, which is hard to parse.
415 "standard::icon"
416 "standard::symlink-target"
417 "unix::nlink"
418 "unix::uid"
419 "owner::user"
420 "unix::gid"
421 "owner::group"
422 "time::access"
423 "time::modified"
424 "time::changed"
425 "standard::size"
426 "unix::mode"
427 "access::can-read"
428 "access::can-write"
429 "access::can-execute"
430 "unix::inode"
431 "unix::device")
432 "GVFS file attributes.")
433
434(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
435 (concat "[[:blank:]]"
436 (regexp-opt tramp-gvfs-file-attributes t)
437 "=\\([^[:blank:]]+\\)")
438 "Regexp to parse GVFS file attributes with `gvfs-ls'.")
439
440(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
441 (concat "^[[:blank:]]*"
442 (regexp-opt tramp-gvfs-file-attributes t)
443 ":[[:blank:]]+\\(.*\\)$")
444 "Regexp to parse GVFS file attributes with `gvfs-info'.")
445
410 446
411;; New handlers should be added here. 447;; New handlers should be added here.
412(defconst tramp-gvfs-file-name-handler-alist 448(defconst tramp-gvfs-file-name-handler-alist
@@ -784,127 +820,185 @@ file names."
784 (tramp-run-real-handler 820 (tramp-run-real-handler
785 'expand-file-name (list localname)))))) 821 'expand-file-name (list localname))))))
786 822
787(defun tramp-gvfs-handle-file-attributes (filename &optional id-format) 823(defun tramp-gvfs-get-directory-attributes (directory)
788 "Like `file-attributes' for Tramp files." 824 "Return GVFS attributes association list of all files in DIRECTORY."
789 (unless id-format (setq id-format 'integer))
790 (ignore-errors 825 (ignore-errors
791 ;; Don't modify `last-coding-system-used' by accident. 826 ;; Don't modify `last-coding-system-used' by accident.
792 (let ((last-coding-system-used last-coding-system-used) 827 (let ((last-coding-system-used last-coding-system-used)
793 (process-environment (cons "LC_MESSAGES=C" process-environment)) 828 result)
794 dirp res-symlink-target res-numlinks res-uid res-gid res-access 829 (with-parsed-tramp-file-name directory nil
795 res-mod res-change res-size res-filemodes res-inode res-device) 830 (with-tramp-file-property v localname "directory-gvfs-attributes"
831 (tramp-message v 5 "directory gvfs attributes: %s" localname)
832 ;; Send command.
833 (tramp-gvfs-send-command
834 v "gvfs-ls" "-h" "-n" "-a"
835 (mapconcat 'identity tramp-gvfs-file-attributes ",")
836 (tramp-gvfs-url-file-name directory))
837 ;; Parse output ...
838 (with-current-buffer (tramp-get-connection-buffer v)
839 (goto-char (point-min))
840 (while (re-search-forward
841 (concat "^\\(.+\\)[[:blank:]]"
842 "\\([[:digit:]]+\\)[[:blank:]]"
843 "(\\(.+\\))[[:blank:]]"
844 "standard::display-name=\\(.+\\)[[:blank:]]"
845 "standard::icon=")
846 (point-at-eol) t)
847 (let ((item (list (cons "standard::display-name" (match-string 4))
848 (cons "type" (match-string 3))
849 (cons "standard::size" (match-string 2))
850 (match-string 1))))
851 (while (re-search-forward
852 tramp-gvfs-file-attributes-with-gvfs-ls-regexp
853 (point-at-eol) t)
854 (push (cons (match-string 1) (match-string 2)) item))
855 (push (nreverse item) result))
856 (forward-line)))
857 result)))))
858
859(defun tramp-gvfs-get-root-attributes (filename)
860 "Return GVFS attributes association list of FILENAME."
861 (ignore-errors
862 ;; Don't modify `last-coding-system-used' by accident.
863 (let ((last-coding-system-used last-coding-system-used)
864 result)
796 (with-parsed-tramp-file-name filename nil 865 (with-parsed-tramp-file-name filename nil
797 (with-tramp-file-property 866 (with-tramp-file-property v localname "file-gvfs-attributes"
798 v localname (format "file-attributes-%s" id-format) 867 (tramp-message v 5 "file gvfs attributes: %s" localname)
799 (tramp-message v 5 "file attributes: %s" localname) 868 ;; Send command.
800 (tramp-gvfs-send-command 869 (tramp-gvfs-send-command
801 v "gvfs-info" (tramp-gvfs-url-file-name filename)) 870 v "gvfs-info" (tramp-gvfs-url-file-name filename))
802 ;; Parse output ... 871 ;; Parse output ...
803 (with-current-buffer (tramp-get-connection-buffer v) 872 (with-current-buffer (tramp-get-connection-buffer v)
804 (goto-char (point-min)) 873 (goto-char (point-min))
805 (when (re-search-forward "attributes:" nil t) 874 (while (re-search-forward
806 ;; ... directory or symlink 875 tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
807 (goto-char (point-min)) 876 (push (cons (match-string 1) (match-string 2)) result))
808 (setq dirp (if (re-search-forward "type: directory" nil t) t)) 877 result))))))
809 (goto-char (point-min)) 878
810 (setq res-symlink-target 879(defun tramp-gvfs-get-file-attributes (filename)
811 (if (re-search-forward 880 "Return GVFS attributes association list of FILENAME."
812 "standard::symlink-target: \\(.+\\)$" nil t) 881 (setq filename (directory-file-name (expand-file-name filename)))
813 (match-string 1))) 882 (with-parsed-tramp-file-name filename nil
814 ;; ... number links 883 (if (or
815 (goto-char (point-min)) 884 (and (string-match "^\\(afp\\|smb\\)$" method)
816 (setq res-numlinks 885 (string-match "^/?\\([^/]+\\)$" localname))
817 (if (re-search-forward "unix::nlink: \\([0-9]+\\)" nil t) 886 (string-equal localname "/"))
818 (string-to-number (match-string 1)) 0)) 887 (tramp-gvfs-get-root-attributes filename)
819 ;; ... uid and gid 888 (assoc
820 (goto-char (point-min)) 889 (file-name-nondirectory filename)
821 (setq res-uid 890 (tramp-gvfs-get-directory-attributes (file-name-directory filename))))))
822 (if (eq id-format 'integer) 891
823 (if (re-search-forward "unix::uid: \\([0-9]+\\)" nil t) 892(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
824 (string-to-number (match-string 1)) 893 "Like `file-attributes' for Tramp files."
825 -1) 894 (unless id-format (setq id-format 'integer))
826 (if (re-search-forward "owner::user: \\(.+\\)$" nil t) 895 (ignore-errors
827 (match-string 1) 896 (let ((attributes (tramp-gvfs-get-file-attributes filename))
828 "UNKNOWN"))) 897 dirp res-symlink-target res-numlinks res-uid res-gid res-access
829 (setq res-gid 898 res-mod res-change res-size res-filemodes res-inode res-device)
830 (if (eq id-format 'integer) 899 (when attributes
831 (if (re-search-forward "unix::gid: \\([0-9]+\\)" nil t) 900 ;; ... directory or symlink
832 (string-to-number (match-string 1)) 901 (setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t))
833 -1) 902 (setq res-symlink-target
834 (if (re-search-forward "owner::group: \\(.+\\)$" nil t) 903 (cdr (assoc "standard::symlink-target" attributes)))
835 (match-string 1) 904 ;; ... number links
836 "UNKNOWN"))) 905 (setq res-numlinks
837 ;; ... last access, modification and change time 906 (string-to-number
838 (goto-char (point-min)) 907 (or (cdr (assoc "unix::nlink" attributes)) "0")))
839 (setq res-access 908 ;; ... uid and gid
840 (if (re-search-forward "time::access: \\([0-9]+\\)" nil t) 909 (setq res-uid
841 (seconds-to-time (string-to-number (match-string 1))) 910 (if (eq id-format 'integer)
842 '(0 0))) 911 (string-to-number
843 (goto-char (point-min)) 912 (or (cdr (assoc "unix::uid" attributes))
844 (setq res-mod 913 (format "%s" tramp-unknown-id-integer)))
845 (if (re-search-forward "time::modified: \\([0-9]+\\)" nil t) 914 (or (cdr (assoc "owner::user" attributes))
846 (seconds-to-time (string-to-number (match-string 1))) 915 (cdr (assoc "unix::uid" attributes))
847 '(0 0))) 916 tramp-unknown-id-string)))
848 (goto-char (point-min)) 917 (setq res-gid
849 (setq res-change 918 (if (eq id-format 'integer)
850 (if (re-search-forward "time::changed: \\([0-9]+\\)" nil t) 919 (string-to-number
851 (seconds-to-time (string-to-number (match-string 1))) 920 (or (cdr (assoc "unix::gid" attributes))
852 '(0 0))) 921 (format "%s" tramp-unknown-id-integer)))
853 ;; ... size 922 (or (cdr (assoc "owner::group" attributes))
854 (goto-char (point-min)) 923 (cdr (assoc "unix::gid" attributes))
855 (setq res-size 924 tramp-unknown-id-string)))
856 (if (re-search-forward "standard::size: \\([0-9]+\\)" nil t) 925 ;; ... last access, modification and change time
857 (string-to-number (match-string 1)) 0)) 926 (setq res-access
858 ;; ... file mode flags 927 (seconds-to-time
859 (goto-char (point-min)) 928 (string-to-number
860 (setq res-filemodes 929 (or (cdr (assoc "time::access" attributes)) "0"))))
861 (if (re-search-forward "unix::mode: \\([0-9]+\\)" nil t) 930 (setq res-mod
862 (tramp-file-mode-from-int 931 (seconds-to-time
863 (string-to-number (match-string 1))) 932 (string-to-number
864 (if dirp "drwx------" "-rwx------"))) 933 (or (cdr (assoc "time::modified" attributes)) "0"))))
865 ;; ... inode and device 934 (setq res-change
866 (goto-char (point-min)) 935 (seconds-to-time
867 (setq res-inode 936 (string-to-number
868 (if (re-search-forward "unix::inode: \\([0-9]+\\)" nil t) 937 (or (cdr (assoc "time::changed" attributes)) "0"))))
869 (string-to-number (match-string 1)) 938 ;; ... size
870 (tramp-get-inode v))) 939 (setq res-size
871 (goto-char (point-min)) 940 (string-to-number
872 (setq res-device 941 (or (cdr (assoc "standard::size" attributes)) "0")))
873 (if (re-search-forward "unix::device: \\([0-9]+\\)" nil t) 942 ;; ... file mode flags
874 (string-to-number (match-string 1)) 943 (setq res-filemodes
875 (tramp-get-device v))) 944 (let ((n (cdr (assoc "unix::mode" attributes))))
876 945 (if n
877 ;; Return data gathered. 946 (tramp-file-mode-from-int (string-to-number n))
878 (list 947 (format
879 ;; 0. t for directory, string (name linked to) for 948 "%s%s%s%s------"
880 ;; symbolic link, or nil. 949 (if dirp "d" "-")
881 (or dirp res-symlink-target) 950 (if (equal (cdr (assoc "access::can-read" attributes))
882 ;; 1. Number of links to file. 951 "FALSE")
883 res-numlinks 952 "-" "r")
884 ;; 2. File uid. 953 (if (equal (cdr (assoc "access::can-write" attributes))
885 res-uid 954 "FALSE")
886 ;; 3. File gid. 955 "-" "w")
887 res-gid 956 (if (equal (cdr (assoc "access::can-execute" attributes))
888 ;; 4. Last access time, as a list of integers. 957 "FALSE")
889 ;; 5. Last modification time, likewise. 958 "-" "x")))))
890 ;; 6. Last status change time, likewise. 959 ;; ... inode and device
891 res-access res-mod res-change 960 (setq res-inode
892 ;; 7. Size in bytes (-1, if number is out of range). 961 (let ((n (cdr (assoc "unix::inode" attributes))))
893 res-size 962 (if n
894 ;; 8. File modes. 963 (string-to-number n)
895 res-filemodes 964 (tramp-get-inode (tramp-dissect-file-name filename)))))
896 ;; 9. t if file's gid would change if file were deleted 965 (setq res-device
897 ;; and recreated. 966 (let ((n (cdr (assoc "unix::device" attributes))))
898 nil 967 (if n
899 ;; 10. Inode number. 968 (string-to-number n)
900 res-inode 969 (tramp-get-device (tramp-dissect-file-name filename)))))
901 ;; 11. Device number. 970
902 res-device 971 ;; Return data gathered.
903 )))))))) 972 (list
973 ;; 0. t for directory, string (name linked to) for
974 ;; symbolic link, or nil.
975 (or dirp res-symlink-target)
976 ;; 1. Number of links to file.
977 res-numlinks
978 ;; 2. File uid.
979 res-uid
980 ;; 3. File gid.
981 res-gid
982 ;; 4. Last access time, as a list of integers.
983 ;; 5. Last modification time, likewise.
984 ;; 6. Last status change time, likewise.
985 res-access res-mod res-change
986 ;; 7. Size in bytes (-1, if number is out of range).
987 res-size
988 ;; 8. File modes.
989 res-filemodes
990 ;; 9. t if file's gid would change if file were deleted
991 ;; and recreated.
992 nil
993 ;; 10. Inode number.
994 res-inode
995 ;; 11. Device number.
996 res-device
997 )))))
904 998
905(defun tramp-gvfs-handle-file-directory-p (filename) 999(defun tramp-gvfs-handle-file-directory-p (filename)
906 "Like `file-directory-p' for Tramp files." 1000 "Like `file-directory-p' for Tramp files."
907 (eq t (car (file-attributes filename)))) 1001 (eq t (car (file-attributes (file-truename filename)))))
908 1002
909(defun tramp-gvfs-handle-file-executable-p (filename) 1003(defun tramp-gvfs-handle-file-executable-p (filename)
910 "Like `file-executable-p' for Tramp files." 1004 "Like `file-executable-p' for Tramp files."
@@ -926,73 +1020,21 @@ file names."
926(defun tramp-gvfs-handle-file-name-all-completions (filename directory) 1020(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
927 "Like `file-name-all-completions' for Tramp files." 1021 "Like `file-name-all-completions' for Tramp files."
928 (unless (save-match-data (string-match "/" filename)) 1022 (unless (save-match-data (string-match "/" filename))
929 (with-parsed-tramp-file-name (expand-file-name directory) nil 1023 (all-completions
930 1024 filename
931 (all-completions 1025 (with-parsed-tramp-file-name (expand-file-name directory) nil
932 filename 1026 (with-tramp-file-property v localname "file-name-all-completions"
933 (mapcar 1027 (let ((result '("./" "../"))
934 'list
935 (or
936 ;; Try cache entries for filename, filename with last
937 ;; character removed, filename with last two characters
938 ;; removed, ..., and finally the empty string - all
939 ;; concatenated to the local directory name.
940 (let ((remote-file-name-inhibit-cache
941 (or remote-file-name-inhibit-cache
942 tramp-completion-reread-directory-timeout)))
943
944 ;; This is inefficient for very long filenames, pity
945 ;; `reduce' is not available...
946 (car
947 (apply
948 'append
949 (mapcar
950 (lambda (x)
951 (let ((cache-hit
952 (tramp-get-file-property
953 v
954 (concat localname (substring filename 0 x))
955 "file-name-all-completions"
956 nil)))
957 (when cache-hit (list cache-hit))))
958 ;; We cannot use a length of 0, because file properties
959 ;; for "foo" and "foo/" are identical.
960 (number-sequence (length filename) 1 -1)))))
961
962 ;; Cache expired or no matching cache entry found so we need
963 ;; to perform a remote operation.
964 (let ((result '("." ".."))
965 entry) 1028 entry)
966 ;; Get a list of directories and files. 1029 ;; Get a list of directories and files.
967 (tramp-gvfs-send-command 1030 (dolist (item (tramp-gvfs-get-directory-attributes directory) result)
968 v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory)) 1031 (setq entry
969 1032 (or ;; Use display-name if available (google-drive).
970 ;; Now grab the output. 1033 ;(cdr (assoc "standard::display-name" item))
971 (with-temp-buffer 1034 (car item)))
972 (insert-buffer-substring (tramp-get-connection-buffer v)) 1035 (if (string-equal (cdr (assoc "type" item)) "directory")
973 (goto-char (point-max)) 1036 (push (file-name-as-directory entry) result)
974 (while (zerop (forward-line -1)) 1037 (push entry result)))))))))
975 (setq entry (buffer-substring (point) (point-at-eol)))
976 (when (string-match filename entry)
977 (if (file-directory-p (expand-file-name entry directory))
978 (push (concat entry "/") result)
979 (push entry result)))))
980
981 ;; Because the remote op went through OK we know the
982 ;; directory we `cd'-ed to exists.
983 (tramp-set-file-property v localname "file-exists-p" t)
984
985 ;; Because the remote op went through OK we know every
986 ;; file listed by `ls' exists.
987 (mapc (lambda (entry)
988 (tramp-set-file-property
989 v (concat localname entry) "file-exists-p" t))
990 result)
991
992 ;; Store result in the cache.
993 (tramp-set-file-property
994 v (concat localname filename)
995 "file-name-all-completions" result))))))))
996 1038
997(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) 1039(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
998 "Like `file-notify-add-watch' for Tramp files." 1040 "Like `file-notify-add-watch' for Tramp files."
@@ -1528,7 +1570,7 @@ connection if a previous connection has died for some reason."
1528 (let ((p (make-network-process 1570 (let ((p (make-network-process
1529 :name (tramp-buffer-name vec) 1571 :name (tramp-buffer-name vec)
1530 :buffer (tramp-get-connection-buffer vec) 1572 :buffer (tramp-get-connection-buffer vec)
1531 :server t :host 'local :service t))) 1573 :server t :host 'local :service t :noquery t)))
1532 (set-process-query-on-exit-flag p nil))) 1574 (set-process-query-on-exit-flag p nil)))
1533 1575
1534 (unless (tramp-gvfs-connection-mounted-p vec) 1576 (unless (tramp-gvfs-connection-mounted-p vec)
@@ -1635,10 +1677,17 @@ connection if a previous connection has died for some reason."
1635 "Send the COMMAND with its ARGS to connection VEC. 1677 "Send the COMMAND with its ARGS to connection VEC.
1636COMMAND is usually a command from the gvfs-* utilities. 1678COMMAND is usually a command from the gvfs-* utilities.
1637`call-process' is applied, and it returns t if the return code is zero." 1679`call-process' is applied, and it returns t if the return code is zero."
1638 (with-current-buffer (tramp-get-connection-buffer vec) 1680 (let* ((locale (tramp-get-local-locale vec))
1639 (tramp-gvfs-maybe-open-connection vec) 1681 (process-environment
1640 (erase-buffer) 1682 (append
1641 (zerop (apply 'tramp-call-process vec command nil t nil args)))) 1683 `(,(format "LANG=%s" locale)
1684 ,(format "LANGUAGE=%s" locale)
1685 ,(format "LC_ALL=%s" locale))
1686 process-environment)))
1687 (with-current-buffer (tramp-get-connection-buffer vec)
1688 (tramp-gvfs-maybe-open-connection vec)
1689 (erase-buffer)
1690 (zerop (apply 'tramp-call-process vec command nil t nil args)))))
1642 1691
1643 1692
1644;; D-Bus BLUEZ functions. 1693;; D-Bus BLUEZ functions.
@@ -1772,35 +1821,37 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
1772 1821
1773;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods. 1822;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
1774(when tramp-gvfs-enabled 1823(when tramp-gvfs-enabled
1775 (zeroconf-init tramp-gvfs-zeroconf-domain) 1824 ;; Suppress D-Bus error messages.
1776 (if (zeroconf-list-service-types) 1825 (let (tramp-gvfs-dbus-event-vector)
1777 (progn 1826 (zeroconf-init tramp-gvfs-zeroconf-domain)
1827 (if (zeroconf-list-service-types)
1828 (progn
1829 (tramp-set-completion-function
1830 "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
1831 (tramp-set-completion-function
1832 "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
1833 (tramp-set-completion-function
1834 "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
1835 (tramp-set-completion-function
1836 "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
1837 (tramp-zeroconf-parse-device-names "_workstation._tcp")))
1838 (when (member "smb" tramp-gvfs-methods)
1839 (tramp-set-completion-function
1840 "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
1841
1842 (when (executable-find "avahi-browse")
1778 (tramp-set-completion-function 1843 (tramp-set-completion-function
1779 "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) 1844 "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
1780 (tramp-set-completion-function 1845 (tramp-set-completion-function
1781 "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) 1846 "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1782 (tramp-set-completion-function 1847 (tramp-set-completion-function
1783 "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) 1848 "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1784 (tramp-set-completion-function 1849 (tramp-set-completion-function
1785 "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") 1850 "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
1786 (tramp-zeroconf-parse-device-names "_workstation._tcp"))) 1851 (tramp-gvfs-parse-device-names "_workstation._tcp")))
1787 (when (member "smb" tramp-gvfs-methods) 1852 (when (member "smb" tramp-gvfs-methods)
1788 (tramp-set-completion-function 1853 (tramp-set-completion-function
1789 "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) 1854 "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
1790
1791 (when (executable-find "avahi-browse")
1792 (tramp-set-completion-function
1793 "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
1794 (tramp-set-completion-function
1795 "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1796 (tramp-set-completion-function
1797 "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
1798 (tramp-set-completion-function
1799 "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
1800 (tramp-gvfs-parse-device-names "_workstation._tcp")))
1801 (when (member "smb" tramp-gvfs-methods)
1802 (tramp-set-completion-function
1803 "smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))
1804 1855
1805 1856
1806;; D-Bus SYNCE functions. 1857;; D-Bus SYNCE functions.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 14c6f949853..e9f78b7d1ce 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -84,8 +84,12 @@ e.g. \"$HOME/.sh_history\"."
84 (string :tag "Redirect to a file"))) 84 (string :tag "Redirect to a file")))
85 85
86;;;###tramp-autoload 86;;;###tramp-autoload
87(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" 87(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
88 "Escape sequences produced by the \"ls\" command.") 88 "Terminal control escape sequences for display attributes.")
89
90;;;###tramp-autoload
91(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
92 "Terminal control escape sequences for device status.")
89 93
90;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for 94;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
91;; root users. It uses the `$' character for other users. In order 95;; root users. It uses the `$' character for other users. In order
@@ -658,29 +662,19 @@ Escape sequence %s is replaced with name of Perl binary.
658This string is passed to `format', so percent characters need to be doubled.") 662This string is passed to `format', so percent characters need to be doubled.")
659 663
660(defconst tramp-perl-file-name-all-completions 664(defconst tramp-perl-file-name-all-completions
661 "%s -e 'sub case { 665 "%s -e '
662 my $str = shift;
663 if ($ARGV[2]) {
664 return lc($str);
665 }
666 else {
667 return $str;
668 }
669}
670opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); 666opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
671@files = readdir(d); closedir(d); 667@files = readdir(d); closedir(d);
672foreach $f (@files) { 668foreach $f (@files) {
673 if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { 669 if (-d \"$ARGV[0]/$f\") {
674 if (-d \"$ARGV[0]/$f\") { 670 print \"$f/\\n\";
675 print \"$f/\\n\"; 671 }
676 } 672 else {
677 else { 673 print \"$f\\n\";
678 print \"$f\\n\";
679 }
680 } 674 }
681} 675}
682print \"ok\\n\" 676print \"ok\\n\"
683' \"$1\" \"$2\" \"$3\" 2>/dev/null" 677' \"$1\" 2>/dev/null"
684 "Perl script to produce output suitable for use with 678 "Perl script to produce output suitable for use with
685`file-name-all-completions' on the remote file system. Escape 679`file-name-all-completions' on the remote file system. Escape
686sequence %s is replaced with name of Perl binary. This string is 680sequence %s is replaced with name of Perl binary. This string is
@@ -1339,8 +1333,10 @@ target of the symlink differ."
1339 (setq res-gid (read (current-buffer))) 1333 (setq res-gid (read (current-buffer)))
1340 (if (eq id-format 'integer) 1334 (if (eq id-format 'integer)
1341 (progn 1335 (progn
1342 (unless (numberp res-uid) (setq res-uid -1)) 1336 (unless (numberp res-uid)
1343 (unless (numberp res-gid) (setq res-gid -1))) 1337 (setq res-uid tramp-unknown-id-integer))
1338 (unless (numberp res-gid)
1339 (setq res-gid tramp-unknown-id-integer)))
1344 (progn 1340 (progn
1345 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) 1341 (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
1346 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) 1342 (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
@@ -1862,135 +1858,63 @@ be non-negative integers."
1862(defun tramp-sh-handle-file-name-all-completions (filename directory) 1858(defun tramp-sh-handle-file-name-all-completions (filename directory)
1863 "Like `file-name-all-completions' for Tramp files." 1859 "Like `file-name-all-completions' for Tramp files."
1864 (unless (save-match-data (string-match "/" filename)) 1860 (unless (save-match-data (string-match "/" filename))
1865 (with-parsed-tramp-file-name (expand-file-name directory) nil 1861 (all-completions
1862 filename
1863 (with-parsed-tramp-file-name (expand-file-name directory) nil
1864 (with-tramp-file-property v localname "file-name-all-completions"
1865 (let (result)
1866 ;; Get a list of directories and files, including reliably
1867 ;; tagging the directories with a trailing "/". Because I
1868 ;; rock. --daniel@danann.net
1869 (tramp-send-command
1870 v
1871 (if (tramp-get-remote-perl v)
1872 (progn
1873 (tramp-maybe-send-script
1874 v tramp-perl-file-name-all-completions
1875 "tramp_perl_file_name_all_completions")
1876 (format "tramp_perl_file_name_all_completions %s"
1877 (tramp-shell-quote-argument localname)))
1878
1879 (format (concat
1880 "(cd %s 2>&1 && %s -a 2>/dev/null"
1881 " | while IFS= read f; do"
1882 " if %s -d \"$f\" 2>/dev/null;"
1883 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
1884 " && \\echo ok) || \\echo fail")
1885 (tramp-shell-quote-argument localname)
1886 (tramp-get-ls-command v)
1887 (tramp-get-test-command v))))
1866 1888
1867 (all-completions 1889 ;; Now grab the output.
1868 filename 1890 (with-current-buffer (tramp-get-buffer v)
1869 (mapcar 1891 (goto-char (point-max))
1870 'list 1892
1871 (or 1893 ;; Check result code, found in last line of output.
1872 ;; Try cache entries for `filename', `filename' with last 1894 (forward-line -1)
1873 ;; character removed, `filename' with last two characters 1895 (if (looking-at "^fail$")
1874 ;; removed, ..., and finally the empty string - all 1896 (progn
1875 ;; concatenated to the local directory name. 1897 ;; Grab error message from line before last line
1876 (let ((remote-file-name-inhibit-cache 1898 ;; (it was put there by `cd 2>&1').
1877 (or remote-file-name-inhibit-cache 1899 (forward-line -1)
1878 tramp-completion-reread-directory-timeout))) 1900 (tramp-error
1879 1901 v 'file-error
1880 ;; This is inefficient for very long file names, pity 1902 "tramp-sh-handle-file-name-all-completions: %s"
1881 ;; `reduce' is not available... 1903 (buffer-substring (point) (point-at-eol))))
1882 (car 1904 ;; For peace of mind, if buffer doesn't end in `fail'
1883 (apply 1905 ;; then it should end in `ok'. If neither are in the
1884 'append 1906 ;; buffer something went seriously wrong on the remote
1885 (mapcar 1907 ;; side.
1886 (lambda (x) 1908 (unless (looking-at "^ok$")
1887 (let ((cache-hit 1909 (tramp-error
1888 (tramp-get-file-property 1910 v 'file-error
1889 v 1911 "\
1890 (concat localname (substring filename 0 x))
1891 "file-name-all-completions"
1892 nil)))
1893 (when cache-hit (list cache-hit))))
1894 ;; We cannot use a length of 0, because file properties
1895 ;; for "foo" and "foo/" are identical.
1896 (number-sequence (length filename) 1 -1)))))
1897
1898 ;; Cache expired or no matching cache entry found so we need
1899 ;; to perform a remote operation.
1900 (let (result)
1901 ;; Get a list of directories and files, including reliably
1902 ;; tagging the directories with a trailing '/'. Because I
1903 ;; rock. --daniel@danann.net
1904
1905 ;; Changed to perform `cd' in the same remote op and only
1906 ;; get entries starting with `filename'. Capture any `cd'
1907 ;; error messages. Ensure any `cd' and `echo' aliases are
1908 ;; ignored.
1909 (tramp-send-command
1910 v
1911 (if (tramp-get-remote-perl v)
1912 (progn
1913 (tramp-maybe-send-script
1914 v tramp-perl-file-name-all-completions
1915 "tramp_perl_file_name_all_completions")
1916 (format "tramp_perl_file_name_all_completions %s %s %d"
1917 (tramp-shell-quote-argument localname)
1918 (tramp-shell-quote-argument filename)
1919 (if read-file-name-completion-ignore-case 1 0)))
1920
1921 (format (concat
1922 "(cd %s 2>&1 && (%s -a %s 2>/dev/null"
1923 ;; `ls' with wildcard might fail with `Argument
1924 ;; list too long' error in some corner cases; if
1925 ;; `ls' fails after `cd' succeeded, chances are
1926 ;; that's the case, so let's retry without
1927 ;; wildcard. This will return "too many" entries
1928 ;; but that isn't harmful.
1929 " || %s -a 2>/dev/null)"
1930 " | while IFS= read f; do"
1931 " if %s -d \"$f\" 2>/dev/null;"
1932 " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
1933 " && \\echo ok) || \\echo fail")
1934 (tramp-shell-quote-argument localname)
1935 (tramp-get-ls-command v)
1936 ;; When `filename' is empty, just `ls' without
1937 ;; `filename' argument is more efficient than `ls *'
1938 ;; for very large directories and might avoid the
1939 ;; `Argument list too long' error.
1940 ;;
1941 ;; With and only with wildcard, we need to add
1942 ;; `-d' to prevent `ls' from descending into
1943 ;; sub-directories.
1944 (if (zerop (length filename))
1945 "."
1946 (format "-d %s*" (tramp-shell-quote-argument filename)))
1947 (tramp-get-ls-command v)
1948 (tramp-get-test-command v))))
1949
1950 ;; Now grab the output.
1951 (with-current-buffer (tramp-get-buffer v)
1952 (goto-char (point-max))
1953
1954 ;; Check result code, found in last line of output.
1955 (forward-line -1)
1956 (if (looking-at "^fail$")
1957 (progn
1958 ;; Grab error message from line before last line
1959 ;; (it was put there by `cd 2>&1').
1960 (forward-line -1)
1961 (tramp-error
1962 v 'file-error
1963 "tramp-sh-handle-file-name-all-completions: %s"
1964 (buffer-substring (point) (point-at-eol))))
1965 ;; For peace of mind, if buffer doesn't end in `fail'
1966 ;; then it should end in `ok'. If neither are in the
1967 ;; buffer something went seriously wrong on the remote
1968 ;; side.
1969 (unless (looking-at "^ok$")
1970 (tramp-error
1971 v 'file-error
1972 "\
1973tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" 1912tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
1974 (tramp-shell-quote-argument localname) (buffer-string)))) 1913 (tramp-shell-quote-argument localname) (buffer-string))))
1975
1976 (while (zerop (forward-line -1))
1977 (push (buffer-substring (point) (point-at-eol)) result)))
1978
1979 ;; Because the remote op went through OK we know the
1980 ;; directory we `cd'-ed to exists.
1981 (tramp-set-file-property v localname "file-exists-p" t)
1982
1983 ;; Because the remote op went through OK we know every
1984 ;; file listed by `ls' exists.
1985 (mapc (lambda (entry)
1986 (tramp-set-file-property
1987 v (concat localname entry) "file-exists-p" t))
1988 result)
1989 1914
1990 ;; Store result in the cache. 1915 (while (zerop (forward-line -1))
1991 (tramp-set-file-property 1916 (push (buffer-substring (point) (point-at-eol)) result)))
1992 v (concat localname filename) 1917 result))))))
1993 "file-name-all-completions" result))))))))
1994 1918
1995;; cp, mv and ln 1919;; cp, mv and ln
1996 1920
@@ -2836,7 +2760,8 @@ The method used must be an out-of-band method."
2836 (unless 2760 (unless
2837 (string-match "color" (tramp-get-connection-property v "ls" "")) 2761 (string-match "color" (tramp-get-connection-property v "ls" ""))
2838 (goto-char beg) 2762 (goto-char beg)
2839 (while (re-search-forward tramp-color-escape-sequence-regexp nil t) 2763 (while
2764 (re-search-forward tramp-display-escape-sequence-regexp nil t)
2840 (replace-match ""))) 2765 (replace-match "")))
2841 2766
2842 ;; Decode the output, it could be multibyte. 2767 ;; Decode the output, it could be multibyte.
@@ -2934,7 +2859,12 @@ the result will be a local, non-Tramp, file name."
2934(defun tramp-sh-handle-start-file-process (name buffer program &rest args) 2859(defun tramp-sh-handle-start-file-process (name buffer program &rest args)
2935 "Like `start-file-process' for Tramp files." 2860 "Like `start-file-process' for Tramp files."
2936 (with-parsed-tramp-file-name (expand-file-name default-directory) nil 2861 (with-parsed-tramp-file-name (expand-file-name default-directory) nil
2937 (let* (;; When PROGRAM matches "*sh", and the first arg is "-c", 2862 (let* ((buffer
2863 (if buffer
2864 (get-buffer-create buffer)
2865 ;; BUFFER can be nil. We use a temporary buffer.
2866 (generate-new-buffer tramp-temp-buffer-name)))
2867 ;; When PROGRAM matches "*sh", and the first arg is "-c",
2938 ;; it might be that the arguments exceed the command line 2868 ;; it might be that the arguments exceed the command line
2939 ;; length. Therefore, we modify the command. 2869 ;; length. Therefore, we modify the command.
2940 (heredoc (and (stringp program) 2870 (heredoc (and (stringp program)
@@ -2992,9 +2922,6 @@ the result will be a local, non-Tramp, file name."
2992 ;; `eshell' and friends. 2922 ;; `eshell' and friends.
2993 (tramp-current-connection nil)) 2923 (tramp-current-connection nil))
2994 2924
2995 (unless buffer
2996 ;; BUFFER can be nil. We use a temporary buffer.
2997 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
2998 (while (get-process name1) 2925 (while (get-process name1)
2999 ;; NAME must be unique as process name. 2926 ;; NAME must be unique as process name.
3000 (setq i (1+ i) 2927 (setq i (1+ i)
@@ -4030,7 +3957,7 @@ file exists and nonzero exit status otherwise."
4030 shell) 3957 shell)
4031 (setq shell 3958 (setq shell
4032 (with-tramp-connection-property vec "remote-shell" 3959 (with-tramp-connection-property vec "remote-shell"
4033 ;; CCC: "root" does not exist always, see QNAP 459. 3960 ;; CCC: "root" does not exist always, see my QNAP TS-459.
4034 ;; Which check could we apply instead? 3961 ;; Which check could we apply instead?
4035 (tramp-send-command vec "echo ~root" t) 3962 (tramp-send-command vec "echo ~root" t)
4036 (if (or (string-match "^~root$" (buffer-string)) 3963 (if (or (string-match "^~root$" (buffer-string))
@@ -4790,7 +4717,7 @@ connection if a previous connection has died for some reason."
4790 (options (tramp-ssh-controlmaster-options vec)) 4717 (options (tramp-ssh-controlmaster-options vec))
4791 (process-connection-type tramp-process-connection-type) 4718 (process-connection-type tramp-process-connection-type)
4792 (process-adaptive-read-buffering nil) 4719 (process-adaptive-read-buffering nil)
4793 ;; There are unfortune settings for "cmdproxy" on 4720 ;; There are unfortunate settings for "cmdproxy" on
4794 ;; W32 systems. 4721 ;; W32 systems.
4795 (process-coding-system-alist nil) 4722 (process-coding-system-alist nil)
4796 (coding-system-for-read nil) 4723 (coding-system-for-read nil)
@@ -5000,7 +4927,12 @@ function waits for output unless NOOUTPUT is set."
5000 (with-current-buffer (process-buffer proc) 4927 (with-current-buffer (process-buffer proc)
5001 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might 4928 (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
5002 ;; be leading escape sequences, which must be ignored. 4929 ;; be leading escape sequences, which must be ignored.
5003 (regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) 4930 ;; Busyboxes built with the EDITING_ASK_TERMINAL config
4931 ;; option send also escape sequences, which must be
4932 ;; ignored.
4933 (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
4934 (regexp-quote tramp-end-of-output)
4935 tramp-device-escape-sequence-regexp))
5004 ;; Sometimes, the commands do not return a newline but a 4936 ;; Sometimes, the commands do not return a newline but a
5005 ;; null byte before the shell prompt, for example "git 4937 ;; null byte before the shell prompt, for example "git
5006 ;; ls-files -c -z ...". 4938 ;; ls-files -c -z ...".
@@ -5103,16 +5035,17 @@ Return ATTR."
5103 (when attr 5035 (when attr
5104 ;; Remove color escape sequences from symlink. 5036 ;; Remove color escape sequences from symlink.
5105 (when (stringp (car attr)) 5037 (when (stringp (car attr))
5106 (while (string-match tramp-color-escape-sequence-regexp (car attr)) 5038 (while (string-match tramp-display-escape-sequence-regexp (car attr))
5107 (setcar attr (replace-match "" nil nil (car attr))))) 5039 (setcar attr (replace-match "" nil nil (car attr)))))
5108 ;; Convert uid and gid. Use -1 as indication of unusable value. 5040 ;; Convert uid and gid. Use `tramp-unknown-id-integer' as
5041 ;; indication of unusable value.
5109 (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) 5042 (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
5110 (setcar (nthcdr 2 attr) -1)) 5043 (setcar (nthcdr 2 attr) tramp-unknown-id-integer))
5111 (when (and (floatp (nth 2 attr)) 5044 (when (and (floatp (nth 2 attr))
5112 (<= (nth 2 attr) most-positive-fixnum)) 5045 (<= (nth 2 attr) most-positive-fixnum))
5113 (setcar (nthcdr 2 attr) (round (nth 2 attr)))) 5046 (setcar (nthcdr 2 attr) (round (nth 2 attr))))
5114 (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) 5047 (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
5115 (setcar (nthcdr 3 attr) -1)) 5048 (setcar (nthcdr 3 attr) tramp-unknown-id-integer))
5116 (when (and (floatp (nth 3 attr)) 5049 (when (and (floatp (nth 3 attr))
5117 (<= (nth 3 attr) most-positive-fixnum)) 5050 (<= (nth 3 attr) most-positive-fixnum))
5118 (setcar (nthcdr 3 attr) (round (nth 3 attr)))) 5051 (setcar (nthcdr 3 attr) (round (nth 3 attr))))
@@ -5556,8 +5489,10 @@ Return ATTR."
5556 (tramp-get-remote-uid-with-python vec id-format)))))) 5489 (tramp-get-remote-uid-with-python vec id-format))))))
5557 ;; Ensure there is a valid result. 5490 ;; Ensure there is a valid result.
5558 (cond 5491 (cond
5559 ((and (equal id-format 'integer) (not (integerp res))) -1) 5492 ((and (equal id-format 'integer) (not (integerp res)))
5560 ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") 5493 tramp-unknown-id-integer)
5494 ((and (equal id-format 'string) (not (stringp res)))
5495 tramp-unknown-id-string)
5561 (t res))))) 5496 (t res)))))
5562 5497
5563(defun tramp-get-remote-gid-with-id (vec id-format) 5498(defun tramp-get-remote-gid-with-id (vec id-format)
@@ -5600,8 +5535,10 @@ Return ATTR."
5600 (tramp-get-remote-gid-with-python vec id-format)))))) 5535 (tramp-get-remote-gid-with-python vec id-format))))))
5601 ;; Ensure there is a valid result. 5536 ;; Ensure there is a valid result.
5602 (cond 5537 (cond
5603 ((and (equal id-format 'integer) (not (integerp res))) -1) 5538 ((and (equal id-format 'integer) (not (integerp res)))
5604 ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") 5539 tramp-unknown-id-integer)
5540 ((and (equal id-format 'string) (not (stringp res)))
5541 tramp-unknown-id-string)
5605 (t res))))) 5542 (t res)))))
5606 5543
5607;; Some predefined connection properties. 5544;; Some predefined connection properties.
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index c4dde050c83..fbd7cd30008 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -663,8 +663,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
663 result))) 663 result)))
664 ;; Sort them if necessary. 664 ;; Sort them if necessary.
665 (unless nosort (setq result (sort result 'string-lessp))) 665 (unless nosort (setq result (sort result 'string-lessp)))
666 ;; Remove double entries. 666 result))
667 (delete-dups result)))
668 667
669(defun tramp-smb-handle-expand-file-name (name &optional dir) 668(defun tramp-smb-handle-expand-file-name (name &optional dir)
670 "Like `expand-file-name' for Tramp files." 669 "Like `expand-file-name' for Tramp files."
@@ -907,17 +906,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
907 "Like `file-name-all-completions' for Tramp files." 906 "Like `file-name-all-completions' for Tramp files."
908 (all-completions 907 (all-completions
909 filename 908 filename
910 (with-parsed-tramp-file-name directory nil 909 (with-parsed-tramp-file-name (expand-file-name directory) nil
911 (with-tramp-file-property v localname "file-name-all-completions" 910 (with-tramp-file-property v localname "file-name-all-completions"
912 (save-match-data 911 (save-match-data
913 (let ((entries (tramp-smb-get-file-entries directory))) 912 (delete-dups
914 (mapcar 913 (mapcar
915 (lambda (x) 914 (lambda (x)
916 (list 915 (list
917 (if (string-match "d" (nth 1 x)) 916 (if (string-match "d" (nth 1 x))
918 (file-name-as-directory (nth 0 x)) 917 (file-name-as-directory (nth 0 x))
919 (nth 0 x)))) 918 (nth 0 x))))
920 entries))))))) 919 (tramp-smb-get-file-entries directory))))))))
921 920
922(defun tramp-smb-handle-file-writable-p (filename) 921(defun tramp-smb-handle-file-writable-p (filename)
923 "Like `file-writable-p' for Tramp files." 922 "Like `file-writable-p' for Tramp files."
@@ -1389,16 +1388,18 @@ target of the symlink differ."
1389(defun tramp-smb-handle-start-file-process (name buffer program &rest args) 1388(defun tramp-smb-handle-start-file-process (name buffer program &rest args)
1390 "Like `start-file-process' for Tramp files." 1389 "Like `start-file-process' for Tramp files."
1391 (with-parsed-tramp-file-name default-directory nil 1390 (with-parsed-tramp-file-name default-directory nil
1392 (let ((command (mapconcat 'identity (cons program args) " ")) 1391 (let* ((buffer
1393 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) 1392 (if buffer
1394 (name1 name) 1393 (get-buffer-create buffer)
1395 (i 0)) 1394 ;; BUFFER can be nil. We use a temporary buffer.
1395 (generate-new-buffer tramp-temp-buffer-name)))
1396 (command (mapconcat 'identity (cons program args) " "))
1397 (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
1398 (name1 name)
1399 (i 0))
1396 (unwind-protect 1400 (unwind-protect
1397 (save-excursion 1401 (save-excursion
1398 (save-restriction 1402 (save-restriction
1399 (unless buffer
1400 ;; BUFFER can be nil. We use a temporary buffer.
1401 (setq buffer (generate-new-buffer tramp-temp-buffer-name)))
1402 (while (get-process name1) 1403 (while (get-process name1)
1403 ;; NAME must be unique as process name. 1404 ;; NAME must be unique as process name.
1404 (setq i (1+ i) 1405 (setq i (1+ i)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 28fc9c748bb..e3755533b9d 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -774,6 +774,12 @@ Derived from `tramp-postfix-host-format'.")
774(defconst tramp-localname-regexp ".*$" 774(defconst tramp-localname-regexp ".*$"
775 "Regexp matching localnames.") 775 "Regexp matching localnames.")
776 776
777(defconst tramp-unknown-id-string "UNKNOWN"
778 "String used to denote an unknown user or group")
779
780(defconst tramp-unknown-id-integer -1
781 "Integer used to denote an unknown user or group")
782
777;;; File name format: 783;;; File name format:
778 784
779(defconst tramp-remote-file-name-spec-regexp 785(defconst tramp-remote-file-name-spec-regexp
@@ -2861,11 +2867,21 @@ User is always nil."
2861 (error 2867 (error
2862 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" 2868 "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
2863 directory)) 2869 directory))
2864 (try-completion 2870 (let (hits-ignored-extensions)
2865 filename 2871 (or
2866 (mapcar 'list (file-name-all-completions filename directory)) 2872 (try-completion
2867 (when predicate 2873 filename (file-name-all-completions filename directory)
2868 (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) 2874 (lambda (x)
2875 (when (funcall (or predicate 'identity) (expand-file-name x directory))
2876 (not
2877 (and
2878 completion-ignored-extensions
2879 (string-match
2880 (concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
2881 ;; We remember the hit.
2882 (push x hits-ignored-extensions))))))
2883 ;; No match. So we try again for ignored files.
2884 (try-completion filename hits-ignored-extensions))))
2869 2885
2870(defun tramp-handle-file-name-directory (file) 2886(defun tramp-handle-file-name-directory (file)
2871 "Like `file-name-directory' but aware of Tramp files." 2887 "Like `file-name-directory' but aware of Tramp files."
@@ -3834,7 +3850,10 @@ be granted."
3834 vec (concat "uid-" suffix) nil)) 3850 vec (concat "uid-" suffix) nil))
3835 (remote-gid 3851 (remote-gid
3836 (tramp-get-connection-property 3852 (tramp-get-connection-property
3837 vec (concat "gid-" suffix) nil))) 3853 vec (concat "gid-" suffix) nil))
3854 (unknown-id
3855 (if (string-equal suffix "string")
3856 tramp-unknown-id-string tramp-unknown-id-integer)))
3838 (and 3857 (and
3839 file-attr 3858 file-attr
3840 (or 3859 (or
@@ -3847,12 +3866,14 @@ be granted."
3847 ;; User accessible and owned by user. 3866 ;; User accessible and owned by user.
3848 (and 3867 (and
3849 (eq access (aref (nth 8 file-attr) offset)) 3868 (eq access (aref (nth 8 file-attr) offset))
3850 (equal remote-uid (nth 2 file-attr))) 3869 (or (equal remote-uid (nth 2 file-attr))
3870 (equal unknown-id (nth 2 file-attr))))
3851 ;; Group accessible and owned by user's 3871 ;; Group accessible and owned by user's
3852 ;; principal group. 3872 ;; principal group.
3853 (and 3873 (and
3854 (eq access (aref (nth 8 file-attr) (+ offset 3))) 3874 (eq access (aref (nth 8 file-attr) (+ offset 3)))
3855 (equal remote-gid (nth 3 file-attr))))))))))) 3875 (or (equal remote-gid (nth 3 file-attr))
3876 (equal unknown-id (nth 3 file-attr))))))))))))
3856 3877
3857;;;###tramp-autoload 3878;;;###tramp-autoload
3858(defun tramp-local-host-p (vec) 3879(defun tramp-local-host-p (vec)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 2450a5db8b9..4d6a1203c25 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -229,8 +229,12 @@
229;; The starting position from where we determined `c-macro-cache'. 229;; The starting position from where we determined `c-macro-cache'.
230(defvar c-macro-cache-syntactic nil) 230(defvar c-macro-cache-syntactic nil)
231(make-variable-buffer-local 'c-macro-cache-syntactic) 231(make-variable-buffer-local 'c-macro-cache-syntactic)
232;; non-nil iff `c-macro-cache' has both elements set AND the cdr is at a 232;; Either nil, or the syntactic end of the macro currently represented by
233;; syntactic end of macro, not merely an apparent one. 233;; `c-macro-cache'.
234(defvar c-macro-cache-no-comment nil)
235(make-variable-buffer-local 'c-macro-cache-no-comment)
236;; Either nil, or the last character of the macro currently represented by
237;; `c-macro-cache' which isn't in a comment. */
234 238
235(defun c-invalidate-macro-cache (beg end) 239(defun c-invalidate-macro-cache (beg end)
236 ;; Called from a before-change function. If the change region is before or 240 ;; Called from a before-change function. If the change region is before or
@@ -242,12 +246,14 @@
242 ((< beg (car c-macro-cache)) 246 ((< beg (car c-macro-cache))
243 (setq c-macro-cache nil 247 (setq c-macro-cache nil
244 c-macro-cache-start-pos nil 248 c-macro-cache-start-pos nil
245 c-macro-cache-syntactic nil)) 249 c-macro-cache-syntactic nil
250 c-macro-cache-no-comment nil))
246 ((and (cdr c-macro-cache) 251 ((and (cdr c-macro-cache)
247 (< beg (cdr c-macro-cache))) 252 (< beg (cdr c-macro-cache)))
248 (setcdr c-macro-cache nil) 253 (setcdr c-macro-cache nil)
249 (setq c-macro-cache-start-pos beg 254 (setq c-macro-cache-start-pos beg
250 c-macro-cache-syntactic nil)))) 255 c-macro-cache-syntactic nil
256 c-macro-cache-no-comment nil))))
251 257
252(defun c-macro-is-genuine-p () 258(defun c-macro-is-genuine-p ()
253 ;; Check that the ostensible CPP construct at point is a real one. In 259 ;; Check that the ostensible CPP construct at point is a real one. In
@@ -288,7 +294,8 @@ comment at the start of cc-engine.el for more info."
288 t)) 294 t))
289 (setq c-macro-cache nil 295 (setq c-macro-cache nil
290 c-macro-cache-start-pos nil 296 c-macro-cache-start-pos nil
291 c-macro-cache-syntactic nil) 297 c-macro-cache-syntactic nil
298 c-macro-cache-no-comment nil)
292 299
293 (save-restriction 300 (save-restriction
294 (if lim (narrow-to-region lim (point-max))) 301 (if lim (narrow-to-region lim (point-max)))
@@ -323,7 +330,8 @@ comment at the start of cc-engine.el for more info."
323 (>= (point) (car c-macro-cache))) 330 (>= (point) (car c-macro-cache)))
324 (setq c-macro-cache nil 331 (setq c-macro-cache nil
325 c-macro-cache-start-pos nil 332 c-macro-cache-start-pos nil
326 c-macro-cache-syntactic nil)) 333 c-macro-cache-syntactic nil
334 c-macro-cache-no-comment nil))
327 (while (progn 335 (while (progn
328 (end-of-line) 336 (end-of-line)
329 (when (and (eq (char-before) ?\\) 337 (when (and (eq (char-before) ?\\)
@@ -347,14 +355,38 @@ comment at the start of cc-engine.el for more info."
347 (let* ((here (point)) 355 (let* ((here (point))
348 (there (progn (c-end-of-macro) (point))) 356 (there (progn (c-end-of-macro) (point)))
349 s) 357 s)
350 (unless c-macro-cache-syntactic 358 (if c-macro-cache-syntactic
359 (goto-char c-macro-cache-syntactic)
351 (setq s (parse-partial-sexp here there)) 360 (setq s (parse-partial-sexp here there))
352 (while (and (or (nth 3 s) ; in a string 361 (while (and (or (nth 3 s) ; in a string
353 (nth 4 s)) ; in a comment (maybe at end of line comment) 362 (nth 4 s)) ; in a comment (maybe at end of line comment)
354 (> there here)) ; No infinite loops, please. 363 (> there here)) ; No infinite loops, please.
355 (setq there (1- (nth 8 s))) 364 (setq there (1- (nth 8 s)))
356 (setq s (parse-partial-sexp here there))) 365 (setq s (parse-partial-sexp here there)))
357 (setq c-macro-cache-syntactic (car c-macro-cache))) 366 (setq c-macro-cache-syntactic (point)))
367 (point)))
368
369(defun c-no-comment-end-of-macro ()
370 ;; Go to the end of a CPP directive, or a pos just before which isn't in a
371 ;; comment. For this purpose, open strings are ignored.
372 ;;
373 ;; This function must only be called from the beginning of a CPP construct.
374 ;;
375 ;; Note that this function might do hidden buffer changes. See the comment
376 ;; at the start of cc-engine.el for more info.
377 (let* ((here (point))
378 (there (progn (c-end-of-macro) (point)))
379 s)
380 (if c-macro-cache-no-comment
381 (goto-char c-macro-cache-no-comment)
382 (setq s (parse-partial-sexp here there))
383 (while (and (nth 3 s) ; in a string
384 (> there here)) ; No infinite loops, please.
385 (setq here (1+ (nth 8 s)))
386 (setq s (parse-partial-sexp here there)))
387 (when (nth 4 s)
388 (goto-char (1- (nth 8 s))))
389 (setq c-macro-cache-no-comment (point)))
358 (point))) 390 (point)))
359 391
360(defun c-forward-over-cpp-define-id () 392(defun c-forward-over-cpp-define-id ()
@@ -8899,6 +8931,22 @@ comment at the start of cc-engine.el for more info."
8899 (c-syntactic-skip-backward c-block-prefix-charset limit t) 8931 (c-syntactic-skip-backward c-block-prefix-charset limit t)
8900 (eq (char-before) ?>)))))) 8932 (eq (char-before) ?>))))))
8901 8933
8934 ;; Skip back over noise clauses.
8935 (while (and
8936 c-opt-cpp-prefix
8937 (eq (char-before) ?\))
8938 (let ((after-paren (point)))
8939 (if (and (c-go-list-backward)
8940 (progn (c-backward-syntactic-ws)
8941 (c-simple-skip-symbol-backward))
8942 (or (looking-at c-paren-nontype-key)
8943 (looking-at c-noise-macro-with-parens-name-re)))
8944 (progn
8945 (c-syntactic-skip-backward c-block-prefix-charset limit t)
8946 t)
8947 (goto-char after-paren)
8948 nil))))
8949
8902 ;; Note: Can't get bogus hits inside template arglists below since they 8950 ;; Note: Can't get bogus hits inside template arglists below since they
8903 ;; have gotten paren syntax above. 8951 ;; have gotten paren syntax above.
8904 (when (and 8952 (when (and
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 705f723d55d..6f4d1f16857 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -476,7 +476,8 @@ so that all identifiers are recognized as words.")
476 c++ '(c-extend-region-for-CPP 476 c++ '(c-extend-region-for-CPP
477 c-before-change-check-<>-operators 477 c-before-change-check-<>-operators
478 c-invalidate-macro-cache) 478 c-invalidate-macro-cache)
479 (c objc) '(c-extend-region-for-CPP c-invalidate-macro-cache) 479 (c objc) '(c-extend-region-for-CPP
480 c-invalidate-macro-cache)
480 ;; java 'c-before-change-check-<>-operators 481 ;; java 'c-before-change-check-<>-operators
481 awk 'c-awk-record-region-clear-NL) 482 awk 'c-awk-record-region-clear-NL)
482(c-lang-defvar c-get-state-before-change-functions 483(c-lang-defvar c-get-state-before-change-functions
@@ -505,9 +506,11 @@ parameters \(point-min) and \(point-max).")
505 ;; For documentation see the following c-lang-defvar of the same name. 506 ;; For documentation see the following c-lang-defvar of the same name.
506 ;; The value here may be a list of functions or a single function. 507 ;; The value here may be a list of functions or a single function.
507 t 'c-change-expand-fl-region 508 t 'c-change-expand-fl-region
508 (c objc) '(c-neutralize-syntax-in-and-mark-CPP 509 (c objc) '(c-extend-font-lock-region-for-macros
510 c-neutralize-syntax-in-and-mark-CPP
509 c-change-expand-fl-region) 511 c-change-expand-fl-region)
510 c++ '(c-neutralize-syntax-in-and-mark-CPP 512 c++ '(c-extend-font-lock-region-for-macros
513 c-neutralize-syntax-in-and-mark-CPP
511 c-restore-<>-properties 514 c-restore-<>-properties
512 c-change-expand-fl-region) 515 c-change-expand-fl-region)
513 java '(c-restore-<>-properties 516 java '(c-restore-<>-properties
@@ -2264,6 +2267,10 @@ contain type identifiers."
2264 ;; MSVC extension. 2267 ;; MSVC extension.
2265 "__declspec")) 2268 "__declspec"))
2266 2269
2270(c-lang-defconst c-paren-nontype-key
2271 t (c-make-keywords-re t (c-lang-const c-paren-nontype-kwds)))
2272(c-lang-defvar c-paren-nontype-key (c-lang-const c-paren-nontype-key))
2273
2267(c-lang-defconst c-paren-type-kwds 2274(c-lang-defconst c-paren-type-kwds
2268 "Keywords that may be followed by a parenthesis expression containing 2275 "Keywords that may be followed by a parenthesis expression containing
2269type identifiers separated by arbitrary tokens." 2276type identifiers separated by arbitrary tokens."
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index de903b80ade..9ab04808af6 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -865,14 +865,6 @@ Note that the style variables are always made local to the buffer."
865 865
866;;; Change hooks, linking with Font Lock and electric-indent-mode. 866;;; Change hooks, linking with Font Lock and electric-indent-mode.
867 867
868;; Buffer local variables recording Beginning/End-of-Macro position before a
869;; change, when a macro straddles, respectively, the BEG or END (or both) of
870;; the change region. Otherwise these have the values BEG/END.
871(defvar c-old-BOM 0)
872(make-variable-buffer-local 'c-old-BOM)
873(defvar c-old-EOM 0)
874(make-variable-buffer-local 'c-old-EOM)
875
876(defun c-called-from-text-property-change-p () 868(defun c-called-from-text-property-change-p ()
877 ;; Is the primitive which invoked `before-change-functions' or 869 ;; Is the primitive which invoked `before-change-functions' or
878 ;; `after-change-functions' one which merely changes text properties? This 870 ;; `after-change-functions' one which merely changes text properties? This
@@ -886,8 +878,8 @@ Note that the style variables are always made local to the buffer."
886 '(put-text-property remove-list-of-text-properties))) 878 '(put-text-property remove-list-of-text-properties)))
887 879
888(defun c-extend-region-for-CPP (beg end) 880(defun c-extend-region-for-CPP (beg end)
889 ;; Set c-old-BOM or c-old-EOM respectively to BEG, END, each extended to the 881 ;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of
890 ;; beginning/end of any preprocessor construct they may be in. 882 ;; any preprocessor construct they may be in.
891 ;; 883 ;;
892 ;; Point is undefined both before and after this function call; the buffer 884 ;; Point is undefined both before and after this function call; the buffer
893 ;; has already been widened, and match-data saved. The return value is 885 ;; has already been widened, and match-data saved. The return value is
@@ -896,45 +888,33 @@ Note that the style variables are always made local to the buffer."
896 ;; This function is in the C/C++/ObjC values of 888 ;; This function is in the C/C++/ObjC values of
897 ;; `c-get-state-before-change-functions' and is called exclusively as a 889 ;; `c-get-state-before-change-functions' and is called exclusively as a
898 ;; before change function. 890 ;; before change function.
899 (goto-char beg) 891 (goto-char c-new-BEG)
900 (c-beginning-of-macro) 892 (c-beginning-of-macro)
901 (setq c-old-BOM (point)) 893 (setq c-new-BEG (point))
902 894
903 (goto-char end) 895 (goto-char c-new-END)
904 (when (c-beginning-of-macro) 896 (when (c-beginning-of-macro)
905 (c-end-of-macro) 897 (c-end-of-macro)
906 (or (eobp) (forward-char))) ; Over the terminating NL which may be marked 898 (or (eobp) (forward-char))) ; Over the terminating NL which may be marked
907 ; with a c-cpp-delimiter category property 899 ; with a c-cpp-delimiter category property
908 (setq c-old-EOM (point))) 900 (setq c-new-END (point)))
909 901
910(defun c-extend-font-lock-region-for-macros (begg endd &optional old-len) 902(defun c-extend-font-lock-region-for-macros (begg endd old-len)
911 ;; Extend the region (BEGG ENDD) to cover all (possibly changed) 903 ;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed)
912 ;; preprocessor macros; return the cons (new-BEG . new-END). OLD-LEN should 904 ;; preprocessor macros; The return value has no significance.
913 ;; be either the old length parameter when called from an
914 ;; after-change-function, or nil otherwise. This defun uses the variables
915 ;; c-old-BOM, c-new-BOM.
916 ;; 905 ;;
917 ;; Point is undefined on both entry and exit to this function. The buffer 906 ;; Point is undefined on both entry and exit to this function. The buffer
918 ;; will have been widened on entry. 907 ;; will have been widened on entry.
919 (let (limits new-beg new-end) 908 ;;
920 (goto-char c-old-BOM) ; already set to old start of macro or begg. 909 ;; This function is in the C/C++/ObjC value of `c-before-font-lock-functions'.
921 (setq new-beg 910 (goto-char endd)
922 (min begg 911 (if (c-beginning-of-macro)
923 (if (setq limits (c-state-literal-at (point))) 912 (c-end-of-macro))
924 (cdr limits) ; go forward out of any string or comment. 913 (setq c-new-END (max endd c-new-END (point)))
925 (point)))) 914 ;; Determine the region, (c-new-BEG c-new-END), which will get font
926 915 ;; locked. This restricts the region should there be long macros.
927 (goto-char endd) 916 (setq c-new-BEG (max c-new-BEG (c-determine-limit 500 begg))
928 (if (setq limits (c-state-literal-at (point))) 917 c-new-END (min c-new-END (c-determine-+ve-limit 500 endd))))
929 (goto-char (car limits))) ; go backward out of any string or comment.
930 (if (c-beginning-of-macro)
931 (c-end-of-macro))
932 (setq new-end (max endd
933 (if old-len
934 (+ (- c-old-EOM old-len) (- endd begg))
935 c-old-EOM)
936 (point)))
937 (cons new-beg new-end)))
938 918
939(defun c-neutralize-CPP-line (beg end) 919(defun c-neutralize-CPP-line (beg end)
940 ;; BEG and END bound a region, typically a preprocessor line. Put a 920 ;; BEG and END bound a region, typically a preprocessor line. Put a
@@ -963,19 +943,14 @@ Note that the style variables are always made local to the buffer."
963 (t nil))))))) 943 (t nil)))))))
964 944
965(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len) 945(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len)
966 ;; (i) Extend the font lock region to cover all changed preprocessor 946 ;; (i) "Neutralize" every preprocessor line wholly or partially in the
967 ;; regions; it does this by setting the variables `c-new-BEG' and 947 ;; changed region. "Restore" lines which were CPP lines before the change
968 ;; `c-new-END' to the new boundaries. 948 ;; and are no longer so.
969 ;;
970 ;; (ii) "Neutralize" every preprocessor line wholly or partially in the
971 ;; extended changed region. "Restore" lines which were CPP lines before the
972 ;; change and are no longer so; these can be located from the Buffer local
973 ;; variables `c-old-BOM' and `c-old-EOM'.
974 ;; 949 ;;
975 ;; (iii) Mark every CPP construct by placing a `category' property value 950 ;; (ii) Mark each CPP construct by placing a `category' property value
976 ;; `c-cpp-delimiter' at its start and end. The marked characters are the 951 ;; `c-cpp-delimiter' at its start and end. The marked characters are the
977 ;; opening # and usually the terminating EOL, but sometimes the character 952 ;; opening # and usually the terminating EOL, but sometimes the character
978 ;; before a comment/string delimiter. 953 ;; before a comment delimiter.
979 ;; 954 ;;
980 ;; That is, set syntax-table properties on characters that would otherwise 955 ;; That is, set syntax-table properties on characters that would otherwise
981 ;; interact syntactically with those outside the CPP line(s). 956 ;; interact syntactically with those outside the CPP line(s).
@@ -992,15 +967,8 @@ Note that the style variables are always made local to the buffer."
992 ;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!! 967 ;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!!
993 ;; 968 ;;
994 ;; This function might make hidden buffer changes. 969 ;; This function might make hidden buffer changes.
995 (c-save-buffer-state (new-bounds) 970 (c-save-buffer-state (limits )
996 ;; First determine the region, (c-new-BEG c-new-END), which will get font 971 ;; Clear 'syntax-table properties "punctuation":
997 ;; locked. It might need "neutralizing". This region may not start
998 ;; inside a string, comment, or macro.
999 (setq new-bounds (c-extend-font-lock-region-for-macros
1000 c-new-BEG c-new-END old-len))
1001 (setq c-new-BEG (max (car new-bounds) (c-determine-limit 500 begg))
1002 c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd)))
1003 ;; Clear all old relevant properties.
1004 (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) 972 (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1))
1005 973
1006 ;; CPP "comment" markers: 974 ;; CPP "comment" markers:
@@ -1011,6 +979,8 @@ Note that the style variables are always made local to the buffer."
1011 979
1012 ;; Add needed properties to each CPP construct in the region. 980 ;; Add needed properties to each CPP construct in the region.
1013 (goto-char c-new-BEG) 981 (goto-char c-new-BEG)
982 (if (setq limits (c-literal-limits)) ; Go past any literal.
983 (goto-char (cdr limits)))
1014 (skip-chars-backward " \t") 984 (skip-chars-backward " \t")
1015 (let ((pps-position (point)) pps-state mbeg) 985 (let ((pps-position (point)) pps-state mbeg)
1016 (while (and (< (point) c-new-END) 986 (while (and (< (point) c-new-END)
@@ -1030,7 +1000,7 @@ Note that the style variables are always made local to the buffer."
1030 (nth 4 pps-state)))) ; in a comment? 1000 (nth 4 pps-state)))) ; in a comment?
1031 (goto-char (match-beginning 1)) 1001 (goto-char (match-beginning 1))
1032 (setq mbeg (point)) 1002 (setq mbeg (point))
1033 (if (> (c-syntactic-end-of-macro) mbeg) 1003 (if (> (c-no-comment-end-of-macro) mbeg)
1034 (progn 1004 (progn
1035 (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties 1005 (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties
1036 (if (eval-when-compile 1006 (if (eval-when-compile
@@ -1256,10 +1226,15 @@ Note that the style variables are always made local to the buffer."
1256 ;; 1226 ;;
1257 ;; This is called from an after-change-function, but the parameters BEG END 1227 ;; This is called from an after-change-function, but the parameters BEG END
1258 ;; and OLD-LEN are not used. 1228 ;; and OLD-LEN are not used.
1259 (if font-lock-mode 1229 (if font-lock-mode
1260 (setq c-new-BEG 1230 (setq c-new-BEG
1261 (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) 1231 (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
1262 c-new-END (c-point 'bonl c-new-END)))) 1232 c-new-END
1233 (save-excursion
1234 (goto-char c-new-END)
1235 (if (bolp)
1236 (point)
1237 (c-point 'bonl c-new-END))))))
1263 1238
1264(defun c-context-expand-fl-region (beg end) 1239(defun c-context-expand-fl-region (beg end)
1265 ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a 1240 ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a
diff --git a/lisp/recentf.el b/lisp/recentf.el
index df7f3e2e565..3321f2fe101 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1064,7 +1064,6 @@ Go to the beginning of buffer if not found."
1064 (define-key km "q" 'recentf-cancel-dialog) 1064 (define-key km "q" 'recentf-cancel-dialog)
1065 (define-key km "n" 'next-line) 1065 (define-key km "n" 'next-line)
1066 (define-key km "p" 'previous-line) 1066 (define-key km "p" 'previous-line)
1067 (define-key km [follow-link] "\C-m")
1068 km) 1067 km)
1069 "Keymap used in recentf dialogs.") 1068 "Keymap used in recentf dialogs.")
1070 1069
diff --git a/lisp/simple.el b/lisp/simple.el
index affc403dcdc..3d25ec19ab2 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6054,7 +6054,13 @@ If NOERROR, don't signal an error if we can't move that many lines."
6054 (setq temporary-goal-column 6054 (setq temporary-goal-column
6055 (cons (/ (float x-pos) 6055 (cons (/ (float x-pos)
6056 (frame-char-width)) 6056 (frame-char-width))
6057 hscroll)))))) 6057 hscroll)))
6058 (executing-kbd-macro
6059 ;; When we move beyond the first/last character visible in
6060 ;; the window, posn-at-point will return nil, so we need to
6061 ;; approximate the goal column as below.
6062 (setq temporary-goal-column
6063 (mod (current-column) (window-text-width)))))))
6058 (if target-hscroll 6064 (if target-hscroll
6059 (set-window-hscroll (selected-window) target-hscroll)) 6065 (set-window-hscroll (selected-window) target-hscroll))
6060 ;; vertical-motion can move more than it was asked to if it moves 6066 ;; vertical-motion can move more than it was asked to if it moves
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 0a0f4582b32..9ede9a5633f 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1789,7 +1789,13 @@ If END is omitted, it defaults to the length of LIST."
1789 "An embedded link." 1789 "An embedded link."
1790 :button-prefix 'widget-link-prefix 1790 :button-prefix 'widget-link-prefix
1791 :button-suffix 'widget-link-suffix 1791 :button-suffix 'widget-link-suffix
1792 :follow-link 'mouse-face 1792 ;; The `follow-link' property should only be used in those contexts where the
1793 ;; mouse-1 event normally doesn't follow the link, yet the `link' widget
1794 ;; seems to almost always be used in contexts where (down-)mouse-1 is bound
1795 ;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is
1796 ;; not necessary (and can even be harmful). So let's not add a :follow-link
1797 ;; by default. See (bug#22434).
1798 ;; :follow-link 'mouse-face
1793 :help-echo "Follow the link." 1799 :help-echo "Follow the link."
1794 :format "%[%t%]") 1800 :format "%[%t%]")
1795 1801
diff --git a/m4/secure_getenv.m4 b/m4/secure_getenv.m4
index 00194c8497f..3983173603a 100644
--- a/m4/secure_getenv.m4
+++ b/m4/secure_getenv.m4
@@ -22,4 +22,5 @@ AC_DEFUN([gl_PREREQ_SECURE_GETENV], [
22 if test $ac_cv_func___secure_getenv = no; then 22 if test $ac_cv_func___secure_getenv = no; then
23 AC_CHECK_FUNCS([issetugid]) 23 AC_CHECK_FUNCS([issetugid])
24 fi 24 fi
25 AC_CHECK_FUNCS_ONCE([getuid geteuid getgid getegid])
25]) 26])
diff --git a/src/buffer.c b/src/buffer.c
index 55a16b237e5..534b9e40da3 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -3552,8 +3552,8 @@ void
3552fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) 3552fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
3553{ 3553{
3554 Lisp_Object overlay; 3554 Lisp_Object overlay;
3555 struct Lisp_Overlay *before_list IF_LINT (= NULL); 3555 struct Lisp_Overlay *before_list;
3556 struct Lisp_Overlay *after_list IF_LINT (= NULL); 3556 struct Lisp_Overlay *after_list;
3557 /* These are either nil, indicating that before_list or after_list 3557 /* These are either nil, indicating that before_list or after_list
3558 should be assigned, or the cons cell the cdr of which should be 3558 should be assigned, or the cons cell the cdr of which should be
3559 assigned. */ 3559 assigned. */
@@ -3700,7 +3700,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
3700 /* If parent is nil, replace overlays_before; otherwise, parent->next. */ 3700 /* If parent is nil, replace overlays_before; otherwise, parent->next. */
3701 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair; 3701 struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
3702 Lisp_Object tem; 3702 Lisp_Object tem;
3703 ptrdiff_t end IF_LINT (= 0); 3703 ptrdiff_t end;
3704 3704
3705 /* After the insertion, the several overlays may be in incorrect 3705 /* After the insertion, the several overlays may be in incorrect
3706 order. The possibility is that, in the list `overlays_before', 3706 order. The possibility is that, in the list `overlays_before',
diff --git a/src/casefiddle.c b/src/casefiddle.c
index c5bfa366630..34a65edd008 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -196,7 +196,7 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
196 ptrdiff_t start_byte; 196 ptrdiff_t start_byte;
197 197
198 /* Position of first and last changes. */ 198 /* Position of first and last changes. */
199 ptrdiff_t first = -1, last IF_LINT (= 0); 199 ptrdiff_t first = -1, last;
200 200
201 ptrdiff_t opoint = PT; 201 ptrdiff_t opoint = PT;
202 ptrdiff_t opoint_byte = PT_BYTE; 202 ptrdiff_t opoint_byte = PT_BYTE;
diff --git a/src/charset.c b/src/charset.c
index 264036ae91b..1a135849539 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -240,7 +240,7 @@ struct charset_map_entries
240static void 240static void
241load_charset_map (struct charset *charset, struct charset_map_entries *entries, int n_entries, int control_flag) 241load_charset_map (struct charset *charset, struct charset_map_entries *entries, int n_entries, int control_flag)
242{ 242{
243 Lisp_Object vec IF_LINT (= Qnil), table IF_LINT (= Qnil); 243 Lisp_Object vec, table IF_LINT (= Qnil);
244 unsigned max_code = CHARSET_MAX_CODE (charset); 244 unsigned max_code = CHARSET_MAX_CODE (charset);
245 bool ascii_compatible_p = charset->ascii_compatible_p; 245 bool ascii_compatible_p = charset->ascii_compatible_p;
246 int min_char, max_char, nonascii_min_char; 246 int min_char, max_char, nonascii_min_char;
diff --git a/src/coding.c b/src/coding.c
index 55a4cea7c0b..a28fec1efe4 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -8008,12 +8008,12 @@ decode_coding_object (struct coding_system *coding,
8008 Lisp_Object dst_object) 8008 Lisp_Object dst_object)
8009{ 8009{
8010 ptrdiff_t count = SPECPDL_INDEX (); 8010 ptrdiff_t count = SPECPDL_INDEX ();
8011 unsigned char *destination IF_LINT (= NULL); 8011 unsigned char *destination;
8012 ptrdiff_t dst_bytes IF_LINT (= 0); 8012 ptrdiff_t dst_bytes;
8013 ptrdiff_t chars = to - from; 8013 ptrdiff_t chars = to - from;
8014 ptrdiff_t bytes = to_byte - from_byte; 8014 ptrdiff_t bytes = to_byte - from_byte;
8015 Lisp_Object attrs; 8015 Lisp_Object attrs;
8016 ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0); 8016 ptrdiff_t saved_pt = -1, saved_pt_byte;
8017 bool need_marker_adjustment = 0; 8017 bool need_marker_adjustment = 0;
8018 Lisp_Object old_deactivate_mark; 8018 Lisp_Object old_deactivate_mark;
8019 8019
@@ -8191,7 +8191,7 @@ encode_coding_object (struct coding_system *coding,
8191 ptrdiff_t chars = to - from; 8191 ptrdiff_t chars = to - from;
8192 ptrdiff_t bytes = to_byte - from_byte; 8192 ptrdiff_t bytes = to_byte - from_byte;
8193 Lisp_Object attrs; 8193 Lisp_Object attrs;
8194 ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0); 8194 ptrdiff_t saved_pt = -1, saved_pt_byte;
8195 bool need_marker_adjustment = 0; 8195 bool need_marker_adjustment = 0;
8196 bool kill_src_buffer = 0; 8196 bool kill_src_buffer = 0;
8197 Lisp_Object old_deactivate_mark; 8197 Lisp_Object old_deactivate_mark;
diff --git a/src/conf_post.h b/src/conf_post.h
index 5d3394fafce..bea2a8a587f 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -181,7 +181,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */
181#endif 181#endif
182 182
183#ifdef CYGWIN 183#ifdef CYGWIN
184#define SYSTEM_PURESIZE_EXTRA 10000 184#define SYSTEM_PURESIZE_EXTRA 50000
185#endif 185#endif
186 186
187#if defined HAVE_NTGUI && !defined DebPrint 187#if defined HAVE_NTGUI && !defined DebPrint
@@ -343,9 +343,8 @@ extern int emacs_setenv_TZ (char const *);
343# define FLEXIBLE_ARRAY_MEMBER 343# define FLEXIBLE_ARRAY_MEMBER
344#endif 344#endif
345 345
346/* Use this to suppress gcc's `...may be used before initialized' warnings. */
347#ifdef lint
348/* Use CODE only if lint checking is in effect. */ 346/* Use CODE only if lint checking is in effect. */
347#if defined GCC_LINT || defined lint
349# define IF_LINT(Code) Code 348# define IF_LINT(Code) Code
350#else 349#else
351# define IF_LINT(Code) /* empty */ 350# define IF_LINT(Code) /* empty */
diff --git a/src/cygw32.c b/src/cygw32.c
index 682232035f6..ca9069a120b 100644
--- a/src/cygw32.c
+++ b/src/cygw32.c
@@ -31,7 +31,7 @@ fchdir_unwind (int dir_fd)
31} 31}
32 32
33static void 33static void
34chdir_to_default_directory () 34chdir_to_default_directory (void)
35{ 35{
36 Lisp_Object new_cwd; 36 Lisp_Object new_cwd;
37 int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0); 37 int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);
@@ -46,7 +46,7 @@ chdir_to_default_directory ()
46 if (!STRINGP (new_cwd)) 46 if (!STRINGP (new_cwd))
47 new_cwd = build_string ("/"); 47 new_cwd = build_string ("/");
48 48
49 if (chdir (SDATA (ENCODE_FILE (new_cwd)))) 49 if (chdir (SSDATA (ENCODE_FILE (new_cwd))))
50 error ("could not chdir: %s", strerror (errno)); 50 error ("could not chdir: %s", strerror (errno));
51} 51}
52 52
diff --git a/src/data.c b/src/data.c
index 2574cbbd764..71da916ae74 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1614,8 +1614,8 @@ The function `default-value' gets the default value and `set-default' sets it.
1614{ 1614{
1615 struct Lisp_Symbol *sym; 1615 struct Lisp_Symbol *sym;
1616 struct Lisp_Buffer_Local_Value *blv = NULL; 1616 struct Lisp_Buffer_Local_Value *blv = NULL;
1617 union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); 1617 union Lisp_Val_Fwd valcontents;
1618 bool forwarded IF_LINT (= 0); 1618 bool forwarded;
1619 1619
1620 CHECK_SYMBOL (variable); 1620 CHECK_SYMBOL (variable);
1621 sym = XSYMBOL (variable); 1621 sym = XSYMBOL (variable);
@@ -1692,8 +1692,8 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
1692 (Lisp_Object variable) 1692 (Lisp_Object variable)
1693{ 1693{
1694 Lisp_Object tem; 1694 Lisp_Object tem;
1695 bool forwarded IF_LINT (= 0); 1695 bool forwarded;
1696 union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); 1696 union Lisp_Val_Fwd valcontents;
1697 struct Lisp_Symbol *sym; 1697 struct Lisp_Symbol *sym;
1698 struct Lisp_Buffer_Local_Value *blv = NULL; 1698 struct Lisp_Buffer_Local_Value *blv = NULL;
1699 1699
@@ -2458,7 +2458,7 @@ uintmax_t
2458cons_to_unsigned (Lisp_Object c, uintmax_t max) 2458cons_to_unsigned (Lisp_Object c, uintmax_t max)
2459{ 2459{
2460 bool valid = 0; 2460 bool valid = 0;
2461 uintmax_t val IF_LINT (= 0); 2461 uintmax_t val;
2462 if (INTEGERP (c)) 2462 if (INTEGERP (c))
2463 { 2463 {
2464 valid = 0 <= XINT (c); 2464 valid = 0 <= XINT (c);
@@ -2511,7 +2511,7 @@ intmax_t
2511cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) 2511cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
2512{ 2512{
2513 bool valid = 0; 2513 bool valid = 0;
2514 intmax_t val IF_LINT (= 0); 2514 intmax_t val;
2515 if (INTEGERP (c)) 2515 if (INTEGERP (c))
2516 { 2516 {
2517 val = XINT (c); 2517 val = XINT (c);
diff --git a/src/frame.c b/src/frame.c
index 1c5c12c7e29..df9753905b2 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -609,7 +609,7 @@ make_frame (bool mini_p)
609{ 609{
610 Lisp_Object frame; 610 Lisp_Object frame;
611 struct frame *f; 611 struct frame *f;
612 struct window *rw, *mw IF_LINT (= NULL); 612 struct window *rw, *mw;
613 Lisp_Object root_window; 613 Lisp_Object root_window;
614 Lisp_Object mini_window; 614 Lisp_Object mini_window;
615 615
@@ -3089,7 +3089,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
3089 /* If both of these parameters are present, it's more efficient to 3089 /* If both of these parameters are present, it's more efficient to
3090 set them both at once. So we wait until we've looked at the 3090 set them both at once. So we wait until we've looked at the
3091 entire list before we set them. */ 3091 entire list before we set them. */
3092 int width IF_LINT (= 0), height IF_LINT (= 0); 3092 int width, height;
3093 bool width_change = false, height_change = false; 3093 bool width_change = false, height_change = false;
3094 3094
3095 /* Same here. */ 3095 /* Same here. */
diff --git a/src/image.c b/src/image.c
index c1f25aa2357..0991f579579 100644
--- a/src/image.c
+++ b/src/image.c
@@ -5895,12 +5895,13 @@ static bool
5895png_load_body (struct frame *f, struct image *img, struct png_load_context *c) 5895png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
5896{ 5896{
5897 Lisp_Object specified_file; 5897 Lisp_Object specified_file;
5898 Lisp_Object specified_data; 5898 /* IF_LINT (volatile) works around GCC bug 54561. */
5899 Lisp_Object IF_LINT (volatile) specified_data;
5900 FILE * IF_LINT (volatile) fp = NULL;
5899 int x, y; 5901 int x, y;
5900 ptrdiff_t i; 5902 ptrdiff_t i;
5901 png_struct *png_ptr; 5903 png_struct *png_ptr;
5902 png_info *info_ptr = NULL, *end_info = NULL; 5904 png_info *info_ptr = NULL, *end_info = NULL;
5903 FILE *fp = NULL;
5904 png_byte sig[8]; 5905 png_byte sig[8];
5905 png_byte *pixels = NULL; 5906 png_byte *pixels = NULL;
5906 png_byte **rows = NULL; 5907 png_byte **rows = NULL;
@@ -5922,7 +5923,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
5922 /* Find out what file to load. */ 5923 /* Find out what file to load. */
5923 specified_file = image_spec_value (img->spec, QCfile, NULL); 5924 specified_file = image_spec_value (img->spec, QCfile, NULL);
5924 specified_data = image_spec_value (img->spec, QCdata, NULL); 5925 specified_data = image_spec_value (img->spec, QCdata, NULL);
5925 IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data);
5926 5926
5927 if (NILP (specified_data)) 5927 if (NILP (specified_data))
5928 { 5928 {
@@ -6018,10 +6018,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
6018 return 0; 6018 return 0;
6019 } 6019 }
6020 6020
6021 /* Silence a bogus diagnostic; see GCC bug 54561. */
6022 IF_LINT (fp = c->fp);
6023 IF_LINT (specified_data = specified_data_volatile);
6024
6025 /* Read image info. */ 6021 /* Read image info. */
6026 if (!NILP (specified_data)) 6022 if (!NILP (specified_data))
6027 png_set_read_fn (png_ptr, &tbr, png_read_from_memory); 6023 png_set_read_fn (png_ptr, &tbr, png_read_from_memory);
@@ -6672,9 +6668,9 @@ jpeg_load_body (struct frame *f, struct image *img,
6672 struct my_jpeg_error_mgr *mgr) 6668 struct my_jpeg_error_mgr *mgr)
6673{ 6669{
6674 Lisp_Object specified_file; 6670 Lisp_Object specified_file;
6675 Lisp_Object specified_data; 6671 /* IF_LINT (volatile) works around GCC bug 54561. */
6676 /* The 'volatile' silences a bogus diagnostic; see GCC bug 54561. */ 6672 Lisp_Object IF_LINT (volatile) specified_data;
6677 FILE * IF_LINT (volatile) fp = NULL; 6673 FILE *volatile fp = NULL;
6678 JSAMPARRAY buffer; 6674 JSAMPARRAY buffer;
6679 int row_stride, x, y; 6675 int row_stride, x, y;
6680 unsigned long *colors; 6676 unsigned long *colors;
@@ -6687,7 +6683,6 @@ jpeg_load_body (struct frame *f, struct image *img,
6687 /* Open the JPEG file. */ 6683 /* Open the JPEG file. */
6688 specified_file = image_spec_value (img->spec, QCfile, NULL); 6684 specified_file = image_spec_value (img->spec, QCfile, NULL);
6689 specified_data = image_spec_value (img->spec, QCdata, NULL); 6685 specified_data = image_spec_value (img->spec, QCdata, NULL);
6690 IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data);
6691 6686
6692 if (NILP (specified_data)) 6687 if (NILP (specified_data))
6693 { 6688 {
@@ -6751,9 +6746,6 @@ jpeg_load_body (struct frame *f, struct image *img,
6751 return 0; 6746 return 0;
6752 } 6747 }
6753 6748
6754 /* Silence a bogus diagnostic; see GCC bug 54561. */
6755 IF_LINT (specified_data = specified_data_volatile);
6756
6757 /* Create the JPEG decompression object. Let it read from fp. 6749 /* Create the JPEG decompression object. Let it read from fp.
6758 Read the JPEG image header. */ 6750 Read the JPEG image header. */
6759 jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo); 6751 jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo);
diff --git a/src/keyboard.c b/src/keyboard.c
index 2b5d514cc40..d2976cb7359 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2122,7 +2122,7 @@ read_event_from_main_queue (struct timespec *end_time,
2122{ 2122{
2123 Lisp_Object c = Qnil; 2123 Lisp_Object c = Qnil;
2124 sys_jmp_buf save_jump; 2124 sys_jmp_buf save_jump;
2125 KBOARD *kb IF_LINT (= NULL); 2125 KBOARD *kb;
2126 2126
2127 start: 2127 start:
2128 2128
@@ -2280,11 +2280,6 @@ read_decoded_event_from_main_queue (struct timespec *end_time,
2280 } 2280 }
2281} 2281}
2282 2282
2283#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
2284# pragma GCC diagnostic push
2285# pragma GCC diagnostic ignored "-Wclobbered"
2286#endif
2287
2288/* Read a character from the keyboard; call the redisplay if needed. */ 2283/* Read a character from the keyboard; call the redisplay if needed. */
2289/* commandflag 0 means do not autosave, but do redisplay. 2284/* commandflag 0 means do not autosave, but do redisplay.
2290 -1 means do not redisplay, but do autosave. 2285 -1 means do not redisplay, but do autosave.
@@ -2317,7 +2312,9 @@ read_char (int commandflag, Lisp_Object map,
2317 Lisp_Object prev_event, 2312 Lisp_Object prev_event,
2318 bool *used_mouse_menu, struct timespec *end_time) 2313 bool *used_mouse_menu, struct timespec *end_time)
2319{ 2314{
2320 Lisp_Object c; 2315 /* IF_LINT (volatile) works around GCC bug 54561. */
2316 Lisp_Object IF_LINT (volatile) c;
2317
2321 ptrdiff_t jmpcount; 2318 ptrdiff_t jmpcount;
2322 sys_jmp_buf local_getcjmp; 2319 sys_jmp_buf local_getcjmp;
2323 sys_jmp_buf save_jump; 2320 sys_jmp_buf save_jump;
@@ -3125,10 +3122,6 @@ read_char (int commandflag, Lisp_Object map,
3125 return c; 3122 return c;
3126} 3123}
3127 3124
3128#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
3129# pragma GCC diagnostic pop
3130#endif
3131
3132/* Record a key that came from a mouse menu. 3125/* Record a key that came from a mouse menu.
3133 Record it for echoing, for this-command-keys, and so on. */ 3126 Record it for echoing, for this-command-keys, and so on. */
3134 3127
diff --git a/src/regex.c b/src/regex.c
index af379367be6..fc2a46fd5a3 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -1197,13 +1197,6 @@ print_double_string (re_char *where, re_char *string1, ssize_t size1,
1197 1197
1198#endif /* not DEBUG */ 1198#endif /* not DEBUG */
1199 1199
1200/* Use this to suppress gcc's `...may be used before initialized' warnings. */
1201#ifdef lint
1202# define IF_LINT(Code) Code
1203#else
1204# define IF_LINT(Code) /* empty */
1205#endif
1206
1207/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can 1200/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can
1208 also be assigned to arbitrarily: each pattern buffer stores its own 1201 also be assigned to arbitrarily: each pattern buffer stores its own
1209 syntax, so it can be changed between regex compilations. */ 1202 syntax, so it can be changed between regex compilations. */
@@ -2472,9 +2465,9 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax,
2472 2465
2473 /* These hold the values of p, pattern, and pend from the main 2466 /* These hold the values of p, pattern, and pend from the main
2474 pattern when we have pushed into a subpattern. */ 2467 pattern when we have pushed into a subpattern. */
2475 re_char *main_p IF_LINT (= NULL); 2468 re_char *main_p;
2476 re_char *main_pattern IF_LINT (= NULL); 2469 re_char *main_pattern;
2477 re_char *main_pend IF_LINT (= NULL); 2470 re_char *main_pend;
2478 2471
2479#ifdef DEBUG 2472#ifdef DEBUG
2480 debug++; 2473 debug++;
diff --git a/src/syntax.c b/src/syntax.c
index fc8c666cec4..1c3f644aec5 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -708,7 +708,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
708 ptrdiff_t comment_end = from; 708 ptrdiff_t comment_end = from;
709 ptrdiff_t comment_end_byte = from_byte; 709 ptrdiff_t comment_end_byte = from_byte;
710 ptrdiff_t comstart_pos = 0; 710 ptrdiff_t comstart_pos = 0;
711 ptrdiff_t comstart_byte IF_LINT (= 0); 711 ptrdiff_t comstart_byte;
712 /* Place where the containing defun starts, 712 /* Place where the containing defun starts,
713 or 0 if we didn't come across it yet. */ 713 or 0 if we didn't come across it yet. */
714 ptrdiff_t defun_start = 0; 714 ptrdiff_t defun_start = 0;
diff --git a/src/unexcw.c b/src/unexcw.c
index ea678dd4c25..6343b38bcff 100644
--- a/src/unexcw.c
+++ b/src/unexcw.c
@@ -147,7 +147,7 @@ fixup_executable (int fd)
147 assert (ret == my_edata - (char *) start_address); 147 assert (ret == my_edata - (char *) start_address);
148 ++found_data; 148 ++found_data;
149 if (debug_unexcw) 149 if (debug_unexcw)
150 printf (" .data, mem start %#lx mem length %d\n", 150 printf (" .data, mem start %#lx mem length %td\n",
151 start_address, my_edata - (char *) start_address); 151 start_address, my_edata - (char *) start_address);
152 if (debug_unexcw) 152 if (debug_unexcw)
153 printf (" .data, file start %d file length %d\n", 153 printf (" .data, file start %d file length %d\n",
@@ -213,7 +213,7 @@ fixup_executable (int fd)
213 sizeof (exe_header->section_header[i])); 213 sizeof (exe_header->section_header[i]));
214 assert (ret == sizeof (exe_header->section_header[i])); 214 assert (ret == sizeof (exe_header->section_header[i]));
215 if (debug_unexcw) 215 if (debug_unexcw)
216 printf (" seek to %ld, write %d\n", 216 printf (" seek to %ld, write %zu\n",
217 (long) ((char *) &exe_header->section_header[i] - 217 (long) ((char *) &exe_header->section_header[i] -
218 (char *) exe_header), 218 (char *) exe_header),
219 sizeof (exe_header->section_header[i])); 219 sizeof (exe_header->section_header[i]));
@@ -228,7 +228,7 @@ fixup_executable (int fd)
228 my_endbss - (char *) start_address); 228 my_endbss - (char *) start_address);
229 assert (ret == (my_endbss - (char *) start_address)); 229 assert (ret == (my_endbss - (char *) start_address));
230 if (debug_unexcw) 230 if (debug_unexcw)
231 printf (" .bss, mem start %#lx mem length %d\n", 231 printf (" .bss, mem start %#lx mem length %td\n",
232 start_address, my_endbss - (char *) start_address); 232 start_address, my_endbss - (char *) start_address);
233 if (debug_unexcw) 233 if (debug_unexcw)
234 printf (" .bss, file start %d file length %d\n", 234 printf (" .bss, file start %d file length %d\n",
diff --git a/src/window.c b/src/window.c
index cf7fa44ae41..99a0709d627 100644
--- a/src/window.c
+++ b/src/window.c
@@ -5693,7 +5693,7 @@ and redisplay normally--don't erase and redraw the frame. */)
5693 struct buffer *buf = XBUFFER (w->contents); 5693 struct buffer *buf = XBUFFER (w->contents);
5694 bool center_p = false; 5694 bool center_p = false;
5695 ptrdiff_t charpos, bytepos; 5695 ptrdiff_t charpos, bytepos;
5696 EMACS_INT iarg IF_LINT (= 0); 5696 EMACS_INT iarg;
5697 int this_scroll_margin; 5697 int this_scroll_margin;
5698 5698
5699 if (buf != current_buffer) 5699 if (buf != current_buffer)
diff --git a/src/xdisp.c b/src/xdisp.c
index e78d3d6f5b6..d2f0d49d2b1 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -27342,18 +27342,21 @@ x_produce_glyphs (struct it *it)
27342 int leftmost, rightmost, lowest, highest; 27342 int leftmost, rightmost, lowest, highest;
27343 int lbearing, rbearing; 27343 int lbearing, rbearing;
27344 int i, width, ascent, descent; 27344 int i, width, ascent, descent;
27345 int c IF_LINT (= 0); /* cmp->glyph_len can't be zero; see Bug#8512 */ 27345 int c;
27346 XChar2b char2b; 27346 XChar2b char2b;
27347 struct font_metrics *pcm; 27347 struct font_metrics *pcm;
27348 ptrdiff_t pos; 27348 ptrdiff_t pos;
27349 27349
27350 for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--) 27350 eassume (0 < glyph_len); /* See Bug#8512. */
27351 if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t') 27351 do
27352 break; 27352 c = COMPOSITION_GLYPH (cmp, --glyph_len);
27353 while (c == '\t' && 0 < glyph_len);
27354
27353 bool right_padded = glyph_len < cmp->glyph_len; 27355 bool right_padded = glyph_len < cmp->glyph_len;
27354 for (i = 0; i < glyph_len; i++) 27356 for (i = 0; i < glyph_len; i++)
27355 { 27357 {
27356 if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t') 27358 c = COMPOSITION_GLYPH (cmp, i);
27359 if (c != '\t')
27357 break; 27360 break;
27358 cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0; 27361 cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0;
27359 } 27362 }
diff --git a/src/xfaces.c b/src/xfaces.c
index 3ced1d483c3..de73c010d54 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1519,7 +1519,7 @@ the WIDTH times as wide as FACE on FRAME. */)
1519 Lisp_Object maximum, Lisp_Object width) 1519 Lisp_Object maximum, Lisp_Object width)
1520{ 1520{
1521 struct frame *f; 1521 struct frame *f;
1522 int size, avgwidth IF_LINT (= 0); 1522 int size, avgwidth;
1523 1523
1524 check_window_system (NULL); 1524 check_window_system (NULL);
1525 CHECK_STRING (pattern); 1525 CHECK_STRING (pattern);
diff --git a/src/xterm.c b/src/xterm.c
index beef61d1618..9fb19a16f60 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -9393,7 +9393,7 @@ static char *error_msg;
9393/* Handle the loss of connection to display DPY. ERROR_MESSAGE is 9393/* Handle the loss of connection to display DPY. ERROR_MESSAGE is
9394 the text of an error message that lead to the connection loss. */ 9394 the text of an error message that lead to the connection loss. */
9395 9395
9396static void 9396static _Noreturn void
9397x_connection_closed (Display *dpy, const char *error_message, bool ioerror) 9397x_connection_closed (Display *dpy, const char *error_message, bool ioerror)
9398{ 9398{
9399 struct x_display_info *dpyinfo = x_display_info_for_display (dpy); 9399 struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
@@ -9491,9 +9491,6 @@ For details, see etc/PROBLEMS.\n",
9491 unbind_to (idx, Qnil); 9491 unbind_to (idx, Qnil);
9492 clear_waiting_for_input (); 9492 clear_waiting_for_input ();
9493 9493
9494 /* Tell GCC not to suggest attribute 'noreturn' for this function. */
9495 IF_LINT (if (! terminal_list) return; )
9496
9497 /* Here, we absolutely have to use a non-local exit (e.g. signal, throw, 9494 /* Here, we absolutely have to use a non-local exit (e.g. signal, throw,
9498 longjmp), because returning from this function would get us back into 9495 longjmp), because returning from this function would get us back into
9499 Xlib's code which will directly call `exit'. */ 9496 Xlib's code which will directly call `exit'. */
@@ -9559,7 +9556,7 @@ x_error_quitter (Display *display, XErrorEvent *event)
9559 It kills all frames on the display that we lost touch with. 9556 It kills all frames on the display that we lost touch with.
9560 If that was the only one, it prints an error message and kills Emacs. */ 9557 If that was the only one, it prints an error message and kills Emacs. */
9561 9558
9562static int 9559static _Noreturn int
9563x_io_error_quitter (Display *display) 9560x_io_error_quitter (Display *display)
9564{ 9561{
9565 char buf[256]; 9562 char buf[256];
@@ -9567,7 +9564,7 @@ x_io_error_quitter (Display *display)
9567 snprintf (buf, sizeof buf, "Connection lost to X server '%s'", 9564 snprintf (buf, sizeof buf, "Connection lost to X server '%s'",
9568 DisplayString (display)); 9565 DisplayString (display));
9569 x_connection_closed (display, buf, true); 9566 x_connection_closed (display, buf, true);
9570 return 0; 9567 assume (false);
9571} 9568}
9572 9569
9573/* Changing the font of the frame. */ 9570/* Changing the font of the frame. */
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 468ed4a36ff..a8d89e87c2d 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1405,10 +1405,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1405 (make-directory tmp-name) 1405 (make-directory tmp-name)
1406 (should (file-directory-p tmp-name)) 1406 (should (file-directory-p tmp-name))
1407 (write-region "foo" nil (expand-file-name "foo" tmp-name)) 1407 (write-region "foo" nil (expand-file-name "foo" tmp-name))
1408 (should (file-exists-p (expand-file-name "foo" tmp-name)))
1408 (write-region "bar" nil (expand-file-name "bold" tmp-name)) 1409 (write-region "bar" nil (expand-file-name "bold" tmp-name))
1410 (should (file-exists-p (expand-file-name "bold" tmp-name)))
1409 (make-directory (expand-file-name "boz" tmp-name)) 1411 (make-directory (expand-file-name "boz" tmp-name))
1412 (should (file-directory-p (expand-file-name "boz" tmp-name)))
1410 (should (equal (file-name-completion "fo" tmp-name) "foo")) 1413 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1414 (should (equal (file-name-completion "foo" tmp-name) t))
1411 (should (equal (file-name-completion "b" tmp-name) "bo")) 1415 (should (equal (file-name-completion "b" tmp-name) "bo"))
1416 (should-not (file-name-completion "a" tmp-name))
1412 (should 1417 (should
1413 (equal 1418 (equal
1414 (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) 1419 (file-name-completion "b" tmp-name 'file-directory-p) "boz/"))
@@ -1416,7 +1421,32 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1416 (should 1421 (should
1417 (equal 1422 (equal
1418 (sort (file-name-all-completions "b" tmp-name) 'string-lessp) 1423 (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
1419 '("bold" "boz/")))) 1424 '("bold" "boz/")))
1425 (should-not (file-name-all-completions "a" tmp-name))
1426 ;; `completion-regexp-list' restricts the completion to
1427 ;; files which match all expressions in this list.
1428 (let ((completion-regexp-list
1429 `(,directory-files-no-dot-files-regexp "b")))
1430 (should
1431 (equal (file-name-completion "" tmp-name) "bo"))
1432 (should
1433 (equal
1434 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
1435 '("bold" "boz/"))))
1436 ;; `file-name-completion' ignores file names that end in
1437 ;; any string in `completion-ignored-extensions'.
1438 (let ((completion-ignored-extensions '(".ext")))
1439 (write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
1440 (should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
1441 (should (equal (file-name-completion "fo" tmp-name) "foo"))
1442 (should (equal (file-name-completion "foo" tmp-name) t))
1443 (should (equal (file-name-completion "foo." tmp-name) "foo.ext"))
1444 (should (equal (file-name-completion "foo.ext" tmp-name) t))
1445 ;; `file-name-all-completions' is not affected.
1446 (should
1447 (equal
1448 (sort (file-name-all-completions "" tmp-name) 'string-lessp)
1449 '("../" "./" "bold" "boz/" "foo" "foo.ext")))))
1420 1450
1421 ;; Cleanup. 1451 ;; Cleanup.
1422 (ignore-errors (delete-directory tmp-name 'recursive)))))) 1452 (ignore-errors (delete-directory tmp-name 'recursive))))))
@@ -1468,7 +1498,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1468 (should (zerop (process-file "ls" nil t nil fnnd))) 1498 (should (zerop (process-file "ls" nil t nil fnnd)))
1469 ;; `ls' could produce colorized output. 1499 ;; `ls' could produce colorized output.
1470 (goto-char (point-min)) 1500 (goto-char (point-min))
1471 (while (re-search-forward tramp-color-escape-sequence-regexp nil t) 1501 (while
1502 (re-search-forward tramp-display-escape-sequence-regexp nil t)
1472 (replace-match "" nil nil)) 1503 (replace-match "" nil nil))
1473 (should (string-equal (format "%s\n" fnnd) (buffer-string))) 1504 (should (string-equal (format "%s\n" fnnd) (buffer-string)))
1474 (should-not (get-buffer-window (current-buffer) t)) 1505 (should-not (get-buffer-window (current-buffer) t))
@@ -1478,7 +1509,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1478 (should (zerop (process-file "ls" nil t t fnnd))) 1509 (should (zerop (process-file "ls" nil t t fnnd)))
1479 ;; `ls' could produce colorized output. 1510 ;; `ls' could produce colorized output.
1480 (goto-char (point-min)) 1511 (goto-char (point-min))
1481 (while (re-search-forward tramp-color-escape-sequence-regexp nil t) 1512 (while
1513 (re-search-forward tramp-display-escape-sequence-regexp nil t)
1482 (replace-match "" nil nil)) 1514 (replace-match "" nil nil))
1483 (should 1515 (should
1484 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) 1516 (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
@@ -1581,7 +1613,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1581 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) 1613 (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
1582 ;; `ls' could produce colorized output. 1614 ;; `ls' could produce colorized output.
1583 (goto-char (point-min)) 1615 (goto-char (point-min))
1584 (while (re-search-forward tramp-color-escape-sequence-regexp nil t) 1616 (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
1585 (replace-match "" nil nil)) 1617 (replace-match "" nil nil))
1586 (should 1618 (should
1587 (string-equal 1619 (string-equal
@@ -1604,7 +1636,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1604 (accept-process-output (get-buffer-process (current-buffer)) 1))) 1636 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1605 ;; `ls' could produce colorized output. 1637 ;; `ls' could produce colorized output.
1606 (goto-char (point-min)) 1638 (goto-char (point-min))
1607 (while (re-search-forward tramp-color-escape-sequence-regexp nil t) 1639 (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
1608 (replace-match "" nil nil)) 1640 (replace-match "" nil nil))
1609 ;; There might be a nasty "Process *Async Shell* finished" message. 1641 ;; There might be a nasty "Process *Async Shell* finished" message.
1610 (goto-char (point-min)) 1642 (goto-char (point-min))
@@ -1633,7 +1665,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
1633 (accept-process-output (get-buffer-process (current-buffer)) 1))) 1665 (accept-process-output (get-buffer-process (current-buffer)) 1)))
1634 ;; `ls' could produce colorized output. 1666 ;; `ls' could produce colorized output.
1635 (goto-char (point-min)) 1667 (goto-char (point-min))
1636 (while (re-search-forward tramp-color-escape-sequence-regexp nil t) 1668 (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
1637 (replace-match "" nil nil)) 1669 (replace-match "" nil nil))
1638 ;; There might be a nasty "Process *Async Shell* finished" message. 1670 ;; There might be a nasty "Process *Async Shell* finished" message.
1639 (goto-char (point-min)) 1671 (goto-char (point-min))