martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'savannah/master' into HEAD

Browse Source
This commit is contained in:
Andrea Corallo
2020-05-14 07:14:23 +01:00
parent 9bc0a7c408 a4671733b7
commit 3bcb79fdcd
48 changed files with 993 additions and 365 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
doc/lispref/os.texi
View File

@@ -2182,9 +2182,9 @@ cause anything special to happen.
@findex list-timers
The @code{list-timers} command lists all the currently active timers.
There's only one command available in the buffer displayed: @kbd{c}
(@code{timer-list-cancel}) that will cancel the timer on the line
under point.
The command @kbd{c} (@code{timer-list-cancel}) will cancel the timer
on the line under point. You can sort the list by column using the
command @kbd{S} (@code{tabulated-list-sort}).
@node Idle Timers
@section Idle Timers

215
lib/attribute.h
View File

@@ -20,39 +20,196 @@
/* Provide public ATTRIBUTE_* names for the private _GL_ATTRIBUTE_*
macros used within Gnulib. */
/* These attributes can be placed in two ways:
- At the start of a declaration (i.e. even before storage-class
specifiers!); then they apply to all entities that are declared
by the declaration.
- Immediately after the name of an entity being declared by the
declaration; then they apply to that entity only. */
#ifndef _GL_ATTRIBUTE_H
#define _GL_ATTRIBUTE_H
/* C2X standard attributes have macro names that do not begin with
'ATTRIBUTE_'. */
#define DEPRECATED _GL_ATTRIBUTE_DEPRECATED
#define FALLTHROUGH _GL_ATTRIBUTE_FALLTHROUGH
#define MAYBE_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED
#define NODISCARD _GL_ATTRIBUTE_NODISCARD
/* Selected GCC attributes; see:
https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html
These names begin with 'ATTRIBUTE_' to avoid name clashes. */
#define ATTRIBUTE_ALLOC_SIZE(args) _GL_ATTRIBUTE_ALLOC_SIZE (args)
#define ATTRIBUTE_ALWAYS_INLINE _GL_ATTRIBUTE_ALWAYS_INLINE
#define ATTRIBUTE_ARTIFICIAL _GL_ATTRIBUTE_ARTIFICIAL
#define ATTRIBUTE_COLD _GL_ATTRIBUTE_COLD
#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
#define ATTRIBUTE_DEPRECATED _GL_ATTRIBUTE_DEPRECATED
#define ATTRIBUTE_ERROR(msg) _GL_ATTRIBUTE_ERROR (msg)
#define ATTRIBUTE_EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE
#define ATTRIBUTE_FORMAT(spec) _GL_ATTRIBUTE_FORMAT (spec)
#define ATTRIBUTE_LEAF _GL_ATTRIBUTE_LEAF
#define ATTRIBUTE_MAY_ALIAS _GL_ATTRIBUTE_MAY_ALIAS
#define ATTRIBUTE_MALLOC _GL_ATTRIBUTE_MALLOC
#define ATTRIBUTE_NOINLINE _GL_ATTRIBUTE_NOINLINE
#define ATTRIBUTE_NONNULL(args) _GL_ATTRIBUTE_NONNULL (args)
#define ATTRIBUTE_NONSTRING _GL_ATTRIBUTE_NONSTRING
#define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW
#define ATTRIBUTE_PACKED _GL_ATTRIBUTE_PACKED
#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
#define ATTRIBUTE_RETURNS_NONNULL _GL_ATTRIBUTE_RETURNS_NONNULL
#define ATTRIBUTE_SENTINEL(pos) _GL_ATTRIBUTE_SENTINEL (pos)
/* This file defines two types of attributes:
* C2X standard attributes. These have macro names that do not begin with
'ATTRIBUTE_'.
* Selected GCC attributes; see:
https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html
https://gcc.gnu.org/onlinedocs/gcc/Common-Variable-Attributes.html
https://gcc.gnu.org/onlinedocs/gcc/Common-Type-Attributes.html
These names begin with 'ATTRIBUTE_' to avoid name clashes. */
/* =============== Attributes for specific kinds of functions =============== */
/* Attributes for functions that should not be used. */
/* Warn if the entity is used. */
/* Applies to:
- function, variable,
- struct, union, struct/union member,
- enumeration, enumeration item,
- typedef,
in C++ also: namespace, class, template specialization. */
#define DEPRECATED _GL_ATTRIBUTE_DEPRECATED
/* If a function call is not optimized way, warn with MSG. */
/* Applies to: functions. */
#define ATTRIBUTE_WARNING(msg) _GL_ATTRIBUTE_WARNING (msg)
/* If a function call is not optimized way, report an error with MSG. */
/* Applies to: functions. */
#define ATTRIBUTE_ERROR(msg) _GL_ATTRIBUTE_ERROR (msg)
/* Attributes for memory-allocating functions. */
/* The function returns a pointer to freshly allocated memory. */
/* Applies to: functions. */
#define ATTRIBUTE_MALLOC _GL_ATTRIBUTE_MALLOC
/* ATTRIBUTE_ALLOC_SIZE ((N)) - The Nth argument of the function
is the size of the returned memory block.
ATTRIBUTE_ALLOC_SIZE ((M, N)) - Multiply the Mth and Nth arguments
to determine the size of the returned memory block. */
/* Applies to: function, pointer to function, function types. */
#define ATTRIBUTE_ALLOC_SIZE(args) _GL_ATTRIBUTE_ALLOC_SIZE (args)
/* Attributes for variadic functions. */
/* The variadic function expects a trailing NULL argument.
ATTRIBUTE_SENTINEL () - The last argument is NULL.
ATTRIBUTE_SENTINEL ((N)) - The (N+1)st argument from the end is NULL. */
/* Applies to: functions. */
#define ATTRIBUTE_SENTINEL(pos) _GL_ATTRIBUTE_SENTINEL (pos)
/* ================== Attributes for compiler diagnostics ================== */
/* Attributes that help the compiler diagnose programmer mistakes.
Some of them may also help for some compiler optimizations. */
/* ATTRIBUTE_FORMAT ((ARCHETYPE, STRING-INDEX, FIRST-TO-CHECK)) -
The STRING-INDEXth function argument is a format string of style
ARCHETYPE, which is one of:
printf, gnu_printf
scanf, gnu_scanf,
strftime, gnu_strftime,
strfmon,
or the same thing prefixed and suffixed with '__'.
If FIRST-TO-CHECK is not 0, arguments starting at FIRST-TO_CHECK
are suitable for the format string. */
/* Applies to: functions. */
#define ATTRIBUTE_FORMAT(spec) _GL_ATTRIBUTE_FORMAT (spec)
/* ATTRIBUTE_NONNULL ((N1, N2,...)) - Arguments N1, N2,... must not be NULL.
ATTRIBUTE_NONNULL () - All pointer arguments must not be null. */
/* Applies to: functions. */
#define ATTRIBUTE_NONNULL(args) _GL_ATTRIBUTE_NONNULL (args)
/* The function's return value is a non-NULL pointer. */
/* Applies to: functions. */
#define ATTRIBUTE_RETURNS_NONNULL _GL_ATTRIBUTE_RETURNS_NONNULL
/* Warn if the caller does not use the return value,
unless the caller uses something like ignore_value. */
/* Applies to: function, enumeration, class. */
#define NODISCARD _GL_ATTRIBUTE_NODISCARD
/* Attributes that disable false alarms when the compiler diagnoses
programmer "mistakes". */
/* Do not warn if the entity is not used. */
/* Applies to:
- function, variable,
- struct, union, struct/union member,
- enumeration, enumeration item,
- typedef,
in C++ also: class. */
#define MAYBE_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED
/* The contents of a character array is not meant to be NUL-terminated. */
/* Applies to: struct/union members and variables that are arrays of element
type '[[un]signed] char'. */
#define ATTRIBUTE_NONSTRING _GL_ATTRIBUTE_NONSTRING
/* Do not warn if control flow falls through to the immediately
following 'case' or 'default' label. */
/* Applies to: Empty statement (;), inside a 'switch' statement. */
#define FALLTHROUGH _GL_ATTRIBUTE_FALLTHROUGH
/* ================== Attributes for debugging information ================== */
/* Attributes regarding debugging information emitted by the compiler. */
/* Omit the function from stack traces when debugging. */
/* Applies to: function. */
#define ATTRIBUTE_ARTIFICIAL _GL_ATTRIBUTE_ARTIFICIAL
/* Make the entity visible to debuggers etc., even with '-fwhole-program'. */
/* Applies to: functions, variables. */
#define ATTRIBUTE_EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE
/* ========== Attributes that mainly direct compiler optimizations ========== */
/* The function does not throw exceptions. */
/* Applies to: functions. */
#define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW
/* Do not inline the function. */
/* Applies to: functions. */
#define ATTRIBUTE_NOINLINE _GL_ATTRIBUTE_NOINLINE
/* Always inline the function, and report an error if the compiler
cannot inline. */
/* Applies to: function. */
#define ATTRIBUTE_ALWAYS_INLINE _GL_ATTRIBUTE_ALWAYS_INLINE
/* The function does not affect observable state, and always returns a value.
Compilers can omit duplicate calls with the same arguments if
observable state is not changed between calls. (This attribute is
looser than ATTRIBUTE_CONST.) */
/* Applies to: functions. */
#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
/* The function neither depends on nor affects observable state,
and always returns a value. Compilers can omit duplicate calls with
the same arguments. (This attribute is stricter than ATTRIBUTE_PURE.) */
/* Applies to: functions. */
#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
/* The function is rarely executed. */
/* Applies to: functions. */
#define ATTRIBUTE_COLD _GL_ATTRIBUTE_COLD
/* If called from some other compilation unit, the function executes
code from that unit only by return or by exception handling,
letting the compiler optimize that unit more aggressively. */
/* Applies to: functions. */
#define ATTRIBUTE_LEAF _GL_ATTRIBUTE_LEAF
/* For struct members: The member has the smallest possible alignment.
For struct, union, class: All members have the smallest possible alignment,
minimizing the memory required. */
/* Applies to: struct members, struct, union,
in C++ also: class. */
#define ATTRIBUTE_PACKED _GL_ATTRIBUTE_PACKED
/* ================ Attributes that make invalid code valid ================ */
/* Attributes that prevent fatal compiler optimizations for code that is not
fully ISO C compliant. */
/* Pointers to the type may point to the same storage as pointers to
other types, thus disabling strict aliasing optimization. */
/* Applies to: types. */
#define ATTRIBUTE_MAY_ALIAS _GL_ATTRIBUTE_MAY_ALIAS
#endif /* _GL_ATTRIBUTE_H */

38
lib/careadlinkat.c
View File

