commit b87e5eea1dd7c7345d0a9f82759eedfd7c9a8099 (HEAD, refs/remotes/origin/master) Author: YAMAMOTO Mitsuharu Date: Sun May 19 08:35:40 2019 +0900 Avoid triple buffering with Xdbe in cairo * src/xterm.h (struct x_output): Remove member cr_surface. Add members cr_surface_desired_width and cr_surface_desired_height. (x_cr_destroy_frame_context) [USE_CAIRO]: Add extern. * src/xterm.c (x_free_cr_resources): Remove function. (FRAME_CR_SURFACE) [USE_CAIRO]: Remove macro. (FRAME_CR_SURFACE_DESIRED_WIDTH, FRAME_CR_SURFACE_DESIRED_HEIGHT) [USE_CAIRO]: New macros. (x_cr_destroy_frame_context) [USE_CAIRO]: Rename from x_cr_destroy_surface. All Uses changed. Don't use FRAME_CR_SURFACE. Make non-static. (x_cr_update_surface_desired_size) [USE_CAIRO]: New function. (x_begin_cr_clip) [USE_CAIRO]: Create Xlib surface if Xdbe is in use. Use FRAME_CR_SURFACE_DESIRED_WIDTH and FRAME_CR_SURFACE_DESIRED_HEIGHT. (x_end_cr_clip) [USE_CAIRO]: Call x_mark_frame_dirty if Xdbe is in use. (x_cr_draw_frame, x_cr_export_frames) [USE_CAIRO]: Save and restore cairo context instead of freeing and clearing it. (x_update_begin) [USE_CAIRO]: Don't create cairo surface here. (show_back_buffer) [USE_CAIRO]: Call cairo_surface_flush before swapping. (x_update_end) [USE_CAIRO]: Don't copy image surface if Xdbe is in use. Get image surface by cairo_get_target instead of FRAME_CR_SURFACE. (x_scroll_run) [USE_CAIRO]: Use XCopyArea if Xdbe is in use. (handle_one_xevent) [USE_CAIRO] : Call x_cr_update_surface_desired_size instead of x_cr_destroy_surface. (x_free_frame_resources) [USE_CAIRO]: Call x_cr_destroy_frame_context instead of x_free_cr_resources. * src/xfns.c (set_up_x_back_buffer, tear_down_x_back_buffer) [USE_CAIRO]: Call x_cr_destroy_frame_context. diff --git a/src/xfns.c b/src/xfns.c index 2ceb55a30a..c8cc1704a4 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2784,6 +2784,9 @@ set_up_x_back_buffer (struct frame *f) block_input (); if (FRAME_X_WINDOW (f) && !FRAME_X_DOUBLE_BUFFERED_P (f)) { +#ifdef USE_CAIRO + x_cr_destroy_frame_context (f); +#endif FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f); if (FRAME_DISPLAY_INFO (f)->supports_xdbe) { @@ -2813,6 +2816,9 @@ tear_down_x_back_buffer (struct frame *f) { if (FRAME_X_DOUBLE_BUFFERED_P (f)) { +#ifdef USE_CAIRO + x_cr_destroy_frame_context (f); +#endif XdbeDeallocateBackBufferName (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f)); FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f); diff --git a/src/xterm.c b/src/xterm.c index 9371d47c95..4f4a1d6d02 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -201,7 +201,6 @@ enum xembed_message XEMBED_ACTIVATE_ACCELERATOR = 14 }; -static void x_free_cr_resources (struct frame *); static bool x_alloc_nearest_color_1 (Display *, Colormap, XColor *); static void x_raise_frame (struct frame *); static void x_lower_frame (struct frame *); @@ -298,7 +297,10 @@ record_event (char *locus, int type) #ifdef USE_CAIRO #define FRAME_CR_CONTEXT(f) ((f)->output_data.x->cr_context) -#define FRAME_CR_SURFACE(f) ((f)->output_data.x->cr_surface) +#define FRAME_CR_SURFACE_DESIRED_WIDTH(f) \ + ((f)->output_data.x->cr_surface_desired_width) +#define FRAME_CR_SURFACE_DESIRED_HEIGHT(f) \ + ((f)->output_data.x->cr_surface_desired_height) static struct x_gc_ext_data * x_gc_get_ext_data (struct frame *f, GC gc, int create_if_not_found_p) @@ -333,19 +335,28 @@ x_extension_initialize (struct x_display_info *dpyinfo) dpyinfo->ext_codes = ext_codes; } -static void -x_cr_destroy_surface (struct frame *f) +void +x_cr_destroy_frame_context (struct frame *f) { - if (FRAME_CR_SURFACE (f)) + if (FRAME_CR_CONTEXT (f)) { - cairo_t *cr = FRAME_CR_CONTEXT (f); - cairo_surface_destroy (FRAME_CR_SURFACE (f)); - FRAME_CR_SURFACE (f) = 0; - if (cr) cairo_destroy (cr); + cairo_destroy (FRAME_CR_CONTEXT (f)); FRAME_CR_CONTEXT (f) = NULL; } } +static void +x_cr_update_surface_desired_size (struct frame *f, int width, int height) +{ + if (FRAME_CR_SURFACE_DESIRED_WIDTH (f) != width + || FRAME_CR_SURFACE_DESIRED_HEIGHT (f) != height) + { + x_cr_destroy_frame_context (f); + FRAME_CR_SURFACE_DESIRED_WIDTH (f) = width; + FRAME_CR_SURFACE_DESIRED_HEIGHT (f) = height; + } +} + cairo_t * x_begin_cr_clip (struct frame *f, GC gc) { @@ -353,21 +364,19 @@ x_begin_cr_clip (struct frame *f, GC gc) if (!cr) { - - if (! FRAME_CR_SURFACE (f)) - { - int scale = 1; -#ifdef USE_GTK - scale = xg_get_scale (f); -#endif - - FRAME_CR_SURFACE (f) = - cairo_image_surface_create (CAIRO_FORMAT_ARGB32, - scale * FRAME_PIXEL_WIDTH (f), - scale * FRAME_PIXEL_HEIGHT (f)); - } - cr = cairo_create (FRAME_CR_SURFACE (f)); - FRAME_CR_CONTEXT (f) = cr; + int width = FRAME_CR_SURFACE_DESIRED_WIDTH (f); + int height = FRAME_CR_SURFACE_DESIRED_HEIGHT (f); + cairo_surface_t *surface; + if (FRAME_X_DOUBLE_BUFFERED_P (f)) + surface = cairo_xlib_surface_create (FRAME_X_DISPLAY (f), + FRAME_X_RAW_DRAWABLE (f), + FRAME_X_VISUAL (f), + width, height); + else + surface = cairo_image_surface_create (CAIRO_FORMAT_ARGB32, + width, height); + cr = FRAME_CR_CONTEXT (f) = cairo_create (surface); + cairo_surface_destroy (surface); } cairo_save (cr); @@ -395,6 +404,8 @@ void x_end_cr_clip (struct frame *f) { cairo_restore (FRAME_CR_CONTEXT (f)); + if (FRAME_X_DOUBLE_BUFFERED_P (f)) + x_mark_frame_dirty (f); } void @@ -532,11 +543,11 @@ x_cr_draw_frame (cairo_t *cr, struct frame *f) width = FRAME_PIXEL_WIDTH (f); height = FRAME_PIXEL_HEIGHT (f); - x_free_cr_resources (f); + cairo_t *saved_cr = FRAME_CR_CONTEXT (f); FRAME_CR_CONTEXT (f) = cr; x_clear_area (f, 0, 0, width, height); expose_frame (f, 0, 0, width, height); - FRAME_CR_CONTEXT (f) = NULL; + FRAME_CR_CONTEXT (f) = saved_cr; } static cairo_status_t @@ -615,11 +626,11 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) while (1) { - x_free_cr_resources (f); + cairo_t *saved_cr = FRAME_CR_CONTEXT (f); FRAME_CR_CONTEXT (f) = cr; x_clear_area (f, 0, 0, width, height); expose_frame (f, 0, 0, width, height); - FRAME_CR_CONTEXT (f) = NULL; + FRAME_CR_CONTEXT (f) = saved_cr; if (NILP (frames)) break; @@ -653,35 +664,6 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) #endif /* USE_CAIRO */ -static void -x_free_cr_resources (struct frame *f) -{ -#ifdef USE_CAIRO - if (f == NULL) - { - Lisp_Object rest, frame; - FOR_EACH_FRAME (rest, frame) - if (FRAME_X_P (XFRAME (frame))) - x_free_cr_resources (XFRAME (frame)); - } - else - { - cairo_t *cr = FRAME_CR_CONTEXT (f); - - if (cr) - { - cairo_surface_t *surface = cairo_get_target (cr); - - if (cairo_surface_get_type (surface) == CAIRO_SURFACE_TYPE_XLIB) - { - cairo_destroy (cr); - FRAME_CR_CONTEXT (f) = NULL; - } - } - } -#endif -} - static void x_set_clip_rectangles (struct frame *f, GC gc, XRectangle *rectangles, int n) { @@ -996,41 +978,7 @@ x_set_frame_alpha (struct frame *f) static void x_update_begin (struct frame *f) { -#ifdef USE_CAIRO - if (FRAME_TOOLTIP_P (f) && !FRAME_VISIBLE_P (f)) - return; - - if (! FRAME_CR_SURFACE (f)) - { - int width, height; -#ifdef USE_GTK - if (FRAME_GTK_WIDGET (f)) - { - GdkWindow *w = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); - int scale = xg_get_scale (f); - width = scale * gdk_window_get_width (w); - height = scale * gdk_window_get_height (w); - } - else -#endif - { - width = FRAME_PIXEL_WIDTH (f); - height = FRAME_PIXEL_HEIGHT (f); - if (! FRAME_EXTERNAL_TOOL_BAR (f)) - height += FRAME_TOOL_BAR_HEIGHT (f); - if (! FRAME_EXTERNAL_MENU_BAR (f)) - height += FRAME_MENU_BAR_HEIGHT (f); - } - - if (width > 0 && height > 0) - { - block_input(); - FRAME_CR_SURFACE (f) = cairo_image_surface_create - (CAIRO_FORMAT_ARGB32, width, height); - unblock_input(); - } - } -#endif /* USE_CAIRO */ + /* Nothing to do. */ } /* Draw a vertical window border from (x,y0) to (x,y1) */ @@ -1122,6 +1070,11 @@ show_back_buffer (struct frame *f) if (FRAME_X_DOUBLE_BUFFERED_P (f)) { #ifdef HAVE_XDBE +#ifdef USE_CAIRO + cairo_t *cr = FRAME_CR_CONTEXT (f); + if (cr) + cairo_surface_flush (cairo_get_target (cr)); +#endif XdbeSwapInfo swap_info; memset (&swap_info, 0, sizeof (swap_info)); swap_info.swap_window = FRAME_X_WINDOW (f); @@ -1158,30 +1111,33 @@ x_update_end (struct frame *f) MOUSE_HL_INFO (f)->mouse_face_defer = false; #ifdef USE_CAIRO - if (FRAME_CR_SURFACE (f)) + if (!FRAME_X_DOUBLE_BUFFERED_P (f)) { - cairo_t *cr; - cairo_surface_t *surface; - int width, height; - block_input (); - width = FRAME_PIXEL_WIDTH (f); - height = FRAME_PIXEL_HEIGHT (f); - if (! FRAME_EXTERNAL_TOOL_BAR (f)) - height += FRAME_TOOL_BAR_HEIGHT (f); - if (! FRAME_EXTERNAL_MENU_BAR (f)) - height += FRAME_MENU_BAR_HEIGHT (f); - surface = cairo_xlib_surface_create (FRAME_X_DISPLAY (f), - FRAME_X_DRAWABLE (f), - FRAME_DISPLAY_INFO (f)->visual, - width, - height); - cr = cairo_create (surface); - cairo_surface_destroy (surface); - - cairo_set_source_surface (cr, FRAME_CR_SURFACE (f), 0, 0); - cairo_paint (cr); - cairo_destroy (cr); + cairo_surface_t *source_surface = cairo_get_target (FRAME_CR_CONTEXT (f)); + if (source_surface) + { + cairo_t *cr; + cairo_surface_t *surface; + int width, height; + + width = FRAME_PIXEL_WIDTH (f); + height = FRAME_PIXEL_HEIGHT (f); + if (! FRAME_EXTERNAL_TOOL_BAR (f)) + height += FRAME_TOOL_BAR_HEIGHT (f); + if (! FRAME_EXTERNAL_MENU_BAR (f)) + height += FRAME_MENU_BAR_HEIGHT (f); + surface = cairo_xlib_surface_create (FRAME_X_DISPLAY (f), + FRAME_X_DRAWABLE (f), + FRAME_X_VISUAL (f), + width, height); + cr = cairo_create (surface); + cairo_surface_destroy (surface); + + cairo_set_source_surface (cr, source_surface, 0, 0); + cairo_paint (cr); + cairo_destroy (cr); + } unblock_input (); } #endif @@ -4253,7 +4209,21 @@ x_scroll_run (struct window *w, struct run *run) gui_clear_cursor (w); #ifdef USE_CAIRO - if (FRAME_CR_CONTEXT (f)) + if (FRAME_X_DOUBLE_BUFFERED_P (f)) + { + cairo_t *cr = FRAME_CR_CONTEXT (f); + if (cr) + cairo_surface_flush (cairo_get_target (cr)); + XCopyArea (FRAME_X_DISPLAY (f), + FRAME_X_DRAWABLE (f), FRAME_X_DRAWABLE (f), + f->output_data.x->normal_gc, + x, from_y, + width, height, + x, to_y); + if (cr) + cairo_surface_mark_dirty (cairo_get_target (cr)); + } + else if (FRAME_CR_CONTEXT (f)) { cairo_surface_t *s = cairo_image_surface_create (CAIRO_FORMAT_ARGB32, width, height); @@ -8711,7 +8681,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, font_drop_xrender_surfaces (f); unblock_input (); #ifdef USE_CAIRO - if (f) x_cr_destroy_surface (f); + if (f) + x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width, + configureEvent.xconfigure.height); #endif #ifdef USE_GTK if (!f @@ -8725,7 +8697,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, xg_frame_resized (f, configureEvent.xconfigure.width, configureEvent.xconfigure.height); #ifdef USE_CAIRO - x_cr_destroy_surface (f); + x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width, + configureEvent.xconfigure.height); #endif f = 0; } @@ -11835,7 +11808,9 @@ x_free_frame_resources (struct frame *f) free_frame_xic (f); #endif - x_free_cr_resources (f); +#ifdef USE_CAIRO + x_cr_destroy_frame_context (f); +#endif #ifdef USE_X_TOOLKIT if (f->output_data.x->widget) { diff --git a/src/xterm.h b/src/xterm.h index 266a42afa0..84030d5c25 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -725,8 +725,9 @@ struct x_output #ifdef USE_CAIRO /* Cairo drawing context. */ cairo_t *cr_context; - /* Cairo surface for double buffering */ - cairo_surface_t *cr_surface; + /* Width and height reported by the last ConfigureNotify event. + They are used when creating the cairo surface next time. */ + int cr_surface_desired_width, cr_surface_desired_height; #endif }; @@ -1107,6 +1108,7 @@ extern int x_dispatch_event (XEvent *, Display *); #endif extern int x_x_to_emacs_modifiers (struct x_display_info *, int); #ifdef USE_CAIRO +extern void x_cr_destroy_frame_context (struct frame *); extern cairo_t *x_begin_cr_clip (struct frame *, GC); extern void x_end_cr_clip (struct frame *); extern void x_set_cr_source_with_gc_foreground (struct frame *, GC); commit 5f9671e57ee99cfe4653b2cb6aca16d52f9a5c53 Author: Stefan Monnier Date: Sat May 18 18:32:47 2019 -0400 * lisp/emacs-lisp/package.el: Fix decoding of downloaded files This is a different fix for bug#34909, which should also fix bug#35739. Our downloading code used to automatically decode the result according to the usual heuristics for files. This caused problems when we later needed to save the data in a file that needed to be byte-for-byte equal to the original in order to pass the signature verification, especially because we didn't keep track of which coding-system was used to decode the data. (package--unless-error): New macro extracted from package--with-response-buffer-1, so that we can specify edebug and indent specs. (package--with-response-buffer-1): Use it. More importantly, change code so it runs `body` in a unibyte buffer with undecoded data. (package--download-one-archive): Don't encode with utf-8 since the data is not decoded yet. (describe-package-1): Explicitly decode the readem.txt files here. * lisp/url/url-handlers.el (url-insert-file-contents): Use it. (url-insert): Don't decode if buffer is unibyte. * lisp/url/url-http.el (url-http--insert-file-helper): New function, extracted from url-insert-file-contents. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 656c4e15f6..6b92916095 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1203,42 +1203,60 @@ errors signaled by ERROR-FORM or by BODY). :error-function (lambda () ,error-form) :noerror ,noerror)) +(defmacro package--unless-error (body &rest before-body) + (declare (debug t) (indent 1)) + (let ((err (make-symbol "err"))) + `(with-temp-buffer + (set-buffer-multibyte nil) + (when (condition-case ,err + (progn ,@before-body t) + (error (funcall error-function) + (unless noerror + (signal (car ,err) (cdr ,err))))) + (funcall ,body))))) + (cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) - (cl-macrolet ((unless-error (body &rest before-body) - (let ((err (make-symbol "err"))) - `(with-temp-buffer - (when (condition-case ,err - (progn ,@before-body t) - (error (funcall error-function) - (unless noerror - (signal (car ,err) (cdr ,err))))) - (funcall ,body)))))) - (if (string-match-p "\\`https?:" url) + (if (string-match-p "\\`https?:" url) (let ((url (concat url file))) (if async - (unless-error #'ignore - (url-retrieve url - (lambda (status) - (let ((b (current-buffer))) - (require 'url-handlers) - (unless-error body - (when-let* ((er (plist-get status :error))) - (error "Error retrieving: %s %S" url er)) - (with-current-buffer b - (goto-char (point-min)) - (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) - (error "Error retrieving: %s %S" url "incomprehensible buffer"))) - (url-insert-buffer-contents b url) - (kill-buffer b) - (goto-char (point-min))))) - nil - 'silent)) - (unless-error body (url-insert-file-contents url)))) - (unless-error body + (package--unless-error #'ignore + (url-retrieve + url + (lambda (status) + (let ((b (current-buffer))) + (require 'url-handlers) + (package--unless-error body + (when-let* ((er (plist-get status :error))) + (error "Error retrieving: %s %S" url er)) + (with-current-buffer b + (goto-char (point-min)) + (unless (search-forward-regexp "^\r?\n\r?" nil t) + (error "Error retrieving: %s %S" + url "incomprehensible buffer"))) + (url-insert b) + (kill-buffer b) + (goto-char (point-min))))) + nil + 'silent)) + (package--unless-error body + ;; Copy&pasted from url-insert-file-contents, + ;; except it calls `url-insert' because we want the contents + ;; literally (but there's no url-insert-file-contents-literally). + (let ((buffer (url-retrieve-synchronously url))) + (unless buffer (signal 'file-error (list url "No Data"))) + (when (fboundp 'url-http--insert-file-helper) + ;; XXX: This is HTTP/S specific and should be moved + ;; to url-http instead. See bug#17549. + (url-http--insert-file-helper buffer url)) + (url-insert buffer) + (kill-buffer buffer) + (goto-char (point-min)))))) + (package--unless-error body (let ((url (expand-file-name file url))) (unless (file-name-absolute-p url) - (error "Location %s is not a url nor an absolute file name" url)) - (insert-file-contents url)))))) + (error "Location %s is not a url nor an absolute file name" + url)) + (insert-file-contents-literally url))))) (define-error 'bad-signature "Failed to verify signature") @@ -1297,7 +1315,8 @@ else, even if an error is signaled." (package--with-response-buffer location :file sig-file :async async :noerror t ;; Connection error is assumed to mean "no sig-file". - :error-form (let ((allow-unsigned (eq package-check-signature 'allow-unsigned))) + :error-form (let ((allow-unsigned + (eq package-check-signature 'allow-unsigned))) (when (and callback allow-unsigned) (funcall callback nil)) (when unwind (funcall unwind)) @@ -1306,8 +1325,9 @@ else, even if an error is signaled." ;; OTOH, an error here means "bad signature", which we never ;; suppress. (Bug#22089) (unwind-protect - (let ((sig (package--check-signature-content (buffer-substring (point) (point-max)) - string sig-file))) + (let ((sig (package--check-signature-content + (buffer-substring (point) (point-max)) + string sig-file))) (when callback (funcall callback sig)) sig) (when unwind (funcall unwind)))))) @@ -1584,15 +1604,18 @@ similar to an entry in `package-alist'. Save the cached copy to (member name package-unsigned-archives)) ;; If we don't care about the signature, save the file and ;; we're done. - (progn (let ((coding-system-for-write 'utf-8)) - (write-region content nil local-file nil 'silent)) - (package--update-downloads-in-progress archive)) + (progn + (cl-assert (not enable-multibyte-characters)) + (let ((coding-system-for-write 'binary)) + (write-region content nil local-file nil 'silent)) + (package--update-downloads-in-progress archive)) ;; If we care, check it (perhaps async) and *then* write the file. (package--check-signature location file content async ;; This function will be called after signature checking. (lambda (&optional good-sigs) - (let ((coding-system-for-write 'utf-8)) + (cl-assert (not enable-multibyte-characters)) + (let ((coding-system-for-write 'binary)) (write-region content nil local-file nil 'silent)) ;; Write out good signatures into archive-contents.signed file. (when good-sigs @@ -1906,7 +1929,8 @@ if all the in-between dependencies are also in PACKAGE-LIST." ;; Update the old pkg-desc which will be shown on the description buffer. (setf (package-desc-signed pkg-desc) t) ;; Update the new (activated) pkg-desc as well. - (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))) + (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) + package-alist)))) (setf (package-desc-signed (car pkg-descs)) t)))))))))) (defun package-installed-p (package &optional min-version) @@ -2480,10 +2504,12 @@ The description is read from the installed package files." (replace-match "")))) (if (package-installed-p desc) - ;; For installed packages, get the description from the installed files. + ;; For installed packages, get the description from the + ;; installed files. (insert (package--get-description desc)) - ;; For non-built-in, non-installed packages, get description from the archive. + ;; For non-built-in, non-installed packages, get description from + ;; the archive. (let* ((basename (format "%s-readme.txt" name)) readme-string) @@ -2493,7 +2519,10 @@ The description is read from the installed package files." (goto-char (point-max)) (unless (bolp) (insert ?\n))) - (setq readme-string (buffer-string)) + (cl-assert (not enable-multibyte-characters)) + (setq readme-string + ;; The readme.txt files are defined to contain utf-8 text. + (decode-coding-region (point-min) (point-max) 'utf-8 t)) t) (insert (or readme-string "This package does not provide a description."))) diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index e35d999e0f..4988068293 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -299,7 +299,8 @@ accessible." (defun url-insert (buffer &optional beg end) "Insert the body of a URL object. BUFFER should be a complete URL buffer as returned by `url-retrieve'. -If the headers specify a coding-system, it is applied to the body before it is inserted. +If the headers specify a coding-system (and current buffer is multibyte), +it is applied to the body before it is inserted. Returns a list of the form (SIZE CHARSET), where SIZE is the size in bytes of the inserted text and CHARSET is the charset that was specified in the header, or nil if none was found. @@ -311,12 +312,13 @@ They count bytes from the beginning of the body." (buffer-substring (+ (point-min) beg) (if end (+ (point-min) end) (point-max))) (buffer-string)))) - (charset (mail-content-type-get (mm-handle-type handle) - 'charset))) + (charset (if enable-multibyte-characters + (mail-content-type-get (mm-handle-type handle) + 'charset)))) (mm-destroy-parts handle) - (if charset - (insert (mm-decode-string data (mm-charset-to-coding-system charset))) - (insert data)) + (insert (if charset + (mm-decode-string data (mm-charset-to-coding-system charset)) + data)) (list (length data) charset))) (defvar url-http-codes) @@ -349,23 +351,10 @@ if it had been inserted from a file named URL." (defun url-insert-file-contents (url &optional visit beg end replace) (let ((buffer (url-retrieve-synchronously url))) (unless buffer (signal 'file-error (list url "No Data"))) - (with-current-buffer buffer + (when (fboundp 'url-http--insert-file-helper) ;; XXX: This is HTTP/S specific and should be moved to url-http ;; instead. See bug#17549. - (when (bound-and-true-p url-http-response-status) - ;; Don't signal an error if VISIT is non-nil, because - ;; 'insert-file-contents' doesn't. This is required to - ;; support, e.g., 'browse-url-emacs', which is a fancy way of - ;; visiting the HTML source of a URL: in that case, we want to - ;; display a file buffer even if the URL does not exist and - ;; 'url-retrieve-synchronously' returns 404 or whatever. - (unless (or visit - (and (>= url-http-response-status 200) - (< url-http-response-status 300))) - (let ((desc (nth 2 (assq url-http-response-status url-http-codes)))) - (kill-buffer buffer) - ;; Signal file-error per bug#16733. - (signal 'file-error (list url desc)))))) + (url-http--insert-file-helper buffer url visit)) (url-insert-buffer-contents buffer url visit beg end replace))) (put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 48e29987a5..00803a103a 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -530,6 +530,23 @@ work correctly." (declare-function gnutls-peer-status "gnutls.c" (proc)) (declare-function gnutls-negotiate "gnutls.el" t t) +(defun url-http--insert-file-helper (buffer url &optional visit) + (with-current-buffer buffer + (when (bound-and-true-p url-http-response-status) + ;; Don't signal an error if VISIT is non-nil, because + ;; 'insert-file-contents' doesn't. This is required to + ;; support, e.g., 'browse-url-emacs', which is a fancy way of + ;; visiting the HTML source of a URL: in that case, we want to + ;; display a file buffer even if the URL does not exist and + ;; 'url-retrieve-synchronously' returns 404 or whatever. + (unless (or visit + (and (>= url-http-response-status 200) + (< url-http-response-status 300))) + (let ((desc (nth 2 (assq url-http-response-status url-http-codes)))) + (kill-buffer buffer) + ;; Signal file-error per bug#16733. + (signal 'file-error (list url desc))))))) + (defun url-http-parse-headers () "Parse and handle HTTP specific headers. Return t if and only if the current buffer is still active and commit 2a5705761ea8204441862d59d5fd72a94f5d592a Author: Stefan Monnier Date: Sat May 18 17:40:21 2019 -0400 * lisp/emacs-lisp/package.el: Reduce macrology in ...with-response-buffer (package--with-response-buffer-1): New function, extracted from package--with-response-buffer. (package--with-response-buffer): Use it. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7b779b5ae5..656c4e15f6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1197,45 +1197,48 @@ errors signaled by ERROR-FORM or by BODY). (declare (indent defun) (debug t)) (while (keywordp (car body)) (setq body (cdr (cdr body)))) - (macroexp-let2* nil ((url-1 url) - (noerror-1 noerror)) - (let ((url-sym (make-symbol "url")) - (b-sym (make-symbol "b-sym"))) - `(cl-macrolet ((unless-error (body-2 &rest before-body) - (let ((err (make-symbol "err"))) - `(with-temp-buffer - (when (condition-case ,err - (progn ,@before-body t) - ,(list 'error ',error-form - (list 'unless ',noerror-1 - `(signal (car ,err) (cdr ,err))))) - ,@body-2))))) - (if (string-match-p "\\`https?:" ,url-1) - (let ((,url-sym (concat ,url-1 ,file))) - (if ,async - (unless-error nil - (url-retrieve ,url-sym - (lambda (status) - (let ((,b-sym (current-buffer))) - (require 'url-handlers) - (unless-error ,body - (when-let* ((er (plist-get status :error))) - (error "Error retrieving: %s %S" ,url-sym er)) - (with-current-buffer ,b-sym - (goto-char (point-min)) - (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) - (error "Error retrieving: %s %S" ,url-sym "incomprehensible buffer"))) - (url-insert-buffer-contents ,b-sym ,url-sym) - (kill-buffer ,b-sym) - (goto-char (point-min))))) - nil - 'silent)) - (unless-error ,body (url-insert-file-contents ,url-sym)))) - (unless-error ,body - (let ((url (expand-file-name ,file ,url-1))) - (unless (file-name-absolute-p url) - (error "Location %s is not a url nor an absolute file name" url)) - (insert-file-contents url)))))))) + `(package--with-response-buffer-1 ,url (lambda () ,@body) + :file ,file + :async ,async + :error-function (lambda () ,error-form) + :noerror ,noerror)) + +(cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) + (cl-macrolet ((unless-error (body &rest before-body) + (let ((err (make-symbol "err"))) + `(with-temp-buffer + (when (condition-case ,err + (progn ,@before-body t) + (error (funcall error-function) + (unless noerror + (signal (car ,err) (cdr ,err))))) + (funcall ,body)))))) + (if (string-match-p "\\`https?:" url) + (let ((url (concat url file))) + (if async + (unless-error #'ignore + (url-retrieve url + (lambda (status) + (let ((b (current-buffer))) + (require 'url-handlers) + (unless-error body + (when-let* ((er (plist-get status :error))) + (error "Error retrieving: %s %S" url er)) + (with-current-buffer b + (goto-char (point-min)) + (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) + (error "Error retrieving: %s %S" url "incomprehensible buffer"))) + (url-insert-buffer-contents b url) + (kill-buffer b) + (goto-char (point-min))))) + nil + 'silent)) + (unless-error body (url-insert-file-contents url)))) + (unless-error body + (let ((url (expand-file-name file url))) + (unless (file-name-absolute-p url) + (error "Location %s is not a url nor an absolute file name" url)) + (insert-file-contents url)))))) (define-error 'bad-signature "Failed to verify signature") commit 3dcacb09a921593509d0975e4f6a9434a54521ae Author: Mattias Engdegård Date: Sat May 18 19:48:32 2019 +0200 Fix broken logic in file-notify * lisp/filenotify.el (file-notify-callback): Repair warped condition that didn't match rename-to/from events correctly. diff --git a/lisp/filenotify.el b/lisp/filenotify.el index a6054c175f..26b83ce66c 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -161,12 +161,14 @@ EVENT is the cadr of the event in `file-notify-handle-event' (while actions (let ((action (pop actions))) ;; Send pending event, if it doesn't match. + ;; We only handle {renamed,moved}-{from,to} pairs when these + ;; arrive in order without anything else in-between. (when (and file-notify--pending-event - ;; The cookie doesn't match. - (not (equal (file-notify--event-cookie - (car file-notify--pending-event)) - (file-notify--event-cookie event))) (or + ;; The cookie doesn't match. + (not (equal (file-notify--event-cookie + (car file-notify--pending-event)) + (file-notify--event-cookie event))) ;; inotify. (and (eq (nth 1 (car file-notify--pending-event)) 'moved-from) commit 028a23dc9d138907d7f434e73febf6ec08b28e16 Author: Paul Eggert Date: Sat May 18 11:05:06 2019 -0700 * lisp/textmodes/texinfmt.el: Chassell is no longer maintainer. diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index 4bfecb48b6..9ccc73ad48 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2019 Free Software ;; Foundation, Inc. -;; Maintainer: Robert J. Chassell +;; Maintainer: bug-texinfo@gnu.org ;; Keywords: maint, tex, docs ;; This file is part of GNU Emacs. commit d6e7b18db13ed06ada8ed9110fb3d6a55c3605a1 Author: Jean-Christophe Helary Date: Sat May 18 11:02:12 2019 -0700 Bob Chassell passed away * doc/lispintro/emacs-lisp-intro.texi (About the Author): Update. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 519decb1d0..09b6698722 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -21858,14 +21858,17 @@ MENU ENTRY: NODE NAME. @end ifnottex @quotation -Robert J. Chassell has worked with GNU Emacs since 1985. He writes -and edits, teaches Emacs and Emacs Lisp, and speaks throughout the +Robert J. Chassell started working with GNU Emacs in 1985. He wrote +and edited, taught Emacs and Emacs Lisp, and spoke throughout the world on software freedom. Chassell was a founding Director and -Treasurer of the Free Software Foundation, Inc. He is co-author of -the @cite{Texinfo} manual, and has edited more than a dozen other -books. He graduated from Cambridge University, in England. He has an -abiding interest in social and economic history and flies his own -airplane. +Treasurer of the Free Software Foundation, Inc. He was co-author of +the @cite{Texinfo} manual, and edited more than a dozen other +books. He graduated from Cambridge University, in England. He had an +abiding interest in social and economic history and flew his own +airplane. He passed away on 30 June 2017. + +@uref{https://www.fsf.org/blogs/community/goodbye-to-bob-chassell, +"Goodbye to Bob Chassell"} @end quotation @c @page commit ae7056793ca78a62562b4a5c46ffbef66493ec60 Author: Paul Eggert Date: Sat May 18 10:50:36 2019 -0700 Fix recent Tramp typo that broke the build ‘make bootstrap’ without this patch should reproduce the problem. * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Autoload zeroconf-init. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 03870537c9..3810231824 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -118,6 +118,7 @@ (defconst tramp-gvfs-enabled (ignore-errors (and (featurep 'dbusbind) + (autoload 'zeroconf-init "zeroconf") (tramp-compat-funcall 'dbus-get-unique-name :system) (tramp-compat-funcall 'dbus-get-unique-name :session) (or (tramp-compat-process-running-p "gvfs-fuse-daemon") commit 63ffb61396042f61705a9ab97fc80515d918c7e5 Author: Basil L. Contovounesios Date: Sat May 18 18:06:29 2019 +0100 Remove XEmacs audio checks from mm-decode.el For discussion, see the following threads: https://lists.gnu.org/archive/html/emacs-devel/2019-03/msg01087.html https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00584.html * lisp/gnus/mm-decode.el (mm-inline-media-tests): Remove no-op media tests for XEmacs features. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 93b57706f8..5b1859e324 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -262,15 +262,6 @@ before the external MIME handler is invoked." ("text/.*" mm-inline-text identity) ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity) ("application/zip" mm-archive-dissect-and-inline identity) - ("audio/wav" mm-inline-audio - ,(lambda (_handle) - (and (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)))) - ("audio/au" - mm-inline-audio - ,(lambda (_handle) - (and (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)))) ("application/pgp-signature" ignore identity) ("application/x-pkcs7-signature" ignore identity) ("application/pkcs7-signature" ignore identity) commit db9af103944959be640a53fcf0f0b696f25d553f Author: Paul Eggert Date: Sat May 18 10:00:26 2019 -0700 For SVG, 8192 is the new 256 Prefer librsvg for display of splash.svg When both librsvg and Imagemagick are available, Emacs should prefer librsvg to render SVG images. However, Emacs was using Imagemagick to render its own splash.svg file because image-type-from-file-header returned nil for that file. * lisp/image.el (image-type-from-buffer) (image-type-from-file-header): Look at the first 8192 bytes of the image, not just the first 256. For Emacs’s own splash.svg file, image-type-header-regexps needs to look at 939 bytes. 8192 bytes is a reasonable number nowadays given typical file system design. * test/lisp/image-tests.el (image-tests--emacs-images-directory): New contant. (image-type-from-file-header-test): New test. diff --git a/lisp/image.el b/lisp/image.el index ba87d7f785..db11302086 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -315,7 +315,7 @@ be determined." (buffer-substring (point-min) (min (point-max) - (+ (point-min) 256)))))) + (+ (point-min) 8192)))))) (setq image-type (cdr image-type)))) (setq type image-type types nil) @@ -339,7 +339,7 @@ be determined." (file-readable-p file) (with-temp-buffer (set-buffer-multibyte nil) - (insert-file-contents-literally file nil 0 256) + (insert-file-contents-literally file nil 0 8192) (image-type-from-buffer)))) diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 89b926e629..621646e575 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -22,6 +22,10 @@ (require 'ert) (require 'image) +(defconst image-tests--emacs-images-directory + (expand-file-name "../etc/images" (getenv "EMACS_TEST_DIRECTORY")) + "Directory containing Emacs images.") + (ert-deftest image--set-property () "Test `image--set-property' behavior." (let ((image (list 'image))) @@ -42,4 +46,11 @@ (setf (image-property image :width) nil) (should (equal image '(image))))) +(ert-deftest image-type-from-file-header-test () + "Test image-type-from-file-header." + (should (eq 'svg + (image-type-from-file-header + (expand-file-name "splash.svg" + image-tests--emacs-images-directory))))) + ;;; image-tests.el ends here commit 5b8be5809eff0f644c3484a2a110a8812236f518 Merge: 16f14a4dbb 95fb826dc5 Author: Michael Albinus Date: Sat May 18 18:14:39 2019 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 16f14a4dbb45075c2c48f25784ddfbecb4433792 Author: Michael Albinus Date: Sat May 18 18:14:17 2019 +0200 Bug#35769 * lisp/net/tramp-sh.el: (tramp-maybe-open-connection): Arrange `process-environment' that it doesn't work for local processes. (Bug#35769) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2d27baf454..11b1af8116 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4769,8 +4769,8 @@ Does not do anything if a connection is already open, but re-opens the connection if a previous connection has died for some reason." (let ((p (tramp-get-connection-process vec)) (process-name (tramp-get-connection-property vec "process-name" nil)) - (process-environment (copy-sequence process-environment)) - (pos (with-current-buffer (tramp-get-connection-buffer vec) (point)))) + (pos (with-current-buffer (tramp-get-connection-buffer vec) (point))) + tmp-process-environment) ;; If Tramp opens the same connection within a short time frame, ;; there is a problem. We shall signal this. @@ -4835,17 +4835,22 @@ connection if a previous connection has died for some reason." ;; Start new process. (when (and p (processp p)) (delete-process p)) - (setenv "TERM" tramp-terminal-type) - (setenv "LC_ALL" (tramp-get-local-locale vec)) - (if (stringp tramp-histfile-override) - (setenv "HISTFILE" tramp-histfile-override) - (if tramp-histfile-override - (progn - (setenv "HISTFILE") - (setenv "HISTFILESIZE" "0") - (setenv "HISTSIZE" "0")))) - (setenv "PROMPT_COMMAND") - (setenv "PS1" tramp-initial-end-of-output) + ;; Use a temporary `process-environment', in order not + ;; to penetrate local processes. + (let ((process-environment (copy-sequence process-environment))) + (setenv "TERM" tramp-terminal-type) + (setenv "LC_ALL" (tramp-get-local-locale vec)) + (if (stringp tramp-histfile-override) + (setenv "HISTFILE" tramp-histfile-override) + (if tramp-histfile-override + (progn + (setenv "HISTFILE") + (setenv "HISTFILESIZE" "0") + (setenv "HISTSIZE" "0")))) + (setenv "PROMPT_COMMAND") + (setenv "PS1" tramp-initial-end-of-output) + (setq tmp-process-environment + (copy-sequence process-environment))) (unless (stringp tramp-encoding-shell) (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) (let* ((current-host (system-name)) @@ -4862,7 +4867,8 @@ connection if a previous connection has died for some reason." ;; This must be done in order to avoid our file ;; name handler. (p (let ((default-directory - (tramp-compat-temporary-file-directory))) + (tramp-compat-temporary-file-directory)) + (process-environment tmp-process-environment)) (apply #'start-process (tramp-get-connection-name vec) commit 95fb826dc58965eac287c0826831352edf2e56f7 Author: Alan Mackenzie Date: Sat May 18 15:20:49 2019 +0000 CC Mode: Handle several consecutive noise macros in declaration contexts. In the bug scenario, the second and subsequent noise macros with parentheses were getting font-lock-type-face. * lisp/progmodes/cc-engine.el (c-end-of-token) (c-forward-noise-clause-not-macro-decl): New functions. (c-find-decl-prefix-search): Handle noise macros by skipping over them. (c-forward-decl-or-cast-1): In the loop checking for types, skip over all consecutive noise macros with parens, not just one. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 41bab270da..c0f044ddfe 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -4491,6 +4491,30 @@ comment at the start of cc-engine.el for more info." (goto-char pos)))))) (< (point) start))) +(defun c-end-of-token (&optional back-limit) + ;; Move to the end of the token we're just before or in the middle of. + ;; BACK-LIMIT may be used to bound the backward search; if given it's + ;; assumed to be at the boundary between two tokens. Return non-nil if the + ;; point is moved, nil otherwise. + ;; + ;; This function might do hidden buffer changes. + (let ((start (point))) + (cond ;; ((< (skip-syntax-backward "w_" (1- start)) 0) + ;; (skip-syntax-forward "w_")) + ((> (skip-syntax-forward "w_") 0)) + ((< (skip-syntax-backward ".()" back-limit) 0) + (while (< (point) start) + (if (looking-at c-nonsymbol-token-regexp) + (goto-char (match-end 0)) + ;; `c-nonsymbol-token-regexp' should always match since + ;; we've skipped backward over punctuation or paren + ;; syntax, but move forward in case it doesn't so that + ;; we don't leave point earlier than we started with. + (forward-char)))) + (t (if (looking-at c-nonsymbol-token-regexp) + (goto-char (match-end 0))))) + (> (point) start))) + (defun c-end-of-current-token (&optional back-limit) ;; Move to the end of the current token. Do not move if not in the ;; middle of one. BACK-LIMIT may be used to bound the backward @@ -5878,9 +5902,14 @@ comment at the start of cc-engine.el for more info." ;; comment style has removed face properties from a construct, ;; and is relying on `c-font-lock-declarations' to add them ;; again. - (and (< (point) cfd-limit) - (looking-at c-doc-line-join-re) - (goto-char (match-end 0))))) + (cond + ((looking-at c-noise-macro-name-re) + (c-forward-noise-clause-not-macro-decl nil)) ; Returns t. + ((looking-at c-noise-macro-with-parens-name-re) + (c-forward-noise-clause-not-macro-decl t)) ; Always returns t. + ((and (< (point) cfd-limit) + (looking-at c-doc-line-join-re)) + (goto-char (match-end 0)))))) ;; Set the position to continue at. We can avoid going over ;; the comments skipped above a second time, but it's possible ;; that the comment skipping has taken us past `cfd-prop-match' @@ -5909,6 +5938,8 @@ comment at the start of cc-engine.el for more info." ;; o The first token after the end of submatch 1 in ;; `c-decl-prefix-or-start-re' when that submatch matches. This ;; submatch is typically a (L or R) brace or paren, a ;, or a ,. + ;; As a special case, noise macros are skipped over and the next + ;; token regarded as the spot. ;; o The start of each `c-decl-prefix-or-start-re' match when ;; submatch 1 doesn't match. This is, for example, the keyword ;; "class" in Pike. @@ -7439,6 +7470,21 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws)) t) +(defun c-forward-noise-clause-not-macro-decl (maybe-parens) + ;; Point is at a noise macro identifier, which, when MAYBE-PARENS is + ;; non-nil, optionally takes paren arguments. Go forward over this name, + ;; and when there may be optional parens, any parenthesis expression which + ;; follows it, but DO NOT go over any macro declaration which may come + ;; between them. Always return t. + (c-end-of-token) + (when maybe-parens + (let ((here (point))) + (c-forward-comments) + (if (not (and (eq (char-after) ?\() + (c-go-list-forward))) + (goto-char here)))) + t) + (defun c-forward-keyword-clause (match) ;; Submatch MATCH in the current match data is assumed to surround a ;; token. If it's a keyword, move over it and any immediately @@ -9053,7 +9099,10 @@ This function might do hidden buffer changes." ((and c-opt-cpp-prefix (looking-at c-noise-macro-with-parens-name-re)) (setq noise-start (point)) - (c-forward-noise-clause) + (while + (and + (c-forward-noise-clause) + (looking-at c-noise-macro-with-parens-name-re))) (setq kwd-clause-end (point)))) (when (setq found-type (c-forward-type t)) ; brace-block-too commit 67b6c1b295afb0c2f51a2e01e19ab4682845148e Merge: 721c520f36 9fcc991229 Author: Eli Zaretskii Date: Sat May 18 17:46:29 2019 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 9fcc9912296642322fec99ff146be3acdae2aa7b Author: Bastien Date: Sat May 18 16:45:00 2019 +0200 Fix missing declaration in gnus-sum.el * lisp/gnus/gnus-sum.el (gnus-tmp-name): Declare var. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 556fb63a07..31958ff7b0 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -42,6 +42,7 @@ (defvar gnus-tmp-indentation) (defvar gnus-tmp-level) (defvar gnus-tmp-lines) +(defvar gnus-tmp-name) (defvar gnus-tmp-number) (defvar gnus-tmp-opening-bracket) (defvar gnus-tmp-process) commit 721c520f36c151a738c47404b498672390139ada Author: Eli Zaretskii Date: Sat May 18 17:44:16 2019 +0300 Fix display of images on MS-Windows broken by a recent commit * src/image.c (initialize_image_type): Test if the type is in Vlibrary_cache up front, and return true without calling the 'init' method if the type was already initialized. diff --git a/src/image.c b/src/image.c index b82bf12aa5..071b92a741 100644 --- a/src/image.c +++ b/src/image.c @@ -9696,15 +9696,15 @@ static bool initialize_image_type (struct image_type const *type) { #ifdef WINDOWSNT - bool (*init) (void) = type->init; + Lisp_Object typesym = builtin_lisp_symbol (type->type); + Lisp_Object tested = Fassq (typesym, Vlibrary_cache); + /* If we failed to load the library before, don't try again. */ + if (CONSP (tested)) + return !NILP (XCDR (tested)) ? true : false; + bool (*init) (void) = type->init; if (init) { - /* If we failed to load the library before, don't try again. */ - Lisp_Object typesym = builtin_lisp_symbol (type->type); - Lisp_Object tested = Fassq (typesym, Vlibrary_cache); - if (CONSP (tested) && NILP (XCDR (tested))) - return false; bool type_valid = init (); Vlibrary_cache = Fcons (Fcons (typesym, type_valid ? Qt : Qnil), Vlibrary_cache); commit b0a0705a4e46831020edb7336a765c50baa093ff Author: Michael Albinus Date: Sat May 18 16:04:58 2019 +0200 Suppress compiler warnings for older Emacsen in tramp-tests.el * test/lisp/net/tramp-tests.el (tramp-test17-insert-directory): Add error name to test. (tramp-test30-make-process, tramp-test45-unload): Suppress compiler warnings from older Emacsen. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 75c7ac6ca4..5fc37c1934 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2794,7 +2794,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; returns `file-missing'. (delete-directory tmp-name1 'recursive) (with-temp-buffer - (should-error (insert-directory tmp-name1 nil)))) + (should-error + (insert-directory tmp-name1 nil) + :type tramp-file-missing))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) @@ -3962,7 +3964,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - ;; `make-process' supports file name handlers since Emacs 27. + ;; `make-process' has been inserted in Emacs 25.1. It supports file + ;; name handlers since Emacs 27. (skip-unless (tramp--test-emacs27-p)) (tramp--test-instrument-test-case 0 @@ -3970,15 +3973,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let ((default-directory tramp-test-temporary-file-directory) (tmp-name (tramp--test-make-temp-name nil quoted)) kill-buffer-query-functions proc) - (should-not (make-process)) + (should-not (with-no-warnings (make-process))) ;; Simple process. (unwind-protect (with-temp-buffer (setq proc - (make-process - :name "test1" :buffer (current-buffer) :command '("cat") - :file-handler t)) + (with-no-warnings + (make-process + :name "test1" :buffer (current-buffer) :command '("cat") + :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) (process-send-string proc "foo") @@ -4000,10 +4004,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) (setq proc - (make-process - :name "test2" :buffer (current-buffer) - :command `("cat" ,(file-name-nondirectory tmp-name)) - :file-handler t)) + (with-no-warnings + (make-process + :name "test2" :buffer (current-buffer) + :command `("cat" ,(file-name-nondirectory tmp-name)) + :file-handler t))) (should (processp proc)) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4020,12 +4025,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unwind-protect (with-temp-buffer (setq proc - (make-process - :name "test3" :buffer (current-buffer) :command '("cat") - :filter - (lambda (p s) - (with-current-buffer (process-buffer p) (insert s))) - :file-handler t)) + (with-no-warnings + (make-process + :name "test3" :buffer (current-buffer) :command '("cat") + :filter + (lambda (p s) + (with-current-buffer (process-buffer p) (insert s))) + :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) (process-send-string proc "foo") @@ -4045,12 +4051,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unwind-protect (with-temp-buffer (setq proc - (make-process - :name "test4" :buffer (current-buffer) :command '("cat") - :sentinel - (lambda (p s) - (with-current-buffer (process-buffer p) (insert s))) - :file-handler t)) + (with-no-warnings + (make-process + :name "test4" :buffer (current-buffer) :command '("cat") + :sentinel + (lambda (p s) + (with-current-buffer (process-buffer p) (insert s))) + :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) (process-send-string proc "foo") @@ -4073,11 +4080,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (unwind-protect (with-temp-buffer (setq proc - (make-process - :name "test5" :buffer (current-buffer) - :command '("cat" "/") - :stderr stderr - :file-handler t)) + (with-no-warnings + (make-process + :name "test5" :buffer (current-buffer) + :command '("cat" "/") + :stderr stderr + :file-handler t))) (should (processp proc)) ;; Read stderr. (with-current-buffer stderr @@ -5755,7 +5763,7 @@ Since it unloads Tramp, it shall be the last test to run." (ert-fail (format "`%s' still bound" x))))) ;; The defstruct `tramp-file-name' and all its internal functions ;; shall be purged. - (should-not (cl--find-class 'tramp-file-name)) + (should-not (with-no-warnings (cl--find-class 'tramp-file-name))) (mapatoms (lambda (x) (and (functionp x) commit cac8884d892a8708d74c55e53328ee45f88d82f0 Author: Michael Albinus Date: Sat May 18 16:04:02 2019 +0200 Require less packages in Tramp * lisp/net/tramp-compat.el (format-spec): Do not require advice, cl-lib, custom, password-cache, timer and ucs-normalize. * lisp/net/tramp-gvfs.el: Do not require zeroconf. Declare zeroconf-* functions. (tramp-gvfs-enabled): Autoload `zeroconf-init'. * lisp/net/tramp-sh.el: Do not require dired. * lisp/net/tramp.el (tramp-get-debug-buffer): Do not require outline. (tramp-file-name-for-operation): Extend docstring. (tramp-parse-netrc): Do not require netrc. Autoload `netrc-parse'. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b515f253c9..21a819f79f 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -35,15 +35,9 @@ (defun tramp-unload-file-name-handlers ()) (require 'auth-source) -(require 'advice) -(require 'cl-lib) -(require 'custom) (require 'format-spec) (require 'parse-time) -(require 'password-cache) (require 'shell) -(require 'timer) -(require 'ucs-normalize) (declare-function tramp-handle-temporary-file-directory "tramp") diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 52eaf686ea..03870537c9 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -99,16 +99,21 @@ (eval-when-compile (require 'cl-lib)) (require 'tramp) - (require 'dbus) (require 'url-parse) (require 'url-util) -(require 'zeroconf) ;; Pacify byte-compiler. (eval-when-compile (require 'custom)) +(declare-function zeroconf-init "zeroconf") +(declare-function zeroconf-list-service-types "zeroconf") +(declare-function zeroconf-list-services "zeroconf") +(declare-function zeroconf-service-host "zeroconf") +(declare-function zeroconf-service-port "zeroconf") +(declare-function zeroconf-service-txt "zeroconf") + ;; We don't call `dbus-ping', because this would load dbus.el. (defconst tramp-gvfs-enabled (ignore-errors diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index da168adce7..35d2eb38e6 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -31,10 +31,10 @@ ;; Pacify byte-compiler. (require 'cl-lib) +(declare-function recentf-cleanup "recentf") (declare-function tramp-dissect-file-name "tramp") (declare-function tramp-file-name-equal-p "tramp") (declare-function tramp-tramp-file-p "tramp") -(declare-function recentf-cleanup "recentf") (defvar eshell-path-env) (defvar recentf-exclude) (defvar tramp-current-connection) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 95fa61af98..2d27baf454 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -30,10 +30,6 @@ (eval-when-compile (require 'cl-lib)) (require 'tramp) -;; Pacify byte-compiler. -(eval-when-compile - (require 'dired)) - (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) (defvar vc-handled-backends) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 88389346c3..48152444a6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1641,8 +1641,6 @@ The outline level is equal to the verbosity of the Tramp message." (get-buffer-create (tramp-debug-buffer-name vec)) (when (bobp) (setq buffer-undo-list t) - ;; So it does not get loaded while `outline-regexp' is let-bound. - (require 'outline) ;; Activate `outline-mode'. This runs `text-mode-hook' and ;; `outline-mode-hook'. We must prevent that local processes ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". @@ -2142,7 +2140,11 @@ pass to the OPERATION." ;; function as well but regexp only. (defun tramp-file-name-for-operation (operation &rest args) "Return file name related to OPERATION file primitive. -ARGS are the arguments OPERATION has been called with." +ARGS are the arguments OPERATION has been called with. + +It does not always return a Tramp file name, for example if the +first argument of `expand-file-name' is absolute and not remote. +Must be handled by the callers." (cond ;; FILE resp DIRECTORY. ((member operation @@ -2954,7 +2956,9 @@ Host is always \"localhost\"." (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." - (require 'netrc) + ;; The declaration is not sufficient at runtime, because netrc.el is + ;; not autoloaded. + (autoload 'netrc-parse "netrc") (mapcar (lambda (item) (and (assoc "machine" item) @@ -3387,6 +3391,7 @@ User is always nil." (access-file filename "Reading directory")) (with-parsed-tramp-file-name (expand-file-name filename) nil (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename) + ;; We must load it in order to get the advice around `insert-directory'. (require 'ls-lisp) (let (ls-lisp-use-insert-directory-program start) (tramp-run-real-handler @@ -4879,7 +4884,6 @@ Only works for Bourne-like shells." ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' ;; - Cleanup hooks where Tramp functions are in -;; - Cleanup advised functions ;; - Cleanup autoloads ;;;###autoload (defun tramp-unload-tramp () commit 1943220d1b7ed28b2708c86acfe5493d5c6e3089 Author: Mattias Engdegård Date: Wed May 8 00:02:59 2019 +0200 Don't use file notification on non-file buffers Allow non-file buffers to declare that notification on their default-directory is sufficient to know when auto-revert updates are required by setting the new variable `buffer-auto-revert-by-notification' to non-nil. If nil, the default, then auto-revert will poll those buffers instead. (bug#35418). Currently, only Dired sets that variable. * lisp/autorevert.el (auto-revert-buffers): Modify condition for using notification. * lisp/files.el (buffer-auto-revert-by-notification): New variable. * lisp/dired.el (dired-mode): Set buffer-auto-revert-by-notification. * doc/emacs/arevert-xtra.texi (Non-File Buffers): Document new variable. * etc/NEWS (Changes in Specialized Modes and Packages): Describe new variable. diff --git a/doc/emacs/arevert-xtra.texi b/doc/emacs/arevert-xtra.texi index 9e01a10ace..37e2f9e581 100644 --- a/doc/emacs/arevert-xtra.texi +++ b/doc/emacs/arevert-xtra.texi @@ -35,6 +35,14 @@ the Buffer Menu.) In this case, Auto Revert does not print any messages while reverting, even when @code{auto-revert-verbose} is non-@code{nil}. +@vindex buffer-auto-revert-by-notification +Some non-file buffers can be updated reliably by file notification on +their default directory; Dired buffers is an example. The major mode +can indicate this by setting @code{buffer-auto-revert-by-notification} +to a non-@code{nil} value in that buffer, allowing Auto Revert to +avoid periodic polling. Such notification does not include changes to +files in that directory, only to the directory itself. + The details depend on the particular types of buffers and are explained in the corresponding sections. diff --git a/etc/NEWS b/etc/NEWS index 8c059157ba..b4aa8d98ff 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1446,6 +1446,13 @@ of an idle Emacs, but may fail on some network file systems; set notification is not supported. The new variable currently has no effect in 'global-auto-revert-mode'. The default value is nil. +*** New variable 'buffer-auto-revert-by-notification' +A major mode can declare that notification on the buffer's default +directory is sufficient to know when updates are required, by setting +the new variable 'buffer-auto-revert-by-notification' to a non-nil +value. Auto Revert mode can use this information to avoid polling the +buffer periodically when 'auto-revert-avoid-polling' is non-nil. + * New Modes and Packages in Emacs 27.1 diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 7cd5e7ee8b..197a2bf157 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -858,8 +858,12 @@ the timer when no buffers need to be checked." (auto-revert-remove-current-buffer)) (when (auto-revert-active-p) ;; Enable file notification. + ;; Don't bother creating a notifier for non-file buffers + ;; unless it explicitly indicates that this works. (when (and auto-revert-use-notify - (not auto-revert-notify-watch-descriptor)) + (not auto-revert-notify-watch-descriptor) + (or buffer-file-name + buffer-auto-revert-by-notification)) (auto-revert-notify-add-watch)) (auto-revert-handler))))) (setq bufs (cdr bufs))) diff --git a/lisp/dired.el b/lisp/dired.el index 385126514b..ea1943de1d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2148,6 +2148,7 @@ Keybindings: (setq buffer-invisibility-spec (list t))) (setq-local revert-buffer-function #'dired-revert) (setq-local buffer-stale-function #'dired-buffer-stale-p) + (setq-local buffer-auto-revert-by-notification t) (setq-local page-delimiter "\n\n") (setq-local dired-directory (or dirname default-directory)) ;; list-buffers uses this to display the dir being edited in this buffer. diff --git a/lisp/files.el b/lisp/files.el index 8fa7f16de0..1dec0ed7ca 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5890,6 +5890,16 @@ This should not be relied upon. For more information on how this variable is used by Auto Revert mode, see Info node `(emacs)Supporting additional buffers'.") +(defvar-local buffer-auto-revert-by-notification nil + "Whether a buffer can rely on notification in Auto-Revert mode. +If non-nil, monitoring changes to the directory of the current +buffer is sufficient for knowing when that buffer needs to be +updated in Auto Revert Mode. Such notification does not include +changes to files in that directory, only to the directory itself. + +This variable only applies to buffers where `buffer-file-name' is +nil; other buffers are tracked by their files.") + (defvar before-revert-hook nil "Normal hook for `revert-buffer' to run before reverting. The function `revert-buffer--default' runs this. commit 4bf447bb912d73c4637f1094c265994dd99ff7e8 Author: Lars Ingebrigtsen Date: Sat May 18 11:18:42 2019 +0200 (epa-file-decode-and-insert): Byte compilation warning fix * lisp/epa-file.el (epa-file-decode-and-insert): Remove superfluous call to `string-to-multibyte string'. diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 35cd1ecfde..d9886d3d67 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -105,9 +105,7 @@ encryption is used." (if (fboundp 'decode-coding-inserted-region) (save-restriction (narrow-to-region (point) (point)) - (insert (if enable-multibyte-characters - (string-to-multibyte string) - string)) + (insert string) (decode-coding-inserted-region (point-min) (point-max) (substring file 0 (string-match epa-file-name-regexp file)) commit 168b8322c375a4b4044d57d37f3b81798271dd92 Author: Michael Albinus Date: Sat May 18 11:11:36 2019 +0200 * lisp/net/tramp.el (tramp-interrupt-process): Return proper value. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 38f07970a7..88389346c3 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4864,9 +4864,8 @@ Only works for Bourne-like shells." (format "kill -2 -%d" pid)) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. - (and (tramp-accept-process-output proc 1) - ;; Report success. - proc))))) + (while (tramp-accept-process-output proc 0)) + (not (process-live-p proc)))))) ;; `interrupt-process-functions' exists since Emacs 26.1. (when (boundp 'interrupt-process-functions) commit b9303ac2931a7945a47e97cf15aa45707c925892 Author: Michael Albinus Date: Sat May 18 11:11:23 2019 +0200 ; Add comment in tramp-archive.el diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index b096edc4b3..e6ae73aae6 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -129,6 +129,8 @@ (setq tramp-archive-enabled tramp-gvfs-enabled) ;; +;; Note: "arc" and "zoo" are supported by `archive-mode', but they +;; don't work here. ;;;###autoload (defconst tramp-archive-suffixes ;; "cab", "lzh", "msu" and "zip" are included with lower and upper