diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2022-03-17 13:42:32 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-03-17 13:42:32 -0700 |
| commit | 9d1d5a9270cd2a388ff24eb89cacda60ef133507 (patch) | |
| tree | 3f9eeb846ffd25417eadd8ccaacfb894118276e1 | |
| parent | 16333a14cb04903ac6a5c87cc79928f895c5a3f8 (diff) | |
| parent | 751c8f88c4faddb2b4f5d5ba3f051e8cd2c0153c (diff) | |
| download | emacs-9d1d5a9270cd2a388ff24eb89cacda60ef133507.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
287 files changed, 11004 insertions, 3366 deletions
diff --git a/admin/authors.el b/admin/authors.el index 342f2718c84..8a62520d6c5 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -68,6 +68,7 @@ files.") (nil "castor@my-dejanews") (nil "chengang31@gmail.com") (nil "chuntaro") + ("Clément Pit-Claudel" "Clément Pit--Claudel") ("David Abrahams" "Dave Abrahams") ("David J. Biesack" "David Biesack") ("David De La Harpe Golden" "David Golden") @@ -242,10 +243,14 @@ files.") ("Vinicius Jose Latorre" "viniciusjl") ("Gaby Launay" "galaunay") ("Dick R. Chiang" "dickmao") + ("Lin Zhou" "georgealbert@qq.com") + (nil "yan@metatem.net") + (nil "gnu_lists@halloleo.hailmail.net") ) "Alist of author aliases. -Each entry is of the form (REALNAME REGEXP...). If an author's name +Each entry is of the form (REALNAME REGEXP...). +If an author's full name, as in \"J.R.Hacker <foobar.com>\", matches one of the REGEXPs, use REALNAME instead. If REALNAME is nil, ignore that author.") @@ -498,6 +503,7 @@ Changes to files matching one of the regexps in this list are not listed.") "nextstep/WISHLIST" ;; Removed, replaced by gitmerge.el "admin/bzrmerge.el" + "bzrmerge.el" ;; Removed in commit f5090b91299 "lib/fdatasync.c" ;; Removed as obsolete @@ -512,8 +518,11 @@ Changes to files matching one of the regexps in this list are not listed.") "MORE.STUFF" "notes/font-backend" "src/ftxfont.c" + "ftxfont.c" "src/ptr-bounds.h" "obsolete/options.el" + "obsolete/old-whitespace.el" + "obsolete/lucid.el" ;; ada-mode has been deleted, now in GNU ELPA "ada-mode.texi" "doc/misc/ada-mode.texi" @@ -874,11 +883,9 @@ Changes to files in this list are not listed.") "gnus-compat.el" "pgg-parse.el" "pgg-pgp.el" "pgg-pgp5.el" "pgg.el" "dns-mode.el" "run-at-time.el" "gnus-encrypt.el" "sha1-el.el" "gnus-gl.el" "gnus.sum.el" "proto-stream.el" "color.el" "color-lab.el" - "eww.el" "shr-color.el" "shr.el" "earcon.el" "gnus-audio.el" "encrypt.el" - "format-spec.el" "gnus-move.el" "gnus-sync.el" - "auth-source.el" "ecomplete.el" "gravatar.el" "mailcap.el" "plstore.el" - "pop3.el" "qp.el" "registry.el" "rfc2231.el" "rtree.el" - "sieve.el" "sieve-mode.el" "gnus-ems.el" + "earcon.el" "gnus-audio.el" "encrypt.el" + "gnus-move.el" "gnus-sync.el" + "gnus-ems.el" ;; doc "getopt.c" "texindex.c" "news.texi" "vc.texi" "vc2-xtra.texi" "back.texi" "vol1.texi" "vol2.texi" "elisp-covers.texi" "two.el" @@ -959,6 +966,43 @@ in the repository.") ;; NB So only add a directory if needed to disambiguate. ;; FIXME? ;; Although perhaps we could let authors-disambiguate-file-name do that? +;; +;; WARNING: The semantics of these entries is tricky to grasp without +;; reading the code! +;; The rule is: for every file that was renamed or moved to another +;; directory, add an entry (OLD-NAME . NEW-BASENAME), where OLD-NAME +;; is the old name of the file as it appears in the ChangeLog files, +;; and NEW-BASENAME is the _basename_ of its new name. Yes, this +;; means that a file which was moved to another directory but kept its +;; basename will have a seemingly-silly entry ("foo" . "foo"). (Told +;; you: this is tricky!) If the moved/renamed file was mentioned in +;; several ChangeLog files with different leading directories, you +;; need to provide an entry for each such instance. For example, if +;; some ChangeLog mentioned a moved file as lisp/gnus/something.el and +;; another ChangeLog mentioned it as gnus/something.el, you need to +;; have two entries: +;; +;; ("gnus/something.el" . "something.el") +;; ("lisp/gnus/something.el" . "something.el") +;; +;; The important part is that the car of the entry should be identical +;; to how a file was mentioned in the respective ChangeLog. It is +;; advisable to run a Grep command such as +;; +;; fgrep -R BASENAME . --include='ChangeLog*' +;; +;; where BASENAME is the old basename of the renamed file. This will +;; show all the different reference forms of the file in the various +;; ChangeLog* files, and you can then prepare a separate entry for +;; each reference form. +;; +;; The cdr of the entry should generally be only the basename of the +;; file's current name, because that's how AUTHORS references files. +;; It _can_ have leading directories, but that is only +;; needed/advisable if there are several files in the tree that have +;; the same basename, and you want to disambiguate them, so that +;; people who actually contributed to different files aren't mentioned +;; as if they contributed to the same single file. (defconst authors-renamed-files-alist '(("nt.c" . "w32.c") ("nt.h" . "w32.h") ("ntheap.c" . "w32heap.c") ("ntheap.h" . "w32heap.h") @@ -966,8 +1010,9 @@ in the repository.") ("ntproc.c" . "w32proc.c") ("w32console.c" . "w32term.c") ("unexnt.c" . "unexw32.c") - ("s/windowsnt.h" . "s/ms-w32.h") - ("s/ms-w32.h" . "inc/ms-w32.h") + ("m/windowsnt.h" . "ms-w32.h") + ("s/windowsnt.h" . "ms-w32.h") + ("s/ms-w32.h" . "ms-w32.h") ("src/config.h" . "config.h") ("winnt.el" . "w32-fns.el") ("linux.h" . "gnu-linux.h") @@ -990,6 +1035,10 @@ in the repository.") ("INSTALL.MSYS" . "INSTALL") ("server.c" . "emacsserver.c") ("lib-src/etags.c" . "etags.c") + ;; gnulib + ("lib/strftime.c" . "nstrftime.c") + ("src/mini-gmp.c" . "mini-gmp.c") + ("src/mini-gmp.h" . "mini-gmp.h") ;; msdos/ ("is-exec.c" . "is_exec.c") ("enriched.doc" . "enriched.txt") @@ -1073,8 +1122,10 @@ in the repository.") ("nxml/test.invalid.xml" . "test-invalid.xml") ("nxml/test.valid.xml" . "test-valid.xml") ("automated/Makefile.in" . "test/Makefile.in") - ("test/rmailmm.el" . "test/manual/rmailmm.el") - ("rmailmm.el" . "test/manual/rmailmm.el") + ;; rmailmm tests wandered from test/ to test/manual to test/lisp/mail/ + ("rmailmm.el" . "rmailmm-tests.el") + ("test/rmailmm.el" . "rmailmm-tests.el") + ("test/manual/rmailmm.el" . "rmailmm-tests.el") ;; The one in lisp is eshell/eshell.el. ("eshell.el" . "eshell-tests.el") ("automated/eshell.el" . "eshell-tests.el") @@ -1106,22 +1157,79 @@ in the repository.") ("major.texi" . "modes.texi") ("msdog-xtra.texi" . "msdos-xtra.texi") ("msdog.texi" . "msdos.texi") + ;; Moved from lisp/gnus/ to lisp/ + ("auth-source.el" . "auth-source.el") + ("lisp/gnus/auth-source.el" . "auth-source.el") + ("ecomplete.el" . "ecomplete.el") + ("format-spec.el" . "format-spec.el") + ("gnus/format-spec.el" . "format-spec.el") + ("lisp/gnus/ecomplete.el" . "ecomplete.el") + ("plstore.el" . "plstore.el") + ("lisp/gnus/plstore.el" . "plstore.el") + ("registry.el" . "registry.el") + ("lisp/gnus/registry.el" . "registry.el") + ("rtree.el" . "rtree.el") ;; Moved from lisp/gnus/ to lisp/calendar/ - ("time-date.el" . "calendar/time-date.el") + ("time-date.el" . "time-date.el") ;; Moved from lisp/gnus/ to lisp/mail/ - ("binhex.el" . "mail/binhex.el") - ("uudecode.el" . "mail/uudecode.el") - ("mail-parse.el" . "mail/mail-parse.el") - ("yenc.el" . "mail/yenc.el") - ("flow-fill.el" . "mail/flow-fill.el") - ("ietf-drums.el" . "mail/ietf-drums.el") - ("sieve-manage.el" . "mail/sieve-manage.el") + ("binhex.el" . "binhex.el") + ("gnus/binhex.el" . "binhex.el") + ("uudecode.el" . "uudecode.el") + ("gnus/uudecode.el" . "uudecode.el") + ("mail-parse.el" . "mail-parse.el") + ("gnus/mail-parse.el" . "mail-parse.el") + ("mail-prsvr.el" . "mail-prsvr.el") + ("gnus/mail-prsvr.el" . "mail-prsvr.el") + ("yenc.el" . "yenc.el") + ("flow-fill.el" . "flow-fill.el") + ("gnus/flow-fill.el" . "flow-fill.el") + ("ietf-drums.el" . "ietf-drums.el") + ("gnus/ietf-drums.el" . "ietf-drums.el") + ("pop3.el" . "pop3.el") + ("mail/pop3.el" . "pop3.el") + ("gnus/pop3.el" . "pop3.el") + ("lisp/gnus/pop3.el" . "pop3.el") + ("qp.el" . "qp.el") + ("gnus/qp.el" . "qp.el") + ("lisp/gnus/qp.el" . "qp.el") + ("rfc2045.el" . "rfc2045.el") + ("gnus/rfc2045.el" . "rfc2045.el") + ("rfc2047.el" . "rfc2047.el") + ("gnus/rfc2047.el" . "rfc2047.el") + ("rfc2231.el" . "rfc2231.el") + ("gnus/rfc2231.el" . "rfc2231.el") + ("lisp/gnus/rfc2231.el" . "rfc2231.el") ;; Moved from lisp/gnus/ to lisp/image/ - ("compface.el" . "image/compface.el") + ("compface.el" . "compface.el") + ("gravatar.el" . "gravatar.el") + ("lisp/gnus/gravatar.el" . "gravatar.el") ;; Moved from lisp/gnus/ to lisp/net/ + ("eww.el" . "eww.el") + ("net/eww.el" . "eww.el") + ("lisp/new/eww.el" . "eww.el") ; an actual typo in ChangeLog.3 + ("gssapi.el" . "gssapi.el") + ("lisp/gnus/gssapi.el" . "gssapi.el") ("imap.el" . "net/imap.el") + ("mailcap.el" . "mailcap.el") + ("gnus/mailcap.el" . "mailcap.el") + ("lisp/gnus/mailcap.el" . "mailcap.el") ("rfc2104.el" . "net/rfc2104.el") - ("starttls.el" . "net/starttls.el") + ("starttls.el" . "starttls.el") + ("lisp/net/starttls.el" . "starttls.el") ; moved to obsolete/ + ("shr.el" . "shr.el") + ("net/shr.el" . "shr.el") + ("shr-color.el" . "shr-color.el") + ("sieve-manage.el" . "sieve-manage.el") + ("sieve-mode.el" . "sieve-mode.el") + ("sieve.el" . "sieve.el") + ("lisp/gnus/sieve-manage.el" . "sieve-manage.el") + ("lisp/gnus/sieve-mode.el" . "sieve-mode.el") + ("lisp/gnus/sieve.el" . "sieve.el") + ;; Moved from lisp/gnus/ to lisp/international + ("rfc1843.el" . "rfc1843.el") + ("gnus/rfc1843.el" . "rfc1843.el") + ("utf7.el" . "utf7.el") + ("gnus/utf7.el" . "utf7.el") ;; And from emacs/ to misc/ and back again. ("ns-emacs.texi" . "macos.texi") ("overrides.texi" . "gnus-overrides.texi") @@ -1136,7 +1244,7 @@ in the repository.") ("ED.WORSHIP" . "JOKES") ("GNU.JOKES" . "JOKES") ("CHARACTERS" . "TODO") - ("lisp/character-fold.el" . "lisp/char-fold.el") + ("lisp/character-fold.el" . "char-fold.el") ("test/automated/character-fold-tests.el" . "char-fold-tests.el") ("test/automated/char-fold-tests.el" . "char-fold-tests.el") ("test/lisp/character-fold-tests.el" . "char-fold-tests.el") @@ -1178,7 +1286,8 @@ in the repository.") ("grammars" . "grammars") ;; Moved from lisp/emacs-lisp/ to admin/. ("emacs-lisp/authors.el" . "authors.el") - ("emacs-lisp/find-gc.el" . "admin/find-gc.el") + ("find-gc.el" . "find-gc.el") + ("emacs-lisp/find-gc.el" . "find-gc.el") ;; From etc to lisp/cedet/semantic/. ("grammars/bovine-grammar.el" . "bovine/grammar.el") ("grammars/wisent-grammar.el" . "wisent/grammar.el") @@ -1186,28 +1295,41 @@ in the repository.") ("nt/README.W32" . "README.W32") ("notes/BRANCH" . "notes/repo") ("notes/bzr" . "notes/repo") - ;; moved from lisp/ to lisp/net/ - ("lisp/pinentry.el" . "lisp/net/pinentry.el") + ;; moved from lisp/ to lisp/net/, then removed + ("pinentry.el" . "pinentry.el") + ("lisp/pinentry.el" . "pinentry.el") + ("lisp/net/pinentry.el" . "pinentry.el") ;; module.* moved to emacs-module.* - ("src/module.h" . "src/emacs-module.h") - ("src/module.c" . "src/emacs-module.c") - ;; gnulib - ("lib/strftime.c" . "lib/nstrftime.c") - ("test/src/regex-tests.el" . "test/src/regex-emacs-tests.el") - ("test/lisp/emacs-lisp/cl-tests.el" . "test/lisp/obsolete/cl-tests.el") - ("lisp/net/starttls.el" . "lisp/obsolete/starttls.el") - ("url-ns.el" . "lisp/obsolete/url-ns.el") - ("gnus-news.texi" . "doc/misc/gnus.texi") - ("lisp/multifile.el" . "lisp/fileloop.el") - ("lisp/emacs-lisp/thread.el" . "lisp/thread.el") - ("lisp/emacs-lisp/cl.el" . "lisp/emacs-lisp/cl-lib.el") - ("lisp/progmodes/mantemp.el" . "lisp/obsolete/mantemp.el") - ("src/mini-gmp.c" . "lib/mini-gmp.c") - ("src/mini-gmp.h" . "lib/mini-gmp.h") + ("src/module.h" . "emacs-module.h") + ("src/module.c" . "emacs-module.c") + ("test/src/regex-tests.el" . "regex-emacs-tests.el") + ("test/lisp/emacs-lisp/cl-tests.el" . "cl-tests.el") + ("url-ns.el" . "url-ns.el") + ("gnus-news.texi" . "gnus.texi") + ("doc/misc/gnus-news.texi" . "gnus.texi") + ("lisp/multifile.el" . "fileloop.el") + ("lisp/emacs-lisp/thread.el" . "thread.el") + ;; cl.el was retired, replaced by cl-lib.el, and we want to + ;; pretend they are the same file... + ("emacs-lisp/cl.el" . "cl-lib.el") + ("lisp/emacs-lisp/cl.el" . "cl-lib.el") + ("lisp/obsolete/cl.el" . "cl-lib.el") + ("mantemp.el" . "mantemp.el") + ("lisp/progmodes/mantemp.el" . "mantemp.el") + ("progmodes/mantemp.el" . "mantemp.el") ("sysdep.c" . "src/sysdep.c") + ;; nnir.el started in lisp/gnus/ChangeLog.*, then was + ;; lisp/gnus/nnir.el in ChangeLog.[123], and is now + ;; lisp/obsolete/nnir.el. + ("nnir.el" . "nnir.el") ("lisp/gnus/nnir.el" . "nnir.el") - ("src/regex.c" . "emacs-regex.c") - ("src/regex.h" . "emacs-regex.h") + ;; regex.[ch] are mentioned as src/regex.[ch] in ChangeLog.[123], + ;; but as just regex.[ch] in src/ChangeLog.*, so we need 2 entries + ;; for each one of them. + ("regex.c" . "regex-emacs.c") + ("regex.h" . "regex-emacs.h") + ("src/regex.c" . "regex-emacs.c") + ("src/regex.h" . "regex-emacs.h") ("test/manual/rmailmm.el" . "rmailmm-tests.el") ("test/lisp/cedet/semantic-utest-fmt.el" . "format-tests.el") ("test/lisp/emacs-lisp/tabulated-list-test.el" . "tabulated-list-tests.el") @@ -1368,10 +1490,14 @@ Additionally, for these logs we apply the `lax' elements of (defun authors-canonical-file-name (file log-file pos author) "Return canonical file name for FILE found in LOG-FILE. +FILE is the file name as it appears in LOG-FILE, including any +leading directories mentioned there. +LOG-FILE is an absolute file name of the log file we are scanning. Checks whether FILE is a valid (existing) file name, has been renamed, or is on the list of removed files. Returns the non-directory part of -the file name. Only uses the LOG-FILE position POS and associated AUTHOR -to print a message if FILE is not found." +the file name to use for FILE in the \"AUTHORS\" file. +Only uses the LOG-FILE position POS and associated AUTHOR to print a +message if FILE is not found." ;; FILE should be re-checked in every different directory associated ;; with a LOG-FILE. Eg configure.ac from src/ChangeLog is not the ;; same as that from top-level/ChangeLog. @@ -1381,6 +1507,8 @@ to print a message if FILE is not found." (if entry (cdr entry) (setq relname (file-name-nondirectory file)) + ;; File names in `authors-valid-file-names' are OK by + ;; definition, so no need to check those. (if (or (member file authors-valid-file-names) (member relname authors-valid-file-names) (file-exists-p file) diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index 872cb00ca28..ec69302dae8 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -43,11 +43,16 @@ General steps (for each step, check for possible errors): because some of the commands below run Make, so they need Makefiles to be present. - For Emacs 28, and as long as --with-native-compilation is not the - default, the tree needs to be configured with native-compilation - enabled, to ensure all the pertinent *.elc files will end up in - the tarball. Otherwise, the *.eln files might not build correctly - on the user's system. + For Emacs 28 and later, as long as --with-native-compilation is + not the default, the tree needs to be configured with + native-compilation enabled, to ensure all the pertinent *.elc + files will end up in the tarball. Otherwise, the *.eln files + might not build correctly on the user's system. + + For a release (as opposed to pretest), delete any left-over "---" + and "+++" markers from etc/NEWS, as well as the "Temporary note" + section at the beginning of that file, and commit etc/NEWS if it + was modified. 2. Regenerate the etc/AUTHORS file: M-: (require 'authors) RET @@ -232,7 +237,9 @@ General steps (for each step, check for possible errors): FILE.gz FILE.xz ... You only need the --user part if you have multiple GPG keys and do - not want to use the default. + not want to use the default. Instead of "your@gpg.key.email" you + could also use the fingerprint of the key, a 40-digit hex number. + (Alternatively, define default-key in your ~/.gnupg/gpg.conf file.) Obviously, if you do not have a fast uplink, be prepared for the upload to take a while. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 73b3d390499..ea3d23686f4 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -40,7 +40,7 @@ GNULIB_MODULES=' getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog ieee754-h ignore-value intprops largefile libgmp lstat manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime - nproc nstrftime + nanosleep nproc nstrftime pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex sig2str sigdescr_np socklen stat-time std-gnu11 stdalign stddef stdio @@ -102,6 +102,12 @@ test -x "$gnulib_srcdir"/gnulib-tool || { exit 1 } +# gnulib-tool has problems with a bare checkout (Bug#32452#65). +test -f configure || ./autogen.sh || exit + +# Old caches can confuse autoconf when some Gnulib-related changes take effect. +rm -fr autom4te.cache || exit + avoided_flags= for module in $AVOIDED_MODULES; do avoided_flags="$avoided_flags --avoid=$module" @@ -109,7 +115,9 @@ done "$gnulib_srcdir"/gnulib-tool --dir="$src" $GNULIB_TOOL_FLAGS \ $avoided_flags $GNULIB_MODULES && -rm -- "$src"lib/gl_openssl.h "$src"m4/fcntl-o.m4 \ +rm -- "$src"lib/gl_openssl.h \ + "$src"lib/stdio-read.c "$src"lib/stdio-write.c \ + "$src"m4/fcntl-o.m4 \ "$src"m4/gl-openssl.m4 \ "$src"m4/gnulib-cache.m4 "$src"m4/gnulib-tool.m4 \ "$src"m4/manywarnings-c++.m4 \ diff --git a/build-aux/config.guess b/build-aux/config.guess index 1105a749838..7f76b6228f7 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -1,14 +1,14 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2021 Free Software Foundation, Inc. +# Copyright 1992-2022 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale -timestamp='2021-11-30' +timestamp='2022-01-09' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or +# the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -60,7 +60,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2021 Free Software Foundation, Inc. +Copyright 1992-2022 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -929,6 +929,9 @@ EOF i*:PW*:*) GUESS=$UNAME_MACHINE-pc-pw32 ;; + *:SerenityOS:*:*) + GUESS=$UNAME_MACHINE-pc-serenity + ;; *:Interix*:*) case $UNAME_MACHINE in x86) diff --git a/build-aux/config.sub b/build-aux/config.sub index 5ba9a97d2c9..9b62e37c43c 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -8,7 +8,7 @@ timestamp='2021-12-25' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or +# the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index a55004680fa..49bf05f2d9f 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -45,7 +45,9 @@ git_diff='git diff --cached --name-only --diff-filter=A' # 'git diff' will backslash escape tabs and newlines, so we don't have # to worry about word splitting here. -$git_diff $head | sane_egrep 'ChangeLog|^-|/-|[^-+./_0-9A-Z_a-z]' | while IFS= read -r new_name; do +$git_diff $head | +LC_ALL=C grep -E 'ChangeLog|^-|/-|[^-+./_0-9A-Z_a-z]' | +while IFS= read -r new_name; do case $new_name in -* | */-*) echo "$new_name: File name component begins with '-'." diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index 1c6847ae3b3..82d9f973366 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -35,7 +35,7 @@ eval 'exec perl -wSx "$0" "$@"' if 0; -my $VERSION = '2021-02-24 23:42'; # UTC +my $VERSION = '2022-01-27 18:49'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook diff --git a/build-aux/update-copyright b/build-aux/update-copyright index 51b25dd0a5e..81b691e8570 100755 --- a/build-aux/update-copyright +++ b/build-aux/update-copyright @@ -7,7 +7,7 @@ # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3, or (at your option) +# the Free Software Foundation, either version 3, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, diff --git a/configure.ac b/configure.ac index 00711cccd5d..bc17935eb13 100644 --- a/configure.ac +++ b/configure.ac @@ -1201,6 +1201,8 @@ dnl Automake replacements. AC_DEFUN([AM_CONDITIONAL], [$2 && $1_CONDITION=1 || $1_CONDITION= AC_SUBST([$1_CONDITION])]) +AC_DEFUN([AM_COND_IF], + [AS_IF([test "$$1_CONDITION"], [$2], [$3])]) dnl Prefer silent make output. For verbose output, use dnl 'configure --disable-silent-rules' or 'make V=1' . @@ -3938,6 +3940,16 @@ case "${opsys}" in darwin) MODULES_SECONDARY_SUFFIX='.so' ;; *) MODULES_SECONDARY_SUFFIX='' ;; esac + +# pgtkterm.c uses dlsym +if test $window_system = pgtk; then + case $opsys in + gnu|gnu-linux) + LIBMODULES="-ldl" + ;; + esac +fi + if test "${with_modules}" != "no"; then case $opsys in gnu|gnu-linux) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 700b3f21911..3112ac332b3 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -113,11 +113,17 @@ a directory's name. @findex dired-jump-other-window @kindex C-x C-j @kindex C-x 4 C-j - Typing @kbd{C-x C-j} (@code{dired-jump}) in any buffer will open a -Dired buffer and move point to the line corresponding to the current -file. In Dired, move up a level and go to the previous directory's -line. Typing @kbd{C-x 4 C-j} (@code{dired-jump-other-window} has the -same effect but opens a new window for the Dired buffer. + You can ask Emacs to invoke Dired on the default-directory +(@pxref{File Names, default-directory}) of any buffer, by typing +@kbd{C-x C-j} (@code{dired-jump}). If the buffer visits a file, this +command will move point to that file's line in the Dired buffer it +shows; otherwise, point will end up on the first file in the directory +listing. As an exception, if you type @kbd{C-x C-j} in a Dired +buffer, Emacs displays the directory listing of the parent directory +and places point on the line that corresponds to the directory where +you invoked @code{dired-jump}. Typing @kbd{C-x 4 C-j} +(@code{dired-jump-other-window} has the same effect, but displays the +Dired buffer in a new window. The variable @code{dired-listing-switches} specifies the options to give to @command{ls} for listing the directory; this string diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index e3cfe5f8441..7489344cda9 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1220,6 +1220,10 @@ cursor during dragging. To suppress such behavior, set the options @code{mouse-drag-and-drop-region-show-tooltip} and/or @code{mouse-drag-and-drop-region-show-cursor} to @code{nil}. +@vindex mouse-drag-and-drop-region-cross-program +To drag text from Emacs to other programs, set the option +@code{mouse-drag-and-drop-region-cross-program} to a non-@code{nil} +value. @node Menu Bars @section Menu Bars diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index a1628eabaa2..a4ae68af5b2 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2091,11 +2091,13 @@ wheel. @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event -This kind of event is generated only on some kinds of systems. On some -systems, @code{mouse-4} and @code{mouse-5} are used instead. For -portable code, use the variables @code{mouse-wheel-up-event} and -@code{mouse-wheel-down-event} defined in @file{mwheel.el} to determine -what event types to expect for the mouse wheel. +This kind of event is generated only on some kinds of systems. On +some systems, @code{mouse-4} and @code{mouse-5} are used instead. For +portable code, use the variables @code{mouse-wheel-up-event}, +@code{mouse-wheel-up-alternate-event}, @code{mouse-wheel-down-event} +and @code{mouse-wheel-down-alternate-event} defined in +@file{mwheel.el} to determine what event types to expect for the mouse +wheel. @cindex @code{pinch} event @item (pinch @var{position} @var{dx} @var{dy} @var{scale} @var{angle}) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 48170348e32..95e00e140da 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3021,12 +3021,21 @@ names (such as @code{:family} or @code{:underline}) and values. Thus, sets the attribute @code{:weight} to @code{bold} and the attribute @code{:slant} to @code{italic}. - If @var{frame} is @code{t}, this function sets the default attributes for newly created frames; they will effectively override the attribute values specified by @code{defface}. If @var{frame} is @code{nil}, this function sets the attributes for all existing frames, as well as -for newly created frames. +for newly created frames. However, if you want to @emph{reset} the +value of an attribute to @code{unspecified} in a way that also affects +newly created frames, you @emph{must} explicitly call this function +with @var{frame} set to @code{t} and the value of the attribute set to +@code{unspecified} (@emph{not} @code{nil}!@:), in addition to the call +with @var{frame} set to @code{nil}. This is because the default +attributes for newly created frames are merged with the face's spec in +@code{defface} when a new frame is created, and so having +@code{unspecified} in the default attributes for new frames will be +unable to override @code{defface}; the special call to this function +as described above will arrange for @code{defface} to be overridden. @end defun The following commands and functions mostly provide compatibility @@ -3303,10 +3312,10 @@ and @code{face-remap-reset-base} functions; it is intended for major modes to remap faces in the buffers they control. @defun face-remap-add-relative face &rest specs -This function adds the face spec in @var{specs} as relative -remappings for face @var{face} in the current buffer. The remaining -arguments, @var{specs}, should form either a list of face names, or a -property list of attribute/value pairs. +This function adds @var{specs} as relative remappings for face +@var{face} in the current buffer. @var{specs} should be a list where +each element is either a face name, or a property list of +attribute/value pairs. The return value is a Lisp object that serves as a cookie; you can pass this object as an argument to @code{face-remap-remove-relative} diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index f8188708e5d..31ebeb51b41 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2168,6 +2168,11 @@ prevent hanging with those window managers. If non-@code{nil}, the frame is visible on all virtual desktops on systems with virtual desktops. +@vindex shaded@r{, a frame parameter} +@item sticky +If non-@code{nil}, tell the window manager to display the frame in a +way that its contents are hidden, leaving only the title bar. + @vindex inhibit-double-buffering@r{, a frame parameter} @item inhibit-double-buffering If non-@code{nil}, the frame is drawn to the screen without double @@ -4033,6 +4038,41 @@ there is no match there, Emacs looks for a match in still no match has been found, the text for the URL is inserted. If you want to alter Emacs behavior, you can customize these variables. +@cindex initiating drag-and-drop + On capable window systems, Emacs also supports dragging contents +from its frames to windows of other applications. + +@defun x-begin-drag targets &optional action frame return-frame +This function begins a drag from @var{frame}, and returns when the +drag-and-drop operation ends, either because the drop was successful, +or because the drop was rejected. The drop occurs when all mouse +buttons are released on top of an X window other than @var{frame} (the +@dfn{drop target}). + +@var{targets} is a list of strings describing selection targets, much +like the @var{data-type} argument to @code{gui-get-selection}, that +the drop target can request from Emacs (@pxref{Window System +Selections}). + +@var{action} is a symbol describing the action recommended to the +target. It can either be @code{XdndActionCopy}, which +means to copy the contents of the selection @code{XdndSelection} to +the drop target; or @code{XdndActionMove}, which means copy as with +@code{XdndActionCopy}, and in addition the caller should delete +whatever was stored in that selection after copying it. + +If @var{return-frame} is non-nil and the mouse moves over an Emacs +frame after first moving out of @var{frame}, then the frame to which +the mouse moves will be returned immediately. This is useful when you +want to treat dragging content from one frame to another specially, +while also being able to drag content to other programs. + +If the drop was rejected or no drop target was found, this function +returns @code{nil}. Otherwise, it returns a symbol describing the +action the target chose to perform, which can differ from @var{action} +if that isn't supported by the drop target. +@end defun + @node Color Names @section Color Names diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 0037922aeda..8d2089bad8b 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -2060,7 +2060,7 @@ to quit, use the following function, which is available since Emacs 27.1. @anchor{process_input} -@deftypefn Function enum emacs_process_input_result process_input (emacs_env *@var{env}) +@deftypefn Function {enum emacs_process_input_result} process_input (emacs_env *@var{env}) This function processes pending input events. It returns @code{emacs_process_input_quit} if the user wants to quit or an error occurred while processing signals. In that case, we recommend that @@ -2135,7 +2135,7 @@ Therefore, we recommend that your module functions check for nonlocal exit conditions and recover from them, using the functions described below. -@deftypefn Function enum emacs_funcall_exit non_local_exit_check (emacs_env *@var{env}) +@deftypefn Function {enum emacs_funcall_exit} non_local_exit_check (emacs_env *@var{env}) This function returns the kind of nonlocal exit condition stored in @var{env}. The possible values are: @@ -2150,7 +2150,7 @@ The last @acronym{API} function exited via @code{throw}. @end vtable @end deftypefn -@deftypefn Function enum emacs_funcall_exit non_local_exit_get (emacs_env *@var{env}, emacs_value *@var{symbol}, emacs_value *@var{data}) +@deftypefn Function {enum emacs_funcall_exit} non_local_exit_get (emacs_env *@var{env}, emacs_value *@var{symbol}, emacs_value *@var{data}) This function returns the kind of nonlocal exit condition stored in @var{env}, like @code{non_local_exit_check} does, but it also returns the full information about the nonlocal exit, if any. If the return diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index f495910fcd6..d7d25dc36af 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -855,15 +855,24 @@ function to all or part of the characters in a charset: Call @var{function} for characters in @var{charset}. @var{function} is called with two arguments. The first one is a cons cell @code{(@var{from} . @var{to})}, where @var{from} and @var{to} -indicate a range of characters contained in charset. The second -argument passed to @var{function} is @var{arg}. +indicate a range of characters contained in @var{charset}. The second +argument passed to @var{function} is @var{arg}, or @code{nil} if +@var{arg} is omitted. By default, the range of codepoints passed to @var{function} includes all the characters in @var{charset}, but optional arguments @var{from-code} and @var{to-code} limit that to the range of characters between these two codepoints of @var{charset}. If either of them is @code{nil}, it defaults to the first or last codepoint of -@var{charset}, respectively. +@var{charset}, respectively. Note that @var{from-code} and +@var{to-code} are @var{charset}'s codepoints, not the Emacs codes of +characters; by contrast, the values @var{from} and @var{to} in the +cons cell passed to @var{function} @emph{are} Emacs character codes. +Those Emacs character codes are either Unicode code points, or Emacs +internal code points that extend Unicode and are beyond the Unicode +range of characters @code{0..#x10FFFF} (@pxref{Text Representations}). +The latter happens rarely, with legacy CJK charsets for codepoints of +@var{charset} which specify characters not yet unified with Unicode. @end defun @node Scanning Charsets diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index d338d59a814..ed07c1cbf70 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2382,8 +2382,9 @@ occupied by the process in the machine's physical memory. @item pcpu The percentage of the CPU time used by the process since it started. -The corresponding @var{value} is a floating-point number between 0 and -100. +The corresponding @var{value} is a nonnegative floating-point number. +Although in theory the number can exceed 100 on a multicore platform, +it is usually less than 100 because Emacs is typically single-threaded. @item pmem The percentage of the total physical memory installed on the machine diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 5d4d378d82a..87a70d064ea 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -259,12 +259,13 @@ name displayed by this will be the full pathname of the installed @code{data-directory}, and @kbd{C-h v} displays the value and the documentation of a variable.) -The location of your Info directory (i.e., where Info documentation -is stored) is kept in the variable @code{Info-default-directory-list}. Use -@kbd{C-h v Info-default-directory-list @key{RET}} to see the value of -this variable, which will be a list of directory names. The last -directory in that list is probably where most Info files are stored. By -default, Emacs Info documentation is placed in @file{/usr/local/share/info}. +The location of your Info directory (i.e., where Info documentation is +stored) is kept in the variable @code{Info-directory-list}. Use +@kbd{C-h v Info-directory-list @key{RET}} to see the value of this +variable, which will be a list of directory names (after Info has been +started). The last directory in that list is probably where most Info +files are stored. By default, Emacs Info documentation is placed in +@file{/usr/local/share/info}. For information on some of the files in the @file{etc} directory, @pxref{Informational files for Emacs}. @@ -701,7 +702,7 @@ directory which is a subdirectory of your home directory named @file{Info}, you could put this in your @file{.emacs} file: @lisp -(add-to-list 'Info-default-directory-list "~/Info") +(add-to-list 'Info-default-directory-list "~/Info/") @end lisp You will need a top-level Info file named @file{dir} in this directory diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 261e88d00c6..372e4c3ffbd 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1012,51 +1012,78 @@ of familiarity. @table @code -@item $var -Expands to the value bound to @code{var}. This is the main way to use +@item $@var{var} +Expands to the value bound to @var{var}. This is the main way to use variables in command invocations. -@item $#var -Expands to the length of the value bound to @code{var}. Raises an error -if the value is not a sequence -(@pxref{Sequences Arrays Vectors, Sequences, , elisp, The Emacs Lisp Reference Manual}). +@item $"@var{var}" +@item $'@var{var}' +Expands to the value bound to @var{var}. This is useful to +disambiguate the variable name when concatenating it with another +value, such as @samp{$"@var{var}"-suffix}. -@item $(lisp) -Expands to the result of evaluating the S-expression @code{(lisp)}. On -its own, this is identical to just @code{(lisp)}, but with the @code{$}, -it can be used in a string, such as @samp{/some/path/$(lisp).txt}. +@item $(@var{lisp}) +Expands to the result of evaluating the S-expression @code{(@var{lisp})}. On +its own, this is identical to just @code{(@var{lisp})}, but with the @code{$}, +it can be used in a string, such as @samp{/some/path/$(@var{lisp}).txt}. -@item $@{command@} -Returns the output of @command{command}, which can be any valid Eshell +@item $@{@var{command}@} +Returns the output of @command{@var{command}}, which can be any valid Eshell command invocation, and may even contain expansions. -@item $var[i] -Expands to the @code{i}th element of the value bound to @code{var}. If -the value is a string, it will be split at whitespace to make it a list. -Again, raises an error if the value is not a sequence. - -@item $var[: i] -As above, but now splitting occurs at the colon character. - -@item $var[: i j] -As above, but instead of returning just a string, it now returns a list -of two strings. If the result is being interpolated into a larger -string, this list will be flattened into one big string, with each -element separated by a space. - -@item $var["\\\\" i] -Separate on backslash characters. Actually, the first argument -- if it -doesn't have the form of a number, or a plain variable name -- can be -any regular expression. So to split on numbers, use @samp{$var["[0-9]+" 10 20]}. - -@item $var[hello] -Calls @code{assoc} on @code{var} with @code{"hello"}, expecting it to be -an alist (@pxref{Association List Type, Association Lists, , elisp, -The Emacs Lisp Reference Manual}). - -@item $#var[hello] -Returns the length of the cdr of the element of @code{var} who car is equal -to @code{"hello"}. +@item $<@var{command}> +As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation +@command{@var{command}}, but writes the output to a temporary file and +returns the file name. + +@item $@var{expr}[@var{i...}] +Expands to the @var{i}th element of the result of @var{expr}, an +expression in one of the above forms listed here. If multiple indices +are supplied, this will return a list containing the elements for each +index. The exact behavior depends on the type of @var{expr}'s value: + +@table @asis + +@item a sequence +Expands to the element at the (zero-based) index @var{i} of the +sequence (@pxref{Sequences Arrays Vectors, Sequences, , elisp, The +Emacs Lisp Reference Manual}). + +@item a string +Split the string at whitespace, and then expand to the @var{i}th +element of the resulting sequence. + +@item an alist +If @var{i} is a non-numeric value, expand to the value associated with +the key @code{"@var{i}"} in the alist. For example, if @var{var} is +@samp{(("dog" . "fido") ("cat" . "felix"))}, then +@samp{$@var{var}[dog]} expands to @code{"fido"}. Otherwise, this +behaves as with sequences; e.g., @samp{$@var{var}[0]} expands to +@code{("dog" . "fido")}. @xref{Association List Type, Association +Lists, , elisp, The Emacs Lisp Reference Manual}. + +@item anything else +Signals an error. + +@end table + +Multiple sets of indices can also be specified. For example, if +@var{var} is @samp{((1 2) (3 4))}, then @samp{$@var{var}[0][1]} will +expand to @code{2}, i.e.@: the second element of the first list member +(all indices are zero-based). + +@item $@var{expr}[@var{regexp} @var{i...}] +As above (when @var{expr} expands to a string), but use @var{regexp} +to split the string. @var{regexp} can be any form other than a +number. For example, @samp{$@var{var}[: 0]} will return the first +element of a colon-delimited string. + +@item $#@var{expr} +Expands to the length of the result of @var{expr}, an expression in +one of the above forms. For example, @samp{$#@var{var}} returns the +length of the variable @var{var} and @samp{$#@var{var}[0]} returns the +length of the first element of @var{var}. Again, signals an error if +the result of @var{expr} is not a string or a sequence. @end table diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 7c37ae55055..3b24dfb919c 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -192,9 +192,9 @@ email composition buffers (@pxref{Inline Query Expansion}) @lisp (with-eval-after-load "message" - (define-key message-mode-map [(control ?c) (tab)] 'eudc-expand-inline)) + (define-key message-mode-map [(control ?c) (tab)] 'eudc-expand-try-all)) (with-eval-after-load "sendmail" - (define-key mail-mode-map [(control ?c) (tab)] 'eudc-expand-inline)) + (define-key mail-mode-map [(control ?c) (tab)] 'eudc-expand-try-all)) @end lisp @menu @@ -281,11 +281,12 @@ LDAP: @vindex message-mode-map @findex eudc-expand-inline +@findex eudc-expand-try-all @vindex eudc-server-hotlist @vindex ldap-host-parameters-alist @lisp (with-eval-after-load "message" - (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) + (define-key message-mode-map (kbd "TAB") 'eudc-expand-try-all)) (setopt eudc-server-hotlist '(("" . bbdb) ("ldaps://ldap.gnu.org" . ldap))) @@ -337,11 +338,12 @@ configure EUDC for LDAP: @vindex message-mode-map @findex eudc-expand-inline +@findex eudc-expand-try-all @vindex eudc-server-hotlist @vindex ldap-host-parameters-alist @lisp (with-eval-after-load "message" - (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) + (define-key message-mode-map (kbd "TAB") 'eudc-expand-try-all)) (setopt 'eudc-server-hotlist '(("" . bbdb) ("ldaps://ldap.gnu.org" . ldap))) @@ -366,11 +368,12 @@ and the @file{.emacs} expressions become: @vindex message-mode-map @findex eudc-expand-inline +@findex eudc-expand-try-all @vindex eudc-server-hotlist @vindex ldap-host-parameters-alist @lisp (with-eval-after-load "message" - (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) + (define-key message-mode-map (kbd "TAB") 'eudc-expand-try-all)) (setopt 'eudc-server-hotlist '(("" . bbdb) ("" . ldap))) (setopt 'ldap-host-parameters-alist @@ -709,31 +712,47 @@ be passed to the program. @node Inline Query Expansion @section Inline Query Expansion -Inline query expansion is a powerful method to get completion from your -directory server. The most common usage is for expanding names to email -addresses in mail message buffers. The expansion is performed by the -command @kbd{M-x eudc-expand-inline} which is available from the -@samp{Expand Inline Query} menu item but can also be conveniently -bound to a key shortcut (@pxref{Installation}). The operation is -controlled by the variables @code{eudc-inline-expansion-format}, -@code{eudc-inline-query-format}, +Inline query expansion is a powerful method to get completion from +your directory servers. The most common usage is for expanding names +to email addresses in mail message buffers. The expansion is +performed by the command @kbd{M-x eudc-expand-try-all} which is +available from the @samp{Expand Inline Query Trying All Servers} menu +item but can also be conveniently bound to a key shortcut +(@pxref{Installation}). The operation is controlled by the variables +@code{eudc-inline-expansion-format}, @code{eudc-inline-query-format}, @code{eudc-expanding-overwrites-query} and @code{eudc-multiple-match-handling-method}. -If the query fails for a server, other servers may be tried successively -until one of them finds a match (@pxref{Multi-server Queries}). +If the query fails for a server, other servers may be tried +successively until one of them finds a match (@pxref{Multi-server +Queries}), or all servers can be tried and all matches returned. + +@deffn Command eudc-expand-try-all try-all-servers-p +Query some or all servers and expand the query string before point. +The query string consists of the buffer substring from the point back +to the preceding comma, colon or beginning of line. +@code{eudc-inline-query-format} controls how individual words are +mapped onto directory attribute names. After querying the server or +servers for the given string, the expansion specified by +@code{eudc-inline-expansion-format} is inserted in the buffer at +point. If multiple matches are available, a selection window is +displayed. If @var{try-all-servers-p} is non-@code{nil} then all +servers are queried. +@end deffn -@deffn Command eudc-expand-inline replace-p +@deffn Command eudc-expand-inline save-query-as-kill-p Query the server and expand the query string before point. The query string consists of the buffer substring from the point back to the -preceding comma, colon or beginning of -line. @code{eudc-inline-query-format} controls how individual words -are mapped onto directory attribute names. After querying the server -for the given string, the expansion specified by +preceding comma, colon or beginning of line. +@code{eudc-inline-query-format} controls how individual words are +mapped onto directory attribute names. After querying the server for +the given string, the expansion specified by @code{eudc-inline-expansion-format} is inserted in the buffer at -point. If @var{replace-p} is @code{t} then this expansion replaces the -query string in the buffer. If @code{eudc-expanding-overwrites-query} -is non-@code{nil} then the meaning of @var{replace-p} is negated. +point. If multiple matches are available, a selection window is +displayed. If @var{save-query-as-kill-p} is @code{t} then the query +string is saved to the kill ring. If +@code{eudc-expansion-save-query-as-kill} is non-@code{nil} then the +meaning of @var{save-query-as-kill-p} is negated. @end deffn @defvar eudc-inline-query-format diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index a3def495c44..f87eab7e513 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -21735,6 +21735,12 @@ articles are drawn. If you want to create a @emph{persistent} group that sticks around after exit from the summary buffer, you can call @code{gnus-group-make-search-group} (bound to @kbd{G g}). +Unlike persistent groups, ephemeral groups by default do not run +articles through the expiry process on exiting. If you want expiry to +happen in ephemeral search groups you can customize the variable +@code{nnselect-allow-ephemeral-expiry}. In all cases the expiry +process uses the underlying group's expiry parameters. + So you just performed a search whose results are so fabulous you wished you had done a persistent search rather than an ephemeral one? No problem; you can create such a group by calling diff --git a/doc/misc/info.texi b/doc/misc/info.texi index 98e0dceb5a2..6ebf60ce360 100644 --- a/doc/misc/info.texi +++ b/doc/misc/info.texi @@ -1191,8 +1191,9 @@ info-stnd, GNU Info}. The list of directories to search for Info files. Each element is a string (directory name) or @code{nil} (try default directory). If not initialized Info uses the environment variable @env{INFOPATH} to -initialize it, or @code{Info-default-directory-list} if there is no -@env{INFOPATH} variable in the environment. +initialize it, or @code{Info-default-directory-list} in addition to +the value returned by the @code{Info--default-directory-list} function +if there is no @env{INFOPATH} variable in the environment. If you wish to customize the Info directory search list for both Emacs Info and stand-alone Info, it is best to set the @env{INFOPATH} diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index a3bc4684135..70f1e8bd1de 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -5,9 +5,9 @@ #+options: ':t toc:nil author:t email:t num:t #+startup: content -#+macro: stable-version 2.1.0 -#+macro: release-date 2022-02-17 -#+macro: development-version 2.2.0-dev +#+macro: stable-version 2.2.0 +#+macro: release-date 2022-02-23 +#+macro: development-version 2.3.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -260,9 +260,9 @@ a theme with either of the following expressions: Changes to the available customization options must always be evaluated before loading a theme ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). An exception to this norm is when using the various Custom interfaces or with commands like -{{{kbd(M-x customize-set-variable)}}}, which automatically reload the theme by -default ([[#h:9001527a-4e2c-43e0-98e8-3ef72d770639][Option for inhibiting theme reload]]). This is how a basic setup -could look like: +{{{kbd(M-x customize-set-variable)}}}, which can automatically reload +the theme ([[#h:9001527a-4e2c-43e0-98e8-3ef72d770639][Option for inhibiting theme reload]]). This is how a basic +setup could look like: #+begin_src emacs-lisp (require 'modus-themes) @@ -372,9 +372,9 @@ it might appear to the unsuspecting user that the themes are somehow broken whenever they try to assign a new value to a customization option or some face. -This "reset" that ~load-theme~ conducts does, however, come at the cost -of being somewhat slower than ~enable-theme~. Users who have a stable -setup and who seldom update their variables during a given Emacs +This "reset" that ~load-theme~ brings about does, however, come at the +cost of being somewhat slower than ~enable-theme~. Users who have a +stable setup and who seldom update their variables during a given Emacs session, are better off using something like this: #+begin_src emacs-lisp @@ -385,6 +385,8 @@ session, are better off using something like this: (enable-theme 'modus-operandi) ;; OR (enable-theme 'modus-vivendi) #+end_src +[[#h:b40aca50-a3b2-4c43-be58-2c26fcd14237][Toggle themes without reloading them]]. + [[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and without use-package]]. With the above granted, other sections of the manual discuss how to @@ -472,7 +474,22 @@ this manual. ;; symbols: `background', `bold', `gray', `intense', `italic' modus-themes-prompts '(intense bold) - modus-themes-completions 'moderate ; {nil,'moderate,'opinionated,'super-opinionated} + ;; The `modus-themes-completions' is an alist that reads three + ;; keys: `matches', `selection', `popup'. Each accepts a nil + ;; value (or empty list) or a list of properties that can include + ;; any of the following (for WEIGHT read further below): + ;; + ;; `key' - `background', `intense', `underline', `italic', WEIGHT + ;; `selection' - `accented', `intense', `underline', `italic', WEIGHT + ;; `popup' - same as `selected' + ;; `t' - applies to any key not explicitly referenced (check docs) + ;; + ;; WEIGHT is a symbol such as `semibold', `light', or anything + ;; covered in `modus-themes-weights'. Bold is used in the absence + ;; of an explicit WEIGHT. + modus-themes-completions '((matches . (extrabold)) + (selection . (semibold accented)) + (popup . (accented intense))) modus-themes-mail-citations nil ; {nil,'intense,'faint,'monochrome} @@ -1058,53 +1075,103 @@ Centaur tabs package. ** Option for completion framework aesthetics :properties: :alt_title: Completion UIs -:description: Choose among standard, moderate, or opinionated looks +:description: Choose among several styles for completion UIs :custom_id: h:f1c20c02-7b34-4c35-9c65-99170efb2882 :end: #+vindex: modus-themes-completions Brief: Set the overall style of completion framework interfaces. -Symbol: ~modus-themes-completions~ (=choice= type) +Symbol: ~modus-themes-completions~ (=alist= type properties) -Possible values: +This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy, Mct, +Orderless, Selectrum, Vertico. The value is an alist that takes the +form of a =(key . properties)= combination. Here is a sample, followed +by a description of the particularities: -1. ~nil~ (default) -2. ~moderate~ -3. ~opinionated~ -4. ~super-opinionated~ - -This is a special option that has different effects depending on the -completion UI. The interfaces can be grouped in two categories, based -on their default aesthetics: (i) those that only or mostly use -foreground colors for their interaction model, and (ii) those that -combine background and foreground values for some of their metaphors. -The former category encompasses Icomplete, Ido, Selectrum, Vertico, Mct, -as well as pattern matching styles like Orderless and Flx. The latter -covers Helm and Ivy. - -A value of nil (the default) will simply respect the metaphors of each -completion framework. - -Option ~moderate~ applies a combination of background and foreground that -is fairly subtle. For Icomplete and friends this constitutes a -departure from their default aesthetics, however the difference is -small. While Helm and Ivy appear slightly different than their original -looks, as they are toned down a bit. - -Option ~opinionated~ uses color combinations that refashion the completion -UI. For the Icomplete camp this means that intense background and -foreground combinations are used: in effect their looks approximate -those of Helm and Ivy in their original style. Whereas the other group -of packages will revert to an even more nuanced aesthetic with some -additional changes to the choice of hues. - -Option ~super-opinionated~ is like the ~opinionated~ though it has a more -pronounced effect, especially on the color of the current -line/candidate. - -To appreciate the scope of this customization option, you should spend -some time with every one of those presets. +#+begin_src emacs-lisp +(setq modus-themes-completions + '((matches . (extrabold background intense)) + (selection . (semibold accented intense)) + (popup . (accented)))) +#+end_src + +The ~matches~ key refers to the highlighted characters that correspond +to the user's input. By default (nil or an empty list), they have a +bold weight and a colored foreground. The list of properties may +include any of the following symbols regardless of the order they may +appear in: + +- ~background~ to add a background color; + +- ~intense~ to increase the overall coloration (also amplifies + the ~background~, if present); + +- ~underline~ to draw a line below the characters; + +- ~italic~ to use a slanted font (italic or oblique forms); + +- The symbol of a font weight attribute such as ~light~, ~semibold~, et + cetera. Valid symbols are defined in the ~modus-themes-weights~ + variable. The absence of a weight means that bold will be used. + +The ~selection~ key applies to the current line or currently matched +candidate, depending on the specifics of the User Interface. By default +(nil or an empty list), it has a subtle gray background and a bold +weight. The list of properties it accepts is as follows (order is not +significant): + +- ~accented~ to make the background colorful instead of gray; + +- ~intense~ to increase the overall coloration; + +- ~underline~ to draw a line below the characters; + +- ~italic~ to use a slanted font (italic or oblique forms); + +- The symbol of a font weight attribute such as ~light~, ~semibold~, et + cetera. Valid symbols are defined in the ~modus-themes-weights~ + variable. The absence of a weight means that bold will be used. + +The ~popup~ key takes the same values as ~selection~. + +Apart from specfying each key separately, a fallback list is accepted. +This is only useful when the desired aesthetic is the same across all +keys that are not explicitly referenced. For example, this: + +#+begin_src emacs-lisp +(setq modus-themes-completions + '((t . (extrabold intense)))) +#+end_src + +Is the same as: + +#+begin_src emacs-lisp +(setq modus-themes-completions + '((matches . (extrabold intense)) + (selection . (extrabold intense)) + (popup . (extrabold intense)))) +#+end_src + +In the case of the fallback, any property that does not apply to the +corresponding key is simply ignored (~matches~ does not have ~accented~, +~selection~ and ~popup~ do not have ~background~). + +A concise expression of those associations can be written as follows, +where the ~car~ is always the key and the ~cdr~ is the list of +properties (whatever order they may appear in): + +#+begin_src emacs-lisp +(setq modus-themes-completions + '((matches extrabold background intense) + (selection semibold accented intense) + (popup accented))) +#+end_src + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. + +Also refer to the Orderless documentation for its intersection with +Company (if you choose to use those in tandem). ** Option for mail citations :properties: @@ -2551,8 +2618,7 @@ both themes and expands to some more assosiations in the palette: (bg-header . "#ede3e0") (bg-tab-bar . "#dcd3d3") (bg-tab-active . "#fdf6eb") - (bg-tab-inactive . "#c8bab8") - (fg-unfocused . "#55556f")) + (bg-tab-inactive . "#c8bab8")) modus-themes-vivendi-color-overrides '((bg-main . "#100b17") (bg-dim . "#161129") @@ -2564,17 +2630,34 @@ both themes and expands to some more assosiations in the palette: (bg-header . "#202037") (bg-tab-bar . "#262b41") (bg-tab-active . "#120f18") - (bg-tab-inactive . "#3a3a5a") - (fg-unfocused . "#9a9aab"))) + (bg-tab-inactive . "#3a3a5a"))) (setq modus-themes-operandi-color-overrides nil modus-themes-vivendi-color-overrides nil))) #+end_src -With this in place, one can invoke {{{kbd(M-x my-modus-themes-tinted)}}} and -then load the Modus theme of their choice. The new palette subset will -come into effect: subtle ochre tints for Modus Operandi and night sky -shades for Modus Vivendi. Switching between the two themes, such as -with {{{kbd(M-x modus-themes-toggle)}}} will also use the overrides. +A more neutral style for ~modus-themes-operandi-color-overrides~ can +look like this: + +#+begin_src emacs-lisp +'((bg-main . "#f7f7f7") + (bg-dim . "#f2f2f2") + (bg-alt . "#e8e8e8") + (bg-hl-line . "#eaeaef") + (bg-active . "#e0e0e0") + (bg-inactive . "#e6e6e6") + (bg-region . "#b5b5b5") + (bg-header . "#e4e4e4") + (bg-tab-bar . "#d1d1d4") + (bg-tab-active . "#f5f5f5") + (bg-tab-inactive . "#c0c0c0")) +#+end_src + +With those in place, one can use {{{kbd(M-x my-modus-themes-tinted)}}} +and then load the Modus theme of their choice. The new palette subset +will come into effect: subtle ochre tints (or shades of gray) for Modus +Operandi and night sky blue shades for Modus Vivendi. Switching between +the two themes, such as with {{{kbd(M-x modus-themes-toggle)}}} will +also use the overrides. Given that this is a user-level customisation, one is free to implement whatever color values they desire, even if the possible combinations @@ -3465,6 +3548,35 @@ to be specified as well: (add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) #+end_src +** Toggle themes without reloading them +:properties: +:custom_id: h:b40aca50-a3b2-4c43-be58-2c26fcd14237 +:end: +#+cindex: Switch themes without load-theme + +Users who have a stable setup and who only ever need to toggle between +the themes without triggering a full reload, are better off defining +their own command which calls ~enable-theme~ instead of ~load-theme~: + +#+begin_src emacs-lisp +(defun my-modus-themes-toggle () + "Toggle between `modus-operandi' and `modus-vivendi' themes. +This uses `enable-theme' instead of the standard method of +`load-theme'. The technicalities are covered in the Modus themes +manual." + (interactive) + (pcase (modus-themes--current-theme) + ('modus-operandi (progn (enable-theme 'modus-vivendi) + (disable-theme 'modus-operandi))) + ('modus-vivendi (progn (enable-theme 'modus-operandi) + (disable-theme 'modus-vivendi))) + (_ (error "No Modus theme is loaded; evaluate `modus-themes-load-themes' first")))) +#+end_src + +[[#h:e68560b3-7fb0-42bc-a151-e015948f8a35][Differences between loading and enabling]]. + +Recall that ~modus-themes-toggle~ uses ~load-theme~. + ** A theme-agnostic hook for theme loading :properties: :custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776 @@ -5173,25 +5285,26 @@ The Modus themes are a collective effort. Every bit of work matters. + Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers, Adrian Manea, Alex Griffin, Alex Koen, Alex Peitsinis, Alexey Shmalko, Alok Singh, Anders Johansson, André Alexandre Gomes, Arif Rezai, Basil - L.{{{space()}}} Contovounesios, Burgess Chang, Christian Tietze, Christopher - Dimech, Damien Cassou, Daniel Mendler, Dario Gjorgjevski, David - Edmondson, Davor Rotim, Divan Santana, Eliraz Kedmi, Emanuele Michele - Alberto Monterosso, Farasha Euker, Feng Shu, Gautier Ponsinet, Gerry - Agbobada, Gianluca Recchia, Guilherme Semente, Gustavo Barros, + L.{{{space()}}} Contovounesios, Burgess Chang, Christian Tietze, + Christopher Dimech, Damien Cassou, Daniel Mendler, Dario Gjorgjevski, + David Edmondson, Davor Rotim, Divan Santana, Eliraz Kedmi, Emanuele + Michele Alberto Monterosso, Farasha Euker, Feng Shu, Gautier Ponsinet, + Gerry Agbobada, Gianluca Recchia, Guilherme Semente, Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Iris Garcia, Jeremy Friesen, Jerry - Zhang, Johannes Grødem, John Haman, Joshua O'Connor, Kevin Fleming, - Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Magne Hov, Manuel Uberti, - Mark Bestley, Mark Burton, Markus Beppler, Mauro Aranda, Michael - Goldenberg, Morgan Smith, Murilo Pereira, Nicky van Foreest, Nicolas - De Jaeghere, Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, - Philip Kaludercic, Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, - Rudolf Adamkovič, Sam Kleinman, Samuel Culpepper, Saša Janiška, - Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut Verron, Thomas - Heartman, Togan Muftuoglu, Trey Merkley, Tomasz Hołubowicz, Toon - Claes, Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: - Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, - Moesasji, Nick, TheBlob42, Trey, bepolymathe, bit9tream, derek-upham, - doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn, pRot0ta1p. + Zhang, Johannes Grødem, John Haman, Joshua O'Connor, Kenta Usami, + Kevin Fleming, Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Magne Hov, + Manuel Uberti, Mark Bestley, Mark Burton, Markus Beppler, Mauro + Aranda, Michael Goldenberg, Morgan Smith, Murilo Pereira, Nicky van + Foreest, Nicolas De Jaeghere, Paul Poloskov, Pengji Zhang, Pete + Kazmier, Peter Wu, Philip Kaludercic, Pierre Téchoueyres, Roman + Rudakov, Ryan Phillips, Rudolf Adamkovič, Sam Kleinman, Samuel + Culpepper, Saša Janiška, Shreyas Ragavan, Simon Pugnet, Tassilo Horn, + Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Trey Merkley, Tomasz + Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh, Vincent Foley. As + well as users: Ben, CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, + Fredrik, Moesasji, Nick, TheBlob42, Trey, bepolymathe, bit9tream, + derek-upham, doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn, + pRot0ta1p. + Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core Emacs), diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ce377e12234..62bcf9c73b3 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -157,6 +157,7 @@ Using @value{tramp} @end ifset * File name completion:: File name completion. * Ad-hoc multi-hops:: Declaring multiple hops in the file name. +* Home directories:: Expanding @file{~} to home directory. * Remote processes:: Integration with other Emacs packages. * Cleanup remote connections:: Cleanup remote connections. * Renaming remote files:: Renaming remote files. @@ -1663,7 +1664,7 @@ local one, first connect via @command{ssh}, and then apply (add-to-list 'tramp-default-proxies-alist '(nil "\\`root\\'" "@trampfn{ssh,%h,}")) (add-to-list 'tramp-default-proxies-alist - '((regexp-quote (system-name)) nil nil)) + `(,(regexp-quote (system-name)) nil nil)) @end group @end lisp @end defopt @@ -2176,6 +2177,14 @@ reestablished. A value of @code{nil} disables this feature. Most of the methods do not set this property except the @option{sudo} and @option{doas} methods, which use predefined values. +@item @t{"~"}@* +@t{"~user"} + +This is the home directory on the remote host. Setting this +connection property helps especially for methods which cannot expand +to a remote home directory, like @option{adb}, @option{rclone} and +@option{sshfs}. @ref{Home directories} for an example. + @item @t{"tmpdir"} The temporary directory on the remote host. If not specified, the @@ -3252,6 +3261,7 @@ is a feature of Emacs that may cause missed prompts when using @end ifset * File name completion:: File name completion. * Ad-hoc multi-hops:: Declaring multiple hops in the file name. +* Home directories:: Expanding @file{~} to home directory. * Remote processes:: Integration with other Emacs packages. * Cleanup remote connections:: Cleanup remote connections. * Renaming remote files:: Renaming remote files. @@ -3267,24 +3277,25 @@ is a feature of Emacs that may cause missed prompts when using @file{@trampfn{method,host,/path/to/file}} opens file @var{/path/to/file} on the remote host @var{host}, using the method @var{method}. +@c We cannot use @trampfn{} in @item. @table @file -@item @trampfn{ssh,melancholia,.emacs} +@item @value{prefix}ssh@value{postfixhop}melancholia@value{postfix}.emacs For the file @file{.emacs} located in the home directory, on the host @code{melancholia}, using method @code{ssh}. -@item @trampfn{ssh,melancholia.danann.net,.emacs} +@item @value{prefix}ssh@value{postfixhop}melancholia.danann.net@value{postfix}.emacs For the file @file{.emacs} specified using the fully qualified domain name of the host. -@item @trampfn{ssh,melancholia,~/.emacs} +@item @value{prefix}ssh@value{postfixhop}melancholia@value{postfix}~/.emacs For the file @file{.emacs} specified using the @file{~}, which is expanded. -@item @trampfn{ssh,melancholia,~daniel/.emacs} +@item @value{prefix}ssh@value{postfixhop}melancholia@value{postfix}~daniel/.emacs For the file @file{.emacs} located in @code{daniel}'s home directory on the host, @code{melancholia}. The @file{~<user>} construct is expanded to the home directory of that user on the remote host. -@item @trampfn{ssh,melancholia,/etc/squid.conf} +@item @value{prefix}ssh@value{postfixhop}melancholia@value{postfix}/etc/squid.conf For the file @file{/etc/squid.conf} on the host @code{melancholia}. @end table @@ -3534,6 +3545,66 @@ file name is equivalent to the previous example: @samp{@trampfn{ssh@value{postfixhop}remotehost|su,,}}. +@node Home directories +@section Expanding @file{~} to home directory + +Home directories on remote hosts can be typed as tilde @file{~}. If +possible, they are expanded to the remote user's home directory on the +remote host. Example: + +@example +@group +@trampfn{ssh,user@@host,~} +@result{} @trampfn{ssh,user@@host,/home/user} +@end group +@end example + +This works in general for @option{ssh}-like methods, and for +@option{sudoedit}. These methods allow also the home directory +expansion for another user, like + +@example +@group +@trampfn{sudoedit,,~otheruser} +@result{} @trampfn{sudoedit,root@@localhost,/home/otheruser} +@end group +@end example + +For other methods, a home directory can be expanded only if supported. +This happens for example for the @option{sftp} method. Methods, which +require a share directory in the remote file name (@option{afp}, +@option{smb}), use the value of this share directory as home +directory: + +@example +@group +@trampfn{smb,user@@host,~} +@result{} @trampfn{smb,user@@host,/share} +@end group +@end example + +Since Tramp cannot know in advance which share directory is intended +to use, this expansion can be applied only when a share directory has +been used already. + +The methods @option{adb}, @option{rclone} and @option{sshfs} do not +support home directory expansion at all. However, @value{tramp} keeps +the home directory in the cache. Therefore, those methods could be +configured to expand a home directory via a connection property, +@xref{Predefined connection information}. Example: + +@lisp +@group +(add-to-list 'tramp-connection-properties + (list (regexp-quote "@trampfn{sshfs,user@@randomhost.your.domain,}") + "~user" "/home/user")) +@end group +@end lisp + +When your remote file name does not contain a @samp{user} part, the +connection property @t{"~"} must be used instead. + + @node Remote processes @section Integration with other Emacs packages @cindex @code{compile} @@ -4519,6 +4590,20 @@ there. @itemize @bullet @item +What is the official name - ``Tramp'' or ``@value{tramp}''? + +The official name is ``Tramp''. This is used in comments, docstrings, +and everywhere speaking about @value{tramp}. + +However, for historical reasons this is formatted as ``@@sc@{Tramp@}'' +in the @value{tramp} manual. +@ifinfo +@pxref{Smallcaps, , , texinfo}. +@end ifinfo +So it looks different there. + + +@item Where is the latest @value{tramp}? @value{tramp} is available at the GNU URL: diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index bf048841a65..191fe8cd853 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -23,9 +23,9 @@ General Public License for more details. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry -* Transient: (transient). Transient Commands. +* Transient: (transient). Transient Commands. @end direntry @finalout @@ -729,7 +729,7 @@ The default is: This displays the window at the bottom of the selected frame. Another useful @var{function} is @code{display-buffer-below-selected}, which is what @code{magit-popup} used by default. For more alternatives see -@ref{Display Action Functions,,,elisp,}, and see @ref{Buffer Display +@ref{Buffer Display Action Functions,,,elisp,}, and see @ref{Buffer Display Action Alists,,,elisp,}. Note that the buffer that was current before the transient buffer diff --git a/etc/DEBUG b/etc/DEBUG index dd33b42f19a..7d2f810d078 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -947,10 +947,10 @@ several kinds of low-level problems in C code, including: * Passing invalid values to some builtin functions, e.g., __builtin_clz (0). * Reaching __builtin_unreachable calls (in Emacs, 'eassume' failure). -To use UndefinedBehaviorSanitizer with GCC and similar compilers, -append '-fsanitize=undefined' to CFLAGS, either when running -'configure' or running 'make'. When supported, you can also specify -'bound-strict' and 'float-cast-overflow'. For example: +To use GCC's UndefinedBehaviorSanitizer, append '-fsanitize=undefined' +to CFLAGS, either when running 'configure' or running 'make'. +When supported, you can also specify 'bound-strict' and +'float-cast-overflow'. For example: ./configure \ CFLAGS='-O0 -g3 -fsanitize=undefined,bounds-strict,float-cast-overflow' @@ -958,6 +958,11 @@ append '-fsanitize=undefined' to CFLAGS, either when running You may need to append '-static-libubsan' to CFLAGS if your version of GCC is installed in an unusual location. +Clang's UB sanitizer can also be used, but has coverage problems. +You'll need '-fsanitize=undefined -fno-sanitize=pointer-overflow' to +suppress misguided warnings about adding zero to a null pointer, +although this also suppresses any valid pointer overflow warnings. + When using GDB to debug an executable with undefined-behavior sanitization, the GDB command: @@ -108,6 +108,11 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 --- +** 'Info-default-directory-list' is no longer populated at Emacs startup. +If you have code in your init file that removes directories from +'Info-default-directory-list', this will no longer work. + +--- ** 'C-k' no longer deletes files in 'ido-mode'. To get the previous action back, put something like the following in your init file: @@ -153,10 +158,23 @@ beginning. An autoload definition appears just as a '(defun . NAME)' and the '(t . NAME)' entries are not generated any more. +--- +** The Tamil input methods no longer insert Tamil digits. +The input methods 'tamil-itrans' and 'tamil-inscript' no longer insert +the Tamil digits, as those digit characters are not used nowadays by +speakers of the Tamil language. To get back the previous behavior, +use the new 'tamil-itrans-digits' and 'tamil-inscript-digits' input +methods instead. + * Changes in Emacs 29.1 +++ +** New user option 'mouse-drag-and-drop-region-cross-program'. +If non-nil, this option allows dragging text in the region from Emacs +to another program. + ++++ ** New function 'command-query'. This function makes its argument command prompt the user for confirmation before executing. @@ -232,6 +250,11 @@ resource "synchronizeResize" to "off". This controls the opacity of the text background when running on a composited display. ++++ +** New frame parameter 'shaded'. +With window managers which support this, it controls whether or not a +frame's contents will be hidden, leaving only the title bar on display. + --- ** New user option 'x-gtk-use-native-input'. This controls whether or not GTK input methods are used by Emacs, @@ -620,6 +643,22 @@ header before sending a message. *** 'texinfo-mode' now has a specialised 'narrow-to-defun' definition. It narrows to the current node. +** EUDC + ++++ +*** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'. +Rename 'eudc-expansion-overwrites-query' to +'eudc-expansion-save-query-as-kill' to reflect the actual behaviour of +the customization variable. + ++++ +*** New command 'eudc-expand-try-all'. +This command can be used in place of 'eudc-expand-inline'. It takes a +prefix argument that causes 'eudc-expand-try-all' to return matches +from all servers instead of just the matches from the first server to +return any. This is useful for example, if one wants to search LDAP +for a name that happens to match a contact in one's BBDB. + ** eww/shr +++ @@ -1042,6 +1081,22 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 +--- +** 'prin1' doesn't always escape "." and "?" in symbols any more. +Previously, symbols like 'foo.bar' would be printed by 'prin1' as +"foo\.bar". This now prints as "foo.bar" instead. The Emacs Lisp +reader interprets these strings as referring to the same symbol, so +this is virtually always backwards-compatible, but there may +theoretically be code out there that expects a specific printed +representation. + +The same is the case with the "?" character: The 'foo?' symbol is now +printed as "foo?" instead of "foo\?". + +If the "." and "?" characters are the first character in the symbol, +they will still be escaped, so the '.foo' symbol is still printed as +"\.foo" and the '?bar' symbol is still printed as "\?bar". + +++ ** Remapping 'mode-line' no longer works as expected. 'mode-line' is now the parent face of the new 'mode-line-active' face, @@ -1154,6 +1209,17 @@ functions. * Lisp Changes in Emacs 29.1 +++ +** New function 'x-begin-drag'. +This function initiates a drag-and-drop request with the contents of +the selection 'XdndSelection', and returns when a drop occurs. + +--- +** New function 'ietf-drums-parse-date-string'. +This function parses RFC5322 (and RFC822) date strings, and should be +used instead of 'parse-time-string' when parsing data that's standards +compliant. + ++++ ** New macro 'setopt'. This is like 'setq', but uses 'customize-set-variable' to set the variable(s). @@ -1624,6 +1690,15 @@ when used as part of a property list specification for the ** 'defalias' records a more precise history of definitions. This is recorded in the `function-history` symbol property. +--- +** 'indian-tml-base-table' no longer translates digits. +Use 'indian-tml-base-digits-table' if you want digits translation. + +-- +** 'indian-tml-itrans-v5-hash' no longer translates digits. +Use 'indian-tml-itrans-digits-v5-hash' if you want digits +translation. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 58c7c44a2bf..84041d79c20 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -43,11 +43,10 @@ recommend examining any such warnings before you decide they are false. ** The Cairo graphics library is now used by default if present. -'--with-cairo' is now the default, if the appropriate development files -are found by 'configure'. Note that building with Cairo means using -Pango instead of libXFT for font support. Since Pango 1.44 has -removed support for bitmapped fonts, this may require you to adjust -your font settings. +'--with-cairo' is now the default, if the appropriate development +files are found by 'configure'. Building with Cairo is known to cause +some problems with bitmap fonts. This may require you to adjust your +font settings, or to build with Xft support instead. Note also that 'FontBackend' settings in ".Xdefaults" or ".Xresources", or 'font-backend' frame parameter settings in your init diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index c67235fae02..3cf06f92bbf 100644 --- a/etc/publicsuffix.txt +++ b/etc/publicsuffix.txt @@ -9,7 +9,7 @@ // ===BEGIN ICANN DOMAINS=== -// ac : https://en.wikipedia.org/wiki/.ac +// ac : http://nic.ac/rules.htm ac com.ac edu.ac @@ -865,6 +865,7 @@ gov.cx // cy : http://www.nic.cy/ // Submitted by registry Panayiotou Fotia <cydns@ucy.ac.cy> +// namespace policies URL https://www.nic.cy/portal//sites/default/files/symfonia_gia_eggrafi.pdf cy ac.cy biz.cy @@ -872,10 +873,9 @@ com.cy ekloges.cy gov.cy ltd.cy -name.cy +mil.cy net.cy org.cy -parliament.cy press.cy pro.cy tm.cy @@ -1366,7 +1366,7 @@ info int eu.int -// io : http://www.nic.io/rules.html +// io : http://www.nic.io/rules.htm // list of other 2nd level tlds ? io com.io @@ -6036,7 +6036,7 @@ gov.sg edu.sg per.sg -// sh : http://www.nic.sh/registrar.html +// sh : http://nic.sh/rules.htm sh com.sh net.sh @@ -7131,7 +7131,7 @@ org.zw // newGTLDs -// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2021-12-30T15:13:57Z +// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2022-02-18T15:13:38Z // This list is auto-generated, don't edit it manually. // aaa : 2015-02-26 American Automobile Association, Inc. aaa @@ -7556,9 +7556,6 @@ brother // brussels : 2014-02-06 DNS.be vzw brussels -// budapest : 2013-11-21 Minds + Machines Group Limited -budapest - // bugatti : 2015-07-23 Bugatti International SA bugatti @@ -7595,7 +7592,7 @@ call // calvinklein : 2015-07-30 PVH gTLD Holdings LLC calvinklein -// cam : 2016-04-21 AC Webconnecting Holding B.V. +// cam : 2016-04-21 Cam Connecting SARL cam // camera : 2013-08-27 Binky Moon, LLC @@ -7868,9 +7865,6 @@ cruise // cruises : 2013-12-05 Binky Moon, LLC cruises -// csc : 2014-09-25 Alliance-One Services, Inc. -csc - // cuisinella : 2014-04-03 SCHMIDT GROUPE S.A.S. cuisinella @@ -10639,6 +10633,10 @@ hlx3.page // Submitted by Przemyslaw Plewa <it-admin@domena.pl> beep.pl +// Aiven: https://aiven.io/ +// Submitted by Etienne Stalmans <security@aiven.io> +aivencloud.com + // alboto.ca : http://alboto.ca // Submitted by Anton Avramov <avramov@alboto.ca> barsy.ca @@ -10811,6 +10809,10 @@ myasustor.com // Submitted by Sam Smyth <devloop@atlassian.com> cdn.prod.atlassian-dev.net +// Authentick UG (haftungsbeschränkt) : https://authentick.net +// Submitted by Lukas Reschke <lukas@authentick.net> +translated.page + // AVM : https://avm.de // Submitted by Andreas Weise <a.weise@avm.de> myfritz.net @@ -10864,6 +10866,10 @@ theshop.jp shopselect.net base.shop +// Beget Ltd +// Submitted by Lev Nekrasov <lnekrasov@beget.com> +*.beget.app + // BetaInABox // Submitted by Adrian <adrian@betainabox.com> betainabox.com @@ -11240,6 +11246,11 @@ dedyn.io *.rss.my.id *.diher.solutions +// Discord Inc : https://discord.com +// Submitted by Sahn Lam <slam@discordapp.com> +discordsays.com +discordsez.com + // DNS Africa Ltd https://dns.business // Submitted by Calvin Browne <calvin@dns.business> jozi.biz @@ -11964,8 +11975,15 @@ futuremailing.at *.kunden.ortsinfo.at *.statics.cloud -// GDS : https://www.gov.uk/service-manual/operations/operating-servicegovuk-subdomains -// Submitted by David Illsley <david.illsley@digital.cabinet-office.gov.uk> +// GDS : https://www.gov.uk/service-manual/technology/managing-domain-names +// Submitted by Stephen Ford <hostmaster@digital.cabinet-office.gov.uk> +independent-commission.uk +independent-inquest.uk +independent-inquiry.uk +independent-panel.uk +independent-review.uk +public-inquiry.uk +royal-commission.uk service.gov.uk // CDDO : https://www.gov.uk/guidance/get-an-api-domain-on-govuk @@ -12021,8 +12039,113 @@ co.ro shop.ro // GMO Pepabo, Inc. : https://pepabo.com/ -// Submitted by dojineko <admin@pepabo.com> +// Submitted by Hosting Div <admin@pepabo.com> lolipop.io +angry.jp +babyblue.jp +babymilk.jp +backdrop.jp +bambina.jp +bitter.jp +blush.jp +boo.jp +boy.jp +boyfriend.jp +but.jp +candypop.jp +capoo.jp +catfood.jp +cheap.jp +chicappa.jp +chillout.jp +chips.jp +chowder.jp +chu.jp +ciao.jp +cocotte.jp +coolblog.jp +cranky.jp +cutegirl.jp +daa.jp +deca.jp +deci.jp +digick.jp +egoism.jp +fakefur.jp +fem.jp +flier.jp +floppy.jp +fool.jp +frenchkiss.jp +girlfriend.jp +girly.jp +gloomy.jp +gonna.jp +greater.jp +hacca.jp +heavy.jp +her.jp +hiho.jp +hippy.jp +holy.jp +hungry.jp +icurus.jp +itigo.jp +jellybean.jp +kikirara.jp +kill.jp +kilo.jp +kuron.jp +littlestar.jp +lolitapunk.jp +lomo.jp +lovepop.jp +lovesick.jp +main.jp +mods.jp +mond.jp +mongolian.jp +moo.jp +namaste.jp +nikita.jp +nobushi.jp +noor.jp +oops.jp +parallel.jp +parasite.jp +pecori.jp +peewee.jp +penne.jp +pepper.jp +perma.jp +pigboat.jp +pinoko.jp +punyu.jp +pupu.jp +pussycat.jp +pya.jp +raindrop.jp +readymade.jp +sadist.jp +schoolbus.jp +secret.jp +staba.jp +stripper.jp +sub.jp +sunnyday.jp +thick.jp +tonkotsu.jp +under.jp +upper.jp +velvet.jp +verse.jp +versus.jp +vivian.jp +watson.jp +weblike.jp +whitesnow.jp +zombie.jp +heteml.net // GOV.UK Platform as a Service : https://www.cloud.service.gov.uk/ // Submitted by Tom Whitwell <gov-uk-paas-support@digital.cabinet-office.gov.uk> @@ -12441,6 +12564,14 @@ js.org kaas.gg khplay.nl +// Kakao : https://www.kakaocorp.com/ +// Submitted by JaeYoong Lee <cec@kakaocorp.com> +ktistory.com + +// Kapsi : https://kapsi.fi +// Submitted by Tomi Juntunen <erani@kapsi.fi> +kapsi.fi + // Keyweb AG : https://www.keyweb.de // Submitted by Martin Dannehl <postmaster@keymachine.de> keymachine.de @@ -12758,7 +12889,10 @@ noop.app // Northflank Ltd. : https://northflank.com/ // Submitted by Marco Suter <marco@northflank.com> *.northflank.app +*.build.run *.code.run +*.database.run +*.migration.run // Noticeable : https://noticeable.io // Submitted by Laurent Pellegrino <security@noticeable.io> @@ -12941,6 +13075,10 @@ orsites.com // Submitted by Yngve Pettersen <yngve@opera.com> operaunite.com +// Orange : https://www.orange.com +// Submitted by Alexandre Linte <alexandre.linte@orange.com> +tech.orange + // Oursky Limited : https://authgear.com/, https://skygear.io/ // Submited by Authgear Team <hello@authgear.com>, Skygear Developer <hello@skygear.io> authgear-staging.com @@ -13050,6 +13188,10 @@ pleskns.com // Submitted by Maximilian Schieder <maxi@zeug.co> dyn53.io +// Porter : https://porter.run/ +// Submitted by Rudraksh MK <rudi@porter.run> +onporter.run + // Positive Codes Technology Company : http://co.bn/faq.html // Submitted by Zulfais <pc@co.bn> co.bn @@ -13211,6 +13353,10 @@ itcouldbewor.se // Submitted by Jennifer Herting <jchits@rit.edu> git-pages.rit.edu +// Rocky Enterprise Software Foundation : https://resf.org +// Submitted by Neil Hanlon <neil@resf.org> +rocky.page + // Rusnames Limited: http://rusnames.ru/ // Submitted by Sergey Zotov <admin@rusnames.ru> биз.рус @@ -13572,6 +13718,10 @@ lima.zone *.transurl.eu *.transurl.nl +// TransIP: https://www.transip.nl +// Submitted by Cedric Dubois <cedric.dubois@team.blue> +site.transip.me + // TuxFamily : http://tuxfamily.org // Submitted by TuxFamily administrators <adm@staff.tuxfamily.org> tuxfamily.org @@ -13694,19 +13844,14 @@ me.vu // Submitted by Serhii Rostilo <sergey@rostilo.kiev.ua> v.ua +// Vultr Objects : https://www.vultr.com/products/object-storage/ +// Submitted by Niels Maumenee <storage@vultr.com> +*.vultrobjects.com + // Waffle Computer Inc., Ltd. : https://docs.waffleinfo.com // Submitted by Masayuki Note <masa@blade.wafflecell.com> wafflecell.com -// WapBlog.ID : https://www.wapblog.id -// Submitted by Fajar Sodik <official@wapblog.id> -idnblogger.com -indowapblog.com -bloger.id -wblog.id -wbq.me -fastblog.net - // WebHare bv: https://www.webhare.com/ // Submitted by Arnold Hendriks <info@webhare.com> *.webhare.dev @@ -13743,6 +13888,10 @@ wmcloud.org panel.gg daemon.panel.gg +// Wizard Zines : https://wizardzines.com +// Submitted by Julia Evans <julia@wizardzines.com> +messwithdns.com + // WoltLab GmbH : https://www.woltlab.com // Submitted by Tim Düsterhus <security@woltlab.cloud> woltlab-demo.com diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index aac5b04c6a4..f71962e3f16 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -4,7 +4,7 @@ ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.1.0 +;; Version: 2.2.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index a902cc8ca23..067fc22ee44 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -4,8 +4,8 @@ ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.1.0 -;; Last-Modified: <2022-02-17 10:36:27 +0200> +;; Version: 2.2.0 +;; Last-Modified: <2022-02-23 08:56:46 +0200> ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -35,6 +35,7 @@ ;; ;; The themes share the following customization variables: ;; +;; modus-themes-completions (alist) ;; modus-themes-headings (alist) ;; modus-themes-org-agenda (alist) ;; modus-themes-bold-constructs (boolean) @@ -45,7 +46,6 @@ ;; modus-themes-subtle-line-numbers (boolean) ;; modus-themes-variable-pitch-ui (boolean) ;; modus-themes-box-buttons (choice) -;; modus-themes-completions (choice) ;; modus-themes-diffs (choice) ;; modus-themes-fringes (choice) ;; modus-themes-hl-line (choice) @@ -586,9 +586,8 @@ cover the blue-cyan-magenta side of the spectrum." (bg-region-accent . "#afafef") (bg-region-accent-subtle . "#efdfff") - (bg-completion-nuanced . "#dfe5ff") - (bg-completion-subtle . "#c3d4ff") - (bg-completion-intense . "#9fc8ff") + (bg-completion . "#b7dbff") + (bg-completion-subtle . "#def3ff") (bg-tab-active . "#f6f6f6") (bg-tab-inactive . "#b7b7b7") @@ -833,9 +832,8 @@ symbol and the latter as a string.") (bg-region-accent . "#4f3d88") (bg-region-accent-subtle . "#240f55") - (bg-completion-nuanced . "#1a2854") - (bg-completion-subtle . "#282878") - (bg-completion-intense . "#323da2") + (bg-completion . "#142f69") + (bg-completion-subtle . "#0e194b") (bg-tab-active . "#0e0e0e") (bg-tab-inactive . "#424242") @@ -1611,23 +1609,53 @@ The actual styling of the face is done by `modus-themes-faces'." The actual styling of the face is done by `modus-themes-faces'." :group 'modus-themes-faces) -(defface modus-themes-completion-standard-first-match nil - "Face for the Icomplete/Ido style first match. +(define-obsolete-face-alias + 'modus-themes-completion-standard-first-match + 'modus-themes-completion-selection + "2.2.0") + +(define-obsolete-face-alias + 'modus-themes-completion-standard-selected + 'modus-themes-completion-selection + "2.2.0") + +(define-obsolete-face-alias + 'modus-themes-completion-extra-selected + 'modus-themes-completion-selection + "2.2.0") + +(define-obsolete-face-alias + 'modus-themes-completion-key-binding + 'modus-themes-key-binding + "2.2.0") + +(defface modus-themes-completion-selected nil + "Face for current selection in completion UIs. +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-themes-faces) + +(defface modus-themes-completion-selected-popup nil + "Face for current selection in completion UI popups. +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-themes-faces) + +(defface modus-themes-completion-match-0 nil + "Face for completions matches 0. The actual styling of the face is done by `modus-themes-faces'." :group 'modus-themes-faces) -(defface modus-themes-completion-standard-selected nil - "Face for the standard completion UI current selection. +(defface modus-themes-completion-match-1 nil + "Face for completions matches 1. The actual styling of the face is done by `modus-themes-faces'." :group 'modus-themes-faces) -(defface modus-themes-completion-extra-selected nil - "Face for the extra completion UI current selection. +(defface modus-themes-completion-match-2 nil + "Face for completions matches 2. The actual styling of the face is done by `modus-themes-faces'." :group 'modus-themes-faces) -(defface modus-themes-completion-key-binding nil - "Face for key bindings in a completion UI context. +(defface modus-themes-completion-match-3 nil + "Face for completions matches 3. The actual styling of the face is done by `modus-themes-faces'." :group 'modus-themes-faces) @@ -2414,7 +2442,7 @@ instead of a box style, it is strongly advised to set (const :tag "No box effects (Moody-compatible)" moody)) (const :tag "Colored background" accented) (const :tag "Without border color" borderless) - (natnum :tag "With extra padding" :value 6)) + (natnum :tag "With extra padding")) :set #'modus-themes--set-option :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Mode line")) @@ -2462,50 +2490,153 @@ interest of optimizing for such a use-case." :link '(info-link "(modus-themes) Diffs")) (defcustom modus-themes-completions nil - "Control the style of the completion framework's interface. - -This is a special option that has different effects depending on -the completion UI. The interfaces can be grouped in two -categories, based on their default aesthetics: (i) those that -only or mostly use foreground colors for their interaction model, -and (ii) those that combine background and foreground values for -some of their metaphors. The former category encompasses -Icomplete, Ido, Selectrum, Vertico, Mct, as well as pattern -matching styles like Orderless and Flx. The latter covers Helm -and Ivy. - -A value of nil (the default) will simply respect the metaphors of -each completion framework. - -Option `moderate' applies a combination of background and -foreground that is fairly subtle. For Icomplete and friends this -constitutes a departure from their default aesthetics, however -the difference is small. While Helm and Ivy appear slightly -different than their original looks, as they are toned down a -bit. - -Option `opinionated' uses color combinations that refashion the -completion UI. For the Icomplete camp this means that intense -background and foreground combinations are used: in effect their -looks approximate those of Helm and Ivy in their original style. -Whereas the other group of packages will revert to an even more -nuanced aesthetic with some additional changes to the choice of -hues. - -Option `super-opinionated' is like the `opinionated' though it -has a more pronounced effect, especially on the color of the -current line/candidate. - -To appreciate the scope of this customization option, you should -spend some time with each of those presets." + "Control the style of completion user interfaces. + +This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy, +Mct, Orderless, Selectrum, Vertico. The value is an alist that +takes the form of a (key . properties) combination. Here is a +sample, followed by a description of the particularities: + + (setq modus-themes-completions + (quote ((matches . (extrabold background intense)) + (selection . (semibold accented intense)) + (popup . (accented))))) + +The `matches' key refers to the highlighted characters that +correspond to the user's input. By default (nil or an empty +list), they have a bold weight and a colored foreground. The +list of properties may include any of the following symbols +regardless of the order they may appear in: + +- `background' to add a background color; + +- `intense' to increase the overall coloration (also amplifies + the `background', if present); + +- `underline' to draw a line below the characters; + +- `italic' to use a slanted font (italic or oblique forms); + +- The symbol of a font weight attribute such as `light', + `semibold', et cetera. Valid symbols are defined in the + variable `modus-themes-weights'. The absence of a weight means + that bold will be used. + +The `selection' key applies to the current line or currently +matched candidate, depending on the specifics of the User +Interface. By default (nil or an empty list), it has a subtle +gray background and a bold weight. The list of properties it +accepts is as follows (order is not significant): + +- `accented' to make the background colorful instead of gray; + +- `intense' to increase the overall coloration; + +- `underline' to draw a line below the characters; + +- `italic' to use a slanted font (italic or oblique forms); + +- The symbol of a font weight attribute such as `light', + `semibold', et cetera. Valid symbols are defined in the + variable `modus-themes-weights'. The absence of a weight means + that bold will be used. + +The `popup' key takes the same values as `selection'. + +Apart from specfying each key separately, a fallback list is +accepted. This is only useful when the desired aesthetic is the +same across all keys that are not explicitly referenced. For +example, this: + + (setq modus-themes-completions + (quote ((t . (extrabold intense))))) + +Is the same as: + + (setq modus-themes-completions + (quote ((matches . (extrabold intense)) + (selection . (extrabold intense)) + (popup . (extrabold intense))))) + +In the case of the fallback, any property that does not apply to +the corresponding key is simply ignored (`matches' does not have +`accented', `selection' and `popup' do not have `background'). + +A concise expression of those associations can be written as +follows, where the `car' is always the key and the `cdr' is the +list of properties (whatever order they may appear in): + + (setq modus-themes-completions + (quote ((matches extrabold background intense) + (selection semibold accented intense) + (popup accented)))) + +Check the manual for tweaking `bold' and `italic' faces: Info +node `(modus-themes) Configure bold and italic faces'. + +Also refer to the Orderless documentation for its intersection +with Company (if you choose to use those in tandem)." :group 'modus-themes - :package-version '(modus-themes . "2.1.0") + :package-version '(modus-themes . "2.2.0") :version "29.1" - :type '(choice - (const :format "[%v] %t\n" :tag "Respect the framework's established aesthetic (default)" nil) - (const :format "[%v] %t\n" :tag "Subtle backgrounds for various elements" moderate) - (const :format "[%v] %t\n" :tag "Alternative to the framework's looks" opinionated) - (const :format "[%v] %t\n" :tag "Radical alternative to the framework's looks" super-opinionated)) + :type `(set + (cons :tag "Matches" + (const matches) + (set :tag "Style of matches" :greedy t + (choice :tag "Font weight (must be supported by the typeface)" + (const :tag "Bold (default)" nil) + (const :tag "Thin" thin) + (const :tag "Ultra-light" ultralight) + (const :tag "Extra-light" extralight) + (const :tag "Light" light) + (const :tag "Semi-light" semilight) + (const :tag "Regular" regular) + (const :tag "Medium" medium) + (const :tag "Semi-bold" semibold) + (const :tag "Extra-bold" extrabold) + (const :tag "Ultra-bold" ultrabold)) + (const :tag "With added background" background) + (const :tag "Increased coloration" intense) + (const :tag "Italic font (oblique or slanted forms)" italic) + (const :tag "Underline" underline))) + (cons :tag "Selection" + (const selection) + (set :tag "Style of selection" :greedy t + (choice :tag "Font weight (must be supported by the typeface)" + (const :tag "Bold (default)" nil) + (const :tag "Thin" thin) + (const :tag "Ultra-light" ultralight) + (const :tag "Extra-light" extralight) + (const :tag "Light" light) + (const :tag "Semi-light" semilight) + (const :tag "Regular" regular) + (const :tag "Medium" medium) + (const :tag "Semi-bold" semibold) + (const :tag "Extra-bold" extrabold) + (const :tag "Ultra-bold" ultrabold)) + (const :tag "With accented background" accented) + (const :tag "Increased coloration" intense) + (const :tag "Italic font (oblique or slanted forms)" italic) + (const :tag "Underline" underline))) + (cons :tag "Popup" + (const popup) + (set :tag "Style of completion pop-ups" :greedy t + (choice :tag "Font weight (must be supported by the typeface)" + (const :tag "Bold (default)" nil) + (const :tag "Thin" thin) + (const :tag "Ultra-light" ultralight) + (const :tag "Extra-light" extralight) + (const :tag "Light" light) + (const :tag "Semi-light" semilight) + (const :tag "Regular" regular) + (const :tag "Medium" medium) + (const :tag "Semi-bold" semibold) + (const :tag "Extra-bold" extrabold) + (const :tag "Ultra-bold" ultrabold)) + (const :tag "With accented background" accented) + (const :tag "Increased coloration" intense) + (const :tag "Italic font (oblique or slanted forms)" italic) + (const :tag "Underline" underline)))) :set #'modus-themes--set-option :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Completion UIs")) @@ -2999,7 +3130,7 @@ In user configuration files the form may look like this: (const :tag "Extra-light" extralight) (const :tag "Light" light) (const :tag "Semi-light" semilight) - (const :tag "Regulat (default)" nil) + (const :tag "Regular (default)" nil) (const :tag "Medium" medium) (const :tag "Bold" bold) (const :tag "Semi-bold" semibold) @@ -3676,47 +3807,61 @@ unspecified." (list deuteran) (list main))) -(defun modus-themes--standard-completions (mainfg subtlebg subtlefg intensebg intensefg &optional superbg superfg) - "Combinations for `modus-themes-completions'. - -MAINFG is an accented foreground value. SUBTLEBG is an accented -background value that can be combined with SUBTLEFG. INTENSEBG -and INTENSEFG are accented colors that are designed to be used in -tandem. Same principle for the optional SUPERBG and SUPERFG. - -These are intended for Icomplete, Ido, and related." - (pcase modus-themes-completions - ('super-opinionated (list :background (or superbg intensebg) :foreground (or superfg intensefg))) - ('opinionated (list :background intensebg :foreground intensefg)) - ('moderate (list :background subtlebg :foreground subtlefg)) - (_ (list :foreground mainfg)))) - -(defun modus-themes--extra-completions (default moderate opinionated) - "Combinations for `modus-themes-completions'. - -DEFAULT, MODERATE, and OPINIONATED are faces that correspond to -the stylistic variants of the aforementioned user option. - -These are intended for Ivy and Helm." - (pcase modus-themes-completions - ('super-opinionated (list :inherit (list 'bold opinionated))) - ('opinionated (list :inherit (list 'bold opinionated))) - ('moderate (list :inherit (list 'bold moderate))) - (_ (list :inherit (list 'bold default))))) - -(defun modus-themes--extra-completions-line (mainfg mainbg modbg opbg sopbg) - "Combinations for `modus-themes-completions'. - -MAINFG and MAINBG form the basic intense style. MODBG, OPBG, and -SOPBG are the moderate, opinionated, and super-opinionated -backgrounds, respectively. - -These are intended for Ivy and Helm." - (pcase modus-themes-completions - ('super-opinionated (list :inherit 'bold :background sopbg :foreground mainfg)) - ('opinionated (list :inherit 'bold :background opbg :foreground mainfg)) - ('moderate (list :inherit 'bold :background modbg :foreground mainfg)) - (_ (list :inherit 'bold :background mainbg :foreground mainfg)))) +(defun modus-themes--completion (key bg fg bgintense fgintense &optional bgaccent bgaccentintense) + "Styles for `modus-themes-completions'. +KEY is the key of a cons cell. BG and FG are the main colors. +BGINTENSE works with the main foreground. FGINTENSE works on its +own. BGACCENT and BGACCENTINTENSE are colorful variants of the +other backgrounds." + (let* ((var (if (listp modus-themes-completions) + modus-themes-completions + (prog1 nil + (warn (concat "`modus-themes-completions' has changed." + "\n" + "Its value must now be an alist." + "\n" + "Please read the updated doc string."))))) + (properties (or (alist-get key var) (alist-get t var))) + (popup (eq key 'popup)) + (selection (eq key 'selection)) + (line (or popup selection)) + (background (or line (memq 'background properties))) + (base-fg (if selection fg 'unspecified)) + (accented (memq 'accented properties)) + (intense (memq 'intense properties)) + (italic (memq 'italic properties)) + (weight (modus-themes--weight properties)) + (bold (when (and weight (eq weight 'bold)) 'bold))) + (list + :inherit + (cond + ((and italic weight (not (eq weight 'bold))) + 'italic) + ((and weight (not (eq weight 'bold))) + 'unspecified) + (italic 'bold-italic) + ('bold)) + :background + (cond + ((and accented intense line) + bgaccentintense) + ((and accented line) + bgaccent) + ((and background intense) + bgintense) + (background bg) + ('unspecified)) + :foreground + (cond + ((and background intense) + base-fg) + (background fg) + (intense fgintense) + (fg)) + :underline + (if (memq 'underline properties) t 'unspecified) + :weight + (if (and weight (null bold)) weight 'unspecified)))) (defun modus-themes--link (fg fgfaint underline bg bgneutral) "Conditional application of link styles. @@ -4359,27 +4504,32 @@ by virtue of calling either of `modus-themes-load-operandi' and `(modus-themes-tab-backdrop ((,class ,@(modus-themes--tab bg-active bg-active-accent nil nil nil nil t)))) `(modus-themes-tab-inactive ((,class ,@(modus-themes--tab bg-tab-inactive bg-tab-inactive-accent fg-dim nil t)))) ;;;;; completion frameworks - `(modus-themes-completion-standard-first-match - ((,class :inherit bold - ,@(modus-themes--standard-completions - magenta bg-alt magenta-alt - bg-active fg-main - blue-intense-bg)))) - `(modus-themes-completion-standard-selected - ((,class :inherit bold :foreground ,fg-main - :background ,@(pcase modus-themes-completions - ('super-opinionated (list bg-completion-intense)) - ('opinionated (list bg-active)) - ('moderate (list bg-completion-nuanced)) - (_ (list bg-inactive)))))) - `(modus-themes-completion-extra-selected - ((,class ,@(modus-themes--extra-completions-line - fg-main bg-completion-intense bg-completion-subtle - bg-completion-nuanced bg-active)))) - `(modus-themes-completion-key-binding - ((,class ,@(if (null modus-themes-completions) - (list :foreground magenta-alt-other) - (list :inherit 'modus-themes-key-binding))))) + `(modus-themes-completion-match-0 + ((,class ,@(modus-themes--completion + 'matches bg-special-faint-calm magenta-alt + magenta-subtle-bg magenta-intense)))) + `(modus-themes-completion-match-1 + ((,class ,@(modus-themes--completion + 'matches bg-special-faint-cold cyan + cyan-subtle-bg cyan-intense)))) + `(modus-themes-completion-match-2 + ((,class ,@(modus-themes--completion + 'matches bg-special-faint-mild green + green-subtle-bg green-intense)))) + `(modus-themes-completion-match-3 + ((,class ,@(modus-themes--completion + 'matches bg-special-faint-warm yellow + yellow-subtle-bg orange-intense)))) + `(modus-themes-completion-selected + ((,class ,@(modus-themes--completion + 'selection bg-inactive 'unspecified + bg-active 'unspecified + bg-completion-subtle bg-completion)))) + `(modus-themes-completion-selected-popup + ((,class ,@(modus-themes--completion + 'popup bg-active 'unspecified + bg-region 'unspecified + cyan-subtle-bg cyan-refine-bg)))) ;;;;; buttons `(modus-themes-box-button ((,class ,@(modus-themes--button bg-active bg-main bg-active-accent @@ -4771,23 +4921,21 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; column-enforce-mode `(column-enforce-face ((,class :inherit modus-themes-refine-yellow))) ;;;;; company-mode - `(company-echo-common ((,class :foreground ,magenta-alt-other))) + `(company-echo-common ((,class :inherit modus-themes-completion-match-0))) `(company-preview ((,class :background ,bg-dim :foreground ,fg-dim))) - `(company-preview-common ((,class :foreground ,blue-alt))) + `(company-preview-common ((,class :inherit company-echo-common))) `(company-preview-search ((,class :inherit modus-themes-special-calm))) `(company-template-field ((,class :inherit modus-themes-intense-magenta))) `(company-tooltip ((,class :background ,bg-alt :foreground ,fg-alt))) - `(company-tooltip-annotation ((,class :inherit modus-themes-slant :foreground ,fg-special-cold))) - `(company-tooltip-annotation-selection ((,class :inherit bold :foreground ,fg-main))) - `(company-tooltip-common ((,class :inherit bold :foreground ,blue-alt))) - `(company-tooltip-common-selection ((,class :foreground ,fg-main))) + `(company-tooltip-annotation ((,class :inherit completions-annotations))) + `(company-tooltip-common ((,class :inherit company-echo-common))) `(company-tooltip-deprecated ((,class :inherit company-tooltip :strike-through t))) - `(company-tooltip-mouse ((,class :inherit modus-themes-intense-blue))) + `(company-tooltip-mouse ((,class :inherit highlight))) `(company-tooltip-scrollbar-thumb ((,class :background ,fg-active))) `(company-tooltip-scrollbar-track ((,class :background ,bg-active))) `(company-tooltip-search ((,class :inherit (modus-themes-search-success-lazy bold)))) `(company-tooltip-search-selection ((,class :inherit (modus-themes-search-success bold) :underline t))) - `(company-tooltip-selection ((,class :inherit (modus-themes-subtle-cyan bold)))) + `(company-tooltip-selection ((,class :inherit modus-themes-completion-selected-popup))) ;;;;; company-posframe `(company-posframe-active-backend-name ((,class :inherit bold :background ,bg-active :foreground ,blue-active))) `(company-posframe-inactive-backend-name ((,class :background ,bg-active :foreground ,fg-active))) @@ -4803,13 +4951,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(compilation-warning ((,class :inherit modus-themes-bold :foreground ,yellow-alt))) ;;;;; completions `(completions-annotations ((,class :inherit modus-themes-slant :foreground ,cyan-faint))) - `(completions-common-part ((,class ,@(modus-themes--standard-completions - blue-alt bg-special-mild fg-special-mild - cyan-refine-bg cyan-refine-fg)))) - `(completions-first-difference ((,class :inherit bold - ,@(modus-themes--standard-completions - magenta-alt bg-special-calm fg-special-calm - magenta-intense-bg fg-main)))) + `(completions-common-part ((,class :inherit modus-themes-completion-match-0))) + `(completions-first-difference ((,class :inherit modus-themes-completion-match-1))) ;;;;; consult `(consult-async-running ((,class :inherit bold :foreground ,blue))) `(consult-async-split ((,class :foreground ,magenta-alt))) @@ -4824,7 +4967,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(consult-preview-error ((,class :inherit modus-themes-intense-red))) `(consult-preview-line ((,class :background ,bg-hl-alt-intense))) ;;;;; corfu - `(corfu-current ((,class :inherit bold :background ,cyan-subtle-bg))) + `(corfu-current ((,class :inherit modus-themes-completion-selected-popup))) `(corfu-bar ((,class :background ,fg-alt))) `(corfu-border ((,class :background ,bg-active))) `(corfu-default ((,class :background ,bg-alt))) @@ -4887,6 +5030,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(custom-set ((,class :foreground ,blue-alt))) `(custom-state ((,class :foreground ,red-alt-faint))) `(custom-themed ((,class :inherit modus-themes-subtle-blue))) + `(custom-variable-obsolete ((,class :inherit shadow))) `(custom-variable-tag ((,class :foreground ,cyan))) ;;;;; dap-mode `(dap-mouse-eval-thing-face ((,class :box (:line-width -1 :color ,blue-active :style nil) @@ -5196,7 +5340,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(elpher-gemini-heading2 ((,class :inherit modus-themes-heading-2))) `(elpher-gemini-heading3 ((,class :inherit modus-themes-heading-3))) ;;;;; embark - `(embark-keybinding ((,class :inherit modus-themes-completion-key-binding))) + `(embark-keybinding ((,class :inherit modus-themes-key-binding))) ;;;;; ement (ement.el) `(ement-room-fully-read-marker ((,class :background ,cyan-subtle-bg))) `(ement-room-membership ((,class :inherit shadow))) @@ -5440,10 +5584,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(flyspell-duplicate ((,class :inherit modus-themes-lang-warning))) `(flyspell-incorrect ((,class :inherit modus-themes-lang-error))) ;;;;; flx - `(flx-highlight-face ((,class ,@(modus-themes--extra-completions - 'modus-themes-intense-magenta - 'modus-themes-subtle-magenta - 'modus-themes-special-calm)))) + `(flx-highlight-face ((,class :inherit modus-themes-completion-match-0))) ;;;;; freeze-it `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm))) ;;;;; frog-menu @@ -5695,10 +5836,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(helm-eshell-prompts-promptidx ((,class :foreground ,cyan-active))) `(helm-etags-file ((,class :foreground ,fg-dim :underline t))) `(helm-ff-backup-file ((,class :inherit shadow))) - `(helm-ff-denied ((,class ,@(modus-themes--extra-completions - 'modus-themes-intense-red - 'modus-themes-subtle-red - 'modus-themes-special-warm)))) + `(helm-ff-denied ((,class :inherit modus-themes-intense-red))) `(helm-ff-directory ((,class :inherit helm-buffer-directory))) `(helm-ff-dirs ((,class :inherit bold :foreground ,blue-alt-other))) `(helm-ff-dotted-directory ((,class :inherit bold :background ,bg-alt :foreground ,fg-alt))) @@ -5707,59 +5845,35 @@ by virtue of calling either of `modus-themes-load-operandi' and `(helm-ff-file ((,class :foreground ,fg-main))) `(helm-ff-file-extension ((,class :foreground ,fg-special-warm))) `(helm-ff-invalid-symlink ((,class :inherit modus-themes-link-broken))) - `(helm-ff-pipe ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-magenta - 'modus-themes-subtle-magenta - 'modus-themes-special-calm)))) - `(helm-ff-prefix ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-yellow - 'modus-themes-subtle-yellow - 'modus-themes-special-warm)))) + `(helm-ff-pipe ((,class :inherit modus-themes-special-calm))) + `(helm-ff-prefix ((,class :inherit modus-themes-special-warm))) `(helm-ff-socket ((,class :foreground ,red-alt-other))) - `(helm-ff-suid ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-red - 'modus-themes-subtle-red - 'modus-themes-special-warm)))) + `(helm-ff-suid ((,class :inherit modus-themes-special-warm))) `(helm-ff-symlink ((,class :inherit modus-themes-link-symlink))) `(helm-ff-truename ((,class :foreground ,blue-alt-other))) - `(helm-fd-finish ((,class :foreground ,green-active))) + `(helm-fd-finish ((,class :inherit success))) `(helm-grep-cmd-line ((,class :foreground ,yellow-alt-other))) `(helm-grep-file ((,class :inherit bold :foreground ,fg-special-cold))) - `(helm-grep-finish ((,class :foreground ,green-active))) + `(helm-grep-finish ((,class :inherit bold))) `(helm-grep-lineno ((,class :foreground ,fg-special-warm))) `(helm-grep-match ((,class :inherit modus-themes-special-calm))) `(helm-header ((,class :inherit bold :foreground ,fg-special-cold))) `(helm-header-line-left-margin ((,class :inherit bold :foreground ,yellow-intense))) - `(helm-history-deleted ((,class ,@(modus-themes--extra-completions - 'modus-themes-intense-red - 'modus-themes-subtle-red - 'modus-themes-special-warm)))) + `(helm-history-deleted ((,class :inherit modus-themes-special-warm))) `(helm-history-remote ((,class :foreground ,red-alt-other))) - `(helm-lisp-completion-info ((,class :inherit compilation-info))) - `(helm-lisp-show-completion ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-yellow - 'modus-themes-subtle-yellow - 'modus-themes-special-warm)))) + `(helm-lisp-completion-info ((,class :inherit modus-themes-bold :foreground ,fg-special-cold))) + `(helm-lisp-show-completion ((,class :inherit modus-themes-special-warm))) `(helm-locate-finish ((,class :inherit success))) - `(helm-match ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-cyan - 'modus-themes-subtle-cyan - 'modus-themes-special-mild)))) + `(helm-match ((,class :inherit modus-themes-completion-match-0))) `(helm-match-item ((,class :inherit helm-match))) `(helm-minibuffer-prompt ((,class :inherit modus-themes-prompt))) `(helm-moccur-buffer ((,class :inherit button :foreground ,cyan-alt-other))) - `(helm-mode-prefix ((,class ,@(modus-themes--extra-completions - 'modus-themes-intense-magenta - 'modus-themes-subtle-magenta - 'modus-themes-special-calm)))) + `(helm-mode-prefix ((,class :inherit modus-themes-special-calm))) `(helm-non-file-buffer ((,class :inherit shadow))) `(helm-prefarg ((,class :foreground ,red-active))) - `(helm-resume-need-update ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-magenta - 'modus-themes-subtle-magenta - 'modus-themes-special-calm)))) - `(helm-selection ((,class :inherit modus-themes-completion-extra-selected))) - `(helm-selection-line ((,class :inherit modus-themes-special-cold))) + `(helm-resume-need-update ((,class :inherit modus-themes-special-calm))) + `(helm-selection ((,class :inherit modus-themes-completion-selected))) + `(helm-selection-line ((,class :background ,bg-hl-alt-intense))) `(helm-separator ((,class :foreground ,fg-special-mild))) `(helm-time-zone-current ((,class :foreground ,green))) `(helm-time-zone-home ((,class :foreground ,magenta))) @@ -5778,12 +5892,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(helm-ls-git-renamed-modified-face ((,class :foreground ,magenta))) `(helm-ls-git-untracked-face ((,class :foreground ,fg-special-cold))) ;;;;; helm-switch-shell - `(helm-switch-shell-new-shell-face ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-magenta - 'modus-themes-subtle-magenta - 'modus-themes-nuanced-magenta)))) + `(helm-switch-shell-new-shell-face ((,class :inherit modus-themes-completion-match-0))) ;;;;; helm-xref - `(helm-xref-file-name ((,class :inherit compilation-info))) + `(helm-xref-file-name ((,class :inherit modus-themes-bold :foreground ,fg-special-cold))) ;;;;; helpful `(helpful-heading ((,class :inherit modus-themes-heading-1))) ;;;;; highlight region or ad-hoc regexp @@ -5826,17 +5937,17 @@ by virtue of calling either of `modus-themes-load-operandi' and `(hydra-face-red ((,class :inherit bold :foreground ,red-faint))) `(hydra-face-teal ((,class :inherit bold :foreground ,cyan-alt-other))) ;;;;; icomplete - `(icomplete-first-match ((,class :inherit modus-themes-completion-standard-first-match))) - `(icomplete-selected-match ((,class :inherit modus-themes-completion-standard-selected))) + `(icomplete-first-match ((,class :inherit modus-themes-completion-match-0))) + `(icomplete-selected-match ((,class :inherit modus-themes-completion-selected))) ;;;;; icomplete-vertical `(icomplete-vertical-separator ((,class :inherit shadow))) ;;;;; ido-mode - `(ido-first-match ((,class :inherit modus-themes-completion-standard-first-match))) + `(ido-first-match ((,class :inherit modus-themes-completion-selected))) `(ido-incomplete-regexp ((,class :inherit error))) `(ido-indicator ((,class :inherit modus-themes-subtle-yellow))) `(ido-only-match ((,class :inherit ido-first-match))) `(ido-subdir ((,class :foreground ,blue))) - `(ido-virtual ((,class :foreground ,fg-special-warm))) + `(ido-virtual ((,class :foreground ,magenta-alt-other))) ;;;;; iedit `(iedit-occurrence ((,class :inherit modus-themes-refine-blue))) `(iedit-read-only-occurrence ((,class :inherit modus-themes-intense-yellow))) @@ -5914,32 +6025,20 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; ivy `(ivy-action ((,class :inherit modus-themes-key-binding))) `(ivy-confirm-face ((,class :inherit success))) - `(ivy-current-match ((,class :inherit modus-themes-completion-extra-selected))) + `(ivy-current-match ((,class :inherit modus-themes-completion-selected))) `(ivy-cursor ((,class :background ,fg-main :foreground ,bg-main))) `(ivy-highlight-face ((,class :foreground ,magenta))) `(ivy-match-required-face ((,class :inherit error))) - `(ivy-minibuffer-match-face-1 ((,class :inherit modus-themes-subtle-neutral))) - `(ivy-minibuffer-match-face-2 ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-green - 'modus-themes-subtle-green - 'modus-themes-special-mild)))) - `(ivy-minibuffer-match-face-3 ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-blue - 'modus-themes-subtle-blue - 'modus-themes-special-cold)))) - `(ivy-minibuffer-match-face-4 ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-magenta - 'modus-themes-subtle-magenta - 'modus-themes-special-calm)))) - `(ivy-modified-buffer ((,class :inherit modus-themes-slant :foreground ,yellow))) - `(ivy-modified-outside-buffer ((,class :inherit modus-themes-slant :foreground ,red-alt))) + `(ivy-minibuffer-match-face-1 (( ))) + `(ivy-minibuffer-match-face-2 ((,class :inherit modus-themes-completion-match-0))) + `(ivy-minibuffer-match-face-3 ((,class :inherit modus-themes-completion-match-1))) + `(ivy-minibuffer-match-face-4 ((,class :inherit modus-themes-completion-match-2))) `(ivy-org ((,class :foreground ,cyan-alt-other))) `(ivy-remote ((,class :foreground ,magenta))) `(ivy-separator ((,class :inherit shadow))) `(ivy-subdir ((,class :foreground ,blue))) `(ivy-virtual ((,class :foreground ,magenta-alt-other))) ;;;;; ivy-posframe - `(ivy-posframe ((,class :background ,bg-dim :foreground ,fg-main))) `(ivy-posframe-border ((,class :background ,fg-window-divider-inner))) `(ivy-posframe-cursor ((,class :background ,fg-main :foreground ,bg-main))) ;;;;; jira (org-jira) @@ -6214,7 +6313,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(marginalia-file-priv-read ((,class :foreground ,fg-main))) `(marginalia-file-priv-write ((,class :foreground ,cyan))) `(marginalia-function ((,class :foreground ,magenta-alt-faint))) - `(marginalia-key ((,class :inherit modus-themes-completion-key-binding))) + `(marginalia-key ((,class :inherit modus-themes-key-binding))) `(marginalia-lighter ((,class :foreground ,blue-alt))) `(marginalia-list ((,class :foreground ,magenta-alt-other-faint))) `(marginalia-mode ((,class :foreground ,cyan))) @@ -6312,7 +6411,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markup-title-5-face ((,class :inherit modus-themes-heading-6))) `(markup-verbatim-face ((,class :inherit modus-themes-fixed-pitch :background ,bg-alt))) ;;;;; mct - `(mct-highlight-candidate ((,class :inherit modus-themes-completion-standard-selected))) + `(mct-highlight-candidate ((,class :inherit modus-themes-completion-selected))) ;;;;; mentor `(mentor-download-message ((,class :foreground ,fg-special-warm))) `(mentor-download-name ((,class :foreground ,fg-special-cold))) @@ -6510,22 +6609,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(nxml-ref ((,class :inherit modus-themes-bold :foreground ,fg-special-mild))) `(rng-error ((,class :inherit error))) ;;;;; orderless - `(orderless-match-face-0 ((,class :inherit bold - ,@(modus-themes--standard-completions - blue-alt-other bg-special-cold fg-special-cold - blue-refine-bg blue-refine-fg)))) - `(orderless-match-face-1 ((,class :inherit bold - ,@(modus-themes--standard-completions - magenta-alt bg-special-calm fg-special-calm - magenta-refine-bg magenta-refine-fg)))) - `(orderless-match-face-2 ((,class :inherit bold - ,@(modus-themes--standard-completions - green bg-special-mild fg-special-mild - green-refine-bg green-refine-fg)))) - `(orderless-match-face-3 ((,class :inherit bold - ,@(modus-themes--standard-completions - yellow bg-special-warm fg-special-warm - yellow-refine-bg yellow-refine-fg)))) + `(orderless-match-face-0 ((,class :inherit modus-themes-completion-match-0))) + `(orderless-match-face-1 ((,class :inherit modus-themes-completion-match-1))) + `(orderless-match-face-2 ((,class :inherit modus-themes-completion-match-2))) + `(orderless-match-face-3 ((,class :inherit modus-themes-completion-match-3))) ;;;;; org `(org-agenda-calendar-event ((,class ,@(modus-themes--agenda-event blue-alt)))) `(org-agenda-calendar-sexp ((,class ,@(modus-themes--agenda-event blue-alt t)))) @@ -6560,8 +6647,7 @@ by virtue of calling either of `modus-themes-load-operandi' and bg-dim fg-special-cold bg-alt fg-alt)))) `(org-block-end-line ((,class :inherit org-block-begin-line))) - `(org-checkbox ((,class :box (:line-width 1 :color ,bg-active) - :background ,bg-inactive :foreground ,fg-active))) + `(org-checkbox (( ))) `(org-checkbox-statistics-done ((,class :inherit org-done))) `(org-checkbox-statistics-todo ((,class :inherit org-todo))) `(org-clock-overlay ((,class :inherit modus-themes-special-cold))) @@ -6781,9 +6867,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(pomidor-work-face ((,class :inherit modus-themes-grue))) ;;;;; popup `(popup-face ((,class :background ,bg-alt :foreground ,fg-main))) - `(popup-isearch-match ((,class :inherit (modus-themes-refine-cyan bold)))) - `(popup-menu-mouse-face ((,class :inherit modus-themes-intense-blue))) - `(popup-menu-selection-face ((,class :inherit (modus-themes-subtle-cyan bold)))) + `(popup-isearch-match ((,class :inherit (modus-themes-search-success bold)))) + `(popup-menu-mouse-face ((,class :inherit highlight))) + `(popup-menu-selection-face ((,class :inherit modus-themes-completion-selected-popup))) `(popup-scroll-bar-background-face ((,class :background ,bg-active))) `(popup-scroll-bar-foreground-face ((,class :foreground ,fg-active))) `(popup-summary-face ((,class :background ,bg-active :foreground ,fg-inactive))) @@ -6918,23 +7004,15 @@ by virtue of calling either of `modus-themes-load-operandi' and `(ruler-mode-pad ((,class :inherit ruler-mode-default :background ,bg-active :foreground ,fg-inactive))) `(ruler-mode-tab-stop ((,class :inherit ruler-mode-default :foreground ,fg-special-warm))) ;;;;; selectrum - `(selectrum-current-candidate ((,class :inherit modus-themes-completion-standard-selected))) + `(selectrum-current-candidate ((,class :inherit modus-themes-completion-selected))) `(selectrum-mouse-highlight ((,class :inherit highlight))) `(selectrum-quick-keys-highlight ((,class :inherit modus-themes-refine-red))) `(selectrum-quick-keys-match ((,class :inherit (bold modus-themes-search-success)))) ;;;;; selectrum-prescient - `(selectrum-prescient-primary-highlight - ((,class :inherit bold - ,@(modus-themes--standard-completions - magenta-alt bg-special-calm fg-special-calm - magenta-refine-bg magenta-refine-fg)))) - `(selectrum-prescient-secondary-highlight - ((,class :inherit bold - ,@(modus-themes--standard-completions - cyan-alt-other bg-special-cold fg-special-cold - cyan-refine-bg cyan-refine-fg)))) + `(selectrum-prescient-primary-highlight ((,class :inherit modus-themes-completion-match-0))) + `(selectrum-prescient-secondary-highlight ((,class :inherit modus-themes-completion-match-1))) ;;;;; semantic `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t))) `(semantic-decoration-on-fileless-includes ((,class :inherit modus-themes-refine-green))) @@ -7091,15 +7169,15 @@ by virtue of calling either of `modus-themes-load-operandi' and `(switch-window-background ((,class :background ,bg-dim))) `(switch-window-label ((,class :height 3.0 :foreground ,blue-intense))) ;;;;; swiper - `(swiper-background-match-face-1 ((,class :inherit modus-themes-subtle-neutral))) - `(swiper-background-match-face-2 ((,class :inherit modus-themes-refine-cyan))) - `(swiper-background-match-face-3 ((,class :inherit modus-themes-refine-magenta))) - `(swiper-background-match-face-4 ((,class :inherit modus-themes-refine-yellow))) - `(swiper-line-face ((,class :inherit modus-themes-special-cold))) - `(swiper-match-face-1 ((,class :inherit (bold modus-themes-intense-neutral)))) - `(swiper-match-face-2 ((,class :inherit (bold modus-themes-intense-green)))) - `(swiper-match-face-3 ((,class :inherit (bold modus-themes-intense-blue)))) - `(swiper-match-face-4 ((,class :inherit (bold modus-themes-intense-red)))) + `(swiper-background-match-face-1 (( ))) + `(swiper-background-match-face-2 ((,class :inherit modus-themes-completion-match-0))) + `(swiper-background-match-face-3 ((,class :inherit modus-themes-completion-match-1))) + `(swiper-background-match-face-4 ((,class :inherit modus-themes-completion-match-2))) + `(swiper-line-face ((,class :background ,bg-hl-alt-intense))) + `(swiper-match-face-1 (( ))) + `(swiper-match-face-2 ((,class :inherit modus-themes-completion-match-0))) + `(swiper-match-face-3 ((,class :inherit modus-themes-completion-match-1))) + `(swiper-match-face-4 ((,class :inherit modus-themes-completion-match-2))) ;;;;; sx `(sx-inbox-item-type ((,class :foreground ,magenta-alt-other))) `(sx-inbox-item-type-unread ((,class :inherit (sx-inbox-item-type bold)))) @@ -7348,7 +7426,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(vc-state-base ((,class :foreground ,fg-active))) `(vc-up-to-date-state ((,class :foreground ,fg-special-cold))) ;;;;; vertico - `(vertico-current ((,class :inherit modus-themes-completion-standard-selected))) + `(vertico-current ((,class :inherit modus-themes-completion-selected))) ;;;;; vertico-quick `(vertico-quick1 ((,class :inherit (modus-themes-intense-magenta bold)))) `(vertico-quick2 ((,class :inherit (modus-themes-refine-cyan bold)))) diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 3e78a6c9598..7d38e5cbf27 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -4,7 +4,7 @@ ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.1.0 +;; Version: 2.2.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index ac7e7901878..b77572734fe 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -26,6 +26,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <assert.h> #include <getopt.h> +#include <attribute.h> #include <flexmember.h> #include <min-max.h> #include <unlocked-io.h> diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 365e803e1cd..7406ef3490e 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -80,6 +80,7 @@ char *w32_getenv (const char *); #include <sys/stat.h> #include <unistd.h> +#include <attribute.h> #include <filename.h> #include <intprops.h> #include <min-max.h> diff --git a/lib-src/etags.c b/lib-src/etags.c index aa5bc8839dd..65b9fae8d5a 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -112,6 +112,7 @@ University of California, as described above. */ # define O_CLOEXEC O_NOINHERIT #endif /* WINDOWSNT */ +#include <attribute.h> #include <inttypes.h> #include <limits.h> #include <unistd.h> diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index f42b1988a2b..d2d4b1d2778 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -42,6 +42,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdlib.h> #include <string.h> +#include <attribute.h> #include <binary-io.h> #include <c-ctype.h> #include <intprops.h> diff --git a/lib-src/movemail.c b/lib-src/movemail.c index 888688f90b1..aa3c15e72e8 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -69,6 +69,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <signal.h> #include <string.h> +#include <attribute.h> #include <unlocked-io.h> #include "syswait.h" diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index d368cbb46c8..9f0de7d64f8 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -59,7 +59,8 @@ variants of those files that can be used to sandbox Emacs before #include <seccomp.h> #include <unistd.h> -#include "verify.h" +#include <attribute.h> +#include <verify.h> #ifndef ARCH_CET_STATUS #define ARCH_CET_STATUS 0x3001 @@ -240,7 +241,9 @@ main (int argc, char **argv) should be further restricted using mount namespaces. */ RULE (SCMP_ACT_ALLOW, SCMP_SYS (access)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat)); +#ifdef __NR_faccessat2 RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat2)); +#endif RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat)); diff --git a/lib/acl-errno-valid.c b/lib/acl-errno-valid.c index 39717c35174..a364e413256 100644 --- a/lib/acl-errno-valid.c +++ b/lib/acl-errno-valid.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/acl-internal.c b/lib/acl-internal.c index 75a80bf0df2..be244c67a2a 100644 --- a/lib/acl-internal.c +++ b/lib/acl-internal.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/acl-internal.h b/lib/acl-internal.h index 582f9e1c1a1..93533762dd0 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/acl.h b/lib/acl.h index 8b933c20b94..f4d0df80618 100644 --- a/lib/acl.h +++ b/lib/acl.h @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/acl_entries.c b/lib/acl_entries.c index e4c014ce715..677de23e0cb 100644 --- a/lib/acl_entries.c +++ b/lib/acl_entries.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/at-func.c b/lib/at-func.c index 92d65f6341f..afcc819beb0 100644 --- a/lib/at-func.c +++ b/lib/at-func.c @@ -3,7 +3,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/cdefs.h b/lib/cdefs.h index abf13a90862..cb2514504f1 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h @@ -41,7 +41,9 @@ Similarly for __has_builtin, etc. */ #if (defined __has_attribute \ && (!defined __clang_minor__ \ - || 3 < __clang_major__ + (5 <= __clang_minor__))) + || (defined __apple_build_version__ \ + ? 6000000 <= __apple_build_version__ \ + : 3 < __clang_major__ + (5 <= __clang_minor__)))) # define __glibc_has_attribute(attr) __has_attribute (attr) #else # define __glibc_has_attribute(attr) 0 @@ -143,7 +145,8 @@ #define __bos0(ptr) __builtin_object_size (ptr, 0) /* Use __builtin_dynamic_object_size at _FORTIFY_SOURCE=3 when available. */ -#if __USE_FORTIFY_LEVEL == 3 && __glibc_clang_prereq (9, 0) +#if __USE_FORTIFY_LEVEL == 3 && (__glibc_clang_prereq (9, 0) \ + || __GNUC_PREREQ (12, 0)) # define __glibc_objsize0(__o) __builtin_dynamic_object_size (__o, 0) # define __glibc_objsize(__o) __builtin_dynamic_object_size (__o, 1) #else diff --git a/lib/close-stream.c b/lib/close-stream.c index 54f3e3c3d0c..9b0e97b271d 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/close-stream.h b/lib/close-stream.h index 537506c4896..2b4c8ed8f5b 100644 --- a/lib/close-stream.h +++ b/lib/close-stream.h @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published - by the Free Software Foundation; either version 3 of the License, + by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/copy-file-range.c b/lib/copy-file-range.c index 96f1ec7c5e8..1ec7f4de67c 100644 --- a/lib/copy-file-range.c +++ b/lib/copy-file-range.c @@ -20,11 +20,45 @@ #include <errno.h> +#if defined __linux__ && HAVE_COPY_FILE_RANGE +# include <sys/utsname.h> +#endif + ssize_t copy_file_range (int infd, off_t *pinoff, int outfd, off_t *poutoff, size_t length, unsigned int flags) { +#undef copy_file_range + +#if defined __linux__ && HAVE_COPY_FILE_RANGE + /* The implementation of copy_file_range (which first appeared in + Linux kernel release 4.5) had many issues before release 5.3 + <https://lwn.net/Articles/789527/>, so fail with ENOSYS for Linux + kernels 5.2 and earlier. + + This workaround, and the configure-time check for Linux, can be + removed when such kernels (released March 2016 through September + 2019) are no longer a consideration. As of January 2021, the + furthest-future planned kernel EOL is December 2024 for kernel + release 4.19. */ + + static signed char ok; + + if (! ok) + { + struct utsname name; + uname (&name); + char *p = name.release; + ok = ((p[1] != '.' || '5' < p[0] + || (p[0] == '5' && (p[3] != '.' || '2' < p[2]))) + ? 1 : -1); + } + + if (0 < ok) + return copy_file_range (infd, pinoff, outfd, poutoff, length, flags); +#endif + /* There is little need to emulate copy_file_range with read+write, since programs that use copy_file_range must fall back on read+write anyway. */ diff --git a/lib/diffseq.h b/lib/diffseq.h index 0c901a6ecfd..0f76ea1d5ad 100644 --- a/lib/diffseq.h +++ b/lib/diffseq.h @@ -5,7 +5,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/dtoastr.c b/lib/dtoastr.c index eaade8fa016..71af14c9df4 100644 --- a/lib/dtoastr.c +++ b/lib/dtoastr.c @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published - by the Free Software Foundation; either version 3 of the License, + by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/dtotimespec.c b/lib/dtotimespec.c index 225a2be67c4..b62a8bd6cfc 100644 --- a/lib/dtotimespec.c +++ b/lib/dtotimespec.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/faccessat.c b/lib/faccessat.c index 2c0c07aac10..c1737d03a10 100644 --- a/lib/faccessat.c +++ b/lib/faccessat.c @@ -3,7 +3,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/fchmodat.c b/lib/fchmodat.c index 506e6badd7d..dc535833660 100644 --- a/lib/fchmodat.c +++ b/lib/fchmodat.c @@ -3,7 +3,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/fdopendir.c b/lib/fdopendir.c index a61bad66e23..c2b0e1ed347 100644 --- a/lib/fdopendir.c +++ b/lib/fdopendir.c @@ -3,7 +3,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c index 2b6f91ff20a..e02f0626ad3 100644 --- a/lib/file-has-acl.c +++ b/lib/file-has-acl.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/filemode.c b/lib/filemode.c index cb508ad12d1..a8cbea844c8 100644 --- a/lib/filemode.c +++ b/lib/filemode.c @@ -5,7 +5,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/filemode.h b/lib/filemode.h index 7c645c16b51..bf38181cdcd 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -5,7 +5,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/filevercmp.c b/lib/filevercmp.c index b3e6e2f3cb8..d546e790548 100644 --- a/lib/filevercmp.c +++ b/lib/filevercmp.c @@ -1,11 +1,12 @@ -/* +/* Compare file names containing version numbers. + Copyright (C) 1995 Ian Jackson <iwj10@cus.cam.ac.uk> Copyright (C) 2001 Anthony Towns <aj@azure.humbug.org.au> Copyright (C) 2008-2022 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, @@ -19,60 +20,65 @@ #include <config.h> #include "filevercmp.h" -#include <sys/types.h> -#include <stdlib.h> #include <stdbool.h> -#include <string.h> #include <c-ctype.h> #include <limits.h> - -/* Match a file suffix defined by this regular expression: - /(\.[A-Za-z~][A-Za-z0-9~]*)*$/ - Scan the string *STR and return a pointer to the matching suffix, or - NULL if not found. Upon return, *STR points to terminating NUL. */ -static const char * -match_suffix (const char **str) +#include <idx.h> +#include <verify.h> + +/* Return the length of a prefix of S that corresponds to the suffix + defined by this extended regular expression in the C locale: + (\.[A-Za-z~][A-Za-z0-9~]*)*$ + If *LEN is -1, S is a string; set *LEN to S's length. + Otherwise, *LEN should be nonnegative, S is a char array, + and *LEN does not change. */ +static idx_t +file_prefixlen (char const *s, ptrdiff_t *len) { - const char *match = NULL; - bool read_alpha = false; - while (**str) + size_t n = *len; /* SIZE_MAX if N == -1. */ + + for (idx_t i = 0; ; i++) { - if (read_alpha) - { - read_alpha = false; - if (!c_isalpha (**str) && '~' != **str) - match = NULL; - } - else if ('.' == **str) + idx_t prefixlen = i; + while (i + 1 < n && s[i] == '.' && (c_isalpha (s[i + 1]) + || s[i + 1] == '~')) + for (i += 2; i < n && (c_isalnum (s[i]) || s[i] == '~'); i++) + continue; + + if (*len < 0 ? !s[i] : i == n) { - read_alpha = true; - if (!match) - match = *str; + *len = i; + return prefixlen; } - else if (!c_isalnum (**str) && '~' != **str) - match = NULL; - (*str)++; } - return match; } -/* verrevcmp helper function */ +/* Return a version sort comparison value for S's byte at position POS. + S has length LEN. If POS == LEN, sort before all non-'~' bytes. */ + static int -order (unsigned char c) +order (char const *s, idx_t pos, idx_t len) { + if (pos == len) + return -1; + + unsigned char c = s[pos]; if (c_isdigit (c)) return 0; else if (c_isalpha (c)) return c; else if (c == '~') - return -1; + return -2; else - return (int) c + UCHAR_MAX + 1; + { + verify (UCHAR_MAX <= (INT_MAX - 1 - 2) / 2); + return c + UCHAR_MAX + 1; + } } /* slightly modified verrevcmp function from dpkg - S1, S2 - compared string - S1_LEN, S2_LEN - length of strings to be scanned + S1, S2 - compared char array + S1_LEN, S2_LEN - length of arrays to be scanned This implements the algorithm for comparison of version strings specified by Debian and now widely adopted. The detailed @@ -81,37 +87,38 @@ order (unsigned char c) implements that from s5.6.12 of Debian Policy v3.8.0.1 https://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */ static int _GL_ATTRIBUTE_PURE -verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len) +verrevcmp (const char *s1, idx_t s1_len, const char *s2, idx_t s2_len) { - size_t s1_pos = 0; - size_t s2_pos = 0; + idx_t s1_pos = 0; + idx_t s2_pos = 0; while (s1_pos < s1_len || s2_pos < s2_len) { int first_diff = 0; while ((s1_pos < s1_len && !c_isdigit (s1[s1_pos])) || (s2_pos < s2_len && !c_isdigit (s2[s2_pos]))) { - int s1_c = (s1_pos == s1_len) ? 0 : order (s1[s1_pos]); - int s2_c = (s2_pos == s2_len) ? 0 : order (s2[s2_pos]); + int s1_c = order (s1, s1_pos, s1_len); + int s2_c = order (s2, s2_pos, s2_len); if (s1_c != s2_c) return s1_c - s2_c; s1_pos++; s2_pos++; } - while (s1[s1_pos] == '0') + while (s1_pos < s1_len && s1[s1_pos] == '0') s1_pos++; - while (s2[s2_pos] == '0') + while (s2_pos < s2_len && s2[s2_pos] == '0') s2_pos++; - while (c_isdigit (s1[s1_pos]) && c_isdigit (s2[s2_pos])) + while (s1_pos < s1_len && s2_pos < s2_len + && c_isdigit (s1[s1_pos]) && c_isdigit (s2[s2_pos])) { if (!first_diff) first_diff = s1[s1_pos] - s2[s2_pos]; s1_pos++; s2_pos++; } - if (c_isdigit (s1[s1_pos])) + if (s1_pos < s1_len && c_isdigit (s1[s1_pos])) return 1; - if (c_isdigit (s2[s2_pos])) + if (s2_pos < s2_len && c_isdigit (s2[s2_pos])) return -1; if (first_diff) return first_diff; @@ -124,58 +131,56 @@ verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len) int filevercmp (const char *s1, const char *s2) { - const char *s1_pos; - const char *s2_pos; - const char *s1_suffix, *s2_suffix; - size_t s1_len, s2_len; - int result; - - /* easy comparison to see if strings are identical */ - int simple_cmp = strcmp (s1, s2); - if (simple_cmp == 0) - return 0; + return filenvercmp (s1, -1, s2, -1); +} - /* special handle for "", "." and ".." */ - if (!*s1) - return -1; - if (!*s2) - return 1; - if (0 == strcmp (".", s1)) - return -1; - if (0 == strcmp (".", s2)) - return 1; - if (0 == strcmp ("..", s1)) - return -1; - if (0 == strcmp ("..", s2)) +/* Compare versions A (of length ALEN) and B (of length BLEN). + See filevercmp.h for function description. */ +int +filenvercmp (char const *a, ptrdiff_t alen, char const *b, ptrdiff_t blen) +{ + /* Special case for empty versions. */ + bool aempty = alen < 0 ? !a[0] : !alen; + bool bempty = blen < 0 ? !b[0] : !blen; + if (aempty) + return -!bempty; + if (bempty) return 1; - /* special handle for other hidden files */ - if (*s1 == '.' && *s2 != '.') - return -1; - if (*s1 != '.' && *s2 == '.') - return 1; - if (*s1 == '.' && *s2 == '.') + /* Special cases for leading ".": "." sorts first, then "..", then + other names with leading ".", then other names. */ + if (a[0] == '.') { - s1++; - s2++; - } + if (b[0] != '.') + return -1; - /* "cut" file suffixes */ - s1_pos = s1; - s2_pos = s2; - s1_suffix = match_suffix (&s1_pos); - s2_suffix = match_suffix (&s2_pos); - s1_len = (s1_suffix ? s1_suffix : s1_pos) - s1; - s2_len = (s2_suffix ? s2_suffix : s2_pos) - s2; - - /* restore file suffixes if strings are identical after "cut" */ - if ((s1_suffix || s2_suffix) && (s1_len == s2_len) - && 0 == strncmp (s1, s2, s1_len)) - { - s1_len = s1_pos - s1; - s2_len = s2_pos - s2; + bool adot = alen < 0 ? !a[1] : alen == 1; + bool bdot = blen < 0 ? !b[1] : blen == 1; + if (adot) + return -!bdot; + if (bdot) + return 1; + + bool adotdot = a[1] == '.' && (alen < 0 ? !a[2] : alen == 2); + bool bdotdot = b[1] == '.' && (blen < 0 ? !b[2] : blen == 2); + if (adotdot) + return -!bdotdot; + if (bdotdot) + return 1; } + else if (b[0] == '.') + return 1; + + /* Cut file suffixes. */ + idx_t aprefixlen = file_prefixlen (a, &alen); + idx_t bprefixlen = file_prefixlen (b, &blen); + + /* If both suffixes are empty, a second pass would return the same thing. */ + bool one_pass_only = aprefixlen == alen && bprefixlen == blen; + + int result = verrevcmp (a, aprefixlen, b, bprefixlen); - result = verrevcmp (s1, s1_len, s2, s2_len); - return result == 0 ? simple_cmp : result; + /* Return the initial result if nonzero, or if no second pass is needed. + Otherwise, restore the suffixes and try again. */ + return result || one_pass_only ? result : verrevcmp (a, alen, b, blen); } diff --git a/lib/filevercmp.h b/lib/filevercmp.h index 98020e66674..5a336776719 100644 --- a/lib/filevercmp.h +++ b/lib/filevercmp.h @@ -1,11 +1,12 @@ -/* +/* Compare file names containing version numbers. + Copyright (C) 1995 Ian Jackson <iwj10@cus.cam.ac.uk> Copyright (C) 2001 Anthony Towns <aj@azure.humbug.org.au> Copyright (C) 2008-2022 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, @@ -19,24 +20,57 @@ #ifndef FILEVERCMP_H #define FILEVERCMP_H -/* Compare version strings: +#include <stddef.h> + +/* Compare strings A and B as file names containing version numbers, + and return an integer that is negative, zero, or positive depending + on whether A compares less than, equal to, or greater than B. + + Use the following version sort algorithm: + + 1. Compare the strings' maximal-length non-digit prefixes lexically. + If there is a difference return that difference. + Otherwise discard the prefixes and continue with the next step. + + 2. Compare the strings' maximal-length digit prefixes, using + numeric comparison of the numbers represented by each prefix. + (Treat an empty prefix as zero; this can happen only at string end.) + If there is a difference, return that difference. + Otherwise discard the prefixes and continue with the next step. + + 3. If both strings are empty, return 0. Otherwise continue with step 1. + + In version sort, lexical comparison is left to right, byte by byte, + using the byte's numeric value (0-255), except that: + + 1. ASCII letters sort before other bytes. + 2. A tilde sorts before anything, even an empty string. + + In addition to the version sort rules, the following strings have + special priority and sort before all other strings (listed in order): - This function compares strings S1 and S2: - 1) By PREFIX in the same way as strcmp. - 2) Then by VERSION (most similarly to version compare of Debian's dpkg). - Leading zeros in version numbers are ignored. - 3) If both (PREFIX and VERSION) are equal, strcmp function is used for - comparison. So this function can return 0 if (and only if) strings S1 - and S2 are identical. + 1. The empty string. + 2. ".". + 3. "..". + 4. Strings starting with "." sort before other strings. - It returns number >0 for S1 > S2, 0 for S1 == S2 and number <0 for S1 < S2. + Before comparing two strings where both begin with non-".", + or where both begin with "." but neither is "." or "..", + suffixes matching the C-locale extended regular expression + (\.[A-Za-z~][A-Za-z0-9~]*)*$ are removed and the strings compared + without them, using version sort without special priority; + if they do not compare equal, this comparison result is used and + the suffixes are effectively ignored. Otherwise, the entire + strings are compared using version sort. - This function compares strings, in a way that if VER1 and VER2 are version - numbers and PREFIX and SUFFIX (SUFFIX defined as (\.[A-Za-z~][A-Za-z0-9~]*)*) - are strings then VER1 < VER2 implies filevercmp (PREFIX VER1 SUFFIX, - PREFIX VER2 SUFFIX) < 0. + This function is intended to be a replacement for strverscmp. */ +int filevercmp (char const *a, char const *b) _GL_ATTRIBUTE_PURE; - This function is intended to be a replacement for strverscmp. */ -int filevercmp (const char *s1, const char *s2) _GL_ATTRIBUTE_PURE; +/* Like filevercmp, except compare the byte arrays A (of length ALEN) + and B (of length BLEN) so that A and B can contain '\0', which + sorts just before '\1'. But if ALEN is -1 treat A as a string + terminated by '\0', and similarly for BLEN. */ +int filenvercmp (char const *a, ptrdiff_t alen, char const *b, ptrdiff_t blen) + _GL_ATTRIBUTE_PURE; #endif /* FILEVERCMP_H */ diff --git a/lib/fpending.c b/lib/fpending.c index 617f3977f8f..6408cff4647 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/fpending.h b/lib/fpending.h index 2b45e9031bb..43542c5b8ad 100644 --- a/lib/fpending.h +++ b/lib/fpending.h @@ -5,7 +5,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/fstatat.c b/lib/fstatat.c index 56de0cab4b2..6e8344964bc 100644 --- a/lib/fstatat.c +++ b/lib/fstatat.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/fsusage.c b/lib/fsusage.c index 734f0fc7460..18f790f6e7b 100644 --- a/lib/fsusage.c +++ b/lib/fsusage.c @@ -5,7 +5,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/fsusage.h b/lib/fsusage.h index f4f50aba29c..0443d19f922 100644 --- a/lib/fsusage.h +++ b/lib/fsusage.h @@ -5,7 +5,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/ftoastr.c b/lib/ftoastr.c index 4349c8c5611..91057529221 100644 --- a/lib/ftoastr.c +++ b/lib/ftoastr.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/ftoastr.h b/lib/ftoastr.h index 065574a9ff4..bac32a387e2 100644 --- a/lib/ftoastr.h +++ b/lib/ftoastr.h @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/futimens.c b/lib/futimens.c index 97228242b1e..bc3e41a9439 100644 --- a/lib/futimens.c +++ b/lib/futimens.c @@ -3,7 +3,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/get-permissions.c b/lib/get-permissions.c index a17b791c8d8..ff79adae72f 100644 --- a/lib/get-permissions.c +++ b/lib/get-permissions.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 53d1b81a3ba..37e82808671 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -8,7 +8,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/gettime.c b/lib/gettime.c index a44a69dfc43..541af18bbfa 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index a8a6cd782d5..3deeca98bef 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -3,7 +3,7 @@ # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or +# the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This file is distributed in the hope that it will be useful, @@ -129,6 +129,7 @@ # minmax \ # mkostemp \ # mktime \ +# nanosleep \ # nproc \ # nstrftime \ # pathmax \ @@ -191,6 +192,10 @@ BUILD_DETAILS = @BUILD_DETAILS@ BYTESWAP_H = @BYTESWAP_H@ CAIRO_CFLAGS = @CAIRO_CFLAGS@ CAIRO_LIBS = @CAIRO_LIBS@ +CAIRO_XCB_CFLAGS = @CAIRO_XCB_CFLAGS@ +CAIRO_XCB_LIBS = @CAIRO_XCB_LIBS@ +CAIRO_XLIB_CFLAGS = @CAIRO_XLIB_CFLAGS@ +CAIRO_XLIB_LIBS = @CAIRO_XLIB_LIBS@ CC = @CC@ CFLAGS = @CFLAGS@ CFLAGS_SOUND = @CFLAGS_SOUND@ @@ -247,7 +252,60 @@ GETOPT_CDEFS_H = @GETOPT_CDEFS_H@ GETOPT_H = @GETOPT_H@ GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@ GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@ +GL_CFLAG_ALLOW_WARNINGS = @GL_CFLAG_ALLOW_WARNINGS@ +GL_CFLAG_GNULIB_WARNINGS = @GL_CFLAG_GNULIB_WARNINGS@ GL_COND_LIBTOOL_CONDITION = @GL_COND_LIBTOOL_CONDITION@ +GL_COND_OBJ_CANONICALIZE_LGPL_CONDITION = @GL_COND_OBJ_CANONICALIZE_LGPL_CONDITION@ +GL_COND_OBJ_COPY_FILE_RANGE_CONDITION = @GL_COND_OBJ_COPY_FILE_RANGE_CONDITION@ +GL_COND_OBJ_DIRFD_CONDITION = @GL_COND_OBJ_DIRFD_CONDITION@ +GL_COND_OBJ_DUP2_CONDITION = @GL_COND_OBJ_DUP2_CONDITION@ +GL_COND_OBJ_EUIDACCESS_CONDITION = @GL_COND_OBJ_EUIDACCESS_CONDITION@ +GL_COND_OBJ_EXECINFO_CONDITION = @GL_COND_OBJ_EXECINFO_CONDITION@ +GL_COND_OBJ_EXPLICIT_BZERO_CONDITION = @GL_COND_OBJ_EXPLICIT_BZERO_CONDITION@ +GL_COND_OBJ_FACCESSAT_CONDITION = @GL_COND_OBJ_FACCESSAT_CONDITION@ +GL_COND_OBJ_FCHMODAT_CONDITION = @GL_COND_OBJ_FCHMODAT_CONDITION@ +GL_COND_OBJ_FCNTL_CONDITION = @GL_COND_OBJ_FCNTL_CONDITION@ +GL_COND_OBJ_FDOPENDIR_CONDITION = @GL_COND_OBJ_FDOPENDIR_CONDITION@ +GL_COND_OBJ_FPENDING_CONDITION = @GL_COND_OBJ_FPENDING_CONDITION@ +GL_COND_OBJ_FREE_CONDITION = @GL_COND_OBJ_FREE_CONDITION@ +GL_COND_OBJ_FSTATAT_CONDITION = @GL_COND_OBJ_FSTATAT_CONDITION@ +GL_COND_OBJ_FSUSAGE_CONDITION = @GL_COND_OBJ_FSUSAGE_CONDITION@ +GL_COND_OBJ_FSYNC_CONDITION = @GL_COND_OBJ_FSYNC_CONDITION@ +GL_COND_OBJ_FUTIMENS_CONDITION = @GL_COND_OBJ_FUTIMENS_CONDITION@ +GL_COND_OBJ_GETDTABLESIZE_CONDITION = @GL_COND_OBJ_GETDTABLESIZE_CONDITION@ +GL_COND_OBJ_GETGROUPS_CONDITION = @GL_COND_OBJ_GETGROUPS_CONDITION@ +GL_COND_OBJ_GETLOADAVG_CONDITION = @GL_COND_OBJ_GETLOADAVG_CONDITION@ +GL_COND_OBJ_GETOPT_CONDITION = @GL_COND_OBJ_GETOPT_CONDITION@ +GL_COND_OBJ_GETRANDOM_CONDITION = @GL_COND_OBJ_GETRANDOM_CONDITION@ +GL_COND_OBJ_GETTIMEOFDAY_CONDITION = @GL_COND_OBJ_GETTIMEOFDAY_CONDITION@ +GL_COND_OBJ_GROUP_MEMBER_CONDITION = @GL_COND_OBJ_GROUP_MEMBER_CONDITION@ +GL_COND_OBJ_LCHMOD_CONDITION = @GL_COND_OBJ_LCHMOD_CONDITION@ +GL_COND_OBJ_LSTAT_CONDITION = @GL_COND_OBJ_LSTAT_CONDITION@ +GL_COND_OBJ_MEMPCPY_CONDITION = @GL_COND_OBJ_MEMPCPY_CONDITION@ +GL_COND_OBJ_MEMRCHR_CONDITION = @GL_COND_OBJ_MEMRCHR_CONDITION@ +GL_COND_OBJ_MINI_GMP_GNULIB_CONDITION = @GL_COND_OBJ_MINI_GMP_GNULIB_CONDITION@ +GL_COND_OBJ_MKOSTEMP_CONDITION = @GL_COND_OBJ_MKOSTEMP_CONDITION@ +GL_COND_OBJ_NANOSLEEP_CONDITION = @GL_COND_OBJ_NANOSLEEP_CONDITION@ +GL_COND_OBJ_OPEN_CONDITION = @GL_COND_OBJ_OPEN_CONDITION@ +GL_COND_OBJ_PSELECT_CONDITION = @GL_COND_OBJ_PSELECT_CONDITION@ +GL_COND_OBJ_PTHREAD_SIGMASK_CONDITION = @GL_COND_OBJ_PTHREAD_SIGMASK_CONDITION@ +GL_COND_OBJ_RAWMEMCHR_CONDITION = @GL_COND_OBJ_RAWMEMCHR_CONDITION@ +GL_COND_OBJ_READLINKAT_CONDITION = @GL_COND_OBJ_READLINKAT_CONDITION@ +GL_COND_OBJ_READLINK_CONDITION = @GL_COND_OBJ_READLINK_CONDITION@ +GL_COND_OBJ_REGEX_CONDITION = @GL_COND_OBJ_REGEX_CONDITION@ +GL_COND_OBJ_SIG2STR_CONDITION = @GL_COND_OBJ_SIG2STR_CONDITION@ +GL_COND_OBJ_SIGDESCR_NP_CONDITION = @GL_COND_OBJ_SIGDESCR_NP_CONDITION@ +GL_COND_OBJ_STDIO_READ_CONDITION = @GL_COND_OBJ_STDIO_READ_CONDITION@ +GL_COND_OBJ_STDIO_WRITE_CONDITION = @GL_COND_OBJ_STDIO_WRITE_CONDITION@ +GL_COND_OBJ_STPCPY_CONDITION = @GL_COND_OBJ_STPCPY_CONDITION@ +GL_COND_OBJ_STRNLEN_CONDITION = @GL_COND_OBJ_STRNLEN_CONDITION@ +GL_COND_OBJ_STRTOIMAX_CONDITION = @GL_COND_OBJ_STRTOIMAX_CONDITION@ +GL_COND_OBJ_STRTOLL_CONDITION = @GL_COND_OBJ_STRTOLL_CONDITION@ +GL_COND_OBJ_SYMLINK_CONDITION = @GL_COND_OBJ_SYMLINK_CONDITION@ +GL_COND_OBJ_TIMEGM_CONDITION = @GL_COND_OBJ_TIMEGM_CONDITION@ +GL_COND_OBJ_TIME_RZ_CONDITION = @GL_COND_OBJ_TIME_RZ_CONDITION@ +GL_COND_OBJ_TIME_R_CONDITION = @GL_COND_OBJ_TIME_R_CONDITION@ +GL_COND_OBJ_UTIMENSAT_CONDITION = @GL_COND_OBJ_UTIMENSAT_CONDITION@ GL_GENERATE_ALLOCA_H_CONDITION = @GL_GENERATE_ALLOCA_H_CONDITION@ GL_GENERATE_BYTESWAP_H_CONDITION = @GL_GENERATE_BYTESWAP_H_CONDITION@ GL_GENERATE_ERRNO_H_CONDITION = @GL_GENERATE_ERRNO_H_CONDITION@ @@ -974,6 +1032,7 @@ REPLACE_CANONICALIZE_FILE_NAME = @REPLACE_CANONICALIZE_FILE_NAME@ REPLACE_CHOWN = @REPLACE_CHOWN@ REPLACE_CLOSE = @REPLACE_CLOSE@ REPLACE_CLOSEDIR = @REPLACE_CLOSEDIR@ +REPLACE_COPY_FILE_RANGE = @REPLACE_COPY_FILE_RANGE@ REPLACE_CREAT = @REPLACE_CREAT@ REPLACE_CTIME = @REPLACE_CTIME@ REPLACE_DIRFD = @REPLACE_DIRFD@ @@ -1197,6 +1256,8 @@ XOBJ = @XOBJ@ XRANDR_CFLAGS = @XRANDR_CFLAGS@ XRANDR_LIBS = @XRANDR_LIBS@ XRENDER_LIBS = @XRENDER_LIBS@ +XSYNC_CFLAGS = @XSYNC_CFLAGS@ +XSYNC_LIBS = @XSYNC_LIBS@ XWIDGETS_OBJ = @XWIDGETS_OBJ@ X_TOOLKIT_TYPE = @X_TOOLKIT_TYPE@ ac_ct_CC = @ac_ct_CC@ @@ -1251,8 +1312,10 @@ gl_GNULIB_ENABLED_rawmemchr_CONDITION = @gl_GNULIB_ENABLED_rawmemchr_CONDITION@ gl_GNULIB_ENABLED_scratch_buffer_CONDITION = @gl_GNULIB_ENABLED_scratch_buffer_CONDITION@ gl_GNULIB_ENABLED_strtoll_CONDITION = @gl_GNULIB_ENABLED_strtoll_CONDITION@ gl_GNULIB_ENABLED_utimens_CONDITION = @gl_GNULIB_ENABLED_utimens_CONDITION@ +gl_LIBOBJDEPS = @gl_LIBOBJDEPS@ gl_LIBOBJS = @gl_LIBOBJS@ gl_LTLIBOBJS = @gl_LTLIBOBJS@ +gltests_LIBOBJDEPS = @gltests_LIBOBJDEPS@ gltests_LIBOBJS = @gltests_LIBOBJS@ gltests_LTLIBOBJS = @gltests_LTLIBOBJS@ gltests_WITNESS = @gltests_WITNESS@ @@ -1303,6 +1366,7 @@ x_default_search_path = @x_default_search_path@ noinst_LIBRARIES += libgnu.a libgnu_a_SOURCES = +libgnu_a_CFLAGS = $(AM_CFLAGS) $(GL_CFLAG_GNULIB_WARNINGS) libgnu_a_LIBADD = $(gl_LIBOBJS) libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) EXTRA_libgnu_a_SOURCES = @@ -1432,10 +1496,9 @@ endif ## begin gnulib module canonicalize-lgpl ifeq (,$(OMIT_GNULIB_MODULE_canonicalize-lgpl)) - -EXTRA_DIST += canonicalize-lgpl.c - -EXTRA_libgnu_a_SOURCES += canonicalize-lgpl.c +ifneq (,$(GL_COND_OBJ_CANONICALIZE_LGPL_CONDITION)) +libgnu_a_SOURCES += canonicalize-lgpl.c +endif endif ## end gnulib module canonicalize-lgpl @@ -1475,10 +1538,9 @@ endif ## begin gnulib module copy-file-range ifeq (,$(OMIT_GNULIB_MODULE_copy-file-range)) - -EXTRA_DIST += copy-file-range.c - -EXTRA_libgnu_a_SOURCES += copy-file-range.c +ifneq (,$(GL_COND_OBJ_COPY_FILE_RANGE_CONDITION)) +libgnu_a_SOURCES += copy-file-range.c +endif endif ## end gnulib module copy-file-range @@ -1621,13 +1683,12 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_dirfd)) ifneq (,$(gl_GNULIB_ENABLED_dirfd_CONDITION)) - +ifneq (,$(GL_COND_OBJ_DIRFD_CONDITION)) +libgnu_a_SOURCES += dirfd.c endif -EXTRA_DIST += dirfd.c - -EXTRA_libgnu_a_SOURCES += dirfd.c endif +endif ## end gnulib module dirfd ## begin gnulib module dtoastr @@ -1653,10 +1714,9 @@ endif ## begin gnulib module dup2 ifeq (,$(OMIT_GNULIB_MODULE_dup2)) - -EXTRA_DIST += dup2.c - -EXTRA_libgnu_a_SOURCES += dup2.c +ifneq (,$(GL_COND_OBJ_DUP2_CONDITION)) +libgnu_a_SOURCES += dup2.c +endif endif ## end gnulib module dup2 @@ -1747,13 +1807,12 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_euidaccess)) ifneq (,$(gl_GNULIB_ENABLED_euidaccess_CONDITION)) - +ifneq (,$(GL_COND_OBJ_EUIDACCESS_CONDITION)) +libgnu_a_SOURCES += euidaccess.c endif -EXTRA_DIST += euidaccess.c - -EXTRA_libgnu_a_SOURCES += euidaccess.c endif +endif ## end gnulib module euidaccess ## begin gnulib module execinfo @@ -1773,9 +1832,11 @@ execinfo.h: $(top_builddir)/config.status endif MOSTLYCLEANFILES += execinfo.h execinfo.h-t -EXTRA_DIST += execinfo.c execinfo.in.h +ifneq (,$(GL_COND_OBJ_EXECINFO_CONDITION)) +libgnu_a_SOURCES += execinfo.c +endif -EXTRA_libgnu_a_SOURCES += execinfo.c +EXTRA_DIST += execinfo.in.h endif ## end gnulib module execinfo @@ -1783,10 +1844,9 @@ endif ## begin gnulib module explicit_bzero ifeq (,$(OMIT_GNULIB_MODULE_explicit_bzero)) - -EXTRA_DIST += explicit_bzero.c - -EXTRA_libgnu_a_SOURCES += explicit_bzero.c +ifneq (,$(GL_COND_OBJ_EXPLICIT_BZERO_CONDITION)) +libgnu_a_SOURCES += explicit_bzero.c +endif endif ## end gnulib module explicit_bzero @@ -1794,10 +1854,13 @@ endif ## begin gnulib module faccessat ifeq (,$(OMIT_GNULIB_MODULE_faccessat)) +ifneq (,$(GL_COND_OBJ_FACCESSAT_CONDITION)) +libgnu_a_SOURCES += faccessat.c +endif -EXTRA_DIST += at-func.c faccessat.c +EXTRA_DIST += at-func.c -EXTRA_libgnu_a_SOURCES += at-func.c faccessat.c +EXTRA_libgnu_a_SOURCES += at-func.c endif ## end gnulib module faccessat @@ -1805,10 +1868,13 @@ endif ## begin gnulib module fchmodat ifeq (,$(OMIT_GNULIB_MODULE_fchmodat)) +ifneq (,$(GL_COND_OBJ_FCHMODAT_CONDITION)) +libgnu_a_SOURCES += fchmodat.c +endif -EXTRA_DIST += at-func.c fchmodat.c +EXTRA_DIST += at-func.c -EXTRA_libgnu_a_SOURCES += at-func.c fchmodat.c +EXTRA_libgnu_a_SOURCES += at-func.c endif ## end gnulib module fchmodat @@ -1816,10 +1882,9 @@ endif ## begin gnulib module fcntl ifeq (,$(OMIT_GNULIB_MODULE_fcntl)) - -EXTRA_DIST += fcntl.c - -EXTRA_libgnu_a_SOURCES += fcntl.c +ifneq (,$(GL_COND_OBJ_FCNTL_CONDITION)) +libgnu_a_SOURCES += fcntl.c +endif endif ## end gnulib module fcntl @@ -1866,10 +1931,9 @@ endif ## begin gnulib module fdopendir ifeq (,$(OMIT_GNULIB_MODULE_fdopendir)) - -EXTRA_DIST += fdopendir.c - -EXTRA_libgnu_a_SOURCES += fdopendir.c +ifneq (,$(GL_COND_OBJ_FDOPENDIR_CONDITION)) +libgnu_a_SOURCES += fdopendir.c +endif endif ## end gnulib module fdopendir @@ -1925,10 +1989,11 @@ endif ## begin gnulib module fpending ifeq (,$(OMIT_GNULIB_MODULE_fpending)) +ifneq (,$(GL_COND_OBJ_FPENDING_CONDITION)) +libgnu_a_SOURCES += fpending.c +endif -EXTRA_DIST += fpending.c fpending.h stdio-impl.h - -EXTRA_libgnu_a_SOURCES += fpending.c +EXTRA_DIST += fpending.h stdio-impl.h endif ## end gnulib module fpending @@ -1936,10 +2001,9 @@ endif ## begin gnulib module free-posix ifeq (,$(OMIT_GNULIB_MODULE_free-posix)) - -EXTRA_DIST += free.c - -EXTRA_libgnu_a_SOURCES += free.c +ifneq (,$(GL_COND_OBJ_FREE_CONDITION)) +libgnu_a_SOURCES += free.c +endif endif ## end gnulib module free-posix @@ -1947,10 +2011,13 @@ endif ## begin gnulib module fstatat ifeq (,$(OMIT_GNULIB_MODULE_fstatat)) +ifneq (,$(GL_COND_OBJ_FSTATAT_CONDITION)) +libgnu_a_SOURCES += fstatat.c +endif -EXTRA_DIST += at-func.c fstatat.c +EXTRA_DIST += at-func.c -EXTRA_libgnu_a_SOURCES += at-func.c fstatat.c +EXTRA_libgnu_a_SOURCES += at-func.c endif ## end gnulib module fstatat @@ -1958,10 +2025,11 @@ endif ## begin gnulib module fsusage ifeq (,$(OMIT_GNULIB_MODULE_fsusage)) +ifneq (,$(GL_COND_OBJ_FSUSAGE_CONDITION)) +libgnu_a_SOURCES += fsusage.c +endif -EXTRA_DIST += fsusage.c fsusage.h - -EXTRA_libgnu_a_SOURCES += fsusage.c +EXTRA_DIST += fsusage.h endif ## end gnulib module fsusage @@ -1969,10 +2037,9 @@ endif ## begin gnulib module fsync ifeq (,$(OMIT_GNULIB_MODULE_fsync)) - -EXTRA_DIST += fsync.c - -EXTRA_libgnu_a_SOURCES += fsync.c +ifneq (,$(GL_COND_OBJ_FSYNC_CONDITION)) +libgnu_a_SOURCES += fsync.c +endif endif ## end gnulib module fsync @@ -1980,10 +2047,9 @@ endif ## begin gnulib module futimens ifeq (,$(OMIT_GNULIB_MODULE_futimens)) - -EXTRA_DIST += futimens.c - -EXTRA_libgnu_a_SOURCES += futimens.c +ifneq (,$(GL_COND_OBJ_FUTIMENS_CONDITION)) +libgnu_a_SOURCES += futimens.c +endif endif ## end gnulib module futimens @@ -2013,35 +2079,32 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_getdtablesize)) ifneq (,$(gl_GNULIB_ENABLED_getdtablesize_CONDITION)) - +ifneq (,$(GL_COND_OBJ_GETDTABLESIZE_CONDITION)) +libgnu_a_SOURCES += getdtablesize.c endif -EXTRA_DIST += getdtablesize.c - -EXTRA_libgnu_a_SOURCES += getdtablesize.c endif +endif ## end gnulib module getdtablesize ## begin gnulib module getgroups ifeq (,$(OMIT_GNULIB_MODULE_getgroups)) ifneq (,$(gl_GNULIB_ENABLED_getgroups_CONDITION)) - +ifneq (,$(GL_COND_OBJ_GETGROUPS_CONDITION)) +libgnu_a_SOURCES += getgroups.c endif -EXTRA_DIST += getgroups.c - -EXTRA_libgnu_a_SOURCES += getgroups.c endif +endif ## end gnulib module getgroups ## begin gnulib module getloadavg ifeq (,$(OMIT_GNULIB_MODULE_getloadavg)) - -EXTRA_DIST += getloadavg.c - -EXTRA_libgnu_a_SOURCES += getloadavg.c +ifneq (,$(GL_COND_OBJ_GETLOADAVG_CONDITION)) +libgnu_a_SOURCES += getloadavg.c +endif endif ## end gnulib module getloadavg @@ -2083,9 +2146,11 @@ endif MOSTLYCLEANFILES += getopt.h getopt.h-t getopt-cdefs.h getopt-cdefs.h-t -EXTRA_DIST += getopt-cdefs.in.h getopt-core.h getopt-ext.h getopt-pfx-core.h getopt-pfx-ext.h getopt.c getopt.in.h getopt1.c getopt_int.h +ifneq (,$(GL_COND_OBJ_GETOPT_CONDITION)) +libgnu_a_SOURCES += getopt.c getopt1.c +endif -EXTRA_libgnu_a_SOURCES += getopt.c getopt1.c +EXTRA_DIST += getopt-cdefs.in.h getopt-core.h getopt-ext.h getopt-pfx-core.h getopt-pfx-ext.h getopt.in.h getopt_int.h endif ## end gnulib module getopt-posix @@ -2093,10 +2158,9 @@ endif ## begin gnulib module getrandom ifeq (,$(OMIT_GNULIB_MODULE_getrandom)) - -EXTRA_DIST += getrandom.c - -EXTRA_libgnu_a_SOURCES += getrandom.c +ifneq (,$(GL_COND_OBJ_GETRANDOM_CONDITION)) +libgnu_a_SOURCES += getrandom.c +endif endif ## end gnulib module getrandom @@ -2122,10 +2186,9 @@ endif ## begin gnulib module gettimeofday ifeq (,$(OMIT_GNULIB_MODULE_gettimeofday)) - -EXTRA_DIST += gettimeofday.c - -EXTRA_libgnu_a_SOURCES += gettimeofday.c +ifneq (,$(GL_COND_OBJ_GETTIMEOFDAY_CONDITION)) +libgnu_a_SOURCES += gettimeofday.c +endif endif ## end gnulib module gettimeofday @@ -2143,13 +2206,12 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_group-member)) ifneq (,$(gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1_CONDITION)) - +ifneq (,$(GL_COND_OBJ_GROUP_MEMBER_CONDITION)) +libgnu_a_SOURCES += group-member.c endif -EXTRA_DIST += group-member.c - -EXTRA_libgnu_a_SOURCES += group-member.c endif +endif ## end gnulib module group-member ## begin gnulib module idx @@ -2249,13 +2311,12 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_lchmod)) ifneq (,$(gl_GNULIB_ENABLED_lchmod_CONDITION)) - +ifneq (,$(GL_COND_OBJ_LCHMOD_CONDITION)) +libgnu_a_SOURCES += lchmod.c endif -EXTRA_DIST += lchmod.c - -EXTRA_libgnu_a_SOURCES += lchmod.c endif +endif ## end gnulib module lchmod ## begin gnulib module libc-config @@ -2291,9 +2352,13 @@ gmp.h: $(top_builddir)/config.status endif MOSTLYCLEANFILES += gmp.h gmp.h-t -EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h +ifneq (,$(GL_COND_OBJ_MINI_GMP_GNULIB_CONDITION)) +libgnu_a_SOURCES += mini-gmp-gnulib.c +endif -EXTRA_libgnu_a_SOURCES += mini-gmp-gnulib.c mini-gmp.c +EXTRA_DIST += mini-gmp.c mini-gmp.h + +EXTRA_libgnu_a_SOURCES += mini-gmp.c endif ## end gnulib module libgmp @@ -2329,10 +2394,9 @@ endif ## begin gnulib module lstat ifeq (,$(OMIT_GNULIB_MODULE_lstat)) - -EXTRA_DIST += lstat.c - -EXTRA_libgnu_a_SOURCES += lstat.c +ifneq (,$(GL_COND_OBJ_LSTAT_CONDITION)) +libgnu_a_SOURCES += lstat.c +endif endif ## end gnulib module lstat @@ -2377,10 +2441,9 @@ endif ## begin gnulib module mempcpy ifeq (,$(OMIT_GNULIB_MODULE_mempcpy)) - -EXTRA_DIST += mempcpy.c - -EXTRA_libgnu_a_SOURCES += mempcpy.c +ifneq (,$(GL_COND_OBJ_MEMPCPY_CONDITION)) +libgnu_a_SOURCES += mempcpy.c +endif endif ## end gnulib module mempcpy @@ -2388,10 +2451,9 @@ endif ## begin gnulib module memrchr ifeq (,$(OMIT_GNULIB_MODULE_memrchr)) - -EXTRA_DIST += memrchr.c - -EXTRA_libgnu_a_SOURCES += memrchr.c +ifneq (,$(GL_COND_OBJ_MEMRCHR_CONDITION)) +libgnu_a_SOURCES += memrchr.c +endif endif ## end gnulib module memrchr @@ -2407,10 +2469,9 @@ endif ## begin gnulib module mkostemp ifeq (,$(OMIT_GNULIB_MODULE_mkostemp)) - -EXTRA_DIST += mkostemp.c - -EXTRA_libgnu_a_SOURCES += mkostemp.c +ifneq (,$(GL_COND_OBJ_MKOSTEMP_CONDITION)) +libgnu_a_SOURCES += mkostemp.c +endif endif ## end gnulib module mkostemp @@ -2439,6 +2500,16 @@ EXTRA_libgnu_a_SOURCES += mktime.c endif ## end gnulib module mktime-internal +## begin gnulib module nanosleep +ifeq (,$(OMIT_GNULIB_MODULE_nanosleep)) + +ifneq (,$(GL_COND_OBJ_NANOSLEEP_CONDITION)) +libgnu_a_SOURCES += nanosleep.c +endif + +endif +## end gnulib module nanosleep + ## begin gnulib module nproc ifeq (,$(OMIT_GNULIB_MODULE_nproc)) @@ -2463,13 +2534,12 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_open)) ifneq (,$(gl_GNULIB_ENABLED_open_CONDITION)) - +ifneq (,$(GL_COND_OBJ_OPEN_CONDITION)) +libgnu_a_SOURCES += open.c endif -EXTRA_DIST += open.c - -EXTRA_libgnu_a_SOURCES += open.c endif +endif ## end gnulib module open ## begin gnulib module openat-h @@ -2503,10 +2573,9 @@ endif ## begin gnulib module pselect ifeq (,$(OMIT_GNULIB_MODULE_pselect)) - -EXTRA_DIST += pselect.c - -EXTRA_libgnu_a_SOURCES += pselect.c +ifneq (,$(GL_COND_OBJ_PSELECT_CONDITION)) +libgnu_a_SOURCES += pselect.c +endif endif ## end gnulib module pselect @@ -2514,10 +2583,9 @@ endif ## begin gnulib module pthread_sigmask ifeq (,$(OMIT_GNULIB_MODULE_pthread_sigmask)) - -EXTRA_DIST += pthread_sigmask.c - -EXTRA_libgnu_a_SOURCES += pthread_sigmask.c +ifneq (,$(GL_COND_OBJ_PTHREAD_SIGMASK_CONDITION)) +libgnu_a_SOURCES += pthread_sigmask.c +endif endif ## end gnulib module pthread_sigmask @@ -2534,11 +2602,12 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_rawmemchr)) ifneq (,$(gl_GNULIB_ENABLED_rawmemchr_CONDITION)) - +ifneq (,$(GL_COND_OBJ_RAWMEMCHR_CONDITION)) +libgnu_a_SOURCES += rawmemchr.c endif -EXTRA_DIST += rawmemchr.c rawmemchr.valgrind -EXTRA_libgnu_a_SOURCES += rawmemchr.c +endif +EXTRA_DIST += rawmemchr.valgrind endif ## end gnulib module rawmemchr @@ -2546,10 +2615,9 @@ endif ## begin gnulib module readlink ifeq (,$(OMIT_GNULIB_MODULE_readlink)) - -EXTRA_DIST += readlink.c - -EXTRA_libgnu_a_SOURCES += readlink.c +ifneq (,$(GL_COND_OBJ_READLINK_CONDITION)) +libgnu_a_SOURCES += readlink.c +endif endif ## end gnulib module readlink @@ -2557,10 +2625,13 @@ endif ## begin gnulib module readlinkat ifeq (,$(OMIT_GNULIB_MODULE_readlinkat)) +ifneq (,$(GL_COND_OBJ_READLINKAT_CONDITION)) +libgnu_a_SOURCES += readlinkat.c +endif -EXTRA_DIST += at-func.c readlinkat.c +EXTRA_DIST += at-func.c -EXTRA_libgnu_a_SOURCES += at-func.c readlinkat.c +EXTRA_libgnu_a_SOURCES += at-func.c endif ## end gnulib module readlinkat @@ -2594,10 +2665,13 @@ endif ## begin gnulib module regex ifeq (,$(OMIT_GNULIB_MODULE_regex)) +ifneq (,$(GL_COND_OBJ_REGEX_CONDITION)) +libgnu_a_SOURCES += regex.c +endif -EXTRA_DIST += regcomp.c regex.c regex.h regex_internal.c regex_internal.h regexec.c +EXTRA_DIST += regcomp.c regex.h regex_internal.c regex_internal.h regexec.c -EXTRA_libgnu_a_SOURCES += regcomp.c regex.c regex_internal.c regexec.c +EXTRA_libgnu_a_SOURCES += regcomp.c regex_internal.c regexec.c endif ## end gnulib module regex @@ -2641,10 +2715,11 @@ endif ## begin gnulib module sig2str ifeq (,$(OMIT_GNULIB_MODULE_sig2str)) +ifneq (,$(GL_COND_OBJ_SIG2STR_CONDITION)) +libgnu_a_SOURCES += sig2str.c +endif -EXTRA_DIST += sig2str.c sig2str.h - -EXTRA_libgnu_a_SOURCES += sig2str.c +EXTRA_DIST += sig2str.h endif ## end gnulib module sig2str @@ -2652,10 +2727,9 @@ endif ## begin gnulib module sigdescr_np ifeq (,$(OMIT_GNULIB_MODULE_sigdescr_np)) - -EXTRA_DIST += sigdescr_np.c - -EXTRA_libgnu_a_SOURCES += sigdescr_np.c +ifneq (,$(GL_COND_OBJ_SIGDESCR_NP_CONDITION)) +libgnu_a_SOURCES += sigdescr_np.c +endif endif ## end gnulib module sigdescr_np @@ -3004,6 +3078,13 @@ stdio.h: stdio.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(AM_V_at)mv $@-t $@ MOSTLYCLEANFILES += stdio.h stdio.h-t +ifneq (,$(GL_COND_OBJ_STDIO_READ_CONDITION)) +libgnu_a_SOURCES += stdio-read.c +endif +ifneq (,$(GL_COND_OBJ_STDIO_WRITE_CONDITION)) +libgnu_a_SOURCES += stdio-write.c +endif + EXTRA_DIST += stdio.in.h endif @@ -3163,10 +3244,9 @@ endif ## begin gnulib module stpcpy ifeq (,$(OMIT_GNULIB_MODULE_stpcpy)) - -EXTRA_DIST += stpcpy.c - -EXTRA_libgnu_a_SOURCES += stpcpy.c +ifneq (,$(GL_COND_OBJ_STPCPY_CONDITION)) +libgnu_a_SOURCES += stpcpy.c +endif endif ## end gnulib module stpcpy @@ -3287,10 +3367,9 @@ endif ## begin gnulib module strnlen ifeq (,$(OMIT_GNULIB_MODULE_strnlen)) - -EXTRA_DIST += strnlen.c - -EXTRA_libgnu_a_SOURCES += strnlen.c +ifneq (,$(GL_COND_OBJ_STRNLEN_CONDITION)) +libgnu_a_SOURCES += strnlen.c +endif endif ## end gnulib module strnlen @@ -3298,10 +3377,9 @@ endif ## begin gnulib module strtoimax ifeq (,$(OMIT_GNULIB_MODULE_strtoimax)) - -EXTRA_DIST += strtoimax.c - -EXTRA_libgnu_a_SOURCES += strtoimax.c +ifneq (,$(GL_COND_OBJ_STRTOIMAX_CONDITION)) +libgnu_a_SOURCES += strtoimax.c +endif endif ## end gnulib module strtoimax @@ -3310,11 +3388,14 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_strtoll)) ifneq (,$(gl_GNULIB_ENABLED_strtoll_CONDITION)) +ifneq (,$(GL_COND_OBJ_STRTOLL_CONDITION)) +libgnu_a_SOURCES += strtoll.c +endif endif -EXTRA_DIST += strtol.c strtoll.c +EXTRA_DIST += strtol.c -EXTRA_libgnu_a_SOURCES += strtol.c strtoll.c +EXTRA_libgnu_a_SOURCES += strtol.c endif ## end gnulib module strtoll @@ -3322,10 +3403,9 @@ endif ## begin gnulib module symlink ifeq (,$(OMIT_GNULIB_MODULE_symlink)) - -EXTRA_DIST += symlink.c - -EXTRA_libgnu_a_SOURCES += symlink.c +ifneq (,$(GL_COND_OBJ_SYMLINK_CONDITION)) +libgnu_a_SOURCES += symlink.c +endif endif ## end gnulib module symlink @@ -3602,10 +3682,9 @@ endif ## begin gnulib module time_r ifeq (,$(OMIT_GNULIB_MODULE_time_r)) - -EXTRA_DIST += time_r.c - -EXTRA_libgnu_a_SOURCES += time_r.c +ifneq (,$(GL_COND_OBJ_TIME_R_CONDITION)) +libgnu_a_SOURCES += time_r.c +endif endif ## end gnulib module time_r @@ -3613,10 +3692,11 @@ endif ## begin gnulib module time_rz ifeq (,$(OMIT_GNULIB_MODULE_time_rz)) +ifneq (,$(GL_COND_OBJ_TIME_RZ_CONDITION)) +libgnu_a_SOURCES += time_rz.c +endif -EXTRA_DIST += time-internal.h time_rz.c - -EXTRA_libgnu_a_SOURCES += time_rz.c +EXTRA_DIST += time-internal.h endif ## end gnulib module time_rz @@ -3624,10 +3704,11 @@ endif ## begin gnulib module timegm ifeq (,$(OMIT_GNULIB_MODULE_timegm)) +ifneq (,$(GL_COND_OBJ_TIMEGM_CONDITION)) +libgnu_a_SOURCES += timegm.c +endif -EXTRA_DIST += mktime-internal.h timegm.c - -EXTRA_libgnu_a_SOURCES += timegm.c +EXTRA_DIST += mktime-internal.h endif ## end gnulib module timegm @@ -3821,6 +3902,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H sed -e 's|@''REPLACE_ACCESS''@|$(REPLACE_ACCESS)|g' \ -e 's|@''REPLACE_CHOWN''@|$(REPLACE_CHOWN)|g' \ -e 's|@''REPLACE_CLOSE''@|$(REPLACE_CLOSE)|g' \ + -e 's|@''REPLACE_COPY_FILE_RANGE''@|$(REPLACE_COPY_FILE_RANGE)|g' \ -e 's|@''REPLACE_DUP''@|$(REPLACE_DUP)|g' \ -e 's|@''REPLACE_DUP2''@|$(REPLACE_DUP2)|g' \ -e 's|@''REPLACE_EXECL''@|$(REPLACE_EXECL)|g' \ @@ -3909,10 +3991,13 @@ endif ## begin gnulib module utimensat ifeq (,$(OMIT_GNULIB_MODULE_utimensat)) +ifneq (,$(GL_COND_OBJ_UTIMENSAT_CONDITION)) +libgnu_a_SOURCES += utimensat.c +endif -EXTRA_DIST += at-func.c utimensat.c +EXTRA_DIST += at-func.c -EXTRA_libgnu_a_SOURCES += at-func.c utimensat.c +EXTRA_libgnu_a_SOURCES += at-func.c endif ## end gnulib module utimensat @@ -3954,3 +4039,7 @@ mostlyclean-local: mostlyclean-generic fi; \ done; \ : +distclean-local: distclean-gnulib-libobjs +distclean-gnulib-libobjs: + -rm -f @gl_LIBOBJDEPS@ +maintainer-clean-local: distclean-gnulib-libobjs diff --git a/lib/intprops.h b/lib/intprops.h index 68d6daa5706..d4a917f72a0 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -229,11 +229,15 @@ /* True if __builtin_add_overflow (A, B, P) and __builtin_sub_overflow (A, B, P) work when P is non-null. */ -#if defined __has_builtin +#ifdef __EDG__ +/* EDG-based compilers like nvc 22.1 cannot add 64-bit signed to unsigned + <https://bugs.gnu.org/53256>. */ +# define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 +#elif defined __has_builtin # define _GL_HAS_BUILTIN_ADD_OVERFLOW __has_builtin (__builtin_add_overflow) /* __builtin_{add,sub}_overflow exists but is not reliable in GCC 5.x and 6.x, see <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98269>. */ -#elif 7 <= __GNUC__ && !defined __EDG__ +#elif 7 <= __GNUC__ # define _GL_HAS_BUILTIN_ADD_OVERFLOW 1 #else # define _GL_HAS_BUILTIN_ADD_OVERFLOW 0 diff --git a/lib/lchmod.c b/lib/lchmod.c index 479ed776cba..706dddff7bb 100644 --- a/lib/lchmod.c +++ b/lib/lchmod.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/memrchr.c b/lib/memrchr.c index e853996ad0a..90fdb86f1f1 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -11,7 +11,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/mini-gmp-gnulib.c b/lib/mini-gmp-gnulib.c index 7620da38dbb..a18ee8f6ab7 100644 --- a/lib/mini-gmp-gnulib.c +++ b/lib/mini-gmp-gnulib.c @@ -6,7 +6,7 @@ It is dual-licensed under "the GNU LGPLv3+ or the GNU GPLv2+". You can redistribute it and/or modify it under either - the terms of the GNU Lesser General Public License as published - by the Free Software Foundation; either version 3, or (at your + by the Free Software Foundation, either version 3, or (at your option) any later version, or - the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c index 8577b59ef6d..e7a320a6420 100644 --- a/lib/mini-gmp.c +++ b/lib/mini-gmp.c @@ -10,7 +10,7 @@ The GNU MP Library is free software; you can redistribute it and/or modify it under the terms of either: * the GNU Lesser General Public License as published by the Free - Software Foundation; either version 3 of the License, or (at your + Software Foundation, either version 3 of the License, or (at your option) any later version. or diff --git a/lib/mini-gmp.h b/lib/mini-gmp.h index 59c24cf5111..508712d235b 100644 --- a/lib/mini-gmp.h +++ b/lib/mini-gmp.h @@ -8,7 +8,7 @@ The GNU MP Library is free software; you can redistribute it and/or modify it under the terms of either: * the GNU Lesser General Public License as published by the Free - Software Foundation; either version 3 of the License, or (at your + Software Foundation, either version 3 of the License, or (at your option) any later version. or diff --git a/lib/mktime.c b/lib/mktime.c index aa12e28e168..7dc9d67ef9d 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -429,8 +429,13 @@ __mktime_internal (struct tm *tp, time with the right value, and use its UTC offset. Heuristic: probe the adjacent timestamps in both directions, - looking for the desired isdst. This should work for all real - time zone histories in the tz database. */ + looking for the desired isdst. If none is found within a + reasonable duration bound, assume a one-hour DST difference. + This should work for all real time zone histories in the tz + database. */ + + /* +1 if we wanted standard time but got DST, -1 if the reverse. */ + int dst_difference = (isdst == 0) - (tm.tm_isdst == 0); /* Distance between probes when looking for a DST boundary. In tzdata2003a, the shortest period of DST is 601200 seconds @@ -441,12 +446,14 @@ __mktime_internal (struct tm *tp, periods when probing. */ int stride = 601200; - /* The longest period of DST in tzdata2003a is 536454000 seconds - (e.g., America/Jujuy starting 1946-10-01 01:00). The longest - period of non-DST is much longer, but it makes no real sense - to search for more than a year of non-DST, so use the DST - max. */ - int duration_max = 536454000; + /* In TZDB 2021e, the longest period of DST (or of non-DST), in + which the DST (or adjacent DST) difference is not one hour, + is 457243209 seconds: e.g., America/Cambridge_Bay with leap + seconds, starting 1965-10-31 00:00 in a switch from + double-daylight time (-05) to standard time (-07), and + continuing to 1980-04-27 02:00 in a switch from standard time + (-07) to daylight time (-06). */ + int duration_max = 457243209; /* Search in both directions, so the maximum distance is half the duration; add the stride to avoid off-by-1 problems. */ @@ -483,6 +490,11 @@ __mktime_internal (struct tm *tp, } } + /* No unusual DST offset was found nearby. Assume one-hour DST. */ + t += 60 * 60 * dst_difference; + if (mktime_min <= t && t <= mktime_max && convert_time (convert, t, &tm)) + goto offset_found; + __set_errno (EOVERFLOW); return -1; } diff --git a/lib/nanosleep.c b/lib/nanosleep.c new file mode 100644 index 00000000000..446794edc0b --- /dev/null +++ b/lib/nanosleep.c @@ -0,0 +1,195 @@ +/* Provide a replacement for the POSIX nanosleep function. + + Copyright (C) 1999-2000, 2002, 2004-2022 Free Software Foundation, Inc. + + This file is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as + published by the Free Software Foundation; either version 2.1 of the + License, or (at your option) any later version. + + This file is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see <https://www.gnu.org/licenses/>. */ + +/* written by Jim Meyering + and Bruno Haible for the native Windows part */ + +#include <config.h> + +#include <time.h> + +#include "intprops.h" +#include "verify.h" + +#include <stdbool.h> +#include <stdio.h> +#include <sys/types.h> +#include <sys/select.h> +#include <signal.h> + +#include <errno.h> + +#include <unistd.h> + + +enum { BILLION = 1000 * 1000 * 1000 }; + +#if HAVE_BUG_BIG_NANOSLEEP + +int +nanosleep (const struct timespec *requested_delay, + struct timespec *remaining_delay) +# undef nanosleep +{ + /* nanosleep mishandles large sleeps due to internal overflow problems. + The worst known case of this is Linux 2.6.9 with glibc 2.3.4, which + can't sleep more than 24.85 days (2^31 milliseconds). Similarly, + cygwin 1.5.x, which can't sleep more than 49.7 days (2^32 milliseconds). + Solve this by breaking the sleep up into smaller chunks. */ + + if (requested_delay->tv_nsec < 0 || BILLION <= requested_delay->tv_nsec) + { + errno = EINVAL; + return -1; + } + + { + /* Verify that time_t is large enough. */ + verify (TYPE_MAXIMUM (time_t) / 24 / 24 / 60 / 60); + const time_t limit = 24 * 24 * 60 * 60; + time_t seconds = requested_delay->tv_sec; + struct timespec intermediate; + intermediate.tv_nsec = requested_delay->tv_nsec; + + while (limit < seconds) + { + int result; + intermediate.tv_sec = limit; + result = nanosleep (&intermediate, remaining_delay); + seconds -= limit; + if (result) + { + if (remaining_delay) + remaining_delay->tv_sec += seconds; + return result; + } + intermediate.tv_nsec = 0; + } + intermediate.tv_sec = seconds; + return nanosleep (&intermediate, remaining_delay); + } +} + +#elif defined _WIN32 && ! defined __CYGWIN__ +/* Native Windows platforms. */ + +# define WIN32_LEAN_AND_MEAN +# include <windows.h> + +/* The Windows API function Sleep() has a resolution of about 15 ms and takes + at least 5 ms to execute. We use this function for longer time periods. + Additionally, we use busy-looping over short time periods, to get a + resolution of about 0.01 ms. In order to measure such short timespans, + we use the QueryPerformanceCounter() function. */ + +int +nanosleep (const struct timespec *requested_delay, + struct timespec *remaining_delay) +{ + static bool initialized; + /* Number of performance counter increments per nanosecond, + or zero if it could not be determined. */ + static double ticks_per_nanosecond; + + if (requested_delay->tv_nsec < 0 || BILLION <= requested_delay->tv_nsec) + { + errno = EINVAL; + return -1; + } + + /* For requested delays of one second or more, 15ms resolution is + sufficient. */ + if (requested_delay->tv_sec == 0) + { + if (!initialized) + { + /* Initialize ticks_per_nanosecond. */ + LARGE_INTEGER ticks_per_second; + + if (QueryPerformanceFrequency (&ticks_per_second)) + ticks_per_nanosecond = + (double) ticks_per_second.QuadPart / 1000000000.0; + + initialized = true; + } + if (ticks_per_nanosecond) + { + /* QueryPerformanceFrequency worked. We can use + QueryPerformanceCounter. Use a combination of Sleep and + busy-looping. */ + /* Number of milliseconds to pass to the Sleep function. + Since Sleep can take up to 8 ms less or 8 ms more than requested + (or maybe more if the system is loaded), we subtract 10 ms. */ + int sleep_millis = (int) requested_delay->tv_nsec / 1000000 - 10; + /* Determine how many ticks to delay. */ + LONGLONG wait_ticks = requested_delay->tv_nsec * ticks_per_nanosecond; + /* Start. */ + LARGE_INTEGER counter_before; + if (QueryPerformanceCounter (&counter_before)) + { + /* Wait until the performance counter has reached this value. + We don't need to worry about overflow, because the performance + counter is reset at reboot, and with a frequency of 3.6E6 + ticks per second 63 bits suffice for over 80000 years. */ + LONGLONG wait_until = counter_before.QuadPart + wait_ticks; + /* Use Sleep for the longest part. */ + if (sleep_millis > 0) + Sleep (sleep_millis); + /* Busy-loop for the rest. */ + for (;;) + { + LARGE_INTEGER counter_after; + if (!QueryPerformanceCounter (&counter_after)) + /* QueryPerformanceCounter failed, but succeeded earlier. + Should not happen. */ + break; + if (counter_after.QuadPart >= wait_until) + /* The requested time has elapsed. */ + break; + } + goto done; + } + } + } + /* Implementation for long delays and as fallback. */ + Sleep (requested_delay->tv_sec * 1000 + requested_delay->tv_nsec / 1000000); + + done: + /* Sleep is not interruptible. So there is no remaining delay. */ + if (remaining_delay != NULL) + { + remaining_delay->tv_sec = 0; + remaining_delay->tv_nsec = 0; + } + return 0; +} + +#else +/* Other platforms lacking nanosleep. + It's not clear whether these are still practical porting targets. + For now, just fall back on pselect. */ + +/* Suspend execution for at least *REQUESTED_DELAY seconds. The + *REMAINING_DELAY part isn't implemented yet. */ + +int +nanosleep (const struct timespec *requested_delay, + struct timespec *remaining_delay) +{ + return pselect (0, NULL, NULL, NULL, requested_delay, NULL); +} +#endif diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 190ff4d8f20..c1dd5542478 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -3,7 +3,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, @@ -1158,7 +1158,6 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) case L_('q'): /* GNU extension. */ DO_SIGNED_NUMBER (1, false, ((tp->tm_mon * 11) >> 5) + 1); - break; case L_('R'): subfmt = L_("%H:%M"); diff --git a/lib/openat-priv.h b/lib/openat-priv.h index 451cac10cc6..5d60810709d 100644 --- a/lib/openat-priv.h +++ b/lib/openat-priv.h @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/openat-proc.c b/lib/openat-proc.c index d5f4296d478..3bacf7dbd13 100644 --- a/lib/openat-proc.c +++ b/lib/openat-proc.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/openat.h b/lib/openat.h index dcb2864ffc8..5c8ff90b804 100644 --- a/lib/openat.h +++ b/lib/openat.h @@ -3,7 +3,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c index 42ae68ffc1d..37fb179260d 100644 --- a/lib/qcopy-acl.c +++ b/lib/qcopy-acl.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/readlinkat.c b/lib/readlinkat.c index f3d39604d2e..ab45e140b59 100644 --- a/lib/readlinkat.c +++ b/lib/readlinkat.c @@ -3,7 +3,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/save-cwd.h b/lib/save-cwd.h index 7aa124c42f8..90e8a0747ce 100644 --- a/lib/save-cwd.h +++ b/lib/save-cwd.h @@ -5,7 +5,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/set-permissions.c b/lib/set-permissions.c index 7a7c5e4ed0e..c1a4b82a0d0 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/sig2str.c b/lib/sig2str.c index f2f01d1f6fc..8e2fc0c0754 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/sig2str.h b/lib/sig2str.h index a507170b64a..a45af7f9686 100644 --- a/lib/sig2str.h +++ b/lib/sig2str.h @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/strftime.h b/lib/strftime.h index 9e5cdc3f32c..a9847084f01 100644 --- a/lib/strftime.h +++ b/lib/strftime.h @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/string.in.h b/lib/string.in.h index 03e6a17a36d..c9432948c15 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -563,22 +563,35 @@ _GL_WARN_ON_USE (strncat, "strncat is unportable - " # undef strndup # define strndup rpl_strndup # endif -_GL_FUNCDECL_RPL (strndup, char *, (char const *__s, size_t __n) - _GL_ARG_NONNULL ((1))); +_GL_FUNCDECL_RPL (strndup, char *, + (char const *__s, size_t __n) + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); _GL_CXXALIAS_RPL (strndup, char *, (char const *__s, size_t __n)); # else -# if ! @HAVE_DECL_STRNDUP@ -_GL_FUNCDECL_SYS (strndup, char *, (char const *__s, size_t __n) - _GL_ARG_NONNULL ((1))); +# if !@HAVE_DECL_STRNDUP@ || __GNUC__ >= 11 +_GL_FUNCDECL_SYS (strndup, char *, + (char const *__s, size_t __n) + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); # endif _GL_CXXALIAS_SYS (strndup, char *, (char const *__s, size_t __n)); # endif _GL_CXXALIASWARN (strndup); -#elif defined GNULIB_POSIXCHECK -# undef strndup -# if HAVE_RAW_DECL_STRNDUP +#else +# if __GNUC__ >= 11 +/* For -Wmismatched-dealloc: Associate strndup with free or rpl_free. */ +_GL_FUNCDECL_SYS (strndup, char *, + (char const *__s, size_t __n) + _GL_ARG_NONNULL ((1)) + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_DEALLOC_FREE); +# endif +# if defined GNULIB_POSIXCHECK +# undef strndup +# if HAVE_RAW_DECL_STRNDUP _GL_WARN_ON_USE (strndup, "strndup is unportable - " "use gnulib module strndup for portability"); +# endif # endif #endif diff --git a/lib/strtoimax.c b/lib/strtoimax.c index d562746ee78..cad12d0d9be 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -5,7 +5,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/strtol.c b/lib/strtol.c index 457f7a5d649..6c2e9333abc 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -8,7 +8,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/strtoll.c b/lib/strtoll.c index 5124168c1bb..acea42ee003 100644 --- a/lib/strtoll.c +++ b/lib/strtoll.c @@ -5,7 +5,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/symlink.c b/lib/symlink.c index 51850b2732c..26310af7b12 100644 --- a/lib/symlink.c +++ b/lib/symlink.c @@ -3,7 +3,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/time-internal.h b/lib/time-internal.h index e1bb56e53ec..c8a2a8ce6bc 100644 --- a/lib/time-internal.h +++ b/lib/time-internal.h @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/time_rz.c b/lib/time_rz.c index d0ae717f308..1a91d3778e7 100644 --- a/lib/time_rz.c +++ b/lib/time_rz.c @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/timespec-add.c b/lib/timespec-add.c index cd0b5f5f5be..0f270e5bc8c 100644 --- a/lib/timespec-add.c +++ b/lib/timespec-add.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/timespec-sub.c b/lib/timespec-sub.c index 2b2aaa59373..36747833e39 100644 --- a/lib/timespec-sub.c +++ b/lib/timespec-sub.c @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/timespec.c b/lib/timespec.c index 82630c2f5a0..9d136cb803b 100644 --- a/lib/timespec.c +++ b/lib/timespec.c @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/timespec.h b/lib/timespec.h index e130d2c6e25..9e358289a2a 100644 --- a/lib/timespec.h +++ b/lib/timespec.h @@ -5,7 +5,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 3386f0b0f75..57df09ecdf4 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -415,16 +415,30 @@ _GL_CXXALIASWARN (close); #if @GNULIB_COPY_FILE_RANGE@ -# if !@HAVE_COPY_FILE_RANGE@ +# if @REPLACE_COPY_FILE_RANGE@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef copy_file_range +# define copy_file_range rpl_copy_file_range +# endif +_GL_FUNCDECL_RPL (copy_file_range, ssize_t, (int ifd, off_t *ipos, + int ofd, off_t *opos, + size_t len, unsigned flags)); +_GL_CXXALIAS_RPL (copy_file_range, ssize_t, (int ifd, off_t *ipos, + int ofd, off_t *opos, + size_t len, unsigned flags)); +# else +# if !@HAVE_COPY_FILE_RANGE@ _GL_FUNCDECL_SYS (copy_file_range, ssize_t, (int ifd, off_t *ipos, int ofd, off_t *opos, size_t len, unsigned flags)); +# endif _GL_CXXALIAS_SYS (copy_file_range, ssize_t, (int ifd, off_t *ipos, int ofd, off_t *opos, size_t len, unsigned flags)); # endif _GL_CXXALIASWARN (copy_file_range); #elif defined GNULIB_POSIXCHECK +# undef copy_file_range # if HAVE_RAW_DECL_COPY_FILE_RANGE _GL_WARN_ON_USE (copy_file_range, "copy_file_range is unportable - " diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h index ce52f8f9773..7461d740959 100644 --- a/lib/unlocked-io.h +++ b/lib/unlocked-io.h @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/utimens.c b/lib/utimens.c index f4907ae4e61..2fa12518507 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/utimens.h b/lib/utimens.h index c3054da0c67..2ccc06e5ed6 100644 --- a/lib/utimens.h +++ b/lib/utimens.h @@ -4,7 +4,7 @@ This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as - published by the Free Software Foundation; either version 3 of the + published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This file is distributed in the hope that it will be useful, diff --git a/lib/utimensat.c b/lib/utimensat.c index 2e4c7bf9660..f81b0c790ef 100644 --- a/lib/utimensat.c +++ b/lib/utimensat.c @@ -3,7 +3,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lib/vla.h b/lib/vla.h index adc8f8f68b6..ce02428f53a 100644 --- a/lib/vla.h +++ b/lib/vla.h @@ -4,7 +4,7 @@ This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 8a425cf9bc0..cb528cebdcd 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -280,15 +280,16 @@ can get pretty complex." (const :tag "default" default)))) (repeat :tag "Extra Parameters" :inline t (choice :tag "Extra parameter" + :value (:host t) (list - :tag "Host" + :tag "Host" :inline t (const :format "" :value :host) (choice :tag "Host (machine) choice" (const :tag "Any" t) (regexp :tag "Regular expression"))) (list - :tag "Protocol" + :tag "Protocol" :inline t (const :format "" :value :port) (choice :tag "Protocol" diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 27517318171..80fb1cdfc78 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1819,7 +1819,7 @@ Don't affect the buffer ring order." (list location))]) entries))) (tabulated-list-init-header) - (setq tabulated-list-entries entries)) + (setq tabulated-list-entries (reverse entries))) (tabulated-list-print t)) ;;;###autoload @@ -1907,7 +1907,8 @@ Bookmark names preceded by a \"*\" have annotations. ,@(if bookmark-bmenu-toggle-filenames '(("File" 0 bookmark-bmenu--file-predicate)))]) (setq tabulated-list-padding bookmark-bmenu-marks-width) - (setq tabulated-list-sort-key '("Bookmark" . nil)) + (when bookmark-sort-flag + (setq tabulated-list-sort-key '("Bookmark" . nil))) (add-hook 'tabulated-list-revert-hook #'bookmark-bmenu--revert nil t)' (setq revert-buffer-function 'bookmark-bmenu--revert) (tabulated-list-init-header)) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 50c2c155caf..179cc5484cd 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -527,13 +527,18 @@ If UNMARK is non-nil, unmark them." (multi-occur (Buffer-menu-marked-buffers) regexp nlines)) +(autoload 'etags-verify-tags-table "etags") (defun Buffer-menu-visit-tags-table () "Visit the tags table in the buffer on this line. See `visit-tags-table'." (interactive nil Buffer-menu-mode) - (let ((file (buffer-file-name (Buffer-menu-buffer t)))) - (if file - (visit-tags-table file) - (error "Specified buffer has no file")))) + (let* ((buf (Buffer-menu-buffer t)) + (file (buffer-file-name buf))) + (cond + ((not file) (error "Specified buffer has no file")) + ((and buf (with-current-buffer buf + (etags-verify-tags-table))) + (visit-tags-table file)) + (t (error "Specified buffer is not a tags-table"))))) (defun Buffer-menu-1-window () "Select this line's buffer, alone, in full frame." diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index bec7348099a..dae97b02303 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1560,12 +1560,12 @@ If TYPE is `groups', include only groups." ;;;###autoload (defun custom-prompt-customize-unsaved-options () "Prompt user to customize any unsaved customization options. -Return non-nil if user chooses to customize, for use in +Return nil if user chooses to customize, for use in `kill-emacs-query-functions'." (not (and (custom-unsaved-options) - (yes-or-no-p "Some customized options have not been saved; Examine? ") - (customize-unsaved) - t))) + (yes-or-no-p + "Some customized options have not been saved; Examine? ") + (progn (customize-unsaved) t)))) ;;; Buffer. @@ -4798,7 +4798,11 @@ if only the first line of the docstring is shown.")) (delay-mode-hooks (emacs-lisp-mode))) (let ((inhibit-read-only t) (print-length nil) - (print-level nil)) + (print-level nil) + ;; We might be saving byte-code with embedded NULs, which + ;; can cause problems when read back, so print them + ;; readably. (Bug#52554) + (print-escape-control-characters t)) (atomic-change-group (custom-save-variables) (custom-save-faces))) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 193cf42ea42..5b07d75f6d8 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -226,6 +226,12 @@ are available (see Info node `(emacs)Document View')" Higher values result in larger images." :type 'number) +(defcustom doc-view-mutool-user-stylesheet nil + "User stylesheet to use when converting EPUB documents to PDF." + :type '(choice (const nil) + (file :must-match t)) + :version "29.1") + (defvar doc-view-doc-type nil "The type of document in the current buffer. Can be `dvi', `pdf', `ps', `djvu', `odf', 'epub', `cbz', `fb2', @@ -1169,8 +1175,16 @@ The test is performed using `doc-view-pdfdraw-program'." (options `(,(concat "-o" png) ,(format "-r%d" (round doc-view-resolution)) ,@(if pdf-passwd `("-p" ,pdf-passwd))))) - (when (and (eq doc-view-doc-type 'epub) doc-view-epub-font-size) - (setq options (append options (list (format "-S%s" doc-view-epub-font-size))))) + (when (eq doc-view-doc-type 'epub) + (when doc-view-epub-font-size + (setq options (append options + (list (format "-S%s" doc-view-epub-font-size))))) + (when doc-view-mutool-user-stylesheet + (setq options + (append options + (list (format "-U%s" + (expand-file-name + doc-view-mutool-user-stylesheet))))))) (doc-view-start-process "pdf->png" doc-view-pdfdraw-program `(,@(doc-view-pdfdraw-program-subcommand) diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el index 260657e0f7a..d5f3fc77560 100644 --- a/lisp/ecomplete.el +++ b/lisp/ecomplete.el @@ -65,10 +65,11 @@ :type 'file) (defcustom ecomplete-database-file-coding-system 'iso-2022-7bit + ;; FIXME: We should transition to `utf-8-emacs-unix' somehow! "Coding system used for writing the ecomplete database file." :type '(symbol :tag "Coding system")) -(defcustom ecomplete-sort-predicate 'ecomplete-decay +(defcustom ecomplete-sort-predicate #'ecomplete-decay "Predicate to use when sorting matched. The predicate is called with two parameters that represent the completion. Each parameter is a list where the first element is @@ -95,13 +96,18 @@ string that was matched." (defun ecomplete-add-item (type key text) "Add item TEXT of TYPE to the database, using KEY as the identifier." + (unless ecomplete-database (ecomplete-setup)) (let ((elems (assq type ecomplete-database)) (now (time-convert nil 'integer)) entry) (unless elems (push (setq elems (list type)) ecomplete-database)) (if (setq entry (assoc key (cdr elems))) - (setcdr entry (list (1+ (cadr entry)) now text)) + (pcase-let ((`(,_key ,count ,_time ,oldtext) entry)) + (setcdr entry (list (1+ count) now + ;; Preserve the "more complete" text. + (if (>= (length text) (length oldtext)) + text oldtext)))) (nconc elems (list (list key 1 now text)))))) (defun ecomplete-get-item (type key) @@ -110,19 +116,23 @@ string that was matched." (defun ecomplete-save () "Write the .ecompleterc file." - (with-temp-buffer - (let ((coding-system-for-write ecomplete-database-file-coding-system)) - (insert "(") - (cl-loop for (type . elems) in ecomplete-database - do - (insert (format "(%s\n" type)) - (dolist (entry elems) - (prin1 entry (current-buffer)) - (insert "\n")) - (insert ")\n")) - (insert ")") - (write-region (point-min) (point-max) - ecomplete-database-file nil 'silent)))) + ;; If the database is empty, it might be because we haven't called + ;; `ecomplete-setup', so better not save at all, lest we lose the real + ;; database! + (when ecomplete-database + (with-temp-buffer + (let ((coding-system-for-write ecomplete-database-file-coding-system)) + (insert "(") + (cl-loop for (type . elems) in ecomplete-database + do + (insert (format "(%s\n" type)) + (dolist (entry elems) + (prin1 entry (current-buffer)) + (insert "\n")) + (insert ")\n")) + (insert ")") + (write-region (point-min) (point-max) + ecomplete-database-file nil 'silent))))) (defun ecomplete-get-matches (type match) (let* ((elems (cdr (assq type ecomplete-database))) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index c542c550169..384e8cba88f 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -37,53 +37,70 @@ the corresponding new element of the same type. The purpose of this is to detect circular structures.") -(defalias 'byte-run--strip-s-p-1 +(defalias 'byte-run--strip-list #'(lambda (arg) - "Strip all positions from symbols in ARG, modifying ARG. -Return the modified ARG." + "Strip the positions from symbols with position in the list ARG. +This is done by destructively modifying ARG. Return ARG." + (let ((a arg)) + (while + (and + (not (gethash a byte-run--ssp-seen)) + (progn + (puthash a t byte-run--ssp-seen) + (cond + ((symbol-with-pos-p (car a)) + (setcar a (bare-symbol (car a)))) + ((consp (car a)) + (byte-run--strip-list (car a))) + ((or (vectorp (car a)) (recordp (car a))) + (byte-run--strip-vector/record (car a)))) + (consp (cdr a)))) + (setq a (cdr a))) + (cond + ((symbol-with-pos-p (cdr a)) + (setcdr a (bare-symbol (cdr a)))) + ((or (vectorp (cdr a)) (recordp (cdr a))) + (byte-run--strip-vector/record (cdr a)))) + arg))) + +(defalias 'byte-run--strip-vector/record + #'(lambda (arg) + "Strip the positions from symbols with position in the vector/record ARG. +This is done by destructively modifying ARG. Return ARG." + (unless (gethash arg byte-run--ssp-seen) + (let ((len (length arg)) + (i 0) + elt) + (puthash arg t byte-run--ssp-seen) + (while (< i len) + (setq elt (aref arg i)) + (cond + ((symbol-with-pos-p elt) + (aset arg i elt)) + ((consp elt) + (byte-run--strip-list elt)) + ((or (vectorp elt) (recordp elt)) + (byte-run--strip-vector/record elt))) + (setq i (1+ i))))) + arg)) + +(defalias 'byte-run-strip-symbol-positions + #'(lambda (arg) + "Strip all positions from symbols in ARG. +This modifies destructively then returns ARG. + +ARG is any Lisp object, but is usually a list or a vector or a +record, containing symbols with position." + (setq byte-run--ssp-seen (make-hash-table :test 'eq)) (cond ((symbol-with-pos-p arg) (bare-symbol arg)) - ((consp arg) - (let* ((hash (gethash arg byte-run--ssp-seen))) - (if hash ; Already processed this node. - arg - (let ((a arg) new) - (while - (progn - (puthash a t byte-run--ssp-seen) - (setq new (byte-run--strip-s-p-1 (car a))) - (setcar a new) - (and (consp (cdr a)) - (not - (setq hash (gethash (cdr a) byte-run--ssp-seen))))) - (setq a (cdr a))) - (setq new (byte-run--strip-s-p-1 (cdr a))) - (setcdr a new) - arg)))) - + (byte-run--strip-list arg)) ((or (vectorp arg) (recordp arg)) - (let ((hash (gethash arg byte-run--ssp-seen))) - (if hash - arg - (let* ((len (length arg)) - (i 0) - new) - (puthash arg t byte-run--ssp-seen) - (while (< i len) - (setq new (byte-run--strip-s-p-1 (aref arg i))) - (aset arg i new) - (setq i (1+ i))) - arg)))) - + (byte-run--strip-vector/record arg)) (t arg)))) -(defalias 'byte-run-strip-symbol-positions - #'(lambda (arg) - (setq byte-run--ssp-seen (make-hash-table :test 'eq)) - (byte-run--strip-s-p-1 arg))) - (defalias 'function-put ;; We don't want people to just use `put' because we can't conveniently ;; hook into `put' to remap old properties to new ones. But for now, there's @@ -92,9 +109,7 @@ Return the modified ARG." "Set FUNCTION's property PROP to VALUE. The namespace for PROP is shared with symbols. So far, FUNCTION can only be a symbol, not a lambda expression." - (put (bare-symbol function) - (byte-run-strip-symbol-positions prop) - (byte-run-strip-symbol-positions value)))) + (put (bare-symbol function) prop value))) (function-put 'defmacro 'doc-string-elt 3) (function-put 'defmacro 'lisp-indent-function 2) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c59bb292f8f..c680437f324 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -500,8 +500,9 @@ Return the compile-time value of FORM." byte-compile-new-defuns)) (setf result (byte-compile-eval + (byte-run-strip-symbol-positions (byte-compile-top-level - (byte-compile-preprocess form))))))) + (byte-compile-preprocess form)))))))) (list 'quote result)))) (eval-and-compile . ,(lambda (&rest body) (byte-compile-recurse-toplevel @@ -512,9 +513,10 @@ Return the compile-time value of FORM." ;; or byte-compile-file-form. (let* ((print-symbols-bare t) ; Possibly redundant binding. (expanded - (macroexpand--all-toplevel - form - macroexpand-all-environment))) + (byte-run-strip-symbol-positions + (macroexpand--all-toplevel + form + macroexpand-all-environment)))) (eval expanded lexical-binding) expanded))))) (with-suppressed-warnings @@ -1583,32 +1585,31 @@ extra args." ;; number of arguments. (defun byte-compile-arglist-warn (name arglist macrop) ;; This is the first definition. See if previous calls are compatible. - (let ((calls (assq name byte-compile-unresolved-functions)) - nums sig min max) - (when (and calls macrop) - (byte-compile-warn-x name "macro `%s' defined too late" name)) - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions)) - (setq calls (delq t calls)) ;Ignore higher-order uses of the function. - (when (cddr calls) - (when (and (symbolp name) - (eq (function-get name 'byte-optimizer) - 'byte-compile-inline-expand)) - (byte-compile-warn-x name "defsubst `%s' was used before it was defined" - name)) - (setq sig (byte-compile-arglist-signature arglist) - nums (sort (copy-sequence (cddr calls)) (function <)) - min (car nums) - max (car (nreverse nums))) - (when (or (< min (car sig)) - (and (cdr sig) (> max (cdr sig)))) - (byte-compile-warn-x - name - "%s being defined to take %s%s, but was previously called with %s" - name - (byte-compile-arglist-signature-string sig) - (if (equal sig '(1 . 1)) " arg" " args") - (byte-compile-arglist-signature-string (cons min max)))))) + (let ((calls (assq name byte-compile-unresolved-functions))) + (when calls + (when macrop + (byte-compile-warn-x name "macro `%s' defined too late" name)) + (setq byte-compile-unresolved-functions + (delq calls byte-compile-unresolved-functions)) + (let ((nums (delq t (cddr calls)))) ; Ignore higher-order uses. + (when nums + (when (and (symbolp name) + (eq (function-get name 'byte-optimizer) + 'byte-compile-inline-expand)) + (byte-compile-warn-x + name "defsubst `%s' was used before it was defined" name)) + (let ((sig (byte-compile-arglist-signature arglist)) + (min (apply #'min nums)) + (max (apply #'max nums))) + (when (or (< min (car sig)) + (and (cdr sig) (> max (cdr sig)))) + (byte-compile-warn-x + name + "%s being defined to take %s%s, but was previously called with %s" + name + (byte-compile-arglist-signature-string sig) + (if (equal sig '(1 . 1)) " arg" " args") + (byte-compile-arglist-signature-string (cons min max))))))))) (let* ((old (byte-compile-fdefinition name macrop)) (initial (and macrop (cdr (assq name @@ -5099,7 +5100,7 @@ binding slots have been popped." OP and OPERAND are as passed to `byte-compile-out'." (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos)) ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1 - ;; elements, and the push the result, for a total of -OPERAND. + ;; elements, and then push the result, for a total of -OPERAND. ;; For discardN*, of course, we just pop OPERAND elements. (- operand) (or (aref byte-stack+-info (symbol-value op)) @@ -5109,7 +5110,11 @@ OP and OPERAND are as passed to `byte-compile-out'." (- 1 operand)))) (defun byte-compile-out (op &optional operand) - (setq operand (byte-run-strip-symbol-positions operand)) + "Push the operation onto `byte-compile-output'. +OP is an opcode, a symbol. OPERAND is either nil or a number or +a one-element list of a lisp form." + (when (and (consp operand) (null (cdr operand))) + (setq operand (byte-run-strip-symbol-positions operand))) (push (cons op operand) byte-compile-output) (if (eq op 'byte-return) ;; This is actually an unnecessary case, because there should be no diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index b44dda6f9d4..7b11c0c8159 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -262,6 +262,16 @@ DEFAULT-BODY, if present, is used as the body of a default method. (declarations nil) (methods ()) (options ()) + (warnings + (let ((nonsymargs + (delq nil (mapcar (lambda (arg) (unless (symbolp arg) arg)) + args)))) + (when nonsymargs + (list + (macroexp-warn-and-return + (format "Non-symbol arguments to cl-defgeneric: %s" + (mapconcat #'prin1-to-string nonsymargs "")) + nil nil nil nonsymargs))))) next-head) (while (progn (setq next-head (car-safe (car options-and-methods))) (or (keywordp next-head) @@ -284,6 +294,7 @@ DEFAULT-BODY, if present, is used as the body of a default method. (setq name (gv-setter (cadr name)))) `(prog1 (progn + ,@warnings (defalias ',name (cl-generic-define ',name ',args ',(nreverse options)) ,(if (consp doc) ;An expression rather than a constant. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 50852172505..0d0b5b51587 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -394,11 +394,17 @@ and BODY is implicitly surrounded by (cl-block NAME ...). `(iter-defun ,name ,@(cl--transform-lambda (cons args body) name))) ;; The lambda list for macros is different from that of normal lambdas. -;; Note that &environment is only allowed as first or last items in the + +;; `cl-macro-list' is shared between a few different use cases that +;; don't all support exactly the same set of special keywords: the +;; debug spec accepts hence a superset of what the macros +;; actually support. +;; For example &environment is only allowed as first or last items in the ;; top level list. (def-edebug-elem-spec 'cl-macro-list - '(([&optional "&environment" arg] + '(([&optional "&whole" arg] ; Only for compiler-macros or at lower levels. + [&optional "&environment" arg] ; Only at top-level. [&rest cl-macro-arg] [&optional ["&optional" &rest &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] @@ -410,26 +416,12 @@ and BODY is implicitly surrounded by (cl-block NAME ...). &optional "&allow-other-keys"]] [&optional ["&aux" &rest &or (cl-macro-arg &optional def-form) arg]] - [&optional "&environment" arg] + [&optional "&environment" arg] ; Only at top-level. + . [&or arg nil] ; Only allowed at lower levels. ))) (def-edebug-elem-spec 'cl-macro-arg - '(&or arg cl-macro-list1)) - -(def-edebug-elem-spec 'cl-macro-list1 - '(([&optional "&whole" arg] ;; only allowed at lower levels - [&rest cl-macro-arg] - [&optional ["&optional" &rest - &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] - [&optional [[&or "&rest" "&body"] cl-macro-arg]] - [&optional ["&key" [&rest - [&or ([&or (symbolp cl-macro-arg) arg] - &optional def-form cl-macro-arg) - arg]] - &optional "&allow-other-keys"]] - [&optional ["&aux" &rest - &or (cl-macro-arg &optional def-form) arg]] - . [&or arg nil]))) + '(&or arg cl-macro-list)) ;;;###autoload (defmacro cl-defmacro (name args &rest body) @@ -692,7 +684,7 @@ its argument list allows full Common Lisp conventions." (defmacro cl-destructuring-bind (args expr &rest body) "Bind the variables in ARGS to the result of EXPR and execute BODY." (declare (indent 2) - (debug (&define cl-macro-list1 def-form cl-declarations def-body))) + (debug (&define cl-macro-list def-form cl-declarations def-body))) (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-defs nil) @@ -2909,18 +2901,10 @@ To see the documentation for a defined struct type, use (debug (&define ;Makes top-level form not be wrapped. [&or symbolp - (gate + (gate ;; FIXME: Why? symbolp &rest - [&or symbolp - (&or [":conc-name" symbolp] - [":constructor" symbolp &optional cl-lambda-list] - [":copier" symbolp] - [":predicate" symbolp] - [":include" symbolp &rest sexp] ;; Not finished. - [":print-function" sexp] - [":type" symbolp] - [":named"] - [":initial-offset" natnump])])] + [&or (":constructor" &define name &optional cl-lambda-list) + sexp])] [&optional stringp] ;; All the above is for the following def-form. &rest &or symbolp (symbolp &optional def-form &rest sexp)))) @@ -3501,7 +3485,10 @@ compiler macros are expanded repeatedly until no further expansions are possible. Unlike regular macros, BODY can decide to \"punt\" and leave the original function call alone by declaring an initial `&whole foo' parameter and then returning foo." - (declare (debug cl-defmacro) (indent 2)) + ;; Like `cl-defmacro', but with the `&whole' special case. + (declare (debug (&define name cl-macro-list + cl-declarations-or-string def-body)) + (indent 2)) (let ((p args) (res nil)) (while (consp p) (push (pop p) res)) (setq args (nconc (nreverse res) (and p (list '&rest p))))) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index b9958f4951e..8912eb10cc5 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -404,7 +404,7 @@ the first time the mode is used." t (eval `(defvar ,(derived-mode-abbrev-table-name mode) (progn - (define-abbrev-table (derived-mode-abbrev-table-name mode) nil) + (define-abbrev-table (derived-mode-abbrev-table-name ',mode) nil) (make-abbrev-table)) ,(format "Abbrev table for %s." mode))))) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 571087c963d..96eaf1ab642 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -61,6 +61,7 @@ "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\ ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ +cl-\\(?:defun\\|defmethod\\|defgeneric\\)\\|\ menu-bar-make-toggle\\|menu-bar-make-toggle-command\\)" find-function-space-re "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)") diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index e635c7f200c..195035e6be9 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -112,9 +112,15 @@ (goto-char start) (dolist (line (split-string text "\n")) (end-of-line) - (if (bolp) - (insert line "\n") - (insert line)) + (if (not (bolp)) + (insert line) + (insert (make-string + (max (- (* (mod (1- times) columns) + (+ fill-column 4)) + (current-column)) + 0) + ?\s)) + (insert line "\n")) (forward-line 1)))))))) buf)) @@ -163,8 +169,9 @@ Usage example: \\='((?a \"always\") (?s \"session only\") (?n \"no\")))" - (let* ((choices (if show-help choices (append choices '((?? "?"))))) - (altered-names (mapcar #'rmc--add-key-description choices)) + (let* ((prompt-choices + (if show-help choices (append choices '((?? "?"))))) + (altered-names (mapcar #'rmc--add-key-description prompt-choices)) (full-prompt (format "%s (%s): " @@ -175,7 +182,7 @@ Usage example: (save-excursion (if show-help (setq buf (rmc--show-help prompt help-string show-help - choices altered-names))) + choices altered-names))) (while (not tchar) (message "%s%s" (if wrong-char @@ -194,7 +201,7 @@ Usage example: (lambda (elem) (cons (capitalize (cadr elem)) (car elem))) - choices))) + prompt-choices))) (condition-case nil (let ((cursor-in-echo-area t)) (read-event)) @@ -232,7 +239,7 @@ Usage example: (when wrong-char (ding)) (setq buf (rmc--show-help prompt help-string show-help - choices altered-names)))))) + choices altered-names)))))) (when (buffer-live-p buf) (kill-buffer buf)) (assq tchar choices))) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index abfe51d32b5..1bcb844d8e9 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -299,6 +299,7 @@ sorted. FUNCTION must be a function of one argument." TYPE must be one of following symbols: vector, string or list. \n(fn TYPE SEQUENCE...)" + (setq sequences (mapcar #'seq-into-sequence sequences)) (pcase type ('vector (apply #'vconcat sequences)) ('string (apply #'concat sequences)) @@ -417,8 +418,9 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." Equality is defined by TESTFN if non-nil or by `equal' if nil." (catch 'seq--break (seq-doseq (e sequence) - (when (funcall (or testfn #'equal) e elt) - (throw 'seq--break t))) + (let ((r (funcall (or testfn #'equal) e elt))) + (when r + (throw 'seq--break r)))) nil)) (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 71eca5a3230..165f5c7bfe2 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -172,9 +172,10 @@ You can call this function to add internal values in the trace buffer." LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, and CONTEXT is a string describing the dynamic context (e.g. values of some global variables)." - (let ((print-circle t)) + (let ((print-circle t) + (print-escape-newlines t)) (format "%s%s%d -> %S%s\n" - (mapconcat 'char-to-string (make-string (max 0 (1- level)) ?|) " ") + (mapconcat #'char-to-string (make-string (max 0 (1- level)) ?|) " ") (if (> level 1) " " "") level ;; FIXME: Make it so we can click the function name to jump to its @@ -187,7 +188,8 @@ some global variables)." LEVEL is the trace level, VALUE value returned by FUNCTION, and CONTEXT is a string describing the dynamic context (e.g. values of some global variables)." - (let ((print-circle t)) + (let ((print-circle t) + (print-escape-newlines t)) (format "%s%s%d <- %s: %S%s\n" (mapconcat 'char-to-string (make-string (1- level) ?|) " ") (if (> level 1) " " "") @@ -278,7 +280,8 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\" nil read-expression-map t 'read-expression-history)))) (lambda () - (let ((print-circle t)) + (let ((print-circle t) + (print-escape-newlines t)) (concat " [" (prin1-to-string (eval exp t)) "]")))))))) ;;;###autoload diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 2c61996637f..8d777335315 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -167,7 +167,7 @@ Return the position of the object if found, and nil if not." (let ((start (point))) (vtable-beginning-of-table) (save-restriction - (narrow-to-region (point) (vtable-end-of-table)) + (narrow-to-region (point) (save-excursion (vtable-end-of-table))) (if (text-property-search-forward 'vtable-object object #'eq) (progn (forward-line -1) @@ -456,22 +456,26 @@ This also updates the displayed table." (pcase-dolist (`(,index . ,direction) (vtable-sort-by table)) (let ((cache (vtable--cache table)) (numerical (vtable-column--numerical - (elt (vtable-columns table) index)))) + (elt (vtable-columns table) index))) + (numcomp (if (eq direction 'descend) + #'> #'<)) + (stringcomp (if (eq direction 'descend) + #'string> #'string<))) (setcar cache (sort (car cache) (lambda (e1 e2) (let ((c1 (elt e1 (1+ index))) (c2 (elt e2 (1+ index)))) (if numerical - (< (car c1) (car c2)) - (string< (if (stringp (car c1)) - (car c1) - (format "%s" (car c1))) - (if (stringp (car c2)) - (car c2) - (format "%s" (car c2))))))))) - (when (eq direction 'descend) - (setcar cache (nreverse (car cache))))))) + (funcall numcomp (car c1) (car c2)) + (funcall + stringcomp + (if (stringp (car c1)) + (car c1) + (format "%s" (car c1))) + (if (stringp (car c2)) + (car c2) + (format "%s" (car c2)))))))))))) (defun vtable--indicator (table index) (let ((order (car (last (vtable-sort-by table))))) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 216c71f59e4..970329e12a9 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -360,12 +360,12 @@ resultant list of strings." (defun eshell-add-pred-func (pred funcs negate follow) "Add the predicate function PRED to FUNCS." - (if negate - (setq pred (lambda (file) - (not (funcall pred file))))) - (if follow - (setq pred (lambda (file) - (funcall pred (file-truename file))))) + (when negate + (setq pred (let ((pred pred)) + (lambda (file) (not (funcall pred file)))))) + (when follow + (setq pred (let ((pred pred)) + (lambda (file) (funcall pred (file-truename file)))))) (cons pred funcs)) (defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 1a2f2a57e8e..ee3f907f85c 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -354,6 +354,30 @@ after are both returned." (list 'eshell-escape-arg arg)))) (goto-char (1+ end))))))) +(defun eshell-unescape-inner-double-quote (bound) + "Unescape escaped characters inside a double-quoted string. +The string to parse starts at point and ends at BOUND. + +If Eshell is currently parsing a quoted string and there are any +backslash-escaped characters, this will return the unescaped +string, updating point to BOUND. Otherwise, this returns nil and +leaves point where it was." + (when eshell-current-quoted + (let (strings + (start (point)) + (special-char + (rx-to-string + `(seq "\\" (group (any ,@eshell-special-chars-inside-quoting)))))) + (while (re-search-forward special-char bound t) + (push (concat (buffer-substring start (match-beginning 0)) + (match-string 1)) + strings) + (setq start (match-end 0))) + (when strings + (push (buffer-substring start bound) strings) + (goto-char bound) + (apply #'concat (nreverse strings)))))) + (defun eshell-parse-special-reference () "Parse a special syntax reference, of the form `#<args>'. diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index dceb061c8f4..8be1136e311 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -350,6 +350,39 @@ This only returns external (non-Lisp) processes." (defvar eshell--sep-terms) +(defmacro eshell-with-temp-command (region &rest body) + "Narrow the buffer to REGION and execute the forms in BODY. + +REGION is a cons cell (START . END) that specifies the region to +which to narrow the buffer. REGION can also be a string, in +which case the macro temporarily inserts it into the buffer at +point, and narrows the buffer to the inserted string. Before +executing BODY, point is set to the beginning of the narrowed +REGION. + +The value returned is the last form in BODY." + (declare (indent 1)) + `(let ((reg ,region)) + (if (stringp reg) + ;; Since parsing relies partly on buffer-local state + ;; (e.g. that of `eshell-parse-argument-hook'), we need to + ;; perform the parsing in the Eshell buffer. + (let ((begin (point)) end + (inhibit-point-motion-hooks t)) + (with-silent-modifications + (insert reg) + (setq end (point)) + (unwind-protect + (save-restriction + (narrow-to-region begin end) + (goto-char begin) + ,@body) + (delete-region begin end)))) + (save-restriction + (narrow-to-region (car reg) (cdr reg)) + (goto-char (car reg)) + ,@body)))) + (defun eshell-parse-command (command &optional args toplevel) "Parse the COMMAND, adding ARGS if given. COMMAND can either be a string, or a cons cell demarcating a buffer @@ -361,15 +394,9 @@ hooks should be run before and after the command." (append (if (consp command) (eshell-parse-arguments (car command) (cdr command)) - (let ((here (point)) - (inhibit-point-motion-hooks t)) - (with-silent-modifications - ;; FIXME: Why not use a temporary buffer and avoid this - ;; "insert&delete" business? --Stef - (insert command) - (prog1 - (eshell-parse-arguments here (point)) - (delete-region here (point)))))) + (eshell-with-temp-command command + (goto-char (point-max)) + (eshell-parse-arguments (point-min) (point-max)))) args)) (commands (mapcar diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index ed37de85f7a..70426ccaf2a 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -102,6 +102,7 @@ information, for example." "A list of the current status of subprocesses.") (declare-function eshell-send-eof-to-process "esh-mode") +(declare-function eshell-tail-process "esh-cmd") (defvar-keymap eshell-proc-mode-map "C-c M-i" #'eshell-insert-process @@ -119,7 +120,9 @@ Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments PROC and STATUS to functions on the latter." ;; Was there till 24.1, but it is not optional. (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc) - (eshell-reset-after-proc status) + ;; Only reset the prompt if this process is running interactively. + (when (eq proc (eshell-tail-process)) + (eshell-reset-after-proc status)) (run-hook-with-args 'eshell-kill-hook proc status)) (define-minor-mode eshell-proc-mode @@ -414,7 +417,7 @@ PROC is the process that's exiting. STRING is the exit message." (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) (unwind-protect - (let* ((entry (assq proc eshell-process-list))) + (let ((entry (assq proc eshell-process-list))) ; (if (not entry) ; (error "Sentinel called for unowned process `%s'" ; (process-name proc)) @@ -422,8 +425,13 @@ PROC is the process that's exiting. STRING is the exit message." (unwind-protect (progn (unless (string= string "run") - (unless (string-match "^\\(finished\\|exited\\)" string) - (eshell-insertion-filter proc string)) + ;; Write the exit message if the status is + ;; abnormal and the process is already writing + ;; to the terminal. + (when (and (eq proc (eshell-tail-process)) + (not (string-match "^\\(finished\\|exited\\)" + string))) + (funcall (process-filter proc) proc string)) (let ((handles (nth 1 entry)) (str (prog1 (nth 3 entry) (setf (nth 3 entry) nil))) @@ -435,12 +443,12 @@ PROC is the process that's exiting. STRING is the exit message." (lambda () (if (nth 4 entry) (run-at-time 0 nil finish-io) - (unwind-protect - (when str - (eshell-output-object - str nil handles)) - (eshell-close-handles - status 'nil handles)))))) + (when str + (ignore-error 'eshell-pipe-broken + (eshell-output-object + str nil handles))) + (eshell-close-handles + status 'nil handles))))) (funcall finish-io))))) (eshell-remove-process-entry entry)))) (eshell-kill-process-function proc string))))) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 5c8dacd980e..ca4cbd744c1 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -34,15 +34,11 @@ ;; ;; "-" is a valid part of a variable name. ;; -;; $<MYVAR>-TOO +;; $\"MYVAR\"-TOO +;; $'MYVAR'-TOO ;; ;; Only "MYVAR" is part of the variable name in this case. ;; -;; $#VARIABLE -;; -;; Returns the length of the value of VARIABLE. This could also be -;; done using the `length' Lisp function. -;; ;; $(lisp) ;; ;; Returns result of Lisp evaluation. Note: Used alone like this, it @@ -55,38 +51,40 @@ ;; Returns the value of an eshell subcommand. See the note above ;; regarding Lisp evaluations. ;; -;; $ANYVAR[10] +;; $<command> +;; +;; Evaluates an eshell subcommand, redirecting the output to a +;; temporary file, and returning the file name. ;; -;; Return the 10th element of ANYVAR. If ANYVAR's value is a string, -;; it will be split in order to make it a list. The splitting will -;; occur at whitespace. +;; $EXPR[10] ;; -;; $ANYVAR[: 10] +;; Return the 10th element of $EXPR, which can be any dollar +;; expression. If $EXPR's value is a string, it will be split in +;; order to make it a list. The splitting will occur at whitespace. ;; -;; As above, except that splitting occurs at the colon now. +;; $EXPR[10 20] ;; -;; $ANYVAR[: 10 20] +;; As above, but instead of returning a single element, it now returns a +;; list of two elements. ;; -;; As above, but instead of returning just a string, it now returns a -;; list of two strings. If the result is being interpolated into a -;; larger string, this list will be flattened into one big string, -;; with each element separated by a space. +;; $EXPR[: 10] ;; -;; $ANYVAR["\\\\" 10] +;; Like $EXPR[10], except that splitting occurs at the colon now. +;; +;; $EXPR["\\\\" 10] ;; ;; Separate on backslash characters. Actually, the first argument -- -;; if it doesn't have the form of a number, or a plain variable name -;; -- can be any regular expression. So to split on numbers, use -;; '$ANYVAR["[0-9]+" 10 20]'. +;; if it doesn't have the form of a number -- can be any regular +;; expression. So to split on numbers, use '$EXPR["[0-9]+" 10 20]'. ;; -;; $ANYVAR[hello] +;; $EXPR[hello] ;; -;; Calls `assoc' on ANYVAR with 'hello', expecting it to be an alist. +;; Calls `assoc' on $EXPR with 'hello', expecting it to be an alist. ;; -;; $#ANYVAR[hello] +;; $#EXPR ;; -;; Returns the length of the cdr of the element of ANYVAR who car is -;; equal to "hello". +;; Returns the length of the value of $EXPR. This could also be +;; done using the `length' Lisp function. ;; ;; There are also a few special variables defined by Eshell. '$$' is ;; the value of the last command (t or nil, in the case of an external @@ -410,7 +408,7 @@ process any indices that come after the variable reference." (eshell-parse-indices)) ;; This is an expression that will be evaluated by `eshell-do-eval', ;; which only support let-binding of dynamically-scoped vars - value `(let ((indices ',indices)) ,value)) + value `(let ((indices (eshell-eval-indices ',indices))) ,value)) (if get-len `(length ,value) value))) @@ -423,26 +421,29 @@ variable. Possible options are: NAME an environment or Lisp variable value - <LONG-NAME> disambiguates the length of the name + \"LONG-NAME\" disambiguates the length of the name + 'LONG-NAME' as above {COMMAND} result of command is variable's value - (LISP-FORM) result of Lisp form is variable's value" + (LISP-FORM) result of Lisp form is variable's value + <COMMAND> write the output of command to a temporary file; + result is the file name" (cond ((eq (char-after) ?{) (let ((end (eshell-find-delimiter ?\{ ?\}))) (if (not end) (throw 'eshell-incomplete ?\{) + (forward-char) (prog1 - `(eshell-convert - (eshell-command-to-value - (eshell-as-subcommand - ,(eshell-parse-command (cons (1+ (point)) end))))) + `(eshell-apply-indices + (eshell-convert + (eshell-command-to-value + (eshell-as-subcommand + ,(let ((subcmd (or (eshell-unescape-inner-double-quote end) + (cons (point) end))) + (eshell-current-quoted nil)) + (eshell-parse-command subcmd))))) + indices) (goto-char (1+ end)))))) - ((memq (char-after) '(?\' ?\")) - (let ((name (if (eq (char-after) ?\') - (eshell-parse-literal-quote) - (eshell-parse-double-quote)))) - (if name - `(eshell-get-variable ,(eval name) indices)))) ((eq (char-after) ?\<) (let ((end (eshell-find-delimiter ?\< ?\>))) (if (not end) @@ -454,20 +455,39 @@ Possible options are: `(let ((eshell-current-handles (eshell-create-handles ,temp 'overwrite))) (progn - (eshell-as-subcommand ,(eshell-parse-command cmd)) + (eshell-as-subcommand + ,(let ((eshell-current-quoted nil)) + (eshell-parse-command cmd))) (ignore (nconc eshell-this-command-hook - (list (lambda () - (delete-file ,temp))))) - (quote ,temp))) + ;; Quote this lambda; it will be evaluated + ;; by `eshell-do-eval', which requires very + ;; particular forms in order to work + ;; properly. See bug#54190. + (list (function (lambda () + (delete-file ,temp)))))) + (eshell-apply-indices ,temp indices))) (goto-char (1+ end))))))) ((eq (char-after) ?\() (condition-case nil - `(eshell-command-to-value - (eshell-lisp-command - ',(read (current-buffer)))) + `(eshell-apply-indices + (eshell-command-to-value + (eshell-lisp-command + ',(read (or (eshell-unescape-inner-double-quote (point-max)) + (current-buffer))))) + indices) (end-of-file (throw 'eshell-incomplete ?\()))) + ((looking-at (rx-to-string + `(or "'" ,(if eshell-current-quoted "\\\"" "\"")))) + (eshell-with-temp-command + (or (eshell-unescape-inner-double-quote (point-max)) + (cons (point) (point-max))) + (let ((name (if (eq (char-after) ?\') + (eshell-parse-literal-quote) + (eshell-parse-double-quote)))) + (when name + `(eshell-get-variable ,(eval name) indices))))) ((assoc (char-to-string (char-after)) eshell-variable-aliases-list) (forward-char) @@ -482,19 +502,29 @@ Possible options are: (defvar eshell-glob-function) (defun eshell-parse-indices () - "Parse and return a list of list of indices." + "Parse and return a list of index-lists. + +For example, \"[0 1][2]\" becomes: + ((\"0\" \"1\") (\"2\")." (let (indices) (while (eq (char-after) ?\[) (let ((end (eshell-find-delimiter ?\[ ?\]))) (if (not end) (throw 'eshell-incomplete ?\[) (forward-char) - (let (eshell-glob-function) - (setq indices (cons (eshell-parse-arguments (point) end) - indices))) + (eshell-with-temp-command (or (eshell-unescape-inner-double-quote end) + (cons (point) end)) + (let (eshell-glob-function (eshell-current-quoted nil)) + (setq indices (cons (eshell-parse-arguments + (point-min) (point-max)) + indices)))) (goto-char (1+ end))))) (nreverse indices))) +(defun eshell-eval-indices (indices) + "Evaluate INDICES, a list of index-lists generated by `eshell-parse-indices'." + (mapcar (lambda (i) (mapcar #'eval i)) indices)) + (defun eshell-get-variable (name &optional indices) "Get the value for the variable NAME." (let* ((alias (assoc name eshell-variable-aliases-list)) @@ -541,13 +571,11 @@ For example, to retrieve the second element of a user's record in (while indices (let ((refs (car indices))) (when (stringp value) - (let (separator) - (if (not (or (not (stringp (caar indices))) - (string-match - (concat "^" eshell-variable-name-regexp "$") - (caar indices)))) - (setq separator (caar indices) - refs (cdr refs))) + (let (separator (index (caar indices))) + (when (and (stringp index) + (not (get-text-property 0 'number index))) + (setq separator index + refs (cdr refs))) (setq value (mapcar #'eshell-convert (split-string value separator))))) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index eb4f6b9534c..50306a5e8a0 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -207,10 +207,12 @@ If SPECS is empty or a single face `eq' to FACE, call `face-remap-reset-base' to use the normal definition of FACE as the base remapping; note that this is different from SPECS containing a single value nil, which means not to inherit from the global definition of FACE at all." + ;; Simplify the specs in the case where it's just a single face (and + ;; it's not a list with just a nil). (while (and (consp specs) (not (null (car specs))) (null (cdr specs))) (setq specs (car specs))) (if (or (null specs) - (and (eq (car specs) face) (null (cdr specs)))) ; default + (eq specs face)) ; default ;; Set entry back to default (face-remap-reset-base face) ;; Set the base remapping diff --git a/lisp/faces.el b/lisp/faces.el index 3a434b3251c..30f8483159a 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -663,7 +663,12 @@ face spec. It is mostly intended for internal use only. If FRAME is nil, set the attributes for all existing frames, as well as the default for new frames. If FRAME is t, change the -default for new frames only. +default for new frames only. As an exception, to reset the value +of some attribute to `unspecified' in a way that overrides the +non-`unspecified' value defined by the face's spec in `defface', +for new frames, you must explicitly call this function with FRAME +set to t and the attribute's value set to `unspecified'; just +using FRAME of nil will not affect new frames in this case. ARGS must come in pairs ATTRIBUTE VALUE. ATTRIBUTE must be a valid face attribute name. All attributes can be set to @@ -1738,7 +1743,15 @@ The following sources are applied in this order: (and tail (face-spec-set-2 face frame (list :extend (cadr tail)))))) (setq face-attrs (face-spec-choose (get face 'face-override-spec) frame)) - (face-spec-set-2 face frame face-attrs))) + (face-spec-set-2 face frame face-attrs) + (when (and (fboundp 'set-frame-parameter) ; This isn't available + ; during loadup. + (eq face 'scroll-bar)) + ;; Set the `scroll-bar-foreground' and `scroll-bar-background' + ;; frame parameters, because the face is handled by setting + ;; those two parameters. (bug#13476) + (set-frame-parameter frame 'scroll-bar-foreground (face-foreground face)) + (set-frame-parameter frame 'scroll-bar-background (face-background face))))) (defun face-spec-set-2 (face frame face-attrs) "Set the face attributes of FACE on FRAME according to FACE-ATTRS. @@ -2821,11 +2834,9 @@ used to display the prompt text." :group 'frames :group 'basic-faces) -(defface scroll-bar - '((((background light)) :foreground "black") - (((background dark)) :foreground "white")) +(defface scroll-bar '((t nil)) "Basic face for the scroll bar colors under X." - :version "28.1" + :version "21.1" :group 'frames :group 'basic-faces) diff --git a/lisp/files.el b/lisp/files.el index a0501cffa1a..a0bc5bf2626 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -987,10 +987,7 @@ one or more of those symbols." (logior (if (memq 'executable predicate) 1 0) (if (memq 'writable predicate) 2 0) (if (memq 'readable predicate) 4 0)))) - (let ((file (locate-file-internal filename path suffixes predicate))) - (if (and file (string-match "\\.eln\\'" file)) - (gethash (file-name-nondirectory file) comp-eln-to-el-h) - file))) + (locate-file-internal filename path suffixes predicate)) (defun locate-file-completion-table (dirs suffixes string pred action) "Do completion for file names passed to `locate-file'." @@ -3744,8 +3741,8 @@ return as the symbol specifying the mode." (while (not (or (and (eq handle-mode t) result) (>= (point) end))) (unless (looking-at hack-local-variable-regexp) - (message "Malformed mode-line: %S" - (buffer-substring-no-properties (point) end)) + (message "Malformed mode-line: %S in buffer %S" + (buffer-substring-no-properties (point) end) (buffer-name)) (throw 'malformed-line nil)) (goto-char (match-end 0)) ;; There used to be a downcase here, diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 1be5a48068c..769ad6d9eb1 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9445,6 +9445,16 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." (push primary urls)) (delete-dups urls))) +(defun gnus-collect-urls-from-article () + "Select the article and return the list of URLs in it. +See 'gnus-collect-urls'." + (gnus-summary-select-article) + (gnus-with-article-buffer + (article-goto-body) + ;; Back up a char, in case body starts with a button. + (backward-char) + (gnus-collect-urls))) + (defun gnus-shorten-url (url max) "Return an excerpt from URL not exceeding MAX characters." (if (<= (length url) max) @@ -9460,33 +9470,27 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." "Scan the current article body for links, and offer to browse them. Links are opened using `browse-url' unless a prefix argument is -given: Then `browse-url-secondary-browser-function' is used instead. +given: then `browse-url-secondary-browser-function' is used instead. If only one link is found, browse that directly, otherwise use completion to select a link. The first link marked in the article text with `gnus-collect-urls-primary-text' is the default." (interactive "P" gnus-summary-mode) - (let (urls target) - (gnus-summary-select-article) - (gnus-with-article-buffer - (article-goto-body) - ;; Back up a char, in case body starts with a button. - (backward-char) - (setq urls (gnus-collect-urls)) - (setq target - (cond ((= (length urls) 1) - (car urls)) - ((> (length urls) 1) - (completing-read - (format-prompt "URL to browse" - (gnus-shorten-url (car urls) 40)) - urls nil t nil nil (car urls))))) - (if target - (if external - (funcall browse-url-secondary-browser-function target) - (browse-url target)) - (message "No URLs found."))))) + (let* ((urls (gnus-collect-urls-from-article)) + (target + (cond ((= (length urls) 1) + (car urls)) + ((> (length urls) 1) + (completing-read + (format-prompt "URL to browse" + (gnus-shorten-url (car urls) 40)) + urls nil t nil nil (car urls)))))) + (if target + (if external + (funcall browse-url-secondary-browser-function target) + (browse-url target)) + (message "No URLs found.")))) (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 800c7dcea03..30734b8f1ad 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -50,6 +50,7 @@ (require 'subr-x) (require 'yank-media) (require 'mailcap) +(require 'sendmail) (autoload 'mailclient-send-it "mailclient") @@ -716,7 +717,7 @@ The function accepts 1 parameter which is the matched prefix." (defvar sendmail-program) (cond ((executable-find sendmail-program) #'message-send-mail-with-sendmail) - ((bound-and-true-p 'smtpmail-default-smtp-server) + ((bound-and-true-p smtpmail-default-smtp-server) #'message-smtpmail-send-it) (t #'message-send-mail-with-mailclient))) @@ -8016,7 +8017,18 @@ is for the internal use." (select-safe-coding-system-function nil) message-required-mail-headers message-generate-hashcash - rfc2047-encode-encoded-words) + rfc2047-encode-encoded-words + ;; If `message-sendmail-envelope-from' is `header' then + ;; the envelope-from will be the original sender's + ;; address, not the resender's. But when resending, the + ;; envelope-from should be the resender's address. Defuse + ;; that particular case. + (message-sendmail-envelope-from + (and (not (and (eq message-sendmail-envelope-from + 'obey-mail-envelope-from) + (eq mail-envelope-from 'header))) + (not (eq message-sendmail-envelope-from 'header)) + message-sendmail-envelope-from))) (message-send-mail)) (when gcc (message-goto-eoh) @@ -8265,17 +8277,23 @@ When FORCE, rebuild the tool bar." 'message-mode-map)))) message-tool-bar-map) -;;; Group name completion. +;;; Group name and email address completion. (defcustom message-newgroups-header-regexp "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups." + "Regexp matching headers that list groups." :group 'message :type 'regexp) +(defcustom message-email-recipient-header-regexp + "^\\([^ :]*-\\)?\\(To\\|B?Cc\\|From\\|Reply-to\\|Mail-Followup-To\\|Mail-Copies-To\\):" + "Regexp matching headers that list email addresses." + :version "29.1" + :type 'regexp) + (defcustom message-completion-alist `((,message-newgroups-header-regexp . ,#'message-expand-group) - ("^\\([^ :]*-\\)?\\(To\\|B?Cc\\|From\\):" . ,#'message-expand-name)) + (,message-email-recipient-header-regexp . ,#'message-expand-name)) "Alist of (RE . FUN). Use FUN for completion on header lines matching RE. FUN should be a function that obeys the same rules as those of `completion-at-point-functions'." diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index f5be477d26d..d6289f13395 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -256,6 +256,11 @@ as `(keyfunc member)' and the corresponding element is just (define-obsolete-variable-alias 'nnir-retrieve-headers-override-function 'nnselect-retrieve-headers-override-function "28.1") +(defcustom nnselect-allow-ephemeral-expiry nil + "If non-nil, articles in ephemeral nnselect groups are subject to expiry." + :version "29.1" + :type 'boolean) + (defcustom nnselect-retrieve-headers-override-function nil "A function that retrieves article headers for ARTICLES from GROUP. The retrieved headers should populate the `nntp-server-buffer'. @@ -457,24 +462,26 @@ If this variable is nil, or if the provided function returns nil, :test #'equal :count 1))))) (deffoo nnselect-request-expire-articles - (articles _group &optional _server force) - (if force - (let (not-expired) - (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles)) - (let ((artlist (sort (mapcar #'cdr artids) #'<))) - (unless (gnus-check-backend-function 'request-expire-articles - artgroup) - (error "Group %s does not support article expiration" artgroup)) - (unless (gnus-check-server (gnus-find-method-for-group artgroup)) - (error "Couldn't open server for group %s" artgroup)) - (push (mapcar (lambda (art) - (car (rassq art artids))) - (let ((nnimap-expunge 'immediately)) - (gnus-request-expire-articles - artlist artgroup force))) - not-expired))) - (sort (delq nil not-expired) #'<)) - articles)) + (articles group &optional _server force) + (let ((nnimap-expunge 'immediately) not-deleted) + (if (and (not force) + (not nnselect-allow-ephemeral-expiry) + (gnus-ephemeral-group-p (nnselect-add-prefix group))) + articles + (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles)) + (let ((artlist (sort (mapcar #'cdr artids) #'<))) + (unless + (gnus-check-backend-function 'request-expire-articles artgroup) + (error "Group %s does not support article expiration" artgroup)) + (unless (gnus-check-server (gnus-find-method-for-group artgroup)) + (error "Couldn't open server for group %s" artgroup)) + (setq not-deleted + (append + (mapcar (lambda (art) (car (rassq art artids))) + (gnus-request-expire-articles artlist artgroup + force)) + not-deleted)))) + (sort (delq nil not-deleted) #'<)))) (deffoo nnselect-warp-to-article () @@ -645,8 +652,15 @@ If this variable is nil, or if the provided function returns nil, (lambda (article) (if (setq seq - (cl-position article - gnus-newsgroup-selection :test 'equal)) + (cl-position + article + gnus-newsgroup-selection + :test + (lambda (x y) + (and (equal (nnselect-artitem-group x) + (nnselect-artitem-group y)) + (eql (nnselect-artitem-number x) + (nnselect-artitem-number y)))))) (push (1+ seq) old-arts) (setq gnus-newsgroup-selection (vconcat gnus-newsgroup-selection (vector article))) @@ -744,7 +758,7 @@ If this variable is nil, or if the provided function returns nil, (deffoo nnselect-request-scan (group _method) (when (and group - (gnus-group-get-parameter (nnselect-add-prefix group) + (gnus-group-find-parameter (nnselect-add-prefix group) 'nnselect-rescan t)) (nnselect-request-group-scan group))) @@ -864,6 +878,9 @@ article came from is also searched." ;; When the backend can store marks we collect any ;; changes. Unlike a normal group the mark lists only ;; include marks for articles we retrieved. + (when (and (gnus-check-backend-function + 'request-set-mark gnus-newsgroup-name) + (not (gnus-article-unpropagatable-p type))) (let* ((old (range-list-intersection artlist (alist-get type (gnus-info-marks group-info)))) @@ -875,7 +892,7 @@ article came from is also searched." ;; This shouldn't happen, but is a sanity check. (setq del (range-intersection (gnus-active artgroup) del)) - (push (list del 'del (list type)) delta-marks))) + (push (list del 'del (list type)) delta-marks)))) ;; Marked sets are of mark-type 'tuple, 'list, or ;; 'range. We merge the lists with what is already in @@ -900,12 +917,15 @@ article came from is also searched." (setq list (cdr all)))) ;; now merge with the original list and sort just to ;; make sure - (setq list - (sort (map-merge - 'alist list - (alist-get type (gnus-info-marks group-info))) - (lambda (elt1 elt2) - (< (car elt1) (car elt2)))))) + (setq + list (sort + (map-merge + 'alist list + (delq nil + (mapcar + (lambda (x) (unless (memq (car x) artlist) x)) + (alist-get type (gnus-info-marks group-info))))) + 'car-less-than-car))) (t (setq list (range-compress-list @@ -949,9 +969,13 @@ article came from is also searched." (cdr (assoc artgroup select-reads))) (sort (cdr (assoc artgroup select-unreads)) #'<)))) (gnus-get-unread-articles-in-group - group-info (gnus-active artgroup) t) - (gnus-group-update-group artgroup t t))))))) - + group-info (gnus-active artgroup) t)) + (gnus-group-update-group + artgroup t + (equal group-info + (setq group-info (copy-sequence (gnus-get-info artgroup)) + group-info + (delq (gnus-info-params group-info) group-info))))))))) (declare-function gnus-registry-get-id-key "gnus-registry" (id key)) diff --git a/lisp/help.el b/lisp/help.el index 975be497e77..f1a617f8500 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1388,7 +1388,8 @@ Return nil if the key sequence is too long." ((keymapp definition) (insert "Prefix Command\n")) ((byte-code-function-p definition) - (insert "[%s]\n" (buttonize "byte-code" #'disassemble definition))) + (insert (format "[%s]\n" + (buttonize "byte-code" #'disassemble definition)))) ((and (consp definition) (memq (car definition) '(closure lambda))) (insert (format "[%s]\n" @@ -1929,8 +1930,8 @@ Return VALUE." ;; window to an arbitrary buffer position. (defmacro with-help-window (buffer-or-name &rest body) "Evaluate BODY, send output to BUFFER-OR-NAME and show in a help window. -This construct is like `with-temp-buffer-window' but unlike that -puts the buffer specified by BUFFER-OR-NAME in `help-mode' and +This construct is like `with-temp-buffer-window', which see, but unlike +that, it puts the buffer specified by BUFFER-OR-NAME in `help-mode' and displays a message about how to delete the help window when it's no longer needed. The help window will be selected if `help-window-select' is non-nil. diff --git a/lisp/indent.el b/lisp/indent.el index d20c8053c5f..0343439d144 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -77,7 +77,7 @@ This variable has no effect unless `tab-always-indent' is `complete'." :group 'indent :type '(choice (const :tag "Always complete" nil) - (const :tag "Unless at the end of a line" eol) + (const :tag "Only complete at the end of a line" eol) (const :tag "Unless looking at a word" word) (const :tag "Unless at a word or parenthesis" word-or-paren) (const :tag "Unless at a word, parenthesis, or punctuation." diff --git a/lisp/info.el b/lisp/info.el index 0565663c38e..db95574bf72 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -161,59 +161,8 @@ A header-line does not scroll with the rest of the buffer." "Face used to highlight matches in an index entry." :version "24.4") -;; This is a defcustom largely so that we can get the benefit -;; of `custom-initialize-delay'. Perhaps it would work to make it a -;; `defvar' and explicitly give it a `standard-value' property, and -;; call `custom-initialize-delay' on it. -;; The value is initialized at startup time, when command-line calls -;; `custom-reevaluate-setting' on all the defcustoms in -;; `custom-delayed-init-variables'. This is somewhat sub-optimal, as ideally -;; this should be done when Info mode is first invoked. ;;;###autoload -(defcustom Info-default-directory-list - (let* ((config-dir - (file-name-as-directory - ;; Self-contained NS build with info/ in the app-bundle. - (or (and (featurep 'ns) - (let ((dir (expand-file-name "../info" data-directory))) - (if (file-directory-p dir) dir))) - configure-info-directory))) - (prefixes - ;; Directory trees in which to look for info subdirectories - (prune-directory-list '("/usr/local/" "/usr/" "/opt/"))) - (suffixes - ;; Subdirectories in each directory tree that may contain info - ;; directories. - '("share/" "")) - (standard-info-dirs - (apply #'nconc - (mapcar (lambda (pfx) - (let ((dirs - (mapcar (lambda (sfx) - (concat pfx sfx "info/")) - suffixes))) - (prune-directory-list dirs))) - prefixes))) - ;; If $(prefix)/share/info is not one of the standard info - ;; directories, they are probably installing an experimental - ;; version of Emacs, so make sure that experimental version's Info - ;; files override the ones in standard directories. - (dirs - (if (member config-dir standard-info-dirs) - ;; FIXME? What is the point of adding it again at the end - ;; when it is already present earlier in the list? - (nconc standard-info-dirs (list config-dir)) - (cons config-dir standard-info-dirs)))) - (if (not (eq system-type 'windows-nt)) - dirs - ;; Include the info directory near where Emacs executable was installed. - (let* ((instdir (file-name-directory invocation-directory)) - (dir1 (expand-file-name "../info/" instdir)) - (dir2 (expand-file-name "../../../info/" instdir))) - (cond ((file-exists-p dir1) (append dirs (list dir1))) - ((file-exists-p dir2) (append dirs (list dir2))) - (t dirs))))) - +(defcustom Info-default-directory-list nil "Default list of directories to search for Info documentation files. They are searched in the order they are given in the list. Therefore, the directory of Info files that come with Emacs @@ -224,15 +173,12 @@ first in this list. Once Info is started, the list of directories to search comes from the variable `Info-directory-list'. -This variable `Info-default-directory-list' is used as the default -for initializing `Info-directory-list' when Info is started, unless -the environment variable INFOPATH is set. - -Although this is a customizable variable, that is mainly for technical -reasons. Normally, you should either set INFOPATH or customize -`Info-additional-directory-list', rather than changing this variable." - :initialize #'custom-initialize-delay - :type '(repeat directory)) + +This variable is used as the default for initializing +`Info-directory-list' when Info is started, unless the +environment variable INFOPATH is set." + :type '(repeat directory) + :version "29.1") (defvar Info-directory-list nil "List of directories to search for Info documentation files. @@ -679,6 +625,51 @@ in `Info-file-supports-index-cookies-list'." (cdr (assoc file Info-file-supports-index-cookies-list))) +(defun Info--default-directory-list () + "Compute a directory list suitable for Info." + (let* ((config-dir + (file-name-as-directory + ;; Self-contained NS build with info/ in the app-bundle. + (or (and (featurep 'ns) + (let ((dir (expand-file-name "../info" data-directory))) + (if (file-directory-p dir) dir))) + configure-info-directory))) + (prefixes + ;; Directory trees in which to look for info subdirectories + (prune-directory-list '("/usr/local/" "/usr/" "/opt/"))) + (suffixes + ;; Subdirectories in each directory tree that may contain info + ;; directories. + '("share/" "")) + (standard-info-dirs + (apply #'nconc + (mapcar (lambda (pfx) + (let ((dirs + (mapcar (lambda (sfx) + (concat pfx sfx "info/")) + suffixes))) + (prune-directory-list dirs))) + prefixes))) + ;; If $(prefix)/share/info is not one of the standard info + ;; directories, they are probably installing an experimental + ;; version of Emacs, so make sure that experimental version's Info + ;; files override the ones in standard directories. + (dirs + (if (member config-dir standard-info-dirs) + ;; FIXME? What is the point of adding it again at the end + ;; when it is already present earlier in the list? + (nconc standard-info-dirs (list config-dir)) + (cons config-dir standard-info-dirs)))) + (if (not (eq system-type 'windows-nt)) + dirs + ;; Include the info directory near where Emacs executable was installed. + (let* ((instdir (file-name-directory invocation-directory)) + (dir1 (expand-file-name "../info/" instdir)) + (dir2 (expand-file-name "../../../info/" instdir))) + (cond ((file-exists-p dir1) (append dirs (list dir1))) + ((file-exists-p dir2) (append dirs (list dir2))) + (t dirs)))))) + (defun Info-default-dirs () (let ((source (expand-file-name "info/" source-directory)) (sibling (if installation-directory @@ -701,25 +692,11 @@ in `Info-file-supports-index-cookies-list'." sibling ;; Uninstalled, builddir == srcdir source)) - (if (or (member alternative Info-default-directory-list) - ;; On DOS/NT, we use movable executables always, - ;; and we must always find the Info dir at run time. - (if (memq system-type '(ms-dos windows-nt)) - nil - ;; Use invocation-directory for Info - ;; only if we used it for exec-directory also. - (not (string= exec-directory - (expand-file-name "lib-src/" - installation-directory)))) - (not (file-exists-p alternative))) - Info-default-directory-list - ;; `alternative' contains the Info files that came with this - ;; version, so we should look there first. `Info-insert-dir' - ;; currently expects to find `alternative' first on the list. - (cons alternative - ;; Don't drop the last part, it might contain non-Emacs stuff. - ;; (reverse (cdr (reverse - Info-default-directory-list)))) ;; ))) + ;; `alternative' contains the Info files that came with this + ;; version, so we should look there first. `Info-insert-dir' + ;; currently expects to find `alternative' first on the list. + (append (cons alternative Info-default-directory-list) + (Info--default-directory-list)))) (defun info-initialize () "Initialize `Info-directory-list', if that hasn't been done yet." diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 14d4c383b23..529cf97215e 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -412,8 +412,8 @@ If it is nil, the current key is shown. DOCSTRING is the documentation string of this package. The command `describe-input-method' shows this string while replacing the form -\\=\\<VAR> in the string by the value of VAR. That value should be a -string. For instance, the form \\=\\<quail-translation-docstring> is +\\=\\=\\=\\<VAR> in the string by the value of VAR. That value should be a +string. For instance, the form \\=\\=\\=\\<quail-translation-docstring> is replaced by a description about how to select a translation from a list of candidates. diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el index 8b1c3d69ae5..60ada03fa25 100644 --- a/lisp/language/ind-util.el +++ b/lisp/language/ind-util.el @@ -273,6 +273,29 @@ (;; Misc Symbols nil ?ஂ ?ஃ nil ?் nil nil) (;; Digits + nil nil nil nil nil nil nil nil nil nil) + (;; Inscript-extra (4) (#, $, ^, *, ]) + "்ர" "ர்" "த்ர" nil nil))) + +(defvar indian-tml-base-digits-table + '( + (;; VOWELS + (?அ nil) (?ஆ ?ா) (?இ ?ி) (?ஈ ?ீ) (?உ ?ு) (?ஊ ?ூ) + nil nil nil (?ஏ ?ே) (?எ ?ெ) (?ஐ ?ை) + nil (?ஓ ?ோ) (?ஒ ?ொ) (?ஔ ?ௌ) nil nil) + (;; CONSONANTS + ?க nil nil nil ?ங ;; GUTTRULS + ?ச nil ?ஜ nil ?ஞ ;; PALATALS + ?ட nil nil nil ?ண ;; CEREBRALS + ?த nil nil nil ?ந ?ன ;; DENTALS + ?ப nil nil nil ?ம ;; LABIALS + ?ய ?ர ?ற ?ல ?ள ?ழ ?வ ;; SEMIVOWELS + nil ?ஷ ?ஸ ?ஹ ;; SIBILANTS + nil nil nil nil nil nil nil nil ;; NUKTAS + "ஜ்ஞ" "க்ஷ") + (;; Misc Symbols + nil ?ஂ ?ஃ nil ?் nil nil) + (;; Digits ?௦ ?௧ ?௨ ?௩ ?௪ ?௫ ?௬ ?௭ ?௮ ?௯) (;; Inscript-extra (4) (#, $, ^, *, ]) "்ர" "ர்" "த்ர" nil nil))) @@ -557,6 +580,10 @@ (defvar indian-tml-itrans-v5-hash (indian-make-hash indian-tml-base-table indian-itrans-v5-table-for-tamil)) + +(defvar indian-tml-itrans-digits-v5-hash + (indian-make-hash indian-tml-base-digits-table + indian-itrans-v5-table-for-tamil)) ) (defmacro indian-translate-region (from to hashtable encode-p) diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 23204c0cd3e..6641aa6b2e7 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -171,7 +171,7 @@ clm) (with-temp-buffer (insert "\n") - (insert " +") + (insert "----+") (insert-char ?- 74) (insert "\n |") (setq clm 6) @@ -244,19 +244,27 @@ (insert "\n") (buffer-string)))) -(defvar quail-tamil-itrans-various-signs-and-digits-table +(defun quail-tamil-itrans-compute-signs-table (digitp) + "Compute the signs table for the tamil-itrans input method. +If DIGITP is non-nil, include the digits translation as well." (let ((various '((?ஃ . "H") ("ஸ்ரீ" . "srii") (?ௐ))) (digits "௦௧௨௩௪௫௬௭௮௯") (width 6) clm) (with-temp-buffer - (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n") + (insert "\n" (make-string 18 ?-) "+") + (when digitp (insert (make-string 60 ?-))) + (insert "\n") (insert (propertize "\t" 'display '(space :align-to 5)) "various" - (propertize "\t" 'display '(space :align-to 18)) "|" - (propertize "\t" 'display '(space :align-to 45)) "digits") - - (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n") - (setq clm 0 ) + (propertize "\t" 'display '(space :align-to 18)) "|") + (when digitp + (insert + (propertize "\t" 'display '(space :align-to 45)) "digits")) + (insert "\n" (make-string 18 ?-) "+") + (when digitp + (insert (make-string 60 ?-))) + (insert "\n") + (setq clm 0) (dotimes (i (length various)) (insert (propertize "\t" 'display (list 'space :align-to clm)) @@ -264,10 +272,11 @@ (setq clm (+ clm width))) (insert (propertize "\t" 'display '(space :align-to 18)) "|") (setq clm 20) - (dotimes (i 10) - (insert (propertize "\t" 'display (list 'space :align-to clm)) - (aref digits i)) - (setq clm (+ clm width))) + (when digitp + (dotimes (i 10) + (insert (propertize "\t" 'display (list 'space :align-to clm)) + (aref digits i)) + (setq clm (+ clm width)))) (insert "\n") (setq clm 0) (dotimes (i (length various)) @@ -276,13 +285,22 @@ (setq clm (+ clm width))) (insert (propertize "\t" 'display '(space :align-to 18)) "|") (setq clm 20) - (dotimes (i 10) - (insert (propertize "\t" 'display (list 'space :align-to clm)) - (format "%d" i)) - (setq clm (+ clm width))) - (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n") + (when digitp + (dotimes (i 10) + (insert (propertize "\t" 'display (list 'space :align-to clm)) + (format "%d" i)) + (setq clm (+ clm width)))) + (insert "\n" (make-string 18 ?-) "+") + (when digitp + (insert (make-string 60 ?-) "\n")) (buffer-string)))) +(defvar quail-tamil-itrans-various-signs-and-digits-table + (quail-tamil-itrans-compute-signs-table t)) + +(defvar quail-tamil-itrans-various-signs-table + (quail-tamil-itrans-compute-signs-table nil)) + (if nil (quail-define-package "tamil-itrans" "Tamil" "TmlIT" t "Tamil ITRANS")) (quail-define-indian-trans-package @@ -293,16 +311,39 @@ You can input characters using the following mapping tables. Example: To enter வணக்கம், type vaNakkam. ### Basic syllables (consonants + vowels) ### -\\<quail-tamil-itrans-syllable-table> +\\=\\<quail-tamil-itrans-syllable-table> + +### Miscellaneous (various signs) ### +\\=\\<quail-tamil-itrans-various-signs-table> + +### Others (numerics + symbols) ### + +Characters below have no ITRANS method associated with them. +Their descriptions are included for easy reference. +\\=\\<quail-tamil-itrans-numerics-and-symbols-table> + +Full key sequences are listed below:") + +(if nil + (quail-define-package "tamil-itrans-digits" "Tamil" "TmlITD" t "Tamil ITRANS with digits")) +(quail-define-indian-trans-package + indian-tml-itrans-digits-v5-hash "tamil-itrans-digits" "Tamil" "TmlITD" + "Tamil transliteration by ITRANS method with Tamil digits support. + +You can input characters using the following mapping tables. + Example: To enter வணக்கம், type vaNakkam. + +### Basic syllables (consonants + vowels) ### +\\=\\<quail-tamil-itrans-syllable-table> ### Miscellaneous (various signs + digits) ### -\\<quail-tamil-itrans-various-signs-and-digits-table> +\\=\\<quail-tamil-itrans-various-signs-and-digits-table> ### Others (numerics + symbols) ### Characters below have no ITRANS method associated with them. Their descriptions are included for easy reference. -\\<quail-tamil-itrans-numerics-and-symbols-table> +\\=\\<quail-tamil-itrans-numerics-and-symbols-table> Full key sequences are listed below:") @@ -479,6 +520,13 @@ Full key sequences are listed below:") "tamil-inscript" "Tamil" "TmlIS" "Tamil keyboard Inscript.") +(if nil + (quail-define-package "tamil-inscript-digits" "Tamil" "TmlISD" t "Tamil keyboard Inscript with digits.")) +(quail-define-inscript-package + indian-tml-base-digits-table inscript-tml-keytable + "tamil-inscript-digits" "Tamil" "TmlISD" + "Tamil keyboard Inscript with Tamil digits support.") + ;; Probhat Input Method (quail-define-package "bengali-probhat" "Bengali" "BngPB" t diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el new file mode 100644 index 00000000000..6f64ae73377 --- /dev/null +++ b/lisp/mail/ietf-drums-date.el @@ -0,0 +1,274 @@ +;;; ietf-drums-date.el --- parse time/date for ietf-drums.el -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers <rogers@rgrjr.com> +;; Keywords: mail, util + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; 'ietf-drums-parse-date-string' parses a time and/or date in a +;; string and returns a list of values, just like `decode-time', where +;; unspecified elements in the string are returned as nil (except +;; unspecified DST is returned as -1). `encode-time' may be applied +;; on these values to obtain an internal time value. + +;; Historically, `parse-time-string' was used for this purpose, but it +;; was gradually but imperfectly extended to handle other date +;; formats. 'ietf-drums-parse-date-string' is compatible in that it +;; uses the same return value format and parses the same email date +;; formats by default, but can be made stricter if desired. + +;;; Code: + +(require 'cl-lib) +(require 'parse-time) + +(define-error 'date-parse-error "Date/time parse error" 'error) + +(defconst ietf-drums-date--slot-names + '(second minute hour day month year weekday dst zone) + "Names of return value slots, for better error messages +See the decoded-time defstruct.") + +(defconst ietf-drums-date--slot-ranges + '((0 60) (0 59) (0 23) (1 31) (1 12) (1 9999)) + "Numeric slot ranges, for bounds checking. +Note that RFC5322 explicitly requires that seconds go up to 60, +to allow for leap seconds (see Mills, D., 'Network Time +Protocol', STD 12, RFC 1119, September 1989).") + +(defsubst ietf-drums-date--ignore-char-p (char) + ;; Ignore whitespace and commas. + (memq char '(?\s ?\t ?\r ?\n ?,))) + +(defun ietf-drums-date--tokenize-string (string &optional comment-eof) + "Turn STRING into tokens, separated only by whitespace and commas. +Multiple commas are ignored. Pure digit sequences are turned +into integers. If COMMENT-EOF is true, then a comment as +defined by RFC5322 (strictly, the CFWS production that also +accepts comments) is treated as an end-of-file, and no further +tokens are recognized, otherwise we strip out all comments and +treat them as whitespace (per RFC822)." + (let ((index 0) + (end (length string)) + (list ())) + (cl-flet ((skip-ignored () + ;; Skip ignored characters at index (the scan + ;; position). Skip RFC822 comments in matched parens, + ;; but do not complain about unterminated comments. + (let ((char nil) + (nest 0)) + (while (and (< index end) + (setq char (aref string index)) + (or (> nest 0) + (ietf-drums-date--ignore-char-p char) + (and (not comment-eof) (eql char ?\()))) + (cl-incf index) + ;; FWS bookkeeping. + (cond ((and (eq char ?\\) + (< (1+ index) end)) + ;; Move to the next char but don't check + ;; it to see if it might be a paren. + (cl-incf index)) + ((eq char ?\() (cl-incf nest)) + ((eq char ?\)) (cl-decf nest))))))) + (skip-ignored) ;; Skip leading whitespace. + (while (and (< index end) + (not (and comment-eof + (eq (aref string index) ?\()))) + (let* ((start index) + (char (aref string index)) + (all-digits (<= ?0 char ?9))) + ;; char is valid; look for more valid characters. + (when (and (eq char ?\\) + (< (1+ index) end)) + ;; Escaped character, which might be a "(". If so, we are + ;; correct to include it in the token, even though the + ;; caller is sure to barf. If not, we violate RFC2?822 by + ;; not removing the backslash, but no characters in valid + ;; RFC2?822 dates need escaping anyway, so it shouldn't + ;; matter that this is not done strictly correctly. -- + ;; rgr, 24-Dec-21. + (cl-incf index)) + (while (and (< (cl-incf index) end) + (setq char (aref string index)) + (not (or (ietf-drums-date--ignore-char-p char) + (eq char ?\()))) + (unless (<= ?0 char ?9) + (setq all-digits nil)) + (when (and (eq char ?\\) + (< (1+ index) end)) + ;; Escaped character, see above. + (cl-incf index))) + (push (if all-digits + (cl-parse-integer string :start start :end index) + (substring string start index)) + list) + (skip-ignored))) + (nreverse list)))) + +(defun ietf-drums-parse-date-string (time-string &optional error no-822) + "Parse an RFC5322 or RFC822 date, passed as TIME-STRING. +The optional ERROR parameter causes syntax errors to be flagged +by signalling an instance of the date-parse-error condition. The +optional NO-822 parameter disables the more lax RFC822 syntax, +which is permitted by default. + +The result is a list of (SEC MIN HOUR DAY MON YEAR DOW DST TZ), +which can be accessed as a decoded-time defstruct (q.v.), +e.g. `decoded-time-year' to extract the year, and turned into an +Emacs timestamp by `encode-time'. + +The strict syntax for RFC5322 is as follows: + + [ day-of-week \",\" ] day FWS month-name FWS year FWS time [CFWS] + +where the \"time\" production is: + + 2DIGIT \":\" 2DIGIT [ \":\" 2DIGIT ] FWS ( \"+\" / \"-\" ) 4DIGIT + +and FWS is \"folding white space,\" and CFWS is \"comments and/or +folding white space\", where comments are included in nesting +parentheses and are equivalent to white space. RFC822 also +accepts comments in random places (all of which is handled by +ietf-drums-date--tokenize-string) and two-digit years. For +two-digit years, 50 and up are interpreted as 1950 through 1999 +and 00 through 49 as 200 through 2049. + +We are somewhat more lax in what we accept (specifically, the +hours don't have to be two digits, and the TZ and the comma after +the DOW are optional), but we do insist that the items that are +present do appear in this order. Unspecified/unrecognized +elements in the string are returned as nil (except unspecified +DST is returned as -1)." + (let ((tokens (ietf-drums-date--tokenize-string (downcase time-string) + no-822)) + (time (list nil nil nil nil nil nil nil -1 nil))) + (cl-labels ((set-matched-slot (slot index token) + ;; Assign a slot value from match data if index is + ;; non-nil, else from token, signalling an error if + ;; enabled and it's out of range. + (let ((value (if index + (cl-parse-integer (match-string index token)) + token))) + (when error + (let ((range (nth slot ietf-drums-date--slot-ranges))) + (when (and range + (not (<= (car range) value (cadr range)))) + (signal 'date-parse-error + (list "Slot out of range" + (nth slot ietf-drums-date--slot-names) + token (car range) (cadr range)))))) + (setf (nth slot time) value))) + (set-numeric (slot token) + ;; Only assign the slot if the token is a number. + (cond ((natnump token) + (set-matched-slot slot nil token)) + (error + (signal 'date-parse-error + (list "Not a number" + (nth slot ietf-drums-date--slot-names) + token)))))) + ;; Check for weekday. + (let ((dow (assoc (car tokens) parse-time-weekdays))) + (when dow + ;; Day of the week. + (set-matched-slot 6 nil (cdr dow)) + (pop tokens))) + ;; Day. + (set-numeric 3 (pop tokens)) + ;; Alphabetic month. + (let* ((month (pop tokens)) + (match (assoc month parse-time-months))) + (cond (match + (set-matched-slot 4 nil (cdr match))) + (error + (signal 'date-parse-error + (list "Expected an alphabetic month" month))) + (t + (push month tokens)))) + ;; Year. + (let ((year (pop tokens))) + ;; Check the year for the right number of digits. + (cond ((not (natnump year)) + (when error + (signal 'date-parse-error + (list "Expected a year" year))) + (push year tokens)) + ((>= year 1000) + (set-numeric 5 year)) + ((or no-822 + (>= year 100)) + (when error + (signal 'date-parse-error + (list "Four-digit years are required" year))) + (push year tokens)) + ((>= year 50) + ;; second half of the 20th century. + (set-numeric 5 (+ 1900 year))) + (t + ;; first half of the 21st century. + (set-numeric 5 (+ 2000 year))))) + ;; Time. + (let ((time (pop tokens))) + (cond ((or (null time) (natnump time)) + (when error + (signal 'date-parse-error + (list "Expected a time" time))) + (push time tokens)) + ((string-match + "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$" + time) + (set-matched-slot 2 1 time) + (set-matched-slot 1 2 time) + (set-matched-slot 0 3 time)) + ((string-match "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\)$" time) + ;; Time without seconds. + (set-matched-slot 2 1 time) + (set-matched-slot 1 2 time) + (set-matched-slot 0 nil 0)) + (error + (signal 'date-parse-error + (list "Expected a time" time))))) + ;; Timezone. + (let* ((zone (pop tokens)) + (match (assoc zone parse-time-zoneinfo))) + (cond (match + (set-matched-slot 8 nil (cadr match)) + (set-matched-slot 7 nil (caddr match))) + ((and (stringp zone) + (string-match "^[-+][0-9][0-9][0-9][0-9]$" zone)) + ;; Numeric time zone. + (set-matched-slot + 8 nil + (* 60 + (+ (cl-parse-integer zone :start 3 :end 5) + (* 60 (cl-parse-integer zone :start 1 :end 3))) + (if (= (aref zone 0) ?-) -1 1)))) + ((and zone error) + (signal 'date-parse-error + (list "Expected a timezone" zone))))) + (when (and tokens error) + (signal 'date-parse-error + (list "Extra token(s)" (car tokens))))) + time)) + +(provide 'ietf-drums-date) + +;;; ietf-drums-date.el ends here diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 85aa27235fc..d1ad671b160 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -294,9 +294,13 @@ a list of address strings." (replace-match " " t t)) (goto-char (point-min))) +(declare-function ietf-drums-parse-date-string "ietf-drums-date" + (time-string &optional error? no-822?)) + (defun ietf-drums-parse-date (string) "Return an Emacs time spec from STRING." - (encode-time (parse-time-string string))) + (require 'ietf-drums-date) + (encode-time (ietf-drums-parse-date-string string))) (defun ietf-drums-narrow-to-header () "Narrow to the header section in the current buffer." diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index b3c45100f6d..bb0d646346c 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -46,7 +46,7 @@ ("Followup-To" . nil) ("Message-ID" . nil) ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\ -\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime) +\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\|Disposition-Notification-To\\)" . address-mime) (t . mime)) "Header/encoding method alist. The list is traversed sequentially. The keys can either be diff --git a/lisp/mouse.el b/lisp/mouse.el index 1e205283de2..93c89de91c2 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2974,6 +2974,11 @@ in addition, temporarily highlight the original region with the :type 'boolean :version "26.1") +(defcustom mouse-drag-and-drop-region-cross-program nil + "If non-nil, allow dragging text to other programs." + :type 'boolean + :version "29.1") + (defface mouse-drag-and-drop-region '((t :inherit region)) "Face to highlight original text during dragging. This face is used by `mouse-drag-and-drop-region' to temporarily @@ -2984,6 +2989,22 @@ highlight the original region when (declare-function rectangle-dimensions "rect" (start end)) (declare-function rectangle-position-as-coordinates "rect" (position)) (declare-function rectangle-intersect-p "rect" (pos1 size1 pos2 size2)) +(declare-function x-begin-drag "xfns.c") + +(defun mouse-drag-and-drop-region-display-tooltip (tooltip) + "Display TOOLTIP, a tooltip string, using `x-show-tip'. +Call `tooltip-show-help-non-mode' instead on non-graphical displays." + (if (display-graphic-p) + (x-show-tip tooltip) + (tooltip-show-help-non-mode tooltip))) + +(defun mouse-drag-and-drop-region-hide-tooltip () + "Hide any tooltip currently displayed. +Call `tooltip-show-help-non-mode' to clear the echo area message +instead on non-graphical displays." + (if (display-graphic-p) + (x-hide-tip) + (tooltip-show-help-non-mode nil))) (defun mouse-drag-and-drop-region (event) "Move text in the region to point where mouse is dragged to. @@ -3046,117 +3067,161 @@ is copied instead of being cut." states)))) (ignore-errors - (track-mouse - (setq track-mouse 'dropping) - ;; When event was "click" instead of "drag", skip loop. - (while (progn - (setq event (read-key)) ; read-event or read-key - (or (mouse-movement-p event) - ;; Handle `mouse-autoselect-window'. - (memq (car event) '(select-window switch-frame)))) - ;; Obtain the dragged text in region. When the loop was - ;; skipped, value-selection remains nil. - (unless value-selection - (setq value-selection (funcall region-extract-function nil)) - (when mouse-drag-and-drop-region-show-tooltip - (let ((text-size mouse-drag-and-drop-region-show-tooltip)) - (setq text-tooltip - (if (and (integerp text-size) - (> (length value-selection) text-size)) - (concat - (substring value-selection 0 (/ text-size 2)) - "\n...\n" - (substring value-selection (- (/ text-size 2)) -1)) - value-selection)))) - - ;; Check if selected text is read-only. - (setq text-from-read-only - (or text-from-read-only - (catch 'loop - (dolist (bound (region-bounds)) - (when (text-property-not-all - (car bound) (cdr bound) 'read-only nil) - (throw 'loop t))))))) - - (setq window-to-paste (posn-window (event-end event))) - (setq point-to-paste (posn-point (event-end event))) - ;; Set nil when target buffer is minibuffer. - (setq buffer-to-paste (let (buf) - (when (windowp window-to-paste) - (setq buf (window-buffer window-to-paste)) - (when (not (minibufferp buf)) - buf)))) - (setq cursor-in-text-area (and window-to-paste - point-to-paste - buffer-to-paste)) - - (when cursor-in-text-area - ;; Check if point under mouse is read-only. - (save-window-excursion - (select-window window-to-paste) - (setq point-to-paste-read-only - (or buffer-read-only - (get-text-property point-to-paste 'read-only)))) - - ;; Check if "drag but negligible". Operation "drag but - ;; negligible" is defined as drag-and-drop the text to - ;; the original region. When modifier is pressed, the - ;; text will be inserted to inside of the original - ;; region. - ;; - ;; If the region is rectangular, check if the newly inserted - ;; rectangular text would intersect the already selected - ;; region. If it would, then set "drag-but-negligible" to t. - ;; As a special case, allow dragging the region freely anywhere - ;; to the left, as this will never trigger its contents to be - ;; inserted into the overlays tracking it. - (setq drag-but-negligible - (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) - buffer-to-paste) - (if region-noncontiguous - (let ((dimensions (rectangle-dimensions start end)) - (start-coordinates - (rectangle-position-as-coordinates start)) - (point-to-paste-coordinates - (rectangle-position-as-coordinates - point-to-paste))) - (and (rectangle-intersect-p - start-coordinates dimensions - point-to-paste-coordinates dimensions) - (not (< (car point-to-paste-coordinates) - (car start-coordinates))))) - (and (<= (overlay-start - (car mouse-drag-and-drop-overlays)) - point-to-paste) - (<= point-to-paste - (overlay-end - (car mouse-drag-and-drop-overlays)))))))) - - ;; Show a tooltip. - (if mouse-drag-and-drop-region-show-tooltip - (tooltip-show text-tooltip) - (tooltip-hide)) - - ;; Show cursor and highlight the original region. - (when mouse-drag-and-drop-region-show-cursor - ;; Modify cursor even when point is out of frame. - (setq cursor-type (cond - ((not cursor-in-text-area) - nil) - ((or point-to-paste-read-only - drag-but-negligible) - 'hollow) - (t - 'bar))) - (when cursor-in-text-area - (dolist (overlay mouse-drag-and-drop-overlays) - (overlay-put overlay - 'face 'mouse-drag-and-drop-region)) - (deactivate-mark) ; Maintain region in other window. - (mouse-set-point event))))) + (catch 'cross-program-drag + (track-mouse + (setq track-mouse 'dropping) + ;; When event was "click" instead of "drag", skip loop. + (while (progn + (setq event (read-key)) ; read-event or read-key + (or (mouse-movement-p event) + ;; Handle `mouse-autoselect-window'. + (memq (car event) '(select-window switch-frame)))) + (catch 'drag-again + ;; Obtain the dragged text in region. When the loop was + ;; skipped, value-selection remains nil. + (unless value-selection + (setq value-selection (funcall region-extract-function nil)) + (when mouse-drag-and-drop-region-show-tooltip + (let ((text-size mouse-drag-and-drop-region-show-tooltip)) + (setq text-tooltip + (if (and (integerp text-size) + (> (length value-selection) text-size)) + (concat + (substring value-selection 0 (/ text-size 2)) + "\n...\n" + (substring value-selection (- (/ text-size 2)) -1)) + value-selection)))) + + ;; Check if selected text is read-only. + (setq text-from-read-only + (or text-from-read-only + (catch 'loop + (dolist (bound (region-bounds)) + (when (text-property-not-all + (car bound) (cdr bound) 'read-only nil) + (throw 'loop t))))))) + + (when (and mouse-drag-and-drop-region-cross-program + (display-graphic-p) + (fboundp 'x-begin-drag) + (framep (posn-window (event-end event))) + (let ((location (posn-x-y (event-end event))) + (frame (posn-window (event-end event)))) + (or (< (car location) 0) + (< (cdr location) 0) + (> (car location) + (frame-pixel-width frame)) + (> (cdr location) + (frame-pixel-height frame))))) + (mouse-drag-and-drop-region-hide-tooltip) + (gui-set-selection 'XdndSelection value-selection) + (let ((drag-action-or-frame + (x-begin-drag '("UTF8_STRING" "text/plain" + "text/plain;charset=utf-8" + "STRING" "TEXT" "COMPOUND_TEXT") + (if mouse-drag-and-drop-region-cut-when-buffers-differ + 'XdndActionMove + 'XdndActionCopy) + (posn-window (event-end event)) t))) + (when (framep drag-action-or-frame) + (throw 'drag-again nil)) + + (when (eq drag-action-or-frame 'XdndActionMove) + ;; Remove the dragged text from source buffer like + ;; operation `cut'. + (dolist (overlay mouse-drag-and-drop-overlays) + (delete-region (overlay-start overlay) + (overlay-end overlay)))) + + (when (eq drag-action-or-frame 'XdndActionCopy) + ;; Set back the dragged text as region on source buffer + ;; like operation `copy'. + (activate-mark))) + (throw 'cross-program-drag nil)) + + (setq window-to-paste (posn-window (event-end event))) + (setq point-to-paste (posn-point (event-end event))) + ;; Set nil when target buffer is minibuffer. + (setq buffer-to-paste (let (buf) + (when (windowp window-to-paste) + (setq buf (window-buffer window-to-paste)) + (when (not (minibufferp buf)) + buf)))) + (setq cursor-in-text-area (and window-to-paste + point-to-paste + buffer-to-paste)) + + (when cursor-in-text-area + ;; Check if point under mouse is read-only. + (save-window-excursion + (select-window window-to-paste) + (setq point-to-paste-read-only + (or buffer-read-only + (get-text-property point-to-paste 'read-only)))) + + ;; Check if "drag but negligible". Operation "drag but + ;; negligible" is defined as drag-and-drop the text to + ;; the original region. When modifier is pressed, the + ;; text will be inserted to inside of the original + ;; region. + ;; + ;; If the region is rectangular, check if the newly inserted + ;; rectangular text would intersect the already selected + ;; region. If it would, then set "drag-but-negligible" to t. + ;; As a special case, allow dragging the region freely anywhere + ;; to the left, as this will never trigger its contents to be + ;; inserted into the overlays tracking it. + (setq drag-but-negligible + (and (eq (overlay-buffer (car mouse-drag-and-drop-overlays)) + buffer-to-paste) + (if region-noncontiguous + (let ((dimensions (rectangle-dimensions start end)) + (start-coordinates + (rectangle-position-as-coordinates start)) + (point-to-paste-coordinates + (rectangle-position-as-coordinates + point-to-paste))) + (and (rectangle-intersect-p + start-coordinates dimensions + point-to-paste-coordinates dimensions) + (not (< (car point-to-paste-coordinates) + (car start-coordinates))))) + (and (<= (overlay-start + (car mouse-drag-and-drop-overlays)) + point-to-paste) + (<= point-to-paste + (overlay-end + (car mouse-drag-and-drop-overlays)))))))) + + ;; Show a tooltip. + (if mouse-drag-and-drop-region-show-tooltip + ;; Don't use tooltip-show since it has side effects + ;; which change the text properties, and + ;; `text-tooltip' can potentially be the text which + ;; will be pasted. + (mouse-drag-and-drop-region-display-tooltip text-tooltip) + (mouse-drag-and-drop-region-hide-tooltip)) + + ;; Show cursor and highlight the original region. + (when mouse-drag-and-drop-region-show-cursor + ;; Modify cursor even when point is out of frame. + (setq cursor-type (cond + ((not cursor-in-text-area) + nil) + ((or point-to-paste-read-only + drag-but-negligible) + 'hollow) + (t + 'bar))) + (when cursor-in-text-area + (dolist (overlay mouse-drag-and-drop-overlays) + (overlay-put overlay + 'face 'mouse-drag-and-drop-region)) + (deactivate-mark) ; Maintain region in other window. + (mouse-set-point event))))))) ;; Hide a tooltip. - (when mouse-drag-and-drop-region-show-tooltip (tooltip-hide)) + (when mouse-drag-and-drop-region-show-tooltip (x-hide-tip)) ;; Check if modifier was pressed on drop. (setq no-modifier-on-drop diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index ef8527fadae..9937c022d9f 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -2554,7 +2554,7 @@ can parse the output from a DIR listing for a host of type TYPE.") FILE is the full name of the remote file, LSARGS is any args to pass to the `ls' command, and PARSE specifies that the output should be parsed and stored away in the internal cache." - (when (string-match "--" lsargs) + (while (string-match "--" lsargs) (require 'ls-lisp) (setq lsargs (ls-lisp--sanitize-switches lsargs))) ;; If parse is t, we assume that file is a directory. i.e. we only parse diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index e4c485eccde..776f774172f 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -708,16 +708,29 @@ interactively. Turn the filename into a URL with function (browse-url (browse-url-file-url file)) (run-hooks 'browse-url-of-file-hook)) +(defun browse-url--file-name-coding-system () + (if (equal system-type 'windows-nt) + ;; W32 pretends that file names are UTF-8 encoded. + 'utf-8 + (or file-name-coding-system default-file-name-coding-system))) + (defun browse-url-file-url (file) "Return the URL corresponding to FILE. Use variable `browse-url-filename-alist' to map filenames to URLs." - (let ((coding (if (equal system-type 'windows-nt) - ;; W32 pretends that file names are UTF-8 encoded. - 'utf-8 - (and (or file-name-coding-system - default-file-name-coding-system))))) - (if coding (setq file (encode-coding-string file coding)))) - (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]")) + (when-let ((coding (browse-url--file-name-coding-system))) + (setq file (encode-coding-string file coding))) + (if (and (file-remote-p file) + ;; We're applying special rules for FTP URLs for historical + ;; reasons. + (seq-find (lambda (match) + (and (string-match-p (car match) file) + (not (string-match "\\`file:" (cdr match))))) + browse-url-filename-alist)) + (setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]")) + ;; Encode all other file names properly. + (setq file (mapconcat #'url-hexify-string + (file-name-split file) + "/"))) (dolist (map browse-url-filename-alist) (when (and map (string-match (car map) file)) (setq file (replace-match (cdr map) t nil file)))) @@ -769,7 +782,10 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead." (defun browse-url-of-dired-file () "In Dired, ask a WWW browser to display the file named on this line." (interactive) - (let ((tem (dired-get-filename t t))) + (let ((tem (dired-get-filename t t)) + ;; Some URL handlers open files in Emacs. We want to always + ;; open in a browser, so disable those. + (browse-url-default-handlers nil)) (if tem (browse-url-of-file (expand-file-name tem)) (error "No file on this line")))) @@ -954,7 +970,13 @@ non-nil, or the same display as Emacs if different from the current environment, otherwise just use the current environment." (let ((display (or browse-url-browser-display (browse-url-emacs-display)))) (if display - (cons (concat "DISPLAY=" display) process-environment) + (cons (concat (if (and (eq window-system 'pgtk) + (equal (pgtk-backend-display-class) + "GdkWaylandDisplay")) + "WAYLAND_DISPLAY=" + "DISPLAY=") + display) + process-environment) process-environment))) (defun browse-url-emacs-display () @@ -1213,10 +1235,12 @@ currently selected window instead." (require 'url-handlers) (let ((parsed (url-generic-parse-url url)) (func (if same-window 'find-file 'find-file-other-window))) - (if (and (equal (url-type parsed) "file") - (file-directory-p (url-filename parsed))) - ;; It's a directory; just open it. - (funcall func (url-filename parsed)) + (if (equal (url-type parsed) "file") + ;; It's a file; just open it. + (let ((file (url-unhex-string (url-filename parsed)))) + (when-let ((coding (browse-url--file-name-coding-system))) + (setq file (decode-coding-string file 'utf-8))) + (funcall func file)) (let ((file-name-handler-alist (cons (cons url-handler-regexp 'url-file-handler) file-name-handler-alist))) diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 3122b26cd81..997b9e30fd4 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -42,7 +42,7 @@ A port number may be specified by appending a colon and a number to the name of the server. Use `localhost' if the directory server resides on your computer (BBDB backend). -To specify multiple servers, customize eudc-server-hotlist +To specify multiple servers, customize `eudc-server-hotlist' instead." :type '(choice (string :tag "Server") (const :tag "None" nil))) @@ -179,10 +179,15 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and (symbol :menu-tag "Other" :tag "Attribute name")))) :version "25.1") -;; Default to nil so that the most common use of eudc-expand-inline, -;; where replace is nil, does not affect the kill ring. -(defcustom eudc-expansion-overwrites-query nil - "If non-nil, expanding a query overwrites the query string." +(define-obsolete-variable-alias + 'eudc-expansion-overwrites-query + 'eudc-expansion-save-query-as-kill + "29.1") + +;; Default to nil so that the most common use of `eudc-expand-inline', +;; where `save-query-as-kill' is nil, does not affect the kill ring. +(defcustom eudc-expansion-save-query-as-kill nil + "If non-nil, expansion saves the query string to the kill ring." :type 'boolean :version "25.1") diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 6831c4ffe3d..7bbf54ee6cd 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -298,8 +298,8 @@ accordingly. Otherwise it is set to its EUDC default binding." ;;}}} -;; Add PROTOCOL to the list of supported protocols (defun eudc-register-protocol (protocol) + "Add PROTOCOL to the list of supported protocols." (unless (memq protocol eudc-supported-protocols) (setq eudc-supported-protocols (cons protocol eudc-supported-protocols)) @@ -741,9 +741,18 @@ If none try N - 1 and so forth." (setq n (1- n))) formats)) +;;;###autoload +(defun eudc-expand-try-all (&optional try-all-servers) + "Wrap `eudc-expand-inline' with a prefix argument. +If TRY-ALL-SERVERS -- the prefix argument when called +interactively -- is non-nil, collect results from all servers. +If TRY-ALL-SERVERS is nil, do not try subsequent servers after +one server returns any match." + (interactive "P") + (eudc-expand-inline (not eudc-expansion-save-query-as-kill) try-all-servers)) ;;;###autoload -(defun eudc-expand-inline (&optional replace) +(defun eudc-expand-inline (&optional save-query-as-kill try-all-servers) "Query the directory server, and expand the query string before point. The query string consists of the buffer substring from the point back to the preceding comma, colon or beginning of line. @@ -751,10 +760,12 @@ The variable `eudc-inline-query-format' controls how to associate the individual inline query words with directory attribute names. After querying the server for the given string, the expansion specified by `eudc-inline-expansion-format' is inserted in the buffer at point. -If REPLACE is non-nil, then this expansion replaces the name in the buffer. -`eudc-expansion-overwrites-query' being non-nil inverts the meaning of REPLACE. +If SAVE-QUERY-AS-KILL is non-nil, then save the pre-expansion +text to the kill ring. `eudc-expansion-save-query-as-kill' being +non-nil inverts the meaning of SAVE-QUERY-AS-KILL. Multiple servers can be tried with the same query until one finds a match, -see `eudc-inline-expansion-servers'." +see `eudc-inline-expansion-servers'. If TRY-ALL-SERVERS is +non-nil, collect results from all servers." (interactive) (let* ((end (point)) (beg (save-excursion @@ -764,13 +775,13 @@ see `eudc-inline-expansion-servers'." (point))) (query-words (split-string (buffer-substring-no-properties beg end) "[ \t]+")) - (response-strings (eudc-query-with-words query-words))) + (response-strings (eudc-query-with-words query-words try-all-servers))) (if (null response-strings) (error "No match") (if (or - (and replace (not eudc-expansion-overwrites-query)) - (and (not replace) eudc-expansion-overwrites-query)) + (and save-query-as-kill (not eudc-expansion-save-query-as-kill)) + (and (not save-query-as-kill) eudc-expansion-save-query-as-kill)) (kill-ring-save beg end)) (cond ((or (= (length response-strings) 1) @@ -787,7 +798,7 @@ see `eudc-inline-expansion-servers'." (error "There is more than one match for the query")))))) ;;;###autoload -(defun eudc-query-with-words (query-words) +(defun eudc-query-with-words (query-words &optional try-all-servers) "Query the directory server, and return the matching responses. The variable `eudc-inline-query-format' controls how to associate the individual QUERY-WORDS with directory attribute names. @@ -795,7 +806,8 @@ After querying the server for the given string, the expansion specified by `eudc-inline-expansion-format' is applied to the matches before returning them.inserted in the buffer at point. Multiple servers can be tried with the same query until one finds a match, -see `eudc-inline-expansion-servers'." +see `eudc-inline-expansion-servers'. When TRY-ALL-SERVERS is non-nil, +keep collecting results from subsequent servers after the first match." (cond ((eq eudc-inline-expansion-servers 'current-server) (or eudc-server @@ -812,6 +824,7 @@ see `eudc-inline-expansion-servers'." (error "Wrong value for `eudc-inline-expansion-servers': %S" eudc-inline-expansion-servers))) (let* (query-formats + response-strings (eudc-former-server eudc-server) (eudc-former-protocol eudc-protocol) ;; Prepare the list of servers to query @@ -823,7 +836,7 @@ see `eudc-inline-expansion-servers'." (if eudc-server (cons (cons eudc-server eudc-protocol) (delete (cons eudc-server eudc-protocol) - (copy-sequence eudc-server-hotlist))) + (copy-sequence eudc-server-hotlist))) eudc-server-hotlist)) ((eq eudc-inline-expansion-servers 'current-server) (list (cons eudc-server eudc-protocol)))))) @@ -833,46 +846,49 @@ see `eudc-inline-expansion-servers'." (setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil)) (unwind-protect - (let ((response - (catch 'found - ;; Loop on the servers - (dolist (server servers) - (eudc-set-server (car server) (cdr server) t) - - ;; Determine which formats apply in the query-format list - (setq query-formats - (or - (eudc-extract-n-word-formats eudc-inline-query-format - (length query-words)) - (if (null eudc-protocol-has-default-query-attributes) - '(name)))) - - ;; Loop on query-formats - (while query-formats - (let ((response - (eudc-query - (eudc-format-query query-words (car query-formats)) - (eudc-translate-attribute-list - (cdr eudc-inline-expansion-format))))) - (if response - (throw 'found response))) - (setq query-formats (cdr query-formats)))) - ;; No more servers to try... no match found - nil)) - (response-strings '())) - - ;; Process response through eudc-inline-expansion-format - (dolist (r response) - (let ((response-string - (apply #'format - (car eudc-inline-expansion-format) - (mapcar (lambda (field) - (or (cdr (assq field r)) - "")) - (eudc-translate-attribute-list - (cdr eudc-inline-expansion-format)))))) - (if (> (length response-string) 0) - (push response-string response-strings)))) + (cl-flet + ((run-query + (query-formats) + (let ((response + (eudc-query + (eudc-format-query query-words (car query-formats)) + (eudc-translate-attribute-list + (cdr eudc-inline-expansion-format))))) + (when response + ;; Process response through eudc-inline-expansion-format. + (dolist (r response) + (let ((response-string + (apply #'format + (car eudc-inline-expansion-format) + (mapcar + (lambda (field) + (or (cdr (assq field r)) + "")) + (eudc-translate-attribute-list + (cdr eudc-inline-expansion-format)))))) + (if (> (length response-string) 0) + (push response-string response-strings)))) + (when (not try-all-servers) + (throw 'found nil)))))) + (catch 'found + ;; Loop on the servers. + (dolist (server servers) + (eudc-set-server (car server) (cdr server) t) + + ;; Determine which formats apply in the query-format list. + (setq query-formats + (or + (eudc-extract-n-word-formats eudc-inline-query-format + (length query-words)) + (if (null eudc-protocol-has-default-query-attributes) + '(name)))) + + ;; Loop on query-formats. + (while query-formats + (run-query query-formats) + (setq query-formats (cdr query-formats)))) + ;; No more servers to try... no match found. + nil) response-strings) (or (and (equal eudc-server eudc-former-server) (equal eudc-protocol eudc-former-protocol)) @@ -1052,6 +1068,8 @@ queries the server for the existing fields and displays a corresponding form." `(["---" nil nil] ["Query with Form" eudc-query-form :help "Display a form to query the directory server"] + ["Expand Inline Query Trying All Servers" eudc-expand-try-all + :help "Query all directory servers and expand the query string before point"] ["Expand Inline Query" eudc-expand-inline :help "Query the directory server, and expand the query string before point"] ["Insert Record into BBDB" eudc-insert-record-at-point-into-bbdb @@ -1086,6 +1104,7 @@ queries the server for the existing fields and displays a corresponding form." :help "Set the directory server to SERVER using PROTOCOL"])) (defun eudc-menu () + "Return easy menu for EUDC." (let (command) (append '("Directory Servers") (list @@ -1117,6 +1136,7 @@ queries the server for the existing fields and displays a corresponding form." eudc-tail-menu))) (defun eudc-install-menu () + "Install EUDC menu." (define-key global-map [menu-bar tools directory-search] diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index a61179958ca..ce90943d9a6 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -179,6 +179,7 @@ It is used for TCP/IP devices." (start-file-process . tramp-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index c6523003b8c..788e4573679 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -287,6 +287,7 @@ It must be supported by libarchive(3).") (start-file-process . tramp-archive-handle-not-implemented) ;; `substitute-in-file-name' performed by default handler. (temporary-file-directory . tramp-archive-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index db7e7d67c4d..bd6d53afcb8 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -37,6 +37,7 @@ (require 'subr-x) (declare-function tramp-error "tramp") +(declare-function tramp-file-name-handler "tramp") (declare-function tramp-tramp-file-p "tramp") (defvar tramp-temp-name-prefix) @@ -133,8 +134,8 @@ NAME is unquoted." #'exec-path (lambda () "List of directories to search programs to run in remote subprocesses." - (if-let ((handler (find-file-name-handler default-directory 'exec-path))) - (funcall handler 'exec-path) + (if (tramp-tramp-file-p default-directory) + (tramp-file-name-handler 'exec-path) exec-path)))) ;; `time-equal-p' has appeared in Emacs 27.1. diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 47c707451ed..fb3ba08bb14 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -229,6 +229,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (start-file-process . ignore) ;; `substitute-in-file-name' performed by default handler. (temporary-file-directory . tramp-handle-temporary-file-directory) + ;; `tramp-get-home-directory' performed by default-handler. ;; `tramp-get-remote-gid' performed by default handler. ;; `tramp-get-remote-uid' performed by default handler. (tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 23290de685e..d6120d2bee1 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -816,6 +816,7 @@ It has been changed in GVFS 1.14.") (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-gvfs-handle-get-home-directory) (tramp-get-remote-gid . tramp-gvfs-handle-get-remote-gid) (tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid) @@ -1139,18 +1140,14 @@ file names." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. - (when (string-match "\\`\\(~\\)\\(/\\|\\'\\)" localname) - (save-match-data - (tramp-gvfs-maybe-open-connection - (make-tramp-file-name - :method method :user user :domain domain - :host host :port port :localname "/" :hop hop))) - (unless (string-empty-p - (tramp-get-connection-property v "default-location" "")) - (setq localname - (replace-match - (tramp-get-connection-property v "default-location" "~") - nil t localname 1)))) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) @@ -1601,6 +1598,27 @@ If FILE-SYSTEM is non-nil, return file system attributes." nil time))))) +(defun tramp-gvfs-handle-get-home-directory (vec &optional _user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (let ((localname + (tramp-get-connection-property vec "default-location" nil)) + result) + (cond + ((zerop (length localname)) + (tramp-get-connection-property (tramp-get-process vec) "share" nil)) + ;; Google-drive. + ((not (string-prefix-p "/" localname)) + (dolist (item + (tramp-gvfs-get-directory-attributes + (tramp-make-tramp-file-name vec "/")) + result) + (when (string-equal (cdr (assoc "name" item)) localname) + (setq result (concat "/" (car item)))))) + (t localname)))) + (defun tramp-gvfs-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 03a2c2457a2..3b2e7c0f916 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -271,7 +271,7 @@ NAME must be equal to `tramp-current-connection'." #'tramp-compile-disable-ssh-controlmaster-options) (add-hook 'tramp-integration-unload-hook (lambda () - (remove-hook 'compilation-start-hook + (remove-hook 'compilation-mode-hook #'tramp-compile-disable-ssh-controlmaster-options)))) ;;; Default connection-local variables for Tramp. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 32ec19bf232..126b09fcbf3 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -143,6 +143,7 @@ (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3c284635153..475d48cc30b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1025,6 +1025,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (start-file-process . tramp-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-sh-handle-get-home-directory) (tramp-get-remote-gid . tramp-sh-handle-get-remote-gid) (tramp-get-remote-uid . tramp-sh-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid) @@ -1449,6 +1450,20 @@ of." (if (eq flag 'nofollow) "-h" "") (tramp-shell-quote-argument localname))))))) +(defun tramp-sh-handle-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (when (tramp-send-command-and-check + vec (format + "echo %s" + (tramp-shell-quote-argument + (concat "~" (or user (tramp-file-name-user vec)))))) + (with-current-buffer (tramp-get-buffer vec) + (goto-char (point-min)) + (buffer-substring (point) (point-at-eol))))) + (defun tramp-sh-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." @@ -2741,27 +2756,21 @@ the result will be a local, non-Tramp, file name." ;; groks tilde expansion! The function `tramp-find-shell' is ;; supposed to find such a shell on the remote host. Please ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) + (fname (match-string 2 localname)) + hname) ;; We cannot simply apply "~/", because under sudo "~/" is ;; expanded to the local user home directory but to the ;; root home directory. On the other hand, using always ;; the default user name for tilde expansion is not ;; appropriate either, because ssh and companions might ;; use a user name from the config file. - (when (and (string-equal uname "~") + (when (and (zerop (length uname)) (string-match-p "\\`su\\(do\\)?\\'" method)) - (setq uname (concat uname user))) - (setq uname - (with-tramp-connection-property v uname - (tramp-send-command - v - (format "cd %s && pwd" (tramp-shell-quote-argument uname))) - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-min)) - (buffer-substring (point) (point-at-eol))))) - (setq localname (concat uname fname)))) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; There might be a double slash, for example when "~/" ;; expands to "/". Remove this. (while (string-match "//" localname) @@ -2769,15 +2778,17 @@ the result will be a local, non-Tramp, file name." ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. ;; `default-directory' is bound, because on Windows there ;; would be problems with UNC shares or Cygwin mounts. (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name - v (tramp-drop-volume-letter - (tramp-run-real-handler - #'expand-file-name (list localname))))))))) + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname + (tramp-drop-volume-letter + (tramp-run-real-handler + #'expand-file-name (list localname)))))))))) ;;; Remote commands: @@ -4123,13 +4134,10 @@ file exists and nonzero exit status otherwise." ;; The algorithm is as follows: we try a list of several commands. ;; For each command, we first run `$cmd /' -- this should return ;; true, as the root directory always exists. And then we run - ;; `$cmd /this\ file\ does\ not\ exist ', hoping that the file indeed - ;; does not exist. This should return false. We use the first - ;; command we find that seems to work. + ;; `$cmd /\ this\ file\ does\ not\ exist\ ', hoping that the file + ;; indeed does not exist. This should return false. We use the + ;; first command we find that seems to work. ;; The list of commands to try is as follows: - ;; `ls -d' This works on most systems, but NetBSD 1.4 - ;; has a bug: `ls' always returns zero exit - ;; status, even for files which don't exist. ;; `test -e' Some Bourne shells have a `test' builtin ;; which does not know the `-e' option. ;; `/bin/test -e' For those, the `test' binary on disk normally @@ -4137,6 +4145,10 @@ file exists and nonzero exit status otherwise." ;; is sometimes `/bin/test' and sometimes it's ;; `/usr/bin/test'. ;; `/usr/bin/test -e' In case `/bin/test' does not exist. + ;; `ls -d' This works on most systems, but NetBSD 1.4 + ;; has a bug: `ls' always returns zero exit + ;; status, even for files which don't exist. + (unless (or (ignore-errors (and (setq result (format "%s -e" (tramp-get-test-command vec))) @@ -4783,36 +4795,33 @@ Goes through the list `tramp-inline-compress-commands'." (t (setq tramp-ssh-controlmaster-options "") (let ((case-fold-search t)) (ignore-errors - (when (executable-find "ssh") - (with-tramp-progress-reporter - vec 4 "Computing ControlMaster options" - (with-temp-buffer - (tramp-call-process vec "ssh" nil t nil "-o" "ControlMaster") - (goto-char (point-min)) - (when (search-forward-regexp "missing.+argument" nil t) - (setq tramp-ssh-controlmaster-options - "-o ControlMaster=auto"))) - (unless (zerop (length tramp-ssh-controlmaster-options)) - (with-temp-buffer - ;; We use a non-existing IP address, in order to - ;; avoid useless connections, and DNS timeouts. - ;; Setting ConnectTimeout is needed since OpenSSH 7. - (tramp-call-process - vec "ssh" nil t nil - "-o" "ConnectTimeout=1" "-o" "ControlPath=%C" "0.0.0.1") - (goto-char (point-min)) + (with-tramp-progress-reporter + vec 4 "Computing ControlMaster options" + ;; We use a non-existing IP address, in order to avoid + ;; useless connections, and DNS timeouts. + (when (zerop + (tramp-call-process + vec "ssh" nil nil nil + "-G" "-o" "ControlMaster=auto" "0.0.0.1")) + (setq tramp-ssh-controlmaster-options + "-o ControlMaster=auto") + (if (zerop + (tramp-call-process + vec "ssh" nil nil nil + "-G" "-o" "ControlPath='tramp.%C'" "0.0.0.1")) (setq tramp-ssh-controlmaster-options (concat tramp-ssh-controlmaster-options - (if (search-forward-regexp "unknown.+key" nil t) - " -o ControlPath='tramp.%%r@%%h:%%p'" - " -o ControlPath='tramp.%%C'")))) - (with-temp-buffer - (tramp-call-process vec "ssh" nil t nil "-o" "ControlPersist") - (goto-char (point-min)) - (when (search-forward-regexp "missing.+argument" nil t) - (setq tramp-ssh-controlmaster-options - (concat tramp-ssh-controlmaster-options - " -o ControlPersist=no"))))))))) + " -o ControlPath='tramp.%%C'")) + (setq tramp-ssh-controlmaster-options + (concat tramp-ssh-controlmaster-options + " -o ControlPath='tramp.%%r@%%h:%%p'"))) + (when (zerop + (tramp-call-process + vec "ssh" nil nil nil + "-G" "-o" "ControlPersist=no" "0.0.0.1")) + (setq tramp-ssh-controlmaster-options + (concat tramp-ssh-controlmaster-options + " -o ControlPersist=no"))))))) tramp-ssh-controlmaster-options))) (defun tramp-scp-strict-file-name-checking (vec) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f52fa0a93be..67c63e6ce7a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -294,6 +294,7 @@ See `tramp-actions-before-shell' for more info.") (start-file-process . tramp-smb-handle-start-file-process) (substitute-in-file-name . tramp-smb-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-smb-handle-get-home-directory) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) @@ -745,25 +746,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-run-real-handler #'expand-file-name (list name nil)) ;; Dissect NAME. (with-parsed-tramp-file-name name nil - ;; Tilde expansion if necessary. We use the user name as share, - ;; which is often the case in domains. - (when (string-match "\\`/?~\\([^/]*\\)" localname) - (setq localname - (replace-match - (if (zerop (length (match-string 1 localname))) - user - (match-string 1 localname)) - nil nil localname))) - ;; Make the file name absolute. + ;; Tilde expansion if necessary. + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) + ;; Tilde expansion is not possible. + (when (and (not tramp-tolerate-tilde) + (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; No tilde characters in file name, do normal - ;; `expand-file-name' (this does "/./" and "/../"). + ;; Do normal `expand-file-name' (this does "/./" and "/../"), + ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (tramp-run-real-handler #'expand-file-name (list localname)))))) + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname + (tramp-run-real-handler #'expand-file-name (list localname))))))) (defun tramp-smb-action-get-acl (proc vec) "Read ACL data from connection buffer." @@ -1589,6 +1595,15 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (tramp-run-real-handler #'substitute-in-file-name (list filename)) (error filename)))) +(defun tramp-smb-handle-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (let ((user (or user (tramp-file-name-user vec)))) + (unless (zerop (length user)) + (concat "/" user)))) + (defun tramp-smb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index d30c19436d5..9dcb6259fb1 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -51,10 +51,12 @@ (add-to-list 'tramp-methods `(,tramp-sshfs-method (tramp-mount-args (("-C") ("-p" "%p") + ("-o" "dir_cache=no") + ("-o" "transform_symlinks") ("-o" "idmap=user,reconnect"))) ;; These are for remote processes. (tramp-login-program "ssh") - (tramp-login-args (("-q")("-l" "%u") ("-p" "%p") + (tramp-login-args (("-q") ("-l" "%u") ("-p" "%p") ("-e" "none") ("-t" "-t") ("%h") ("%l"))) (tramp-direct-async t) @@ -119,7 +121,7 @@ (file-symlink-p . tramp-handle-file-symlink-p) (file-system-info . tramp-sshfs-handle-file-system-info) (file-truename . tramp-handle-file-truename) - (file-writable-p . tramp-handle-file-writable-p) + (file-writable-p . tramp-sshfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) @@ -144,6 +146,7 @@ (start-file-process . tramp-handle-start-file-process) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . ignore) (tramp-get-remote-gid . ignore) (tramp-get-remote-uid . ignore) (tramp-set-file-uid-gid . ignore) @@ -220,6 +223,10 @@ arguments to pass to the OPERATION." ;;`file-system-info' exists since Emacs 27.1. (tramp-compat-funcall 'file-system-info (tramp-fuse-local-file-name filename))) +(defun tramp-sshfs-handle-file-writable-p (filename) + "Like `file-writable-p' for Tramp files." + (file-writable-p (tramp-fuse-local-file-name filename))) + (defun tramp-sshfs-handle-insert-file-contents (filename &optional visit beg end replace) "Like `insert-file-contents' for Tramp files." diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index a35f9391a1d..242a6c7f587 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -137,6 +137,7 @@ See `tramp-actions-before-shell' for more info.") (start-file-process . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (temporary-file-directory . tramp-handle-temporary-file-directory) + (tramp-get-home-directory . tramp-sudoedit-handle-get-home-directory) (tramp-get-remote-gid . tramp-sudoedit-handle-get-remote-gid) (tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid) (tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid) @@ -369,17 +370,23 @@ the result will be a local, non-Tramp, file name." (setq localname "~")) (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) - (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) (let ((uname (match-string 1 localname)) - (fname (match-string 2 localname))) - (when (string-equal uname "~") - (setq uname (concat uname user))) - (setq localname (concat uname fname)))) - ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) - (setq localname "/")) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) + ;; Do not keep "/..". + (when (string-match-p "^/\\.\\.?$" localname) + (setq localname "/")) ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../"). - (tramp-make-tramp-file-name v (expand-file-name localname)))) + (tramp-make-tramp-file-name + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname + (tramp-run-real-handler + #'expand-file-name (list localname)))))) (defun tramp-sudoedit-remote-acl-p (vec) "Check, whether ACL is enabled on the remote host." @@ -699,6 +706,13 @@ component is used as the target of the symlink." (tramp-flush-file-property v localname "file-selinux-context")) t))))) +(defun tramp-sudoedit-handle-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (expand-file-name (concat "~" (or user (tramp-file-name-user vec))))) + (defun tramp-sudoedit-handle-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 932dfb36910..38bdfab1929 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -185,7 +185,7 @@ See the variable `tramp-encoding-shell' for more information." ;; Since Emacs 26.1, `system-name' can return nil at build time if ;; Emacs is compiled with "--no-build-details". We do expect it to be -;; a string. (Bug#44481) +;; a string. (Bug#44481, Bug#54294) (defconst tramp-system-name (or (system-name) "") "The system name Tramp is running locally.") @@ -1421,7 +1421,10 @@ calling HANDLER.") ;; internal data structure. Convenience functions for internal ;; data structure. -;; The basic structure for remote file names. +;; The basic structure for remote file names. We must autoload it in +;; tramp-loaddefs.el, because some functions, which need it, wouldn't +;; work otherwise when unloading / reloading Tramp. (Bug#50869) +;;;###tramp-autoload (cl-defstruct (tramp-file-name (:type list) :named) method user domain host port localname hop) @@ -2603,7 +2606,9 @@ Must be handled by the callers." (when (processp (nth 0 args)) (tramp-get-default-directory (process-buffer (nth 0 args))))) ;; VEC. - ((member operation '(tramp-get-remote-gid tramp-get-remote-uid)) + ((member operation + '(tramp-get-home-directory + tramp-get-remote-gid tramp-get-remote-uid)) (tramp-make-tramp-file-name (nth 0 args))) ;; Unknown file primitive. (t (error "Unknown file I/O primitive: %s" operation)))) @@ -3360,15 +3365,16 @@ Let-bind it when necessary.") (tramp-tolerate-tilde t) (home-dir (if (let ((non-essential t)) (tramp-connectable-p vec)) - ;; If a connection has already been established, make - ;; sure the "home-directory" connection property is - ;; properly set. - (with-tramp-connection-property vec "home-directory" - (tramp-compat-funcall - 'directory-abbrev-apply - (expand-file-name (tramp-make-tramp-file-name vec "~")))) + ;; If a connection has already been established, get the + ;; home directory. + (tramp-get-home-directory vec) ;; Otherwise, just use the cached value. - (tramp-get-connection-property vec "home-directory" nil)))) + (tramp-get-connection-property vec "~" nil)))) + (when home-dir + (setq home-dir + (tramp-compat-funcall + 'directory-abbrev-apply + (tramp-make-tramp-file-name vec home-dir)))) ;; If any elt of `directory-abbrev-alist' matches this name, ;; abbreviate accordingly. (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename)) @@ -3498,6 +3504,17 @@ Let-bind it when necessary.") (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) + ;; Expand tilde. Usually, the methods applying this handler do + ;; not support tilde expansion. But users could declare a + ;; respective connection property. (Bug#53847) + (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (let ((uname (match-string 1 localname)) + (fname (match-string 2 localname)) + hname) + (when (zerop (length uname)) + (setq uname user)) + (when (setq hname (tramp-get-home-directory v uname)) + (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) @@ -4018,7 +4035,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (match (string-match tramp-lock-file-info-regexp info))) (or ; Locked by me. (and (string-equal (match-string 1 info) (user-login-name)) - (string-equal (match-string 2 info) (system-name)) + (string-equal (match-string 2 info) tramp-system-name) (string-equal (match-string 3 info) (tramp-get-lock-pid file))) ; User name. (match-string 1 info)))) @@ -4049,7 +4066,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; USER@HOST.PID[:BOOT_TIME] (info (format - "%s@%s.%s" (user-login-name) (system-name) + "%s@%s.%s" (user-login-name) tramp-system-name (tramp-get-lock-pid file)))) ;; Protect against security hole. @@ -5366,8 +5383,8 @@ If FILENAME is remote, a file name handler is called." (when (and modes (not (zerop (logand modes #o2000)))) (setq gid (file-attribute-group-id (file-attributes dir))))) - (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid))) - (funcall handler #'tramp-set-file-uid-gid filename uid gid) + (if (tramp-tramp-file-p filename) + (tramp-file-name-handler #'tramp-set-file-uid-gid filename uid gid) ;; On W32 systems, "chown" does not work. (unless (memq system-type '(ms-dos windows-nt)) (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) @@ -5468,15 +5485,19 @@ be granted." (equal remote-gid (file-attribute-group-id file-attr)) (equal unknown-id (file-attribute-group-id file-attr)))))))))))) +(defun tramp-get-home-directory (vec &optional user) + "The remote home directory for connection VEC as local file name. +If USER is a string, return its home directory instead of the +user identified by VEC. If there is no user specified in either +VEC or USER, or if there is no home directory, return nil." + (with-tramp-connection-property vec (concat "~" user) + (tramp-file-name-handler #'tramp-get-home-directory vec user))) + (defun tramp-get-remote-uid (vec id-format) "The uid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "uid-%s" id-format) - (or (when-let - ((handler - (find-file-name-handler - (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid))) - (funcall handler #'tramp-get-remote-uid vec id-format)) + (or (tramp-file-name-handler #'tramp-get-remote-uid vec id-format) ;; Ensure there is a valid result. (and (equal id-format 'integer) tramp-unknown-id-integer) (and (equal id-format 'string) tramp-unknown-id-string)))) @@ -5485,11 +5506,7 @@ ID-FORMAT valid values are `string' and `integer'." "The gid of the remote connection VEC, in ID-FORMAT. ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "gid-%s" id-format) - (or (when-let - ((handler - (find-file-name-handler - (tramp-make-tramp-file-name vec) 'tramp-get-remote-gid))) - (funcall handler #'tramp-get-remote-gid vec id-format)) + (or (tramp-file-name-handler #'tramp-get-remote-gid vec id-format) ;; Ensure there is a valid result. (and (equal id-format 'integer) tramp-unknown-id-integer) (and (equal id-format 'string) tramp-unknown-id-string)))) @@ -5755,8 +5772,8 @@ Consults the auth-source package." ;; adapt `default-directory'. (Bug#39389, Bug#39489) (default-directory tramp-compat-temporary-file-directory) (case-fold-search t) - ;; In tramp-sh.el, we must use "password-vector" due to - ;; multi-hop. + ;; In tramp-sh.el, we must use "password-vector" due to + ;; multi-hop. (vec (tramp-get-connection-property proc "password-vector" (process-get proc 'vector))) (key (tramp-make-tramp-file-name vec 'noloc)) @@ -5941,8 +5958,8 @@ name of a process or buffer, or nil to default to the current buffer." (defun tramp-get-remote-null-device (vec) "Return null device on the remote host identified by VEC. -If VEC is nil or `tramp-null-hop', return local null device." - (if (or (null vec) (equal vec tramp-null-hop)) +If VEC is `tramp-null-hop', return local null device." + (if (equal vec tramp-null-hop) null-device (with-tramp-connection-property vec "null-device" (let ((default-directory (tramp-make-tramp-file-name vec))) diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el index d82406affb2..81b7e4471fd 100644 --- a/lisp/org/oc-basic.el +++ b/lisp/org/oc-basic.el @@ -178,21 +178,29 @@ Return a hash table with citation references as keys and fields alist as values. " and "))) ('issued ;; Date are expressed as an array - ;; (`date-parts') or a "string (`raw'). - ;; In both cases, extract the year and - ;; associate it to `year' field, for - ;; compatibility with BibTeX format. + ;; (`date-parts') or a "string (`raw' + ;; or `literal'). In both cases, + ;; extract the year and associate it + ;; to `year' field, for compatibility + ;; with BibTeX format. (let ((date (or (alist-get 'date-parts value) + (alist-get 'literal value) (alist-get 'raw value)))) (cons 'year (cond ((consp date) (caar date)) ((stringp date) - (car (split-string date "-"))) + (replace-regexp-in-string + (rx + (minimal-match (zero-or-more anything)) + (group-n 1 (repeat 4 digit)) + (zero-or-more anything)) + (rx (backref 1)) + date)) (t (error "Unknown CSL-JSON date format: %S" - date)))))) + value)))))) (_ (cons field value)))) item) diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 2951c3def1e..905e491f4ad 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -183,7 +183,7 @@ link. (defcustom org-link-descriptive t "Non-nil means Org displays descriptive links. -E.g. [[https://orgmode.org][Org website]] is be displayed as +E.g. [[https://orgmode.org][Org website]] is displayed as \"Org Website\", hiding the link itself and just displaying its description. When set to nil, Org displays the full links literally. diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 79527866076..9db1406b3fb 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -396,31 +396,25 @@ still has an entry since one of its properties (`:title') does.") "Alist between element types and locations of secondary values.") (defconst org-element--pair-round-table - (let ((table (make-syntax-table))) + (let ((table (make-char-table 'syntax-table '(2)))) (modify-syntax-entry ?\( "()" table) (modify-syntax-entry ?\) ")(" table) - (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table) - (modify-syntax-entry char " " table))) - "Table used internally to pair only round brackets. -Other brackets are treated as spaces.") + table) + "Table used internally to pair only round brackets.") (defconst org-element--pair-square-table - (let ((table (make-syntax-table))) + (let ((table (make-char-table 'syntax-table '(2)))) (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\] ")[" table) - (dolist (char '(?\{ ?\} ?\( ?\) ?\< ?\>) table) - (modify-syntax-entry char " " table))) - "Table used internally to pair only square brackets. -Other brackets are treated as spaces.") + table) + "Table used internally to pair only square brackets.") (defconst org-element--pair-curly-table - (let ((table (make-syntax-table))) + (let ((table (make-char-table 'syntax-table '(2)))) (modify-syntax-entry ?\{ "(}" table) (modify-syntax-entry ?\} "){" table) - (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table) - (modify-syntax-entry char " " table))) - "Table used internally to pair only curly brackets. -Other brackets are treated as spaces.") + table) + "Table used internally to pair only curly brackets.") (defun org-element--parse-paired-brackets (char) "Parse paired brackets at point. diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 6a2aa8ca5ba..a38b79304ef 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made." (defun org-git-version () "The Git version of Org mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.5.2-17-gea6b74")) + (let ((org-git-version "release_9.5.2-24-g668205")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index f5d4df3d9c6..67c8f1cedf7 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -17522,11 +17522,11 @@ this numeric value." (interactive "r") (let ((result "")) (while (/= beg end) - (when (get-char-property beg 'invisible) - (setq beg (next-single-char-property-change beg 'invisible nil end))) - (let ((next (next-single-char-property-change beg 'invisible nil end))) - (setq result (concat result (buffer-substring beg next))) - (setq beg next))) + (if (invisible-p beg) + (setq beg (next-single-char-property-change beg 'invisible nil end)) + (let ((next (next-single-char-property-change beg 'invisible nil end))) + (setq result (concat result (buffer-substring beg next))) + (setq beg next)))) (setq deactivate-mark t) (kill-new result) (message "Visible strings have been copied to the kill ring."))) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 463e106c7ac..bfe48ef1f90 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -129,6 +129,9 @@ is always with pixel resolution.") (define-key map [vertical-scroll-bar wheel-down] 'pixel-scroll-precision) (define-key map [vertical-scroll-bar wheel-up] 'pixel-scroll-precision) (define-key map [vertical-scroll-bar touch-end] 'pixel-scroll-start-momentum) + (define-key map [tool-bar wheel-down] 'pixel-scroll-precision) + (define-key map [tool-bar wheel-up] 'pixel-scroll-precision) + (define-key map [tool-bar touch-end] 'pixel-scroll-start-momentum) (define-key map [left-margin wheel-down] 'pixel-scroll-precision) (define-key map [left-margin wheel-up] 'pixel-scroll-precision) (define-key map [left-margin touch-end] 'pixel-scroll-start-momentum) @@ -592,10 +595,11 @@ the height of the current window." (when (< delta 0) (set-window-vscroll nil (- delta) t))))) -(defun pixel-scroll-precision-interpolate (delta) +(defun pixel-scroll-precision-interpolate (delta &optional old-window) "Interpolate a scroll of DELTA pixels. -This results in the window being scrolled by DELTA pixels with an -animation." +OLD-WINDOW is the window which will be selected when redisplay +takes place, or nil for the current window. This results in the +window being scrolled by DELTA pixels with an animation." (let ((percentage 0) (total-time pixel-scroll-precision-interpolation-total-time) (factor pixel-scroll-precision-interpolation-factor) @@ -613,7 +617,9 @@ animation." (while-no-input (unwind-protect (while (< percentage 1) - (redisplay t) + (with-selected-window (or old-window + (selected-window)) + (redisplay t)) (sleep-for between-scroll) (setq time-elapsed (+ time-elapsed (- (float-time) last-time)) @@ -664,7 +670,10 @@ Move the display up or down by the pixel deltas in EVENT to scroll the display according to the user's turning the mouse wheel." (interactive "e") - (let ((window (mwheel-event-window event))) + (let ((window (mwheel-event-window event)) + (current-window (selected-window))) + (when (framep window) + (setq window (frame-selected-window window))) (if (and (nth 4 event)) (let ((delta (round (cdr (nth 4 event))))) (unless (zerop delta) @@ -685,7 +694,7 @@ wheel." (let ((kin-state (pixel-scroll-kinetic-state))) (aset kin-state 0 (make-ring 30)) (aset kin-state 1 nil)) - (pixel-scroll-precision-interpolate delta)) + (pixel-scroll-precision-interpolate delta current-window)) (condition-case nil (progn (if (< delta 0) @@ -738,6 +747,8 @@ It is a vector of the form [ VELOCITY TIME SIGN ]." (when pixel-scroll-precision-use-momentum (let ((window (mwheel-event-window event)) (state nil)) + (when (framep window) + (setq window (frame-selected-window window))) (setq state (pixel-scroll-kinetic-state window)) (when (and (aref state 1) (listp (aref state 0))) diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index d7c093444ed..670b6e7e898 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -240,12 +240,13 @@ executable." (not (string= argument (buffer-substring (point) (match-end 1)))) (if (or (not executable-query) no-query-flag - (save-window-excursion - ;; Make buffer visible before question. - (switch-to-buffer (current-buffer)) - (y-or-n-p (format-message - "Replace magic number by `#!%s'? " - argument)))) + (save-match-data + (save-window-excursion + ;; Make buffer visible before question. + (switch-to-buffer (current-buffer)) + (y-or-n-p (format-message + "Replace magic number by `#!%s'? " + argument))))) (progn (replace-match argument t t nil 1) (message "Magic number changed to `#!%s'" argument)))) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index ddccbe80e7f..a35a7deb4b1 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -90,6 +90,7 @@ (require 'gud) (require 'cl-lib) (require 'cl-seq) +(require 'bindat) (eval-when-compile (require 'pcase)) (declare-function speedbar-change-initial-expansion-list @@ -4288,7 +4289,7 @@ member." ;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. (def-gdb-trigger-and-handler gdb-invalidate-locals - (concat (gdb-current-context-command "-stack-list-locals") + (concat (gdb-current-context-command "-stack-list-variables") " --simple-values") gdb-locals-handler gdb-locals-handler-custom '(start update)) @@ -4299,6 +4300,48 @@ member." 'gdb-locals-mode 'gdb-invalidate-locals) + +;; Retrieve the values of all variables before invalidating locals. +(def-gdb-trigger-and-handler + gdb-locals-values + (concat (gdb-current-context-command "-stack-list-variables") + " --all-values") + gdb-locals-values-handler gdb-locals-values-handler-custom + '(start update)) + +(gdb-set-buffer-rules + 'gdb-locals-values-buffer + 'gdb-locals-values-buffer-name + 'gdb-locals-mode + 'gdb-locals-values) + +(defun gdb-locals-values-buffer-name () + (gdb-current-context-buffer-name + (concat "local values of " (gdb-get-target-string)))) + +(defcustom gdb-locals-simple-values-only nil + "Only display simple values in the Locals buffer." + :type 'boolean + :group 'gud + :version "29.1") + +(defcustom gdb-locals-value-limit 100 + "Maximum length the value of a local variable is allowed to be." + :type 'integer + :group 'gud + :version "29.1") + +(defvar gdb-locals-values-table (make-hash-table :test #'equal) + "Mapping of local variable names to a string with their value.") + +(defun gdb-locals-values-handler-custom () + "Store the values of local variables in `gdb-locals-value-map'." + (let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables))) + (dolist (local locals-list) + (let ((name (bindat-get-field local 'name)) + (value (bindat-get-field local 'value))) + (puthash name value gdb-locals-values-table))))) + (defvar gdb-locals-watch-map (let ((map (make-sparse-keymap))) (suppress-keymap map) @@ -4315,6 +4358,15 @@ member." map) "Keymap to edit value of a simple data type local variable.") +(defun gdb-locals-value-filter (value) + "Filter function for the local variable VALUE." + (let* ((no-nl (replace-regexp-in-string "\n" " " value)) + (str (replace-regexp-in-string "[[:space:]]+" " " no-nl)) + (limit gdb-locals-value-limit)) + (if (>= (length str) limit) + (concat (substring str 0 limit) "...") + str))) + (defun gdb-edit-locals-value (&optional event) "Assign a value to a variable displayed in the locals buffer." (interactive (list last-input-event)) @@ -4327,17 +4379,22 @@ member." (gud-basic-call (concat "-gdb-set variable " var " = " value))))) -;; Don't display values of arrays or structures. -;; These can be expanded using gud-watch. +;; Complex data types are looked up in `gdb-locals-values-table'. (defun gdb-locals-handler-custom () - (let ((locals-list (gdb-mi--field (gdb-mi--partial-output) 'locals)) + "Handler to rebuild the local variables table buffer." + (let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables)) (table (make-gdb-table))) (dolist (local locals-list) (let ((name (gdb-mi--field local 'name)) (value (gdb-mi--field local 'value)) (type (gdb-mi--field local 'type))) (when (not value) - (setq value "<complex data type>")) + (setq value + (if gdb-locals-simple-values-only + "<complex data type>" + (gethash name gdb-locals-values-table "<unavailable>")))) + (setq value (gdb-locals-value-filter value)) + (if (or (not value) (string-match "0x" value)) (add-text-properties 0 (length name) @@ -4860,6 +4917,8 @@ file\" where the GDB session starts (see `gdb-main-file')." (expand-file-name gdb-default-window-configuration-file gdb-window-configuration-directory))) ;; Create default layout as before. + ;; Make sure that local values are updated before locals. + (gdb-get-buffer-create 'gdb-locals-values-buffer) (gdb-get-buffer-create 'gdb-locals-buffer) (gdb-get-buffer-create 'gdb-stack-buffer) (gdb-get-buffer-create 'gdb-breakpoints-buffer) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 880c5b55179..daaf86f3277 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -418,30 +418,33 @@ The directory names should be absolute. Used in the VC project backend implementation of `project-external-roots'.") (defun project-try-vc (dir) - (let* ((backend - ;; FIXME: This is slow. Cache it. - (ignore-errors (vc-responsible-backend dir))) - (root - (pcase backend - ('Git - ;; Don't stop at submodule boundary. - ;; FIXME: Cache for a shorter time. - (or (vc-file-getprop dir 'project-git-root) - (let ((root (vc-call-backend backend 'root dir))) - (vc-file-setprop - dir 'project-git-root - (if (and - ;; FIXME: Invalidate the cache when the value - ;; of this variable changes. - (project--vc-merge-submodules-p root) - (project--submodule-p root)) - (let* ((parent (file-name-directory - (directory-file-name root)))) - (vc-call-backend backend 'root parent)) - root))))) - ('nil nil) - (_ (ignore-errors (vc-call-backend backend 'root dir)))))) - (and root (cons 'vc root)))) + (or (vc-file-getprop dir 'project-vc) + (let* ((backend (ignore-errors (vc-responsible-backend dir))) + (root + (pcase backend + ('Git + ;; Don't stop at submodule boundary. + (or (vc-file-getprop dir 'project-git-root) + (let ((root (vc-call-backend backend 'root dir))) + (vc-file-setprop + dir 'project-git-root + (if (and + ;; FIXME: Invalidate the cache when the value + ;; of this variable changes. + (project--vc-merge-submodules-p root) + (project--submodule-p root)) + (let* ((parent (file-name-directory + (directory-file-name root)))) + (vc-call-backend backend 'root parent)) + root))))) + ('nil nil) + (_ (ignore-errors (vc-call-backend backend 'root dir))))) + project) + (when root + (setq project (list 'vc backend root)) + ;; FIXME: Cache for a shorter time. + (vc-file-setprop dir 'project-vc project) + project)))) (defun project--submodule-p (root) ;; XXX: We only support Git submodules for now. @@ -467,7 +470,7 @@ backend implementation of `project-external-roots'.") (t nil)))) (cl-defmethod project-root ((project (head vc))) - (cdr project)) + (nth 2 project)) (cl-defmethod project-external-roots ((project (head vc))) (project-subtract-directories @@ -482,8 +485,8 @@ backend implementation of `project-external-roots'.") (lambda (dir) (let ((ignores (project--value-in-dir 'project-vc-ignores dir)) backend) - (if (and (file-equal-p dir (cdr project)) - (setq backend (vc-responsible-backend dir)) + (if (and (file-equal-p dir (nth 2 project)) + (setq backend (cadr project)) (cond ((eq backend 'Hg)) ((and (eq backend 'Git) @@ -595,11 +598,11 @@ backend implementation of `project-external-roots'.") (file-missing nil))) (cl-defmethod project-ignores ((project (head vc)) dir) - (let* ((root (cdr project)) + (let* ((root (nth 2 project)) backend) (append (when (file-equal-p dir root) - (setq backend (vc-responsible-backend root)) + (setq backend (cadr project)) (delq nil (mapcar @@ -1004,6 +1007,8 @@ directories listed in `vc-directory-exclusion-list'." (interactive) (vc-dir (project-root (project-current t)))) +(declare-function comint-check-proc "comint") + ;;;###autoload (defun project-shell () "Start an inferior shell in the current project's root directory. @@ -1012,11 +1017,14 @@ switch to it. Otherwise, create a new shell buffer. With \\[universal-argument] prefix arg, create a new inferior shell buffer even if one already exists." (interactive) + (require 'comint) (let* ((default-directory (project-root (project-current t))) (default-project-shell-name (project-prefixed-buffer-name "shell")) (shell-buffer (get-buffer default-project-shell-name))) (if (and shell-buffer (not current-prefix-arg)) - (pop-to-buffer shell-buffer (bound-and-true-p display-comint-buffer-action)) + (if (comint-check-proc shell-buffer) + (pop-to-buffer shell-buffer (bound-and-true-p display-comint-buffer-action)) + (shell shell-buffer)) (shell (generate-new-buffer-name default-project-shell-name))))) ;;;###autoload @@ -1112,6 +1120,29 @@ If non-nil, it overrides `compilation-buffer-name-function' for compilation-buffer-name-function))) (call-interactively #'compile))) +(defcustom project-ignore-buffer-conditions nil + "List of conditions to filter the buffers to be switched to. +If any of these conditions are satisfied for a buffer in the +current project, `project-switch-to-buffer', +`project-display-buffer' and `project-display-buffer-other-frame' +ignore it. +See the doc string of `project-kill-buffer-conditions' for the +general form of conditions." + :type '(repeat (choice regexp function symbol + (cons :tag "Major mode" + (const major-mode) symbol) + (cons :tag "Derived mode" + (const derived-mode) symbol) + (cons :tag "Negation" + (const not) sexp) + (cons :tag "Conjunction" + (const and) sexp) + (cons :tag "Disjunction" + (const or) sexp))) + :version "29.1" + :group 'project + :package-version '(project . "0.8.2")) + (defun project--read-project-buffer () (let* ((pr (project-current t)) (current-buffer (current-buffer)) @@ -1121,7 +1152,10 @@ If non-nil, it overrides `compilation-buffer-name-function' for (predicate (lambda (buffer) ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist. - (memq (cdr buffer) buffers)))) + (and (memq (cdr buffer) buffers) + (not + (project--buffer-check + (cdr buffer) project-ignore-buffer-conditions)))))) (read-buffer "Switch to buffer: " (when (funcall predicate (cons other-name other-buffer)) @@ -1239,11 +1273,12 @@ Used by `project-kill-buffers'." (push buf bufs))) (nreverse bufs))) -(defun project--kill-buffer-check (buf conditions) +(defun project--buffer-check (buf conditions) "Check if buffer BUF matches any element of the list CONDITIONS. -See `project-kill-buffer-conditions' for more details on the form -of CONDITIONS." - (catch 'kill +See `project-kill-buffer-conditions' or +`project-ignore-buffer-conditions' for more details on the +form of CONDITIONS." + (catch 'match (dolist (c conditions) (when (cond ((stringp c) @@ -1258,15 +1293,15 @@ of CONDITIONS." (buffer-local-value 'major-mode buf) (cdr c))) ((eq (car-safe c) 'not) - (not (project--kill-buffer-check buf (cdr c)))) + (not (project--buffer-check buf (cdr c)))) ((eq (car-safe c) 'or) - (project--kill-buffer-check buf (cdr c))) + (project--buffer-check buf (cdr c))) ((eq (car-safe c) 'and) (seq-every-p - (apply-partially #'project--kill-buffer-check + (apply-partially #'project--buffer-check buf) (mapcar #'list (cdr c))))) - (throw 'kill t))))) + (throw 'match t))))) (defun project--buffers-to-kill (pr) "Return list of buffers in project PR to kill. @@ -1274,7 +1309,7 @@ What buffers should or should not be killed is described in `project-kill-buffer-conditions'." (let (bufs) (dolist (buf (project-buffers pr)) - (when (project--kill-buffer-check buf project-kill-buffer-conditions) + (when (project--buffer-check buf project-kill-buffer-conditions) (push buf bufs))) bufs)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d83290fe457..c4d8b123a86 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -563,6 +563,8 @@ class declarations.") ;; Python 3.5+ PEP492 (and "async" (+ space) (or "def" "for" "with")) "await" + ;; Python 3.10+ + "match" "case" ;; Extra: "self") symbol-end) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 4388b0e7de0..abe25f2c633 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -216,7 +216,7 @@ It creates the Imenu index for the buffer, if necessary." (setq which-func-mode nil)))) (defun which-func-update () - "Update the Which-Function mode display for all windows." + "Update the Which-Function mode display in the current window." ;; (walk-windows 'which-func-update-1 nil 'visible)) (let ((non-essential t)) (which-func-update-1 (selected-window)))) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index aa98aa89f15..5d1ba4eaf55 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,7 +1,7 @@ ;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2022 Free Software Foundation, Inc. -;; Version: 1.4.0 +;; Version: 1.4.1 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -227,7 +227,7 @@ This behavior is new in Emacs 28.") "A match xref item describes a search result." length) -(cl-defgeneric xref-match-length ((item xref-match-item)) +(cl-defmethod xref-match-length ((item xref-match-item)) "Return the length of the match." (xref-match-item-length item)) @@ -1714,7 +1714,7 @@ IGNORES is a list of glob patterns for files to ignore." (ripgrep . ;; '!*/' is there to filter out dirs (e.g. submodules). - "xargs -0 rg <C> --null -nH --no-messages -g '!*/' -e <R>" + "xargs -0 rg <C> --null -nH --no-heading --no-messages -g '!*/' -e <R>" )) "Associative list mapping program identifiers to command templates. @@ -1923,21 +1923,22 @@ Such as the current syntax table and the applied syntax properties." (defvar xref--last-file-buffer nil) (defvar xref--temp-buffer-file-name nil) +(defvar xref--hits-remote-id nil) (defun xref--convert-hits (hits regexp) (let (xref--last-file-buffer (tmp-buffer (generate-new-buffer " *xref-temp*")) - (remote-id (file-remote-p default-directory)) + (xref--hits-remote-id (file-remote-p default-directory)) (syntax-needed (xref--regexp-syntax-dependent-p regexp))) (unwind-protect (mapcan (lambda (hit) - (xref--collect-matches hit regexp tmp-buffer remote-id syntax-needed)) + (xref--collect-matches hit regexp tmp-buffer syntax-needed)) hits) (kill-buffer tmp-buffer)))) -(defun xref--collect-matches (hit regexp tmp-buffer remote-id syntax-needed) +(defun xref--collect-matches (hit regexp tmp-buffer syntax-needed) (pcase-let* ((`(,line ,file ,text) hit) - (file (and file (concat remote-id file))) + (file (and file (concat xref--hits-remote-id file))) (buf (xref--find-file-buffer file)) (inhibit-modification-hooks t)) (if buf @@ -2010,10 +2011,17 @@ Such as the current syntax table and the applied syntax properties." (defun xref--find-file-buffer (file) (unless (equal (car xref--last-file-buffer) file) - (setq xref--last-file-buffer - ;; `find-buffer-visiting' is considerably slower, - ;; especially on remote files. - (cons file (get-file-buffer file)))) + ;; `find-buffer-visiting' is considerably slower, + ;; especially on remote files. + (let ((buf (get-file-buffer file))) + (when (and buf + (or + (buffer-modified-p buf) + (unless xref--hits-remote-id + (not (verify-visited-file-modtime (current-buffer)))))) + ;; We can't use buffers whose contents diverge from disk (bug#54025). + (setq buf nil)) + (setq xref--last-file-buffer (cons file buf)))) (cdr xref--last-file-buffer)) (provide 'xref) diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 3d12723c025..5786a21e88e 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -132,8 +132,11 @@ Setting the variable with a customization buffer also takes effect." (define-minor-mode scroll-bar-mode "Toggle vertical scroll bars on all frames (Scroll Bar mode). -This command applies to all frames that exist and frames to be -created in the future." +This command applies to all frames that exist, as well as new +frames to be created in the future. This is done by altering the +frame parameters, so if you (re-)set `default-frame-alist' after +toggling the scroll bars on or off with this command, the scroll +bars may reappear on new frames." :variable ((get-scroll-bar-mode) . (lambda (v) (set-scroll-bar-mode (if v (or previous-scroll-bar-mode diff --git a/lisp/select.el b/lisp/select.el index 42b50c44e6c..e9bc5451171 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -485,7 +485,8 @@ two markers or an overlay. Otherwise, it is nil." (if eight-bit 'C_STRING 'STRING)))))))) (cond - ((eq type 'UTF8_STRING) + ((or (eq type 'UTF8_STRING) + (eq type 'text/plain\;charset=utf-8)) (if (or (not coding) (not (eq (coding-system-type coding) 'utf-8))) (setq coding 'utf-8)) @@ -497,6 +498,12 @@ two markers or an overlay. Otherwise, it is nil." (setq coding 'iso-8859-1)) (setq str (encode-coding-string str coding))) + ((eq type 'text/plain) + (if (or (not coding) + (not (eq (coding-system-type coding) 'charset))) + (setq coding 'ascii)) + (setq str (encode-coding-string str coding))) + ((eq type 'COMPOUND_TEXT) (if (or (not coding) (not (eq (coding-system-type coding) 'iso-2022))) @@ -630,6 +637,8 @@ This function returns the string \"emacs\"." (COMPOUND_TEXT . xselect-convert-to-string) (STRING . xselect-convert-to-string) (UTF8_STRING . xselect-convert-to-string) + (text/plain . xselect-convert-to-string) + (text/plain\;charset=utf-8 . xselect-convert-to-string) (TARGETS . xselect-convert-to-targets) (LENGTH . xselect-convert-to-length) (DELETE . xselect-convert-to-delete) diff --git a/lisp/shell.el b/lisp/shell.el index 6198214abee..565ededa1ef 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -783,17 +783,26 @@ Make the shell buffer the current buffer, and return it. (getenv "ESHELL") shell-file-name)) (name (file-name-nondirectory prog)) (startfile (concat "~/.emacs_" name)) - (xargs-name (intern-soft (concat "explicit-" name "-args")))) + (xargs-name (intern-soft (concat "explicit-" name "-args"))) + (start-point (point))) (unless (file-exists-p startfile) (setq startfile (locate-user-emacs-file (concat "init_" name ".sh")))) (setq-local shell--start-prog (file-name-nondirectory prog)) (apply #'make-comint-in-buffer "shell" buffer prog - (if (file-exists-p startfile) startfile) + nil (if (and xargs-name (boundp xargs-name)) (symbol-value xargs-name) '("-i"))) - (shell-mode)))) + (shell-mode) + (when (file-exists-p startfile) + ;; Wait until the prompt has appeared. + (while (= start-point (point)) + (sleep-for 0.1)) + (shell-eval-command + (with-temp-buffer + (insert-file-contents startfile) + (buffer-string))))))) buffer) ;;; Directory tracking @@ -1026,77 +1035,45 @@ this feature; see the function `dirtrack-mode'." "Resync the buffer's idea of the current directory stack. This command queries the shell with the command bound to `shell-dirstack-query' (default \"dirs\"), reads the next -line output and parses it to form the new directory stack. -DON'T issue this command unless the buffer is at a shell prompt. -Also, note that if some other subprocess decides to do output -immediately after the query, its output will be taken as the -new directory stack -- you lose. If this happens, just do the -command again." +line output and parses it to form the new directory stack." (interactive) - (let* ((proc (get-buffer-process (current-buffer))) - (pmark (process-mark proc)) - (started-at-pmark (= (point) (marker-position pmark)))) - (save-excursion - (goto-char pmark) - ;; If the process echoes commands, don't insert a fake command in - ;; the buffer or it will appear twice. - (unless comint-process-echoes - (insert shell-dirstack-query) (insert "\n")) - (sit-for 0) ; force redisplay - (comint-send-string proc shell-dirstack-query) - (comint-send-string proc "\n") - (set-marker pmark (point)) - (let ((pt (point)) - (regexp - (concat - (if comint-process-echoes - ;; Skip command echo if the process echoes - (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)") - "\\(\\)") - "\\(.+\n\\)"))) - ;; This extra newline prevents the user's pending input from spoofing us. - (insert "\n") (backward-char 1) - ;; Wait for one line. - (while (not (looking-at regexp)) - (accept-process-output proc) - (goto-char pt))) - (goto-char pmark) (delete-char 1) ; remove the extra newline - ;; That's the dirlist. Grab it & parse it. - (let* ((dls (buffer-substring-no-properties - (match-beginning 0) (1- (match-end 0)))) - (dlsl nil) - (pos 0) - (ds nil)) - ;; Split the dirlist into whitespace and non-whitespace chunks. - ;; dlsl will be a reversed list of tokens. - (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos) - (push (match-string 1 dls) dlsl) - (setq pos (match-end 1))) - - ;; Prepend trailing entries until they form an existing directory, - ;; whitespace and all. Discard the next whitespace and repeat. - (while dlsl - (let ((newelt "") - tem1 tem2) - (while newelt - ;; We need tem1 because we don't want to prepend - ;; `comint-file-name-prefix' repeatedly into newelt via tem2. - (setq tem1 (pop dlsl) - tem2 (concat comint-file-name-prefix tem1 newelt)) - (cond ((file-directory-p tem2) - (push tem2 ds) - (when (string= " " (car dlsl)) - (pop dlsl)) - (setq newelt nil)) - (t - (setq newelt (concat tem1 newelt))))))) - - (with-demoted-errors "Couldn't cd: %s" - (shell-cd (car ds)) - (setq shell-dirstack (cdr ds) - shell-last-dir (car shell-dirstack)) - (shell-dirstack-message)))) - (if started-at-pmark (goto-char (marker-position pmark))))) + (let* ((dls (car + (last + (string-lines + (string-chop-newline + (shell-eval-command (concat shell-dirstack-query "\n"))))))) + (dlsl nil) + (pos 0) + (ds nil)) + ;; Split the dirlist into whitespace and non-whitespace chunks. + ;; dlsl will be a reversed list of tokens. + (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos) + (push (match-string 1 dls) dlsl) + (setq pos (match-end 1))) + + ;; Prepend trailing entries until they form an existing directory, + ;; whitespace and all. Discard the next whitespace and repeat. + (while dlsl + (let ((newelt "") + tem1 tem2) + (while newelt + ;; We need tem1 because we don't want to prepend + ;; `comint-file-name-prefix' repeatedly into newelt via tem2. + (setq tem1 (pop dlsl) + tem2 (concat comint-file-name-prefix tem1 newelt)) + (cond ((file-directory-p tem2) + (push tem2 ds) + (when (string= " " (car dlsl)) + (pop dlsl)) + (setq newelt nil)) + (t + (setq newelt (concat tem1 newelt))))))) + + (with-demoted-errors "Couldn't cd: %s" + (shell-cd (car ds)) + (setq shell-dirstack (cdr ds) + shell-last-dir (car shell-dirstack)) + (shell-dirstack-message)))) ;; For your typing convenience: (defalias 'dirs 'shell-resync-dirs) @@ -1431,6 +1408,36 @@ Returns t if successful." (point-max) (shell--prompt-begin-position)))))) +(defun shell-eval-command (command) + "Eval COMMAND in the current shell process and return the result." + (let* ((proc (get-buffer-process (current-buffer))) + (old-filter (process-filter proc)) + (result "") + prev) + (unwind-protect + (progn + (set-process-filter + proc + (lambda (_proc string) + (setq result (concat result string)))) + (process-send-string proc command) + ;; Wait until we get a prompt (which will be a line without + ;; a newline). This is far from fool-proof -- if something + ;; outputs incomplete data and then sleeps, we'll think + ;; we've received the prompt. + (while (not (let* ((lines (string-lines result)) + (last (car (last lines)))) + (and (length> lines 0) + (not (equal last "")) + (or (not prev) + (not (equal last prev))) + (setq prev last)))) + (accept-process-output proc 0 100))) + ;; Restore old filter. + (set-process-filter proc old-filter)) + ;; Remove the prompt. + (replace-regexp-in-string "\n.*\\'" "\n" result))) + (provide 'shell) ;;; shell.el ends here diff --git a/lisp/startup.el b/lisp/startup.el index 09951bda953..bf5c4a8180b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1044,7 +1044,11 @@ init-file, or to a default value if loading is not possible." (debug-on-error-initial (if (eq init-file-debug t) 'startup - init-file-debug))) + init-file-debug)) + ;; The init file might contain byte-code with embedded NULs, + ;; which can cause problems when read back, so disable nul + ;; byte detection. (Bug#52554) + (inhibit-null-byte-detection t)) (let ((debug-on-error debug-on-error-initial)) (condition-case-unless-debug error (when init-file-user diff --git a/lisp/subr.el b/lisp/subr.el index eb9af0b36da..2321765f953 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4560,7 +4560,7 @@ but that should be robust in the unexpected case that an error is signaled." (if (eq orig-body body) exp ;; The use without `format' is obsolete, let's warn when we bump ;; into any such remaining uses. - (macroexp-warn-and-return format "Missing format argument" exp)))) + (macroexp-warn-and-return "Missing format argument" exp nil nil format)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 09105027581..245a55a671f 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -481,7 +481,7 @@ If the value is a string, use it as a buffer name to switch to if such buffer exists, or switch to a buffer visiting the file or directory that the string specifies. If the value is a function, call it with no arguments and switch to the buffer that it returns. -If nil, duplicate the contents of the tab that was active +If `clone', duplicate the contents of the tab that was active before calling the command that adds a new tab." :type '(choice (const :tag "Current buffer" t) (const :tag "Current window" window) @@ -489,7 +489,7 @@ before calling the command that adds a new tab." (directory :tag "Directory" :value "~/") (file :tag "File" :value "~/.emacs") (function :tag "Function") - (const :tag "Duplicate tab" nil)) + (const :tag "Duplicate tab" clone)) :group 'tab-bar :version "27.1") @@ -1318,7 +1318,8 @@ configuration." (let ((tab-bar-new-tab-choice 'window)) (tab-bar-new-tab)) (tab-bar-switch-to-recent-tab) - (delete-window) + (let ((ignore-window-parameters t)) + (delete-window)) (tab-bar-switch-to-recent-tab)) @@ -1367,14 +1368,20 @@ After the tab is created, the hooks in (select-window (minibuffer-selected-window))) ;; Remove window parameters that can cause problems ;; with `delete-other-windows' and `split-window'. - (set-window-parameter nil 'window-atom nil) - (set-window-parameter nil 'window-side nil) + (unless (eq tab-bar-new-tab-choice 'clone) + (set-window-parameter nil 'window-atom nil) + (set-window-parameter nil 'window-side nil)) (let ((ignore-window-parameters t)) - (delete-other-windows) - (unless (eq tab-bar-new-tab-choice 'window) - ;; Create a new window to get rid of old window parameters - ;; (e.g. prev/next buffers) of old window. - (split-window) (delete-window))) + (if (eq tab-bar-new-tab-choice 'clone) + ;; Create new unique windows with the same layout + (window-state-put (window-state-get)) + (delete-other-windows) + (if (eq tab-bar-new-tab-choice 'window) + ;; Create new unique window from remaining window + (window-state-put (window-state-get)) + ;; Create a new window to get rid of old window parameters + ;; (e.g. prev/next buffers) of old window. + (split-window) (delete-window)))) (let ((buffer (if (functionp tab-bar-new-tab-choice) @@ -1453,7 +1460,7 @@ If FROM-NUMBER is a tab number, a new tab is created from that tab." "Clone the current tab to ARG positions to the right. ARG and FROM-NUMBER have the same meaning as in `tab-bar-new-tab'." (interactive "P") - (let ((tab-bar-new-tab-choice nil) + (let ((tab-bar-new-tab-choice 'clone) (tab-bar-new-tab-group t)) (tab-bar-new-tab arg from-number))) diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index c4810f116d2..83f70edd2c3 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -45,6 +45,25 @@ (defvar haiku-initialized) +(defvar haiku-dnd-selection-value nil + "The local value of the special `XdndSelection' selection.") + +(defvar haiku-dnd-selection-converters '((STRING . haiku-dnd-convert-string)) + "Alist of X selection types to functions that act as selection converters. +The functions should accept a single argument VALUE, describing +the value of the drag-and-drop selection, and return a list of +two elements TYPE and DATA, where TYPE is a string containing the +MIME type of DATA, and DATA is a unibyte string, or nil if the +data could not be converted.") + +(defun haiku-dnd-convert-string (value) + "Convert VALUE to a UTF-8 string and appropriate MIME type. +Return a list of the appropriate MIME type, and UTF-8 data of +VALUE as a unibyte string, or nil if VALUE was not a string." + (when (stringp value) + (list "text/plain" (string-to-unibyte + (encode-coding-string value 'utf-8))))) + (declare-function x-open-connection "haikufns.c") (declare-function x-handle-args "common-win") (declare-function haiku-selection-data "haikuselect.c") @@ -52,6 +71,7 @@ (declare-function haiku-selection-targets "haikuselect.c") (declare-function haiku-selection-owner-p "haikuselect.c") (declare-function haiku-put-resource "haikufns.c") +(declare-function haiku-drag-message "haikuselect.c") (defun haiku--handle-x-command-line-resources (command-line-resources) "Handle command line X resources specified with the option `-xrm'. @@ -97,11 +117,15 @@ If TYPE is nil, return \"text/plain\"." (if (eq data-type 'TARGETS) (apply #'vector (mapcar #'intern (haiku-selection-targets type))) - (haiku-selection-data type (haiku--selection-type-to-mime data-type)))) + (if (eq type 'XdndSelection) + haiku-dnd-selection-value + (haiku-selection-data type (haiku--selection-type-to-mime data-type))))) (cl-defmethod gui-backend-set-selection (type value &context (window-system haiku)) - (haiku-selection-put type "text/plain" value t)) + (if (eq type 'XdndSelection) + (setq haiku-dnd-selection-value value) + (haiku-selection-put type "text/plain" value t))) (cl-defmethod gui-backend-selection-exists-p (selection &context (window-system haiku)) @@ -130,9 +154,23 @@ If TYPE is nil, return \"text/plain\"." (interactive "e") (let* ((string (caddr event)) (window (posn-window (event-start event)))) - (with-selected-window window - (raise-frame) - (dnd-handle-one-url window 'private (concat "file:" string))))) + (cond + ((assoc "refs" string) + (with-selected-window window + (raise-frame) + (dolist (filename (cddr (assoc "refs" string))) + (dnd-handle-one-url window 'private + (concat "file:" filename))))) + ((assoc "text/plain" string) + (with-selected-window window + (raise-frame) + (dolist (text (cddr (assoc "text/plain" string))) + (goto-char (posn-point (event-start event))) + (dnd-insert-text window 'private + (if (multibyte-string-p text) + text + (decode-coding-string text 'undecided)))))) + (t (message "Don't know how to drop any of: %s" (mapcar #'car string)))))) (define-key special-event-map [drag-n-drop] 'haiku-dnd-handle-drag-n-drop-event) @@ -145,6 +183,32 @@ This is necessary because on Haiku `use-system-tooltip' doesn't take effect on menu items until the menu bar is updated again." (force-mode-line-update t)) +(defun x-begin-drag (targets &optional action frame _return-frame) + "SKIP: real doc in xfns.c." + (unless haiku-dnd-selection-value + (error "No local value for XdndSelection")) + (let ((message nil)) + (dolist (target targets) + (let ((selection-converter (cdr (assoc (intern target) + haiku-dnd-selection-converters)))) + (when selection-converter + (let ((selection-result + (funcall selection-converter + haiku-dnd-selection-value))) + (when selection-result + (let ((field (cdr (assoc (car selection-result) message)))) + (unless (cadr field) + ;; Add B_MIME_TYPE to the message if the type was not + ;; previously defined. + (push 1296649541 (alist-get (car selection-result) message + nil nil #'equal)))) + (push (cadr selection-result) + (cdr (alist-get (car selection-result) message + nil nil #'equal)))))))) + (prog1 (or action 'XdndActionCopy) + (haiku-drag-message (or frame (selected-frame)) + message)))) + (add-variable-watcher 'use-system-tooltips #'haiku-use-system-tooltips-watcher) (provide 'haiku-win) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index ab471db3ddc..ab6a907c52d 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -4119,11 +4119,11 @@ Optional arg POS is the position of the BibTeX entry to use." (goto-char pnt))))) (defun bibtex-mark-entry () - "Put mark at beginning, point at end of current BibTeX entry. + "Put mark at end, point at beginning of current BibTeX entry. Activate mark in Transient Mark mode." (interactive) - (push-mark (bibtex-beginning-of-entry) t t) - (bibtex-end-of-entry)) + (push-mark (bibtex-end-of-entry) t t) + (bibtex-beginning-of-entry)) (defun bibtex-count-entries (&optional count-string-entries) "Count number of entries in current buffer or region. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 664214419fa..5de04b12d46 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -489,6 +489,9 @@ Flyspell mode is a buffer-local minor mode. When enabled, it spawns a single Ispell process and checks each word. The default flyspell behavior is to highlight incorrect words. +This mode is geared toward text modes. In buffers that contain +code, `flyspell-prog-mode' is usually a better choice. + Bindings: \\[ispell-word]: correct words (using Ispell). \\[flyspell-auto-correct-word]: automatically correct word. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 83631e64752..b49541f47d4 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -419,11 +419,11 @@ These have to be run via `sgml-syntax-propertize'")) (defun sgml-syntax-propertize (start end &optional rules-function) "Syntactic keywords for `sgml-mode'." (setq sgml--syntax-propertize-ppss (cons start (syntax-ppss start))) - (cl-assert (>= (cadr sgml--syntax-propertize-ppss) 0)) - (sgml-syntax-propertize-inside end) - (funcall (or rules-function sgml--syntax-propertize) (point) end) - ;; Catch any '>' after the last quote. - (sgml--syntax-propertize-ppss end)) + (when (>= (cadr sgml--syntax-propertize-ppss) 0) + (sgml-syntax-propertize-inside end) + (funcall (or rules-function sgml--syntax-propertize) (point) end) + ;; Catch any '>' after the last quote. + (sgml--syntax-propertize-ppss end))) (defun sgml-syntax-propertize-inside (end) (let ((ppss (syntax-ppss))) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ab94036d01d..da4d7cc442d 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2989,13 +2989,7 @@ There might be text before point." (put-text-property (1- (match-beginning 1)) (match-beginning 1) 'syntax-table - (if (= (1+ (line-beginning-position)) (match-beginning 1)) - ;; The `%' is a single-char comment, which Emacs - ;; syntax-table can't deal with. We could turn it - ;; into a non-comment, or use `\n%' or `%^' as the comment. - ;; Instead, we include it in the ^^A comment. - (string-to-syntax "< b") - (string-to-syntax ">"))) + (string-to-syntax ">")) (let ((end (line-end-position))) (if (< end (point-max)) (put-text-property @@ -3018,8 +3012,9 @@ There might be text before point." (defconst doctex-syntax-propertize-rules (syntax-propertize-precompile-rules latex-syntax-propertize-rules - ;; For DocTeX comment-in-doc. - ("\\(\\^\\)\\^A" (1 (doctex-font-lock-^^A)))))) + ;; For DocTeX comment-in-doc (DocTeX ≥3 also allows ^^X). + ;; We make the comment start on the second char because of bug#35140. + ("\\^\\(\\^\\)[AX]" (1 (doctex-font-lock-^^A)))))) (defvar doctex-font-lock-keywords (append tex-font-lock-keywords @@ -3568,28 +3563,122 @@ There might be text before point." ("\\ordmasculine" . ?º) ("\\lambdabar" . ?ƛ) ("\\celsius" . ?℃) + ;; Text symbols formerly part of textcomp package: + ("\\textdollar" . ?$) + ("\\textborn" . ?*) + ("\\textless" . ?<) + ("\\textgreater" . ?>) + ("\\textbackslash" . ?\\) + ("\\textasciicircum" . ?^) + ("\\textunderscore" . ?_) + ("\\textbraceleft" . ?\{) + ("\\textbar" . ?|) + ("\\textbraceright" . ?\}) + ("\\textasciitilde" . ?~) + ("\\textexclamdown" . ?¡) + ("\\textcent" . ?¢) + ("\\textsterling" . ?£) + ("\\textcurrency" . ?¤) + ("\\textyen" . ?¥) + ("\\textbrokenbar" . ?¦) + ("\\textsection" . ?§) + ("\\textasciidieresis" . ?¨) + ("\\textcopyright" . ?©) + ("\\textordfeminine" . ?ª) + ("\\guillemetleft" . ?«) + ("\\guillemotleft" . ?«) + ("\\textlnot" . ?¬) + ("\\textregistered" . ?®) + ("\\textasciimacron" . ?¯) + ("\\textdegree" . ?°) + ("\\textpm" . ?±) + ("\\texttwosuperior" . ?²) + ("\\textthreesuperior" . ?³) + ("\\textasciiacute" . ?´) ("\\textmu" . ?µ) + ("\\textparagraph" . ?¶) + ("\\textpilcrow" . ?¶) + ("\\textperiodcentered" . ?·) + ("\\textonesuperior" . ?¹) + ("\\textordmasculine" . ?º) + ("\\guillemetright" . ?») + ("\\guillemotright" . ?») + ("\\textonequarter" . ?¼) + ("\\textonehalf" . ?½) + ("\\textthreequarters" . ?¾) + ("\\textquestiondown" . ?¿) + ("\\texttimes" . ?×) + ("\\textdiv" . ?÷) + ("\\textflorin" . ?ƒ) + ("\\textasciicaron" . ?ˇ) + ("\\textasciibreve" . ?˘) + ("\\textacutedbl" . ?˝) + ("\\textgravedbl" . 757) + ("\\texttildelow" . 759) + ("\\textbaht" . ?฿) + ("\\textendash" . ?–) + ("\\textemdash" . ?—) + ("\\textbardbl" . ?‖) + ("\\textquoteleft" . 8216) + ("\\textquoteright" . 8217) + ("\\quotesinglbase" . 8218) + ("\\textquotedblleft" . 8220) + ("\\textquotedblright" . 8221) + ("\\quotedblbase" . 8222) + ;; \textdagger and \textdied are replaced with DAGGER (#x2020) and + ;; not with LATIN CROSS (#x271d) + ("\\textdagger" . ?†) + ("\\textdied" . ?†) + ("\\textdaggerdbl" . ?‡) + ("\\textbullet" . ?•) + ("\\textellipsis" . ?…) + ("\\textperthousand" . ?‰) + ("\\textpertenthousand" . ?‱) + ("\\guilsinglleft" . ?‹) + ("\\guilsinglright" . ?›) + ("\\textreferencemark" . ?※) + ("\\textinterrobang" . ?‽) ("\\textfractionsolidus" . ?⁄) - ("\\textbigcircle" . ?⃝) - ("\\textmusicalnote" . ?♪) - ("\\textdied" . ?✝) + ("\\textlquill" . 8261) ; Literal ?⁅ breaks indentation + ("\\textrquill" . 8262) ; Literal ?⁆ breaks indentation + ("\\textdiscount" . ?⁒) ("\\textcolonmonetary" . ?₡) - ("\\textwon" . ?₩) + ("\\textlira" . ?₤) ("\\textnaira" . ?₦) + ("\\textwon" . ?₩) + ("\\textdong" . ?₫) + ("\\texteuro" . ?€) ("\\textpeso" . ?₱) - ("\\textlira" . ?₤) - ("\\textrecipe" . ?℞) - ("\\textinterrobang" . ?‽) - ("\\textpertenthousand" . ?‱) - ("\\textbaht" . ?฿) + ("\\textguarani" . ?₲) + ("\\textcelsius" . ?℃) ("\\textnumero" . ?№) - ("\\textdiscount" . ?⁒) + ("\\textcircledP" . ?℗) + ("\\textrecipe" . ?℞) + ("\\textservicemark" . ?℠) + ("\\texttrademark" . ?™) + ("\\textohm" . ?Ω) + ("\\textmho" . ?℧) ("\\textestimated" . ?℮) + ("\\textleftarrow" . ?←) + ("\\textuparrow" . ?↑) + ("\\textrightarrow" . ?→) + ("\\textdownarrow" . ?↓) + ("\\textminus" . ?−) + ("\\textsurd" . ?√) + ("\\textlangle" . 9001) ; Literal ?〈 breaks indentation + ("\\textrangle" . 9002) ; Literal ?〉 breaks indentation + ("\\textblank" . ?␢) + ("\\textvisiblespace" . ?␣) ("\\textopenbullet" . ?◦) - ("\\textlquill" . 8261) ; Literal ?⁅ breaks indentation. - ("\\textrquill" . 8262) ; Literal ?⁆ breaks indentation. - ("\\textcircledP" . ?℗) - ("\\textreferencemark" . ?※)) + ;; \textbigcircle is replaced with LARGE CIRCLE (#x25ef) and not + ;; with COMBINING ENCLOSING CIRCLE (#x20dd) + ("\\textbigcircle" . ?◯) + ("\\textmusicalnote" . ?♪) + ("\\textmarried" . ?⚭) + ("\\textdivorced" . ?⚮) + ("\\textlbrackdbl" . 10214) ; Literal ?⟦ breaks indentation + ("\\textrbrackdbl" . 10215) ; Literal ?⟧ breaks indentation + ("\\textinterrobangdown" . ?⸘)) "A `prettify-symbols-alist' usable for (La)TeX modes.") (defun tex--prettify-symbols-compose-p (_start end _match) diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 585010d21c5..dd658b1b68b 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -87,11 +87,13 @@ instead of the filename inheritance method." ((and prompt (not byserv)) (setq user (or (url-do-auth-source-search server type :user) - (read-string (url-auth-user-prompt href realm) - (or user (user-real-login-name)))) + (and (url-interactive-p) + (read-string (url-auth-user-prompt href realm) + (or user (user-real-login-name))))) pass (or (url-do-auth-source-search server type :secret) - (read-passwd "Password: " nil (or pass "")))) + (and (url-interactive-p) + (read-passwd "Password: " nil (or pass ""))))) (set url-basic-auth-storage (cons (list server (cons file @@ -117,11 +119,13 @@ instead of the filename inheritance method." (progn (setq user (or (url-do-auth-source-search server type :user) - (read-string (url-auth-user-prompt href realm) - (user-real-login-name))) + (and (url-interactive-p) + (read-string (url-auth-user-prompt href realm) + (user-real-login-name)))) pass (or (url-do-auth-source-search server type :secret) - (read-passwd "Password: ")) + (and (url-interactive-p) + (read-passwd "Password: "))) retval (base64-encode-string (format "%s:%s" user pass) t) byserv (assoc server (symbol-value url-basic-auth-storage))) (setcdr byserv @@ -233,11 +237,13 @@ CREDS is a plist that may have properties `:user' and `:secret'." ;; plist-put modify the same plist. (setq creds (plist-put creds :user - (read-string (url-auth-user-prompt url realm) - (or (plist-get creds :user) - (user-real-login-name))))) + (and (url-interactive-p) + (read-string (url-auth-user-prompt url realm) + (or (plist-get creds :user) + (user-real-login-name)))))) (plist-put creds :secret - (read-passwd "Password: " nil (plist-get creds :secret)))) + (and (url-interactive-p) + (read-passwd "Password: " nil (plist-get creds :secret))))) (defun url-digest-auth-directory-id-assoc (dirkey keylist) "Find the best match for DIRKEY in key alist KEYLIST. diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 16c3a6a1e62..daeba17031d 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1304,9 +1304,7 @@ The return value of this function is the retrieval buffer." (cl-check-type url url "Need a pre-parsed URL.") (let* (;; (host (url-host (or url-using-proxy url))) ;; (port (url-port (or url-using-proxy url))) - (nsm-noninteractive (or url-request-noninteractive - (and (boundp 'url-http-noninteractive) - url-http-noninteractive))) + (nsm-noninteractive (not (url-interactive-p))) ;; The following binding is needed in url-open-stream, which ;; is called from url-http-find-free-connection. (url-current-object url) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index 152300bda55..b2e24607e11 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -161,11 +161,7 @@ The variable `url-queue-timeout' sets a timeout." (url-queue-context-buffer job) (current-buffer)) (let ((url-request-noninteractive t) - (url-allow-non-local-files t) - ;; This will disable querying the user for - ;; credentials if one of the things we're fetching - ;; in the background return a header requesting it. - (url-request-extra-headers '(("Authorization" . "")))) + (url-allow-non-local-files t)) (url-retrieve (url-queue-url job) #'url-queue-callback-function (list job) (url-queue-silentp job) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 83c089a930a..922f26d65bc 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -1,7 +1,6 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool -*- lexical-binding:t -*- -;; Copyright (C) 1996-1999, 2001, 2004-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1996-2022 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -131,7 +130,7 @@ Samples: This variable controls several other variables and is _NOT_ automatically updated. Call the function `url-setup-privacy-info' after modifying this variable." - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (set-default sym val) (url-setup-privacy-info)) :type '(radio (const :tag "None (you believe in the basic goodness of humanity)" :value none) @@ -204,10 +203,9 @@ from the ACCESS_proxy environment variables." :type 'boolean :group 'url-cache) -(defvar url-mime-separator-chars (mapcar 'identity - (concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - "abcdefghijklmnopqrstuvwxyz" - "0123456789'()+_,-./=?")) +(defvar url-mime-separator-chars (append "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz" + "0123456789'()+_,-./=?") "Characters allowable in a MIME multipart separator.") (defcustom url-bad-port-list @@ -254,7 +252,7 @@ Generated according to current coding system priorities." (push (car elt) accum))) (nreverse accum))))) (concat (format "%s;q=1, " (pop ordered)) - (mapconcat 'symbol-name ordered ";q=0.5, ") + (mapconcat #'symbol-name ordered ";q=0.5, ") ";q=0.5"))) (defvar url-mime-charset-string nil @@ -424,11 +422,15 @@ Should be one of: This should be set, e.g. by mail user agents rendering HTML to avoid `bugs' which call home.") +(defun url-interactive-p () + "Non-nil when the current request is from an interactive context." + (not (or url-request-noninteractive + (bound-and-true-p url-http-noninteractive)))) + ;; Obsolete (defconst url-version "Emacs" "Version number of URL package.") (make-obsolete-variable 'url-version 'emacs-version "28.1") (provide 'url-vars) - ;;; url-vars.el ends here diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index b38a676acbd..3cf692bfdaa 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -201,8 +201,8 @@ switches." ;; FIXME are there other possible combinations? (cond ((eq state 'edited) (setq state 'needs-merge)) ((not state) (setq state 'needs-update)))) - (when (and state (not (string= "." filename))) - (setq result (cons (list filename state) result))))) + (when state + (setq result (cons (list filename state) result))))) (funcall callback result))) ;; dir-status-files called from vc-dir, which loads vc, diff --git a/lisp/window.el b/lisp/window.el index 54c9eee5f32..dd297a31698 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5698,12 +5698,12 @@ right, if any." ;;; Balancing windows. ;; The following routine uses the recycled code from an old version of -;; `window--resize-child-windows'. It's not very pretty, but coding it the way the -;; new `window--resize-child-windows' code does would hardly make it any shorter or -;; more readable (FWIW we'd need three loops - one to calculate the -;; minimum sizes per window, one to enlarge or shrink windows until the -;; new parent-size matches, and one where we shrink the largest/enlarge -;; the smallest window). +;; `window--resize-child-windows'. It's not very pretty, but coding it +;; the way the new `window--resize-child-windows' code does would hardly +;; make it any shorter or more readable (FWIW we'd need three loops - +;; one to calculate the minimum sizes per window, one to enlarge or +;; shrink windows until the new parent-size matches, and one where we +;; shrink the largest/enlarge the smallest window). (defun balance-windows-2 (window horizontal) "Subroutine of `balance-windows-1'. WINDOW must be a vertical combination (horizontal if HORIZONTAL @@ -5714,9 +5714,10 @@ is non-nil)." (first (window-child window)) (sub first) (number-of-children 0) + (rest 0) (parent-size (window-new-pixel window)) (total-sum parent-size) - failed size sub-total sub-delta sub-amount rest) + failed size sub-total sub-delta sub-amount) (while sub (if (window-size-fixed-p sub horizontal) (progn diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 559679131bd..0529d223dbe 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -446,7 +446,6 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (version (x-dnd-version-from-flags flags)) (more-than-3 (x-dnd-more-than-3-from-flags flags)) (dnd-source (aref data 0))) - (message "%s %s" version more-than-3) (if version ;; If flags is bad, version will be nil. (x-dnd-save-state window nil nil diff --git a/lwlib/lwlib-Xm.c b/lwlib/lwlib-Xm.c index fa60fc89d08..52ea304f717 100644 --- a/lwlib/lwlib-Xm.c +++ b/lwlib/lwlib-Xm.c @@ -115,6 +115,7 @@ static void xm_generic_callback (Widget, XtPointer, XtPointer); static void xm_nosel_callback (Widget, XtPointer, XtPointer); static void xm_pull_down_callback (Widget, XtPointer, XtPointer); static void xm_pop_down_callback (Widget, XtPointer, XtPointer); +static void xm_pop_up_callback (Widget, XtPointer, XtPointer); static void xm_internal_update_other_instances (Widget, XtPointer, XtPointer); static void xm_arm_callback (Widget, XtPointer, XtPointer); @@ -269,28 +270,23 @@ static void xm_arm_callback (Widget w, XtPointer client_data, XtPointer call_data) { XmPushButtonCallbackStruct *cbs = (XmPushButtonCallbackStruct *) call_data; - widget_value *wv = (widget_value *) client_data; - widget_instance *instance; - - /* Get the id of the menu bar or popup menu this widget is in. */ - while (w != NULL) - { - if (XmIsRowColumn (w)) - { - unsigned char type = 0xff; - - XtVaGetValues (w, XmNrowColumnType, &type, NULL); - if (type == XmMENU_BAR || type == XmMENU_POPUP) - break; - } + widget_value *wv = NULL; + widget_instance *instance = client_data; + XtPointer user_data; + Arg al[2]; + int ac = 0; - w = XtParent (w); - } + XtSetArg (al[ac], XmNuserData, &user_data); ac++; + XtGetValues (w, al, ac); + wv = user_data; - if (w != NULL) + if (wv != NULL) { - instance = lw_get_widget_instance (w); - if (instance && instance->info->highlight_cb) + if (instance->info->highlight_cb + && (cbs->reason == XmCR_DISARM + || (cbs->event + && (cbs->event->type == EnterNotify + || cbs->event->type == MotionNotify)))) { call_data = cbs->reason == XmCR_DISARM ? NULL : wv; instance->info->highlight_cb (w, instance->info->id, call_data); @@ -501,9 +497,11 @@ make_menu_in_widget (widget_instance* instance, ; children = (Widget*)(void*)XtMalloc (num_children * sizeof (Widget)); +#ifndef LESSTIF_VERSION /* WIDGET should be a RowColumn. */ if (!XmIsRowColumn (widget)) emacs_abort (); +#endif /* Determine whether WIDGET is a menu bar. */ type = -1; @@ -516,8 +514,12 @@ make_menu_in_widget (widget_instance* instance, /* Add a callback to popups and pulldowns that is called when it is made invisible again. */ if (!menubar_p) - XtAddCallback (XtParent (widget), XmNpopdownCallback, - xm_pop_down_callback, (XtPointer)instance); + { + XtAddCallback (XtParent (widget), XmNpopdownCallback, + xm_pop_down_callback, (XtPointer) instance); + XtAddCallback (XtParent (widget), XmNpopupCallback, + xm_pop_up_callback, (XtPointer) instance); + } /* Preserve the first KEEP_FIRST_CHILDREN old children. */ for (child_index = 0, cur = val; child_index < keep_first_children; @@ -537,7 +539,7 @@ make_menu_in_widget (widget_instance* instance, ac = 0; XtSetArg (al[ac], XmNsensitive, cur->enabled); ac++; XtSetArg (al[ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; - XtSetArg (al[ac], XmNuserData, cur->call_data); ac++; + XtSetArg (al[ac], XmNuserData, cur); ac++; if (instance->pop_up_p && !cur->contents && !cur->call_data && !lw_separator_p (cur->name, &separator, 1)) @@ -568,14 +570,18 @@ make_menu_in_widget (widget_instance* instance, ? XmN_OF_MANY : XmONE_OF_MANY)); ++ac; button = XmCreateToggleButton (widget, cur->name, al, ac); - XtAddCallback (button, XmNarmCallback, xm_arm_callback, cur); - XtAddCallback (button, XmNdisarmCallback, xm_arm_callback, cur); + XtAddCallback (button, XmNarmCallback, xm_arm_callback, + (XtPointer) instance); + XtAddCallback (button, XmNdisarmCallback, xm_arm_callback, + (XtPointer) instance); } else { button = XmCreatePushButton (widget, cur->name, al, ac); - XtAddCallback (button, XmNarmCallback, xm_arm_callback, cur); - XtAddCallback (button, XmNdisarmCallback, xm_arm_callback, cur); + XtAddCallback (button, XmNarmCallback, xm_arm_callback, + (XtPointer) instance); + XtAddCallback (button, XmNdisarmCallback, xm_arm_callback, + (XtPointer) instance); } xm_update_label (instance, button, cur); @@ -642,7 +648,7 @@ update_one_menu_entry (widget_instance* instance, /* update the sensitivity and userdata */ /* Common to all widget types */ XtSetSensitive (widget, val->enabled); - XtVaSetValues (widget, XmNuserData, val->call_data, NULL); + XtVaSetValues (widget, XmNuserData, val, NULL); /* update the menu button as a label. */ if (val->this_one_change >= VISIBLE_CHANGE) @@ -842,7 +848,7 @@ xm_update_one_widget (widget_instance* instance, /* Common to all widget types */ XtSetSensitive (widget, val->enabled); - XtVaSetValues (widget, XmNuserData, val->call_data, NULL); + XtVaSetValues (widget, XmNuserData, val, NULL); /* Common to all label like widgets */ if (XtIsSubclass (widget, xmLabelWidgetClass)) @@ -1787,6 +1793,7 @@ do_call (Widget widget, int ac; XtPointer user_data; widget_instance* instance = (widget_instance*)closure; + widget_value *wv; Widget instance_widget; LWLIB_ID id; @@ -1804,17 +1811,18 @@ do_call (Widget widget, user_data = NULL; XtSetArg (al [ac], XmNuserData, &user_data); ac++; XtGetValues (widget, al, ac); + wv = user_data; switch (type) { case pre_activate: if (instance->info->pre_activate_cb) - instance->info->pre_activate_cb (widget, id, user_data); + instance->info->pre_activate_cb (widget, id, wv ? wv->call_data : NULL); break; case selection: if (instance->info->selection_cb) - instance->info->selection_cb (widget, id, user_data); + instance->info->selection_cb (widget, id, wv ? wv->call_data : NULL); break; case no_selection: @@ -1824,7 +1832,7 @@ do_call (Widget widget, case post_activate: if (instance->info->post_activate_cb) - instance->info->post_activate_cb (widget, id, user_data); + instance->info->post_activate_cb (widget, id, wv ? wv->call_data : NULL); break; default: @@ -1912,6 +1920,18 @@ xm_pop_down_callback (Widget widget, do_call (widget, closure, post_activate); } +static void +xm_pop_up_callback (Widget widget, + XtPointer closure, + XtPointer call_data) +{ + widget_instance *instance = (widget_instance *) closure; + + if ((!instance->pop_up_p && XtParent (widget) == instance->widget) + || XtParent (widget) == instance->parent) + do_call (widget, closure, pre_activate); +} + /* set the keyboard focus */ void diff --git a/m4/copy-file-range.m4 b/m4/copy-file-range.m4 index 4c7ec4eaafa..1b8b9d88589 100644 --- a/m4/copy-file-range.m4 +++ b/m4/copy-file-range.m4 @@ -7,6 +7,7 @@ dnl with or without modifications, as long as this notice is preserved. AC_DEFUN([gl_FUNC_COPY_FILE_RANGE], [ AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + AC_REQUIRE([AC_CANONICAL_HOST]) dnl Persuade glibc <unistd.h> to declare copy_file_range. AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) @@ -21,7 +22,7 @@ AC_DEFUN([gl_FUNC_COPY_FILE_RANGE], [AC_LANG_PROGRAM( [[#include <unistd.h> ]], - [[ssize_t (*func) (int, off_t *, int, off_t, size_t, unsigned) + [[ssize_t (*func) (int, off_t *, int, off_t *, size_t, unsigned) = copy_file_range; return func (0, 0, 0, 0, 0, 0) & 127; ]]) @@ -32,5 +33,27 @@ AC_DEFUN([gl_FUNC_COPY_FILE_RANGE], if test "$gl_cv_func_copy_file_range" != yes; then HAVE_COPY_FILE_RANGE=0 + else + AC_DEFINE([HAVE_COPY_FILE_RANGE], 1, + [Define to 1 if the function copy_file_range exists.]) + + case $host_os in + linux*) + AC_CACHE_CHECK([whether copy_file_range is known to work], + [gl_cv_copy_file_range_known_to_work], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [[#include <linux/version.h> + ]], + [[#if LINUX_VERSION_CODE < KERNEL_VERSION (5, 3, 0) + #error "copy_file_range is buggy" + #endif + ]])], + [gl_cv_copy_file_range_known_to_work=yes], + [gl_cv_copy_file_range_known_to_work=no])]) + if test "$gl_cv_copy_file_range_known_to_work" = no; then + REPLACE_COPY_FILE_RANGE=1 + fi;; + esac fi ]) diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4 index 2e914dbc070..8a12bddd571 100644 --- a/m4/extern-inline.m4 +++ b/m4/extern-inline.m4 @@ -7,7 +7,22 @@ dnl with or without modifications, as long as this notice is preserved. AC_DEFUN([gl_EXTERN_INLINE], [ - AH_VERBATIM([extern_inline], + AC_CACHE_CHECK([whether ctype.h defines __header_inline], + [gl_cv_have___header_inline], + [AC_PREPROC_IFELSE( + [AC_LANG_SOURCE([[#include <ctype.h> + #ifndef __header_inline + #error "<ctype.h> does not define __header_inline" + #endif + ]])], + [gl_cv_have___header_inline=yes], + [gl_cv_have___header_inline=no])]) + if test "$gl_cv_have___header_inline" = yes; then + AC_DEFINE([HAVE___HEADER_INLINE], [1], + [Define to 1 if ctype.h defines __header_inline.]) + fi + + AH_VERBATIM([HAVE___HEADER_INLINE_1], [/* Please see the Gnulib manual for how to use these macros. Suppress extern inline with HP-UX cc, as it appears to be broken; see @@ -54,7 +69,7 @@ AC_DEFUN([gl_EXTERN_INLINE], */ #if (((defined __APPLE__ && defined __MACH__) \ || defined __DragonFly__ || defined __FreeBSD__) \ - && (defined __header_inline \ + && (defined HAVE___HEADER_INLINE \ ? (defined __cplusplus && defined __GNUC_STDC_INLINE__ \ && ! defined __clang__) \ : ((! defined _DONT_USE_CTYPE_INLINE_ \ diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 87a9a751b6a..c5ced04f181 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 69 +# gnulib-common.m4 serial 72 dnl Copyright (C) 2007-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -69,7 +69,9 @@ AC_DEFUN([gl_COMMON_BODY], [ [/* Attributes. */ #if (defined __has_attribute \ && (!defined __clang_minor__ \ - || 3 < __clang_major__ + (5 <= __clang_minor__))) + || (defined __apple_build_version__ \ + ? 6000000 <= __apple_build_version__ \ + : 3 < __clang_major__ + (5 <= __clang_minor__)))) # define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__) #else # define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr @@ -181,7 +183,12 @@ AC_DEFUN([gl_COMMON_BODY], [ #else # define _GL_ATTRIBUTE_DEALLOC(f, i) #endif -#define _GL_ATTRIBUTE_DEALLOC_FREE _GL_ATTRIBUTE_DEALLOC (free, 1) +/* If gnulib's <string.h> or <wchar.h> has already defined this macro, continue + to use this earlier definition, since <stdlib.h> may not have been included + yet. */ +#ifndef _GL_ATTRIBUTE_DEALLOC_FREE +# define _GL_ATTRIBUTE_DEALLOC_FREE _GL_ATTRIBUTE_DEALLOC (free, 1) +#endif /* _GL_ATTRIBUTE_DEPRECATED: Declares that an entity is deprecated. The compiler may warn if the entity is used. */ @@ -813,6 +820,24 @@ AC_DEFUN([gl_CACHE_VAL_SILENT], ]) ]) +# gl_CONDITIONAL(conditional, condition) +# is like AM_CONDITIONAL(conditional, condition), except that it does not +# produce an error +# configure: error: conditional "..." was never defined. +# Usually this means the macro was only invoked conditionally. +# when only invoked conditionally. Instead, in that case, both the _TRUE +# and the _FALSE case are disabled. +AC_DEFUN([gl_CONDITIONAL], +[ + pushdef([AC_CONFIG_COMMANDS_PRE], [:])dnl + AM_CONDITIONAL([$1], [$2]) + popdef([AC_CONFIG_COMMANDS_PRE])dnl + if test -z "${[$1]_TRUE}" && test -z "${[$1]_FALSE}"; then + [$1]_TRUE='#' + [$1]_FALSE='#' + fi +]) + # gl_CC_ALLOW_WARNINGS # sets and substitutes a variable GL_CFLAG_ALLOW_WARNINGS, to a $(CC) option # that reverts a preceding '-Werror' option, if available. @@ -879,6 +904,72 @@ AC_DEFUN([gl_CXX_ALLOW_WARNINGS], AC_SUBST([GL_CXXFLAG_ALLOW_WARNINGS]) ]) +# gl_CC_GNULIB_WARNINGS +# sets and substitutes a variable GL_CFLAG_GNULIB_WARNINGS, to a $(CC) option +# set that enables or disables warnings as suitable for the Gnulib coding style. +AC_DEFUN([gl_CC_GNULIB_WARNINGS], +[ + AC_REQUIRE([gl_CC_ALLOW_WARNINGS]) + dnl Assume that the compiler supports -Wno-* options only if it also supports + dnl -Wno-error. + GL_CFLAG_GNULIB_WARNINGS='' + if test -n "$GL_CFLAG_ALLOW_WARNINGS"; then + dnl Enable these warning options: + dnl + dnl GCC clang + dnl -Wno-cast-qual >= 3 >= 3.9 + dnl -Wno-conversion >= 3 >= 3.9 + dnl -Wno-float-conversion >= 4.9 >= 3.9 + dnl -Wno-float-equal >= 3 >= 3.9 + dnl -Wimplicit-fallthrough >= 7 >= 3.9 + dnl -Wno-pedantic >= 4.8 >= 3.9 + dnl -Wno-sign-compare >= 3 >= 3.9 + dnl -Wno-sign-conversion >= 4.3 >= 3.9 + dnl -Wno-type-limits >= 4.3 >= 3.9 + dnl -Wno-undef >= 3 >= 3.9 + dnl -Wno-unsuffixed-float-constants >= 4.5 + dnl -Wno-unused-function >= 3 >= 3.9 + dnl -Wno-unused-parameter >= 3 >= 3.9 + dnl + cat > conftest.c <<\EOF + #if __GNUC__ >= 3 || (__clang_major__ + (__clang_minor__ >= 9) > 3) + -Wno-cast-qual + -Wno-conversion + -Wno-float-equal + -Wno-sign-compare + -Wno-undef + -Wno-unused-function + -Wno-unused-parameter + #endif + #if __GNUC__ + (__GNUC_MINOR__ >= 9) > 4 || (__clang_major__ + (__clang_minor__ >= 9) > 3) + -Wno-float-conversion + #endif + #if __GNUC__ >= 7 || (__clang_major__ + (__clang_minor__ >= 9) > 3) + -Wimplicit-fallthrough + #endif + #if __GNUC__ + (__GNUC_MINOR__ >= 8) > 4 || (__clang_major__ + (__clang_minor__ >= 9) > 3) + -Wno-pedantic + #endif + #if __GNUC__ + (__GNUC_MINOR__ >= 3) > 4 || (__clang_major__ + (__clang_minor__ >= 9) > 3) + -Wno-sign-conversion + -Wno-type-limits + #endif + #if __GNUC__ + (__GNUC_MINOR__ >= 5) > 4 + -Wno-unsuffixed-float-constants + #endif +EOF + gl_command="$CC $CFLAGS $CPPFLAGS -E conftest.c > conftest.out" + if AC_TRY_EVAL([gl_command]); then + gl_options=`grep -v '#' conftest.out` + for word in $gl_options; do + GL_CFLAG_GNULIB_WARNINGS="$GL_CFLAG_GNULIB_WARNINGS $word" + done + fi + rm -f conftest.c conftest.out + fi + AC_SUBST([GL_CFLAG_GNULIB_WARNINGS]) +]) + dnl gl_CONDITIONAL_HEADER([foo.h]) dnl takes a shell variable GL_GENERATE_FOO_H (with value true or false) as input dnl and produces @@ -903,7 +994,7 @@ AC_DEFUN([gl_CONDITIONAL_HEADER], *) echo "*** gl_generate_var is not set correctly" 1>&2; exit 1 ;; esac AC_SUBST(gl_header_name) - AM_CONDITIONAL(gl_generate_cond, [$gl_generate_var]) + gl_CONDITIONAL(gl_generate_cond, [$gl_generate_var]) m4_popdef([gl_generate_cond]) m4_popdef([gl_generate_var]) m4_popdef([gl_header_name]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index c47ea915f14..fb5f1b52a43 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -3,7 +3,7 @@ # # This file is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or +# the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This file is distributed in the hope that it will be useful, @@ -140,6 +140,7 @@ AC_DEFUN([gl_EARLY], # Code from module mktime: # Code from module mktime-internal: # Code from module multiarch: + # Code from module nanosleep: # Code from module nocrash: # Code from module nproc: # Code from module nstrftime: @@ -236,9 +237,8 @@ AC_DEFUN([gl_INIT], gl_CONDITIONAL_HEADER([byteswap.h]) AC_PROG_MKDIR_P gl_CANONICALIZE_LGPL - if test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1; then - AC_LIBOBJ([canonicalize-lgpl]) - fi + gl_CONDITIONAL([GL_COND_OBJ_CANONICALIZE_LGPL], + [test $HAVE_CANONICALIZE_FILE_NAME = 0 || test $REPLACE_CANONICALIZE_FILE_NAME = 1]) gl_MODULE_INDICATOR([canonicalize-lgpl]) gl_STDLIB_MODULE_INDICATOR([canonicalize_file_name]) gl_STDLIB_MODULE_INDICATOR([realpath]) @@ -247,9 +247,9 @@ AC_DEFUN([gl_INIT], gl_CLOCK_TIME gl_MODULE_INDICATOR([close-stream]) gl_FUNC_COPY_FILE_RANGE - if test $HAVE_COPY_FILE_RANGE = 0; then - AC_LIBOBJ([copy-file-range]) - fi + gl_CONDITIONAL([GL_COND_OBJ_COPY_FILE_RANGE], + [test $HAVE_COPY_FILE_RANGE = 0 || + test $REPLACE_COPY_FILE_RANGE = 1]) gl_UNISTD_MODULE_INDICATOR([copy-file-range]) AC_REQUIRE([AC_C_RESTRICT]) gl_MD5 @@ -265,10 +265,10 @@ AC_DEFUN([gl_INIT], AC_PROG_MKDIR_P gl_DOUBLE_SLASH_ROOT gl_FUNC_DUP2 - if test $REPLACE_DUP2 = 1; then - AC_LIBOBJ([dup2]) + gl_CONDITIONAL([GL_COND_OBJ_DUP2], [test $REPLACE_DUP2 = 1]) + AM_COND_IF([GL_COND_OBJ_DUP2], [ gl_PREREQ_DUP2 - fi + ]) gl_UNISTD_MODULE_INDICATOR([dup2]) gl_ENVIRON gl_UNISTD_MODULE_INDICATOR([environ]) @@ -278,83 +278,77 @@ AC_DEFUN([gl_INIT], gl_EXECINFO_H gl_CONDITIONAL_HEADER([execinfo.h]) AC_PROG_MKDIR_P - if $GL_GENERATE_EXECINFO_H; then - AC_LIBOBJ([execinfo]) - fi + gl_CONDITIONAL([GL_COND_OBJ_EXECINFO], [$GL_GENERATE_EXECINFO_H]) gl_FUNC_EXPLICIT_BZERO - if test $HAVE_EXPLICIT_BZERO = 0; then - AC_LIBOBJ([explicit_bzero]) + gl_CONDITIONAL([GL_COND_OBJ_EXPLICIT_BZERO], [test $HAVE_EXPLICIT_BZERO = 0]) + AM_COND_IF([GL_COND_OBJ_EXPLICIT_BZERO], [ gl_PREREQ_EXPLICIT_BZERO - fi + ]) gl_STRING_MODULE_INDICATOR([explicit_bzero]) AC_REQUIRE([gl_EXTERN_INLINE]) gl_FUNC_FACCESSAT - if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then - AC_LIBOBJ([faccessat]) + gl_CONDITIONAL([GL_COND_OBJ_FACCESSAT], + [test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1]) + AM_COND_IF([GL_COND_OBJ_FACCESSAT], [ gl_PREREQ_FACCESSAT - fi + ]) gl_MODULE_INDICATOR([faccessat]) gl_UNISTD_MODULE_INDICATOR([faccessat]) gl_FUNC_FCHMODAT - if test $HAVE_FCHMODAT = 0 || test $REPLACE_FCHMODAT = 1; then - AC_LIBOBJ([fchmodat]) + gl_CONDITIONAL([GL_COND_OBJ_FCHMODAT], + [test $HAVE_FCHMODAT = 0 || test $REPLACE_FCHMODAT = 1]) + AM_COND_IF([GL_COND_OBJ_FCHMODAT], [ gl_PREREQ_FCHMODAT - fi + ]) gl_SYS_STAT_MODULE_INDICATOR([fchmodat]) gl_FUNC_FCNTL - if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then - AC_LIBOBJ([fcntl]) - fi + gl_CONDITIONAL([GL_COND_OBJ_FCNTL], + [test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1]) gl_FCNTL_MODULE_INDICATOR([fcntl]) gl_FCNTL_H gl_FCNTL_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P gl_FUNC_FDOPENDIR - if test $HAVE_FDOPENDIR = 0 || test $REPLACE_FDOPENDIR = 1; then - AC_LIBOBJ([fdopendir]) - fi + gl_CONDITIONAL([GL_COND_OBJ_FDOPENDIR], + [test $HAVE_FDOPENDIR = 0 || test $REPLACE_FDOPENDIR = 1]) gl_DIRENT_MODULE_INDICATOR([fdopendir]) gl_MODULE_INDICATOR([fdopendir]) gl_FILE_HAS_ACL gl_FILEMODE AC_C_FLEXIBLE_ARRAY_MEMBER gl_FUNC_FPENDING - if test $gl_cv_func___fpending = no; then - AC_LIBOBJ([fpending]) - fi + gl_CONDITIONAL([GL_COND_OBJ_FPENDING], [test $gl_cv_func___fpending = no]) gl_FUNC_FREE - if test $REPLACE_FREE = 1; then - AC_LIBOBJ([free]) + gl_CONDITIONAL([GL_COND_OBJ_FREE], [test $REPLACE_FREE = 1]) + AM_COND_IF([GL_COND_OBJ_FREE], [ gl_PREREQ_FREE - fi + ]) gl_STDLIB_MODULE_INDICATOR([free-posix]) gl_FUNC_FSTATAT - if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then - AC_LIBOBJ([fstatat]) - fi + gl_CONDITIONAL([GL_COND_OBJ_FSTATAT], + [test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1]) gl_SYS_STAT_MODULE_INDICATOR([fstatat]) gl_FSUSAGE - if test $gl_cv_fs_space = yes; then - AC_LIBOBJ([fsusage]) + gl_CONDITIONAL([GL_COND_OBJ_FSUSAGE], [test $gl_cv_fs_space = yes]) + AM_COND_IF([GL_COND_OBJ_FSUSAGE], [ gl_PREREQ_FSUSAGE_EXTRA - fi + ]) gl_FUNC_FSYNC - if test $HAVE_FSYNC = 0; then - AC_LIBOBJ([fsync]) + gl_CONDITIONAL([GL_COND_OBJ_FSYNC], [test $HAVE_FSYNC = 0]) + AM_COND_IF([GL_COND_OBJ_FSYNC], [ gl_PREREQ_FSYNC - fi + ]) gl_UNISTD_MODULE_INDICATOR([fsync]) gl_FUNC_FUTIMENS - if test $HAVE_FUTIMENS = 0 || test $REPLACE_FUTIMENS = 1; then - AC_LIBOBJ([futimens]) - fi + gl_CONDITIONAL([GL_COND_OBJ_FUTIMENS], + [test $HAVE_FUTIMENS = 0 || test $REPLACE_FUTIMENS = 1]) gl_SYS_STAT_MODULE_INDICATOR([futimens]) AC_REQUIRE([AC_CANONICAL_HOST]) gl_GETLOADAVG - if test $HAVE_GETLOADAVG = 0; then - AC_LIBOBJ([getloadavg]) + gl_CONDITIONAL([GL_COND_OBJ_GETLOADAVG], [test $HAVE_GETLOADAVG = 0]) + AM_COND_IF([GL_COND_OBJ_GETLOADAVG], [ gl_PREREQ_GETLOADAVG - fi + ]) gl_STDLIB_MODULE_INDICATOR([getloadavg]) gl_FUNC_GETOPT_GNU dnl Because of the way gl_FUNC_GETOPT_GNU is implemented (the gl_getopt_required @@ -364,26 +358,25 @@ AC_DEFUN([gl_INIT], gl_CONDITIONAL_HEADER([getopt.h]) gl_CONDITIONAL_HEADER([getopt-cdefs.h]) AC_PROG_MKDIR_P - if test $REPLACE_GETOPT = 1; then - AC_LIBOBJ([getopt]) - AC_LIBOBJ([getopt1]) + gl_CONDITIONAL([GL_COND_OBJ_GETOPT], [test $REPLACE_GETOPT = 1]) + AM_COND_IF([GL_COND_OBJ_GETOPT], [ dnl Define the substituted variable GNULIB_UNISTD_H_GETOPT to 1. gl_UNISTD_H_REQUIRE_DEFAULTS gl_MODULE_INDICATOR_INIT_VARIABLE([GNULIB_UNISTD_H_GETOPT], [1]) - fi + ]) gl_UNISTD_MODULE_INDICATOR([getopt-posix]) AC_REQUIRE([AC_CANONICAL_HOST]) gl_FUNC_GETRANDOM - if test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1; then - AC_LIBOBJ([getrandom]) - fi + gl_CONDITIONAL([GL_COND_OBJ_GETRANDOM], + [test $HAVE_GETRANDOM = 0 || test $REPLACE_GETRANDOM = 1]) gl_SYS_RANDOM_MODULE_INDICATOR([getrandom]) gl_GETTIME gl_FUNC_GETTIMEOFDAY - if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then - AC_LIBOBJ([gettimeofday]) + gl_CONDITIONAL([GL_COND_OBJ_GETTIMEOFDAY], + [test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1]) + AM_COND_IF([GL_COND_OBJ_GETTIMEOFDAY], [ gl_PREREQ_GETTIMEOFDAY - fi + ]) gl_SYS_TIME_MODULE_INDICATOR([gettimeofday]) gl_IEEE754_H gl_CONDITIONAL_HEADER([ieee754.h]) @@ -396,17 +389,15 @@ AC_DEFUN([gl_INIT], gl_LIBGMP gl_CONDITIONAL_HEADER([gmp.h]) AC_PROG_MKDIR_P - if test $HAVE_LIBGMP != yes; then - AC_LIBOBJ([mini-gmp-gnulib]) - fi + gl_CONDITIONAL([GL_COND_OBJ_MINI_GMP_GNULIB], [test $HAVE_LIBGMP != yes]) gl_LIMITS_H gl_CONDITIONAL_HEADER([limits.h]) AC_PROG_MKDIR_P gl_FUNC_LSTAT - if test $REPLACE_LSTAT = 1; then - AC_LIBOBJ([lstat]) + gl_CONDITIONAL([GL_COND_OBJ_LSTAT], [test $REPLACE_LSTAT = 1]) + AM_COND_IF([GL_COND_OBJ_LSTAT], [ gl_PREREQ_LSTAT - fi + ]) gl_SYS_STAT_MODULE_INDICATOR([lstat]) gl_FUNC_MEMMEM_SIMPLE if test $HAVE_MEMMEM = 0 || test $REPLACE_MEMMEM = 1; then @@ -414,23 +405,23 @@ AC_DEFUN([gl_INIT], fi gl_STRING_MODULE_INDICATOR([memmem]) gl_FUNC_MEMPCPY - if test $HAVE_MEMPCPY = 0; then - AC_LIBOBJ([mempcpy]) + gl_CONDITIONAL([GL_COND_OBJ_MEMPCPY], [test $HAVE_MEMPCPY = 0]) + AM_COND_IF([GL_COND_OBJ_MEMPCPY], [ gl_PREREQ_MEMPCPY - fi + ]) gl_STRING_MODULE_INDICATOR([mempcpy]) gl_FUNC_MEMRCHR - if test $ac_cv_func_memrchr = no; then - AC_LIBOBJ([memrchr]) + gl_CONDITIONAL([GL_COND_OBJ_MEMRCHR], [test $ac_cv_func_memrchr = no]) + AM_COND_IF([GL_COND_OBJ_MEMRCHR], [ gl_PREREQ_MEMRCHR - fi + ]) gl_STRING_MODULE_INDICATOR([memrchr]) gl_MINMAX gl_FUNC_MKOSTEMP - if test $HAVE_MKOSTEMP = 0; then - AC_LIBOBJ([mkostemp]) + gl_CONDITIONAL([GL_COND_OBJ_MKOSTEMP], [test $HAVE_MKOSTEMP = 0]) + AM_COND_IF([GL_COND_OBJ_MKOSTEMP], [ gl_PREREQ_MKOSTEMP - fi + ]) gl_MODULE_INDICATOR([mkostemp]) gl_STDLIB_MODULE_INDICATOR([mkostemp]) gl_FUNC_MKTIME @@ -440,47 +431,49 @@ AC_DEFUN([gl_INIT], fi gl_TIME_MODULE_INDICATOR([mktime]) gl_MULTIARCH + gl_FUNC_NANOSLEEP + gl_CONDITIONAL([GL_COND_OBJ_NANOSLEEP], + [test $HAVE_NANOSLEEP = 0 || test $REPLACE_NANOSLEEP = 1]) + gl_TIME_MODULE_INDICATOR([nanosleep]) gl_NPROC gl_FUNC_GNU_STRFTIME gl_PATHMAX gl_FUNC_PIPE2 gl_UNISTD_MODULE_INDICATOR([pipe2]) gl_FUNC_PSELECT - if test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1; then - AC_LIBOBJ([pselect]) - fi + gl_CONDITIONAL([GL_COND_OBJ_PSELECT], + [test $HAVE_PSELECT = 0 || test $REPLACE_PSELECT = 1]) gl_SYS_SELECT_MODULE_INDICATOR([pselect]) gl_FUNC_PTHREAD_SIGMASK - if test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1; then - AC_LIBOBJ([pthread_sigmask]) + gl_CONDITIONAL([GL_COND_OBJ_PTHREAD_SIGMASK], + [test $HAVE_PTHREAD_SIGMASK = 0 || test $REPLACE_PTHREAD_SIGMASK = 1]) + AM_COND_IF([GL_COND_OBJ_PTHREAD_SIGMASK], [ gl_PREREQ_PTHREAD_SIGMASK - fi + ]) gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask]) gl_FUNC_READLINK - if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then - AC_LIBOBJ([readlink]) + gl_CONDITIONAL([GL_COND_OBJ_READLINK], + [test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1]) + AM_COND_IF([GL_COND_OBJ_READLINK], [ gl_PREREQ_READLINK - fi + ]) gl_UNISTD_MODULE_INDICATOR([readlink]) gl_FUNC_READLINKAT - if test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1; then - AC_LIBOBJ([readlinkat]) - fi + gl_CONDITIONAL([GL_COND_OBJ_READLINKAT], + [test $HAVE_READLINKAT = 0 || test $REPLACE_READLINKAT = 1]) gl_UNISTD_MODULE_INDICATOR([readlinkat]) gl_REGEX - if test $ac_use_included_regex = yes; then - AC_LIBOBJ([regex]) + gl_CONDITIONAL([GL_COND_OBJ_REGEX], [test $ac_use_included_regex = yes]) + AM_COND_IF([GL_COND_OBJ_REGEX], [ gl_PREREQ_REGEX - fi + ]) gl_FUNC_SIG2STR - if test $ac_cv_func_sig2str = no; then - AC_LIBOBJ([sig2str]) + gl_CONDITIONAL([GL_COND_OBJ_SIG2STR], [test $ac_cv_func_sig2str = no]) + AM_COND_IF([GL_COND_OBJ_SIG2STR], [ gl_PREREQ_SIG2STR - fi + ]) gl_FUNC_SIGDESCR_NP - if test $HAVE_SIGDESCR_NP = 0; then - AC_LIBOBJ([sigdescr_np]) - fi + gl_CONDITIONAL([GL_COND_OBJ_SIGDESCR_NP], [test $HAVE_SIGDESCR_NP = 0]) gl_STRING_MODULE_INDICATOR([sigdescr_np]) gl_SIGNAL_H gl_SIGNAL_H_REQUIRE_DEFAULTS @@ -504,6 +497,8 @@ AC_DEFUN([gl_INIT], gl_STDIO_H gl_STDIO_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P + gl_CONDITIONAL([GL_COND_OBJ_STDIO_READ], [test $REPLACE_STDIO_READ_FUNCS = 1]) + gl_CONDITIONAL([GL_COND_OBJ_STDIO_WRITE], [test $REPLACE_STDIO_WRITE_FUNCS = 1]) dnl No need to create extra modules for these functions. Everyone who uses dnl <stdio.h> likely needs them. gl_STDIO_MODULE_INDICATOR([fscanf]) @@ -531,30 +526,31 @@ AC_DEFUN([gl_INIT], gl_STDLIB_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P gl_FUNC_STPCPY - if test $HAVE_STPCPY = 0; then - AC_LIBOBJ([stpcpy]) + gl_CONDITIONAL([GL_COND_OBJ_STPCPY], [test $HAVE_STPCPY = 0]) + AM_COND_IF([GL_COND_OBJ_STPCPY], [ gl_PREREQ_STPCPY - fi + ]) gl_STRING_MODULE_INDICATOR([stpcpy]) gl_STRING_H gl_STRING_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P gl_FUNC_STRNLEN - if test $HAVE_DECL_STRNLEN = 0 || test $REPLACE_STRNLEN = 1; then - AC_LIBOBJ([strnlen]) + gl_CONDITIONAL([GL_COND_OBJ_STRNLEN], + [test $HAVE_DECL_STRNLEN = 0 || test $REPLACE_STRNLEN = 1]) + AM_COND_IF([GL_COND_OBJ_STRNLEN], [ gl_PREREQ_STRNLEN - fi + ]) gl_STRING_MODULE_INDICATOR([strnlen]) gl_FUNC_STRTOIMAX - if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then - AC_LIBOBJ([strtoimax]) + gl_CONDITIONAL([GL_COND_OBJ_STRTOIMAX], + [test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1]) + AM_COND_IF([GL_COND_OBJ_STRTOIMAX], [ gl_PREREQ_STRTOIMAX - fi + ]) gl_INTTYPES_MODULE_INDICATOR([strtoimax]) gl_FUNC_SYMLINK - if test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1; then - AC_LIBOBJ([symlink]) - fi + gl_CONDITIONAL([GL_COND_OBJ_SYMLINK], + [test $HAVE_SYMLINK = 0 || test $REPLACE_SYMLINK = 1]) gl_UNISTD_MODULE_INDICATOR([symlink]) gl_SYS_RANDOM_H gl_SYS_RANDOM_H_REQUIRE_DEFAULTS @@ -577,21 +573,21 @@ AC_DEFUN([gl_INIT], gl_TIME_H_REQUIRE_DEFAULTS AC_PROG_MKDIR_P gl_TIME_R - if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then - AC_LIBOBJ([time_r]) + gl_CONDITIONAL([GL_COND_OBJ_TIME_R], + [test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1]) + AM_COND_IF([GL_COND_OBJ_TIME_R], [ gl_PREREQ_TIME_R - fi + ]) gl_TIME_MODULE_INDICATOR([time_r]) gl_TIME_RZ - if test $HAVE_TIMEZONE_T = 0; then - AC_LIBOBJ([time_rz]) - fi + gl_CONDITIONAL([GL_COND_OBJ_TIME_RZ], [test $HAVE_TIMEZONE_T = 0]) gl_TIME_MODULE_INDICATOR([time_rz]) gl_FUNC_TIMEGM - if test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1; then - AC_LIBOBJ([timegm]) + gl_CONDITIONAL([GL_COND_OBJ_TIMEGM], + [test $HAVE_TIMEGM = 0 || test $REPLACE_TIMEGM = 1]) + AM_COND_IF([GL_COND_OBJ_TIMEGM], [ gl_PREREQ_TIMEGM - fi + ]) gl_TIME_MODULE_INDICATOR([timegm]) gl_TIMER_TIME gl_TIMESPEC @@ -610,9 +606,8 @@ AC_DEFUN([gl_INIT], [An alias of GNULIB_STDIO_SINGLE_THREAD.]) gl_FUNC_GLIBC_UNLOCKED_IO gl_FUNC_UTIMENSAT - if test $HAVE_UTIMENSAT = 0 || test $REPLACE_UTIMENSAT = 1; then - AC_LIBOBJ([utimensat]) - fi + gl_CONDITIONAL([GL_COND_OBJ_UTIMENSAT], + [test $HAVE_UTIMENSAT = 0 || test $REPLACE_UTIMENSAT = 1]) gl_SYS_STAT_MODULE_INDICATOR([utimensat]) AC_C_VARARRAYS gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false @@ -660,11 +655,11 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_dirfd; then gl_FUNC_DIRFD - if test $ac_cv_func_dirfd = no && test $gl_cv_func_dirfd_macro = no \ - || test $REPLACE_DIRFD = 1; then - AC_LIBOBJ([dirfd]) + gl_CONDITIONAL([GL_COND_OBJ_DIRFD], + [test $ac_cv_func_dirfd = no && test $gl_cv_func_dirfd_macro = no || test $REPLACE_DIRFD = 1]) + AM_COND_IF([GL_COND_OBJ_DIRFD], [ gl_PREREQ_DIRFD - fi + ]) gl_DIRENT_MODULE_INDICATOR([dirfd]) gl_gnulib_enabled_dirfd=true fi @@ -686,10 +681,10 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_euidaccess; then gl_FUNC_EUIDACCESS - if test $HAVE_EUIDACCESS = 0; then - AC_LIBOBJ([euidaccess]) + gl_CONDITIONAL([GL_COND_OBJ_EUIDACCESS], [test $HAVE_EUIDACCESS = 0]) + AM_COND_IF([GL_COND_OBJ_EUIDACCESS], [ gl_PREREQ_EUIDACCESS - fi + ]) gl_UNISTD_MODULE_INDICATOR([euidaccess]) gl_gnulib_enabled_euidaccess=true if test $HAVE_EUIDACCESS = 0; then @@ -702,10 +697,11 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_getdtablesize; then gl_FUNC_GETDTABLESIZE - if test $HAVE_GETDTABLESIZE = 0 || test $REPLACE_GETDTABLESIZE = 1; then - AC_LIBOBJ([getdtablesize]) + gl_CONDITIONAL([GL_COND_OBJ_GETDTABLESIZE], + [test $HAVE_GETDTABLESIZE = 0 || test $REPLACE_GETDTABLESIZE = 1]) + AM_COND_IF([GL_COND_OBJ_GETDTABLESIZE], [ gl_PREREQ_GETDTABLESIZE - fi + ]) gl_UNISTD_MODULE_INDICATOR([getdtablesize]) gl_gnulib_enabled_getdtablesize=true fi @@ -714,9 +710,8 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_getgroups; then gl_FUNC_GETGROUPS - if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then - AC_LIBOBJ([getgroups]) - fi + gl_CONDITIONAL([GL_COND_OBJ_GETGROUPS], + [test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1]) gl_UNISTD_MODULE_INDICATOR([getgroups]) gl_gnulib_enabled_getgroups=true if test $HAVE_GETGROUPS = 0 || test $REPLACE_GETGROUPS = 1; then @@ -736,10 +731,10 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1; then gl_FUNC_GROUP_MEMBER - if test $HAVE_GROUP_MEMBER = 0; then - AC_LIBOBJ([group-member]) + gl_CONDITIONAL([GL_COND_OBJ_GROUP_MEMBER], [test $HAVE_GROUP_MEMBER = 0]) + AM_COND_IF([GL_COND_OBJ_GROUP_MEMBER], [ gl_PREREQ_GROUP_MEMBER - fi + ]) gl_UNISTD_MODULE_INDICATOR([group-member]) gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=true if test $HAVE_GROUP_MEMBER = 0; then @@ -754,10 +749,10 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_lchmod; then gl_FUNC_LCHMOD - if test $HAVE_LCHMOD = 0; then - AC_LIBOBJ([lchmod]) + gl_CONDITIONAL([GL_COND_OBJ_LCHMOD], [test $HAVE_LCHMOD = 0]) + AM_COND_IF([GL_COND_OBJ_LCHMOD], [ gl_PREREQ_LCHMOD - fi + ]) gl_SYS_STAT_MODULE_INDICATOR([lchmod]) gl_gnulib_enabled_lchmod=true fi @@ -806,10 +801,10 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_open; then gl_FUNC_OPEN - if test $REPLACE_OPEN = 1; then - AC_LIBOBJ([open]) + gl_CONDITIONAL([GL_COND_OBJ_OPEN], [test $REPLACE_OPEN = 1]) + AM_COND_IF([GL_COND_OBJ_OPEN], [ gl_PREREQ_OPEN - fi + ]) gl_FCNTL_MODULE_INDICATOR([open]) gl_gnulib_enabled_open=true if test $REPLACE_OPEN = 1; then @@ -827,10 +822,10 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_rawmemchr; then gl_FUNC_RAWMEMCHR - if test $HAVE_RAWMEMCHR = 0; then - AC_LIBOBJ([rawmemchr]) + gl_CONDITIONAL([GL_COND_OBJ_RAWMEMCHR], [test $HAVE_RAWMEMCHR = 0]) + AM_COND_IF([GL_COND_OBJ_RAWMEMCHR], [ gl_PREREQ_RAWMEMCHR - fi + ]) gl_STRING_MODULE_INDICATOR([rawmemchr]) gl_gnulib_enabled_rawmemchr=true fi @@ -889,10 +884,11 @@ AC_DEFUN([gl_INIT], { if ! $gl_gnulib_enabled_strtoll; then gl_FUNC_STRTOLL - if test $HAVE_STRTOLL = 0 || test $REPLACE_STRTOLL = 1; then - AC_LIBOBJ([strtoll]) + gl_CONDITIONAL([GL_COND_OBJ_STRTOLL], + [test $HAVE_STRTOLL = 0 || test $REPLACE_STRTOLL = 1]) + AM_COND_IF([GL_COND_OBJ_STRTOLL], [ gl_PREREQ_STRTOLL - fi + ]) gl_STDLIB_MODULE_INDICATOR([strtoll]) gl_gnulib_enabled_strtoll=true fi @@ -1035,16 +1031,28 @@ AC_DEFUN([gl_INIT], AC_CONFIG_COMMANDS_PRE([ gl_libobjs= gl_ltlibobjs= + gl_libobjdeps= if test -n "$gl_LIBOBJS"; then # Remove the extension. +changequote(,)dnl sed_drop_objext='s/\.o$//;s/\.obj$//' + sed_dirname1='s,//*,/,g' + sed_dirname2='s,\(.\)/$,\1,' + sed_dirname3='s,^[^/]*$,.,' + sed_dirname4='s,\(.\)/[^/]*$,\1,' + sed_basename1='s,.*/,,' +changequote([, ])dnl for i in `for i in $gl_LIBOBJS; do echo "$i"; done | sed -e "$sed_drop_objext" | sort | uniq`; do gl_libobjs="$gl_libobjs $i.$ac_objext" gl_ltlibobjs="$gl_ltlibobjs $i.lo" + i_dir=`echo "$i" | sed -e "$sed_dirname1" -e "$sed_dirname2" -e "$sed_dirname3" -e "$sed_dirname4"` + i_base=`echo "$i" | sed -e "$sed_basename1"` + gl_libobjdeps="$gl_libobjdeps $i_dir/\$(DEPDIR)/$i_base.Po" done fi AC_SUBST([gl_LIBOBJS], [$gl_libobjs]) AC_SUBST([gl_LTLIBOBJS], [$gl_ltlibobjs]) + AC_SUBST([gl_LIBOBJDEPS], [$gl_libobjdeps]) ]) gltests_libdeps= gltests_ltlibdeps= @@ -1087,17 +1095,30 @@ changequote([, ])dnl AC_CONFIG_COMMANDS_PRE([ gltests_libobjs= gltests_ltlibobjs= + gltests_libobjdeps= if test -n "$gltests_LIBOBJS"; then # Remove the extension. +changequote(,)dnl sed_drop_objext='s/\.o$//;s/\.obj$//' + sed_dirname1='s,//*,/,g' + sed_dirname2='s,\(.\)/$,\1,' + sed_dirname3='s,^[^/]*$,.,' + sed_dirname4='s,\(.\)/[^/]*$,\1,' + sed_basename1='s,.*/,,' +changequote([, ])dnl for i in `for i in $gltests_LIBOBJS; do echo "$i"; done | sed -e "$sed_drop_objext" | sort | uniq`; do gltests_libobjs="$gltests_libobjs $i.$ac_objext" gltests_ltlibobjs="$gltests_ltlibobjs $i.lo" + i_dir=`echo "$i" | sed -e "$sed_dirname1" -e "$sed_dirname2" -e "$sed_dirname3" -e "$sed_dirname4"` + i_base=`echo "$i" | sed -e "$sed_basename1"` + gltests_libobjdeps="$gltests_libobjdeps $i_dir/\$(DEPDIR)/$i_base.Po" done fi AC_SUBST([gltests_LIBOBJS], [$gltests_libobjs]) AC_SUBST([gltests_LTLIBOBJS], [$gltests_ltlibobjs]) + AC_SUBST([gltests_LIBOBJDEPS], [$gltests_libobjdeps]) ]) + AC_REQUIRE([gl_CC_GNULIB_WARNINGS]) LIBGNU_LIBDEPS="$gl_libdeps" AC_SUBST([LIBGNU_LIBDEPS]) LIBGNU_LTLIBDEPS="$gl_ltlibdeps" @@ -1288,6 +1309,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/mkostemp.c lib/mktime-internal.h lib/mktime.c + lib/nanosleep.c lib/nproc.c lib/nproc.h lib/nstrftime.c @@ -1330,6 +1352,8 @@ AC_DEFUN([gl_FILE_LIST], [ lib/stddef.in.h lib/stdint.in.h lib/stdio-impl.h + lib/stdio-read.c + lib/stdio-write.c lib/stdio.in.h lib/stdlib.in.h lib/stpcpy.c @@ -1438,6 +1462,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/mktime.m4 m4/mode_t.m4 m4/multiarch.m4 + m4/nanosleep.m4 m4/nocrash.m4 m4/nproc.m4 m4/nstrftime.m4 diff --git a/m4/libgmp.m4 b/m4/libgmp.m4 index a2dee933829..d69dcc7237a 100644 --- a/m4/libgmp.m4 +++ b/m4/libgmp.m4 @@ -1,4 +1,4 @@ -# libgmp.m4 serial 6 +# libgmp.m4 serial 7 # Configure the GMP library or a replacement. dnl Copyright 2020-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -63,8 +63,8 @@ AC_DEFUN([gl_LIBGMP], else GL_GENERATE_GMP_H=true fi - AM_CONDITIONAL([GL_GENERATE_MINI_GMP_H], + gl_CONDITIONAL([GL_GENERATE_MINI_GMP_H], [test $HAVE_LIBGMP != yes]) - AM_CONDITIONAL([GL_GENERATE_GMP_GMP_H], + gl_CONDITIONAL([GL_GENERATE_GMP_GMP_H], [test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" != yes]) ]) diff --git a/m4/mktime.m4 b/m4/mktime.m4 index d48f40d187b..431b17dcb0d 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,4 +1,4 @@ -# serial 36 +# serial 37 dnl Copyright (C) 2002-2003, 2005-2007, 2009-2022 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -82,7 +82,8 @@ spring_forward_gap () instead of "TZ=America/Vancouver" in order to detect the bug even on systems that don't support the Olson extension, or don't have the full zoneinfo tables installed. */ - putenv ("TZ=PST8PDT,M4.1.0,M10.5.0"); + if (putenv ("TZ=PST8PDT,M4.1.0,M10.5.0") != 0) + return -1; tm.tm_year = 98; tm.tm_mon = 3; @@ -170,7 +171,8 @@ year_2050_test () instead of "TZ=America/Vancouver" in order to detect the bug even on systems that don't support the Olson extension, or don't have the full zoneinfo tables installed. */ - putenv ("TZ=PST8PDT,M4.1.0,M10.5.0"); + if (putenv ("TZ=PST8PDT,M4.1.0,M10.5.0") != 0) + return -1; t = mktime (&tm); @@ -181,6 +183,25 @@ year_2050_test () || (0 < t && answer - 120 <= t && t <= answer + 120)); } +static int +indiana_test () +{ + if (putenv ("TZ=America/Indiana/Indianapolis") != 0) + return -1; + struct tm tm; + tm.tm_year = 1986 - 1900; tm.tm_mon = 4 - 1; tm.tm_mday = 28; + tm.tm_hour = 16; tm.tm_min = 24; tm.tm_sec = 50; tm.tm_isdst = 0; + time_t std = mktime (&tm); + if (! (std == 515107490 || std == 515107503)) + return 1; + + /* This platform supports TZDB, either without or with leap seconds. + Return true if GNU Bug#48085 is absent. */ + tm.tm_isdst = 1; + time_t dst = mktime (&tm); + return std - dst == 60 * 60; +} + int main () { @@ -236,7 +257,7 @@ main () result |= 16; if (! spring_forward_gap ()) result |= 32; - if (! year_2050_test ()) + if (! year_2050_test () || ! indiana_test ()) result |= 64; return result; }]])], diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4 new file mode 100644 index 00000000000..1964b1ea47d --- /dev/null +++ b/m4/nanosleep.m4 @@ -0,0 +1,139 @@ +# serial 41 + +dnl From Jim Meyering. +dnl Check for the nanosleep function. +dnl If not found, use the supplied replacement. +dnl + +# Copyright (C) 1999-2001, 2003-2022 Free Software Foundation, Inc. + +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_NANOSLEEP], +[ + AC_REQUIRE([gl_TIME_H_DEFAULTS]) + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles + + dnl Persuade glibc and Solaris <time.h> to declare nanosleep. + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + + AC_CHECK_DECLS_ONCE([alarm]) + + nanosleep_save_libs=$LIBS + + # Solaris 2.5.1 needs -lposix4 to get the nanosleep function. + # Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4. + LIB_NANOSLEEP= + AC_SUBST([LIB_NANOSLEEP]) + AC_SEARCH_LIBS([nanosleep], [rt posix4], + [test "$ac_cv_search_nanosleep" = "none required" || + LIB_NANOSLEEP=$ac_cv_search_nanosleep]) + if test "x$ac_cv_search_nanosleep" != xno; then + dnl The system has a nanosleep function. + + AC_REQUIRE([gl_MULTIARCH]) + if test $APPLE_UNIVERSAL_BUILD = 1; then + # A universal build on Apple Mac OS X platforms. + # The test result would be 'no (mishandles large arguments)' in 64-bit + # mode but 'yes' in 32-bit mode. But we need a configuration result that + # is valid in both modes. + gl_cv_func_nanosleep='no (mishandles large arguments)' + fi + + AC_CACHE_CHECK([for working nanosleep], + [gl_cv_func_nanosleep], + [ + AC_RUN_IFELSE( + [AC_LANG_SOURCE([[ + #include <errno.h> + #include <limits.h> + #include <signal.h> + #include <time.h> + #include <unistd.h> + #define TYPE_SIGNED(t) (! ((t) 0 < (t) -1)) + #define TYPE_MAXIMUM(t) \ + ((t) (! TYPE_SIGNED (t) \ + ? (t) -1 \ + : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1))) + + #if HAVE_DECL_ALARM + static void + check_for_SIGALRM (int sig) + { + if (sig != SIGALRM) + _exit (1); + } + #endif + + int + main () + { + static struct timespec ts_sleep; + static struct timespec ts_remaining; + /* Test for major problems first. */ + if (! nanosleep) + return 2; + ts_sleep.tv_sec = 0; + ts_sleep.tv_nsec = 1; + #if HAVE_DECL_ALARM + { + static struct sigaction act; + act.sa_handler = check_for_SIGALRM; + sigemptyset (&act.sa_mask); + sigaction (SIGALRM, &act, NULL); + alarm (1); + if (nanosleep (&ts_sleep, NULL) != 0) + return 3; + /* Test for a minor problem: the handling of large arguments. */ + ts_sleep.tv_sec = TYPE_MAXIMUM (time_t); + ts_sleep.tv_nsec = 999999999; + alarm (1); + if (nanosleep (&ts_sleep, &ts_remaining) != -1) + return 4; + if (errno != EINTR) + return 5; + if (ts_remaining.tv_sec <= TYPE_MAXIMUM (time_t) - 10) + return 6; + } + #else /* A simpler test for native Windows. */ + if (nanosleep (&ts_sleep, &ts_remaining) < 0) + return 3; + #endif + return 0; + }]])], + [gl_cv_func_nanosleep=yes], + [case $? in dnl ( + 4|5|6) gl_cv_func_nanosleep='no (mishandles large arguments)';; dnl ( + *) gl_cv_func_nanosleep=no;; + esac], + [case "$host_os" in dnl (( + linux*) # Guess it halfway works when the kernel is Linux. + gl_cv_func_nanosleep='guessing no (mishandles large arguments)' ;; + mingw*) # Guess no on native Windows. + gl_cv_func_nanosleep='guessing no' ;; + *) # If we don't know, obey --enable-cross-guesses. + gl_cv_func_nanosleep="$gl_cross_guess_normal" ;; + esac + ]) + ]) + case "$gl_cv_func_nanosleep" in + *yes) + REPLACE_NANOSLEEP=0 + ;; + *) + REPLACE_NANOSLEEP=1 + case "$gl_cv_func_nanosleep" in + *"mishandles large arguments"*) + AC_DEFINE([HAVE_BUG_BIG_NANOSLEEP], [1], + [Define to 1 if nanosleep mishandles large arguments.]) + ;; + esac + ;; + esac + else + HAVE_NANOSLEEP=0 + fi + LIBS=$nanosleep_save_libs +]) diff --git a/m4/stdio_h.m4 b/m4/stdio_h.m4 index cc80e77365f..42e96071f8b 100644 --- a/m4/stdio_h.m4 +++ b/m4/stdio_h.m4 @@ -1,4 +1,4 @@ -# stdio_h.m4 serial 57 +# stdio_h.m4 serial 59 dnl Copyright (C) 2007-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -40,41 +40,32 @@ AC_DEFUN_ONCE([gl_STDIO_H], attribute "__gnu_printf__" instead of "__printf__"]) fi - dnl This ifdef is necessary to avoid an error "missing file lib/stdio-read.c" - dnl "expected source file, required through AC_LIBSOURCES, not found". It is - dnl also an optimization, to avoid performing a configure check whose result - dnl is not used. But it does not make the test of GNULIB_STDIO_H_NONBLOCKING - dnl or GNULIB_NONBLOCKING redundant. + dnl This ifdef is an optimization, to avoid performing a configure check whose + dnl result is not used. But it does not make the test of + dnl GNULIB_STDIO_H_NONBLOCKING or GNULIB_NONBLOCKING redundant. m4_ifdef([gl_NONBLOCKING_IO], [ gl_NONBLOCKING_IO if test $gl_cv_have_nonblocking != yes; then REPLACE_STDIO_READ_FUNCS=1 - AC_LIBOBJ([stdio-read]) fi ]) - dnl This ifdef is necessary to avoid an error "missing file lib/stdio-write.c" - dnl "expected source file, required through AC_LIBSOURCES, not found". It is - dnl also an optimization, to avoid performing a configure check whose result - dnl is not used. But it does not make the test of GNULIB_STDIO_H_SIGPIPE or - dnl GNULIB_SIGPIPE redundant. + dnl This ifdef is an optimization, to avoid performing a configure check whose + dnl result is not used. But it does not make the test of + dnl GNULIB_STDIO_H_SIGPIPE or GNULIB_SIGPIPE redundant. m4_ifdef([gl_SIGNAL_SIGPIPE], [ gl_SIGNAL_SIGPIPE if test $gl_cv_header_signal_h_SIGPIPE != yes; then REPLACE_STDIO_WRITE_FUNCS=1 - AC_LIBOBJ([stdio-write]) fi ]) - dnl This ifdef is necessary to avoid an error "missing file lib/stdio-write.c" - dnl "expected source file, required through AC_LIBSOURCES, not found". It is - dnl also an optimization, to avoid performing a configure check whose result - dnl is not used. But it does not make the test of GNULIB_STDIO_H_NONBLOCKING - dnl or GNULIB_NONBLOCKING redundant. + dnl This ifdef is an optimization, to avoid performing a configure check whose + dnl result is not used. But it does not make the test of + dnl GNULIB_STDIO_H_NONBLOCKING or GNULIB_NONBLOCKING redundant. m4_ifdef([gl_NONBLOCKING_IO], [ gl_NONBLOCKING_IO if test $gl_cv_have_nonblocking != yes; then REPLACE_STDIO_WRITE_FUNCS=1 - AC_LIBOBJ([stdio-write]) fi ]) diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index f93f97a1bda..4c66ccc0a40 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -222,6 +222,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], REPLACE_ACCESS=0; AC_SUBST([REPLACE_ACCESS]) REPLACE_CHOWN=0; AC_SUBST([REPLACE_CHOWN]) REPLACE_CLOSE=0; AC_SUBST([REPLACE_CLOSE]) + REPLACE_COPY_FILE_RANGE=0; AC_SUBST([REPLACE_COPY_FILE_RANGE]) REPLACE_DUP=0; AC_SUBST([REPLACE_DUP]) REPLACE_DUP2=0; AC_SUBST([REPLACE_DUP2]) REPLACE_EXECL=0; AC_SUBST([REPLACE_EXECL]) diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 86f00c024a8..cc29ad02819 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -50,6 +50,7 @@ s/\.h\.in/.h-in/ /^LIB_ACL *=/s/@LIB_ACL@// /^LIB_EACCESS *=/s/@LIB_EACCESS@// /^LIB_FDATASYNC *=/s/@LIB_FDATASYNC@// +/^LIB_NANOSLEEP *=/s/@LIB_NANOSLEEP@// s/ *@LIBTIFF@// s/ *@LIBJPEG@// s/ *@LIBPNG@// diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 8602aaf449e..45e03621ce3 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -418,6 +418,8 @@ s/= @GL_GENERATE_LIMITS_H_CONDITION@/= / s/= @GL_GENERATE_GMP_H_CONDITION@/= 1/ s/= @GL_GENERATE_GMP_GMP_H_CONDITION@/= / s/= @GL_GENERATE_MINI_GMP_H_CONDITION@/= 1/ +s/= @GL_COND_OBJ_STDIO_READ_CONDITION@/= / +s/= @GL_COND_OBJ_STDIO_WRITE_CONDITION@/= / s/\$\(MKDIR_P\) malloc// # # Determine which modules to build and which to omit @@ -429,7 +431,6 @@ OMIT_GNULIB_MODULE_careadlinkat = true\ OMIT_GNULIB_MODULE_cloexec = true\ OMIT_GNULIB_MODULE_dirent = true\ OMIT_GNULIB_MODULE_dirfd = true\ -OMIT_GNULIB_MODULE_scratch_buffer = true\ OMIT_GNULIB_MODULE_dup2 = true\ OMIT_GNULIB_MODULE_errno = true\ OMIT_GNULIB_MODULE_euidaccess = true\ @@ -445,6 +446,7 @@ OMIT_GNULIB_MODULE_group-member = true\ OMIT_GNULIB_MODULE_inttypes-incomplete = true\ OMIT_GNULIB_MODULE_localtime-buffer = true\ OMIT_GNULIB_MODULE_lstat = true\ +OMIT_GNULIB_MODULE_nanosleep = true\ OMIT_GNULIB_MODULE_open = true\ OMIT_GNULIB_MODULE_pipe2 = true\ OMIT_GNULIB_MODULE_pselect = true\ diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index 4748474f1dc..69119b135e2 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -74,3 +74,4 @@ OMIT_GNULIB_MODULE_futimens = true OMIT_GNULIB_MODULE_utimensat = true OMIT_GNULIB_MODULE_file-has-acl = true OMIT_GNULIB_MODULE_nproc = true +OMIT_GNULIB_MODULE_nanosleep = true diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site index 6ab81e943f1..7ca19cbad06 100644 --- a/nt/mingw-cfg.site +++ b/nt/mingw-cfg.site @@ -167,3 +167,6 @@ ac_cv_func_strsignal=no # implementation of 'free' doesn't touch errno, and it emits a # compilation warning. gl_cv_func_free_preserves_errno=yes +# Don't build the Gnulib nanosleep module: it requires W2K or later, +# and MinGW does have nanosleep. +gl_cv_func_nanosleep=yes diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c index 646631df84b..e679c2ffed6 100644 --- a/oldXMenu/Activate.c +++ b/oldXMenu/Activate.c @@ -121,6 +121,8 @@ int x_menu_grab_keyboard = 1; static Wait_func wait_func; static void* wait_data; +static Translate_func translate_func = NULL; +static Expose_func expose_func = NULL; void XMenuActivateSetWaitFunction (Wait_func func, void *data) @@ -129,6 +131,18 @@ XMenuActivateSetWaitFunction (Wait_func func, void *data) wait_data = data; } +void +XMenuActivateSetTranslateFunction (Translate_func func) +{ + translate_func = func; +} + +void +XMenuActivateSetExposeFunction (Expose_func func) +{ + expose_func = func; +} + int XMenuActivate( register Display *display, /* Display to put menu on. */ @@ -332,6 +346,9 @@ XMenuActivate( feq = feq_tmp; } else if (_XMEventHandler) (*_XMEventHandler)(&event); + + if (expose_func) + expose_func (&event); break; } if (event_xmp->activated) { @@ -449,6 +466,9 @@ XMenuActivate( * If the current selection was activated then * deactivate it. */ + /* Emacs specific, HELP_STRING cannot be validly NULL + * in the real XMenu library. */ + help_callback (NULL, cur_p->serial, cur_s->serial); if (cur_s->activated) { cur_s->activated = False; _XMRefreshSelection(display, menu, cur_s); @@ -515,6 +535,12 @@ XMenuActivate( feq = feq_tmp; } else if (_XMEventHandler) (*_XMEventHandler)(&event); + break; +#ifdef HAVE_XINPUT2 + case GenericEvent: + if (translate_func) + translate_func (&event); +#endif } /* * If a selection has been made, break out of the event loop. diff --git a/oldXMenu/XMenu.h b/oldXMenu/XMenu.h index 50ea6834090..54061235ae7 100644 --- a/oldXMenu/XMenu.h +++ b/oldXMenu/XMenu.h @@ -255,6 +255,12 @@ typedef struct _xmenu { typedef void (*Wait_func)(void*); +/* Function for translating GenericEvents. It is should call + XPutBackEvent on an equivalent artificial core event on any + function it wants to translate. */ +typedef void (*Translate_func)(XEvent *); +typedef void (*Expose_func)(XEvent *); + /* * XMenu library routine declarations. */ @@ -274,6 +280,8 @@ void XMenuEventHandler(int (*handler) (XEvent *)); int XMenuLocate(Display *display, XMenu *menu, int p_num, int s_num, int x_pos, int y_pos, int *ul_x, int *ul_y, int *width, int *height); void XMenuSetFreeze(XMenu *menu, int freeze); void XMenuActivateSetWaitFunction(Wait_func func, void *data); +void XMenuActivateSetTranslateFunction(Translate_func func); +void XMenuActivateSetExposeFunction(Expose_func func); int XMenuActivate(Display *display, XMenu *menu, int *p_num, int *s_num, int x_pos, int y_pos, unsigned int event_mask, char **data, void (*help_callback) (char const *, int, int)); char *XMenuPost(Display *display, XMenu *menu, int *p_num, int *s_num, int x_pos, int y_pos, int event_mask); int XMenuDeletePane(Display *display, XMenu *menu, int p_num); diff --git a/oldXMenu/XMenuInt.h b/oldXMenu/XMenuInt.h index 86b8e057cd5..5d5365ad8f2 100644 --- a/oldXMenu/XMenuInt.h +++ b/oldXMenu/XMenuInt.h @@ -37,6 +37,8 @@ without express or implied warranty. #include <config.h> +#include <attribute.h> + /* Avoid warnings about redefining NULL by including <stdio.h> first; the other file which wants to define it (<stddef.h> on Ultrix systems) can deal if NULL is already defined, but <stdio.h> can't. */ diff --git a/src/Makefile.in b/src/Makefile.in index 3353fb16d79..2b7c4bb316c 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -146,6 +146,7 @@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ LIB_ACL=@LIB_ACL@ LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@ LIB_EACCESS=@LIB_EACCESS@ +LIB_NANOSLEEP=@LIB_NANOSLEEP@ LIB_TIMER_TIME=@LIB_TIMER_TIME@ DBUS_CFLAGS = @DBUS_CFLAGS@ @@ -548,7 +549,7 @@ lisp = $(addprefix ${lispsource}/,${shortlisp}) LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBX_OTHER) $(LIBSOUND) \ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(LIB_CLOCK_GETTIME) \ - $(WEBKIT_LIBS) \ + $(LIB_NANOSLEEP) $(WEBKIT_LIBS) \ $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ $(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \ $(XDBE_LIBS) $(XSYNC_LIBS) \ diff --git a/src/alloc.c b/src/alloc.c index 9ed94dc8a1e..c19e3dabb6e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4928,7 +4928,7 @@ mark_maybe_pointer (void *p, bool symbol_only) /* Mark Lisp objects referenced from the address range START..END or END..START. */ -static void ATTRIBUTE_NO_SANITIZE_ADDRESS +void ATTRIBUTE_NO_SANITIZE_ADDRESS mark_memory (void const *start, void const *end) { char const *pp; diff --git a/src/bidi.c b/src/bidi.c index 16faf655b26..4d2c74b17cd 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -2758,6 +2758,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it) (which requires the display engine to copy the cache back and forth many times). */ if (maxlevel == base_level + && (l2r_seen || r2l_seen) /* N0d */ && ((base_level == 0 && !r2l_seen) || (base_level == 1 && !l2r_seen))) { @@ -2920,13 +2921,17 @@ bidi_resolve_brackets (struct bidi_it *bidi_it) int embedding_level = bidi_it->level_stack[bidi_it->stack_idx].level; bidi_type_t embedding_type = (embedding_level & 1) ? STRONG_R : STRONG_L; - eassert (bidi_it->prev_for_neutral.type != UNKNOWN_BT); eassert (bidi_it->bracket_pairing_pos > bidi_it->charpos); if (bidi_it->bracket_enclosed_type == embedding_type) /* N0b */ type = embedding_type; - else + else if (bidi_it->bracket_enclosed_type == STRONG_L /* N0c, N0d */ + || bidi_it->bracket_enclosed_type == STRONG_R) { - switch (bidi_it->prev_for_neutral.type) + bidi_type_t prev_type_for_neutral = bidi_it->prev_for_neutral.type; + + if (prev_type_for_neutral == UNKNOWN_BT) + prev_type_for_neutral = embedding_type; + switch (prev_type_for_neutral) { case STRONG_R: case WEAK_EN: diff --git a/src/bignum.c b/src/bignum.c index cb5322f291a..e4e4d45d686 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -476,3 +476,96 @@ check_int_nonnegative (Lisp_Object x) CHECK_INTEGER (x); return NILP (Fnatnump (x)) ? 0 : check_integer_range (x, 0, INT_MAX); } + +/* Return a random mp_limb_t. */ + +static mp_limb_t +get_random_limb (void) +{ + if (GMP_NUMB_BITS <= ULONG_WIDTH) + return get_random_ulong (); + + /* Work around GCC -Wshift-count-overflow false alarm. */ + int shift = GMP_NUMB_BITS <= ULONG_WIDTH ? 0 : ULONG_WIDTH; + + /* This is in case someone builds GMP with unusual definitions for + MINI_GMP_LIMB_TYPE or _LONG_LONG_LIMB. */ + mp_limb_t r = 0; + for (int i = 0; i < GMP_NUMB_BITS; i += ULONG_WIDTH) + r = (r << shift) | get_random_ulong (); + return r; +} + +/* Return a random mp_limb_t I in the range 0 <= I < LIM. + If LIM is zero, simply return a random mp_limb_t. */ + +static mp_limb_t +get_random_limb_lim (mp_limb_t lim) +{ + /* Return the remainder of a random mp_limb_t R divided by LIM, + except reject the rare case where R is so close to the maximum + mp_limb_t that the remainder isn't random. */ + mp_limb_t difflim = - lim, diff, remainder; + do + { + mp_limb_t r = get_random_limb (); + if (lim == 0) + return r; + remainder = r % lim; + diff = r - remainder; + } + while (difflim < diff); + + return remainder; +} + +/* Return a random Lisp integer I in the range 0 <= I < LIMIT, + where LIMIT is a positive bignum. */ + +Lisp_Object +get_random_bignum (struct Lisp_Bignum const *limit) +{ + mpz_t const *lim = bignum_val (limit); + mp_size_t nlimbs = mpz_size (*lim); + eassume (0 < nlimbs); + mp_limb_t *r_limb = mpz_limbs_write (mpz[0], nlimbs); + mp_limb_t const *lim_limb = mpz_limbs_read (*lim); + mp_limb_t limhi = lim_limb[nlimbs - 1]; + eassert (limhi); + bool edgy; + + do + { + /* Generate the result one limb at a time, most significant first. + Choose the most significant limb RHI randomly from 0..LIMHI, + where LIMHI is the LIM's first limb, except choose from + 0..(LIMHI-1) if there is just one limb. RHI == LIMHI is an + unlucky edge case as later limbs might cause the result to be + exceed or equal LIM; if this happens, it causes another + iteration in the outer loop. */ + + mp_limb_t rhi = get_random_limb_lim (limhi + (1 < nlimbs)); + edgy = rhi == limhi; + r_limb[nlimbs - 1] = rhi; + + for (mp_size_t i = nlimbs - 1; 0 < i--; ) + { + /* get_random_limb_lim (edgy ? limb_lim[i] + 1 : 0) + would be wrong here, as the full mp_limb_t range is + needed in later limbs for the edge case to have the + proper weighting. */ + mp_limb_t ri = get_random_limb (); + if (edgy) + { + if (lim_limb[i] < ri) + break; + edgy = lim_limb[i] == ri; + } + r_limb[i] = ri; + } + } + while (edgy); + + mpz_limbs_finish (mpz[0], nlimbs); + return make_integer_mpz (); +} diff --git a/src/bignum.h b/src/bignum.h index 5f94ce850cf..de9ee17c027 100644 --- a/src/bignum.h +++ b/src/bignum.h @@ -51,6 +51,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT) extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long) ARG_NONNULL ((1, 2)); extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST; +extern Lisp_Object get_random_bignum (struct Lisp_Bignum const *); INLINE_HEADER_BEGIN diff --git a/src/buffer.c b/src/buffer.c index 91ff6b946f7..f8a7a4f5109 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1159,11 +1159,9 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) else { char number[sizeof "-999999"]; - - /* Use XFIXNUM instead of XFIXNAT to work around GCC bug 80776. */ - int i = XFIXNUM (Frandom (make_fixnum (1000000))); - eassume (0 <= i && i < 1000000); - + EMACS_INT r = get_random (); + eassume (0 <= r); + int i = r % 1000000; AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i)); genbase = concat2 (name, lnumber); if (NILP (Fget_buffer (genbase))) diff --git a/src/bytecode.c b/src/bytecode.c index 96f1f905812..ed1f6ca4a85 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" #include "blockinput.h" +#include "sysstdio.h" #include "character.h" #include "buffer.h" #include "keyboard.h" @@ -186,6 +187,7 @@ DEFINE (Bfollowing_char, 0147) \ DEFINE (Bpreceding_char, 0150) \ DEFINE (Bcurrent_column, 0151) \ DEFINE (Bindent_to, 0152) \ +/* 0153 was Bscan_buffer in v17. */ \ DEFINE (Beolp, 0154) \ DEFINE (Beobp, 0155) \ DEFINE (Bbolp, 0156) \ @@ -193,6 +195,7 @@ DEFINE (Bbobp, 0157) \ DEFINE (Bcurrent_buffer, 0160) \ DEFINE (Bset_buffer, 0161) \ DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ +/* 0163 was Bset_mark in v17. */ \ DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ \ DEFINE (Bforward_char, 0165) \ @@ -253,11 +256,7 @@ DEFINE (Brem, 0246) \ DEFINE (Bnumberp, 0247) \ DEFINE (Bintegerp, 0250) \ \ -DEFINE (BRgoto, 0252) \ -DEFINE (BRgotoifnil, 0253) \ -DEFINE (BRgotoifnonnil, 0254) \ -DEFINE (BRgotoifnilelsepop, 0255) \ -DEFINE (BRgotoifnonnilelsepop, 0256) \ +/* 0252-0256 were relative jumps, apparently never used. */ \ \ DEFINE (BlistN, 0257) \ DEFINE (BconcatN, 0260) \ @@ -277,11 +276,6 @@ enum byte_code_op #define DEFINE(name, value) name = value, BYTE_CODES #undef DEFINE - -#if BYTE_CODE_SAFE - Bscan_buffer = 0153, /* No longer generated as of v18. */ - Bset_mark = 0163, /* this loser is no longer generated as of v18 */ -#endif }; /* Fetch the next byte from the bytecode stream. */ @@ -291,7 +285,7 @@ enum byte_code_op /* Fetch two bytes from the bytecode stream and make a 16-bit number out of them. */ -#define FETCH2 (op = FETCH, op + (FETCH << 8)) +#define FETCH2 (op = FETCH, op | (FETCH << 8)) /* Push X onto the execution stack. The expression X should not contain TOP, to avoid competing side effects. */ @@ -331,9 +325,8 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } - pin_string (bytestr); // Bytecode must be immovable. - - return exec_byte_code (bytestr, vector, maxdepth, 0, 0, NULL); + Lisp_Object fun = CALLN (Fmake_byte_code, 0, bytestr, vector, maxdepth); + return exec_byte_code (fun, 0, 0, NULL); } static void @@ -342,48 +335,186 @@ bcall0 (Lisp_Object f) Ffuncall (1, &f); } -/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and - MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, - emacs may crash!). ARGS_TEMPLATE is the function arity encoded as an - integer, and ARGS, of size NARGS, should be a vector of the actual - arguments. The arguments in ARGS are pushed on the stack according - to ARGS_TEMPLATE before executing BYTESTR. */ +/* The bytecode stack size in bytes. + This is a fairly generous amount, but: + - if users need more, we could allocate more, or just reserve the address + space and allocate on demand + - if threads are used more, then it might be a good idea to reduce the + per-thread overhead in time and space + - for maximum flexibility but a small runtime penalty, we could allocate + the stack in smaller chunks as needed +*/ +#define BC_STACK_SIZE (512 * 1024 * sizeof (Lisp_Object)) + +/* Bytecode interpreter stack: + + |--------------| -- + |fun | | ^ stack growth + |saved_pc | | | direction + |saved_top ------- | + fp--->|saved_fp ---- | | current frame + |--------------| | | | (called from bytecode in this example) + | (free) | | | | + top-->| ...stack... | | | | + : ... : | | | + |incoming args | | | | + |--------------| | | -- + |fun | | | | + |saved_pc | | | | + |saved_top | | | | + |saved_fp |<- | | previous frame + |--------------| | | + | (free) | | | + | ...stack... |<---- | + : ... : | + |incoming args | | + |--------------| -- + : : +*/ + +/* bytecode stack frame header (footer, actually) */ +struct bc_frame { + struct bc_frame *saved_fp; /* previous frame pointer, + NULL if bottommost frame */ + + /* In a frame called directly from C, the following two members are NULL. */ + Lisp_Object *saved_top; /* previous stack pointer */ + const unsigned char *saved_pc; /* previous program counter */ + + Lisp_Object fun; /* current function object */ + + Lisp_Object next_stack[]; /* data stack of next frame */ +}; + +void +init_bc_thread (struct bc_thread_state *bc) +{ + bc->stack = xmalloc (BC_STACK_SIZE); + bc->stack_end = bc->stack + BC_STACK_SIZE; + /* Put a dummy header at the bottom to indicate the first free location. */ + bc->fp = (struct bc_frame *)bc->stack; + memset (bc->fp, 0, sizeof *bc->fp); +} + +void +free_bc_thread (struct bc_thread_state *bc) +{ + xfree (bc->stack); +} + +void +mark_bytecode (struct bc_thread_state *bc) +{ + struct bc_frame *fp = bc->fp; + Lisp_Object *top = NULL; /* stack pointer of topmost frame not known */ + for (;;) + { + struct bc_frame *next_fp = fp->saved_fp; + /* Only the dummy frame at the bottom has saved_fp = NULL. */ + if (!next_fp) + break; + mark_object (fp->fun); + Lisp_Object *frame_base = next_fp->next_stack; + if (top) + { + /* The stack pointer of a frame is known: mark the part of the stack + above it conservatively. This includes any outgoing arguments. */ + mark_memory (top + 1, fp); + /* Mark the rest of the stack precisely. */ + mark_objects (frame_base, top + 1 - frame_base); + } + else + { + /* The stack pointer is unknown -- mark everything conservatively. */ + mark_memory (frame_base, fp); + } + top = fp->saved_top; + fp = next_fp; + } +} + +DEFUN ("internal-stack-stats", Finternal_stack_stats, Sinternal_stack_stats, + 0, 0, 0, + doc: /* internal */) + (void) +{ + struct bc_thread_state *bc = ¤t_thread->bc; + int nframes = 0; + int nruns = 0; + for (struct bc_frame *fp = bc->fp; fp; fp = fp->saved_fp) + { + nframes++; + if (fp->saved_top == NULL) + nruns++; + } + fprintf (stderr, "%d stack frames, %d runs\n", nframes, nruns); + return Qnil; +} + +/* Whether a stack pointer is valid in the current frame. */ +INLINE bool +valid_sp (struct bc_thread_state *bc, Lisp_Object *sp) +{ + struct bc_frame *fp = bc->fp; + return sp < (Lisp_Object *)fp && sp + 1 >= fp->saved_fp->next_stack; +} + +/* Execute the byte-code in FUN. ARGS_TEMPLATE is the function arity + encoded as an integer (the one in FUN is ignored), and ARGS, of + size NARGS, should be a vector of the actual arguments. The + arguments in ARGS are pushed on the stack according to + ARGS_TEMPLATE before executing FUN. */ Lisp_Object -exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, - ptrdiff_t args_template, ptrdiff_t nargs, Lisp_Object *args) +exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, + ptrdiff_t nargs, Lisp_Object *args) { #ifdef BYTE_CODE_METER int volatile this_op = 0; #endif + unsigned char quitcounter = 1; + struct bc_thread_state *bc = ¤t_thread->bc; + + /* Values used for the first stack record when called from C. */ + Lisp_Object *top = NULL; + unsigned char const *pc = NULL; + + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + setup_frame: ; eassert (!STRING_MULTIBYTE (bytestr)); eassert (string_immovable_p (bytestr)); + /* FIXME: in debug mode (!NDEBUG, BYTE_CODE_SAFE or enabled checking), + save the specpdl index on function entry and check that it is the same + when returning, to detect unwind imbalances. This would require adding + a field to the frame header. */ + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + Lisp_Object maxdepth = AREF (fun, COMPILED_STACK_DEPTH); ptrdiff_t const_length = ASIZE (vector); ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; - unsigned char quitcounter = 1; - /* Allocate two more slots than required, because... */ - EMACS_INT stack_items = XFIXNAT (maxdepth) + 2; - USE_SAFE_ALLOCA; - void *alloc; - SAFE_ALLOCA_LISP (alloc, stack_items); - Lisp_Object *stack_base = alloc; - /* ... we plonk BYTESTR and VECTOR there to ensure that they survive - GC (bug#33014), since these variables aren't used directly beyond - the interpreter prologue and wouldn't be found in the stack frame - otherwise. */ - stack_base[0] = bytestr; - stack_base[1] = vector; - Lisp_Object *top = stack_base + 1; - Lisp_Object *stack_lim = top + stack_items; + EMACS_INT max_stack = XFIXNAT (maxdepth); + Lisp_Object *frame_base = bc->fp->next_stack; + struct bc_frame *fp = (struct bc_frame *)(frame_base + max_stack); + + if ((char *)fp->next_stack > bc->stack_end) + error ("Bytecode stack overflow"); + + /* Save the function object so that the bytecode and vector are + held from removal by the GC. */ + fp->fun = fun; + /* Save previous stack pointer and pc in the new frame. If we came + directly from outside, these will be NULL. */ + fp->saved_top = top; + fp->saved_pc = pc; + fp->saved_fp = bc->fp; + bc->fp = fp; + + top = frame_base - 1; unsigned char const *bytestr_data = SDATA (bytestr); - unsigned char const *pc = bytestr_data; -#if BYTE_CODE_SAFE || !defined NDEBUG - specpdl_ref count = SPECPDL_INDEX (); -#endif + pc = bytestr_data; /* ARGS_TEMPLATE is composed of bit fields: bits 0..6 minimum number of arguments @@ -410,7 +541,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, int op; enum handlertype type; - if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim)) + if (BYTE_CODE_SAFE && !valid_sp (bc, top)) emacs_abort (); #ifdef BYTE_CODE_METER @@ -642,39 +773,45 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, error ("Lisp nesting exceeds `max-lisp-eval-depth'"); } - ptrdiff_t numargs = op; - Lisp_Object fun = TOP; - Lisp_Object *args = &TOP + 1; + ptrdiff_t call_nargs = op; + Lisp_Object call_fun = TOP; + Lisp_Object *call_args = &TOP + 1; - specpdl_ref count1 = record_in_backtrace (fun, args, numargs); + specpdl_ref count1 = record_in_backtrace (call_fun, + call_args, call_nargs); maybe_gc (); if (debug_on_next_call) do_debug_on_call (Qlambda, count1); - Lisp_Object original_fun = fun; - if (SYMBOLP (fun)) - fun = XSYMBOL (fun)->u.s.function; + Lisp_Object original_fun = call_fun; + if (SYMBOLP (call_fun)) + call_fun = XSYMBOL (call_fun)->u.s.function; Lisp_Object template; Lisp_Object bytecode; - Lisp_Object val; - if (COMPILEDP (fun) + if (COMPILEDP (call_fun) // Lexical binding only. - && (template = AREF (fun, COMPILED_ARGLIST), + && (template = AREF (call_fun, COMPILED_ARGLIST), FIXNUMP (template)) // No autoloads. - && (bytecode = AREF (fun, COMPILED_BYTECODE), + && (bytecode = AREF (call_fun, COMPILED_BYTECODE), !CONSP (bytecode))) - val = exec_byte_code (bytecode, - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH), - XFIXNUM (template), numargs, args); - else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) - val = funcall_subr (XSUBR (fun), numargs, args); + { + fun = call_fun; + bytestr = bytecode; + args_template = XFIXNUM (template); + nargs = call_nargs; + args = call_args; + goto setup_frame; + } + + Lisp_Object val; + if (SUBRP (call_fun) && !SUBR_NATIVE_COMPILED_DYNP (call_fun)) + val = funcall_subr (XSUBR (call_fun), call_nargs, call_args); else - val = funcall_general (original_fun, numargs, args); + val = funcall_general (original_fun, call_nargs, call_args); lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count1))) + if (backtrace_debug_on_exit (specpdl_ptr - 1)) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; @@ -705,7 +842,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, op = FETCH2; op_branch: op -= pc - bytestr_data; - op_relative_branch: if (BYTE_CODE_SAFE && ! (bytestr_data - pc <= op && op < bytestr_data + bytestr_length - pc)) @@ -740,38 +876,41 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, DISCARD (1); NEXT; - CASE (BRgoto): - op = FETCH - 128; - goto op_relative_branch; - - CASE (BRgotoifnil): - op = FETCH - 128; - if (NILP (POP)) - goto op_relative_branch; - NEXT; - - CASE (BRgotoifnonnil): - op = FETCH - 128; - if (!NILP (POP)) - goto op_relative_branch; - NEXT; - - CASE (BRgotoifnilelsepop): - op = FETCH - 128; - if (NILP (TOP)) - goto op_relative_branch; - DISCARD (1); - NEXT; - - CASE (BRgotoifnonnilelsepop): - op = FETCH - 128; - if (!NILP (TOP)) - goto op_relative_branch; - DISCARD (1); - NEXT; - CASE (Breturn): - goto exit; + { + Lisp_Object *saved_top = bc->fp->saved_top; + if (saved_top) + { + Lisp_Object val = TOP; + + lisp_eval_depth--; + if (backtrace_debug_on_exit (specpdl_ptr - 1)) + val = call_debugger (list2 (Qexit, val)); + specpdl_ptr--; + + top = saved_top; + pc = bc->fp->saved_pc; + struct bc_frame *fp = bc->fp->saved_fp; + bc->fp = fp; + + Lisp_Object fun = fp->fun; + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + bytestr_data = SDATA (bytestr); + vectorp = XVECTOR (vector)->contents; + if (BYTE_CODE_SAFE) + { + /* Only required for checking, not for execution. */ + const_length = ASIZE (vector); + bytestr_length = SCHARS (bytestr); + } + + TOP = val; + NEXT; + } + else + goto exit; + } CASE (Bdiscard): DISCARD (1); @@ -826,9 +965,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (sys_setjmp (c->jmp)) { struct handler *c = handlerlist; + handlerlist = c->next; top = c->bytecode_top; op = c->bytecode_dest; - handlerlist = c->next; + struct bc_frame *fp = bc->fp; + + Lisp_Object fun = fp->fun; + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + bytestr_data = SDATA (bytestr); + vectorp = XVECTOR (vector)->contents; + if (BYTE_CODE_SAFE) + { + /* Only required for checking, not for execution. */ + const_length = ASIZE (vector); + bytestr_length = SCHARS (bytestr); + } + pc = bytestr_data; PUSH (c->val); goto op_branch; } @@ -1467,19 +1620,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = INTEGERP (TOP) ? Qt : Qnil; NEXT; -#if BYTE_CODE_SAFE - /* These are intentionally written using 'case' syntax, - because they are incompatible with the threaded - interpreter. */ - - case Bset_mark: - error ("set-mark is an obsolete bytecode"); - break; - case Bscan_buffer: - error ("scan-buffer is an obsolete bytecode"); - break; -#endif - CASE_ABORT: /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ @@ -1580,20 +1720,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: -#if BYTE_CODE_SAFE || !defined NDEBUG - if (!specpdl_ref_eq (SPECPDL_INDEX (), count)) - { - /* Binds and unbinds are supposed to be compiled balanced. */ - if (specpdl_ref_lt (count, SPECPDL_INDEX ())) - unbind_to (count, Qnil); - error ("binding stack not balanced (serious byte compiler bug)"); - } -#endif - /* The byte code should have been properly pinned. */ - eassert (SDATA (bytestr) == bytestr_data); + bc->fp = bc->fp->saved_fp; Lisp_Object result = TOP; - SAFE_FREE (); return result; } @@ -1615,6 +1744,7 @@ void syms_of_bytecode (void) { defsubr (&Sbyte_code); + defsubr (&Sinternal_stack_stats); #ifdef BYTE_CODE_METER diff --git a/src/charset.c b/src/charset.c index d0cfe60952e..9edbd4c8c84 100644 --- a/src/charset.c +++ b/src/charset.c @@ -793,16 +793,21 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun DEFUN ("map-charset-chars", Fmap_charset_chars, Smap_charset_chars, 2, 5, 0, doc: /* Call FUNCTION for all characters in CHARSET. -FUNCTION is called with an argument RANGE and the optional 3rd -argument ARG. - -RANGE is a cons (FROM . TO), where FROM and TO indicate a range of -characters contained in CHARSET. - -The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the -range of code points (in CHARSET) of target characters. Note that -these are not character codes, but code points in CHARSET; for the -difference see `decode-char' and `list-charset-chars'. */) +Optional 3rd argument ARG is an additional argument to be passed +to FUNCTION, see below. +Optional 4th and 5th arguments FROM-CODE and TO-CODE specify the +range of code points (in CHARSET) of target characters on which to +map the FUNCTION. Note that these are not character codes, but code +points of CHARSET; for the difference see `decode-char' and +`list-charset-chars'. If FROM-CODE is nil or imitted, it stands for +the first code point of CHARSET; if TO-CODE is nil or omitted, it +stands for the last code point of CHARSET. + +FUNCTION will be called with two arguments: RANGE and ARG. +RANGE is a cons (FROM . TO), where FROM and TO specify a range of +characters that belong to CHARSET on which FUNCTION should do its +job. FROM and TO are Emacs character codes, unlike FROM-CODE and +TO-CODE, which are CHARSET code points. */) (Lisp_Object function, Lisp_Object charset, Lisp_Object arg, Lisp_Object from_code, Lisp_Object to_code) { struct charset *cs; diff --git a/src/composite.c b/src/composite.c index 3659de8900c..c2ade90d54a 100644 --- a/src/composite.c +++ b/src/composite.c @@ -704,8 +704,8 @@ DEFUN ("clear-composition-cache", Fclear_composition_cache, Clear composition cache. */) (void) { - Lisp_Object args[] = {QCtest, Qequal, QCsize, make_fixnum (311)}; - gstring_hash_table = CALLMANY (Fmake_hash_table, args); + gstring_hash_table = CALLN (Fmake_hash_table, QCtest, Qequal, + QCsize, make_fixnum (311)); /* Fixme: We call Fclear_face_cache to force complete re-building of display glyphs. But, it may be better to call this function from Fclear_face_cache instead. */ diff --git a/src/conf_post.h b/src/conf_post.h index cee5a0878a1..5108e44efbd 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -32,13 +32,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ /* To help make dependencies clearer elsewhere, this file typically does not #include other files. The exceptions are stdbool.h because it is unlikely to interfere with configuration and bool is - such a core part of the C language, attribute.h because its - ATTRIBUTE_* macros are used here, and ms-w32.h (DOS_NT + such a core part of the C language, and ms-w32.h (DOS_NT only) because it historically was included here and changing that would take some work. */ #include <stdbool.h> -#include <attribute.h> #if defined WINDOWSNT && !defined DEFER_MS_W32_H # include <ms-w32.h> @@ -194,6 +192,12 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ #define iswctype(wc, type) false #define mbsinit(ps) 1 +/* Some things that lib/at-func.c wants. */ +#define GNULIB_SUPPORT_ONLY_AT_FDCWD + +/* Needed by lib/lchmod.c. */ +#define EOPNOTSUPP EINVAL + #define MALLOC_0_IS_NONNULL 1 /* We must intercept 'opendir' calls to stash away the directory name, @@ -273,8 +277,8 @@ extern void _DebPrint (const char *fmt, ...); extern char *emacs_getenv_TZ (void); extern int emacs_setenv_TZ (char const *); -#define NO_INLINE ATTRIBUTE_NOINLINE -#define EXTERNALLY_VISIBLE ATTRIBUTE_EXTERNALLY_VISIBLE +#define NO_INLINE _GL_ATTRIBUTE_NOINLINE +#define EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE #if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__ # define PRINTF_ARCHETYPE __gnu_printf__ @@ -304,9 +308,9 @@ extern int emacs_setenv_TZ (char const *); # define PRINTF_ARCHETYPE __printf__ #endif #define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \ - ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) + _GL_ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check)) -#define ARG_NONNULL ATTRIBUTE_NONNULL +#define ARG_NONNULL _GL_ATTRIBUTE_NONNULL /* Declare NAME to be a pointer to an object of type TYPE, initialized to the address ADDR, which may be of a different type. Accesses @@ -314,15 +318,16 @@ extern int emacs_setenv_TZ (char const *); behavior, even if options like gcc -fstrict-aliasing are used. */ #define DECLARE_POINTER_ALIAS(name, type, addr) \ - type ATTRIBUTE_MAY_ALIAS *name = (type *) (addr) + type _GL_ATTRIBUTE_MAY_ALIAS *name = (type *) (addr) #if 3 <= __GNUC__ # define ATTRIBUTE_SECTION(name) __attribute__((section (name))) #else -#define ATTRIBUTE_SECTION(name) +# define ATTRIBUTE_SECTION(name) #endif -#define ATTRIBUTE_MALLOC_SIZE(args) ATTRIBUTE_MALLOC ATTRIBUTE_ALLOC_SIZE (args) +#define ATTRIBUTE_MALLOC_SIZE(args) \ + _GL_ATTRIBUTE_MALLOC _GL_ATTRIBUTE_ALLOC_SIZE (args) /* Work around GCC bug 59600: when a function is inlined, the inlined code may have its addresses sanitized even if the function has the diff --git a/src/dispextern.h b/src/dispextern.h index f7755acd96b..b7cfde70339 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3488,6 +3488,9 @@ bool update_window_fringes (struct window *, bool); void gui_init_fringe (struct redisplay_interface *); +extern int max_used_fringe_bitmap; +void gui_define_fringe_bitmap (struct frame *, int); + #ifdef HAVE_NTGUI void w32_reset_fringes (void); #endif diff --git a/src/dynlib.h b/src/dynlib.h index ac3d8e58ab3..03b8f983564 100644 --- a/src/dynlib.h +++ b/src/dynlib.h @@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef DYNLIB_H #define DYNLIB_H +#include <attribute.h> #include <stdbool.h> typedef void *dynlib_handle_ptr; diff --git a/src/eval.c b/src/eval.c index 294d79e67a0..c46b74ac40c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -223,8 +223,8 @@ init_eval_once_for_pdumper (void) { enum { size = 50 }; union specbinding *pdlvec = malloc ((size + 1) * sizeof *specpdl); - specpdl_size = size; specpdl = specpdl_ptr = pdlvec + 1; + specpdl_end = specpdl + size; } void @@ -267,8 +267,6 @@ restore_stack_limits (Lisp_Object data) integer_to_intmax (XCDR (data), &max_lisp_eval_depth); } -static void grow_specpdl (void); - /* Call the Lisp debugger, giving it argument ARG. */ Lisp_Object @@ -1235,6 +1233,7 @@ unwind_to_catch (struct handler *catch, enum nonlocal_exit type, eassert (handlerlist == catch); lisp_eval_depth = catch->f_lisp_eval_depth; + set_act_rec (current_thread, catch->act_rec); sys_longjmp (catch->jmp, 1); } @@ -1675,6 +1674,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) c->next = handlerlist; c->f_lisp_eval_depth = lisp_eval_depth; c->pdlcount = SPECPDL_INDEX (); + c->act_rec = get_act_rec (current_thread); c->poll_suppress_count = poll_suppress_count; c->interrupt_input_blocked = interrupt_input_blocked; handlerlist = c; @@ -1773,7 +1773,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) && ! NILP (error_symbol) /* Don't try to call a lisp function if we've already overflowed the specpdl stack. */ - && specpdl_ptr < specpdl + specpdl_size) + && specpdl_ptr < specpdl_end) { /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); @@ -2320,62 +2320,29 @@ alist mapping symbols to their value. */) return unbind_to (count, eval_sub (form)); } -static void +void grow_specpdl_allocation (void) { - eassert (specpdl_ptr == specpdl + specpdl_size); + eassert (specpdl_ptr == specpdl_end); specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); union specbinding *pdlvec = specpdl - 1; - ptrdiff_t pdlvecsize = specpdl_size + 1; - if (max_size <= specpdl_size) + ptrdiff_t size = specpdl_end - specpdl; + ptrdiff_t pdlvecsize = size + 1; + if (max_size <= size) { if (max_specpdl_size < 400) max_size = max_specpdl_size = 400; - if (max_size <= specpdl_size) + if (max_size <= size) xsignal0 (Qexcessive_variable_binding); } pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); specpdl = pdlvec + 1; - specpdl_size = pdlvecsize - 1; + specpdl_end = specpdl + pdlvecsize - 1; specpdl_ptr = specpdl_ref_to_ptr (count); } -/* Grow the specpdl stack by one entry. - The caller should have already initialized the entry. - Signal an error on stack overflow. - - Make sure that there is always one unused entry past the top of the - stack, so that the just-initialized entry is safely unwound if - memory exhausted and an error is signaled here. Also, allocate a - never-used entry just before the bottom of the stack; sometimes its - address is taken. */ - -INLINE void -grow_specpdl (void) -{ - specpdl_ptr++; - if (specpdl_ptr == specpdl + specpdl_size) - grow_specpdl_allocation (); -} - -specpdl_ref -record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) -{ - specpdl_ref count = SPECPDL_INDEX (); - - eassert (nargs >= UNEVALLED); - specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; - specpdl_ptr->bt.debug_on_exit = false; - specpdl_ptr->bt.function = function; - current_thread->stack_top = specpdl_ptr->bt.args = args; - specpdl_ptr->bt.nargs = nargs; - grow_specpdl (); - - return count; -} - /* Eval a sub-expression of the current expression (i.e. in the same lexical scope). */ Lisp_Object @@ -3140,10 +3107,7 @@ fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (CONSP (AREF (fun, COMPILED_BYTECODE))) Ffetch_bytecode (fun); - return exec_byte_code (AREF (fun, COMPILED_BYTECODE), - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH), - args_template, nargs, args); + return exec_byte_code (fun, args_template, nargs, args); } static Lisp_Object diff --git a/src/fileio.c b/src/fileio.c index 243a87a4821..a0282204de8 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5973,7 +5973,8 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) bool old_message_p = 0; struct auto_save_unwind auto_save_unwind; - intmax_t sum = INT_ADD_WRAPV (specpdl_size, 40, &sum) ? INTMAX_MAX : sum; + intmax_t sum = INT_ADD_WRAPV (specpdl_end - specpdl, 40, &sum) + ? INTMAX_MAX : sum; if (max_specpdl_size < sum) max_specpdl_size = sum; diff --git a/src/filelock.c b/src/filelock.c index cb548ac79bd..4fdad8d8560 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -578,8 +578,13 @@ current_lock_owner (lock_info_type *owner, char *lfname) if (lfinfo_end != owner->user + lfinfolen) return EINVAL; - /* On current host? */ Lisp_Object system_name = Fsystem_name (); + /* If `system-name' returns nil, that means we're in a + --no-build-details Emacs, and the name part of the link (e.g., + .#test.txt -> larsi@.118961:1646577954) is an empty string. */ + if (NILP (system_name)) + system_name = build_string (""); + /* On current host? */ if (STRINGP (system_name) && dot - (at + 1) == SBYTES (system_name) && memcmp (at + 1, SSDATA (system_name), SBYTES (system_name)) == 0) diff --git a/src/fns.c b/src/fns.c index 06a64563806..6e89fe3ca5f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -55,49 +55,24 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, return argument; } +/* Return a random Lisp fixnum I in the range 0 <= I < LIM, + where LIM is taken from a positive fixnum. */ static Lisp_Object -ccall2 (Lisp_Object (f) (ptrdiff_t nargs, Lisp_Object *args), - Lisp_Object arg1, Lisp_Object arg2) +get_random_fixnum (EMACS_INT lim) { - Lisp_Object args[2] = {arg1, arg2}; - return f (2, args); -} - -static Lisp_Object -get_random_bignum (Lisp_Object limit) -{ - /* This is a naive transcription into bignums of the fixnum algorithm. - I'd be quite surprised if that's anywhere near the best algorithm - for it. */ - while (true) + /* Return the remainder of a random integer R (in range 0..INTMASK) + divided by LIM, except reject the rare case where R is so close + to INTMASK that the remainder isn't random. */ + EMACS_INT difflim = INTMASK - lim + 1, diff, remainder; + do { - Lisp_Object val = make_fixnum (0); - Lisp_Object lim = limit; - int bits = 0; - int bitsperiteration = FIXNUM_BITS - 1; - do - { - /* Shift by one so it is a valid positive fixnum. */ - EMACS_INT rand = get_random () >> 1; - Lisp_Object lrand = make_fixnum (rand); - bits += bitsperiteration; - val = ccall2 (Flogior, - Fash (val, make_fixnum (bitsperiteration)), - lrand); - lim = Fash (lim, make_fixnum (- bitsperiteration)); - } - while (!EQ (lim, make_fixnum (0))); - /* Return the remainder, except reject the rare case where - get_random returns a number so close to INTMASK that the - remainder isn't random. */ - Lisp_Object remainder = Frem (val, limit); - if (!NILP (ccall2 (Fleq, - ccall2 (Fminus, val, remainder), - ccall2 (Fminus, - Fash (make_fixnum (1), make_fixnum (bits)), - limit)))) - return remainder; + EMACS_INT r = get_random (); + remainder = r % lim; + diff = r - remainder; } + while (difflim < diff); + + return make_fixnum (remainder); } DEFUN ("random", Frandom, Srandom, 0, 1, 0, @@ -111,32 +86,26 @@ With a string argument, set the seed based on the string's contents. See Info node `(elisp)Random Numbers' for more details. */) (Lisp_Object limit) { - EMACS_INT val; - if (EQ (limit, Qt)) init_random (); else if (STRINGP (limit)) seed_random (SSDATA (limit), SBYTES (limit)); - if (BIGNUMP (limit)) + else if (FIXNUMP (limit)) { - if (0 > mpz_sgn (*xbignum_val (limit))) - xsignal2 (Qwrong_type_argument, Qnatnump, limit); - return get_random_bignum (limit); + EMACS_INT lim = XFIXNUM (limit); + if (lim <= 0) + xsignal1 (Qargs_out_of_range, limit); + return get_random_fixnum (lim); + } + else if (BIGNUMP (limit)) + { + struct Lisp_Bignum *lim = XBIGNUM (limit); + if (mpz_sgn (*bignum_val (lim)) <= 0) + xsignal1 (Qargs_out_of_range, limit); + return get_random_bignum (lim); } - val = get_random (); - if (FIXNUMP (limit) && 0 < XFIXNUM (limit)) - while (true) - { - /* Return the remainder, except reject the rare case where - get_random returns a number so close to INTMASK that the - remainder isn't random. */ - EMACS_INT remainder = val % XFIXNUM (limit); - if (val - remainder <= INTMASK - XFIXNUM (limit) + 1) - return make_fixnum (remainder); - val = get_random (); - } - return make_ufixnum (val); + return make_ufixnum (get_random ()); } /* Random data-structure functions. */ diff --git a/src/frame.c b/src/frame.c index 8750fe4889c..0ec7057db20 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3908,6 +3908,9 @@ static const struct frame_parm_table frame_parms[] = {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)}, {"alpha-background", SYMBOL_INDEX (Qalpha_background)}, +#ifdef HAVE_X_WINDOWS + {"shaded", SYMBOL_INDEX (Qshaded)}, +#endif #ifdef NS_IMPL_COCOA {"ns-appearance", SYMBOL_INDEX (Qns_appearance)}, {"ns-transparent-titlebar", SYMBOL_INDEX (Qns_transparent_titlebar)}, @@ -6084,6 +6087,7 @@ syms_of_frame (void) DEFSYM (Qfullheight, "fullheight"); DEFSYM (Qfullboth, "fullboth"); DEFSYM (Qmaximized, "maximized"); + DEFSYM (Qshaded, "shaded"); DEFSYM (Qx_resource_name, "x-resource-name"); DEFSYM (Qx_frame_parameter, "x-frame-parameter"); @@ -6229,14 +6233,24 @@ You can also use a floating number between 0.0 and 1.0. */); doc: /* Alist of default values for frame creation. These may be set in your init file, like this: (setq default-frame-alist \\='((width . 80) (height . 55) (menu-bar-lines . 1))) + These override values given in window system configuration data, - including X Windows' defaults database. +including X Windows' defaults database. + +Note that many display-related modes (like `scroll-bar-mode' or +`menu-bar-mode') alter `default-frame-alist', so if you set this +variable directly, you may be overriding other settings +unintentionally. Instead it's often better to use +`modify-all-frames-parameters' or push new elements to the front of +this alist. + For values specific to the first Emacs frame, see `initial-frame-alist'. + For window-system specific values, see `window-system-default-frame-alist'. + For values specific to the separate minibuffer frame, see - `minibuffer-frame-alist'. -The `menu-bar-lines' element of the list controls whether new frames - have menu bars; `menu-bar-mode' works by altering this element. +`minibuffer-frame-alist'. + Setting this variable does not affect existing frames, only new ones. */); Vdefault_frame_alist = Qnil; @@ -6256,7 +6270,7 @@ Setting this variable does not affect existing frames, only new ones. */); DEFVAR_BOOL ("scroll-bar-adjust-thumb-portion", scroll_bar_adjust_thumb_portion_p, - doc: /* Adjust thumb for overscrolling for Gtk+ and MOTIF. + doc: /* Adjust scroll bars for overscrolling for Gtk+, Motif and Haiku. Non-nil means adjust the thumb in the scroll bar so it can be dragged downwards even if the end of the buffer is shown (i.e. overscrolling). Set to nil if you want the thumb to be at the bottom when the end of the buffer diff --git a/src/fringe.c b/src/fringe.c index 4ea368d215b..bc4e0f1f136 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1823,6 +1823,23 @@ gui_init_fringe (struct redisplay_interface *rif) } } +/* Call frame F's specific define_fringe_bitmap method for a fringe + bitmap number N. Called by various *term.c functions when they + need to display a fringe bitmap whose terminal-specific data is not + available. */ +void +gui_define_fringe_bitmap (struct frame *f, int n) +{ + struct redisplay_interface *rif = FRAME_RIF (f); + + if (!rif || !rif->define_fringe_bitmap || n >= max_used_fringe_bitmap) + return; + + struct fringe_bitmap *fb = fringe_bitmaps[n]; + if (fb) + rif->define_fringe_bitmap (n, fb->bits, fb->height, fb->width); +} + #ifdef HAVE_NTGUI void w32_reset_fringes (void) diff --git a/src/gnutls.c b/src/gnutls.c index 3ec38370679..09590ca005c 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -616,6 +616,9 @@ gnutls_try_handshake (struct Lisp_Process *proc) gnutls_session_t state = proc->gnutls_state; int ret; bool non_blocking = proc->is_non_blocking_client; + /* Sleep for ten milliseconds when busy-looping in + gnutls_handshake. */ + struct timespec delay = { 0, 1000 * 1000 * 10 }; if (proc->gnutls_complete_negotiation_p) non_blocking = false; @@ -630,6 +633,7 @@ gnutls_try_handshake (struct Lisp_Process *proc) maybe_quit (); if (non_blocking && ret != GNUTLS_E_INTERRUPTED) break; + nanosleep (&delay, NULL); } proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED; diff --git a/src/gtkutil.c b/src/gtkutil.c index d4726014c01..ec2864e34a7 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -142,7 +142,7 @@ struct xg_frame_tb_info bool xg_gtk_initialized; /* Used to make sure xwidget calls are possible */ #endif -static GtkWidget * xg_get_widget_from_map (ptrdiff_t idx); +static GtkWidget *xg_get_widget_from_map (ptrdiff_t idx, Display *dpy); @@ -266,6 +266,7 @@ xg_display_open (char *display_name, GdkDisplay **dpy) static int xg_get_gdk_scale (void) { +#ifdef HAVE_GTK3 const char *sscale = getenv ("GDK_SCALE"); if (sscale) @@ -274,6 +275,7 @@ xg_get_gdk_scale (void) if (0 < scale) return min (scale, INT_MAX); } +#endif return 1; } @@ -1610,10 +1612,7 @@ xg_create_frame_widgets (struct frame *f) with regular X drawing primitives, so from a GTK/GDK point of view, the widget is totally blank. When an expose comes, this will make the widget blank, and then Emacs redraws it. This flickers - a lot, so we turn off double buffering. - FIXME: gtk_widget_set_double_buffered is deprecated and might stop - working in the future. We need to migrate away from combining - X and GTK+ drawing to a pure GTK+ build. */ + a lot, so we turn off double buffering. */ #ifndef HAVE_PGTK gtk_widget_set_double_buffered (wfixed, FALSE); @@ -2039,8 +2038,8 @@ xg_set_background_color (struct frame *f, unsigned long bg) !NILP (bar); bar = XSCROLL_BAR (bar)->next) { - GtkWidget *scrollbar = - xg_get_widget_from_map (XSCROLL_BAR (bar)->x_window); + GtkWidget *scrollbar = xg_get_widget_from_map (XSCROLL_BAR (bar)->x_window, + FRAME_X_DISPLAY (f)); GtkWidget *webox = gtk_widget_get_parent (scrollbar); xg_set_widget_bg (f, webox, FRAME_BACKGROUND_PIXEL (f)); } @@ -3280,8 +3279,13 @@ menu_bar_button_pressed_cb (GtkWidget *widget, GdkEvent *event, { struct frame *f = user_data; - if (event->button.button < 4) - set_frame_menubar (f, true); + if (event->button.button < 4 + && event->button.window != gtk_widget_get_window (widget) + && !popup_activated ()) + { + pgtk_menu_set_in_use (true); + set_frame_menubar (f, true); + } return false; } @@ -4223,13 +4227,13 @@ xg_event_is_for_menubar (struct frame *f, const XEvent *event) } else { -#else +#endif rec.x = event->xbutton.x / scale; rec.y = event->xbutton.y / scale; -#endif #ifdef HAVE_XINPUT2 } #endif + rec.width = 1; rec.height = 1; @@ -4260,6 +4264,8 @@ bool xg_ignore_gtk_scrollbar; static int scroll_bar_width_for_theme; static int scroll_bar_height_for_theme; +#if defined HAVE_PGTK || !defined HAVE_GTK3 + /* Xlib's `Window' fits in 32 bits. But we want to store pointers, and they may be larger than 32 bits. Keep a mapping from integer index to widget pointers to get around the 32 bit limitation. */ @@ -4331,7 +4337,7 @@ xg_remove_widget_from_map (ptrdiff_t idx) /* Get the widget pointer at IDX from id_to_widget. */ static GtkWidget * -xg_get_widget_from_map (ptrdiff_t idx) +xg_get_widget_from_map (ptrdiff_t idx, Display *dpy) { if (idx < id_to_widget.max_size && id_to_widget.widgets[idx] != 0) return id_to_widget.widgets[idx]; @@ -4339,6 +4345,42 @@ xg_get_widget_from_map (ptrdiff_t idx) return 0; } +#else +static void +find_scrollbar_cb (GtkWidget *widget, gpointer user_data) +{ + GtkWidget **scroll_bar = user_data; + + if (GTK_IS_SCROLLBAR (widget)) + *scroll_bar = widget; +} + +static GtkWidget * +xg_get_widget_from_map (ptrdiff_t window, Display *dpy) +{ + GtkWidget *gwdesc, *scroll_bar = NULL; + GdkWindow *gdkwin; + + gdkwin = gdk_x11_window_lookup_for_display (gdk_x11_lookup_xdisplay (dpy), + (Window) window); + if (gdkwin) + { + GdkEvent event; + event.any.window = gdkwin; + event.any.type = GDK_NOTHING; + gwdesc = gtk_get_event_widget (&event); + + if (gwdesc && GTK_IS_EVENT_BOX (gwdesc)) + gtk_container_forall (GTK_CONTAINER (gwdesc), + find_scrollbar_cb, &scroll_bar); + } + else + return NULL; + + return scroll_bar; +} +#endif + static void update_theme_scrollbar_width (void) { @@ -4398,7 +4440,7 @@ xg_get_default_scrollbar_height (struct frame *f) return scroll_bar_width_for_theme * xg_get_scale (f); } -#ifndef HAVE_PGTK +#ifndef HAVE_GTK3 /* Return the scrollbar id for X Window WID on display DPY. Return -1 if WID not in id_to_widget. */ @@ -4425,12 +4467,40 @@ xg_get_scroll_id_for_window (Display *dpy, Window wid) DATA is the index into id_to_widget for WIDGET. We free pointer to last scroll bar values here and remove the index. */ +#if !defined HAVE_GTK3 || defined HAVE_PGTK static void xg_gtk_scroll_destroy (GtkWidget *widget, gpointer data) { intptr_t id = (intptr_t) data; xg_remove_widget_from_map (id); } +#endif + +#if defined HAVE_GTK3 && !defined HAVE_PGTK +static void +xg_scroll_bar_size_allocate_cb (GtkWidget *widget, + GdkRectangle *allocation, + gpointer user_data) +{ + GdkEvent *event = gtk_get_current_event (); + GdkEvent dummy; + + if (event && event->any.type == GDK_CONFIGURE) + x_scroll_bar_configure (event); + else + { + /* These are the only fields used by x_scroll_bar_configure. */ + dummy.configure.send_event = FALSE; + dummy.configure.x = allocation->x; + dummy.configure.y = allocation->y; + dummy.configure.width = allocation->width; + dummy.configure.height = allocation->height; + dummy.configure.window = gtk_widget_get_window (widget); + + x_scroll_bar_configure (&dummy); + } +} +#endif static void xg_finish_scroll_bar_creation (struct frame *f, @@ -4441,19 +4511,32 @@ xg_finish_scroll_bar_creation (struct frame *f, const char *scroll_bar_name) { GtkWidget *webox = gtk_event_box_new (); +#ifdef HAVE_GTK3 + GtkCssProvider *foreground_provider; + GtkCssProvider *background_provider; +#endif gtk_widget_set_name (wscroll, scroll_bar_name); #ifndef HAVE_GTK3 gtk_range_set_update_policy (GTK_RANGE (wscroll), GTK_UPDATE_CONTINUOUS); #endif - g_object_set_data (G_OBJECT (wscroll), XG_FRAME_DATA, (gpointer)f); + g_object_set_data (G_OBJECT (wscroll), XG_FRAME_DATA, (gpointer) f); + +#if defined HAVE_GTK3 && !defined HAVE_PGTK + g_signal_connect (G_OBJECT (webox), "size-allocate", + G_CALLBACK (xg_scroll_bar_size_allocate_cb), + NULL); +#endif +#if defined HAVE_PGTK || !defined HAVE_GTK3 ptrdiff_t scroll_id = xg_store_widget_in_map (wscroll); g_signal_connect (G_OBJECT (wscroll), "destroy", G_CALLBACK (xg_gtk_scroll_destroy), (gpointer) scroll_id); +#endif + g_signal_connect (G_OBJECT (wscroll), "change-value", scroll_callback, @@ -4481,27 +4564,35 @@ xg_finish_scroll_bar_creation (struct frame *f, gtk_widget_realize (webox); #ifdef HAVE_PGTK gtk_widget_show_all (webox); -#endif -#ifndef HAVE_PGTK +#elif defined HAVE_GTK3 + bar->x_window = GTK_WIDGET_TO_X_WIN (webox); + gtk_widget_show_all (webox); +#else GTK_WIDGET_TO_X_WIN (webox); #endif /* Set the cursor to an arrow. */ xg_set_cursor (webox, FRAME_DISPLAY_INFO (f)->xg_cursor); -#ifdef HAVE_PGTK +#ifdef HAVE_GTK3 GtkStyleContext *ctxt = gtk_widget_get_style_context (wscroll); - gtk_style_context_add_provider (ctxt, - GTK_STYLE_PROVIDER (FRAME_OUTPUT_DATA (f)-> - scrollbar_foreground_css_provider), + foreground_provider = FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider; + background_provider = FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider; + + gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (foreground_provider), GTK_STYLE_PROVIDER_PRIORITY_USER); - gtk_style_context_add_provider (ctxt, - GTK_STYLE_PROVIDER (FRAME_OUTPUT_DATA (f)-> - scrollbar_background_css_provider), + gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (background_provider), GTK_STYLE_PROVIDER_PRIORITY_USER); + +#ifndef HAVE_PGTK + gtk_widget_add_events (webox, GDK_STRUCTURE_MASK); + gtk_widget_set_double_buffered (wscroll, FALSE); +#endif #endif +#if defined HAVE_PGTK || !defined HAVE_GTK3 bar->x_window = scroll_id; +#endif } /* Create a scroll bar widget for frame F. Store the scroll bar @@ -4575,7 +4666,8 @@ xg_create_horizontal_scroll_bar (struct frame *f, void xg_remove_scroll_bar (struct frame *f, ptrdiff_t scrollbar_id) { - GtkWidget *w = xg_get_widget_from_map (scrollbar_id); + GtkWidget *w = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); if (w) { GtkWidget *wparent = gtk_widget_get_parent (w); @@ -4598,11 +4690,15 @@ xg_update_scrollbar_pos (struct frame *f, int width, int height) { - GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id); + GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); if (wscroll) { GtkWidget *wfixed = f->output_data.xp->edit_widget; GtkWidget *wparent = gtk_widget_get_parent (wscroll); +#if !defined HAVE_PGTK && defined HAVE_GTK3 + GdkWindow *wdesc = gtk_widget_get_window (wparent); +#endif gint msl; int scale = xg_get_scale (f); @@ -4635,12 +4731,17 @@ xg_update_scrollbar_pos (struct frame *f, { gtk_widget_show_all (wparent); gtk_widget_set_size_request (wscroll, width, height); - } -#if !defined HAVE_PGTK && GTK_CHECK_VERSION (2, 18, 0) - if (!gdk_window_ensure_native (gtk_widget_get_window (wscroll))) - emacs_abort (); +#if !defined HAVE_PGTK && defined HAVE_GTK3 + if (wdesc) + { + gdk_window_move_resize (wdesc, left, top, width, height); +#if GTK_CHECK_VERSION (3, 20, 0) + gtk_widget_queue_allocate (wparent); #endif + } +#endif + } if (oldx != -1 && oldw > 0 && oldh > 0) { @@ -4656,7 +4757,8 @@ xg_update_scrollbar_pos (struct frame *f, if (!hidden) { - GtkWidget *scrollbar = xg_get_widget_from_map (scrollbar_id); + GtkWidget *scrollbar = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); GtkWidget *webox = gtk_widget_get_parent (scrollbar); #ifndef HAVE_PGTK @@ -4695,12 +4797,16 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, int width, int height) { - GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id); + GtkWidget *wscroll = xg_get_widget_from_map (scrollbar_id, + FRAME_X_DISPLAY (f)); if (wscroll) { GtkWidget *wfixed = f->output_data.xp->edit_widget; GtkWidget *wparent = gtk_widget_get_parent (wscroll); +#if !defined HAVE_PGTK && defined HAVE_GTK3 + GdkWindow *wdesc = gtk_widget_get_window (wparent); +#endif gint msl; int scale = xg_get_scale (f); @@ -4732,6 +4838,16 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, { gtk_widget_show_all (wparent); gtk_widget_set_size_request (wscroll, width, height); + +#if !defined HAVE_PGTK && defined HAVE_GTK3 + if (wdesc) + { + gdk_window_move_resize (wdesc, left, top, width, height); +#if GTK_CHECK_VERSION (3, 20, 0) + gtk_widget_queue_allocate (wparent); +#endif + } +#endif } if (oldx != -1 && oldw > 0 && oldh > 0) /* Clear under old scroll bar position. */ @@ -4741,18 +4857,13 @@ xg_update_horizontal_scrollbar_pos (struct frame *f, pgtk_clear_area (f, oldx, oldy, oldw, oldh); #endif -#if !defined HAVE_PGTK && GTK_CHECK_VERSION (2, 18, 0) - if (!gdk_window_ensure_native (gtk_widget_get_window (wscroll))) - emacs_abort (); -#endif - /* GTK does not redraw until the main loop is entered again, but if there are no X events pending we will not enter it. So we sync here to get some events. */ { GtkWidget *scrollbar = - xg_get_widget_from_map (scrollbar_id); + xg_get_widget_from_map (scrollbar_id, FRAME_X_DISPLAY (f)); GtkWidget *webox = gtk_widget_get_parent (scrollbar); #ifndef HAVE_PGTK @@ -4792,9 +4903,10 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int position, int whole) { - GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window); - struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); + GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window, + FRAME_X_DISPLAY (f)); + if (wscroll && bar->dragging == -1) { @@ -4879,7 +4991,9 @@ xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int position, int whole) { - GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window); + struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); + GtkWidget *wscroll = xg_get_widget_from_map (bar->x_window, + FRAME_X_DISPLAY (f)); if (wscroll && bar->dragging == -1) { @@ -4911,7 +5025,8 @@ xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, frame. This function does additional checks. */ bool -xg_event_is_for_scrollbar (struct frame *f, const EVENT *event) +xg_event_is_for_scrollbar (struct frame *f, const EVENT *event, + bool for_valuator) { bool retval = 0; @@ -4924,7 +5039,8 @@ xg_event_is_for_scrollbar (struct frame *f, const EVENT *event) && (event->xgeneric.evtype == XI_ButtonPress && xev->detail < 4)) || (event->type == ButtonPress - && event->xbutton.button < 4))) + && event->xbutton.button < 4) + || for_valuator)) #else if (f #ifndef HAVE_PGTK @@ -6056,8 +6172,10 @@ xg_initialize (void) xg_menu_cb_list.prev = xg_menu_cb_list.next = xg_menu_item_cb_list.prev = xg_menu_item_cb_list.next = 0; +#if defined HAVE_PGTK || !defined HAVE_GTK3 id_to_widget.max_size = id_to_widget.used = 0; id_to_widget.widgets = 0; +#endif settings = gtk_settings_get_for_screen (gdk_display_get_default_screen (gdk_display_get_default ())); @@ -6260,6 +6378,13 @@ xg_widget_key_press_event_cb (GtkWidget *widget, GdkEvent *event, if (event->key.is_modifier) goto done; +#ifndef HAVE_GTK3 + /* FIXME: event->key.is_modifier is not accurate on GTK 2. */ + + if (keysym >= GDK_KEY_Shift_L && keysym <= GDK_KEY_Hyper_R) + goto done; +#endif + /* First deal with keysyms which have defined translations to characters. */ if (keysym >= 32 && keysym < 128) diff --git a/src/gtkutil.h b/src/gtkutil.h index b74244d84d0..63ecac07907 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -148,7 +148,8 @@ extern void xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, int position, int whole); -extern bool xg_event_is_for_scrollbar (struct frame *, const EVENT *); +extern bool xg_event_is_for_scrollbar (struct frame *, const EVENT *, + bool for_valuator); extern int xg_get_default_scrollbar_width (struct frame *f); extern int xg_get_default_scrollbar_height (struct frame *f); diff --git a/src/haiku_io.c b/src/haiku_io.c index cade69f3387..89f0877eb67 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -90,14 +90,16 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_menu_bar_help_event); case ZOOM_EVENT: return sizeof (struct haiku_zoom_event); - case REFS_EVENT: - return sizeof (struct haiku_refs_event); + case DRAG_AND_DROP_EVENT: + return sizeof (struct haiku_drag_and_drop_event); case APP_QUIT_REQUESTED_EVENT: return sizeof (struct haiku_app_quit_requested_event); case DUMMY_EVENT: return sizeof (struct haiku_dummy_event); case MENU_BAR_LEFT: return sizeof (struct haiku_menu_bar_left_event); + case SCROLL_BAR_PART_EVENT: + return sizeof (struct haiku_scroll_bar_part_event); } emacs_abort (); @@ -143,7 +145,7 @@ haiku_read (enum haiku_event_type *type, void *buf, ssize_t len) Input is blocked when an attempt to read is in progress. */ int haiku_read_with_timeout (enum haiku_event_type *type, void *buf, ssize_t len, - time_t timeout, bool popup_menu_p) + bigtime_t timeout, bool popup_menu_p) { int32 typ; port_id from = (popup_menu_p diff --git a/src/haiku_select.cc b/src/haiku_select.cc index 011ad58036f..4212f60a480 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -19,6 +19,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <config.h> #include <Clipboard.h> +#include <Message.h> +#include <Path.h> +#include <Entry.h> #include <cstdlib> #include <cstring> @@ -257,3 +260,80 @@ init_haiku_select (void) primary = new BClipboard ("primary"); secondary = new BClipboard ("secondary"); } + +int +be_enum_message (void *message, int32 *tc, int32 index, + int32 *count, const char **name_return) +{ + BMessage *msg = (BMessage *) message; + type_code type; + char *name; + status_t rc; + + rc = msg->GetInfo (B_ANY_TYPE, index, &name, &type, count); + + if (rc != B_OK) + return 1; + + *tc = type; + *name_return = name; + return 0; +} + +int +be_get_refs_data (void *message, const char *name, + int32 index, char **path_buffer) +{ + status_t rc; + BEntry entry; + BPath path; + entry_ref ref; + BMessage *msg; + + msg = (BMessage *) message; + rc = msg->FindRef (name, index, &ref); + + if (rc != B_OK) + return 1; + + rc = entry.SetTo (&ref, 0); + + if (rc != B_OK) + return 1; + + rc = entry.GetPath (&path); + + if (rc != B_OK) + return 1; + + *path_buffer = strdup (path.Path ()); + return 0; +} + +int +be_get_message_data (void *message, const char *name, + int32 type_code, int32 index, + const void **buf_return, + ssize_t *size_return) +{ + BMessage *msg = (BMessage *) message; + + return msg->FindData (name, type_code, + index, buf_return, size_return) != B_OK; +} + +void * +be_create_simple_message (void) +{ + return new BMessage (B_SIMPLE_DATA); +} + +int +be_add_message_data (void *message, const char *name, + int32 type_code, const void *buf, + ssize_t buf_size) +{ + BMessage *msg = (BMessage *) message; + + return msg->AddData (name, type_code, buf, buf_size) != B_OK; +} diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 4f6a96568cb..8c45a7adcb1 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -81,6 +81,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "haiku_support.h" #define SCROLL_BAR_UPDATE 3000 +#define WAIT_FOR_RELEASE 3001 static color_space dpy_color_space = B_NO_COLOR_SPACE; static key_map *key_map = NULL; @@ -117,6 +118,9 @@ static BLocker movement_locker; static BMessage volatile *popup_track_message; static int32 volatile alert_popup_value; +static void *grab_view = NULL; +static BLocker grab_view_locker; + /* This could be a private API, but it's used by (at least) the Qt port, so it's probably here to stay. */ extern status_t get_subpixel_antialiasing (bool *); @@ -381,37 +385,6 @@ public: haiku_write (APP_QUIT_REQUESTED_EVENT, &rq); return 0; } - - void - RefsReceived (BMessage *msg) - { - struct haiku_refs_event rq; - entry_ref ref; - BEntry entry; - BPath path; - int32 cookie = 0; - int32 x, y; - void *window; - - if ((msg->FindPointer ("window", 0, &window) != B_OK) - || (msg->FindInt32 ("x", 0, &x) != B_OK) - || (msg->FindInt32 ("y", 0, &y) != B_OK)) - return; - - rq.window = window; - rq.x = x; - rq.y = y; - - while (msg->FindRef ("refs", cookie++, &ref) == B_OK) - { - if (entry.SetTo (&ref, 0) == B_OK - && entry.GetPath (&path) == B_OK) - { - rq.ref = strdup (path.Path ()); - haiku_write (REFS_EVENT, &rq); - } - } - } }; class EmacsWindow : public BWindow @@ -665,21 +638,19 @@ public: if (msg->WasDropped ()) { - entry_ref ref; BPoint whereto; + struct haiku_drag_and_drop_event rq; - if (msg->FindRef ("refs", &ref) == B_OK) + if (msg->FindPoint ("_drop_point_", &whereto) == B_OK) { - msg->what = B_REFS_RECEIVED; - msg->AddPointer ("window", this); - if (msg->FindPoint ("_drop_point_", &whereto) == B_OK) - { - this->ConvertFromScreen (&whereto); - msg->AddInt32 ("x", whereto.x); - msg->AddInt32 ("y", whereto.y); - } - be_app->PostMessage (msg); - msg->SendReply (B_OK); + this->ConvertFromScreen (&whereto); + + rq.window = this; + rq.message = DetachCurrentMessage ();; + rq.x = whereto.x; + rq.y = whereto.y; + + haiku_write (DRAG_AND_DROP_EVENT, &rq); } } else if (msg->GetPointer ("menuptr")) @@ -1197,6 +1168,7 @@ public: uint32_t previous_buttons = 0; int looper_locked_count = 0; BRegion sb_region; + BRegion invalid_region; BView *offscreen_draw_view = NULL; BBitmap *offscreen_draw_bitmap_1 = NULL; @@ -1209,6 +1181,7 @@ public: #endif BPoint tt_absl_pos; + BMessage *wait_for_release_message = NULL; color_space cspace; @@ -1219,7 +1192,16 @@ public: ~EmacsView () { + if (wait_for_release_message) + gui_abort ("Wait for release message still exists"); + TearDownDoubleBuffering (); + + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (grab_view == this) + grab_view = NULL; + grab_view_locker.Unlock (); } void @@ -1228,6 +1210,28 @@ public: cspace = B_RGBA32; } + void + MessageReceived (BMessage *msg) + { + uint32 buttons; + BLooper *looper = Looper (); + + if (msg->what == WAIT_FOR_RELEASE) + { + if (wait_for_release_message) + gui_abort ("Wait for release message already exists"); + + GetMouse (NULL, &buttons, false); + + if (!buttons) + msg->SendReply (msg); + else + wait_for_release_message = looper->DetachCurrentMessage (); + } + else + BView::MessageReceived (msg); + } + #ifdef USE_BE_CAIRO void DetachCairoSurface (void) @@ -1403,7 +1407,8 @@ public: SetViewBitmap (copy_bitmap, Frame (), Frame (), B_FOLLOW_NONE, 0); - Invalidate (); + Invalidate (&invalid_region); + invalid_region.MakeEmpty (); UnlockLooper (); return; } @@ -1431,6 +1436,7 @@ public: gui_abort ("Failed to lock bitmap after double buffering was set up"); } + invalid_region.MakeEmpty (); UnlockLooper (); Invalidate (); } @@ -1450,6 +1456,17 @@ public: ToolTip ()->SetMouseRelativeLocation (BPoint (-(point.x - tt_absl_pos.x), -(point.y - tt_absl_pos.y))); + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + + if (grab_view && this != grab_view) + { + grab_view_locker.Unlock (); + return; + } + + grab_view_locker.Unlock (); + if (movement_locker.Lock ()) { haiku_write (MOUSE_MOTION, &rq); @@ -1465,18 +1482,26 @@ public: this->GetMouse (&point, &buttons, false); + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (buttons) + grab_view = this; + grab_view_locker.Unlock (); + rq.window = this->Window (); - rq.btn_no = 0; - if (!(previous_buttons & B_PRIMARY_MOUSE_BUTTON) && - (buttons & B_PRIMARY_MOUSE_BUTTON)) + if (!(previous_buttons & B_PRIMARY_MOUSE_BUTTON) + && (buttons & B_PRIMARY_MOUSE_BUTTON)) rq.btn_no = 0; - else if (!(previous_buttons & B_SECONDARY_MOUSE_BUTTON) && - (buttons & B_SECONDARY_MOUSE_BUTTON)) + else if (!(previous_buttons & B_SECONDARY_MOUSE_BUTTON) + && (buttons & B_SECONDARY_MOUSE_BUTTON)) rq.btn_no = 2; - else if (!(previous_buttons & B_TERTIARY_MOUSE_BUTTON) && - (buttons & B_TERTIARY_MOUSE_BUTTON)) + else if (!(previous_buttons & B_TERTIARY_MOUSE_BUTTON) + && (buttons & B_TERTIARY_MOUSE_BUTTON)) rq.btn_no = 1; + else + return; + previous_buttons = buttons; rq.x = point.x; @@ -1497,7 +1522,8 @@ public: if (mods & B_OPTION_KEY) rq.modifiers |= HAIKU_MODIFIER_SUPER; - SetMouseEventMask (B_POINTER_EVENTS, B_LOCK_WINDOW_FOCUS); + SetMouseEventMask (B_POINTER_EVENTS, (B_LOCK_WINDOW_FOCUS + | B_NO_POINTER_HISTORY)); rq.time = system_time (); haiku_write (BUTTON_DOWN, &rq); @@ -1511,8 +1537,23 @@ public: this->GetMouse (&point, &buttons, false); + if (!grab_view_locker.Lock ()) + gui_abort ("Couldn't lock grab view locker"); + if (!buttons) + grab_view = NULL; + grab_view_locker.Unlock (); + + if (!buttons && wait_for_release_message) + { + wait_for_release_message->SendReply (wait_for_release_message); + delete wait_for_release_message; + wait_for_release_message = NULL; + + previous_buttons = buttons; + return; + } + rq.window = this->Window (); - rq.btn_no = 0; if ((previous_buttons & B_PRIMARY_MOUSE_BUTTON) && !(buttons & B_PRIMARY_MOUSE_BUTTON)) @@ -1523,6 +1564,9 @@ public: else if ((previous_buttons & B_TERTIARY_MOUSE_BUTTON) && !(buttons & B_TERTIARY_MOUSE_BUTTON)) rq.btn_no = 1; + else + return; + previous_buttons = buttons; rq.x = point.x; @@ -1554,7 +1598,21 @@ public: class EmacsScrollBar : public BScrollBar { public: - void *scroll_bar; + int dragging = 0; + bool horizontal; + enum haiku_scroll_bar_part current_part; + float old_value; + scroll_bar_info info; + + /* True if button events should be passed to the parent. */ + bool handle_button = false; + bool in_overscroll = false; + bool can_overscroll = false; + bool maybe_overscroll = false; + BPoint last_overscroll; + int last_reported_overscroll_value; + int max_value, real_max_value; + int overscroll_start_value; EmacsScrollBar (int x, int y, int x1, int y1, bool horizontal_p) : BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ? @@ -1562,15 +1620,68 @@ public: { BView *vw = (BView *) this; vw->SetResizingMode (B_FOLLOW_NONE); + horizontal = horizontal_p; + get_scroll_bar_info (&info); + SetSteps (5000, 10000); } void MessageReceived (BMessage *msg) { + int32 portion, range, dragging, value; + float proportion; + if (msg->what == SCROLL_BAR_UPDATE) { - this->SetRange (0, msg->GetInt32 ("emacs:range", 0)); - this->SetValue (msg->GetInt32 ("emacs:units", 0)); + portion = msg->GetInt32 ("emacs:portion", 0); + range = msg->GetInt32 ("emacs:range", 0); + dragging = msg->GetInt32 ("emacs:dragging", 0); + proportion = ((range <= 0 || portion <= 0) + ? 1.0f : (float) portion / range); + value = msg->GetInt32 ("emacs:units", 0); + can_overscroll = msg->GetBool ("emacs:overscroll", false); + + if (value < 0) + value = 0; + + if (dragging != 1) + { + if (in_overscroll || dragging != -1) + { + /* Set the value to the smallest possible one. + Otherwise, the call to SetRange could lead to + spurious updates. */ + old_value = 0; + SetValue (0); + + /* Unlike on Motif, PORTION isn't included in the total + range of the scroll bar. */ + + SetRange (0, range - portion); + SetProportion (proportion); + max_value = range - portion; + real_max_value = range; + + if (in_overscroll || value > max_value) + value = max_value; + + old_value = roundf (value); + SetValue (old_value); + } + else + { + value = Value (); + + old_value = 0; + SetValue (0); + SetRange (0, range - portion); + SetProportion (proportion); + old_value = value; + SetValue (value); + max_value = range - portion; + real_max_value = range; + } + } } BScrollBar::MessageReceived (msg); @@ -1580,20 +1691,178 @@ public: ValueChanged (float new_value) { struct haiku_scroll_bar_value_event rq; - rq.scroll_bar = scroll_bar; - rq.position = new_value; + struct haiku_scroll_bar_part_event part; + + new_value = Value (); + + if (dragging) + { + if (new_value != old_value) + { + if (dragging > 1) + { + SetValue (old_value); - haiku_write (SCROLL_BAR_VALUE_EVENT, &rq); + part.scroll_bar = this; + part.window = Window (); + part.part = current_part; + haiku_write (SCROLL_BAR_PART_EVENT, &part); + } + else + dragging++; + } + + return; + } + + if (new_value != old_value) + { + rq.scroll_bar = this; + rq.window = Window (); + rq.position = new_value; + old_value = new_value; + + haiku_write (SCROLL_BAR_VALUE_EVENT, &rq); + } + } + + BRegion + ButtonRegionFor (enum haiku_scroll_bar_part button) + { + BRegion region; + BRect bounds; + BRect rect; + float button_size; + + bounds = Bounds (); + bounds.InsetBy (0.0, 0.0); + + if (horizontal) + button_size = bounds.Height () + 1.0f; + else + button_size = bounds.Width () + 1.0f; + + rect = BRect (bounds.left, bounds.top, + bounds.left + button_size - 1.0f, + bounds.top + button_size - 1.0f); + + if (button == HAIKU_SCROLL_BAR_UP_BUTTON) + { + if (!horizontal) + { + region.Include (rect); + if (info.double_arrows) + region.Include (rect.OffsetToCopy (bounds.left, + bounds.bottom - 2 * button_size + 1)); + } + else + { + region.Include (rect); + if (info.double_arrows) + region.Include (rect.OffsetToCopy (bounds.right - 2 * button_size, + bounds.top)); + } + } + else + { + if (!horizontal) + { + region.Include (rect.OffsetToCopy (bounds.left, bounds.bottom - button_size)); + + if (info.double_arrows) + region.Include (rect.OffsetByCopy (0.0, button_size)); + } + else + { + region.Include (rect.OffsetToCopy (bounds.right - button_size, bounds.top)); + + if (info.double_arrows) + region.Include (rect.OffsetByCopy (button_size, 0.0)); + } + } + + return region; } void MouseDown (BPoint pt) { struct haiku_scroll_bar_drag_event rq; + struct haiku_scroll_bar_part_event part; + BRegion r; + BLooper *looper; + BMessage *message; + int32 buttons, mods; + BView *parent; + + looper = Looper (); + message = NULL; + + if (!looper) + GetMouse (&pt, (uint32 *) &buttons, false); + else + { + message = looper->CurrentMessage (); + + if (!message || message->FindInt32 ("buttons", &buttons) != B_OK) + GetMouse (&pt, (uint32 *) &buttons, false); + } + + if (message && (message->FindInt32 ("modifiers", &mods) + == B_OK) + && mods & B_CONTROL_KEY) + { + /* Allow C-mouse-3 to split the window on a scroll bar. */ + handle_button = true; + parent = Parent (); + parent->MouseDown (ConvertToParent (pt)); + + return; + } + + if (buttons == B_PRIMARY_MOUSE_BUTTON) + { + r = ButtonRegionFor (HAIKU_SCROLL_BAR_UP_BUTTON); + + if (r.Contains (pt)) + { + part.scroll_bar = this; + part.window = Window (); + part.part = HAIKU_SCROLL_BAR_UP_BUTTON; + dragging = 1; + current_part = HAIKU_SCROLL_BAR_UP_BUTTON; + + haiku_write (SCROLL_BAR_PART_EVENT, &part); + goto out; + } + + r = ButtonRegionFor (HAIKU_SCROLL_BAR_DOWN_BUTTON); + + if (r.Contains (pt)) + { + part.scroll_bar = this; + part.window = Window (); + part.part = HAIKU_SCROLL_BAR_DOWN_BUTTON; + dragging = 1; + current_part = HAIKU_SCROLL_BAR_DOWN_BUTTON; + + haiku_write (SCROLL_BAR_PART_EVENT, &part); + goto out; + } + + maybe_overscroll = true; + } + rq.dragging_p = 1; - rq.scroll_bar = scroll_bar; + rq.window = Window (); + rq.scroll_bar = this; + + SetMouseEventMask (B_POINTER_EVENTS, (B_SUSPEND_VIEW_FOCUS + | B_LOCK_WINDOW_FOCUS)); haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + + out: BScrollBar::MouseDown (pt); } @@ -1601,12 +1870,125 @@ public: MouseUp (BPoint pt) { struct haiku_scroll_bar_drag_event rq; + BView *parent; + + in_overscroll = false; + maybe_overscroll = false; + + if (handle_button) + { + handle_button = false; + parent = Parent (); + parent->MouseUp (ConvertToParent (pt)); + + return; + } + rq.dragging_p = 0; - rq.scroll_bar = scroll_bar; + rq.scroll_bar = this; + rq.window = Window (); haiku_write (SCROLL_BAR_DRAG_EVENT, &rq); + dragging = false; + BScrollBar::MouseUp (pt); } + + void + MouseMoved (BPoint point, uint32 transit, const BMessage *msg) + { + struct haiku_menu_bar_left_event rq; + struct haiku_scroll_bar_value_event value_event; + int range, diff, value, trough_size; + BRect bounds; + BPoint conv; + uint32 buttons; + + GetMouse (NULL, &buttons, false); + + if (transit == B_EXITED_VIEW) + { + conv = ConvertToParent (point); + + rq.x = std::lrint (conv.x); + rq.y = std::lrint (conv.y); + rq.window = this->Window (); + + if (movement_locker.Lock ()) + { + haiku_write (MENU_BAR_LEFT, &rq); + movement_locker.Unlock (); + } + } + + if (in_overscroll) + { + if (horizontal) + diff = point.x - last_overscroll.x; + else + diff = point.y - last_overscroll.y; + + if (diff < 0) + { + in_overscroll = false; + goto allow; + } + + range = real_max_value; + bounds = Bounds (); + bounds.InsetBy (1.0, 1.0); + value = overscroll_start_value; + trough_size = (horizontal + ? BE_RECT_WIDTH (bounds) + : BE_RECT_HEIGHT (bounds)); + trough_size -= (horizontal + ? BE_RECT_HEIGHT (bounds) + : BE_RECT_WIDTH (bounds)) / 2; + if (info.double_arrows) + trough_size -= (horizontal + ? BE_RECT_HEIGHT (bounds) + : BE_RECT_WIDTH (bounds)) / 2; + + value += ((double) range / trough_size) * diff; + + if (value != last_reported_overscroll_value) + { + last_reported_overscroll_value = value; + + value_event.scroll_bar = this; + value_event.window = Window (); + value_event.position = value; + + haiku_write (SCROLL_BAR_VALUE_EVENT, &value_event); + return; + } + } + else if (can_overscroll + && (buttons == B_PRIMARY_MOUSE_BUTTON) + && maybe_overscroll) + { + value = Value (); + + if (value >= max_value) + { + BScrollBar::MouseMoved (point, transit, msg); + + if (value == Value ()) + { + overscroll_start_value = value; + in_overscroll = true; + last_overscroll = point; + last_reported_overscroll_value = value; + + MouseMoved (point, transit, msg); + return; + } + } + } + + allow: + BScrollBar::MouseMoved (point, transit, msg); + } }; class EmacsTitleMenuItem : public BMenuItem @@ -1910,6 +2292,16 @@ BWindow_set_offset (void *window, int x, int y) wn->MoveTo (x, y); } +void +BWindow_dimensions (void *window, int *width, int *height) +{ + BWindow *w = (BWindow *) window; + BRect frame = w->Frame (); + + *width = BE_RECT_WIDTH (frame); + *height = BE_RECT_HEIGHT (frame); +} + /* Iconify WINDOW. */ void BWindow_iconify (void *window) @@ -2051,10 +2443,9 @@ BScrollBar_make_for_view (void *view, int horizontal_p, void *scroll_bar_ptr) { EmacsScrollBar *sb = new EmacsScrollBar (x, y, x1, y1, horizontal_p); - sb->scroll_bar = scroll_bar_ptr; - BView *vw = (BView *) view; BView *sv = (BView *) sb; + if (!vw->LockLooper ()) gui_abort ("Failed to lock scrollbar owner"); vw->AddChild ((BView *) sb); @@ -2089,14 +2480,22 @@ BView_move_frame (void *view, int x, int y, int x1, int y1) vw->UnlockLooper (); } +/* DRAGGING can either be 0 (which means to update everything), 1 + (which means to update nothing), or -1 (which means to update only + the thumb size and range). */ + void -BView_scroll_bar_update (void *sb, int portion, int whole, int position) +BView_scroll_bar_update (void *sb, int portion, int whole, int position, + int dragging, bool can_overscroll) { BScrollBar *bar = (BScrollBar *) sb; BMessage msg = BMessage (SCROLL_BAR_UPDATE); BMessenger mr = BMessenger (bar); msg.AddInt32 ("emacs:range", whole); msg.AddInt32 ("emacs:units", position); + msg.AddInt32 ("emacs:portion", portion); + msg.AddInt32 ("emacs:dragging", dragging); + msg.AddBool ("emacs:overscroll", can_overscroll); mr.SendMessage (&msg); } @@ -2123,14 +2522,23 @@ BView_invalidate (void *view) /* Lock VIEW in preparation for drawing operations. This should be called before any attempt to draw onto VIEW or to lock it for Cairo - drawing. `BView_draw_unlock' should be called afterwards. */ + drawing. `BView_draw_unlock' should be called afterwards. + + If any drawing is going to take place, INVALID_REGION should be + true, and X, Y, WIDTH, HEIGHT should specify a rectangle in which + the drawing will take place. */ void -BView_draw_lock (void *view) +BView_draw_lock (void *view, bool invalidate_region, + int x, int y, int width, int height) { EmacsView *vw = (EmacsView *) view; if (vw->looper_locked_count) { vw->looper_locked_count++; + + if (invalidate_region && vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); return; } BView *v = (BView *) find_appropriate_view_for_draw (vw); @@ -2144,10 +2552,24 @@ BView_draw_lock (void *view) if (v != vw && !vw->LockLooper ()) gui_abort ("Failed to lock view while acquiring draw lock"); + + if (invalidate_region && vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); vw->looper_locked_count++; } void +BView_invalidate_region (void *view, int x, int y, int width, int height) +{ + EmacsView *vw = (EmacsView *) view; + + if (vw->offscreen_draw_view) + vw->invalid_region.Include (BRect (x, y, x + width - 1, + y + height - 1)); +} + +void BView_draw_unlock (void *view) { EmacsView *vw = (EmacsView *) view; @@ -2266,6 +2688,23 @@ BView_forget_scroll_bar (void *view, int x, int y, int width, int height) } } +bool +BView_inside_scroll_bar (void *view, int x, int y) +{ + EmacsView *vw = (EmacsView *) view; + bool val; + + if (vw->LockLooper ()) + { + val = vw->sb_region.Contains (BPoint (x, y)); + vw->UnlockLooper (); + } + else + val = false; + + return val; +} + void BView_get_mouse (void *view, int *x, int *y) { @@ -2478,7 +2917,7 @@ BMenu_run (void *menu, int x, int y, void (*run_help_callback) (void *, void *), void (*block_input_function) (void), void (*unblock_input_function) (void), - void (*process_pending_signals_function) (void), + struct timespec (*process_pending_signals_function) (void), void *run_help_callback_data) { BPopUpMenu *mn = (BPopUpMenu *) menu; @@ -2486,10 +2925,12 @@ BMenu_run (void *menu, int x, int y, void *buf; void *ptr = NULL; struct be_popup_menu_data data; - struct object_wait_info infos[2]; + struct object_wait_info infos[3]; struct haiku_menu_bar_help_event *event; BMessage *msg; ssize_t stat; + struct timespec next_time; + bigtime_t timeout; block_input_function (); port_popup_menu_to_emacs = create_port (1800, "popup menu port"); @@ -2514,6 +2955,10 @@ BMenu_run (void *menu, int x, int y, (void *) &data); infos[1].type = B_OBJECT_TYPE_THREAD; infos[1].events = B_EVENT_INVALID; + + infos[2].object = port_application_to_emacs; + infos[2].type = B_OBJECT_TYPE_PORT; + infos[2].events = B_EVENT_READ; unblock_input_function (); if (infos[1].object < B_OK) @@ -2530,12 +2975,19 @@ BMenu_run (void *menu, int x, int y, while (true) { - process_pending_signals_function (); + next_time = process_pending_signals_function (); + + if (next_time.tv_nsec < 0) + timeout = 10000000000; + else + timeout = (next_time.tv_sec * 1000000 + + next_time.tv_nsec / 1000); - if ((stat = wait_for_objects_etc ((object_wait_info *) &infos, 2, - B_RELATIVE_TIMEOUT, 10000)) < B_OK) + if ((stat = wait_for_objects_etc ((object_wait_info *) &infos, 3, + B_RELATIVE_TIMEOUT, timeout)) < B_OK) { - if (stat == B_INTERRUPTED || stat == B_TIMED_OUT) + if (stat == B_INTERRUPTED || stat == B_TIMED_OUT + || stat == B_WOULD_BLOCK) continue; else gui_abort ("Failed to wait for popup"); @@ -2543,7 +2995,7 @@ BMenu_run (void *menu, int x, int y, if (infos[0].events & B_EVENT_READ) { - if (!haiku_read_with_timeout (&type, buf, 200, 1000000, true)) + while (!haiku_read_with_timeout (&type, buf, 200, 0, true)) { switch (type) { @@ -2573,6 +3025,7 @@ BMenu_run (void *menu, int x, int y, infos[0].events = B_EVENT_READ; infos[1].events = B_EVENT_INVALID; + infos[2].events = B_EVENT_READ; } } @@ -3481,3 +3934,84 @@ EmacsWindow_signal_menu_update_complete (void *window) pthread_cond_signal (&w->menu_update_cv); pthread_mutex_unlock (&w->menu_update_mutex); } + +void +BMessage_delete (void *message) +{ + delete (BMessage *) message; +} + +static int32 +be_drag_message_thread_entry (void *thread_data) +{ + BMessenger *messenger; + BMessage reply; + + messenger = (BMessenger *) thread_data; + messenger->SendMessage (WAIT_FOR_RELEASE, &reply); + + return 0; +} + +void +be_drag_message (void *view, void *message, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void)) +{ + EmacsView *vw = (EmacsView *) view; + BMessage *msg = (BMessage *) message; + BMessage wait_for_release; + BMessenger messenger (vw); + struct object_wait_info infos[2]; + ssize_t stat; + + block_input_function (); + if (!vw->LockLooper ()) + gui_abort ("Failed to lock view looper for drag"); + + vw->DragMessage (msg, BRect (0, 0, 0, 0)); + vw->UnlockLooper (); + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = spawn_thread (be_drag_message_thread_entry, + "Drag waiter thread", + B_DEFAULT_MEDIA_PRIORITY, + (void *) &messenger); + infos[1].type = B_OBJECT_TYPE_THREAD; + infos[1].events = B_EVENT_INVALID; + unblock_input_function (); + + if (infos[1].object < B_OK) + return; + + block_input_function (); + resume_thread (infos[1].object); + unblock_input_function (); + + while (true) + { + block_input_function (); + stat = wait_for_objects ((struct object_wait_info *) &infos, 2); + unblock_input_function (); + + if (stat == B_INTERRUPTED || stat == B_TIMED_OUT + || stat == B_WOULD_BLOCK) + continue; + + if (stat < B_OK) + gui_abort ("Failed to wait for drag"); + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + if (infos[1].events & B_EVENT_INVALID) + return; + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_INVALID; + } +} diff --git a/src/haiku_support.h b/src/haiku_support.h index ef433514fe7..af7216286a7 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -76,6 +76,7 @@ enum haiku_event_type ICONIFICATION, MOVE_EVENT, SCROLL_BAR_VALUE_EVENT, + SCROLL_BAR_PART_EVENT, SCROLL_BAR_DRAG_EVENT, WHEEL_MOVE_EVENT, MENU_BAR_RESIZE, @@ -85,7 +86,7 @@ enum haiku_event_type FILE_PANEL_EVENT, MENU_BAR_HELP_EVENT, ZOOM_EVENT, - REFS_EVENT, + DRAG_AND_DROP_EVENT, APP_QUIT_REQUESTED_EVENT, DUMMY_EVENT, MENU_BAR_LEFT @@ -112,12 +113,11 @@ struct haiku_expose_event int height; }; -struct haiku_refs_event +struct haiku_drag_and_drop_event { void *window; int x, y; - /* Free this with free! */ - char *ref; + void *message; }; struct haiku_app_quit_requested_event @@ -295,15 +295,30 @@ struct haiku_font_pattern struct haiku_scroll_bar_value_event { void *scroll_bar; + void *window; int position; }; struct haiku_scroll_bar_drag_event { void *scroll_bar; + void *window; int dragging_p; }; +enum haiku_scroll_bar_part + { + HAIKU_SCROLL_BAR_UP_BUTTON, + HAIKU_SCROLL_BAR_DOWN_BUTTON + }; + +struct haiku_scroll_bar_part_event +{ + void *scroll_bar; + void *window; + enum haiku_scroll_bar_part part; +}; + struct haiku_menu_bar_resize_event { void *window; @@ -404,7 +419,7 @@ extern "C" extern int haiku_read_with_timeout (enum haiku_event_type *type, void *buf, ssize_t len, - time_t timeout, bool popup_menu_p); + bigtime_t timeout, bool popup_menu_p); extern int haiku_write (enum haiku_event_type type, void *buf); @@ -612,7 +627,8 @@ extern "C" BView_move_frame (void *view, int x, int y, int x1, int y1); extern void - BView_scroll_bar_update (void *sb, int portion, int whole, int position); + BView_scroll_bar_update (void *sb, int portion, int whole, int position, + int dragging, bool can_overscroll); extern int BScrollBar_default_size (int horizontal_p); @@ -621,7 +637,11 @@ extern "C" BView_invalidate (void *view); extern void - BView_draw_lock (void *view); + BView_draw_lock (void *view, bool invalidate_region, + int x, int y, int width, int height); + + extern void + BView_invalidate_region (void *view, int x, int y, int width, int height); extern void BView_draw_unlock (void *view); @@ -666,6 +686,9 @@ extern "C" extern void BView_forget_scroll_bar (void *view, int x, int y, int width, int height); + extern bool + BView_inside_scroll_bar (void *view, int x, int y); + extern void BView_get_mouse (void *view, int *x, int *y); @@ -721,7 +744,7 @@ extern "C" void (*run_help_callback) (void *, void *), void (*block_input_function) (void), void (*unblock_input_function) (void), - void (*process_pending_signals_function) (void), + struct timespec (*process_pending_signals_function) (void), void *run_help_callback_data); extern void @@ -916,6 +939,18 @@ extern "C" extern haiku_font_family_or_style * be_list_font_families (size_t *length); + extern void + BWindow_dimensions (void *window, int *width, int *height); + + extern void + BMessage_delete (void *message); + + extern void + be_drag_message (void *view, void *message, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void)); + #ifdef __cplusplus extern void * find_appropriate_view_for_draw (void *vw); diff --git a/src/haikufns.c b/src/haikufns.c index 69f502fb016..7bb613af6e2 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -565,7 +565,7 @@ unwind_popup (void) static Lisp_Object haiku_create_frame (Lisp_Object parms) { - struct frame *f; + struct frame *f, *cascade_target; Lisp_Object frame, tem; Lisp_Object name; bool minibuffer_only = false; @@ -575,6 +575,13 @@ haiku_create_frame (Lisp_Object parms) struct haiku_display_info *dpyinfo = NULL; struct kboard *kb; + if (x_display_list->focused_frame) + cascade_target = x_display_list->focused_frame; + else if (x_display_list->focus_event_frame) + cascade_target = x_display_list->focus_event_frame; + else + cascade_target = NULL; + parms = Fcopy_alist (parms); Vx_resource_name = Vinvocation_name; @@ -888,10 +895,18 @@ haiku_create_frame (Lisp_Object parms) block_input (); if (window_prompting & (USPosition | PPosition)) haiku_set_offset (f, f->left_pos, f->top_pos, 1); + else if (cascade_target) + haiku_set_offset (f, cascade_target->left_pos + 15, + cascade_target->top_pos + 15, 1); else BWindow_center_on_screen (FRAME_HAIKU_WINDOW (f)); unblock_input (); + FRAME_OUTPUT_DATA (f)->configury_done = true; + + if (f->want_fullscreen != FULLSCREEN_NONE) + FRAME_TERMINAL (f)->fullscreen_hook (f); + /* Make sure windows on this frame appear in calls to next-window and similar functions. */ Vwindow_list = Qnil; @@ -1374,7 +1389,7 @@ haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval { struct face *defface; - BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); BView_SetViewColor (FRAME_HAIKU_VIEW (f), color.pixel); BView_draw_unlock (FRAME_HAIKU_VIEW (f)); @@ -2201,6 +2216,9 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, block_input (); void *wnd = FRAME_HAIKU_WINDOW (tip_f); BWindow_resize (wnd, width, height); + /* The window decorator might cause the actual width and height to + be larger than WIDTH and HEIGHT, so use the actual sizes. */ + BWindow_dimensions (wnd, &width, &height); BView_resize_to (FRAME_HAIKU_VIEW (tip_f), width, height); BView_set_view_cursor (FRAME_HAIKU_VIEW (tip_f), FRAME_OUTPUT_DATA (f)->current_cursor); diff --git a/src/haikumenu.c b/src/haikumenu.c index 41db0d414dd..8da00ffcb05 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -63,7 +63,7 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, } if (view) - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); while (i < menu_items_used) { @@ -340,13 +340,12 @@ haiku_menu_show_help (void *help, void *data) show_help_echo (Qnil, Qnil, Qnil, Qnil); } -static void +static struct timespec haiku_process_pending_signals_for_menu (void) { process_pending_signals (); - input_pending = false; - detect_input_pending_run_timers (true); + return timer_check (); } Lisp_Object @@ -509,6 +508,10 @@ set_frame_menubar (struct frame *f, bool deep_p) int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); + int count; + ptrdiff_t subitems, i; + int *submenu_start, *submenu_end, *submenu_n_panes; + Lisp_Object *submenu_names; XSETFRAME (Vmenu_updating_frame, f); @@ -553,6 +556,7 @@ set_frame_menubar (struct frame *f, bool deep_p) do always reinitialize them. */ if (first_time_p) previous_menu_items_used = 0; + buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->contents; specbind (Qinhibit_quit, Qt); /* Don't let the debugger step into this code @@ -588,29 +592,23 @@ set_frame_menubar (struct frame *f, bool deep_p) /* Fill in menu_items with the current menu bar contents. This can evaluate Lisp code. */ save_menu_items (); + menu_items = f->menu_bar_vector; menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; - init_menu_items (); - int i; - int count = BMenu_count_items (mbar); - int subitems = ASIZE (items) / 4; - - int *submenu_start, *submenu_end, *submenu_n_panes; - Lisp_Object *submenu_names; - + subitems = ASIZE (items) / 4; submenu_start = alloca ((subitems + 1) * sizeof *submenu_start); submenu_end = alloca (subitems * sizeof *submenu_end); submenu_n_panes = alloca (subitems * sizeof *submenu_n_panes); submenu_names = alloca (subitems * sizeof (Lisp_Object)); - for (i = 0; i < subitems; ++i) + init_menu_items (); + for (i = 0; i < subitems; i++) { Lisp_Object key, string, maps; - key = AREF (items, i * 4); - string = AREF (items, i * 4 + 1); - maps = AREF (items, i * 4 + 2); - + key = AREF (items, 4 * i); + string = AREF (items, 4 * i + 1); + maps = AREF (items, 4 * i + 2); if (NILP (string)) break; @@ -618,16 +616,44 @@ set_frame_menubar (struct frame *f, bool deep_p) string = ENCODE_UTF_8 (string); submenu_start[i] = menu_items_used; + menu_items_n_panes = 0; parse_single_submenu (key, string, maps); submenu_n_panes[i] = menu_items_n_panes; + submenu_end[i] = menu_items_used; submenu_names[i] = string; } - finish_menu_items (); + submenu_start[i] = -1; + finish_menu_items (); + + set_buffer_internal_1 (prev); + + FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 1; + + /* If there has been no change in the Lisp-level contents + of the menu bar, skip redisplaying it. Just exit. */ + + /* Compare the new menu items with the ones computed last time. */ + for (i = 0; i < previous_menu_items_used; i++) + if (menu_items_used == i + || (!EQ (previous_items[i], AREF (menu_items, i)))) + break; + if (i == menu_items_used && i == previous_menu_items_used && i != 0) + { + /* The menu items have not changed. Don't bother updating + the menus in any form, since it would be a no-op. */ + discard_menu_items (); + unbind_to (specpdl_count, Qnil); + return; + } + + /* Convert menu_items into widget_value trees + to display the menu. This cannot evaluate Lisp code. */ block_input (); + count = BMenu_count_items (mbar); for (i = 0; submenu_start[i] >= 0; ++i) { void *mn = NULL; @@ -643,12 +669,12 @@ set_frame_menubar (struct frame *f, bool deep_p) } unblock_input (); - set_buffer_internal_1 (prev); - - FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 1; + /* The menu items are different, so store them in the frame. */ fset_menu_bar_vector (f, menu_items); f->menu_bar_items_used = menu_items_used; } + + /* This undoes save_menu_items. */ unbind_to (specpdl_count, Qnil); } diff --git a/src/haikuselect.c b/src/haikuselect.c index 65dac0e02fa..7474ff12327 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -23,6 +23,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "coding.h" #include "haikuselect.h" #include "haikuterm.h" +#include "haiku_support.h" #include <stdlib.h> @@ -179,6 +180,353 @@ same as `SECONDARY'. */) return value ? Qt : Qnil; } +/* Return the Lisp representation of MESSAGE. + + It is an alist of strings, denoting message field names, to a list + of the form (TYPE DATA ...), where TYPE is an integer denoting the + system data type of DATA, and DATA is in the general case a unibyte + string. + + If TYPE is a symbol instead of an integer, then DATA was specially + decoded. If TYPE is `ref', then DATA is the absolute file name of + a file, or nil if decoding the file name failed. If TYPE is + `string', then DATA is a unibyte string. If TYPE is `short', then + DATA is a 16-bit signed integer. If TYPE is `long', then DATA is a + 32-bit signed integer. If TYPE is `llong', then DATA is a 64-bit + signed integer. If TYPE is `byte' or `char', then DATA is an 8-bit + signed integer. If TYPE is `bool', then DATA is a boolean. */ +Lisp_Object +haiku_message_to_lisp (void *message) +{ + Lisp_Object list = Qnil, tem, t1, t2; + const char *name; + char *pbuf; + const void *buf; + ssize_t buf_size; + int32 i, j, count, type_code; + int rc; + + for (i = 0; !be_enum_message (message, &type_code, i, + &count, &name); ++i) + { + tem = Qnil; + + for (j = 0; j < count; ++j) + { + rc = be_get_message_data (message, name, + type_code, j, + &buf, &buf_size); + if (rc) + emacs_abort (); + + switch (type_code) + { + case 'BOOL': + t1 = (*(bool *) buf) ? Qt : Qnil; + break; + + case 'RREF': + rc = be_get_refs_data (message, name, + j, &pbuf); + + if (rc) + { + t1 = Qnil; + break; + } + + if (!pbuf) + memory_full (SIZE_MAX); + + t1 = build_string (pbuf); + free (pbuf); + break; + + case 'SHRT': + t1 = make_fixnum (*(int16 *) buf); + break; + + case 'LONG': + t1 = make_int (*(int32 *) buf); + break; + + case 'LLNG': + t1 = make_int ((intmax_t) *(int64 *) buf); + break; + + case 'BYTE': + case 'CHAR': + t1 = make_fixnum (*(int8 *) buf); + break; + + default: + t1 = make_uninit_string (buf_size); + memcpy (SDATA (t1), buf, buf_size); + } + + tem = Fcons (t1, tem); + } + + switch (type_code) + { + case 'CSTR': + t2 = Qstring; + break; + + case 'SHRT': + t2 = Qshort; + break; + + case 'LONG': + t2 = Qlong; + break; + + case 'LLNG': + t2 = Qllong; + break; + + case 'BYTE': + t2 = Qbyte; + break; + + case 'RREF': + t2 = Qref; + break; + + case 'CHAR': + t2 = Qchar; + break; + + case 'BOOL': + t2 = Qbool; + break; + + default: + t2 = make_int (type_code); + } + + tem = Fcons (t2, tem); + list = Fcons (Fcons (build_string_from_utf8 (name), tem), list); + } + + return list; +} + +static int32 +lisp_to_type_code (Lisp_Object obj) +{ + if (BIGNUMP (obj)) + return (int32) bignum_to_intmax (obj); + + if (FIXNUMP (obj)) + return XFIXNUM (obj); + + if (EQ (obj, Qstring)) + return 'CSTR'; + else if (EQ (obj, Qshort)) + return 'SHRT'; + else if (EQ (obj, Qlong)) + return 'LONG'; + else if (EQ (obj, Qllong)) + return 'LLNG'; + else if (EQ (obj, Qbyte)) + return 'BYTE'; + else if (EQ (obj, Qref)) + return 'RREF'; + else if (EQ (obj, Qchar)) + return 'CHAR'; + else if (EQ (obj, Qbool)) + return 'BOOL'; + else + return -1; +} + +static void +haiku_lisp_to_message (Lisp_Object obj, void *message) +{ + Lisp_Object tem, t1, name, type_sym, t2, data; + int32 type_code, long_data; + int16 short_data; + int64 llong_data; + int8 char_data; + bool bool_data; + intmax_t t4; + + CHECK_LIST (obj); + for (tem = obj; CONSP (tem); tem = XCDR (tem)) + { + t1 = XCAR (tem); + CHECK_CONS (t1); + + name = XCAR (t1); + CHECK_STRING (name); + + t1 = XCDR (t1); + CHECK_CONS (t1); + + type_sym = XCAR (t1); + type_code = lisp_to_type_code (type_sym); + + if (type_code == -1) + signal_error ("Unknown data type", type_sym); + + CHECK_LIST (t1); + for (t2 = XCDR (t1); CONSP (t2); t2 = XCDR (t2)) + { + data = XCAR (t2); + + switch (type_code) + { + case 'RREF': + signal_error ("Cannot deserialize data type", type_sym); + break; + + case 'SHRT': + if (!TYPE_RANGED_FIXNUMP (int16, data)) + signal_error ("Invalid value", data); + short_data = XFIXNUM (data); + + block_input (); + be_add_message_data (message, SSDATA (name), + type_code, &short_data, + sizeof short_data); + unblock_input (); + break; + + case 'LONG': + if (BIGNUMP (data)) + { + t4 = bignum_to_intmax (data); + + /* We know that int32 is signed. */ + if (!t4 || t4 > TYPE_MINIMUM (int32) + || t4 < TYPE_MAXIMUM (int32)) + signal_error ("Value too large", data); + + long_data = (int32) t4; + } + else + { + if (!TYPE_RANGED_FIXNUMP (int32, data)) + signal_error ("Invalid value", data); + + long_data = (int32) XFIXNUM (data); + } + + block_input (); + be_add_message_data (message, SSDATA (name), + type_code, &long_data, + sizeof long_data); + unblock_input (); + break; + + case 'LLNG': + if (BIGNUMP (data)) + { + t4 = bignum_to_intmax (data); + + if (!t4 || t4 > TYPE_MINIMUM (int64) + || t4 < TYPE_MAXIMUM (int64)) + signal_error ("Value too large", data); + + llong_data = (int64) t4; + } + else + { + if (!TYPE_RANGED_FIXNUMP (int64, data)) + signal_error ("Invalid value", data); + + llong_data = (int64) XFIXNUM (data); + } + + block_input (); + be_add_message_data (message, SSDATA (name), + type_code, &llong_data, + sizeof llong_data); + unblock_input (); + break; + + case 'CHAR': + case 'BYTE': + if (!TYPE_RANGED_FIXNUMP (int8, data)) + signal_error ("Invalid value", data); + char_data = XFIXNUM (data); + + block_input (); + be_add_message_data (message, SSDATA (name), + type_code, &char_data, + sizeof char_data); + unblock_input (); + break; + + case 'BOOL': + bool_data = !NILP (data); + + block_input (); + be_add_message_data (message, SSDATA (name), + type_code, &bool_data, + sizeof bool_data); + unblock_input (); + break; + + default: + CHECK_STRING (data); + + block_input (); + be_add_message_data (message, SSDATA (name), + type_code, SDATA (data), + SBYTES (data)); + unblock_input (); + } + } + CHECK_LIST_END (t2, t1); + } + CHECK_LIST_END (tem, obj); +} + +DEFUN ("haiku-drag-message", Fhaiku_drag_message, Shaiku_drag_message, + 2, 2, 0, + doc: /* Begin dragging MESSAGE from FRAME. + +MESSAGE an alist of strings, denoting message field names, to a list +the form (TYPE DATA ...), where TYPE is an integer denoting the system +data type of DATA, and DATA is in the general case a unibyte string. + +If TYPE is a symbol instead of an integer, then DATA was specially +decoded. If TYPE is `ref', then DATA is the absolute file name of a +file, or nil if decoding the file name failed. If TYPE is `string', +then DATA is a unibyte string. If TYPE is `short', then DATA is a +16-bit signed integer. If TYPE is `long', then DATA is a 32-bit +signed integer. If TYPE is `llong', then DATA is a 64-bit signed +integer. If TYPE is `byte' or `char', then DATA is an 8-bit signed +integer. If TYPE is `bool', then DATA is a boolean. + +FRAME is a window system frame that must be visible, from which the +drag will originate. */) + (Lisp_Object frame, Lisp_Object message) +{ + specpdl_ref idx; + void *be_message; + struct frame *f; + + idx = SPECPDL_INDEX (); + f = decode_window_system_frame (frame); + + if (!FRAME_VISIBLE_P (f)) + error ("Frame is invisible"); + + be_message = be_create_simple_message (); + + record_unwind_protect_ptr (BMessage_delete, be_message); + haiku_lisp_to_message (message, be_message); + be_drag_message (FRAME_HAIKU_VIEW (f), be_message, + block_input, unblock_input, + process_pending_signals); + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + return unbind_to (idx, Qnil); +} + void syms_of_haikuselect (void) { @@ -188,9 +536,18 @@ syms_of_haikuselect (void) DEFSYM (QUTF8_STRING, "UTF8_STRING"); DEFSYM (Qforeign_selection, "foreign-selection"); DEFSYM (QTARGETS, "TARGETS"); + DEFSYM (Qstring, "string"); + DEFSYM (Qref, "ref"); + DEFSYM (Qshort, "short"); + DEFSYM (Qlong, "long"); + DEFSYM (Qllong, "llong"); + DEFSYM (Qbyte, "byte"); + DEFSYM (Qchar, "char"); + DEFSYM (Qbool, "bool"); defsubr (&Shaiku_selection_data); defsubr (&Shaiku_selection_put); defsubr (&Shaiku_selection_targets); defsubr (&Shaiku_selection_owner_p); + defsubr (&Shaiku_drag_message); } diff --git a/src/haikuselect.h b/src/haikuselect.h index 566aae596f6..366890d1a46 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -23,6 +23,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <cstdio> #endif +#include <SupportDefs.h> + #ifdef __cplusplus #include <stdio.h> extern "C" @@ -72,11 +74,23 @@ extern "C" extern bool BClipboard_owns_primary (void); - extern bool - BClipboard_owns_secondary (void); + extern bool BClipboard_owns_secondary (void); /* Free the returned data. */ extern void BClipboard_free_data (void *ptr); + + extern int be_enum_message (void *message, int32 *tc, int32 index, + int32 *count, const char **name_return); + extern int be_get_message_data (void *message, const char *name, + int32 type_code, int32 index, + const void **buf_return, + ssize_t *size_return); + extern int be_get_refs_data (void *message, const char *name, + int32 index, char **path_buffer); + extern void *be_create_simple_message (void); + extern int be_add_message_data (void *message, const char *name, + int32 type_code, const void *buf, + ssize_t buf_size); #ifdef __cplusplus }; #endif diff --git a/src/haikuterm.c b/src/haikuterm.c index c184501a207..4ae64129ef1 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -40,11 +40,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <cairo.h> #endif +/* Minimum and maximum values used for Haiku scroll bars. */ +#define BE_SB_MAX 12000000 + struct haiku_display_info *x_display_list = NULL; extern frame_parm_handler haiku_frame_parm_handlers[]; static void **fringe_bmps; -static int fringe_bitmap_fillptr = 0; +static int max_fringe_bmp = 0; static Lisp_Object rdb; @@ -101,6 +104,15 @@ haiku_coords_from_parent (struct frame *f, int *x, int *y) } static void +haiku_toolkit_position (struct frame *f, int x, int y, + bool *menu_bar_p, bool *tool_bar_p) +{ + if (FRAME_OUTPUT_DATA (f)->menubar) + *menu_bar_p = (x >= 0 && x < FRAME_PIXEL_WIDTH (f) + && y >= 0 && y < FRAME_MENU_BAR_HEIGHT (f)); +} + +static void haiku_delete_terminal (struct terminal *terminal) { emacs_abort (); @@ -131,6 +143,9 @@ haiku_update_size_hints (struct frame *f) int base_width, base_height; eassert (FRAME_HAIKU_P (f) && FRAME_HAIKU_WINDOW (f)); + if (f->tooltip) + return; + base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); @@ -161,8 +176,12 @@ haiku_clip_to_string (struct glyph_string *s) FRAME_PIXEL_HEIGHT (s->f), 10, 10); else - BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[0].x, - r[0].y, r[0].width, r[0].height); + { + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[0].x, + r[0].y, r[0].width, r[0].height); + BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[0].x, + r[0].y, r[0].width, r[0].height); + } } if (n > 1) @@ -175,8 +194,12 @@ haiku_clip_to_string (struct glyph_string *s) FRAME_PIXEL_HEIGHT (s->f), 10, 10); else - BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[1].x, r[1].y, - r[1].width, r[1].height); + { + BView_ClipToRect (FRAME_HAIKU_VIEW (s->f), r[1].x, r[1].y, + r[1].width, r[1].height); + BView_invalidate_region (FRAME_HAIKU_VIEW (s->f), r[1].x, + r[1].y, r[1].width, r[1].height); + } } } @@ -193,7 +216,7 @@ haiku_flip_buffers (struct frame *f) void *view = FRAME_OUTPUT_DATA (f)->view; block_input (); - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); FRAME_DIRTY_P (f) = 0; EmacsView_flip_and_blit (view); BView_draw_unlock (view); @@ -224,7 +247,7 @@ haiku_clear_frame_area (struct frame *f, int x, int y, { void *vw = FRAME_HAIKU_VIEW (f); block_input (); - BView_draw_lock (vw); + BView_draw_lock (vw, true, x, y, width, height); BView_StartClip (vw); BView_ClipToRect (vw, x, y, width, height); BView_SetHighColor (vw, FRAME_BACKGROUND_PIXEL (f)); @@ -242,7 +265,8 @@ haiku_clear_frame (struct frame *f) mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); block_input (); - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); @@ -384,6 +408,126 @@ haiku_frame_raise_lower (struct frame *f, bool raise_p) } } +static struct frame * +haiku_mouse_or_wdesc_frame (void *window) +{ + struct frame *lm_f = (gui_mouse_grabbed (x_display_list) + ? x_display_list->last_mouse_frame + : NULL); + + if (lm_f && !EQ (track_mouse, Qdropping)) + return lm_f; + else + { + struct frame *w_f = haiku_window_to_frame (window); + + /* Do not return a tooltip frame. */ + if (!w_f || FRAME_TOOLTIP_P (w_f)) + return EQ (track_mouse, Qdropping) ? lm_f : NULL; + else + /* When dropping it would be probably nice to raise w_f + here. */ + return w_f; + } +} + +/* Set the thumb size and position of scroll bar BAR. We are + currently displaying PORTION out of a whole WHOLE, and our position + POSITION. */ + +static void +haiku_set_scroll_bar_thumb (struct scroll_bar *bar, int portion, + int position, int whole) +{ + void *scroll_bar = bar->scroll_bar; + double top, shown, size, value; + + if (scroll_bar_adjust_thumb_portion_p) + { + /* We use an estimate of 30 chars per line rather than the real + `portion' value. This has the disadvantage that the thumb + size is not very representative, but it makes our life a lot + easier. Otherwise, we have to constantly adjust the thumb + size, which we can't always do quickly enough: while + dragging, the size of the thumb might prevent the user from + dragging the thumb all the way to the end. */ + portion = WINDOW_TOTAL_LINES (XWINDOW (bar->window)) * 30; + /* When the thumb is at the bottom, position == whole. So we + need to increase `whole' to make space for the thumb. */ + whole += portion; + } + else + bar->page_size = 0; + + if (whole <= 0) + top = 0, shown = 1; + else + { + top = (double) position / whole; + shown = (double) portion / whole; + } + + /* Slider size. Must be in the range [1 .. MAX - MIN] where MAX + is the scroll bar's maximum and MIN is the scroll bar's minimum + value. */ + size = clip_to_bounds (1, shown * BE_SB_MAX, BE_SB_MAX); + + /* Position. Must be in the range [MIN .. MAX - SLIDER_SIZE]. */ + value = top * BE_SB_MAX; + value = min (value, BE_SB_MAX - size); + + if (!bar->dragging && scroll_bar_adjust_thumb_portion_p) + bar->page_size = size; + + BView_scroll_bar_update (scroll_bar, lrint (size), + BE_SB_MAX, ceil (value), + (scroll_bar_adjust_thumb_portion_p + ? bar->dragging : bar->dragging ? -1 : 0), + !scroll_bar_adjust_thumb_portion_p); +} + +static void +haiku_set_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, + int position, int whole) +{ + void *scroll_bar = bar->scroll_bar; + double size, value, shown, top; + + shown = (double) portion / whole; + top = (double) position / whole; + + size = shown * BE_SB_MAX; + value = top * BE_SB_MAX; + + if (!bar->dragging) + bar->page_size = size; + + BView_scroll_bar_update (scroll_bar, lrint (size), BE_SB_MAX, + ceil (value), bar->dragging ? -1 : 0, true); +} + +static struct scroll_bar * +haiku_scroll_bar_from_widget (void *scroll_bar, void *window) +{ + Lisp_Object tem; + struct frame *frame = haiku_window_to_frame (window); + + if (!frame) + return NULL; + + if (!NILP (FRAME_SCROLL_BARS (frame))) + { + for (tem = FRAME_SCROLL_BARS (frame); !NILP (tem); + tem = XSCROLL_BAR (tem)->next) + { + if (XSCROLL_BAR (tem)->scroll_bar == scroll_bar) + return XSCROLL_BAR (tem); + } + } + + return NULL; +} + /* Unfortunately, NOACTIVATE is not implementable on Haiku. */ static void haiku_focus_frame (struct frame *frame, bool noactivate) @@ -1155,7 +1299,7 @@ static void haiku_update_end (struct frame *f) { MOUSE_HL_INFO (f)->mouse_face_defer = false; - flush_frame (f); + BWindow_Flush (FRAME_HAIKU_WINDOW (f)); } static void @@ -1462,7 +1606,7 @@ haiku_draw_glyph_string (struct glyph_string *s) block_input (); view = FRAME_HAIKU_VIEW (s->f); - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); prepare_face_for_display (s->f, s->face); struct face *face = s->face; @@ -1645,13 +1789,17 @@ haiku_after_update_window_line (struct window *w, if (face) { void *view = FRAME_HAIKU_VIEW (f); - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); BView_StartClip (view); BView_SetHighColor (view, face->background_defaulted_p ? FRAME_BACKGROUND_PIXEL (f) : face->background); BView_FillRectangle (view, 0, y, width, height); BView_FillRectangle (view, FRAME_PIXEL_WIDTH (f) - width, y, width, height); + BView_invalidate_region (FRAME_HAIKU_VIEW (f), + 0, y, width, height); + BView_invalidate_region (view, FRAME_PIXEL_WIDTH (f) - width, + y, width, height); BView_EndClip (view); BView_draw_unlock (view); } @@ -1739,7 +1887,7 @@ haiku_draw_window_cursor (struct window *w, h = cursor_height; } - BView_draw_lock (view); + BView_draw_lock (view, false, 0, 0, 0, 0); BView_StartClip (view); if (cursor_type == BAR_CURSOR) @@ -1771,13 +1919,20 @@ haiku_draw_window_cursor (struct window *w, break; case HBAR_CURSOR: BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; case BAR_CURSOR: if (cursor_glyph->resolved_level & 1) - BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, - fy, w->phys_cursor_width, h); + { + BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, + fy, w->phys_cursor_width, h); + BView_invalidate_region (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, + fy, w->phys_cursor_width, h); + } else BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); + + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; case HOLLOW_BOX_CURSOR: if (phys_cursor_glyph->type != IMAGE_GLYPH) @@ -1787,6 +1942,8 @@ haiku_draw_window_cursor (struct window *w, } else draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + + BView_invalidate_region (view, fx, fy, w->phys_cursor_width, h); break; case FILLED_BOX_CURSOR: draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); @@ -1865,7 +2022,7 @@ haiku_draw_vertical_window_border (struct window *w, face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); void *view = FRAME_HAIKU_VIEW (f); - BView_draw_lock (view); + BView_draw_lock (view, true, x, y_0, 1, y_1); BView_StartClip (view); if (face) BView_SetHighColor (view, face->foreground); @@ -1910,7 +2067,7 @@ haiku_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) : FRAME_FOREGROUND_PIXEL (f)); void *view = FRAME_HAIKU_VIEW (f); - BView_draw_lock (view); + BView_draw_lock (view, true, x0, y0, x1 - x0 + 1, y1 - y0 + 1); BView_StartClip (view); if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) @@ -2132,7 +2289,6 @@ haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int p if (NILP (w->horizontal_scroll_bar)) { bar = haiku_scroll_bar_create (w, left, top, width, height, true); - BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); bar->update = position; bar->position = position; bar->total = whole; @@ -2155,13 +2311,9 @@ haiku_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int p bar->width = width; bar->height = height; } - - if (!bar->dragging) - { - BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); - BView_invalidate (bar->scroll_bar); - } } + + haiku_set_horizontal_scroll_bar_thumb (bar, portion, position, whole); bar->position = position; bar->total = whole; XSETVECTOR (barobj, bar); @@ -2192,7 +2344,6 @@ haiku_set_vertical_scroll_bar (struct window *w, if (NILP (w->vertical_scroll_bar)) { bar = haiku_scroll_bar_create (w, left, top, width, height, false); - BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); bar->position = position; bar->total = whole; } @@ -2208,22 +2359,15 @@ haiku_set_vertical_scroll_bar (struct window *w, bar->width, bar->height); BView_move_frame (bar->scroll_bar, left, top, left + width - 1, top + height - 1); - flush_frame (WINDOW_XFRAME (w)); BView_publish_scroll_bar (view, left, top, width, height); bar->left = left; bar->top = top; bar->width = width; bar->height = height; } - - if (!bar->dragging) - { - BView_scroll_bar_update (bar->scroll_bar, portion, whole, position); - bar->update = position; - BView_invalidate (bar->scroll_bar); - } } + haiku_set_scroll_bar_thumb (bar, portion, position, whole); bar->position = position; bar->total = whole; @@ -2240,7 +2384,7 @@ haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct face *face = p->face; block_input (); - BView_draw_lock (view); + BView_draw_lock (view, true, p->x, p->y, p->wd, p->h); BView_StartClip (view); haiku_clip_to_row (w, row, ANY_AREA); @@ -2250,10 +2394,24 @@ haiku_draw_fringe_bitmap (struct window *w, struct glyph_row *row, BView_FillRectangle (view, p->bx, p->by, p->nx, p->ny); } - if (p->which && p->which < fringe_bitmap_fillptr) + if (p->which + && p->which < max_fringe_bmp + && p->which < max_used_fringe_bitmap) { void *bitmap = fringe_bmps[p->which]; + if (!bitmap) + { + /* This fringe bitmap is known to fringe.c, but lacks the + BBitmap which shadows that bitmap. This is typical to + define-fringe-bitmap being called when the selected frame + was not a GUI frame, for example, when packages that + define fringe bitmaps are loaded by a daemon Emacs. + Create the missing pattern now. */ + gui_define_fringe_bitmap (WINDOW_XFRAME (w), p->which); + bitmap = fringe_bmps[p->which]; + } + uint32_t col; if (!p->cursor_p) @@ -2281,14 +2439,14 @@ static void haiku_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd) { - if (which >= fringe_bitmap_fillptr) + if (which >= max_fringe_bmp) { - int i = fringe_bitmap_fillptr; - fringe_bitmap_fillptr = which + 20; - fringe_bmps = !i ? xmalloc (fringe_bitmap_fillptr * sizeof (void *)) : - xrealloc (fringe_bmps, fringe_bitmap_fillptr * sizeof (void *)); + int i = max_fringe_bmp; + max_fringe_bmp = which + 20; + fringe_bmps = !i ? xmalloc (max_fringe_bmp * sizeof (void *)) : + xrealloc (fringe_bmps, max_fringe_bmp * sizeof (void *)); - while (i < fringe_bitmap_fillptr) + while (i < max_fringe_bmp) fringe_bmps[i++] = NULL; } @@ -2303,7 +2461,7 @@ haiku_define_fringe_bitmap (int which, unsigned short *bits, static void haiku_destroy_fringe_bitmap (int which) { - if (which >= fringe_bitmap_fillptr) + if (which >= max_fringe_bmp) return; if (fringe_bmps[which]) @@ -2345,7 +2503,7 @@ haiku_scroll_run (struct window *w, struct run *run) block_input (); gui_clear_cursor (w); - BView_draw_lock (view); + BView_draw_lock (view, true, x, to_y, width, height); BView_StartClip (view); BView_CopyBits (view, x, from_y, width, height, x, to_y, width, height); @@ -2360,14 +2518,19 @@ haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, Time *timestamp) { + Lisp_Object frame, tail; + struct frame *f1 = NULL; + if (!fp) return; block_input (); - Lisp_Object frame, tail; - struct frame *f1 = NULL; + FOR_EACH_FRAME (tail, frame) - XFRAME (frame)->mouse_moved = false; + { + if (FRAME_HAIKU_P (XFRAME (frame))) + XFRAME (frame)->mouse_moved = false; + } if (gui_mouse_grabbed (x_display_list) && !EQ (track_mouse, Qdropping)) f1 = x_display_list->last_mouse_frame; @@ -2415,7 +2578,12 @@ haiku_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, static void haiku_flush (struct frame *f) { - if (FRAME_VISIBLE_P (f)) + /* This is needed for tooltip frames to work properly with double + buffering. */ + if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ()) + haiku_flip_buffers (f); + + if (FRAME_VISIBLE_P (f) && !FRAME_TOOLTIP_P (f)) BWindow_Flush (FRAME_HAIKU_WINDOW (f)); } @@ -2623,6 +2791,10 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (FRAME_TOOLTIP_P (f)) { + if (FRAME_PIXEL_WIDTH (f) != width + || FRAME_PIXEL_HEIGHT (f) != height) + SET_FRAME_GARBAGED (f); + FRAME_PIXEL_WIDTH (f) = width; FRAME_PIXEL_HEIGHT (f) = height; @@ -2630,7 +2802,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) continue; } - BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); BView_resize_to (FRAME_HAIKU_VIEW (f), width, height); BView_draw_unlock (FRAME_HAIKU_VIEW (f)); @@ -2678,8 +2850,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) struct haiku_key_event *b = buf; Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; struct frame *f = haiku_window_to_frame (b->window); - if (!f) - continue; /* If mouse-highlight is an integer, input clears out mouse highlighting. */ @@ -2693,6 +2863,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) need_flush = 1; } + if (!f) + continue; + inev.code = b->keysym ? b->keysym : b->multibyte_char; if (b->keysym) @@ -2755,7 +2928,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case MOUSE_MOTION: { struct haiku_mouse_motion_event *b = buf; - struct frame *f = haiku_window_to_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window); Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; if (!f) @@ -2799,7 +2972,10 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) need_flush = 1; } - if (f->auto_lower && !popup_activated_p) + if (f->auto_lower && !popup_activated_p + /* Don't do this if the mouse entered a scroll bar. */ + && !BView_inside_scroll_bar (FRAME_HAIKU_VIEW (f), + b->x, b->y)) { /* If we're leaving towards the menu bar, don't auto-lower here, and wait for a exit @@ -2911,7 +3087,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case BUTTON_DOWN: { struct haiku_button_event *b = buf; - struct frame *f = haiku_window_to_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window); Lisp_Object tab_bar_arg = Qnil; int tab_bar_p = 0, tool_bar_p = 0; bool up_okay_p = false; @@ -3079,7 +3255,12 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case SCROLL_BAR_VALUE_EVENT: { struct haiku_scroll_bar_value_event *b = buf; - struct scroll_bar *bar = b->scroll_bar; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + int portion, whole; + + if (!bar) + continue; struct window *w = XWINDOW (bar->window); @@ -3091,21 +3272,75 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (bar->position != b->position) { - inev.kind = bar->horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : - SCROLL_BAR_CLICK_EVENT; + inev.kind = (bar->horizontal + ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : + SCROLL_BAR_CLICK_EVENT); inev.part = bar->horizontal ? scroll_bar_horizontal_handle : scroll_bar_handle; - XSETINT (inev.x, b->position); - XSETINT (inev.y, bar->total); + if (bar->horizontal) + { + portion = bar->total * ((float) b->position + / BE_SB_MAX); + whole = (bar->total + * ((float) (BE_SB_MAX - bar->page_size) + / BE_SB_MAX)); + portion = min (portion, whole); + } + else + { + whole = BE_SB_MAX - bar->page_size; + portion = min (b->position, whole); + } + + XSETINT (inev.x, portion); + XSETINT (inev.y, whole); XSETWINDOW (inev.frame_or_window, w); } break; } + case SCROLL_BAR_PART_EVENT: + { + struct haiku_scroll_bar_part_event *b = buf; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + if (!bar) + continue; + + inev.kind = (bar->horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT + : SCROLL_BAR_CLICK_EVENT); + + bar->dragging = 0; + + switch (b->part) + { + case HAIKU_SCROLL_BAR_UP_BUTTON: + inev.part = (bar->horizontal + ? scroll_bar_left_arrow + : scroll_bar_up_arrow); + break; + case HAIKU_SCROLL_BAR_DOWN_BUTTON: + inev.part = (bar->horizontal + ? scroll_bar_right_arrow + : scroll_bar_down_arrow); + break; + } + + XSETINT (inev.x, 0); + XSETINT (inev.y, 0); + inev.frame_or_window = bar->window; + + break; + } case SCROLL_BAR_DRAG_EVENT: { struct haiku_scroll_bar_drag_event *b = buf; - struct scroll_bar *bar = b->scroll_bar; + struct scroll_bar *bar + = haiku_scroll_bar_from_widget (b->scroll_bar, b->window); + + if (!bar) + continue; bar->dragging = b->dragging_p; if (!b->dragging_p && bar->horizontal) @@ -3219,7 +3454,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) menu bar. */ if (!b->no_lock) { - BView_draw_lock (FRAME_HAIKU_VIEW (f)); + BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); /* This shouldn't be here, but nsmenu does it, so it should probably be safe. */ int was_waiting_for_input_p = waiting_for_input; @@ -3310,27 +3545,25 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) haiku_make_fullscreen_consistent (f); break; } - case REFS_EVENT: + case DRAG_AND_DROP_EVENT: { - struct haiku_refs_event *b = buf; + struct haiku_drag_and_drop_event *b = buf; struct frame *f = haiku_window_to_frame (b->window); if (!f) { - free (b->ref); + BMessage_delete (b->message); continue; } inev.kind = DRAG_N_DROP_EVENT; - inev.arg = build_string_from_utf8 (b->ref); + inev.arg = haiku_message_to_lisp (b->message); XSETINT (inev.x, b->x); XSETINT (inev.y, b->y); XSETFRAME (inev.frame_or_window, f); - /* There should be no problem with calling free here. - free on Haiku is thread-safe. */ - free (b->ref); + BMessage_delete (b->message); break; } case APP_QUIT_REQUESTED_EVENT: @@ -3437,7 +3670,8 @@ haiku_flash (struct frame *f) delay = make_timespec (0, 150 * 1000 * 1000); wakeup = timespec_add (current_timespec (), delay); - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); /* If window is tall, flash top and bottom line. */ if (height > 3 * FRAME_LINE_HEIGHT (f)) @@ -3481,7 +3715,8 @@ haiku_flash (struct frame *f) pselect (0, NULL, NULL, NULL, &timeout, NULL); } - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); /* If window is tall, flash top and bottom line. */ if (height > 3 * FRAME_LINE_HEIGHT (f)) @@ -3544,6 +3779,13 @@ haiku_toggle_invisible_pointer (struct frame *f, bool invisible_p) static void haiku_fullscreen (struct frame *f) { + /* When FRAME_OUTPUT_DATA (f)->configury_done is false, the frame is + being created, and its regular width and height have not yet been + set. This function will be called again by haiku_create_frame, + so do nothing. */ + if (!FRAME_OUTPUT_DATA (f)->configury_done) + return; + if (f->want_fullscreen == FULLSCREEN_MAXIMIZED) { EmacsWindow_make_fullscreen (FRAME_HAIKU_WINDOW (f), 0); @@ -3609,6 +3851,7 @@ haiku_create_terminal (struct haiku_display_info *dpyinfo) terminal->menu_show_hook = haiku_menu_show; terminal->toggle_invisible_pointer_hook = haiku_toggle_invisible_pointer; terminal->fullscreen_hook = haiku_fullscreen; + terminal->toolkit_position_hook = haiku_toolkit_position; return terminal; } @@ -3706,7 +3949,8 @@ haiku_clear_under_internal_border (struct frame *f) struct face *face = FACE_FROM_ID_OR_NULL (f, face_id); void *view = FRAME_HAIKU_VIEW (f); block_input (); - BView_draw_lock (view); + BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); BView_StartClip (view); BView_ClipToRect (view, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); diff --git a/src/haikuterm.h b/src/haikuterm.h index a2520858f54..65fd51e237c 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -165,6 +165,10 @@ struct haiku_output /* The pending position we're waiting for. */ int pending_top, pending_left; + + /* Whether or not adjust_frame_size and haiku_set_offset have yet + been called by haiku_create_frame. */ + bool configury_done; }; struct x_output @@ -213,6 +217,8 @@ struct scroll_bar /* True if the scroll bar is horizontal. */ bool horizontal; + + int page_size; }; #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) @@ -253,6 +259,7 @@ extern void haiku_free_frame_resources (struct frame *f); extern void haiku_scroll_bar_remove (struct scroll_bar *bar); extern void haiku_clear_under_internal_border (struct frame *f); extern void haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p); +extern Lisp_Object haiku_message_to_lisp (void *); extern struct haiku_display_info *haiku_term_init (void); diff --git a/src/image.c b/src/image.c index e2ba744e0a3..c412dc90296 100644 --- a/src/image.c +++ b/src/image.c @@ -11160,7 +11160,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) /* On displays with a mutable colormap, figure out the colors allocated for the image by looking at the pixels of an XImage for img->pixmap. */ - if (x_mutable_colormap (FRAME_X_VISUAL (f))) + if (x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) { XImage *ximg; diff --git a/src/keyboard.c b/src/keyboard.c index da8c6c54d85..218f9a86c86 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5247,6 +5247,8 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, Lisp_Object window_or_frame = f ? window_from_coordinates (f, mx, my, &part, true, true) : Qnil; + bool tool_bar_p = false; + bool menu_bar_p = false; /* Report mouse events on the tab bar and (on GUI frames) on the tool bar. */ @@ -5280,6 +5282,20 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, coordinates. FIXME! */ window_or_frame = Qnil; } + + if (FRAME_TERMINAL (f)->toolkit_position_hook) + { + FRAME_TERMINAL (f)->toolkit_position_hook (f, mx, my, &menu_bar_p, + &tool_bar_p); + + if (NILP (track_mouse) || EQ (track_mouse, Qt)) + { + if (menu_bar_p) + posn = Qmenu_bar; + else if (tool_bar_p) + posn = Qtool_bar; + } + } #endif if (f && !FRAME_WINDOW_P (f) diff --git a/src/lisp.h b/src/lisp.h index deeca9bc86b..21709b12598 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <inttypes.h> #include <limits.h> +#include <attribute.h> #include <intprops.h> #include <verify.h> @@ -3453,6 +3454,41 @@ backtrace_debug_on_exit (union specbinding *pdl) return pdl->bt.debug_on_exit; } +void grow_specpdl_allocation (void); + +/* Grow the specpdl stack by one entry. + The caller should have already initialized the entry. + Signal an error on stack overflow. + + Make sure that there is always one unused entry past the top of the + stack, so that the just-initialized entry is safely unwound if + memory exhausted and an error is signaled here. Also, allocate a + never-used entry just before the bottom of the stack; sometimes its + address is taken. */ +INLINE void +grow_specpdl (void) +{ + specpdl_ptr++; + if (specpdl_ptr == specpdl_end) + grow_specpdl_allocation (); +} + +INLINE specpdl_ref +record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) +{ + specpdl_ref count = SPECPDL_INDEX (); + + eassert (nargs >= UNEVALLED); + specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; + specpdl_ptr->bt.debug_on_exit = false; + specpdl_ptr->bt.function = function; + current_thread->stack_top = specpdl_ptr->bt.args = args; + specpdl_ptr->bt.nargs = nargs; + grow_specpdl (); + + return count; +} + /* This structure helps implement the `catch/throw' and `condition-case/signal' control structures. A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. @@ -3510,6 +3546,7 @@ struct handler sys_jmp_buf jmp; EMACS_INT f_lisp_eval_depth; specpdl_ref pdlcount; + struct bc_frame *act_rec; int poll_suppress_count; int interrupt_input_blocked; }; @@ -4051,6 +4088,7 @@ extern void alloc_unexec_pre (void); extern void alloc_unexec_post (void); extern void mark_stack (char const *, char const *); extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg); +extern void mark_memory (void const *start, void const *end); /* Force callee-saved registers and register windows onto the stack, so that conservative garbage collection can see their values. */ @@ -4468,7 +4506,6 @@ extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); extern void syms_of_eval (void); extern void prog_ignore (Lisp_Object); -extern specpdl_ref record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); extern void mark_specpdl (union specbinding *first, union specbinding *ptr); extern void get_backtrace (Lisp_Object array); Lisp_Object backtrace_top_function (void); @@ -4817,9 +4854,24 @@ extern int read_bytecode_char (bool); /* Defined in bytecode.c. */ extern void syms_of_bytecode (void); -extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, - ptrdiff_t, ptrdiff_t, Lisp_Object *); +extern Lisp_Object exec_byte_code (Lisp_Object, ptrdiff_t, + ptrdiff_t, Lisp_Object *); extern Lisp_Object get_byte_code_arity (Lisp_Object); +extern void init_bc_thread (struct bc_thread_state *bc); +extern void free_bc_thread (struct bc_thread_state *bc); +extern void mark_bytecode (struct bc_thread_state *bc); + +INLINE struct bc_frame * +get_act_rec (struct thread_state *th) +{ + return th->bc.fp; +} + +INLINE void +set_act_rec (struct thread_state *th, struct bc_frame *act_rec) +{ + th->bc.fp = act_rec; +} /* Defined in macros.c. */ extern void init_macros (void); @@ -4874,6 +4926,7 @@ extern void child_setup_tty (int); extern void setup_pty (int); extern int set_window_size (int, int, int); extern EMACS_INT get_random (void); +extern unsigned long int get_random_ulong (void); extern void seed_random (void *, ptrdiff_t); extern void init_random (void); extern void emacs_backtrace (int); diff --git a/src/lread.c b/src/lread.c index 0486a98883c..d7b56c5087e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1661,7 +1661,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; - int fd = openp (path, filename, suffixes, &file, predicate, false, false); + int fd = openp (path, filename, suffixes, &file, predicate, false, true); if (NILP (predicate) && fd >= 0) emacs_close (fd); return file; diff --git a/src/macros.c b/src/macros.c index 0447a367fd6..6b6865d9298 100644 --- a/src/macros.c +++ b/src/macros.c @@ -273,9 +273,15 @@ pop_kbd_macro (Lisp_Object info) } DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0, - doc: /* Execute MACRO as string of editor command characters. -MACRO can also be a vector of keyboard events. If MACRO is a symbol, -its function definition is used. + doc: /* Execute MACRO as a sequence of events. +If MACRO is a string or vector, then the events in it are executed +exactly as if they had been input by the user. + +If MACRO is a symbol, its function definition is used. If that is +another symbol, this process repeats. Eventually the result should be +a string or vector. If the result is not a symbol, string, or vector, +an error is signaled. + COUNT is a repeat count, or nil for once, or 0 for infinite loop. Optional third arg LOOPFUNC may be a function that is called prior to diff --git a/src/msdos.c b/src/msdos.c index f126d28c985..1608245904c 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -2725,7 +2725,8 @@ dos_rawgetc (void) event.x = make_fixnum (x); event.y = make_fixnum (y); event.frame_or_window = selected_frame; - event.arg = Qnil; + event.arg = tty_handle_tab_bar_click (SELECTED_FRAME (), + x, y, press, &event); event.timestamp = event_timestamp (); kbd_buffer_store_event (&event); } diff --git a/src/nsfns.m b/src/nsfns.m index 1900616b9de..720ed3f88e5 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1112,6 +1112,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, Lisp_Object parent, parent_frame; struct kboard *kb; static int desc_ctr = 1; + NSWindow *main_window = [NSApp mainWindow]; /* gui_display_get_arg modifies parms. */ parms = Fcopy_alist (parms); @@ -1483,8 +1484,27 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); - if (window_prompting & USPosition) + /* This cascading behavior (which is the job of the window manager + on X-based systems) is something NS applications are expected to + implement themselves. At least one person tells me he used + Carbon Emacs solely for this behavior. */ + if (window_prompting & (USPosition | PPosition) || FRAME_PARENT_FRAME (f)) ns_set_offset (f, f->left_pos, f->top_pos, 1); + else + { + NSWindow *frame_window = [FRAME_NS_VIEW (f) window]; + NSPoint top_left; + + if (main_window) + { + top_left = NSMakePoint (NSMinX ([main_window frame]), + NSMaxY ([main_window frame])); + top_left = [frame_window cascadeTopLeftFromPoint: top_left]; + [frame_window cascadeTopLeftFromPoint: top_left]; + } + else + [frame_window center]; + } /* Make sure windows on this frame appear in calls to next-window and similar functions. */ diff --git a/src/nsterm.m b/src/nsterm.m index aba26ef7585..fd56094c28b 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2916,6 +2916,14 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, } NSBezierPath *bmp = [fringe_bmp objectForKey:[NSNumber numberWithInt:p->which]]; + + if (bmp == nil + && p->which < max_used_fringe_bitmap) + { + gui_define_fringe_bitmap (f, p->which); + bmp = [fringe_bmp objectForKey: [NSNumber numberWithInt: p->which]]; + } + if (bmp) { NSAffineTransform *transform = [NSAffineTransform transform]; @@ -5830,7 +5838,7 @@ not_in_argv (NSString *arg) fd_set fds; FD_ZERO (&fds); FD_SET (selfds[0], &fds); - result = select (selfds[0]+1, &fds, NULL, NULL, NULL); + result = pselect (selfds[0]+1, &fds, NULL, NULL, NULL, NULL); if (result > 0 && read (selfds[0], &c, 1) == 1 && c == 'g') waiting = 0; } @@ -8382,7 +8390,7 @@ not_in_argv (NSString *arg) EmacsToolbar *toolbar = [[EmacsToolbar alloc] initForView:view - withIdentifier:[NSString stringWithLispString:f->name]]; + withIdentifier:[NSString stringWithFormat:@"%p", f]]; [self setToolbar:toolbar]; update_frame_tool_bar_1 (f, toolbar); diff --git a/src/pgtkfns.c b/src/pgtkfns.c index dd2e305965a..38e60858432 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -3872,6 +3872,21 @@ nil, it defaults to the selected frame. */) return unbind_to (count, font); } +#if GTK_CHECK_VERSION (3, 14, 0) +DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, + doc: /* Toggle interactive GTK debugging. */) + (Lisp_Object enable) +{ + gboolean enable_debug = !NILP (enable); + + block_input (); + gtk_window_set_interactive_debugging (enable_debug); + unblock_input (); + + return NILP (enable) ? Qnil : Qt; +} +#endif /* GTK_CHECK_VERSION (3, 14, 0) */ + /* ========================================================================== Lisp interface declaration @@ -3971,6 +3986,10 @@ be used as the image of the icon representing the frame. */); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); +#if GTK_CHECK_VERSION (3, 14, 0) + defsubr (&Sx_gtk_debug); +#endif + defsubr (&Spgtk_hide_others); defsubr (&Spgtk_hide_emacs); diff --git a/src/pgtkmenu.c b/src/pgtkmenu.c index 7a3bfea4518..bd63af3b223 100644 --- a/src/pgtkmenu.c +++ b/src/pgtkmenu.c @@ -43,7 +43,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <gtk/gtk.h> /* Flag which when set indicates a dialog or menu has been posted by - Xt on behalf of one of the widget sets. */ + GTK on behalf of one of the widget sets. */ static int popup_activated_flag; /* Set menu_items_inuse so no other popup menu or dialog is created. */ @@ -132,7 +132,7 @@ pgtk_activate_menubar (struct frame *f) static void popup_deactivate_callback (GtkWidget *widget, gpointer client_data) { - popup_activated_flag = 0; + pgtk_menu_set_in_use (false); } /* Function that finds the frame for WIDGET and shows the HELP text diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 54b65ac54e4..e00ed7fa85d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -36,6 +36,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <c-strcase.h> #include <ftoastr.h> +#include <dlfcn.h> + #include "lisp.h" #include "blockinput.h" #include "frame.h" @@ -47,7 +49,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "fontset.h" #include "composite.h" #include "ccl.h" -#include "dynlib.h" #include "termhooks.h" #include "termopts.h" @@ -105,7 +106,35 @@ static void pgtk_fill_rectangle (struct frame *f, unsigned long color, int x, bool respect_alpha_background); static void pgtk_clip_to_row (struct window *w, struct glyph_row *row, enum glyph_row_area area, cairo_t * cr); -static struct frame *pgtk_any_window_to_frame (GdkWindow * window); +static struct frame *pgtk_any_window_to_frame (GdkWindow *window); + +static void +pgtk_toolkit_position (struct frame *f, int x, int y, + bool *menu_bar_p, bool *tool_bar_p) +{ + GdkRectangle test_rect; + int scale; + + y += (FRAME_MENUBAR_HEIGHT (f) + + FRAME_TOOLBAR_TOP_HEIGHT (f)); + x += FRAME_TOOLBAR_LEFT_WIDTH (f); + + if (FRAME_EXTERNAL_MENU_BAR (f)) + *menu_bar_p = (x >= 0 && x < FRAME_PIXEL_WIDTH (f) + && y >= 0 && y < FRAME_MENUBAR_HEIGHT (f)); + + if (FRAME_X_OUTPUT (f)->toolbar_widget) + { + scale = xg_get_scale (f); + test_rect.x = x / scale; + test_rect.y = y / scale; + test_rect.width = 1; + test_rect.height = 1; + + *tool_bar_p = gtk_widget_intersect (FRAME_X_OUTPUT (f)->toolbar_widget, + &test_rect, NULL); + } +} /* * This is not a flip context in the same sense as gpu rendering @@ -2345,29 +2374,15 @@ x_draw_stretch_glyph_string (struct glyph_string *s) else if (!s->background_filled_p) { int background_width = s->background_width; - int x = s->x, text_left_x = window_box_left_offset (s->w, TEXT_AREA); + int x = s->x, text_left_x = window_box_left (s->w, TEXT_AREA); /* Don't draw into left fringe or scrollbar area except for - header line and mode line. */ - if (x < text_left_x && !s->row->mode_line_p) + header line and mode line. */ + if (s->area == TEXT_AREA + && x < text_left_x && !s->row->mode_line_p) { - int left_x = WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (s->w); - int right_x = text_left_x; - - if (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (s->w)) - left_x += WINDOW_LEFT_FRINGE_WIDTH (s->w); - else - right_x -= WINDOW_LEFT_FRINGE_WIDTH (s->w); - - /* Adjust X and BACKGROUND_WIDTH to fit inside the space - between LEFT_X and RIGHT_X. */ - if (x < left_x) - { - background_width -= left_x - x; - x = left_x; - } - if (x + background_width > right_x) - background_width = right_x - x; + background_width -= text_left_x - x; + x = text_left_x; } if (background_width > 0) x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); @@ -2925,20 +2940,13 @@ pgtk_copy_bits (struct frame *f, cairo_rectangle_t *src_rect, cairo_rectangle_t *dst_rect) { cairo_t *cr; - GdkWindow *window; cairo_surface_t *surface; /* temporary surface */ - int scale; - - window = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); surface = - gdk_window_create_similar_surface (window, CAIRO_CONTENT_COLOR_ALPHA, - FRAME_CR_SURFACE_DESIRED_WIDTH (f), - FRAME_CR_SURFACE_DESIRED_HEIGHT - (f)); - - scale = gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); - cairo_surface_set_device_scale (surface, scale, scale); + cairo_surface_create_similar (FRAME_CR_SURFACE (f), + CAIRO_CONTENT_COLOR_ALPHA, + (int) src_rect->width, + (int) src_rect->height); cr = cairo_create (surface); cairo_set_source_surface (cr, FRAME_CR_SURFACE (f), -src_rect->x, @@ -3545,10 +3553,23 @@ pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row, } } - if (p->which && p->which < max_fringe_bmp) + if (p->which + && p->which < max_fringe_bmp + && p->which < max_used_fringe_bitmap) { Emacs_GC gcv; + if (!fringe_bmp[p->which]) + { + /* This fringe bitmap is known to fringe.c, but lacks the + cairo_pattern_t pattern which shadows that bitmap. This + is typical to define-fringe-bitmap being called when the + selected frame was not a GUI frame, for example, when + packages that define fringe bitmaps are loaded by a + daemon Emacs. Create the missing pattern now. */ + gui_define_fringe_bitmap (f, p->which); + } + gcv.foreground = (p->cursor_p ? (p->overlay_p ? face->background : FRAME_X_OUTPUT (f)->cursor_color) @@ -4808,6 +4829,7 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo) terminal->focus_frame_hook = pgtk_focus_frame; terminal->set_frame_offset_hook = x_set_offset; terminal->free_pixmap = pgtk_free_pixmap; + terminal->toolkit_position_hook = pgtk_toolkit_position; /* Other hooks are NULL by default. */ @@ -5957,7 +5979,7 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event, clear_mouse_face (hlinfo); } - if (f && xg_event_is_for_scrollbar (f, event)) + if (f && xg_event_is_for_scrollbar (f, event, false)) f = 0; if (f) { @@ -6517,8 +6539,8 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) static int x_initialized = 0; static unsigned x_display_id = 0; static char *initial_display = NULL; - static dynlib_handle_ptr *handle = NULL; char *dpy_name; + static void *handle = NULL; Lisp_Object lisp_dpy_name = Qnil; block_input (); @@ -6692,15 +6714,15 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) dpyinfo->connection = -1; if (!handle) - handle = dynlib_open (NULL); + handle = dlopen (NULL, RTLD_LAZY); #ifdef GDK_WINDOWING_X11 if (!strcmp (G_OBJECT_TYPE_NAME (dpy), "GdkX11Display") && handle) { void *(*gdk_x11_display_get_xdisplay) (GdkDisplay *) - = dynlib_sym (handle, "gdk_x11_display_get_xdisplay"); + = dlsym (handle, "gdk_x11_display_get_xdisplay"); int (*x_connection_number) (void *) - = dynlib_sym (handle, "XConnectionNumber"); + = dlsym (handle, "XConnectionNumber"); if (x_connection_number && gdk_x11_display_get_xdisplay) @@ -6714,7 +6736,7 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) { struct wl_display *wl_dpy = gdk_wayland_display_get_wl_display (dpy); int (*display_get_fd) (struct wl_display *) - = dynlib_sym (handle, "wl_display_get_fd"); + = dlsym (handle, "wl_display_get_fd"); if (display_get_fd) dpyinfo->connection = display_get_fd (wl_dpy); diff --git a/src/print.c b/src/print.c index 8cce8a1ad83..704fc278f2d 100644 --- a/src/print.c +++ b/src/print.c @@ -2171,14 +2171,19 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) Lisp_Object name = SYMBOL_NAME (obj); ptrdiff_t size_byte = SBYTES (name); - /* Set CONFUSING if NAME looks like a number, calling - string_to_number for non-obvious cases. */ char *p = SSDATA (name); bool signedp = *p == '-' || *p == '+'; ptrdiff_t len; - bool confusing = ((c_isdigit (p[signedp]) || p[signedp] == '.') - && !NILP (string_to_number (p, 10, &len)) - && len == size_byte); + bool confusing = + /* Set CONFUSING if NAME looks like a number, calling + string_to_number for non-obvious cases. */ + ((c_isdigit (p[signedp]) || p[signedp] == '.') + && !NILP (string_to_number (p, 10, &len)) + && len == size_byte) + /* We don't escape "." or "?" (unless they're the first + character in the symbol name). */ + || *p == '?' + || *p == '.'; if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj)) @@ -2201,8 +2206,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { if (c == '\"' || c == '\\' || c == '\'' || c == ';' || c == '#' || c == '(' || c == ')' - || c == ',' || c == '.' || c == '`' - || c == '[' || c == ']' || c == '?' || c <= 040 + || c == ',' || c == '`' + || c == '[' || c == ']' || c <= 040 || c == NO_BREAK_SPACE || confusing) { diff --git a/src/process.c b/src/process.c index 94cc8800970..993e1c56038 100644 --- a/src/process.c +++ b/src/process.c @@ -6420,7 +6420,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, if (p->raw_status_new) update_status (p); if (! EQ (p->status, Qrun)) - error ("Process %s not running", SDATA (p->name)); + error ("Process %s not running: %s", SDATA (p->name), SDATA (status_message (p))); if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); @@ -7125,7 +7125,7 @@ process has been transmitted to the serial port. */) if (XPROCESS (proc)->raw_status_new) update_status (XPROCESS (proc)); if (! EQ (XPROCESS (proc)->status, Qrun)) - error ("Process %s not running", SDATA (XPROCESS (proc)->name)); + error ("Process %s not running: %s", SDATA (XPROCESS (proc)->name), SDATA (status_message (XPROCESS (proc)))); if (coding && CODING_REQUIRE_FLUSHING (coding)) { diff --git a/src/sysdep.c b/src/sysdep.c index 95f77febcbf..1632f46d13e 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2200,6 +2200,16 @@ get_random (void) return val & INTMASK; } +/* Return a random unsigned long. */ +unsigned long int +get_random_ulong (void) +{ + unsigned long int r = 0; + for (int i = 0; i < (ULONG_WIDTH + RAND_BITS - 1) / RAND_BITS; i++) + r = random () ^ (r << RAND_BITS) ^ (r >> (ULONG_WIDTH - RAND_BITS)); + return r; +} + #ifndef HAVE_SNPRINTF /* Approximate snprintf as best we can on ancient hosts that lack it. */ int @@ -3152,95 +3162,70 @@ list_system_processes (void) #endif /* !defined (WINDOWSNT) */ +#if defined __FreeBSD__ || defined DARWIN_OS || defined __OpenBSD__ -#if defined __FreeBSD__ || defined DARWIN_OS - -static struct timespec -timeval_to_timespec (struct timeval t) -{ - return make_timespec (t.tv_sec, t.tv_usec * 1000); -} static Lisp_Object -make_lisp_timeval (struct timeval t) +make_lisp_s_us (time_t s, long us) { - return make_lisp_time (timeval_to_timespec (t)); + Lisp_Object sec = make_int (s); + Lisp_Object usec = make_fixnum (us); + Lisp_Object hz = make_fixnum (1000000); + Lisp_Object ticks = CALLN (Fplus, CALLN (Ftimes, sec, hz), usec); + return Ftime_convert (Fcons (ticks, hz), Qnil); } -#elif defined __OpenBSD__ +#endif + +#if defined __FreeBSD__ || defined DARWIN_OS static Lisp_Object -make_lisp_timeval (long sec, long usec) +make_lisp_timeval (struct timeval t) { - return make_lisp_time(make_timespec(sec, usec * 1000)); + return make_lisp_s_us (t.tv_sec, t.tv_usec); } #endif #ifdef GNU_LINUX -static struct timespec -time_from_jiffies (unsigned long long tval, long hz) -{ - unsigned long long s = tval / hz; - unsigned long long frac = tval % hz; - int ns; - - if (TYPE_MAXIMUM (time_t) < s) - time_overflow (); - if (LONG_MAX - 1 <= ULLONG_MAX / TIMESPEC_HZ - || frac <= ULLONG_MAX / TIMESPEC_HZ) - ns = frac * TIMESPEC_HZ / hz; - else - { - /* This is reachable only in the unlikely case that HZ * HZ - exceeds ULLONG_MAX. It calculates an approximation that is - guaranteed to be in range. */ - long hz_per_ns = hz / TIMESPEC_HZ + (hz % TIMESPEC_HZ != 0); - ns = frac / hz_per_ns; - } - return make_timespec (s, ns); +static Lisp_Object +time_from_jiffies (unsigned long long ticks, Lisp_Object hz, Lisp_Object form) +{ + return Ftime_convert (Fcons (make_uint (ticks), hz), form); } static Lisp_Object -ltime_from_jiffies (unsigned long long tval, long hz) +put_jiffies (Lisp_Object attrs, Lisp_Object propname, + unsigned long long ticks, Lisp_Object hz) { - struct timespec t = time_from_jiffies (tval, hz); - return make_lisp_time (t); + return Fcons (Fcons (propname, time_from_jiffies (ticks, hz, Qnil)), attrs); } -static struct timespec +static Lisp_Object get_up_time (void) { FILE *fup; - struct timespec up = make_timespec (0, 0); + Lisp_Object up = Qnil; block_input (); fup = emacs_fopen ("/proc/uptime", "r"); if (fup) { - unsigned long long upsec, upfrac; + unsigned long long upsec; + EMACS_UINT upfrac; int upfrac_start, upfrac_end; - if (fscanf (fup, "%llu.%n%llu%n", + if (fscanf (fup, "%llu.%n%"pI"u%n", &upsec, &upfrac_start, &upfrac, &upfrac_end) == 2) { - if (TYPE_MAXIMUM (time_t) < upsec) - { - upsec = TYPE_MAXIMUM (time_t); - upfrac = TIMESPEC_HZ - 1; - } - else - { - int upfraclen = upfrac_end - upfrac_start; - for (; upfraclen < LOG10_TIMESPEC_HZ; upfraclen++) - upfrac *= 10; - for (; LOG10_TIMESPEC_HZ < upfraclen; upfraclen--) - upfrac /= 10; - upfrac = min (upfrac, TIMESPEC_HZ - 1); - } - up = make_timespec (upsec, upfrac); + EMACS_INT hz = 1; + for (int i = upfrac_start; i < upfrac_end; i++) + hz *= 10; + Lisp_Object sec = make_uint (upsec); + Lisp_Object subsec = Fcons (make_fixnum (upfrac), make_fixnum (hz)); + up = Ftime_add (sec, subsec); } fclose (fup); } @@ -3361,7 +3346,6 @@ system_process_attributes (Lisp_Object pid) unsigned long long u_time, s_time, cutime, cstime, start; long priority, niceness, rss; unsigned long minflt, majflt, cminflt, cmajflt, vsize; - struct timespec tnow, tstart, tboot, telapsed, us_time; double pcpu, pmem; Lisp_Object attrs = Qnil; Lisp_Object decoded_cmd; @@ -3449,47 +3433,41 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (majflt)), attrs); attrs = Fcons (Fcons (Qcminflt, INT_TO_INTEGER (cminflt)), attrs); attrs = Fcons (Fcons (Qcmajflt, INT_TO_INTEGER (cmajflt)), attrs); + clocks_per_sec = sysconf (_SC_CLK_TCK); - if (clocks_per_sec < 0) - clocks_per_sec = 100; - attrs = Fcons (Fcons (Qutime, - ltime_from_jiffies (u_time, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qstime, - ltime_from_jiffies (s_time, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qtime, - ltime_from_jiffies (s_time + u_time, - clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qcutime, - ltime_from_jiffies (cutime, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qcstime, - ltime_from_jiffies (cstime, clocks_per_sec)), - attrs); - attrs = Fcons (Fcons (Qctime, - ltime_from_jiffies (cstime + cutime, - clocks_per_sec)), - attrs); + if (0 < clocks_per_sec) + { + Lisp_Object hz = make_int (clocks_per_sec); + attrs = put_jiffies (attrs, Qutime, u_time, hz); + attrs = put_jiffies (attrs, Qstime, s_time, hz); + attrs = put_jiffies (attrs, Qtime, s_time + u_time, hz); + attrs = put_jiffies (attrs, Qcutime, cutime, hz); + attrs = put_jiffies (attrs, Qcstime, cstime, hz); + attrs = put_jiffies (attrs, Qctime, cstime + cutime, hz); + + Lisp_Object uptime = get_up_time (); + if (!NILP (uptime)) + { + Lisp_Object now = Ftime_convert (Qnil, hz); + Lisp_Object boot = Ftime_subtract (now, uptime); + Lisp_Object tstart = time_from_jiffies (start, hz, hz); + Lisp_Object lstart = + Ftime_convert (Ftime_add (boot, tstart), Qnil); + attrs = Fcons (Fcons (Qstart, lstart), attrs); + Lisp_Object etime = + Ftime_convert (Ftime_subtract (uptime, tstart), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); + pcpu = (100.0 * (s_time + u_time) + / (clocks_per_sec * float_time (etime))); + attrs = Fcons (Fcons (Qpcpu, make_float (pcpu)), attrs); + } + } + attrs = Fcons (Fcons (Qpri, make_fixnum (priority)), attrs); attrs = Fcons (Fcons (Qnice, make_fixnum (niceness)), attrs); attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (thcount)), attrs); - tnow = current_timespec (); - telapsed = get_up_time (); - tboot = timespec_sub (tnow, telapsed); - tstart = time_from_jiffies (start, clocks_per_sec); - tstart = timespec_add (tboot, tstart); - attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs); attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (vsize / 1024)), attrs); attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (4 * rss)), attrs); - telapsed = timespec_sub (tnow, tstart); - attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs); - us_time = time_from_jiffies (u_time + s_time, clocks_per_sec); - pcpu = timespectod (us_time) / timespectod (telapsed); - if (pcpu > 1.0) - pcpu = 1.0; - attrs = Fcons (Fcons (Qpcpu, make_float (100 * pcpu)), attrs); pmem = 4.0 * 100 * rss / procfs_get_total_memory (); if (pmem > 100) pmem = 100; @@ -3706,7 +3684,6 @@ system_process_attributes (Lisp_Object pid) char *ttyname; size_t len; char args[MAXPATHLEN]; - struct timespec t, now; int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID}; struct kinfo_proc proc; @@ -3787,35 +3764,30 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qcminflt, make_fixnum (proc.ki_rusage_ch.ru_minflt)), attrs); attrs = Fcons (Fcons (Qcmajflt, make_fixnum (proc.ki_rusage_ch.ru_majflt)), attrs); - attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.ki_rusage.ru_utime)), - attrs); - attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.ki_rusage.ru_stime)), - attrs); - t = timespec_add (timeval_to_timespec (proc.ki_rusage.ru_utime), - timeval_to_timespec (proc.ki_rusage.ru_stime)); - attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs); + Lisp_Object utime = make_lisp_timeval (proc.ki_rusage.ru_utime); + attrs = Fcons (Fcons (Qutime, utime), attrs); + Lisp_Object stime = make_lisp_timeval (proc.ki_rusage.ru_stime); + attrs = Fcons (Fcons (Qstime, stime), attrs); + attrs = Fcons (Fcons (Qtime, Ftime_add (utime, stime)), attrs); - attrs = Fcons (Fcons (Qcutime, - make_lisp_timeval (proc.ki_rusage_ch.ru_utime)), - attrs); - attrs = Fcons (Fcons (Qcstime, - make_lisp_timeval (proc.ki_rusage_ch.ru_utime)), - attrs); - t = timespec_add (timeval_to_timespec (proc.ki_rusage_ch.ru_utime), - timeval_to_timespec (proc.ki_rusage_ch.ru_stime)); - attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs); + Lisp_Object cutime = make_lisp_timeval (proc.ki_rusage_ch.ru_utime); + attrs = Fcons (Fcons (Qcutime, cutime), attrs); + Lisp_Object cstime = make_lisp_timeval (proc.ki_rusage_ch.ru_stime); + attrs = Fcons (Fcons (Qcstime, cstime), attrs); + attrs = Fcons (Fcons (Qctime, Ftime_add (cutime, cstime)), attrs); attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (proc.ki_numthreads)), attrs); attrs = Fcons (Fcons (Qpri, make_fixnum (proc.ki_pri.pri_native)), attrs); attrs = Fcons (Fcons (Qnice, make_fixnum (proc.ki_nice)), attrs); - attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs); + Lisp_Object start = make_lisp_timeval (proc.ki_start); + attrs = Fcons (Fcons (Qstart, start), attrs); attrs = Fcons (Fcons (Qvsize, make_fixnum (proc.ki_size >> 10)), attrs); attrs = Fcons (Fcons (Qrss, make_fixnum (proc.ki_rssize * pagesize >> 10)), attrs); - now = current_timespec (); - t = timespec_sub (now, timeval_to_timespec (proc.ki_start)); - attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); + Lisp_Object now = Ftime_convert (Qnil, make_fixnum (1000000)); + Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); len = sizeof fscale; if (sysctlbyname ("kern.fscale", &fscale, &len, NULL, 0) == 0) @@ -3875,7 +3847,6 @@ system_process_attributes (Lisp_Object pid) struct kinfo_proc proc; struct passwd *pw; struct group *gr; - struct timespec t; struct uvmexp uvmexp; Lisp_Object attrs = Qnil; @@ -3957,20 +3928,14 @@ system_process_attributes (Lisp_Object pid) /* FIXME: missing cminflt, cmajflt. */ - attrs = Fcons (Fcons (Qutime, make_lisp_timeval (proc.p_uutime_sec, - proc.p_uutime_usec)), - attrs); - attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.p_ustime_sec, - proc.p_ustime_usec)), - attrs); - t = timespec_add (make_timespec (proc.p_uutime_sec, - proc.p_uutime_usec * 1000), - make_timespec (proc.p_ustime_sec, - proc.p_ustime_usec * 1000)); - attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs); - - attrs = Fcons (Fcons (Qcutime, make_lisp_timeval (proc.p_uctime_sec, - proc.p_uctime_usec)), + Lisp_Object utime = make_lisp_s_us (proc.p_uutime_sec, proc.p_uutime_usec); + attrs = Fcons (Fcons (Qutime, utime), attrs); + Lisp_Object stime = make_lisp_s_us (proc.p_ustime_sec, proc.p_ustime_usec); + attrs = Fcons (Fcons (Qstime, stime), attrs); + attrs = Fcons (Fcons (Qtime, Ftime_add (utime, stime)), attrs); + + attrs = Fcons (Fcons (Qcutime, make_lisp_s_us (proc.p_uctime_sec, + proc.p_uctime_usec)), attrs); /* FIXME: missing cstime and thus ctime. */ @@ -3980,8 +3945,8 @@ system_process_attributes (Lisp_Object pid) /* FIXME: missing thcount (thread count) */ - attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.p_ustart_sec, - proc.p_ustart_usec)), + attrs = Fcons (Fcons (Qstart, make_lisp_s_us (proc.p_ustart_sec, + proc.p_ustart_usec)), attrs); len = (proc.p_vm_tsize + proc.p_vm_dsize + proc.p_vm_ssize) * pagesize >> 10; @@ -3990,10 +3955,11 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qrss, make_fixnum (proc.p_vm_rssize * pagesize >> 10)), attrs); - t = make_timespec (proc.p_ustart_sec, - proc.p_ustart_usec * 1000); - t = timespec_sub (current_timespec (), t); - attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); + Lisp_Object now = Ftime_convert (Qnil, make_fixnum (1000000)); + Lisp_Object start = make_lisp_s_us (proc.p_ustart_sec, + proc.p_ustart_usec); + Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); len = sizeof (fscale); mib[0] = CTL_KERN; @@ -4054,7 +4020,6 @@ system_process_attributes (Lisp_Object pid) struct group *gr; char *ttyname; struct timeval starttime; - struct timespec t, now; dev_t tdev; uid_t uid; gid_t gid; @@ -4165,11 +4130,12 @@ system_process_attributes (Lisp_Object pid) starttime = proc.kp_proc.p_starttime; attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs); - attrs = Fcons (Fcons (Qstart, make_lisp_timeval (starttime)), attrs); + Lisp_Object start = make_lisp_timeval (starttime); + attrs = Fcons (Fcons (Qstart, start), attrs); - now = current_timespec (); - t = timespec_sub (now, timeval_to_timespec (starttime)); - attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); + Lisp_Object now = Ftime_convert (Qnil, make_fixnum (1000000)); + Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil); + attrs = Fcons (Fcons (Qetime, etime), attrs); struct proc_taskinfo taskinfo; if (proc_pidinfo (proc_id, PROC_PIDTASKINFO, 0, &taskinfo, sizeof (taskinfo)) > 0) diff --git a/src/syssignal.h b/src/syssignal.h index 07055c04be6..02fe44a3820 100644 --- a/src/syssignal.h +++ b/src/syssignal.h @@ -22,6 +22,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <signal.h> +#include <attribute.h> + extern void init_signals (void); extern void block_child_signal (sigset_t *); extern void unblock_child_signal (sigset_t const *); diff --git a/src/sysstdio.h b/src/sysstdio.h index 5bcfe7d8a58..727a466be52 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -24,7 +24,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <fcntl.h> #include <limits.h> #include <stdio.h> -#include "unlocked-io.h" + +#include <attribute.h> +#include <unlocked-io.h> extern FILE *emacs_fopen (char const *, char const *) ATTRIBUTE_MALLOC; extern void errputc (int); diff --git a/src/systhread.h b/src/systhread.h index fb1a0a72d64..bf4e0306cdc 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -21,6 +21,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdbool.h> +#include <attribute.h> + #ifdef THREADS_ENABLED #ifdef HAVE_PTHREAD diff --git a/src/systime.h b/src/systime.h index f3b1b2394da..41d728f1c29 100644 --- a/src/systime.h +++ b/src/systime.h @@ -92,6 +92,7 @@ extern bool list4_to_timespec (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, struct timespec *); extern struct timespec lisp_time_argument (Lisp_Object); extern AVOID time_overflow (void); +extern double float_time (Lisp_Object); extern void init_timefns (void); extern void syms_of_timefns (void); diff --git a/src/termhooks.h b/src/termhooks.h index b7696fed4f8..93ac9ba0d2e 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -831,6 +831,13 @@ struct terminal frames on the terminal when it calls this hook, so infinite recursion is prevented. */ void (*delete_terminal_hook) (struct terminal *); + + /* Called to determine whether a position is on the toolkit tool bar + or menu bar. May be NULL. It should accept five arguments + FRAME, X, Y, MENU_BAR_P, TOOL_BAR_P, and store true into + MENU_BAR_P if X and Y are in FRAME's toolkit menu bar, and true + into TOOL_BAR_P if X and Y are in FRAME's toolkit tool bar. */ + void (*toolkit_position_hook) (struct frame *, int, int, bool *, bool *); } GCALIGNED_STRUCT; INLINE bool diff --git a/src/thread.c b/src/thread.c index 4c98d590b7a..c6742341fb8 100644 --- a/src/thread.c +++ b/src/thread.c @@ -671,6 +671,8 @@ mark_one_thread (struct thread_state *thread) mark_object (tem); } + mark_bytecode (&thread->bc); + /* No need to mark Lisp_Object members like m_last_thing_searched, as mark_threads_callback does that by calling mark_object. */ } @@ -790,7 +792,7 @@ run_thread (void *state) xfree (self->m_specpdl - 1); self->m_specpdl = NULL; self->m_specpdl_ptr = NULL; - self->m_specpdl_size = 0; + self->m_specpdl_end = NULL; { struct handler *c, *c_next; @@ -839,6 +841,7 @@ finalize_one_thread (struct thread_state *state) free_search_regs (&state->m_search_regs); free_search_regs (&state->m_saved_search_regs); sys_cond_destroy (&state->thread_condvar); + free_bc_thread (&state->bc); } DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0, @@ -862,13 +865,14 @@ If NAME is given, it must be a string; it names the new thread. */) /* Perhaps copy m_last_thing_searched from parent? */ new_thread->m_current_buffer = current_thread->m_current_buffer; - new_thread->m_specpdl_size = 50; - new_thread->m_specpdl = xmalloc ((1 + new_thread->m_specpdl_size) - * sizeof (union specbinding)); - /* Skip the dummy entry. */ - ++new_thread->m_specpdl; + ptrdiff_t size = 50; + union specbinding *pdlvec = xmalloc ((1 + size) * sizeof (union specbinding)); + new_thread->m_specpdl = pdlvec + 1; /* Skip the dummy entry. */ + new_thread->m_specpdl_end = new_thread->m_specpdl + size; new_thread->m_specpdl_ptr = new_thread->m_specpdl; + init_bc_thread (&new_thread->bc); + sys_cond_init (&new_thread->thread_condvar); /* We'll need locking here eventually. */ @@ -1128,6 +1132,7 @@ init_threads (void) sys_mutex_lock (&global_lock); current_thread = &main_thread.s; main_thread.s.thread_id = sys_thread_self (); + init_bc_thread (&main_thread.s.bc); } void diff --git a/src/thread.h b/src/thread.h index 1e7eb86f6ee..ddba1a2d994 100644 --- a/src/thread.h +++ b/src/thread.h @@ -33,6 +33,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "sysselect.h" /* FIXME */ #include "systhread.h" +/* Byte-code interpreter thread state. */ +struct bc_thread_state { + struct bc_frame *fp; /* current frame pointer */ + + /* start and end of allocated bytecode stack */ + char *stack; + char *stack_end; +}; + struct thread_state { union vectorlike_header header; @@ -92,14 +101,14 @@ struct thread_state struct handler *m_handlerlist_sentinel; #define handlerlist_sentinel (current_thread->m_handlerlist_sentinel) - /* Current number of specbindings allocated in specpdl. */ - ptrdiff_t m_specpdl_size; -#define specpdl_size (current_thread->m_specpdl_size) - /* Pointer to beginning of specpdl. */ union specbinding *m_specpdl; #define specpdl (current_thread->m_specpdl) + /* End of specpld (just beyond the last element). */ + union specbinding *m_specpdl_end; +#define specpdl_end (current_thread->m_specpdl_end) + /* Pointer to first unused element in specpdl. */ union specbinding *m_specpdl_ptr; #define specpdl_ptr (current_thread->m_specpdl_ptr) @@ -181,6 +190,8 @@ struct thread_state /* Threads are kept on a linked list. */ struct thread_state *next_thread; + + struct bc_thread_state bc; } GCALIGNED_STRUCT; INLINE bool diff --git a/src/timefns.c b/src/timefns.c index f73c69149f7..9b5b090ba71 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -879,6 +879,16 @@ decode_lisp_time (Lisp_Object specified_time, bool decode_secs_only, return form; } +/* Convert a Lisp timestamp SPECIFIED_TIME to double. + Signal an error if unsuccessful. */ +double +float_time (Lisp_Object specified_time) +{ + double t; + decode_lisp_time (specified_time, false, 0, &t); + return t; +} + /* Convert Z to time_t, returning true if it fits. */ static bool mpz_time (mpz_t const z, time_t *t) @@ -1068,7 +1078,7 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) if (FLOATP (a) && !isfinite (XFLOAT_DATA (a))) { double da = XFLOAT_DATA (a); - double db = XFLOAT_DATA (Ffloat_time (b)); + double db = float_time (b); return make_float (subtract ? da - db : da + db); } enum timeform aform, bform; @@ -1264,9 +1274,7 @@ If precise time stamps are required, use either `encode-time', or (if you need time as a string) `format-time-string'. */) (Lisp_Object specified_time) { - double t; - decode_lisp_time (specified_time, false, 0, &t); - return make_float (t); + return make_float (float_time (specified_time)); } /* Write information into buffer S of size MAXSIZE, according to the diff --git a/src/tparam.h b/src/tparam.h index 6361f138eaa..653f01bdde0 100644 --- a/src/tparam.h +++ b/src/tparam.h @@ -20,6 +20,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef EMACS_TPARAM_H #define EMACS_TPARAM_H +#include <attribute.h> + /* Don't try to include termcap.h. On some systems, configure finds a non-standard termcap.h that the main build won't find. */ diff --git a/src/w32term.c b/src/w32term.c index 78777f153c0..9094843f60f 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -794,12 +794,25 @@ w32_draw_fringe_bitmap (struct window *w, struct glyph_row *row, w32_fill_area (f, hdc, face->background, p->bx, p->by, p->nx, p->ny); - if (p->which && p->which < max_fringe_bmp) + if (p->which + && p->which < max_fringe_bmp + && p->which < max_used_fringe_bitmap) { HBITMAP pixmap = fringe_bmp[p->which]; HDC compat_hdc; HANDLE horig_obj; + if (!fringe_bmp[p->which]) + { + /* This fringe bitmap is known to fringe.c, but lacks the + HBITMAP data which shadows that bitmap. This is typical + to define-fringe-bitmap being called when the selected + frame was not a GUI frame, for example, when packages + that define fringe bitmaps are loaded by a daemon Emacs. + Create the missing HBITMAP now. */ + gui_define_fringe_bitmap (f, p->which); + } + compat_hdc = CreateCompatibleDC (hdc); SaveDC (hdc); diff --git a/src/xdisp.c b/src/xdisp.c index b00343daa7e..5cb58391dde 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16037,11 +16037,9 @@ redisplay_internal (void) if (!fr->glyphs_initialized_p) return; -#if defined (USE_X_TOOLKIT) || (defined (USE_GTK) && !defined (HAVE_PGTK)) || defined (HAVE_NS) +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) || defined (HAVE_NS) if (popup_activated ()) - { - return; - } + return; #endif #if defined (HAVE_HAIKU) @@ -29037,6 +29035,7 @@ normal_char_ascent_descent (struct font *font, int c, int *ascent, int *descent) if (get_char_glyph_code (c >= 0 ? c : '{', font, &char2b)) { struct font_metrics *pcm = get_per_char_metric (font, &char2b); + eassume (pcm); if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) { diff --git a/src/xfaces.c b/src/xfaces.c index 55a9bed8f22..d7f1f4d96e5 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -475,7 +475,7 @@ x_free_colors (struct frame *f, unsigned long *pixels, int npixels) { /* If display has an immutable color map, freeing colors is not necessary and some servers don't allow it. So don't do it. */ - if (x_mutable_colormap (FRAME_X_VISUAL (f))) + if (x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) { #ifdef DEBUG_X_COLORS unregister_colors (pixels, npixels); @@ -500,7 +500,7 @@ x_free_dpy_colors (Display *dpy, Screen *screen, Colormap cmap, /* If display has an immutable color map, freeing colors is not necessary and some servers don't allow it. So don't do it. */ - if (x_mutable_colormap (dpyinfo->visual)) + if (x_mutable_colormap (&dpyinfo->visual_info)) { #ifdef DEBUG_X_COLORS unregister_colors (pixels, npixels); @@ -888,6 +888,11 @@ parse_hex_color_comp (const char *s, const char *e, unsigned short *dst) static double parse_float_color_comp (const char *s, const char *e) { + /* Only allow decimal float literals without whitespace. */ + for (const char *p = s; p < e; p++) + if (!((*p >= '0' && *p <= '9') + || *p == '.' || *p == '+' || *p == '-' || *p == 'e' || *p == 'E')) + return -1; char *end; double x = strtod (s, &end); return (end == e && x >= 0 && x <= 1) ? x : -1; @@ -5978,6 +5983,8 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] } else if (CONSP (box)) { + bool set_color = false; + /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW being one of `raised' or `sunken'. */ face->box = FACE_SIMPLE_BOX; @@ -6015,6 +6022,7 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] face->box_color = load_color (f, face, value, LFACE_BOX_INDEX); face->use_box_color_for_shadows_p = true; + set_color = true; } } else if (EQ (keyword, QCstyle)) @@ -6026,7 +6034,9 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE] else if (EQ (value, Qflat_button)) { face->box = FACE_SIMPLE_BOX; - face->box_color = face->background; + /* Don't override colors set in this box. */ + if (!set_color) + face->box_color = face->background; } } } diff --git a/src/xfns.c b/src/xfns.c index 9afadd16e98..b5d0b2c54e8 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -737,6 +737,18 @@ x_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) gui_set_alpha_background (f, arg, oldval); +#ifdef HAVE_XRENDER + /* Setting `alpha_background' to something other than opaque on a + display that doesn't support the required features leads to + confusing results. */ + if (f->alpha_background < 1.0 + && !FRAME_DISPLAY_INFO (f)->alpha_bits + && !FRAME_CHECK_XR_VERSION (f, 0, 2)) + f->alpha_background = 1.0; +#else + f->alpha_background = 1.0; +#endif + #ifdef USE_GTK /* This prevents GTK from painting the window's background, which interferes with transparent background in some environments */ @@ -806,7 +818,19 @@ x_set_inhibit_double_buffering (struct frame *f, and after any potential change. One of the calls will end up being a no-op. */ if (want_double_buffering != was_double_buffered) - font_drop_xrender_surfaces (f); + { + font_drop_xrender_surfaces (f); + + /* Scroll bars decide whether or not to use a back buffer + based on the value of this frame parameter, so destroy + all scroll bars. */ +#ifndef USE_TOOLKIT_SCROLL_BARS + if (FRAME_TERMINAL (f)->condemn_scroll_bars_hook) + FRAME_TERMINAL (f)->condemn_scroll_bars_hook (f); + if (FRAME_TERMINAL (f)->judge_scroll_bars_hook) + FRAME_TERMINAL (f)->judge_scroll_bars_hook (f); +#endif + } if (FRAME_X_DOUBLE_BUFFERED_P (f) && !want_double_buffering) tear_down_x_back_buffer (f); else if (!FRAME_X_DOUBLE_BUFFERED_P (f) && want_double_buffering) @@ -895,6 +919,9 @@ static void x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { struct frame *p = NULL; +#ifdef HAVE_GTK3 + GdkWindow *window; +#endif if (!NILP (new_value) && (!FRAMEP (new_value) @@ -918,6 +945,14 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)), p ? GTK_RESIZE_IMMEDIATE : GTK_RESIZE_QUEUE); #endif + +#ifdef HAVE_GTK3 + if (p) + { + window = gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)); + gdk_x11_window_set_frame_sync_enabled (window, false); + } +#endif unblock_input (); fset_parent_frame (f, new_value); @@ -1460,6 +1495,21 @@ x_set_border_pixel (struct frame *f, unsigned long pix) unload_color (f, f->output_data.x->border_pixel); f->output_data.x->border_pixel = pix; +#ifdef USE_X_TOOLKIT + if (f->output_data.x->widget && f->border_width > 0) + { + block_input (); + XtVaSetValues (f->output_data.x->widget, XtNborderColor, + (Pixel) pix, NULL); + unblock_input (); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + + return; + } +#endif + if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0) { block_input (); @@ -1893,6 +1943,10 @@ static void x_set_scroll_bar_foreground (struct frame *f, Lisp_Object value, Lisp_Object oldval) { unsigned long pixel; +#ifdef HAVE_GTK3 + XColor color; + char css[64]; +#endif if (STRINGP (value)) pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f)); @@ -1914,6 +1968,28 @@ x_set_scroll_bar_foreground (struct frame *f, Lisp_Object value, Lisp_Object old update_face_from_frame_parameter (f, Qscroll_bar_foreground, value); redraw_frame (f); } + +#ifdef HAVE_GTK3 + if (!FRAME_TOOLTIP_P (f)) + { + if (pixel != -1) + { + color.pixel = pixel; + + XQueryColor (FRAME_X_DISPLAY (f), + FRAME_X_COLORMAP (f), + &color); + + sprintf (css, "scrollbar slider { background-color: #%02x%02x%02x; }", + color.red >> 8, color.green >> 8, color.blue >> 8); + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider, + css, -1, NULL); + } + else + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider, + "", -1, NULL); + } +#endif } @@ -1926,6 +2002,10 @@ static void x_set_scroll_bar_background (struct frame *f, Lisp_Object value, Lisp_Object oldval) { unsigned long pixel; +#ifdef HAVE_GTK3 + XColor color; + char css[64]; +#endif if (STRINGP (value)) pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f)); @@ -1961,6 +2041,28 @@ x_set_scroll_bar_background (struct frame *f, Lisp_Object value, Lisp_Object old update_face_from_frame_parameter (f, Qscroll_bar_background, value); redraw_frame (f); } + +#ifdef HAVE_GTK3 + if (!FRAME_TOOLTIP_P (f)) + { + if (pixel != -1) + { + color.pixel = pixel; + + XQueryColor (FRAME_X_DISPLAY (f), + FRAME_X_COLORMAP (f), + &color); + + sprintf (css, "scrollbar trough { background-color: #%02x%02x%02x; }", + color.red >> 8, color.green >> 8, color.blue >> 8); + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider, + css, -1, NULL); + } + else + gtk_css_provider_load_from_data (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider, + "", -1, NULL); + } +#endif } @@ -3529,7 +3631,7 @@ setup_xi_event_mask (struct frame *f) mask.mask_len = l; block_input (); -#ifndef USE_GTK +#ifndef HAVE_GTK3 mask.deviceid = XIAllMasterDevices; XISetMask (m, XI_ButtonPress); @@ -3537,16 +3639,18 @@ setup_xi_event_mask (struct frame *f) XISetMask (m, XI_Motion); XISetMask (m, XI_Enter); XISetMask (m, XI_Leave); +#ifndef USE_GTK XISetMask (m, XI_FocusIn); XISetMask (m, XI_FocusOut); XISetMask (m, XI_KeyPress); XISetMask (m, XI_KeyRelease); +#endif XISelectEvents (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &mask, 1); memset (m, 0, l); -#endif /* !USE_GTK */ +#endif /* !HAVE_GTK3 */ #ifdef USE_X_TOOLKIT XISetMask (m, XI_KeyPress); @@ -4661,6 +4765,13 @@ This function is an internal primitive--use `make-frame' instead. */) gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); +#ifdef HAVE_GTK3 + FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider + = gtk_css_provider_new (); + FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider + = gtk_css_provider_new (); +#endif + x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground, "scrollBarForeground", "ScrollBarForeground", true); @@ -4989,7 +5100,7 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, if (dpyinfo->n_planes <= 2) return Qnil; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticColor: case PseudoColor: @@ -5016,7 +5127,7 @@ If omitted or nil, that stands for the selected frame's display. */) if (dpyinfo->n_planes <= 1) return Qnil; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticColor: case PseudoColor: @@ -5092,14 +5203,17 @@ If omitted or nil, that stands for the selected frame's display. { struct x_display_info *dpyinfo = check_x_display_info (terminal); - int nr_planes = DisplayPlanes (dpyinfo->display, - XScreenNumberOfScreen (dpyinfo->screen)); + if (dpyinfo->visual_info.class != TrueColor + && dpyinfo->visual_info.class != DirectColor) + return make_fixnum (dpyinfo->visual_info.colormap_size); + + int nr_planes = dpyinfo->n_planes; - /* Truncate nr_planes to 24 to avoid integer overflow. - Some displays says 32, but only 24 bits are actually significant. + /* Truncate nr_planes to 24 to avoid integer overflow. Some + displays says 32, but only 24 bits are actually significant. There are only very few and rare video cards that have more than - 24 significant bits. Also 24 bits is more than 16 million colors, - it "should be enough for everyone". */ + 24 significant bits. Also 24 bits is more than 16 million + colors, it "should be enough for everyone". */ if (nr_planes > 24) nr_planes = 24; return make_fixnum (1 << nr_planes); @@ -5293,7 +5407,7 @@ If omitted or nil, that stands for the selected frame's display. struct x_display_info *dpyinfo = check_x_display_info (terminal); Lisp_Object result; - switch (dpyinfo->visual->class) + switch (dpyinfo->visual_info.class) { case StaticGray: result = intern ("static-gray"); @@ -6433,7 +6547,7 @@ DEFUN ("x-set-mouse-absolute-pixel-position", Fx_set_mouse_absolute_pixel_positi The coordinates X and Y are interpreted in pixels relative to a position \(0, 0) of the selected frame's display. */) (Lisp_Object x, Lisp_Object y) - { +{ struct frame *f = SELECTED_FRAME (); if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) @@ -6468,6 +6582,89 @@ The coordinates X and Y are interpreted in pixels relative to a position return Qnil; } +DEFUN ("x-begin-drag", Fx_begin_drag, Sx_begin_drag, 1, 4, 0, + doc: /* Begin dragging contents on FRAME, with targets TARGETS. +TARGETS is a list of strings, which defines the X selection targets +that will be available to the drop target. Block until the mouse +buttons are released, then return the action chosen by the target, or +`nil' if the drop was not accepted by the drop target. Dragging +starts when the mouse is pressed on FRAME, and the contents of the +selection `XdndSelection' will be sent to the X window underneath the +mouse pointer (the drop target) when the mouse button is released. +ACTION is a symbol which tells the target what the source will do, and +can be one of the following: + + - `XdndActionCopy', which means to copy the contents from the drag + source (FRAME) to the drop target. + + - `XdndActionMove', which means to first take the contents of + `XdndSelection', and to delete whatever was saved into that + selection afterwards. + +There are also some other valid values of ACTION that depend on +details of both the drop target's implementation details and that of +Emacs. For that reason, they are not mentioned here. Consult +"Drag-and-Drop Protocol for the X Window System" for more details: +https://freedesktop.org/wiki/Specifications/XDND/. + +If RETURN-FRAME is non-nil, this function will return the frame if the +mouse pointer moves onto an Emacs frame, after first moving out of +FRAME. + +If ACTION is not specified or nil, `XdndActionCopy' is used +instead. */) + (Lisp_Object targets, Lisp_Object action, Lisp_Object frame, + Lisp_Object return_frame) +{ + struct frame *f = decode_window_system_frame (frame); + int ntargets = 0; + char *target_names[2048]; + Atom *target_atoms; + Lisp_Object lval; + Atom xaction; + + CHECK_LIST (targets); + + for (; CONSP (targets); targets = XCDR (targets)) + { + CHECK_STRING (XCAR (targets)); + + if (ntargets < 2048) + { + target_names[ntargets] = SSDATA (XCAR (targets)); + ntargets++; + } + else + error ("Too many targets"); + } + + if (NILP (action) || EQ (action, QXdndActionCopy)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionCopy; + else if (EQ (action, QXdndActionMove)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionMove; + else if (EQ (action, QXdndActionLink)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionLink; + else if (EQ (action, QXdndActionAsk)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionAsk; + else if (EQ (action, QXdndActionPrivate)) + xaction = FRAME_DISPLAY_INFO (f)->Xatom_XdndActionPrivate; + else + signal_error ("Invalid drag-and-drop action", action); + + target_atoms = xmalloc (ntargets * sizeof *target_atoms); + + block_input (); + XInternAtoms (FRAME_X_DISPLAY (f), target_names, + ntargets, False, target_atoms); + unblock_input (); + + x_set_dnd_targets (target_atoms, ntargets); + lval = x_dnd_begin_drag_and_drop (f, FRAME_DISPLAY_INFO (f)->last_user_time, + xaction, !NILP (return_frame)); + + return lval; +} + /************************************************************************ X Displays ************************************************************************/ @@ -6566,6 +6763,7 @@ select_visual (struct x_display_info *dpyinfo) SSDATA (ENCODE_SYSTEM (value))); dpyinfo->visual = vinfo.visual; + dpyinfo->visual_info = vinfo; } else { @@ -6599,6 +6797,7 @@ select_visual (struct x_display_info *dpyinfo) { dpyinfo->n_planes = vinfo[i].depth; dpyinfo->visual = vinfo[i].visual; + dpyinfo->visual_info = vinfo[i]; dpyinfo->pict_format = format; XFree (vinfo); @@ -6619,7 +6818,7 @@ select_visual (struct x_display_info *dpyinfo) &vinfo_template, &n_visuals); if (n_visuals <= 0) fatal ("Can't get proper X visual info"); - + dpyinfo->visual_info = *vinfo; dpyinfo->n_planes = vinfo->depth; XFree (vinfo); } @@ -7501,8 +7700,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) if (FRAME_DISPLAY_INFO (f)->n_planes == 1) disptype = Qmono; - else if (FRAME_DISPLAY_INFO (f)->visual->class == GrayScale - || FRAME_DISPLAY_INFO (f)->visual->class == StaticGray) + else if (FRAME_X_VISUAL_INFO (f)->class == GrayScale + || FRAME_X_VISUAL_INFO (f)->class == StaticGray) disptype = intern ("grayscale"); else disptype = intern ("color"); @@ -8354,20 +8553,84 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, result = 0; while (result == 0) { - XEvent event; + XEvent event, copy; +#ifdef HAVE_XINPUT2 + x_menu_wait_for_event (FRAME_X_DISPLAY (f)); +#else x_menu_wait_for_event (0); - XtAppNextEvent (Xt_app_con, &event); - if (event.type == KeyPress - && FRAME_X_DISPLAY (f) == event.xkey.display) - { - KeySym keysym = XLookupKeysym (&event.xkey, 0); +#endif - /* Pop down on C-g. */ - if (keysym == XK_g && (event.xkey.state & ControlMask) != 0) - XtUnmanageChild (dialog); - } + if ( +#ifndef HAVE_XINPUT2 + XtAppPending (Xt_app_con) +#else + XPending (FRAME_X_DISPLAY (f)) +#endif + ) + { +#ifndef HAVE_XINPUT2 + XtAppNextEvent (Xt_app_con, &event); +#else + XNextEvent (FRAME_X_DISPLAY (f), &event); +#endif + + copy = event; + if (event.type == KeyPress + && FRAME_X_DISPLAY (f) == event.xkey.display) + { + KeySym keysym = XLookupKeysym (&event.xkey, 0); + + /* Pop down on C-g. */ + if (keysym == XK_g && (event.xkey.state & ControlMask) != 0) + XtUnmanageChild (dialog); + } +#ifdef HAVE_XINPUT2 + else if (event.type == GenericEvent + && FRAME_X_DISPLAY (f) == event.xgeneric.display + && FRAME_DISPLAY_INFO (f)->supports_xi2 + && (event.xgeneric.extension + == FRAME_DISPLAY_INFO (f)->xi2_opcode) + && event.xgeneric.evtype == XI_KeyPress) + { + KeySym keysym; + XIDeviceEvent *xev; - (void) x_dispatch_event (&event, FRAME_X_DISPLAY (f)); + if (event.xcookie.data) + emacs_abort (); + + if (XGetEventData (FRAME_X_DISPLAY (f), &event.xcookie)) + { + xev = (XIDeviceEvent *) event.xcookie.data; + + copy.xkey.type = KeyPress; + copy.xkey.serial = xev->serial; + copy.xkey.send_event = xev->send_event; + copy.xkey.display = FRAME_X_DISPLAY (f); + copy.xkey.window = xev->event; + copy.xkey.root = xev->root; + copy.xkey.subwindow = xev->child; + copy.xkey.time = xev->time; + copy.xkey.x = lrint (xev->event_x); + copy.xkey.y = lrint (xev->event_y); + copy.xkey.x_root = lrint (xev->root_x); + copy.xkey.y_root = lrint (xev->root_y); + copy.xkey.state = xev->mods.effective; + copy.xkey.keycode = xev->detail; + copy.xkey.same_screen = True; + + keysym = XLookupKeysym (©.xkey, 0); + + if (keysym == XK_g + && (copy.xkey.state & ControlMask) != 0) /* Any escape, ignore modifiers. */ + XtUnmanageChild (dialog); + + XFreeEventData (FRAME_X_DISPLAY (f), &event.xcookie); + } + } +#endif + + (void) x_dispatch_event (©, FRAME_X_DISPLAY (f)); + } } /* Get the result. */ @@ -8888,6 +9151,7 @@ frame_parm_handler x_frame_parm_handlers[] = x_set_override_redirect, gui_set_no_special_glyphs, x_set_alpha_background, + x_set_shaded, }; /* Some versions of libX11 don't have symbols for a few functions we @@ -8915,7 +9179,15 @@ XkbFreeNames (XkbDescPtr xkb, unsigned int which, Bool free_map) int XDisplayCells (Display *dpy, int screen_number) { - return 1677216; + struct x_display_info *dpyinfo = x_display_info_for_display (dpy); + + if (!dpyinfo) + emacs_abort (); + + /* Not strictly correct, since the display could be using a + non-default visual, but it satisfies the callers we need to care + about. */ + return dpyinfo->visual_info.colormap_size; } #endif @@ -8961,6 +9233,12 @@ syms_of_xfns (void) DEFSYM (Qreverse_landscape, "reverse-landscape"); #endif + DEFSYM (QXdndActionCopy, "XdndActionCopy"); + DEFSYM (QXdndActionMove, "XdndActionMove"); + DEFSYM (QXdndActionLink, "XdndActionLink"); + DEFSYM (QXdndActionAsk, "XdndActionAsk"); + DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); + Fput (Qundefined_color, Qerror_conditions, pure_list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, @@ -9234,6 +9512,7 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); defsubr (&Sx_double_buffered_p); + defsubr (&Sx_begin_drag); tip_timer = Qnil; staticpro (&tip_timer); tip_frame = Qnil; diff --git a/src/xmenu.c b/src/xmenu.c index 21e8f0f9ec7..d19fe13c295 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -184,8 +184,8 @@ x_menu_wait_for_event (void *data) instead of the small ifdefs below. */ while ( -#ifdef USE_X_TOOLKIT - ! XtAppPending (Xt_app_con) +#if defined USE_X_TOOLKIT + ! (data ? XPending (data) : XtAppPending (Xt_app_con)) #elif defined USE_GTK ! gtk_events_pending () #else @@ -222,6 +222,72 @@ x_menu_wait_for_event (void *data) #endif } } + +#if !defined USE_GTK && !defined USE_X_TOOLKIT && defined HAVE_XINPUT2 +static void +x_menu_translate_generic_event (XEvent *event) +{ + struct x_display_info *dpyinfo; + XEvent copy; + XIDeviceEvent *xev; + + dpyinfo = x_display_info_for_display (event->xgeneric.display); + + if (event->xgeneric.extension == dpyinfo->xi2_opcode) + { + eassert (!event->xcookie.data); + + if (XGetEventData (dpyinfo->display, &event->xcookie)) + { + switch (event->xcookie.evtype) + { + case XI_ButtonPress: + case XI_ButtonRelease: + xev = (XIDeviceEvent *) event->xcookie.data; + copy.xbutton.type = (event->xcookie.evtype == XI_ButtonPress + ? ButtonPress : ButtonRelease); + copy.xbutton.serial = xev->serial; + copy.xbutton.send_event = xev->send_event; + copy.xbutton.display = dpyinfo->display; + copy.xbutton.window = xev->event; + copy.xbutton.root = xev->root; + copy.xbutton.subwindow = xev->child; + copy.xbutton.time = xev->time; + copy.xbutton.x = lrint (xev->event_x); + copy.xbutton.y = lrint (xev->event_y); + copy.xbutton.x_root = lrint (xev->root_x); + copy.xbutton.y_root = lrint (xev->root_y); + copy.xbutton.state = xev->mods.effective; + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xbutton.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xbutton.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xbutton.state |= Button3Mask; + } + + XPutBackEvent (dpyinfo->display, ©); + + break; + } + XFreeEventData (dpyinfo->display, &event->xcookie); + } + } +} +#endif + +#if !defined USE_X_TOOLKIT && !defined USE_GTK +static void +x_menu_expose_event (XEvent *event) +{ + x_dispatch_event (event, event->xexpose.display); +} +#endif #endif /* ! MSDOS */ @@ -572,11 +638,11 @@ x_activate_menubar (struct frame *f) { for (int i = 0; i < dpyinfo->num_devices; ++i) { -#ifndef USE_MOTIF if (dpyinfo->devices[i].grab) -#endif - XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, - CurrentTime); + { + XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, + CurrentTime); + } } } #endif @@ -1461,6 +1527,23 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, if (i == 5) i = 0; } +#if !defined HAVE_GTK3 && defined HAVE_XINPUT2 + if (FRAME_DISPLAY_INFO (f)->num_devices) + { + for (int i = 0; i < FRAME_DISPLAY_INFO (f)->num_devices; ++i) + { + if (FRAME_DISPLAY_INFO (f)->devices[i].grab) + { + FRAME_DISPLAY_INFO (f)->devices[i].grab = 0; + + XIUngrabDevice (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->devices[i].device_id, + CurrentTime); + } + } + } +#endif + /* Display the menu. */ gtk_widget_show_all (menu); @@ -1514,6 +1597,23 @@ pop_down_menu (int id) popup_activated_flag = 0; } +#if defined HAVE_XINPUT2 && defined USE_MOTIF +static Bool +server_timestamp_predicate (Display *display, + XEvent *xevent, + XPointer arg) +{ + XID *args = (XID *) arg; + + if (xevent->type == PropertyNotify + && xevent->xproperty.window == args[0] + && xevent->xproperty.atom == args[1]) + return True; + + return False; +} +#endif + /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the menu pops down. menu_item_selection will be set to the selection. */ @@ -1529,6 +1629,10 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, LWLIB_ID menu_id; Widget menu; Window dummy_window; +#if defined HAVE_XINPUT2 && defined USE_MOTIF + XEvent property_dummy; + Atom property_atom; +#endif eassert (FRAME_X_P (f)); @@ -1609,14 +1713,39 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, } if (any_xi_grab_p) - XGrabPointer (dpyinfo->display, - FRAME_X_WINDOW (f), - False, (PointerMotionMask - | PointerMotionHintMask - | ButtonReleaseMask - | ButtonPressMask), - GrabModeSync, GrabModeAsync, - None, None, CurrentTime); + { +#ifndef USE_MOTIF + XGrabPointer (dpyinfo->display, + FRAME_X_WINDOW (f), + False, (PointerMotionMask + | PointerMotionHintMask + | ButtonReleaseMask + | ButtonPressMask), + GrabModeSync, GrabModeAsync, + None, None, CurrentTime); +#endif + } + +#ifdef USE_MOTIF + if (dpyinfo->supports_xi2) + { + /* Dispatch a PropertyNotify to Xt with the current server time. + Motif tries to set a grab with the timestamp of the last event + processed by Xt, but Xt doesn't consider GenericEvents, so the + timestamp is always less than the last grab time. */ + + property_atom = dpyinfo->Xatom_EMACS_SERVER_TIME_PROP; + + XChangeProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + property_atom, XA_ATOM, 32, + PropModeReplace, (unsigned char *) &property_atom, 1); + + XIfEvent (dpyinfo->display, &property_dummy, server_timestamp_predicate, + (XPointer) &(XID[]) {FRAME_OUTER_WINDOW (f), property_atom}); + + XtDispatchEvent (&property_dummy); + } +#endif if (dpyinfo->supports_xi2) XUngrabServer (dpyinfo->display); @@ -1624,9 +1753,18 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, /* Display the menu. */ lw_popup_menu (menu, &dummy); + +#if defined HAVE_XINPUT2 && defined USE_MOTIF + /* This is needed to prevent XI_Enter events that set an implicit + focus from being sent. */ + if (dpyinfo->supports_xi2) + XSetInputFocus (XtDisplay (menu), XtWindow (menu), + RevertToParent, CurrentTime); +#endif + popup_activated_flag = 1; -#ifdef HAVE_XINPUT2 +#if defined HAVE_XINPUT2 && !defined USE_MOTIF if (any_xi_grab_p) XAllowEvents (dpyinfo->display, AsyncPointer, CurrentTime); #endif @@ -1643,6 +1781,14 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, unbind_to (specpdl_count, Qnil); } + +#if defined HAVE_XINPUT2 && defined USE_MOTIF + /* For some reason input focus isn't always restored to the outer + window after the menu pops down. */ + if (any_xi_grab_p) + XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + RevertToParent, CurrentTime); +#endif } #endif /* not USE_GTK */ @@ -2514,6 +2660,10 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, #ifndef MSDOS XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); +#ifdef HAVE_XINPUT2 + XMenuActivateSetTranslateFunction (x_menu_translate_generic_event); +#endif + XMenuActivateSetExposeFunction (x_menu_expose_event); #endif record_unwind_protect_ptr (pop_down_menu, diff --git a/src/xselect.c b/src/xselect.c index 979f4549488..cdc70d3e247 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -98,7 +98,11 @@ static void lisp_data_to_selection_data (struct x_display_info *, Lisp_Object, static int selection_quantum (Display *display) { - long mrs = XMaxRequestSize (display); + long mrs = XExtendedMaxRequestSize (display); + + if (!mrs) + mrs = XMaxRequestSize (display); + return (mrs < MAX_SELECTION_QUANTUM / X_LONG_SIZE + 25 ? (mrs - 25) * X_LONG_SIZE : MAX_SELECTION_QUANTUM); @@ -2643,6 +2647,25 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, +/* Return the timestamp where ownership of SELECTION was asserted, or + nil if no local selection is present. */ + +Lisp_Object +x_timestamp_for_selection (struct x_display_info *dpyinfo, + Lisp_Object selection) +{ + Lisp_Object value, local_value; + + local_value = LOCAL_SELECTION (selection, dpyinfo); + + if (NILP (local_value)) + return Qnil; + + value = XCAR (XCDR (XCDR (local_value))); + + return value; +} + static void syms_of_xselect_for_pdumper (void); void diff --git a/src/xterm.c b/src/xterm.c index caacf8336c4..6485374e2ae 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -117,9 +117,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ background pixel values. Usually, one graphics context is computed for each face when it is - first about to be displayed, and this graphics context is the one - which is used for future X drawing operations in a glyph string - with that face. (See `prepare_face_for_display' in xfaces.c). + about to be displayed for the first time, and this graphics context + is the one which is used for future X drawing operations in a glyph + string with that face. (See `prepare_face_for_display' in + xfaces.c). However, when drawing glyph strings for special display elements such as the cursor, or mouse sensitive text, different GCs may be @@ -155,11 +156,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ onto the physical display. When the visual class is TrueColor, the colormap will be indexed - based on the red, green, and blue components of the pixel values, - and the colormap will be statically allocated as to contain linear - ramps for each component. As such, most of the color allocation - described below is bypassed, and the pixel values are computed - directly from the color. + based on the red, green, and blue (RGB) components of the pixel + values, and the colormap will be statically allocated so as to + contain linear ramps for each component. As such, most of the + color allocation described below is bypassed, and the pixel values + are computed directly from the color. Otherwise, each time Emacs wants a pixel value that corresponds to a color, Emacs has to ask the X server to obtain the pixel value @@ -199,7 +200,303 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ `x_alloc_nearest_color_1', while the optimization for TrueColor visuals is in `x_make_truecolor_pixel'. Also see `x_query_colors`, which is used to determine the color values for given pixel - values. */ + values. + + OPTIONAL FEATURES + + While X servers and client libraries tend to come with many + extensions to the core X11R6 protocol, dependencies on anything + other than the core X11R6 protocol and Xlib should be optional at + both compile-time and runtime. Emacs should also not crash + regardless of what combination of X server and client-side features + are present. For example, if you are developing a feature that + will need Xfixes, then add a test in configure.ac for the library + at compile-time which defines `HAVE_XFIXES', like this: + + ### Use Xfixes (-lXfixes) if available + HAVE_XFIXES=no + if test "${HAVE_X11}" = "yes"; then + XFIXES_REQUIRED=4.0.0 + XFIXES_MODULES="xfixes >= $XFIXES_REQUIRED" + EMACS_CHECK_MODULES([XFIXES], [$XFIXES_MODULES]) + if test $HAVE_XFIXES = no; then + # Test old way in case pkg-config doesn't have it (older machines). + AC_CHECK_HEADER(X11/extensions/Xfixes.h, + [AC_CHECK_LIB(Xfixes, XFixesHideCursor, HAVE_XFIXES=yes)]) + if test $HAVE_XFIXES = yes; then + XFIXES_LIBS=-lXfixes + fi + fi + if test $HAVE_XFIXES = yes; then + AC_DEFINE(HAVE_XFIXES, 1, [Define to 1 if you have the Xfixes extension.]) + fi + fi + AC_SUBST(XFIXES_CFLAGS) + AC_SUBST(XFIXES_LIBS) + + Then, make sure to adjust CFLAGS and LIBES in src/Makefile.in and + add the new XFIXES_CFLAGS and XFIXES_LIBS variables to + msdos/sed1v2.inp. (The latter has to be adjusted for any new + variables that are included in CFLAGS and LIBES even if the + libraries are not used by the MS-DOS port.) + + Finally, add some fields in `struct x_display_info' which specify + the major and minor versions of the extension, and whether or not to + support them. They (and their accessors) should be protected by the + `HAVE_XFIXES' preprocessor conditional. Then, these fields should + be set in `x_term_init', and all Xfixes calls must be protected by + not only the preprocessor conditional, but also by checks against + those variables. + + X TOOLKIT SUPPORT + + Emacs supports being built with many different toolkits (and also no + toolkit at all), which provide decorations such as menu bars and + scroll bars, along with handy features like file panels, dialog + boxes, font panels, and popup menus. Those configurations can + roughly be classified as belonging to one of three categories: + + - Using no toolkit at all. + - Using the X Toolkit Intrinsics (Xt). + - Using GTK. + + The no toolkit configuration is the simplest: no toolkit widgets are + used, Emacs uses its own implementation of scroll bars, and the + XMenu library that came with X11R2 and earlier versions of X is used + for popup menus. There is also no complicated window structure to + speak of. + + The Xt configurations come in either the Lucid or Motif flavors. + The former utilizes Emacs's own Xt-based Lucid widget library for + menus, and Xaw (or derivatives such as neXTaw and Xaw3d) for dialog + boxes and, optionally, scroll bars. It does not support file + panels. The latter uses either Motif or LessTif for menu bars, + popup menus, dialogs and file panels. + + The GTK configurations come in the GTK+ 2 or GTK 3 configurations, + where the toolkit provides all the aforementioned decorations and + features. They work mostly the same, though GTK 3 has various small + annoyances that complicate maintenance. + + All of those configurations have various special technicalities + about event handling and the layout of windows inside a frame that + must be kept in mind when writing X code which is run on all of + them. + + The no toolkit configuration has no noteworthy aspects about the + layout of windows inside a frame, since each frame has only one + associated window aside from scroll bars. However, in the Xt + configurations, every widget is a separate window, and there are + quite a few widgets. The "outer widget", a widget of class + ApplicationShell, is the top-level window of a frame. Its window is + accessed via the macro `FRAME_OUTER_WINDOW'. The "edit widget", a + widget class of EmacsFrame, is a child of the outer widget that + controls the size of a frame as known to Emacs, and is the widget + that Emacs draws to during display operations. The "menu bar + widget" is the widget holding the menu bar. + + Special care must be taken when performing operations on a frame. + Properties that are used by the window manager, for example, must be + set on the outer widget. Drawing, on the other hand, must be done + to the edit widget, and button press events on the menu bar widget + must be redirected and not sent to Xt until the Lisp code is run to + update the menu bar. + + The EmacsFrame widget is specific to Emacs and is implemented in + widget.c. See that file for more details. + + In the GTK configurations, GTK widgets do not necessarily correspond + to X windows, since the toolkit might decide to keep only a + client-side record of the widgets for performance reasons. + + Because the GtkFixed widget that holds the "edit area" might not + correspond to an X window, drawing operations may be directly + performed on the outer window, with special care taken to not + overwrite the surrounding GTK widgets. This also means that the + only important window for most purposes is the outer window, which + on GTK builds can usually be accessed using the macro + `FRAME_X_WINDOW'. + + How `handle_one_xevent' is called also depends on the configuration. + Without a toolkit, Emacs performs all event processing by itself, + running XPending and XNextEvent in a loop whenever there is input, + passing the event to `handle_one_xevent'. + + When using Xt, the same is performed, but `handle_one_xevent' may + also decide to call XtDispatchEvent on an event after Emacs finishes + processing it. + + When using GTK, however, `handle_one_xevent' is called from an event + filter installed on the GTK event loop. Unless the event filter + elects to drop the event, it will be passed to GTK right after + leaving the event filter. + + Fortunately, `handle_one_xevent' is provided a `*finish' parameter + that abstracts away all these details. If it is `X_EVENT_DROP', + then the event will not be dispatched to Xt or utilized by GTK. + Code inside `handle_one_xevent' should thus avoid making assumptions + about the event dispatch mechanism and use that parameter + instead. + + FRAME RESIZING + + In the following explanations "frame size" refers to the "native + size" of a frame as reported by the (frame.h) macros + FRAME_PIXEL_WIDTH and FRAME_PIXEL_HEIGHT. These specify the size of + a frame as the values passed to/received from a toolkit and the + window manager. The "text size" Emacs Lisp code uses in functions + like 'set-frame-size' or sees in the ‘width’ and 'height' frame + parameters is only loosely related to the native size. The + necessary translations are provided by the macros + FRAME_TEXT_TO_PIXEL_WIDTH and FRAME_TEXT_TO_PIXEL_HEIGHT as well as + FRAME_PIXEL_TO_TEXT_WIDTH and FRAME_PIXEL_TO_TEXT_HEIGHT (in + frame.h). + + Lisp functions may ask for resizing a frame either explicitly, using + one of the interfaces provided for that purpose like, for example, + 'set-frame-size' or changing the 'height' or 'width' parameter of + that frame, or implicitly, for example, by turning off/on or + changing the width of fringes or scroll bars for that frame. Any + such request passes through the routine 'adjust_frame_size' (in + frame.c) which decides, among others, whether the native frame size + would really change and whether it is allowed to change it at that + moment. Only if 'adjust_frame_size' decides that the corresponding + terminal's 'set_window_size_hook' may be run, it will dispatch + execution to the appropriate function which, for X builds, is + 'x_set_window_size' in this file. + + For GTK builds, 'x_set_window_size' calls 'xg_frame_set_char_size' + in gtkutil.c if the frame has an edit widget and + 'x_set_window_size_1' in this file otherwise. For non-GTK builds, + 'x_set_window_size' always calls 'x_set_window_size_1' directly. + + 'xg_frame_set_char_size' calls the GTK function 'gtk_window_resize' + for the frame's outer widget; x_set_window_size_1 calls the Xlib + function 'XResizeWindow' instead. In either case, if Emacs thinks + that the frame is visible, it will wait for a ConfigureNotify event + (see below) to occur within a timeout of 'x-wait-for-event-timeout' + (the default is 0.1 seconds). If Emacs thinks that the frame is not + visible, it calls 'adjust_frame_size' to run 'resize_frame_windows' + (see below) and hopes for the best. + + Note that if Emacs receives a ConfigureEvent in response to an + earlier resize request, the sizes specified by that event are not + necessarily the sizes Emacs requested. Window manager and toolkit + may override any of the requested sizes for their own reasons. + + On X, size notifications are received as ConfigureNotify events. + The expected reaction to such an event on the Emacs side is to + resize all Emacs windows that are on the frame referred to by the + event. Since resizing Emacs windows and redisplaying their buffers + is a costly operation, Emacs may collapse several subsequent + ConfigureNotify events into one to avoid that Emacs falls behind in + user interactions like resizing a frame by dragging one of its + borders with the mouse. + + Each ConfigureEvent event specifies a window, a width and a height. + The event loop uses 'x_top_window_to_frame' to associate the window + with its frame. Once the frame has been identified, on GTK the + event is dispatched to 'xg_frame_resized'. On Motif/Lucid + 'x_window' has installed 'EmacsFrameResize' as the routine that + handles resize events. In either case, these routines end up + calling the function 'change_frame_size' in dispnew.c. On + non-toolkit builds the effect is to call 'change_frame_size' + directly from the event loop. In either case, the value true is + passed as the DELAY argument. + + 'change_frame_size' is the central function to decide whether it is + safe to process a resize request immediately or it has to be delayed + (usually because its DELAY argument is true). Since resizing a + frame's windows may run arbitrary Lisp code, Emacs cannot generally + process resize requests during redisplay and therefore has to queue + them. If processing the event must be delayed, the new sizes (that + is, the ones requested by the ConfigureEvent) are stored in the + new_width and new_height slots of the respective frame structure, + possibly replacing ones that have been stored there upon the receipt + of a preceding ConfigureEvent. + + Delayed size changes are applied eventually upon calls of the + function 'do_pending_window_change' (in dispnew.c) which is called + by the redisplay code at suitable spots where it's safe to change + sizes. 'do_pending_window_change' calls 'change_frame_size' with + its DELAY argument false in the hope that it is now safe to call the + function 'resize_frame_windows' (in window.c) which is in charge of + adjusting the sizes of all Emacs windows on the frame accordingly. + Note that if 'resize_frame_windows' decides that the windows of a + frame do not fit into the constraints set up by the new frame sizes, + it will resize the windows to some minimum sizes with the effect + that parts of the frame at the right and bottom will appear clipped + off. + + In addition to explicitly passing width and height values in + functions like 'gtk_window_resize' or 'XResizeWindow', Emacs also + sets window manager size hints - a more implicit form of asking for + the size Emacs would like its frames to assume. Some of these hints + only restate the size and the position explicitly requested for a + frame. Another hint specifies the increments in which the window + manager should resize a frame to - either set to the default + character size of a frame or to one pixel for a non-nil value of + 'frame-resize-pixelwise'. See the function 'x_wm_set_size_hint' - + in gtkutil.c for GTK and in this file for other builds - for the + details. + + We have not discussed here a number of special issues like, for + example, how to handle size requests and notifications for maximized + and fullscreen frames or how to resize child frames. Some of these + require special treatment depending on the desktop or window manager + used. + + One thing that might come handy when investigating problems wrt + resizing frames is the variable 'frame-size-history'. Setting this + to a non-nil value, will cause Emacs to start recording frame size + adjustments, usually specified by the function that asked for an + adjustment, a sizes part that records the old and new values of the + frame's width and height and maybe some additional information. The + internal function `frame--size-history' can then be used to display + the value of this variable in a more readable form. + + FRAME RESIZE SYNCHRONIZATION + + The X window system operates asynchronously. That is to say, the + window manager and X server might think a window has been resized + before Emacs has a chance to process the ConfigureNotify event that + was sent. + + When a compositing manager is present, and the X server and Emacs + both support the X synchronization extension, the semi-standard + frame synchronization protocol can be used to notify the compositing + manager of when Emacs has actually finished redisplaying the + contents of a frame after a resize. The compositing manager will + customarily then postpone displaying the contents of the frame until + the redisplay is complete. + + Emacs announces support for this protocol by creating an X + server-side counter object, and setting it as the + `_NET_WM_SYNC_REQUEST_COUNTER' property of the frame's top-level + window. The window manager then initiates the synchronized resize + process by sending Emacs a ClientMessage event before the + ConfigureNotify event where: + + type = ClientMessage + window = the respective client window + message_type = WM_PROTOCOLS + format = 32 + data.l[0] = _NET_WM_SYNC_REQUEST + data.l[1] = timestamp + data.l[2] = low 32 bits of a provided frame counter value + data.l[3] = high 32 bits of a provided frame counter value + data.l[4] = 1 if the the extended frame counter should be updated, + otherwise 0 + + Upon receiving such an event, Emacs constructs and saves a counter + value from the provided low and high 32 bits. Then, when the + display engine tells us that a frame has been completely updated + (presumably because of a redisplay caused by a ConfigureNotify + event), we set the counter to the saved value, telling the + compositing manager that the contents of the window now accurately + reflect the new size. The compositing manager will then display the + contents of the window, and the window manager might also postpone + updating the window decorations until this moment. */ #include <config.h> #include <stdlib.h> @@ -281,6 +578,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef USE_X_TOOLKIT #include <X11/Shell.h> +#include <X11/ShellP.h> #endif #include <unistd.h> @@ -300,13 +598,15 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <cairo-xlib.h> #endif +#ifdef USE_MOTIF +#include <Xm/Xm.h> +#endif + #ifdef USE_X_TOOLKIT /* Include toolkit specific headers for the scroll bar widget. */ - #ifdef USE_TOOLKIT_SCROLL_BARS #if defined USE_MOTIF -#include <Xm/Xm.h> /* For LESSTIF_VERSION */ #include <Xm/ScrollBar.h> #else /* !USE_MOTIF i.e. use Xaw */ @@ -402,6 +702,19 @@ static Lisp_Object xg_default_icon_file; static char emacs_class[] = EMACS_CLASS; #endif +#ifdef USE_GTK +static int current_count; +static int current_finish; +static struct input_event *current_hold_quit; +#endif + +enum +{ + X_EVENT_NORMAL, + X_EVENT_GOTO_OUT, + X_EVENT_DROP +}; + enum xembed_info { XEMBED_MAPPED = 1 << 0 @@ -463,9 +776,426 @@ static void x_wm_set_window_state (struct frame *, int); static void x_wm_set_icon_pixmap (struct frame *, ptrdiff_t); static void x_initialize (void); -static bool x_get_current_wm_state (struct frame *, Window, int *, bool *); +static bool x_get_current_wm_state (struct frame *, Window, int *, bool *, bool *); static void x_update_opaque_region (struct frame *, XEvent *); +#if !defined USE_TOOLKIT_SCROLL_BARS && defined HAVE_XDBE +static void x_scroll_bar_end_update (struct x_display_info *, struct scroll_bar *); +#endif + +static bool x_dnd_in_progress; + +/* Whether or not to return a frame from `x_dnd_begin_drag_and_drop'. + + 0 means to do nothing. 1 means to wait for the mouse to first exit + `x_dnd_frame'. 2 means to wait for the mouse to move onto a frame, + and 3 means to `x_dnd_return_frame_object'. */ +static int x_dnd_return_frame; +static struct frame *x_dnd_return_frame_object; + +static Window x_dnd_last_seen_window; +static int x_dnd_last_protocol_version; +static Time x_dnd_selection_timestamp; + +static Window x_dnd_mouse_rect_target; +static XRectangle x_dnd_mouse_rect; +static Atom x_dnd_action; +static Atom x_dnd_wanted_action; + +static Atom *x_dnd_targets = NULL; +static int x_dnd_n_targets; +static struct frame *x_dnd_frame; + +#define X_DND_SUPPORTED_VERSION 5 + +static int x_dnd_get_window_proto (struct x_display_info *, Window); +static Window x_dnd_get_window_proxy (struct x_display_info *, Window); + +static Window +x_dnd_get_target_window (struct x_display_info *dpyinfo, + int root_x, int root_y, int *proto_out) +{ + Window child_return, child, dummy, proxy; + int dest_x_return, dest_y_return, rc, proto; + child_return = dpyinfo->root_window; + dest_x_return = root_x; + dest_y_return = root_y; + + proto = -1; + + /* Not strictly necessary, but satisfies GCC. */ + child = dpyinfo->root_window; + + while (child_return != None) + { + child = child_return; + + x_catch_errors (dpyinfo->display); + rc = XTranslateCoordinates (dpyinfo->display, + child_return, child_return, + dest_x_return, dest_y_return, + &dest_x_return, &dest_y_return, + &child_return); + + if (x_had_errors_p (dpyinfo->display) || !rc) + { + x_uncatch_errors_after_check (); + break; + } + + proxy = x_dnd_get_window_proxy (dpyinfo, child_return); + + if (proxy != None) + { + proto = x_dnd_get_window_proto (dpyinfo, proxy); + + if (proto != -1) + { + *proto_out = proto; + + x_uncatch_errors_after_check (); + return proxy; + } + } + + if (child_return) + { + proto = x_dnd_get_window_proto (dpyinfo, child_return); + + if (proto != -1) + { + *proto_out = proto; + x_uncatch_errors_after_check (); + + return child_return; + } + + rc = XTranslateCoordinates (dpyinfo->display, + child, child_return, + dest_x_return, dest_y_return, + &dest_x_return, &dest_y_return, + &dummy); + + if (x_had_errors_p (dpyinfo->display) || !rc) + { + x_uncatch_errors_after_check (); + *proto_out = -1; + return None; + } + } + + x_uncatch_errors_after_check (); + } + + *proto_out = x_dnd_get_window_proto (dpyinfo, child); + return child; +} + +static Window +x_dnd_get_window_proxy (struct x_display_info *dpyinfo, Window wdesc) +{ + int rc, actual_format; + unsigned long actual_size, bytes_remaining; + unsigned char *tmp_data; + XWindowAttributes attrs; + Atom actual_type; + Window proxy; + + proxy = None; + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, wdesc, + dpyinfo->Xatom_XdndProxy, + 0, 1, False, XA_WINDOW, + &actual_type, &actual_format, + &actual_size, &bytes_remaining, + &tmp_data); + + if (!x_had_errors_p (dpyinfo->display) + && rc == Success + && actual_type == XA_WINDOW + && actual_format == 32 + && actual_size == 1) + { + proxy = *(Window *) tmp_data; + XFree (tmp_data); + + /* Verify the proxy window exists. */ + XGetWindowAttributes (dpyinfo->display, proxy, &attrs); + + if (x_had_errors_p (dpyinfo->display)) + proxy = None; + } + x_uncatch_errors_after_check (); + + return proxy; +} + +static int +x_dnd_get_window_proto (struct x_display_info *dpyinfo, Window wdesc) +{ + Atom actual, value; + unsigned char *tmp_data; + int rc, format; + unsigned long n, left; + bool had_errors; + + if (wdesc == None || wdesc == FRAME_X_WINDOW (x_dnd_frame)) + return -1; + + x_catch_errors (dpyinfo->display); + rc = XGetWindowProperty (dpyinfo->display, wdesc, dpyinfo->Xatom_XdndAware, + 0, 1, False, XA_ATOM, &actual, &format, &n, &left, + &tmp_data); + had_errors = x_had_errors_p (dpyinfo->display); + x_uncatch_errors_after_check (); + + if (had_errors || rc != Success || actual != XA_ATOM || format != 32 || n < 1) + return -1; + + value = (int) *(Atom *) tmp_data; + XFree (tmp_data); + + return (int) value; +} + +static void +x_dnd_send_enter (struct frame *f, Window target, int supported) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + int i; + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndEnter; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = (((unsigned int) min (X_DND_SUPPORTED_VERSION, + supported) << 24) + | (x_dnd_n_targets > 3 ? 1 : 0)); + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + for (i = 0; i < min (3, x_dnd_n_targets); ++i) + msg.xclient.data.l[i + 2] = x_dnd_targets[i]; + + if (x_dnd_n_targets > 3) + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + dpyinfo->Xatom_XdndTypeList, XA_ATOM, 32, + PropModeReplace, (unsigned char *) x_dnd_targets, + x_dnd_n_targets); + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +static void +x_dnd_send_position (struct frame *f, Window target, int supported, + unsigned short root_x, unsigned short root_y, + Time timestamp, Atom action) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + if (target == x_dnd_mouse_rect_target + && x_dnd_mouse_rect.width + && x_dnd_mouse_rect.height) + { + if (root_x >= x_dnd_mouse_rect.x + && root_x < (x_dnd_mouse_rect.x + + x_dnd_mouse_rect.width) + && root_y >= x_dnd_mouse_rect.y + && root_y < (x_dnd_mouse_rect.y + + x_dnd_mouse_rect.height)) + return; + } + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndPosition; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = (root_x << 16) | root_y; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + if (supported >= 3) + msg.xclient.data.l[3] = timestamp; + + if (supported >= 4) + msg.xclient.data.l[4] = action; + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +static void +x_dnd_send_leave (struct frame *f, Window target) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndLeave; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +static void +x_dnd_send_drop (struct frame *f, Window target, Time timestamp, + int supported) +{ + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + XEvent msg; + + msg.xclient.type = ClientMessage; + msg.xclient.message_type = dpyinfo->Xatom_XdndDrop; + msg.xclient.format = 32; + msg.xclient.window = target; + msg.xclient.data.l[0] = FRAME_X_WINDOW (f); + msg.xclient.data.l[1] = 0; + msg.xclient.data.l[2] = 0; + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + if (supported >= 1) + msg.xclient.data.l[2] = timestamp; + + XSendEvent (FRAME_X_DISPLAY (f), target, False, 0, &msg); +} + +void +x_set_dnd_targets (Atom *targets, int ntargets) +{ + if (x_dnd_targets) + xfree (x_dnd_targets); + + x_dnd_targets = targets; + x_dnd_n_targets = ntargets; +} + +Lisp_Object +x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, + bool return_frame_p) +{ +#ifndef USE_GTK + XEvent next_event; + int finish; +#endif + struct input_event hold_quit; + char *atom_name; + Lisp_Object action, ltimestamp; + + if (!FRAME_VISIBLE_P (f)) + error ("Frame is invisible"); + + if (x_dnd_in_progress) + error ("A drag-and-drop session is already in progress"); + + ltimestamp = x_timestamp_for_selection (FRAME_DISPLAY_INFO (f), + QXdndSelection); + + if (NILP (ltimestamp)) + error ("No local value for XdndSelection"); + + if (BIGNUMP (ltimestamp)) + x_dnd_selection_timestamp = bignum_to_intmax (ltimestamp); + else + x_dnd_selection_timestamp = XFIXNUM (ltimestamp); + + x_dnd_in_progress = true; + x_dnd_frame = f; + x_dnd_last_seen_window = FRAME_X_WINDOW (f); + x_dnd_last_protocol_version = -1; + x_dnd_mouse_rect_target = None; + x_dnd_action = None; + x_dnd_wanted_action = xaction; + x_dnd_return_frame = 0; + + if (return_frame_p) + x_dnd_return_frame = 1; + +#ifdef USE_GTK + current_count = 0; +#endif + + while (x_dnd_in_progress) + { + hold_quit.kind = NO_EVENT; +#ifdef USE_GTK + current_finish = X_EVENT_NORMAL; + current_hold_quit = &hold_quit; +#endif + + block_input (); +#ifndef USE_GTK + XNextEvent (FRAME_X_DISPLAY (f), &next_event); + + handle_one_xevent (FRAME_DISPLAY_INFO (f), + &next_event, &finish, &hold_quit); +#else + gtk_main_iteration (); +#endif + unblock_input (); + + if (hold_quit.kind != NO_EVENT) + { + if (x_dnd_in_progress) + { + block_input (); + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + unblock_input (); + + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } + + FRAME_DISPLAY_INFO (f)->grabbed = 0; +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + quit (); + } + } + +#ifdef USE_GTK + current_hold_quit = NULL; +#endif + + if (x_dnd_return_frame == 3) + { + x_dnd_return_frame_object->mouse_moved = true; + + XSETFRAME (action, x_dnd_return_frame_object); + return action; + } + + FRAME_DISPLAY_INFO (f)->grabbed = 0; + + if (x_dnd_wanted_action != None) + { + block_input (); + atom_name = XGetAtomName (FRAME_X_DISPLAY (f), + x_dnd_wanted_action); + action = intern (atom_name); + XFree (atom_name); + unblock_input (); + + return action; + } + + return Qnil; +} + /* Flush display of frame F. */ static void @@ -558,6 +1288,43 @@ record_event (char *locus, int type) #endif static void +x_toolkit_position (struct frame *f, int x, int y, + bool *menu_bar_p, bool *tool_bar_p) +{ +#ifdef USE_GTK + GdkRectangle test_rect; + int scale; + + y += (FRAME_MENUBAR_HEIGHT (f) + + FRAME_TOOLBAR_TOP_HEIGHT (f)); + x += FRAME_TOOLBAR_LEFT_WIDTH (f); + + if (FRAME_EXTERNAL_MENU_BAR (f)) + *menu_bar_p = (x >= 0 && x < FRAME_PIXEL_WIDTH (f) + && y >= 0 && y < FRAME_MENUBAR_HEIGHT (f)); + + if (FRAME_X_OUTPUT (f)->toolbar_widget) + { + scale = xg_get_scale (f); + test_rect.x = x / scale; + test_rect.y = y / scale; + test_rect.width = 1; + test_rect.height = 1; + + *tool_bar_p = gtk_widget_intersect (FRAME_X_OUTPUT (f)->toolbar_widget, + &test_rect, NULL); + } +#elif defined USE_X_TOOLKIT + *menu_bar_p = (x > 0 && x < FRAME_PIXEL_WIDTH (f) + && (y < 0 && y >= -FRAME_MENUBAR_HEIGHT (f))); +#else + *menu_bar_p = (WINDOWP (f->menu_bar_window) + && (x > 0 && x < FRAME_PIXEL_WIDTH (f) + && (y > 0 && y < FRAME_MENU_BAR_HEIGHT (f)))); +#endif +} + +static void x_update_opaque_region (struct frame *f, XEvent *configure) { #ifndef HAVE_GTK3 @@ -643,7 +1410,9 @@ x_extension_initialize (struct x_display_info *dpyinfo) static void x_free_xi_devices (struct x_display_info *dpyinfo) { +#ifdef HAVE_XINPUT2_2 struct xi_touch_point_t *tem, *last; +#endif block_input (); @@ -651,8 +1420,11 @@ x_free_xi_devices (struct x_display_info *dpyinfo) { for (int i = 0; i < dpyinfo->num_devices; ++i) { +#ifdef HAVE_XINPUT2_1 xfree (dpyinfo->devices[i].valuators); +#endif +#ifdef HAVE_XINPUT2_2 tem = dpyinfo->devices[i].touchpoints; while (tem) { @@ -660,6 +1432,7 @@ x_free_xi_devices (struct x_display_info *dpyinfo) tem = tem->next; xfree (last); } +#endif } xfree (dpyinfo->devices); @@ -729,16 +1502,27 @@ x_init_master_valuators (struct x_display_info *dpyinfo) if (device->enabled) { +#ifdef HAVE_XINPUT2_1 int actual_valuator_count = 0; +#endif + struct xi_device_t *xi_device = &dpyinfo->devices[actual_devices++]; xi_device->device_id = device->deviceid; xi_device->grab = 0; + +#ifdef HAVE_XINPUT2_1 xi_device->valuators = xmalloc (sizeof *xi_device->valuators * device->num_classes); +#endif +#ifdef HAVE_XINPUT2_2 xi_device->touchpoints = NULL; +#endif + xi_device->master_p = (device->use == XIMasterKeyboard || device->use == XIMasterPointer); +#ifdef HAVE_XINPUT2_2 xi_device->direct_p = false; +#endif for (int c = 0; c < device->num_classes; ++c) { @@ -777,7 +1561,9 @@ x_init_master_valuators (struct x_display_info *dpyinfo) } } +#ifdef HAVE_XINPUT2_1 xi_device->scroll_valuator_count = actual_valuator_count; +#endif } } @@ -786,6 +1572,7 @@ x_init_master_valuators (struct x_display_info *dpyinfo) unblock_input (); } +#ifdef HAVE_XINPUT2_1 /* Return the delta of the scroll valuator VALUATOR_NUMBER under DEVICE_ID in the display DPYINFO with VALUE. The valuator's valuator will be set to VALUE afterwards. In case no scroll @@ -842,6 +1629,8 @@ x_get_scroll_valuator_delta (struct x_display_info *dpyinfo, int device_id, return DBL_MAX; } +#endif + struct xi_device_t * xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) { @@ -909,7 +1698,9 @@ xi_find_touch_point (struct xi_device_t *device, int detail) return NULL; } -#endif /* XI_TouchBegin */ +#endif /* HAVE_XINPUT2_2 */ + +#ifdef HAVE_XINPUT2_1 static void xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id, @@ -939,6 +1730,8 @@ xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id, return; } +#endif /* HAVE_XINPUT2_1 */ + #endif #ifdef USE_CAIRO @@ -2280,7 +3073,9 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring } #ifdef USE_CAIRO - if (p->which && p->which < max_fringe_bmp) + if (p->which + && p->which < max_fringe_bmp + && p->which < max_used_fringe_bitmap) { XGCValues gcv; @@ -2290,6 +3085,16 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring : f->output_data.x->cursor_pixel) : face->foreground)); XSetBackground (display, gc, face->background); + if (!fringe_bmp[p->which]) + { + /* This fringe bitmap is known to fringe.c, but lacks the + cairo_pattern_t pattern which shadows that bitmap. This + is typical to define-fringe-bitmap being called when the + selected frame was not a GUI frame, for example, when + packages that define fringe bitmaps are loaded by a + daemon Emacs. Create the missing pattern now. */ + gui_define_fringe_bitmap (f, p->which); + } x_cr_draw_image (f, gc, fringe_bmp[p->which], 0, p->dh, p->wd, p->h, p->x, p->y, p->overlay_p); XSetForeground (display, gc, gcv.foreground); @@ -2425,6 +3230,7 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time) { #ifndef USE_GTK struct frame *focus_frame = dpyinfo->x_focus_frame; + struct x_output *output; #endif #ifdef ENABLE_CHECKING @@ -2433,6 +3239,56 @@ x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time) dpyinfo->last_user_time = time; #ifndef USE_GTK + if (focus_frame + && (dpyinfo->last_user_time + > (dpyinfo->last_user_check_time + 2000))) + { + output = FRAME_X_OUTPUT (focus_frame); + + if (!x_wm_supports (focus_frame, + dpyinfo->Xatom_net_wm_user_time_window)) + { + if (output->user_time_window == None) + output->user_time_window = FRAME_OUTER_WINDOW (focus_frame); + else if (output->user_time_window != FRAME_OUTER_WINDOW (focus_frame)) + { + XDestroyWindow (dpyinfo->display, + output->user_time_window); + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time_window); + output->user_time_window = FRAME_OUTER_WINDOW (focus_frame); + } + } + else + { + if (output->user_time_window == FRAME_OUTER_WINDOW (focus_frame) + || output->user_time_window == None) + { + XSetWindowAttributes attrs; + memset (&attrs, 0, sizeof attrs); + + output->user_time_window + = XCreateWindow (dpyinfo->display, + FRAME_X_WINDOW (focus_frame), + -1, -1, 1, 1, 0, 0, InputOnly, + CopyFromParent, 0, &attrs); + + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time); + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (focus_frame), + dpyinfo->Xatom_net_wm_user_time_window, + XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &output->user_time_window, + 1); + } + } + + dpyinfo->last_user_check_time = time; + } + if (focus_frame) { while (FRAME_PARENT_FRAME (focus_frame)) @@ -3212,8 +4068,7 @@ x_color_cells (Display *dpy, int *ncells) if (dpyinfo->color_cells == NULL) { - Screen *screen = dpyinfo->screen; - int ncolor_cells = XDisplayCells (dpy, XScreenNumberOfScreen (screen)); + int ncolor_cells = dpyinfo->visual_info.colormap_size; int i; dpyinfo->color_cells = xnmalloc (ncolor_cells, @@ -3412,7 +4267,7 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) eassume (dpyinfo); rc = XAllocColor (dpy, cmap, color) != 0; - if (dpyinfo->visual->class == DirectColor) + if (dpyinfo->visual_info.class == DirectColor) return rc; if (rc == 0) @@ -3428,8 +4283,14 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) long nearest_delta, trial_delta; int x; Status status; + bool retry = false; + int ncolor_cells, i; + bool temp_allocated; + XColor temp; + start: cells = x_color_cells (dpy, &no_cells); + temp_allocated = false; nearest = 0; /* I'm assuming CSE so I'm not going to condense this. */ @@ -3449,13 +4310,21 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) * ((color->blue >> 8) - (cells[x].blue >> 8)))); if (trial_delta < nearest_delta) { - XColor temp; + /* We didn't decide to use this color, so free it. */ + if (temp_allocated) + { + XFreeColors (dpy, cmap, &temp.pixel, 1, 0); + temp_allocated = false; + } + temp.red = cells[x].red; temp.green = cells[x].green; temp.blue = cells[x].blue; status = XAllocColor (dpy, cmap, &temp); + if (status) { + temp_allocated = true; nearest = x; nearest_delta = trial_delta; } @@ -3464,7 +4333,38 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) color->red = cells[nearest].red; color->green = cells[nearest].green; color->blue = cells[nearest].blue; - status = XAllocColor (dpy, cmap, color); + + if (!temp_allocated) + status = XAllocColor (dpy, cmap, color); + else + { + *color = temp; + status = 1; + } + + if (status == 0 && !retry) + { + /* Our private cache of color cells is probably out of date. + Refresh it here, and try to allocate the nearest color + from the new colormap. */ + + retry = true; + xfree (dpyinfo->color_cells); + + ncolor_cells = dpyinfo->visual_info.colormap_size; + + dpyinfo->color_cells = xnmalloc (ncolor_cells, + sizeof *dpyinfo->color_cells); + dpyinfo->ncolor_cells = ncolor_cells; + + for (i = 0; i < ncolor_cells; ++i) + dpyinfo->color_cells[i].pixel = i; + + XQueryColors (dpy, dpyinfo->cmap, + dpyinfo->color_cells, ncolor_cells); + + goto start; + } rc = status != 0; } @@ -3537,7 +4437,7 @@ x_copy_color (struct frame *f, unsigned long pixel) necessary and some servers don't allow it. Since we won't free a color once we've allocated it, we don't need to re-allocate it to maintain the server's reference count. */ - if (!x_mutable_colormap (FRAME_X_VISUAL (f))) + if (!x_mutable_colormap (FRAME_X_VISUAL_INFO (f))) return pixel; color.pixel = pixel; @@ -5286,7 +6186,7 @@ XTflash (struct frame *f) block_input (); - if (FRAME_X_VISUAL (f)->class == TrueColor) + if (FRAME_X_VISUAL_INFO (f)->class == TrueColor) { values.function = GXxor; values.foreground = (FRAME_FOREGROUND_PIXEL (f) @@ -5372,7 +6272,7 @@ XTflash (struct frame *f) flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); - if (FRAME_X_VISUAL (f)->class == TrueColor) + if (FRAME_X_VISUAL_INFO (f)->class == TrueColor) XFreeGC (FRAME_X_DISPLAY (f), gc); x_flush (f); @@ -5560,6 +6460,12 @@ x_scroll_run (struct window *w, struct run *run) } #endif + /* Some of the following code depends on `normal_gc' being + up-to-date on the X server, but doesn't call a routine that will + flush it first. So do this ourselves instead. */ + XFlushGC (FRAME_X_DISPLAY (f), + f->output_data.x->normal_gc); + #ifdef USE_CAIRO if (FRAME_CR_CONTEXT (f)) { @@ -6001,7 +6907,8 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, #ifdef HAVE_XINPUT2 case GenericEvent: { - XIEvent *xi_event = (XIEvent *) event->xcookie.data; + XIEvent *xi_event = event->xcookie.data; + XIEnterEvent *enter_or_focus = event->xcookie.data; struct frame *focus_frame = dpyinfo->x_focus_event_frame; int focus_state @@ -6011,13 +6918,14 @@ x_detect_focus_change (struct x_display_info *dpyinfo, struct frame *frame, || xi_event->evtype == XI_FocusOut) x_focus_changed ((xi_event->evtype == XI_FocusIn ? FocusIn : FocusOut), - FOCUS_EXPLICIT, - dpyinfo, frame, bufp); + ((enter_or_focus->detail + == XINotifyPointer) + ? FOCUS_IMPLICIT : FOCUS_EXPLICIT), + dpyinfo, frame, bufp); else if ((xi_event->evtype == XI_Enter || xi_event->evtype == XI_Leave) - && (((XIEnterEvent *) xi_event)->detail - != XINotifyInferior) - && ((XIEnterEvent *) xi_event)->focus + && (enter_or_focus->detail != XINotifyInferior) + && enter_or_focus->focus && !(focus_state & FOCUS_EXPLICIT)) x_focus_changed ((xi_event->evtype == XI_Enter ? FocusIn : FocusOut), @@ -6383,13 +7291,26 @@ get_keysym_name (int keysym) /* Prepare a mouse-event in *RESULT for placement in the input queue. If the event is a button press, then note that we have grabbed - the mouse. */ + the mouse. + + The XButtonEvent structure passed as EVENT might not come from the + X server, and instead be artificially constructed from input + extension events. In these special events, the only fields that + are initialized are `time', `button', `state', `type', `window' and + `x' and `y'. This function should not access any other fields in + EVENT without also initializing the corresponding fields in `bv' + under the XI_ButtonPress and XI_ButtonRelease labels inside + `handle_one_xevent'. */ static Lisp_Object x_construct_mouse_click (struct input_event *result, const XButtonEvent *event, struct frame *f) { + int x = event->x; + int y = event->y; + Window dummy; + /* Make the event type NO_EVENT; we'll change that when we decide otherwise. */ result->kind = MOUSE_CLICK_EVENT; @@ -6401,8 +7322,16 @@ x_construct_mouse_click (struct input_event *result, ? up_modifier : down_modifier)); - XSETINT (result->x, event->x); - XSETINT (result->y, event->y); + /* If result->window is not the frame's edit widget (which can + happen with GTK+ scroll bars, for example), translate the + coordinates so they appear at the correct position. */ + if (event->window != FRAME_X_WINDOW (f)) + XTranslateCoordinates (FRAME_X_DISPLAY (f), + event->window, FRAME_X_WINDOW (f), + x, y, &x, &y, &dummy); + + XSETINT (result->x, x); + XSETINT (result->y, y); XSETFRAME (result->frame_or_window, f); result->arg = Qnil; return Qnil; @@ -6414,7 +7343,15 @@ x_construct_mouse_click (struct input_event *result, We have received a mouse movement event, which is given in *event. If the mouse is over a different glyph than it was last time, tell the mainstream emacs code by setting mouse_moved. If not, ask for - another motion event, so we can check again the next time it moves. */ + another motion event, so we can check again the next time it moves. + + The XMotionEvent structure passed as EVENT might not come from the + X server, and instead be artificially constructed from input + extension events. In these special events, the only fields that + are initialized are `time', `window', and `x' and `y'. This + function should not access any other fields in EVENT without also + initializing the corresponding fields in `ev' under the XI_Motion, + XI_Enter and XI_Leave labels inside `handle_one_xevent'. */ static bool x_note_mouse_movement (struct frame *frame, const XMotionEvent *event) @@ -6728,9 +7665,9 @@ x_window_to_scroll_bar (Display *display, Window window_id, int type) { Lisp_Object tail, frame; -#if defined (USE_GTK) && defined (USE_TOOLKIT_SCROLL_BARS) +#if defined (USE_GTK) && !defined (HAVE_GTK3) && defined (USE_TOOLKIT_SCROLL_BARS) window_id = (Window) xg_get_scroll_id_for_window (display, window_id); -#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */ +#endif /* USE_GTK && !HAVE_GTK3 && USE_TOOLKIT_SCROLL_BARS */ FOR_EACH_FRAME (tail, frame) { @@ -7452,6 +8389,30 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) XDefineCursor (XtDisplay (widget), XtWindow (widget), f->output_data.x->nontext_cursor); +#ifdef HAVE_XINPUT2 + /* Ask for input extension button and motion events. This lets us + send the proper `wheel-up' or `wheel-down' events to Emacs. */ + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + XISelectEvents (XtDisplay (widget), XtWindow (widget), + &mask, 1); + } +#endif #else /* !USE_MOTIF i.e. use Xaw */ /* Set resources. Create the widget. The background of the @@ -7653,6 +8614,30 @@ x_create_horizontal_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) XDefineCursor (XtDisplay (widget), XtWindow (widget), f->output_data.x->nontext_cursor); +#ifdef HAVE_XINPUT2 + /* Ask for input extension button and motion events. This lets us + send the proper `wheel-up' or `wheel-down' events to Emacs. */ + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + XISelectEvents (XtDisplay (widget), XtWindow (widget), + &mask, 1); + } +#endif #else /* !USE_MOTIF i.e. use Xaw */ /* Set resources. Create the widget. The background of the @@ -8039,6 +9024,9 @@ x_scroll_bar_create (struct window *w, int top, int left, XSetWindowAttributes a; unsigned long mask; Window window; +#ifdef HAVE_XDBE + Drawable drawable; +#endif a.background_pixel = f->output_data.x->scroll_bar_background_pixel; if (a.background_pixel == -1) @@ -8067,7 +9055,51 @@ x_scroll_bar_create (struct window *w, int top, int left, CopyFromParent, /* Attributes. */ mask, &a); +#ifdef HAVE_XDBE + if (FRAME_DISPLAY_INFO (f)->supports_xdbe + && FRAME_X_DOUBLE_BUFFERED_P (f)) + { + x_catch_errors (FRAME_X_DISPLAY (f)); + drawable = XdbeAllocateBackBufferName (FRAME_X_DISPLAY (f), + window, XdbeCopied); + if (x_had_errors_p (FRAME_X_DISPLAY (f))) + drawable = window; + else + XSetWindowBackgroundPixmap (FRAME_X_DISPLAY (f), window, None); + x_uncatch_errors_after_check (); + } + else + drawable = window; +#endif + +#ifdef HAVE_XINPUT2 + /* Ask for input extension button and motion events. This lets us + send the proper `wheel-up' or `wheel-down' events to Emacs. */ + if (FRAME_DISPLAY_INFO (f)->supports_xi2) + { + XIEventMask mask; + ptrdiff_t l = XIMaskLen (XI_LASTEVENT); + unsigned char *m; + + mask.mask = m = alloca (l); + memset (m, 0, l); + mask.mask_len = l; + + mask.deviceid = XIAllMasterDevices; + XISetMask (m, XI_ButtonPress); + XISetMask (m, XI_ButtonRelease); + XISetMask (m, XI_Motion); + XISetMask (m, XI_Enter); + XISetMask (m, XI_Leave); + + XISelectEvents (FRAME_X_DISPLAY (f), window, &mask, 1); + } +#endif + bar->x_window = window; +#ifdef HAVE_XDBE + bar->x_drawable = drawable; +#endif } #endif /* not USE_TOOLKIT_SCROLL_BARS */ @@ -8141,7 +9173,11 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, bool rebuild) { bool dragging = bar->dragging != -1; +#ifndef HAVE_XDBE Window w = bar->x_window; +#else + Drawable w = bar->x_drawable; +#endif struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; @@ -8191,10 +9227,22 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, /* Draw the empty space above the handle. Note that we can't clear zero-height areas; that means "clear to end of window." */ if ((inside_width > 0) && (start > 0)) - x_clear_area1 (FRAME_X_DISPLAY (f), w, - VERTICAL_SCROLL_BAR_LEFT_BORDER, - VERTICAL_SCROLL_BAR_TOP_BORDER, - inside_width, start, False); + { + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); + + XFillRectangle (FRAME_X_DISPLAY (f), w, gc, + VERTICAL_SCROLL_BAR_LEFT_BORDER, + VERTICAL_SCROLL_BAR_TOP_BORDER, + inside_width, start); + + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); + } /* Change to proper foreground color if one is specified. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) @@ -8208,20 +9256,38 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, VERTICAL_SCROLL_BAR_TOP_BORDER + start, inside_width, end - start); - /* Restore the foreground color of the GC if we changed it above. */ - if (f->output_data.x->scroll_bar_foreground_pixel != -1) - XSetForeground (FRAME_X_DISPLAY (f), gc, - FRAME_FOREGROUND_PIXEL (f)); /* Draw the empty space below the handle. Note that we can't clear zero-height areas; that means "clear to end of window." */ if ((inside_width > 0) && (end < inside_height)) - x_clear_area1 (FRAME_X_DISPLAY (f), w, - VERTICAL_SCROLL_BAR_LEFT_BORDER, - VERTICAL_SCROLL_BAR_TOP_BORDER + end, - inside_width, inside_height - end, False); + { + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); + + XFillRectangle (FRAME_X_DISPLAY (f), w, gc, + VERTICAL_SCROLL_BAR_LEFT_BORDER, + VERTICAL_SCROLL_BAR_TOP_BORDER + end, + inside_width, inside_height - end); + + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); + } + + /* Restore the foreground color of the GC if we changed it above. */ + if (f->output_data.x->scroll_bar_foreground_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); } +#ifdef HAVE_XDBE + if (!rebuild) + x_scroll_bar_end_update (FRAME_DISPLAY_INFO (f), bar); +#endif + unblock_input (); } @@ -8243,6 +9309,11 @@ x_scroll_bar_remove (struct scroll_bar *bar) XtDestroyWidget (SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar)); #endif /* not USE_GTK */ #else +#ifdef HAVE_XDBE + if (bar->x_window != bar->x_drawable) + XdbeDeallocateBackBufferName (FRAME_X_DISPLAY (f), + bar->x_drawable); +#endif XDestroyWindow (FRAME_X_DISPLAY (f), bar->x_window); #endif @@ -8663,12 +9734,39 @@ XTjudge_scroll_bars (struct frame *f) static void x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) { +#ifndef HAVE_XDBE Window w = bar->x_window; +#else + Drawable w = bar->x_drawable; +#endif + struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; block_input (); +#ifdef HAVE_XDBE + if (w != bar->x_window) + { + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); + + XFillRectangle (FRAME_X_DISPLAY (f), + bar->x_drawable, + gc, event->xexpose.x, + event->xexpose.y, + event->xexpose.width, + event->xexpose.height); + + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); + } +#endif + x_scroll_bar_set_handle (bar, bar->start, bar->end, true); /* Switch to scroll bar foreground color. */ @@ -8689,6 +9787,10 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) XSetForeground (FRAME_X_DISPLAY (f), gc, FRAME_FOREGROUND_PIXEL (f)); +#ifdef HAVE_XDBE + x_scroll_bar_end_update (FRAME_DISPLAY_INFO (f), bar); +#endif + unblock_input (); } @@ -8820,6 +9922,24 @@ x_scroll_bar_note_movement (struct scroll_bar *bar, } } +#ifdef HAVE_XDBE +static void +x_scroll_bar_end_update (struct x_display_info *dpyinfo, + struct scroll_bar *bar) +{ + XdbeSwapInfo swap_info; + + /* This means the scroll bar is double-buffered. */ + if (bar->x_drawable != bar->x_window) + { + memset (&swap_info, 0, sizeof swap_info); + swap_info.swap_window = bar->x_window; + swap_info.swap_action = XdbeCopied; + XdbeSwapBuffers (dpyinfo->display, &swap_info, 1); + } +} +#endif + #endif /* !USE_TOOLKIT_SCROLL_BARS */ /* Return information to the user about the current position of the mouse @@ -8970,6 +10090,16 @@ x_scroll_bar_clear (struct frame *f) { #ifndef USE_TOOLKIT_SCROLL_BARS Lisp_Object bar; +#ifdef HAVE_XDBE + GC gc = f->output_data.x->normal_gc; + + if (f->output_data.x->scroll_bar_background_pixel != -1) + XSetForeground (FRAME_X_DISPLAY (f), gc, + f->output_data.x->scroll_bar_background_pixel); + else + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_BACKGROUND_PIXEL (f)); +#endif /* We can have scroll bars even if this is 0, if we just turned off scroll bar mode. @@ -8977,9 +10107,27 @@ x_scroll_bar_clear (struct frame *f) if (FRAME_HAS_VERTICAL_SCROLL_BARS (f)) for (bar = FRAME_SCROLL_BARS (f); VECTORP (bar); bar = XSCROLL_BAR (bar)->next) - XClearArea (FRAME_X_DISPLAY (f), - XSCROLL_BAR (bar)->x_window, - 0, 0, 0, 0, True); + { +#ifdef HAVE_XDBE + if (XSCROLL_BAR (bar)->x_window + == XSCROLL_BAR (bar)->x_drawable) +#endif + XClearArea (FRAME_X_DISPLAY (f), + XSCROLL_BAR (bar)->x_window, + 0, 0, 0, 0, True); +#ifdef HAVE_XDBE + else + XFillRectangle (FRAME_X_DISPLAY (f), + XSCROLL_BAR (bar)->x_drawable, + gc, 0, 0, XSCROLL_BAR (bar)->width, + XSCROLL_BAR (bar)->height); +#endif + } + +#ifdef HAVE_XDBE + XSetForeground (FRAME_X_DISPLAY (f), gc, + FRAME_FOREGROUND_PIXEL (f)); +#endif #endif /* not USE_TOOLKIT_SCROLL_BARS */ } @@ -9014,13 +10162,6 @@ static struct x_display_info *XTread_socket_fake_io_error; static struct x_display_info *next_noop_dpyinfo; -enum -{ - X_EVENT_NORMAL, - X_EVENT_GOTO_OUT, - X_EVENT_DROP -}; - /* Filter events for the current X input method. DPYINFO is the display this event is for. EVENT is the X event to filter. @@ -9096,10 +10237,6 @@ x_filter_event (struct x_display_info *dpyinfo, XEvent *event) #endif #ifdef USE_GTK -static int current_count; -static int current_finish; -static struct input_event *current_hold_quit; - /* This is the filter function invoked by the GTK event loop. It is invoked before the XEvent is translated to a GdkEvent, so we have a chance to act on the event before GTK. */ @@ -9191,9 +10328,9 @@ x_net_wm_state (struct frame *f, Window window) { int value = FULLSCREEN_NONE; Lisp_Object lval = Qnil; - bool sticky = false; + bool sticky = false, shaded = false; - x_get_current_wm_state (f, window, &value, &sticky); + x_get_current_wm_state (f, window, &value, &sticky, &shaded); switch (value) { @@ -9212,29 +10349,53 @@ x_net_wm_state (struct frame *f, Window window) } store_frame_param (f, Qfullscreen, lval); -/** store_frame_param (f, Qsticky, sticky ? Qt : Qnil); **/ + store_frame_param (f, Qsticky, sticky ? Qt : Qnil); + store_frame_param (f, Qshaded, shaded ? Qt : Qnil); } -/* Flip back buffers on any frames with undrawn content. */ +/* Flip back buffers on FRAME if it has undrawn content. */ static void -flush_dirty_back_buffers (void) +flush_dirty_back_buffer_on (struct frame *f) { block_input (); - Lisp_Object tail, frame; - FOR_EACH_FRAME (tail, frame) - { - struct frame *f = XFRAME (frame); - if (FRAME_LIVE_P (f) && - FRAME_X_P (f) && - FRAME_X_WINDOW (f) && - !FRAME_GARBAGED_P (f) && - !buffer_flipping_blocked_p () && - FRAME_X_NEED_BUFFER_FLIP (f)) - show_back_buffer (f); - } + if (FRAME_LIVE_P (f) && + FRAME_X_P (f) && + FRAME_X_WINDOW (f) && + !FRAME_GARBAGED_P (f) && + !buffer_flipping_blocked_p () && + FRAME_X_NEED_BUFFER_FLIP (f)) + show_back_buffer (f); unblock_input (); } +#ifdef HAVE_GTK3 +void +x_scroll_bar_configure (GdkEvent *event) +{ + XEvent configure; + GdkDisplay *gdpy; + Display *dpy; + + configure.xconfigure.type = ConfigureNotify; + configure.xconfigure.serial = 0; + configure.xconfigure.send_event = event->configure.send_event; + configure.xconfigure.x = event->configure.x; + configure.xconfigure.y = event->configure.y; + configure.xconfigure.width = event->configure.width; + configure.xconfigure.height = event->configure.height; + configure.xconfigure.border_width = 0; + configure.xconfigure.event = GDK_WINDOW_XID (event->configure.window); + configure.xconfigure.window = GDK_WINDOW_XID (event->configure.window); + configure.xconfigure.above = None; + configure.xconfigure.override_redirect = False; + + gdpy = gdk_window_get_display (event->configure.window); + dpy = gdk_x11_display_get_xdisplay (gdpy); + + x_dispatch_event (&configure, dpy); +} +#endif + /** mouse_or_wdesc_frame: When not dropping and the mouse was grabbed for DPYINFO, return the frame where the mouse was seen last. If @@ -9298,6 +10459,16 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent configureEvent; XEvent next_event; Lisp_Object coding; +#if defined USE_MOTIF && defined HAVE_XINPUT2 + /* Some XInput 2 events are important for Motif menu bars to work + correctly, so they must be translated into core events before + being passed to XtDispatchEvent. */ + bool use_copy = false; + XEvent copy; +#elif defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + GdkEvent *copy = NULL; + GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display); +#endif *finish = X_EVENT_NORMAL; @@ -9305,10 +10476,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.kind = NO_EVENT; inev.ie.arg = Qnil; -#ifdef HAVE_XKB - if (event->type != dpyinfo->xkb_event_type) + /* Ignore events coming from various extensions, such as XFIXES and + XKB. */ + if (event->type < LASTEvent) { -#endif #ifdef HAVE_XINPUT2 if (event->type != GenericEvent) #endif @@ -9317,11 +10488,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, else any = NULL; #endif -#ifdef HAVE_XKB } else any = NULL; -#endif if (any && any->wait_event_type == event->type) any->wait_event_type = 0; /* Indicates we got it. */ @@ -9330,6 +10499,42 @@ handle_one_xevent (struct x_display_info *dpyinfo, { case ClientMessage: { + if (x_dnd_in_progress + && FRAME_DISPLAY_INFO (x_dnd_frame) == dpyinfo + && event->xclient.message_type == dpyinfo->Xatom_XdndStatus) + { + Window target; + + target = event->xclient.data.l[0]; + + if (x_dnd_last_protocol_version != -1 + && target == x_dnd_last_seen_window + && event->xclient.data.l[1] & 2) + { + x_dnd_mouse_rect_target = target; + x_dnd_mouse_rect.x = (event->xclient.data.l[2] & 0xffff0000) >> 16; + x_dnd_mouse_rect.y = (event->xclient.data.l[2] & 0xffff); + x_dnd_mouse_rect.width = (event->xclient.data.l[3] & 0xffff0000) >> 16; + x_dnd_mouse_rect.height = (event->xclient.data.l[3] & 0xffff); + } + else + x_dnd_mouse_rect_target = None; + + if (x_dnd_last_protocol_version != -1 + && target == x_dnd_last_seen_window) + { + if (event->xclient.data.l[1] & 1) + { + if (x_dnd_last_protocol_version >= 2) + x_dnd_wanted_action = event->xclient.data.l[4]; + else + x_dnd_wanted_action = dpyinfo->Xatom_XdndActionCopy; + } + else + x_dnd_wanted_action = None; + } + } + if (event->xclient.message_type == dpyinfo->Xatom_wm_protocols && event->xclient.format == 32) { @@ -9825,6 +11030,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, case NoExpose: /* This occurs when an XCopyArea's source area was completely available. */ +#ifdef USE_X_TOOLKIT + *finish = X_EVENT_DROP; +#endif break; case UnmapNotify: @@ -9880,8 +11088,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, { bool iconified = FRAME_ICONIFIED_P (f); int value; - bool sticky; - bool not_hidden = x_get_current_wm_state (f, event->xmap.window, &value, &sticky); + bool sticky, shaded; + bool not_hidden = x_get_current_wm_state (f, event->xmap.window, &value, &sticky, + &shaded); if (CONSP (frame_size_history)) frame_size_history_extra @@ -10156,75 +11365,99 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Random non-modifier sorts of keysyms. */ if (((keysym >= XK_BackSpace && keysym <= XK_Escape) - || keysym == XK_Delete + || keysym == XK_Delete #ifdef XK_ISO_Left_Tab - || (keysym >= XK_ISO_Left_Tab - && keysym <= XK_ISO_Enter) + || (keysym >= XK_ISO_Left_Tab + && keysym <= XK_ISO_Enter) #endif - || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ - || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ + || IsCursorKey (keysym) /* 0xff50 <= x < 0xff60 */ + || IsMiscFunctionKey (keysym) /* 0xff60 <= x < VARIES */ #ifdef HPUX - /* This recognizes the "extended function - keys". It seems there's no cleaner way. - Test IsModifierKey to avoid handling - mode_switch incorrectly. */ - || (XK_Select <= keysym && keysym < XK_KP_Space) + /* This recognizes the "extended function + keys". It seems there's no cleaner way. + Test IsModifierKey to avoid handling + mode_switch incorrectly. */ + || (XK_Select <= keysym && keysym < XK_KP_Space) #endif #ifdef XK_dead_circumflex - || orig_keysym == XK_dead_circumflex + || orig_keysym == XK_dead_circumflex #endif #ifdef XK_dead_grave - || orig_keysym == XK_dead_grave + || orig_keysym == XK_dead_grave #endif #ifdef XK_dead_tilde - || orig_keysym == XK_dead_tilde + || orig_keysym == XK_dead_tilde #endif #ifdef XK_dead_diaeresis - || orig_keysym == XK_dead_diaeresis + || orig_keysym == XK_dead_diaeresis #endif #ifdef XK_dead_macron - || orig_keysym == XK_dead_macron + || orig_keysym == XK_dead_macron #endif #ifdef XK_dead_degree - || orig_keysym == XK_dead_degree + || orig_keysym == XK_dead_degree #endif #ifdef XK_dead_acute - || orig_keysym == XK_dead_acute + || orig_keysym == XK_dead_acute #endif #ifdef XK_dead_cedilla - || orig_keysym == XK_dead_cedilla + || orig_keysym == XK_dead_cedilla #endif #ifdef XK_dead_breve - || orig_keysym == XK_dead_breve + || orig_keysym == XK_dead_breve #endif #ifdef XK_dead_ogonek - || orig_keysym == XK_dead_ogonek + || orig_keysym == XK_dead_ogonek #endif #ifdef XK_dead_caron - || orig_keysym == XK_dead_caron + || orig_keysym == XK_dead_caron #endif #ifdef XK_dead_doubleacute - || orig_keysym == XK_dead_doubleacute + || orig_keysym == XK_dead_doubleacute #endif #ifdef XK_dead_abovedot - || orig_keysym == XK_dead_abovedot -#endif - || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ - || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ - /* Any "vendor-specific" key is ok. */ - || (orig_keysym & (1 << 28)) - || (keysym != NoSymbol && nbytes == 0)) - && ! (IsModifierKey (orig_keysym) - /* The symbols from XK_ISO_Lock - to XK_ISO_Last_Group_Lock - don't have real modifiers but - should be treated similarly to - Mode_switch by Emacs. */ + || orig_keysym == XK_dead_abovedot +#endif +#ifdef XK_dead_abovering + || orig_keysym == XK_dead_abovering +#endif +#ifdef XK_dead_belowdot + || orig_keysym == XK_dead_belowdot +#endif +#ifdef XK_dead_voiced_sound + || orig_keysym == XK_dead_voiced_sound +#endif +#ifdef XK_dead_semivoiced_sound + || orig_keysym == XK_dead_semivoiced_sound +#endif +#ifdef XK_dead_hook + || orig_keysym == XK_dead_hook +#endif +#ifdef XK_dead_horn + || orig_keysym == XK_dead_horn +#endif +#ifdef XK_dead_stroke + || orig_keysym == XK_dead_stroke +#endif +#ifdef XK_dead_abovecomma + || orig_keysym == XK_dead_abovecomma +#endif + || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ + || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ + /* Any "vendor-specific" key is ok. */ + || (orig_keysym & (1 << 28)) + || (keysym != NoSymbol && nbytes == 0)) + && ! (IsModifierKey (orig_keysym) + /* The symbols from XK_ISO_Lock + to XK_ISO_Last_Group_Lock + don't have real modifiers but + should be treated similarly to + Mode_switch by Emacs. */ #if defined XK_ISO_Lock && defined XK_ISO_Last_Group_Lock - || (XK_ISO_Lock <= orig_keysym - && orig_keysym <= XK_ISO_Last_Group_Lock) + || (XK_ISO_Lock <= orig_keysym + && orig_keysym <= XK_ISO_Last_Group_Lock) #endif - )) + )) { STORE_KEYSYM_FOR_DEBUG (keysym); /* make_lispy_event will convert this to a symbolic @@ -10257,6 +11490,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, } done_keysym: #ifdef HAVE_X_I18N + if (f) + { + struct window *w = XWINDOW (f->selected_window); + xic_set_preeditarea (w, w->cursor.x, w->cursor.y); + + if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) + xic_set_statusarea (f); + } + /* Don't dispatch this event since XtDispatchEvent calls XFilterEvent, and two calls in a row may freeze the client. */ @@ -10356,6 +11598,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case LeaveNotify: + x_display_set_last_user_time (dpyinfo, event->xcrossing.time); + #ifdef HAVE_XWIDGETS { struct xwidget_view *xvw = xwidget_view_from_window (event->xcrossing.window); @@ -10367,7 +11611,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, } } #endif - x_display_set_last_user_time (dpyinfo, event->xcrossing.time); if (x_top_window_to_frame (dpyinfo, event->xcrossing.window)) x_detect_focus_change (dpyinfo, any, event, &inev.ie); @@ -10419,6 +11662,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, case MotionNotify: { + XMotionEvent xmotion = event->xmotion; + previous_help_echo_string = help_echo_string; help_echo_string = Qnil; @@ -10428,10 +11673,61 @@ handle_one_xevent (struct x_display_info *dpyinfo, clear_mouse_face (hlinfo); } + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + Window target; + int target_proto; + + target = x_dnd_get_target_window (dpyinfo, + event->xmotion.x_root, + event->xmotion.y_root, + &target_proto); + + if (target != x_dnd_last_seen_window) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_X_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + + if (x_dnd_last_seen_window == FRAME_X_WINDOW (x_dnd_frame) + && x_dnd_return_frame == 1) + x_dnd_return_frame = 2; + + if (x_dnd_return_frame == 2 + && x_any_window_to_frame (dpyinfo, target)) + { + x_dnd_in_progress = false; + x_dnd_return_frame_object + = x_any_window_to_frame (dpyinfo, target); + x_dnd_return_frame = 3; + } + + x_dnd_wanted_action = None; + x_dnd_last_seen_window = target; + x_dnd_last_protocol_version = target_proto; + + if (target != None && x_dnd_last_protocol_version != -1) + x_dnd_send_enter (x_dnd_frame, target, + x_dnd_last_protocol_version); + } + + if (x_dnd_last_protocol_version != -1 && target != None) + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + event->xmotion.x_root, + event->xmotion.y_root, + x_dnd_selection_timestamp, + dpyinfo->Xatom_XdndActionCopy); + + goto OTHER; + } + f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); #ifdef USE_GTK - if (f && xg_event_is_for_scrollbar (f, event)) + if (f && xg_event_is_for_scrollbar (f, event, false)) f = 0; #endif #ifdef HAVE_XWIDGETS @@ -10459,8 +11755,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, || !NILP (focus_follows_mouse))) { static Lisp_Object last_mouse_window; + + if (xmotion.window != FRAME_X_WINDOW (f)) + { + XTranslateCoordinates (FRAME_X_DISPLAY (f), + xmotion.window, FRAME_X_WINDOW (f), + xmotion.x, xmotion.y, &xmotion.x, + &xmotion.y, &xmotion.subwindow); + xmotion.window = FRAME_X_WINDOW (f); + } + Lisp_Object window = window_from_coordinates - (f, event->xmotion.x, event->xmotion.y, 0, false, false); + (f, xmotion.x, xmotion.y, 0, false, false); /* A window will be autoselected only when it is not selected now and the last mouse movement event was @@ -10482,7 +11788,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, last_mouse_window = window; } - if (!x_note_mouse_movement (f, &event->xmotion)) + if (!x_note_mouse_movement (f, &xmotion)) help_echo_string = previous_help_echo_string; } else @@ -10540,6 +11846,44 @@ handle_one_xevent (struct x_display_info *dpyinfo, configureEvent = next_event; } +#if defined HAVE_GTK3 && defined USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar = x_window_to_scroll_bar (dpyinfo->display, + configureEvent.xconfigure.window, 2); + + /* There is really no other way to make GTK scroll bars fit + in the dimensions we want them to. */ + if (bar) + { + /* Skip all the pending configure events, not just the + ones where window motion occurred. */ + while (XPending (dpyinfo->display)) + { + XNextEvent (dpyinfo->display, &next_event); + if (next_event.type != ConfigureNotify + || next_event.xconfigure.window != event->xconfigure.window) + { + XPutBackEvent (dpyinfo->display, &next_event); + break; + } + else + configureEvent = next_event; + } + + if (configureEvent.xconfigure.width != max (bar->width, 1) + || configureEvent.xconfigure.height != max (bar->height, 1)) + { + XResizeWindow (dpyinfo->display, bar->x_window, + max (bar->width, 1), max (bar->height, 1)); + x_flush (WINDOW_XFRAME (XWINDOW (bar->window))); + } + + if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) + x_drop_xrender_surfaces (f); + + goto OTHER; + } +#endif + f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window); /* Unfortunately, we need to call x_drop_xrender_surfaces for _all_ ConfigureNotify events, otherwise we miss some and @@ -10687,11 +12031,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_X_I18N - if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) - xic_set_statusarea (f); - if (f) { + if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) + xic_set_statusarea (f); + struct window *w = XWINDOW (f->selected_window); xic_set_preeditarea (w, w->cursor.x, w->cursor.y); } @@ -10703,8 +12047,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, case ButtonRelease: case ButtonPress: { + if (event->xbutton.type == ButtonPress) + x_display_set_last_user_time (dpyinfo, event->xbutton.time); + #ifdef HAVE_XWIDGETS - struct xwidget_view *xvw = xwidget_view_from_window (event->xmotion.window); + struct xwidget_view *xvw = xwidget_view_from_window (event->xbutton.window); if (xvw) { @@ -10728,14 +12075,43 @@ handle_one_xevent (struct x_display_info *dpyinfo, Lisp_Object tab_bar_arg = Qnil; bool tab_bar_p = false; bool tool_bar_p = false; + bool dnd_grab = false; + + for (int i = 1; i < 8; ++i) + { + if (i != event->xbutton.button + && event->xbutton.state & (Button1Mask << (i - 1))) + dnd_grab = true; + } + + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame) + && !dnd_grab + && event->xbutton.type == ButtonRelease) + { + x_dnd_in_progress = false; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + + x_dnd_last_protocol_version = -1; + x_dnd_last_seen_window = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); + + goto OTHER; + } + + if (x_dnd_in_progress) + goto OTHER; memset (&compose_status, 0, sizeof (compose_status)); dpyinfo->last_mouse_glyph_frame = NULL; - if (event->xbutton.type == ButtonPress) - x_display_set_last_user_time (dpyinfo, event->xbutton.time); - - f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); + f = mouse_or_wdesc_frame (dpyinfo, event->xbutton.window); if (f && event->xbutton.type == ButtonPress && !popup_activated () && !x_window_to_scroll_bar (event->xbutton.display, @@ -10760,7 +12136,36 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #ifdef USE_GTK - if (f && xg_event_is_for_scrollbar (f, event)) + if (!f) + { + f = x_any_window_to_frame (dpyinfo, event->xbutton.window); + + if (event->xbutton.button > 3 + && event->xbutton.button < 9 + && f) + { + if (ignore_next_mouse_click_timeout) + { + if (event->type == ButtonPress + && event->xbutton.time > ignore_next_mouse_click_timeout) + { + ignore_next_mouse_click_timeout = 0; + x_construct_mouse_click (&inev.ie, &event->xbutton, f); + } + if (event->type == ButtonRelease) + ignore_next_mouse_click_timeout = 0; + } + else + x_construct_mouse_click (&inev.ie, &event->xbutton, f); + + *finish = X_EVENT_DROP; + goto OTHER; + } + else + f = NULL; + } + + if (f && xg_event_is_for_scrollbar (f, event, false)) f = 0; #endif if (f) @@ -10869,11 +12274,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #if defined (USE_X_TOOLKIT) || defined (USE_GTK) f = x_menubar_window_to_frame (dpyinfo, event); - /* For a down-event in the menu bar, - don't pass it to Xt right now. - Instead, save it away - and we will pass it to Xt from kbd_buffer_get_event. - That way, we can run some Lisp code first. */ + /* For a down-event in the menu bar, don't pass it to Xt or + GTK right away. Instead, save it and pass it to Xt or GTK + from kbd_buffer_get_event. That way, we can run some Lisp + code first. */ if (! popup_activated () #ifdef USE_GTK /* Gtk+ menus only react to the first three buttons. */ @@ -10888,12 +12292,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, && event->xbutton.y < FRAME_MENUBAR_HEIGHT (f) && event->xbutton.same_screen) { - if (!f->output_data.x->saved_menu_event) - f->output_data.x->saved_menu_event = xmalloc (sizeof *event); - *f->output_data.x->saved_menu_event = *event; - inev.ie.kind = MENU_BAR_ACTIVATE_EVENT; - XSETFRAME (inev.ie.frame_or_window, f); - *finish = X_EVENT_DROP; +#ifdef USE_MOTIF + unsigned char column_type; + Widget widget; + + widget = XtWindowToWidget (dpyinfo->display, + event->xbutton.window); + XtVaGetValues (widget, XmNrowColumnType, &column_type, NULL); + + if (column_type != XmMENU_BAR) + { +#endif + if (!f->output_data.x->saved_menu_event) + f->output_data.x->saved_menu_event = xmalloc (sizeof *event); + *f->output_data.x->saved_menu_event = *event; + inev.ie.kind = MENU_BAR_ACTIVATE_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + *finish = X_EVENT_DROP; +#ifdef USE_MOTIF + } +#endif } else goto OTHER; @@ -10931,14 +12349,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, case DestroyNotify: xft_settings_event (dpyinfo, event); break; + #ifdef HAVE_XINPUT2 case GenericEvent: { if (!dpyinfo->supports_xi2) goto OTHER; + if (event->xgeneric.extension != dpyinfo->xi2_opcode) /* Not an XI2 event. */ goto OTHER; + bool must_free_data = false; XIEvent *xi_event = (XIEvent *) event->xcookie.data; /* Sometimes the event is already claimed by GTK, which @@ -10950,19 +12371,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, } XIDeviceEvent *xev = (XIDeviceEvent *) xi_event; - XILeaveEvent *leave = (XILeaveEvent *) xi_event; - XIEnterEvent *enter = (XIEnterEvent *) xi_event; - XIFocusInEvent *focusin = (XIFocusInEvent *) xi_event; - XIFocusOutEvent *focusout = (XIFocusOutEvent *) xi_event; - XIDeviceChangedEvent *device_changed = (XIDeviceChangedEvent *) xi_event; - XIValuatorState *states; - double *values; - bool found_valuator = false; - - /* A fake XMotionEvent for x_note_mouse_movement. */ - XMotionEvent ev; - /* A fake XButtonEvent for x_construct_mouse_click. */ - XButtonEvent bv; if (!xi_event) { @@ -10973,189 +12381,270 @@ handle_one_xevent (struct x_display_info *dpyinfo, switch (event->xcookie.evtype) { case XI_FocusIn: - any = x_any_window_to_frame (dpyinfo, focusin->event); + { + XIFocusInEvent *focusin = (XIFocusInEvent *) xi_event; + + any = x_any_window_to_frame (dpyinfo, focusin->event); #ifdef USE_GTK - /* Some WMs (e.g. Mutter in Gnome Shell), don't unmap - minimized/iconified windows; thus, for those WMs we won't get - a MapNotify when unminimizing/deiconifying. Check here if we - are deiconizing a window (Bug42655). - - But don't do that by default on GTK since it may cause a plain - invisible frame get reported as iconified, compare - https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html. - That is fixed above but bites us here again. - - The option x_set_frame_visibility_more_laxly allows to override - the default behavior (Bug#49955, Bug#53298). */ - if (EQ (x_set_frame_visibility_more_laxly, Qfocus_in) - || EQ (x_set_frame_visibility_more_laxly, Qt)) + /* Some WMs (e.g. Mutter in Gnome Shell), don't unmap + minimized/iconified windows; thus, for those WMs we won't get + a MapNotify when unminimizing/deiconifying. Check here if we + are deiconizing a window (Bug42655). + + But don't do that by default on GTK since it may cause a plain + invisible frame get reported as iconified, compare + https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html. + That is fixed above but bites us here again. + + The option x_set_frame_visibility_more_laxly allows to override + the default behavior (Bug#49955, Bug#53298). */ + if (EQ (x_set_frame_visibility_more_laxly, Qfocus_in) + || EQ (x_set_frame_visibility_more_laxly, Qt)) #endif /* USE_GTK */ - { - f = any; - if (f && FRAME_ICONIFIED_P (f)) - { - SET_FRAME_VISIBLE (f, 1); - SET_FRAME_ICONIFIED (f, false); - f->output_data.x->has_been_visible = true; - inev.ie.kind = DEICONIFY_EVENT; - XSETFRAME (inev.ie.frame_or_window, f); - } - } - x_detect_focus_change (dpyinfo, any, event, &inev.ie); - goto XI_OTHER; + { + f = any; + if (f && FRAME_ICONIFIED_P (f)) + { + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, false); + f->output_data.x->has_been_visible = true; + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + } + } + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + goto XI_OTHER; + } case XI_FocusOut: - any = x_any_window_to_frame (dpyinfo, focusout->event); - x_detect_focus_change (dpyinfo, any, event, &inev.ie); - goto XI_OTHER; + { + XIFocusOutEvent *focusout = (XIFocusOutEvent *) xi_event; + + any = x_any_window_to_frame (dpyinfo, focusout->event); + x_detect_focus_change (dpyinfo, any, event, &inev.ie); + goto XI_OTHER; + } case XI_Enter: + { + XIEnterEvent *enter = (XIEnterEvent *) xi_event; + XMotionEvent ev; - any = x_top_window_to_frame (dpyinfo, enter->event); - ev.x = lrint (enter->event_x); - ev.y = lrint (enter->event_y); - ev.window = enter->event; - x_display_set_last_user_time (dpyinfo, xi_event->time); - - /* There is no need to handle entry/exit events for - passive focus from non-top windows at all, since they - are an inferiors of the frame's top window, which will - get virtual events. */ - if (any) - x_detect_focus_change (dpyinfo, any, event, &inev.ie); + any = x_top_window_to_frame (dpyinfo, enter->event); + ev.x = lrint (enter->event_x); + ev.y = lrint (enter->event_y); + ev.window = enter->event; + ev.time = enter->time; - if (!any) - any = x_any_window_to_frame (dpyinfo, enter->event); + x_display_set_last_user_time (dpyinfo, xi_event->time); - xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid, - true); +#ifdef USE_MOTIF + use_copy = true; + + copy.xcrossing.type = EnterNotify; + copy.xcrossing.serial = enter->serial; + copy.xcrossing.send_event = enter->send_event; + copy.xcrossing.display = dpyinfo->display; + copy.xcrossing.window = enter->event; + copy.xcrossing.root = enter->root; + copy.xcrossing.subwindow = enter->child; + copy.xcrossing.time = enter->time; + copy.xcrossing.x = lrint (enter->event_x); + copy.xcrossing.y = lrint (enter->event_y); + copy.xcrossing.x_root = lrint (enter->root_x); + copy.xcrossing.y_root = lrint (enter->root_y); + copy.xcrossing.mode = enter->mode; + copy.xcrossing.detail = enter->detail; + copy.xcrossing.focus = enter->focus; + copy.xcrossing.state = 0; + copy.xcrossing.same_screen = True; +#endif + + /* There is no need to handle entry/exit events for + passive focus from non-top windows at all, since they + are an inferiors of the frame's top window, which will + get virtual events. */ + if (any) + x_detect_focus_change (dpyinfo, any, event, &inev.ie); - { + if (!any) + any = x_any_window_to_frame (dpyinfo, enter->event); + +#ifdef HAVE_XINPUT2_1 + xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid, + true); +#endif + + { #ifdef HAVE_XWIDGETS - struct xwidget_view *xwidget_view = xwidget_view_from_window (enter->event); + struct xwidget_view *xwidget_view = xwidget_view_from_window (enter->event); #endif #ifdef HAVE_XWIDGETS - if (xwidget_view) - { - xwidget_motion_or_crossing (xwidget_view, event); + if (xwidget_view) + { + xwidget_motion_or_crossing (xwidget_view, event); - goto XI_OTHER; - } + goto XI_OTHER; + } #endif - } + } - f = any; + f = any; - if (f && x_mouse_click_focus_ignore_position) - ignore_next_mouse_click_timeout = xi_event->time + 200; + if (f && x_mouse_click_focus_ignore_position) + ignore_next_mouse_click_timeout = xi_event->time + 200; - /* EnterNotify counts as mouse movement, - so update things that depend on mouse position. */ - if (f && !f->output_data.x->hourglass_p) - x_note_mouse_movement (f, &ev); + /* EnterNotify counts as mouse movement, + so update things that depend on mouse position. */ + if (f && !f->output_data.x->hourglass_p) + x_note_mouse_movement (f, &ev); #ifdef USE_GTK - /* We may get an EnterNotify on the buttons in the toolbar. In that - case we moved out of any highlighted area and need to note this. */ - if (!f && dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); + /* We may get an EnterNotify on the buttons in the toolbar. In that + case we moved out of any highlighted area and need to note this. */ + if (!f && dpyinfo->last_mouse_glyph_frame) + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); #endif - goto XI_OTHER; + goto XI_OTHER; + } case XI_Leave: - ev.x = lrint (leave->event_x); - ev.y = lrint (leave->event_y); - ev.window = leave->event; - any = x_top_window_to_frame (dpyinfo, leave->event); + { + XILeaveEvent *leave = (XILeaveEvent *) xi_event; +#ifdef USE_GTK + XMotionEvent ev; - /* This allows us to catch LeaveNotify events generated by - popup menu grabs. FIXME: this is right when there is a - focus menu, but implicit focus tracking can get screwed - up if we get this and no XI_Enter event later. */ + ev.x = lrint (leave->event_x); + ev.y = lrint (leave->event_y); + ev.window = leave->event; + ev.time = leave->time; +#endif + + any = x_top_window_to_frame (dpyinfo, leave->event); + + /* This allows us to catch LeaveNotify events generated by + popup menu grabs. FIXME: this is right when there is a + focus menu, but implicit focus tracking can get screwed + up if we get this and no XI_Enter event later. */ #ifdef USE_X_TOOLKIT - if (popup_activated () - && leave->mode == XINotifyPassiveUngrab) - any = x_any_window_to_frame (dpyinfo, leave->event); -#endif - - /* One problem behind the design of XInput 2 scrolling is - that valuators are not unique to each window, but only - the window that has grabbed the valuator's device or - the window that the device's pointer is on top of can - receive motion events. There is also no way to - retrieve the value of a valuator outside of each motion - event. - - As such, to prevent wildly inaccurate results when the - valuators have changed outside Emacs, we reset our - records of each valuator's value whenever the pointer - moves out of a frame (and not into one of its - children, which we know about). */ - if (leave->detail != XINotifyInferior && any) - xi_reset_scroll_valuators_for_device_id (dpyinfo, - enter->deviceid, false); + if (popup_activated () + && leave->mode == XINotifyPassiveUngrab) + any = x_any_window_to_frame (dpyinfo, leave->event); +#endif + +#ifdef USE_MOTIF + use_copy = true; + + copy.xcrossing.type = LeaveNotify; + copy.xcrossing.serial = leave->serial; + copy.xcrossing.send_event = leave->send_event; + copy.xcrossing.display = dpyinfo->display; + copy.xcrossing.window = leave->event; + copy.xcrossing.root = leave->root; + copy.xcrossing.subwindow = leave->child; + copy.xcrossing.time = leave->time; + copy.xcrossing.x = lrint (leave->event_x); + copy.xcrossing.y = lrint (leave->event_y); + copy.xcrossing.x_root = lrint (leave->root_x); + copy.xcrossing.y_root = lrint (leave->root_y); + copy.xcrossing.mode = leave->mode; + copy.xcrossing.detail = leave->detail; + copy.xcrossing.focus = leave->focus; + copy.xcrossing.state = 0; + copy.xcrossing.same_screen = True; +#endif + + /* One problem behind the design of XInput 2 scrolling is + that valuators are not unique to each window, but only + the window that has grabbed the valuator's device or + the window that the device's pointer is on top of can + receive motion events. There is also no way to + retrieve the value of a valuator outside of each motion + event. + + As such, to prevent wildly inaccurate results when the + valuators have changed outside Emacs, we reset our + records of each valuator's value whenever the pointer + moves out of a frame (and not into one of its + children, which we know about). */ +#ifdef HAVE_XINPUT2_1 + if (leave->detail != XINotifyInferior && any) + xi_reset_scroll_valuators_for_device_id (dpyinfo, + leave->deviceid, false); +#endif + + x_display_set_last_user_time (dpyinfo, xi_event->time); #ifdef HAVE_XWIDGETS - { - struct xwidget_view *xvw - = xwidget_view_from_window (leave->event); + { + struct xwidget_view *xvw + = xwidget_view_from_window (leave->event); - if (xvw) - { - *finish = X_EVENT_DROP; - xwidget_motion_or_crossing (xvw, event); + if (xvw) + { + *finish = X_EVENT_DROP; + xwidget_motion_or_crossing (xvw, event); - goto XI_OTHER; - } - } + goto XI_OTHER; + } + } #endif - x_display_set_last_user_time (dpyinfo, xi_event->time); - - if (any) - x_detect_focus_change (dpyinfo, any, event, &inev.ie); + if (any) + x_detect_focus_change (dpyinfo, any, event, &inev.ie); #ifndef USE_X_TOOLKIT - f = x_top_window_to_frame (dpyinfo, leave->event); + f = x_top_window_to_frame (dpyinfo, leave->event); #else - /* On Xt builds that have XI2, the enter and leave event - masks are set on the frame widget's window. */ - f = x_window_to_frame (dpyinfo, leave->event); + /* On Xt builds that have XI2, the enter and leave event + masks are set on the frame widget's window. */ + f = x_window_to_frame (dpyinfo, leave->event); - if (!f) - f = x_top_window_to_frame (dpyinfo, leave->event); + if (!f) + f = x_top_window_to_frame (dpyinfo, leave->event); #endif - if (f) - { - if (f == hlinfo->mouse_face_mouse_frame) - { - /* If we move outside the frame, then we're - certainly no longer on any text in the frame. */ - clear_mouse_face (hlinfo); - hlinfo->mouse_face_mouse_frame = 0; - } + if (f) + { + if (f == hlinfo->mouse_face_mouse_frame) + { + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); + hlinfo->mouse_face_mouse_frame = 0; + } - /* Generate a nil HELP_EVENT to cancel a help-echo. - Do it only if there's something to cancel. - Otherwise, the startup message is cleared when - the mouse leaves the frame. */ - if (any_help_event_p) - do_help = -1; - } + /* Generate a nil HELP_EVENT to cancel a help-echo. + Do it only if there's something to cancel. + Otherwise, the startup message is cleared when + the mouse leaves the frame. */ + if (any_help_event_p) + do_help = -1; + } #ifdef USE_GTK - /* See comment in EnterNotify above */ - else if (dpyinfo->last_mouse_glyph_frame) - x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); + /* See comment in EnterNotify above */ + else if (dpyinfo->last_mouse_glyph_frame) + x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); #endif - goto XI_OTHER; + goto XI_OTHER; + } case XI_Motion: { struct xi_device_t *device; +#ifdef HAVE_XINPUT2_1 + XIValuatorState *states; + double *values; + bool found_valuator = false; +#endif + /* A fake XMotionEvent for x_note_mouse_movement. */ + XMotionEvent ev; +#ifdef HAVE_XINPUT2_1 states = &xev->valuators; values = states->values; +#endif + device = xi_device_from_id (dpyinfo, xev->deviceid); if (!device) @@ -11166,6 +12655,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; #endif + Window dummy; + +#ifdef HAVE_XINPUT2_1 #ifdef HAVE_XWIDGETS struct xwidget_view *xv = xwidget_view_from_window (xev->event); double xv_total_x = 0.0; @@ -11174,6 +12666,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, double total_x = 0.0; double total_y = 0.0; + int real_x, real_y; + for (int i = 0; i < states->mask_len * 8; i++) { if (XIMaskIsSet (states->mask, i)) @@ -11183,7 +12677,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, int scroll_height; Lisp_Object window; - /* See the comment on top of x_init_master_valuators for more details on how scroll wheel movement is reported on XInput 2. */ @@ -11198,7 +12691,36 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = x_any_window_to_frame (dpyinfo, xev->event); if (!f) - goto XI_OTHER; + { +#if defined USE_MOTIF || !defined USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (xi_event->display, + xev->event, 2); + + if (bar) + f = WINDOW_XFRAME (XWINDOW (bar->window)); + + if (!f) +#endif + goto XI_OTHER; + } + } + +#ifdef USE_GTK + if (f && xg_event_is_for_scrollbar (f, event, true)) + *finish = X_EVENT_DROP; +#endif + + if (FRAME_X_WINDOW (f) != xev->event) + XTranslateCoordinates (dpyinfo->display, + xev->event, FRAME_X_WINDOW (f), + lrint (xev->event_x), + lrint (xev->event_y), + &real_x, &real_y, &dummy); + else + { + real_x = lrint (xev->event_x); + real_y = lrint (xev->event_y); } #ifdef HAVE_XWIDGETS @@ -11227,8 +12749,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, && (fabs (delta) > 0)) continue; - window = window_from_coordinates (f, xev->event_x, - xev->event_y, NULL, + window = window_from_coordinates (f, real_x, real_y, NULL, false, false); if (WINDOWP (window)) @@ -11245,9 +12766,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, scroll_unit *= XFLOATINT (Vx_scroll_event_delta_factor); if (val->horizontal) - total_x += delta * scroll_unit; + total_x += val->emacs_value * scroll_unit; else - total_y += delta * scroll_unit; + total_y += val->emacs_value * scroll_unit; found_valuator = true; val->emacs_value = 0; @@ -11259,6 +12780,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (xv) { uint state = xev->mods.effective; + x_display_set_last_user_time (dpyinfo, xev->time); if (xev->buttons.mask_len) { @@ -11287,14 +12809,30 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif if (found_valuator) { + x_display_set_last_user_time (dpyinfo, xev->time); + +#if defined USE_GTK && !defined HAVE_GTK3 + /* Unlike on Motif, we can't select for XI + events on the scroll bar window under GTK+ 2. + So instead of that, just ignore XI wheel + events which land on a scroll bar. + + Here we assume anything which isn't the edit + widget window is a scroll bar. */ + + if (xev->child != None + && xev->child != FRAME_X_WINDOW (f)) + goto OTHER; +#endif + if (fabs (total_x) > 0 || fabs (total_y) > 0) { inev.ie.kind = (fabs (total_y) >= fabs (total_x) ? WHEEL_EVENT : HORIZ_WHEEL_EVENT); inev.ie.timestamp = xev->time; - XSETINT (inev.ie.x, lrint (xev->event_x)); - XSETINT (inev.ie.y, lrint (xev->event_y)); + XSETINT (inev.ie.x, lrint (real_x)); + XSETINT (inev.ie.y, lrint (real_y)); XSETFRAME (inev.ie.frame_or_window, f); inev.ie.modifiers = (signbit (fabs (total_y) >= fabs (total_x) @@ -11306,19 +12844,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, inev.ie.arg = list3 (Qnil, make_float (total_x), make_float (total_y)); - -#ifdef USE_GTK - if (f && xg_event_is_for_scrollbar (f, event)) - *finish = X_EVENT_DROP; -#endif } else { inev.ie.kind = TOUCH_END_EVENT; inev.ie.timestamp = xev->time; - XSETINT (inev.ie.x, lrint (xev->event_x)); - XSETINT (inev.ie.y, lrint (xev->event_y)); + XSETINT (inev.ie.x, lrint (real_x)); + XSETINT (inev.ie.y, lrint (real_y)); XSETFRAME (inev.ie.frame_or_window, f); } @@ -11327,12 +12860,44 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_XWIDGETS } #endif +#endif /* HAVE_XINPUT2_1 */ ev.x = lrint (xev->event_x); ev.y = lrint (xev->event_y); ev.window = xev->event; ev.time = xev->time; +#ifdef USE_MOTIF + use_copy = true; + + copy.xmotion.type = MotionNotify; + copy.xmotion.serial = xev->serial; + copy.xmotion.send_event = xev->send_event; + copy.xmotion.display = dpyinfo->display; + copy.xmotion.window = xev->event; + copy.xmotion.root = xev->root; + copy.xmotion.subwindow = xev->child; + copy.xmotion.time = xev->time; + copy.xmotion.x = lrint (xev->event_x); + copy.xmotion.y = lrint (xev->event_y); + copy.xmotion.x_root = lrint (xev->root_x); + copy.xmotion.y_root = lrint (xev->root_y); + copy.xmotion.state = 0; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xmotion.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xmotion.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xmotion.state |= Button3Mask; + } + + copy.xmotion.is_hint = False; + copy.xmotion.same_screen = True; +#endif + previous_help_echo_string = help_echo_string; help_echo_string = Qnil; @@ -11342,14 +12907,71 @@ handle_one_xevent (struct x_display_info *dpyinfo, clear_mouse_face (hlinfo); } + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) + { + Window target; + int target_proto; + + target = x_dnd_get_target_window (dpyinfo, + xev->root_x, + xev->root_y, + &target_proto); + + if (target != x_dnd_last_seen_window) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1 + && x_dnd_last_seen_window != FRAME_X_WINDOW (x_dnd_frame)) + x_dnd_send_leave (x_dnd_frame, x_dnd_last_seen_window); + + if (x_dnd_last_seen_window == FRAME_X_WINDOW (x_dnd_frame) + && x_dnd_return_frame == 1) + x_dnd_return_frame = 2; + + if (x_dnd_return_frame == 2 + && x_any_window_to_frame (dpyinfo, target)) + { + x_dnd_in_progress = false; + x_dnd_return_frame_object + = x_any_window_to_frame (dpyinfo, target); + x_dnd_return_frame = 3; + } + + x_dnd_last_seen_window = target; + x_dnd_last_protocol_version = target_proto; + + if (target != None && x_dnd_last_protocol_version != -1) + x_dnd_send_enter (x_dnd_frame, target, + x_dnd_last_protocol_version); + } + + if (x_dnd_last_protocol_version != -1 && target != None) + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + xev->root_x, xev->root_y, + x_dnd_selection_timestamp, + dpyinfo->Xatom_XdndActionCopy); + + goto XI_OTHER; + } + f = mouse_or_wdesc_frame (dpyinfo, xev->event); #ifdef USE_GTK - if (f && xg_event_is_for_scrollbar (f, event)) + if (f && xg_event_is_for_scrollbar (f, event, false)) f = 0; #endif if (f) { + if (xev->event != FRAME_X_WINDOW (f)) + { + XTranslateCoordinates (FRAME_X_DISPLAY (f), + xev->event, FRAME_X_WINDOW (f), + ev.x, ev.y, &ev.x, &ev.y, &dummy); + ev.window = FRAME_X_WINDOW (f); + } + /* Maybe generate a SELECT_WINDOW_EVENT for `mouse-autoselect-window' but don't let popup menus interfere with this (Bug#1261). */ @@ -11427,17 +13049,126 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_XWIDGETS struct xwidget_view *xvw; #endif + /* A fake XButtonEvent for x_construct_mouse_click. */ + XButtonEvent bv; + bool dnd_grab = false; + + for (int i = 0; i < xev->buttons.mask_len * 8; ++i) + { + if (i != xev->detail && XIMaskIsSet (xev->buttons.mask, i)) + dnd_grab = true; + } + + if (x_dnd_in_progress + && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame) + && !dnd_grab + && xev->evtype == XI_ButtonRelease) + { + x_dnd_in_progress = false; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + + x_dnd_last_protocol_version = -1; + x_dnd_last_seen_window = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); + + goto XI_OTHER; + } + + if (x_dnd_in_progress) + goto XI_OTHER; + +#ifdef USE_MOTIF +#ifdef USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (dpyinfo->display, + xev->event, 2); +#endif + + use_copy = true; + copy.xbutton.type = (xev->evtype == XI_ButtonPress + ? ButtonPress : ButtonRelease); + copy.xbutton.serial = xev->serial; + copy.xbutton.send_event = xev->send_event; + copy.xbutton.display = dpyinfo->display; + copy.xbutton.window = xev->event; + copy.xbutton.root = xev->root; + copy.xbutton.subwindow = xev->child; + copy.xbutton.time = xev->time; + copy.xbutton.x = lrint (xev->event_x); + copy.xbutton.y = lrint (xev->event_y); + copy.xbutton.x_root = lrint (xev->root_x); + copy.xbutton.y_root = lrint (xev->root_y); + copy.xbutton.state = xev->mods.effective; + copy.xbutton.button = xev->detail; + copy.xbutton.same_screen = True; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xbutton.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xbutton.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xbutton.state |= Button3Mask; + } +#elif defined USE_GTK && !defined HAVE_GTK3 + copy = gdk_event_new (xev->evtype == XI_ButtonPress + ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE); + + copy->button.window = gdk_x11_window_lookup_for_display (gdpy, xev->event); + copy->button.send_event = xev->send_event; + copy->button.time = xev->time; + copy->button.x = xev->event_x; + copy->button.y = xev->event_y; + copy->button.x_root = xev->root_x; + copy->button.y_root = xev->root_y; + copy->button.state = xev->mods.effective; + copy->button.button = xev->detail; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy->button.state |= GDK_BUTTON1_MASK; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy->button.state |= GDK_BUTTON2_MASK; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy->button.state |= GDK_BUTTON3_MASK; + } + + if (!copy->button.window) + emacs_abort (); + + g_object_ref (copy->button.window); + + if (popup_activated () + && xev->evtype == XI_ButtonRelease) + goto XI_OTHER; +#endif -#ifdef XIPointerEmulated +#ifdef HAVE_XINPUT2_1 /* Ignore emulated scroll events when XI2 native scroll events are present. */ if (xev->flags & XIPointerEmulated) { +#if !defined USE_MOTIF || !defined USE_TOOLKIT_SCROLL_BARS *finish = X_EVENT_DROP; +#else + if (bar) + *finish = X_EVENT_DROP; +#endif goto XI_OTHER; } #endif + if (xev->evtype == XI_ButtonPress) + x_display_set_last_user_time (dpyinfo, xev->time); + #ifdef HAVE_XWIDGETS xvw = xwidget_view_from_window (xev->event); if (xvw) @@ -11472,9 +13203,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, dpyinfo->last_mouse_glyph_frame = NULL; - if (xev->evtype == XI_ButtonPress) - x_display_set_last_user_time (dpyinfo, xev->time); - f = mouse_or_wdesc_frame (dpyinfo, xev->event); if (f && xev->evtype == XI_ButtonPress @@ -11500,7 +13228,49 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #ifdef USE_GTK - if (f && xg_event_is_for_scrollbar (f, event)) + if (!f) + { + int real_x = lrint (xev->event_x); + int real_y = lrint (xev->event_y); + Window child; + + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (xev->detail > 3 && xev->detail < 9 && f) + { + if (xev->evtype == XI_ButtonRelease) + { + if (FRAME_X_WINDOW (f) != xev->event) + XTranslateCoordinates (dpyinfo->display, xev->event, + FRAME_X_WINDOW (f), real_x, + real_y, &real_x, &real_y, &child); + + if (xev->detail <= 5) + inev.ie.kind = WHEEL_EVENT; + else + inev.ie.kind = HORIZ_WHEEL_EVENT; + + inev.ie.timestamp = xev->time; + + XSETINT (inev.ie.x, real_x); + XSETINT (inev.ie.y, real_y); + XSETFRAME (inev.ie.frame_or_window, f); + + inev.ie.modifiers + |= x_x_to_emacs_modifiers (dpyinfo, + xev->mods.effective); + + inev.ie.modifiers |= xev->detail % 2 ? down_modifier : up_modifier; + } + + *finish = X_EVENT_DROP; + goto XI_OTHER; + } + else + f = NULL; + } + + if (f && xg_event_is_for_scrollbar (f, event, false)) f = 0; #endif @@ -11593,6 +13363,25 @@ handle_one_xevent (struct x_display_info *dpyinfo, xembed_send_message (f, xev->time, XEMBED_REQUEST_FOCUS, 0, 0, 0); } + else + { + struct scroll_bar *bar + = x_window_to_scroll_bar (dpyinfo->display, + xev->event, 2); + +#ifndef USE_TOOLKIT_SCROLL_BARS + if (bar) + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); +#else + /* Make the "Ctrl-Mouse-2 splits window" work for toolkit + scroll bars. */ + if (bar && xev->mods.effective & ControlMask) + { + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); + *finish = X_EVENT_DROP; + } +#endif + } if (xev->evtype == XI_ButtonPress) { @@ -11685,6 +13474,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, xkey.time = xev->time; xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) | (xev->group.effective << 13)); + + /* Some input methods react differently depending on the + buttons that are pressed. */ + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + xkey.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + xkey.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + xkey.state |= Button3Mask; + } + xkey.keycode = xev->detail; xkey.same_screen = True; @@ -11732,7 +13534,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { for (i = 0; i < 8 * dpyinfo->modmap->max_keypermod; i++) { - if (xkey.keycode == dpyinfo->modmap->modifiermap[xev->detail]) + if (xev->detail == dpyinfo->modmap->modifiermap[i]) goto xi_done_keysym; } } @@ -11955,6 +13757,30 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef XK_dead_abovedot || keysym == XK_dead_abovedot #endif +#ifdef XK_dead_abovering + || keysym == XK_dead_abovering +#endif +#ifdef XK_dead_belowdot + || keysym == XK_dead_belowdot +#endif +#ifdef XK_dead_voiced_sound + || keysym == XK_dead_voiced_sound +#endif +#ifdef XK_dead_semivoiced_sound + || keysym == XK_dead_semivoiced_sound +#endif +#ifdef XK_dead_hook + || keysym == XK_dead_hook +#endif +#ifdef XK_dead_horn + || keysym == XK_dead_horn +#endif +#ifdef XK_dead_stroke + || keysym == XK_dead_stroke +#endif +#ifdef XK_dead_abovecomma + || keysym == XK_dead_abovecomma +#endif || IsKeypadKey (keysym) /* 0xff80 <= x < 0xffbe */ || IsFunctionKey (keysym) /* 0xffbe <= x < 0xffe1 */ /* Any "vendor-specific" key is ok. */ @@ -12016,6 +13842,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, xkey.time = xev->time; xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) | (xev->group.effective << 13)); + + /* Some input methods react differently depending on the + buttons that are pressed. */ + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + xkey.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + xkey.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + xkey.state |= Button3Mask; + } + xkey.keycode = xev->detail; xkey.same_screen = True; @@ -12042,8 +13881,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_DeviceChanged: { + XIDeviceChangedEvent *device_changed = (XIDeviceChangedEvent *) xi_event; struct xi_device_t *device; +#ifdef HAVE_XINPUT2_2 struct xi_touch_point_t *tem, *last; +#endif int c; #ifdef HAVE_XINPUT2_1 int i; @@ -12067,11 +13909,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Free data that we will regenerate from new information. */ +#ifdef HAVE_XINPUT2_1 device->valuators = xrealloc (device->valuators, (device_changed->num_classes * sizeof *device->valuators)); device->scroll_valuator_count = 0; +#endif +#ifdef HAVE_XINPUT2_2 device->direct_p = false; +#endif for (c = 0; c < device_changed->num_classes; ++c) { @@ -12141,6 +13987,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif +#ifdef HAVE_XINPUT2_2 /* The device is no longer a DirectTouch device, so remove any touchpoints that we might have recorded. */ @@ -12157,6 +14004,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, device->touchpoints = NULL; } +#endif goto XI_OTHER; } @@ -12370,7 +14218,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, case XI_GesturePinchEnd: { -#if defined HAVE_XWIDGETS && HAVE_USABLE_XI_GESTURE_PINCH_EVENT +#if defined HAVE_XWIDGETS XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event; struct xwidget_view *xvw = xwidget_view_from_window (pev->event); @@ -12387,8 +14235,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, xi_done_keysym: #ifdef HAVE_X_I18N - if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) - xic_set_statusarea (f); + if (f) + { + struct window *w = XWINDOW (f->selected_window); + xic_set_preeditarea (w, w->cursor.x, w->cursor.y); + + if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) + xic_set_statusarea (f); + } #endif if (must_free_data) XFreeEventData (dpyinfo->display, &event->xcookie); @@ -12460,10 +14314,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (event->type != ConfigureNotify || (event->xconfigure.width != 0 && event->xconfigure.height != 0)) - XtDispatchEvent ((XEvent *) event); + { +#if defined USE_MOTIF && defined HAVE_XINPUT2 + XtDispatchEvent (use_copy ? © : (XEvent *) event); +#else + XtDispatchEvent ((XEvent *) event); +#endif + } } unblock_input (); #endif /* USE_X_TOOLKIT */ +#if defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + if (*finish != X_EVENT_DROP && copy) + { + gtk_main_do_event (copy); + *finish = X_EVENT_DROP; + } + + if (copy) + gdk_event_free (copy); +#endif break; } @@ -12498,20 +14368,29 @@ handle_one_xevent (struct x_display_info *dpyinfo, count++; } - /* Sometimes event processing draws to the frame outside redisplay. - To ensure that these changes become visible, draw them here. */ - flush_dirty_back_buffers (); + /* Sometimes event processing draws to either F or ANY outside + redisplay. To ensure that these changes become visible, draw + them here. */ + + if (f) + flush_dirty_back_buffer_on (f); + + if (any && any != f) + flush_dirty_back_buffer_on (any); return count; } -#if defined USE_X_TOOLKIT || defined USE_MOTIF || defined USE_GTK - /* Handles the XEvent EVENT on display DISPLAY. This is used for event loops outside the normal event handling, i.e. looping while a popup menu or a dialog is posted. Returns the value handle_one_xevent sets in the finish argument. */ + +#ifdef USE_GTK +static int +#else int +#endif x_dispatch_event (XEvent *event, Display *display) { struct x_display_info *dpyinfo; @@ -12524,7 +14403,6 @@ x_dispatch_event (XEvent *event, Display *display) return finish; } -#endif /* Read events coming from the X server. Return as soon as there are no more events to be read. @@ -12969,11 +14847,19 @@ x_bitmap_icon (struct frame *f, Lisp_Object file) } #elif defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) - - rc = x_create_bitmap_from_xpm_data (f, gnu_xpm_bits); - if (rc != -1) - FRAME_DISPLAY_INFO (f)->icon_bitmap_id = rc; - + /* This allocates too many colors. */ + if ((FRAME_X_VISUAL_INFO (f)->class == TrueColor + || FRAME_X_VISUAL_INFO (f)->class == StaticColor + || FRAME_X_VISUAL_INFO (f)->class == StaticGray) + /* That pixmap needs about 240 colors, and we should + also leave some more space for other colors as + well. */ + || FRAME_X_VISUAL_INFO (f)->colormap_size >= (240 * 4)) + { + rc = x_create_bitmap_from_xpm_data (f, gnu_xpm_bits); + if (rc != -1) + FRAME_DISPLAY_INFO (f)->icon_bitmap_id = rc; + } #endif /* If all else fails, use the (black and white) xbm image. */ @@ -13961,6 +15847,18 @@ x_set_sticky (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) dpyinfo->Xatom_net_wm_state_sticky, None); } +void +x_set_shaded (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +{ + Lisp_Object frame; + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + + XSETFRAME (frame, f); + + set_wm_state (frame, !NILP (new_value), + dpyinfo->Xatom_net_wm_state_shaded, None); +} + /** * x_set_skip_taskbar: * @@ -14061,7 +15959,8 @@ static bool x_get_current_wm_state (struct frame *f, Window window, int *size_state, - bool *sticky) + bool *sticky, + bool *shaded) { unsigned long actual_size; int i; @@ -14085,6 +15984,7 @@ x_get_current_wm_state (struct frame *f, *sticky = false; *size_state = FULLSCREEN_NONE; + *shaded = false; block_input (); @@ -14146,6 +16046,8 @@ x_get_current_wm_state (struct frame *f, *size_state = FULLSCREEN_BOTH; else if (a == dpyinfo->Xatom_net_wm_state_sticky) *sticky = true; + else if (a == dpyinfo->Xatom_net_wm_state_shaded) + *shaded = true; } #ifdef USE_XCB @@ -14168,7 +16070,7 @@ do_ewmh_fullscreen (struct frame *f) int cur; bool dummy; - x_get_current_wm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy); + x_get_current_wm_state (f, FRAME_OUTER_WINDOW (f), &cur, &dummy, &dummy); /* Some window managers don't say they support _NET_WM_STATE, but they do say they support _NET_WM_STATE_FULLSCREEN. Try that also. */ @@ -14308,8 +16210,10 @@ x_handle_net_wm_state (struct frame *f, const XPropertyEvent *event) { int value = FULLSCREEN_NONE; Lisp_Object lval; - bool sticky = false; - bool not_hidden = x_get_current_wm_state (f, event->window, &value, &sticky); + bool sticky = false, shaded = false; + bool not_hidden = x_get_current_wm_state (f, event->window, + &value, &sticky, + &shaded); lval = Qnil; switch (value) @@ -14330,6 +16234,7 @@ x_handle_net_wm_state (struct frame *f, const XPropertyEvent *event) store_frame_param (f, Qfullscreen, lval); store_frame_param (f, Qsticky, sticky ? Qt : Qnil); + store_frame_param (f, Qshaded, shaded ? Qt : Qnil); return not_hidden; } @@ -15264,6 +17169,16 @@ x_free_frame_resources (struct frame *f) struct scroll_bar *b; #endif + if (x_dnd_in_progress && f == x_dnd_frame) + { + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (f, x_dnd_last_seen_window); + + x_dnd_in_progress = false; + x_dnd_frame = NULL; + } + block_input (); /* If a display connection is dead, don't try sending more @@ -15419,6 +17334,14 @@ x_free_frame_resources (struct frame *f) XFlush (FRAME_X_DISPLAY (f)); } +#ifdef HAVE_GTK3 + if (FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider) + g_object_unref (FRAME_OUTPUT_DATA (f)->scrollbar_background_css_provider); + + if (FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider) + g_object_unref (FRAME_OUTPUT_DATA (f)->scrollbar_foreground_css_provider); +#endif + xfree (f->output_data.x->saved_menu_event); xfree (f->output_data.x); f->output_data.x = NULL; @@ -15467,6 +17390,9 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) { XSizeHints size_hints; Window window = FRAME_OUTER_WINDOW (f); +#ifdef USE_X_TOOLKIT + WMShellWidget shell; +#endif if (!window) return; @@ -15474,8 +17400,63 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) #ifdef USE_X_TOOLKIT if (f->output_data.x->widget) { + /* Do this dance in xterm.c because some stuff is not as easily + available in widget.c. */ + + eassert (XtIsWMShell (f->output_data.x->widget)); + shell = (WMShellWidget) f->output_data.x->widget; + + shell->wm.size_hints.flags &= ~(PPosition | USPosition); + shell->wm.size_hints.flags |= flags & (PPosition | USPosition); + + if (user_position) + { + shell->wm.size_hints.flags &= ~PPosition; + shell->wm.size_hints.flags |= USPosition; + } + widget_update_wm_size_hints (f->output_data.x->widget, f->output_data.x->edit_widget); + +#ifdef USE_MOTIF + /* Do this all over again for the benefit of Motif, which always + knows better than the programmer. */ + shell->wm.size_hints.flags &= ~(PPosition | USPosition); + shell->wm.size_hints.flags |= flags & (PPosition | USPosition); + + if (user_position) + { + shell->wm.size_hints.flags &= ~PPosition; + shell->wm.size_hints.flags |= USPosition; + } + + /* Drill hints into Motif, since it keeps setting its own. */ + size_hints.flags = shell->wm.size_hints.flags; + size_hints.x = shell->wm.size_hints.x; + size_hints.y = shell->wm.size_hints.y; + size_hints.width = shell->wm.size_hints.width; + size_hints.height = shell->wm.size_hints.height; + size_hints.min_width = shell->wm.size_hints.min_width; + size_hints.min_height = shell->wm.size_hints.min_height; + size_hints.max_width = shell->wm.size_hints.max_width; + size_hints.max_height = shell->wm.size_hints.max_height; + size_hints.width_inc = shell->wm.size_hints.width_inc; + size_hints.height_inc = shell->wm.size_hints.height_inc; + size_hints.min_aspect.x = shell->wm.size_hints.min_aspect.x; + size_hints.min_aspect.y = shell->wm.size_hints.min_aspect.y; + size_hints.max_aspect.x = shell->wm.size_hints.max_aspect.x; + size_hints.max_aspect.y = shell->wm.size_hints.max_aspect.y; +#ifdef HAVE_X11XTR6 + size_hints.base_width = shell->wm.base_width; + size_hints.base_height = shell->wm.base_height; + size_hints.win_gravity = shell->wm.win_gravity; +#endif + + XSetWMNormalHints (XtDisplay (f->output_data.x->widget), + XtWindow (f->output_data.x->widget), + &size_hints); +#endif + return; } #endif @@ -16270,7 +18251,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) /* See if a private colormap is requested. */ if (dpyinfo->visual == DefaultVisualOfScreen (dpyinfo->screen)) { - if (dpyinfo->visual->class == PseudoColor) + if (dpyinfo->visual_info.class == PseudoColor) { AUTO_STRING (privateColormap, "privateColormap"); AUTO_STRING (PrivateColormap, "PrivateColormap"); @@ -16288,13 +18269,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->visual, AllocNone); /* See if we can construct pixel values from RGB values. */ - if (dpyinfo->visual->class == TrueColor) + if (dpyinfo->visual_info.class == TrueColor) { - get_bits_and_offset (dpyinfo->visual->red_mask, + get_bits_and_offset (dpyinfo->visual_info.red_mask, &dpyinfo->red_bits, &dpyinfo->red_offset); - get_bits_and_offset (dpyinfo->visual->blue_mask, + get_bits_and_offset (dpyinfo->visual_info.blue_mask, &dpyinfo->blue_bits, &dpyinfo->blue_offset); - get_bits_and_offset (dpyinfo->visual->green_mask, + get_bits_and_offset (dpyinfo->visual_info.green_mask, &dpyinfo->green_bits, &dpyinfo->green_offset); #ifdef HAVE_XRENDER @@ -16321,9 +18302,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) if (XAllocColor (dpyinfo->display, dpyinfo->cmap, &xc) != 0) { - alpha_mask = xc.pixel & ~(dpyinfo->visual->red_mask - | dpyinfo->visual->blue_mask - | dpyinfo->visual->green_mask); + alpha_mask = xc.pixel & ~(dpyinfo->visual_info.red_mask + | dpyinfo->visual_info.blue_mask + | dpyinfo->visual_info.green_mask); if (alpha_mask) get_bits_and_offset (alpha_mask, &dpyinfo->alpha_bits, @@ -16398,32 +18379,74 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) &xi_first_error)) { #ifdef HAVE_GTK3 - /* Catch errors caused by GTK requesting a different version of - XInput 2 than what Emacs was built with. */ - x_catch_errors (dpyinfo->display); + bool move_backwards = false; + int original_minor = minor; query: + + /* Catch errors caused by GTK requesting a different version of + XInput 2 than what Emacs was built with. Usually, the X + server tolerates these mistakes, but a BadValue error can + result if only one of GTK or Emacs wasn't built with support + for XInput 2.2. + + To work around the first, it suffices to increase the minor + version until the X server is happy if the XIQueryVersion + request results in an error. If that doesn't work, however, + then it's the latter, so decrease the minor until the version + that GTK requested is found. */ #endif + x_catch_errors (dpyinfo->display); + rc = XIQueryVersion (dpyinfo->display, &major, &minor); #ifdef HAVE_GTK3 + /* Increase the minor version until we find one the X + server agrees with. If that didn't work, then + decrease the version until it either hits zero or + becomes agreeable to the X server. */ + if (x_had_errors_p (dpyinfo->display)) { - /* Some unreasonable value that will probably not be - exceeded in the future. */ - if (minor > 100) - rc = BadRequest; + x_uncatch_errors_after_check (); + + /* Since BadValue errors can't be generated if both the + prior and current requests specify a version of 2.2 or + later, this means the prior request specified a version + of the input extension less than 2.2. */ + if (minor >= 2) + { + move_backwards = true; + minor = original_minor; + + if (--minor < 0) + rc = BadRequest; + else + goto query; + } else { - /* Increase the minor version until we find one the X server - agrees with. */ - minor++; - goto query; + if (!move_backwards) + { + minor++; + goto query; + } + + if (--minor < 0) + rc = BadRequest; + else + goto query; + } } + else + x_uncatch_errors_after_check (); +#else + if (x_had_errors_p (dpyinfo->display)) + rc = BadRequest; - x_uncatch_errors (); + x_uncatch_errors_after_check (); #endif if (rc == Success) @@ -16432,6 +18455,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) x_init_master_valuators (dpyinfo); } } + dpyinfo->xi2_version = minor; #endif @@ -16552,6 +18576,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("MULTIPLE", Xatom_MULTIPLE) ATOM_REFS_INIT ("INCR", Xatom_INCR) ATOM_REFS_INIT ("_EMACS_TMP_", Xatom_EMACS_TMP) + ATOM_REFS_INIT ("EMACS_SERVER_TIME_PROP", Xatom_EMACS_SERVER_TIME_PROP) ATOM_REFS_INIT ("TARGETS", Xatom_TARGETS) ATOM_REFS_INIT ("NULL", Xatom_NULL) ATOM_REFS_INIT ("ATOM", Xatom_ATOM) @@ -16579,6 +18604,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("_NET_WM_STATE_MAXIMIZED_VERT", Xatom_net_wm_state_maximized_vert) ATOM_REFS_INIT ("_NET_WM_STATE_STICKY", Xatom_net_wm_state_sticky) + ATOM_REFS_INIT ("_NET_WM_STATE_SHADED", Xatom_net_wm_state_shaded) ATOM_REFS_INIT ("_NET_WM_STATE_HIDDEN", Xatom_net_wm_state_hidden) ATOM_REFS_INIT ("_NET_WM_WINDOW_TYPE", Xatom_net_window_type) ATOM_REFS_INIT ("_NET_WM_WINDOW_TYPE_TOOLTIP", @@ -16613,6 +18639,24 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("ShiftLock", Xatom_ShiftLock) ATOM_REFS_INIT ("Alt", Xatom_Alt) #endif + /* DND source. */ + ATOM_REFS_INIT ("XdndAware", Xatom_XdndAware) + ATOM_REFS_INIT ("XdndSelection", Xatom_XdndSelection) + ATOM_REFS_INIT ("XdndTypeList", Xatom_XdndTypeList) + ATOM_REFS_INIT ("XdndActionCopy", Xatom_XdndActionCopy) + ATOM_REFS_INIT ("XdndActionMove", Xatom_XdndActionMove) + ATOM_REFS_INIT ("XdndActionLink", Xatom_XdndActionLink) + ATOM_REFS_INIT ("XdndActionAsk", Xatom_XdndActionAsk) + ATOM_REFS_INIT ("XdndActionPrivate", Xatom_XdndActionPrivate) + ATOM_REFS_INIT ("XdndActionList", Xatom_XdndActionList) + ATOM_REFS_INIT ("XdndActionDescription", Xatom_XdndActionDescription) + ATOM_REFS_INIT ("XdndProxy", Xatom_XdndProxy) + ATOM_REFS_INIT ("XdndEnter", Xatom_XdndEnter) + ATOM_REFS_INIT ("XdndPosition", Xatom_XdndPosition) + ATOM_REFS_INIT ("XdndStatus", Xatom_XdndStatus) + ATOM_REFS_INIT ("XdndLeave", Xatom_XdndLeave) + ATOM_REFS_INIT ("XdndDrop", Xatom_XdndDrop) + ATOM_REFS_INIT ("XdndFinished", Xatom_XdndFinished) }; int i; @@ -17070,6 +19114,7 @@ x_create_terminal (struct x_display_info *dpyinfo) terminal->free_pixmap = x_free_pixmap; terminal->delete_frame_hook = x_destroy_window; terminal->delete_terminal_hook = x_delete_terminal; + terminal->toolkit_position_hook = x_toolkit_position; /* Other hooks are NULL by default. */ return terminal; @@ -17287,6 +19332,7 @@ With MS Windows, Haiku windowing or Nextstep, the value is t. */); Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier)); DEFSYM (Qsuper, "super"); Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier)); + DEFSYM (QXdndSelection, "XdndSelection"); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which keys Emacs uses for the ctrl modifier. diff --git a/src/xterm.h b/src/xterm.h index 7303565ec2a..9665e92a9fb 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -132,6 +132,7 @@ INLINE_HEADER_BEGIN | FocusChangeMask \ | LeaveWindowMask \ | EnterWindowMask \ + | PropertyChangeMask \ | VisibilityChangeMask) #ifdef HAVE_X11R6_XIM @@ -143,6 +144,21 @@ struct xim_inst_t }; #endif /* HAVE_X11R6_XIM */ +#ifdef HAVE_XINPUT2 +#if HAVE_XISCROLLCLASSINFO_TYPE && defined XIScrollClass +#define HAVE_XINPUT2_1 +#endif +#if HAVE_XITOUCHCLASSINFO_TYPE && defined XITouchClass +#define HAVE_XINPUT2_2 +#endif +#if HAVE_XIBARRIERRELEASEPOINTERINFO_DEVICEID && defined XIBarrierPointerReleased +#define HAVE_XINPUT2_3 +#endif +#if HAVE_XIGESTURECLASSINFO_TYPE && defined XIGestureClass +#define HAVE_XINPUT2_4 +#endif +#endif + /* Structure recording X pixmap and reference count. If REFCOUNT is 0 then this record is free to be reused. */ @@ -185,6 +201,8 @@ struct color_name_cache_entry }; #ifdef HAVE_XINPUT2 + +#ifdef HAVE_XINPUT2_1 struct xi_scroll_valuator_t { bool invalid_p; @@ -196,7 +214,9 @@ struct xi_scroll_valuator_t int number; int horizontal; }; +#endif +#ifdef HAVE_XINPUT2_2 struct xi_touch_point_t { struct xi_touch_point_t *next; @@ -204,17 +224,26 @@ struct xi_touch_point_t int number; double x, y; }; +#endif struct xi_device_t { int device_id; +#ifdef HAVE_XINPUT2_1 int scroll_valuator_count; +#endif int grab; bool master_p; +#ifdef HAVE_XINPUT2_2 bool direct_p; +#endif +#ifdef HAVE_XINPUT2_1 struct xi_scroll_valuator_t *valuators; +#endif +#ifdef HAVE_XINPUT2_2 struct xi_touch_point_t *touchpoints; +#endif }; #endif @@ -254,6 +283,9 @@ struct x_display_info /* The Visual being used for this display. */ Visual *visual; + /* The visual information corresponding to VISUAL. */ + XVisualInfo visual_info; + #ifdef HAVE_XRENDER /* The picture format for this display. */ XRenderPictFormat *pict_format; @@ -379,7 +411,8 @@ struct x_display_info Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE, Xatom_COMPOUND_TEXT, Xatom_UTF8_STRING, Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, - Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER, Xatom_COUNTER; + Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER, Xatom_COUNTER, + Xatom_EMACS_SERVER_TIME_PROP; /* More atoms for font properties. The last three are private properties, see the comments in src/fontset.h. */ @@ -431,8 +464,10 @@ struct x_display_info /* The scroll bar in which the last X motion event occurred. */ struct scroll_bar *last_mouse_scroll_bar; - /* Time of last user interaction as returned in X events on this display. */ - Time last_user_time; + /* Time of last user interaction as returned in X events on this + display, and time where WM support for `_NET_WM_USER_TIME_WINDOW' + was last checked. */ + Time last_user_time, last_user_check_time; /* Position where the mouse was last time we reported a motion. This is a position on last_mouse_motion_frame. */ @@ -508,10 +543,11 @@ struct x_display_info Xatom_net_wm_state_maximized_horz, Xatom_net_wm_state_maximized_vert, Xatom_net_wm_state_sticky, Xatom_net_wm_state_above, Xatom_net_wm_state_below, Xatom_net_wm_state_hidden, Xatom_net_wm_state_skip_taskbar, - Xatom_net_frame_extents, Xatom_net_current_desktop, Xatom_net_workarea, - Xatom_net_wm_opaque_region, Xatom_net_wm_ping, Xatom_net_wm_sync_request, - Xatom_net_wm_sync_request_counter, Xatom_net_wm_frame_drawn, - Xatom_net_wm_user_time, Xatom_net_wm_user_time_window; + Xatom_net_wm_state_shaded, Xatom_net_frame_extents, Xatom_net_current_desktop, + Xatom_net_workarea, Xatom_net_wm_opaque_region, Xatom_net_wm_ping, + Xatom_net_wm_sync_request, Xatom_net_wm_sync_request_counter, + Xatom_net_wm_frame_drawn, Xatom_net_wm_user_time, + Xatom_net_wm_user_time_window; /* XSettings atoms and windows. */ Atom Xatom_xsettings_sel, Xatom_xsettings_prop, Xatom_xsettings_mgr; @@ -525,6 +561,14 @@ struct x_display_info /* SM */ Atom Xatom_SM_CLIENT_ID; + /* DND source. */ + Atom Xatom_XdndAware, Xatom_XdndSelection, Xatom_XdndTypeList, + Xatom_XdndActionCopy, Xatom_XdndActionMove, Xatom_XdndActionLink, + Xatom_XdndActionAsk, Xatom_XdndActionPrivate, Xatom_XdndActionList, + Xatom_XdndActionDescription, Xatom_XdndProxy, Xatom_XdndEnter, + Xatom_XdndPosition, Xatom_XdndStatus, Xatom_XdndLeave, Xatom_XdndDrop, + Xatom_XdndFinished; + #ifdef HAVE_XKB /* Virtual modifiers */ Atom Xatom_Meta, Xatom_Super, Xatom_Hyper, Xatom_ShiftLock, Xatom_Alt; @@ -722,6 +766,13 @@ struct x_output GtkWindow *ttip_window; GtkIMContext *im_context; + +#ifdef HAVE_GTK3 + /* The CSS providers used for scroll bar foreground and background + colors. */ + GtkCssProvider *scrollbar_foreground_css_provider; + GtkCssProvider *scrollbar_background_css_provider; +#endif #endif /* USE_GTK */ /* If >=0, a bitmap index. The indicated bitmap is used for the @@ -998,6 +1049,9 @@ extern void x_mark_frame_dirty (struct frame *f); /* This is the Visual which frame F is on. */ #define FRAME_X_VISUAL(f) FRAME_DISPLAY_INFO (f)->visual +/* And its corresponding visual info. */ +#define FRAME_X_VISUAL_INFO(f) (&FRAME_DISPLAY_INFO (f)->visual_info) + #ifdef HAVE_XRENDER #define FRAME_X_PICTURE_FORMAT(f) FRAME_DISPLAY_INFO (f)->pict_format #define FRAME_X_PICTURE(f) ((f)->output_data.x->picture) @@ -1048,6 +1102,11 @@ struct scroll_bar /* The X window representing this scroll bar. */ Window x_window; +#if defined HAVE_XDBE && !defined USE_TOOLKIT_SCROLL_BARS + /* The X drawable representing this scroll bar. */ + Drawable x_drawable; +#endif + /* The position and size of the scroll bar in pixels, relative to the frame. */ int top, left, width, height; @@ -1276,7 +1335,7 @@ extern void x_clear_area (struct frame *f, int, int, int, int); extern void x_mouse_leave (struct x_display_info *); #endif -#if defined USE_X_TOOLKIT || defined USE_MOTIF +#ifndef USE_GTK extern int x_dispatch_event (XEvent *, Display *); #endif extern int x_x_to_emacs_modifiers (struct x_display_info *, int); @@ -1302,8 +1361,16 @@ extern void x_xr_apply_ext_clip (struct frame *f, GC gc); extern void x_xr_reset_ext_clip (struct frame *f); #endif +#ifdef HAVE_GTK3 +extern void x_scroll_bar_configure (GdkEvent *); +#endif + extern void x_display_set_last_user_time (struct x_display_info *, Time); +extern Lisp_Object x_dnd_begin_drag_and_drop (struct frame *, Time, Atom, + bool); +extern void x_set_dnd_targets (Atom *, int); + INLINE int x_display_pixel_height (struct x_display_info *dpyinfo) { @@ -1337,13 +1404,14 @@ x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) also allows us to make other optimizations relating to server-side reference counts. */ INLINE bool -x_mutable_colormap (Visual *visual) +x_mutable_colormap (XVisualInfo *visual) { int class = visual->class; return (class != StaticColor && class != StaticGray && class != TrueColor); } extern void x_set_sticky (struct frame *, Lisp_Object, Lisp_Object); +extern void x_set_shaded (struct frame *, Lisp_Object, Lisp_Object); extern void x_set_skip_taskbar (struct frame *, Lisp_Object, Lisp_Object); extern void x_set_z_group (struct frame *, Lisp_Object, Lisp_Object); extern bool x_wm_supports (struct frame *, Atom); @@ -1397,6 +1465,9 @@ extern Lisp_Object x_property_data_to_lisp (struct frame *, extern void x_clipboard_manager_save_frame (Lisp_Object); extern void x_clipboard_manager_save_all (void); +extern Lisp_Object x_timestamp_for_selection (struct x_display_info *, + Lisp_Object); + #ifdef USE_GTK extern bool xg_set_icon (struct frame *, Lisp_Object); extern bool xg_set_icon_from_xpm_data (struct frame *, const char **); @@ -1469,21 +1540,6 @@ struct xi_device_t *xi_device_from_id (struct x_display_info *, int); (nr).width = (rwidth), \ (nr).height = (rheight)) -#ifdef HAVE_XINPUT2 -#if HAVE_XISCROLLCLASSINFO_TYPE && defined XIScrollClass -#define HAVE_XINPUT2_1 -#endif -#if HAVE_XITOUCHCLASSINFO_TYPE && defined XITouchClass -#define HAVE_XINPUT2_2 -#endif -#if HAVE_XIBARRIERRELEASEPOINTERINFO_DEVICEID && defined XIBarrierPointerReleased -#define HAVE_XINPUT2_3 -#endif -#if HAVE_XIGESTURECLASSINFO_TYPE && defined XIGestureClass -#define HAVE_XINPUT2_4 -#endif -#endif - INLINE_HEADER_END #endif /* XTERM_H */ diff --git a/src/xwidget.c b/src/xwidget.c index e812b13f23b..71bc3504295 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -1443,7 +1443,7 @@ xwidget_scroll (struct xwidget_view *view, double x, double y, gdk_event_free (xg_event); } -#ifdef HAVE_USABLE_XI_GESTURE_PINCH_EVENT +#ifdef HAVE_XINPUT2_4 void xwidget_pinch (struct xwidget_view *view, XIGesturePinchEvent *xev) { diff --git a/src/xwidget.h b/src/xwidget.h index be1460ede5b..502beb67650 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -223,7 +223,7 @@ extern void xwidget_motion_notify (struct xwidget_view *, double, double, double, double, uint, Time); extern void xwidget_scroll (struct xwidget_view *, double, double, double, double, uint, Time, bool); -#ifdef HAVE_USABLE_XI_GESTURE_PINCH_EVENT +#ifdef HAVE_XINPUT2_4 extern void xwidget_pinch (struct xwidget_view *, XIGesturePinchEvent *); #endif #endif diff --git a/test/Makefile.in b/test/Makefile.in index 708c4b2fb0f..3b6e116e65f 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -49,8 +49,6 @@ SEPCHAR = @SEPCHAR@ HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ -REPLACE_FREE = @REPLACE_FREE@ - -include ${top_builddir}/src/verbose.mk # We never change directory before running Emacs, so a relative file @@ -265,27 +263,29 @@ endif GMP_H = @GMP_H@ LIBGMP = @LIBGMP@ +LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ +LIB_NANOSLEEP = @LIB_NANOSLEEP@ -MODULE_CFLAGS = -I../src -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib \ +MODULE_CFLAGS = $(and $(GMP_H),-I.) -I../src -I$(srcdir)/../src \ $(FPIC_CFLAGS) $(PROFILING_CFLAGS) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS) +gmp.h: + echo '#include "$(srcdir)/../lib/mini-gmp.h"' >$@ + test_module = $(test_module_dir)/mod-test${SO} src/emacs-module-tests.log src/emacs-module-tests.elc: $(test_module) -FREE_SOURCE_0 = -FREE_SOURCE_1 = $(srcdir)/../lib/free.c - # In the compilation command, we can't use any object or archive file # as source because those are not compiled with -fPIC. Therefore we # use only source files. -$(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h +$(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h \ + ../src/config.h $(and $(GMP_H),gmp.h) $(AM_V_CCLD)${MKDIR_P} $(dir $@) $(AM_V_at)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \ -o $@ $< $(LIBGMP) \ - $(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \ - $(FREE_SOURCE_$(REPLACE_FREE)) \ - $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c + $(and $(GMP_H),$(srcdir)/../lib/mini-gmp.c) \ + $(LIB_CLOCK_GETTIME) $(LIB_NANOSLEEP) endif src/emacs-tests.log: ../lib-src/seccomp-filter.c @@ -345,7 +345,7 @@ clean: find . '(' -name '*.xml' -a ! -path '*resources*' ')' $(FIND_DELETE) rm -f ${srcdir}/lisp/gnus/mml-sec-resources/random_seed rm -f $(test_module_dir)/*.o $(test_module_dir)/*.so \ - $(test_module_dir)/*.dll + $(test_module_dir)/*.dll gmp.h bootstrap-clean: clean find $(srcdir) -name '*.elc' $(FIND_DELETE) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 008ec0de4a6..19ede627a13 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -23,6 +23,7 @@ (require 'cl-lib) (require 'cl-macs) +(require 'edebug) (require 'ert) @@ -694,4 +695,36 @@ collection clause." (list cl-macs--test1 cl-macs--test2)) '(1 2)))) +(ert-deftest cl-define-compiler-macro/edebug () + "Check that we can instrument compiler macros." + (with-temp-buffer + (dolist (form '((defun cl-define-compiler-macro/edebug (a b) nil) + (cl-define-compiler-macro + cl-define-compiler-macro/edebug + (&whole w a b) + w))) + (print form (current-buffer))) + (let ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop)) + ;; Just make sure the forms can be instrumented. + (eval-buffer)))) + +(ert-deftest cl-defstruct/edebug () + "Check that we can instrument `cl-defstruct' forms." + (with-temp-buffer + (dolist (form '((cl-defstruct cl-defstruct/edebug/1) + (cl-defstruct (cl-defstruct/edebug/2 + :noinline)) + (cl-defstruct (cl-defstruct/edebug/3 + (:noinline t))) + (cl-defstruct (cl-defstruct/edebug/4 + :named)) + (cl-defstruct (cl-defstruct/edebug/5 + (:named t))))) + (print form (current-buffer))) + (let ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop)) + ;; Just make sure the forms can be instrumented. + (eval-buffer)))) + ;;; cl-macs-tests.el ends here diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index dd12e3764ce..84c28e11315 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -377,8 +377,11 @@ This macro is used to test if macroexpansion in `should' works." (test (make-ert-test :body test-body)) (result (ert-run-test test))) (should (ert-test-failed-p result)) - (should (eq (backtrace-frame-fun (car (ert-test-failed-backtrace result))) - 'signal)))) + (should (memq (backtrace-frame-fun (car (ert-test-failed-backtrace result))) + ;;; This is `ert-fail' on nativecomp and `signal' + ;;; otherwise. It's not clear whether that's a bug + ;;; or not (bug#51308). + '(ert-fail signal))))) (ert-deftest ert-test-messages () :tags '(:causes-redisplay) @@ -595,6 +598,7 @@ This macro is used to test if macroexpansion in `should' works." (should found-complex))))) (ert-deftest ert-test-run-tests-batch-expensive () + :tags (if (getenv "EMACS_EMBA_CI") '(:unstable)) (let* ((complex-list '((:1 (:2 (:3 (:4 (:5 (:6 "abc")))))))) (failing-test-1 (make-ert-test :name 'failing-test-1 diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el index c1c46d6400e..385b0fe44a5 100644 --- a/test/lisp/emacs-lisp/rmc-tests.el +++ b/test/lisp/emacs-lisp/rmc-tests.el @@ -66,5 +66,26 @@ (should (equal (list char str) (read-multiple-choice "Do it? " '((?y "yes") (?n "no")))))))) -(provide 'rmc-tests) +(ert-deftest test-read-multiple-choice-help () + (let ((chars '(?o ?a)) + help) + (cl-letf* (((symbol-function #'read-event) + (lambda () + (message "chars %S" chars) + (when (= 1 (length chars)) + (with-current-buffer "*Multiple Choice Help*" + (setq help (buffer-string)))) + (pop chars)))) + (read-multiple-choice + "Choose:" + '((?a "aaa") + (?b "bbb") + (?c "ccc" "a really long description of ccc"))) + (should (equal help "Choose: + +a: [A]aa b: [B]bb c: [C]cc + a really long + description of ccc + \n"))))) + ;;; rmc-tests.el ends here diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index a1d15fe73a4..91c2fba4791 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -71,6 +71,7 @@ (skip-unless shell-file-name) (skip-unless shell-command-switch) (skip-unless (executable-find shell-file-name)) + (skip-unless (not (getenv "EMACS_EMBA_CI"))) (let ((input ,input)) (with-temp-eshell ,@body))))) diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el index e7ea6c00d6f..7f461d1813c 100644 --- a/test/lisp/eshell/esh-proc-tests.el +++ b/test/lisp/eshell/esh-proc-tests.el @@ -43,3 +43,54 @@ "y\n") (eshell-wait-for-subprocess t) (should (eq (process-list) nil)))) + +(ert-deftest esh-proc-test/kill-pipeline () + "Test that killing a pipeline of processes only emits a single +prompt. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "echo") + (executable-find "sleep"))) + ;; This test doesn't work on EMBA with AOT nativecomp, but works + ;; fine elsewhere. + (skip-unless (not (getenv "EMACS_EMBA_CI"))) + (with-temp-eshell + (eshell-insert-command + (concat "sh -c 'while true; do echo y; sleep 1; done' | " + "sh -c 'while true; do read NAME; done'")) + (let ((output-start (eshell-beginning-of-output))) + (eshell-kill-process) + (eshell-wait-for-subprocess t) + (should (string-match-p + ;; "interrupt\n" is for MS-Windows. + (rx (or "interrupt\n" "killed\n" "killed: 9\n")) + (buffer-substring-no-properties + output-start (eshell-end-of-output))))))) + +(ert-deftest esh-proc-test/kill-pipeline-head () + "Test that killing the first process in a pipeline doesn't +write the exit status to the pipe. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "echo") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-insert-command + (concat "sh -c 'while true; do sleep 1; done' | " + "sh -c 'while read NAME; do echo =${NAME}=; done'")) + (let ((output-start (eshell-beginning-of-output))) + (kill-process (eshell-head-process)) + (eshell-wait-for-subprocess t) + (should (equal (buffer-substring-no-properties + output-start (eshell-end-of-output)) + ""))))) + +(ert-deftest esh-proc-test/kill-background-process () + "Test that killing a background process doesn't emit a new +prompt. See bug#54136." + (skip-unless (and (executable-find "sh") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-insert-command "sh -c 'while true; do sleep 1; done' &") + (kill-process (caar eshell-process-list)) + ;; Give `eshell-sentinel' a chance to run. + (sit-for 0.1) + (eshell-match-result "\\[sh\\(\\.exe\\)?\\] [[:digit:]]+\n"))) diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el new file mode 100644 index 00000000000..1d051d681af --- /dev/null +++ b/test/lisp/eshell/esh-var-tests.el @@ -0,0 +1,347 @@ +;;; esh-var-tests.el --- esh-var test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for Eshell's variable handling. + +;;; Code: + +(require 'ert) +(require 'esh-mode) +(require 'eshell) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +(defvar eshell-test-value nil) + +;;; Tests: + + +;; Variable interpolation + +(ert-deftest esh-var-test/interp-var () + "Interpolate variable" + (should (equal (eshell-test-command-result "echo $user-login-name") + user-login-name))) + +(ert-deftest esh-var-test/interp-quoted-var () + "Interpolate quoted variable" + (should (equal (eshell-test-command-result "echo $'user-login-name'") + user-login-name)) + (should (equal (eshell-test-command-result "echo $\"user-login-name\"") + user-login-name))) + +(ert-deftest esh-var-test/interp-quoted-var-concat () + "Interpolate and concat quoted variable" + (should (equal (eshell-test-command-result "echo $'user-login-name'-foo") + (concat user-login-name "-foo"))) + (should (equal (eshell-test-command-result "echo $\"user-login-name\"-foo") + (concat user-login-name "-foo")))) + +(ert-deftest esh-var-test/interp-var-indices () + "Interpolate list variable with indices" + (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0]") + "zero")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0 2]") + '("zero" "two"))) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0 2 4]") + '("zero" "two" "four"))))) + +(ert-deftest esh-var-test/interp-var-split-indices () + "Interpolate string variable with indices" + (let ((eshell-test-value "zero one two three four")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0]") + "zero")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0 2]") + '("zero" "two"))) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0 2 4]") + '("zero" "two" "four"))))) + +(ert-deftest esh-var-test/interp-var-string-split-indices () + "Interpolate string variable with string splitter and indices" + (let ((eshell-test-value "zero:one:two:three:four")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[: 0]") + "zero")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[: 0 2]") + '("zero" "two")))) + (let ((eshell-test-value "zeroXoneXtwoXthreeXfour")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[X 0]") + "zero")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[X 0 2]") + '("zero" "two"))))) + +(ert-deftest esh-var-test/interp-var-regexp-split-indices () + "Interpolate string variable with regexp splitter and indices" + (let ((eshell-test-value "zero:one!two:three!four")) + (should (equal (eshell-test-command-result + "echo $eshell-test-value['[:!]' 0]") + "zero")) + (should (equal (eshell-test-command-result + "echo $eshell-test-value['[:!]' 0 2]") + '("zero" "two"))) + (should (equal (eshell-test-command-result + "echo $eshell-test-value[\"[:!]\" 0]") + "zero")) + (should (equal (eshell-test-command-result + "echo $eshell-test-value[\"[:!]\" 0 2]") + '("zero" "two"))))) + +(ert-deftest esh-var-test/interp-var-assoc () + "Interpolate alist variable with index" + (let ((eshell-test-value '(("foo" . 1)))) + (should (eq (eshell-test-command-result "echo $eshell-test-value[foo]") + 1)))) + +(ert-deftest esh-var-test/interp-var-length-list () + "Interpolate length of list variable" + (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) + (should (eq (eshell-test-command-result "echo $#eshell-test-value") 3)) + (should (eq (eshell-test-command-result "echo $#eshell-test-value[1]") 1)) + (should (eq (eshell-test-command-result "echo $#eshell-test-value[2][1]") + 4)))) + +(ert-deftest esh-var-test/interp-var-length-string () + "Interpolate length of string variable" + (let ((eshell-test-value "foobar")) + (should (eq (eshell-test-command-result "echo $#eshell-test-value") 6)))) + +(ert-deftest esh-var-test/interp-var-length-alist () + "Interpolate length of alist variable" + (let ((eshell-test-value '(("foo" . (1 2 3))))) + (should (eq (eshell-test-command-result "echo $#eshell-test-value") 1)) + (should (eq (eshell-test-command-result "echo $#eshell-test-value[foo]") + 3)))) + +(ert-deftest esh-var-test/interp-lisp () + "Interpolate Lisp form evaluation" + (should (equal (eshell-test-command-result "+ $(+ 1 2) 3") 6))) + +(ert-deftest esh-var-test/interp-lisp-indices () + "Interpolate Lisp form evaluation with index" + (should (equal (eshell-test-command-result "+ $(list 1 2)[1] 3") 5))) + +(ert-deftest esh-var-test/interp-cmd () + "Interpolate command result" + (should (equal (eshell-test-command-result "+ ${+ 1 2} 3") 6))) + +(ert-deftest esh-var-test/interp-cmd-indices () + "Interpolate command result with index" + (should (equal (eshell-test-command-result "+ ${list 1 2}[1] 3") 5))) + +(ert-deftest esh-var-test/interp-cmd-external () + "Interpolate command result from external command" + (skip-unless (executable-find "echo")) + (with-temp-eshell + (eshell-command-result-p "echo ${*echo hi}" + "hi\n"))) + +(ert-deftest esh-var-test/interp-cmd-external-indices () + "Interpolate command result from external command with index" + (skip-unless (executable-find "echo")) + (with-temp-eshell + (eshell-command-result-p "echo ${*echo \"hi\nbye\"}[1]" + "bye\n"))) + +(ert-deftest esh-var-test/interp-temp-cmd () + "Interpolate command result redirected to temp file" + (should (equal (eshell-test-command-result "cat $<echo hi>") "hi"))) + +(ert-deftest esh-var-test/interp-concat-lisp () + "Interpolate and concat Lisp form" + (should (equal (eshell-test-command-result "+ $(+ 1 2)3 3") 36))) + +(ert-deftest esh-var-test/interp-concat-lisp2 () + "Interpolate and concat two Lisp forms" + (should (equal (eshell-test-command-result "+ $(+ 1 2)$(+ 1 2) 3") 36))) + +(ert-deftest esh-var-test/interp-concat-cmd () + "Interpolate and concat command" + (should (equal (eshell-test-command-result "+ ${+ 1 2}3 3") 36))) + +(ert-deftest esh-var-test/interp-concat-cmd2 () + "Interpolate and concat two commands" + (should (equal (eshell-test-command-result "+ ${+ 1 2}${+ 1 2} 3") 36))) + +(ert-deftest esh-var-test/interp-concat-cmd-external () + "Interpolate command result from external command with concatenation" + (skip-unless (executable-find "echo")) + (with-temp-eshell + (eshell-command-result-p "echo ${echo hi}-${*echo there}" + "hi-there\n"))) + +(ert-deftest esh-var-test/quoted-interp-var () + "Interpolate variable inside double-quotes" + (should (equal (eshell-test-command-result "echo \"$user-login-name\"") + user-login-name))) + +(ert-deftest esh-var-test/quoted-interp-quoted-var () + "Interpolate quoted variable inside double-quotes" + (should (equal (eshell-test-command-result + "echo \"hi, $'user-login-name'\"") + (concat "hi, " user-login-name))) + (should (equal (eshell-test-command-result + "echo \"hi, $\\\"user-login-name\\\"\"") + (concat "hi, " user-login-name)))) + +(ert-deftest esh-var-test/quoted-interp-var-indices () + "Interpolate string variable with indices inside double-quotes" + (let ((eshell-test-value '("zero" "one" "two" "three" "four"))) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0]\"") + "zero")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0 2]\"") + '("zero" "two"))) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0 2 4]\"") + '("zero" "two" "four"))))) + +(ert-deftest esh-var-test/quoted-interp-var-split-indices () + "Interpolate string variable with indices inside double-quotes" + (let ((eshell-test-value "zero one two three four")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0]\"") + "zero")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0 2]\"") + '("zero" "two"))))) + +(ert-deftest esh-var-test/quoted-interp-var-string-split-indices () + "Interpolate string variable with string splitter and indices +inside double-quotes" + (let ((eshell-test-value "zero:one:two:three:four")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[: 0]\"") + "zero")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[: 0 2]\"") + '("zero" "two")))) + (let ((eshell-test-value "zeroXoneXtwoXthreeXfour")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[X 0]\"") + "zero")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[X 0 2]\"") + '("zero" "two"))))) + +(ert-deftest esh-var-test/quoted-interp-var-regexp-split-indices () + "Interpolate string variable with regexp splitter and indices" + (let ((eshell-test-value "zero:one!two:three!four")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value['[:!]' 0]\"") + "zero")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value['[:!]' 0 2]\"") + '("zero" "two"))) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[\\\"[:!]\\\" 0]\"") + "zero")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[\\\"[:!]\\\" 0 2]\"") + '("zero" "two"))))) + +(ert-deftest esh-var-test/quoted-interp-var-assoc () + "Interpolate alist variable with index inside double-quotes" + (let ((eshell-test-value '(("foo" . 1)))) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[foo]\"") + 1)))) + +(ert-deftest esh-var-test/quoted-interp-var-length-list () + "Interpolate length of list variable inside double-quotes" + (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) + (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") 3)) + (should (eq (eshell-test-command-result "echo \"$#eshell-test-value[1]\"") + 1)) + (should (eq (eshell-test-command-result + "echo \"$#eshell-test-value[2][1]\"") + 4)))) + +(ert-deftest esh-var-test/quoted-interp-var-length-string () + "Interpolate length of string variable inside double-quotes" + (let ((eshell-test-value "foobar")) + (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") + 6)))) + +(ert-deftest esh-var-test/quoted-interp-var-length-alist () + "Interpolate length of alist variable inside double-quotes" + (let ((eshell-test-value '(("foo" . (1 2 3))))) + (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") 1)) + (should (eq (eshell-test-command-result "echo \"$#eshell-test-value[foo]\"") + 3)))) + +(ert-deftest esh-var-test/quoted-interp-lisp () + "Interpolate Lisp form evaluation inside double-quotes" + (should (equal (eshell-test-command-result + "echo \"hi $(concat \\\"the\\\" \\\"re\\\")\"") + "hi there"))) + +(ert-deftest esh-var-test/quoted-interp-lisp-indices () + "Interpolate Lisp form evaluation with index" + (should (equal (eshell-test-command-result "+ \"$(list 1 2)[1]\" 3") 5))) + +(ert-deftest esh-var-test/quoted-interp-cmd () + "Interpolate command result inside double-quotes" + (should (equal (eshell-test-command-result + "echo \"hi ${echo \\\"there\\\"}\"") + "hi there"))) + +(ert-deftest esh-var-test/quoted-interp-cmd-indices () + "Interpolate command result with index inside double-quotes" + (should (equal (eshell-test-command-result "+ \"${list 1 2}[1]\" 3") 5))) + +(ert-deftest esh-var-test/quoted-interp-temp-cmd () + "Interpolate command result redirected to temp file inside double-quotes" + (should (equal (eshell-test-command-result "cat \"$<echo hi>\"") "hi"))) + + +;; Built-in variables + +(ert-deftest esh-var-test/window-height () + "$LINES should equal (window-height)" + (should (eshell-test-command-result "= $LINES (window-height)"))) + +(ert-deftest esh-var-test/window-width () + "$COLUMNS should equal (window-width)" + (should (eshell-test-command-result "= $COLUMNS (window-width)"))) + +(ert-deftest esh-var-test/last-result-var () + "Test using the \"last result\" ($$) variable" + (with-temp-eshell + (eshell-command-result-p "+ 1 2; + $$ 2" + "3\n5\n"))) + +(ert-deftest esh-var-test/last-result-var2 () + "Test using the \"last result\" ($$) variable twice" + (with-temp-eshell + (eshell-command-result-p "+ 1 2; + $$ $$" + "3\n6\n"))) + +(ert-deftest esh-var-test/last-arg-var () + "Test using the \"last arg\" ($_) variable" + (with-temp-eshell + (eshell-command-result-p "+ 1 2; + $_ 4" + "3\n6\n"))) + +;; esh-var-tests.el ends here diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index d6ee1bdb175..e31db07c619 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -85,44 +85,6 @@ Test that trailing arguments outside the subcommand are ignored. e.g. \"{(+ 1 2)} 3\" => 3" (should (equal (eshell-test-command-result "{(+ 1 2)} 3") 3))) -(ert-deftest eshell-test/interp-cmd () - "Interpolate command result" - (should (equal (eshell-test-command-result "+ ${+ 1 2} 3") 6))) - -(ert-deftest eshell-test/interp-lisp () - "Interpolate Lisp form evaluation" - (should (equal (eshell-test-command-result "+ $(+ 1 2) 3") 6))) - -(ert-deftest eshell-test/interp-concat () - "Interpolate and concat command" - (should (equal (eshell-test-command-result "+ ${+ 1 2}3 3") 36))) - -(ert-deftest eshell-test/interp-concat-lisp () - "Interpolate and concat Lisp form" - (should (equal (eshell-test-command-result "+ $(+ 1 2)3 3") 36))) - -(ert-deftest eshell-test/interp-concat2 () - "Interpolate and concat two commands" - (should (equal (eshell-test-command-result "+ ${+ 1 2}${+ 1 2} 3") 36))) - -(ert-deftest eshell-test/interp-concat-lisp2 () - "Interpolate and concat two Lisp forms" - (should (equal (eshell-test-command-result "+ $(+ 1 2)$(+ 1 2) 3") 36))) - -(ert-deftest eshell-test/interp-cmd-external () - "Interpolate command result from external command" - (skip-unless (executable-find "echo")) - (with-temp-eshell - (eshell-command-result-p "echo ${*echo hi}" - "hi\n"))) - -(ert-deftest eshell-test/interp-cmd-external-concat () - "Interpolate command result from external command with concatenation" - (skip-unless (executable-find "echo")) - (with-temp-eshell - (eshell-command-result-p "echo ${echo hi}-${*echo there}" - "hi-there\n"))) - (ert-deftest eshell-test/pipe-headproc () "Check that piping a non-process to a process command waits for the process" (skip-unless (executable-find "cat")) @@ -148,32 +110,6 @@ e.g. \"{(+ 1 2)} 3\" => 3" (eshell-wait-for-subprocess) (eshell-match-result "OLLEH\n"))) -(ert-deftest eshell-test/window-height () - "$LINES should equal (window-height)" - (should (eshell-test-command-result "= $LINES (window-height)"))) - -(ert-deftest eshell-test/window-width () - "$COLUMNS should equal (window-width)" - (should (eshell-test-command-result "= $COLUMNS (window-width)"))) - -(ert-deftest eshell-test/last-result-var () - "Test using the \"last result\" ($$) variable" - (with-temp-eshell - (eshell-command-result-p "+ 1 2; + $$ 2" - "3\n5\n"))) - -(ert-deftest eshell-test/last-result-var2 () - "Test using the \"last result\" ($$) variable twice" - (with-temp-eshell - (eshell-command-result-p "+ 1 2; + $$ $$" - "3\n6\n"))) - -(ert-deftest eshell-test/last-arg-var () - "Test using the \"last arg\" ($_) variable" - (with-temp-eshell - (eshell-command-result-p "+ 1 2; + $_ 4" - "3\n6\n"))) - (ert-deftest eshell-test/inside-emacs-var () "Test presence of \"INSIDE_EMACS\" in subprocesses" (with-temp-eshell diff --git a/test/lisp/mail/ietf-drums-date-tests.el b/test/lisp/mail/ietf-drums-date-tests.el new file mode 100644 index 00000000000..5b798077ff9 --- /dev/null +++ b/test/lisp/mail/ietf-drums-date-tests.el @@ -0,0 +1,190 @@ +;;; ietf-drums-date-tests.el --- Test suite for ietf-drums-date.el -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Bob Rogers <rogers@rgrjr.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ietf-drums) +(require 'ietf-drums-date) + +(ert-deftest ietf-drums-date-tests () + "Test basic ietf-drums-parse-date-string functionality." + + ;; Test tokenization. + (should (equal (ietf-drums-date--tokenize-string " ") '())) + (should (equal (ietf-drums-date--tokenize-string " a b") '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "a bbc dde") + '("a" "bbc" "dde"))) + (should (equal (ietf-drums-date--tokenize-string " , a 27 b,, c 14:32 ") + '("a" 27 "b" "c" "14:32"))) + ;; Some folding whitespace tests. + (should (equal (ietf-drums-date--tokenize-string " a b (end) c" t) + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "(quux)a (foo (bar)) b(baz)") + '("a" "b"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\cde") + ;; Strictly incorrect, but strictly unnecessary syntax. + '("a" "b\\cde"))) + (should (equal (ietf-drums-date--tokenize-string "a b\\ de") + '("a" "b\\ de"))) + (should (equal (ietf-drums-date--tokenize-string "a \\de \\(f") + '("a" "\\de" "\\(f"))) + + ;; Start with some compatible RFC822 dates. + (dolist (case '(("Mon, 22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("22 Feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 nil -1 3600) + (22219 21758)) + ("Mon, 22 February 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Mon, 22 feb 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Monday, 22 february 2016 19:35:42 +0100" + (42 35 19 22 2 2016 1 -1 3600) + (22219 21758)) + ("Monday, 22 february 2016 19:35:42 PST" + (42 35 19 22 2 2016 1 nil -28800) + (22219 54158)) + ("Friday, 21 Sep 2018 13:47:58 PDT" + (58 47 13 21 9 2018 5 t -25200) + (23461 22782)) + ("Friday, 21 Sep 2018 13:47:58 EDT" + (58 47 13 21 9 2018 5 t -14400) + (23461 11982)))) + (let* ((input (car case)) + (parsed (cadr case)) + (encoded (caddr case))) + ;; The input should parse the same without RFC822. + (should (equal (ietf-drums-parse-date-string input) parsed)) + (should (equal (ietf-drums-parse-date-string input nil t) parsed)) + ;; Check the encoded date (the official output, though the + ;; decoded-time is easier to debug). + (should (equal (ietf-drums-parse-date input) encoded)))) + + ;; Test a few without timezones. + (dolist (case '(("Mon, 22 Feb 2016 19:35:42" + (42 35 19 22 2 2016 1 -1 nil)) + ("Friday, 21 Sep 2018 13:47:58" + (58 47 13 21 9 2018 5 -1 nil)))) + (let* ((input (car case)) + (parsed (cadr case))) + ;; The input should parse the same without RFC822. + (should (equal (ietf-drums-parse-date-string input) parsed)) + (should (equal (ietf-drums-parse-date-string input nil t) parsed)) + ;; We can't check the encoded date here because it will differ + ;; depending on the TZ of the test environment. + )) + + ;; Two-digit years are not allowed by the "modern" format. + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +0100") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 16 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 16))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +0100") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string "22 Feb 96 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb 96 19:35:42 +0100" t t)) + '(date-parse-error "Four-digit years are required" 96))) + + ;; Try some dates with comments. + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100") + '(42 35 19 22 2 2016 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" nil t) + '(nil nil nil 22 2 nil nil -1 nil))) + (should (equal (should-error (ietf-drums-parse-date-string + "22 Feb (today) 16 19:35:42 +0100" t t)) + '(date-parse-error "Expected a year" nil))) + (should (equal (ietf-drums-parse-date-string + "22 Feb 96 (long ago) 19:35:42 +0100") + '(42 35 19 22 2 1996 nil -1 3600))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep(comment \\) with \\( parens)18 19:35:42") + '(42 35 19 21 9 2018 5 -1 nil))) + (should (equal (ietf-drums-parse-date-string + "Friday, 21 Sep 18 19:35:42 (unterminated comment") + '(42 35 19 21 9 2018 5 -1 nil))) + + ;; Test some RFC822 error cases + (dolist (test '(("33 1 2022" ("Slot out of range" day 33 1 31)) + ("0 1 2022" ("Slot out of range" day 0 1 31)) + ("1 1 2020 2021" ("Expected an alphabetic month" 1)) + ("1 Jan 2020 2021" ("Expected a time" 2021)) + ("1 Jan 2020 20:21 2000" ("Expected a timezone" 2000)) + ("1 Jan 2020 20:21 +0200 33" ("Extra token(s)" 33)))) + (should (equal (should-error (ietf-drums-parse-date-string (car test) t)) + (cons 'date-parse-error (cadr test))))) + + (dolist (test '(("22 Feb 196" nil ;; bad year + ("Four-digit years are required" 196)) + ("22 Feb 16 19:35:24" t ;; two-digit year + ("Four-digit years are required" 16)) + ("22 Feb 96 19:35:42" t ;; two-digit year + ("Four-digit years are required" 96)) + ("2 Feb 2021 1996" nil + ("Expected a time" 1996)) + ("22 Fub 1996" nil + ("Expected an alphabetic month" "fub")) + ("1 Jan 2020 30" nil + ("Expected a time" 30)) + ("1 Jan 2020 16:47 15:15" nil + ("Expected a timezone" "15:15")) + ("1 Jan 2020 16:47 +0800 -0800" t + ("Extra token(s)" "-0800")) + ;; Range tests + ("32 Dec 2021" nil + ("Slot out of range" day 32 1 31)) + ("0 Dec 2021" nil + ("Slot out of range" day 0 1 31)) + ("3 13 2021" nil + ("Expected an alphabetic month" 13)) + ("3 Dec 0000" t + ("Four-digit years are required" 0)) + ("3 Dec 20021" nil + ("Slot out of range" year 20021 1 9999)) + ("1 Jan 2020 24:21:14" nil + ("Slot out of range" hour "24:21:14" 0 23)) + ("1 Jan 2020 14:60:21" nil + ("Slot out of range" minute "14:60:21" 0 59)) + ("1 Jan 2020 14:21:61" nil + ("Slot out of range" second "14:21:61" 0 60)))) + (should (equal (should-error + (ietf-drums-parse-date-string (car test) t (cadr test))) + (cons 'date-parse-error (caddr test))))) + (should (equal (ietf-drums-parse-date-string + "1 Jan 2020 14:21:60") ;; a leap second! + '(60 21 14 1 1 2020 nil -1 nil)))) + +(provide 'ietf-drums-date-tests) + +;;; ietf-drums-date-tests.el ends here diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el index 8f180f3d6bb..c94719c97af 100644 --- a/test/lisp/net/browse-url-tests.el +++ b/test/lisp/net/browse-url-tests.el @@ -82,10 +82,13 @@ (ert-deftest browse-url-tests-file-url () (should (equal (browse-url-file-url "/foo") "file:///foo")) - (should (equal (browse-url-file-url "/foo:") "ftp://foo/")) - (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/")) - (should (equal (browse-url-file-url "/anonymous@foo:") - "ftp://foo/"))) + (when (file-remote-p "/foo:") + (should (equal (browse-url-file-url "/foo:") "ftp://foo/"))) + (when (file-remote-p "/ftp@foo:") + (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/"))) + (when (file-remote-p "/anonymous@foo:") + (should (equal (browse-url-file-url "/anonymous@foo:") + "ftp://foo/")))) (ert-deftest browse-url-tests-delete-temp-file () (ert-with-temp-file browse-url-temp-file-name diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el index b439c08c791..188706fc86a 100644 --- a/test/lisp/net/mailcap-tests.el +++ b/test/lisp/net/mailcap-tests.el @@ -79,45 +79,45 @@ ;; execution errors when running the tests from the Makefile ;; because then HOME=/nonexistent. (ert-with-temp-directory home - (setenv "HOME" home) - ;; Now parse our resource mailcap file. - (mailcap-parse-mailcap (ert-resource-file "mailcap")) - - ;; Assert that we get what we have defined. - (dolist (type '("audio/ogg" "audio/flac")) - (should (string= "mpv %s" (mailcap-mime-info type)))) - (should (string= "aplay %s" (mailcap-mime-info "audio/x-wav"))) - (should (string= "emacsclient -t %s" - (mailcap-mime-info "text/plain"))) - ;; evince is chosen because acroread has test=false and okular - ;; comes later. - (should (string= "evince %s" - (mailcap-mime-info "application/pdf"))) - (should (string= "inkscape %s" - (mailcap-mime-info "image/svg+xml"))) - (should (string= "eog %s" - (mailcap-mime-info "image/jpg"))) - ;; With REQUEST being a number, all fields of the selected entry - ;; should be returned. - (should (equal '((viewer . "evince %s") - (type . "application/pdf")) - (mailcap-mime-info "application/pdf" 1))) - ;; With 'all, all applicable entries should be returned. - (should (equal '(((viewer . "evince %s") - (type . "application/pdf")) - ((viewer . "okular %s") - (type . "application/pdf"))) - (mailcap-mime-info "application/pdf" 'all))) - (let* ((c nil) - (toggle (lambda (_) (setq c (not c))))) - (mailcap-add "audio/ogg" "toggle %s" toggle) - (should (string= "toggle %s" (mailcap-mime-info "audio/ogg"))) - ;; The test results are cached, so in order to have the test - ;; re-evaluated, one needs to clear the cache. - (setq mailcap-viewer-test-cache nil) - (should (string= "mpv %s" (mailcap-mime-info "audio/ogg"))) - (setq mailcap-viewer-test-cache nil) - (should (string= "toggle %s" (mailcap-mime-info "audio/ogg"))))))) + (with-environment-variables (("HOME" home)) + ;; Now parse our resource mailcap file. + (mailcap-parse-mailcap (ert-resource-file "mailcap")) + + ;; Assert that we get what we have defined. + (dolist (type '("audio/ogg" "audio/flac")) + (should (string= "mpv %s" (mailcap-mime-info type)))) + (should (string= "aplay %s" (mailcap-mime-info "audio/x-wav"))) + (should (string= "emacsclient -t %s" + (mailcap-mime-info "text/plain"))) + ;; evince is chosen because acroread has test=false and okular + ;; comes later. + (should (string= "evince %s" + (mailcap-mime-info "application/pdf"))) + (should (string= "inkscape %s" + (mailcap-mime-info "image/svg+xml"))) + (should (string= "eog %s" + (mailcap-mime-info "image/jpg"))) + ;; With REQUEST being a number, all fields of the selected entry + ;; should be returned. + (should (equal '((viewer . "evince %s") + (type . "application/pdf")) + (mailcap-mime-info "application/pdf" 1))) + ;; With 'all, all applicable entries should be returned. + (should (equal '(((viewer . "evince %s") + (type . "application/pdf")) + ((viewer . "okular %s") + (type . "application/pdf"))) + (mailcap-mime-info "application/pdf" 'all))) + (let* ((c nil) + (toggle (lambda (_) (setq c (not c))))) + (mailcap-add "audio/ogg" "toggle %s" toggle) + (should (string= "toggle %s" (mailcap-mime-info "audio/ogg"))) + ;; The test results are cached, so in order to have the test + ;; re-evaluated, one needs to clear the cache. + (setq mailcap-viewer-test-cache nil) + (should (string= "mpv %s" (mailcap-mime-info "audio/ogg"))) + (setq mailcap-viewer-test-cache nil) + (should (string= "toggle %s" (mailcap-mime-info "audio/ogg")))))))) (defvar mailcap--test-result nil) (defun mailcap--test-viewer () diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4e74f2aa73f..f34fdbdaf79 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2122,10 +2122,10 @@ Also see `ignore'." (ert-deftest tramp-test05-expand-file-name-relative () "Check `expand-file-name'." (skip-unless (tramp--test-enabled)) - ;; The bugs are fixed in Emacs 28.1. - (skip-unless (tramp--test-emacs28-p)) ;; Methods with a share do not expand "/path/..". (skip-unless (not (tramp--test-share-p))) + ;; The bugs are fixed in Emacs 28.1. + (skip-unless (tramp--test-emacs28-p)) (should (string-equal @@ -2226,9 +2226,12 @@ This checks also `file-name-as-directory', `file-name-directory', (ert-deftest tramp-test07-abbreviate-file-name () "Check that Tramp abbreviates file names correctly." (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-emacs29-p)) (skip-unless (not (tramp--test-ange-ftp-p))) + ;; `abbreviate-file-name' is supported since Emacs 29.1. + (skip-unless (tramp--test-emacs29-p)) + ;; We must refill the cache. `file-truename' does it. + (file-truename tramp-test-temporary-file-directory) (let* ((remote-host (file-remote-p tramp-test-temporary-file-directory)) (remote-host-nohop (tramp-make-tramp-file-name (tramp-dissect-file-name remote-host))) @@ -2261,12 +2264,12 @@ This checks also `file-name-as-directory', `file-name-directory', (setq home-dir (concat remote-host "/") home-dir-nohop (tramp-make-tramp-file-name (tramp-dissect-file-name home-dir))) - ;; The remote home directory is kept in the connection property - ;; "home-directory". We fake this setting. - (tramp-set-connection-property tramp-test-vec "home-directory" home-dir) + ;; The remote home directory is kept in the connection property "~". + ;; We fake this setting. + (tramp-set-connection-property tramp-test-vec "~" (file-local-name home-dir)) (should (equal (abbreviate-file-name (concat home-dir "foo/bar")) (concat home-dir-nohop "foo/bar"))) - (tramp-flush-connection-property tramp-test-vec "home-directory"))) + (tramp-flush-connection-property tramp-test-vec "~"))) (ert-deftest tramp-test07-file-exists-p () "Check `file-exist-p', `write-region' and `delete-file'." @@ -3437,8 +3440,10 @@ This tests also `access-file', `file-readable-p', (should (string-equal (file-attribute-type attr) - (tramp-file-name-localname - (tramp-dissect-file-name tmp-name3)))) + (funcall + (if (tramp--test-sshfs-p) #'file-name-nondirectory #'identity) + (tramp-file-name-localname + (tramp-dissect-file-name tmp-name3))))) (delete-file tmp-name2)) (when test-file-ownership-preserved-p @@ -3598,7 +3603,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (should (= (file-modes tmp-name1) #o444)) (should-not (file-executable-p tmp-name1)) ;; A file is always writable for user "root". - (unless (zerop (file-attribute-user-id (file-attributes tmp-name1))) + (unless + (or (zerop (file-attribute-user-id (file-attributes tmp-name1))) + (tramp--test-sshfs-p)) (should-not (file-writable-p tmp-name1))) ;; Check the NOFOLLOW arg. It exists since Emacs 28. For ;; regular files, there shouldn't be a difference. @@ -4706,7 +4713,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (ert-deftest tramp-test30-make-process () "Check `make-process'." - :tags '(:expensive-test :tramp-asynchronous-processes) + :tags (append '(:expensive-test :tramp-asynchronous-processes) + (and (getenv "EMACS_EMBA_CI") + '(:unstable))) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) ;; `make-process' supports file name handlers since Emacs 27. @@ -6191,7 +6200,7 @@ This requires restrictions of file name syntax." (defun tramp--test-ange-ftp-p () "Check, whether Ange-FTP is used." (eq - (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) + (tramp-find-foreign-file-name-handler tramp-test-vec) 'tramp-ftp-file-name-handler)) (defun tramp--test-asynchronous-processes-p () @@ -6910,7 +6919,9 @@ This is needed in timer functions as well as process filters and sentinels." Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." :tags (append '(:expensive-test :tramp-asynchronous-processes) - (and (getenv "EMACS_HYDRA_CI") '(:unstable))) + (and (or (getenv "EMACS_HYDRA_CI") + (getenv "EMACS_EMBA_CI")) + '(:unstable))) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for @@ -7254,7 +7265,6 @@ process sentinels. They shall not disturb each other." "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) - (skip-unless noninteractive) ;; We have autoloaded objects from tramp.el and tramp-archive.el. ;; In order to remove them, we first need to load both packages. (require 'tramp) @@ -7320,7 +7330,13 @@ Since it unloads Tramp, it shall be the last test to run." (and (string-match-p "^tramp" (symbol-name fun)) (ert-fail (format "Function `%s' still contains Tramp advice" x)))) - x))))) + x)))) + + ;; Reload. + (require 'tramp) + (require 'tramp-archive) + (should (featurep 'tramp)) + (should (featurep 'tramp-archive))) (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]. diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 015c1efd978..187af821c22 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -47,8 +47,6 @@ uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *); #include <gmp.h> #include <emacs-module.h> -#include "timespec.h" - int plugin_is_GPL_compatible; #if INTPTR_MAX <= 0 @@ -74,9 +72,6 @@ int plugin_is_GPL_compatible; # error "INTPTR_MAX too large" #endif -/* Smoke test to verify that EMACS_LIMB_MAX is defined. */ -_Static_assert (0 < EMACS_LIMB_MAX, "EMACS_LIMB_MAX missing or incorrect"); - /* Always return symbol 't'. */ static emacs_value Fmod_test_return_t (emacs_env *env, ptrdiff_t nargs, emacs_value args[], @@ -422,6 +417,16 @@ signal_errno (emacs_env *env, const char *function) signal_system_error (env, errno, function); } +#ifdef CLOCK_REALTIME + +/* Whether A <= B. */ +static bool +timespec_le (struct timespec a, struct timespec b) +{ + return (a.tv_sec < b.tv_sec + || (a.tv_sec == b.tv_sec && a.tv_nsec <= b.tv_nsec)); +} + /* A long-running operation that occasionally calls `should_quit' or `process_input'. */ @@ -434,11 +439,13 @@ Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args, if (env->non_local_exit_check (env)) return NULL; const bool process_input = env->is_not_nil (env, args[1]); - const struct timespec amount = make_timespec(0, 10000000); + const struct timespec amount = { .tv_nsec = 10000000 }; while (true) { - const struct timespec now = current_timespec (); - if (timespec_cmp (now, until) >= 0) + struct timespec now; + if (clock_gettime (CLOCK_REALTIME, &now) != 0) + return NULL; + if (timespec_le (until, now)) break; if (nanosleep (&amount, NULL) && errno != EINTR) { @@ -452,6 +459,7 @@ Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args, } return env->intern (env, "finished"); } +#endif static emacs_value Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, emacs_value *args, @@ -553,6 +561,7 @@ make_big_integer (emacs_env *env, const mpz_t value) return result; } +#ifdef CLOCK_REALTIME static emacs_value Fmod_test_nanoseconds (emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data) { assert (nargs == 1); @@ -560,11 +569,6 @@ Fmod_test_nanoseconds (emacs_env *env, ptrdiff_t nargs, emacs_value *args, void mpz_t nanoseconds; assert (LONG_MIN <= time.tv_sec && time.tv_sec <= LONG_MAX); mpz_init_set_si (nanoseconds, time.tv_sec); -#ifdef __MINGW32__ - _Static_assert (1000000000 <= ULONG_MAX, "unsupported architecture"); -#else - static_assert (1000000000 <= ULONG_MAX, "unsupported architecture"); -#endif mpz_mul_ui (nanoseconds, nanoseconds, 1000000000); assert (0 <= time.tv_nsec && time.tv_nsec <= ULONG_MAX); mpz_add_ui (nanoseconds, nanoseconds, time.tv_nsec); @@ -572,6 +576,7 @@ Fmod_test_nanoseconds (emacs_env *env, ptrdiff_t nargs, emacs_value *args, void mpz_clear (nanoseconds); return result; } +#endif static emacs_value Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args, @@ -631,7 +636,7 @@ sleep_for_half_second (void) #ifdef WINDOWSNT Sleep (500); #else - const struct timespec sleep = {0, 500000000}; + const struct timespec sleep = { .tv_nsec = 500000000 }; if (nanosleep (&sleep, NULL) != 0) perror ("nanosleep"); #endif @@ -763,6 +768,11 @@ bind_function (emacs_env *env, const char *name, emacs_value Sfun) int emacs_module_init (struct emacs_runtime *ert) { + /* These smoke tests don't use _Static_assert because too many + compilers lack support for _Static_assert. */ + assert (0 < EMACS_LIMB_MAX); + assert (1000000000 <= ULONG_MAX); + /* Check that EMACS_MAJOR_VERSION is defined and an integral constant. */ char dummy[EMACS_MAJOR_VERSION]; @@ -815,9 +825,13 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL); DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0, NULL, NULL); +#ifdef CLOCK_REALTIME DEFUN ("mod-test-sleep-until", Fmod_test_sleep_until, 2, 2, NULL, NULL); +#endif DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL); +#ifdef CLOCK_REALTIME DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL); +#endif DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL); DEFUN ("mod-test-make-function-with-finalizer", Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index ec83f91f003..1099fd04678 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -336,6 +336,7 @@ Return A + B (ert-deftest mod-test-sleep-until () "Check that `mod-test-sleep-until' either returns normally or quits. Interactively, you can try hitting \\[keyboard-quit] to quit." + (skip-unless (fboundp 'mod-test-sleep-until)) (dolist (arg '(nil t)) ;; Guard against some caller setting `inhibit-quit'. (with-local-quit @@ -390,6 +391,7 @@ Interactively, you can try hitting \\[keyboard-quit] to quit." (ert-deftest mod-test-nanoseconds () "Test truncation when converting to `struct timespec'." + (skip-unless (fboundp 'mod-test-nanoseconds)) (dolist (test-case '((0 . 0) (-1 . -1000000000) ((1 . 1000000000) . 1) @@ -408,6 +410,7 @@ Interactively, you can try hitting \\[keyboard-quit] to quit." (should (= (mod-test-nanoseconds input) expected)))))) (ert-deftest mod-test-double () + (skip-unless (fboundp 'mod-test-double)) (dolist (input (list 0 1 2 -1 42 12345678901234567890 most-positive-fixnum (1+ most-positive-fixnum) most-negative-fixnum (1- most-negative-fixnum))) diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 1ef0caf1a46..0bae1959d1b 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -417,5 +417,13 @@ otherwise, use a different charset." t))) (should (equal (prin1-to-string (make-marker)) "")))) +(ert-deftest test-dots () + (should (equal (prin1-to-string 'foo.bar) "foo.bar")) + (should (equal (prin1-to-string '.foo) "\\.foo")) + (should (equal (prin1-to-string '.foo.) "\\.foo.")) + (should (equal (prin1-to-string 'bar?bar) "bar?bar")) + (should (equal (prin1-to-string '\?bar) "\\?bar")) + (should (equal (prin1-to-string '\?bar?) "\\?bar?"))) + (provide 'print-tests) ;;; print-tests.el ends here diff --git a/test/src/xfaces-tests.el b/test/src/xfaces-tests.el index 31c0f021b28..16f16537918 100644 --- a/test/src/xfaces-tests.el +++ b/test/src/xfaces-tests.el @@ -47,7 +47,10 @@ '(0 32768 6554))) (should (equal (color-values-from-color-spec "rgbi:1e-3/1.0e-2/1e0") '(66 655 65535))) - (should (equal (color-values-from-color-spec "rgbi:0/0.5/10") nil))) + (should (equal (color-values-from-color-spec "rgbi:0/0.5/10") nil)) + (should (equal (color-values-from-color-spec "rgbi:0/0/ 0") nil)) + (should (equal (color-values-from-color-spec "rgbi:0/0x0/0") nil)) + (should (equal (color-values-from-color-spec "rgbi:0/+0x1/0") nil))) (provide 'xfaces-tests) |