mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-29 19:48:19 +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])
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])
AH_VERBATIM([GNULIB_PORTCHECK_FORTIFY_SOURCE],
[/* 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.
\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,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@ -4609,11 +4609,23 @@
% Like \expandablevalue, but completely expandable (the \message in the
% definition above operates at the execution level of TeX). Used when
% 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.
\def\dummyvalue#1{%
\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
\csname SET#1\endcsname
\fi
@ -4760,7 +4772,7 @@
% Define \doindex, the driver for all index macros.
% 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\doindexxxx #1{\doind{\indexname}{#1}}
@ -4769,6 +4781,7 @@
\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx}
\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}}
% Used when writing an index entry out to an index file to prevent
% expansion of Texinfo commands that can appear in an index entry.
%
@ -4787,9 +4800,11 @@
\def\}{{\tt\char125}}%
%
% 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
% redefine everything using @ as the escape character (instead of
% \realbackslash, still used for index files). When everything uses @,
@ -4802,30 +4817,35 @@
\let\} = \rbraceatcmd
%
% Do the redefinitions.
\commondummies
\definedummies
\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{%
% \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.
%
% For control letters, we have \definedummyletter, which omits the
% space.
%
% 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
% that will dutifully get written to the index (or wherever).
%
\def\definedummyword ##1{\def##1{\string##1\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
% that will dutifully get written to the index (or wherever).
%
% For control letters, we have \definedummyletter, which omits the
% space.
%
\def\definedummyword #1{\def#1{\string#1\space}}%
\def\definedummyletter#1{\def#1{\string#1}}%
\let\definedummyaccent\definedummyletter
% Called from \indexdummies and \atdummies, to effectively prevent
% the expansion of commands.
%
\def\definedummies{%
%
\let\commondummyword\definedummyword
\let\commondummyletter\definedummyletter
\let\commondummyaccent\definedummyaccent
\commondummiesnofonts
%
\definedummyletter\_%
@ -4910,77 +4930,77 @@
\normalturnoffactive
}
% \commondummiesnofonts: common to \commondummies and \indexnofonts.
% Define \definedumyletter, \definedummyaccent and \definedummyword before
% using.
% \commondummiesnofonts: common to \definedummies and \indexnofonts.
% Define \commondummyletter, \commondummyaccent and \commondummyword before
% using. Used for accents, font commands, and various control letters.
%
\def\commondummiesnofonts{%
% Control letters and accents.
\definedummyletter\!%
\definedummyaccent\"%
\definedummyaccent\'%
\definedummyletter\*%
\definedummyaccent\,%
\definedummyletter\.%
\definedummyletter\/%
\definedummyletter\:%
\definedummyaccent\=%
\definedummyletter\?%
\definedummyaccent\^%
\definedummyaccent\`%
\definedummyaccent\~%
\definedummyword\u
\definedummyword\v
\definedummyword\H
\definedummyword\dotaccent
\definedummyword\ogonek
\definedummyword\ringaccent
\definedummyword\tieaccent
\definedummyword\ubaraccent
\definedummyword\udotaccent
\definedummyword\dotless
\commondummyletter\!%
\commondummyaccent\"%
\commondummyaccent\'%
\commondummyletter\*%
\commondummyaccent\,%
\commondummyletter\.%
\commondummyletter\/%
\commondummyletter\:%
\commondummyaccent\=%
\commondummyletter\?%
\commondummyaccent\^%
\commondummyaccent\`%
\commondummyaccent\~%
\commondummyword\u
\commondummyword\v
\commondummyword\H
\commondummyword\dotaccent
\commondummyword\ogonek
\commondummyword\ringaccent
\commondummyword\tieaccent
\commondummyword\ubaraccent
\commondummyword\udotaccent
\commondummyword\dotless
%
% Texinfo font commands.
\definedummyword\b
\definedummyword\i
\definedummyword\r
\definedummyword\sansserif
\definedummyword\sc
\definedummyword\slanted
\definedummyword\t
\commondummyword\b
\commondummyword\i
\commondummyword\r
\commondummyword\sansserif
\commondummyword\sc
\commondummyword\slanted
\commondummyword\t
%
% Commands that take arguments.
\definedummyword\abbr
\definedummyword\acronym
\definedummyword\anchor
\definedummyword\cite
\definedummyword\code
\definedummyword\command
\definedummyword\dfn
\definedummyword\dmn
\definedummyword\email
\definedummyword\emph
\definedummyword\env
\definedummyword\file
\definedummyword\image
\definedummyword\indicateurl
\definedummyword\inforef
\definedummyword\kbd
\definedummyword\key
\definedummyword\math
\definedummyword\option
\definedummyword\pxref
\definedummyword\ref
\definedummyword\samp
\definedummyword\strong
\definedummyword\tie
\definedummyword\U
\definedummyword\uref
\definedummyword\url
\definedummyword\var
\definedummyword\verb
\definedummyword\w
\definedummyword\xref
\commondummyword\abbr
\commondummyword\acronym
\commondummyword\anchor
\commondummyword\cite
\commondummyword\code
\commondummyword\command
\commondummyword\dfn
\commondummyword\dmn
\commondummyword\email
\commondummyword\emph
\commondummyword\env
\commondummyword\file
\commondummyword\image
\commondummyword\indicateurl
\commondummyword\inforef
\commondummyword\kbd
\commondummyword\key
\commondummyword\math
\commondummyword\option
\commondummyword\pxref
\commondummyword\ref
\commondummyword\samp
\commondummyword\strong
\commondummyword\tie
\commondummyword\U
\commondummyword\uref
\commondummyword\url
\commondummyword\var
\commondummyword\verb
\commondummyword\w
\commondummyword\xref
}
% For testing: output @{ and @} in index sort strings as \{ and \}.
@ -5036,11 +5056,11 @@
%
\def\indexnofonts{%
% Accent commands should become @asis.
\def\definedummyaccent##1{\let##1\asis}%
\def\commondummyaccent##1{\let##1\asis}%
% 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.
\let\definedummyword\definedummyaccent
\let\commondummyword\commondummyaccent
\commondummiesnofonts
%
% Don't no-op \tt, since it isn't a user-level command
@ -5125,8 +5145,11 @@
% goes to end-of-line is not handled.
%
\macrolist
\let\value\indexnofontsvalue
}
\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
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
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 Elisp data-structure library `radix-tree'.
* 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 saved_errno;
const char *server_name = local_socket_name;
const char *tmpdir IF_LINT ( = NULL);
const char *tmpdir;
char *tmpdir_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 status = 0;
#if defined (MAIL_USE_MAILLOCK) && defined (HAVE_TOUCHLOCK)
time_t touched_lock IF_LINT (= 0);
time_t touched_lock;
#endif
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.
@ -20,22 +20,35 @@
#include <stdlib.h>
#if !HAVE___SECURE_GETENV
# if HAVE_ISSETUGID
# if HAVE_ISSETUGID || (HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID)
# include <unistd.h>
# else
# undef issetugid
# define issetugid() 1
# endif
#endif
char *
secure_getenv (char const *name)
{
#if HAVE___SECURE_GETENV
#if HAVE___SECURE_GETENV /* glibc */
return __secure_getenv (name);
#else
#elif HAVE_ISSETUGID /* OS X, FreeBSD, NetBSD, OpenBSD */
if (issetugid ())
return 0;
return NULL;
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
}

2
lib/verify.h
View File

@ -263,7 +263,7 @@ template <int w>
# define assume(R) ((R) ? (void) 0 : __builtin_unreachable ())
#elif 1200 <= _MSC_VER
# define assume(R) __assume (R)
#elif (defined lint \
#elif ((defined GCC_LINT || defined lint) \
&& (__has_builtin (__builtin_trap) \
|| 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))))
/* 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))
(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
"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
variables or functions that use \"foo-\" as prefix, that will not be registered.
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.
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
prefix), and if set too large, they will be too specific (i.e. they will
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)
;; 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
;; 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
;; remaining definitions.
(let ((prefixes (autoload--split-prefixes-1 defs))
(again t))
;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes))
(while again
(setq again nil)
(let ((newprefixes
(sort
(mapcar (lambda (cell)
(cons cell
(autoload--split-prefixes-1 (cdr cell))))
prefixes)
(lambda (x y) (< (length (cdr x)) (length (cdr y)))))))
(setq prefixes nil)
(while newprefixes
(let ((x (pop newprefixes)))
(if (or (equal '("") (cdar x))
(and (cddr x)
(not (member (caar x)
autoload-popular-prefixes))
(> (+ (length prefixes) (length newprefixes)
(length (cdr x)))
autoload-defs-autoload-max-size)))
;; Nothing to split or would split too deep.
(push (car x) prefixes)
;; (message "Expand %S to %S" (caar x) (cdr x))
(setq again t)
(setq prefixes
(nconc (mapcar (lambda (cell)
(cons (concat (caar x)
(car cell))
(cdr cell)))
(cdr x))
prefixes)))))))
(let* ((tree (let ((tree radix-tree-empty))
(dolist (def defs)
(setq tree (radix-tree-insert tree def t)))
tree))
(prefixes (list (cons "" tree))))
(while
(let ((newprefixes nil)
(changes nil))
(dolist (pair prefixes)
(let ((prefix (car pair)))
(if (or (> (length prefix) autoload-def-prefixes-max-length)
(radix-tree-lookup (cdr pair) ""))
;; No point splitting it any further.
(push pair newprefixes)
(setq changes t)
(radix-tree-iter-subtrees
(cdr pair) (lambda (sprefix subtree)
(push (cons (concat prefix sprefix) subtree)
newprefixes))))))
(and changes
(or (and (null (cdr prefixes)) (equal "" (caar prefixes)))
(<= (length newprefixes)
autoload-def-prefixes-max-entries))
(setq prefixes newprefixes)
(< (length prefixes) autoload-def-prefixes-max-entries))))
;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
(when prefixes
`(if (fboundp 'register-definition-prefixes)
@ -989,7 +967,7 @@ write its autoloads into the specified file instead."
t files-re))
dirs)))
(done ()) ;Files processed; to remove duplicates.
(changed nil) ;Non-nil if some change occured.
(changed nil) ;Non-nil if some change occurred.
(last-time)
;; Files with no autoload cookies or whose autoloads go to other
;; 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 . byte-code-function-p)
(consp . arrayp)
(consp . atom)
(consp . vectorp)
(consp . stringp)
(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)
;; Avoid copying text props (except hard newlines).
(insert (with-current-buffer mailbuf
(mml-buffer-substring-no-properties-except-hard-newlines
(mml-buffer-substring-no-properties-except-some
(point-min) (point-max))))
;; Remove some headers.
(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).
(insert
(with-current-buffer messbuf
(mml-buffer-substring-no-properties-except-hard-newlines
(mml-buffer-substring-no-properties-except-some
(point-min) (point-max))))
(message-encode-message-body)
;; Remove some headers.
@ -8386,30 +8386,32 @@ Used in `message-simplify-recipients'."
(defun message-toggle-image-thumbnails ()
"For any included image files, insert a thumbnail of that image."
(interactive)
(let ((overlays (overlays-in (point-min) (point-max)))
(displayed nil))
(while overlays
(let ((overlay (car overlays)))
(when (overlay-get overlay 'put-image)
(delete-overlay overlay)
(setq displayed t)))
(setq overlays (cdr overlays)))
(let ((displayed nil))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(when-let ((props (get-text-property (point) 'display)))
(when (and (consp props)
(eq (car props) 'image))
(put-text-property (point) (1+ (point)) 'display nil)
(setq displayed t)))))
(unless displayed
(save-excursion
(goto-char (point-min))
(while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t)
(let ((file (match-string 1))
(while (re-search-forward "<img.*src=\"\\([^\"]+\\).*>" nil t)
(let ((string (match-string 0))
(file (match-string 1))
(edges (window-inside-pixel-edges
(get-buffer-window (current-buffer)))))
(put-image
(delete-region (match-beginning 0) (match-end 0))
(insert-image
(create-image
file 'imagemagick nil
:max-width (truncate
(* 0.7 (- (nth 2 edges) (nth 0 edges))))
:max-height (truncate
(* 0.5 (- (nth 3 edges) (nth 1 edges)))))
(match-beginning 0)
" ")))))))
string)))))))
(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))
(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))
(bufstart start) tmp)
(while (setq tmp (text-property-any start end 'hard 't))
(set-text-properties (- tmp bufstart) (- tmp bufstart -1)
'(hard t) str)
(bufstart start)
tmp)
;; Copy over all hard newlines.
(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)))
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)
(setq count (+ count (if (match-beginning 1) -1 1)))
(goto-char (point-max))))
(mml-buffer-substring-no-properties-except-hard-newlines
(mml-buffer-substring-no-properties-except-some
beg (if (> count 0)
(point)
(match-beginning 0))))
(if (re-search-forward
"<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
(prog1
(mml-buffer-substring-no-properties-except-hard-newlines
(mml-buffer-substring-no-properties-except-some
beg (match-beginning 0))
(if (or (not (match-beginning 1))
(equal (match-string 2) "multipart"))
(goto-char (match-beginning 0))
(when (looking-at "[ \t]*\n")
(forward-line 1))))
(mml-buffer-substring-no-properties-except-hard-newlines
(mml-buffer-substring-no-properties-except-some
beg (goto-char (point-max)))))))
(defvar mml-boundary nil)
@ -514,7 +523,9 @@ be \"related\" or \"alternate\"."
(when (search-forward (url-filename parsed) end t)
(let ((cid (format "fsf.%d" cid)))
(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)))))))
;; We have local images that we want to include.
(if (not new-parts)
@ -527,11 +538,41 @@ be \"related\" or \"alternate\"."
(setq cont
(nconc cont
(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)
">")))))))
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)
(let ((mm-use-ultra-safe-encoding
(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
;; necessary, and adding to the list of files to delete
;; eventually.
(if file-name
(rmail-insert-inbox-text files nil)
(setq delete-files (rmail-insert-inbox-text files t)))
(unwind-protect
(progn
;; 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
;; Rmail/mbox format.
(goto-char (point-min))
@ -1969,11 +1981,6 @@ Value is the size of the newly read mail after conversion."
size))
(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)
(while files
;; 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."
(all-completions
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"
(save-match-data
(tramp-adb-send-command
@ -934,20 +934,22 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(unless (stringp program)
(tramp-error v 'file-error "PROGRAM must be a string"))
(let ((command
(format "cd %s; %s"
(tramp-shell-quote-argument localname)
(mapconcat 'tramp-shell-quote-argument
(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))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
(command
(format "cd %s; %s"
(tramp-shell-quote-argument localname)
(mapconcat 'tramp-shell-quote-argument
(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)
;; NAME must be unique as process name.
(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"
"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.
(defconst tramp-gvfs-file-name-handler-alist
@ -784,127 +820,185 @@ file names."
(tramp-run-real-handler
'expand-file-name (list localname))))))
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(defun tramp-gvfs-get-directory-attributes (directory)
"Return GVFS attributes association list of all files in DIRECTORY."
(ignore-errors
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
(process-environment (cons "LC_MESSAGES=C" process-environment))
dirp res-symlink-target res-numlinks res-uid res-gid res-access
res-mod res-change res-size res-filemodes res-inode res-device)
result)
(with-parsed-tramp-file-name directory nil
(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-tramp-file-property
v localname (format "file-attributes-%s" id-format)
(tramp-message v 5 "file attributes: %s" localname)
(with-tramp-file-property v localname "file-gvfs-attributes"
(tramp-message v 5 "file gvfs attributes: %s" localname)
;; Send command.
(tramp-gvfs-send-command
v "gvfs-info" (tramp-gvfs-url-file-name filename))
;; Parse output ...
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(when (re-search-forward "attributes:" nil t)
;; ... directory or symlink
(goto-char (point-min))
(setq dirp (if (re-search-forward "type: directory" nil t) t))
(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)))
(while (re-search-forward
tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
(push (cons (match-string 1) (match-string 2)) result))
result))))))
;; 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-get-file-attributes (filename)
"Return GVFS attributes association list of FILENAME."
(setq filename (directory-file-name (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
(if (or
(and (string-match "^\\(afp\\|smb\\)$" method)
(string-match "^/?\\([^/]+\\)$" localname))
(string-equal localname "/"))
(tramp-gvfs-get-root-attributes filename)
(assoc
(file-name-nondirectory filename)
(tramp-gvfs-get-directory-attributes (file-name-directory filename))))))
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
(ignore-errors
(let ((attributes (tramp-gvfs-get-file-attributes filename))
dirp res-symlink-target res-numlinks res-uid res-gid res-access
res-mod res-change res-size res-filemodes res-inode res-device)
(when attributes
;; ... directory or symlink
(setq dirp (if (equal "directory" (cdr (assoc "type" attributes))) t))
(setq res-symlink-target
(cdr (assoc "standard::symlink-target" attributes)))
;; ... 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)
"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)
"Like `file-executable-p' for Tramp files."
@ -926,73 +1020,21 @@ file names."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(unless (save-match-data (string-match "/" filename))
(with-parsed-tramp-file-name (expand-file-name directory) nil
(all-completions
filename
(mapcar
'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 '("." ".."))
(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 '("./" "../"))
entry)
;; Get a list of directories and files.
(tramp-gvfs-send-command
v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory))
;; Now grab the output.
(with-temp-buffer
(insert-buffer-substring (tramp-get-connection-buffer v))
(goto-char (point-max))
(while (zerop (forward-line -1))
(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))))))))
(dolist (item (tramp-gvfs-get-directory-attributes directory) result)
(setq entry
(or ;; Use display-name if available (google-drive).
;(cdr (assoc "standard::display-name" item))
(car item)))
(if (string-equal (cdr (assoc "type" item)) "directory")
(push (file-name-as-directory entry) result)
(push entry result)))))))))
(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
"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
:name (tramp-buffer-name 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)))
(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.
COMMAND is usually a command from the gvfs-* utilities.
`call-process' is applied, and it returns t if the return code is zero."
(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))))
(let* ((locale (tramp-get-local-locale vec))
(process-environment
(append
`(,(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.
@ -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.
(when tramp-gvfs-enabled
(zeroconf-init tramp-gvfs-zeroconf-domain)
(if (zeroconf-list-service-types)
(progn
;; Suppress D-Bus error messages.
(let (tramp-gvfs-dbus-event-vector)
(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
"afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp")))
"afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function
"dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
"dav" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp")))
"davs" '((tramp-gvfs-parse-device-names "_webdav._tcp")))
(tramp-set-completion-function
"sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp")
(tramp-zeroconf-parse-device-names "_workstation._tcp")))
"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-zeroconf-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")))))))
"smb" '((tramp-gvfs-parse-device-names "_smb._tcp"))))))))
;; 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")))
;;;###tramp-autoload
(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m"
"Escape sequences produced by the \"ls\" command.")
(defconst tramp-display-escape-sequence-regexp "\e[[;0-9]+m"
"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
;; 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.")
(defconst tramp-perl-file-name-all-completions
"%s -e 'sub case {
my $str = shift;
if ($ARGV[2]) {
return lc($str);
}
else {
return $str;
}
}
"%s -e '
opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\");
@files = readdir(d); closedir(d);
foreach $f (@files) {
if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) {
if (-d \"$ARGV[0]/$f\") {
print \"$f/\\n\";
}
else {
print \"$f\\n\";
}
if (-d \"$ARGV[0]/$f\") {
print \"$f/\\n\";
}
else {
print \"$f\\n\";
}
}
print \"ok\\n\"
' \"$1\" \"$2\" \"$3\" 2>/dev/null"
' \"$1\" 2>/dev/null"
"Perl script to produce output suitable for use with
`file-name-all-completions' on the remote file system. Escape
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)))
(if (eq id-format 'integer)
(progn
(unless (numberp res-uid) (setq res-uid -1))
(unless (numberp res-gid) (setq res-gid -1)))
(unless (numberp res-uid)
(setq res-uid tramp-unknown-id-integer))
(unless (numberp res-gid)
(setq res-gid tramp-unknown-id-integer)))
(progn
(unless (stringp res-uid) (setq res-uid (symbol-name res-uid)))
(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)
"Like `file-name-all-completions' for Tramp files."
(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
filename
(mapcar
'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)))
(format (concat
"(cd %s 2>&1 && %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)
(tramp-get-test-command v))))
;; This is inefficient for very long file names, 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)))))
;; Now grab the output.
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-max))
;; Cache expired or no matching cache entry found so we need
;; to perform a remote operation.
(let (result)
;; Get a list of directories and files, including reliably
;; tagging the directories with a trailing '/'. Because I
;; rock. --daniel@danann.net
;; Changed to perform `cd' in the same remote op and only
;; get entries starting with `filename'. Capture any `cd'
;; error messages. Ensure any `cd' and `echo' aliases are
;; ignored.
(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 %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
"\
;; 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-shell-quote-argument localname) (buffer-string))))
(tramp-shell-quote-argument localname) (buffer-string))))
(while (zerop (forward-line -1))
(push (buffer-substring (point) (point-at-eol)) 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))))))))
(while (zerop (forward-line -1))
(push (buffer-substring (point) (point-at-eol)) result)))
result))))))
;; cp, mv and ln
@ -2836,7 +2760,8 @@ The method used must be an out-of-band method."
(unless
(string-match "color" (tramp-get-connection-property v "ls" ""))
(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 "")))
;; 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)
"Like `start-file-process' for Tramp files."
(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
;; length. Therefore, we modify the command.
(heredoc (and (stringp program)
@ -2992,9 +2922,6 @@ the result will be a local, non-Tramp, file name."
;; `eshell' and friends.
(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)
;; NAME must be unique as process name.
(setq i (1+ i)
@ -4030,7 +3957,7 @@ file exists and nonzero exit status otherwise."
shell)
(setq 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?
(tramp-send-command vec "echo ~root" t)
(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))
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
;; There are unfortune settings for "cmdproxy" on
;; There are unfortunate settings for "cmdproxy" on
;; W32 systems.
(process-coding-system-alist nil)
(coding-system-for-read nil)
@ -5000,7 +4927,12 @@ function waits for output unless NOOUTPUT is set."
(with-current-buffer (process-buffer proc)
(let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
;; 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
;; null byte before the shell prompt, for example "git
;; ls-files -c -z ...".
@ -5103,16 +5035,17 @@ Return ATTR."
(when attr
;; Remove color escape sequences from symlink.
(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)))))
;; 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))
(setcar (nthcdr 2 attr) -1))
(setcar (nthcdr 2 attr) tramp-unknown-id-integer))
(when (and (floatp (nth 2 attr))
(<= (nth 2 attr) most-positive-fixnum))
(setcar (nthcdr 2 attr) (round (nth 2 attr))))
(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))
(<= (nth 3 attr) most-positive-fixnum))
(setcar (nthcdr 3 attr) (round (nth 3 attr))))
@ -5556,8 +5489,10 @@ Return ATTR."
(tramp-get-remote-uid-with-python vec id-format))))))
;; Ensure there is a valid result.
(cond
((and (equal id-format 'integer) (not (integerp res))) -1)
((and (equal id-format 'string) (not (stringp res))) "UNKNOWN")
((and (equal id-format 'integer) (not (integerp res)))
tramp-unknown-id-integer)
((and (equal id-format 'string) (not (stringp res)))
tramp-unknown-id-string)
(t res)))))
(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))))))
;; Ensure there is a valid result.
(cond
((and (equal id-format 'integer) (not (integerp res))) -1)
((and (equal id-format 'string) (not (stringp res))) "UNKNOWN")
((and (equal id-format 'integer) (not (integerp res)))
tramp-unknown-id-integer)
((and (equal id-format 'string) (not (stringp res)))
tramp-unknown-id-string)
(t res)))))
;; 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)))
;; Sort them if necessary.
(unless nosort (setq result (sort result 'string-lessp)))
;; Remove double entries.
(delete-dups result)))
result))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"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."
(all-completions
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"
(save-match-data
(let ((entries (tramp-smb-get-file-entries directory)))
(mapcar
(lambda (x)
(list
(if (string-match "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
entries)))))))
(delete-dups
(mapcar
(lambda (x)
(list
(if (string-match "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory))))))))
(defun tramp-smb-handle-file-writable-p (filename)
"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)
"Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name default-directory nil
(let ((command (mapconcat 'identity (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
(i 0))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; 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
(save-excursion
(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)
;; NAME must be unique as process name.
(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 ".*$"
"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:
(defconst tramp-remote-file-name-spec-regexp
@ -2861,11 +2867,21 @@ User is always nil."
(error
"tramp-handle-file-name-completion invoked on non-tramp directory `%s'"
directory))
(try-completion
filename
(mapcar 'list (file-name-all-completions filename directory))
(when predicate
(lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
(let (hits-ignored-extensions)
(or
(try-completion
filename (file-name-all-completions filename 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)
"Like `file-name-directory' but aware of Tramp files."
@ -3834,7 +3850,10 @@ be granted."
vec (concat "uid-" suffix) nil))
(remote-gid
(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
file-attr
(or
@ -3847,12 +3866,14 @@ be granted."
;; User accessible and owned by user.
(and
(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
;; principal group.
(and
(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
(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'.
(defvar c-macro-cache-syntactic nil)
(make-variable-buffer-local 'c-macro-cache-syntactic)
;; non-nil iff `c-macro-cache' has both elements set AND the cdr is at a
;; syntactic end of macro, not merely an apparent one.
;; Either nil, or the syntactic end of the macro currently represented by
;; `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)
;; Called from a before-change function. If the change region is before or
@ -242,12 +246,14 @@
((< beg (car c-macro-cache))
(setq c-macro-cache 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)
(< beg (cdr c-macro-cache)))
(setcdr c-macro-cache nil)
(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 ()
;; 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))
(setq c-macro-cache 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
(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)))
(setq c-macro-cache 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
(end-of-line)
(when (and (eq (char-before) ?\\)
@ -347,14 +355,38 @@ comment at the start of cc-engine.el for more info."
(let* ((here (point))
(there (progn (c-end-of-macro) (point)))
s)
(unless c-macro-cache-syntactic
(if c-macro-cache-syntactic
(goto-char c-macro-cache-syntactic)
(setq s (parse-partial-sexp here there))
(while (and (or (nth 3 s) ; in a string
(nth 4 s)) ; in a comment (maybe at end of line comment)
(> there here)) ; No infinite loops, please.
(setq there (1- (nth 8 s)))
(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)))
(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)
(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
;; have gotten paren syntax above.
(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-before-change-check-<>-operators
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
awk 'c-awk-record-region-clear-NL)
(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.
;; The value here may be a list of functions or a single function.
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++ '(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-change-expand-fl-region)
java '(c-restore-<>-properties
@ -2264,6 +2267,10 @@ contain type identifiers."
;; MSVC extension.
"__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
"Keywords that may be followed by a parenthesis expression containing
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.
;; 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 ()
;; Is the primitive which invoked `before-change-functions' or
;; `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)))
(defun c-extend-region-for-CPP (beg end)
;; Set c-old-BOM or c-old-EOM respectively to BEG, END, each extended to the
;; beginning/end of any preprocessor construct they may be in.
;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of
;; any preprocessor construct they may be in.
;;
;; Point is undefined both before and after this function call; the buffer
;; 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
;; `c-get-state-before-change-functions' and is called exclusively as a
;; before change function.
(goto-char beg)
(goto-char c-new-BEG)
(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)
(c-end-of-macro)
(or (eobp) (forward-char))) ; Over the terminating NL which may be marked
; 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)
;; Extend the region (BEGG ENDD) to cover all (possibly changed)
;; preprocessor macros; return the cons (new-BEG . new-END). OLD-LEN should
;; 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.
(defun c-extend-font-lock-region-for-macros (begg endd old-len)
;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed)
;; preprocessor macros; The return value has no significance.
;;
;; Point is undefined on both entry and exit to this function. The buffer
;; 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.
(setq new-beg
(min begg
(if (setq limits (c-state-literal-at (point)))
(cdr limits) ; go forward out of any string or comment.
(point))))
(goto-char endd)
(if (setq limits (c-state-literal-at (point)))
(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)))
;;
;; This function is in the C/C++/ObjC value of `c-before-font-lock-functions'.
(goto-char endd)
(if (c-beginning-of-macro)
(c-end-of-macro))
(setq c-new-END (max endd c-new-END (point)))
;; Determine the region, (c-new-BEG c-new-END), which will get font
;; locked. This restricts the region should there be long macros.
(setq c-new-BEG (max c-new-BEG (c-determine-limit 500 begg))
c-new-END (min c-new-END (c-determine-+ve-limit 500 endd))))
(defun c-neutralize-CPP-line (beg end)
;; 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)))))))
(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len)
;; (i) Extend the font lock region to cover all changed preprocessor
;; regions; it does this by setting the variables `c-new-BEG' and
;; `c-new-END' to the new boundaries.
;; (i) "Neutralize" every preprocessor line wholly or partially in the
;; changed region. "Restore" lines which were CPP lines before the change
;; and are no longer so.
;;
;; (ii) "Neutralize" every preprocessor line wholly or partially in the
;; 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
;; (ii) Mark each CPP construct by placing a `category' property value
;; `c-cpp-delimiter' at its start and end. The marked characters are the
;; 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
;; 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!!!
;;
;; This function might make hidden buffer changes.
(c-save-buffer-state (new-bounds)
;; First determine the region, (c-new-BEG c-new-END), which will get font
;; 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-save-buffer-state (limits )
;; Clear 'syntax-table properties "punctuation":
(c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1))
;; 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.
(goto-char c-new-BEG)
(if (setq limits (c-literal-limits)) ; Go past any literal.
(goto-char (cdr limits)))
(skip-chars-backward " \t")
(let ((pps-position (point)) pps-state mbeg)
(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?
(goto-char (match-beginning 1))
(setq mbeg (point))
(if (> (c-syntactic-end-of-macro) mbeg)
(if (> (c-no-comment-end-of-macro) mbeg)
(progn
(c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties
(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
;; and OLD-LEN are not used.
(if font-lock-mode
(setq 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))))
(if font-lock-mode
(setq c-new-BEG
(or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
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)
;; 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 "n" 'next-line)
(define-key km "p" 'previous-line)
(define-key km [follow-link] "\C-m")
km)
"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
(cons (/ (float x-pos)
(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
(set-window-hscroll (selected-window) target-hscroll))
;; 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."
:button-prefix 'widget-link-prefix
: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."
: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
AC_CHECK_FUNCS([issetugid])
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)
{
Lisp_Object overlay;
struct Lisp_Overlay *before_list IF_LINT (= NULL);
struct Lisp_Overlay *after_list IF_LINT (= NULL);
struct Lisp_Overlay *before_list;
struct Lisp_Overlay *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
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. */
struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
Lisp_Object tem;
ptrdiff_t end IF_LINT (= 0);
ptrdiff_t end;
/* After the insertion, the several overlays may be in incorrect
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;
/* 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_byte = PT_BYTE;

2
src/charset.c
View File

@ -240,7 +240,7 @@ struct charset_map_entries
static void
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);
bool ascii_compatible_p = charset->ascii_compatible_p;
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)
{
ptrdiff_t count = SPECPDL_INDEX ();
unsigned char *destination IF_LINT (= NULL);
ptrdiff_t dst_bytes IF_LINT (= 0);
unsigned char *destination;
ptrdiff_t dst_bytes;
ptrdiff_t chars = to - from;
ptrdiff_t bytes = to_byte - from_byte;
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;
Lisp_Object old_deactivate_mark;
@ -8191,7 +8191,7 @@ encode_coding_object (struct coding_system *coding,
ptrdiff_t chars = to - from;
ptrdiff_t bytes = to_byte - from_byte;
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 kill_src_buffer = 0;
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
#ifdef CYGWIN
#define SYSTEM_PURESIZE_EXTRA 10000
#define SYSTEM_PURESIZE_EXTRA 50000
#endif
#if defined HAVE_NTGUI && !defined DebPrint
@ -343,9 +343,8 @@ extern int emacs_setenv_TZ (char const *);
# define FLEXIBLE_ARRAY_MEMBER
#endif
/* Use this to suppress gcc's `...may be used before initialized' warnings. */
#ifdef lint
/* Use CODE only if lint checking is in effect. */
#if defined GCC_LINT || defined lint
# define IF_LINT(Code) Code
#else
# define IF_LINT(Code) /* empty */

