aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2021-12-03 14:24:49 +0100
committerMichael Albinus2021-12-03 14:24:49 +0100
commitd3eb3918d4989408ae8b71d39c24924f2f2343c7 (patch)
tree1a7c4be3407f515f22633038ccb19171203cf016
parent76099240119d0137f25b356d64e2c1b70201973e (diff)
parent1431fce67f75e5f0acaa77f508502a00603177de (diff)
downloademacs-d3eb3918d4989408ae8b71d39c24924f2f2343c7.tar.gz
emacs-d3eb3918d4989408ae8b71d39c24924f2f2343c7.zip
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
-rw-r--r--CONTRIBUTE26
-rwxr-xr-xadmin/diff-tar-files4
-rw-r--r--admin/make-tarball.txt33
-rw-r--r--lib-src/Makefile.in4
-rw-r--r--lisp/pixel-scroll.el84
-rw-r--r--lisp/tab-bar.el7
-rw-r--r--src/alloc.c20
-rw-r--r--src/comp.c18
-rw-r--r--src/comp.h10
-rw-r--r--src/data.c10
-rw-r--r--src/eval.c23
-rw-r--r--src/fileio.c4
-rw-r--r--src/lisp.h16
-rw-r--r--src/lread.c12
-rw-r--r--src/pdumper.c40
-rw-r--r--src/xdisp.c57
-rw-r--r--src/xwidget.c3
-rw-r--r--test/lisp/tab-bar-tests.el51
18 files changed, 246 insertions, 176 deletions
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 5740004637b..7c3421ed75a 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -185,20 +185,26 @@ ChangeLog file, where they can be corrected. It saves time to get
185them right the first time, so here are guidelines for formatting them: 185them right the first time, so here are guidelines for formatting them:
186 186
187- Start with a single unindented summary line explaining the change; 187- Start with a single unindented summary line explaining the change;
188 do not end this line with a period. If that line starts with a 188 do not end this line with a period. If possible, try to keep the
189 semicolon and a space "; ", the commit message will be ignored when 189 summary line to 50 characters or fewer; this is for compatibility
190 generating the ChangeLog file. Use this for minor commits that do 190 with certain Git commands that print that line in width-constrained
191 not need separate ChangeLog entries, such as changes in etc/NEWS. 191 contexts.
192 192
193- After the summary line, there should be an empty line, then 193 If the summary line starts with a semicolon and a space "; ", the
194 unindented ChangeLog entries. 194 commit message will be ignored when generating the ChangeLog file.
195 Use this for minor commits that do not need separate ChangeLog
196 entries, such as changes in etc/NEWS.
197
198- After the summary line, there should be an empty line.
199
200- Unindented ChangeLog entries normally come next. However, if the
201 commit couldn't be properly summarized in the brief summary line,
202 you can put a paragraph (after the empty line and before the
203 individual ChangeLog entries) that further describes the commit.
195 204
196- Limit lines in commit messages to 78 characters, unless they consist 205- Limit lines in commit messages to 78 characters, unless they consist
197 of a single word of at most 140 characters; this is enforced by a 206 of a single word of at most 140 characters; this is enforced by a
198 commit hook. It's nicer to limit the summary line to 50 characters; 207 commit hook.
199 this isn't enforced. If the change can't be summarized so briefly,
200 add a paragraph after the empty line and before the individual file
201 descriptions.
202 208
203- If only a single file is changed, the summary line can be the normal 209- If only a single file is changed, the summary line can be the normal
204 file first line (starting with the asterisk). Then there is no 210 file first line (starting with the asterisk). Then there is no
diff --git a/admin/diff-tar-files b/admin/diff-tar-files
index cdcc512ae6b..2fe15401d0d 100755
--- a/admin/diff-tar-files
+++ b/admin/diff-tar-files
@@ -35,7 +35,7 @@ old_tmp=/tmp/old.$$
35new_tmp=/tmp/new.$$ 35new_tmp=/tmp/new.$$
36trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15 36trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15
37 37
38tar tzf "$old_tar" | sed -e 's,^[^/]*,,' | sort > $old_tmp 38tar tf "$old_tar" | sed -e 's,^[^/]*,,' | sort > $old_tmp
39tar tzf "$new_tar" | sed -e 's,^[^/]*,,' | sort > $new_tmp 39tar tf "$new_tar" | sed -e 's,^[^/]*,,' | sort > $new_tmp
40diff -u $old_tmp $new_tmp 40diff -u $old_tmp $new_tmp
41rm -f $new_tmp $old_tmp 41rm -f $new_tmp $old_tmp
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 22276080c5d..872cb00ca28 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -5,7 +5,7 @@ Instructions to create pretest or release tarballs. -*- coding: utf-8 -*-
5 5
6Steps to take before starting on the first pretest in any release sequence: 6Steps to take before starting on the first pretest in any release sequence:
7 7
80. The release branch (e.g. emacs-26) should already have been made 80. The release branch (e.g. emacs-28) should already have been made
9 and you should use it for all that follows. Diffs from this 9 and you should use it for all that follows. Diffs from this
10 branch should be going to the emacs-diffs mailing list. 10 branch should be going to the emacs-diffs mailing list.
11 11
@@ -14,12 +14,13 @@ Steps to take before starting on the first pretest in any release sequence:
14 14
152. Consider increasing the value of the variable 152. Consider increasing the value of the variable
16 'customize-changed-options-previous-release' in cus-edit.el to 16 'customize-changed-options-previous-release' in cus-edit.el to
17 refer to a newer version of Emacs. (This is probably needed only 17 refer to a newer version of Emacs. (This is now done when cutting
18 when preparing the first pretest for a major Emacs release.) 18 the release branch, see admin/release-branch.txt.)
19 Commit cus-edit.el if changed. 19 Commit cus-edit.el if changed.
20 20
213. Remove any old pretests from https://alpha.gnu.org/gnu/emacs/pretest. 213. Remove any old pretests from https://alpha.gnu.org/gnu/emacs/pretest.
22 You can use 'gnupload --delete' (see below for more gnupload details). 22 You can use 'gnupload --delete' (see below for more gnupload details).
23 (We currently don't bother with this.)
23 24
24General steps (for each step, check for possible errors): 25General steps (for each step, check for possible errors):
25 26
@@ -89,7 +90,7 @@ General steps (for each step, check for possible errors):
89 admin/release-process must be completed. 90 admin/release-process must be completed.
90 91
91 Set the version number to that of the actual release (commit in 92 Set the version number to that of the actual release (commit in
92 one, as described above). Pick a date about a week from now when 93 one, as described above). Pick a date about a week from now when
93 you intend to make the release. Use M-x add-release-logs to add 94 you intend to make the release. Use M-x add-release-logs to add
94 entries to etc/HISTORY and the ChangeLog file. It's best not to 95 entries to etc/HISTORY and the ChangeLog file. It's best not to
95 commit these files until the release is actually made. Merge the 96 commit these files until the release is actually made. Merge the
@@ -163,8 +164,15 @@ General steps (for each step, check for possible errors):
163 164
164 If this is the first pretest of a major release, just comparing 165 If this is the first pretest of a major release, just comparing
165 with the previous release may overlook many new files. You can try 166 with the previous release may overlook many new files. You can try
166 something like 'find . | sort' in a clean repository, and compare the 167 something like 'find . | sort' in a clean repository, and
167 results against the new tar contents. 168 compare the results against the new tar contents. Another
169 alternative is using something like:
170
171 tar cf - emacs-NEW | tar t -C /tmp | grep -Ev "\.(o|d)$" | sort
172
173 Where emacs-NEW is the directory containing your clean repository.
174 The output of this command might be easier to compare to the
175 tarball than the one you get from find.
168 176
1697. tar -xf emacs-NEW.tar; cd emacs-NEW 1777. tar -xf emacs-NEW.tar; cd emacs-NEW
170 ./configure --prefix=/tmp/emacs && make check && make install 178 ./configure --prefix=/tmp/emacs && make check && make install
@@ -194,6 +202,14 @@ General steps (for each step, check for possible errors):
194 git tag -a TAG -m "Emacs TAG" SHA1 202 git tag -a TAG -m "Emacs TAG" SHA1
195 git push --tags 203 git push --tags
196 204
205 In the past, we were not always consistent with the annotation
206 (i.e. -m "Emacs TAG"). The preferred format is like this for a
207 pretest, release candidate and final release:
208
209 git tag -a emacs-28.0.90 -m "Emacs 28.0.90 pretest"
210 git tag -a emacs-28.1-rc1 -m "Emacs 28.1 RC1"
211 git tag -a emacs-28.1 -m "Emacs 28.1 release"
212
1979. Decide what compression schemes to offer. 2139. Decide what compression schemes to offer.
198 For a release, at least gz and xz: 214 For a release, at least gz and xz:
199 gzip --best --no-name -c emacs-NEW.tar > emacs-NEW.tar.gz 215 gzip --best --no-name -c emacs-NEW.tar > emacs-NEW.tar.gz
@@ -256,6 +272,11 @@ General steps (for each step, check for possible errors):
256 because replies that invariably are not announcements also get 272 because replies that invariably are not announcements also get
257 sent out as if they were.) 273 sent out as if they were.)
258 274
275 To create the included SHA1 and SHA256 checksums, run:
276
277 sha1sum emacs-NEW.tar.xz
278 sha256sum emacs-NEW.tar.xz
279
25912. After a release, update the Emacs pages as described below. 28012. After a release, update the Emacs pages as described below.
260 281
26113. Bump the Emacs version on the release branch. 28213. Bump the Emacs version on the release branch.
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index d062e78366f..c07b678839c 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -195,6 +195,8 @@ LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
195LIB_GETRANDOM = @LIB_GETRANDOM@ 195LIB_GETRANDOM = @LIB_GETRANDOM@
196## Whatever libraries are needed for euidaccess 196## Whatever libraries are needed for euidaccess
197LIB_EACCESS=@LIB_EACCESS@ 197LIB_EACCESS=@LIB_EACCESS@
198## Libraries needed for file_has_acl
199LIB_HAS_ACL=@LIB_HAS_ACL@
198## empty or -lwsock2 for MinGW 200## empty or -lwsock2 for MinGW
199LIB_WSOCK32=@LIB_WSOCK32@ 201LIB_WSOCK32=@LIB_WSOCK32@
200 202
@@ -418,7 +420,7 @@ pop.o: ${srcdir}/pop.c ${srcdir}/pop.h ${srcdir}/../lib/min-max.h $(config_h)
418emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h) 420emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h)
419 $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< \ 421 $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< \
420 $(NTLIB) $(LOADLIBES) \ 422 $(NTLIB) $(LOADLIBES) \
421 $(LIB_WSOCK32) $(LIB_EACCESS) $(LIBS_ECLIENT) -o $@ 423 $(LIB_WSOCK32) $(LIB_EACCESS) $(LIB_HAS_ACL) $(LIBS_ECLIENT) -o $@
422 424
423emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h) 425emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES) $(config_h)
424 $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \ 426 $(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index a45a4d41c33..1c2d95613e5 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -109,14 +109,26 @@ This is only effective if supported by your mouse or touchpad."
109 :type 'boolean 109 :type 'boolean
110 :version "29.1") 110 :version "29.1")
111 111
112(defcustom pixel-scroll-precision-momentum-tick 0.16 112(defcustom pixel-scroll-precision-momentum-tick 0.01
113 "Number of seconds between each momentum scroll." 113 "Number of seconds between each momentum scroll."
114 :group 'mouse 114 :group 'mouse
115 :type 'float 115 :type 'float
116 :version "29.1") 116 :version "29.1")
117 117
118(defcustom pixel-scroll-precision-momentum-factor 0.95 118(defcustom pixel-scroll-precision-momentum-seconds 1.75
119 "Factor by which to reduce scroll velocity on each momentum scroll" 119 "The maximum duration in seconds of momentum scrolling."
120 :group 'mouse
121 :type 'float
122 :version "29.1")
123
124(defcustom pixel-scroll-precision-momentum-min-velocity 10.0
125 "The minimum scrolled pixels per second before momentum scrolling starts."
126 :group 'mouse
127 :type 'float
128 :version "29.1")
129
130(defcustom pixel-scroll-precision-initial-velocity-factor 0.25
131 "Factor applied to the initial velocity before momentum scrolling begins."
120 :group 'mouse 132 :group 'mouse
121 :type 'float 133 :type 'float
122 :version "29.1") 134 :version "29.1")
@@ -518,8 +530,13 @@ It is a vector of the form [ VELOCITY TIME ]."
518(defun pixel-scroll-accumulate-velocity (delta) 530(defun pixel-scroll-accumulate-velocity (delta)
519 "Accumulate DELTA into the current window's kinetic scroll state." 531 "Accumulate DELTA into the current window's kinetic scroll state."
520 (let* ((state (pixel-scroll-kinetic-state)) 532 (let* ((state (pixel-scroll-kinetic-state))
533 (ring (aref state 0))
521 (time (aref state 1))) 534 (time (aref state 1)))
522 (when (and time (> (- (float-time) time) 0.5)) 535 (when (or (and time (> (- (float-time) time) 0.5))
536 (and (not (ring-empty-p ring))
537 (not (eq (< delta 0)
538 (< (cdr (ring-ref ring 0))
539 0)))))
523 (aset state 0 (make-ring 10))) 540 (aset state 0 (make-ring 10)))
524 (ring-insert (aref state 0) 541 (ring-insert (aref state 0)
525 (cons (aset state 1 (float-time)) 542 (cons (aset state 1 (float-time))
@@ -532,8 +549,7 @@ It is a vector of the form [ VELOCITY TIME ]."
532 (total 0)) 549 (total 0))
533 (dolist (tem elts) 550 (dolist (tem elts)
534 (setq total (+ total (cdr tem)))) 551 (setq total (+ total (cdr tem))))
535 (/ total (* (- (caar elts) 552 (/ total (* (- (float-time) (caar elts))
536 (caar (last elts)))
537 100)))) 553 100))))
538 554
539(defun pixel-scroll-start-momentum (event) 555(defun pixel-scroll-start-momentum (event)
@@ -546,25 +562,45 @@ It is a vector of the form [ VELOCITY TIME ]."
546 (setq state (pixel-scroll-kinetic-state)) 562 (setq state (pixel-scroll-kinetic-state))
547 (when (and (aref state 1) 563 (when (and (aref state 1)
548 (listp (aref state 0))) 564 (listp (aref state 0)))
549 (unwind-protect (progn 565 (while-no-input
550 (aset state 0 566 (unwind-protect (progn
551 (/ (pixel-scroll-calculate-velocity state) 2)) 567 (aset state 0 (pixel-scroll-calculate-velocity state))
552 (let ((velocity (aref state 0))) 568 (when (> (abs (aref state 0))
553 (if (> velocity 0) 569 pixel-scroll-precision-momentum-min-velocity)
554 (while (> velocity 1) 570 (let* ((velocity (* (aref state 0)
555 (pixel-scroll-precision-scroll-up (round velocity)) 571 pixel-scroll-precision-initial-velocity-factor))
556 (setq velocity (* velocity 572 (original-velocity velocity)
557 pixel-scroll-precision-momentum-factor)) 573 (time-spent 0))
574 (if (> velocity 0)
575 (while (and (> velocity 0)
576 (<= time-spent
577 pixel-scroll-precision-momentum-seconds))
578 (when (> (round velocity) 0)
579 (pixel-scroll-precision-scroll-up (round velocity)))
580 (setq velocity (- velocity
581 (/ original-velocity
582 (/ pixel-scroll-precision-momentum-seconds
583 pixel-scroll-precision-momentum-tick))))
584 (redisplay t)
585 (sit-for pixel-scroll-precision-momentum-tick)
586 (setq time-spent (+ time-spent
587 pixel-scroll-precision-momentum-tick))))
588 (while (and (< velocity 0)
589 (<= time-spent
590 pixel-scroll-precision-momentum-seconds))
591 (when (> (round (abs velocity)) 0)
592 (pixel-scroll-precision-scroll-down (round
593 (abs velocity))))
594 (setq velocity (+ velocity
595 (/ (abs original-velocity)
596 (/ pixel-scroll-precision-momentum-seconds
597 pixel-scroll-precision-momentum-tick))))
558 (redisplay t) 598 (redisplay t)
559 (sit-for pixel-scroll-precision-momentum-tick))) 599 (sit-for pixel-scroll-precision-momentum-tick)
560 (while (< velocity -1) 600 (setq time-spent (+ time-spent
561 (pixel-scroll-precision-scroll-down (round (abs velocity))) 601 pixel-scroll-precision-momentum-tick))))))
562 (setq velocity (* velocity 602 (aset state 0 (make-ring 10))
563 pixel-scroll-precision-momentum-factor)) 603 (aset state 1 nil))))))))
564 (redisplay t)
565 (sit-for pixel-scroll-precision-momentum-tick))))
566 (aset state 0 (make-ring 10))
567 (aset state 1 nil)))))))
568 604
569;;;###autoload 605;;;###autoload
570(define-minor-mode pixel-scroll-precision-mode 606(define-minor-mode pixel-scroll-precision-mode
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 656cb878e3e..7a5221d83ab 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1586,18 +1586,17 @@ happens interactively)."
1586 (let* ((tabs (funcall tab-bar-tabs-function)) 1586 (let* ((tabs (funcall tab-bar-tabs-function))
1587 (current-index (tab-bar--current-tab-index tabs)) 1587 (current-index (tab-bar--current-tab-index tabs))
1588 (keep-index (if (integerp tab-number) 1588 (keep-index (if (integerp tab-number)
1589 (1- (max 0 (min tab-number (length tabs)))) 1589 (1- (max 1 (min tab-number (length tabs))))
1590 current-index)) 1590 current-index))
1591 (keep-tab (nth keep-index tabs))
1592 (index 0)) 1591 (index 0))
1593 1592
1594 (when keep-tab 1593 (when (nth keep-index tabs)
1595 (unless (eq keep-index current-index) 1594 (unless (eq keep-index current-index)
1596 (tab-bar-select-tab (1+ keep-index)) 1595 (tab-bar-select-tab (1+ keep-index))
1597 (setq tabs (funcall tab-bar-tabs-function))) 1596 (setq tabs (funcall tab-bar-tabs-function)))
1598 1597
1599 (dolist (tab tabs) 1598 (dolist (tab tabs)
1600 (unless (or (eq tab keep-tab) 1599 (unless (or (eq index keep-index)
1601 (run-hook-with-args-until-success 1600 (run-hook-with-args-until-success
1602 'tab-bar-tab-prevent-close-functions tab 1601 'tab-bar-tab-prevent-close-functions tab
1603 ;; `last-tab-p' logically can't ever be true 1602 ;; `last-tab-p' logically can't ever be true
diff --git a/src/alloc.c b/src/alloc.c
index f8908c91dba..55c30847bbf 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3160,26 +3160,26 @@ cleanup_vector (struct Lisp_Vector *vector)
3160 module_finalize_function (function); 3160 module_finalize_function (function);
3161 } 3161 }
3162#endif 3162#endif
3163 else if (NATIVE_COMP_FLAG 3163#ifdef HAVE_NATIVE_COMP
3164 && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) 3164 else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT))
3165 { 3165 {
3166 struct Lisp_Native_Comp_Unit *cu = 3166 struct Lisp_Native_Comp_Unit *cu =
3167 PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); 3167 PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
3168 unload_comp_unit (cu); 3168 unload_comp_unit (cu);
3169 } 3169 }
3170 else if (NATIVE_COMP_FLAG 3170 else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR))
3171 && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR))
3172 { 3171 {
3173 struct Lisp_Subr *subr = 3172 struct Lisp_Subr *subr =
3174 PSEUDOVEC_STRUCT (vector, Lisp_Subr); 3173 PSEUDOVEC_STRUCT (vector, Lisp_Subr);
3175 if (!NILP (subr->native_comp_u[0])) 3174 if (!NILP (subr->native_comp_u))
3176 { 3175 {
3177 /* FIXME Alternative and non invasive solution to this 3176 /* FIXME Alternative and non invasive solution to this
3178 cast? */ 3177 cast? */
3179 xfree ((char *)subr->symbol_name); 3178 xfree ((char *)subr->symbol_name);
3180 xfree (subr->native_c_name[0]); 3179 xfree (subr->native_c_name);
3181 } 3180 }
3182 } 3181 }
3182#endif
3183} 3183}
3184 3184
3185/* Reclaim space used by unmarked vectors. */ 3185/* Reclaim space used by unmarked vectors. */
@@ -6785,15 +6785,17 @@ mark_object (Lisp_Object arg)
6785 break; 6785 break;
6786 6786
6787 case PVEC_SUBR: 6787 case PVEC_SUBR:
6788#ifdef HAVE_NATIVE_COMP
6788 if (SUBR_NATIVE_COMPILEDP (obj)) 6789 if (SUBR_NATIVE_COMPILEDP (obj))
6789 { 6790 {
6790 set_vector_marked (ptr); 6791 set_vector_marked (ptr);
6791 struct Lisp_Subr *subr = XSUBR (obj); 6792 struct Lisp_Subr *subr = XSUBR (obj);
6792 mark_object (subr->native_intspec); 6793 mark_object (subr->native_intspec);
6793 mark_object (subr->native_comp_u[0]); 6794 mark_object (subr->native_comp_u);
6794 mark_object (subr->lambda_list[0]); 6795 mark_object (subr->lambda_list);
6795 mark_object (subr->type[0]); 6796 mark_object (subr->type);
6796 } 6797 }
6798#endif
6797 break; 6799 break;
6798 6800
6799 case PVEC_FREE: 6801 case PVEC_FREE:
diff --git a/src/comp.c b/src/comp.c
index 7bb160e4f0a..fb9b1a5a2d8 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -5136,21 +5136,29 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg,
5136 if (CONSP (minarg)) 5136 if (CONSP (minarg))
5137 { 5137 {
5138 /* Dynamic code. */ 5138 /* Dynamic code. */
5139 x->s.lambda_list[0] = maxarg; 5139#ifdef HAVE_NATIVE_COMP
5140 x->s.lambda_list = maxarg;
5141#endif
5140 maxarg = XCDR (minarg); 5142 maxarg = XCDR (minarg);
5141 minarg = XCAR (minarg); 5143 minarg = XCAR (minarg);
5142 } 5144 }
5143 else 5145 else
5144 x->s.lambda_list[0] = Qnil; 5146 {
5147#ifdef HAVE_NATIVE_COMP
5148 x->s.lambda_list = Qnil;
5149#endif
5150 }
5145 x->s.function.a0 = func; 5151 x->s.function.a0 = func;
5146 x->s.min_args = XFIXNUM (minarg); 5152 x->s.min_args = XFIXNUM (minarg);
5147 x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; 5153 x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY;
5148 x->s.symbol_name = xstrdup (SSDATA (symbol_name)); 5154 x->s.symbol_name = xstrdup (SSDATA (symbol_name));
5149 x->s.native_intspec = intspec; 5155 x->s.native_intspec = intspec;
5150 x->s.doc = XFIXNUM (doc_idx); 5156 x->s.doc = XFIXNUM (doc_idx);
5151 x->s.native_comp_u[0] = comp_u; 5157#ifdef HAVE_NATIVE_COMP
5152 x->s.native_c_name[0] = xstrdup (SSDATA (c_name)); 5158 x->s.native_comp_u = comp_u;
5153 x->s.type[0] = type; 5159 x->s.native_c_name = xstrdup (SSDATA (c_name));
5160 x->s.type = type;
5161#endif
5154 Lisp_Object tem; 5162 Lisp_Object tem;
5155 XSETSUBR (tem, &x->s); 5163 XSETSUBR (tem, &x->s);
5156 5164
diff --git a/src/comp.h b/src/comp.h
index c4af4193d0b..96bb52a14bc 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -20,16 +20,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
20#ifndef COMP_H 20#ifndef COMP_H
21#define COMP_H 21#define COMP_H
22 22
23/* To keep ifdefs under control. */
24enum {
25 NATIVE_COMP_FLAG =
26#ifdef HAVE_NATIVE_COMP
27 1
28#else
29 0
30#endif
31};
32
33#include <dynlib.h> 23#include <dynlib.h>
34 24
35struct Lisp_Native_Comp_Unit 25struct Lisp_Native_Comp_Unit
diff --git a/src/data.c b/src/data.c
index 0d3376f0903..b2c395831ae 100644
--- a/src/data.c
+++ b/src/data.c
@@ -891,9 +891,11 @@ function or t otherwise. */)
891{ 891{
892 CHECK_SUBR (subr); 892 CHECK_SUBR (subr);
893 893
894 return SUBR_NATIVE_COMPILED_DYNP (subr) 894#ifdef HAVE_NATIVE_COMP
895 ? XSUBR (subr)->lambda_list[0] 895 if (SUBR_NATIVE_COMPILED_DYNP (subr))
896 : Qt; 896 return XSUBR (subr)->lambda_list;
897#endif
898 return Qt;
897} 899}
898 900
899DEFUN ("subr-type", Fsubr_type, 901DEFUN ("subr-type", Fsubr_type,
@@ -917,7 +919,7 @@ DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit,
917 (Lisp_Object subr) 919 (Lisp_Object subr)
918{ 920{
919 CHECK_SUBR (subr); 921 CHECK_SUBR (subr);
920 return XSUBR (subr)->native_comp_u[0]; 922 return XSUBR (subr)->native_comp_u;
921} 923}
922 924
923DEFUN ("native-comp-unit-file", Fnative_comp_unit_file, 925DEFUN ("native-comp-unit-file", Fnative_comp_unit_file,
diff --git a/src/eval.c b/src/eval.c
index 94ad0607732..fe29564aa2d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -220,17 +220,14 @@ void
220init_eval_once (void) 220init_eval_once (void)
221{ 221{
222 /* Don't forget to update docs (lispref node "Local Variables"). */ 222 /* Don't forget to update docs (lispref node "Local Variables"). */
223 if (!NATIVE_COMP_FLAG) 223#ifndef HAVE_NATIVE_COMP
224 { 224 max_specpdl_size = 1800; /* See bug#46818. */
225 max_specpdl_size = 1800; /* See bug#46818. */ 225 max_lisp_eval_depth = 800;
226 max_lisp_eval_depth = 800; 226#else
227 } 227 /* Original values increased for comp.el. */
228 else 228 max_specpdl_size = 2500;
229 { 229 max_lisp_eval_depth = 1600;
230 /* Original values increased for comp.el. */ 230#endif
231 max_specpdl_size = 2500;
232 max_lisp_eval_depth = 1600;
233 }
234 Vrun_hooks = Qnil; 231 Vrun_hooks = Qnil;
235 pdumper_do_now_and_after_load (init_eval_once_for_pdumper); 232 pdumper_do_now_and_after_load (init_eval_once_for_pdumper);
236} 233}
@@ -3278,11 +3275,13 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
3278 else if (MODULE_FUNCTIONP (fun)) 3275 else if (MODULE_FUNCTIONP (fun))
3279 return funcall_module (fun, nargs, arg_vector); 3276 return funcall_module (fun, nargs, arg_vector);
3280#endif 3277#endif
3278#ifdef HAVE_NATIVE_COMP
3281 else if (SUBR_NATIVE_COMPILED_DYNP (fun)) 3279 else if (SUBR_NATIVE_COMPILED_DYNP (fun))
3282 { 3280 {
3283 syms_left = XSUBR (fun)->lambda_list[0]; 3281 syms_left = XSUBR (fun)->lambda_list;
3284 lexenv = Qnil; 3282 lexenv = Qnil;
3285 } 3283 }
3284#endif
3286 else 3285 else
3287 emacs_abort (); 3286 emacs_abort ();
3288 3287
diff --git a/src/fileio.c b/src/fileio.c
index 859b30564aa..12ece586b83 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -2386,7 +2386,9 @@ permissions. */)
2386 2386
2387 if (!NILP (keep_time)) 2387 if (!NILP (keep_time))
2388 { 2388 {
2389 struct timespec ts[] = { get_stat_atime (&st), get_stat_mtime (&st) }; 2389 struct timespec ts[2];
2390 ts[0] = get_stat_atime (&st);
2391 ts[1] = get_stat_mtime (&st);
2390 if (futimens (ofd, ts) != 0) 2392 if (futimens (ofd, ts) != 0)
2391 xsignal2 (Qfile_date_error, 2393 xsignal2 (Qfile_date_error,
2392 build_string ("Cannot set file date"), newname); 2394 build_string ("Cannot set file date"), newname);
diff --git a/src/lisp.h b/src/lisp.h
index 19caba40014..242156bbcb8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2091,10 +2091,12 @@ struct Lisp_Subr
2091 Lisp_Object native_intspec; 2091 Lisp_Object native_intspec;
2092 }; 2092 };
2093 EMACS_INT doc; 2093 EMACS_INT doc;
2094 Lisp_Object native_comp_u[NATIVE_COMP_FLAG]; 2094#ifdef HAVE_NATIVE_COMP
2095 char *native_c_name[NATIVE_COMP_FLAG]; 2095 Lisp_Object native_comp_u;
2096 Lisp_Object lambda_list[NATIVE_COMP_FLAG]; 2096 char *native_c_name;
2097 Lisp_Object type[NATIVE_COMP_FLAG]; 2097 Lisp_Object lambda_list;
2098 Lisp_Object type;
2099#endif
2098 } GCALIGNED_STRUCT; 2100 } GCALIGNED_STRUCT;
2099union Aligned_Lisp_Subr 2101union Aligned_Lisp_Subr
2100 { 2102 {
@@ -4786,19 +4788,19 @@ extern char *emacs_root_dir (void);
4786INLINE bool 4788INLINE bool
4787SUBR_NATIVE_COMPILEDP (Lisp_Object a) 4789SUBR_NATIVE_COMPILEDP (Lisp_Object a)
4788{ 4790{
4789 return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u[0]); 4791 return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u);
4790} 4792}
4791 4793
4792INLINE bool 4794INLINE bool
4793SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a) 4795SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a)
4794{ 4796{
4795 return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list[0]); 4797 return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list);
4796} 4798}
4797 4799
4798INLINE Lisp_Object 4800INLINE Lisp_Object
4799SUBR_TYPE (Lisp_Object a) 4801SUBR_TYPE (Lisp_Object a)
4800{ 4802{
4801 return XSUBR (a)->type[0]; 4803 return XSUBR (a)->type;
4802} 4804}
4803 4805
4804INLINE struct Lisp_Native_Comp_Unit * 4806INLINE struct Lisp_Native_Comp_Unit *
diff --git a/src/lread.c b/src/lread.c
index 2e63ec48912..5a2f1bc54e5 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1279,7 +1279,10 @@ Return t if the file exists and loads successfully. */)
1279 || suffix_p (file, MODULES_SECONDARY_SUFFIX) 1279 || suffix_p (file, MODULES_SECONDARY_SUFFIX)
1280#endif 1280#endif
1281#endif 1281#endif
1282 || (NATIVE_COMP_FLAG && suffix_p (file, NATIVE_ELISP_SUFFIX))) 1282#ifdef HAVE_NATIVE_COMP
1283 || suffix_p (file, NATIVE_ELISP_SUFFIX)
1284#endif
1285 )
1283 must_suffix = Qnil; 1286 must_suffix = Qnil;
1284 /* Don't insist on adding a suffix 1287 /* Don't insist on adding a suffix
1285 if the argument includes a directory name. */ 1288 if the argument includes a directory name. */
@@ -1359,8 +1362,11 @@ Return t if the file exists and loads successfully. */)
1359 bool is_module = false; 1362 bool is_module = false;
1360#endif 1363#endif
1361 1364
1362 bool is_native_elisp = 1365#ifdef HAVE_NATIVE_COMP
1363 NATIVE_COMP_FLAG && suffix_p (found, NATIVE_ELISP_SUFFIX) ? true : false; 1366 bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX);
1367#else
1368 bool is_native_elisp = false;
1369#endif
1364 1370
1365 /* Check if we're stuck in a recursive load cycle. 1371 /* Check if we're stuck in a recursive load cycle.
1366 1372
diff --git a/src/pdumper.c b/src/pdumper.c
index 9eff5c48d09..02956aa7cec 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2860,13 +2860,18 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
2860 struct Lisp_Subr out; 2860 struct Lisp_Subr out;
2861 dump_object_start (ctx, &out, sizeof (out)); 2861 dump_object_start (ctx, &out, sizeof (out));
2862 DUMP_FIELD_COPY (&out, subr, header.size); 2862 DUMP_FIELD_COPY (&out, subr, header.size);
2863 if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0])) 2863#ifdef HAVE_NATIVE_COMP
2864 bool native_comp = !NILP (subr->native_comp_u);
2865#else
2866 bool native_comp = false;
2867#endif
2868 if (native_comp)
2864 out.function.a0 = NULL; 2869 out.function.a0 = NULL;
2865 else 2870 else
2866 dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); 2871 dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
2867 DUMP_FIELD_COPY (&out, subr, min_args); 2872 DUMP_FIELD_COPY (&out, subr, min_args);
2868 DUMP_FIELD_COPY (&out, subr, max_args); 2873 DUMP_FIELD_COPY (&out, subr, max_args);
2869 if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0])) 2874 if (native_comp)
2870 { 2875 {
2871 dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); 2876 dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
2872 dump_remember_cold_op (ctx, 2877 dump_remember_cold_op (ctx,
@@ -2880,19 +2885,16 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
2880 dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); 2885 dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
2881 } 2886 }
2882 DUMP_FIELD_COPY (&out, subr, doc); 2887 DUMP_FIELD_COPY (&out, subr, doc);
2883 if (NATIVE_COMP_FLAG) 2888#ifdef HAVE_NATIVE_COMP
2884 { 2889 dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL);
2885 dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL); 2890 if (!NILP (subr->native_comp_u))
2886 if (!NILP (subr->native_comp_u[0])) 2891 dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name);
2887 dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name[0]);
2888 2892
2889 dump_field_lv (ctx, &out, subr, &subr->lambda_list[0], WEIGHT_NORMAL); 2893 dump_field_lv (ctx, &out, subr, &subr->lambda_list, WEIGHT_NORMAL);
2890 dump_field_lv (ctx, &out, subr, &subr->type[0], WEIGHT_NORMAL); 2894 dump_field_lv (ctx, &out, subr, &subr->type, WEIGHT_NORMAL);
2891 } 2895#endif
2892 dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); 2896 dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
2893 if (NATIVE_COMP_FLAG 2897 if (native_comp && ctx->flags.dump_object_contents)
2894 && ctx->flags.dump_object_contents
2895 && !NILP (subr->native_comp_u[0]))
2896 /* We'll do the final addr relocation during VERY_LATE_RELOCS time 2898 /* We'll do the final addr relocation during VERY_LATE_RELOCS time
2897 after the compilation units has been loaded. */ 2899 after the compilation units has been loaded. */
2898 dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], 2900 dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
@@ -3422,9 +3424,9 @@ dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr)
3422 3424
3423 dump_remember_fixup_ptr_raw 3425 dump_remember_fixup_ptr_raw
3424 (ctx, 3426 (ctx,
3425 subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name[0]), 3427 subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name),
3426 ctx->offset); 3428 ctx->offset);
3427 const char *c_name = XSUBR (subr)->native_c_name[0]; 3429 const char *c_name = XSUBR (subr)->native_c_name;
3428 dump_write (ctx, c_name, 1 + strlen (c_name)); 3430 dump_write (ctx, c_name, 1 + strlen (c_name));
3429} 3431}
3430#endif 3432#endif
@@ -5361,20 +5363,16 @@ dump_do_dump_relocation (const uintptr_t dump_base,
5361 } 5363 }
5362 case RELOC_NATIVE_SUBR: 5364 case RELOC_NATIVE_SUBR:
5363 { 5365 {
5364 if (!NATIVE_COMP_FLAG)
5365 /* This cannot happen. */
5366 emacs_abort ();
5367
5368 /* When resurrecting from a dump given non all the original 5366 /* When resurrecting from a dump given non all the original
5369 native compiled subrs may be still around we can't rely on 5367 native compiled subrs may be still around we can't rely on
5370 a 'top_level_run' mechanism, we revive them one-by-one 5368 a 'top_level_run' mechanism, we revive them one-by-one
5371 here. */ 5369 here. */
5372 struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset); 5370 struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset);
5373 struct Lisp_Native_Comp_Unit *comp_u = 5371 struct Lisp_Native_Comp_Unit *comp_u =
5374 XNATIVE_COMP_UNIT (subr->native_comp_u[0]); 5372 XNATIVE_COMP_UNIT (subr->native_comp_u);
5375 if (!comp_u->handle) 5373 if (!comp_u->handle)
5376 error ("NULL handle in compilation unit %s", SSDATA (comp_u->file)); 5374 error ("NULL handle in compilation unit %s", SSDATA (comp_u->file));
5377 const char *c_name = subr->native_c_name[0]; 5375 const char *c_name = subr->native_c_name;
5378 eassert (c_name); 5376 eassert (c_name);
5379 void *func = dynlib_sym (comp_u->handle, c_name); 5377 void *func = dynlib_sym (comp_u->handle, c_name);
5380 if (!func) 5378 if (!func)
diff --git a/src/xdisp.c b/src/xdisp.c
index 80c8457795d..9f93799783d 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -28812,21 +28812,6 @@ normal_char_height (struct font *font, int c)
28812 return ascent + descent; 28812 return ascent + descent;
28813} 28813}
28814 28814
28815/* Return the "standard" pixel width of a character from FACE's font,
28816 if the font is fixed-pitch, zero otherwise. */
28817static int
28818get_normal_width (struct face *face)
28819{
28820 struct font *ascii_font = face->ascii_face->font;
28821 /* Heuristics: fixed-pitch fonts have the value of MAX-WIDTH not
28822 much larger than AVERAGE-WIDTH. */
28823 bool fixed_pitch =
28824 ascii_font->average_width == ascii_font->space_width
28825 && ascii_font->average_width != 0
28826 && ascii_font->max_width < 3 * ascii_font->average_width;
28827 return fixed_pitch ? ascii_font->space_width : 0;
28828}
28829
28830/* EXPORT for RIF: 28815/* EXPORT for RIF:
28831 Set *LEFT and *RIGHT to the left and right overhang of GLYPH on 28816 Set *LEFT and *RIGHT to the left and right overhang of GLYPH on
28832 frame F. Overhangs of glyphs other than type CHAR_GLYPH are 28817 frame F. Overhangs of glyphs other than type CHAR_GLYPH are
@@ -30924,17 +30909,6 @@ gui_produce_glyphs (struct it *it)
30924 it->phys_ascent = pcm->ascent + boff; 30909 it->phys_ascent = pcm->ascent + boff;
30925 it->phys_descent = pcm->descent - boff; 30910 it->phys_descent = pcm->descent - boff;
30926 it->pixel_width = pcm->width; 30911 it->pixel_width = pcm->width;
30927 if (align_columns_display)
30928 {
30929 int unit_width = get_normal_width (face);
30930 if (unit_width > 0)
30931 {
30932 int ncolumns =
30933 (it->pixel_width - 1 + unit_width) / unit_width;
30934
30935 it->pixel_width = ncolumns * unit_width;
30936 }
30937 }
30938 /* Don't use font-global values for ascent and descent 30912 /* Don't use font-global values for ascent and descent
30939 if they result in an exceedingly large line height. */ 30913 if they result in an exceedingly large line height. */
30940 if (it->override_ascent < 0) 30914 if (it->override_ascent < 0)
@@ -31512,17 +31486,6 @@ gui_produce_glyphs (struct it *it)
31512 it->glyph_row->contains_overlapping_glyphs_p = true; 31486 it->glyph_row->contains_overlapping_glyphs_p = true;
31513 31487
31514 it->pixel_width = cmp->pixel_width; 31488 it->pixel_width = cmp->pixel_width;
31515 if (align_columns_display)
31516 {
31517 int unit_width = get_normal_width (face);
31518 if (unit_width > 0)
31519 {
31520 int ncolumns =
31521 (it->pixel_width - 1 + unit_width) / unit_width;
31522
31523 it->pixel_width = ncolumns * unit_width;
31524 }
31525 }
31526 it->ascent = it->phys_ascent = cmp->ascent; 31489 it->ascent = it->phys_ascent = cmp->ascent;
31527 it->descent = it->phys_descent = cmp->descent; 31490 it->descent = it->phys_descent = cmp->descent;
31528 IT_APPLY_FACE_BOX(it, face); 31491 IT_APPLY_FACE_BOX(it, face);
@@ -31568,17 +31531,6 @@ gui_produce_glyphs (struct it *it)
31568 it->glyph_row->contains_overlapping_glyphs_p = true; 31531 it->glyph_row->contains_overlapping_glyphs_p = true;
31569 it->ascent = it->phys_ascent = metrics.ascent; 31532 it->ascent = it->phys_ascent = metrics.ascent;
31570 it->descent = it->phys_descent = metrics.descent; 31533 it->descent = it->phys_descent = metrics.descent;
31571 if (align_columns_display)
31572 {
31573 int unit_width = get_normal_width (face);
31574 if (unit_width > 0)
31575 {
31576 int ncolumns =
31577 (it->pixel_width - 1 + unit_width) / unit_width;
31578
31579 it->pixel_width = ncolumns * unit_width;
31580 }
31581 }
31582 } 31534 }
31583 IT_APPLY_FACE_BOX(it, face); 31535 IT_APPLY_FACE_BOX(it, face);
31584 31536
@@ -35655,15 +35607,6 @@ variable are ignored and the default 0.25 is used instead. */);
35655Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */); 35607Value is a number or a cons (WIDTH-DPI . HEIGHT-DPI). */);
35656 Vdisplay_pixels_per_inch = make_float (72.0); 35608 Vdisplay_pixels_per_inch = make_float (72.0);
35657 35609
35658 DEFVAR_BOOL ("align-columns-display", align_columns_display,
35659 doc: /* Whether to align columns on GUI frames.
35660If this is non-nil characters displayed on GUI frames will be
35661aligned to produce straight columns. This is achieved by
35662enlarging the pixel width of characters to an integral
35663multiple of pixels taken by ASCII characters of the same face.
35664This affects only fixed-pitch fonts. */);
35665 align_columns_display = false;
35666
35667#ifdef GLYPH_DEBUG 35610#ifdef GLYPH_DEBUG
35668 DEFVAR_INT ("debug-end-pos", debug_end_pos, doc: /* Don't ask. */); 35611 DEFVAR_INT ("debug-end-pos", debug_end_pos, doc: /* Don't ask. */);
35669#endif 35612#endif
diff --git a/src/xwidget.c b/src/xwidget.c
index a5b96d01100..9b9f364ce40 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -1098,6 +1098,9 @@ xwidget_scroll (struct xwidget_view *view, double x, double y,
1098 xg_event->scroll.delta_y = dy; 1098 xg_event->scroll.delta_y = dy;
1099 xg_event->scroll.device = find_suitable_pointer (view->frame); 1099 xg_event->scroll.device = find_suitable_pointer (view->frame);
1100 1100
1101 if (!(fabs (dx) > 0) || !(fabs (dy) > 0))
1102 xg_event->scroll.is_stop = TRUE;
1103
1101 g_object_ref (xg_event->any.window); 1104 g_object_ref (xg_event->any.window);
1102 1105
1103 gtk_main_do_event (xg_event); 1106 gtk_main_do_event (xg_event);
diff --git a/test/lisp/tab-bar-tests.el b/test/lisp/tab-bar-tests.el
new file mode 100644
index 00000000000..7212ce89167
--- /dev/null
+++ b/test/lisp/tab-bar-tests.el
@@ -0,0 +1,51 @@
1;;; tab-bar-tests.el --- Tests for tab-bar.el -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2021 Free Software Foundation, Inc.
4
5;; Author: Juri Linkov <juri@linkov.net>
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
21
22;;; Code:
23
24(require 'ert)
25
26(defun tab-bar-tests-close-other-tabs (arg)
27 (tab-bar-tabs-set nil)
28 (tab-rename "1")
29 (tab-new) (tab-rename "2") ;; (tab-switch "2")
30 (tab-new) (tab-rename "3") ;; (tab-switch "3")
31 (should (eq (length (tab-bar-tabs)) 3))
32 (should (equal (alist-get 'name (tab-bar--current-tab-find)) "3"))
33 (tab-bar-close-other-tabs arg)
34 (should (equal (alist-get 'name (tab-bar--current-tab-find))
35 (if arg (number-to-string (max 1 (min arg 3))) "3")))
36 (should (eq (length (tab-bar-tabs)) 1))
37 (should (eq (length tab-bar-closed-tabs) 2))
38 (tab-undo)
39 (tab-undo)
40 (should (equal (tab-undo) "No more closed tabs to undo"))
41 (should (eq (length (tab-bar-tabs)) 3))
42 (should (eq (length tab-bar-closed-tabs) 0)))
43
44(ert-deftest tab-bar-tests-close-other-tabs-default ()
45 (tab-bar-tests-close-other-tabs nil))
46
47(ert-deftest tab-bar-tests-close-other-tabs-with-arg ()
48 (dotimes (i 5) (tab-bar-tests-close-other-tabs i)))
49
50(provide 'tab-bar-tests)
51;;; tab-bar-tests.el ends here