1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-20 11:33:09 -08:00

Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs into trunk

This commit is contained in:
Stefan Monnier 2019-07-09 16:13:25 -04:00
commit 3078e6d2fb
33 changed files with 150 additions and 72 deletions

View file

@ -1578,8 +1578,26 @@ primitives being @code{add-function} and @code{remove-function}) and another
set layered on top of it for named functions (with the main primitives being
@code{advice-add} and @code{advice-remove}).
For example, in order to trace the calls to the process filter of a process
@var{proc}, you could use:
As a trivial example, here's how to add advice that'll modify the
return value of a function every time it's called:
@example
(defun my-double (x)
(* x 2))
(defun my-increase (x)
(+ x 1))
(advice-add 'my-double :filter-return #'my-increase)
@end example
After adding this advice, if you call @code{my-double} with @samp{3},
the return value will be @samp{7}. To remove this advice, say
@example
(advice-remove 'my-double #'my-increase)
@end example
A more advanced example would be to trace the calls to the process
filter of a process @var{proc}:
@example
(defun my-tracing-function (proc string)

View file

@ -1408,6 +1408,10 @@ Where a command affects the contents of several buffers, as may happen,
for example, when a function on the @code{post-command-hook} affects a
buffer other than the @code{current-buffer}, then @code{undo-boundary}
will be called in each of the affected buffers.
This function can be called before an amalgamating command. It
removes the previous @code{undo-boundary} if a series of such calls
have been made.
@end defun
@defvar undo-auto-current-boundary-timer

View file

@ -144,7 +144,8 @@ main (int argc, char **argv)
for (char *finger = buf;
(finger = memmem (finger, buf + chunksz - finger,
fingerprint, sizeof fingerprint));
(unsigned char *) fingerprint,
sizeof fingerprint));
finger++)
{
if (! (fseeko (f, finger - buf, SEEK_SET) == 0

View file

@ -29,7 +29,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
by a fingerprint of the temporary Emacs executable that was built
along the way. */
unsigned char const fingerprint[] =
volatile unsigned char fingerprint[] =
{
0xDE,
0x86,

View file

@ -24,6 +24,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Emacs. This way, we have a unique value that we can use to pair
data files (like a portable dump image) with a specific build of
Emacs. */
extern unsigned char const fingerprint[32];
extern volatile unsigned char fingerprint[32];
#endif

View file

@ -929,7 +929,10 @@ don't move point."
(pcase (save-excursion (condition-case nil
(read (current-buffer))
;; Conservatively skip syntax errors.
(invalid-read-syntax)))
(invalid-read-syntax)
;; Don't bug out if the file is empty (or a
;; definition ends prematurely.
(end-of-file)))
(`(,(or 'defun 'defvar 'defcustom 'defmacro 'defconst 'defsubst 'defadvice)
,(pred symbolp)
;; Require an initializer, i.e. ignore single-argument `defvar'
@ -2250,7 +2253,10 @@ Code:, and others referenced in the style guide."
(re-search-forward "^(require" nil t)
(re-search-forward "^(" nil t))
(beginning-of-line))
(t (re-search-forward ";;; .* --- .*\n")))
((not (re-search-forward ";;; .* --- .*\n" nil t))
(checkdoc-create-error
"You should have a summary line (\";;; .* --- .*\")"
nil nil t)))
(if (checkdoc-y-or-n-p
"You should have a \";;; Commentary:\", add one? ")
(insert "\n;;; Commentary:\n;; \n\n")

View file

@ -593,7 +593,7 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\
(null (cdr method)))
(lisp-indent-report-bad-format method))
(cond ((and tail (not (consp tem)))
(cond ((and tail (not (or (consp tem) (symbolp tem))))
;; indent tail of &rest in same way as first elt of rest
(throw 'exit normal-indent))
((eq tem '&body)

View file

@ -2720,6 +2720,8 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
("\\.js[mx]?\\'" . javascript-mode)
;; https://en.wikipedia.org/wiki/.har
("\\.har\\'" . javascript-mode)
("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
("\\.by\\'" . bovine-grammar-mode)

View file

@ -2528,6 +2528,7 @@ The arguments have the same meaning as those of
(defvar debbugs-gnu-bug-number) ; debbugs-gnu
;;;###autoload
(defun gnus-read-ephemeral-emacs-bug-group (ids &optional window-conf)
"Browse Emacs bug reports with IDS in an ephemeral group.
The arguments have the same meaning as those of

View file

@ -11153,7 +11153,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
t
(if (<= article 0)
(progn
(gnus-error 1 "Can't mark negative article numbers")
(gnus-error 1 "Gnus doesn't know the article number; can't mark")
nil)
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
(setq gnus-newsgroup-spam-marked
@ -11326,7 +11326,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(let ((mark (or mark gnus-ticked-mark)))
(if (<= article 0)
(progn
(gnus-error 1 "Can't mark negative article numbers")
(gnus-error 1 "Gnus doesn't know the article number; can't mark")
nil)
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)
@ -12188,11 +12188,15 @@ performed."
(save-window-excursion
(gnus-summary-select-article decode decode nil article)
(gnus-summary-goto-subject article))
(with-current-buffer save-buffer
(erase-buffer)
(insert-buffer-substring (if decode
gnus-article-buffer
gnus-original-article-buffer)))
;; The article may have expired.
(let ((art-buf (if decode
gnus-article-buffer
gnus-original-article-buffer)))
(when (zerop (buffer-size (get-buffer art-buf)))
(error "Couldn't select article %s" article))
(with-current-buffer save-buffer
(erase-buffer)
(insert-buffer-substring art-buf)))
(setq file (gnus-article-save save-buffer file num))
(gnus-summary-remove-process-mark article)
(unless not-saved

View file

@ -8108,7 +8108,13 @@ From headers in the original article."
(emails
(message-tokenize-header
(mail-strip-quoted-names
(mapconcat 'message-fetch-reply-field fields ","))))
(mapconcat
#'identity
(cl-loop for field in fields
for value = (message-fetch-reply-field field)
when value
collect value)
","))))
(email
(cond ((functionp message-alternative-emails)
(car (cl-remove-if-not message-alternative-emails emails)))

View file

@ -691,7 +691,19 @@ become JSON objects."
(defun json-read ()
"Parse and return the JSON object following point.
Advances point just past JSON object."
Advances point just past JSON object.
If called with the following JSON after point
{\"a\": [1, 2, {\"c\": false}],
\"b\": \"foo\"}
you will get the following structure returned:
((a .
[1 2
((c . :json-false))])
(b . \"foo\"))"
(json-skip-whitespace)
(let ((char (json-peek)))
(if (zerop char)
@ -719,7 +731,11 @@ Advances point just past JSON object."
;;; JSON encoder
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string."
"Return a JSON representation of OBJECT as a string.
OBJECT should have a structure like one returned by `json-read'.
If an error is detected during encoding, an error based on
`json-error' is signalled."
(cond ((memq object (list t json-null json-false))
(json-encode-keyword object))
((stringp object) (json-encode-string object))
@ -746,6 +762,7 @@ With prefix argument MINIMIZE, minimize it instead."
The function `json-pretty-print' uses `replace-region-contents'
(which see) passing the value of this variable as argument
MAX-SECS.")
(make-obsolete-variable 'json-pretty-print-max-secs nil "27.1")
(defun json-pretty-print (begin end &optional minimize)
"Pretty-print selected region.
@ -755,14 +772,17 @@ With prefix argument MINIMIZE, minimize it instead."
;; Distinguish an empty objects from 'null'
(json-null :json-null)
;; Ensure that ordering is maintained
(json-object-type 'alist))
(replace-region-contents
begin end
(lambda () (json-encode (json-read)))
json-pretty-print-max-secs
;; FIXME: What's a good value here? Can we use something better,
;; e.g., by deriving a value from the size of the region?
64)))
(json-object-type 'alist)
json)
(save-restriction
(narrow-to-region begin end)
(goto-char begin)
(while (setq json (condition-case _
(json-read)
(json-error nil)))
(delete-region begin (point))
(insert (json-encode json))
(setq begin (point))))))
(defun json-pretty-print-buffer-ordered (&optional minimize)
"Pretty-print current buffer with object keys ordered.

View file

@ -1784,14 +1784,18 @@ to get different commands to edit and resubmit."
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
The value can be a length of time to show the message for.
If the value is non-nil and not a number, we wait 2 seconds."
If the value is non-nil and not a number, we wait 2 seconds.
Also see `extended-command-suggest-shorter'."
:group 'keyboard
:type '(choice (const :tag "off" nil)
(integer :tag "time" 2)
(other :tag "on")))
(defcustom extended-command-suggest-shorter t
"If non-nil, show a shorter M-x invocation when there is one."
"If non-nil, show a shorter M-x invocation when there is one.
Also see `suggest-key-bindings'."
:group 'keyboard
:type 'boolean
:version "26.1")
@ -3624,12 +3628,12 @@ impose the use of a shell (with its need to quote arguments)."
;; If will kill a process, query first.
(if (yes-or-no-p "A command is running in the default buffer. Kill it? ")
(kill-process proc)
(error "Shell command in progress")))
(user-error "Shell command in progress")))
((eq async-shell-command-buffer 'confirm-new-buffer)
;; If will create a new buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
(setq buffer (generate-new-buffer bname))
(error "Shell command in progress")))
(user-error "Shell command in progress")))
((eq async-shell-command-buffer 'new-buffer)
;; It will create a new buffer.
(setq buffer (generate-new-buffer bname)))
@ -3640,7 +3644,7 @@ impose the use of a shell (with its need to quote arguments)."
(with-current-buffer buffer
(rename-uniquely))
(setq buffer (get-buffer-create bname)))
(error "Shell command in progress")))
(user-error "Shell command in progress")))
((eq async-shell-command-buffer 'rename-buffer)
;; It will rename the buffer.
(with-current-buffer buffer

View file

@ -165,7 +165,7 @@ to obtain the value of this variable."
:type '(choice regexp (const :tag "Use default value" nil)))
(put 'sentence-end 'safe-local-variable 'string-or-null-p)
(defcustom sentence-end-base "[.?!…‽][]\"'”’)}]*"
(defcustom sentence-end-base "[.?!…‽][]\"'”’)}»›]*"
"Regexp matching the basic end of a sentence, not including following space."
:group 'paragraphs
:type 'string

View file

@ -3019,7 +3019,7 @@ cleanup_vector (struct Lisp_Vector *vector)
{
/* Attempt to catch subtle bugs like Bug#16140. */
eassert (valid_font_driver (drv));
drv->close (font);
drv->close_font (font);
}
}
}

View file

@ -219,7 +219,10 @@ static mode_t const default_output_mode = 0666;
DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
doc: /* Call PROGRAM synchronously in separate process.
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `/dev/null').
If you want to make the input come from an Emacs buffer, use
`call-process-region' instead.
Third argument DESTINATION specifies how to handle program's output.
If DESTINATION is a buffer, or t that stands for the current buffer,

View file

@ -1288,7 +1288,7 @@ uniprop_table (Lisp_Object prop)
if (STRINGP (table))
{
AUTO_STRING (intl, "international/");
result = Fload (concat2 (intl, table), Qt, Qt, Qt, Qt);
result = save_match_data_load (concat2 (intl, table), Qt, Qt, Qt, Qt);
if (NILP (result))
return Qnil;
table = XCDR (val);

View file

@ -302,7 +302,7 @@ reread_doc_file (Lisp_Object file)
if (NILP (file))
Fsnarf_documentation (Vdoc_file_name);
else
Fload (file, Qt, Qt, Qt, Qnil);
save_match_data_load (file, Qt, Qt, Qt, Qnil);
return 1;
}

View file

@ -2049,9 +2049,6 @@ it defines a macro. */)
CHECK_SYMBOL (funname);
/* Preserve the match data. */
record_unwind_save_match_data ();
/* If autoloading gets an error (which includes the error of failing
to define the function being called), we use Vautoload_queue
to undo function definitions and `provide' calls made by
@ -2067,7 +2064,7 @@ it defines a macro. */)
so don't signal an error if autoloading fails. */
Lisp_Object ignore_errors
= (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only;
Fload (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
save_match_data_load (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;

View file

@ -2984,8 +2984,9 @@ suppressed. */)
Vautoload_queue = Qt;
/* Load the file. */
tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename,
noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
tem = save_match_data_load
(NILP (filename) ? Fsymbol_name (feature) : filename,
noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
/* If load failed entirely, return nil. */
if (NILP (tem))

View file

@ -44,10 +44,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
/* Avoid macro definition of `open' in generated lib/fcntl.h to mess up
use of it as a struct member. */
#undef open
#define DEFAULT_ENCODING Qiso8859_1
/* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
@ -2646,7 +2642,7 @@ font_clear_cache (struct frame *f, Lisp_Object cache,
if (! NILP (AREF (val, FONT_TYPE_INDEX)))
{
eassert (font && driver == font->driver);
driver->close (font);
driver->close_font (font);
}
}
if (driver->free_entity)
@ -2906,7 +2902,7 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size)
width and height. */
for (psize = pixel_size; ; psize++)
{
font_object = driver_list->driver->open (f, entity, psize);
font_object = driver_list->driver->open_font (f, entity, psize);
if (NILP (font_object))
return Qnil;
font = XFONT_OBJECT (font_object);
@ -2966,7 +2962,7 @@ font_close_object (struct frame *f, Lisp_Object font_object)
/* Already closed. */
return;
FONT_ADD_LOG ("close", font_object, Qnil);
font->driver->close (font);
font->driver->close_font (font);
#ifdef HAVE_WINDOW_SYSTEM
eassert (FRAME_DISPLAY_INFO (f)->n_fonts);
FRAME_DISPLAY_INFO (f)->n_fonts--;

View file

@ -58,7 +58,7 @@ INLINE_HEADER_BEGIN
Lisp object encapsulating "struct font". This corresponds to
an opened font.
Note: Only the method `open' of a font-driver can create this
Note: Only the method `open_font' of a font-driver can create this
object, and it should never be modified by Lisp. */
@ -594,9 +594,9 @@ struct font_driver
:weight, :slant, :width, :size, :dpi, :spacing, :avgwidth. If
the font is scalable, :size and :avgwidth must be 0.
The `open' method of the same font-backend is called with one of
The `open_font' method of the same font-backend is called with one of
the returned font-entities. If the backend needs additional
information to be used in `open' method, this method can add any
information to be used in `open_font' method, this method can add any
Lispy value using the property :font-entity to the entities.
This and the following `match' are the only APIs that allocate
@ -623,11 +623,11 @@ struct font_driver
/* Open a font specified by FONT_ENTITY on frame F. If the font is
scalable, open it with PIXEL_SIZE. */
Lisp_Object (*open) (struct frame *f, Lisp_Object font_entity,
int pixel_size);
Lisp_Object (*open_font) (struct frame *f, Lisp_Object font_entity,
int pixel_size);
/* Close FONT. NOTE: this can be called by GC. */
void (*close) (struct font *font);
void (*close_font) (struct font *font);
/* Prepare FACE for displaying characters by FONT on frame F by
storing some data in FACE->extra. */

View file

@ -576,8 +576,8 @@ struct font_driver const ftcrfont_driver =
.list = ftcrfont_list,
.match = ftcrfont_match,
.list_family = ftfont_list_family,
.open = ftcrfont_open,
.close = ftcrfont_close,
.open_font = ftcrfont_open,
.close_font = ftcrfont_close,
.has_char = ftcrfont_has_char,
.encode_char = ftcrfont_encode_char,
.text_extents = ftcrfont_text_extents,

View file

@ -3039,8 +3039,8 @@ static struct font_driver const ftfont_driver =
.list = ftfont_list,
.match = ftfont_match,
.list_family = ftfont_list_family,
.open = ftfont_open,
.close = ftfont_close,
.open_font = ftfont_open,
.close_font = ftfont_close,
.has_char = ftfont_has_char,
.encode_char = ftfont_encode_char,
.text_extents = ftfont_text_extents,

View file

@ -335,8 +335,8 @@ struct font_driver const ftxfont_driver =
.list = ftxfont_list,
.match = ftxfont_match,
.list_family = ftfont_list_family,
.open = ftxfont_open,
.close = ftxfont_close,
.open_font = ftxfont_open,
.close_font = ftxfont_close,
.has_char = ftfont_has_char,
.encode_char = ftfont_encode_char,
.text_extents = ftfont_text_extents,

View file

@ -4019,6 +4019,8 @@ LOADHIST_ATTACH (Lisp_Object x)
if (initialized)
Vcurrent_load_list = Fcons (x, Vcurrent_load_list);
}
extern Lisp_Object save_match_data_load (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object *, Lisp_Object, bool);
enum { S2N_IGNORE_TRAILING = 1 };

View file

@ -1508,6 +1508,17 @@ Return t if the file exists and loads successfully. */)
return Qt;
}
Lisp_Object
save_match_data_load (Lisp_Object file, Lisp_Object noerror,
Lisp_Object nomessage, Lisp_Object nosuffix,
Lisp_Object must_suffix)
{
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_save_match_data ();
Lisp_Object result = Fload (file, noerror, nomessage, nosuffix, must_suffix);
return unbind_to (count, result);
}
static bool
complete_filename_p (Lisp_Object pathname)

View file

@ -1663,8 +1663,8 @@ static struct font_driver macfont_driver =
.match = macfont_match,
.list_family = macfont_list_family,
.free_entity = macfont_free_entity,
.open = macfont_open,
.close = macfont_close,
.open_font = macfont_open,
.close_font = macfont_close,
.has_char = macfont_has_char,
.encode_char = macfont_encode_char,
.text_extents = macfont_text_extents,

View file

@ -1491,8 +1491,8 @@ struct font_driver const nsfont_driver =
.list = nsfont_list,
.match = nsfont_match,
.list_family = nsfont_list_family,
.open = nsfont_open,
.close = nsfont_close,
.open_font = nsfont_open,
.close_font = nsfont_close,
.has_char = nsfont_has_char,
.encode_char = nsfont_encode_char,
.text_extents = nsfont_text_extents,

View file

@ -4101,7 +4101,8 @@ types. */)
ctx->header.magic[0] = '!'; /* Note that dump is incomplete. */
verify (sizeof (fingerprint) == sizeof (ctx->header.fingerprint));
memcpy (ctx->header.fingerprint, fingerprint, sizeof (fingerprint));
memcpy (ctx->header.fingerprint, (unsigned char *) fingerprint,
sizeof (fingerprint));
const dump_off header_start = ctx->offset;
dump_fingerprint ("dumping fingerprint", ctx->header.fingerprint);
@ -5359,9 +5360,10 @@ pdumper_load (const char *dump_filename)
err = PDUMPER_LOAD_VERSION_MISMATCH;
verify (sizeof (header->fingerprint) == sizeof (fingerprint));
if (memcmp (header->fingerprint, fingerprint, sizeof (fingerprint)) != 0)
if (memcmp (header->fingerprint, (unsigned char *) fingerprint,
sizeof (fingerprint)) != 0)
{
dump_fingerprint ("desired fingerprint", fingerprint);
dump_fingerprint ("desired fingerprint", (unsigned char *) fingerprint);
dump_fingerprint ("found fingerprint", header->fingerprint);
goto out;
}

View file

@ -1106,8 +1106,8 @@ struct font_driver const xfont_driver =
.list = xfont_list,
.match = xfont_match,
.list_family = xfont_list_family,
.open = xfont_open,
.close = xfont_close,
.open_font = xfont_open,
.close_font = xfont_close,
.prepare_face = xfont_prepare_face,
.has_char = xfont_has_char,
.encode_char = xfont_encode_char,

View file

@ -643,8 +643,8 @@ struct font_driver const xftfont_driver =
.list = xftfont_list,
.match = xftfont_match,
.list_family = ftfont_list_family,
.open = xftfont_open,
.close = xftfont_close,
.open_font = xftfont_open,
.close_font = xftfont_close,
.prepare_face = xftfont_prepare_face,
.done_face = xftfont_done_face,
.has_char = xftfont_has_char,

View file

@ -48,7 +48,7 @@
(ert-deftest image-type-from-file-header-test ()
"Test image-type-from-file-header."
(should (eq 'svg
(should (eq (if (image-type-available-p 'svg) 'svg)
(image-type-from-file-header
(expand-file-name "splash.svg"
image-tests--emacs-images-directory)))))