diff options
| author | K. Handa | 2016-06-01 08:07:18 +0900 |
|---|---|---|
| committer | K. Handa | 2016-06-01 08:07:18 +0900 |
| commit | 4efef3db2fb1c3a20b83a67948e614d9b0c258dd (patch) | |
| tree | c0c08fc308869f7ba3d988594e4a51b69a70325b | |
| parent | 694d5e5b56a9d55023ffc292188bd88f6f6cbca6 (diff) | |
| parent | 01030eed9395f5004e7d0721394697d1ca90cc2f (diff) | |
| download | emacs-4efef3db2fb1c3a20b83a67948e614d9b0c258dd.tar.gz emacs-4efef3db2fb1c3a20b83a67948e614d9b0c258dd.zip | |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
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 | ||
| @@ -276,6 +276,13 @@ for the ChangeLog file, if none already exists. Customize | |||
| 276 | built-in IDNA support now). | 276 | built-in IDNA support now). |
| 277 | 277 | ||
| 278 | --- | 278 | --- |
| 279 | *** When sending HTML messages with embedded images, and you have | ||
| 280 | exiftool installed, and you rotate images with EXIF data (i.e., | ||
| 281 | JPEGs), the rotational information will be inserted into the outgoing | ||
| 282 | image in the message. (The original image will not have its | ||
| 283 | orientation 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 |
| 280 | there are now top-level domains added all the time. Message will no | 287 | there are now top-level domains added all the time. Message will no |
| 281 | longer warn about sending emails to top-level domains it hasn't heard | 288 | longer 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 | ||
| 31 | char * | 28 | char * |
| 32 | secure_getenv (char const *name) | 29 | secure_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. |
| 518 | Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines | 505 | Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines |
| 519 | variables or functions that use \"foo-\" as prefix, that will not be registered. | 506 | variables or functions that use \"foo-\" as prefix, that will not be registered. |
| 520 | But all other prefixes will be included.") | 507 | But 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. |
| 524 | If set too small, the prefixes will be too generic (i.e. they'll use little | 511 | If set too small, the prefixes will be too generic (i.e. they'll use little |
| 525 | memory, we'll end up looking in too many files when we need a particular | 512 | memory, we'll end up looking in too many files when we need a particular |
| 526 | prefix), and if set too large, they will be too specific (i.e. they will | 513 | prefix), and if set too large, they will be too specific (i.e. they will |
| 527 | cost more memory use).") | 514 | cost 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. | ||
| 518 | Don'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. | ||
| 136 | If 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. | ||
| 154 | FUN is called with two arguments: PREFIX and SUBTREE. | ||
| 155 | You can test if SUBTREE is a leaf (and extract its value) with the | ||
| 156 | pcase 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. | ||
| 167 | FUN is called with two arguments: KEY and VAL. | ||
| 168 | PREFIX 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. |
| 1636 | COMMAND is usually a command from the gvfs-* utilities. | 1678 | COMMAND 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. | |||
| 658 | This string is passed to `format', so percent characters need to be doubled.") | 662 | This 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 | } | ||
| 670 | opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); | 666 | opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); |
| 671 | @files = readdir(d); closedir(d); | 667 | @files = readdir(d); closedir(d); |
| 672 | foreach $f (@files) { | 668 | foreach $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 | } |
| 682 | print \"ok\\n\" | 676 | print \"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 |
| 686 | sequence %s is replaced with name of Perl binary. This string is | 680 | sequence %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 | "\ | ||
| 1973 | tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" | 1912 | tramp-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 |
| 2269 | type identifiers separated by arbitrary tokens." | 2276 | type 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 | |||
| 3552 | fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) | 3552 | fix_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 | |||
| 240 | static void | 240 | static void |
| 241 | load_charset_map (struct charset *charset, struct charset_map_entries *entries, int n_entries, int control_flag) | 241 | load_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 | ||
| 33 | static void | 33 | static void |
| 34 | chdir_to_default_directory () | 34 | chdir_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 | |||
| 2458 | cons_to_unsigned (Lisp_Object c, uintmax_t max) | 2458 | cons_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 | |||
| 2511 | cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) | 2511 | cons_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 | |||
| 5895 | png_load_body (struct frame *f, struct image *img, struct png_load_context *c) | 5895 | png_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 | ||
| 9396 | static void | 9396 | static _Noreturn void |
| 9397 | x_connection_closed (Display *dpy, const char *error_message, bool ioerror) | 9397 | x_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 | ||
| 9562 | static int | 9559 | static _Noreturn int |
| 9563 | x_io_error_quitter (Display *display) | 9560 | x_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)) |