From 11ce84b93df374e43d91b46cc84cede12893d1b0 Mon Sep 17 00:00:00 2001 From: dickmao Date: Sun, 19 Dec 2021 21:23:15 -0500 Subject: [PATCH] Rationalize window-text-pixel-size Even if 43c4cc2 did anything (it doesn't), it was obviously the wrong way to go about it. Then I saw 914cb7a, I had to do something about it. * doc/lispref/display.texi (Size of Displayed Text): Revert. * src/pgtkfns.c (Fx_show_tip): Revert. * src/xdisp.c (window_text_pixel_size): De-obfuscate. (Fwindow_text_pixel_size): Revert. (Fbuffer_text_pixel_size): Revert. * src/xfns.c (Fx_show_tip): Revert. * test/lisp/emacs-lisp/multisession-tests.el (multi-test--on-conflict-p, multi-test-sqlite-simple, multi-test-sqlite-busy, multi-test-files-simple, multi-test-files-busy, multi-test-files-some-values): You gotta do what you gotta do. * test/src/xdisp-tests.el (xdisp-tests--visible-buffer): `with-temp-buffer` won't cut it for xdisp tests. (xdisp-tests--reconnoiter-image-height, xdisp-tests--scroll-down-leaves-cursor-behind, xdisp-tests--window-text-pixel-size-single-sline, xdisp-tests--window-text-pixel-size-display-property): Test stuff. --- doc/lispref/display.texi | 8 +- src/pgtkfns.c | 3 +- src/w32fns.c | 3 +- src/xdisp.c | 154 +++++---------------- src/xfns.c | 3 +- test/lisp/emacs-lisp/multisession-tests.el | 81 +++++++---- test/src/xdisp-tests.el | 66 +++++++++ 7 files changed, 152 insertions(+), 166 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 98a15404f9..dd996fbe4a 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2086,7 +2086,7 @@ Size of Displayed Text (@pxref{Resizing Windows}) to make a window exactly as large as the text it contains. -@defun window-text-pixel-size &optional window from to x-limit y-limit mode-lines ignore-line-at-end +@defun window-text-pixel-size &optional window from to x-limit y-limit mode-lines This function returns the size of the text of @var{window}'s buffer in pixels. @var{window} must be a live window and defaults to the selected one. The return value is a cons of the maximum pixel-width @@ -2136,12 +2136,6 @@ Size of Displayed Text height of all of these lines, if present, in the return value. @end defun -The optional argument @var{ignore-line-at-end} controls whether or -not to count the height of text in @var{to}'s screen line as part of -the returned pixel-height. This is useful if your Lisp program is -only interested in the dimensions of text up to and excluding the -visual beginning of @var{to}'s screen line. - @code{window-text-pixel-size} treats the text displayed in a window as a whole and does not care about the size of individual lines. The following function does. diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 44e3d2a37e..1a4f08ca7d 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -3474,8 +3474,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_fixnum (w->pixel_height), Qnil, - Qnil); + make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); diff --git a/src/w32fns.c b/src/w32fns.c index 02a6d78b51..65463b5261 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -7525,8 +7525,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_fixnum (w->pixel_height), Qnil, - Qnil); + make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); diff --git a/src/xdisp.c b/src/xdisp.c index 0c35d24c26..d5101457c7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10827,22 +10827,22 @@ in_display_vector_p (struct it *it) && it->dpvec + it->current.dpvec_index != it->dpend); } -/* This is like Fwindow_text_pixel_size but assumes that WINDOW's buffer - is the current buffer. Fbuffer_text_pixel_size calls it after it has - set WINDOW's buffer to the buffer specified by its BUFFER_OR_NAME - argument. */ +/* Return cons pair of WINDOW's cartesian dimensions. */ + static Lisp_Object window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, Lisp_Object y_limit, - Lisp_Object mode_lines, Lisp_Object ignore_line_at_end) + Lisp_Object mode_lines) { struct window *w = decode_live_window (window); struct it it; ptrdiff_t start, end, bpos; struct text_pos startp; void *itdata = NULL; - int c, max_x = 0, max_y = 0, x = 0, y = 0; - int doff = 0; + int c, x = 0, y = 0, start_x = 0, start_vpos = 0; + + int max_x = (RANGED_FIXNUMP (0, x_limit, INT_MAX)) ? XFIXNUM (x_limit) : INT_MAX; + int max_y = (RANGED_FIXNUMP (0, y_limit, INT_MAX)) ? XFIXNUM (y_limit) : INT_MAX; if (NILP (from)) { @@ -10902,121 +10902,29 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, else end = clip_to_bounds (start, fix_position (to), ZV); - if (RANGED_FIXNUMP (0, x_limit, INT_MAX)) - max_x = XFIXNUM (x_limit); - else if (!NILP (x_limit)) - max_x = INT_MAX; - - if (NILP (y_limit)) - max_y = INT_MAX; - else if (RANGED_FIXNUMP (0, y_limit, INT_MAX)) - max_y = XFIXNUM (y_limit); - itdata = bidi_shelve_cache (); + start_display (&it, w, startp); - int start_y = it.current_y; - /* It makes no sense to measure dimensions of region of text that - crosses the point where bidi reordering changes scan direction. - By using unidirectional movement here we at least support the use - case of measuring regions of text that have a uniformly R2L - directionality, and regions that begin and end in text of the - same directionality. */ - it.bidi_p = false; - - /* Start at the beginning of the line containing FROM. Otherwise - IT.current_x will be incorrectly set to zero at some arbitrary - non-zero X coordinate. */ + it.last_visible_x = min (it.last_visible_x, max_x); + reseat_at_previous_visible_line_start (&it); it.current_x = it.hpos = 0; - if (IT_CHARPOS (it) != start) - move_it_to (&it, start, -1, -1, -1, MOVE_TO_POS); - - /* Now move to TO. */ - int start_x = it.current_x; - int move_op = MOVE_TO_POS | MOVE_TO_Y; - int to_x = -1; - it.current_y = start_y; - /* If FROM is on a newline, pretend that we start at the beginning - of the next line, because the newline takes no place on display. */ - if (FETCH_BYTE (start) == '\n') - it.current_x = 0; - if (!NILP (x_limit)) - { - it.last_visible_x = max_x; - /* Actually, we never want move_it_to stop at to_x. But to make - sure that move_it_in_display_line_to always moves far enough, - we set to_x to INT_MAX and specify MOVE_TO_X. */ - move_op |= MOVE_TO_X; - to_x = INT_MAX; - } - - void *it2data = NULL; - struct it it2; - SAVE_IT (it2, it, it2data); - - x = move_it_to (&it, end, to_x, max_y, -1, move_op); - - /* We could have a display property at END, in which case asking - move_it_to to stop at END will overshoot and stop at position - after END. So we try again, stopping before END, and account for - the width of the last buffer position manually. */ - if (IT_CHARPOS (it) > end) - { - end--; - RESTORE_IT (&it, &it2, it2data); - x = move_it_to (&it, end, to_x, max_y, -1, move_op); - /* Add the width of the thing at TO, but only if we didn't - overshoot it; if we did, it is already accounted for. Also, - account for the height of the thing at TO. */ - if (IT_CHARPOS (it) == end) - { - x += it.pixel_width; - - /* DTRT if ignore_line_at_end is t. */ - if (!NILP (ignore_line_at_end)) - doff = (max (it.max_ascent, it.ascent) - + max (it.max_descent, it.descent)); - else - { - it.max_ascent = max (it.max_ascent, it.ascent); - it.max_descent = max (it.max_descent, it.descent); - } - } - } - else - bidi_unshelve_cache (it2data, true); + move_it_to (&it, start, -1, -1, -1, MOVE_TO_POS); + start_x = it.current_x; + start_vpos = it.vpos; - if (!NILP (x_limit)) - { - /* Don't return more than X-LIMIT. */ - if (x > max_x) - x = max_x; - } + x = move_it_to (&it, end, -1, max_y, -1, MOVE_TO_POS | MOVE_TO_Y); + x = min (x, max_x); - /* If text spans more than one screen line, we don't need to adjust - the x-span for start_x, since the second and subsequent lines - will begin at zero X coordinate. */ - if (it.current_y > start_y) - start_x = 0; - - /* Subtract height of header-line and tab-line which was counted - automatically by start_display. */ - if (!NILP (ignore_line_at_end)) - y = (it.current_y + doff - - WINDOW_TAB_LINE_HEIGHT (w) - - WINDOW_HEADER_LINE_HEIGHT (w)); - else - y = (it.current_y + it.max_ascent + it.max_descent + doff - - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w)); - - /* Don't return more than Y-LIMIT. */ - if (y > max_y) - y = max_y; + /* Subtract header- and tab-line included by start_move_it(). */ + y = it.current_y + it.max_ascent + it.max_descent + - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w); + y = min (y, max_y); if ((EQ (mode_lines, Qtab_line) || EQ (mode_lines, Qt)) && window_wants_tab_line (w)) - /* Add height of tab-line as requested. */ { + /* Add height of tab-line as requested. */ Lisp_Object window_tab_line_format = window_parameter (w, Qtab_line_format); @@ -11052,10 +10960,15 @@ window_text_pixel_size (Lisp_Object window, Lisp_Object from, Lisp_Object to, bidi_unshelve_cache (itdata, false); - return Fcons (make_fixnum (x - start_x), make_fixnum (y)); + /* X is widest line seen by move_it_forwards() */ + return Fcons (make_fixnum + (it.vpos == start_vpos + ? x - start_x /* START to END same sline */ + : x), + make_fixnum (y)); } -DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 7, 0, +DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 6, 0, doc: /* Return the size of the text of WINDOW's buffer in pixels. WINDOW must be a live window and defaults to the selected one. The return value is a cons of the maximum pixel-width of any text line @@ -11102,12 +11015,9 @@ DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_siz height of the mode-, tab- or header-line of WINDOW in the return value. If it is the symbol `mode-line', 'tab-line' or `header-line', include only the height of that line, if present, in the return value. If t, -include the height of any of these, if present, in the return value. - -IGNORE-LINE-AT-END, if non-nil, means to not add the height of the -screen line that includes TO to the returned height of the text. */) +include the height of any of these, if present, in the return value. */) (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, - Lisp_Object y_limit, Lisp_Object mode_lines, Lisp_Object ignore_line_at_end) + Lisp_Object y_limit, Lisp_Object mode_lines) { struct window *w = decode_live_window (window); struct buffer *b = XBUFFER (w->contents); @@ -11120,8 +11030,7 @@ DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_siz set_buffer_internal_1 (b); } - value = window_text_pixel_size (window, from, to, x_limit, y_limit, mode_lines, - ignore_line_at_end); + value = window_text_pixel_size (window, from, to, x_limit, y_limit, mode_lines); if (old_b) set_buffer_internal_1 (old_b); @@ -11171,8 +11080,7 @@ DEFUN ("buffer-text-pixel-size", Fbuffer_text_pixel_size, Sbuffer_text_pixel_siz set_marker_both (w->old_pointm, buffer, BEG, BEG_BYTE); } - value = window_text_pixel_size (window, Qnil, Qnil, x_limit, y_limit, Qnil, - Qnil); + value = window_text_pixel_size (window, Qnil, Qnil, x_limit, y_limit, Qnil); unbind_to (count, Qnil); diff --git a/src/xfns.c b/src/xfns.c index 30ed358fb2..dc25d7bfca 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7169,8 +7169,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_fixnum (w->pixel_height), Qnil, - Qnil); + make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); diff --git a/test/lisp/emacs-lisp/multisession-tests.el b/test/lisp/emacs-lisp/multisession-tests.el index 1bf0a533a7..981557fd9e 100644 --- a/test/lisp/emacs-lisp/multisession-tests.el +++ b/test/lisp/emacs-lisp/multisession-tests.el @@ -26,6 +26,15 @@ (require 'ert-x) (require 'cl-lib) +(defsubst multi-test--on-conflict-p () + "The 'on conflict' is only supported in sqlite3 v3.24.0 +https://stackoverflow.com/a/51531835/5132008" + (when (bound-and-true-p multisession--db) + (let ((result (with-sqlite-transaction multisession--db + (sqlite-select multisession--db "select sqlite_version()")))) + (version-list-<= (version-to-list "3.24.0") + (version-to-list (seq-find #'stringp (cl-first result))))))) + (ert-deftest multi-test-sqlite-simple () (skip-unless (sqlite-available-p)) (ert-with-temp-file dir @@ -38,6 +47,7 @@ multi-test-sqlite-simple (define-multisession-variable multisession--foo 0 "" :synchronized t) + (skip-unless (multi-test--on-conflict-p)) (should (= (multisession-value multisession--foo) 0)) (cl-incf (multisession-value multisession--foo)) (should (= (multisession-value multisession--foo) 1)) @@ -56,11 +66,12 @@ multi-test-sqlite-simple :synchronized t) (cl-incf (multisession-value multisession--foo)))))) (should (= (multisession-value multisession--foo) 2))) - (sqlite-close multisession--db) + (when multisession--db + (sqlite-close multisession--db)) (setq multisession--db nil))))) (ert-deftest multi-test-sqlite-busy () - (skip-unless (and t (sqlite-available-p))) + (skip-unless (sqlite-available-p)) (ert-with-temp-file dir :directory t (let ((user-init-file "/tmp/foo.el") @@ -72,6 +83,7 @@ multi-test-sqlite-busy (define-multisession-variable multisession--bar 0 "" :synchronized t) + (skip-unless (multi-test--on-conflict-p)) (should (= (multisession-value multisession--bar) 0)) (cl-incf (multisession-value multisession--bar)) (should (= (multisession-value multisession--bar) 1)) @@ -93,45 +105,53 @@ multi-test-sqlite-busy (cl-incf (multisession-value multisession--bar)))))))) (while (process-live-p proc) (ignore-error 'sqlite-locked-error - (message "multisession--bar %s" (multisession-value multisession--bar)) - ;;(cl-incf (multisession-value multisession--bar)) - ) - (sleep-for 0.1)) - (message "multisession--bar ends up as %s" (multisession-value multisession--bar)) + (message "multisession--bar %s" (multisession-value multisession--bar))) + (accept-process-output nil 0.1)) + (message "bar ends up as %s" (multisession-value multisession--bar)) (should (< (multisession-value multisession--bar) 1003))) - (sqlite-close multisession--db) + (when (process-live-p proc) + (kill-process proc)) + (when multisession--db + (sqlite-close multisession--db)) (setq multisession--db nil))))) (ert-deftest multi-test-files-simple () + (skip-unless (sqlite-available-p)) (ert-with-temp-file dir :directory t (let ((user-init-file "/tmp/sfoo.el") (multisession-storage 'files) (multisession-directory dir)) - (define-multisession-variable multisession--sfoo 0 - "" - :synchronized t) - (should (= (multisession-value multisession--sfoo) 0)) - (cl-incf (multisession-value multisession--sfoo)) - (should (= (multisession-value multisession--sfoo) 1)) - (call-process - (concat invocation-directory invocation-name) - nil t nil - "-Q" "-batch" - "--eval" (prin1-to-string - `(progn - (require 'multisession) - (let ((multisession-directory ,dir) - (multisession-storage 'files) - (user-init-file "/tmp/sfoo.el")) - (define-multisession-variable multisession--sfoo 0 - "" - :synchronized t) - (cl-incf (multisession-value multisession--sfoo)))))) - (should (= (multisession-value multisession--sfoo) 2))))) + (unwind-protect + (progn + (define-multisession-variable multisession--sfoo 0 + "" + :synchronized t) + (skip-unless (multi-test--on-conflict-p)) + (should (= (multisession-value multisession--sfoo) 0)) + (cl-incf (multisession-value multisession--sfoo)) + (should (= (multisession-value multisession--sfoo) 1)) + (call-process + (concat invocation-directory invocation-name) + nil t nil + "-Q" "-batch" + "--eval" (prin1-to-string + `(progn + (require 'multisession) + (let ((multisession-directory ,dir) + (multisession-storage 'files) + (user-init-file "/tmp/sfoo.el")) + (define-multisession-variable multisession--sfoo 0 + "" + :synchronized t) + (cl-incf (multisession-value multisession--sfoo)))))) + (should (= (multisession-value multisession--sfoo) 2))) + (when multisession--db + (sqlite-close multisession--db)) + (setq multisession--db nil))))) (ert-deftest multi-test-files-busy () - (skip-unless (and t (sqlite-available-p))) + (skip-unless (sqlite-available-p)) (ert-with-temp-file dir :directory t (let ((user-init-file "/tmp/foo.el") @@ -168,6 +188,7 @@ multi-test-files-busy (should (< (multisession-value multisession--sbar) 2000))))) (ert-deftest multi-test-files-some-values () + (skip-unless (sqlite-available-p)) (ert-with-temp-file dir :directory t (let ((user-init-file "/tmp/sfoo.el") diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index ae4aacd9c7..dd99b28320 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -21,6 +21,14 @@ (require 'ert) +(defmacro xdisp-tests--visible-buffer (&rest body) + (declare (debug t) (indent 0)) + `(progn + (switch-to-buffer (symbol-name (ert-test-name (ert-running-test)))) + (progn ,@body) + (let (kill-buffer-query-functions) + (kill-buffer (symbol-name (ert-test-name (ert-running-test))))))) + (defmacro xdisp-tests--in-minibuffer (&rest body) (declare (debug t) (indent 0)) `(catch 'result @@ -170,4 +178,62 @@ test-get-display-property (should (equal (get-display-property 2 'height) 2.0)) (should (equal (get-display-property 2 'space-width) 20)))) +(ert-deftest xdisp-tests--reconnoiter-image-height () + "C-v on image extending beyond window should not signal +end-of-buffer." + (skip-unless (not noninteractive)) + (skip-unless (> (window-pixel-height) 300)) + (xdisp-tests--visible-buffer + (dotimes (_ (/ (- (window-pixel-height) 100) (line-pixel-height))) + (insert "line" "\n")) + (insert-image (create-image (expand-file-name + "test/data/image/blank-100x200.png" + source-directory))) + (insert "\n") + (redisplay) + (goto-char (point-min)) + (scroll-up) + (redisplay))) + +(ert-deftest xdisp-tests--scroll-down-leaves-cursor-behind () + "When first line contains accented, and therefore taller +character, e.g., Óscar, scrolling down (moving window-start up) +has resulted in a no-op." + (xdisp-tests--visible-buffer + (insert "Óscar" "\n") + (dotimes (_ (/ (1+ (window-pixel-height)) (line-pixel-height))) + (insert "line" "\n")) + (goto-char (point-max)) + (redisplay) + (scroll-down) + (redisplay) + (should (= (window-start) 1)))) + +(ert-deftest xdisp-tests--window-text-pixel-size-single-sline () + "Verify `window-text-pixel-size' handles one screen line spanned." + (xdisp-tests--visible-buffer + (save-excursion + (insert "xxxx")) + (should (= (* 2 (frame-char-width)) + (car (window-text-pixel-size + nil (1+ (point-min)) (1- (point-max)))))))) + +(ert-deftest xdisp-tests--window-text-pixel-size-display-property () + "Verify `window-text-pixel-size' returns dimensions including +width of display property." + (xdisp-tests--visible-buffer + (let ((disp-string "ornery")) + (save-excursion + (insert "xxxx")) + (should + (= (+ (1- (length disp-string)) + (car (window-text-pixel-size + nil (line-beginning-position) (line-end-position)))) + (progn + (put-text-property (1- (line-end-position)) + (line-end-position) + 'display disp-string) + (car (window-text-pixel-size + nil (line-beginning-position) (line-end-position))))))))) + ;;; xdisp-tests.el ends here -- 2.26.2