mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-02-06 20:49:33 +00:00
Code Issues Releases Activity

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

Browse Source
This commit is contained in:
K. Handa 2016-06-01 08:07:18 +09:00
commit 4efef3db2f
43 changed files with 1074 additions and 749 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
configure.ac
View File

@ -997,7 +997,7 @@ AS_IF([test $gl_gcc_warnings = no],
gl_WARN_ADD([-Wno-pointer-sign]) gl_WARN_ADD([-Wno-pointer-sign])
fi fi
AC_DEFINE([lint], [1], [Define to 1 if the compiler is checking for lint.]) AC_DEFINE([GCC_LINT], [1], [Define to 1 if --enable-gcc-warnings.])
AC_DEFINE([GNULIB_PORTCHECK], [1], [enable some gnulib portability checks]) AC_DEFINE([GNULIB_PORTCHECK], [1], [enable some gnulib portability checks])
AH_VERBATIM([GNULIB_PORTCHECK_FORTIFY_SOURCE], AH_VERBATIM([GNULIB_PORTCHECK_FORTIFY_SOURCE],
[/* Enable compile-time and run-time bounds-checking, and some warnings, [/* Enable compile-time and run-time bounds-checking, and some warnings,

203
doc/misc/texinfo.tex
View File

@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex. % Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
% %
\def\texinfoversion{2016-05-26.20} \def\texinfoversion{2016-05-28.16}
% %
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@ -4609,11 +4609,23 @@ end
% Like \expandablevalue, but completely expandable (the \message in the % Like \expandablevalue, but completely expandable (the \message in the
% definition above operates at the execution level of TeX). Used when % definition above operates at the execution level of TeX). Used when
% writing to auxiliary files, due to the expansion that \write does. % writing to auxiliary files, due to the expansion that \write does.
% If flag is undefined, pass through an unexpanded @value command: maybe it
% will be set by the time it is read back in.
% %
% NB flag names containing - or _ may not work here. % NB flag names containing - or _ may not work here.
\def\dummyvalue#1{% \def\dummyvalue#1{%
\expandafter\ifx\csname SET#1\endcsname\relax \expandafter\ifx\csname SET#1\endcsname\relax
[No value for ``#1'']% \noexpand\value{#1}%
\else
\csname SET#1\endcsname
\fi
}
% Used for @value's in index entries to form the sort key: expand the @value
% if possible, otherwise sort late.
\def\indexnofontsvalue#1{%
\expandafter\ifx\csname SET#1\endcsname\relax
ZZZZZZZ
\else \else
\csname SET#1\endcsname \csname SET#1\endcsname
\fi \fi
@ -4760,7 +4772,7 @@ end
% Define \doindex, the driver for all index macros. % Define \doindex, the driver for all index macros.
% Argument #1 is generated by the calling \fooindex macro, % Argument #1 is generated by the calling \fooindex macro,
% and it the two-letter name of the index. % and it is the two-letter name of the index.
\def\doindex#1{\edef\indexname{#1}\parsearg\doindexxxx} \def\doindex#1{\edef\indexname{#1}\parsearg\doindexxxx}
\def\doindexxxx #1{\doind{\indexname}{#1}} \def\doindexxxx #1{\doind{\indexname}{#1}}
@ -4769,6 +4781,7 @@ end
\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx} \def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx}
\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}} \def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}}
% Used when writing an index entry out to an index file to prevent % Used when writing an index entry out to an index file to prevent
% expansion of Texinfo commands that can appear in an index entry. % expansion of Texinfo commands that can appear in an index entry.
% %
@ -4787,9 +4800,11 @@ end
\def\}{{\tt\char125}}% \def\}{{\tt\char125}}%
% %
% Do the redefinitions. % Do the redefinitions.
\commondummies \definedummies
} }
% Used for the aux and toc files, where @ is the escape character.
%
% For the aux and toc files, @ is the escape character. So we want to % For the aux and toc files, @ is the escape character. So we want to
% redefine everything using @ as the escape character (instead of % redefine everything using @ as the escape character (instead of
% \realbackslash, still used for index files). When everything uses @, % \realbackslash, still used for index files). When everything uses @,
@ -4802,30 +4817,35 @@ end
\let\} = \rbraceatcmd \let\} = \rbraceatcmd
% %
% Do the redefinitions. % Do the redefinitions.
\commondummies \definedummies
\otherbackslash \otherbackslash
} }
% Called from \indexdummies and \atdummies. % \definedummyword defines \#1 as \string\#1\space, thus effectively
% preventing its expansion. This is used only for control words,
% not control letters, because the \space would be incorrect for
% control characters, but is needed to separate the control word
% from whatever follows.
% %
\def\commondummies{% % These can be used both for control words that take an argument and
% \definedummyword defines \#1 as \string\#1\space, thus effectively % those that do not. If it is followed by {arg} in the input, then
% preventing its expansion. This is used only for control words, % that will dutifully get written to the index (or wherever).
% not control letters, because the \space would be incorrect for %
% control characters, but is needed to separate the control word % For control letters, we have \definedummyletter, which omits the
% from whatever follows. % space.
% %
% For control letters, we have \definedummyletter, which omits the \def\definedummyword #1{\def#1{\string#1\space}}%
% space. \def\definedummyletter#1{\def#1{\string#1}}%
% \let\definedummyaccent\definedummyletter
% These can be used both for control words that take an argument and
% those that do not. If it is followed by {arg} in the input, then % Called from \indexdummies and \atdummies, to effectively prevent
% that will dutifully get written to the index (or wherever). % the expansion of commands.
% %
\def\definedummyword ##1{\def##1{\string##1\space}}% \def\definedummies{%
\def\definedummyletter##1{\def##1{\string##1}}%
\let\definedummyaccent\definedummyletter
% %
\let\commondummyword\definedummyword
\let\commondummyletter\definedummyletter
\let\commondummyaccent\definedummyaccent
\commondummiesnofonts \commondummiesnofonts
% %
\definedummyletter\_% \definedummyletter\_%
@ -4910,77 +4930,77 @@ end
\normalturnoffactive \normalturnoffactive
} }
% \commondummiesnofonts: common to \commondummies and \indexnofonts. % \commondummiesnofonts: common to \definedummies and \indexnofonts.
% Define \definedumyletter, \definedummyaccent and \definedummyword before % Define \commondummyletter, \commondummyaccent and \commondummyword before
% using. % using. Used for accents, font commands, and various control letters.
% %
\def\commondummiesnofonts{% \def\commondummiesnofonts{%
% Control letters and accents. % Control letters and accents.
\definedummyletter\!% \commondummyletter\!%
\definedummyaccent\"% \commondummyaccent\"%
\definedummyaccent\'% \commondummyaccent\'%
\definedummyletter\*% \commondummyletter\*%
\definedummyaccent\,% \commondummyaccent\,%
\definedummyletter\.% \commondummyletter\.%
\definedummyletter\/% \commondummyletter\/%
\definedummyletter\:% \commondummyletter\:%
\definedummyaccent\=% \commondummyaccent\=%
\definedummyletter\?% \commondummyletter\?%
\definedummyaccent\^% \commondummyaccent\^%
\definedummyaccent\`% \commondummyaccent\`%
\definedummyaccent\~% \commondummyaccent\~%
\definedummyword\u \commondummyword\u
\definedummyword\v \commondummyword\v
\definedummyword\H \commondummyword\H
\definedummyword\dotaccent \commondummyword\dotaccent
\definedummyword\ogonek \commondummyword\ogonek
\definedummyword\ringaccent \commondummyword\ringaccent
\definedummyword\tieaccent \commondummyword\tieaccent
\definedummyword\ubaraccent \commondummyword\ubaraccent
\definedummyword\udotaccent \commondummyword\udotaccent
\definedummyword\dotless \commondummyword\dotless
% %
% Texinfo font commands. % Texinfo font commands.
\definedummyword\b \commondummyword\b
\definedummyword\i \commondummyword\i
\definedummyword\r \commondummyword\r
\definedummyword\sansserif \commondummyword\sansserif
\definedummyword\sc \commondummyword\sc
\definedummyword\slanted \commondummyword\slanted
\definedummyword\t \commondummyword\t
% %
% Commands that take arguments. % Commands that take arguments.
\definedummyword\abbr \commondummyword\abbr
\definedummyword\acronym \commondummyword\acronym
\definedummyword\anchor \commondummyword\anchor
\definedummyword\cite \commondummyword\cite
\definedummyword\code \commondummyword\code
\definedummyword\command \commondummyword\command
\definedummyword\dfn \commondummyword\dfn
\definedummyword\dmn \commondummyword\dmn
\definedummyword\email \commondummyword\email
\definedummyword\emph \commondummyword\emph
\definedummyword\env \commondummyword\env
\definedummyword\file \commondummyword\file
\definedummyword\image \commondummyword\image
\definedummyword\indicateurl \commondummyword\indicateurl
\definedummyword\inforef \commondummyword\inforef
\definedummyword\kbd \commondummyword\kbd
\definedummyword\key \commondummyword\key
\definedummyword\math \commondummyword\math
\definedummyword\option \commondummyword\option
\definedummyword\pxref \commondummyword\pxref
\definedummyword\ref \commondummyword\ref
\definedummyword\samp \commondummyword\samp
\definedummyword\strong \commondummyword\strong
\definedummyword\tie \commondummyword\tie
\definedummyword\U \commondummyword\U
\definedummyword\uref \commondummyword\uref
\definedummyword\url \commondummyword\url
\definedummyword\var \commondummyword\var
\definedummyword\verb \commondummyword\verb
\definedummyword\w \commondummyword\w
\definedummyword\xref \commondummyword\xref
} }
% For testing: output @{ and @} in index sort strings as \{ and \}. % For testing: output @{ and @} in index sort strings as \{ and \}.
@ -5036,11 +5056,11 @@ end
% %
\def\indexnofonts{% \def\indexnofonts{%
% Accent commands should become @asis. % Accent commands should become @asis.
\def\definedummyaccent##1{\let##1\asis}% \def\commondummyaccent##1{\let##1\asis}%
% We can just ignore other control letters. % We can just ignore other control letters.
\def\definedummyletter##1{\let##1\empty}% \def\commondummyletter##1{\let##1\empty}%
% All control words become @asis by default; overrides below. % All control words become @asis by default; overrides below.
\let\definedummyword\definedummyaccent \let\commondummyword\commondummyaccent
\commondummiesnofonts \commondummiesnofonts
% %
% Don't no-op \tt, since it isn't a user-level command % Don't no-op \tt, since it isn't a user-level command
@ -5125,8 +5145,11 @@ end
% goes to end-of-line is not handled. % goes to end-of-line is not handled.
% %
\macrolist \macrolist
\let\value\indexnofontsvalue
} }
\let\SETmarginindex=\relax % put index entries in margin (undocumented)? \let\SETmarginindex=\relax % put index entries in margin (undocumented)?

9
etc/NEWS
View File

@ -275,6 +275,13 @@ for the ChangeLog file, if none already exists. Customize
*** 'message-use-idna' now defaults to t (because Emacs comes with *** 'message-use-idna' now defaults to t (because Emacs comes with
built-in IDNA support now). built-in IDNA support now).
---
*** When sending HTML messages with embedded images, and you have
exiftool installed, and you rotate images with EXIF data (i.e.,
JPEGs), the rotational information will be inserted into the outgoing
image in the message. (The original image will not have its
orientation affected.)
--- ---
*** The 'message-valid-fqdn-regexp' variable has been removed, since *** The 'message-valid-fqdn-regexp' variable has been removed, since
there are now top-level domains added all the time. Message will no there are now top-level domains added all the time. Message will no
@ -353,6 +360,8 @@ See the 'vc-faces' customization group.
* New Modes and Packages in Emacs 25.2 * New Modes and Packages in Emacs 25.2
** New Elisp data-structure library `radix-tree'.
* Incompatible Lisp Changes in Emacs 25.2 * Incompatible Lisp Changes in Emacs 25.2

2
lib-src/emacsclient.c
View File

@ -1195,7 +1195,7 @@ set_local_socket (const char *local_socket_name)
int use_tmpdir = 0; int use_tmpdir = 0;
int saved_errno; int saved_errno;
const char *server_name = local_socket_name; const char *server_name = local_socket_name;
const char *tmpdir IF_LINT ( = NULL); const char *tmpdir;
char *tmpdir_storage = NULL; char *tmpdir_storage = NULL;
char *socket_name_storage = NULL; char *socket_name_storage = NULL;

2
lib-src/movemail.c
View File

@ -338,7 +338,7 @@ main (int argc, char **argv)
int lockcount = 0; int lockcount = 0;
int status = 0; int status = 0;
#if defined (MAIL_USE_MAILLOCK) && defined (HAVE_TOUCHLOCK) #if defined (MAIL_USE_MAILLOCK) && defined (HAVE_TOUCHLOCK)
time_t touched_lock IF_LINT (= 0); time_t touched_lock;
#endif #endif
if (setuid (getuid ()) < 0 || setregid (-1, real_gid) < 0) if (setuid (getuid ()) < 0 || setregid (-1, real_gid) < 0)

29
lib/secure_getenv.c
View File

@ -1,4 +1,4 @@
/* Look up an environment variable more securely. /* Look up an environment variable, returning NULL in insecure situations.
Copyright 2013-2016 Free Software Foundation, Inc. Copyright 2013-2016 Free Software Foundation, Inc.
@ -20,22 +20,35 @@
#include <stdlib.h> #include <stdlib.h>
#if !HAVE___SECURE_GETENV #if !HAVE___SECURE_GETENV
# if HAVE_ISSETUGID # if HAVE_ISSETUGID || (HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID)
# include <unistd.h> # include <unistd.h>
# else
# undef issetugid
# define issetugid() 1
# endif # endif
#endif #endif
char * char *
secure_getenv (char const *name) secure_getenv (char const *name)
{ {
#if HAVE___SECURE_GETENV #if HAVE___SECURE_GETENV /* glibc */
return __secure_getenv (name); return __secure_getenv (name);
#else #elif HAVE_ISSETUGID /* OS X, FreeBSD, NetBSD, OpenBSD */
if (issetugid ()) if (issetugid ())
return 0; return NULL;
return getenv (name); return getenv (name);
#elif HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID /* other Unix */
if (geteuid () != getuid () || getegid () != getgid ())
return NULL;
return getenv (name);
#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ /* native Windows */
/* On native Windows, there is no such concept as setuid or setgid binaries.
- Programs launched as system services have high privileges, but they don't
inherit environment variables from a user.
- Programs launched by a user with "Run as Administrator" have high
privileges and use the environment variables, but the user has been asked
whether he agrees.
- Programs launched by a user without "Run as Administrator" cannot gain
high privileges, therefore there is no risk. */
return getenv (name);
#else
return NULL;
#endif #endif
} }

2
lib/verify.h
View File

@ -263,7 +263,7 @@ template <int w>
# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) # define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
#elif 1200 <= _MSC_VER #elif 1200 <= _MSC_VER
# define assume(R) __assume (R) # define assume(R) __assume (R)
#elif (defined lint \ #elif ((defined GCC_LINT || defined lint) \
&& (__has_builtin (__builtin_trap) \ && (__has_builtin (__builtin_trap) \
|| 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)))) || 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))))
/* Doing it this way helps various packages when configured with /* Doing it this way helps various packages when configured with

88
lisp/emacs-lisp/autoload.el
View File

@ -500,41 +500,26 @@ Return non-nil in the case where no autoloads were added at point."
(let ((generated-autoload-file buffer-file-name)) (let ((generated-autoload-file buffer-file-name))
(autoload-generate-file-autoloads file (current-buffer)))) (autoload-generate-file-autoloads file (current-buffer))))
(defun autoload--split-prefixes-1 (strs)
(let ((prefixes ()))
(dolist (str strs)
(string-match "\\`[^-:/_]*[-:/_]*" str)
(let* ((prefix (match-string 0 str))
(tail (substring str (match-end 0)))
(cell (assoc prefix prefixes)))
(cond
((null cell) (push (list prefix tail) prefixes))
((equal (cadr cell) tail) nil)
(t (setcdr cell (cons tail (cdr cell)))))))
prefixes))
(defvar autoload-compute-prefixes t (defvar autoload-compute-prefixes t
"If non-nil, autoload will add code to register the prefixes used in a file. "If non-nil, autoload will add code to register the prefixes used in a file.
Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
variables or functions that use \"foo-\" as prefix, that will not be registered. variables or functions that use \"foo-\" as prefix, that will not be registered.
But all other prefixes will be included.") But all other prefixes will be included.")
(defconst autoload-defs-autoload-max-size 5 (defconst autoload-def-prefixes-max-entries 5
"Target length of the list of definition prefixes per file. "Target length of the list of definition prefixes per file.
If set too small, the prefixes will be too generic (i.e. they'll use little If set too small, the prefixes will be too generic (i.e. they'll use little
memory, we'll end up looking in too many files when we need a particular memory, we'll end up looking in too many files when we need a particular
prefix), and if set too large, they will be too specific (i.e. they will prefix), and if set too large, they will be too specific (i.e. they will
cost more memory use).") cost more memory use).")
(defvar autoload-popular-prefixes nil) (defconst autoload-def-prefixes-max-length 12
"Target size of definition prefixes.
Don't try to split prefixes that are already longer than that.")
(require 'radix-tree)
(defun autoload--make-defs-autoload (defs file) (defun autoload--make-defs-autoload (defs file)
;; FIXME: avoid redundant entries. E.g. opascal currently has
;; "opascal-" "opascal--literal-start-re" "opascal--syntax-propertize"
;; where only the first one should be kept.
;; FIXME: Avoid keeping too-long-prefixes. E.g. ob-scheme currently has
;; "org-babel-scheme-" "org-babel-default-header-args:scheme"
;; "org-babel-expand-body:scheme" "org-babel-execute:scheme".
;; Remove the defs that obey the rule that file foo.el (or ;; Remove the defs that obey the rule that file foo.el (or
;; foo-mode.el) uses "foo-" as prefix. ;; foo-mode.el) uses "foo-" as prefix.
@ -548,39 +533,32 @@ cost more memory use).")
;; Then compute a small set of prefixes that cover all the ;; Then compute a small set of prefixes that cover all the
;; remaining definitions. ;; remaining definitions.
(let ((prefixes (autoload--split-prefixes-1 defs)) (let* ((tree (let ((tree radix-tree-empty))
(again t)) (dolist (def defs)
;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes)) (setq tree (radix-tree-insert tree def t)))
(while again tree))
(setq again nil) (prefixes (list (cons "" tree))))
(let ((newprefixes (while
(sort (let ((newprefixes nil)
(mapcar (lambda (cell) (changes nil))
(cons cell (dolist (pair prefixes)
(autoload--split-prefixes-1 (cdr cell)))) (let ((prefix (car pair)))
prefixes) (if (or (> (length prefix) autoload-def-prefixes-max-length)
(lambda (x y) (< (length (cdr x)) (length (cdr y))))))) (radix-tree-lookup (cdr pair) ""))
(setq prefixes nil) ;; No point splitting it any further.
(while newprefixes (push pair newprefixes)
(let ((x (pop newprefixes))) (setq changes t)
(if (or (equal '("") (cdar x)) (radix-tree-iter-subtrees
(and (cddr x) (cdr pair) (lambda (sprefix subtree)
(not (member (caar x) (push (cons (concat prefix sprefix) subtree)
autoload-popular-prefixes)) newprefixes))))))
(> (+ (length prefixes) (length newprefixes) (and changes
(length (cdr x))) (or (and (null (cdr prefixes)) (equal "" (caar prefixes)))
autoload-defs-autoload-max-size))) (<= (length newprefixes)
;; Nothing to split or would split too deep. autoload-def-prefixes-max-entries))
(push (car x) prefixes) (setq prefixes newprefixes)
;; (message "Expand %S to %S" (caar x) (cdr x)) (< (length prefixes) autoload-def-prefixes-max-entries))))
(setq again t)
(setq prefixes
(nconc (mapcar (lambda (cell)
(cons (concat (caar x)
(car cell))
(cdr cell)))
(cdr x))
prefixes)))))))
;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
(when prefixes (when prefixes
`(if (fboundp 'register-definition-prefixes) `(if (fboundp 'register-definition-prefixes)
@ -989,7 +967,7 @@ write its autoloads into the specified file instead."
t files-re)) t files-re))
dirs))) dirs)))
(done ()) ;Files processed; to remove duplicates. (done ()) ;Files processed; to remove duplicates.
(changed nil) ;Non-nil if some change occured. (changed nil) ;Non-nil if some change occurred.
(last-time) (last-time)
;; Files with no autoload cookies or whose autoloads go to other ;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings. ;; files because of file-local autoload-generated-file settings.

1
lisp/emacs-lisp/pcase.el
View File

@ -509,6 +509,7 @@ MATCH is the pattern that needs to be matched, of the form:
(numberp . stringp) (numberp . stringp)
(numberp . byte-code-function-p) (numberp . byte-code-function-p)
(consp . arrayp) (consp . arrayp)
(consp . atom)
(consp . vectorp) (consp . vectorp)
(consp . stringp) (consp . stringp)
(consp . byte-code-function-p) (consp . byte-code-function-p)

188
lisp/emacs-lisp/radix-tree.el Normal file
View File

@ -0,0 +1,188 @@
;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*-
;; Copyright (C) 2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; There are many different options for how to represent radix trees
;; in Elisp. Here I chose a very simple one. A radix-tree can be either:
;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string
;; meaning that everything that starts with PREFIX is in PTREE,
;; and everything else in RTREE. It also has the property that
;; everything that starts with the first letter of PREFIX but not with
;; that whole PREFIX is not in RTREE (i.e. is not in the tree at all).
;; - anything else is taken as the value to associate with the empty string.
;; So every node is basically an (improper) alist where each mapping applies
;; to a different leading letter.
;;
;; The main downside of this representation is that the lookup operation
;; is slower because each level of the tree is an alist rather than some kind
;; of array, so every level's lookup is O(N) rather than O(1). We could easily
;; solve this by using char-tables instead of alists, but that would make every
;; level take up a lot more memory, and it would make the resulting
;; data structure harder to read (by a human) when printed out.
;;; Code:
(defun radix-tree--insert (tree key val i)
(pcase tree
(`((,prefix . ,ptree) . ,rtree)
(let* ((ni (+ i (length prefix)))
(cmp (compare-strings prefix nil nil key i ni)))
(if (eq t cmp)
(let ((nptree (radix-tree--insert ptree key val ni)))
`((,prefix . ,nptree) . ,rtree))
(let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
(if (zerop n)
(let ((nrtree (radix-tree--insert rtree key val i)))
`((,prefix . ,ptree) . ,nrtree))
(let* ((nprefix (substring prefix 0 n))
(kprefix (substring key (+ i n)))
(pprefix (substring prefix n))
(ktree (if (equal kprefix "") val
`((,kprefix . ,val)))))
`((,nprefix
. ((,pprefix . ,ptree) . ,ktree))
. ,rtree)))))))
(_
(if (= (length key) i) val
(let ((prefix (substring key i)))
`((,prefix . ,val) . ,tree))))))
(defun radix-tree--remove (tree key i)
(pcase tree
(`((,prefix . ,ptree) . ,rtree)
(let* ((ni (+ i (length prefix)))
(cmp (compare-strings prefix nil nil key i ni)))
(if (eq t cmp)
(pcase (radix-tree--remove ptree key ni)
(`nil rtree)
(`((,pprefix . ,pptree))
`((,(concat prefix pprefix) . ,pptree) . ,rtree))
(nptree `((,prefix . ,nptree) . ,rtree)))
(let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
(if (zerop n)
(let ((nrtree (radix-tree--remove rtree key i)))
`((,prefix . ,ptree) . ,nrtree))
tree)))))
(_
(if (= (length key) i) nil tree))))
(defun radix-tree--lookup (tree string i)
(pcase tree
(`((,prefix . ,ptree) . ,rtree)
(let* ((ni (+ i (length prefix)))
(cmp (compare-strings prefix nil nil string i ni)))
(if (eq t cmp)
(radix-tree--lookup ptree string ni)
(let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
(if (zerop n)
(radix-tree--lookup rtree string i)
(+ i n))))))
(val
(if (and val (equal (length string) i))
(if (integerp val) `(t . ,val) val)
i))))
(defun radix-tree--subtree (tree string i)
(if (equal (length string) i) tree
(pcase tree
(`((,prefix . ,ptree) . ,rtree)
(let* ((ni (+ i (length prefix)))
(cmp (compare-strings prefix nil nil string i ni)))
(if (eq t cmp)
(radix-tree--subtree ptree string ni)
(let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1))))
(cond
((zerop n) (radix-tree--subtree rtree string i))
((equal (+ n i) (length string))
(let ((nprefix (substring prefix n)))
`((,nprefix . ,ptree))))
(t nil))))))
(_ nil))))
;;; Entry points
(defconst radix-tree-empty nil
"The empty radix-tree.")
(defun radix-tree-insert (tree key val)
"Insert a mapping from KEY to VAL in radix TREE."
(when (consp val) (setq val `(t . ,val)))
(if val (radix-tree--insert tree key val 0)
(radix-tree--remove tree key 0)))
(defun radix-tree-lookup (tree key)
"Return the value associated to KEY in radix TREE.
If not found, return nil."
(pcase (radix-tree--lookup tree key 0)
(`(t . ,val) val)
((pred numberp) nil)
(val val)))
(defun radix-tree-subtree (tree string)
"Return the subtree of TREE rooted at the prefix STRING."
(radix-tree--subtree tree string 0))
(eval-and-compile
(pcase-defmacro radix-tree-leaf (vpat)
;; FIXME: We'd like to use a negative pattern (not consp), but pcase
;; doesn't support it. Using `atom' works but generates sub-optimal code.
`(or `(t . ,,vpat) (and (pred atom) ,vpat))))
(defun radix-tree-iter-subtrees (tree fun)
"Apply FUN to every immediate subtree of radix TREE.
FUN is called with two arguments: PREFIX and SUBTREE.
You can test if SUBTREE is a leaf (and extract its value) with the
pcase pattern (radix-tree-leaf PAT)."
(while tree
(pcase tree
(`((,prefix . ,ptree) . ,rtree)
(funcall fun prefix ptree)
(setq tree rtree))
(_ (funcall fun "" tree)
(setq tree nil)))))
(defun radix-tree-iter-mappings (tree fun &optional prefix)
"Apply FUN to every mapping in TREE.
FUN is called with two arguments: KEY and VAL.
PREFIX is only used internally."
(radix-tree-iter-subtrees
tree
(lambda (p s)
(let ((nprefix (concat prefix p)))
(pcase s
((radix-tree-leaf v) (funcall fun nprefix v))
(_ (radix-tree-iter-mappings s fun nprefix)))))))
;; (defun radix-tree->alist (tree)
;; (let ((al nil))
;; (radix-tree-iter-mappings tree (lambda (p v) (push (cons p v) al)))
;; al))
(defun radix-tree-count (tree)
(let ((i 0))
(radix-tree-iter-mappings tree (lambda (_ _) (setq i (1+ i))))
i))
(provide 'radix-tree)
;;; radix-tree.el ends here

32
lisp/gnus/message.el
View File

@ -4545,7 +4545,7 @@ This function could be useful in `message-setup-hook'."
(setq message-options options) (setq message-options options)
;; Avoid copying text props (except hard newlines). ;; Avoid copying text props (except hard newlines).
(insert (with-current-buffer mailbuf (insert (with-current-buffer mailbuf
(mml-buffer-substring-no-properties-except-hard-newlines (mml-buffer-substring-no-properties-except-some
(point-min) (point-max)))) (point-min) (point-max))))
;; Remove some headers. ;; Remove some headers.
(message-encode-message-body) (message-encode-message-body)
@ -4909,7 +4909,7 @@ Otherwise, generate and save a value for `canlock-password' first."
;; Avoid copying text props (except hard newlines). ;; Avoid copying text props (except hard newlines).
(insert (insert
(with-current-buffer messbuf (with-current-buffer messbuf
(mml-buffer-substring-no-properties-except-hard-newlines (mml-buffer-substring-no-properties-except-some
(point-min) (point-max)))) (point-min) (point-max))))
(message-encode-message-body) (message-encode-message-body)
;; Remove some headers. ;; Remove some headers.
@ -8386,30 +8386,32 @@ Used in `message-simplify-recipients'."
(defun message-toggle-image-thumbnails () (defun message-toggle-image-thumbnails ()
"For any included image files, insert a thumbnail of that image." "For any included image files, insert a thumbnail of that image."
(interactive) (interactive)
(let ((overlays (overlays-in (point-min) (point-max))) (let ((displayed nil))
(displayed nil)) (save-excursion
(while overlays (goto-char (point-min))
(let ((overlay (car overlays))) (while (not (eobp))
(when (overlay-get overlay 'put-image) (when-let ((props (get-text-property (point) 'display)))
(delete-overlay overlay) (when (and (consp props)
(setq displayed t))) (eq (car props) 'image))
(setq overlays (cdr overlays))) (put-text-property (point) (1+ (point)) 'display nil)
(setq displayed t)))))
(unless displayed (unless displayed
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t) (while (re-search-forward "<img.*src=\"\\([^\"]+\\).*>" nil t)
(let ((file (match-string 1)) (let ((string (match-string 0))
(file (match-string 1))
(edges (window-inside-pixel-edges (edges (window-inside-pixel-edges
(get-buffer-window (current-buffer))))) (get-buffer-window (current-buffer)))))
(put-image (delete-region (match-beginning 0) (match-end 0))
(insert-image
(create-image (create-image
file 'imagemagick nil file 'imagemagick nil
:max-width (truncate :max-width (truncate
(* 0.7 (- (nth 2 edges) (nth 0 edges)))) (* 0.7 (- (nth 2 edges) (nth 0 edges))))
:max-height (truncate :max-height (truncate
(* 0.5 (- (nth 3 edges) (nth 1 edges))))) (* 0.5 (- (nth 3 edges) (nth 1 edges)))))
(match-beginning 0) string)))))))
" ")))))))
(provide 'message) (provide 'message)

61
lisp/gnus/mml.el
View File

@ -413,12 +413,21 @@ A message part needs to be split into %d charset parts. Really send? "
(setq contents (append (list (cons 'tag-location orig-point)) contents)) (setq contents (append (list (cons 'tag-location orig-point)) contents))
(cons (intern name) (nreverse contents)))) (cons (intern name) (nreverse contents))))
(defun mml-buffer-substring-no-properties-except-hard-newlines (start end) (defun mml-buffer-substring-no-properties-except-some (start end)
(let ((str (buffer-substring-no-properties start end)) (let ((str (buffer-substring-no-properties start end))
(bufstart start) tmp) (bufstart start)
(while (setq tmp (text-property-any start end 'hard 't)) tmp)
(set-text-properties (- tmp bufstart) (- tmp bufstart -1) ;; Copy over all hard newlines.
'(hard t) str) (while (setq tmp (text-property-any start end 'hard t))
(put-text-property (- tmp bufstart) (- tmp bufstart -1)
'hard t str)
(setq start (1+ tmp)))
;; Copy over all `display' properties (which are usually images).
(setq start bufstart)
(while (setq tmp (text-property-not-all start end 'display nil))
(put-text-property (- tmp bufstart) (- tmp bufstart -1)
'display (get-text-property tmp 'display)
str)
(setq start (1+ tmp))) (setq start (1+ tmp)))
str)) str))
@ -435,21 +444,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(if (re-search-forward "<#\\(/\\)?mml." nil t) (if (re-search-forward "<#\\(/\\)?mml." nil t)
(setq count (+ count (if (match-beginning 1) -1 1))) (setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max)))) (goto-char (point-max))))
(mml-buffer-substring-no-properties-except-hard-newlines (mml-buffer-substring-no-properties-except-some
beg (if (> count 0) beg (if (> count 0)
(point) (point)
(match-beginning 0)))) (match-beginning 0))))
(if (re-search-forward (if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1 (prog1
(mml-buffer-substring-no-properties-except-hard-newlines (mml-buffer-substring-no-properties-except-some
beg (match-beginning 0)) beg (match-beginning 0))
(if (or (not (match-beginning 1)) (if (or (not (match-beginning 1))
(equal (match-string 2) "multipart")) (equal (match-string 2) "multipart"))
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n") (when (looking-at "[ \t]*\n")
(forward-line 1)))) (forward-line 1))))
(mml-buffer-substring-no-properties-except-hard-newlines (mml-buffer-substring-no-properties-except-some
beg (goto-char (point-max))))))) beg (goto-char (point-max)))))))
(defvar mml-boundary nil) (defvar mml-boundary nil)
@ -514,7 +523,9 @@ be \"related\" or \"alternate\"."
(when (search-forward (url-filename parsed) end t) (when (search-forward (url-filename parsed) end t)
(let ((cid (format "fsf.%d" cid))) (let ((cid (format "fsf.%d" cid)))
(replace-match (concat "cid:" cid) t t) (replace-match (concat "cid:" cid) t t)
(push (list cid (url-filename parsed)) new-parts)) (push (list cid (url-filename parsed)
(get-text-property start 'display))
new-parts))
(setq cid (1+ cid))))))) (setq cid (1+ cid)))))))
;; We have local images that we want to include. ;; We have local images that we want to include.
(if (not new-parts) (if (not new-parts)
@ -527,11 +538,41 @@ be \"related\" or \"alternate\"."
(setq cont (setq cont
(nconc cont (nconc cont
(list `(part (type . "image/png") (list `(part (type . "image/png")
(filename . ,(nth 1 new-part)) ,@(mml--possibly-alter-image
(nth 1 new-part)
(nth 2 new-part))
(id . ,(concat "<" (nth 0 new-part) (id . ,(concat "<" (nth 0 new-part)
">"))))))) ">")))))))
cont)))) cont))))
(defun mml--possibly-alter-image (file-name image)
(if (or (null image)
(not (consp image))
(not (eq (car image) 'image))
(not (image-property image :rotation))
(not (executable-find "exiftool")))
`((filename . ,file-name))
`((filename . ,file-name)
(buffer
.
,(with-current-buffer (mml-generate-new-buffer " *mml rotation*")
(set-buffer-multibyte nil)
(call-process "exiftool"
file-name
(list (current-buffer) nil)
nil
(format "-Orientation#=%d"
(cl-case (truncate
(image-property image :rotation))
(0 0)
(90 6)
(180 3)
(270 8)
(otherwise 0)))
"-o" "-"
"-")
(current-buffer))))))
(defun mml-generate-mime-1 (cont) (defun mml-generate-mime-1 (cont)
(let ((mm-use-ultra-safe-encoding (let ((mm-use-ultra-safe-encoding
(or mm-use-ultra-safe-encoding (assq 'sign cont)))) (or mm-use-ultra-safe-encoding (assq 'sign cont))))

23
lisp/mail/rmail.el
View File

@ -1818,9 +1818,21 @@ not be a new one). It returns non-nil if it got any new messages."
;; Read in the contents of the inbox files, renaming them as ;; Read in the contents of the inbox files, renaming them as
;; necessary, and adding to the list of files to delete ;; necessary, and adding to the list of files to delete
;; eventually. ;; eventually.
(if file-name (unwind-protect
(rmail-insert-inbox-text files nil) (progn
(setq delete-files (rmail-insert-inbox-text files t))) ;; Set modified now to lock the file, so that we don't
;; encounter locking problems later in the middle of
;; reading the mail.
(set-buffer-modified-p t)
(if file-name
(rmail-insert-inbox-text files nil)
(setq delete-files (rmail-insert-inbox-text files t))))
;; If there was no new mail, or we aborted before actually
;; trying to get any, mark buffer unmodified. Otherwise the
;; buffer is correctly marked modified and the file locked
;; until we save out the new mail.
(if (= (point-min) (point-max))
(set-buffer-modified-p nil)))
;; Scan the new text and convert each message to ;; Scan the new text and convert each message to
;; Rmail/mbox format. ;; Rmail/mbox format.
(goto-char (point-min)) (goto-char (point-min))
@ -1969,11 +1981,6 @@ Value is the size of the newly read mail after conversion."
size)) size))
(defun rmail-insert-inbox-text (files renamep) (defun rmail-insert-inbox-text (files renamep)
;; Detect a locked file now, so that we avoid moving mail
;; out of the real inbox file. (That could scare people.)
(or (memq (file-locked-p buffer-file-name) '(nil t))
(error "RMAIL file %s is locked"
(file-name-nondirectory buffer-file-name)))
(let (file tofile delete-files popmail got-password password) (let (file tofile delete-files popmail got-password password)
(while files (while files
;; Handle remote mailbox names specially; don't expand as filenames ;; Handle remote mailbox names specially; don't expand as filenames

30
lisp/net/tramp-adb.el
View File

@ -535,7 +535,7 @@ Emacs dired can't find files."
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(all-completions (all-completions
filename filename
(with-parsed-tramp-file-name directory nil (with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions" (with-tramp-file-property v localname "file-name-all-completions"
(save-match-data (save-match-data
(tramp-adb-send-command (tramp-adb-send-command
@ -934,20 +934,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(unless (stringp program) (unless (stringp program)
(tramp-error v 'file-error "PROGRAM must be a string")) (tramp-error v 'file-error "PROGRAM must be a string"))
(let ((command (let* ((buffer
(format "cd %s; %s" (if buffer
(tramp-shell-quote-argument localname) (get-buffer-create buffer)
(mapconcat 'tramp-shell-quote-argument ;; BUFFER can be nil. We use a temporary buffer.
(cons program args) " "))) (generate-new-buffer tramp-temp-buffer-name)))
(tramp-process-connection-type (command
(or (null program) tramp-process-connection-type)) (format "cd %s; %s"
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) (tramp-shell-quote-argument localname)
(name1 name) (mapconcat 'tramp-shell-quote-argument
(i 0)) (cons program args) " ")))
(tramp-process-connection-type
(or (null program) tramp-process-connection-type))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
(unless buffer
;; BUFFER can be nil. We use a temporary buffer.
(setq buffer (generate-new-buffer tramp-temp-buffer-name)))
(while (get-process name1) (while (get-process name1)
;; NAME must be unique as process name. ;; NAME must be unique as process name.
(setq i (1+ i) (setq i (1+ i)

453
lisp/net/tramp-gvfs.el
View File

@ -407,6 +407,42 @@ Every entry is a list (NAME ADDRESS).")
(defconst tramp-hal-interface-device "org.freedesktop.Hal.Device" (defconst tramp-hal-interface-device "org.freedesktop.Hal.Device"
"The device interface of the HAL daemon.") "The device interface of the HAL daemon.")
(defconst tramp-gvfs-file-attributes
'("type"
"standard::display-name"
;; We don't need this one. It is used as delimiter in case the
;; display name contains spaces, which is hard to parse.
"standard::icon"
"standard::symlink-target"
"unix::nlink"
"unix::uid"
"owner::user"
"unix::gid"
"owner::group"
"time::access"
"time::modified"
"time::changed"
"standard::size"
"unix::mode"
"access::can-read"
"access::can-write"
"access::can-execute"
"unix::inode"
"unix::device")
"GVFS file attributes.")
(defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp
(concat "[[:blank:]]"
(regexp-opt tramp-gvfs-file-attributes t)
"=\\([^[:blank:]]+\\)")
"Regexp to parse GVFS file attributes with `gvfs-ls'.")
(defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp
(concat "^[[:blank:]]*"
(regexp-opt tramp-gvfs-file-attributes t)
":[[:blank:]]+\\(.*\\)$")
"Regexp to parse GVFS file attributes with `gvfs-info'.")
;; New handlers should be added here. ;; New handlers should be added here.
(defconst tramp-gvfs-file-name-handler-alist (defconst tramp-gvfs-file-name-handler-alist
@ -784,127 +820,185 @@ file names."
(tramp-run-real-handler (tramp-run-real-handler
'expand-file-name (list localname)))))) 'expand-file-name (list localname))))))
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format) (defun tramp-gvfs-get-directory-attributes (directory)
"Like `file-attributes' for Tramp files." "Return GVFS attributes association list of all files in DIRECTORY."
(unless id-format (setq id-format 'integer))
(ignore-errors (ignore-errors
;; Don't modify `last-coding-system-used' by accident. ;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used) (let ((last-coding-system-used last-coding-system-used)
(process-environment (cons "LC_MESSAGES=C" process-environment)) result)
dirp res-symlink-target res-numlinks res-uid res-gid res-access (with-parsed-tramp-file-name directory nil
res-mod res-change res-size res-filemodes res-inode res-device) (with-tramp-file-property v localname "directory-gvfs-attributes"
(tramp-message v 5 "directory gvfs attributes: %s" localname)
;; Send command.
(tramp-gvfs-send-command
v "gvfs-ls" "-h" "-n" "-a"
(mapconcat 'identity tramp-gvfs-file-attributes ",")
(tramp-gvfs-url-file-name directory))
;; Parse output ...
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (re-search-forward
(concat "^\\(.+\\)[[:blank:]]"
"\\([[:digit:]]+\\)[[:blank:]]"
"(\\(.+\\))[[:blank:]]"
"standard::display-name=\\(.+\\)[[:blank:]]"
"standard::icon=")
(point-at-eol) t)
(let ((item (list (cons "standard::display-name" (match-string 4))
(cons "type" (match-string 3))
(cons "standard::size" (match-string 2))
(match-string 1))))
(while (re-search-forward
tramp-gvfs-file-attributes-with-gvfs-ls-regexp
(point-at-eol) t)
(push (cons (match-string 1) (match-string 2)) item))
(push (nreverse item) result))
(forward-line)))
result)))))
(defun tramp-gvfs-get-root-attributes (filename)
"Return GVFS attributes association list of FILENAME."
(ignore-errors
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
(with-parsed-tramp-file-name filename nil (with-parsed-tramp-file-name filename nil
(with-tramp-file-property (with-tramp-file-property v localname "file-gvfs-attributes"
v localname (format "file-attributes-%s" id-format) (tramp-message v 5 "file gvfs attributes: %s" localname)
(tramp-message v 5 "file attributes: %s" localname) ;; Send command.
(tramp-gvfs-send-command (tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name filename)) v "gvfs-info" (tramp-gvfs-url-file-name filename))
;; Parse output ... ;; Parse output ...
(with-current-buffer (tramp-get-connection-buffer v) (with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward "attributes:" nil t) (while (re-search-forward
;; ... directory or symlink tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
(goto-char (point-min)) (push (cons (match-string 1) (match-string 2)) result))
(setq dirp (if (re-search-forward "type: directory" nil t) t)) result))))))
(goto-char (point-min))
(setq res-symlink-target
(if (re-search-forward
"standard::symlink-target: \\(.+\\)$" nil t)
(match-string 1)))
;; ... number links
(goto-char (point-min))
(setq res-numlinks
(if (re-search-forward "unix::nlink: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1)) 0))
;; ... uid and gid
(goto-char (point-min))
(setq res-uid
(if (eq id-format 'integer)
(if (re-search-forward "unix::uid: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
-1)
(if (re-search-forward "owner::user: \\(.+\\)$" nil t)
(match-string 1)
"UNKNOWN")))
(setq res-gid
(if (eq id-format 'integer)
(if (re-search-forward "unix::gid: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
-1)
(if (re-search-forward "owner::group: \\(.+\\)$" nil t)
(match-string 1)
"UNKNOWN")))
;; ... last access, modification and change time
(goto-char (point-min))
(setq res-access
(if (re-search-forward "time::access: \\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
(goto-char (point-min))
(setq res-mod
(if (re-search-forward "time::modified: \\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
(goto-char (point-min))
(setq res-change
(if (re-search-forward "time::changed: \\([0-9]+\\)" nil t)
(seconds-to-time (string-to-number (match-string 1)))
'(0 0)))
;; ... size
(goto-char (point-min))
(setq res-size
(if (re-search-forward "standard::size: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1)) 0))
;; ... file mode flags
(goto-char (point-min))
(setq res-filemodes
(if (re-search-forward "unix::mode: \\([0-9]+\\)" nil t)
(tramp-file-mode-from-int
(string-to-number (match-string 1)))
(if dirp "drwx------" "-rwx------")))
;; ... inode and device
(goto-char (point-min))
(setq res-inode
(if (re-search-forward "unix::inode: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
(tramp-get-inode v)))
(goto-char (point-min))
(setq res-device
(if (re-search-forward "unix::device: \\([0-9]+\\)" nil t)
(string-to-number (match-string 1))
(tramp-get-device v)))
;; Return data gathered. (defun tramp-gvfs-get-file-attributes (filename)
(list "Return GVFS attributes association list of FILENAME."
;; 0. t for directory, string (name linked to) for (setq filename (directory-file-name (expand-file-name filename)))
;; symbolic link, or nil. (with-parsed-tramp-file-name filename nil
(or dirp res-symlink-target) (if (or
;; 1. Number of links to file. (and (string-match "^\\(afp\\|smb\\)$" method)
res-numlinks (string-match "^/?\\([^/]+\\)$" localname))
;; 2. File uid. (string-equal localname "/"))
res-uid (tramp-gvfs-get-root-attributes filename)
;; 3. File gid. (assoc
res-gid (file-name-nondirectory filename)
;; 4. Last access time, as a list of integers. (tramp-gvfs-get-directory-attributes (file-name-directory filename))))))
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise. (defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
res-access res-mod res-change "Like `file-attributes' for Tramp files."
;; 7. Size in bytes (-1, if number is out of range). (unless id-format (setq id-format 'integer))
res-size (ignore-errors
;; 8. File modes. (let ((attributes (tramp-gvfs-get-file-attributes filename))
res-filemodes dirp res-symlink-target res-numlinks res-uid res-gid res-access
;; 9. t if file's gid would change if file were deleted res-mod res-change res-size res-filemodes res-inode res-device)
;; and recreated. (when attributes
nil ;; ... directory or symlink
;; 10. Inode number. (setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t))
res-inode (setq res-symlink-target
;; 11. Device number. (cdr (assoc "standard::symlink-target" attributes)))
res-device ;; ... number links
)))))))) (setq res-numlinks
(string-to-number
(or (cdr (assoc "unix::nlink" attributes)) "0")))
;; ... uid and gid
(setq res-uid
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::uid" attributes))
(format "%s" tramp-unknown-id-integer)))
(or (cdr (assoc "owner::user" attributes))
(cdr (assoc "unix::uid" attributes))
tramp-unknown-id-string)))
(setq res-gid
(if (eq id-format 'integer)
(string-to-number
(or (cdr (assoc "unix::gid" attributes))
(format "%s" tramp-unknown-id-integer)))
(or (cdr (assoc "owner::group" attributes))
(cdr (assoc "unix::gid" attributes))
tramp-unknown-id-string)))
;; ... last access, modification and change time
(setq res-access
(seconds-to-time
(string-to-number
(or (cdr (assoc "time::access" attributes)) "0"))))
(setq res-mod
(seconds-to-time
(string-to-number
(or (cdr (assoc "time::modified" attributes)) "0"))))
(setq res-change
(seconds-to-time
(string-to-number
(or (cdr (assoc "time::changed" attributes)) "0"))))
;; ... size
(setq res-size
(string-to-number
(or (cdr (assoc "standard::size" attributes)) "0")))
;; ... file mode flags
(setq res-filemodes
(let ((n (cdr (assoc "unix::mode" attributes))))
(if n
(tramp-file-mode-from-int (string-to-number n))
(format
"%s%s%s%s------"
(if dirp "d" "-")
(if (equal (cdr (assoc "access::can-read" attributes))
"FALSE")
"-" "r")
(if (equal (cdr (assoc "access::can-write" attributes))
"FALSE")
"-" "w")
(if (equal (cdr (assoc "access::can-execute" attributes))
"FALSE")
"-" "x")))))
;; ... inode and device
(setq res-inode
(let ((n (cdr (assoc "unix::inode" attributes))))
(if n
(string-to-number n)
(tramp-get-inode (tramp-dissect-file-name filename)))))
(setq res-device
(let ((n (cdr (assoc "unix::device" attributes))))
(if n
(string-to-number n)
(tramp-get-device (tramp-dissect-file-name filename)))))
;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for
;; symbolic link, or nil.
(or dirp res-symlink-target)
;; 1. Number of links to file.
res-numlinks
;; 2. File uid.
res-uid
;; 3. File gid.
res-gid
;; 4. Last access time, as a list of integers.
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise.
res-access res-mod res-change
;; 7. Size in bytes (-1, if number is out of range).
res-size
;; 8. File modes.
res-filemodes
;; 9. t if file's gid would change if file were deleted
;; and recreated.
nil
;; 10. Inode number.
res-inode
;; 11. Device number.
res-device
)))))
(defun tramp-gvfs-handle-file-directory-p (filename) (defun tramp-gvfs-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files." "Like `file-directory-p' for Tramp files."
(eq t (car (file-attributes filename)))) (eq t (car (file-attributes (file-truename filename)))))
(defun tramp-gvfs-handle-file-executable-p (filename) (defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files." "Like `file-executable-p' for Tramp files."
@ -926,73 +1020,21 @@ file names."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory) (defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename)) (unless (save-match-data (string-match "/" filename))
(with-parsed-tramp-file-name (expand-file-name directory) nil (all-completions
filename
(all-completions (with-parsed-tramp-file-name (expand-file-name directory) nil
filename (with-tramp-file-property v localname "file-name-all-completions"
(mapcar (let ((result '("./" "../"))
'list
(or
;; Try cache entries for filename, filename with last
;; character removed, filename with last two characters
;; removed, ..., and finally the empty string - all
;; concatenated to the local directory name.
(let ((remote-file-name-inhibit-cache
(or remote-file-name-inhibit-cache
tramp-completion-reread-directory-timeout)))
;; This is inefficient for very long filenames, pity
;; `reduce' is not available...
(car
(apply
'append
(mapcar
(lambda (x)
(let ((cache-hit
(tramp-get-file-property
v
(concat localname (substring filename 0 x))
"file-name-all-completions"
nil)))
(when cache-hit (list cache-hit))))
;; We cannot use a length of 0, because file properties
;; for "foo" and "foo/" are identical.
(number-sequence (length filename) 1 -1)))))
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
(let ((result '("." ".."))
entry) entry)
;; Get a list of directories and files. ;; Get a list of directories and files.
(tramp-gvfs-send-command (dolist (item (tramp-gvfs-get-directory-attributes directory) result)
v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory)) (setq entry
(or ;; Use display-name if available (google-drive).
;; Now grab the output. ;(cdr (assoc "standard::display-name" item))
(with-temp-buffer (car item)))
(insert-buffer-substring (tramp-get-connection-buffer v)) (if (string-equal (cdr (assoc "type" item)) "directory")
(goto-char (point-max)) (push (file-name-as-directory entry) result)
(while (zerop (forward-line -1)) (push entry result)))))))))
(setq entry (buffer-substring (point) (point-at-eol)))
(when (string-match filename entry)
(if (file-directory-p (expand-file-name entry directory))
(push (concat entry "/") result)
(push entry result)))))
;; Because the remote op went through OK we know the
;; directory we `cd'-ed to exists.
(tramp-set-file-property v localname "file-exists-p" t)
;; Because the remote op went through OK we know every
;; file listed by `ls' exists.
(mapc (lambda (entry)
(tramp-set-file-property
v (concat localname entry) "file-exists-p" t))
result)
;; Store result in the cache.
(tramp-set-file-property
v (concat localname filename)
"file-name-all-completions" result))))))))
(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
"Like `file-notify-add-watch' for Tramp files." "Like `file-notify-add-watch' for Tramp files."
@ -1528,7 +1570,7 @@ connection if a previous connection has died for some reason."
(let ((p (make-network-process (let ((p (make-network-process
:name (tramp-buffer-name vec) :name (tramp-buffer-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t))) :server t :host 'local :service t :noquery t)))
(set-process-query-on-exit-flag p nil))) (set-process-query-on-exit-flag p nil)))
(unless (tramp-gvfs-connection-mounted-p vec) (unless (tramp-gvfs-connection-mounted-p vec)
@ -1635,10 +1677,17 @@ connection if a previous connection has died for some reason."
"Send the COMMAND with its ARGS to connection VEC. "Send the COMMAND with its ARGS to connection VEC.
COMMAND is usually a command from the gvfs-* utilities. COMMAND is usually a command from the gvfs-* utilities.
`call-process' is applied, and it returns t if the return code is zero." `call-process' is applied, and it returns t if the return code is zero."
(with-current-buffer (tramp-get-connection-buffer vec) (let* ((locale (tramp-get-local-locale vec))
(tramp-gvfs-maybe-open-connection vec) (process-environment
(erase-buffer) (append
(zerop (apply 'tramp-call-process vec command nil t nil args)))) `(,(format "LANG=%s" locale)
,(format "LANGUAGE=%s" locale)
,(format "LC_ALL=%s" locale))
process-environment)))
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-gvfs-maybe-open-connection vec)
(erase-buffer)
(zerop (apply 'tramp-call-process vec command nil t nil args)))))
;; D-Bus BLUEZ functions. ;; D-Bus BLUEZ functions.
@ -1772,35 +1821,37 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi."
;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods. ;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
(when tramp-gvfs-enabled (when tramp-gvfs-enabled
(zeroconf-init tramp-gvfs-zeroconf-domain) ;; Suppress D-Bus error messages.
(if (zeroconf-list-service-types) (let (tramp-gvfs-dbus-event-vector)
(progn (zeroconf-init tramp-gvfs-zeroconf-domain)
(if (zeroconf-list-service-types)
(progn
(tramp-set-completion-function
"afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function
"dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
(tramp-zeroconf-parse-device-names "_workstation._tcp")))
(when (member "smb" tramp-gvfs-methods)
(tramp-set-completion-function
"smb" '((tramp-zeroconf-parse-device-names "_smb._tcp")))))
(when (executable-find "avahi-browse")
(tramp-set-completion-function (tramp-set-completion-function
"afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function (tramp-set-completion-function
"dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function (tramp-set-completion-function
"davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function (tramp-set-completion-function
"sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
(tramp-zeroconf-parse-device-names "_workstation._tcp"))) (tramp-gvfs-parse-device-names "_workstation._tcp")))
(when (member "smb" tramp-gvfs-methods) (when (member "smb" tramp-gvfs-methods)
(tramp-set-completion-function (tramp-set-completion-function
"smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) "smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
(when (executable-find "avahi-browse")
(tramp-set-completion-function
"afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function
"dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp")
(tramp-gvfs-parse-device-names "_workstation._tcp")))
(when (member "smb" tramp-gvfs-methods)
(tramp-set-completion-function
"smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))
;; D-Bus SYNCE functions. ;; D-Bus SYNCE functions.

259
lisp/net/tramp-sh.el
View File

@ -84,8 +84,12 @@ e.g. \"$HOME/.sh_history\"."
(string :tag "Redirect to a file"))) (string :tag "Redirect to a file")))
;;;###tramp-autoload ;;;###tramp-autoload
(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" (defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
"Escape sequences produced by the \"ls\" command.") "Terminal control escape sequences for display attributes.")
;;;###tramp-autoload
(defconst tramp-device-escape-sequence-regexp "\e[[0-9]+n"
"Terminal control escape sequences for device status.")
;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
;; root users. It uses the `$' character for other users. In order ;; 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.
This string is passed to `format', so percent characters need to be doubled.") This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-perl-file-name-all-completions (defconst tramp-perl-file-name-all-completions
"%s -e 'sub case { "%s -e '
my $str = shift;
if ($ARGV[2]) {
return lc($str);
}
else {
return $str;
}
}
opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
@files = readdir(d); closedir(d); @files = readdir(d); closedir(d);
foreach $f (@files) { foreach $f (@files) {
if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { if (-d \"$ARGV[0]/$f\") {
if (-d \"$ARGV[0]/$f\") { print \"$f/\\n\";
print \"$f/\\n\"; }
} else {
else { print \"$f\\n\";
print \"$f\\n\";
}
} }
} }
print \"ok\\n\" print \"ok\\n\"
' \"$1\" \"$2\" \"$3\" 2>/dev/null" ' \"$1\" 2>/dev/null"
"Perl script to produce output suitable for use with "Perl script to produce output suitable for use with
`file-name-all-completions' on the remote file system. Escape `file-name-all-completions' on the remote file system. Escape
sequence %s is replaced with name of Perl binary. This string is sequence %s is replaced with name of Perl binary. This string is
@ -1339,8 +1333,10 @@ target of the symlink differ."
(setq res-gid (read (current-buffer))) (setq res-gid (read (current-buffer)))
(if (eq id-format 'integer) (if (eq id-format 'integer)
(progn (progn
(unless (numberp res-uid) (setq res-uid -1)) (unless (numberp res-uid)
(unless (numberp res-gid) (setq res-gid -1))) (setq res-uid tramp-unknown-id-integer))
(unless (numberp res-gid)
(setq res-gid tramp-unknown-id-integer)))
(progn (progn
(unless (stringp res-uid) (setq res-uid (symbol-name res-uid))) (unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
(unless (stringp res-gid) (setq res-gid (symbol-name res-gid))))) (unless (stringp res-gid) (setq res-gid (symbol-name res-gid)))))
@ -1862,135 +1858,63 @@ be non-negative integers."
(defun tramp-sh-handle-file-name-all-completions (filename directory) (defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename)) (unless (save-match-data (string-match "/" filename))
(with-parsed-tramp-file-name (expand-file-name directory) nil (all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
(let (result)
;; Get a list of directories and files, including reliably
;; tagging the directories with a trailing "/". Because I
;; rock. --daniel@danann.net
(tramp-send-command
v
(if (tramp-get-remote-perl v)
(progn
(tramp-maybe-send-script
v tramp-perl-file-name-all-completions
"tramp_perl_file_name_all_completions")
(format "tramp_perl_file_name_all_completions %s"
(tramp-shell-quote-argument localname)))
(all-completions (format (concat
filename "(cd %s 2>&1 && %s -a 2>/dev/null"
(mapcar " | while IFS= read f; do"
'list " if %s -d \"$f\" 2>/dev/null;"
(or " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
;; Try cache entries for `filename', `filename' with last " && \\echo ok) || \\echo fail")
;; character removed, `filename' with last two characters (tramp-shell-quote-argument localname)
;; removed, ..., and finally the empty string - all (tramp-get-ls-command v)
;; concatenated to the local directory name. (tramp-get-test-command v))))
(let ((remote-file-name-inhibit-cache
(or remote-file-name-inhibit-cache
tramp-completion-reread-directory-timeout)))
;; This is inefficient for very long file names, pity ;; Now grab the output.
;; `reduce' is not available... (with-current-buffer (tramp-get-buffer v)
(car (goto-char (point-max))
(apply
'append
(mapcar
(lambda (x)
(let ((cache-hit
(tramp-get-file-property
v
(concat localname (substring filename 0 x))
"file-name-all-completions"
nil)))
(when cache-hit (list cache-hit))))
;; We cannot use a length of 0, because file properties
;; for "foo" and "foo/" are identical.
(number-sequence (length filename) 1 -1)))))
;; Cache expired or no matching cache entry found so we need ;; Check result code, found in last line of output.
;; to perform a remote operation. (forward-line -1)
(let (result) (if (looking-at "^fail$")
;; Get a list of directories and files, including reliably (progn
;; tagging the directories with a trailing '/'. Because I ;; Grab error message from line before last line
;; rock. --daniel@danann.net ;; (it was put there by `cd 2>&1').
(forward-line -1)
;; Changed to perform `cd' in the same remote op and only (tramp-error
;; get entries starting with `filename'. Capture any `cd' v 'file-error
;; error messages. Ensure any `cd' and `echo' aliases are "tramp-sh-handle-file-name-all-completions: %s"
;; ignored. (buffer-substring (point) (point-at-eol))))
(tramp-send-command ;; For peace of mind, if buffer doesn't end in `fail'
v ;; then it should end in `ok'. If neither are in the
(if (tramp-get-remote-perl v) ;; buffer something went seriously wrong on the remote
(progn ;; side.
(tramp-maybe-send-script (unless (looking-at "^ok$")
v tramp-perl-file-name-all-completions (tramp-error
"tramp_perl_file_name_all_completions") v 'file-error
(format "tramp_perl_file_name_all_completions %s %s %d" "\
(tramp-shell-quote-argument localname)
(tramp-shell-quote-argument filename)
(if read-file-name-completion-ignore-case 1 0)))
(format (concat
"(cd %s 2>&1 && (%s -a %s 2>/dev/null"
;; `ls' with wildcard might fail with `Argument
;; list too long' error in some corner cases; if
;; `ls' fails after `cd' succeeded, chances are
;; that's the case, so let's retry without
;; wildcard. This will return "too many" entries
;; but that isn't harmful.
" || %s -a 2>/dev/null)"
" | while IFS= read f; do"
" if %s -d \"$f\" 2>/dev/null;"
" then \\echo \"$f/\"; else \\echo \"$f\"; fi; done"
" && \\echo ok) || \\echo fail")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command v)
;; When `filename' is empty, just `ls' without
;; `filename' argument is more efficient than `ls *'
;; for very large directories and might avoid the
;; `Argument list too long' error.
;;
;; With and only with wildcard, we need to add
;; `-d' to prevent `ls' from descending into
;; sub-directories.
(if (zerop (length filename))
"."
(format "-d %s*" (tramp-shell-quote-argument filename)))
(tramp-get-ls-command v)
(tramp-get-test-command v))))
;; Now grab the output.
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-max))
;; Check result code, found in last line of output.
(forward-line -1)
(if (looking-at "^fail$")
(progn
;; Grab error message from line before last line
;; (it was put there by `cd 2>&1').
(forward-line -1)
(tramp-error
v 'file-error
"tramp-sh-handle-file-name-all-completions: %s"
(buffer-substring (point) (point-at-eol))))
;; For peace of mind, if buffer doesn't end in `fail'
;; then it should end in `ok'. If neither are in the
;; buffer something went seriously wrong on the remote
;; side.
(unless (looking-at "^ok$")
(tramp-error
v 'file-error
"\
tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(tramp-shell-quote-argument localname) (buffer-string)))) (tramp-shell-quote-argument localname) (buffer-string))))
(while (zerop (forward-line -1)) (while (zerop (forward-line -1))
(push (buffer-substring (point) (point-at-eol)) result))) (push (buffer-substring (point) (point-at-eol)) result)))
result))))))
;; Because the remote op went through OK we know the
;; directory we `cd'-ed to exists.
(tramp-set-file-property v localname "file-exists-p" t)
;; Because the remote op went through OK we know every
;; file listed by `ls' exists.
(mapc (lambda (entry)
(tramp-set-file-property
v (concat localname entry) "file-exists-p" t))
result)
;; Store result in the cache.
(tramp-set-file-property
v (concat localname filename)
"file-name-all-completions" result))))))))
;; cp, mv and ln ;; cp, mv and ln
@ -2836,7 +2760,8 @@ The method used must be an out-of-band method."
(unless (unless
(string-match "color" (tramp-get-connection-property v "ls" "")) (string-match "color" (tramp-get-connection-property v "ls" ""))
(goto-char beg) (goto-char beg)
(while (re-search-forward tramp-color-escape-sequence-regexp nil t) (while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match ""))) (replace-match "")))
;; Decode the output, it could be multibyte. ;; Decode the output, it could be multibyte.
@ -2934,7 +2859,12 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sh-handle-start-file-process (name buffer program &rest args) (defun tramp-sh-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files." "Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name default-directory) nil (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let* (;; When PROGRAM matches "*sh", and the first arg is "-c", (let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; When PROGRAM matches "*sh", and the first arg is "-c",
;; it might be that the arguments exceed the command line ;; it might be that the arguments exceed the command line
;; length. Therefore, we modify the command. ;; length. Therefore, we modify the command.
(heredoc (and (stringp program) (heredoc (and (stringp program)
@ -2992,9 +2922,6 @@ the result will be a local, non-Tramp, file name."
;; `eshell' and friends. ;; `eshell' and friends.
(tramp-current-connection nil)) (tramp-current-connection nil))
(unless buffer
;; BUFFER can be nil. We use a temporary buffer.
(setq buffer (generate-new-buffer tramp-temp-buffer-name)))
(while (get-process name1) (while (get-process name1)
;; NAME must be unique as process name. ;; NAME must be unique as process name.
(setq i (1+ i) (setq i (1+ i)
@ -4030,7 +3957,7 @@ file exists and nonzero exit status otherwise."
shell) shell)
(setq shell (setq shell
(with-tramp-connection-property vec "remote-shell" (with-tramp-connection-property vec "remote-shell"
;; CCC: "root" does not exist always, see QNAP 459. ;; CCC: "root" does not exist always, see my QNAP TS-459.
;; Which check could we apply instead? ;; Which check could we apply instead?
(tramp-send-command vec "echo ~root" t) (tramp-send-command vec "echo ~root" t)
(if (or (string-match "^~root$" (buffer-string)) (if (or (string-match "^~root$" (buffer-string))
@ -4790,7 +4717,7 @@ connection if a previous connection has died for some reason."
(options (tramp-ssh-controlmaster-options vec)) (options (tramp-ssh-controlmaster-options vec))
(process-connection-type tramp-process-connection-type) (process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil) (process-adaptive-read-buffering nil)
;; There are unfortune settings for "cmdproxy" on ;; There are unfortunate settings for "cmdproxy" on
;; W32 systems. ;; W32 systems.
(process-coding-system-alist nil) (process-coding-system-alist nil)
(coding-system-for-read nil) (coding-system-for-read nil)
@ -5000,7 +4927,12 @@ function waits for output unless NOOUTPUT is set."
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
(let* (;; Initially, `tramp-end-of-output' is "#$ ". There might (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
;; be leading escape sequences, which must be ignored. ;; be leading escape sequences, which must be ignored.
(regexp (format "[^#$\n]*%s\r?$" (regexp-quote tramp-end-of-output))) ;; Busyboxes built with the EDITING_ASK_TERMINAL config
;; option send also escape sequences, which must be
;; ignored.
(regexp (format "[^#$\n]*%s\\(%s\\)?\r?$"
(regexp-quote tramp-end-of-output)
tramp-device-escape-sequence-regexp))
;; Sometimes, the commands do not return a newline but a ;; Sometimes, the commands do not return a newline but a
;; null byte before the shell prompt, for example "git ;; null byte before the shell prompt, for example "git
;; ls-files -c -z ...". ;; ls-files -c -z ...".
@ -5103,16 +5035,17 @@ Return ATTR."
(when attr (when attr
;; Remove color escape sequences from symlink. ;; Remove color escape sequences from symlink.
(when (stringp (car attr)) (when (stringp (car attr))
(while (string-match tramp-color-escape-sequence-regexp (car attr)) (while (string-match tramp-display-escape-sequence-regexp (car attr))
(setcar attr (replace-match "" nil nil (car attr))))) (setcar attr (replace-match "" nil nil (car attr)))))
;; Convert uid and gid. Use -1 as indication of unusable value. ;; Convert uid and gid. Use `tramp-unknown-id-integer' as
;; indication of unusable value.
(when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0)) (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
(setcar (nthcdr 2 attr) -1)) (setcar (nthcdr 2 attr) tramp-unknown-id-integer))
(when (and (floatp (nth 2 attr)) (when (and (floatp (nth 2 attr))
(<= (nth 2 attr) most-positive-fixnum)) (<= (nth 2 attr) most-positive-fixnum))
(setcar (nthcdr 2 attr) (round (nth 2 attr)))) (setcar (nthcdr 2 attr) (round (nth 2 attr))))
(when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0)) (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
(setcar (nthcdr 3 attr) -1)) (setcar (nthcdr 3 attr) tramp-unknown-id-integer))
(when (and (floatp (nth 3 attr)) (when (and (floatp (nth 3 attr))
(<= (nth 3 attr) most-positive-fixnum)) (<= (nth 3 attr) most-positive-fixnum))
(setcar (nthcdr 3 attr) (round (nth 3 attr)))) (setcar (nthcdr 3 attr) (round (nth 3 attr))))
@ -5556,8 +5489,10 @@ Return ATTR."
(tramp-get-remote-uid-with-python vec id-format)))))) (tramp-get-remote-uid-with-python vec id-format))))))
;; Ensure there is a valid result. ;; Ensure there is a valid result.
(cond (cond
((and (equal id-format 'integer) (not (integerp res))) -1) ((and (equal id-format 'integer) (not (integerp res)))
((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") tramp-unknown-id-integer)
((and (equal id-format 'string) (not (stringp res)))
tramp-unknown-id-string)
(t res))))) (t res)))))
(defun tramp-get-remote-gid-with-id (vec id-format) (defun tramp-get-remote-gid-with-id (vec id-format)
@ -5600,8 +5535,10 @@ Return ATTR."
(tramp-get-remote-gid-with-python vec id-format)))))) (tramp-get-remote-gid-with-python vec id-format))))))
;; Ensure there is a valid result. ;; Ensure there is a valid result.
(cond (cond
((and (equal id-format 'integer) (not (integerp res))) -1) ((and (equal id-format 'integer) (not (integerp res)))
((and (equal id-format 'string) (not (stringp res))) "UNKNOWN") tramp-unknown-id-integer)
((and (equal id-format 'string) (not (stringp res)))
tramp-unknown-id-string)
(t res))))) (t res)))))
;; Some predefined connection properties. ;; Some predefined connection properties.

37
lisp/net/tramp-smb.el
View File

@ -663,8 +663,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
result))) result)))
;; Sort them if necessary. ;; Sort them if necessary.
(unless nosort (setq result (sort result 'string-lessp))) (unless nosort (setq result (sort result 'string-lessp)))
;; Remove double entries. result))
(delete-dups result)))
(defun tramp-smb-handle-expand-file-name (name &optional dir) (defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files." "Like `expand-file-name' for Tramp files."
@ -907,17 +906,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(all-completions (all-completions
filename filename
(with-parsed-tramp-file-name directory nil (with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions" (with-tramp-file-property v localname "file-name-all-completions"
(save-match-data (save-match-data
(let ((entries (tramp-smb-get-file-entries directory))) (delete-dups
(mapcar (mapcar
(lambda (x) (lambda (x)
(list (list
(if (string-match "d" (nth 1 x)) (if (string-match "d" (nth 1 x))
(file-name-as-directory (nth 0 x)) (file-name-as-directory (nth 0 x))
(nth 0 x)))) (nth 0 x))))
entries))))))) (tramp-smb-get-file-entries directory))))))))
(defun tramp-smb-handle-file-writable-p (filename) (defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files." "Like `file-writable-p' for Tramp files."
@ -1389,16 +1388,18 @@ target of the symlink differ."
(defun tramp-smb-handle-start-file-process (name buffer program &rest args) (defun tramp-smb-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files." "Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name default-directory nil (with-parsed-tramp-file-name default-directory nil
(let ((command (mapconcat 'identity (cons program args) " ")) (let* ((buffer
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) (if buffer
(name1 name) (get-buffer-create buffer)
(i 0)) ;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
(command (mapconcat 'identity (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
(unwind-protect (unwind-protect
(save-excursion (save-excursion
(save-restriction (save-restriction
(unless buffer
;; BUFFER can be nil. We use a temporary buffer.
(setq buffer (generate-new-buffer tramp-temp-buffer-name)))
(while (get-process name1) (while (get-process name1)
;; NAME must be unique as process name. ;; NAME must be unique as process name.
(setq i (1+ i) (setq i (1+ i)

37
lisp/net/tramp.el
View File

@ -774,6 +774,12 @@ Derived from `tramp-postfix-host-format'.")
(defconst tramp-localname-regexp ".*$" (defconst tramp-localname-regexp ".*$"
"Regexp matching localnames.") "Regexp matching localnames.")
(defconst tramp-unknown-id-string "UNKNOWN"
"String used to denote an unknown user or group")
(defconst tramp-unknown-id-integer -1
"Integer used to denote an unknown user or group")
;;; File name format: ;;; File name format:
(defconst tramp-remote-file-name-spec-regexp (defconst tramp-remote-file-name-spec-regexp
@ -2861,11 +2867,21 @@ User is always nil."
(error (error
"tramp-handle-file-name-completion invoked on non-tramp directory `%s'" "tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
directory)) directory))
(try-completion (let (hits-ignored-extensions)
filename (or
(mapcar 'list (file-name-all-completions filename directory)) (try-completion
(when predicate filename (file-name-all-completions filename directory)
(lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) (lambda (x)
(when (funcall (or predicate 'identity) (expand-file-name x directory))
(not
(and
completion-ignored-extensions
(string-match
(concat (regexp-opt completion-ignored-extensions 'paren) "$") x)
;; We remember the hit.
(push x hits-ignored-extensions))))))
;; No match. So we try again for ignored files.
(try-completion filename hits-ignored-extensions))))
(defun tramp-handle-file-name-directory (file) (defun tramp-handle-file-name-directory (file)
"Like `file-name-directory' but aware of Tramp files." "Like `file-name-directory' but aware of Tramp files."
@ -3834,7 +3850,10 @@ be granted."
vec (concat "uid-" suffix) nil)) vec (concat "uid-" suffix) nil))
(remote-gid (remote-gid
(tramp-get-connection-property (tramp-get-connection-property
vec (concat "gid-" suffix) nil))) vec (concat "gid-" suffix) nil))
(unknown-id
(if (string-equal suffix "string")
tramp-unknown-id-string tramp-unknown-id-integer)))
(and (and
file-attr file-attr
(or (or
@ -3847,12 +3866,14 @@ be granted."
;; User accessible and owned by user. ;; User accessible and owned by user.
(and (and
(eq access (aref (nth 8 file-attr) offset)) (eq access (aref (nth 8 file-attr) offset))
(equal remote-uid (nth 2 file-attr))) (or (equal remote-uid (nth 2 file-attr))
(equal unknown-id (nth 2 file-attr))))
;; Group accessible and owned by user's ;; Group accessible and owned by user's
;; principal group. ;; principal group.
(and (and
(eq access (aref (nth 8 file-attr) (+ offset 3))) (eq access (aref (nth 8 file-attr) (+ offset 3)))
(equal remote-gid (nth 3 file-attr))))))))))) (or (equal remote-gid (nth 3 file-attr))
(equal unknown-id (nth 3 file-attr))))))))))))
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-local-host-p (vec) (defun tramp-local-host-p (vec)

64
lisp/progmodes/cc-engine.el
View File

@ -229,8 +229,12 @@
;; The starting position from where we determined `c-macro-cache'. ;; The starting position from where we determined `c-macro-cache'.
(defvar c-macro-cache-syntactic nil) (defvar c-macro-cache-syntactic nil)
(make-variable-buffer-local 'c-macro-cache-syntactic) (make-variable-buffer-local 'c-macro-cache-syntactic)
;; non-nil iff `c-macro-cache' has both elements set AND the cdr is at a ;; Either nil, or the syntactic end of the macro currently represented by
;; syntactic end of macro, not merely an apparent one. ;; `c-macro-cache'.
(defvar c-macro-cache-no-comment nil)
(make-variable-buffer-local 'c-macro-cache-no-comment)
;; Either nil, or the last character of the macro currently represented by
;; `c-macro-cache' which isn't in a comment. */
(defun c-invalidate-macro-cache (beg end) (defun c-invalidate-macro-cache (beg end)
;; Called from a before-change function. If the change region is before or ;; Called from a before-change function. If the change region is before or
@ -242,12 +246,14 @@
((< beg (car c-macro-cache)) ((< beg (car c-macro-cache))
(setq c-macro-cache nil (setq c-macro-cache nil
c-macro-cache-start-pos nil c-macro-cache-start-pos nil
c-macro-cache-syntactic nil)) c-macro-cache-syntactic nil
c-macro-cache-no-comment nil))
((and (cdr c-macro-cache) ((and (cdr c-macro-cache)
(< beg (cdr c-macro-cache))) (< beg (cdr c-macro-cache)))
(setcdr c-macro-cache nil) (setcdr c-macro-cache nil)
(setq c-macro-cache-start-pos beg (setq c-macro-cache-start-pos beg
c-macro-cache-syntactic nil)))) c-macro-cache-syntactic nil
c-macro-cache-no-comment nil))))
(defun c-macro-is-genuine-p () (defun c-macro-is-genuine-p ()
;; Check that the ostensible CPP construct at point is a real one. In ;; 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."
t)) t))
(setq c-macro-cache nil (setq c-macro-cache nil
c-macro-cache-start-pos nil c-macro-cache-start-pos nil
c-macro-cache-syntactic nil) c-macro-cache-syntactic nil
c-macro-cache-no-comment nil)
(save-restriction (save-restriction
(if lim (narrow-to-region lim (point-max))) (if lim (narrow-to-region lim (point-max)))
@ -323,7 +330,8 @@ comment at the start of cc-engine.el for more info."
(>= (point) (car c-macro-cache))) (>= (point) (car c-macro-cache)))
(setq c-macro-cache nil (setq c-macro-cache nil
c-macro-cache-start-pos nil c-macro-cache-start-pos nil
c-macro-cache-syntactic nil)) c-macro-cache-syntactic nil
c-macro-cache-no-comment nil))
(while (progn (while (progn
(end-of-line) (end-of-line)
(when (and (eq (char-before) ?\\) (when (and (eq (char-before) ?\\)
@ -347,14 +355,38 @@ comment at the start of cc-engine.el for more info."
(let* ((here (point)) (let* ((here (point))
(there (progn (c-end-of-macro) (point))) (there (progn (c-end-of-macro) (point)))
s) s)
(unless c-macro-cache-syntactic (if c-macro-cache-syntactic
(goto-char c-macro-cache-syntactic)
(setq s (parse-partial-sexp here there)) (setq s (parse-partial-sexp here there))
(while (and (or (nth 3 s) ; in a string (while (and (or (nth 3 s) ; in a string
(nth 4 s)) ; in a comment (maybe at end of line comment) (nth 4 s)) ; in a comment (maybe at end of line comment)
(> there here)) ; No infinite loops, please. (> there here)) ; No infinite loops, please.
(setq there (1- (nth 8 s))) (setq there (1- (nth 8 s)))
(setq s (parse-partial-sexp here there))) (setq s (parse-partial-sexp here there)))
(setq c-macro-cache-syntactic (car c-macro-cache))) (setq c-macro-cache-syntactic (point)))
(point)))
(defun c-no-comment-end-of-macro ()
;; Go to the end of a CPP directive, or a pos just before which isn't in a
;; comment. For this purpose, open strings are ignored.
;;
;; This function must only be called from the beginning of a CPP construct.
;;
;; Note that this function might do hidden buffer changes. See the comment
;; at the start of cc-engine.el for more info.
(let* ((here (point))
(there (progn (c-end-of-macro) (point)))
s)
(if c-macro-cache-no-comment
(goto-char c-macro-cache-no-comment)
(setq s (parse-partial-sexp here there))
(while (and (nth 3 s) ; in a string
(> there here)) ; No infinite loops, please.
(setq here (1+ (nth 8 s)))
(setq s (parse-partial-sexp here there)))
(when (nth 4 s)
(goto-char (1- (nth 8 s))))
(setq c-macro-cache-no-comment (point)))
(point))) (point)))
(defun c-forward-over-cpp-define-id () (defun c-forward-over-cpp-define-id ()
@ -8899,6 +8931,22 @@ comment at the start of cc-engine.el for more info."
(c-syntactic-skip-backward c-block-prefix-charset limit t) (c-syntactic-skip-backward c-block-prefix-charset limit t)
(eq (char-before) ?>)))))) (eq (char-before) ?>))))))
;; Skip back over noise clauses.
(while (and
c-opt-cpp-prefix
(eq (char-before) ?\))
(let ((after-paren (point)))
(if (and (c-go-list-backward)
(progn (c-backward-syntactic-ws)
(c-simple-skip-symbol-backward))
(or (looking-at c-paren-nontype-key)
(looking-at c-noise-macro-with-parens-name-re)))
(progn
(c-syntactic-skip-backward c-block-prefix-charset limit t)
t)
(goto-char after-paren)
nil))))
;; Note: Can't get bogus hits inside template arglists below since they ;; Note: Can't get bogus hits inside template arglists below since they
;; have gotten paren syntax above. ;; have gotten paren syntax above.
(when (and (when (and

13
lisp/progmodes/cc-langs.el
View File

@ -476,7 +476,8 @@ so that all identifiers are recognized as words.")
c++ '(c-extend-region-for-CPP c++ '(c-extend-region-for-CPP
c-before-change-check-<>-operators c-before-change-check-<>-operators
c-invalidate-macro-cache) c-invalidate-macro-cache)
(c objc) '(c-extend-region-for-CPP c-invalidate-macro-cache) (c objc) '(c-extend-region-for-CPP
c-invalidate-macro-cache)
;; java 'c-before-change-check-<>-operators ;; java 'c-before-change-check-<>-operators
awk 'c-awk-record-region-clear-NL) awk 'c-awk-record-region-clear-NL)
(c-lang-defvar c-get-state-before-change-functions (c-lang-defvar c-get-state-before-change-functions
@ -505,9 +506,11 @@ parameters \(point-min) and \(point-max).")
;; For documentation see the following c-lang-defvar of the same name. ;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function. ;; The value here may be a list of functions or a single function.
t 'c-change-expand-fl-region t 'c-change-expand-fl-region
(c objc) '(c-neutralize-syntax-in-and-mark-CPP (c objc) '(c-extend-font-lock-region-for-macros
c-neutralize-syntax-in-and-mark-CPP
c-change-expand-fl-region) c-change-expand-fl-region)
c++ '(c-neutralize-syntax-in-and-mark-CPP c++ '(c-extend-font-lock-region-for-macros
c-neutralize-syntax-in-and-mark-CPP
c-restore-<>-properties c-restore-<>-properties
c-change-expand-fl-region) c-change-expand-fl-region)
java '(c-restore-<>-properties java '(c-restore-<>-properties
@ -2264,6 +2267,10 @@ contain type identifiers."
;; MSVC extension. ;; MSVC extension.
"__declspec")) "__declspec"))
(c-lang-defconst c-paren-nontype-key
t (c-make-keywords-re t (c-lang-const c-paren-nontype-kwds)))
(c-lang-defvar c-paren-nontype-key (c-lang-const c-paren-nontype-key))
(c-lang-defconst c-paren-type-kwds (c-lang-defconst c-paren-type-kwds
"Keywords that may be followed by a parenthesis expression containing "Keywords that may be followed by a parenthesis expression containing
type identifiers separated by arbitrary tokens." type identifiers separated by arbitrary tokens."

101
lisp/progmodes/cc-mode.el
View File

@ -865,14 +865,6 @@ Note that the style variables are always made local to the buffer."
;;; Change hooks, linking with Font Lock and electric-indent-mode. ;;; Change hooks, linking with Font Lock and electric-indent-mode.
;; Buffer local variables recording Beginning/End-of-Macro position before a
;; change, when a macro straddles, respectively, the BEG or END (or both) of
;; the change region. Otherwise these have the values BEG/END.
(defvar c-old-BOM 0)
(make-variable-buffer-local 'c-old-BOM)
(defvar c-old-EOM 0)
(make-variable-buffer-local 'c-old-EOM)
(defun c-called-from-text-property-change-p () (defun c-called-from-text-property-change-p ()
;; Is the primitive which invoked `before-change-functions' or ;; Is the primitive which invoked `before-change-functions' or
;; `after-change-functions' one which merely changes text properties? This ;; `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."
'(put-text-property remove-list-of-text-properties))) '(put-text-property remove-list-of-text-properties)))
(defun c-extend-region-for-CPP (beg end) (defun c-extend-region-for-CPP (beg end)
;; Set c-old-BOM or c-old-EOM respectively to BEG, END, each extended to the ;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of
;; beginning/end of any preprocessor construct they may be in. ;; any preprocessor construct they may be in.
;; ;;
;; Point is undefined both before and after this function call; the buffer ;; Point is undefined both before and after this function call; the buffer
;; has already been widened, and match-data saved. The return value is ;; 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."
;; This function is in the C/C++/ObjC values of ;; This function is in the C/C++/ObjC values of
;; `c-get-state-before-change-functions' and is called exclusively as a ;; `c-get-state-before-change-functions' and is called exclusively as a
;; before change function. ;; before change function.
(goto-char beg) (goto-char c-new-BEG)
(c-beginning-of-macro) (c-beginning-of-macro)
(setq c-old-BOM (point)) (setq c-new-BEG (point))
(goto-char end) (goto-char c-new-END)
(when (c-beginning-of-macro) (when (c-beginning-of-macro)
(c-end-of-macro) (c-end-of-macro)
(or (eobp) (forward-char))) ; Over the terminating NL which may be marked (or (eobp) (forward-char))) ; Over the terminating NL which may be marked
; with a c-cpp-delimiter category property ; with a c-cpp-delimiter category property
(setq c-old-EOM (point))) (setq c-new-END (point)))
(defun c-extend-font-lock-region-for-macros (begg endd &optional old-len) (defun c-extend-font-lock-region-for-macros (begg endd old-len)
;; Extend the region (BEGG ENDD) to cover all (possibly changed) ;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed)
;; preprocessor macros; return the cons (new-BEG . new-END). OLD-LEN should ;; preprocessor macros; The return value has no significance.
;; be either the old length parameter when called from an
;; after-change-function, or nil otherwise. This defun uses the variables
;; c-old-BOM, c-new-BOM.
;; ;;
;; Point is undefined on both entry and exit to this function. The buffer ;; Point is undefined on both entry and exit to this function. The buffer
;; will have been widened on entry. ;; will have been widened on entry.
(let (limits new-beg new-end) ;;
(goto-char c-old-BOM) ; already set to old start of macro or begg. ;; This function is in the C/C++/ObjC value of `c-before-font-lock-functions'.
(setq new-beg (goto-char endd)
(min begg (if (c-beginning-of-macro)
(if (setq limits (c-state-literal-at (point))) (c-end-of-macro))
(cdr limits) ; go forward out of any string or comment. (setq c-new-END (max endd c-new-END (point)))
(point)))) ;; Determine the region, (c-new-BEG c-new-END), which will get font
;; locked. This restricts the region should there be long macros.
(goto-char endd) (setq c-new-BEG (max c-new-BEG (c-determine-limit 500 begg))
(if (setq limits (c-state-literal-at (point))) c-new-END (min c-new-END (c-determine-+ve-limit 500 endd))))
(goto-char (car limits))) ; go backward out of any string or comment.
(if (c-beginning-of-macro)
(c-end-of-macro))
(setq new-end (max endd
(if old-len
(+ (- c-old-EOM old-len) (- endd begg))
c-old-EOM)
(point)))
(cons new-beg new-end)))
(defun c-neutralize-CPP-line (beg end) (defun c-neutralize-CPP-line (beg end)
;; BEG and END bound a region, typically a preprocessor line. Put a ;; 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."
(t nil))))))) (t nil)))))))
(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len) (defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len)
;; (i) Extend the font lock region to cover all changed preprocessor ;; (i) "Neutralize" every preprocessor line wholly or partially in the
;; regions; it does this by setting the variables `c-new-BEG' and ;; changed region. "Restore" lines which were CPP lines before the change
;; `c-new-END' to the new boundaries. ;; and are no longer so.
;; ;;
;; (ii) "Neutralize" every preprocessor line wholly or partially in the ;; (ii) Mark each CPP construct by placing a `category' property value
;; extended changed region. "Restore" lines which were CPP lines before the
;; change and are no longer so; these can be located from the Buffer local
;; variables `c-old-BOM' and `c-old-EOM'.
;;
;; (iii) Mark every CPP construct by placing a `category' property value
;; `c-cpp-delimiter' at its start and end. The marked characters are the ;; `c-cpp-delimiter' at its start and end. The marked characters are the
;; opening # and usually the terminating EOL, but sometimes the character ;; opening # and usually the terminating EOL, but sometimes the character
;; before a comment/string delimiter. ;; before a comment delimiter.
;; ;;
;; That is, set syntax-table properties on characters that would otherwise ;; That is, set syntax-table properties on characters that would otherwise
;; interact syntactically with those outside the CPP line(s). ;; 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."
;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!! ;; Note: SPEED _MATTERS_ IN THIS FUNCTION!!!
;; ;;
;; This function might make hidden buffer changes. ;; This function might make hidden buffer changes.
(c-save-buffer-state (new-bounds) (c-save-buffer-state (limits )
;; First determine the region, (c-new-BEG c-new-END), which will get font ;; Clear 'syntax-table properties "punctuation":
;; locked. It might need "neutralizing". This region may not start
;; inside a string, comment, or macro.
(setq new-bounds (c-extend-font-lock-region-for-macros
c-new-BEG c-new-END old-len))
(setq c-new-BEG (max (car new-bounds) (c-determine-limit 500 begg))
c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd)))
;; Clear all old relevant properties.
(c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1)) (c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1))
;; CPP "comment" markers: ;; CPP "comment" markers:
@ -1011,6 +979,8 @@ Note that the style variables are always made local to the buffer."
;; Add needed properties to each CPP construct in the region. ;; Add needed properties to each CPP construct in the region.
(goto-char c-new-BEG) (goto-char c-new-BEG)
(if (setq limits (c-literal-limits)) ; Go past any literal.
(goto-char (cdr limits)))
(skip-chars-backward " \t") (skip-chars-backward " \t")
(let ((pps-position (point)) pps-state mbeg) (let ((pps-position (point)) pps-state mbeg)
(while (and (< (point) c-new-END) (while (and (< (point) c-new-END)
@ -1030,7 +1000,7 @@ Note that the style variables are always made local to the buffer."
(nth 4 pps-state)))) ; in a comment? (nth 4 pps-state)))) ; in a comment?
(goto-char (match-beginning 1)) (goto-char (match-beginning 1))
(setq mbeg (point)) (setq mbeg (point))
(if (> (c-syntactic-end-of-macro) mbeg) (if (> (c-no-comment-end-of-macro) mbeg)
(progn (progn
(c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties
(if (eval-when-compile (if (eval-when-compile
@ -1256,10 +1226,15 @@ Note that the style variables are always made local to the buffer."
;; ;;
;; This is called from an after-change-function, but the parameters BEG END ;; This is called from an after-change-function, but the parameters BEG END
;; and OLD-LEN are not used. ;; and OLD-LEN are not used.
(if font-lock-mode (if font-lock-mode
(setq c-new-BEG (setq c-new-BEG
(or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
c-new-END (c-point 'bonl c-new-END)))) c-new-END
(save-excursion
(goto-char c-new-END)
(if (bolp)
(point)
(c-point 'bonl c-new-END))))))
(defun c-context-expand-fl-region (beg end) (defun c-context-expand-fl-region (beg end)
;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a

1
lisp/recentf.el
View File

@ -1064,7 +1064,6 @@ Go to the beginning of buffer if not found."
(define-key km "q" 'recentf-cancel-dialog) (define-key km "q" 'recentf-cancel-dialog)
(define-key km "n" 'next-line) (define-key km "n" 'next-line)
(define-key km "p" 'previous-line) (define-key km "p" 'previous-line)
(define-key km [follow-link] "\C-m")
km) km)
"Keymap used in recentf dialogs.") "Keymap used in recentf dialogs.")

8
lisp/simple.el
View File

@ -6054,7 +6054,13 @@ If NOERROR, don't signal an error if we can't move that many lines."
(setq temporary-goal-column (setq temporary-goal-column
(cons (/ (float x-pos) (cons (/ (float x-pos)
(frame-char-width)) (frame-char-width))
hscroll)))))) hscroll)))
(executing-kbd-macro
;; When we move beyond the first/last character visible in
;; the window, posn-at-point will return nil, so we need to
;; approximate the goal column as below.
(setq temporary-goal-column
(mod (current-column) (window-text-width)))))))
(if target-hscroll (if target-hscroll
(set-window-hscroll (selected-window) target-hscroll)) (set-window-hscroll (selected-window) target-hscroll))
;; vertical-motion can move more than it was asked to if it moves ;; vertical-motion can move more than it was asked to if it moves

8
lisp/wid-edit.el
View File

@ -1789,7 +1789,13 @@ If END is omitted, it defaults to the length of LIST."
"An embedded link." "An embedded link."
:button-prefix 'widget-link-prefix :button-prefix 'widget-link-prefix
:button-suffix 'widget-link-suffix :button-suffix 'widget-link-suffix
:follow-link 'mouse-face ;; The `follow-link' property should only be used in those contexts where the
;; mouse-1 event normally doesn't follow the link, yet the `link' widget
;; seems to almost always be used in contexts where (down-)mouse-1 is bound
;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is
;; not necessary (and can even be harmful). So let's not add a :follow-link
;; by default. See (bug#22434).
;; :follow-link 'mouse-face
:help-echo "Follow the link." :help-echo "Follow the link."
:format "%[%t%]") :format "%[%t%]")

1
m4/secure_getenv.m4
View File

@ -22,4 +22,5 @@ AC_DEFUN([gl_PREREQ_SECURE_GETENV], [
if test $ac_cv_func___secure_getenv = no; then if test $ac_cv_func___secure_getenv = no; then
AC_CHECK_FUNCS([issetugid]) AC_CHECK_FUNCS([issetugid])
fi fi
AC_CHECK_FUNCS_ONCE([getuid geteuid getgid getegid])
]) ])

6
src/buffer.c
View File

@ -3552,8 +3552,8 @@ void
fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
{ {
Lisp_Object overlay; Lisp_Object overlay;
struct Lisp_Overlay *before_list IF_LINT (= NULL); struct Lisp_Overlay *before_list;
struct Lisp_Overlay *after_list IF_LINT (= NULL); struct Lisp_Overlay *after_list;
/* These are either nil, indicating that before_list or after_list /* These are either nil, indicating that before_list or after_list
should be assigned, or the cons cell the cdr of which should be should be assigned, or the cons cell the cdr of which should be
assigned. */ assigned. */
@ -3700,7 +3700,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
/* If parent is nil, replace overlays_before; otherwise, parent->next. */ /* If parent is nil, replace overlays_before; otherwise, parent->next. */
struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair; struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
Lisp_Object tem; Lisp_Object tem;
ptrdiff_t end IF_LINT (= 0); ptrdiff_t end;
/* After the insertion, the several overlays may be in incorrect /* After the insertion, the several overlays may be in incorrect
order. The possibility is that, in the list `overlays_before', order. The possibility is that, in the list `overlays_before',

2
src/casefiddle.c
View File

@ -196,7 +196,7 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
ptrdiff_t start_byte; ptrdiff_t start_byte;
/* Position of first and last changes. */ /* Position of first and last changes. */
ptrdiff_t first = -1, last IF_LINT (= 0); ptrdiff_t first = -1, last;
ptrdiff_t opoint = PT; ptrdiff_t opoint = PT;
ptrdiff_t opoint_byte = PT_BYTE; ptrdiff_t opoint_byte = PT_BYTE;

2
src/charset.c
View File

@ -240,7 +240,7 @@ struct charset_map_entries
static void static void
load_charset_map (struct charset *charset, struct charset_map_entries *entries, int n_entries, int control_flag) load_charset_map (struct charset *charset, struct charset_map_entries *entries, int n_entries, int control_flag)
{ {
Lisp_Object vec IF_LINT (= Qnil), table IF_LINT (= Qnil); Lisp_Object vec, table IF_LINT (= Qnil);
unsigned max_code = CHARSET_MAX_CODE (charset); unsigned max_code = CHARSET_MAX_CODE (charset);
bool ascii_compatible_p = charset->ascii_compatible_p; bool ascii_compatible_p = charset->ascii_compatible_p;
int min_char, max_char, nonascii_min_char; int min_char, max_char, nonascii_min_char;

8
src/coding.c
View File

@ -8008,12 +8008,12 @@ decode_coding_object (struct coding_system *coding,
Lisp_Object dst_object) Lisp_Object dst_object)
{ {
ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count = SPECPDL_INDEX ();
unsigned char *destination IF_LINT (= NULL); unsigned char *destination;
ptrdiff_t dst_bytes IF_LINT (= 0); ptrdiff_t dst_bytes;
ptrdiff_t chars = to - from; ptrdiff_t chars = to - from;
ptrdiff_t bytes = to_byte - from_byte; ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs; Lisp_Object attrs;
ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0); ptrdiff_t saved_pt = -1, saved_pt_byte;
bool need_marker_adjustment = 0; bool need_marker_adjustment = 0;
Lisp_Object old_deactivate_mark; Lisp_Object old_deactivate_mark;
@ -8191,7 +8191,7 @@ encode_coding_object (struct coding_system *coding,
ptrdiff_t chars = to - from; ptrdiff_t chars = to - from;
ptrdiff_t bytes = to_byte - from_byte; ptrdiff_t bytes = to_byte - from_byte;
Lisp_Object attrs; Lisp_Object attrs;
ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0); ptrdiff_t saved_pt = -1, saved_pt_byte;
bool need_marker_adjustment = 0; bool need_marker_adjustment = 0;
bool kill_src_buffer = 0; bool kill_src_buffer = 0;
Lisp_Object old_deactivate_mark; Lisp_Object old_deactivate_mark;

5
src/conf_post.h
View File

@ -181,7 +181,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */
#endif #endif
#ifdef CYGWIN #ifdef CYGWIN
#define SYSTEM_PURESIZE_EXTRA 10000 #define SYSTEM_PURESIZE_EXTRA 50000
#endif #endif
#if defined HAVE_NTGUI && !defined DebPrint #if defined HAVE_NTGUI && !defined DebPrint
@ -343,9 +343,8 @@ extern int emacs_setenv_TZ (char const *);
# define FLEXIBLE_ARRAY_MEMBER # define FLEXIBLE_ARRAY_MEMBER
#endif #endif
/* Use this to suppress gcc's `...may be used before initialized' warnings. */
#ifdef lint
/* Use CODE only if lint checking is in effect. */ /* Use CODE only if lint checking is in effect. */
#if defined GCC_LINT || defined lint
# define IF_LINT(Code) Code # define IF_LINT(Code) Code
#else #else
# define IF_LINT(Code) /* empty */ # define IF_LINT(Code) /* empty */

4
src/cygw32.c
View File

@ -31,7 +31,7 @@ fchdir_unwind (int dir_fd)
} }
static void static void
chdir_to_default_directory () chdir_to_default_directory (void)
{ {
Lisp_Object new_cwd; Lisp_Object new_cwd;
int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0); int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);
@ -46,7 +46,7 @@ chdir_to_default_directory ()
if (!STRINGP (new_cwd)) if (!STRINGP (new_cwd))
new_cwd = build_string ("/"); new_cwd = build_string ("/");
if (chdir (SDATA (ENCODE_FILE (new_cwd)))) if (chdir (SSDATA (ENCODE_FILE (new_cwd))))
error ("could not chdir: %s", strerror (errno)); error ("could not chdir: %s", strerror (errno));
} }

12
src/data.c
View File

@ -1614,8 +1614,8 @@ The function `default-value' gets the default value and `set-default' sets it.
{ {
struct Lisp_Symbol *sym; struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL; struct Lisp_Buffer_Local_Value *blv = NULL;
union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); union Lisp_Val_Fwd valcontents;
bool forwarded IF_LINT (= 0); bool forwarded;
CHECK_SYMBOL (variable); CHECK_SYMBOL (variable);
sym = XSYMBOL (variable); sym = XSYMBOL (variable);
@ -1692,8 +1692,8 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
(Lisp_Object variable) (Lisp_Object variable)
{ {
Lisp_Object tem; Lisp_Object tem;
bool forwarded IF_LINT (= 0); bool forwarded;
union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); union Lisp_Val_Fwd valcontents;
struct Lisp_Symbol *sym; struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL; struct Lisp_Buffer_Local_Value *blv = NULL;
@ -2458,7 +2458,7 @@ uintmax_t
cons_to_unsigned (Lisp_Object c, uintmax_t max) cons_to_unsigned (Lisp_Object c, uintmax_t max)
{ {
bool valid = 0; bool valid = 0;
uintmax_t val IF_LINT (= 0); uintmax_t val;
if (INTEGERP (c)) if (INTEGERP (c))
{ {
valid = 0 <= XINT (c); valid = 0 <= XINT (c);
@ -2511,7 +2511,7 @@ intmax_t
cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{ {
bool valid = 0; bool valid = 0;
intmax_t val IF_LINT (= 0); intmax_t val;
if (INTEGERP (c)) if (INTEGERP (c))
{ {
val = XINT (c); val = XINT (c);

4
src/frame.c
View File

@ -609,7 +609,7 @@ make_frame (bool mini_p)
{ {
Lisp_Object frame; Lisp_Object frame;
struct frame *f; struct frame *f;
struct window *rw, *mw IF_LINT (= NULL); struct window *rw, *mw;
Lisp_Object root_window; Lisp_Object root_window;
Lisp_Object mini_window; Lisp_Object mini_window;
@ -3089,7 +3089,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
/* If both of these parameters are present, it's more efficient to /* If both of these parameters are present, it's more efficient to
set them both at once. So we wait until we've looked at the set them both at once. So we wait until we've looked at the
entire list before we set them. */ entire list before we set them. */
int width IF_LINT (= 0), height IF_LINT (= 0); int width, height;
bool width_change = false, height_change = false; bool width_change = false, height_change = false;
/* Same here. */ /* Same here. */

20
src/image.c
View File

@ -5895,12 +5895,13 @@ static bool
png_load_body (struct frame *f, struct image *img, struct png_load_context *c) png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
{ {
Lisp_Object specified_file; Lisp_Object specified_file;
Lisp_Object specified_data; /* IF_LINT (volatile) works around GCC bug 54561. */
Lisp_Object IF_LINT (volatile) specified_data;
FILE * IF_LINT (volatile) fp = NULL;
int x, y; int x, y;
ptrdiff_t i; ptrdiff_t i;
png_struct *png_ptr; png_struct *png_ptr;
png_info *info_ptr = NULL, *end_info = NULL; png_info *info_ptr = NULL, *end_info = NULL;
FILE *fp = NULL;
png_byte sig[8]; png_byte sig[8];
png_byte *pixels = NULL; png_byte *pixels = NULL;
png_byte **rows = NULL; png_byte **rows = NULL;
@ -5922,7 +5923,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
/* Find out what file to load. */ /* Find out what file to load. */
specified_file = image_spec_value (img->spec, QCfile, NULL); specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL);
IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data);
if (NILP (specified_data)) if (NILP (specified_data))
{ {
@ -6018,10 +6018,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
return 0; return 0;
} }
/* Silence a bogus diagnostic; see GCC bug 54561. */
IF_LINT (fp = c->fp);
IF_LINT (specified_data = specified_data_volatile);
/* Read image info. */ /* Read image info. */
if (!NILP (specified_data)) if (!NILP (specified_data))
png_set_read_fn (png_ptr, &tbr, png_read_from_memory); png_set_read_fn (png_ptr, &tbr, png_read_from_memory);
@ -6672,9 +6668,9 @@ jpeg_load_body (struct frame *f, struct image *img,
struct my_jpeg_error_mgr *mgr) struct my_jpeg_error_mgr *mgr)
{ {
Lisp_Object specified_file; Lisp_Object specified_file;
Lisp_Object specified_data; /* IF_LINT (volatile) works around GCC bug 54561. */
/* The 'volatile' silences a bogus diagnostic; see GCC bug 54561. */ Lisp_Object IF_LINT (volatile) specified_data;
FILE * IF_LINT (volatile) fp = NULL; FILE *volatile fp = NULL;
JSAMPARRAY buffer; JSAMPARRAY buffer;
int row_stride, x, y; int row_stride, x, y;
unsigned long *colors; unsigned long *colors;
@ -6687,7 +6683,6 @@ jpeg_load_body (struct frame *f, struct image *img,
/* Open the JPEG file. */ /* Open the JPEG file. */
specified_file = image_spec_value (img->spec, QCfile, NULL); specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL);
IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data);
if (NILP (specified_data)) if (NILP (specified_data))
{ {
@ -6751,9 +6746,6 @@ jpeg_load_body (struct frame *f, struct image *img,
return 0; return 0;
} }
/* Silence a bogus diagnostic; see GCC bug 54561. */
IF_LINT (specified_data = specified_data_volatile);
/* Create the JPEG decompression object. Let it read from fp. /* Create the JPEG decompression object. Let it read from fp.
Read the JPEG image header. */ Read the JPEG image header. */
jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo); jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo);

15
src/keyboard.c
View File

@ -2122,7 +2122,7 @@ read_event_from_main_queue (struct timespec *end_time,
{ {
Lisp_Object c = Qnil; Lisp_Object c = Qnil;
sys_jmp_buf save_jump; sys_jmp_buf save_jump;
KBOARD *kb IF_LINT (= NULL); KBOARD *kb;
start: start:
@ -2280,11 +2280,6 @@ read_decoded_event_from_main_queue (struct timespec *end_time,
} }
} }
#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
# pragma GCC diagnostic push
# pragma GCC diagnostic ignored "-Wclobbered"
#endif
/* Read a character from the keyboard; call the redisplay if needed. */ /* Read a character from the keyboard; call the redisplay if needed. */
/* commandflag 0 means do not autosave, but do redisplay. /* commandflag 0 means do not autosave, but do redisplay.
-1 means do not redisplay, but do autosave. -1 means do not redisplay, but do autosave.
@ -2317,7 +2312,9 @@ read_char (int commandflag, Lisp_Object map,
Lisp_Object prev_event, Lisp_Object prev_event,
bool *used_mouse_menu, struct timespec *end_time) bool *used_mouse_menu, struct timespec *end_time)
{ {
Lisp_Object c; /* IF_LINT (volatile) works around GCC bug 54561. */
Lisp_Object IF_LINT (volatile) c;
ptrdiff_t jmpcount; ptrdiff_t jmpcount;
sys_jmp_buf local_getcjmp; sys_jmp_buf local_getcjmp;
sys_jmp_buf save_jump; sys_jmp_buf save_jump;
@ -3125,10 +3122,6 @@ read_char (int commandflag, Lisp_Object map,
return c; return c;
} }
#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
# pragma GCC diagnostic pop
#endif
/* Record a key that came from a mouse menu. /* Record a key that came from a mouse menu.
Record it for echoing, for this-command-keys, and so on. */ Record it for echoing, for this-command-keys, and so on. */

13
src/regex.c
View File

@ -1197,13 +1197,6 @@ print_double_string (re_char *where, re_char *string1, ssize_t size1,
#endif /* not DEBUG */ #endif /* not DEBUG */
/* Use this to suppress gcc's `...may be used before initialized' warnings. */
#ifdef lint
# define IF_LINT(Code) Code
#else
# define IF_LINT(Code) /* empty */
#endif
/* Set by `re_set_syntax' to the current regexp syntax to recognize. Can /* Set by `re_set_syntax' to the current regexp syntax to recognize. Can
also be assigned to arbitrarily: each pattern buffer stores its own also be assigned to arbitrarily: each pattern buffer stores its own
syntax, so it can be changed between regex compilations. */ 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,
/* These hold the values of p, pattern, and pend from the main /* These hold the values of p, pattern, and pend from the main
pattern when we have pushed into a subpattern. */ pattern when we have pushed into a subpattern. */
re_char *main_p IF_LINT (= NULL); re_char *main_p;
re_char *main_pattern IF_LINT (= NULL); re_char *main_pattern;
re_char *main_pend IF_LINT (= NULL); re_char *main_pend;
#ifdef DEBUG #ifdef DEBUG
debug++; debug++;

2
src/syntax.c
View File

@ -708,7 +708,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
ptrdiff_t comment_end = from; ptrdiff_t comment_end = from;
ptrdiff_t comment_end_byte = from_byte; ptrdiff_t comment_end_byte = from_byte;
ptrdiff_t comstart_pos = 0; ptrdiff_t comstart_pos = 0;
ptrdiff_t comstart_byte IF_LINT (= 0); ptrdiff_t comstart_byte;
/* Place where the containing defun starts, /* Place where the containing defun starts,
or 0 if we didn't come across it yet. */ or 0 if we didn't come across it yet. */
ptrdiff_t defun_start = 0; ptrdiff_t defun_start = 0;

6
src/unexcw.c
View File

@ -147,7 +147,7 @@ fixup_executable (int fd)
assert (ret == my_edata - (char *) start_address); assert (ret == my_edata - (char *) start_address);
++found_data; ++found_data;
if (debug_unexcw) if (debug_unexcw)
printf (" .data, mem start %#lx mem length %d\n", printf (" .data, mem start %#lx mem length %td\n",
start_address, my_edata - (char *) start_address); start_address, my_edata - (char *) start_address);
if (debug_unexcw) if (debug_unexcw)
printf (" .data, file start %d file length %d\n", printf (" .data, file start %d file length %d\n",
@ -213,7 +213,7 @@ fixup_executable (int fd)
sizeof (exe_header->section_header[i])); sizeof (exe_header->section_header[i]));
assert (ret == sizeof (exe_header->section_header[i])); assert (ret == sizeof (exe_header->section_header[i]));
if (debug_unexcw) if (debug_unexcw)
printf (" seek to %ld, write %d\n", printf (" seek to %ld, write %zu\n",
(long) ((char *) &exe_header->section_header[i] - (long) ((char *) &exe_header->section_header[i] -
(char *) exe_header), (char *) exe_header),
sizeof (exe_header->section_header[i])); sizeof (exe_header->section_header[i]));
@ -228,7 +228,7 @@ fixup_executable (int fd)
my_endbss - (char *) start_address); my_endbss - (char *) start_address);
assert (ret == (my_endbss - (char *) start_address)); assert (ret == (my_endbss - (char *) start_address));
if (debug_unexcw) if (debug_unexcw)
printf (" .bss, mem start %#lx mem length %d\n", printf (" .bss, mem start %#lx mem length %td\n",
start_address, my_endbss - (char *) start_address); start_address, my_endbss - (char *) start_address);
if (debug_unexcw) if (debug_unexcw)
printf (" .bss, file start %d file length %d\n", printf (" .bss, file start %d file length %d\n",

2
src/window.c
View File

@ -5693,7 +5693,7 @@ and redisplay normally--don't erase and redraw the frame. */)
struct buffer *buf = XBUFFER (w->contents); struct buffer *buf = XBUFFER (w->contents);
bool center_p = false; bool center_p = false;
ptrdiff_t charpos, bytepos; ptrdiff_t charpos, bytepos;
EMACS_INT iarg IF_LINT (= 0); EMACS_INT iarg;
int this_scroll_margin; int this_scroll_margin;
if (buf != current_buffer) if (buf != current_buffer)

13
src/xdisp.c
View File

@ -27342,18 +27342,21 @@ x_produce_glyphs (struct it *it)
int leftmost, rightmost, lowest, highest; int leftmost, rightmost, lowest, highest;
int lbearing, rbearing; int lbearing, rbearing;
int i, width, ascent, descent; int i, width, ascent, descent;
int c IF_LINT (= 0); /* cmp->glyph_len can't be zero; see Bug#8512 */ int c;
XChar2b char2b; XChar2b char2b;
struct font_metrics *pcm; struct font_metrics *pcm;
ptrdiff_t pos; ptrdiff_t pos;
for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--) eassume (0 < glyph_len); /* See Bug#8512. */
if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t') do
break; c = COMPOSITION_GLYPH (cmp, --glyph_len);
while (c == '\t' && 0 < glyph_len);
bool right_padded = glyph_len < cmp->glyph_len; bool right_padded = glyph_len < cmp->glyph_len;
for (i = 0; i < glyph_len; i++) for (i = 0; i < glyph_len; i++)
{ {
if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t') c = COMPOSITION_GLYPH (cmp, i);
if (c != '\t')
break; break;
cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0; cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0;
} }

2
src/xfaces.c
View File

@ -1519,7 +1519,7 @@ the WIDTH times as wide as FACE on FRAME. */)
Lisp_Object maximum, Lisp_Object width) Lisp_Object maximum, Lisp_Object width)
{ {
struct frame *f; struct frame *f;
int size, avgwidth IF_LINT (= 0); int size, avgwidth;
check_window_system (NULL); check_window_system (NULL);
CHECK_STRING (pattern); CHECK_STRING (pattern);

9
src/xterm.c
View File

@ -9393,7 +9393,7 @@ static char *error_msg;
/* Handle the loss of connection to display DPY. ERROR_MESSAGE is /* Handle the loss of connection to display DPY. ERROR_MESSAGE is
the text of an error message that lead to the connection loss. */ the text of an error message that lead to the connection loss. */
static void static _Noreturn void
x_connection_closed (Display *dpy, const char *error_message, bool ioerror) x_connection_closed (Display *dpy, const char *error_message, bool ioerror)
{ {
struct x_display_info *dpyinfo = x_display_info_for_display (dpy); struct x_display_info *dpyinfo = x_display_info_for_display (dpy);
@ -9491,9 +9491,6 @@ For details, see etc/PROBLEMS.\n",
unbind_to (idx, Qnil); unbind_to (idx, Qnil);
clear_waiting_for_input (); clear_waiting_for_input ();
/* Tell GCC not to suggest attribute 'noreturn' for this function. */
IF_LINT (if (! terminal_list) return; )
/* Here, we absolutely have to use a non-local exit (e.g. signal, throw, /* Here, we absolutely have to use a non-local exit (e.g. signal, throw,
longjmp), because returning from this function would get us back into longjmp), because returning from this function would get us back into
Xlib's code which will directly call `exit'. */ Xlib's code which will directly call `exit'. */
@ -9559,7 +9556,7 @@ x_error_quitter (Display *display, XErrorEvent *event)
It kills all frames on the display that we lost touch with. It kills all frames on the display that we lost touch with.
If that was the only one, it prints an error message and kills Emacs. */ If that was the only one, it prints an error message and kills Emacs. */
static int static _Noreturn int
x_io_error_quitter (Display *display) x_io_error_quitter (Display *display)
{ {
char buf[256]; char buf[256];
@ -9567,7 +9564,7 @@ x_io_error_quitter (Display *display)
snprintf (buf, sizeof buf, "Connection lost to X server '%s'", snprintf (buf, sizeof buf, "Connection lost to X server '%s'",
DisplayString (display)); DisplayString (display));
x_connection_closed (display, buf, true); x_connection_closed (display, buf, true);
return 0; assume (false);
} }
/* Changing the font of the frame. */ /* Changing the font of the frame. */

44
test/lisp/net/tramp-tests.el
View File

@ -1405,10 +1405,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(make-directory tmp-name) (make-directory tmp-name)
(should (file-directory-p tmp-name)) (should (file-directory-p tmp-name))
(write-region "foo" nil (expand-file-name "foo" tmp-name)) (write-region "foo" nil (expand-file-name "foo" tmp-name))
(should (file-exists-p (expand-file-name "foo" tmp-name)))
(write-region "bar" nil (expand-file-name "bold" tmp-name)) (write-region "bar" nil (expand-file-name "bold" tmp-name))
(should (file-exists-p (expand-file-name "bold" tmp-name)))
(make-directory (expand-file-name "boz" tmp-name)) (make-directory (expand-file-name "boz" tmp-name))
(should (file-directory-p (expand-file-name "boz" tmp-name)))
(should (equal (file-name-completion "fo" tmp-name) "foo")) (should (equal (file-name-completion "fo" tmp-name) "foo"))
(should (equal (file-name-completion "foo" tmp-name) t))
(should (equal (file-name-completion "b" tmp-name) "bo")) (should (equal (file-name-completion "b" tmp-name) "bo"))
(should-not (file-name-completion "a" tmp-name))
(should (should
(equal (equal
(file-name-completion "b" tmp-name 'file-directory-p) "boz/")) (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'."
(should (should
(equal (equal
(sort (file-name-all-completions "b" tmp-name) 'string-lessp) (sort (file-name-all-completions "b" tmp-name) 'string-lessp)
'("bold" "boz/")))) '("bold" "boz/")))
(should-not (file-name-all-completions "a" tmp-name))
;; `completion-regexp-list' restricts the completion to
;; files which match all expressions in this list.
(let ((completion-regexp-list
`(,directory-files-no-dot-files-regexp "b")))
(should
(equal (file-name-completion "" tmp-name) "bo"))
(should
(equal
(sort (file-name-all-completions "" tmp-name) 'string-lessp)
'("bold" "boz/"))))
;; `file-name-completion' ignores file names that end in
;; any string in `completion-ignored-extensions'.
(let ((completion-ignored-extensions '(".ext")))
(write-region "foo" nil (expand-file-name "foo.ext" tmp-name))
(should (file-exists-p (expand-file-name "foo.ext" tmp-name)))
(should (equal (file-name-completion "fo" tmp-name) "foo"))
(should (equal (file-name-completion "foo" tmp-name) t))
(should (equal (file-name-completion "foo." tmp-name) "foo.ext"))
(should (equal (file-name-completion "foo.ext" tmp-name) t))
;; `file-name-all-completions' is not affected.
(should
(equal
(sort (file-name-all-completions "" tmp-name) 'string-lessp)
'("../" "./" "bold" "boz/" "foo" "foo.ext")))))
;; Cleanup. ;; Cleanup.
(ignore-errors (delete-directory tmp-name 'recursive)))))) (ignore-errors (delete-directory tmp-name 'recursive))))))
@ -1468,7 +1498,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (zerop (process-file "ls" nil t nil fnnd))) (should (zerop (process-file "ls" nil t nil fnnd)))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t) (while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil)) (replace-match "" nil nil))
(should (string-equal (format "%s\n" fnnd) (buffer-string))) (should (string-equal (format "%s\n" fnnd) (buffer-string)))
(should-not (get-buffer-window (current-buffer) t)) (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'."
(should (zerop (process-file "ls" nil t t fnnd))) (should (zerop (process-file "ls" nil t t fnnd)))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t) (while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil)) (replace-match "" nil nil))
(should (should
(string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) (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'."
(format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer)) (format "ls %s" (file-name-nondirectory tmp-name)) (current-buffer))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t) (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil)) (replace-match "" nil nil))
(should (should
(string-equal (string-equal
@ -1604,7 +1636,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(accept-process-output (get-buffer-process (current-buffer)) 1))) (accept-process-output (get-buffer-process (current-buffer)) 1)))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t) (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil)) (replace-match "" nil nil))
;; There might be a nasty "Process *Async Shell* finished" message. ;; There might be a nasty "Process *Async Shell* finished" message.
(goto-char (point-min)) (goto-char (point-min))
@ -1633,7 +1665,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(accept-process-output (get-buffer-process (current-buffer)) 1))) (accept-process-output (get-buffer-process (current-buffer)) 1)))
;; `ls' could produce colorized output. ;; `ls' could produce colorized output.
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward tramp-color-escape-sequence-regexp nil t) (while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil)) (replace-match "" nil nil))
;; There might be a nasty "Process *Async Shell* finished" message. ;; There might be a nasty "Process *Async Shell* finished" message.
(goto-char (point-min)) (goto-char (point-min))