commit e567ac149518967f992b1286d90d94df6bb589b7 (HEAD, refs/remotes/origin/master) Author: Martin Rudalics Date: Fri Jan 11 10:02:47 2019 +0100 Run window change functions during redisplay * doc/lispref/windows.texi (Window Sizes): Move (and rename) descriptions of 'window-pixel-height-before-size-change' and 'window-pixel-width-before-size-change' to Window Hooks section. (Window Configurations): Remove warning against use of 'save-window-excursion' in 'window-size-change-functions'. (Window Hooks): Rewrite section according to redesign of window change functions. * lisp/erc/erc-track.el (erc-window-configuration-change) (erc-modified-channels-update): Call latter directly from 'window-configuration-change-hook' instead via 'post-command-hook'. * lisp/frame.el (frame-size-changed-p): Change nomenclature in let bindings. * lisp/net/rcirc.el (rcirc-window-configuration-change) (rcirc-window-configuration-change-1): Call latter directly from 'window-configuration-change-hook' instead via 'post-command-hook'. * lisp/window.el (window-pixel-width-before-size-change) (window-pixel-height-before-size-change): Defalias. (window--resize-mini-window, window-resize) (adjust-window-trailing-edge, delete-window) (delete-other-windows, balance-windows): Don't run 'window-configuration-change-hook' any more from here. (split-window): Don't run 'window-configuration-change-hook' from here. 'run-window-scroll-functions' from here. (window--adjust-process-windows): Run from 'window-configuration-change-hook' only. * src/frame.c (old_selected_frame): New Lisp variable. (make_frame): Initialize frame's change_stamp slot. (Fold_selected_frame): New function. * src/frame.h (struct frame): New slots old_selected_window, window_change, change_stamp and number_of_windows. (fset_old_selected_window): New inlined function. (FRAME_WINDOW_CHANGE, FRAME_OLD_SELECTED_WINDOW): New macros. * src/window.c (old_selected_window): New Lisp variable. (wset_old_buffer): New inlined function. (Fframe_old_selected_window, Fold_selected_window) (Fwindow_old_buffer): New functions. (Fwindow_old_pixel_width, Fwindow_old_pixel_height): Rename from Fwindow_pixel_width_before_size_change and Fwindow_pixel_height_before_size_change. Update doc-strings. (Fwindow_old_body_pixel_width, Fwindow_old_body_pixel_height): New functions. (Fdelete_other_windows_internal): Set frame's window_change slot instead of running 'window-configuration-change-hook'. (Frun_window_configuration_change_hook): In doc-string tell that this function is no more needed. (Frun_window_scroll_functions): Amend doc-string. Run with window's buffer current. (window_sub_list, window_change_record_windows) (window_change_record_frame, window_change_record) (run_window_change_functions_1, run_window_change_functions): New functions. (set_window_buffer): Set frame's window_change slot instead of running 'window-configuration-change-hook'. (make_window): Don't initialize pixel_width_before_size_change and pixel_height_before_size_change slots. (window_resize_apply, Fdelete_window_internal): Set frame's window_change slot. (Fsplit_window_internal): Set frame's window_change slot. Don't run 'window-scroll-functions' from here. * src/window.h (struct window): New slots old_buffer, change_stamp, old_pixel_width (renamed from pixel_width_before_size_change), old_pixel_height (renamed from pixel_height_before_size_change), old_body_pixel_width and old_body_pixel_height. * src/xdisp.c (init_iterator): Set frame's window_change slot when the body height or width changes. (prepare_menu_bars): Don't run_window_size_change_functions. (redisplay_internal): Don't run_window_size_change_functions, run_window_change_functions instead. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index a0853180fb..6b5aa66a95 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -568,12 +568,6 @@ its pixel height is the pixel height of the screen areas spanned by its children. @end defun -@defun window-pixel-height-before-size-change &optional Lisp_Object &optional window -This function returns the height of window @var{window} in pixels at the -time @code{window-size-change-functions} was run for the last time on -@var{window}'s frame (@pxref{Window Hooks}). -@end defun - @cindex window pixel width @cindex pixel width of a window @cindex total pixel width of a window @@ -588,12 +582,6 @@ If @var{window} is an internal window, its pixel width is the width of the screen areas spanned by its children. @end defun -@defun window-pixel-width-before-size-change &optional Lisp_Object &optional window -This function returns the width of window @var{window} in pixels at the -time @code{window-size-change-functions} was run for the last time on -@var{window}'s frame (@pxref{Window Hooks}). -@end defun - @cindex full-width window @cindex full-height window The following functions can be used to determine whether a given @@ -5705,10 +5693,6 @@ prevent the code in @var{forms} from opening new windows, because new windows might be opened in other frames (@pxref{Choosing Window}), and @code{save-window-excursion} only saves and restores the window configuration on the current frame. - -Do not use this macro in @code{window-size-change-functions}; exiting -the macro triggers execution of @code{window-size-change-functions}, -leading to an endless loop. @end defmac @defun window-configuration-p object @@ -5827,10 +5811,10 @@ This function sets @var{window}'s value of @var{parameter} to is the selected window. @end defun -By default, the functions that save and restore window configurations or the -states of windows (@pxref{Window Configurations}) do not care about -window parameters. This means that when you change the value of a -parameter within the body of a @code{save-window-excursion}, the +By default, the functions that save and restore window configurations +or the states of windows (@pxref{Window Configurations}) do not care +about window parameters. This means that when you change the value of +a parameter within the body of a @code{save-window-excursion}, the previous value is not restored when that macro exits. It also means that when you restore via @code{window-state-put} a window state saved earlier by @code{window-state-get}, all cloned windows have their @@ -6019,27 +6003,26 @@ applications. It might be replaced by an improved solution in future versions of Emacs. @end table + @node Window Hooks @section Hooks for Window Scrolling and Changes @cindex hooks for window operations -This section describes how a Lisp program can take action whenever a -window displays a different part of its buffer or a different buffer. -There are three actions that can change this: scrolling the window, -switching buffers in the window, and changing the size of the window. -The first two actions run @code{window-scroll-functions}; the last runs -@code{window-size-change-functions}. +This section describes how Lisp programs can take action after a +window has been scrolled or other window modifications occurred. We +first consider the case where a window shows a different part of its +buffer. @defvar window-scroll-functions This variable holds a list of functions that Emacs should call before -redisplaying a window with scrolling. Displaying a different buffer in -the window also runs these functions. +redisplaying a window with scrolling. Displaying a different buffer +in a window and making a new window also call these functions. -This variable is not a normal hook, because each function is called with -two arguments: the window, and its new display-start position. At the -time of the call, the display-start position of the window argument is -already set to its new value, and the buffer to be displayed in the -window is already set as the current buffer. +This variable is not a normal hook, because each function is called +with two arguments: the window, and its new display-start position. +At the time of the call, the display-start position of the argument +window is already set to its new value, and the buffer to be displayed +in the window is set as the current buffer. These functions must take care when using @code{window-end} (@pxref{Window Start and End}); if you need an up-to-date value, you @@ -6050,63 +6033,226 @@ is scrolled. It's not designed for that, and such use probably won't work. @end defvar -@defun run-window-scroll-functions &optional window -This function calls @code{window-scroll-functions} for the specified -@var{window}, which defaults to the selected window. -@end defun +In addition, you can use @code{jit-lock-register} to register a Font +Lock fontification function, which will be called whenever parts of a +buffer are (re)fontified because a window was scrolled or its size +changed. @xref{Other Font Lock Variables}. + +@cindex window change functions + The remainder of this section covers four hooks that are called at +the end of redisplay provided a significant, non-scrolling change of a +window has been detected. For simplicity, these hooks and the +functions they call will be collectively referred to as @dfn{window +change functions}. + +@cindex window buffer change +The first of these hooks is run after a @dfn{window buffer change} is +detected, which means that a window was created, deleted or assigned +another buffer. + +@defvar window-buffer-change-functions +This variable specifies functions called at the end of redisplay when +window buffers have changed. The value should be a list of functions +that take one argument. + +Functions specified buffer-locally are called for any window showing +the corresponding buffer if that window has been created or assigned +that buffer since the last time window change functions were run. In +this case the window is passed as argument. + +Functions specified by the default value are called for a frame if at +least one window on that frame has been added, deleted or assigned +another buffer since the last time window change functions were run. +In this case the frame is passed as argument. +@end defvar + +@cindex window size change +The second of these hooks is run after a @dfn{window size change} has +been detected which means that a window was created, assigned another +buffer, or changed its total size or that of its text area. @defvar window-size-change-functions -This variable holds a list of functions to be called if the size of any -window changes for any reason. The functions are called once per -redisplay, and once for each frame on which size changes have occurred. - -Each function receives the frame as its sole argument. To find out -whether a specific window has changed size, compare the return values of -@code{window-pixel-width-before-size-change} and -@code{window-pixel-width} respectively -@code{window-pixel-height-before-size-change} and -@code{window-pixel-height} for that window (@pxref{Window Sizes}). - -The buffer-local value of this hook is run once for the buffer and the -frame in question, provided at least one window showing the buffer on -that frame has changed its size. As it still receives the frame as -its sole argument, any function called on a buffer-local basis will be -oblivious to which window(s) showing the buffer changed its (their) -size and has to check out these windows by using the method described -in the previous paragraph. - -These function are usually only called when at least one window was -added or has changed size since the last time this hook was run for -the associated frame. In some rare cases this hook also runs when a -window that was added intermittently has been deleted afterwards. In -these cases none of the windows on the frame will appear to have -changed its size. +This variable specifies functions called at the end of redisplay when +a window size change occurred. The value should be a list of +functions that take one argument. + +Functions specified buffer-locally are called for any window showing +the corresponding buffer if that window has been added or assigned +another buffer, total or body size since the last time window change +functions were run. In this case the window is passed as argument. + +Functions specified by the default value are called for a frame if at +least one window on that frame has been added or assigned another +buffer, total or body size since the last time window change functions +were run. In this case the frame is passed as argument. +@end defvar + +@cindex window selection change +The third of these hooks is run after a @dfn{window selection change} +has selected another window since the last redisplay. + +@defvar window-selection-change-functions +This variable specifies functions called at the end of redisplay when +the selected window or a frame's selected window has changed. The +value should be a list of functions that take one argument. + +Functions specified buffer-locally are called for any window showing +the corresponding buffer if that window has been selected or +deselected (among all windows or among all windows on its frame) since +the last time window change functions were run. In this case the +window is passed as argument. + +Functions specified by the default value are called for a frame if +that frame has been selected or deselected or the frame's selected +window has changed since the last time window change functions were +run. In this case the frame is passed as argument. @end defvar +@cindex window configuration change +The fourth of these hooks is run when a @dfn{window configuration +change} has been detected which means that either the buffer or the +size of a window changed. + @defvar window-configuration-change-hook -A normal hook that is run every time the window configuration of a -frame changes. Window configuration changes include splitting and -deleting windows, and the display of a different buffer in a window. - -The hook can be also used for tracking changes of window sizes. It -is, however, not run when the size of a frame changes or automatic -resizing of a minibuffer window (@pxref{Minibuffer Windows}) changes -the size of another window. As a rule, adding a function to -@code{window-size-change-functions}, see above, is the recommended way -for reliably tracking size changes of any window. - -The buffer-local value of this hook is run once for each window on the -affected frame, with the relevant window selected and its buffer -current. The global value of this hook is run once for the modified -frame, with that frame selected. +This variable specifies functions called at the end of redisplay when +either the buffer or the size of a window has changed. The value +should be a list of functions that take no argument. + +Functions specified buffer-locally are called for any window showing +the corresponding buffer if at least one window on that frame has been +added, deleted or assigned another buffer, total or body size since +the last time window change functions were run. Each call is +performed with the window showing the buffer temporarily selected and +its buffer current. + +Functions specified by the default value are called for each frame if +at least one window on that frame has been added, deleted or assigned +another buffer, total or body size since the last time window change +functions were run. Each call is performed with the frame temporarily +selected and the selected window's buffer current. @end defvar -@defun run-window-configuration-change-hook &optional frame -This function runs @code{window-configuration-change-hook} for the -specified @var{frame}, which defaults to the selected frame. +Window change functions are called at the end of redisplay for each +frame as follows: First, any buffer-local window buffer change +function, window size change function and selected window change +functions are called in this order. Next, the default values for +these functions are called in the same order. Then any buffer-local +window configuration change functions are called followed by functions +specified by the default value of those functions. + + Window change functions are run for a specific frame only if a +corresponding change was registered for that frame earlier. Such +changes include the creation or deletion of a window or the assignment +of another buffer or size to a window. Note that even when such a +change has been registered, this does not mean that any of the hooks +described above is run. If, for example, a change was registered +within the scope of a window excursion (@pxref{Window +Configurations}), this will trigger a call of window change functions +only if that excursion still persists at the time change functions are +run. If it is exited earlier, hooks will be run only if registered by +a change outside the scope of that excursion. + + While window change functions are run, the functions described next +can be called to get more insight into what has changed for a specific +window or frame since the last redisplay. All these functions take a +live window as single, optional argument, defaulting to the selected +window. + +@defun window-old-buffer &optional window +This function returns the buffer shown in @var{window} at the last +time window change functions were run for @var{window}'s frame. If it +returns @code{nil}, @var{window} has been created after that. If it +returns @code{t}, @var{window} was not shown at that time but has been +restored from a previously saved window configuration afterwards. +Otherwise, the return value is the buffer shown by @code{window} at +that time. @end defun - In addition, you can use @code{jit-lock-register} to register a Font -Lock fontification function, which will be called whenever parts of a -buffer are (re)fontified because a window was scrolled or its size -changed. @xref{Other Font Lock Variables}. +@defun window-old-pixel-width &optional window +This function returns the total pixel width of @var{window} the +last time window change functions found @code{window} live on its +frame. It is zero if @code{window} was created after that. +@end defun + +@defun window-old-pixel-height &optional window +This function returns the total pixel height of @var{window} the last +time window change functions found @code{window} live on its frame. +It is zero if @code{window} was created after that. +@end defun + +@defun window-old-body-pixel-width &optional window +This function returns the pixel width of @var{window}'s text area the +last time window change functions found @code{window} live on its +frame. It is zero if @code{window} was created after that. +@end defun + +@defun window-old-body-pixel-height &optional window +This function returns the pixel height of @var{window}'s text area the +last time window change functions found @code{window} live on its +frame. It is zero if @code{window} was created after that. +@end defun + +In order to find out which window or frame was selected the last time +window change functions were run, the following functions can be used: + +@defun frame-old-selected-window &optional frame +This function returns the selected window of @var{frame} at the last +time window change functions were run. If omitted or @code{nil} +@var{frame} defaults to the selected frame. +@end defun + +@defun old-selected-window +This function returns the selected window at the last time window +change functions were run. +@end defun + +@defun old-selected-frame +This function returns the selected frame at the last time window +change functions were run. +@end defun + +Note that window change functions provide no information about which +windows have been deleted since the last time they were run. If +necessary, an application should remember any window showing a +specific buffer in a local variable of that buffer and update it in a +function run by the default value of +@code{window-buffer-change-functions} or +@code{window-configuration-change-hook} (the only hooks triggered by +the deletion of windows). + + The following caveats should be considered when adding a function +to window change functions: + +@itemize @bullet +@item +Some operations will not trigger a call of window change functions. +These include showing another buffer in a minibuffer window or any +change of a tooltip window. + +@item +Window change functions should not create or delete windows or change +the buffer, size or selection status of any window because there is no +guarantee that the information about such a change will be propagated +to other window change functions. If at all, any such change should +be executed only by the last function listed by the default value of +@code{window-configuration-change-hook}. + +@item +Macros like @code{save-window-excursion}, @code{with-selected-window} +or @code{with-current-buffer} can be used when running window change +functions. + +@item +Running window change functions does not save and restore match data. +Unless running @code{window-configuration-change-hook} it does not +save or restore the selected window or frame or the current buffer +either. + +@item +Any redisplay triggering the run of window change functions may be +aborted. If the abort occurs before window change functions have run +to their completion, they will be run again with the previous values, +that is, as if redisplay had not been performed. If aborted later, +they will be run with the new values, that is, as if redisplay had +been actually performed. +@end itemize diff --git a/etc/NEWS b/etc/NEWS index a96ec781b4..bb214f26c5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1283,9 +1283,30 @@ displaying the same buffer. See the node "(elisp) Face Remapping" of the Emacs Lisp Reference manual for more detail. +++ -** Special handling of buffer-local 'window-size-change-functions'. -A buffer-local value of this hook is now run only if at least one -window showing the buffer has changed its size. +** Window change functions have been redesigned completely. +Hooks reacting to window changes run now only when redisplay detects +that a change has actually occurred. The four hooks provided are: +'window-buffer-change-functions' (run after window buffers have +changed), 'window-size-change-functions' (run after a window was +assigned a new buffer or size), 'window-configuration-change-hook' +(like the former but run also when a window was deleted) and +'window-selection-change-functions' (run when the selected window +changed). 'window-scroll-functions' are unaffected by these changes. + +In addition, a number of functions now allow the caller to detect what +has changed since last redisplay: 'window-old-buffer' returns for any +window the buffer it showed at that time. ‘old-selected-window’ and +'old-selected-frame' return the window and frame that were selected +during last redisplay. 'window-old-pixel-width' (renamed from +'window-pixel-width-before-size-change'), 'window-old-pixel-height' +(renamed from 'window-pixel-height-before-size-change'), +'window-old-body-pixel-width' and 'window-old-body-pixel-height' +return the total and body sizes of any window during last redisplay. + +One consequence of these changes is that all window change functions +run now after functions run by 'post-command-hook'. See the section +"(elisp) Window Hooks" in the Elisp manual for a detailed explanation +of the new behavior. +++ ** New buffer display action alist entry 'dedicated'. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index c966cf8627..f42bd64872 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -640,7 +640,7 @@ only consider active buffers visible.") (unless (minibuffer-window-active-p (minibuffer-window)) ;; delay this until command has finished to make sure window is ;; actually visible before clearing activity - (add-hook 'post-command-hook 'erc-modified-channels-update))) + (erc-modified-channels-update))) (defvar erc-modified-channels-update-inside nil "Variable to prevent running `erc-modified-channels-update' multiple @@ -669,8 +669,7 @@ ARGS are ignored." (erc-modified-channels-remove-buffer buffer)))) erc-modified-channels-alist) (when removed-channel - (erc-modified-channels-display))) - (remove-hook 'post-command-hook 'erc-modified-channels-update))) + (erc-modified-channels-display))))) (defvar erc-track-mouse-face (if (featurep 'xemacs) 'modeline-mousable diff --git a/lisp/frame.el b/lisp/frame.el index 8341ba1707..dc81302939 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1745,20 +1745,17 @@ for FRAME." (let* ((frame (window-normalize-frame frame)) (root (frame-root-window frame)) (mini (minibuffer-window frame)) - (mini-height-before-size-change 0) + (mini-old-height 0) (mini-height 0)) ;; FRAME's minibuffer window counts iff it's on FRAME and FRAME is ;; not a minibuffer-only frame. (when (and (eq (window-frame mini) frame) (not (eq mini root))) - (setq mini-height-before-size-change - (window-pixel-height-before-size-change mini)) + (setq mini-old-height (window-old-pixel-height mini)) (setq mini-height (window-pixel-height mini))) ;; Return non-nil when either the width of the root or the sum of ;; the heights of root and minibuffer window changed. - (or (/= (window-pixel-width-before-size-change root) - (window-pixel-width root)) - (/= (+ (window-pixel-height-before-size-change root) - mini-height-before-size-change) + (or (/= (window-old-pixel-width root) (window-pixel-width root)) + (/= (+ (window-old-pixel-height root) mini-old-height) (+ (window-pixel-height root) mini-height))))) ;;;; Frame/display capabilities. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 863554604e..47681ccfe7 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2064,9 +2064,7 @@ activity. Only run if the buffer is not visible and (defvar rcirc-visible-buffers nil) (defun rcirc-window-configuration-change () (unless (minibuffer-window-active-p (minibuffer-window)) - ;; delay this until command has finished to make sure window is - ;; actually visible before clearing activity - (add-hook 'post-command-hook 'rcirc-window-configuration-change-1))) + (rcirc-window-configuration-change-1))) (defun rcirc-window-configuration-change-1 () ;; clear activity and overlay arrows @@ -2090,9 +2088,7 @@ activity. Only run if the buffer is not visible and rcirc-activity))) ;; update the mode-line string (unless (equal old-activity rcirc-activity) - (rcirc-update-activity-string))) - - (remove-hook 'post-command-hook 'rcirc-window-configuration-change-1)) + (rcirc-update-activity-string)))) ;;; buffer name abbreviation diff --git a/lisp/window.el b/lisp/window.el index 751263c925..424d0525f4 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2043,6 +2043,8 @@ doc-string of `window-resizable'." ;; Aliases of functions defined in window.c. (defalias 'window-height 'window-total-height) (defalias 'window-width 'window-body-width) +(defalias 'window-pixel-width-before-size-change 'window-old-pixel-width) +(defalias 'window-pixel-height-before-size-change 'window-old-pixel-height) (defun window-full-height-p (&optional window) "Return t if WINDOW is as high as its containing frame. @@ -2759,8 +2761,7 @@ as small) as possible, but don't signal an error." ;; The following routine catches the case where we want to resize ;; a minibuffer-only frame. (when (resize-mini-window-internal window) - (window--pixel-to-total frame) - (run-window-configuration-change-hook frame)))))) + (window--pixel-to-total frame)))))) (defun window--resize-apply-p (frame &optional horizontal) "Return t when a window on FRAME shall be resized vertically. @@ -2858,9 +2859,7 @@ instead." (window--resize-siblings window delta horizontal ignore)) (when (window--resize-apply-p frame horizontal) (if (window-resize-apply frame horizontal) - (progn - (window--pixel-to-total frame horizontal) - (run-window-configuration-change-hook frame)) + (window--pixel-to-total frame horizontal) (error "Failed to apply resizing %s" window)))) (t (error "Cannot resize window %s" window))))) @@ -3579,9 +3578,7 @@ move it as far as possible in the desired direction." ;; Don't report an error in the standard case. (when (window--resize-apply-p frame horizontal) (if (window-resize-apply frame horizontal) - (progn - (window--pixel-to-total frame horizontal) - (run-window-configuration-change-hook frame)) + (window--pixel-to-total frame horizontal) ;; But do report an error if applying the changes fails. (error "Failed adjusting window %s" window)))))))) @@ -4112,7 +4109,6 @@ that is its frame's root window." ;; `delete-window-internal' has selected a window that should ;; not be selected, fix this here. (other-window -1 frame)) - (run-window-configuration-change-hook frame) (window--check frame) ;; Always return nil. nil)))) @@ -4198,7 +4194,6 @@ any window whose `no-delete-other-windows' parameter is non-nil." ;; If WINDOW is the main window of its frame do nothing. (unless (eq window main) (delete-other-windows-internal window main) - (run-window-configuration-change-hook frame) (window--check frame)) ;; Always return nil. nil))) @@ -5186,7 +5181,6 @@ frame. The selected window is not changed by this function." (unless size (window--sanitize-window-sizes horizontal)) - (run-window-configuration-change-hook frame) (run-window-scroll-functions new) (window--check frame) ;; Always return the new window. @@ -5417,15 +5411,13 @@ window." (balance-windows-1 window) (when (window--resize-apply-p frame) (window-resize-apply frame) - (window--pixel-to-total frame) - (run-window-configuration-change-hook frame)) + (window--pixel-to-total frame)) ;; Balance horizontally. (window--resize-reset (window-frame window) t) (balance-windows-1 window t) (when (window--resize-apply-p frame t) (window-resize-apply frame t) - (window--pixel-to-total frame t) - (run-window-configuration-change-hook frame)))) + (window--pixel-to-total frame t)))) (defun window-fixed-size-p (&optional window direction) "Return t if WINDOW cannot be resized in DIRECTION. @@ -9441,15 +9433,7 @@ displaying that processes's buffer." (when size (set-process-window-size process (cdr size) (car size)))))))))) -;; Remove the following call in Emacs 27, running -;; 'window-size-change-functions' should suffice. (add-hook 'window-configuration-change-hook 'window--adjust-process-windows) - -;; Catch any size changes not handled by -;; 'window-configuration-change-hook' (Bug#32720, "another issue" in -;; Bug#33230). -(add-hook 'window-size-change-functions (lambda (_frame) - (window--adjust-process-windows))) ;; Some of these are in tutorial--default-keys, so update that if you ;; change these. diff --git a/src/frame.c b/src/frame.c index ca6704a44c..6d93abd09b 100644 --- a/src/frame.c +++ b/src/frame.c @@ -55,9 +55,11 @@ along with GNU Emacs. If not, see . */ #endif /* The currently selected frame. */ - Lisp_Object selected_frame; +/* The selected frame the last time window change functions were run. */ +Lisp_Object old_selected_frame; + /* A frame which is not just a mini-buffer, or NULL if there are no such frames. This is usually the most recent such frame that was selected. */ @@ -855,7 +857,8 @@ make_frame (bool mini_p) f->ns_transparent_titlebar = false; #endif #endif - + /* This one should never be zero. */ + f->change_stamp = 1; root_window = make_window (); rw = XWINDOW (root_window); if (mini_p) @@ -1451,7 +1454,8 @@ This function returns FRAME, or nil if FRAME has been deleted. */) return do_switch_frame (frame, 1, 0, norecord); } -DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "^e", +DEFUN ("handle-switch-frame", Fhandle_switch_frame, + Shandle_switch_frame, 1, 1, "^e", doc: /* Handle a switch-frame event EVENT. Switch-frame events are usually bound to this function. A switch-frame event is an event Emacs sends itself to @@ -1471,6 +1475,18 @@ DEFUN ("selected-frame", Fselected_frame, Sselected_frame, 0, 0, 0, { return selected_frame; } + +DEFUN ("old-selected-frame", Fold_selected_frame, + Sold_selected_frame, 0, 0, 0, + doc: /* Return the old selected FRAME. +FRAME must be a live frame and defaults to the selected one. + +The return value is the frame selected the last time window change +functions were run. */) + (void) +{ + return old_selected_frame; +} DEFUN ("frame-list", Fframe_list, Sframe_list, 0, 0, 0, @@ -6098,9 +6114,10 @@ iconify the top level frame instead. */); defsubr (&Swindow_system); defsubr (&Sframe_windows_min_size); defsubr (&Smake_terminal_frame); - defsubr (&Shandle_switch_frame); defsubr (&Sselect_frame); + defsubr (&Shandle_switch_frame); defsubr (&Sselected_frame); + defsubr (&Sold_selected_frame); defsubr (&Sframe_list); defsubr (&Sframe_parent); defsubr (&Sframe_ancestor_p); diff --git a/src/frame.h b/src/frame.h index b7059027fb..ab3efdfa92 100644 --- a/src/frame.h +++ b/src/frame.h @@ -125,6 +125,10 @@ struct frame The selected window of the selected frame is Emacs's selected window. */ Lisp_Object selected_window; + /* This frame's selected window when run_window_change_functions was + called the last time on this frame. */ + Lisp_Object old_selected_window; + /* This frame's minibuffer window. Most frames have their own minibuffer windows, but only the selected frame's minibuffer window @@ -321,9 +325,14 @@ struct frame cleared. */ bool_bf explicit_name : 1; - /* True if configuration of windows on this frame has changed since - last call of run_window_size_change_functions. */ - bool_bf window_configuration_changed : 1; + /* True if at least one window on this frame changed since the last + call of run_window_change_functions. Changes are either "state + changes" (a window has been created, deleted or got assigned + another buffer) or "size changes" (the total or body size of a + window changed). run_window_change_functions exits early unless + either this flag is true or a window selection happened on this + frame. */ + bool_bf window_change : 1; /* True if the mouse has moved on this display device since the last time we checked. */ @@ -406,6 +415,20 @@ struct frame /* Bitfield area ends here. */ + /* This frame's change stamp, set the last time window change + functions were run for this frame. Should never be 0 because + that's the change stamp of a new window. A window was not on a + frame the last run_window_change_functions was called on it if + it's change stamp differs from that of its frame. */ + int change_stamp; + + /* This frame's number of windows, set the last time window change + functions were run for this frame. Should never be 0 even for + minibuffer-only frames. If no window has been added, this allows + to detect whether a window was deleted on this frame since the + last time run_window_change_functions was called on it. */ + ptrdiff_t number_of_windows; + /* Number of lines (rounded up) of tool bar. REMOVE THIS */ int tool_bar_lines; @@ -662,6 +685,11 @@ fset_selected_window (struct frame *f, Lisp_Object val) f->selected_window = val; } INLINE void +fset_old_selected_window (struct frame *f, Lisp_Object val) +{ + f->old_selected_window = val; +} +INLINE void fset_title (struct frame *f, Lisp_Object val) { f->title = val; @@ -908,10 +936,9 @@ default_pixels_per_inch_y (void) are frozen on frame F. */ #define FRAME_WINDOWS_FROZEN(f) (f)->frozen_window_starts -/* True if the frame's window configuration has changed since last call - of run_window_size_change_functions. */ -#define FRAME_WINDOW_CONFIGURATION_CHANGED(f) \ - (f)->window_configuration_changed +/* True if at least one window changed on frame F since the last time + window change functions were run on F. */ +#define FRAME_WINDOW_CHANGE(f) (f)->window_change /* The minibuffer window of frame F, if it has one; otherwise nil. */ #define FRAME_MINIBUF_WINDOW(f) f->minibuffer_window @@ -919,8 +946,10 @@ default_pixels_per_inch_y (void) /* The root window of the window tree of frame F. */ #define FRAME_ROOT_WINDOW(f) f->root_window -/* The currently selected window of the window tree of frame F. */ +/* The currently selected window of frame F. */ #define FRAME_SELECTED_WINDOW(f) f->selected_window +/* The old selected window of frame F. */ +#define FRAME_OLD_SELECTED_WINDOW(f) f->old_selected_window #define FRAME_INSERT_COST(f) (f)->insert_line_cost #define FRAME_DELETE_COST(f) (f)->delete_line_cost @@ -1215,6 +1244,7 @@ SET_FRAME_VISIBLE (struct frame *f, int v) (f)->iconified = (eassert (0 <= (i) && (i) <= 1), (i)) extern Lisp_Object selected_frame; +extern Lisp_Object old_selected_frame; #if ! (defined USE_GTK || defined HAVE_NS) extern int frame_default_tool_bar_height; diff --git a/src/window.c b/src/window.c index 72185f9340..0fc4f62299 100644 --- a/src/window.c +++ b/src/window.c @@ -77,6 +77,11 @@ static void apply_window_adjustment (struct window *); FRAME_SELECTED_WINDOW (selected_frame). */ Lisp_Object selected_window; +/* The value of selected_window at the last time window change + functions were run. This is always the same as + FRAME_OLD_SELECTED_WINDOW (old_selected_frame). */ +Lisp_Object old_selected_window; + /* A list of all windows for use by next_window and Fwindow_list. Functions creating or deleting windows should invalidate this cache by setting it to nil. */ @@ -304,6 +309,12 @@ wset_buffer (struct window *w, Lisp_Object val) adjust_window_count (w, 1); } +static void +wset_old_buffer (struct window *w, Lisp_Object val) +{ + w->old_buffer = val; +} + DEFUN ("windowp", Fwindowp, Swindowp, 1, 1, 0, doc: /* Return t if OBJECT is a window and nil otherwise. */) (Lisp_Object object) @@ -428,6 +439,22 @@ return the selected window of that frame. */) return window; } +DEFUN ("frame-old-selected-window", Fframe_old_selected_window, + Sframe_old_selected_window, 0, 1, 0, + doc: /* Return old selected window of FRAME. +FRAME must be a live frame and defaults to the selected one. + +The return value is the window selected on FRAME the last time window +change functions were run for FRAME. */) + (Lisp_Object frame) +{ + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + + return XFRAME (frame)->old_selected_window; +} + DEFUN ("set-frame-selected-window", Fset_frame_selected_window, Sset_frame_selected_window, 2, 3, 0, doc: /* Set selected window of FRAME to WINDOW. @@ -465,6 +492,16 @@ selected windows appears and to which many commands apply. */) return selected_window; } +DEFUN ("old-selected-window", Fold_selected_window, + Sold_selected_window, 0, 0, 0, + doc: /* Return the old selected window. +The return value is the window selected the last time window change +functions were run. */) + (void) +{ + return old_selected_window; +} + EMACS_INT window_select_count; /* If select_window is called with inhibit_point_swap true it will @@ -597,9 +634,33 @@ Return nil for an internal window or a deleted window. */) (Lisp_Object window) { struct window *w = decode_any_window (window); + return WINDOW_LEAF_P (w) ? w->contents : Qnil; } +DEFUN ("window-old-buffer", Fwindow_old_buffer, Swindow_old_buffer, 0, 1, 0, + doc: /* Return the old buffer displayed by WINDOW. +WINDOW must be a live window and defaults to the selected one. + +The return value is the buffer shown in WINDOW at the last time window +change functions were run. It is nil if WINDOW was created after +that. It is t if WINDOW has been restored from a window configuration +after that. */) + (Lisp_Object window) +{ + struct window *w = decode_live_window (window); + + return (NILP (w->old_buffer) + /* A new window. */ + ? Qnil + : (w->change_stamp != WINDOW_XFRAME (w)->change_stamp) + /* A window restored from a configuration. */ + ? Qt + /* A window that was live the last time seen by window + change functions. */ + : w->old_buffer); +} + DEFUN ("window-parent", Fwindow_parent, Swindow_parent, 0, 1, 0, doc: /* Return the parent window of window WINDOW. WINDOW must be a valid window and defaults to the selected one. @@ -723,34 +784,32 @@ the height of the screen areas spanned by its children. */) return make_fixnum (decode_valid_window (window)->pixel_height); } -DEFUN ("window-pixel-width-before-size-change", - Fwindow_pixel_width_before_size_change, - Swindow_pixel_width_before_size_change, 0, 1, 0, - doc: /* Return pixel width of window WINDOW before last size changes. +DEFUN ("window-old-pixel-width", Fwindow_old_pixel_width, + Swindow_old_pixel_width, 0, 1, 0, + doc: /* Return old total pixel width of WINDOW. WINDOW must be a valid window and defaults to the selected one. -The return value is the pixel width of WINDOW at the last time -`window-size-change-functions' was run. It's zero if WINDOW was made -after that. */) +The return value is the total pixel width of WINDOW after the last +time window change functions found WINDOW live on its frame. It is +zero if WINDOW was created after that. */) (Lisp_Object window) { return (make_fixnum - (decode_valid_window (window)->pixel_width_before_size_change)); + (decode_valid_window (window)->old_pixel_width)); } -DEFUN ("window-pixel-height-before-size-change", - Fwindow_pixel_height_before_size_change, - Swindow_pixel_height_before_size_change, 0, 1, 0, - doc: /* Return pixel height of window WINDOW before last size changes. +DEFUN ("window-old-pixel-height", Fwindow_old_pixel_height, + Swindow_old_pixel_height, 0, 1, 0, + doc: /* Return old total pixel height of WINDOW. WINDOW must be a valid window and defaults to the selected one. -The return value is the pixel height of WINDOW at the last time -`window-size-change-functions' was run. It's zero if WINDOW was made -after that. */) +The return value is the total pixel height of WINDOW after the last +time window change functions found WINDOW live on its frame. It is +zero if WINDOW was created after that. */) (Lisp_Object window) { return (make_fixnum - (decode_valid_window (window)->pixel_height_before_size_change)); + (decode_valid_window (window)->old_pixel_height)); } DEFUN ("window-total-height", Fwindow_total_height, Swindow_total_height, 0, 2, 0, @@ -984,6 +1043,26 @@ window_body_width (struct window *w, bool pixelwise) 0); } +DEFUN ("window-body-width", Fwindow_body_width, Swindow_body_width, 0, 2, 0, + doc: /* Return the width of WINDOW's text area. +WINDOW must be a live window and defaults to the selected one. Optional +argument PIXELWISE non-nil means return the width in pixels. The return +value does not include any vertical dividers, fringes or marginal areas, +or scroll bars. + +If PIXELWISE is nil, return the largest integer smaller than WINDOW's +pixel width divided by the character width of WINDOW's frame. This +means that if a column at the right of the text area is only partially +visible, that column is not counted. + +Note that the returned value includes the column reserved for the +continuation glyph. */) + (Lisp_Object window, Lisp_Object pixelwise) +{ + return make_fixnum (window_body_width (decode_live_window (window), + !NILP (pixelwise))); +} + DEFUN ("window-body-height", Fwindow_body_height, Swindow_body_height, 0, 2, 0, doc: /* Return the height of WINDOW's text area. WINDOW must be a live window and defaults to the selected one. Optional @@ -1001,24 +1080,34 @@ visible, that line is not counted. */) !NILP (pixelwise))); } -DEFUN ("window-body-width", Fwindow_body_width, Swindow_body_width, 0, 2, 0, - doc: /* Return the width of WINDOW's text area. -WINDOW must be a live window and defaults to the selected one. Optional -argument PIXELWISE non-nil means return the width in pixels. The return -value does not include any vertical dividers, fringes or marginal areas, -or scroll bars. +DEFUN ("window-old-body-pixel-width", + Fwindow_old_body_pixel_width, + Swindow_old_body_pixel_width, 0, 1, 0, + doc: /* Return old width of WINDOW's text area in pixels. +WINDOW must be a live window and defaults to the selected one. -If PIXELWISE is nil, return the largest integer smaller than WINDOW's -pixel width divided by the character width of WINDOW's frame. This -means that if a column at the right of the text area is only partially -visible, that column is not counted. +The return value is the pixel width of WINDOW's text area after the +last time window change functions found WINDOW live on its frame. It +is zero if WINDOW was created after that. */) + (Lisp_Object window) +{ + return (make_fixnum + (decode_live_window (window)->old_body_pixel_width)); +} -Note that the returned value includes the column reserved for the -continuation glyph. */) - (Lisp_Object window, Lisp_Object pixelwise) +DEFUN ("window-old-body-pixel-height", + Fwindow_old_body_pixel_height, + Swindow_old_body_pixel_height, 0, 1, 0, + doc: /* Return old height of WINDOW's text area in pixels. +WINDOW must be a live window and defaults to the selected one. + +The return value is the pixel height of WINDOW's text area after the +last time window change functions found WINDOW live on its frame. It +is zero if WINDOW was created after that. */) + (Lisp_Object window) { - return make_fixnum (window_body_width (decode_live_window (window), - !NILP (pixelwise))); + return (make_fixnum + (decode_live_window (window)->old_body_pixel_height)); } DEFUN ("window-mode-line-height", Fwindow_mode_line_height, @@ -3264,7 +3353,7 @@ window-start value is reasonable when this function is called. */) adjust_frame_glyphs (f); unblock_input (); - run_window_configuration_change_hook (f); + FRAME_WINDOW_CHANGE (f) = true; return Qnil; } @@ -3318,6 +3407,15 @@ select_frame_norecord (Lisp_Object frame) Fselect_frame (frame, Qt); } +/** + * run_window_configuration_change_hook: + * + * Run any functions on 'window-configuration-change-hook' for the + * frame specified by F. The buffer-local values are run with the + * window showing the buffer selected. The default value is run with + * the frame specified by F selected. All functions are called with + * the selected window's buffer current. + */ static void run_window_configuration_change_hook (struct frame *f) { @@ -3371,7 +3469,10 @@ run_window_configuration_change_hook (struct frame *f) DEFUN ("run-window-configuration-change-hook", Frun_window_configuration_change_hook, Srun_window_configuration_change_hook, 0, 1, 0, doc: /* Run `window-configuration-change-hook' for FRAME. -If FRAME is omitted or nil, it defaults to the selected frame. */) +If FRAME is omitted or nil, it defaults to the selected frame. + +This function should not be needed any more and will be therefore +considered obsolete. */) (Lisp_Object frame) { run_window_configuration_change_hook (decode_live_frame (frame)); @@ -3381,130 +3482,381 @@ If FRAME is omitted or nil, it defaults to the selected frame. */) DEFUN ("run-window-scroll-functions", Frun_window_scroll_functions, Srun_window_scroll_functions, 0, 1, 0, doc: /* Run `window-scroll-functions' for WINDOW. -If WINDOW is omitted or nil, it defaults to the selected window. */) +If WINDOW is omitted or nil, it defaults to the selected window. + +This function is curently only called by 'split-window' for the new +window after it has established the size of the new window. */) (Lisp_Object window) { - if (! NILP (Vwindow_scroll_functions)) + struct window *w = decode_live_window (window); + ptrdiff_t count = SPECPDL_INDEX (); + + record_unwind_current_buffer (); + Fset_buffer (w->contents); + if (!NILP (Vwindow_scroll_functions)) run_hook_with_args_2 (Qwindow_scroll_functions, window, - Fmarker_position (decode_live_window (window)->start)); + Fmarker_position (w->start)); + unbind_to (count, Qnil); + return Qnil; } -/* Compare old and present pixel sizes of windows in tree rooted at W. - Return true iff any of these windows differs in size. */ - -static bool -window_size_changed (struct window *w) +/** + * window_sub_list: + * + * Return list of live windows constructed by traversing any window + * sub-tree rooted at WINDOW in preorder followed by right siblings of + * WINDOW. Called from outside with second argument WINDOWS nil. The + * returned list is in reverse order. + */ +static Lisp_Object +window_sub_list (Lisp_Object window, Lisp_Object windows) { - if (w->pixel_width != w->pixel_width_before_size_change - || w->pixel_height != w->pixel_height_before_size_change) - return true; - if (WINDOW_INTERNAL_P (w)) + struct window *w = XWINDOW (window); + + while (w) { - w = XWINDOW (w->contents); - while (w) - { - if (window_size_changed (w)) - return true; + if (WINDOW_INTERNAL_P (w)) + windows = window_sub_list (w->contents, windows); + else + windows = Fcons (window, windows); - w = NILP (w->next) ? 0 : XWINDOW (w->next); - } + window = w->next; + w = NILP (window) ? 0 : XWINDOW (window); } - return false; + return windows; } -/* Set before size change pixel sizes of windows in tree rooted at W to - their present pixel sizes. */ -static void -window_set_before_size_change_sizes (struct window *w) +/** + * window_change_record_windows: + * + * Record changes for all live windows found by traversing any window + * sub-tree rooted at WINDOW in preorder followed by any right + * siblings of WINDOW. This sets the old buffer, old pixel and old + * body pixel sizes of each live window found to the respective + * current values. It also sets the change stamp of each window found + * to STAMP. Return the number of live windows found. + * + * When not called by itself recursively, WINDOW is its frame's root + * window, STAMP is the current change stamp of WINDOW's frame and + * NUMBER is 0. + */ +static ptrdiff_t +window_change_record_windows (Lisp_Object window, int stamp, ptrdiff_t number) { - w->pixel_width_before_size_change = w->pixel_width; - w->pixel_height_before_size_change = w->pixel_height; + struct window *w = XWINDOW (window); - if (WINDOW_INTERNAL_P (w)) + while (w) { - w = XWINDOW (w->contents); - while (w) + if (WINDOW_INTERNAL_P (w)) + number = window_change_record_windows (w->contents, stamp, number); + else { - window_set_before_size_change_sizes (w); - w = NILP (w->next) ? 0 : XWINDOW (w->next); + number += 1; + w->change_stamp = stamp; + wset_old_buffer (w, w->contents); + w->old_pixel_width = w->pixel_width; + w->old_pixel_height = w->pixel_height; + w->old_body_pixel_width = window_body_width (w, true); + w->old_body_pixel_height = window_body_height (w, true); } + + w = NILP (w->next) ? 0 : XWINDOW (w->next); } + + return number; } -void -run_window_size_change_functions (Lisp_Object frame) +/** + * window_change_record_frame: + * + * Record changes for FRAME. This records FRAME's selected window, + * updates FRAME's change stamp, records the states of all live + * windows of FRAME via window_change_record_windows and resets + * FRAME's window_change flag. + */ +static void +window_change_record_frame (Lisp_Object frame) { struct frame *f = XFRAME (frame); - struct window *r = XWINDOW (FRAME_ROOT_WINDOW (f)); - if (NILP (Vrun_hooks) - || !(f->can_x_set_window_size) - || !(f->after_make_frame)) - return; + /* Record selected window. */ + fset_old_selected_window (f, FRAME_SELECTED_WINDOW (f)); - if (FRAME_WINDOW_CONFIGURATION_CHANGED (f) - /* Here we implicitly exclude the possibility that the height of - FRAME and its minibuffer window both change leaving the height - of FRAME's root window alone. */ - || window_size_changed (r)) - { - Lisp_Object globals = Fdefault_value (Qwindow_size_change_functions); - Lisp_Object windows = Fwindow_list (frame, Qlambda, Qnil); - /* The buffers for which the local hook was already run. */ - Lisp_Object buffers = Qnil; + /* Bump up FRAME's change stamp. If this wraps, make it 1 to avoid + that a new window (whose change stamp is always set to 0) gets + reported as "existing before". */ + f->change_stamp += 1; + if (f->change_stamp == 0) + f->change_stamp = 1; - for (; CONSP (windows); windows = XCDR (windows)) - { - Lisp_Object window = XCAR (windows); - Lisp_Object buffer = Fwindow_buffer (window); - - /* Run a buffer-local value only once for that buffer and - only if at least one window showing that buffer on FRAME - actually changed its size. Note that the function is run - with FRAME as its argument and as such oblivious to the - window checked below. */ - if (window_size_changed (XWINDOW (window)) - && !NILP (Flocal_variable_p (Qwindow_size_change_functions, buffer)) - && NILP (Fmemq (buffer, buffers))) - { - Lisp_Object locals - = Fbuffer_local_value (Qwindow_size_change_functions, buffer); + /* Bump up the change stamps of all live windows on this frame so + the next call of this function can tell whether any of them + "existed before" and record state for each of these windows. */ + f->number_of_windows + = window_change_record_windows (f->root_window, f->change_stamp, 0); - while (CONSP (locals)) - { - if (!EQ (XCAR (locals), Qt)) - safe_call1 (XCAR (locals), frame); - locals = XCDR (locals); - } + /* Reset our flag. */ + FRAME_WINDOW_CHANGE (f) = false; +} - buffers = Fcons (buffer, buffers); - } - } - while (CONSP (globals)) +/** + * window_change_record: + * + * Record selected window in old_selected_window and selected frame in + * old_selected_frame. + */ +static void +window_change_record (void) +{ + /* Strictly spoken we don't need old_selected_window at all - its + value is the old selected window of old_selected_frame. */ + old_selected_window = selected_window; + old_selected_frame = selected_frame; +} + + +/** + * run_window_change_functions_1: + * + * Run window change functions specified by SYMBOL with argument + * WINDOW_OR_FRAME. If BUFFER is nil, WINDOW_OR_FRAME specifies a + * frame. In this case, run the default value of SYMBOL. Otherwise, + * WINDOW_OR_FRAME denotes a window showing BUFFER. In this case, run + * the buffer local value of SYMBOL in BUFFER, if any. + */ +static void +run_window_change_functions_1 (Lisp_Object symbol, Lisp_Object buffer, + Lisp_Object window_or_frame) +{ + Lisp_Object funs = Qnil; + + if (NILP (buffer)) + funs = Fdefault_value (symbol); + else if (!NILP (Fassoc (symbol, BVAR (XBUFFER (buffer), local_var_alist), + Qnil))) + /* Don't run global value buffer-locally. */ + funs = buffer_local_value (symbol, buffer); + + while (CONSP (funs)) + { + if (!EQ (XCAR (funs), Qt)) + safe_call1 (XCAR (funs), window_or_frame); + funs = XCDR (funs); + } +} + + +/** + * run_window_change_functions: + * + * Run window change functions for each live frame. This function + * must be called from a "safe" position in redisplay_internal. + * + * Do not run any functions for a frame whose window_change flag is + * nil and where no window selection happened since the last time this + * function was called. Also, skip any tooltip frame. + * + * The change functions run are, in this order: + * + * 'window-buffer-change-functions' which are run for a window that + * changed its buffer or that was not shown the last time window + * change functions were run. The default value is also run when a + * window was deleted since the last time window change functions were + * run. + * + * `window-size-change-functions' run for a window that changed its + * body or total size, a window that changed its buffer or a window + * that was not shown the last time window change functions were run. + * + * `window-selected-change-functions' run for a window that was + * (de-)selected since the last time window change functions were run. + * + * A buffer-local value of these functions is run if and only if the + * window for which the functions are run, currently shows the buffer. + * Each call gets one argument - the window showing the buffer. This + * means that the buffer-local value of these functions may be called + * as many times at the buffer is shown on the frame. + * + * The default value of these functions is called only after all + * buffer-local values for all of these functions have been run. Each + * such call receives one argument - the frame for which this function + * is run. + * + * After the three change functions cited above have been run in the + * indicated way, functions on 'window-configuration-change-hook' are + * run. A buffer-local value is run if a window shows that buffer and + * has either changed its buffer or its body or total size or did not + * appear on this frame since the last time window change functions + * were run. The functions are called without argument and the + * buffer's window selected. The default value is run without + * argument and the frame for which the function is run selected. + * + * This function does not save and restore match data. Any functions + * it calls are responsible for doing that themselves. + */ +void +run_window_change_functions (void) +{ + Lisp_Object tail, frame; + bool selected_frame_change = !EQ (selected_frame, old_selected_frame); + ptrdiff_t count_outer = SPECPDL_INDEX (); + + record_unwind_protect_void (window_change_record); + + FOR_EACH_FRAME (tail, frame) + { + struct frame *f = XFRAME (frame); + Lisp_Object root = FRAME_ROOT_WINDOW (f); + bool frame_window_change = FRAME_WINDOW_CHANGE (f); + bool window_buffer_change, window_size_change; + bool frame_buffer_change = false, frame_size_change = false; + bool frame_selected_change + = (selected_frame_change + && (EQ (frame, old_selected_frame) + || EQ (frame, selected_frame))); + bool frame_selected_window_change + = !EQ (FRAME_OLD_SELECTED_WINDOW (f), FRAME_SELECTED_WINDOW (f)); + bool window_deleted = false; + Lisp_Object windows; + ptrdiff_t number_of_windows; + ptrdiff_t count_inner = SPECPDL_INDEX (); + + if (!f->can_x_set_window_size + || !f->after_make_frame + || FRAME_TOOLTIP_P (f) + || !(frame_window_change + || frame_selected_change + || frame_selected_window_change)) + /* Either we cannot run hooks for this frame yet or no window + change has been reported for this frame since the last time + we ran window change functions on it. */ + continue; + + /* Analyze windows and run buffer locals hooks in pre-order. */ + windows = Fnreverse (window_sub_list (root, Qnil)); + number_of_windows = 0; + + record_unwind_protect (window_change_record_frame, frame); + + /* The following loop collects all data needed to tell whether + the default value of a hook shall be run and runs any buffer + local hooks right away. */ + for (; CONSP (windows); windows = XCDR (windows)) { - if (!EQ (XCAR (globals), Qt)) - safe_call1 (XCAR (globals), frame); - globals = XCDR (globals); + Lisp_Object window = XCAR (windows); + struct window *w = XWINDOW (window); + Lisp_Object buffer = WINDOW_BUFFER (w); + + /* Count this window even if it has been deleted while + running a hook. */ + number_of_windows += 1; + + if (!WINDOW_LIVE_P (window)) + continue; + + /* A "buffer change" means either the window's buffer + changed or the window was not part of this frame the last + time window change functions were run for it. */ + window_buffer_change = + (frame_window_change + && (!EQ (buffer, w->old_buffer) + || w->change_stamp != f->change_stamp)); + /* A "size change" means either a buffer change or that the + total or body size of the window has changed. + + Note: A buffer change implies a size change because either + this window didn't show the buffer before or this window + didn't show the buffer the last time the window change + functions were run. In either case, an application + tracing size changes in a buffer-locally fashion might + want to be informed about that change. */ + window_size_change = + (frame_window_change + && (window_buffer_change + || w->pixel_width != w->old_pixel_width + || w->pixel_height != w->old_pixel_height + || window_body_width (w, true) != w->old_body_pixel_width + || window_body_height (w, true) != w->old_body_pixel_height)); + + /* The following two are needed when running the default + values for this frame below. */ + frame_buffer_change = frame_buffer_change || window_buffer_change; + frame_size_change = frame_size_change || window_size_change; + + if (window_buffer_change) + run_window_change_functions_1 + (Qwindow_buffer_change_functions, buffer, window); + + if (window_size_change && WINDOW_LIVE_P (window)) + run_window_change_functions_1 + (Qwindow_size_change_functions, buffer, window); + + /* This window's selection has changed when it it was + (de-)selected as its frame's or the globally selected + window. */ + if (((frame_selected_change + && (EQ (window, old_selected_window) + || EQ (window, selected_window))) + || (frame_selected_window_change + && (EQ (window, FRAME_OLD_SELECTED_WINDOW (f)) + || EQ (window, FRAME_SELECTED_WINDOW (f))))) + && WINDOW_LIVE_P (window)) + run_window_change_functions_1 + (Qwindow_selection_change_functions, buffer, window); } - window_set_before_size_change_sizes (r); + /* When the number of windows on a frame has decreased, at least + one window of that frame was deleted. In that case, we want + to run the default buffer and configuration change hooks. The + default size change hook is not necessarily run in that case, + but usually will be unless the deletion was "compensated" by + a reduction of the frame size or an increase of a minibuffer + window size. */ + window_deleted = number_of_windows < f->number_of_windows; + /* A frame changed buffers when one of its windows has changed + its buffer or at least one window was deleted. */ + if ((frame_buffer_change || window_deleted) && FRAME_LIVE_P (f)) + run_window_change_functions_1 + (Qwindow_buffer_change_functions, Qnil, frame); + + /* A size change occurred when at least one of the frame's + windows has changed size. */ + if (frame_size_change && FRAME_LIVE_P (f)) + run_window_change_functions_1 + (Qwindow_size_change_functions, Qnil, frame); + + /* A frame has changed its window selection when its selected + window has changed or when it was (de-)selected. */ + if ((frame_selected_change || frame_selected_window_change) + && FRAME_LIVE_P (f)) + run_window_change_functions_1 + (Qwindow_selection_change_functions, Qnil, frame); + + /* A frame's configuration changed when one of its windows has + changed buffer or size or at least one window was deleted. */ + if ((frame_size_change || window_deleted) && FRAME_LIVE_P (f)) + /* This will run any buffer local window configuration change + hook as well. */ + run_window_configuration_change_hook (f); - if (FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f)) - /* Record size of FRAME's minibuffer window too. */ - window_set_before_size_change_sizes - (XWINDOW (FRAME_MINIBUF_WINDOW (f))); + if (!FRAME_LIVE_P (f)) + continue; - FRAME_WINDOW_CONFIGURATION_CHANGED (f) = false; + /* Record changes (via window_change_record_frame) for this + frame, even when an unhandled error occurred. */ + unbind_to (count_inner, Qnil); } -} + /* Record selected window and frame. */ + unbind_to (count_outer, Qnil); +} /* Make WINDOW display BUFFER. RUN_HOOKS_P means it's allowed to run hooks. See make_frame for a case where it's not allowed. @@ -3581,14 +3933,18 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, apply_window_adjustment (w); } - if (run_hooks_p) - { - if (!NILP (Vwindow_scroll_functions)) - run_hook_with_args_2 (Qwindow_scroll_functions, window, - Fmarker_position (w->start)); - if (!samebuf) - run_window_configuration_change_hook (XFRAME (WINDOW_FRAME (w))); - } + if (run_hooks_p && !NILP (Vwindow_scroll_functions)) + run_hook_with_args_2 (Qwindow_scroll_functions, window, + Fmarker_position (w->start)); + + /* Ensure that window change functions are run later if the buffer + differs and the window is neither a mini nor a pseudo window. + + Note: Running window change functions for the minibuffer is noisy + and was generally suppressed in the past. Is there any reason we + should run them? */ + if (!samebuf && !MINI_WINDOW_P (w) && !WINDOW_PSEUDO_P (w)) + FRAME_WINDOW_CHANGE (XFRAME (w->frame)) = true; unbind_to (count, Qnil); } @@ -3828,8 +4184,6 @@ make_window (void) w->phys_cursor_width = -1; #endif w->sequence_number = ++sequence_number; - w->pixel_width_before_size_change = 0; - w->pixel_height_before_size_change = 0; w->scroll_bar_width = -1; w->scroll_bar_height = -1; w->column_number_displayed = -1; @@ -4095,6 +4449,9 @@ window_resize_apply (struct window *w, bool horflag) else /* Bug#15957. */ w->window_end_valid = false; + + if (!WINDOW_PSEUDO_P (w)) + FRAME_WINDOW_CHANGE (WINDOW_XFRAME (w)) = true; } @@ -4559,17 +4916,11 @@ set correctly. See the code of `split-window' for how this is done. */) block_input (); window_resize_apply (p, horflag); adjust_frame_glyphs (f); - /* Set buffer of NEW to buffer of reference window. Don't run - any hooks. */ - set_window_buffer (new, r->contents, false, true); + /* Set buffer of NEW to buffer of reference window. */ + set_window_buffer (new, r->contents, true, true); + FRAME_WINDOW_CHANGE (f) = true; unblock_input (); - /* Maybe we should run the scroll functions in Elisp (which already - runs the configuration change hook). */ - if (! NILP (Vwindow_scroll_functions)) - run_hook_with_args_2 (Qwindow_scroll_functions, new, - Fmarker_position (n->start)); - /* Return NEW. */ return new; } @@ -4720,6 +5071,8 @@ Signal an error when WINDOW is the only window on its frame. */) } else unblock_input (); + + FRAME_WINDOW_CHANGE (f) = true; } else /* We failed: Relink WINDOW into window tree. */ @@ -6310,7 +6663,6 @@ struct saved_window Lisp_Object window, buffer, start, pointm, old_pointm; Lisp_Object pixel_left, pixel_top, pixel_height, pixel_width; - Lisp_Object pixel_height_before_size_change, pixel_width_before_size_change; Lisp_Object left_col, top_line, total_cols, total_lines; Lisp_Object normal_cols, normal_lines; Lisp_Object hscroll, min_hscroll, hscroll_whole, suspend_auto_hscroll; @@ -6426,12 +6778,6 @@ the return value is nil. Otherwise the value is t. */) struct window *root_window; struct window **leaf_windows; ptrdiff_t i, k, n_leaf_windows; - /* Records whether a window has been added or removed wrt the - original configuration. */ - bool window_changed = false; - /* Records whether a window has changed its buffer wrt the - original configuration. */ - bool buffer_changed = false; /* Don't do this within the main loop below: This may call Lisp code and is thus potentially unsafe while input is blocked. */ @@ -6441,11 +6787,6 @@ the return value is nil. Otherwise the value is t. */) window = p->window; w = XWINDOW (window); - if (NILP (w->contents)) - /* A dead window that will be resurrected, the window - configuration will change. */ - window_changed = true; - if (BUFFERP (w->contents) && !EQ (w->contents, p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) @@ -6530,10 +6871,6 @@ the return value is nil. Otherwise the value is t. */) w->pixel_top = XFIXNAT (p->pixel_top); w->pixel_width = XFIXNAT (p->pixel_width); w->pixel_height = XFIXNAT (p->pixel_height); - w->pixel_width_before_size_change - = XFIXNAT (p->pixel_width_before_size_change); - w->pixel_height_before_size_change - = XFIXNAT (p->pixel_height_before_size_change); w->left_col = XFIXNAT (p->left_col); w->top_line = XFIXNAT (p->top_line); w->total_cols = XFIXNAT (p->total_cols); @@ -6581,9 +6918,6 @@ the return value is nil. Otherwise the value is t. */) if (BUFFERP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer))) /* If saved buffer is alive, install it. */ { - if (!EQ (w->contents, p->buffer)) - /* Record buffer configuration change. */ - buffer_changed = true; wset_buffer (w, p->buffer); w->start_at_line_beg = !NILP (p->start_at_line_beg); set_marker_restricted (w->start, p->start, w->contents); @@ -6617,8 +6951,6 @@ the return value is nil. Otherwise the value is t. */) else if (!NILP (w->start)) /* Leaf window has no live buffer, get one. */ { - /* Record buffer configuration change. */ - buffer_changed = true; /* Get the buffer via other_buffer_safely in order to avoid showing an unimportant buffer and, if necessary, to recreate *scratch* in the course (part of Juanma's bs-show @@ -6666,10 +6998,7 @@ the return value is nil. Otherwise the value is t. */) /* Now, free glyph matrices in windows that were not reused. */ for (i = 0; i < n_leaf_windows; i++) if (NILP (leaf_windows[i]->contents)) - { - free_window_matrices (leaf_windows[i]); - window_changed = true; - } + free_window_matrices (leaf_windows[i]); /* Allow x_set_window_size again and apply frame size changes if needed. */ @@ -6699,35 +7028,10 @@ the return value is nil. Otherwise the value is t. */) selected window. */ if (FRAME_LIVE_P (XFRAME (data->selected_frame))) do_switch_frame (data->selected_frame, 0, 0, Qnil); - - if (window_changed) - /* At least one window has been added or removed. Run - `window-configuration-change-hook' and make sure - `window-size-change-functions' get run later. - - We have to do this in order to capture the following - scenario: Suppose our frame contains two live windows W1 and - W2 and 'set-window-configuration' replaces them by two - windows W3 and W4 that were dead the last time - run_window_size_change_functions was run. If W3 and W4 have - the same values for their old and new pixel sizes but these - values differ from those of W1 and W2, the sizes of our - frame's two live windows changed but window_size_changed has - no means to detect that fact. - - Obviously, this will get us false positives, for example, - when we restore the original configuration with W1 and W2 - before run_window_size_change_functions gets called. */ - { - run_window_configuration_change_hook (f); - FRAME_WINDOW_CONFIGURATION_CHANGED (f) = true; - } - else if (buffer_changed) - /* At least one window has changed its buffer. Run - `window-configuration-change-hook' only. */ - run_window_configuration_change_hook (f); } + FRAME_WINDOW_CHANGE (f) = true; + if (!NILP (new_current_buffer)) { Fset_buffer (new_current_buffer); @@ -6889,10 +7193,6 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, ptrdiff_t i) p->pixel_top = make_fixnum (w->pixel_top); p->pixel_width = make_fixnum (w->pixel_width); p->pixel_height = make_fixnum (w->pixel_height); - p->pixel_width_before_size_change - = make_fixnum (w->pixel_width_before_size_change); - p->pixel_height_before_size_change - = make_fixnum (w->pixel_height_before_size_change); p->left_col = make_fixnum (w->left_col); p->top_line = make_fixnum (w->top_line); p->total_cols = make_fixnum (w->total_cols); @@ -7581,9 +7881,9 @@ init_window_once (void) { struct frame *f = make_initial_frame (); XSETFRAME (selected_frame, f); - Vterminal_frame = selected_frame; + old_selected_frame = Vterminal_frame = selected_frame; minibuf_window = f->minibuffer_window; - selected_window = f->selected_window; + old_selected_window = selected_window = f->selected_window; } void @@ -7604,6 +7904,8 @@ syms_of_window (void) DEFSYM (Qwindow_configuration_change_hook, "window-configuration-change-hook"); DEFSYM (Qwindow_size_change_functions, "window-size-change-functions"); + DEFSYM (Qwindow_buffer_change_functions, "window-buffer-change-functions"); + DEFSYM (Qwindow_selection_change_functions, "window-selection-change-functions"); DEFSYM (Qwindowp, "windowp"); DEFSYM (Qwindow_configuration_p, "window-configuration-p"); DEFSYM (Qwindow_live_p, "window-live-p"); @@ -7688,24 +7990,66 @@ on their symbols to be controlled by this variable. */); Vwindow_point_insertion_type = Qnil; DEFSYM (Qwindow_point_insertion_type, "window-point-insertion-type"); - DEFVAR_LISP ("window-configuration-change-hook", - Vwindow_configuration_change_hook, - doc: /* Functions to call when window configuration changes. -The buffer-local value is run once per window, with the relevant window -selected; while the global value is run only once for the modified frame, -with the relevant frame selected. */); - Vwindow_configuration_change_hook = Qnil; + DEFVAR_LISP ("window-buffer-change-functions", Vwindow_buffer_change_functions, + doc: /* Functions called during redisplay when window buffers have changed. +The value should be a list of functions that take one argument. + +Functions specified buffer-locally are called for each window showing +the corresponding buffer if and only if that window has been added or +changed its buffer since the last redisplay. In this case the window +is passed as argument. + +Functions specified by the default value are called for each frame if +at least one window on that frame has been added, deleted or changed +its buffer since the last redisplay. In this case the frame is passed +as argument. */); + Vwindow_buffer_change_functions = Qnil; DEFVAR_LISP ("window-size-change-functions", Vwindow_size_change_functions, - doc: /* Functions called during redisplay, if window sizes have changed. + doc: /* Functions called during redisplay when window sizes have changed. The value should be a list of functions that take one argument. -During the first part of redisplay, for each frame, if any of its windows -have changed size since the last redisplay, or have been split or deleted, -all the functions in the list are called, with the frame as argument. -If redisplay decides to resize the minibuffer window, it calls these -functions on behalf of that as well. */); + +Functions specified buffer-locally are called for each window showing +the corresponding buffer if and only if that window has been added or +changed its buffer or its total or body size since the last redisplay. +In this case the window is passed as argument. + +Functions specified by the default value are called for each frame if +at least one window on that frame has been added or changed its buffer +or its total or body size since the last redisplay. In this case the +frame is passed as argument. */); Vwindow_size_change_functions = Qnil; + DEFVAR_LISP ("window-selection-change-functions", Vwindow_selection_change_functions, + doc: /* Functions called during redisplay when the selected window has changed. +The value should be a list of functions that take one argument. + +Functions specified buffer-locally are called for each window showing +the corresponding buffer if and only if that window has been selected +or deselected since the last redisplay. In this case the window is +passed as argument. + +Functions specified by the default value are called for each frame if +the frame's selected window has changed since the last redisplay. In +this case the frame is passed as argument. */); + Vwindow_selection_change_functions = Qnil; + + DEFVAR_LISP ("window-configuration-change-hook", Vwindow_configuration_change_hook, + doc: /* Functions called during redisplay when window configuration has changed. +The value should be a list of functions that take no argument. + +Functions specified buffer-locally are called for each window showing +the corresponding buffer if at least one window on that frame has been +added, deleted or changed its buffer or its total or body size since +the last redisplay. Each call is performed with the window showing +the buffer temporarily selected. + +Functions specified by the default value are called for each frame if +at least one window on that frame has been added, deleted or changed +its buffer or its total or body size since the last redisplay. Each +call is performed with the frame temporarily selected. */); + Vwindow_configuration_change_hook = Qnil; + DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay, doc: /* Non-nil means `recenter' redraws entire frame. If this option is non-nil, then the `recenter' command with a nil @@ -7817,6 +8161,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */); Vfast_but_imprecise_scrolling = false; defsubr (&Sselected_window); + defsubr (&Sold_selected_window); defsubr (&Sminibuffer_window); defsubr (&Swindow_minibuffer_p); defsubr (&Swindowp); @@ -7826,10 +8171,12 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Sframe_root_window); defsubr (&Sframe_first_window); defsubr (&Sframe_selected_window); + defsubr (&Sframe_old_selected_window); defsubr (&Sset_frame_selected_window); defsubr (&Spos_visible_in_window_p); defsubr (&Swindow_line_height); defsubr (&Swindow_buffer); + defsubr (&Swindow_old_buffer); defsubr (&Swindow_parent); defsubr (&Swindow_top_child); defsubr (&Swindow_left_child); @@ -7840,8 +8187,10 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Swindow_use_time); defsubr (&Swindow_pixel_width); defsubr (&Swindow_pixel_height); - defsubr (&Swindow_pixel_width_before_size_change); - defsubr (&Swindow_pixel_height_before_size_change); + defsubr (&Swindow_old_pixel_width); + defsubr (&Swindow_old_pixel_height); + defsubr (&Swindow_old_body_pixel_width); + defsubr (&Swindow_old_body_pixel_height); defsubr (&Swindow_total_width); defsubr (&Swindow_total_height); defsubr (&Swindow_normal_size); diff --git a/src/window.h b/src/window.h index ee6ec3bb19..9c4aea85ea 100644 --- a/src/window.h +++ b/src/window.h @@ -142,6 +142,11 @@ struct window as well. */ Lisp_Object contents; + /* The old buffer of this window, set to this window's buffer by + run_window_change_functions every time it sees this window. + Unused for internal windows. */ + Lisp_Object old_buffer; + /* A marker pointing to where in the text to start displaying. BIDI Note: This is the _logical-order_ start, i.e. the smallest buffer position visible in the window, not necessarily the @@ -229,6 +234,14 @@ struct window /* Unique number of window assigned when it was created. */ EMACS_INT sequence_number; + /* The change stamp of this window. Set to 0 when the window is + created, it is set to its frame's change stamp every time + run_window_change_functions is run on that frame with this + window live. It is left alone when the window exists only + within a window configuration. Not useful for internal + windows. */ + int change_stamp; + /* The upper left corner pixel coordinates of this window, as integers relative to upper left corner of frame = 0, 0. */ int pixel_left; @@ -243,10 +256,13 @@ struct window int pixel_width; int pixel_height; - /* The pixel sizes of the window at the last time - `window-size-change-functions' was run. */ - int pixel_width_before_size_change; - int pixel_height_before_size_change; + /* The pixel and pixel body sizes of the window at the last time + run_window_change_functions was run with this window live. Not + useful for internal windows. */ + int old_pixel_width; + int old_pixel_height; + int old_body_pixel_width; + int old_body_pixel_height; /* The size of the window. */ int total_cols; @@ -1023,6 +1039,7 @@ wset_next_buffers (struct window *w, Lisp_Object val) This value is always the same as FRAME_SELECTED_WINDOW (selected_frame). */ extern Lisp_Object selected_window; +extern Lisp_Object old_selected_window; /* This is a time stamp for window selection, so we can find the least recently used window. Its only users are Fselect_window, @@ -1051,7 +1068,7 @@ extern void grow_mini_window (struct window *, int, bool); extern void shrink_mini_window (struct window *, bool); extern int window_relative_x_coord (struct window *, enum window_part, int); -void run_window_size_change_functions (Lisp_Object); +void run_window_change_functions (void); /* Make WINDOW display BUFFER. RUN_HOOKS_P means it's allowed to run hooks. See make_frame for a case where it's not allowed. */ diff --git a/src/xdisp.c b/src/xdisp.c index 7725570ced..86495078fb 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2786,6 +2786,7 @@ init_iterator (struct it *it, struct window *w, struct glyph_row *row, enum face_id base_face_id) { enum face_id remapped_base_face_id = base_face_id; + int body_width = 0, body_height = 0; /* Some precondition checks. */ eassert (w != NULL && it != NULL); @@ -2962,7 +2963,7 @@ init_iterator (struct it *it, struct window *w, { /* Mode lines, menu bar in terminal frames. */ it->first_visible_x = 0; - it->last_visible_x = WINDOW_PIXEL_WIDTH (w); + it->last_visible_x = body_width = WINDOW_PIXEL_WIDTH (w); } else { @@ -2982,8 +2983,12 @@ init_iterator (struct it *it, struct window *w, else it->first_visible_x = window_hscroll_limited (w, it->f) * FRAME_COLUMN_WIDTH (it->f); - it->last_visible_x = (it->first_visible_x - + window_box_width (w, TEXT_AREA)); + + body_width = window_box_width (w, TEXT_AREA); + if (!w->pseudo_window_p && !MINI_WINDOW_P (w) + && body_width != w->old_body_pixel_width) + FRAME_WINDOW_CHANGE (it->f) = true; + it->last_visible_x = it->first_visible_x + body_width; /* If we truncate lines, leave room for the truncation glyph(s) at the right margin. Otherwise, leave room for the continuation @@ -2997,7 +3002,8 @@ init_iterator (struct it *it, struct window *w, } it->header_line_p = window_wants_header_line (w); - it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll; + body_height = WINDOW_HEADER_LINE_HEIGHT (w); + it->current_y = body_height + w->vscroll; } /* Leave room for a border glyph. */ @@ -3006,6 +3012,10 @@ init_iterator (struct it *it, struct window *w, it->last_visible_x -= 1; it->last_visible_y = window_text_bottom_y (w); + body_height += it->last_visible_y; + if (!w->pseudo_window_p && !MINI_WINDOW_P (w) + && body_height != w->old_body_pixel_height) + FRAME_WINDOW_CHANGE (it->f) = true; /* For mode lines and alike, arrange for the first glyph having a left box line if the face specifies a box. */ @@ -12200,8 +12210,6 @@ prepare_menu_bars (void) && !XBUFFER (w->contents)->text->redisplay) continue; - run_window_size_change_functions (frame); - if (FRAME_PARENT_FRAME (f)) continue; @@ -14119,20 +14127,6 @@ redisplay_internal (void) { echo_area_display (false); - /* If echo_area_display resizes the mini-window, the redisplay and - window_sizes_changed flags of the selected frame are set, but - it's too late for the hooks in window-size-change-functions, - which have been examined already in prepare_menu_bars. So in - that case we call the hooks here only for the selected frame. */ - if (sf->redisplay) - { - ptrdiff_t count1 = SPECPDL_INDEX (); - - record_unwind_save_match_data (); - run_window_size_change_functions (selected_frame); - unbind_to (count1, Qnil); - } - if (message_cleared_p) update_miniwindow_p = true; @@ -14149,15 +14143,6 @@ redisplay_internal (void) && (current_buffer->clip_changed || window_outdated (w)) && resize_mini_window (w, false)) { - if (sf->redisplay) - { - ptrdiff_t count1 = SPECPDL_INDEX (); - - record_unwind_save_match_data (); - run_window_size_change_functions (selected_frame); - unbind_to (count1, Qnil); - } - /* Resized active mini-window to fit the size of what it is showing if its contents might have changed. */ must_finish = true; @@ -14347,7 +14332,19 @@ redisplay_internal (void) && (w = XWINDOW (selected_window)) != sw) goto retry; - /* We used to always goto end_of_redisplay here, but this + if (!NILP (Vrun_hooks)) + { + run_window_change_functions (); + + /* If windows or buffers changed or selected_window + changed, redisplay again. */ + if ((windows_or_buffers_changed) + || (WINDOWP (selected_window) + && (w = XWINDOW (selected_window)) != sw)) + goto retry; + } + + /* We used to always goto end_of_redisplay here, but this isn't enough if we have a blinking cursor. */ if (w->cursor_off_p == w->last_cursor_off_p) goto end_of_redisplay; @@ -14706,9 +14703,22 @@ redisplay_internal (void) /* If we just did a pending size change, or have additional visible frames, or selected_window changed, redisplay again. */ if ((windows_or_buffers_changed && !pending) - || (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw)) + || (WINDOWP (selected_window) + && (w = XWINDOW (selected_window)) != sw)) goto retry; + if (!NILP (Vrun_hooks)) + { + run_window_change_functions (); + + /* If windows or buffers changed or selected_window changed, + redisplay again. */ + if ((windows_or_buffers_changed) + || (WINDOWP (selected_window) + && (w = XWINDOW (selected_window)) != sw)) + goto retry; + } + /* Clear the face and image caches. We used to do this only if consider_all_windows_p. But the cache commit 470082de55f7b1c1cde8aabbb5b8de55b4b08f83 Author: Paul Eggert Date: Thu Jan 10 21:35:31 2019 -0800 List lengths are always fixnums now Without this patch, it was theoretically possible for a list length to be a bignum, which means that safe-length could signal an error (due to generating a too-large bignum) contrary to its documentation. Fix things to remove the theoretical possibility, so that list lengths are always fixnums (and so that list lenghts are always ptrdiff_t values too, since that is assumed internally anyway). * src/alloc.c (Fcons): Do not allocate so many conses that a list length won’t fit into ptrdiff_t or into fixnum. This matters only on weird platforms; on typical platforms, list lengths always fit anyway. * src/fns.c (list_length, Fsafe_length, proper-list-p): Remove integer overflow checks that are no longer needed. diff --git a/src/alloc.c b/src/alloc.c index 407ac72541..31e8da7016 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2774,6 +2774,19 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, { if (cons_block_index == CONS_BLOCK_SIZE) { + /* Maximum number of conses that should be active at any + given time, so that list lengths fit into a ptrdiff_t and + into a fixnum. */ + ptrdiff_t max_conses = min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM); + + /* This check is typically optimized away, as a runtime + check is needed only on weird platforms where a count of + distinct conses might not fit. */ + if (max_conses < INTPTR_MAX / sizeof (struct Lisp_Cons) + && (max_conses - CONS_BLOCK_SIZE + < total_free_conses + total_conses)) + memory_full (sizeof (struct cons_block)); + struct cons_block *new = lisp_align_malloc (sizeof *new, MEM_TYPE_CONS); memset (new->gcmarkbits, 0, sizeof new->gcmarkbits); diff --git a/src/fns.c b/src/fns.c index 0fad6f4744..6fcb38e4b0 100644 --- a/src/fns.c +++ b/src/fns.c @@ -101,9 +101,7 @@ list_length (Lisp_Object list) FOR_EACH_TAIL (list) i++; CHECK_LIST_END (list, list); - if (i <= min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM)) - return i; - overflow_error (); + return i; } @@ -141,14 +139,13 @@ DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, doc: /* Return the length of a list, but avoid error or infinite loop. This function never gets an error. If LIST is not really a list, it returns 0. If LIST is circular, it returns an integer that is at -least the number of distinct elements. -Value is a fixnum, if it's small enough, otherwise a bignum. */) +least the number of distinct elements. */) (Lisp_Object list) { intptr_t len = 0; FOR_EACH_TAIL_SAFE (list) len++; - return INT_TO_INTEGER (len); + return make_fixnum (len); } DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0, @@ -168,8 +165,6 @@ A proper list is neither circular nor dotted (i.e., its last cdr is nil). */ } if (!NILP (last_tail)) return Qnil; - if (MOST_POSITIVE_FIXNUM < len) - overflow_error (); return make_fixnum (len); } commit 9609db9d98babfe8782a03aebe46176e57905c63 Author: Paul Eggert Date: Thu Jan 10 15:29:21 2019 -0800 Minor tweaks to HAVE_NATIVE_SCALING code This mostly just reindents. * src/image.c (x_set_image_size): Always define, but to a no-op if !HAVE_NATIVE_SCALING, to avoid an #ifdef elsewhere. (x_create_x_image_and_pixmap): Move decl to avoid an #ifdef. (image_create_x_image_and_pixmap): Move #ifdef outside of call. * src/xterm.c (x_composite_image): Avoid ‘else #endif’. diff --git a/src/dispextern.h b/src/dispextern.h index b064875ac4..9cea3218c1 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -32,7 +32,7 @@ along with GNU Emacs. If not, see . */ #endif /* USE_X_TOOLKIT */ #ifdef HAVE_XRENDER -#include +# include #endif #else /* !HAVE_X_WINDOWS */ @@ -2938,10 +2938,9 @@ struct redisplay_interface #ifdef HAVE_WINDOW_SYSTEM -#if defined (HAVE_X_WINDOWS) && defined (HAVE_XRENDER) \ - || defined (HAVE_NS) -#define HAVE_NATIVE_SCALING -#endif +# if defined HAVE_XRENDER || defined HAVE_NS +# define HAVE_NATIVE_SCALING +# endif /* Structure describing an image. Specific image formats like XBM are converted into this form, so that display only has to deal with @@ -2967,10 +2966,10 @@ struct image synchronized to Pixmap. */ XImagePtr ximg, mask_img; -#ifdef HAVE_NATIVE_SCALING +# ifdef HAVE_NATIVE_SCALING /* Picture versions of pixmap and mask for compositing. */ Picture picture, mask_picture; -#endif +# endif #endif /* Colors allocated for this image, if any. Allocated via xmalloc. */ diff --git a/src/image.c b/src/image.c index 84c31dcfc3..2fae105815 100644 --- a/src/image.c +++ b/src/image.c @@ -1859,47 +1859,48 @@ compute_image_size (size_t width, size_t height, *d_width = desired_width; *d_height = desired_height; } +#endif /* HAVE_IMAGEMAGICK || HAVE_NATIVE_SCALING */ -#ifdef HAVE_NATIVE_SCALING static void x_set_image_size (struct frame *f, struct image *img) { -#ifdef HAVE_IMAGEMAGICK +#ifdef HAVE_NATIVE_SCALING +# ifdef HAVE_IMAGEMAGICK /* ImageMagick images are already the correct size. */ - if (!EQ (image_spec_value (img->spec, QCtype, NULL), Qimagemagick)) -#endif - { - int width, height; + if (EQ (image_spec_value (img->spec, QCtype, NULL), Qimagemagick)) + return; +# endif - compute_image_size (img->width, img->height, img->spec, &width, &height); + int width, height; + compute_image_size (img->width, img->height, img->spec, &width, &height); -#ifdef HAVE_NS - ns_image_set_size (img->pixmap, width, height); - img->width = width; - img->height = height; -#endif +# ifdef HAVE_NS + ns_image_set_size (img->pixmap, width, height); + img->width = width; + img->height = height; +# endif -#ifdef HAVE_XRENDER - if (img->picture) - { - double xscale = (double) img->width/width; - double yscale = (double) img->height/height; +# ifdef HAVE_XRENDER + if (img->picture) + { + double xscale = img->width / (double) width; + double yscale = img->height / (double) height; - XTransform tmat = {{{XDoubleToFixed (xscale), XDoubleToFixed (0), XDoubleToFixed (0)}, - {XDoubleToFixed (0), XDoubleToFixed (yscale), XDoubleToFixed (0)}, - {XDoubleToFixed (0), XDoubleToFixed (0), XDoubleToFixed (1)}}}; + XTransform tmat + = {{{XDoubleToFixed (xscale), XDoubleToFixed (0), XDoubleToFixed (0)}, + {XDoubleToFixed (0), XDoubleToFixed (yscale), XDoubleToFixed (0)}, + {XDoubleToFixed (0), XDoubleToFixed (0), XDoubleToFixed (1)}}}; - XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture, FilterBest, 0, 0); - XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat); + XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture, FilterBest, + 0, 0); + XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat); - img->width = width; - img->height = height; - } -#endif + img->width = width; + img->height = height; } -} +# endif #endif -#endif /* HAVE_IMAGEMAGICK || HAVE_XRENDER || HAVE_NS */ +} /* Return the id of image with Lisp specification SPEC on frame F. @@ -1956,9 +1957,7 @@ lookup_image (struct frame *f, Lisp_Object spec) `:background COLOR'. */ Lisp_Object ascent, margin, relief, bg; int relief_bound; -#ifdef HAVE_NATIVE_SCALING x_set_image_size (f, img); -#endif ascent = image_spec_value (spec, QCascent, NULL); if (FIXNUMP (ascent)) @@ -2139,9 +2138,6 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, Display *display = FRAME_X_DISPLAY (f); Drawable drawable = FRAME_X_DRAWABLE (f); Screen *screen = FRAME_X_SCREEN (f); -#ifdef HAVE_XRENDER - int event_basep, error_basep; -#endif eassert (input_blocked_p ()); @@ -2178,7 +2174,8 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, return 0; } -#ifdef HAVE_XRENDER +# ifdef HAVE_XRENDER + int event_basep, error_basep; if (picture && XRenderQueryExtension (display, &event_basep, &error_basep)) { XRenderPictFormat *format; @@ -2191,7 +2188,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, : PictStandardA8); *picture = XRenderCreatePicture (display, *pixmap, format, 0, &attr); } -#endif +# endif return 1; #endif /* HAVE_X_WINDOWS */ @@ -2367,14 +2364,13 @@ image_create_x_image_and_pixmap (struct frame *f, struct image *img, { eassert ((!mask_p ? img->pixmap : img->mask) == NO_PIXMAP); - return x_create_x_image_and_pixmap (f, width, height, depth, ximg, - !mask_p ? &img->pixmap : &img->mask, + Picture *picture = NULL; #ifdef HAVE_XRENDER - !mask_p ? &img->picture : &img->mask_picture -#else - NULL + picture = !mask_p ? &img->picture : &img->mask_picture; #endif - ); + return x_create_x_image_and_pixmap (f, width, height, depth, ximg, + !mask_p ? &img->pixmap : &img->mask, + picture); } /* Put X image XIMG into image IMG on frame F, as a mask if and only diff --git a/src/xterm.c b/src/xterm.c index fbbf61d320..632703849f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3001,13 +3001,14 @@ x_composite_image (struct glyph_string *s, Pixmap dest, width, height); XRenderFreePicture (s->display, destination); + return; } - else #endif - XCopyArea (s->display, s->img->pixmap, - dest, s->gc, - srcX, srcY, - width, height, dstX, dstY); + + XCopyArea (s->display, s->img->pixmap, + dest, s->gc, + srcX, srcY, + width, height, dstX, dstY); } @@ -3060,7 +3061,8 @@ x_draw_image_foreground (struct glyph_string *s) image_rect.width = s->slice.width; image_rect.height = s->slice.height; if (x_intersect_rectangles (&clip_rect, &image_rect, &r)) - x_composite_image (s, FRAME_X_DRAWABLE (s->f), s->slice.x + r.x - x, s->slice.y + r.y - y, + x_composite_image (s, FRAME_X_DRAWABLE (s->f), + s->slice.x + r.x - x, s->slice.y + r.y - y, r.x, r.y, r.width, r.height); } else commit a1b7a3f2a3957a399d6c3c7bcffa07ac67da82fc Author: Alan Third Date: Wed Jan 2 21:00:09 2019 +0000 Add native image scaling (bug#33587) * configure.ac: Test for XRender outside of xft checks. * src/Makefile.in (XRENDER_LIBS): List XRender libs separately from xft libs. * lisp/image.el (image--get-imagemagick-and-warn): Allow resizing if native scaling is available. * src/dispextern.h: Add XRender and image scaling stuff. (struct image): Add XRender Pictures. * src/image.c (x_create_bitmap_mask): (image_create_x_image_and_pixmap): Handle XRender Picture. (scale_image_size): (compute_image_size): Make available when any form of scaling is enabled. (x_set_image_size): New function. (lookup_image): Set image size. (x_create_x_image_and_pixmap): Create XRender Picture when necessary. (x_put_x_image): Handle the case where desired size != actual size. (free_image): Free XRender Pictures. (Fimage_scaling_p): New function. (syms_of_image): Add image-scaling-p. * src/nsimage.m (ns_load_image): Remove NS specific resizing. ([EmacsImage setSizeFromSpec:]): Remove method. (ns_image_set_size): New function. * src/nsterm.m (ns_draw_fringe_bitmap): Cocoa and GNUstep both have the same compositing functions, so remove unnecessary difference. * src/xterm.c (x_composite_image): New function. (x_draw_image_foreground): Use new x_composite_image function. * doc/lispref/display.texi (Image Descriptors): Document image-scaling-p and add resizing descriptors. (ImageMagick Images): Remove resizing descriptors. diff --git a/configure.ac b/configure.ac index e5bd6943ca..16a2ce059d 100644 --- a/configure.ac +++ b/configure.ac @@ -3241,6 +3241,17 @@ either XPointer or XPointer*.])dnl CFLAGS=$late_CFLAGS fi +# Check for XRender +HAVE_XRENDER=no +if test "${HAVE_X11}" = "yes"; then + AC_CHECK_LIB(Xrender, XRenderQueryExtension, HAVE_XRENDER=yes) + if test $HAVE_XRENDER = yes; then + XRENDER_LIBS="-lXrender" + AC_SUBST(XRENDER_LIBS) + AC_DEFINE([HAVE_XRENDER], 1, [Define to 1 if XRender is available.]) + fi +fi + ### Start of font-backend (under any platform) section. # (nothing here yet -- this is a placeholder) ### End of font-backend (under any platform) section. @@ -3263,15 +3274,12 @@ if test "${HAVE_X11}" = "yes"; then EMACS_CHECK_MODULES([XFT], [xft >= 0.13.0], [], [HAVE_XFT=no]) ## Because xterm.c uses XRenderQueryExtension when XFT is ## enabled, we also need to link to -lXrender. - HAVE_XRENDER=no - AC_CHECK_LIB(Xrender, XRenderQueryExtension, HAVE_XRENDER=yes) if test "$HAVE_XFT" != no && test "$HAVE_XRENDER" != no; then OLD_CPPFLAGS="$CPPFLAGS" OLD_CFLAGS="$CFLAGS" OLD_LIBS="$LIBS" CPPFLAGS="$CPPFLAGS $XFT_CFLAGS" CFLAGS="$CFLAGS $XFT_CFLAGS" - XFT_LIBS="-lXrender $XFT_LIBS" LIBS="$XFT_LIBS $LIBS" AC_CHECK_HEADER(X11/Xft/Xft.h, AC_CHECK_LIB(Xft, XftFontOpen, HAVE_XFT=yes, , $XFT_LIBS) , , diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 19424ecc7e..350b310871 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5112,6 +5112,47 @@ This adds a shadow rectangle around the image. The value, @var{relief} is negative, shadows are drawn so that the image appears as a pressed button; otherwise, it appears as an unpressed button. +@item :width @var{width}, :height @var{height} +The @code{:width} and @code{:height} keywords are used for scaling the +image. If only one of them is specified, the other one will be +calculated so as to preserve the aspect ratio. If both are specified, +aspect ratio may not be preserved. + +@item :max-width @var{max-width}, :max-height @var{max-height} +The @code{:max-width} and @code{:max-height} keywords are used for +scaling if the size of the image exceeds these values. If +@code{:width} is set, it will have precedence over @code{max-width}, +and if @code{:height} is set, it will have precedence over +@code{max-height}, but you can otherwise mix these keywords as you +wish. + +If both @code{:max-width} and @code{:height} are specified, but +@code{:width} is not, preserving the aspect ratio might require that +width exceeds @code{:max-width}. If this happens, scaling will use a +smaller value for the height so as to preserve the aspect ratio while +not exceeding @code{:max-width}. Similarly when both +@code{:max-height} and @code{:width} are specified, but @code{:height} +is not. For example, if you have a 200x100 image and specify that +@code{:width} should be 400 and @code{:max-height} should be 150, +you'll end up with an image that is 300x150: Preserving the aspect +ratio and not exceeding the ``max'' setting. This combination of +parameters is a useful way of saying ``display this image as large as +possible, but no larger than the available display area''. + +@item :scale @var{scale} +This should be a number, where values higher than 1 means to increase +the size, and lower means to decrease the size, by multiplying both +the width and height. For instance, a value of 0.25 will make the +image a quarter size of what it originally was. If the scaling makes +the image larger than specified by @code{:max-width} or +@code{:max-height}, the resulting size will not exceed those two +values. If both @code{:scale} and @code{:height}/@code{:width} are +specified, the height/width will be adjusted by the specified scaling +factor. + +@item :index @var{frame} +@xref{Multi-Frame Images}. + @item :conversion @var{algorithm} This specifies a conversion algorithm that should be applied to the image before it is displayed; the value, @var{algorithm}, specifies @@ -5251,6 +5292,16 @@ This function returns @code{t} if image @var{spec} has a mask bitmap. (@pxref{Input Focus}). @end defun +@defun image-scaling-p &optional frame +This function returns @code{t} if @var{frame} supports image scaling. +@var{frame} @code{nil} or omitted means to use the selected frame +(@pxref{Input Focus}). + +If image scaling is not supported, @code{:width}, @code{:height}, +@code{:scale}, @code{:max-width} and @code{:max-height} will only be +usable through ImageMagick, if available (@pxref{ImageMagick Images}). +@end defun + @node XBM Images @subsection XBM Images @cindex XBM @@ -5387,42 +5438,6 @@ color, which is used as the image's background color if the image supports transparency. If the value is @code{nil}, it defaults to the frame's background color. -@item :width @var{width}, :height @var{height} -The @code{:width} and @code{:height} keywords are used for scaling the -image. If only one of them is specified, the other one will be -calculated so as to preserve the aspect ratio. If both are specified, -aspect ratio may not be preserved. - -@item :max-width @var{max-width}, :max-height @var{max-height} -The @code{:max-width} and @code{:max-height} keywords are used for -scaling if the size of the image of the image exceeds these values. -If @code{:width} is set it will have precedence over @code{max-width}, -and if @code{:height} is set it will have precedence over -@code{max-height}, but you can otherwise mix these keywords as you -wish. @code{:max-width} and @code{:max-height} will always preserve -the aspect ratio. - -If both @code{:width} and @code{:max-height} has been set (but -@code{:height} has not been set), then @code{:max-height} will have -precedence. The same is the case for the opposite combination: The -``max'' keyword has precedence. That is, if you have a 200x100 image -and specify that @code{:width} should be 400 and @code{:max-height} -should be 150, you'll end up with an image that is 300x150: Preserving -the aspect ratio and not exceeding the ``max'' setting. This -combination of parameters is a useful way of saying ``display this -image as large as possible, but no larger than the available display -area''. - -@item :scale @var{scale} -This should be a number, where values higher than 1 means to increase -the size, and lower means to decrease the size. For instance, a value -of 0.25 will make the image a quarter size of what it originally was. -If the scaling makes the image larger than specified by -@code{:max-width} or @code{:max-height}, the resulting size will not -exceed those two values. If both @code{:scale} and -@code{:height}/@code{:width} are specified, the height/width will be -adjusted by the specified scaling factor. - @item :format @var{type} The value, @var{type}, should be a symbol specifying the type of the image data, as found in @code{image-format-suffixes}. This is used @@ -5431,9 +5446,6 @@ hint to ImageMagick to help it detect the image type. @item :rotation @var{angle} Specifies a rotation angle in degrees. - -@item :index @var{frame} -@xref{Multi-Frame Images}. @end table @node SVG Images diff --git a/etc/NEWS b/etc/NEWS index a3aa5a2938..a96ec781b4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1461,6 +1461,12 @@ that is non-nil, it will look for a file name handler for the current buffer's 'default-directory' and invoke that file name handler to make the process. That way 'make-process' can start remote processes. ++++ +** Emacs now supports resizing images without ImageMagick on X window +systems where the XRender extension is available, and on the NS port. +The new function 'image-scaling-p' can be used to test whether any +given frame supports resizing. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/lisp/image.el b/lisp/image.el index 5727d8fbce..2e84e47b5c 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -982,8 +982,8 @@ default is 20%." image)) (defun image--get-imagemagick-and-warn () - (unless (or (fboundp 'imagemagick-types) (featurep 'ns)) - (error "Cannot rescale images without ImageMagick support")) + (unless (or (fboundp 'imagemagick-types) (image-scaling-p)) + (error "Cannot rescale images on this terminal")) (let ((image (image--get-image))) (image-flush image) (when (fboundp 'imagemagick-types) diff --git a/src/Makefile.in b/src/Makefile.in index e9831e9299..f409ed4db2 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -127,7 +127,8 @@ LIBIMAGE=@LIBTIFF@ @LIBJPEG@ @LIBPNG@ @LIBGIF@ @LIBXPM@ XCB_LIBS=@XCB_LIBS@ XFT_LIBS=@XFT_LIBS@ -LIBX_EXTRA=-lX11 $(XCB_LIBS) $(XFT_LIBS) +XRENDER_LIBS=@XRENDER_LIBS@ +LIBX_EXTRA=-lX11 $(XCB_LIBS) $(XFT_LIBS) $(XRENDER_LIBS) FONTCONFIG_CFLAGS = @FONTCONFIG_CFLAGS@ FONTCONFIG_LIBS = @FONTCONFIG_LIBS@ diff --git a/src/dispextern.h b/src/dispextern.h index 5774e3e951..b064875ac4 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -31,6 +31,9 @@ along with GNU Emacs. If not, see . */ #include #endif /* USE_X_TOOLKIT */ +#ifdef HAVE_XRENDER +#include +#endif #else /* !HAVE_X_WINDOWS */ /* X-related stuff used by non-X gui code. */ @@ -2935,6 +2938,11 @@ struct redisplay_interface #ifdef HAVE_WINDOW_SYSTEM +#if defined (HAVE_X_WINDOWS) && defined (HAVE_XRENDER) \ + || defined (HAVE_NS) +#define HAVE_NATIVE_SCALING +#endif + /* Structure describing an image. Specific image formats like XBM are converted into this form, so that display only has to deal with this type of image. */ @@ -2958,6 +2966,11 @@ struct image and the latter is outdated. NULL means the X image has been synchronized to Pixmap. */ XImagePtr ximg, mask_img; + +#ifdef HAVE_NATIVE_SCALING + /* Picture versions of pixmap and mask for compositing. */ + Picture picture, mask_picture; +#endif #endif /* Colors allocated for this image, if any. Allocated via xmalloc. */ diff --git a/src/image.c b/src/image.c index 87e0c071ee..84c31dcfc3 100644 --- a/src/image.c +++ b/src/image.c @@ -408,8 +408,13 @@ x_destroy_all_bitmaps (Display_Info *dpyinfo) dpyinfo->bitmaps_last = 0; } +#ifndef HAVE_XRENDER +/* Required for the definition of x_create_x_image_and_pixmap below. */ +typedef void Picture; +#endif + static bool x_create_x_image_and_pixmap (struct frame *, int, int, int, - XImagePtr *, Pixmap *); + XImagePtr *, Pixmap *, Picture *); static void x_destroy_x_image (XImagePtr ximg); #ifdef HAVE_NTGUI @@ -472,7 +477,8 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id) return; } - result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask); + result = x_create_x_image_and_pixmap (f, width, height, 1, + &mask_img, &mask, NULL); unblock_input (); if (!result) @@ -1011,6 +1017,13 @@ free_image (struct frame *f, struct image *img) c->images[img->id] = NULL; +#ifdef HAVE_XRENDER + if (img->picture) + XRenderFreePicture (FRAME_X_DISPLAY (f), img->picture); + if (img->mask_picture) + XRenderFreePicture (FRAME_X_DISPLAY (f), img->mask_picture); +#endif + /* Windows NT redefines 'free', but in this file, we need to avoid the redefinition. */ #ifdef WINDOWSNT @@ -1747,6 +1760,147 @@ postprocess_image (struct frame *f, struct image *img) } } +#if defined (HAVE_IMAGEMAGICK) || defined (HAVE_NATIVE_SCALING) +/* Scale an image size by returning SIZE / DIVISOR * MULTIPLIER, + safely rounded and clipped to int range. */ + +static int +scale_image_size (int size, size_t divisor, size_t multiplier) +{ + if (divisor != 0) + { + double s = size; + double scaled = s * multiplier / divisor + 0.5; + if (scaled < INT_MAX) + return scaled; + } + return INT_MAX; +} + +/* Compute the desired size of an image with native size WIDTH x HEIGHT. + Use SPEC to deduce the size. Store the desired size into + *D_WIDTH x *D_HEIGHT. Store -1 x -1 if the native size is OK. */ +static void +compute_image_size (size_t width, size_t height, + Lisp_Object spec, + int *d_width, int *d_height) +{ + Lisp_Object value; + int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1; + double scale = 1; + + value = image_spec_value (spec, QCscale, NULL); + if (NUMBERP (value)) + scale = XFLOATINT (value); + + value = image_spec_value (spec, QCmax_width, NULL); + if (FIXNATP (value)) + max_width = min (XFIXNAT (value), INT_MAX); + + value = image_spec_value (spec, QCmax_height, NULL); + if (FIXNATP (value)) + max_height = min (XFIXNAT (value), INT_MAX); + + /* If width and/or height is set in the display spec assume we want + to scale to those values. If either h or w is unspecified, the + unspecified should be calculated from the specified to preserve + aspect ratio. */ + value = image_spec_value (spec, QCwidth, NULL); + if (FIXNATP (value)) + { + desired_width = min (XFIXNAT (value) * scale, INT_MAX); + /* :width overrides :max-width. */ + max_width = -1; + } + + value = image_spec_value (spec, QCheight, NULL); + if (FIXNATP (value)) + { + desired_height = min (XFIXNAT (value) * scale, INT_MAX); + /* :height overrides :max-height. */ + max_height = -1; + } + + /* If we have both width/height set explicitly, we skip past all the + aspect ratio-preserving computations below. */ + if (desired_width != -1 && desired_height != -1) + goto out; + + width = width * scale; + height = height * scale; + + if (desired_width != -1) + /* Width known, calculate height. */ + desired_height = scale_image_size (desired_width, width, height); + else if (desired_height != -1) + /* Height known, calculate width. */ + desired_width = scale_image_size (desired_height, height, width); + else + { + desired_width = width; + desired_height = height; + } + + if (max_width != -1 && desired_width > max_width) + { + /* The image is wider than :max-width. */ + desired_width = max_width; + desired_height = scale_image_size (desired_width, width, height); + } + + if (max_height != -1 && desired_height > max_height) + { + /* The image is higher than :max-height. */ + desired_height = max_height; + desired_width = scale_image_size (desired_height, height, width); + } + + out: + *d_width = desired_width; + *d_height = desired_height; +} + +#ifdef HAVE_NATIVE_SCALING +static void +x_set_image_size (struct frame *f, struct image *img) +{ +#ifdef HAVE_IMAGEMAGICK + /* ImageMagick images are already the correct size. */ + if (!EQ (image_spec_value (img->spec, QCtype, NULL), Qimagemagick)) +#endif + { + int width, height; + + compute_image_size (img->width, img->height, img->spec, &width, &height); + +#ifdef HAVE_NS + ns_image_set_size (img->pixmap, width, height); + img->width = width; + img->height = height; +#endif + +#ifdef HAVE_XRENDER + if (img->picture) + { + double xscale = (double) img->width/width; + double yscale = (double) img->height/height; + + XTransform tmat = {{{XDoubleToFixed (xscale), XDoubleToFixed (0), XDoubleToFixed (0)}, + {XDoubleToFixed (0), XDoubleToFixed (yscale), XDoubleToFixed (0)}, + {XDoubleToFixed (0), XDoubleToFixed (0), XDoubleToFixed (1)}}}; + + XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture, FilterBest, 0, 0); + XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat); + + img->width = width; + img->height = height; + } +#endif + } +} +#endif +#endif /* HAVE_IMAGEMAGICK || HAVE_XRENDER || HAVE_NS */ + /* Return the id of image with Lisp specification SPEC on frame F. SPEC must be a valid Lisp image specification (see valid_image_p). */ @@ -1802,6 +1956,9 @@ lookup_image (struct frame *f, Lisp_Object spec) `:background COLOR'. */ Lisp_Object ascent, margin, relief, bg; int relief_bound; +#ifdef HAVE_NATIVE_SCALING + x_set_image_size (f, img); +#endif ascent = image_spec_value (spec, QCascent, NULL); if (FIXNUMP (ascent)) @@ -1976,12 +2133,15 @@ x_check_image_size (XImagePtr ximg, int width, int height) static bool x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, - XImagePtr *ximg, Pixmap *pixmap) + XImagePtr *ximg, Pixmap *pixmap, Picture *picture) { #ifdef HAVE_X_WINDOWS Display *display = FRAME_X_DISPLAY (f); Drawable drawable = FRAME_X_DRAWABLE (f); Screen *screen = FRAME_X_SCREEN (f); +#ifdef HAVE_XRENDER + int event_basep, error_basep; +#endif eassert (input_blocked_p ()); @@ -2018,6 +2178,21 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, return 0; } +#ifdef HAVE_XRENDER + if (picture && XRenderQueryExtension (display, &event_basep, &error_basep)) + { + XRenderPictFormat *format; + XRenderPictureAttributes attr; + + /* FIXME: Do we need to handle all possible bit depths? */ + format = XRenderFindStandardFormat (display, + depth > 24 ? PictStandardARGB32 + : depth > 8 ? PictStandardRGB24 + : PictStandardA8); + *picture = XRenderCreatePicture (display, *pixmap, format, 0, &attr); + } +#endif + return 1; #endif /* HAVE_X_WINDOWS */ @@ -2163,7 +2338,8 @@ x_put_x_image (struct frame *f, XImagePtr ximg, Pixmap pixmap, int width, int he eassert (input_blocked_p ()); gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL); - XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height); + XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, + ximg->width, ximg->height); XFreeGC (FRAME_X_DISPLAY (f), gc); #endif /* HAVE_X_WINDOWS */ @@ -2192,7 +2368,13 @@ image_create_x_image_and_pixmap (struct frame *f, struct image *img, eassert ((!mask_p ? img->pixmap : img->mask) == NO_PIXMAP); return x_create_x_image_and_pixmap (f, width, height, depth, ximg, - !mask_p ? &img->pixmap : &img->mask); + !mask_p ? &img->pixmap : &img->mask, +#ifdef HAVE_XRENDER + !mask_p ? &img->picture : &img->mask_picture +#else + NULL +#endif + ); } /* Put X image XIMG into image IMG on frame F, as a mask if and only @@ -8101,105 +8283,6 @@ gif_load (struct frame *f, struct image *img) ImageMagick ***********************************************************************/ -/* Scale an image size by returning SIZE / DIVISOR * MULTIPLIER, - safely rounded and clipped to int range. */ - -static int -scale_image_size (int size, size_t divisor, size_t multiplier) -{ - if (divisor != 0) - { - double s = size; - double scaled = s * multiplier / divisor + 0.5; - if (scaled < INT_MAX) - return scaled; - } - return INT_MAX; -} - -/* Compute the desired size of an image with native size WIDTH x HEIGHT. - Use SPEC to deduce the size. Store the desired size into - *D_WIDTH x *D_HEIGHT. Store -1 x -1 if the native size is OK. */ -static void -compute_image_size (size_t width, size_t height, - Lisp_Object spec, - int *d_width, int *d_height) -{ - Lisp_Object value; - int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1; - double scale = 1; - - value = image_spec_value (spec, QCscale, NULL); - if (NUMBERP (value)) - scale = XFLOATINT (value); - - value = image_spec_value (spec, QCmax_width, NULL); - if (FIXNATP (value)) - max_width = min (XFIXNAT (value), INT_MAX); - - value = image_spec_value (spec, QCmax_height, NULL); - if (FIXNATP (value)) - max_height = min (XFIXNAT (value), INT_MAX); - - /* If width and/or height is set in the display spec assume we want - to scale to those values. If either h or w is unspecified, the - unspecified should be calculated from the specified to preserve - aspect ratio. */ - value = image_spec_value (spec, QCwidth, NULL); - if (FIXNATP (value)) - { - desired_width = min (XFIXNAT (value) * scale, INT_MAX); - /* :width overrides :max-width. */ - max_width = -1; - } - - value = image_spec_value (spec, QCheight, NULL); - if (FIXNATP (value)) - { - desired_height = min (XFIXNAT (value) * scale, INT_MAX); - /* :height overrides :max-height. */ - max_height = -1; - } - - /* If we have both width/height set explicitly, we skip past all the - aspect ratio-preserving computations below. */ - if (desired_width != -1 && desired_height != -1) - goto out; - - width = width * scale; - height = height * scale; - - if (desired_width != -1) - /* Width known, calculate height. */ - desired_height = scale_image_size (desired_width, width, height); - else if (desired_height != -1) - /* Height known, calculate width. */ - desired_width = scale_image_size (desired_height, height, width); - else - { - desired_width = width; - desired_height = height; - } - - if (max_width != -1 && desired_width > max_width) - { - /* The image is wider than :max-width. */ - desired_width = max_width; - desired_height = scale_image_size (desired_width, width, height); - } - - if (max_height != -1 && desired_height > max_height) - { - /* The image is higher than :max-height. */ - desired_height = max_height; - desired_width = scale_image_size (desired_height, height, width); - } - - out: - *d_width = desired_width; - *d_height = desired_height; -} - static bool imagemagick_image_p (Lisp_Object); static bool imagemagick_load (struct frame *, struct image *); static void imagemagick_clear_image (struct frame *, struct image *); @@ -9816,6 +9899,25 @@ DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, Initialization ***********************************************************************/ +DEFUN ("image-scaling-p", Fimage_scaling_p, Simage_scaling_p, 0, 1, 0, + doc: /* Test whether FRAME supports resizing images. +Return t if FRAME supports native scaling, nil otherwise. */) + (Lisp_Object frame) +{ +#ifdef HAVE_NS + return Qt; +#elif defined (HAVE_X_WINDOWS) && defined (HAVE_XRENDER) + int event_basep, error_basep; + + if (XRenderQueryExtension + (FRAME_X_DISPLAY (decode_window_system_frame (frame)), + &event_basep, &error_basep)) + return Qt; +#endif + + return Qnil; +} + DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 1, 1, 0, doc: /* Initialize image library implementing image type TYPE. Return non-nil if TYPE is a supported image type. @@ -10058,6 +10160,8 @@ non-numeric, there is no explicit limit on the size of images. */); defsubr (&Slookup_image); #endif + defsubr (&Simage_scaling_p); + DEFVAR_BOOL ("cross-disabled-images", cross_disabled_images, doc: /* Non-nil means always draw a cross over disabled images. Disabled images are those having a `:conversion disabled' property. diff --git a/src/nsimage.m b/src/nsimage.m index 7879c5891d..f16910de08 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -126,8 +126,6 @@ Updated by Christian Limpach (chris@nice.ch) eImg = temp; } - [eImg setSizeFromSpec:XCDR (img->spec)]; - size = [eImg size]; img->width = size.width; img->height = size.height; @@ -151,6 +149,12 @@ Updated by Christian Limpach (chris@nice.ch) return [(id)img size].height; } +void +ns_image_set_size (void *img, int width, int height) +{ + [(EmacsImage *)img setSize:NSMakeSize (width, height)]; +} + unsigned long ns_get_pixel (void *img, int x, int y) { @@ -524,66 +528,6 @@ - (BOOL)setFrame: (unsigned int) index return YES; } -- (void)setSizeFromSpec: (Lisp_Object) spec -{ - NSSize size = [self size]; - Lisp_Object value; - double scale = 1, aspect = size.width / size.height; - double width = -1, height = -1, max_width = -1, max_height = -1; - - value = Fplist_get (spec, QCscale); - if (NUMBERP (value)) - scale = XFLOATINT (value) ; - - value = Fplist_get (spec, QCmax_width); - if (NUMBERP (value)) - max_width = XFLOATINT (value); - - value = Fplist_get (spec, QCmax_height); - if (NUMBERP (value)) - max_height = XFLOATINT (value); - - value = Fplist_get (spec, QCwidth); - if (NUMBERP (value)) - { - width = XFLOATINT (value) * scale; - /* :width overrides :max-width. */ - max_width = -1; - } - - value = Fplist_get (spec, QCheight); - if (NUMBERP (value)) - { - height = XFLOATINT (value) * scale; - /* :height overrides :max-height. */ - max_height = -1; - } - - if (width <= 0 && height <= 0) - { - width = size.width * scale; - height = size.height * scale; - } - else if (width > 0 && height <= 0) - height = width / aspect; - else if (height > 0 && width <= 0) - width = height * aspect; - - if (max_width > 0 && width > max_width) - { - width = max_width; - height = max_width / aspect; - } - - if (max_height > 0 && height > max_height) - { - height = max_height; - width = max_height * aspect; - } - - [self setSize:NSMakeSize(width, height)]; -} - - (instancetype)rotate: (double)rotation { EmacsImage *new_image; diff --git a/src/nsterm.h b/src/nsterm.h index 089cbccbf0..78ce608554 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -648,7 +648,6 @@ typedef id instancetype; - (NSColor *)stippleMask; - (Lisp_Object)getMetadata; - (BOOL)setFrame: (unsigned int) index; -- (void)setSizeFromSpec: (Lisp_Object) spec; - (instancetype)rotate: (double)rotation; @end @@ -1197,6 +1196,7 @@ extern bool ns_load_image (struct frame *f, struct image *img, Lisp_Object spec_file, Lisp_Object spec_data); extern int ns_image_width (void *img); extern int ns_image_height (void *img); +extern void ns_image_set_size (void *img, int width, int height); extern unsigned long ns_get_pixel (void *img, int x, int y); extern void ns_put_pixel (void *img, int x, int y, unsigned long argb); extern void ns_set_alpha (void *img, int x, int y, unsigned char a); diff --git a/src/nsterm.m b/src/nsterm.m index 2bce4a89ae..6383e4b7ab 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3121,7 +3121,6 @@ so some key presses (TAB) are swallowed by the system. */ [img setXBMColor: bm_color]; } -#ifdef NS_IMPL_COCOA // Note: For periodic images, the full image height is "h + hd". // By using the height h, a suitable part of the image is used. NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); @@ -3134,13 +3133,6 @@ so some key presses (TAB) are swallowed by the system. */ fraction: 1.0 respectFlipped: YES hints: nil]; -#else - { - NSPoint pt = imageRect.origin; - pt.y += p->h; - [img compositeToPoint: pt operation: NSCompositingOperationSourceOver]; - } -#endif } ns_reset_clipping (f); } diff --git a/src/xterm.c b/src/xterm.c index e9cebcebba..fbbf61d320 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -38,11 +38,6 @@ along with GNU Emacs. If not, see . */ #include #endif -/* Using Xft implies that XRender is available. */ -#ifdef HAVE_XFT -#include -#endif - #ifdef HAVE_XDBE #include #endif @@ -2976,6 +2971,46 @@ x_draw_glyph_string_box (struct glyph_string *s) } +static void +x_composite_image (struct glyph_string *s, Pixmap dest, + int srcX, int srcY, int dstX, int dstY, + int width, int height) +{ +#ifdef HAVE_XRENDER + if (s->img->picture) + { + Picture destination; + XRenderPictFormat *default_format; + XRenderPictureAttributes attr; + + /* FIXME: Should we do this each time or would it make sense to + store destination in the frame struct? */ + default_format = XRenderFindVisualFormat (s->display, + DefaultVisual (s->display, 0)); + destination = XRenderCreatePicture (s->display, dest, + default_format, 0, &attr); + + /* FIXME: It may make sense to use PictOpSrc instead of + PictOpOver, as I don't know if we care about alpha values too + much here. */ + XRenderComposite (s->display, PictOpOver, + s->img->picture, s->img->mask_picture, destination, + srcX, srcY, + srcX, srcY, + dstX, dstY, + width, height); + + XRenderFreePicture (s->display, destination); + } + else +#endif + XCopyArea (s->display, s->img->pixmap, + dest, s->gc, + srcX, srcY, + width, height, dstX, dstY); +} + + /* Draw foreground of image glyph string S. */ static void @@ -3007,6 +3042,7 @@ x_draw_image_foreground (struct glyph_string *s) trust on the shape extension to be available (XShapeCombineRegion). So, compute the rectangle to draw manually. */ + /* FIXME: Do we need to do this when using XRender compositing? */ unsigned long mask = (GCClipMask | GCClipXOrigin | GCClipYOrigin | GCFunction); XGCValues xgcv; @@ -3024,10 +3060,8 @@ x_draw_image_foreground (struct glyph_string *s) image_rect.width = s->slice.width; image_rect.height = s->slice.height; if (x_intersect_rectangles (&clip_rect, &image_rect, &r)) - XCopyArea (s->display, s->img->pixmap, - FRAME_X_DRAWABLE (s->f), s->gc, - s->slice.x + r.x - x, s->slice.y + r.y - y, - r.width, r.height, r.x, r.y); + x_composite_image (s, FRAME_X_DRAWABLE (s->f), s->slice.x + r.x - x, s->slice.y + r.y - y, + r.x, r.y, r.width, r.height); } else { @@ -3039,10 +3073,8 @@ x_draw_image_foreground (struct glyph_string *s) image_rect.width = s->slice.width; image_rect.height = s->slice.height; if (x_intersect_rectangles (&clip_rect, &image_rect, &r)) - XCopyArea (s->display, s->img->pixmap, - FRAME_X_DRAWABLE (s->f), s->gc, - s->slice.x + r.x - x, s->slice.y + r.y - y, - r.width, r.height, r.x, r.y); + x_composite_image (s, FRAME_X_DRAWABLE (s->f), s->slice.x + r.x - x, s->slice.y + r.y - y, + r.x, r.y, r.width, r.height); /* When the image has a mask, we can expect that at least part of a mouse highlight or a block cursor will commit c342b26371480316024e1e5d63cd8b3f035dda69 Author: Alan Third Date: Sat Jan 5 16:11:37 2019 +0000 Fix drag and drop behaviour on NS (bug#30929) * doc/emacs/macos.texi (Mac / GNUstep Events): Describe the new drag and drop behaviour. * lisp/term/ns-win.el (ns-drag-n-drop): Handle the new event format. (ns-drag-n-drop-other-frame): (ns-drag-n-drop-as-text): (ns-drag-n-drop-as-text-other-frame): Remove functions and key bindings. * src/nsterm.m ([EmacsView performDragOperation:]): Send Emacs event in new format without setting any modifiers. diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index 6d27e97821..d9920957ad 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -170,8 +170,25 @@ the requested line (@code{ns-open-file-select-line}). This event occurs when a user drags an object from another application into an Emacs frame. The default behavior is to open a file in the window under the mouse, or to insert text at point of the window under -the mouse. It may sometimes be necessary to use the @key{Meta} key in -conjunction with dragging to force text insertion. +the mouse. + +The sending application has some limited ability to decide how Emacs +handles the sent object, but the user may override the default +behaviour by holding one or more modifier key. + +@table @kbd +@item control +Insert as text in the current buffer. If the object is a file, this +will insert the filename. +@item alt/option +Attempt to open the object as though it is a file or URL. +@item super/command +Perform the default action for the type. This can be useful when an +application is overriding the default behaviour. +@end table + +The modifier keys listed above are defined by macOS and are unaffected +by user changes to the modifiers in Emacs. @item ns-change-font This event occurs when the user selects a font in a Nextstep font diff --git a/etc/NEWS b/etc/NEWS index 3d49640ac5..a3aa5a2938 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1494,6 +1494,12 @@ versions of MS-Windows. Set this variable to 50 if for some reason you need the old behavior (and please report such situations to Emacs developers). ++++ +** On NS the behaviour of drag and drop can now be modified by use of +modifier keys in line with Apples guidelines. This makes the drag and +drop behaviour more consistent, as previously the sending application +was able to 'set' modifiers without the knowledge of the user. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index c9f5bfef52..6a668b213d 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -501,48 +501,38 @@ unless the current buffer is a scratch buffer." (find-file f))))) -(defun ns-drag-n-drop (event &optional new-frame force-text) +(defun ns-drag-n-drop (event) "Edit the files listed in the drag-n-drop EVENT. -Switch to a buffer editing the last file dropped." +Switch to a buffer editing the last file dropped, or insert the +string dropped into the current buffer." (interactive "e") (let* ((window (posn-window (event-start event))) (arg (car (cdr (cdr event)))) (type (car arg)) - (data (car (cdr arg))) - (url-or-string (cond ((eq type 'file) - (concat "file:" data)) - (t data)))) + (operations (car (cdr arg))) + (objects (cdr (cdr arg))) + (string (mapconcat 'identity objects "\n"))) (set-frame-selected-window nil window) - (when new-frame - (select-frame (make-frame))) (raise-frame) (setq window (selected-window)) - (if force-text - (dnd-insert-text window 'private data) - (dnd-handle-one-url window 'private url-or-string)))) - - -(defun ns-drag-n-drop-other-frame (event) - "Edit the files listed in the drag-n-drop EVENT, in other frames. -May create new frames, or reuse existing ones. The frame editing -the last file dropped is selected." - (interactive "e") - (ns-drag-n-drop event t)) - -(defun ns-drag-n-drop-as-text (event) - "Drop the data in EVENT as text." - (interactive "e") - (ns-drag-n-drop event nil t)) - -(defun ns-drag-n-drop-as-text-other-frame (event) - "Drop the data in EVENT as text in a new frame." - (interactive "e") - (ns-drag-n-drop event t t)) + (cond ((memq 'ns-drag-operation-generic operations) + ;; Perform the default action for the type. + (if (eq type 'file) + (dolist (data objects) + (dnd-handle-one-url window 'private (concat "file:" data))) + (dnd-insert-text window 'private string))) + ((memq 'ns-drag-operation-copy operations) + ;; Try to open the file/URL. If type is nil, try to open + ;; it as a URL anyway. + (dolist (data objects) + (dnd-handle-one-url window 'private (if (eq type 'file) + (concat "file:" data) + data)))) + (t + ;; Insert the text as is. + (dnd-insert-text window 'private string))))) (global-set-key [drag-n-drop] 'ns-drag-n-drop) -(global-set-key [C-drag-n-drop] 'ns-drag-n-drop-other-frame) -(global-set-key [M-drag-n-drop] 'ns-drag-n-drop-as-text) -(global-set-key [C-M-drag-n-drop] 'ns-drag-n-drop-as-text-other-frame) ;;;; Frame-related functions. diff --git a/src/nsterm.m b/src/nsterm.m index 016c044760..2bce4a89ae 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -8230,7 +8230,9 @@ -(BOOL)performDragOperation: (id ) sender NSEvent *theEvent = [[self window] currentEvent]; NSPoint position; NSDragOperation op = [sender draggingSourceOperationMask]; - int modifiers = 0; + Lisp_Object operations = Qnil; + Lisp_Object strings = Qnil; + Lisp_Object type_sym; NSTRACE ("[EmacsView performDragOperation:]"); @@ -8243,19 +8245,17 @@ -(BOOL)performDragOperation: (id ) sender pb = [sender draggingPasteboard]; type = [pb availableTypeFromArray: ns_drag_types]; - if (! (op & (NSDragOperationMove|NSDragOperationDelete)) && - // URL drags contain all operations (0xf), don't allow all to be set. - (op & 0xf) != 0xf) - { - if (op & NSDragOperationLink) - modifiers |= NSEventModifierFlagControl; - if (op & NSDragOperationCopy) - modifiers |= NSEventModifierFlagOption; - if (op & NSDragOperationGeneric) - modifiers |= NSEventModifierFlagCommand; - } + /* We used to convert these drag operations to keyboard modifiers, + but because they can be set by the sending program as well as the + keyboard modifiers it was difficult to work out a sensible key + mapping for drag and drop. */ + if (op & NSDragOperationLink) + operations = Fcons (Qns_drag_operation_link, operations); + if (op & NSDragOperationCopy) + operations = Fcons (Qns_drag_operation_copy, operations); + if (op & NSDragOperationGeneric || NILP (operations)) + operations = Fcons (Qns_drag_operation_generic, operations); - modifiers = EV_MODIFIERS2 (modifiers); if (type == 0) { return NO; @@ -8269,39 +8269,20 @@ -(BOOL)performDragOperation: (id ) sender if (!(files = [pb propertyListForType: type])) return NO; + type_sym = Qfile; + fenum = [files objectEnumerator]; while ( (file = [fenum nextObject]) ) - { - emacs_event->kind = DRAG_N_DROP_EVENT; - XSETINT (emacs_event->x, x); - XSETINT (emacs_event->y, y); - emacs_event->modifiers = modifiers; - emacs_event->arg = list2 (Qfile, build_string ([file UTF8String])); - EV_TRAILER (theEvent); - } - return YES; + strings = Fcons (build_string ([file UTF8String]), strings); } else if ([type isEqualToString: NSURLPboardType]) { NSURL *url = [NSURL URLFromPasteboard: pb]; if (url == nil) return NO; - emacs_event->kind = DRAG_N_DROP_EVENT; - XSETINT (emacs_event->x, x); - XSETINT (emacs_event->y, y); - emacs_event->modifiers = modifiers; - emacs_event->arg = list2 (Qurl, - build_string ([[url absoluteString] - UTF8String])); - EV_TRAILER (theEvent); + type_sym = Qurl; - if ([url isFileURL] != NO) - { - NSString *file = [url path]; - ns_input_file = append2 (ns_input_file, - build_string ([file UTF8String])); - } - return YES; + strings = Fcons (build_string ([[url absoluteString] UTF8String]), Qnil); } else if ([type isEqualToString: NSStringPboardType] || [type isEqualToString: NSTabularTextPboardType]) @@ -8311,19 +8292,27 @@ -(BOOL)performDragOperation: (id ) sender if (! (data = [pb stringForType: type])) return NO; - emacs_event->kind = DRAG_N_DROP_EVENT; - XSETINT (emacs_event->x, x); - XSETINT (emacs_event->y, y); - emacs_event->modifiers = modifiers; - emacs_event->arg = list2 (Qnil, build_string ([data UTF8String])); - EV_TRAILER (theEvent); - return YES; + type_sym = Qnil; + + strings = Fcons (build_string ([data UTF8String]), Qnil); } else { fprintf (stderr, "Invalid data type in dragging pasteboard"); return NO; } + + emacs_event->kind = DRAG_N_DROP_EVENT; + XSETINT (emacs_event->x, x); + XSETINT (emacs_event->y, y); + emacs_event->modifiers = 0; + + emacs_event->arg = Fcons (type_sym, + Fcons (operations, + strings)); + EV_TRAILER (theEvent); + + return YES; } @@ -9358,6 +9347,10 @@ Convert an X font name (XLFD) to an NS font name. DEFSYM (Qfile, "file"); DEFSYM (Qurl, "url"); + DEFSYM (Qns_drag_operation_copy, "ns-drag-operation-copy"); + DEFSYM (Qns_drag_operation_link, "ns-drag-operation-link"); + DEFSYM (Qns_drag_operation_generic, "ns-drag-operation-generic"); + Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier)); Fput (Qhyper, Qmodifier_value, make_fixnum (hyper_modifier)); Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); commit 7ae0a24c87c2bbefe78717d5e89cf3fe14f4af4c Author: Michael Albinus Date: Thu Jan 10 13:27:34 2019 +0100 New test custom--test-theme-variables * test/lisp/custom-tests.el (custom--test-user-option) (custom--test-variable): New variables. (custom--test-theme-variables): New test. * test/lisp/custom-resources/custom--test-theme.el (custom--test): New file. diff --git a/test/lisp/custom-resources/custom--test-theme.el b/test/lisp/custom-resources/custom--test-theme.el new file mode 100644 index 0000000000..da9121e0a0 --- /dev/null +++ b/test/lisp/custom-resources/custom--test-theme.el @@ -0,0 +1,9 @@ +(deftheme custom--test + "A test theme.") + +(custom-theme-set-variables + 'custom--test + '(custom--test-user-option 'bar) + '(custom--test-variable 'bar)) + +(provide-theme 'custom--test) diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 16ad7db93c..0c49db6c76 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el @@ -84,4 +84,43 @@ (when (file-directory-p tmpdir) (delete-directory tmpdir t))))) +(defcustom custom--test-user-option 'foo + "User option for test." + :group 'emacs + :type 'symbol) + +(defvar custom--test-variable 'foo + "Variable for test.") + +;; This is demonstrating bug#34027. +(ert-deftest custom--test-theme-variables () + "Test variables setting with enabling / disabling a custom theme." + :expected-result :failed + ;; We load custom-resources/custom--test-theme.el. + (let ((custom-theme-load-path + `(,(expand-file-name "custom-resources" (file-name-directory #$))))) + (load-theme 'custom--test 'no-confirm 'no-enable) + ;; The variables have still their initial values. + (should (equal custom--test-user-option 'foo)) + (should (equal custom--test-variable 'foo)) + + (custom-set-variables + '(custom--test-user-option 'baz) + '(custom--test-variable 'baz)) + ;; The initial values have been changed. + (should (equal custom--test-user-option 'baz)) + (should (equal custom--test-variable 'baz)) + + (enable-theme 'custom--test) + ;; The variables have the theme values. + (should (equal custom--test-user-option 'bar)) + (should (equal custom--test-variable 'bar)) + + (disable-theme 'custom--test) + ;; The variables should have the changed values, by reverting. + ;; This doesn't work as expected. Instead, they have their + ;; initial values `foo'. + (should (equal custom--test-user-option 'baz)) + (should (equal custom--test-variable 'baz)))) + ;;; custom-tests.el ends here commit f646675cd1637948b2df2351a9666792ea8251ea Author: Martin Rudalics Date: Thu Jan 10 11:02:17 2019 +0100 Handle dedicated status in 'window--display-buffer' (Bug#33870) * lisp/window.el (display-buffer-record-window): Rewrite doc-string. (window--display-buffer): Remove fifth argument DEDICATED and either directly use a 'dedicated' entry in ALIST or the value of 'display-buffer-mark-dedicated' instead. (display-buffer-in-atom-window, display-buffer-use-some-frame) (display-buffer-pop-up-frame, display-buffer-pop-up-window) (display-buffer-below-selected, display-buffer-at-bottom): Adjust callers of 'window--display-buffer'. (window--make-major-side-window) (display-buffer-in-side-window): Handle dedicated status of the chosen side window via a 'dedicated' alist entry and adjust 'window--display-buffer' call. (display-buffer-in-child-frame): Set up TYPE correctly for and adjust 'window--display-buffer' call. (display-buffer-in-previous-window): Handle dedicated status of a previous window already showing BUFFER. * doc/lispref/windows.texi (Buffer Display Action Alists): New action alist entry 'dedicated'. (Dedicated Windows): Mention new buffer display action alist entry 'dedicated'. * etc/NEWS: Mention new buffer display action alist entry 'dedicated'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 3940dd8924..a0853180fb 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2881,6 +2881,13 @@ Frames}) to avoid changing the width of other, unrelated windows. Also, this entry should be processed under only certain conditions which are specified right below this list. +@vindex dedicated@r{, a buffer display action alist entry} +@item dedicated +If non-@code{nil}, such an entry tells @code{display-buffer} to mark +any window it creates as dedicated to its buffer (@pxref{Dedicated +Windows}). It does that by calling @code{set-window-dedicated-p} with +the chosen window as first argument and the entry's value as second. + @vindex preserve-size@r{, a buffer display action alist entry} @item preserve-size If non-@code{nil} such an entry tells Emacs to preserve the size of @@ -3900,6 +3907,9 @@ display. Other functions do not treat @code{t} differently from any non-@code{nil} value. @end defun +You can also tell @code{display-buffer} to mark a window it creates as +dedicated to its buffer by providing a suitable @code{dedicated} +action alist entry (@pxref{Buffer Display Action Alists}). @node Quitting Windows @section Quitting Windows diff --git a/etc/NEWS b/etc/NEWS index 6a91017e59..3d49640ac5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1287,6 +1287,11 @@ of the Emacs Lisp Reference manual for more detail. A buffer-local value of this hook is now run only if at least one window showing the buffer has changed its size. ++++ +** New buffer display action alist entry 'dedicated'. +Such an entry allows to specify the dedicated status of a window +created by 'display-buffer'. + +++ ** New buffer display action alist entry 'window-min-height'. Such an entry allows to specify a minimum height of the window used diff --git a/lisp/window.el b/lisp/window.el index 37d82c060c..751263c925 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -700,8 +700,7 @@ failed." (set-window-parameter window 'window-atom 'main)) (set-window-parameter new 'window-atom side) ;; Display BUFFER in NEW and return NEW. - (window--display-buffer - buffer new 'window alist display-buffer-mark-dedicated)))) + (window--display-buffer buffer new 'window alist)))) (defun window--atom-check-1 (window) "Subroutine of `window--atom-check'." @@ -958,7 +957,11 @@ and may be called only if no window on SIDE exists yet." ;; window and not make a new parent window unless needed. (window-combination-resize 'side) (window-combination-limit nil) - (window (split-window-no-error next-to nil on-side))) + (window (split-window-no-error next-to nil on-side)) + (alist (if (assq 'dedicated alist) + alist + (cons `(dedicated . ,(or display-buffer-mark-dedicated 'side)) + alist)))) (when window ;; Initialize `window-side' parameter of new window to SIDE and ;; make that parameter persistent. @@ -985,7 +988,7 @@ and may be called only if no window on SIDE exists yet." (with-current-buffer buffer (setq window--sides-shown t)) ;; Install BUFFER in new window and return WINDOW. - (window--display-buffer buffer window 'window alist 'side)))) + (window--display-buffer buffer window 'window alist)))) (defun display-buffer-in-side-window (buffer alist) "Display BUFFER in a side window of the selected frame. @@ -1019,10 +1022,7 @@ nor installs any other window parameters unless they have been explicitly provided via a `window-parameters' entry in ALIST." (let* ((side (or (cdr (assq 'side alist)) 'bottom)) (slot (or (cdr (assq 'slot alist)) 0)) - (left-or-right (memq side '(left right))) - ;; Softly dedicate window to BUFFER unless - ;; `display-buffer-mark-dedicated' already asks for it. - (dedicated (or display-buffer-mark-dedicated 'side))) + (left-or-right (memq side '(left right)))) (cond ((not (memq side '(top bottom left right))) (error "Invalid side %s specified" side)) @@ -1055,7 +1055,11 @@ explicitly provided via a `window-parameters' entry in ALIST." ((eq side 'bottom) 3)) window-sides-slots)) (window--sides-inhibit-check t) - window this-window this-slot prev-window next-window + (alist (if (assq 'dedicated alist) + alist + (cons `(dedicated . ,(or display-buffer-mark-dedicated 'side)) + alist))) + window this-window this-slot prev-window next-window best-window best-slot abs-slot) (cond @@ -1113,8 +1117,7 @@ explicitly provided via a `window-parameters' entry in ALIST." ;; Reuse `this-window'. (with-current-buffer buffer (setq window--sides-shown t)) - (window--display-buffer - buffer this-window 'reuse alist dedicated)) + (window--display-buffer buffer this-window 'reuse alist)) (and (or (not max-slots) (< slots max-slots)) (or (and next-window ;; Make new window before `next-window'. @@ -1131,8 +1134,7 @@ explicitly provided via a `window-parameters' entry in ALIST." (set-window-parameter window 'window-slot slot) (with-current-buffer buffer (setq window--sides-shown t)) - (window--display-buffer - buffer window 'window alist dedicated)) + (window--display-buffer buffer window 'window alist)) (and best-window ;; Reuse `best-window'. (progn @@ -1141,7 +1143,7 @@ explicitly provided via a `window-parameters' entry in ALIST." (with-current-buffer buffer (setq window--sides-shown t)) (window--display-buffer - buffer best-window 'reuse alist dedicated))))))))) + buffer best-window 'reuse alist))))))))) (defun window-toggle-side-windows (&optional frame) "Toggle display of side windows on specified FRAME. @@ -6073,23 +6075,26 @@ not resized by this function." (defun display-buffer-record-window (type window buffer) "Record information for window used by `display-buffer'. +WINDOW is the window used for or created by a buffer display +action function. BUFFER is the buffer to display. Note that +this function must be called before BUFFER is explicitly made +WINDOW's buffer (although WINDOW may show BUFFER already). + TYPE specifies the type of the calling operation and must be one -of the symbols `reuse' (when WINDOW existed already and was -reused for displaying BUFFER), `window' (when WINDOW was created -on an already existing frame), or `frame' (when WINDOW was -created on a new frame). WINDOW is the window used for or created -by the `display-buffer' routines. BUFFER is the buffer that -shall be displayed. - -This function installs or updates the quit-restore parameter of -WINDOW. The quit-restore parameter is a list of four elements: -The first element is one of the symbols `window', `frame', `same' or -`other'. The second element is either one of the symbols `window' -or `frame' or a list whose elements are the buffer previously -shown in the window, that buffer's window start and window point, -and the window's height. The third element is the window -selected at the time the parameter was created. The fourth -element is BUFFER." +of the symbols 'reuse' (meaning that WINDOW exists already and +will be used for displaying BUFFER), 'window' (WINDOW was created +on an already existing frame) or 'frame' (WINDOW was created on a +new frame). + +This function installs or updates the 'quit-restore' parameter of +WINDOW. The 'quit-restore' parameter is a list of four elements: +The first element is one of the symbols 'window', 'frame', 'same' +or 'other'. The second element is either one of the symbols +'window' or 'frame' or a list whose elements are the buffer +previously shown in the window, that buffer's window start and +window point, and the window's height. The third element is the +window selected at the time the parameter was created. The +fourth element is BUFFER." (cond ((eq type 'reuse) (if (eq (window-buffer window) buffer) @@ -6748,20 +6753,51 @@ window is larger than WINDOW." (/ (- (window-total-height window) (window-total-height)) 2)) (error nil)))))) -(defun window--display-buffer (buffer window type &optional alist dedicated) +(defun window--display-buffer (buffer window type &optional alist) "Display BUFFER in WINDOW. -TYPE must be one of the symbols `reuse', `window' or `frame' and -is passed unaltered to `display-buffer-record-window'. ALIST is -the alist argument of `display-buffer'. Set `window-dedicated-p' -to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are -live." +WINDOW must be a live window chosen by a buffer display action +function for showing BUFFER. TYPE tells whether WINDOW existed +already before that action function was called or is a new window +created by that function. ALIST is a buffer display action alist +as compiled by `display-buffer'. + +TYPE must be one of the following symbols: 'reuse' (which means +WINDOW existed before the call of `display-buffer' and may +already show BUFFER or not), 'window' (WINDOW was created on an +existing frame) or 'frame' (WINDOW was created on a new frame). +TYPE is passed unaltered to `display-buffer-record-window'. + +Handle WINDOW's dedicated flag as follows: If WINDOW already +shows BUFFER, leave it alone. Otherwise, if ALIST contains a +'dedicated' entry and WINDOW is either new or that entry's value +equals 'side', set WINDOW's dedicated flag to the value of that +entry. Otherwise, if WINDOW is new and the value of +'display-buffer-mark-dedicated' is non-nil, set WINDOW's +dedicated flag to that value. In any other case, reset WINDOW's +dedicated flag to nil. + +Return WINDOW if BUFFER and WINDOW are live." (when (and (buffer-live-p buffer) (window-live-p window)) (display-buffer-record-window type window buffer) (unless (eq buffer (window-buffer window)) + ;; Unless WINDOW already shows BUFFER reset its dedicated flag. (set-window-dedicated-p window nil) (set-window-buffer window buffer)) - (when dedicated - (set-window-dedicated-p window dedicated)) + (let ((alist-dedicated (assq 'dedicated alist))) + ;; Maybe dedicate WINDOW to BUFFER if asked for. + (cond + ;; Don't dedicate WINDOW if it is dedicated because it shows + ;; BUFFER already or it is reused and is not a side window. + ((or (window-dedicated-p window) + (and (eq type 'reuse) (not (eq (cdr alist-dedicated) 'side))))) + ;; Otherwise, if ALIST contains a 'dedicated' entry, use that + ;; entry's value (which may be nil). + (alist-dedicated + (set-window-dedicated-p window (cdr alist-dedicated))) + ;; Otherwise, if 'display-buffer-mark-dedicated' is non-nil, + ;; use that. + (display-buffer-mark-dedicated + (set-window-dedicated-p window display-buffer-mark-dedicated)))) (when (memq type '(window frame)) (set-window-prev-buffers window nil)) (let ((quit-restore (window-parameter window 'quit-restore)) @@ -7190,8 +7226,7 @@ that allows the selected frame)." frame nil (cdr (assq 'inhibit-same-window alist)))))) (when window (prog1 - (window--display-buffer - buffer window 'reuse alist display-buffer-mark-dedicated) + (window--display-buffer buffer window 'reuse alist) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame frame)))))) @@ -7356,8 +7391,7 @@ new frame." (with-current-buffer buffer (setq frame (funcall fun))) (setq window (frame-selected-window frame))) - (prog1 (window--display-buffer - buffer window 'frame alist display-buffer-mark-dedicated) + (prog1 (window--display-buffer buffer window 'frame alist) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame frame)))))) @@ -7386,8 +7420,7 @@ raising the frame." (window--try-to-split-window (get-lru-window frame t) alist)))) - (prog1 (window--display-buffer - buffer window 'window alist display-buffer-mark-dedicated) + (prog1 (window--display-buffer buffer window 'window alist) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) @@ -7435,7 +7468,7 @@ be added to ALIST." (parent (or (assq 'parent-frame parameters) (selected-frame))) (share (assq 'share-child-frame parameters)) - share1 frame window) + share1 frame window type) (with-current-buffer buffer (when (frame-live-p parent) (catch 'frame @@ -7448,12 +7481,14 @@ be added to ALIST." (throw 'frame t)))))) (if frame - (setq window (frame-selected-window frame)) + (progn + (setq window (frame-selected-window frame)) + (setq type 'reuse)) (setq frame (make-frame parameters)) - (setq window (frame-selected-window frame)))) + (setq window (frame-selected-window frame)) + (setq type 'frame))) - (prog1 (window--display-buffer - buffer window 'frame alist display-buffer-mark-dedicated) + (prog1 (window--display-buffer buffer window type alist) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame frame))))) @@ -7492,16 +7527,14 @@ must also contain a 'window-height' entry with the same value." split-width-threshold) (setq window (window--try-to-split-window (selected-window) alist))) - (window--display-buffer - buffer window 'window alist display-buffer-mark-dedicated)) + (window--display-buffer buffer window 'window alist)) (and (setq window (window-in-direction 'below)) (not (window-dedicated-p window)) (or (not (numberp min-height)) ;; A window that showed another buffer before cannot ;; be resized. (>= (window-height window) min-height)) - (window--display-buffer - buffer window 'reuse alist display-buffer-mark-dedicated))))) + (window--display-buffer buffer window 'reuse alist))))) (defun display-buffer--maybe-at-bottom (buffer alist) (let ((alist (append alist `(,(if temp-buffer-resize-mode @@ -7533,21 +7566,17 @@ selected frame." (setq bottom-window window)))) nil nil 'nomini) (or (and bottom-window-shows-buffer - (window--display-buffer - buffer bottom-window 'reuse alist display-buffer-mark-dedicated)) + (window--display-buffer buffer bottom-window 'reuse alist)) (and (not (frame-parameter nil 'unsplittable)) - (let (split-width-threshold) + (let (split-height-threshold) (setq window (window--try-to-split-window bottom-window alist))) - (window--display-buffer - buffer window 'window alist display-buffer-mark-dedicated)) + (window--display-buffer buffer window 'window alist)) (and (not (frame-parameter nil 'unsplittable)) (setq window (split-window-no-error (window-main-window))) - (window--display-buffer - buffer window 'window alist display-buffer-mark-dedicated)) + (window--display-buffer buffer window 'window alist)) (and (setq window bottom-window) (not (window-dedicated-p window)) - (window--display-buffer - buffer window 'reuse alist display-buffer-mark-dedicated))))) + (window--display-buffer buffer window 'reuse alist))))) (defun display-buffer-in-previous-window (buffer alist) "Display BUFFER in a window previously showing it. @@ -7596,7 +7625,8 @@ above, even if that window never showed BUFFER before." ;; anything we found so far. (when (and (setq window (cdr (assq 'previous-window alist))) (window-live-p window) - (not (window-dedicated-p window))) + (or (eq buffer (window-buffer window)) + (not (window-dedicated-p window)))) (if (eq window (selected-window)) (unless inhibit-same-window (setq second-best-window window)) commit a2e78046f6b52e0a433ae6e1b9e6e5015f415412 Author: Paul Eggert Date: Wed Jan 9 16:16:46 2019 -0800 Mention Japanese change in documentation diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index b3e7d218c6..6a26667510 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -397,7 +397,7 @@ messages. But if your locale matches an entry in the variable coding system instead. For example, if the locale @samp{ja_JP.PCK} matches @code{japanese-shift-jis} in @code{locale-preferred-coding-systems}, Emacs uses that encoding even -though it might normally use @code{japanese-iso-8bit}. +though it might normally use @code{utf-8}. You can override the language environment chosen at startup with explicit use of the command @code{set-language-environment}, or with diff --git a/etc/NEWS b/etc/NEWS index 3670ab5bf4..6a91017e59 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -217,6 +217,11 @@ regular expression was previously invalid, but is now accepted: --- ** New input methods 'hawaiian-postfix' and 'hawaiian-prefix'. ++++ +** In Japanese environments that do not specify encodings and are not +based on MS-Windows, the default encoding is now utf-8 instead of +japanese-iso-8bit. + +++ ** New function 'exec-path'. This function by default returns the value of the corresponding diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index 6d87303ba1..b1eb3d9127 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -29,11 +29,9 @@ ;;;###autoload (defun setup-japanese-environment-internal () - ;; By default, we use 'iso-2022-jp for default coding system. But, the - ;; following prefer-coding-system will override it. - (if (memq system-type '(windows-nt ms-dos cygwin)) - (prefer-coding-system 'japanese-shift-jis) - (prefer-coding-system 'utf-8)) + (prefer-coding-system (if (memq system-type '(windows-nt ms-dos cygwin)) + 'japanese-shift-jis + 'utf-8)) (use-cjk-char-width-table 'ja_JP)) (defconst japanese-kana-table commit a57ee3dad6d6f12a7236a783a91148e349ad601e Author: Yasuhiro KIMURA Date: Wed Jan 9 15:44:10 2019 -0800 Change preferred Japanese coding system to UTF-8 * lisp/language/japan-util.el (setup-japanese-environment-internal): Use utf-8 as preferred coding system instead of japanese-iso-8bit when system is not MS-Windows. And while I'm at it, fix comment to fit current implementation. (Bug#28705) Copyright-paperwork-exempt: yes. diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index 5d6f537407..6d87303ba1 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -29,11 +29,11 @@ ;;;###autoload (defun setup-japanese-environment-internal () - ;; By default, we use 'japanese-iso-8bit for file names. But, the + ;; By default, we use 'iso-2022-jp for default coding system. But, the ;; following prefer-coding-system will override it. (if (memq system-type '(windows-nt ms-dos cygwin)) (prefer-coding-system 'japanese-shift-jis) - (prefer-coding-system 'japanese-iso-8bit)) + (prefer-coding-system 'utf-8)) (use-cjk-char-width-table 'ja_JP)) (defconst japanese-kana-table commit a84650334e30b2451bf4a8957bf2d57ade296d4e Author: Paul Eggert Date: Wed Jan 9 09:52:38 2019 -0800 Use shortcuts for Flength When calculating the length of a Lisp object whose type is known, use a specialized length operation on it to save a bit of runtime overhead. * src/callint.c (Fcall_interactively): * src/minibuf.c (read_minibuf_unwind): Use ASIZE rather than Flength on values that must be vectors. * src/charset.c (Fsort_charsets): * src/coding.c (detect_coding_sjis): (Fdefine_coding_system_internal): * src/data.c (wrong_choice): * src/eval.c (Flet, eval_sub, Fapply, apply_lambda): * src/fns.c (sort_list): * src/font.c (font_vconcat_entity_vectors) (font_find_for_lface): * src/frame.c (Fmodify_frame_parameters): * src/fringe.c (get_logical_fringe_bitmap): * src/ftfont.c (ftfont_get_open_type_spec): * src/gtkutil.c (xg_print_frames_dialog): * src/lread.c (read1, read_vector): * src/keymap.c (Fkey_description): * src/kqueue.c (Fkqueue_add_watch): * src/macfont.m (macfont_get_open_type_spec): * src/menu.c (parse_single_submenu, x_popup_menu_1): * src/minibuf.c (Finternal_complete_buffer): * src/nsfont.m (ns_findfonts, nsfont_list_family): * src/process.c (Fmake_process): * src/search.c (Fset_match_data): * src/xfaces.c (Fx_family_fonts): Use list_length rather than Flength on values that must be lists. * src/fns.c (list_length): New function. (Flength): Use it. * src/nsfont.m (ns_findfonts): Use !NILP (x) rather than XFIXNUM (Flength (x)) != 0. * src/xdisp.c (store_mode_line_string): Use SCHARS rather than Flength on values that must be strings. diff --git a/src/callint.c b/src/callint.c index dac905e16f..0911c49ae5 100644 --- a/src/callint.c +++ b/src/callint.c @@ -572,7 +572,7 @@ invoke it. If KEYS is omitted or nil, the return value of /* If the key sequence ends with a down-event, discard the following up-event. */ Lisp_Object teml - = Faref (args[i], make_fixnum (XFIXNUM (Flength (args[i])) - 1)); + = Faref (args[i], make_fixnum (ASIZE (args[i]) - 1)); if (CONSP (teml)) teml = XCAR (teml); if (SYMBOLP (teml)) diff --git a/src/charset.c b/src/charset.c index 427349b298..724b35536e 100644 --- a/src/charset.c +++ b/src/charset.c @@ -2242,8 +2242,7 @@ Return the sorted list. CHARSETS is modified by side effects. See also `charset-priority-list' and `set-charset-priority'. */) (Lisp_Object charsets) { - Lisp_Object len = Flength (charsets); - ptrdiff_t n = XFIXNAT (len), i, j; + ptrdiff_t n = list_length (charsets), i, j; int done; Lisp_Object tail, elt, attrs; struct charset_sort_data *sort_data; diff --git a/src/coding.c b/src/coding.c index 0297c8a100..1c1462198c 100644 --- a/src/coding.c +++ b/src/coding.c @@ -4591,8 +4591,7 @@ detect_coding_sjis (struct coding_system *coding, int max_first_byte_of_2_byte_code; CODING_GET_INFO (coding, attrs, charset_list); - max_first_byte_of_2_byte_code - = (XFIXNUM (Flength (charset_list)) > 3 ? 0xFC : 0xEF); + max_first_byte_of_2_byte_code = list_length (charset_list) <= 3 ? 0xEF : 0xFC; detect_info->checked |= CATEGORY_MASK_SJIS; /* A coding system of this category is always ASCII compatible. */ @@ -10387,14 +10386,11 @@ usage: (define-coding-system-internal ...) */) } else if (EQ (coding_type, Qshift_jis)) { - - struct charset *charset; - - if (XFIXNUM (Flength (charset_list)) != 3 - && XFIXNUM (Flength (charset_list)) != 4) + ptrdiff_t charset_list_len = list_length (charset_list); + if (charset_list_len != 3 && charset_list_len != 4) error ("There should be three or four charsets"); - charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); + struct charset *charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); if (CHARSET_DIMENSION (charset) != 1) error ("Dimension of charset %s is not one", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); @@ -10429,7 +10425,7 @@ usage: (define-coding-system-internal ...) */) { struct charset *charset; - if (XFIXNUM (Flength (charset_list)) != 2) + if (list_length (charset_list) != 2) error ("There should be just two charsets"); charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list))); diff --git a/src/data.c b/src/data.c index 1c12474081..a9908a34f4 100644 --- a/src/data.c +++ b/src/data.c @@ -980,14 +980,12 @@ chain of aliases, signal a `cyclic-variable-indirection' error. */) swap_in_symval_forwarding for that. */ Lisp_Object -do_symval_forwarding (register union Lisp_Fwd *valcontents) +do_symval_forwarding (union Lisp_Fwd *valcontents) { - register Lisp_Object val; switch (XFWDTYPE (valcontents)) { case Lisp_Fwd_Int: - XSETINT (val, *XFIXNUMFWD (valcontents)->intvar); - return val; + return make_fixnum (*XFIXNUMFWD (valcontents)->intvar); case Lisp_Fwd_Bool: return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil); @@ -1023,7 +1021,7 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) void wrong_choice (Lisp_Object choice, Lisp_Object wrong) { - ptrdiff_t i = 0, len = XFIXNUM (Flength (choice)); + ptrdiff_t i = 0, len = list_length (choice); Lisp_Object obj, *args; AUTO_STRING (one_of, "One of "); AUTO_STRING (comma, ", "); diff --git a/src/eval.c b/src/eval.c index c64a40b955..28478956e3 100644 --- a/src/eval.c +++ b/src/eval.c @@ -951,16 +951,15 @@ usage: (let VARLIST BODY...) */) (Lisp_Object args) { Lisp_Object *temps, tem, lexenv; - Lisp_Object elt, varlist; + Lisp_Object elt; ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t argnum; USE_SAFE_ALLOCA; - varlist = XCAR (args); - CHECK_LIST (varlist); + Lisp_Object varlist = XCAR (args); /* Make space to hold the values to give the bound variables. */ - EMACS_INT varlist_len = XFIXNAT (Flength (varlist)); + EMACS_INT varlist_len = list_length (varlist); SAFE_ALLOCA_LISP (temps, varlist_len); ptrdiff_t nvars = varlist_len; @@ -2263,14 +2262,15 @@ eval_sub (Lisp_Object form) if (SUBRP (fun)) { Lisp_Object args_left = original_args; - Lisp_Object numargs = Flength (args_left); + ptrdiff_t numargs = list_length (args_left); check_cons_list (); - if (XFIXNUM (numargs) < XSUBR (fun)->min_args + if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 - && XSUBR (fun)->max_args < XFIXNUM (numargs))) - xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); + && XSUBR (fun)->max_args < numargs)) + xsignal2 (Qwrong_number_of_arguments, original_fun, + make_fixnum (numargs)); else if (XSUBR (fun)->max_args == UNEVALLED) val = (XSUBR (fun)->function.aUNEVALLED) (args_left); @@ -2281,9 +2281,9 @@ eval_sub (Lisp_Object form) ptrdiff_t argnum = 0; USE_SAFE_ALLOCA; - SAFE_ALLOCA_LISP (vals, XFIXNUM (numargs)); + SAFE_ALLOCA_LISP (vals, numargs); - while (CONSP (args_left) && argnum < XFIXNUM (numargs)) + while (CONSP (args_left) && argnum < numargs) { Lisp_Object arg = XCAR (args_left); args_left = XCDR (args_left); @@ -2313,7 +2313,7 @@ eval_sub (Lisp_Object form) args_left = Fcdr (args_left); } - set_backtrace_args (specpdl + count, argvals, XFIXNUM (numargs)); + set_backtrace_args (specpdl + count, argvals, numargs); switch (i) { @@ -2417,16 +2417,13 @@ Thus, (apply \\='+ 1 2 \\='(3 4)) returns 10. usage: (apply FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t i, numargs, funcall_nargs; - register Lisp_Object *funcall_args = NULL; - register Lisp_Object spread_arg = args[nargs - 1]; + ptrdiff_t i, funcall_nargs; + Lisp_Object *funcall_args = NULL; + Lisp_Object spread_arg = args[nargs - 1]; Lisp_Object fun = args[0]; - Lisp_Object retval; USE_SAFE_ALLOCA; - CHECK_LIST (spread_arg); - - numargs = XFIXNUM (Flength (spread_arg)); + ptrdiff_t numargs = list_length (spread_arg); if (numargs == 0) return Ffuncall (nargs - 1, args); @@ -2476,7 +2473,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) spread_arg = XCDR (spread_arg); } - retval = Ffuncall (funcall_nargs, funcall_args); + Lisp_Object retval = Ffuncall (funcall_nargs, funcall_args); SAFE_FREE (); return retval; @@ -2974,25 +2971,22 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) { - Lisp_Object args_left; - ptrdiff_t i; - EMACS_INT numargs; Lisp_Object *arg_vector; Lisp_Object tem; USE_SAFE_ALLOCA; - numargs = XFIXNAT (Flength (args)); + ptrdiff_t numargs = list_length (args); SAFE_ALLOCA_LISP (arg_vector, numargs); - args_left = args; + Lisp_Object args_left = args; - for (i = 0; i < numargs; ) + for (ptrdiff_t i = 0; i < numargs; i++) { tem = Fcar (args_left), args_left = Fcdr (args_left); tem = eval_sub (tem); - arg_vector[i++] = tem; + arg_vector[i] = tem; } - set_backtrace_args (specpdl + count, arg_vector, i); + set_backtrace_args (specpdl + count, arg_vector, numargs); tem = funcall_lambda (fun, numargs, arg_vector); check_cons_list (); diff --git a/src/fns.c b/src/fns.c index 7791310a31..0fad6f4744 100644 --- a/src/fns.c +++ b/src/fns.c @@ -91,42 +91,50 @@ See Info node `(elisp)Random Numbers' for more details. */) /* Random data-structure functions. */ +/* Return the length of LIST. Signal an error if LIST is not a proper + list or if the length does not fit into a fixnum or into ptrdiff_t. */ + +ptrdiff_t +list_length (Lisp_Object list) +{ + intptr_t i = 0; + FOR_EACH_TAIL (list) + i++; + CHECK_LIST_END (list, list); + if (i <= min (PTRDIFF_MAX, MOST_POSITIVE_FIXNUM)) + return i; + overflow_error (); +} + + DEFUN ("length", Flength, Slength, 1, 1, 0, doc: /* Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. If the string contains multibyte characters, this is not necessarily the number of bytes in the string; it is the number of characters. To get the number of bytes, use `string-bytes'. */) - (register Lisp_Object sequence) + (Lisp_Object sequence) { - register Lisp_Object val; + EMACS_INT val; if (STRINGP (sequence)) - XSETFASTINT (val, SCHARS (sequence)); + val = SCHARS (sequence); else if (VECTORP (sequence)) - XSETFASTINT (val, ASIZE (sequence)); + val = ASIZE (sequence); else if (CHAR_TABLE_P (sequence)) - XSETFASTINT (val, MAX_CHAR); + val = MAX_CHAR; else if (BOOL_VECTOR_P (sequence)) - XSETFASTINT (val, bool_vector_size (sequence)); + val = bool_vector_size (sequence); else if (COMPILEDP (sequence) || RECORDP (sequence)) - XSETFASTINT (val, PVSIZE (sequence)); + val = PVSIZE (sequence); else if (CONSP (sequence)) - { - intptr_t i = 0; - FOR_EACH_TAIL (sequence) - i++; - CHECK_LIST_END (sequence, sequence); - if (MOST_POSITIVE_FIXNUM < i) - overflow_error (); - val = make_fixnum (i); - } + val = list_length (sequence); else if (NILP (sequence)) - XSETFASTINT (val, 0); + val = 0; else wrong_type_argument (Qsequencep, sequence); - return val; + return make_fixnum (val); } DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0, @@ -1957,24 +1965,15 @@ See also the function `nreverse', which is used more often. */) static Lisp_Object sort_list (Lisp_Object list, Lisp_Object predicate) { - Lisp_Object front, back; - Lisp_Object len, tem; - EMACS_INT length; - - front = list; - len = Flength (list); - length = XFIXNUM (len); + ptrdiff_t length = list_length (list); if (length < 2) return list; - XSETINT (len, (length / 2) - 1); - tem = Fnthcdr (len, list); - back = Fcdr (tem); + Lisp_Object tem = Fnthcdr (make_fixnum (length / 2 - 1), list); + Lisp_Object back = Fcdr (tem); Fsetcdr (tem, Qnil); - front = Fsort (front, predicate); - back = Fsort (back, predicate); - return merge (front, back, predicate); + return merge (Fsort (list, predicate), Fsort (back, predicate), predicate); } /* Using PRED to compare, return whether A and B are in order. diff --git a/src/font.c b/src/font.c index cf68160e59..3fc77a1d76 100644 --- a/src/font.c +++ b/src/font.c @@ -2174,13 +2174,12 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop) static Lisp_Object font_vconcat_entity_vectors (Lisp_Object list) { - EMACS_INT nargs = XFIXNAT (Flength (list)); + ptrdiff_t nargs = list_length (list); Lisp_Object *args; USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (args, nargs); - ptrdiff_t i; - for (i = 0; i < nargs; i++, list = XCDR (list)) + for (ptrdiff_t i = 0; i < nargs; i++, list = XCDR (list)) args[i] = XCAR (list); Lisp_Object result = Fvconcat (nargs, args); SAFE_FREE (); @@ -3241,7 +3240,7 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int if (! NILP (alters)) { - EMACS_INT alterslen = XFIXNAT (Flength (alters)); + EMACS_INT alterslen = list_length (alters); SAFE_ALLOCA_LISP (family, alterslen + 2); for (i = 0; CONSP (alters); i++, alters = XCDR (alters)) family[i] = XCAR (alters); diff --git a/src/frame.c b/src/frame.c index 6efc2a6109..ca6704a44c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3190,7 +3190,7 @@ list, but are otherwise ignored. */) #endif { - EMACS_INT length = XFIXNAT (Flength (alist)); + EMACS_INT length = list_length (alist); ptrdiff_t i; Lisp_Object *parms; Lisp_Object *values; diff --git a/src/fringe.c b/src/fringe.c index a7e8dad482..74f41f0087 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -719,7 +719,7 @@ static int get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, int partial_p) { Lisp_Object cmap, bm1 = Qnil, bm2 = Qnil, bm; - EMACS_INT ln1 = 0, ln2 = 0; + ptrdiff_t ln1 = 0, ln2 = 0; int ix1 = right_p; int ix2 = ix1 + (partial_p ? 2 : 0); @@ -743,7 +743,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in return NO_FRINGE_BITMAP; if (CONSP (bm1)) { - ln1 = XFIXNUM (Flength (bm1)); + ln1 = list_length (bm1); if (partial_p) { if (ln1 > ix2) @@ -778,7 +778,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in { if (CONSP (bm2)) { - ln2 = XFIXNUM (Flength (bm2)); + ln2 = list_length (bm2); if (partial_p) { if (ln2 > ix2) diff --git a/src/ftfont.c b/src/ftfont.c index 6899a5763a..f5a225be05 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -594,16 +594,14 @@ ftfont_get_open_type_spec (Lisp_Object otf_spec) spec->nfeatures[0] = spec->nfeatures[1] = 0; for (i = 0; i < 2 && ! NILP (otf_spec); i++, otf_spec = XCDR (otf_spec)) { - Lisp_Object len; - val = XCAR (otf_spec); if (NILP (val)) continue; - len = Flength (val); + ptrdiff_t len = list_length (val); spec->features[i] = - (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XFIXNUM (len) + (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < len ? 0 - : malloc (XFIXNUM (len) * sizeof *spec->features[i])); + : malloc (len * sizeof *spec->features[i])); if (! spec->features[i]) { if (i > 0 && spec->features[0]) diff --git a/src/gtkutil.c b/src/gtkutil.c index 2eac28798b..92199bb0af 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -4299,7 +4299,7 @@ xg_print_frames_dialog (Lisp_Object frames) gtk_print_operation_set_print_settings (print, print_settings); if (page_setup != NULL) gtk_print_operation_set_default_page_setup (print, page_setup); - gtk_print_operation_set_n_pages (print, XFIXNUM (Flength (frames))); + gtk_print_operation_set_n_pages (print, list_length (frames)); g_signal_connect (print, "draw-page", G_CALLBACK (draw_page), &frames); res = gtk_print_operation_run (print, GTK_PRINT_OPERATION_ACTION_PRINT_DIALOG, NULL, NULL); diff --git a/src/keymap.c b/src/keymap.c index 21d37328ad..dda552ba47 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2042,7 +2042,7 @@ For an approximate inverse of this, see `kbd'. */) else if (VECTORP (list)) size = ASIZE (list); else if (CONSP (list)) - size = XFIXNUM (Flength (list)); + size = list_length (list); else wrong_type_argument (Qarrayp, list); diff --git a/src/kqueue.c b/src/kqueue.c index 655bfd58d3..43e75cac31 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -395,11 +395,12 @@ only when the upper directory of the renamed file is watched. */) maxfd = 256; /* We assume 50 file descriptors are sufficient for the rest of Emacs. */ - if ((maxfd - 50) < XFIXNUM (Flength (watch_list))) + ptrdiff_t watch_list_len = list_length (watch_list); + if (maxfd - 50 < watch_list_len) xsignal2 (Qfile_notify_error, build_string ("File watching not possible, no file descriptor left"), - Flength (watch_list)); + make_fixnum (watch_list_len)); if (kqueuefd < 0) { diff --git a/src/lisp.h b/src/lisp.h index dce61c165c..faf5a4ad40 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3413,6 +3413,7 @@ extern void syms_of_syntax (void); /* Defined in fns.c. */ enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; +extern ptrdiff_t list_length (Lisp_Object); extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); diff --git a/src/lread.c b/src/lread.c index 02f7caaded..5a595f2119 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2879,7 +2879,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Sub char-table can't be read as a regular vector because of a two C integer fields. */ Lisp_Object tbl, tmp = read_list (1, readcharfun); - ptrdiff_t size = XFIXNUM (Flength (tmp)); + ptrdiff_t size = list_length (tmp); int i, depth, min_char; struct Lisp_Cons *cell; @@ -3846,8 +3846,7 @@ static Lisp_Object read_vector (Lisp_Object readcharfun, bool bytecodeflag) { Lisp_Object tem = read_list (1, readcharfun); - Lisp_Object len = Flength (tem); - ptrdiff_t size = XFIXNAT (len); + ptrdiff_t size = list_length (tem); if (bytecodeflag && size <= COMPILED_STACK_DEPTH) error ("Invalid byte code"); Lisp_Object vector = make_nil_vector (size); diff --git a/src/macfont.m b/src/macfont.m index 0e90eb44ee..09c4ff31c8 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -1791,16 +1791,14 @@ static int macfont_variation_glyphs (struct font *, int c, spec->nfeatures[0] = spec->nfeatures[1] = 0; for (i = 0; i < 2 && ! NILP (otf_spec); i++, otf_spec = XCDR (otf_spec)) { - Lisp_Object len; - val = XCAR (otf_spec); if (NILP (val)) continue; - len = Flength (val); + ptrdiff_t len = list_length (val); spec->features[i] = - (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XFIXNUM (len) + (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < len ? 0 - : malloc (XFIXNUM (len) * sizeof *spec->features[i])); + : malloc (len * sizeof *spec->features[i])); if (! spec->features[i]) { if (i > 0 && spec->features[0]) diff --git a/src/menu.c b/src/menu.c index c35d711b31..c0e5bd9caf 100644 --- a/src/menu.c +++ b/src/menu.c @@ -524,19 +524,15 @@ bool parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, Lisp_Object maps) { - Lisp_Object length; - EMACS_INT len; Lisp_Object *mapvec; - ptrdiff_t i; bool top_level_items = 0; USE_SAFE_ALLOCA; - length = Flength (maps); - len = XFIXNUM (length); + ptrdiff_t len = list_length (maps); /* Convert the list MAPS into a vector MAPVEC. */ SAFE_ALLOCA_LISP (mapvec, len); - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { mapvec[i] = Fcar (maps); maps = Fcdr (maps); @@ -544,7 +540,7 @@ parse_single_submenu (Lisp_Object item_key, Lisp_Object item_name, /* Loop over the given keymaps, making a pane for each map. But don't make a pane that is empty--ignore that map instead. */ - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { if (!KEYMAPP (mapvec[i])) { @@ -1309,7 +1305,7 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) else if (CONSP (menu) && KEYMAPP (XCAR (menu))) { /* We were given a list of keymaps. */ - EMACS_INT nmaps = XFIXNAT (Flength (menu)); + ptrdiff_t nmaps = list_length (menu); Lisp_Object *maps; ptrdiff_t i; USE_SAFE_ALLOCA; diff --git a/src/minibuf.c b/src/minibuf.c index 8017da194b..c1fbfb4085 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -780,8 +780,7 @@ read_minibuf_unwind (void) /* Restore prompt, etc, from outer minibuffer level. */ Lisp_Object key_vec = Fcar (minibuf_save_list); - eassert (VECTORP (key_vec)); - this_command_key_count = XFIXNAT (Flength (key_vec)); + this_command_key_count = ASIZE (key_vec); this_command_keys = key_vec; minibuf_save_list = Fcdr (minibuf_save_list); minibuf_prompt = Fcar (minibuf_save_list); @@ -1783,7 +1782,7 @@ If FLAG is nil, invoke `try-completion'; if it is t, invoke while (CONSP (bufs) && SREF (XCAR (bufs), 0) == ' ') bufs = XCDR (bufs); if (NILP (bufs)) - return (EQ (Flength (res), Flength (Vbuffer_alist)) + return (list_length (res) == list_length (Vbuffer_alist) /* If all bufs are internal don't strip them out. */ ? res : bufs); res = bufs; diff --git a/src/nsfont.m b/src/nsfont.m index d4639dcca8..b59f87f468 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -576,7 +576,7 @@ but also for ascii (which causes unnecessary font substitution). */ /* Add synthItal member if needed. */ family = [fdesc objectForKey: NSFontFamilyAttribute]; - if (family != nil && !foundItal && XFIXNUM (Flength (list)) > 0) + if (family != nil && !foundItal && !NILP (list)) { NSFontDescriptor *s1 = [NSFontDescriptor new]; NSFontDescriptor *sDesc @@ -595,8 +595,8 @@ but also for ascii (which causes unnecessary font substitution). */ return ns_fallback_entity (); if (NSFONT_TRACE) - fprintf (stderr, " Returning %"pI"d entities.\n", - XFIXNUM (Flength (list))); + fprintf (stderr, " Returning %"pD"d entities.\n", + list_length (list)); return list; } @@ -667,8 +667,8 @@ Properties to be considered are same as for list(). */ /* FIXME: escape the name? */ if (NSFONT_TRACE) - fprintf (stderr, "nsfont: list families returning %"pI"d entries\n", - XFIXNUM (Flength (list))); + fprintf (stderr, "nsfont: list families returning %"pD"d entries\n", + list_length (list)); unblock_input (); return list; diff --git a/src/process.c b/src/process.c index b2a7f38317..edf633e512 100644 --- a/src/process.c +++ b/src/process.c @@ -1804,7 +1804,7 @@ usage: (make-process &rest ARGS) */) val = Vcoding_system_for_read; if (NILP (val)) { - ptrdiff_t nargs2 = 3 + XFIXNUM (Flength (command)); + ptrdiff_t nargs2 = 3 + list_length (command); Lisp_Object tem2; SAFE_ALLOCA_LISP (args2, nargs2); ptrdiff_t i = 0; @@ -1834,7 +1834,7 @@ usage: (make-process &rest ARGS) */) { if (EQ (coding_systems, Qt)) { - ptrdiff_t nargs2 = 3 + XFIXNUM (Flength (command)); + ptrdiff_t nargs2 = 3 + list_length (command); Lisp_Object tem2; SAFE_ALLOCA_LISP (args2, nargs2); ptrdiff_t i = 0; diff --git a/src/search.c b/src/search.c index 702e6e3d8e..f97dbe7334 100644 --- a/src/search.c +++ b/src/search.c @@ -2992,13 +2992,11 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) /* Allocate registers if they don't already exist. */ { - EMACS_INT length = XFIXNAT (Flength (list)) / 2; + ptrdiff_t length = list_length (list) / 2; if (length > search_regs.num_regs) { ptrdiff_t num_regs = search_regs.num_regs; - if (PTRDIFF_MAX < length) - memory_full (SIZE_MAX); search_regs.start = xpalloc (search_regs.start, &num_regs, length - num_regs, min (PTRDIFF_MAX, UINT_MAX), sizeof *search_regs.start); diff --git a/src/xdisp.c b/src/xdisp.c index 8b091c81be..7725570ced 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24137,7 +24137,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, } else { - len = XFIXNAT (Flength (lisp_string)); + len = SCHARS (lisp_string); if (precision > 0 && len > precision) { len = precision; diff --git a/src/xfaces.c b/src/xfaces.c index 8fe99e7655..cffa89e1f3 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1424,7 +1424,6 @@ the face font sort order. */) Lisp_Object font_spec, list, *drivers, vec; struct frame *f = decode_live_frame (frame); ptrdiff_t i, nfonts; - EMACS_INT ndrivers; Lisp_Object result; USE_SAFE_ALLOCA; @@ -1457,7 +1456,7 @@ the face font sort order. */) font_props_for_sorting[i++] = FONT_ADSTYLE_INDEX; font_props_for_sorting[i++] = FONT_REGISTRY_INDEX; - ndrivers = XFIXNUM (Flength (list)); + ptrdiff_t ndrivers = list_length (list); SAFE_ALLOCA_LISP (drivers, ndrivers); for (i = 0; i < ndrivers; i++, list = XCDR (list)) drivers[i] = XCAR (list);