@@ -72,23 +72,38 @@ careadlinkat (int fd, char const *filename,
SSIZE_MAX < SIZE_MAX ? (size_t) SSIZE_MAX + 1 : SIZE_MAX;
char stack_buf[1024];
#if (defined GCC_LINT || defined lint) && _GL_GNUC_PREREQ (10, 1)
/* Pacify preadlinkat without creating a pointer to the stack
that a broken gcc -Wreturn-local-addr would cry wolf about. See:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95044
This workaround differs from the mainline code, but
no other way to pacify GCC 10.1.0 is known; even an explicit
#pragma does not pacify GCC. When the GCC bug is fixed this
workaround should be limited to the broken GCC versions. */
# define WORK_AROUND_GCC_BUG_95044
#endif
if (! alloc)
alloc = &stdlib_allocator;
if (! buffer_size)
if (!buffer)
{
#ifdef WORK_AROUND_GCC_BUG_95044
buffer = alloc->allocate (sizeof stack_buf);
#else
/* Allocate the initial buffer on the stack. This way, in the
common case of a symlink of small size, we get away with a
single small malloc() instead of a big malloc() followed by a
shrinking realloc(). */
buffer = stack_buf;
#endif
buffer_size = sizeof stack_buf;
}
buf = buffer;
buf_size = buffer_size;
do
while (buf)
{
/* Attempt to read the link into the current buffer. */
ssize_t link_length = preadlinkat (fd, filename, buf, buf_size);
@@ -117,19 +132,19 @@ careadlinkat (int fd, char const *filename,
if (buf == stack_buf)
{
char *b = (char *) alloc->allocate (link_size);
char *b = alloc->allocate (link_size);
buf_size = link_size;
if (! b)
break;
memcpy (b, buf, link_size);
buf = b;
return memcpy (b, buf, link_size);
}
else if (link_size < buf_size && buf != buffer && alloc->reallocate)
if (link_size < buf_size && buf != buffer && alloc->reallocate)
{
/* Shrink BUF before returning it. */
char *b = (char *) alloc->reallocate (buf, link_size);
char *b = alloc->reallocate (buf, link_size);
if (b)
buf = b;
return b;
}
return buf;
@@ -138,8 +153,8 @@ careadlinkat (int fd, char const *filename,
if (buf != buffer)
alloc->free (buf);
if (buf_size <= buf_size_max / 2)
buf_size *= 2;
if (buf_size < buf_size_max / 2)
buf_size = 2 * buf_size + 1;
else if (buf_size < buf_size_max)
buf_size = buf_size_max;
else if (buf_size_max < SIZE_MAX)
@@ -149,9 +164,8 @@ careadlinkat (int fd, char const *filename,
}
else
break;
buf = (char *) alloc->allocate (buf_size);
buf = alloc->allocate (buf_size);
}
while (buf);
if (alloc->die)
alloc->die (buf_size);

26
lib/string.in.h
View File

@@ -334,9 +334,10 @@ _GL_WARN_ON_USE (stpncpy, "stpncpy is unportable - "
GB18030 and the character to be searched is a digit. */
# undef strchr
/* Assume strchr is always declared. */
_GL_WARN_ON_USE (strchr, "strchr cannot work correctly on character strings "
"in some multibyte locales - "
"use mbschr if you care about internationalization");
_GL_WARN_ON_USE_CXX (strchr, const char *, (const char *, int),
"strchr cannot work correctly on character strings "
"in some multibyte locales - "
"use mbschr if you care about internationalization");
#endif
/* Find the first occurrence of C in S or the final NUL byte. */
@@ -528,15 +529,17 @@ _GL_CXXALIASWARN (strpbrk);
locale encoding is GB18030 and one of the characters to be searched is a
digit. */
# undef strpbrk
_GL_WARN_ON_USE (strpbrk, "strpbrk cannot work correctly on character strings "
"in multibyte locales - "
"use mbspbrk if you care about internationalization");
_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *),
"strpbrk cannot work correctly on character strings "
"in multibyte locales - "
"use mbspbrk if you care about internationalization");
# endif
#elif defined GNULIB_POSIXCHECK
# undef strpbrk
# if HAVE_RAW_DECL_STRPBRK
_GL_WARN_ON_USE (strpbrk, "strpbrk is unportable - "
"use gnulib module strpbrk for portability");
_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *),
"strpbrk is unportable - "
"use gnulib module strpbrk for portability");
# endif
#endif
@@ -555,9 +558,10 @@ _GL_WARN_ON_USE (strspn, "strspn cannot work correctly on character strings "
GB18030 and the character to be searched is a digit. */
# undef strrchr
/* Assume strrchr is always declared. */
_GL_WARN_ON_USE (strrchr, "strrchr cannot work correctly on character strings "
"in some multibyte locales - "
"use mbsrchr if you care about internationalization");
_GL_WARN_ON_USE_CXX (strrchr, const char *, (const char *, int),
"strrchr cannot work correctly on character strings "
"in some multibyte locales - "
"use mbsrchr if you care about internationalization");
#endif
/* Search the next delimiter (char listed in DELIM) starting at *STRINGP.

21
lib/warn-on-use.h
View File

@@ -100,23 +100,28 @@ _GL_WARN_EXTERN_C int _gl_warn_on_use
#endif
/* _GL_WARN_ON_USE_CXX (function, rettype, parameters_and_attributes, "string")
is like _GL_WARN_ON_USE (function, "string"), except that the function is
declared with the given prototype, consisting of return type, parameters,
and attributes.
is like _GL_WARN_ON_USE (function, "string"), except that in C++ mode the
function is declared with the given prototype, consisting of return type,
parameters, and attributes.
This variant is useful for overloaded functions in C++. _GL_WARN_ON_USE does
not work in this case. */
#ifndef _GL_WARN_ON_USE_CXX
# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__)
# if !defined __cplusplus
# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
_GL_WARN_ON_USE (function, msg)
# else
# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__)
# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
extern rettype function parameters_and_attributes \
__attribute__ ((__warning__ (msg)))
# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
/* Verify the existence of the function. */
# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
extern rettype function parameters_and_attributes
# else /* Unsupported. */
# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
# else /* Unsupported. */
# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
_GL_WARN_EXTERN_C int _gl_warn_on_use
# endif
# endif
#endif

4
lisp/calendar/cal-bahai.el
View File

@@ -57,8 +57,8 @@
(defconst calendar-bahai-month-name-array
["Bahá" "Jalál" "Jamál" "‘Aẓamat" "Núr" "Raḥmat" "Kalimát" "Kamál"
"Asmá’" "‘Izzat" "Mashíyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
"Sharaf" "Sulṭán" "Mulk" "‘Alá’"]
"Asmá’" "‘Izzat" "Mas͟híyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
"S͟haraf" "Sulṭán" "Mulk" "‘Alá’"]
"Array of the month names in the Bahá’í calendar.")
(defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))

22
lisp/calendar/cal-julian.el
View File