4
src/cygw32.c
View File

@ -31,7 +31,7 @@ fchdir_unwind (int dir_fd)
}
static void
chdir_to_default_directory ()
chdir_to_default_directory (void)
{
Lisp_Object new_cwd;
int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);
@ -46,7 +46,7 @@ chdir_to_default_directory ()
if (!STRINGP (new_cwd))
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));
}

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

4
src/frame.c
View File

@ -609,7 +609,7 @@ make_frame (bool mini_p)
{
Lisp_Object frame;
struct frame *f;
struct window *rw, *mw IF_LINT (= NULL);
struct window *rw, *mw;
Lisp_Object root_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
set them both at once. So we wait until we've looked at the
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;
/* 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)
{
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;
ptrdiff_t i;
png_struct *png_ptr;
png_info *info_ptr = NULL, *end_info = NULL;
FILE *fp = NULL;
png_byte sig[8];
png_byte *pixels = 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. */
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
IF_LINT (Lisp_Object volatile specified_data_volatile = 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;
}
/* Silence a bogus diagnostic; see GCC bug 54561. */
IF_LINT (fp = c->fp);
IF_LINT (specified_data = specified_data_volatile);
/* Read image info. */
if (!NILP (specified_data))
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)
{
Lisp_Object specified_file;
Lisp_Object specified_data;
/* The 'volatile' silences a bogus diagnostic; see GCC bug 54561. */
FILE * IF_LINT (volatile) fp = NULL;
/* IF_LINT (volatile) works around GCC bug 54561. */
Lisp_Object IF_LINT (volatile) specified_data;
FILE *volatile fp = NULL;
JSAMPARRAY buffer;
int row_stride, x, y;
unsigned long *colors;
@ -6687,7 +6683,6 @@ jpeg_load_body (struct frame *f, struct image *img,
/* Open the JPEG file. */
specified_file = image_spec_value (img->spec, QCfile, NULL);
specified_data = image_spec_value (img->spec, QCdata, NULL);
IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data);
if (NILP (specified_data))
{
@ -6751,9 +6746,6 @@ jpeg_load_body (struct frame *f, struct image *img,
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.
Read the JPEG image header. */
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;
sys_jmp_buf save_jump;
KBOARD *kb IF_LINT (= NULL);
KBOARD *kb;
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. */
/* commandflag 0 means do not autosave, but do redisplay.
-1 means do not redisplay, but do autosave.
@ -2317,7 +2312,9 @@ read_char (int commandflag, Lisp_Object map,
Lisp_Object prev_event,
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;
sys_jmp_buf local_getcjmp;
sys_jmp_buf save_jump;
@ -3125,10 +3122,6 @@ read_char (int commandflag, Lisp_Object map,
return c;
}
#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__)
# pragma GCC diagnostic pop
#endif
/* Record a key that came from a mouse menu.
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 */
/* 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
also be assigned to arbitrarily: each pattern buffer stores its own
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
pattern when we have pushed into a subpattern. */
re_char *main_p IF_LINT (= NULL);
re_char *main_pattern IF_LINT (= NULL);
re_char *main_pend IF_LINT (= NULL);
re_char *main_p;
re_char *main_pattern;
re_char *main_pend;
#ifdef 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_byte = from_byte;
ptrdiff_t comstart_pos = 0;
ptrdiff_t comstart_byte IF_LINT (= 0);
ptrdiff_t comstart_byte;
/* Place where the containing defun starts,
or 0 if we didn't come across it yet. */
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);
++found_data;
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);
if (debug_unexcw)
printf (" .data, file start %d file length %d\n",
@ -213,7 +213,7 @@ fixup_executable (int fd)
sizeof (exe_header->section_header[i]));
assert (ret == sizeof (exe_header->section_header[i]));
if (debug_unexcw)
printf (" seek to %ld, write %d\n",
printf (" seek to %ld, write %zu\n",
(long) ((char *) &exe_header->section_header[i] -
(char *) exe_header),
sizeof (exe_header->section_header[i]));
@ -228,7 +228,7 @@ fixup_executable (int fd)
my_endbss - (char *) start_address);
assert (ret == (my_endbss - (char *) start_address));
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);
if (debug_unexcw)
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);
bool center_p = false;
ptrdiff_t charpos, bytepos;
EMACS_INT iarg IF_LINT (= 0);
EMACS_INT iarg;
int this_scroll_margin;
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 lbearing, rbearing;
int i, width, ascent, descent;
int c IF_LINT (= 0); /* cmp->glyph_len can't be zero; see Bug#8512 */
int c;
XChar2b char2b;
struct font_metrics *pcm;
ptrdiff_t pos;
for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--)
if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t')
break;
eassume (0 < glyph_len); /* See Bug#8512. */
do
c = COMPOSITION_GLYPH (cmp, --glyph_len);
while (c == '\t' && 0 < glyph_len);
bool right_padded = glyph_len < cmp->glyph_len;
for (i = 0; i < glyph_len; i++)
{
if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
c = COMPOSITION_GLYPH (cmp, i);
if (c != '\t')
break;
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)
{
struct frame *f;
int size, avgwidth IF_LINT (= 0);
int size, avgwidth;
check_window_system (NULL);
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
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)
{
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);
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,
longjmp), because returning from this function would get us back into
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.
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)
{
char buf[256];
@ -9567,7 +9564,7 @@ x_io_error_quitter (Display *display)
snprintf (buf, sizeof buf, "Connection lost to X server '%s'",
DisplayString (display));
x_connection_closed (display, buf, true);
return 0;
assume (false);
}
/* 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)
(should (file-directory-p 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))
(should (file-exists-p (expand-file-name "bold" 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 "foo" tmp-name) t))
(should (equal (file-name-completion "b" tmp-name) "bo"))
(should-not (file-name-completion "a" tmp-name))
(should
(equal
(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
(equal
(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.
(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)))
;; `ls' could produce colorized output.
(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))
(should (string-equal (format "%s\n" fnnd) (buffer-string)))
(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)))
;; `ls' could produce colorized output.
(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))
(should
(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))
;; `ls' could produce colorized output.
(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))
(should
(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)))
;; `ls' could produce colorized output.
(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))
;; There might be a nasty "Process *Async Shell* finished" message.
(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)))
;; `ls' could produce colorized output.
(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))
;; There might be a nasty "Process *Async Shell* finished" message.
(goto-char (point-min))