commit 2e9111813b1dfdda1bf56c2b70a4220dbd8abce1 (HEAD, refs/remotes/origin/master) Author: Sean Whitton Date: Mon Apr 11 09:20:35 2022 -0700 Add two classic Common Lisp macro-writing macros * lisp/emacs-lisp/cl-macs.el (cl-with-gensyms, cl-once-only): New macros. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index da7157f434..af8855516c 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2430,6 +2430,57 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (unless advised (advice-remove 'macroexpand #'cl--sm-macroexpand))))) +;;;###autoload +(defmacro cl-with-gensyms (names &rest body) + "Bind each of NAMES to an uninterned symbol and evaluate BODY." + (declare (debug (sexp body)) (indent 1)) + `(let ,(cl-loop for name in names collect + `(,name (gensym (symbol-name ',name)))) + ,@body)) + +;;;###autoload +(defmacro cl-once-only (names &rest body) + "Generate code to evaluate each of NAMES just once in BODY. + +This macro helps with writing other macros. Each of names is +either (NAME FORM) or NAME, which latter means (NAME NAME). +During macroexpansion, each NAME is bound to an uninterned +symbol. The expansion evaluates each FORM and binds it to the +corresponding uninterned symbol. + +For example, consider this macro: + + (defmacro my-cons (x) + (cl-once-only (x) + \\=`(cons ,x ,x))) + +The call (my-cons (pop y)) will expand to something like this: + + (let ((g1 (pop y))) + (cons g1 g1)) + +The use of `cl-once-only' ensures that the pop is performed only +once, as intended. + +See also `macroexp-let2'." + (declare (debug (sexp body)) (indent 1)) + (setq names (mapcar #'ensure-list names)) + (let ((our-gensyms (cl-loop for _ in names collect (gensym)))) + ;; During macroexpansion, obtain a gensym for each NAME. + `(let ,(cl-loop for sym in our-gensyms collect `(,sym (gensym))) + ;; Evaluate each FORM and bind to the corresponding gensym. + ;; + ;; We require this explicit call to `list' rather than using + ;; (,,@(cl-loop ...)) due to a limitation of Elisp's backquote. + `(let ,(list + ,@(cl-loop for name in names and gensym in our-gensyms + for to-eval = (or (cadr name) (car name)) + collect ``(,,gensym ,,to-eval))) + ;; During macroexpansion, bind each NAME to its gensym. + ,(let ,(cl-loop for name in names and gensym in our-gensyms + collect `(,(car name) ,gensym)) + ,@body))))) + ;;; Multiple values. ;;;###autoload commit e2b64f8999f79a5820ba00d2987885d7dda492d5 Author: Po Lu Date: Tue Apr 12 13:27:56 2022 +0800 Fix some DISPLAY variable related bugs on PGTK * src/callproc.c (getenv_internal, make_environment_block): Don't set DISPLAY on non-X GDK backends. (bug#54844) diff --git a/src/callproc.c b/src/callproc.c index 0922e10f01..dd162f36a6 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -85,6 +85,10 @@ extern char **environ; #include "nsterm.h" #endif +#ifdef HAVE_PGTK +#include "pgtkterm.h" +#endif + /* Pattern used by call-process-region to make temp files. */ static Lisp_Object Vtemp_file_name_pattern; @@ -1687,6 +1691,7 @@ getenv_internal (const char *var, ptrdiff_t varlen, char **value, /* For DISPLAY try to get the values from the frame or the initial env. */ if (strcmp (var, "DISPLAY") == 0) { +#ifndef HAVE_PGTK Lisp_Object display = Fframe_parameter (NILP (frame) ? selected_frame : frame, Qdisplay); if (STRINGP (display)) @@ -1695,6 +1700,7 @@ getenv_internal (const char *var, ptrdiff_t varlen, char **value, *valuelen = SBYTES (display); return 1; } +#endif /* If still not found, Look for DISPLAY in Vinitial_environment. */ if (getenv_internal_1 (var, varlen, value, valuelen, Vinitial_environment)) @@ -1812,6 +1818,18 @@ make_environment_block (Lisp_Object current_dir) if (NILP (display)) { Lisp_Object tmp = Fframe_parameter (selected_frame, Qdisplay); + +#ifdef HAVE_PGTK + /* The only time GDK actually returns correct information is + when it's running under X Windows. DISPLAY shouldn't be + set to a Wayland display either, since that's an X specific + variable. */ + if (FRAME_WINDOW_P (SELECTED_FRAME ()) + && strcmp (G_OBJECT_TYPE_NAME (FRAME_X_DISPLAY (SELECTED_FRAME ())), + "GdkX11Display")) + tmp = Qnil; +#endif + if (!STRINGP (tmp) && CONSP (Vinitial_environment)) /* If still not found, Look for DISPLAY in Vinitial_environment. */ tmp = Fgetenv_internal (build_string ("DISPLAY"), commit b15d9fcebbafc583906a5896dc73dacd0814544c Author: Po Lu Date: Tue Apr 12 12:01:34 2022 +0800 * src/xterm.c (frame_set_mouse_pixel_position): Avoid server grab. diff --git a/src/xterm.c b/src/xterm.c index 342f2b044f..b1d9ca7361 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -20850,16 +20850,17 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) if (FRAME_DISPLAY_INFO (f)->supports_xi2) { - XGrabServer (FRAME_X_DISPLAY (f)); - if (XIGetClientPointer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + if (XIGetClientPointer (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), &deviceid)) { + x_catch_errors (FRAME_X_DISPLAY (f)); XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); + x_uncatch_errors (); } - XUngrabServer (FRAME_X_DISPLAY (f)); } else #endif commit bf44581a5e6a8232b222261a607e5bee148c195b Author: Po Lu Date: Tue Apr 12 02:37:39 2022 +0000 Don't use native image APIs for some types on Haiku * src/haikuimage.c (haiku_can_use_native_image_api): Ignore types with animations when their respective libraries are present. diff --git a/src/haikuimage.c b/src/haikuimage.c index 1207fb32d3..af3021c5cd 100644 --- a/src/haikuimage.c +++ b/src/haikuimage.c @@ -42,8 +42,10 @@ haiku_can_use_native_image_api (Lisp_Object type) mime_type = "image/jpeg"; else if (EQ (type, Qpng)) mime_type = "image/png"; +#ifndef HAVE_GIF else if (EQ (type, Qgif)) mime_type = "image/gif"; +#endif else if (EQ (type, Qtiff)) mime_type = "image/tiff"; else if (EQ (type, Qbmp)) @@ -52,8 +54,12 @@ haiku_can_use_native_image_api (Lisp_Object type) mime_type = "image/svg"; else if (EQ (type, Qpbm)) mime_type = "image/pbm"; + /* Don't use native image APIs for image types that have animations, + since those aren't supported by the Translation Kit. */ +#ifndef HAVE_WEBP else if (EQ (type, Qwebp)) mime_type = "image/webp"; +#endif if (!mime_type) return 0; commit 1ef57361ab784fb15fbc6a8e14600de395fe6b75 Author: Po Lu Date: Tue Apr 12 00:47:38 2022 +0000 Fix last tool bar bug on Haiku as well * src/haikuterm.c (haiku_read_socket): Adapt last change to Haiku. diff --git a/src/haikuterm.c b/src/haikuterm.c index 1270fba410..f07e9e0b29 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3213,7 +3213,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) int y = b->y; window = window_from_coordinates (f, x, y, 0, true, true); - tool_bar_p = EQ (window, f->tool_bar_window); + tool_bar_p = (EQ (window, f->tool_bar_window) + && (type != BUTTON_UP + || f->last_tool_bar_item != -1)); if (tool_bar_p) { commit 60f66cc2a29cfdfa1f5547bda874274b92a067e2 Author: Po Lu Date: Tue Apr 12 08:41:19 2022 +0800 Fix selecting text and releasing the mouse buttons above the toolbar * src/xterm.c (handle_one_xevent): Don't send ButtonRelease events to tool bars if there is no selected tool bar item. diff --git a/src/xterm.c b/src/xterm.c index 801a964105..342f2b044f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15812,7 +15812,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, int y = event->xbutton.y; window = window_from_coordinates (f, x, y, 0, true, true); - tool_bar_p = EQ (window, f->tool_bar_window); + tool_bar_p = (EQ (window, f->tool_bar_window) + && (event->xbutton.type != ButtonRelease + || f->last_tool_bar_item != -1)); if (tool_bar_p && event->xbutton.button < 4) handle_tool_bar_click @@ -17200,7 +17202,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, int y = bv.y; window = window_from_coordinates (f, x, y, 0, true, true); - tool_bar_p = EQ (window, f->tool_bar_window); + /* Ignore button release events if the mouse + wasn't previously pressed on the tool bar. + We do this because otherwise selecting some + text with the mouse and then releasing it on + the tool bar doesn't stop selecting text, + since the tool bar eats the button up + event. */ + tool_bar_p = (EQ (window, f->tool_bar_window) + && (xev->evtype != XI_ButtonRelease + || f->last_tool_bar_item != -1)); if (tool_bar_p && xev->detail < 4) handle_tool_bar_click_with_device commit 6a480c830bc8d313ca3052570487a65411c937c2 Author: Stefan Monnier Date: Mon Apr 11 15:10:51 2022 -0400 * lisp/emacs-lisp/macroexp.el (macroexp-let2*): Allow common shorthand diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index f85ed847c4..f0e3f337a6 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2789,13 +2789,13 @@ implemented this way: (gv-define-expander substring (lambda (do place from &optional to) (gv-letplace (getter setter) place - (macroexp-let2* nil ((start from) (end to)) - (funcall do `(substring ,getter ,start ,end) + (macroexp-let2* (from to) + (funcall do `(substring ,getter ,from ,to) (lambda (v) - (macroexp-let2 nil v v + (macroexp-let2* (v) `(progn ,(funcall setter `(cl--set-substring - ,getter ,start ,end ,v)) + ,getter ,from ,to ,v)) ,v)))))))) @end example @end defmac @@ -2808,7 +2808,7 @@ of Common Lisp could be implemented this way: @example (defmacro incf (place &optional n) (gv-letplace (getter setter) place - (macroexp-let2 nil v (or n 1) + (macroexp-let2* ((v (or n 1))) (funcall setter `(+ ,v ,getter))))) @end example diff --git a/etc/NEWS b/etc/NEWS index 3c4dacf912..79c27da549 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1360,6 +1360,9 @@ functions. * Lisp Changes in Emacs 29.1 ++++ +** 'macroexp-let2*' can omit 'test' arg and use single-var bindings. + +++ ** New variable 'last-event-device' and new function 'device-class'. On X Windows, 'last-event-device' specifies the input extension device diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e91b302af1..e4bc2df280 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -567,12 +567,20 @@ cases where EXP is a constant." (defmacro macroexp-let2* (test bindings &rest body) "Multiple binding version of `macroexp-let2'. -BINDINGS is a list of elements of the form (SYM EXP). Each EXP -can refer to symbols specified earlier in the binding list." +BINDINGS is a list of elements of the form (SYM EXP) or just SYM, +which then stands for (SYM SYM). +Each EXP can refer to symbols specified earlier in the binding list. + +TEST has to be a symbol, and if it is nil it can be omitted." (declare (indent 2) (debug (sexp (&rest (sexp form)) body))) + (when (consp test) ;; `test' was omitted. + (push bindings body) + (setq bindings test) + (setq test nil)) (pcase-exhaustive bindings ('nil (macroexp-progn body)) - (`((,var ,exp) . ,tl) + (`(,(or `(,var ,exp) (and (pred symbolp) var (let exp var))) + . ,tl) `(macroexp-let2 ,test ,var ,exp (macroexp-let2* ,test ,tl ,@body))))) commit d6338f8a6a5670d7d7075aa277896d9f74723c7a Author: Paul Eggert Date: Mon Apr 11 10:37:59 2022 -0700 Use preferred chars among duplicates as per UTR#25 §25. diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index 10f8ce6efb..b90c065461 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -182,10 +182,10 @@ ("o" . [?°]) ("Oe" . [?œ]) ("OE" . [?Œ]) - ("*u" . [?µ]) - ("u" . [?µ]) - ("*m" . [?µ]) - ("m" . [?µ]) + ("*u" . [?μ]) + ("u" . [?μ]) + ("*m" . [?μ]) + ("m" . [?μ]) ("*x" . [?×]) ("x" . [?×]) ("*|" . [?¦]) diff --git a/lisp/leim/quail/compose.el b/lisp/leim/quail/compose.el index 2aa8ae78fe..60c73d7dff 100644 --- a/lisp/leim/quail/compose.el +++ b/lisp/leim/quail/compose.el @@ -464,9 +464,9 @@ Examples: ("2^" ?²) ("^3" ?³) ("3^" ?³) - ("mu" ?µ) - ("/u" ?µ) - ("u/" ?µ) + ("mu" ?μ) + ("/u" ?μ) + ("u/" ?μ) ("^1" ?¹) ("1^" ?¹) ("^_o" ?º) diff --git a/lisp/leim/quail/symbol-ksc.el b/lisp/leim/quail/symbol-ksc.el index 042465697a..d440058902 100644 --- a/lisp/leim/quail/symbol-ksc.el +++ b/lisp/leim/quail/symbol-ksc.el @@ -39,7 +39,7 @@ "한글심벌입력표: 【(】괄호열기【arrow】화살【sex】♂♀【index】첨자 【accent】악센트 【)】괄호닫기【music】음악【dot】점 【quote】따옴표【xtext】§※¶¡¿ - 【Unit】℃Å￠℉【math】수학기호【pic】상형문자【line】선문자 + 【Unit】℃Å￠℉【math】수학기호【pic】상형문자【line】선문자 【unit】단위 【frac】분수 【textline】­―∥＼∼ 【wn】㈜【ks】㉿【No】№【㏇】㏇ 【dag】† 【ddag】‡【percent】‰ 【am】㏂【pm】㏘【™】™【Tel】℡【won】￦ 【yen】￥ 【pound】￡ @@ -65,7 +65,7 @@ ("dot" "·‥…¨ː") ("quote" "、。〃‘’“”°′″´˝") ("textline" "­―∥＼∼") - ("Unit" "℃Å￠℉") + ("Unit" "℃Å￠℉") ("sex" "♂♀") ("accent" "～ˇ˘˚˙¸˛") ("percent" "‰") commit 67505e035528c59b76cd838caf05116d2e34043d Author: Juri Linkov Date: Mon Apr 11 19:51:49 2022 +0300 * lisp/minibuffer.el (minibuffer-completion-auto-choose): New defcustom. (minibuffer-choose-previous-completion) (minibuffer-choose-next-completion): Remove commands. (minibuffer-local-completion-map): Remove keybindings of minibuffer-choose-next-completion and minibuffer-choose-previous-completion. Use them for minibuffer-next-completion and minibuffer-previous-completion. * lisp/simple.el (minibuffer-local-shell-command-map): Idem. diff --git a/etc/NEWS b/etc/NEWS index 95f5213228..3c4dacf912 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -605,7 +605,8 @@ value. When the minibuffer is the current buffer, typing 'M-' or 'M-' selects a previous/next completion candidate from the "*Completions*" buffer and inserts it to the minibuffer. -'M-S-' and 'M-S-' do the same, but without inserting +When the variable 'minibuffer-completion-auto-choose' is nil, +'M-' and 'M-' do the same, but without inserting a completion candidate to the minibuffer, then 'M-RET' can be used to choose the currently active candidate from the "*Completions*" buffer and exit the minibuffer. With a prefix argument, 'C-u M-RET' diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 68b167ccc7..f60af482da 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2749,11 +2749,9 @@ The completion method is determined by `completion-at-point-functions'." "" #'switch-to-completions "M-v" #'switch-to-completions "M-g M-c" #'switch-to-completions - "M-" #'minibuffer-choose-previous-completion - "M-" #'minibuffer-choose-next-completion - "M-S-" #'minibuffer-previous-completion - "M-S-" #'minibuffer-next-completion - "M-RET" #'minibuffer-choose-completion) + "M-" #'minibuffer-previous-completion + "M-" #'minibuffer-next-completion + "M-RET" #'minibuffer-choose-completion) (defvar-keymap minibuffer-local-must-match-map :doc "Local keymap for minibuffer input with completion, for exact match." @@ -4356,35 +4354,39 @@ and execute the forms." (with-selected-window window ,@body)))) -(defun minibuffer-previous-completion (&optional n) - "Run `previous-completion' from the minibuffer in its completions window." - (interactive "p") - (with-minibuffer-completions-window - (when completions-highlight-face - (setq-local cursor-face-highlight-nonselected-window t)) - (previous-completion (or n 1)))) +(defcustom minibuffer-completion-auto-choose t + "Non-nil means to automatically insert completions to the minibuffer. +When non-nil, then `minibuffer-next-completion' and +`minibuffer-previous-completion' will insert the completion +selected by these commands to the minibuffer." + :type 'boolean + :version "29.1") (defun minibuffer-next-completion (&optional n) - "Run `next-completion' from the minibuffer in its completions window." + "Run `next-completion' from the minibuffer in its completions window. +When `minibuffer-completion-auto-choose' is non-nil, then also +insert the selected completion to the minibuffer." (interactive "p") (with-minibuffer-completions-window (when completions-highlight-face (setq-local cursor-face-highlight-nonselected-window t)) - (next-completion (or n 1)))) + (next-completion (or n 1)) + (when minibuffer-completion-auto-choose + (let ((completion-use-base-affixes t)) + (choose-completion nil t t))))) -(defun minibuffer-choose-previous-completion (&optional n) +(defun minibuffer-previous-completion (&optional n) "Run `previous-completion' from the minibuffer in its completions window. -Also insert the selected completion to the minibuffer." - (interactive "p") - (minibuffer-previous-completion n) - (minibuffer-choose-completion t t)) - -(defun minibuffer-choose-next-completion (&optional n) - "Run `next-completion' from the minibuffer in its completions window. -Also insert the selected completion to the minibuffer." +When `minibuffer-completion-auto-choose' is non-nil, then also +insert the selected completion to the minibuffer." (interactive "p") - (minibuffer-next-completion n) - (minibuffer-choose-completion t t)) + (with-minibuffer-completions-window + (when completions-highlight-face + (setq-local cursor-face-highlight-nonselected-window t)) + (previous-completion (or n 1)) + (when minibuffer-completion-auto-choose + (let ((completion-use-base-affixes t)) + (choose-completion nil t t))))) (defun minibuffer-choose-completion (&optional no-exit no-quit) "Run `choose-completion' from the minibuffer in its completions window. diff --git a/lisp/simple.el b/lisp/simple.el index eb65701803..2481d22ad1 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3924,10 +3924,8 @@ to the end of the list of defaults just after the default value." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\t" #'completion-at-point) - (define-key map [M-up] #'minibuffer-choose-previous-completion) - (define-key map [M-down] #'minibuffer-choose-next-completion) - (define-key map [M-S-up] #'minibuffer-previous-completion) - (define-key map [M-S-down] #'minibuffer-next-completion) + (define-key map [M-up] #'minibuffer-previous-completion) + (define-key map [M-down] #'minibuffer-next-completion) (define-key map [?\M-\r] #'minibuffer-choose-completion) map) "Keymap used for completing shell commands in minibuffer.") commit 1c28b9ed1a26be5bd3e8e7f3b15cb00d423760c6 Author: Lars Ingebrigtsen Date: Mon Apr 11 18:50:20 2022 +0200 Make normal image caching actually work when doing animated images * src/image.c (filter_image_spec): New function. (uncache_image): Use it. (lookup_image): Ditto. (syms_of_image): Define some keywords. diff --git a/src/image.c b/src/image.c index e4782495f3..38c3f1496a 100644 --- a/src/image.c +++ b/src/image.c @@ -1796,13 +1796,50 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash, } +/* Filter out image elements that don't affect display, but will + disrupt finding the image in the cache. This should perhaps be + user-configurable, but for now it's hard-coded (but new elements + can be added at will). */ +static Lisp_Object +filter_image_spec (Lisp_Object spec) +{ + Lisp_Object out = Qnil; + + /* Skip past the `image' element. */ + if (CONSP (spec)) + spec = XCDR (spec); + + while (CONSP (spec)) + { + Lisp_Object key = XCAR (spec); + spec = XCDR (spec); + if (CONSP (spec)) + { + Lisp_Object value = XCAR (spec); + spec = XCDR (spec); + + /* Some animation-related data doesn't affect display, but + breaks the image cache. Filter those out. */ + if (!(EQ (key, QCanimate_buffer) + || EQ (key, QCanimate_tardiness) + || EQ (key, QCanimate_position) + || EQ (key, QCanimate_multi_frame_data))) + { + out = Fcons (value, out); + out = Fcons (key, out); + } + } + } + return out; +} + /* Search frame F for an image with spec SPEC, and free it. */ static void uncache_image (struct frame *f, Lisp_Object spec) { struct image *img; - EMACS_UINT hash = sxhash (spec); + EMACS_UINT hash = sxhash (filter_image_spec (spec)); /* Because the background colors are based on the current face, we can have multiple copies of an image with the same spec. We want @@ -2643,7 +2680,7 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id) eassert (valid_image_p (spec)); /* Look up SPEC in the hash table of the image cache. */ - hash = sxhash (spec); + hash = sxhash (filter_image_spec (spec)); img = search_image_cache (f, spec, hash, foreground, background, font_size, font_family, false); if (img && img->load_failed_p) @@ -11895,6 +11932,11 @@ non-numeric, there is no explicit limit on the size of images. */); defsubr (&Slookup_image); #endif + DEFSYM (QCanimate_buffer, ":animate-buffer"); + DEFSYM (QCanimate_tardiness, ":animate-tardiness"); + DEFSYM (QCanimate_position, ":animate-position"); + DEFSYM (QCanimate_multi_frame_data, ":animate-multi-frame-data"); + defsubr (&Simage_transforms_p); DEFVAR_BOOL ("cross-disabled-images", cross_disabled_images, commit aeffeccb408190db8f8e5985a27c0b95356f61cc Author: Juri Linkov Date: Mon Apr 11 19:48:13 2022 +0300 ; etc/NEWS: Fix grammer. diff --git a/etc/NEWS b/etc/NEWS index 2cddfcc8db..95f5213228 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1593,7 +1593,7 @@ the clipboard, and insert it into the buffer. --- ** New function 'minibuffer-lazy-highlight-setup'. -This function allows to set up the minibuffer so that lazy +This function allows setting up the minibuffer so that lazy highlighting of its content is applied in the original window. +++ commit 2c45d3cae0f60efd7281fe86e3a76cebab20a159 Author: Lars Ingebrigtsen Date: Mon Apr 11 17:36:26 2022 +0200 Make more IPV6 domains non-suspicious in textsec * lisp/international/textsec.el (textsec--ipvx-address-p): Make more IPV6 domains non-suspicious. diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el index 3e78790938..82eba1b5d5 100644 --- a/lisp/international/textsec.el +++ b/lisp/international/textsec.el @@ -236,15 +236,16 @@ The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)." ;; This is a very relaxed pattern for IPv4 or IPv6 addresses. The ;; assumption is that any malformed address accepted by this rule ;; will be rejected by the actual address parser eventually. - (rx-let ((ipv4 (** 1 4 - (** 1 3 (in "0-9")) - (? "."))) - (ipv6 (: (** 1 7 - (** 0 4 (in "0-9a-f")) - ":") - (** 0 4 (in "0-9a-f")) - (? ":" ipv4)))) - (string-match-p (rx bos (or ipv4 ipv6 (: "[" ipv6 "]")) eos) domain))) + (let ((case-fold-search t)) + (rx-let ((ipv4 (** 1 4 + (** 1 3 (in "0-9")) + (? "."))) + (ipv6 (: (** 1 7 + (** 0 4 (in "0-9a-f")) + ":") + (** 0 4 (in "0-9a-f")) + (? ":" ipv4)))) + (string-match-p (rx bos (or ipv4 ipv6 (: "[" ipv6 "]")) eos) domain)))) (defun textsec-domain-suspicious-p (domain) "Say whether DOMAIN's name looks suspicious. commit 949bc336a066cd80a0c7e0c2a72e0cb10636692b Author: Mattias Engdegård Date: Mon Apr 11 17:10:21 2022 +0200 ; * src/image.c: move #endif to correct place diff --git a/src/image.c b/src/image.c index d6c2af7f19..e4782495f3 100644 --- a/src/image.c +++ b/src/image.c @@ -2866,6 +2866,8 @@ anim_get_animation_cache (Lisp_Object spec) return cache; } +#endif /* HAVE_WEBP || HAVE_GIF */ + /* Call FN on every image in the image cache of frame F. Used to mark Lisp Objects in the image cache. */ @@ -8520,10 +8522,6 @@ tiff_load (struct frame *f, struct image *img) - - -#endif /* HAVE_GIF || HAVE_WEBP */ - /*********************************************************************** GIF ***********************************************************************/ commit 0e7185cefae6033e2e0628ce91009e1fbf328206 Author: Lars Ingebrigtsen Date: Mon Apr 11 16:52:34 2022 +0200 Make gif_load work across architectures again * src/image.c (gif_load): Invert the way animated pixmaps are created: Work on the cached computed-so-far pixmap, and then copy the entire thing to the ximg with PUT_PIXEL at the end. This should work across platforms, which the previous version didn't. diff --git a/src/image.c b/src/image.c index f28eb5eb6e..d6c2af7f19 100644 --- a/src/image.c +++ b/src/image.c @@ -8775,6 +8775,7 @@ gif_load (struct frame *f, struct image *img) Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL); Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); + unsigned long *pixmap = NULL; EMACS_INT idx = -1; int gif_err; struct anim_cache* cache = NULL; @@ -8794,7 +8795,10 @@ gif_load (struct frame *f, struct image *img) /* We have an old cache entry, and it looks correct, so use it. */ if (cache->index == idx - 1) - gif = cache->handle; + { + gif = cache->handle; + pixmap = cache->temp; + } } } @@ -8958,6 +8962,15 @@ gif_load (struct frame *f, struct image *img) if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) goto gif_error; + /* We construct the (possibly composited animated) image in this + buffer. */ + if (!pixmap) + { + pixmap = xmalloc (width * height * sizeof (unsigned long)); + if (cache) + cache->temp = pixmap; + } + /* Clear the part of the screen image not covered by the image. Full animated GIF support requires more here (see the gif89 spec, disposal methods). Let's simply assume that the part not covered @@ -8972,20 +8985,21 @@ gif_load (struct frame *f, struct image *img) frame_bg = lookup_rgb_color (f, color.red, color.green, color.blue); } #endif /* USE_CAIRO */ + for (y = 0; y < img->corners[TOP_CORNER]; ++y) for (x = 0; x < width; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; for (y = img->corners[BOT_CORNER]; y < height; ++y) for (x = 0; x < width; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; for (y = img->corners[TOP_CORNER]; y < img->corners[BOT_CORNER]; ++y) { for (x = 0; x < img->corners[LEFT_CORNER]; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; for (x = img->corners[RIGHT_CORNER]; x < width; ++x) - PUT_PIXEL (ximg, x, y, frame_bg); + *(pixmap + x + y * width) = frame_bg; } /* Read the GIF image into the X image. */ @@ -9006,13 +9020,12 @@ gif_load (struct frame *f, struct image *img) int start_frame = 0; - /* We have animation data in the cache, so copy it over so that we - can alter it. */ - int cache_image_size = width * height * ximg->bits_per_pixel / 8; + /* We have animation data in the cache. */ if (cache && cache->temp) { - memcpy (ximg->data, cache->temp, cache_image_size); - start_frame = cache->index; + start_frame = cache->index + 1; + if (start_frame > idx) + start_frame = 0; cache->index = idx; } @@ -9106,8 +9119,8 @@ gif_load (struct frame *f, struct image *img) int c = raster[y * subimg_width + x]; if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { - PUT_PIXEL (ximg, x + subimg_left, row + subimg_top, - pixel_colors[c]); + *(pixmap + x + subimg_left + (y + subimg_top) * width) = + pixel_colors[c]; } } } @@ -9120,21 +9133,18 @@ gif_load (struct frame *f, struct image *img) int c = raster[y * subimg_width + x]; if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { - PUT_PIXEL (ximg, x + subimg_left, y + subimg_top, - pixel_colors[c]); + *(pixmap + x + subimg_left + (y + subimg_top) * width) = + pixel_colors[c]; } } } } - if (cache) - { - /* Allocate an area to store what we have computed so far. */ - if (! cache->temp) - cache->temp = xmalloc (cache_image_size); - /* Copy over the data to the cache. */ - memcpy (cache->temp, ximg->data, cache_image_size); - } + /* We now have the complete image (possibly composed from a series + of animated frames) in pixmap. Put it into ximg. */ + for (y = 0; y < height; ++y) + for (x = 0; x < width; ++x) + PUT_PIXEL (ximg, x, y, *(pixmap + x + y * width)); #ifdef COLOR_TABLE_SUPPORT img->colors = colors_in_color_table (&img->ncolors); @@ -9178,6 +9188,8 @@ gif_load (struct frame *f, struct image *img) if (!cache) { + if (pixmap) + xfree (pixmap); if (gif_close (gif, &gif_err) == GIF_ERROR) { #if HAVE_GIFERRORSTRING @@ -9204,7 +9216,11 @@ gif_load (struct frame *f, struct image *img) gif_error: if (!cache) - gif_close (gif, NULL); + { + if (pixmap) + xfree (pixmap); + gif_close (gif, NULL); + } return false; } commit be48dfe0b3a80c0896f4d562c6a8f428ec91d19e Author: Lars Ingebrigtsen Date: Mon Apr 11 16:45:14 2022 +0200 Revert "; * src/image.c (gif_load): Fix compilation error on MS-Windows." This reverts commit a715f2fbe70bb4cbb961e82af95e2965030b4513. This is fixed in a different way in a subsequent commit. diff --git a/src/image.c b/src/image.c index c48fd9d868..f28eb5eb6e 100644 --- a/src/image.c +++ b/src/image.c @@ -9008,11 +9008,7 @@ gif_load (struct frame *f, struct image *img) /* We have animation data in the cache, so copy it over so that we can alter it. */ -#ifdef HAVE_NTGUI - int cache_image_size = width * height * ximg->info.bmiHeader.biBitCount / 8; -#else int cache_image_size = width * height * ximg->bits_per_pixel / 8; -#endif if (cache && cache->temp) { memcpy (ximg->data, cache->temp, cache_image_size); commit 26db1ca80e459a640cc6648fb7f94c873def3ddd Author: Mattias Engdegård Date: Mon Apr 11 16:22:38 2022 +0200 Recognise hybrid IPv6/IPv4 addresses in textsec (bug#54624) * lisp/international/textsec.el (textsec--ipvx-address-p): Recognise hybrid addresses like "::ffff:129.55.2.201". Combine to a single regexp and translate to rx. Remove some regexp ambiguity (relint complaint). * test/lisp/international/textsec-tests.el (test-suspiction-domain): Add test cases. diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el index cca49986fc..3e78790938 100644 --- a/lisp/international/textsec.el +++ b/lisp/international/textsec.el @@ -233,12 +233,18 @@ The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)." (defun textsec--ipvx-address-p (domain) "Return non-nil if DOMAIN is an ipv4 or ipv6 address." - (or (string-match-p "\\`\\([0-9]\\{1,3\\}\\.?\\)\\{1,4\\}\\'" domain) - (let ((ipv6 "\\([0-9a-f]\\{0,4\\}:?\\)\\{1,8\\}")) - ;; With brackets. - (or (string-match-p (format "\\`\\[%s\\]\\'" ipv6) domain) - ;; Without. - (string-match-p (format "\\`%s\\'" ipv6) domain))))) + ;; This is a very relaxed pattern for IPv4 or IPv6 addresses. The + ;; assumption is that any malformed address accepted by this rule + ;; will be rejected by the actual address parser eventually. + (rx-let ((ipv4 (** 1 4 + (** 1 3 (in "0-9")) + (? "."))) + (ipv6 (: (** 1 7 + (** 0 4 (in "0-9a-f")) + ":") + (** 0 4 (in "0-9a-f")) + (? ":" ipv4)))) + (string-match-p (rx bos (or ipv4 ipv6 (: "[" ipv6 "]")) eos) domain))) (defun textsec-domain-suspicious-p (domain) "Say whether DOMAIN's name looks suspicious. diff --git a/test/lisp/international/textsec-tests.el b/test/lisp/international/textsec-tests.el index 9216d334f8..6b0773dc40 100644 --- a/test/lisp/international/textsec-tests.el +++ b/test/lisp/international/textsec-tests.el @@ -126,7 +126,10 @@ (should-not (textsec-domain-suspicious-p "[21a:34aa:c782:3ad2:1bf8:73f8:141:66e8]")) (should (textsec-domain-suspicious-p - "[21a:34aa:c782:3ad2:1bf8:73f8:141:66e8"))) + "[21a:34aa:c782:3ad2:1bf8:73f8:141:66e8")) + (should-not (textsec-domain-suspicious-p "138.25.106.12")) + (should-not (textsec-domain-suspicious-p "2001:db8::ff00:42:8329")) + (should-not (textsec-domain-suspicious-p "::ffff:129.55.2.201"))) (ert-deftest test-suspicious-local () (should-not (textsec-local-address-suspicious-p "larsi")) commit a715f2fbe70bb4cbb961e82af95e2965030b4513 Author: Eli Zaretskii Date: Mon Apr 11 17:04:31 2022 +0300 ; * src/image.c (gif_load): Fix compilation error on MS-Windows. diff --git a/src/image.c b/src/image.c index f28eb5eb6e..c48fd9d868 100644 --- a/src/image.c +++ b/src/image.c @@ -9008,7 +9008,11 @@ gif_load (struct frame *f, struct image *img) /* We have animation data in the cache, so copy it over so that we can alter it. */ +#ifdef HAVE_NTGUI + int cache_image_size = width * height * ximg->info.bmiHeader.biBitCount / 8; +#else int cache_image_size = width * height * ximg->bits_per_pixel / 8; +#endif if (cache && cache->temp) { memcpy (ximg->data, cache->temp, cache_image_size); commit 68ec0ffa2181d7e061bc4799798be0b2344d6a6b Author: Lars Ingebrigtsen Date: Mon Apr 11 15:18:41 2022 +0200 Fix anim_cache garbage collection * src/image.c (struct anim_cache): Move earlier. (mark_image_cache): Mark the Lisp_Object in the anim cache. diff --git a/src/image.c b/src/image.c index 4b2a038cc1..f28eb5eb6e 100644 --- a/src/image.c +++ b/src/image.c @@ -2782,6 +2782,90 @@ cache_image (struct frame *f, struct image *img) } +#if defined (HAVE_WEBP) || defined (HAVE_GIF) + +/* To speed animations up, we keep a cache (based on EQ-ness of the + image spec/object) where we put the animator iterator. */ + +struct anim_cache +{ + Lisp_Object spec; + /* For webp, this will be an iterator, and for libgif, a gif handle. */ + void *handle; + /* If we need to maintain temporary data of some sort. */ + void *temp; + /* A function to call to free the handle. */ + void (*destructor) (void *); + int index, width, height, frames; + struct timespec update_time; + struct anim_cache *next; +}; + +static struct anim_cache *anim_cache = NULL; + +static struct anim_cache * +anim_create_cache (Lisp_Object spec) +{ + struct anim_cache *cache = xmalloc (sizeof (struct anim_cache)); + cache->handle = NULL; + cache->temp = NULL; + + cache->index = 0; + cache->next = NULL; + cache->spec = spec; + return cache; +} + +/* Discard cached images that haven't been used for a minute. */ +static void +anim_prune_animation_cache (void) +{ + struct anim_cache **pcache = &anim_cache; + struct timespec old = timespec_sub (current_timespec (), + make_timespec (60, 0)); + + while (*pcache) + { + struct anim_cache *cache = *pcache; + if (timespec_cmp (old, cache->update_time) <= 0) + pcache = &cache->next; + else + { + if (cache->handle) + cache->destructor (cache); + if (cache->temp) + xfree (cache->temp); + *pcache = cache->next; + xfree (cache); + } + } +} + +static struct anim_cache * +anim_get_animation_cache (Lisp_Object spec) +{ + struct anim_cache *cache; + struct anim_cache **pcache = &anim_cache; + + anim_prune_animation_cache (); + + while (1) + { + cache = *pcache; + if (! cache) + { + *pcache = cache = anim_create_cache (spec); + break; + } + if (EQ (spec, cache->spec)) + break; + pcache = &cache->next; + } + + cache->update_time = current_timespec (); + return cache; +} + /* Call FN on every image in the image cache of frame F. Used to mark Lisp Objects in the image cache. */ @@ -2808,6 +2892,11 @@ mark_image_cache (struct image_cache *c) if (c->images[i]) mark_image (c->images[i]); } + +#if defined HAVE_WEBP || defined HAVE_GIF + for (struct anim_cache *cache = anim_cache; cache; cache = cache->next) + mark_object (cache->spec); +#endif } @@ -8433,91 +8522,6 @@ tiff_load (struct frame *f, struct image *img) -#if defined (HAVE_WEBP) || defined (HAVE_GIF) - -/* To speed animations up, we keep a cache (based on EQ-ness of the - image spec/object) where we put the animator iterator. */ - -struct anim_cache -{ - Lisp_Object spec; - /* For webp, this will be an iterator, and for libgif, a gif handle. */ - void *handle; - /* If we need to maintain temporary data of some sort. */ - void *temp; - /* A function to call to free the handle. */ - void (*destructor)(void*); - int index, width, height, frames; - struct timespec update_time; - struct anim_cache *next; -}; - -static struct anim_cache *anim_cache = NULL; - -static struct anim_cache * -anim_create_cache (Lisp_Object spec) -{ - struct anim_cache *cache = xmalloc (sizeof (struct anim_cache)); - cache->handle = NULL; - cache->temp = NULL; - - cache->index = 0; - cache->next = NULL; - /* FIXME: Does this need gc protection? */ - cache->spec = spec; - return cache; -} - -/* Discard cached images that haven't been used for a minute. */ -static void -anim_prune_animation_cache (void) -{ - struct anim_cache **pcache = &anim_cache; - struct timespec old = timespec_sub (current_timespec (), - make_timespec (60, 0)); - - while (*pcache) - { - struct anim_cache *cache = *pcache; - if (timespec_cmp (old, cache->update_time) <= 0) - pcache = &cache->next; - else - { - if (cache->handle) - cache->destructor (cache); - if (cache->temp) - xfree (cache->temp); - *pcache = cache->next; - xfree (cache); - } - } -} - -static struct anim_cache * -anim_get_animation_cache (Lisp_Object spec) -{ - struct anim_cache *cache; - struct anim_cache **pcache = &anim_cache; - - anim_prune_animation_cache (); - - while (1) - { - cache = *pcache; - if (! cache) - { - *pcache = cache = anim_create_cache (spec); - break; - } - if (EQ (spec, cache->spec)) - break; - pcache = &cache->next; - } - - cache->update_time = current_timespec (); - return cache; -} - #endif /* HAVE_GIF || HAVE_WEBP */ /*********************************************************************** commit 0347969bdfa3ec689c49537a7b29f4a506f732a2 Author: Lars Ingebrigtsen Date: Mon Apr 11 14:54:31 2022 +0200 Fix compilation errors when HAVE_GIF and not HAVE_WEBP * src/image.c: Enable the cache functions when HAVE_GIF, too diff --git a/src/image.c b/src/image.c index 967263e2c6..4b2a038cc1 100644 --- a/src/image.c +++ b/src/image.c @@ -8433,7 +8433,7 @@ tiff_load (struct frame *f, struct image *img) -#if defined (HAVE_WEBP) +#if defined (HAVE_WEBP) || defined (HAVE_GIF) /* To speed animations up, we keep a cache (based on EQ-ness of the image spec/object) where we put the animator iterator. */ commit 8b7aaf3e56c63cae7e2affc249179e5022451595 Author: Lars Ingebrigtsen Date: Mon Apr 11 14:38:27 2022 +0200 Speed up GIF animations * src/image.c (anim_prune_animation_cache): Tweak the destructor API. (gif_destroy): New function. (gif_load): Use a cache to avoid quadratic CPU usage for animated images (bug#45224). (webp_destroy): New function. (webp_load): Use it. diff --git a/src/image.c b/src/image.c index a3c9868426..967263e2c6 100644 --- a/src/image.c +++ b/src/image.c @@ -8484,7 +8484,7 @@ anim_prune_animation_cache (void) else { if (cache->handle) - cache->destructor (cache->handle); + cache->destructor (cache); if (cache->temp) xfree (cache->temp); *pcache = cache->next; @@ -8754,127 +8754,187 @@ static const int interlace_increment[] = {8, 8, 4, 2}; #define GIF_LOCAL_DESCRIPTOR_EXTENSION 249 +static void +gif_destroy (struct anim_cache* cache) +{ + int gif_err; + gif_close (cache->handle, &gif_err); +} + static bool gif_load (struct frame *f, struct image *img) { int rc, width, height, x, y, i, j; ColorMapObject *gif_color_map; - GifFileType *gif; + GifFileType *gif = NULL; gif_memory_source memsrc; Lisp_Object specified_bg = image_spec_value (img->spec, QCbackground, NULL); Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); - EMACS_INT idx; + EMACS_INT idx = -1; int gif_err; + struct anim_cache* cache = NULL; - if (NILP (specified_data)) + /* Which sub-image are we to display? */ + { + Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); + idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; + } + + if (idx != -1) { - Lisp_Object file = image_find_image_file (specified_file); - if (!STRINGP (file)) + /* If this is an animated image, create a cache for it. */ + cache = anim_get_animation_cache (img->spec); + if (cache->handle) { - image_error ("Cannot find image file `%s'", specified_file); - return false; + /* We have an old cache entry, and it looks correct, so use + it. */ + if (cache->index == idx - 1) + gif = cache->handle; } + } - Lisp_Object encoded_file = ENCODE_FILE (file); + /* If we don't have a cached entry, read the image. */ + if (! gif) + { + if (NILP (specified_data)) + { + Lisp_Object file = image_find_image_file (specified_file); + if (!STRINGP (file)) + { + image_error ("Cannot find image file `%s'", specified_file); + return false; + } + + Lisp_Object encoded_file = ENCODE_FILE (file); #ifdef WINDOWSNT - encoded_file = ansi_encode_filename (encoded_file); + encoded_file = ansi_encode_filename (encoded_file); #endif - /* Open the GIF file. */ + /* Open the GIF file. */ #if GIFLIB_MAJOR < 5 - gif = DGifOpenFileName (SSDATA (encoded_file)); + gif = DGifOpenFileName (SSDATA (encoded_file)); #else - gif = DGifOpenFileName (SSDATA (encoded_file), &gif_err); + gif = DGifOpenFileName (SSDATA (encoded_file), &gif_err); #endif - if (gif == NULL) - { + if (gif == NULL) + { #if HAVE_GIFERRORSTRING - const char *errstr = GifErrorString (gif_err); - if (errstr) - image_error ("Cannot open `%s': %s", file, build_string (errstr)); - else + const char *errstr = GifErrorString (gif_err); + if (errstr) + image_error ("Cannot open `%s': %s", file, + build_string (errstr)); + else #endif - image_error ("Cannot open `%s'", file); - return false; + image_error ("Cannot open `%s'", file); + return false; + } } - } - else - { - if (!STRINGP (specified_data)) + else { - image_error ("Invalid image data `%s'", specified_data); - return false; - } + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data); + return false; + } - /* Read from memory! */ - current_gif_memory_src = &memsrc; - memsrc.bytes = SDATA (specified_data); - memsrc.len = SBYTES (specified_data); - memsrc.index = 0; + /* Read from memory! */ + current_gif_memory_src = &memsrc; + memsrc.bytes = SDATA (specified_data); + memsrc.len = SBYTES (specified_data); + memsrc.index = 0; #if GIFLIB_MAJOR < 5 - gif = DGifOpen (&memsrc, gif_read_from_memory); + gif = DGifOpen (&memsrc, gif_read_from_memory); #else - gif = DGifOpen (&memsrc, gif_read_from_memory, &gif_err); + gif = DGifOpen (&memsrc, gif_read_from_memory, &gif_err); +#endif + if (!gif) + { +#if HAVE_GIFERRORSTRING + const char *errstr = GifErrorString (gif_err); + if (errstr) + image_error ("Cannot open memory source `%s': %s", + img->spec, build_string (errstr)); + else #endif - if (!gif) + image_error ("Cannot open memory source `%s'", img->spec); + return false; + } + } + + /* Before reading entire contents, check the declared image size. */ + if (!check_image_size (f, gif->SWidth, gif->SHeight)) + { + image_size_error (); + goto gif_error; + } + + /* Read entire contents. */ + rc = DGifSlurp (gif); + if (rc == GIF_ERROR || gif->ImageCount <= 0) { #if HAVE_GIFERRORSTRING - const char *errstr = GifErrorString (gif_err); + const char *errstr = GifErrorString (gif->Error); if (errstr) - image_error ("Cannot open memory source `%s': %s", - img->spec, build_string (errstr)); + if (NILP (specified_data)) + image_error ("Error reading `%s' (%s)", img->spec, + build_string (errstr)); + else + image_error ("Error reading GIF data: %s", + build_string (errstr)); else #endif - image_error ("Cannot open memory source `%s'", img->spec); - return false; + if (NILP (specified_data)) + image_error ("Error reading `%s'", img->spec); + else + image_error ("Error reading GIF data"); + goto gif_error; } - } - /* Before reading entire contents, check the declared image size. */ - if (!check_image_size (f, gif->SWidth, gif->SHeight)) + width = img->width = gif->SWidth; + height = img->height = gif->SHeight; + + /* Check that the selected subimages fit. It's not clear whether + the GIF spec requires this, but Emacs can crash if they don't fit. */ + for (j = 0; j <= idx; ++j) + { + struct SavedImage *subimage = gif->SavedImages + j; + int subimg_width = subimage->ImageDesc.Width; + int subimg_height = subimage->ImageDesc.Height; + int subimg_top = subimage->ImageDesc.Top; + int subimg_left = subimage->ImageDesc.Left; + if (! (subimg_width >= 0 && subimg_height >= 0 + && 0 <= subimg_top && subimg_top <= height - subimg_height + && 0 <= subimg_left && subimg_left <= width - subimg_width)) + { + image_error ("Subimage does not fit in image"); + goto gif_error; + } + } + } + else { - image_size_error (); - goto gif_error; + /* Cached image; set data. */ + width = img->width = gif->SWidth; + height = img->height = gif->SHeight; } - /* Read entire contents. */ - rc = DGifSlurp (gif); - if (rc == GIF_ERROR || gif->ImageCount <= 0) + if (idx < 0 || idx >= gif->ImageCount) { -#if HAVE_GIFERRORSTRING - const char *errstr = GifErrorString (gif->Error); - if (errstr) - if (NILP (specified_data)) - image_error ("Error reading `%s' (%s)", img->spec, - build_string (errstr)); - else - image_error ("Error reading GIF data: %s", - build_string (errstr)); - else -#endif - if (NILP (specified_data)) - image_error ("Error reading `%s'", img->spec); - else - image_error ("Error reading GIF data"); + image_error ("Invalid image number `%s' in image `%s'", + make_fixnum (idx), img->spec); goto gif_error; } - /* Which sub-image are we to display? */ - { - Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); - idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; - if (idx < 0 || idx >= gif->ImageCount) - { - image_error ("Invalid image number `%s' in image `%s'", - image_number, img->spec); - goto gif_error; - } - } - - width = img->width = gif->SWidth; - height = img->height = gif->SHeight; + /* It's an animated image, so initalize the cache. */ + if (cache && !cache->handle) + { + cache->handle = gif; + cache->destructor = (void (*)(void *)) &gif_destroy; + cache->width = width; + cache->height = height; + } img->corners[TOP_CORNER] = gif->SavedImages[0].ImageDesc.Top; img->corners[LEFT_CORNER] = gif->SavedImages[0].ImageDesc.Left; @@ -8889,24 +8949,6 @@ gif_load (struct frame *f, struct image *img) goto gif_error; } - /* Check that the selected subimages fit. It's not clear whether - the GIF spec requires this, but Emacs can crash if they don't fit. */ - for (j = 0; j <= idx; ++j) - { - struct SavedImage *subimage = gif->SavedImages + j; - int subimg_width = subimage->ImageDesc.Width; - int subimg_height = subimage->ImageDesc.Height; - int subimg_top = subimage->ImageDesc.Top; - int subimg_left = subimage->ImageDesc.Left; - if (! (subimg_width >= 0 && subimg_height >= 0 - && 0 <= subimg_top && subimg_top <= height - subimg_height - && 0 <= subimg_left && subimg_left <= width - subimg_width)) - { - image_error ("Subimage does not fit in image"); - goto gif_error; - } - } - /* Create the X image and pixmap. */ Emacs_Pix_Container ximg; if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) @@ -8944,11 +8986,6 @@ gif_load (struct frame *f, struct image *img) /* Read the GIF image into the X image. */ - /* FIXME: With the current implementation, loading an animated gif - is quadratic in the number of animation frames, since each frame - is a separate struct image. We must provide a way for a single - gif_load call to construct and save all animation frames. */ - init_color_table (); unsigned long bgcolor UNINIT; @@ -8963,7 +9000,19 @@ gif_load (struct frame *f, struct image *img) #endif } - for (j = 0; j <= idx; ++j) + int start_frame = 0; + + /* We have animation data in the cache, so copy it over so that we + can alter it. */ + int cache_image_size = width * height * ximg->bits_per_pixel / 8; + if (cache && cache->temp) + { + memcpy (ximg->data, cache->temp, cache_image_size); + start_frame = cache->index; + cache->index = idx; + } + + for (j = start_frame; j <= idx; ++j) { /* We use a local variable `raster' here because RasterBits is a char *, which invites problems with bytes >= 0x80. */ @@ -9074,6 +9123,15 @@ gif_load (struct frame *f, struct image *img) } } + if (cache) + { + /* Allocate an area to store what we have computed so far. */ + if (! cache->temp) + cache->temp = xmalloc (cache_image_size); + /* Copy over the data to the cache. */ + memcpy (cache->temp, ximg->data, cache_image_size); + } + #ifdef COLOR_TABLE_SUPPORT img->colors = colors_in_color_table (&img->ncolors); free_color_table (); @@ -9114,17 +9172,20 @@ gif_load (struct frame *f, struct image *img) Fcons (make_fixnum (gif->ImageCount), img->lisp_data)); - if (gif_close (gif, &gif_err) == GIF_ERROR) + if (!cache) { + if (gif_close (gif, &gif_err) == GIF_ERROR) + { #if HAVE_GIFERRORSTRING - char const *error_text = GifErrorString (gif_err); + char const *error_text = GifErrorString (gif_err); - if (error_text) - image_error ("Error closing `%s': %s", - img->spec, build_string (error_text)); - else + if (error_text) + image_error ("Error closing `%s': %s", + img->spec, build_string (error_text)); + else #endif - image_error ("Error closing `%s'", img->spec); + image_error ("Error closing `%s'", img->spec); + } } /* Maybe fill in the background field while we have ximg handy. */ @@ -9138,7 +9199,8 @@ gif_load (struct frame *f, struct image *img) return true; gif_error: - gif_close (gif, NULL); + if (!cache) + gif_close (gif, NULL); return false; } @@ -9292,6 +9354,12 @@ init_webp_functions (void) #endif /* WINDOWSNT */ +static void +webp_destroy (struct anim_cache* cache) +{ + WebPAnimDecoderDelete (cache->handle); +} + /* Load WebP image IMG for use on frame F. Value is true if successful. */ @@ -9408,7 +9476,7 @@ webp_load (struct frame *f, struct image *img) cache->height = height = WebPDemuxGetI (demux, WEBP_FF_CANVAS_HEIGHT); cache->frames = frames = WebPDemuxGetI (demux, WEBP_FF_FRAME_COUNT); - cache->destructor = (void (*)(void *)) &WebPAnimDecoderDelete; + cache->destructor = (void (*)(void *)) webp_destroy; WebPDemuxDelete (demux); WebPAnimDecoderOptions dec_options; commit 5141234acf85fe232adcaa3b0278f7766eb0d250 Author: Lars Ingebrigtsen Date: Mon Apr 11 13:35:45 2022 +0200 Refactor the webp cache code to allow usage by gif_load, too * src/image.c (struct anim_cache, anim_create_cache) (anim_prune_animation_cache, anim_get_animation_cache): Rename from webp_cache (etc) to prepare for usage in the gif animation implementation, too. (webp_load): Adjust cache usage. diff --git a/src/image.c b/src/image.c index 3f9111a709..a3c9868426 100644 --- a/src/image.c +++ b/src/image.c @@ -8431,6 +8431,95 @@ tiff_load (struct frame *f, struct image *img) + + +#if defined (HAVE_WEBP) + +/* To speed animations up, we keep a cache (based on EQ-ness of the + image spec/object) where we put the animator iterator. */ + +struct anim_cache +{ + Lisp_Object spec; + /* For webp, this will be an iterator, and for libgif, a gif handle. */ + void *handle; + /* If we need to maintain temporary data of some sort. */ + void *temp; + /* A function to call to free the handle. */ + void (*destructor)(void*); + int index, width, height, frames; + struct timespec update_time; + struct anim_cache *next; +}; + +static struct anim_cache *anim_cache = NULL; + +static struct anim_cache * +anim_create_cache (Lisp_Object spec) +{ + struct anim_cache *cache = xmalloc (sizeof (struct anim_cache)); + cache->handle = NULL; + cache->temp = NULL; + + cache->index = 0; + cache->next = NULL; + /* FIXME: Does this need gc protection? */ + cache->spec = spec; + return cache; +} + +/* Discard cached images that haven't been used for a minute. */ +static void +anim_prune_animation_cache (void) +{ + struct anim_cache **pcache = &anim_cache; + struct timespec old = timespec_sub (current_timespec (), + make_timespec (60, 0)); + + while (*pcache) + { + struct anim_cache *cache = *pcache; + if (timespec_cmp (old, cache->update_time) <= 0) + pcache = &cache->next; + else + { + if (cache->handle) + cache->destructor (cache->handle); + if (cache->temp) + xfree (cache->temp); + *pcache = cache->next; + xfree (cache); + } + } +} + +static struct anim_cache * +anim_get_animation_cache (Lisp_Object spec) +{ + struct anim_cache *cache; + struct anim_cache **pcache = &anim_cache; + + anim_prune_animation_cache (); + + while (1) + { + cache = *pcache; + if (! cache) + { + *pcache = cache = anim_create_cache (spec); + break; + } + if (EQ (spec, cache->spec)) + break; + pcache = &cache->next; + } + + cache->update_time = current_timespec (); + return cache; +} + +#endif /* HAVE_GIF || HAVE_WEBP */ + /*********************************************************************** GIF ***********************************************************************/ @@ -9203,82 +9292,6 @@ init_webp_functions (void) #endif /* WINDOWSNT */ -/* To speed webp animations up, we keep a cache (based on EQ-ness of - the image spec/object) where we put the libwebp animator - iterator. */ - -struct webp_cache -{ - Lisp_Object spec; - WebPAnimDecoder* anim; - int index, width, height, frames; - struct timespec update_time; - struct webp_cache *next; -}; - -static struct webp_cache *webp_cache = NULL; - -static struct webp_cache * -webp_create_cache (Lisp_Object spec) -{ - struct webp_cache *cache = xmalloc (sizeof (struct webp_cache)); - cache->anim = NULL; - - cache->index = 0; - cache->next = NULL; - /* FIXME: Does this need gc protection? */ - cache->spec = spec; - return cache; -} - -/* Discard cached images that haven't been used for a minute. */ -static void -webp_prune_animation_cache (void) -{ - struct webp_cache **pcache = &webp_cache; - struct timespec old = timespec_sub (current_timespec (), - make_timespec (60, 0)); - - while (*pcache) - { - struct webp_cache *cache = *pcache; - if (timespec_cmp (old, cache->update_time) <= 0) - pcache = &cache->next; - else - { - if (cache->anim) - WebPAnimDecoderDelete (cache->anim); - *pcache = cache->next; - xfree (cache); - } - } -} - -static struct webp_cache * -webp_get_animation_cache (Lisp_Object spec) -{ - struct webp_cache *cache; - struct webp_cache **pcache = &webp_cache; - - webp_prune_animation_cache (); - - while (1) - { - cache = *pcache; - if (! cache) - { - *pcache = cache = webp_create_cache (spec); - break; - } - if (EQ (spec, cache->spec)) - break; - pcache = &cache->next; - } - - cache->update_time = current_timespec (); - return cache; -} - /* Load WebP image IMG for use on frame F. Value is true if successful. */ @@ -9371,14 +9384,14 @@ webp_load (struct frame *f, struct image *img) webp_data.size = size; int timestamp; - struct webp_cache* cache = webp_get_animation_cache (img->spec); + struct anim_cache* cache = anim_get_animation_cache (img->spec); /* Get the next frame from the animation cache. */ - if (cache->anim && cache->index == idx - 1) + if (cache->handle && cache->index == idx - 1) { - WebPAnimDecoderGetNext (cache->anim, &decoded, ×tamp); + WebPAnimDecoderGetNext (cache->handle, &decoded, ×tamp); delay = timestamp; cache->index++; - anim = cache->anim; + anim = cache->handle; width = cache->width; height = cache->height; frames = cache->frames; @@ -9386,8 +9399,8 @@ webp_load (struct frame *f, struct image *img) else { /* Start a new cache entry. */ - if (cache->anim) - WebPAnimDecoderDelete (cache->anim); + if (cache->handle) + WebPAnimDecoderDelete (cache->handle); /* Get the width/height of the total image. */ WebPDemuxer* demux = WebPDemux (&webp_data); @@ -9395,13 +9408,14 @@ webp_load (struct frame *f, struct image *img) cache->height = height = WebPDemuxGetI (demux, WEBP_FF_CANVAS_HEIGHT); cache->frames = frames = WebPDemuxGetI (demux, WEBP_FF_FRAME_COUNT); + cache->destructor = (void (*)(void *)) &WebPAnimDecoderDelete; WebPDemuxDelete (demux); WebPAnimDecoderOptions dec_options; WebPAnimDecoderOptionsInit (&dec_options); anim = WebPAnimDecoderNew (&webp_data, &dec_options); - cache->anim = anim; + cache->handle = anim; cache->index = idx; while (WebPAnimDecoderHasMoreFrames (anim)) { commit 07ee24d83debfeb0570a596fa27e7203bf55a4b3 Author: Po Lu Date: Mon Apr 11 19:27:07 2022 +0800 Fix event source attribution for GTK input methods * src/gtkutil.c (xg_im_context_commit): Use pending keystroke source if it exists. diff --git a/src/gtkutil.c b/src/gtkutil.c index 4fc0edf8ac..718da171f4 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -6274,6 +6274,10 @@ xg_im_context_commit (GtkIMContext *imc, gchar *str, { struct frame *f = user_data; struct input_event ie; +#ifdef HAVE_XINPUT2 + struct xi_device_t *source; + struct x_display_info *dpyinfo; +#endif EVENT_INIT (ie); /* This used to use g_utf8_to_ucs4_fast, which led to bad results @@ -6292,6 +6296,22 @@ xg_im_context_commit (GtkIMContext *imc, gchar *str, make_fixnum (SCHARS (ie.arg)), Qcoding, Qt, ie.arg); +#ifdef HAVE_XINPUT2 + dpyinfo = FRAME_DISPLAY_INFO (f); + + /* There is no timestamp associated with commit events, so use the + device that sent the last event to be filtered. */ + if (dpyinfo->pending_keystroke_time) + { + dpyinfo->pending_keystroke_time = 0; + source = xi_device_from_id (dpyinfo, + dpyinfo->pending_keystroke_source); + + if (source) + ie.device = source->name; + } +#endif + XSETFRAME (ie.frame_or_window, f); ie.modifiers = 0; ie.timestamp = 0; commit 11080420dd7f2c34bbebf797de6eb4d4a14dae35 Author: Lars Ingebrigtsen Date: Mon Apr 11 12:32:55 2022 +0200 Improve gif_load error messages * src/image.c (gif_load): Improve error reporting (bug#54848). diff --git a/src/image.c b/src/image.c index e3e540e5e2..3f9111a709 100644 --- a/src/image.c +++ b/src/image.c @@ -8754,10 +8754,21 @@ gif_load (struct frame *f, struct image *img) rc = DGifSlurp (gif); if (rc == GIF_ERROR || gif->ImageCount <= 0) { - if (NILP (specified_data)) - image_error ("Error reading `%s'", img->spec); +#if HAVE_GIFERRORSTRING + const char *errstr = GifErrorString (gif->Error); + if (errstr) + if (NILP (specified_data)) + image_error ("Error reading `%s' (%s)", img->spec, + build_string (errstr)); + else + image_error ("Error reading GIF data: %s", + build_string (errstr)); else - image_error ("Error reading GIF data"); +#endif + if (NILP (specified_data)) + image_error ("Error reading `%s'", img->spec); + else + image_error ("Error reading GIF data"); goto gif_error; } commit 7d5d0abd2d5a29cb1a5ea18298d49690fe60dc6f Author: Lars Ingebrigtsen Date: Mon Apr 11 12:12:41 2022 +0200 Ensure shell.el loading properly * lisp/shell.el (subr-x): Require for string-chop-newline (bug#54834). diff --git a/lisp/shell.el b/lisp/shell.el index 008fcc4c4e..a9990f5d55 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -98,6 +98,7 @@ (require 'comint) (require 'pcomplete) (eval-when-compile (require 'files-x)) ;with-connection-local-variables +(require 'subr-x) ;;; Customization and Buffer Variables commit 7140b1e82d7d20c59ee8e0d7a47f6608cb60cb0c Author: Po Lu Date: Mon Apr 11 07:45:37 2022 +0000 Always cascade from toplevel frames on Haiku * src/haikufns.c (haiku_create_frame): Cascade from toplevel frames, since otherwise the positions are wrong anyway, and it doesn't make sense to cascade from a frame that disappears when it becomes deactivated. diff --git a/src/haikufns.c b/src/haikufns.c index 767f555317..ef95d42f0f 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -582,6 +582,11 @@ haiku_create_frame (Lisp_Object parms) else cascade_target = NULL; + /* Always cascade from the most toplevel frame. */ + + while (cascade_target && FRAME_PARENT_FRAME (cascade_target)) + cascade_target = FRAME_PARENT_FRAME (cascade_target); + parms = Fcopy_alist (parms); Vx_resource_name = Vinvocation_name; @@ -624,6 +629,7 @@ haiku_create_frame (Lisp_Object parms) f = make_frame_without_minibuffer (tem, kb, display); else f = make_frame (1); + XSETFRAME (frame, f); f->terminal = dpyinfo->terminal; @@ -810,6 +816,11 @@ haiku_create_frame (Lisp_Object parms) || !FRAME_LIVE_P (XFRAME (parent_frame))) parent_frame = Qnil; + /* It doesn't make sense to center child frames, the resulting + position makes no sense. */ + if (!NILP (parent_frame)) + window_prompting |= PPosition; + fset_parent_frame (f, parent_frame); store_frame_param (f, Qparent_frame, parent_frame);