@@ -1,4 +1,4 @@
;;; cal-julian.el --- calendar functions for the Julian calendar
;;; cal-julian.el --- calendar functions for the Julian calendar -*- lexical-binding:t -*-
;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
@@ -182,23 +182,27 @@ Echo astronomical (Julian) day number unless NOECHO is non-nil."
(calendar-astro-to-absolute daynumber))))
(or noecho (calendar-astro-print-day-number)))
;; The function below is designed to be used in sexp diary entries,
;; and may be present in users' diary files, so suppress the warning
;; about this prefix-less dynamic variable. It's called from
;; `diary-list-sexp-entries', which binds the variable.
(with-suppressed-warnings ((lexical date))
(defvar date))
;;;###diary-autoload
(defun diary-julian-date ()
"Julian calendar equivalent of date diary entry."
;; This function is designed to be used in sexp diary entries, and
;; may be present in users' diary files, so suppress the warning
;; about this prefix-less dynamic variable. It's called from
;; `diary-list-sexp-entries', which binds the variable.
(with-suppressed-warnings ((lexical date))
(defvar date))
(format "Julian date: %s" (calendar-julian-date-string date)))
;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-astro-day-number ()
"Astronomical (Julian) day number diary entry."
;; This function is designed to be used in sexp diary entries, and
;; may be present in users' diary files, so suppress the warning
;; about this prefix-less dynamic variable. It's called from
;; `diary-list-sexp-entries', which binds the variable.
(with-suppressed-warnings ((lexical date))
(defvar date))
(format "Astronomical (Julian) day number at noon UTC: %s.0"
(calendar-astro-date-string date)))

53
lisp/emacs-lisp/edebug.el
View File

@@ -741,6 +741,21 @@ Maybe clear the markers and delete the symbol's edebug property?"
;;; Offsets for reader
(defun edebug-get-edebug-or-ghost (name)
"Get NAME's value of property `edebug' or property `ghost-edebug'.
The idea is that should function NAME be recompiled whilst
debugging is in progress, property `edebug' will get set to a
marker. The needed data will then come from property
`ghost-edebug'."
(let ((e (get name 'edebug)))
(if (consp e)
e
(let ((g (get name 'ghost-edebug)))
(if (consp g)
g
e)))))
;; Define a structure to represent offset positions of expressions.
;; Each offset structure looks like: (before . after) for constituents,
;; or for structures that have elements: (before <subexpressions> . after)
@@ -1168,6 +1183,12 @@ purpose by adding an entry to this alist, and setting
;; Not edebugging this form, so reset the symbol's edebug
;; property to be just a marker at the definition's source code.
;; This only works for defs with simple names.
;; Preserve the `edebug' property in case there's
;; debugging still under way.
(let ((ghost (get def-name 'edebug)))
(if (consp ghost)
(put def-name 'ghost-edebug ghost)))
(put def-name 'edebug (point-marker))
;; Also nil out dependent defs.
'(mapcar (function
@@ -1411,6 +1432,8 @@ contains a circular object."
(cons window (window-start window)))))
;; Store the edebug data in symbol's property list.
;; We actually want to remove this property entirely, but can't.
(put edebug-def-name 'ghost-edebug nil)
(put edebug-def-name 'edebug
;; A struct or vector would be better here!!
(list edebug-form-begin-marker
@@ -1423,8 +1446,8 @@ contains a circular object."
)))
(defun edebug--restore-breakpoints (name)
(let ((data (get name 'edebug)))
(when (listp data)
(let ((data (edebug-get-edebug-or-ghost name)))
(when (consp data)
(let ((offsets (nth 2 data))
(breakpoints (nth 1 data))
(start (nth 0 data))
@@ -3128,7 +3151,7 @@ before returning. The default is one second."
;; Return (function . index) of the nearest edebug stop point.
(let* ((edebug-def-name (edebug-form-data-symbol))
(edebug-data
(let ((data (get edebug-def-name 'edebug)))
(let ((data (edebug-get-edebug-or-ghost edebug-def-name)))
(if (or (null data) (markerp data))
(error "%s is not instrumented for Edebug" edebug-def-name))
data)) ; we could do it automatically, if data is a marker.
@@ -3165,7 +3188,7 @@ before returning. The default is one second."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
(edebug-data (get edebug-def-name 'edebug))
(edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3206,7 +3229,7 @@ the breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
(edebug-data (get edebug-def-name 'edebug))
(edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3244,7 +3267,7 @@ the breakpoint."
"\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
(defun edebug--overlay-breakpoints (function)
(let* ((data (get function 'edebug))
(let* ((data (edebug-get-edebug-or-ghost function))
(start (nth 0 data))
(breakpoints (nth 1 data))
(offsets (nth 2 data)))
@@ -3284,9 +3307,9 @@ With prefix argument, make it a temporary breakpoint."
(interactive "P")
;; If the form hasn't been instrumented yet, do it now.
(when (and (not edebug-active)
(let ((data (get (edebug--form-data-name
(edebug-get-form-data-entry (point)))
'edebug)))
(let ((data (edebug-get-edebug-or-ghost
(edebug--form-data-name
(edebug-get-form-data-entry (point))))))
(or (null data) (markerp data))))
(edebug-defun))
(edebug-modify-breakpoint t nil arg))
@@ -3300,7 +3323,7 @@ With prefix argument, make it a temporary breakpoint."
"Unset all the breakpoints in the current form."
(interactive)
(let* ((name (edebug-form-data-symbol))
(breakpoints (nth 1 (get name 'edebug))))
(breakpoints (nth 1 (edebug-get-edebug-or-ghost name))))
(unless breakpoints
(user-error "There are no breakpoints in %s" name))
(save-excursion
@@ -3316,7 +3339,7 @@ With prefix argument, make it a temporary breakpoint."
(user-error "No stop point near point"))
(let* ((name (car stop-point))
(index (cdr stop-point))
(data (get name 'edebug))
(data (edebug-get-edebug-or-ghost name))
(breakpoint (assq index (nth 1 data))))
(unless breakpoint
(user-error "No breakpoint near point"))
@@ -3497,7 +3520,7 @@ instrument cannot be found, signal an error."
(goto-char func-marker)
(edebug-eval-top-level-form)
(list func)))
((consp func-marker)
((and (consp func-marker) (consp (symbol-function func)))
(message "%s is already instrumented." func)
(list func))
(t
@@ -4270,7 +4293,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
(let* ((index (backtrace-get-index))
(frame (nth index backtrace-frames)))
(when (edebug--frame-def-name frame)
(let* ((data (get (edebug--frame-def-name frame) 'edebug))
(let* ((data (edebug-get-edebug-or-ghost (edebug--frame-def-name frame)))
(marker (nth 0 data))
(offsets (nth 2 data)))
(pop-to-buffer (marker-buffer marker))
@@ -4354,7 +4377,7 @@ reinstrument it."
(let* ((function (edebug-form-data-symbol))
(counts (get function 'edebug-freq-count))
(coverages (get function 'edebug-coverage))
(data (get function 'edebug))
(data (edebug-get-edebug-or-ghost function))
(def-mark (car data)) ; mark at def start
(edebug-points (nth 2 data))
(i (1- (length edebug-points)))
@@ -4512,7 +4535,7 @@ With prefix argument, make it a temporary breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
(edebug-data (get edebug-def-name 'edebug))
(edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
(edebug-breakpoints (car (cdr edebug-data)))
(edebug-break-data (assq index edebug-breakpoints))
(edebug-break-condition (car (cdr edebug-break-data)))

3
lisp/emacs-lisp/eieio-base.el
View File

@@ -473,8 +473,7 @@ instance."
(let* ((cfn (or file (oref this file)))
(default-directory (file-name-directory cfn)))
(cl-letf ((standard-output (current-buffer))
(inhibit-modification-hooks t)
((oref this file) ;FIXME: Why change it?
((oref this file) ;FIXME: Why change it?
(if file
;; FIXME: Makes a name relative to (oref this file),
;; whereas I think it should be relative to cfn.

19
lisp/emacs-lisp/eieio.el
View File

@@ -351,21 +351,20 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the
contents of field NAME is matched against PAT, or they can be of
the form NAME which is a shorthand for (NAME NAME)."
(declare (debug (&rest [&or (sexp pcase-PAT) sexp])))
(let ((is (make-symbol "table")))
;; FIXME: This generates a horrendous mess of redundant let bindings.
;; `pcase' needs to be improved somehow to introduce let-bindings more
;; sparingly, or the byte-compiler needs to be taught to optimize
;; them away.
;; FIXME: `pcase' does not do a good job here of sharing tests&code among
;; various branches.
`(and (pred eieio-object-p)
;; FIXME: This generates a horrendous mess of redundant let bindings.
;; `pcase' needs to be improved somehow to introduce let-bindings more
;; sparingly, or the byte-compiler needs to be taught to optimize
;; them away.
;; FIXME: `pcase' does not do a good job here of sharing tests&code among
;; various branches.
`(and (pred eieio-object-p)
,@(mapcar (lambda (field)
(pcase-exhaustive field
(`(,name ,pat)
`(app (pcase--flip eieio-oref ',name) ,pat))
`(app (pcase--flip eieio-oref ',name) ,pat))
((pred symbolp)
`(app (pcase--flip eieio-oref ',field) ,field))))
fields))))
fields)))
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.

5
lisp/emacs-lisp/eldoc.el
View File

@@ -5,6 +5,11 @@
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: extensions
;; Created: 1995-10-06
;; Version: 1.0.0
;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.

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

@@ -344,7 +344,8 @@ of the elements of LIST is performed as if by `pcase-let'.
(seen '())
(codegen
(lambda (code vars)
(let ((prev (assq code seen)))
(let ((vars (pcase--fgrep vars code))
(prev (assq code seen)))
(if (not prev)
(let ((res (pcase-codegen code vars)))
(push (list code vars res) seen)
@@ -398,7 +399,10 @@ of the elements of LIST is performed as if by `pcase-let'.
(if (pcase--small-branch-p (cdr case))
;; Don't bother sharing multiple
;; occurrences of this leaf since it's small.
#'pcase-codegen codegen)
(lambda (code vars)
(pcase-codegen code
(pcase--fgrep vars code)))
codegen)
(cdr case)
vars))))
cases))))
@@ -687,14 +691,22 @@ MATCH is the pattern that needs to be matched, of the form:
'(nil . :pcase--fail)
'(:pcase--fail . nil))))))
(defun pcase--fgrep (vars sexp)
"Check which of the symbols VARS appear in SEXP."
(defun pcase--fgrep (bindings sexp)
"Return those of the BINDINGS which might be used in SEXP."
(let ((res '()))
(while (consp sexp)
(dolist (var (pcase--fgrep vars (pop sexp)))
(unless (memq var res) (push var res))))
(and (memq sexp vars) (not (memq sexp res)) (push sexp res))
res))
(while (and (consp sexp) bindings)
(dolist (binding (pcase--fgrep bindings (pop sexp)))
(push binding res)
(setq bindings (remove binding bindings))))
(if (vectorp sexp)
;; With backquote, code can appear within vectors as well.
;; This wouldn't be needed if we `macroexpand-all' before
;; calling pcase--fgrep, OTOH.
(pcase--fgrep bindings (mapcar #'identity sexp))
(let ((tmp (assq sexp bindings)))
(if tmp
(cons tmp res)
res)))))
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (integerp upat) (stringp upat)))
@@ -734,13 +746,11 @@ MATCH is the pattern that needs to be matched, of the form:
"Build a function call to FUN with arg ARG."
(if (symbolp fun)
`(,fun ,arg)
(let* (;; `vs' is an upper bound on the vars we need.
(vs (pcase--fgrep (mapcar #'car vars) fun))
(env (mapcar (lambda (var)
(list var (cdr (assq var vars))))
vs))
(let* (;; `env' is an upper bound on the bindings we need.
(env (mapcar (lambda (x) (list (car x) (cdr x)))
(pcase--fgrep vars fun)))
(call (progn
(when (memq arg vs)
(when (assq arg env)
;; `arg' is shadowed by `env'.
(let ((newsym (gensym "x")))
(push (list newsym arg) env)
@@ -748,7 +758,7 @@ MATCH is the pattern that needs to be matched, of the form:
(if (functionp fun)
`(funcall #',fun ,arg)
`(,@fun ,arg)))))
(if (null vs)
(if (null env)
call
;; Let's not replace `vars' in `fun' since it's
;; too difficult to do it right, instead just
@@ -759,10 +769,12 @@ MATCH is the pattern that needs to be matched, of the form:
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
(if found (cdr found)
(let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
(env (mapcar (lambda (v) (list v (cdr (assq v vars))))
vs)))
(if env (macroexp-let* env exp) exp)))))
(let* ((env (pcase--fgrep vars exp)))
(if env
(macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
env)
exp)
exp)))))
;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems.

62
lisp/emacs-lisp/syntax.el
View File

@@ -63,9 +63,10 @@ override the buffer's syntax table for special syntactic constructs that
cannot be handled just by the buffer's syntax-table.
The specified function may call `syntax-ppss' on any position
before END, but it should not call `syntax-ppss-flush-cache',
which means that it should not call `syntax-ppss' on some
position and later modify the buffer on some earlier position.")
before END, but if it calls `syntax-ppss' on some
position and later modifies the buffer on some earlier position,
then it is its responsability to call `syntax-ppss-flush-cache' to flush
the now obsolete ppss info from the cache.")
(defvar syntax-propertize-chunk-size 500)
@@ -320,6 +321,11 @@ END) suitable for `syntax-propertize-function'."
(defvar-local syntax-ppss-table nil
"Syntax-table to use during `syntax-ppss', if any.")
(defvar-local syntax-propertize--inhibit-flush nil
"If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache.
Otherwise it flushes both the ppss cache and the properties
set by `syntax-propertize'")
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS (a buffer point)."
(when (< syntax-propertize--done pos)
@@ -345,23 +351,27 @@ END) suitable for `syntax-propertize-function'."
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
(funs syntax-propertize-extend-region-functions))
(while funs
(let ((new (funcall (pop funs) start end))
;; Avoid recursion!
(syntax-propertize--done most-positive-fixnum))
(if (or (null new)
(and (>= (car new) start) (<= (cdr new) end)))
nil
(setq start (car new))
(setq end (cdr new))
;; If there's been a change, we should go through the
;; list again since this new position may
;; warrant a different answer from one of the funs we've
;; already seen.
(unless (eq funs
(cdr syntax-propertize-extend-region-functions))
(setq funs syntax-propertize-extend-region-functions)))))
(first t)
(repeat t))
(while repeat
(setq repeat nil)
(run-hook-wrapped
'syntax-propertize-extend-region-functions
(lambda (f)
(let ((new (funcall f start end))
;; Avoid recursion!
(syntax-propertize--done most-positive-fixnum))
(if (or (null new)
(and (>= (car new) start) (<= (cdr new) end)))
nil
(setq start (car new))
(setq end (cdr new))
;; If there's been a change, we should go through the
;; list again since this new position may
;; warrant a different answer from one of the funs we've
;; already seen.
(unless first (setq repeat t))))
(setq first nil))))
;; Flush ppss cache between the original value of `start' and that
;; set above by syntax-propertize-extend-region-functions.
(syntax-ppss-flush-cache start)
@@ -371,8 +381,13 @@ END) suitable for `syntax-propertize-function'."
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
;; Avoid recursion!
(let ((syntax-propertize--done most-positive-fixnum))
;; Make sure we only let-bind it buffer-locally.
(make-local-variable 'syntax-propertize--inhibit-flush)
;; Let-bind `syntax-propertize--done' to avoid infinite recursion!
(let ((syntax-propertize--done most-positive-fixnum)
;; Let `syntax-propertize-function' call
;; `syntax-ppss-flush-cache' without worries.
(syntax-propertize--inhibit-flush t))
(funcall syntax-propertize-function start end)))))))))
;;; Link syntax-propertize with syntax.c.
@@ -451,7 +466,8 @@ These are valid when the buffer has no restriction.")
(defun syntax-ppss-flush-cache (beg &rest ignored)
"Flush the cache of `syntax-ppss' starting at position BEG."
;; Set syntax-propertize to refontify anything past beg.
(setq syntax-propertize--done (min beg syntax-propertize--done))
(unless syntax-propertize--inhibit-flush
(setq syntax-propertize--done (min beg syntax-propertize--done)))
;; Flush invalid cache entries.
(dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
(pcase cell

132
lisp/emacs-lisp/timer-list.el
View File

@@ -32,41 +32,49 @@
"List all timers in a buffer."
(interactive)
(pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
(let ((inhibit-read-only t))
(erase-buffer)
(timer-list-mode)
(dolist (timer (append timer-list timer-idle-list))
(insert (format "%4s %10s %8s %s"
;; Idle.
(if (aref timer 7) "*" " ")
;; Next time.
(let ((time (list (aref timer 1)
(aref timer 2)
(aref timer 3))))
(format "%.2f"
(float-time
(if (aref timer 7)
time
(time-subtract time nil)))))
;; Repeat.
(let ((repeat (aref timer 4)))
(cond
((numberp repeat)
(format "%.1f" repeat))
((null repeat)
"-")
(t
(format "%s" repeat))))
;; Function.
(let ((cl-print-compiled 'static)
(cl-print-compiled-button nil)
(print-escape-newlines t))
(cl-prin1-to-string (aref timer 5)))))
(put-text-property (line-beginning-position)
(1+ (line-beginning-position))
'timer timer)
(insert "\n")))
(goto-char (point-min)))
(timer-list-mode)
(tabulated-list-init-header)
(setq tabulated-list-entries
(mapcar
(lambda (timer)
(list
nil
`[ ;; Idle.
,(propertize
(if (aref timer 7) " *" " ")
'help-echo "* marks idle timers"
'timer timer)
;; Next time.
,(propertize
(let ((time (list (aref timer 1)
(aref timer 2)
(aref timer 3))))
(format "%10.2f"
(float-time
(if (aref timer 7)
time
(time-subtract time nil)))))
'help-echo "Time in sec till next invocation")
;; Repeat.
,(propertize
(let ((repeat (aref timer 4)))
(cond
((numberp repeat)
(format "%8.1f" repeat))
((null repeat)
" -")
(t
(format "%8s" repeat))))
'help-echo "Symbol: repeat; number: repeat interval in sec")
;; Function.
,(propertize
(let ((cl-print-compiled 'static)
(cl-print-compiled-button nil)
(print-escape-newlines t))
(cl-prin1-to-string (aref timer 5)))
'help-echo "Function called by timer")]))
(append timer-list timer-idle-list)))
(tabulated-list-print))
;; This command can be destructive if they don't know what they are
;; doing. Kids, don't try this at home!
;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
@@ -74,35 +82,47 @@
(defvar timer-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "c" 'timer-list-cancel)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(easy-menu-define nil map ""
'("Timers"
["Cancel" timer-list-cancel t]))
map))
(define-derived-mode timer-list-mode special-mode "Timer-List"
(define-derived-mode timer-list-mode tabulated-list-mode "Timer-List"
"Mode for listing and controlling timers."
(setq bidi-paragraph-direction 'left-to-right)
(setq truncate-lines t)
(buffer-disable-undo)
(setq-local revert-buffer-function #'list-timers)
(setq buffer-read-only t)
(setq header-line-format
(concat (propertize " " 'display '(space :align-to 0))
(format "%4s %10s %8s %s"
(propertize "Idle"
'mouse-face 'highlight
'help-echo "* marks idle timers")
(propertize "Next"
'mouse-face 'highlight
'help-echo "Time in sec till next invocation")
(propertize "Repeat"
'mouse-face 'highlight
'help-echo "Symbol: repeat; number: repeat interval in sec")
(propertize "Function"
'mouse-face 'highlight
'help-echo "Function called by timer")))))
(setq tabulated-list-format
'[("Idle" 6 timer-list--idle-predicate)
(" Next" 12 timer-list--next-predicate)
(" Repeat" 11 timer-list--repeat-predicate)
("Function" 10 timer-list--function-predicate)]))
(defun timer-list--idle-predicate (A B)
"Predicate to sort Timer-List by the Idle column."
(let ((iA (aref (cadr A) 0))
(iB (aref (cadr B) 0)))
(cond ((string= iA iB)
(timer-list--next-predicate A B))
((string= iA " *") nil)
(t t))))
(defun timer-list--next-predicate (A B)
"Predicate to sort Timer-List by the Next column."
(let ((nA (string-to-number (aref (cadr A) 1)))
(nB (string-to-number (aref (cadr B) 1))))
(< nA nB)))
(defun timer-list--repeat-predicate (A B)
"Predicate to sort Timer-List by the Repeat column."
(let ((rA (aref (cadr A) 2))
(rB (aref (cadr B) 2)))
(string< rA rB)))
(defun timer-list--function-predicate (A B)
"Predicate to sort Timer-List by the Next column."
(let ((fA (aref (cadr A) 3))
(fB (aref (cadr B) 3)))
(string< fA fB)))
(defun timer-list-cancel ()
"Cancel the timer on the line under point."

6
lisp/gnus/gmm-utils.el
View File

@@ -168,9 +168,9 @@ ARGS are passed to `message'."
(defcustom gmm-tool-bar-style
(if (and (boundp 'tool-bar-mode)
tool-bar-mode
(memq (display-visual-class)
(list 'static-gray 'gray-scale
'static-color 'pseudo-color)))
(not (memq (display-visual-class)
(list 'static-gray 'gray-scale
'static-color 'pseudo-color))))
'gnome
'retro)
"Preferred tool bar style."

2
lisp/gnus/message.el
View File

@@ -7984,7 +7984,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list."
(defcustom message-tool-bar-retro
'(;; Old Emacs 21 icon for consistency.
(message-send-and-exit "gnus/mail-send")
(message-send-and-exit "mail/send")
(message-kill-buffer "close")
(message-dont-send "cancel")
(mml-attach-file "attach" mml-mode-map)

31
lisp/ielm.el
View File

@@ -44,8 +44,7 @@
(defcustom ielm-noisy t
"If non-nil, IELM will beep on error."
:type 'boolean
:group 'ielm)
:type 'boolean)
(defcustom ielm-prompt-read-only t
"If non-nil, the IELM prompt is read only.
@@ -74,7 +73,6 @@ buffers, including IELM buffers. If you sometimes use IELM on
text-only terminals or with `emacs -nw', you might wish to use
another binding for `comint-kill-whole-line'."
:type 'boolean
:group 'ielm
:version "22.1")
(defcustom ielm-prompt "ELISP> "
@@ -90,8 +88,7 @@ does not update the prompt of an *ielm* buffer with a running process.
For IELM buffers that are not called `*ielm*', you can execute
\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value,
for new prompts. This works even if the buffer has a running process."
:type 'string
:group 'ielm)
:type 'string)
(defvar ielm-prompt-internal "ELISP> "
"Stored value of `ielm-prompt' in the current IELM buffer.
@@ -103,8 +100,7 @@ customizes `ielm-prompt'.")
"Controls whether \\<ielm-map>\\[ielm-return] has intelligent behavior in IELM.
If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline
and indents for incomplete sexps. If nil, always inserts newlines."
:type 'boolean
:group 'ielm)
:type 'boolean)
(defcustom ielm-dynamic-multiline-inputs t
"Force multiline inputs to start from column zero?
@@ -112,15 +108,13 @@ If non-nil, after entering the first line of an incomplete sexp, a newline
will be inserted after the prompt, moving the input to the next line.
This gives more frame width for large indented sexps, and allows functions
such as `edebug-defun' to work with such inputs."
:type 'boolean
:group 'ielm)
:type 'boolean)
(defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook)
(defcustom ielm-mode-hook nil
"Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
:options '(eldoc-mode)
:type 'hook
:group 'ielm)
:type 'hook)
;; We define these symbols (that are only used buffer-locally in ielm
;; buffers) this way to avoid having them be defined in the global
@@ -366,9 +360,9 @@ nonempty, then flushes the buffer."
;; that same let. To avoid problems, neither of
;; these buffers should be alive during the
;; evaluation of form.
(let* ((*1 *)
(*2 **)
(*3 ***)
(let* ((*1 (bound-and-true-p *))
(*2 (bound-and-true-p **))
(*3 (bound-and-true-p ***))
(active-process (ielm-process))
(old-standard-output standard-output)
new-standard-output
@@ -453,11 +447,12 @@ nonempty, then flushes the buffer."
(if error-type
(progn
(when ielm-noisy (ding))
(setq output (concat output "*** " error-type " *** "))
(setq output (concat output result)))
(setq output (concat output
"*** " error-type " *** "
result)))
;; There was no error, so shift the *** values
(setq *** **)
(setq ** *)
(setq *** (bound-and-true-p **))
(setq ** (bound-and-true-p *))
(setq * result))
(when (or (not for-effect) (not (equal output "")))
(setq output (concat output "\n"))))

6
lisp/jsonrpc.el
View File

@@ -4,11 +4,11 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
;; Package-Requires: ((emacs "25.2"))
;; Version: 1.0.11
;; Package-Requires: ((emacs "25.2"))
;; This is an Elpa :core package. Don't use functionality that is not
;; compatible with Emacs 25.2.
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

79
lisp/net/browse-url.el
View File

@@ -127,8 +127,10 @@
;; is not sensible to invoke an external browser with it, so here only
;; internal browsers are considered. Therefore, it is advised to put
;; that property also on custom browser functions.
;; (put 'my-browse-url-in-emacs 'browse-url-browser-kind 'internal)
;; (put 'my-browse-url-externally 'browse-url-browser-kind 'external)
;; (function-put 'my-browse-url-in-emacs 'browse-url-browser-kind
;; 'internal)
;; (function-put 'my-browse-url-externally 'browse-url-browser-kind
;; 'external)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
@@ -621,8 +623,8 @@ process), or nil (we don't know)."
(defun browse-url--browser-kind-mailto (url)
(browse-url--browser-kind browse-url-mailto-function url))
(put 'browse-url--mailto 'browse-url-browser-kind
#'browse-url--browser-kind-mailto)
(function-put 'browse-url--mailto 'browse-url-browser-kind
#'browse-url--browser-kind-mailto)
(defun browse-url--man (url &rest args)
"Calls `browse-url-man-function' with URL and ARGS."
@@ -630,8 +632,8 @@ process), or nil (we don't know)."
(defun browse-url--browser-kind-man (url)
(browse-url--browser-kind browse-url-man-function url))
(put 'browse-url--man 'browse-url-browser-kind
#'browse-url--browser-kind-man)
(function-put 'browse-url--man 'browse-url-browser-kind
#'browse-url--browser-kind-man)
(defun browse-url--browser (url &rest args)
"Calls `browse-url-browser-function' with URL and ARGS."
@@ -639,8 +641,8 @@ process), or nil (we don't know)."
(defun browse-url--browser-kind-browser (url)
(browse-url--browser-kind browse-url-browser-function url))
(put 'browse-url--browser 'browse-url-browser-kind
#'browse-url--browser-kind-browser)
(function-put 'browse-url--browser 'browse-url-browser-kind
#'browse-url--browser-kind-browser)
(defun browse-url--non-html-file-url-p (url)
"Return non-nil if URL is a file:// URL of a non-HTML file."
@@ -1010,8 +1012,8 @@ The optional NEW-WINDOW argument is not used."
(url-unhex-string url)
url)))))
(put 'browse-url-default-windows-browser 'browse-url-browser-kind
'external)
(function-put 'browse-url-default-windows-browser 'browse-url-browser-kind
'external)
(defun browse-url-default-macosx-browser (url &optional _new-window)
"Invoke the macOS system's default Web browser.
@@ -1019,8 +1021,8 @@ The optional NEW-WINDOW argument is not used."
(interactive (browse-url-interactive-arg "URL: "))
(start-process (concat "open " url) nil "open" url))
(put 'browse-url-default-macosx-browser 'browse-url-browser-kind
'external)
(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind
'external)
;; --- Netscape ---
@@ -1078,9 +1080,9 @@ instead of `browse-url-new-window-flag'."
(lambda (&rest _ignore) (error "No usable browser found"))))
url args))
(put 'browse-url-default-browser 'browse-url-browser-kind
;; Well, most probably external if we ignore w3.
'external)
(function-put 'browse-url-default-browser 'browse-url-browser-kind
;; Well, most probably external if we ignore w3.
'external)
(defun browse-url-can-use-xdg-open ()
"Return non-nil if the \"xdg-open\" program can be used.
@@ -1101,7 +1103,7 @@ The optional argument IGNORED is not used."
(interactive (browse-url-interactive-arg "URL: "))
(call-process "xdg-open" nil 0 nil url))
(put 'browse-url-xdg-open 'browse-url-browser-kind 'external)
(function-put 'browse-url-xdg-open 'browse-url-browser-kind 'external)
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
@@ -1146,7 +1148,7 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-netscape-sentinel process ,url)))))
(put 'browse-url-netscape 'browse-url-browser-kind 'external)
(function-put 'browse-url-netscape 'browse-url-browser-kind 'external)
(defun browse-url-netscape-sentinel (process url)
"Handle a change to the process communicating with Netscape."
@@ -1218,7 +1220,7 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-mozilla-sentinel process ,url)))))
(put 'browse-url-mozilla 'browse-url-browser-kind 'external)
(function-put 'browse-url-mozilla 'browse-url-browser-kind 'external)
(defun browse-url-mozilla-sentinel (process url)
"Handle a change to the process communicating with Mozilla."
@@ -1260,7 +1262,7 @@ instead of `browse-url-new-window-flag'."
'("-new-window")))
(list url)))))
(put 'browse-url-firefox 'browse-url-browser-kind 'external)
(function-put 'browse-url-firefox 'browse-url-browser-kind 'external)
;;;###autoload
(defun browse-url-chromium (url &optional _new-window)
@@ -1279,7 +1281,7 @@ The optional argument NEW-WINDOW is not used."
browse-url-chromium-arguments
(list url)))))
(put 'browse-url-chromium 'browse-url-browser-kind 'external)
(function-put 'browse-url-chromium 'browse-url-browser-kind 'external)
(defun browse-url-chrome (url &optional _new-window)
"Ask the Google Chrome WWW browser to load URL.
@@ -1297,7 +1299,7 @@ The optional argument NEW-WINDOW is not used."
browse-url-chrome-arguments
(list url)))))
(put 'browse-url-chrome 'browse-url-browser-kind 'external)
(function-put 'browse-url-chrome 'browse-url-browser-kind 'external)
;;;###autoload
(defun browse-url-galeon (url &optional new-window)
@@ -1336,7 +1338,7 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-galeon-sentinel process ,url)))))
(put 'browse-url-galeon 'browse-url-browser-kind 'external)
(function-put 'browse-url-galeon 'browse-url-browser-kind 'external)
(defun browse-url-galeon-sentinel (process url)
"Handle a change to the process communicating with Galeon."
@@ -1384,7 +1386,7 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-epiphany-sentinel process ,url)))))
(put 'browse-url-epiphany 'browse-url-browser-kind 'external)
(function-put 'browse-url-epiphany 'browse-url-browser-kind 'external)
(defun browse-url-epiphany-sentinel (process url)
"Handle a change to the process communicating with Epiphany."
@@ -1410,7 +1412,7 @@ currently selected window instead."
file-name-handler-alist)))
(if same-window (find-file url) (find-file-other-window url))))
(put 'browse-url-emacs 'browse-url-browser-kind 'internal)
(function-put 'browse-url-emacs 'browse-url-browser-kind 'internal)
;;;###autoload
(defun browse-url-gnome-moz (url &optional new-window)
@@ -1436,7 +1438,7 @@ used instead of `browse-url-new-window-flag'."
'("--newwin"))
(list "--raise" url))))
(put 'browse-url-gnome-moz 'browse-url-browser-kind 'external)
(function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external)
;; --- Mosaic ---
@@ -1489,7 +1491,7 @@ used instead of `browse-url-new-window-flag'."
(append browse-url-mosaic-arguments (list url)))
(message "Starting %s...done" browse-url-mosaic-program))))
(put 'browse-url-mosaic 'browse-url-browser-kind 'external)
(function-put 'browse-url-mosaic 'browse-url-browser-kind 'external)
;; --- Mosaic using CCI ---
@@ -1523,7 +1525,7 @@ used instead of `browse-url-new-window-flag'."
(process-send-string "browse-url" "disconnect\r\n")
(delete-process "browse-url"))
(put 'browse-url-cci 'browse-url-browser-kind 'external)
(function-put 'browse-url-cci 'browse-url-browser-kind 'external)
;; --- Conkeror ---
;;;###autoload
@@ -1562,7 +1564,7 @@ NEW-WINDOW instead of `browse-url-new-window-flag'."
"buffer")
url))))))
(put 'browse-url-conkeror 'browse-url-browser-kind 'external)
(function-put 'browse-url-conkeror 'browse-url-browser-kind 'external)
;; --- W3 ---
@@ -1587,7 +1589,7 @@ used instead of `browse-url-new-window-flag'."
(w3-fetch-other-window url)
(w3-fetch url)))
(put 'browse-url-w3 'browse-url-browser-kind 'internal)
(function-put 'browse-url-w3 'browse-url-browser-kind 'internal)
;;;###autoload
(defun browse-url-w3-gnudoit (url &optional _new-window)
@@ -1603,7 +1605,7 @@ The `browse-url-gnudoit-program' program is used with options given by
(list (concat "(w3-fetch \"" url "\")")
"(raise-frame)"))))
(put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal)
(function-put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal)
;; --- Lynx in an xterm ---
@@ -1622,7 +1624,7 @@ The optional argument NEW-WINDOW is not used."
,@browse-url-xterm-args "-e" ,browse-url-text-browser
,url)))
(put 'browse-url-text-xterm 'browse-url-browser-kind 'external)
(function-put 'browse-url-text-xterm 'browse-url-browser-kind 'external)
;; --- Lynx in an Emacs "term" window ---
@@ -1698,7 +1700,7 @@ used instead of `browse-url-new-window-flag'."
url
"\r")))))
(put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
;; --- mailto ---
@@ -1747,7 +1749,7 @@ used instead of `browse-url-new-window-flag'."
(unless (bolp)
(insert "\n"))))))))
(put 'browse-url-mail 'browse-url-browser-kind 'internal)
(function-put 'browse-url-mail 'browse-url-browser-kind 'internal)
;; --- man ---
@@ -1762,7 +1764,7 @@ used instead of `browse-url-new-window-flag'."
((executable-find manual-program) (man url))
(t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url)))))
(put 'browse-url-man 'browse-url-browser-kind 'internal)
(function-put 'browse-url-man 'browse-url-browser-kind 'internal)
;; --- Random browser ---
@@ -1781,7 +1783,7 @@ don't offer a form of remote control."
0 nil
(append browse-url-generic-args (list url))))
(put 'browse-url-generic 'browse-url-browser-kind 'external)
(function-put 'browse-url-generic 'browse-url-browser-kind 'external)
;;;###autoload
(defun browse-url-kde (url &optional _new-window)
@@ -1793,7 +1795,7 @@ The optional argument NEW-WINDOW is not used."
(apply #'start-process (concat "KDE " url) nil browse-url-kde-program
(append browse-url-kde-args (list url))))
(put 'browse-url-kde 'browse-url-browser-kind 'external)
(function-put 'browse-url-kde 'browse-url-browser-kind 'external)
(defun browse-url-elinks-new-window (url)
"Ask the Elinks WWW browser to load URL in a new window."
@@ -1804,7 +1806,8 @@ The optional argument NEW-WINDOW is not used."
browse-url-elinks-wrapper
(list "elinks" url)))))
(put 'browse-url-elinks-new-window 'browse-url-browser-kind 'external)
(function-put 'browse-url-elinks-new-window 'browse-url-browser-kind
'external)
;;;###autoload
(defun browse-url-elinks (url &optional new-window)
@@ -1827,7 +1830,7 @@ from `browse-url-elinks-wrapper'."
`(lambda (process change)
(browse-url-elinks-sentinel process ,url))))))
(put 'browse-url-elinks 'browse-url-browser-kind 'external)
(function-put 'browse-url-elinks 'browse-url-browser-kind 'external)
(defun browse-url-elinks-sentinel (process url)
"Determines if Elinks is running or a new one has to be started."

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

@@ -125,7 +125,10 @@
(autoload 'zeroconf-init "zeroconf")
(tramp-compat-funcall 'dbus-get-unique-name :system)
(tramp-compat-funcall 'dbus-get-unique-name :session)
(or (tramp-process-running-p "gvfs-fuse-daemon")
(or ;; Until Emacs 25, `process-attributes' could crash Emacs
;; for some processes. Better we don't check.
(<= emacs-major-version 25)
(tramp-process-running-p "gvfs-fuse-daemon")
(tramp-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")

15
lisp/net/tramp.el
View File

@@ -3783,7 +3783,8 @@ support symbolic links."
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files.
BUFFER might be a list, in this case STDERR is separated."
;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only.
;; `make-process' knows the `:file-handler' argument since Emacs
;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'.
(tramp-file-name-handler
'make-process
:name name
@@ -4857,13 +4858,13 @@ verbosity of 6."
"Return t if system process PROCESS-NAME is running for `user-login-name'."
(when (stringp process-name)
(catch 'result
(dolist (pid (tramp-compat-funcall 'list-system-processes))
(let ((attributes (process-attributes pid)))
(dolist (pid (list-system-processes))
(when-let ((attributes (process-attributes pid))
(comm (cdr (assoc 'comm attributes))))
(and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
(when-let ((comm (cdr (assoc 'comm attributes))))
;; The returned command name could be truncated to 15
;; characters. Therefore, we cannot check for `string-equal'.
(string-prefix-p comm process-name))
;; The returned command name could be truncated to 15
;; characters. Therefore, we cannot check for `string-equal'.
(string-prefix-p comm process-name)
(throw 'result t)))))))
(defun tramp-read-passwd (proc &optional prompt)

4
lisp/play/animate.el
View File

@@ -1,4 +1,4 @@
;;; animate.el --- make text dance
;;; animate.el --- make text dance -*- lexical-binding:t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
@@ -84,7 +84,7 @@
(defun animate-place-char (char vpos hpos)
(goto-char (window-start))
(let (abbrev-mode)
(dotimes (i vpos)
(dotimes (_ vpos)
(end-of-line)
(if (= (forward-line 1) 1)
(insert "\n"))))

2
lisp/play/dissociate.el
View File

@@ -1,4 +1,4 @@
;;; dissociate.el --- scramble text amusingly for Emacs
;;; dissociate.el --- scramble text amusingly for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.

5
lisp/progmodes/flymake.el
View File

@@ -5,8 +5,11 @@
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Version: 1.0.8
;; Package-Requires: ((emacs "26.1"))
;; Keywords: c languages tools
;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.

11
lisp/progmodes/glasses.el
View File

@@ -1,4 +1,4 @@
;;; glasses.el --- make cantReadThis readable
;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -66,7 +66,6 @@ defined by `glasses-original-separator'. If you don't want to add missing
separators, set `glasses-separator' to an empty string. If you don't want to
replace existent separators, set `glasses-original-separator' to an empty
string."
:group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -78,7 +77,6 @@ For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
underscore separators are displayed as hyphens.
If `glasses-original-separator' is an empty string, no such display change is
performed."
:group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default
@@ -92,7 +90,6 @@ If it is nil, no face is placed at the capitalized letter.
For example, you can set `glasses-separator' to an empty string and
`glasses-face' to `bold'. Then unreadable identifiers will have no separators,
but will have their capitals in bold."
:group 'glasses
:type '(choice (const :tag "None" nil) face)
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -100,7 +97,6 @@ but will have their capitals in bold."
(defcustom glasses-separate-parentheses-p t
"If non-nil, ensure space between an identifier and an opening parenthesis."
:group 'glasses
:type 'boolean)
(defcustom glasses-separate-parentheses-exceptions
@@ -108,7 +104,6 @@ but will have their capitals in bold."
"List of regexp that are exceptions for `glasses-separate-parentheses-p'.
They are matched to the current line truncated to the point where the
parenthesis expression starts."
:group 'glasses
:type '(repeat regexp))
(defcustom glasses-separate-capital-groups t
@@ -116,7 +111,6 @@ parenthesis expression starts."
When the value is non-nil, HTMLSomething and IPv6 are displayed
as HTML_Something and I_Pv6 respectively. Set the value to nil
if you prefer to display them unchanged."
:group 'glasses
:type 'boolean
:version "24.1")
@@ -124,7 +118,6 @@ if you prefer to display them unchanged."
"If non-nil, downcase embedded capital letters in identifiers.
Only identifiers starting with lower case letters are affected, letters inside
other identifiers are unchanged."
:group 'glasses
:type 'boolean
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -135,7 +128,6 @@ other identifiers are unchanged."
Only words starting with this regexp are uncapitalized.
The regexp is case sensitive.
It has any effect only when `glasses-uncapitalize-p' is non-nil."
:group 'glasses
:type 'regexp
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -149,7 +141,6 @@ file write then.
Note the removal action does not try to be much clever, so it can remove real
separators too."
:group 'glasses
:type 'boolean)

5
lisp/progmodes/project.el
View File

@@ -1,6 +1,11 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
;; Version: 0.1
;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid using functionality that
;; not compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.

5
lisp/progmodes/xref.el
View File

@@ -1,6 +1,11 @@
;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
;; Version: 1.0.0
;; Package-Requires: ((emacs "26.3") (project "0.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.

18
lisp/subr.el
View File

@@ -262,10 +262,9 @@ Then evaluate RESULT to get return value, default nil.
;; use dolist.
;; FIXME: This cost disappears in byte-compiled lexical-binding files.
(let ((temp '--dolist-tail--))
;; This is not a reliable test, but it does not matter because both
;; semantics are acceptable, tho one is slightly faster with dynamic
;; scoping and the other is slightly faster (and has cleaner semantics)
;; with lexical scoping.
;; This test does not matter much because both semantics are acceptable,
;; but one is slightly faster with dynamic scoping and the other is
;; slightly faster (and has cleaner semantics) with lexical scoping.
(if lexical-binding
`(let ((,temp ,(nth 1 spec)))
(while ,temp
@@ -297,9 +296,9 @@ the return value (nil if RESULT is omitted). Its use is deprecated.
(let ((temp '--dotimes-limit--)
(start 0)
(end (nth 1 spec)))
;; This is not a reliable test, but it does not matter because both
;; semantics are acceptable, tho one is slightly faster with dynamic
;; scoping and the other has cleaner semantics.
;; This test does not matter much because both semantics are acceptable,
;; but one is slightly faster with dynamic scoping and the other has
;; cleaner semantics.
(if lexical-binding
(let ((counter '--dotimes-counter--))
`(let ((,temp ,end)
@@ -4038,7 +4037,7 @@ the function `undo--wrap-and-run-primitive-undo'."
(defmacro combine-change-calls (beg end &rest body)
"Evaluate BODY, running the change hooks just once.
BODY is a sequence of lisp forms to evaluate. BEG and END bound
BODY is a sequence of Lisp forms to evaluate. BEG and END bound
the region the change hooks will be run for.
Firstly, `before-change-functions' is invoked for the region
@@ -4056,7 +4055,8 @@ change `before-change-functions' or `after-change-functions'.
Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single \(apply ...) entry containing
the function `undo--wrap-and-run-primitive-undo'. "
the function `undo--wrap-and-run-primitive-undo'."
(declare (debug t) (indent 2))
`(combine-change-calls-1 ,beg ,end (lambda () ,@body)))
(defun undo--wrap-and-run-primitive-undo (beg end list)

2
lisp/t-mouse.el
View File

@@ -1,4 +1,4 @@
;;; t-mouse.el --- mouse support within the text terminal
;;; t-mouse.el --- mouse support within the text terminal -*- lexical-binding:t -*-
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: emacs-devel@gnu.org

10
lisp/term/x-win.el
View File

@@ -1407,13 +1407,13 @@ This returns an error if any Emacs frames are X frames."
("etc/images/right-arrow" . ("go-next" "gtk-go-forward"))
("etc/images/home" . ("go-home" "gtk-home"))
("etc/images/jump-to" . ("go-jump" "gtk-jump-to"))
("etc/images/index" . "gtk-index")
("etc/images/index" . ("gtk-search" "gtk-index"))
("etc/images/exit" . ("application-exit" "gtk-quit"))
("etc/images/cancel" . "gtk-cancel")
("etc/images/info" . ("dialog-information" "gtk-info"))
("etc/images/bookmark_add" . "n:bookmark_add")
;; Used in Gnus and/or MH-E:
("etc/images/attach" . "gtk-attach")
("etc/images/attach" . ("mail-attachment" "gtk-attach"))
("etc/images/connect" . "gtk-connect")
("etc/images/contact" . "gtk-contact")
("etc/images/delete" . ("edit-delete" "gtk-delete"))
@@ -1425,14 +1425,16 @@ This returns an error if any Emacs frames are X frames."
("etc/images/lock" . "gtk-lock")
("etc/images/next-page" . "gtk-next-page")
("etc/images/refresh" . ("view-refresh" "gtk-refresh"))
("etc/images/search-replace" . "edit-find-replace")
("etc/images/sort-ascending" . ("view-sort-ascending" "gtk-sort-ascending"))
("etc/images/sort-column-ascending" . "gtk-sort-column-ascending")
("etc/images/sort-criteria" . "gtk-sort-criteria")
("etc/images/sort-descending" . ("view-sort-descending"
"gtk-sort-descending"))
("etc/images/sort-row-ascending" . "gtk-sort-row-ascending")
("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check"))
("images/gnus/toggle-subscription" . "gtk-task-recurring")
("images/mail/compose" . "gtk-mail-compose")
("images/mail/compose" . ("mail-message-new" "gtk-mail-compose"))
("images/mail/copy" . "gtk-mail-copy")
("images/mail/forward" . "gtk-mail-forward")
("images/mail/inbox" . "gtk-inbox")
@@ -1442,7 +1444,7 @@ This returns an error if any Emacs frames are X frames."
("images/mail/reply-all" . "gtk-mail-reply-to-all")
("images/mail/reply" . "gtk-mail-reply")
("images/mail/save-draft" . "gtk-mail-handling")
("images/mail/send" . "gtk-mail-send")
("images/mail/send" . ("mail-send" "gtk-mail-send"))
("images/mail/spam" . "gtk-spam")
;; Used for GDB Graphical Interface
("images/gud/break" . "gtk-no")

110
lisp/textmodes/bibtex.el
View File

@@ -440,7 +440,7 @@ If parsing fails, try to set this variable to nil."
"Alist of BibTeX entry types and their associated fields.
Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL).
ENTRY-TYPE is the type of a BibTeX entry.
DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
REQUIRED is a list of required fields.
CROSSREF is a list of fields that are optional if a crossref field
is present; but these fields are required otherwise.
@@ -1051,7 +1051,7 @@ See `bibtex-generate-autokey' for details."
(defvaralias 'bibtex-autokey-name-case-convert
'bibtex-autokey-name-case-convert-function)
(defcustom bibtex-autokey-name-case-convert-function 'downcase
(defcustom bibtex-autokey-name-case-convert-function #'downcase
"Function called for each name to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1127,7 +1127,7 @@ Case is significant. See `bibtex-generate-autokey' for details."
(defvaralias 'bibtex-autokey-titleword-case-convert
'bibtex-autokey-titleword-case-convert-function)
(defcustom bibtex-autokey-titleword-case-convert-function 'downcase
(defcustom bibtex-autokey-titleword-case-convert-function #'downcase
"Function called for each titleword to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1188,12 +1188,13 @@ See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
:type 'boolean)
(defcustom bibtex-autokey-before-presentation-function nil
"If non-nil, function to call before generated key is presented.
(defcustom bibtex-autokey-before-presentation-function #'identity
"Function to call before generated key is presented.
The function must take one argument (the automatically generated key),
and must return a string (the key to use)."
:group 'bibtex-autokey
:type '(choice (const nil) function))
:version "28.1"
:type 'function)
(defcustom bibtex-entry-offset 0
"Offset for BibTeX entries.
@@ -1242,7 +1243,7 @@ If non-nil, the column for the equal sign is the value of
:group 'bibtex
:type '(repeat string))
(defcustom bibtex-summary-function 'bibtex-summary
(defcustom bibtex-summary-function #'bibtex-summary
"Function to call for generating a summary of current BibTeX entry.
It takes no arguments. Point must be at beginning of entry.
Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'."
@@ -1660,7 +1661,7 @@ Initialized by `bibtex-set-dialect'.")
(defvar bibtex-font-lock-url-regexp
;; Assume that field names begin at the beginning of a line.
(concat "^[ \t]*"
(regexp-opt (delete-dups (mapcar 'caar bibtex-generate-url-list)) t)
(regexp-opt (delete-dups (mapcar #'caar bibtex-generate-url-list)) t)
"[ \t]*=[ \t]*")
"Regexp for `bibtex-font-lock-url' derived from `bibtex-generate-url-list'.")
@@ -1892,14 +1893,16 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings."
(let ((mtch (match-string-no-properties 0)))
(push (or (if bibtex-expand-strings
(cdr (assoc-string mtch (bibtex-strings) t)))
mtch) content)
mtch)
content)
(goto-char (match-end 0)))
(let ((bounds (bibtex-parse-field-string)))
(push (buffer-substring-no-properties
(1+ (car bounds)) (1- (cdr bounds))) content)
(1+ (car bounds)) (1- (cdr bounds)))
content)
(goto-char (cdr bounds))))
(re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t))
(apply 'concat (nreverse content))))
(apply #'concat (nreverse content))))
(buffer-substring-no-properties (bibtex-start-of-text-in-field bounds)
(bibtex-end-of-text-in-field bounds))))
@@ -2239,8 +2242,9 @@ Optional arg BEG is beginning of entry."
Optional arg COMMA is as in `bibtex-enclosing-field'."
(unless bibtex-last-kill-command (error "BibTeX kill ring is empty"))
(let ((fun (lambda (kryp kr) ; adapted from `current-kill'
(car (set kryp (nthcdr (mod (- n (length (eval kryp)))
(length kr)) kr))))))
(car (set kryp (nthcdr (mod (- n (length (symbol-value kryp)))
(length kr))
kr))))))
;; We put the mark at the beginning of the inserted field or entry
;; and point at its end - a behavior similar to what `yank' does.
;; The mark is then used by `bibtex-yank-pop', which needs to know
@@ -2251,7 +2255,8 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(goto-char (bibtex-end-of-field (bibtex-enclosing-field comma)))
(push-mark)
(bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer
bibtex-field-kill-ring) t nil t))
bibtex-field-kill-ring)
t nil t))
;; insert past the current entry
(bibtex-skip-to-valid-entry)
(push-mark)
@@ -2615,7 +2620,7 @@ Return optimized value to be used by `bibtex-format-entry'."
regexp-alist))
(let (opt-list)
;; Loop over field names
(dolist (field (delete-dups (apply 'append (mapcar 'car regexp-alist))))
(dolist (field (delete-dups (apply #'append (mapcar #'car regexp-alist))))
(let (rules)
;; Collect all matches we have for this field name
(dolist (e regexp-alist)
@@ -2623,7 +2628,7 @@ Return optimized value to be used by `bibtex-format-entry'."
(push (cons (nth 1 e) (nth 2 e)) rules)))
(if (eq type 'braces)
;; concatenate all regexps to a single regexp
(setq rules (concat "\\(?:" (mapconcat 'car rules "\\|") "\\)")))
(setq rules (concat "\\(?:" (mapconcat #'car rules "\\|") "\\)")))
;; create list of replacement rules.
(push (cons field rules) opt-list)))
opt-list))
@@ -2674,7 +2679,7 @@ and `bibtex-autokey-names-stretch'."
(if (string= "" names)
names
(let* ((case-fold-search t)
(name-list (mapcar 'bibtex-autokey-demangle-name
(name-list (mapcar #'bibtex-autokey-demangle-name
(split-string names "[ \t\n]+and[ \t\n]+")))
additional-names)
(unless (or (not (numberp bibtex-autokey-names))
@@ -2686,7 +2691,7 @@ and `bibtex-autokey-names-stretch'."
bibtex-autokey-names)
(nreverse name-list)))
additional-names bibtex-autokey-additional-names))
(concat (mapconcat 'identity name-list
(concat (mapconcat #'identity name-list
bibtex-autokey-name-separator)
additional-names)))))
@@ -2736,7 +2741,7 @@ Return the result as a string."
;; specific words and use only a specific amount of words.
(let ((counter 0)
(ignore-re (concat "\\`\\(?:"
(mapconcat 'identity
(mapconcat #'identity
bibtex-autokey-titleword-ignore "\\|")
"\\)\\'"))
titlewords titlewords-extra word)
@@ -2760,7 +2765,7 @@ Return the result as a string."
;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra.
(unless (string-match "\\b\\w+" titlestring)
(setq titlewords (append titlewords-extra titlewords)))
(mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords)
(mapconcat #'bibtex-autokey-demangle-title (nreverse titlewords)
bibtex-autokey-titleword-separator))))
(defun bibtex-autokey-demangle-title (titleword)
@@ -2837,7 +2842,7 @@ Concatenate the key:
non-empty insert `bibtex-autokey-name-year-separator' between the two.
If the title part and the year (or name) part are non-empty, insert
`bibtex-autokey-year-title-separator' between the two.
2. If `bibtex-autokey-before-presentation-function' is non-nil, it must be
2. `bibtex-autokey-before-presentation-function' must be
a function taking one argument. Call this function with the generated
key as the argument. Use the return value of this function (a string)
as the key.
@@ -2865,7 +2870,7 @@ Concatenate the key:
(defun bibtex-global-key-alist ()
"Return global key alist based on `bibtex-files'."
(if bibtex-files
(apply 'append
(apply #'append
(mapcar (lambda (buf)
(with-current-buffer buf bibtex-reference-keys))
;; include current buffer only if it uses `bibtex-mode'
@@ -3129,7 +3134,7 @@ does not use `bibtex-mode'."
(if buffer-list
(switch-to-buffer
(completing-read "Switch to BibTeX buffer: "
(mapcar 'buffer-name buffer-list)
(mapcar #'buffer-name buffer-list)
nil t
(if current (buffer-name (current-buffer)))))
(message "No BibTeX buffers defined")))
@@ -3178,7 +3183,7 @@ that is generated by calling `bibtex-url'."
Used as default value of `bibtex-summary-function'."
;; It would be neat to make this function customizable. How?
(if (looking-at bibtex-entry-maybe-empty-head)
(let* ((bibtex-autokey-name-case-convert-function 'identity)
(let* ((bibtex-autokey-name-case-convert-function #'identity)
(bibtex-autokey-name-length 'infty)
(bibtex-autokey-names 1)
(bibtex-autokey-names-stretch 0)
@@ -3189,7 +3194,7 @@ Used as default value of `bibtex-summary-function'."
(year (bibtex-autokey-get-year))
(bibtex-autokey-titlewords 5)
(bibtex-autokey-titlewords-stretch 2)
(bibtex-autokey-titleword-case-convert-function 'identity)
(bibtex-autokey-titleword-case-convert-function #'identity)
(bibtex-autokey-titleword-length 5)
(bibtex-autokey-titleword-separator " ")
(title (bibtex-autokey-get-title))
@@ -3336,12 +3341,12 @@ BOUND limits the search."
(define-button-type 'bibtex-url
'action 'bibtex-button-action
'bibtex-function 'bibtex-url
'bibtex-function #'bibtex-url
'help-echo (purecopy "mouse-2, RET: follow URL"))
(define-button-type 'bibtex-search-crossref
'action 'bibtex-button-action
'bibtex-function 'bibtex-search-crossref
'bibtex-function #'bibtex-search-crossref
'help-echo (purecopy "mouse-2, RET: follow crossref"))
(defun bibtex-button (beg end type &rest args)
@@ -3405,7 +3410,7 @@ if that value is non-nil.
\\{bibtex-mode-map}"
(add-hook 'completion-at-point-functions
'bibtex-completion-at-point-function nil 'local)
#'bibtex-completion-at-point-function nil 'local)
(make-local-variable 'bibtex-buffer-last-parsed-tick)
;; Install stealthy parse function if not already installed
(unless bibtex-parse-idle-timer
@@ -3419,7 +3424,7 @@ if that value is non-nil.
(set (make-local-variable 'comment-column) 0)
(set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*")
(set (make-local-variable 'outline-regexp) "[ \t]*@")
(set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
(set (make-local-variable 'fill-paragraph-function) #'bibtex-fill-field)
(set (make-local-variable 'fill-prefix)
(make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
(set (make-local-variable 'font-lock-defaults)
@@ -3441,7 +3446,7 @@ if that value is non-nil.
(syntax-propertize-via-font-lock
bibtex-font-lock-syntactic-keywords))
;; Allow `bibtex-dialect' as a file-local variable.
(add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t))
(add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t))
(defun bibtex-entry-alist (dialect)
"Return entry-alist for DIALECT."
@@ -3488,8 +3493,9 @@ are also bound buffer-locally if `bibtex-dialect' is already buffer-local
in the current buffer (for example, as a file-local variable).
LOCAL is t for interactive calls."
(interactive (list (intern (completing-read "Dialect: "
(mapcar 'list bibtex-dialect-list)
nil t)) t))
(mapcar #'list bibtex-dialect-list)
nil t))
t))
(let ((setfun (if (or local (local-variable-p 'bibtex-dialect))
(lambda (var val) (set (make-local-variable var) val))
'set)))
@@ -3506,7 +3512,7 @@ LOCAL is t for interactive calls."
bibtex-dialect))))
(funcall setfun 'bibtex-entry-type
(concat "@[ \t]*\\(?:"
(regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)"))
(regexp-opt (mapcar #'car bibtex-entry-alist)) "\\)"))
(funcall setfun 'bibtex-entry-head
(concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\("
bibtex-reference-key "\\)"))
@@ -3516,7 +3522,7 @@ LOCAL is t for interactive calls."
(concat "^[ \t]*@[ \t]*\\(?:"
(regexp-opt
(append '("String" "Preamble")
(mapcar 'car bibtex-entry-alist))) "\\)"))
(mapcar #'car bibtex-entry-alist))) "\\)"))
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)))
@@ -3549,11 +3555,13 @@ LOCAL is t for interactive calls."
(let* ((entry (car elt))
(fname (intern (format "bibtex-%s" entry))))
(unless (fboundp fname)
(eval (list 'defun fname nil
(format "Insert a template for a @%s entry; see also `bibtex-entry'."
entry)
'(interactive "*")
`(bibtex-entry ,entry))))
(defalias fname
(lambda ()
(:documentation
(format "Insert a template for a @%s entry; see also `bibtex-entry'."
entry)
(interactive "*")
(bibtex-entry entry)))))
;; Menu entries
(define-key menu-map (vector fname)
`(menu-item ,(or (nth 1 elt) (car elt)) ,fname))))
@@ -3608,8 +3616,8 @@ is non-nil."
(insert "@" entry-type (bibtex-entry-left-delimiter))
(if key (insert key))
(save-excursion
(mapc 'bibtex-make-field (car field-list))
(mapc 'bibtex-make-optional-field (cdr field-list))
(mapc #'bibtex-make-field (car field-list))
(mapc #'bibtex-make-optional-field (cdr field-list))
(if bibtex-comma-after-last-field
(insert ","))
(insert "\n")
@@ -3657,8 +3665,8 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE."
(insert (bibtex-field-left-delimiter)))
(goto-char end)))
(skip-chars-backward " \t\n")
(mapc 'bibtex-make-field required)
(mapc 'bibtex-make-optional-field optional)))))
(mapc #'bibtex-make-field required)
(mapc #'bibtex-make-optional-field optional)))))
(defun bibtex-parse-entry (&optional content keep-opt-alt)
"Parse entry at point, return an alist.
@@ -4980,7 +4988,8 @@ If mark is active reformat entries in region, if not in whole buffer."
("Remove empty optional and alternative fields? " . opts-or-alts)
("Remove delimiters around pure numerical fields? " . numerical-fields)
(,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
" comma at end of entry? ") . last-comma)
" comma at end of entry? ")
. last-comma)
("Replace double page dashes by single ones? " . page-dashes)
("Delete whitespace at the beginning and end of fields? " . whitespace)
("Inherit booktitle? " . inherit-booktitle)
@@ -5047,7 +5056,7 @@ entries from minibuffer."
(goto-char (point-max))
(message "Buffer is now parsable. Please save it.")))
(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1")
(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1")
(defun bibtex-completion-at-point-function ()
(let ((pnt (point))
(case-fold-search t)
@@ -5258,8 +5267,8 @@ Return the URL or nil if none can be generated."
;; If SCHEME is set up correctly,
;; we should never reach this point
(error "Match failed: %s" text)))
(if fmt (apply 'format fmt (nreverse obj))
(apply 'concat (nreverse obj)))))
(if fmt (apply #'format fmt (nreverse obj))
(apply #'concat (nreverse obj)))))
(if (called-interactively-p 'interactive) (message "%s" url))
(unless no-browse (browse-url url)))
(if (and (not url) (called-interactively-p 'interactive))
@@ -5289,10 +5298,11 @@ where FILE is the BibTeX file of ENTRY."
(list (completing-read
"Field: "
(delete-dups
(apply 'append
(apply #'append
bibtex-user-optional-fields
(mapcar (lambda (x) (mapcar 'car (apply 'append (nthcdr 2 x))))
bibtex-entry-alist))) nil t)
(mapcar (lambda (x) (mapcar #'car (apply #'append (nthcdr 2 x))))
bibtex-entry-alist)))
nil t)
(read-string "Regexp: ")
(if bibtex-search-entry-globally
(not current-prefix-arg)

18
lisp/textmodes/css-mode.el
View File

@@ -119,7 +119,6 @@
("cue" cue-before cue-after)
("cue-after" uri "none")
("cue-before" uri "none")
("direction" "ltr" "rtl")
("display" "inline" "block" "list-item" "inline-block" "table"
"inline-table" "table-row-group" "table-header-group"
"table-footer-group" "table-row" "table-column-group"
@@ -180,7 +179,6 @@
("stress" number)
("table-layout" "auto" "fixed")
("top" length percentage "auto")
("unicode-bidi" "normal" "embed" "bidi-override")
("vertical-align" "baseline" "sub" "super" "top" "text-top"
"middle" "bottom" "text-bottom" percentage length)
("visibility" "visible" "hidden" "collapse")
@@ -278,6 +276,10 @@
("color" color)
("opacity" alphavalue)
;; CSS Containment Module Level 1
;; (https://www.w3.org/TR/css-contain-1/#property-index)
("contain" "none" "strict" "content" "size" "layout" "paint")
;; CSS Grid Layout Module Level 1
;; (https://www.w3.org/TR/css-grid-1/#property-index)
("grid" grid-template grid-template-rows "auto-flow" "dense"
@@ -490,6 +492,16 @@
;; (https://www.w3.org/TR/css-will-change-1/#property-index)
("will-change" "auto" animateable-feature)
;; CSS Writing Modes Level 3
;; (https://www.w3.org/TR/css-writing-modes-3/#property-index)
;; "glyph-orientation-vertical" is obsolete and left out.
("direction" "ltr" "rtl")
("text-combine-upright" "none" "all")
("text-orientation" "mixed" "upright" "sideways")
("unicode-bidi" "normal" "embed" "isolate" "bidi-override"
"isolate-override" "plaintext")
("writing-mode" "horizontal-tb" "vertical-rl" "vertical-lr")
;; Filter Effects Module Level 1
;; (http://www.w3.org/TR/filter-effects/#property-index)
("color-interpolation-filters" "auto" "sRGB" "linearRGB")
@@ -874,7 +886,7 @@ cannot be completed sensibly: `custom-ident',
(defconst css-escapes-re
"\\\\\\(?:[^\000-\037\177]\\|[[:xdigit:]]+[ \n\t\r\f]?\\)")
(defconst css-nmchar-re (concat "\\(?:[-[:alnum:]]\\|" css-escapes-re "\\)"))
(defconst css-nmchar-re (concat "\\(?:[-_[:alnum:]]\\|" css-escapes-re "\\)"))
(defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)"))
(defconst css-ident-re ;; (concat css-nmstart-re css-nmchar-re "*")
;; Apparently, "at rules" names can start with a dash, e.g. @-moz-keyframes.

24
m4/manywarnings.m4
View File

@@ -1,4 +1,4 @@
# manywarnings.m4 serial 18
# manywarnings.m4 serial 19
dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -117,6 +117,23 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Waddress-of-packed-member \
-Waggressive-loop-optimizations \
-Wall \
-Wanalyzer-double-fclose \
-Wanalyzer-double-free \
-Wanalyzer-exposure-through-output-file \
-Wanalyzer-file-leak \
-Wanalyzer-free-of-non-heap \
-Wanalyzer-malloc-leak \
-Wanalyzer-null-argument \
-Wanalyzer-null-dereference \
-Wanalyzer-possible-null-argument \
-Wanalyzer-possible-null-dereference \
-Wanalyzer-stale-setjmp-buffer \
-Wanalyzer-tainted-array-index \
-Wanalyzer-too-complex \
-Wanalyzer-unsafe-call-within-signal-handler \
-Wanalyzer-use-after-free \
-Wanalyzer-use-of-pointer-in-stale-stack-frame \
-Warith-conversion \
-Wattribute-warning \
-Wattributes \
-Wbad-function-cast \
@@ -150,9 +167,11 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wempty-body \
-Wendif-labels \
-Wenum-compare \
-Wenum-conversion \
-Wexpansion-to-defined \
-Wextra \
-Wformat-contains-nul \
-Wformat-diag \
-Wformat-extra-args \
-Wformat-nonliteral \
-Wformat-security \
@@ -231,6 +250,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wstrict-aliasing \
-Wstrict-overflow \
-Wstrict-prototypes \
-Wstring-compare \
-Wstringop-truncation \
-Wsuggest-attribute=cold \
-Wsuggest-attribute=const \
@@ -242,6 +262,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wsuggest-final-types \
-Wswitch \
-Wswitch-bool \
-Wswitch-outside-range \
-Wswitch-unreachable \
-Wsync-nand \
-Wsystem-headers \
@@ -269,6 +290,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wvla \
-Wvolatile-register-var \
-Wwrite-strings \
-Wzero-length-bounds \
\
; do
gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item"

2
src/dispnew.c
View File

@@ -881,7 +881,7 @@ clear_glyph_row (struct glyph_row *row)
enum { off = offsetof (struct glyph_row, used) };
/* Zero everything except pointers in `glyphs'. */
memset (row->used, 0, sizeof *row - off);
memset ((char *) row + off, 0, sizeof *row - off);
}

2
src/fns.c
View File

@@ -4392,7 +4392,7 @@ hash_clear (struct Lisp_Hash_Table *h)
{
ptrdiff_t size = HASH_TABLE_SIZE (h);
if (!hash_rehash_needed_p (h))
memclear (XVECTOR (h->hash)->contents, size * word_size);
memclear (xvector_contents (h->hash), size * word_size);
for (ptrdiff_t i = 0; i < size; i++)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);

3
src/intervals.c
View File

@@ -117,10 +117,11 @@ create_root_interval (Lisp_Object parent)
/* Make the interval TARGET have exactly the properties of SOURCE. */
void
copy_properties (register INTERVAL source, register INTERVAL target)
copy_properties (INTERVAL source, INTERVAL target)
{
if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
return;
eassume (source && target);
COPY_INTERVAL_CACHE (source, target);
set_interval_plist (target, Fcopy_sequence (source->plist));

4
src/keyboard.c
View File

@@ -8302,7 +8302,7 @@ append_tab_bar_item (void)
/* Append entries from tab_bar_item_properties to the end of
tab_bar_items_vector. */
vcopy (tab_bar_items_vector, ntab_bar_items,
XVECTOR (tab_bar_item_properties)->contents, TAB_BAR_ITEM_NSLOTS);
xvector_contents (tab_bar_item_properties), TAB_BAR_ITEM_NSLOTS);
ntab_bar_items += TAB_BAR_ITEM_NSLOTS;
}
@@ -8779,7 +8779,7 @@ append_tool_bar_item (void)
/* Append entries from tool_bar_item_properties to the end of
tool_bar_items_vector. */
vcopy (tool_bar_items_vector, ntool_bar_items,
XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
xvector_contents (tool_bar_item_properties), TOOL_BAR_ITEM_NSLOTS);
ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
}

23
src/lisp.h
View File

@@ -3358,6 +3358,27 @@ struct frame;
#define HAVE_EXT_TOOL_BAR true
#endif
/* Return the address of vector A's element at index I. */
INLINE Lisp_Object *
xvector_contents_addr (Lisp_Object a, ptrdiff_t i)
{
/* This should return &XVECTOR (a)->contents[i], but that would run
afoul of GCC bug 95072. */
void *v = XVECTOR (a);
char *p = v;
void *w = p + header_size + i * word_size;
return w;
}
/* Return the address of vector A's elements. */
INLINE Lisp_Object *
xvector_contents (Lisp_Object a)
{
return xvector_contents_addr (a, 0);
}
/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
INLINE void
@@ -3365,7 +3386,7 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args,
ptrdiff_t count)
{
eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
memcpy (xvector_contents_addr (v, offset), args, count * sizeof *args);
}
/* Functions to modify hash tables. */

6
src/xfaces.c
View File

@@ -1888,7 +1888,7 @@ get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name,
lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
if (! NILP (lface))
memcpy (attrs, XVECTOR (lface)->contents,
memcpy (attrs, xvector_contents (lface),
LFACE_VECTOR_SIZE * sizeof *attrs);
return !NILP (lface);
@@ -2860,7 +2860,7 @@ The value is TO. */)
f = XFRAME (new_frame);
}
vcopy (copy, 0, XVECTOR (lface)->contents, LFACE_VECTOR_SIZE);
vcopy (copy, 0, xvector_contents (lface), LFACE_VECTOR_SIZE);
/* Changing a named face means that all realized faces depending on
that face are invalid. Since we cannot tell which realized faces
@@ -5598,7 +5598,7 @@ realize_default_face (struct frame *f)
/* Realize the face; it must be fully-specified now. */
eassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
memcpy (attrs, xvector_contents (lface), sizeof attrs);
struct face *face = realize_face (c, attrs, DEFAULT_FACE_ID);
#ifndef HAVE_WINDOW_SYSTEM

2
src/xmenu.c
View File

@@ -763,7 +763,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p)
/* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
memcpy (previous_items, xvector_contents (f->menu_bar_vector),
previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.

72
test/lisp/calendar/cal-julian-tests.el Normal file
View File

@@ -0,0 +1,72 @@
;;; cal-julian-tests.el --- tests for calendar/cal-julian.el -*- lexical-binding:t -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; Author: Stefan Kangas <stefankangas@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'cal-julian)
(ert-deftest cal-julian-test-to-absolute ()
(should (equal (calendar-gregorian-from-absolute
(calendar-julian-to-absolute
'(10 25 1917)))
'(11 7 1917))))
(ert-deftest cal-julian-test-from-absolute ()
(should (equal (calendar-julian-from-absolute
(calendar-absolute-from-gregorian
'(11 7 1917)))
'(10 25 1917))))
(ert-deftest cal-julian-test-date-string ()
(should (equal (let ((calendar-date-display-form calendar-iso-date-display-form))
(calendar-julian-date-string '(11 7 1917)))
"1917-10-25")))
(defmacro with-cal-julian-test (&rest body)
`(save-window-excursion
(unwind-protect
(progn
(calendar)
,@body)
(kill-buffer "*Calendar*"))))
(ert-deftest cal-julian-test-goto-date ()
(with-cal-julian-test
(calendar-julian-goto-date '(10 25 1917))
(should (looking-at "7"))))
(ert-deftest cal-julian-test-astro-to-and-from-absolute ()
(should (= (+ (calendar-astro-to-absolute 0.0)
(calendar-astro-from-absolute 0.0))
0.0)))
(ert-deftest cal-julian-calendar-astro-date-string ()
(should (equal (calendar-astro-date-string '(10 25 1917)) "2421527")))
(ert-deftest calendar-astro-goto-day-number ()
(with-cal-julian-test
(calendar-astro-goto-day-number 2421527)
(backward-char)
(should (looking-at "25"))))
(provide 'cal-julian-tests)
;;; cal-julian-tests.el ends here

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

@@ -4208,9 +4208,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (zerop (process-file "true")))
(should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist")))
(should (= 42 (process-file "sh" nil nil nil "-c" "exit 42")))
(should
(= 42
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "exit 42")))
;; Return string in case the process is interrupted.
(should (stringp (process-file "sh" nil nil nil "-c" "kill -2 $$")))
(should
(string-equal
"Signal 2"
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "kill -2 $$")))
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
@@ -4873,6 +4883,7 @@ INPUT, if non-nil, is a string sent to the process."
kill-buffer-query-functions)
;; Check INSIDE_EMACS.
(setenv "INSIDE_EMACS")
(should
(string-equal
(format "%s,tramp:%s" emacs-version tramp-version)

56
test/lisp/play/animate-tests.el Normal file
View File

@@ -0,0 +1,56 @@
;;; animate-tests.el --- Tests for animate.el -*- lexical-binding:t -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(require 'animate)
(ert-deftest animate-test-birthday-present ()
(unwind-protect
(save-window-excursion
(cl-letf (((symbol-function 'sit-for) (lambda (_) nil)))
(animate-birthday-present "foo")
(should (equal (buffer-string)
"
Happy Birthday,
Foo
You are my sunshine,
My only sunshine.
I'm awful sad that
You've moved away.
Let's talk together
And love more deeply.
Please bring back
my sunshine
to stay!"))))
(kill-buffer "*A-Present-for-Foo*")))
(provide 'animate-tests)
;;; animate-tests.el ends here

38
test/lisp/play/dissociate-tests.el Normal file
View File

@@ -0,0 +1,38 @@
;;; dissociate-tests.el --- Tests for dissociate.el -*- lexical-binding:t -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(require 'dissociate)
(ert-deftest dissociate-tests-dissociated-press ()
(cl-letf (((symbol-function 'y-or-n-p) (lambda (_) nil))
((symbol-function 'random) (lambda (_) 10)))
(save-window-excursion
(with-temp-buffer
(insert "Lorem ipsum dolor sit amet")
(dissociated-press)
(should (string-match-p "dolor sit ametdolor sit amdolor sit amdolor sit am"
(buffer-string)))))))
(provide 'dissociate-tests)
;;; dissociate-tests.el ends here

101
test/lisp/progmodes/glasses-tests.el Normal file
View File

@@ -0,0 +1,101 @@
;;; glasses-tests.el --- Tests for glasses.el -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ert)
(require 'glasses)
(require 'seq)
(ert-deftest glasses-tests-parenthesis-exception-p ()
(with-temp-buffer
(insert "public OnClickListener menuListener() {}")
(let ((glasses-separate-parentheses-exceptions '("^Listen")))
(should-not (glasses-parenthesis-exception-p 1 (point-max)))
(should (glasses-parenthesis-exception-p 15 (point-max)))
(should-not (glasses-parenthesis-exception-p 24 (point-max)))
(should (glasses-parenthesis-exception-p 28 (point-max))))))
(ert-deftest glasses-tests-overlay-p ()
(should
(glasses-overlay-p (glasses-make-overlay (point-min) (point-max))))
(should-not
(glasses-overlay-p (make-overlay (point-min) (point-max)))))
(ert-deftest glasses-tests-make-overlay-p ()
(let ((o (glasses-make-overlay (point-min) (point-max))))
(should (eq (overlay-get o 'category) 'glasses)))
(let ((o (glasses-make-overlay (point-min) (point-max) 'foo)))
(should (eq (overlay-get o 'category) 'foo))))
(ert-deftest glasses-tests-make-readable ()
(with-temp-buffer
(insert "pp.setBackgroundResource(R.drawable.button_right);")
(glasses-make-readable (point-min) (point-max))
(pcase-let ((`(,o1 ,o2 ,o3)
(sort (overlays-in (point-min) (point-max))
(lambda (o1 o2)
(< (overlay-start o1) (overlay-start o2))))))
(should (= (overlay-start o1) 7))
(should (equal (overlay-get o1 'before-string)
glasses-separator))
(should (= (overlay-start o2) 17))
(should (equal (overlay-get o2 'before-string)
glasses-separator))
(should (= (overlay-start o3) 25))
(should (equal (overlay-get o3 'before-string) " ")))))
(ert-deftest glasses-tests-make-readable-dont-separate-parentheses ()
(with-temp-buffer
(insert "pp.setBackgroundResource(R.drawable.button_right);")
(let ((glasses-separate-parentheses-p nil))
(glasses-make-readable (point-min) (point-max))
(should-not (overlays-at 25)))))
(ert-deftest glasses-tests-make-unreadable ()
(with-temp-buffer
(insert "pp.setBackgroundResource(R.drawable.button_right);")
(glasses-make-readable (point-min) (point-max))
(should (seq-some #'glasses-overlay-p
(overlays-in (point-min) (point-max))))
(glasses-make-unreadable (point-min) (point-max))
(should-not (seq-some #'glasses-overlay-p
(overlays-in (point-min) (point-max))))))
(ert-deftest glasses-tests-convert-to-unreadable ()
(with-temp-buffer
(insert "set_Background_Resource(R.button_right);")
(let ((glasses-convert-on-write-p nil))
(should-not (glasses-convert-to-unreadable))
(should (equal (buffer-string)
"set_Background_Resource(R.button_right);")))
(let ((glasses-convert-on-write-p t))
(should-not (glasses-convert-to-unreadable))
(should (equal (buffer-string)
"setBackgroundResource(R.button_right);")))))
(provide 'glasses-tests)
;;; glasses-tests.el ends here

4
test/manual/indent/css-mode.css
View File

@@ -92,5 +92,9 @@ div::before {
.foo-bar--baz {
--foo-variable: 5px;
--_variable_with_underscores: #fff;
--_variable-starting-with-underscore: none;
margin: var(--foo-variable);
color: var(--_variable_with_underscores);
display: var(--_variable-starting-with-underscore);
}

10
test/manual/indent/less-css-mode.less
View File

@@ -1,3 +1,13 @@
@var-with-dashes: #428bca;
@var_with_underscores: 10px;
@_var-starting-with-underscore: none;
body {
background: @var-with-dashes;
padding: @var_with_underscores;
display: @_var-starting-with-underscore;
}
.desktop-and-old-ie(@rules) {
@media screen and (min-width: 1200) { @rules(); }
html.lt-ie9 & { @rules(); }

4
test/manual/indent/scss-mode.scss
View File

@@ -41,9 +41,13 @@ p.#{$name} var
article[role="main"] {
$toto: 500 !global;
$var-with-default: 300 !default;
$var_with_underscores: #fff;
$_var-starting-with-underscore: none;
float: left !important;
width: 600px / 888px * 100%;
height: 100px / 888px * 100%;
color: $var_with_underscores;
display: $_var-starting-with-underscore;
}
%placeholder {