diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2022-02-24 13:59:25 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-02-24 13:59:25 -0700 |
| commit | 3266231e6c94ee88ed0096b4147c397022ae5f2c (patch) | |
| tree | b3e8d8d51fe6ca51ed521a910e094dd8c9d297e2 | |
| parent | 13dfee144436992fd380f1806c63c64ace660441 (diff) | |
| parent | 16333a14cb04903ac6a5c87cc79928f895c5a3f8 (diff) | |
| download | emacs-3266231e6c94ee88ed0096b4147c397022ae5f2c.tar.gz | |
Merge branch 'athena/unstable' into athena/bullseye-backports
399 files changed, 20988 insertions, 8760 deletions
@@ -4,11 +4,13 @@ Inc. See the end of the file for license conditions. -This file contains general information on building GNU Emacs. -For more information specific to the MS-Windows, GNUstep/macOS, and -MS-DOS ports, also read the files nt/INSTALL, nextstep/INSTALL, and -msdos/INSTALL. For information about building from a repository checkout -(rather than a release), also read the file INSTALL.REPO. +This file contains general information on building GNU Emacs. For +more information specific to the MS-Windows, GNUstep/macOS, and MS-DOS +ports, also read the files nt/INSTALL, nextstep/INSTALL, and +msdos/INSTALL. + +For information about building from a Git checkout (rather than an +Emacs release), read the INSTALL.REPO file first. BASIC INSTALLATION diff --git a/Makefile.in b/Makefile.in index 8ac6f527469..877802ec11c 100644 --- a/Makefile.in +++ b/Makefile.in @@ -694,8 +694,6 @@ install-etcdoc: src install-arch-indep printf 'Copying %s to %s ...\n' "etc/$$docfile" \ "$(DESTDIR)${etcdocdir}"; \ ${INSTALL_DATA} etc/$${docfile} "$(DESTDIR)${etcdocdir}/$${docfile}"; \ - $(set_installuser); \ - chown $${installuser} "$(DESTDIR)${etcdocdir}/$${docfile}" || true ; \ else true; fi ## FIXME: diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index 6f699430895..4ca88982cde 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -34,7 +34,8 @@ top_builddir = @top_builddir@ unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH EMACS = ${top_builddir}/src/emacs -emacs = "${EMACS}" -batch --no-site-file --no-site-lisp --eval '(setq load-prefer-newer t)' +emacs = "${EMACS}" -batch --no-site-file --no-site-lisp \ + --eval '(setq max-specpdl-size 5000)' --eval '(setq load-prefer-newer t)' make_bovine = ${emacs} -l semantic/bovine/grammar -f bovine-batch-make-parser make_wisent = ${emacs} -l semantic/wisent/grammar -f wisent-batch-make-parser diff --git a/config.bat b/config.bat index 29742eec52b..758e4621386 100644 --- a/config.bat +++ b/config.bat @@ -310,6 +310,9 @@ rm -f makefile.tmp sed -f ../msdos/sedlibcf.inp < gnulib.mk-in > gnulib.tmp
sed -f ../msdos/sedlibmk.inp < gnulib.tmp > gnulib.mk
rm -f gnulib.tmp
+Rem Create directorys in lib/ that MKDIR_P is supposed to create
+Rem but I have no idea how to do that on MS-DOS.
+mkdir sys
Rem Create .d files for new files in lib/ and lib/malloc/
If Not Exist deps\stamp mkdir deps
for %%f in (*.c) do @call ..\msdos\depfiles.bat %%f
diff --git a/configure.ac b/configure.ac index e5574b6b054..00711cccd5d 100644 --- a/configure.ac +++ b/configure.ac @@ -471,7 +471,7 @@ AC_ARG_WITH([ns],[AS_HELP_STRING([--with-ns], [use Nextstep (macOS Cocoa or GNUstep) windowing system. On by default on macOS.])],[],[with_ns=maybe]) OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI in a Cygwin build]) -OPTION_DEFAULT_OFF([pgtk], [use pure GTK build without reliance on X libs (Wayland support) (requires cairo) - Experimental]) +OPTION_DEFAULT_OFF([pgtk], [use GTK to support window systems other than X]) OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console]) OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) @@ -2620,10 +2620,11 @@ if test "${HAVE_X11}" = "yes"; then emacs_cv_xkb=yes, emacs_cv_xkb=no)]) if test $emacs_cv_xkb = yes; then AC_DEFINE(HAVE_XKB, 1, [Define to 1 if you have the Xkb extension.]) + AC_CHECK_FUNCS(XkbRefreshKeyboardMapping XkbFreeNames) fi - AC_CHECK_FUNCS(XrmSetDatabase XScreenResourceString \ -XScreenNumberOfScreen) + AC_CHECK_FUNCS(XrmSetDatabase XScreenResourceString XScreenNumberOfScreen) + AC_CHECK_FUNCS(XDisplayCells XDestroySubwindows) fi if test "${window_system}" = "x11"; then @@ -2639,6 +2640,7 @@ fail; AC_DEFINE(HAVE_X11R6, 1, [Define to 1 if you have the X11R6 or newer version of Xlib.]) AC_DEFINE(HAVE_X_I18N, 1, [Define if you have usable i18n support.]) + AC_CHECK_MEMBERS([XICCallback.callback], [], [], [#include <X11/Xlib.h>]) ## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style ## XIM support. case "$opsys" in @@ -4476,18 +4478,34 @@ if test "${HAVE_X11}" = "yes" && test "${with_xinput2}" != "no"; then AC_MSG_WARN([You are building Emacs with GTK+ 2 and the X Input Extension version 2. This might lead to problems if your version of GTK+ is not built with support for XInput 2.]) fi - # Detect both faulty installations of libXi where gesture event - # types are defined but gesture event structures are not, and - # also where gesture event structures are empty. - AC_CHECK_MEMBERS([XIGesturePinchEvent.delta_unaccel_y], - [AC_DEFINE(HAVE_USABLE_XI_GESTURE_PINCH_EVENT, 1, - [Define to 1 if XInput headers define gesture structures correctly.])], - [], [[#include <X11/extensions/XInput2.h>]]) + + # Now check for some members (which used in conjunction with + # protocol definitions) can be used to determine the version of + # XInput supported. + AC_CHECK_MEMBERS([XIScrollClassInfo.type, XITouchClassInfo.type, + XIBarrierReleasePointerInfo.deviceid, XIGestureClassInfo.type], + [], [], [#include <X11/extensions/XInput2.h>]) fi fi AC_SUBST(XINPUT_CFLAGS) AC_SUBST(XINPUT_LIBS) +XSYNC_LIBS= +XSYNC_CFLAGS= +HAVE_XSYNC=no +if test "${HAVE_X11}" = "yes"; then + AC_CHECK_HEADER(X11/extensions/sync.h, + AC_CHECK_LIB(Xext, XSyncQueryExtension, HAVE_XSYNC=yes), + [], [#include <X11/Xlib.h>]) + + if test "${HAVE_XSYNC}" = "yes"; then + AC_DEFINE(HAVE_XSYNC, 1, [Define to 1 if the X Synchronization Extension is available.]) + XSYNC_LIBS="-lXext" + fi +fi +AC_SUBST(XSYNC_LIBS) +AC_SUBST(XSYNC_CFLAGS) + ### Use Xdbe (-lXdbe) if available HAVE_XDBE=no if test "${HAVE_X11}" = "yes"; then @@ -4650,7 +4668,7 @@ AC_CHECK_HEADERS( ]])]) AC_SUBST([HAVE_SECCOMP]) -EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0]) +EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.5.2]) AC_SUBST([HAVE_LIBSECCOMP]) AC_SUBST([LIBSECCOMP_LIBS]) AC_SUBST([LIBSECCOMP_CFLAGS]) diff --git a/debian/changelog b/debian/changelog index ab9b03aefd9..14daf1b1843 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +emacs-snapshot (29~git20220222.1) unstable; urgency=medium + + * Package git snapshot. + + -- Sean Whitton <spwhitton@spwhitton.name> Thu, 24 Feb 2022 13:16:15 -0700 + emacs-snapshot (29~git20220124.1~bpo11+1~athena1) bullseye-backports; urgency=medium * Rebuild for athena's apt repository. diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 5c444fc6488..de1d5e0b2c3 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -329,6 +329,10 @@ option does this too, but other options like @samp{-q} do not. Do not include the @file{site-lisp} directories in @code{load-path} (@pxref{Init File}). The @samp{-Q} option does this too. +@item --init-directory +@opindex --init-directory +Specify the directory to use when looking for the Emacs init files. + @item --no-splash @opindex --no-splash @cindex splash screen diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index b2dd5eb6980..a3c9c7c206a 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -844,6 +844,21 @@ otherwise stated, affects only the current Emacs session. The only way to alter the variable in future sessions is to put something in your initialization file (@pxref{Init File}). + If you're setting a customizable variable in your initialization +file, and you don't want to use the Customize interface, you can use +the @code{setopt} macro. For instance: + +@findex setopt +@example +(setopt fill-column 75) +@end example + +This works the same as @code{setq}, but if the variable has any +special setter functions, they will be run automatically when using +@code{setopt}. You can also use @code{setopt} on other, +non-customizable variables, but this is less efficient than using +@code{setq}. + @node Hooks @subsection Hooks @cindex hook @@ -2219,6 +2234,22 @@ is included in the message displayed when the command is used: "It's better to use `kill-region' instead.\n") @end example +@findex command-query + As a less heavy-handed alternative to disabling commands, you may +want to be queried before executing a command. For instance, to be +queried before executing the @kbd{M->} (@code{end-of-buffer}) +command, you could put something like the following in your init file: + +@example +(command-query + 'end-of-buffer + "Do you really want to go to the end of the buffer?") +@end example + +By default, you'll be queried with a @kbd{y}/@kbd{n} question, but if +you give a non-@code{nil} value to the third, optional argument, +you'll be queried with @kbd{yes}/@kbd{no} instead. + @findex disable-command @findex enable-command You can make a command disabled either by editing the initialization @@ -2338,8 +2369,8 @@ mode when you set them with Customize, but ordinary @code{setq} won't do that; to enable the mode in your init file, call the minor mode command. Finally, a few customizable user options are initialized in complex ways, and these have to be set either via the customize -interface (@pxref{Customization}) or by using -@code{customize-set-variable} (@pxref{Examining}). +interface (@pxref{Customization}), or by using +@code{customize-set-variable}/@code{setopt} (@pxref{Examining}). The second argument to @code{setq} is an expression for the new value of the variable. This can be a constant, a variable, or a @@ -2492,7 +2523,7 @@ Change the coding system used when using the clipboard (@pxref{Communication Coding}). @example -(customize-set-variable 'selection-coding-system 'utf-8) +(setopt selection-coding-system 'utf-8) @end example @item diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 84eb7275da7..ffd8079fc15 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1467,8 +1467,8 @@ specified buffers. The command @kbd{M-x compare-windows} compares the text in the current window with that in the window that was the selected window before you selected the current one. (For more information about -windows in Emacs, @ref{Windows}.) Comparison starts at point in each -window, after pushing each initial point value on the mark ring +windows in Emacs, @pxref{Windows}.) Comparison starts at point in +each window, after pushing each initial point value on the mark ring (@pxref{Mark Ring}) in its respective buffer. Then it moves point forward in each window, one character at a time, until it reaches characters that don't match. Then the command exits. @@ -1828,6 +1828,22 @@ argument to @kbd{M-x delete-file} or @kbd{M-x delete-directory} makes them delete outright, instead of using the Trash, regardless of @code{delete-by-moving-to-trash}. + If you have @code{delete-by-moving-to-trash} set, and you want to +delete files manually in Emacs from the Trash directory, using +commands like @kbd{D} (@code{dired-do-delete}) doesn't work well in +the Trash directory (it'll just give the file a new name, but won't +delete anything). If you want to be able to do this, you should +create a @code{.dir-locals.el} file containing something like the +following in the Trash directory: + +@example +((dired-mode . ((delete-by-moving-to-trash . nil)))) +@end example + + Note, however, if you use the system ``empty trash'' command, it's +liable to also delete this @code{.dir-locals.el} file, so this should +only be done if you delete files from the Trash directory manually. + @ifnottex If a file is under version control (@pxref{Version Control}), you should delete it using @kbd{M-x vc-delete-file} instead of @kbd{M-x diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 29edbe98633..e3cfe5f8441 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -949,6 +949,7 @@ Speedbar,,speedbar, Speedbar Manual}. @node Multiple Displays @section Multiple Displays @cindex multiple displays +@cindex display server A single Emacs can talk to more than one X display. Initially, Emacs uses just one display---the one specified with the @env{DISPLAY} diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 979be34fac7..13d9269c68e 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -195,7 +195,14 @@ use the @kbd{C-o} (@code{open-line}) command (@pxref{Blank Lines}). often bound to @dfn{completion commands}, which allow you to easily fill in the desired text without typing all of it. @xref{Completion}. As with @key{RET}, you can use @kbd{C-q} to insert a @key{TAB}, -@key{SPC}, or @samp{?} character. +@key{SPC}, or @samp{?} character. If you want to make @key{SPC} and +@key{?} insert normally instead of starting completion, you can put +the following in your init file: + +@lisp +(keymap-unset minibuffer-local-completion-map "SPC") +(keymap-unset minibuffer-local-completion-map "?") +@end lisp For convenience, @kbd{C-a} (@code{move-beginning-of-line}) in a minibuffer moves point to the beginning of the argument text, not the diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index df1e5ef2381..4710c05b620 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -455,20 +455,27 @@ servers the user has connected to. If this variable is @code{t}, @cindex PostScript file @cindex OpenDocument file @cindex Microsoft Office file +@cindex EPUB file +@cindex CBZ file +@cindex FB2 file +@cindex XPS file +@cindex OXPS file @cindex DocView mode @cindex mode, DocView @cindex document viewer (DocView) @findex doc-view-mode DocView mode is a major mode for viewing DVI, PostScript (PS), PDF, -OpenDocument, and Microsoft Office documents. It provides features -such as slicing, zooming, and searching inside documents. It works by -converting the document to a set of images using the @command{gs} -(GhostScript) or @command{mudraw}/@command{pdfdraw} (MuPDF) commands -and other external tools @footnote{For PostScript files, GhostScript -is a hard requirement. For DVI files, @code{dvipdf} or @code{dvipdfm} -is needed. For OpenDocument and Microsoft Office documents, the -@code{unoconv} tool is needed.}, and displaying those images. +OpenDocument, Microsoft Office, EPUB, CBZ, FB2, XPS and OXPS +documents. It provides features such as slicing, zooming, and +searching inside documents. It works by converting the document to a +set of images using the @command{gs} (GhostScript) or +@command{pdfdraw}/@command{mutool draw} (MuPDF) commands and other +external tools @footnote{PostScript files require GhostScript, DVI +files require @code{dvipdf} or @code{dvipdfm}, OpenDocument and +Microsoft Office documents require the @code{unoconv} tool, and EPUB, +CBZ, FB2, XPS and OXPS files require @code{mutool} to be available.}, +and displaying those images. @findex doc-view-toggle-display @findex doc-view-minor-mode @@ -849,6 +856,9 @@ Restores the position of point as it was before inserting the shell-command output. @end table +In case the output buffer is not the current buffer, shell command +output is appended at the end of this buffer. + @node Interactive Shell @subsection Interactive Subshell diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index a57cfac8daf..f2d82324e94 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -422,7 +422,7 @@ characters, that disables character folding during that search. search string. To search for non-@acronym{ASCII} characters, use one of the -following methods: +following methods during incremental search: @itemize @bullet @item @@ -1874,12 +1874,12 @@ replacing regexp matches in file names. @node Other Repeating Search @section Other Search-and-Loop Commands - Here are some other commands that find matches for a regular -expression. They all ignore case in matching, if the pattern contains + Here are some other commands that find matches for regular +expressions. They all ignore case in matching, if the pattern contains no upper-case letters and @code{case-fold-search} is non-@code{nil}. Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers}, -which always search the whole buffer, all operate on the text from point -to the end of the buffer, or on the region if it is active. +which always search the whole buffer, all of the commands operate on the +text from point to the end of the buffer, or on the region if it is active. @table @kbd @findex multi-isearch-buffers @@ -1953,19 +1953,27 @@ is not considered a match. @kindex RET @r{(Occur mode)} @kindex o @r{(Occur mode)} @kindex C-o @r{(Occur mode)} -In the @file{*Occur*} buffer, you can click on each entry, or move -point there and type @key{RET}, to visit the corresponding position in -the buffer that was searched. @kbd{o} and @kbd{C-o} display the match -in another window; @kbd{C-o} does not select it. Alternatively, you -can use the @kbd{M-g M-n} (@code{next-error}) command to visit the -occurrences one by one (@pxref{Compilation Mode}). +The @file{*Occur*} buffer uses the Occur mode as its major mode. You +can use the @kbd{n} and @kbd{p} keys to move to the next or previous +match; with prefix numeric argument, these commands move that many +matches. Digit keys are bound to @code{digit-argument}, so @kbd{5 n} +moves to the fifth next match (you don't have to type @kbd{C-u}). +@key{SPC} and @key{DEL} scroll the @file{*Occur*} buffer up and down. +Clicking on a match or moving point there and typing @key{RET} visits +the corresponding position in the original buffer that was searched. +@kbd{o} and @kbd{C-o} display the match in another window; @kbd{C-o} +does not select that window. Alternatively, you can use the @kbd{M-g +M-n} (@code{next-error}) command to visit the occurrences one by one +(@pxref{Compilation Mode}). Finally, @kbd{q} quits the window showing +the @file{*Occur*} buffer and buries the buffer. @cindex Occur Edit mode @cindex mode, Occur Edit -Typing @kbd{e} in the @file{*Occur*} buffer switches to Occur Edit -mode, in which edits made to the entries are also applied to the text -in the originating buffer. Type @kbd{C-c C-c} to return to Occur -mode. +Typing @kbd{e} in the @file{*Occur*} buffer makes the buffer writable +and enters the Occur Edit mode, in which you can edit the matching +lines and have those edits reflected in the text in the originating +buffer. Type @kbd{C-c C-c} to leave the Occur Edit mode and return to +the Occur mode. @findex list-matching-lines The command @kbd{M-x list-matching-lines} is a synonym for @kbd{M-x diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index c5b54777a8c..9f152f1cc14 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1702,17 +1702,17 @@ to work with them. @table @kbd @item C-c C-o Insert @samp{\begin} and @samp{\end} for @LaTeX{} block and position -point on a line between them (@code{tex-latex-block}). +point on a line between them (@code{latex-insert-block}). @item C-c C-e Close the innermost @LaTeX{} block not yet closed -(@code{tex-close-latex-block}). +(@code{latex-close-block}). @end table -@findex tex-latex-block +@findex latex-insert-block @kindex C-c C-o @r{(@LaTeX{} mode)} In @LaTeX{} input, @samp{\begin} and @samp{\end} tags are used to group blocks of text. To insert a block, type @kbd{C-c C-o} -(@code{tex-latex-block}). This prompts for a block type, and inserts +(@code{latex-insert-block}). This prompts for a block type, and inserts the appropriate matching @samp{\begin} and @samp{\end} tags, leaving a blank line between the two and moving point there. @@ -1723,11 +1723,11 @@ completion list contains the standard @LaTeX{} block types. If you want additional block types for completion, customize the list variable @code{latex-block-names}. -@findex tex-close-latex-block +@findex latex-close-block @kindex C-c C-e @r{(@LaTeX{} mode)} @findex latex-electric-env-pair-mode In @LaTeX{} input, @samp{\begin} and @samp{\end} tags must balance. -You can use @kbd{C-c C-e} (@code{tex-close-latex-block}) to insert an +You can use @kbd{C-c C-e} (@code{latex-close-block}) to insert an @samp{\end} tag which matches the last unmatched @samp{\begin}. It also indents the @samp{\end} to match the corresponding @samp{\begin}, and inserts a newline after the @samp{\end} tag if point is at the diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index e966565f000..93f9c779dbf 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -782,10 +782,12 @@ Emacs, so you will have to report the bug somewhere else. @item The type of machine you are using, and the operating system name and -version number (again, automatically included by @kbd{M-x -report-emacs-bug}). @kbd{M-x emacs-version @key{RET}} provides this -information too. Copy its output from the @file{*Messages*} buffer, -so that you get it all and get it accurately. +version number (again, automatically included by @w{@kbd{M-x +report-emacs-bug}}). @w{@kbd{M-x emacs-version @key{RET}}} provides +this information too. Copy its output from the @file{*Messages*} +buffer, so that you get it all and get it accurately, or use +@w{@kbd{C-u M-x emacs-version @key{RET}}} to insert the version +information into the current buffer. @item The operands given to the @code{configure} command when Emacs was diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 4a3862562c2..4537f8157e8 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -442,8 +442,8 @@ selected window write: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*scratch\\*" (display-buffer-same-window)))) @end group @end example @@ -468,8 +468,8 @@ Lisp Reference Manual}) as follows: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . 0))) @end group @@ -535,8 +535,8 @@ the following form in your initialization file (@pxref{Init File}): @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*Completions\\*" display-buffer-below-selected))) @end group @end example diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index ccf7e35eee3..2c2700bc15b 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -149,6 +149,15 @@ various X toolkits (GTK+, Lucid, etc.)---we indicate below when this is the case. @table @asis +@item @code{alpha} (class @code{Alpha}) +Sets the @samp{alpha} frame parameter, determining frame transparency +(@pxref{Frame Parameters,,, elisp, The Emacs Lisp Reference Manual}). + +@item @code{alphaBackground} (class @code{AlphaBackground}) +Sets the @samp{alpha-background} frame parameter, determining background +transparency +(@pxref{Frame Parameters,,, elisp, The Emacs Lisp Reference Manual}). + @item @code{background} (class @code{Background}) Background color (@pxref{Colors}). @@ -364,6 +373,17 @@ Use some location on display specific to the input method for displaying the preview text. @end table +@item @code{synchronizeResize} (class @code{SynchronizeResize}) +If @samp{off} or @samp{false}, Emacs will not try to tell the window +manager when it has finished redrawing the display in response to a +frame being resized. Otherwise, the window manager will postpone +drawing a frame that was just resized until its contents are updated, +which prevents blank areas of a frame that have not yet been painted +from being displayed. If set to @samp{extended}, it will enable use +of an alternative frame synchronization protocol, which might be +supported by some compositing window managers that don't support the +protocol Emacs uses by default. + @item @code{verticalScrollBars} (class @code{ScrollBars}) Give frames scroll bars on the left if @samp{left}, on the right if @samp{right}; don't have scroll bars if @samp{off} (@pxref{Scroll Bars}). diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in index d554f3d7a68..42e6d2c1c87 100644 --- a/doc/lispintro/Makefile.in +++ b/doc/lispintro/Makefile.in @@ -63,7 +63,7 @@ ENVADD = \ MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)" DVI_TARGETS = emacs-lisp-intro.dvi -HTML_TARGETS = emacs-lisp-intro.html +HTML_TARGETS = eintr.html PDF_TARGETS = emacs-lisp-intro.pdf PS_TARGETS = emacs-lisp-intro.ps @@ -95,7 +95,7 @@ emacs-lisp-intro.dvi: ${srcs} emacs-lisp-intro.pdf: ${srcs} $(ENVADD) $(TEXI2PDF) $< -emacs-lisp-intro.html: ${srcs} +eintr.html: ${srcs} $(AM_V_GEN)$(MAKEINFO) $(MAKEINFO_OPTS) $(HTML_OPTS) -o $@ $< emacs-lisp-intro.ps: emacs-lisp-intro.dvi diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 9d4520b040e..466d7f0e604 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -1,8 +1,6 @@ \input texinfo @c -*- mode: texinfo; coding: utf-8 -*- @comment %**start of header @setfilename ../../info/eintr.info -@c setfilename emacs-lisp-intro.info -@c sethtmlfilename emacs-lisp-intro.html @settitle Programming in Emacs Lisp @include docstyle.texi @syncodeindex vr cp diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 01aa1e1fa4b..a1628eabaa2 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -3945,6 +3945,15 @@ what happens when a disabled command is invoked interactively. Disabling a command has no effect on calling it as a function from Lisp programs. +@findex command-query + The value of the @code{disabled} property can also be a list where +the first element is the symbol @code{query}. In that case, the user +will be queried whether to execute the command. The second element in +the list should be @code{nil} or non-@code{nil} to say whether to use +@code{y-or-n-p} or @code{yes-or-no-p}, respectively, and the third +element is the question to use. The @code{command-query} convenience +function should be used to enable querying for a command. + @deffn Command enable-command command Allow @var{command} (a symbol) to be executed without special confirmation from now on, and alter the user's init file (@pxref{Init diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 2b6ec849d28..3670225dc49 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -61,7 +61,7 @@ Here is an example: @group (silly-loop 50000000) -@result{} 10.235304117202759 +@result{} 5.200886011123657 @end group @group @@ -71,12 +71,12 @@ Here is an example: @group (silly-loop 50000000) -@result{} 3.705854892730713 +@result{} 0.6239290237426758 @end group @end example - In this example, the interpreted code required 10 seconds to run, -whereas the byte-compiled code required less than 4 seconds. These + In this example, the interpreted code required more than 5 seconds to run, +whereas the byte-compiled code required less than 1 second. These results are representative, but actual results may vary. @node Compilation Functions @@ -135,10 +135,10 @@ definition of @var{symbol} (@pxref{Byte-Code Objects}). @group (byte-compile 'factorial) @result{} -#[(integer) - "^H\301U\203^H^@@\301\207\302^H\303^HS!\"\207" - [integer 1 * factorial] - 4 "Compute factorial of INTEGER."] +#[257 + "\211\300U\203^H^@@\300\207\211\301^BS!_\207" + [1 factorial] 4 + "Compute factorial of INTEGER.\n\n(fn INTEGER)"] @end group @end example @@ -688,11 +688,11 @@ Lisp source; these do not appear in the output of @code{disassemble}. (disassemble 'factorial) @print{} byte-code for factorial: doc: Compute factorial of an integer. - args: (integer) + args: (arg1) @end group @group -0 varref integer ; @r{Get the value of @code{integer} and} +0 dup ; @r{Get the value of @code{integer} and} ; @r{push it onto the stack.} 1 constant 1 ; @r{Push 1 onto stack.} @end group @@ -707,9 +707,9 @@ Lisp source; these do not appear in the output of @code{disassemble}. 7 return ; @r{Return the top element of the stack.} @end group @group -8:1 varref integer ; @r{Push value of @code{integer} onto stack.} +8:1 dup ; @r{Push value of @code{integer} onto stack.} 9 constant factorial ; @r{Push @code{factorial} onto stack.} -10 varref integer ; @r{Push value of @code{integer} onto stack.} +10 stack-ref 2 ; @r{Push value of @code{integer} onto stack.} 11 sub1 ; @r{Pop @code{integer}, decrement value,} ; @r{push new value onto stack.} 12 call 1 ; @r{Call function @code{factorial} using first} @@ -717,9 +717,9 @@ Lisp source; these do not appear in the output of @code{disassemble}. ; @r{push returned value onto stack.} @end group @group -13 mult ; @r{Pop top two values off stack, multiply} +13 mult ; @r{Pop top two values off stack, multiply} ; @r{them, and push result onto stack.} -14 return ; @r{Return the top element of the stack.} +14 return ; @r{Return the top element of the stack.} @end group @end example @@ -740,7 +740,7 @@ The @code{silly-loop} function is somewhat more complex: (disassemble 'silly-loop) @print{} byte-code for silly-loop: doc: Return time before and after N iterations of a loop. - args: (n) + args: (arg1) @end group @group @@ -749,24 +749,21 @@ The @code{silly-loop} function is somewhat more complex: @end group @group 1 call 0 ; @r{Call @code{current-time-string} with no} - ; @r{argument, push result onto stack.} + ; @r{argument, push result onto stack as @code{t1}.} @end group @group -2 varbind t1 ; @r{Pop stack and bind @code{t1} to popped value.} -@end group -@group -3:1 varref n ; @r{Get value of @code{n} from the environment} +2:1 stack-ref 1 ; @r{Get value of the argument @code{n}} ; @r{and push the value on the stack.} -4 sub1 ; @r{Subtract 1 from top of stack.} +3 sub1 ; @r{Subtract 1 from top of stack.} @end group @group -5 dup ; @r{Duplicate top of stack; i.e., copy the top} +4 dup ; @r{Duplicate top of stack; i.e., copy the top} ; @r{of the stack and push copy onto stack.} -6 varset n ; @r{Pop the top of the stack,} - ; @r{and bind @code{n} to the value.} +5 stack-set 3 ; @r{Pop the top of the stack,} + ; @r{and set @code{n} to the value.} -;; @r{(In effect, the sequence @code{dup varset} copies the top of the stack} -;; @r{into the value of @code{n} without popping it.)} +;; @r{(In effect, the sequence @code{dup stack-set} copies the top of} +;; @r{the stack into the value of @code{n} without popping it.)} @end group @group @@ -781,16 +778,15 @@ The @code{silly-loop} function is somewhat more complex: ; @r{else continue.} @end group @group -12 varref t1 ; @r{Push value of @code{t1} onto stack.} +12 dup ; @r{Push value of @code{t1} onto stack.} 13 constant current-time-string ; @r{Push @code{current-time-string}} ; @r{onto the top of the stack.} 14 call 0 ; @r{Call @code{current-time-string} again.} @end group @group -15 unbind 1 ; @r{Unbind @code{t1} in local environment.} -16 list2 ; @r{Pop top two elements off stack, create a} +15 list2 ; @r{Pop top two elements off stack, create a} ; @r{list of them, and push it onto stack.} -17 return ; @r{Return value of the top of stack.} +16 return ; @r{Return value of the top of stack.} @end group @end example diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 634d46a7854..2f1666ba771 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1326,6 +1326,20 @@ Assign values to variables in a @code{setq} form, destructuring each @var{value} according to its respective @var{pattern}. @end defmac +@defmac pcase-lambda lambda-list &rest body +This is like @code{lambda}, but allows each argument to be a pattern. +For instance, here's a simple function that takes a cons cell as the +argument: + +@example +(setq fun + (pcase-lambda (`(,key . ,val)) + (vector key (* val 10)))) +(funcall fun '(foo . 2)) + @result{} [foo 20] +@end example +@end defmac + @node Iteration @section Iteration @cindex iteration diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9020b98a1eb..48170348e32 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -612,6 +612,16 @@ how to display a message and prevent it from being logged: @end example @end defopt +@defvar messages-buffer-name +This variable has the name of the buffer where messages should be +logged to, and defaults to @file{*Messages*}. Some packages may find +it useful to temporarily redirect the output to a different buffer +(perhaps to write the buffer out to a log file later), and they can +bind this variable to a different buffer name. (Note that this buffer +(if it doesn't exist already), will be created and put into +@code{messages-buffer-mode}.) +@end defvar + To make @file{*Messages*} more convenient for the user, the logging facility combines successive identical messages. It also combines successive related messages for the sake of two cases: question @@ -2644,9 +2654,10 @@ used automatically to handle certain shades of gray. @item :font The font used to display the face. Its value should be a font object -or a fontset. @xref{Low-Level Font}, for information about font -objects, font specs, and font entities. @xref{Fontsets}, for -information about fontsets. +or a fontset. If it is a font object, it specifies the font to be +used by the face for displaying ASCII characters. @xref{Low-Level +Font}, for information about font objects, font specs, and font +entities. @xref{Fontsets}, for information about fontsets. @anchor{face-font-attribute} When specifying this attribute using @code{set-face-attribute} or @@ -3090,13 +3101,19 @@ return value is always specified, use a value of @code{default} for @var{inherit}. @defun face-font face &optional frame character -This function returns the name of the font of face @var{face}. +This function returns the name of the font used by the specified +@var{face}. If the optional argument @var{frame} is specified, it returns the name -of the font of @var{face} for that frame. If @var{frame} is omitted or -@code{nil}, the selected frame is used. In the latter case, if the -optional third argument @var{character} is supplied, it returns the font -name used for @var{character}. +of the font of @var{face} for that frame; @var{frame} defaults to the +selected frame if it is @code{nil} or omitted. If @var{frame} is +@code{t}, the function reports on the font defaults for @var{face} to +be used for new frames. + +By default, the returned font is for displaying ASCII characters, but +if @var{frame} is anything but @code{t}, and the optional third +argument @var{character} is supplied, the function returns the font +name used by @var{face} for that character. @end defun @defun face-foreground face &optional frame inherit @@ -3303,6 +3320,16 @@ if you need to remove the remapping later. ;; Increase the size of the 'default' face by 50%: (face-remap-add-relative 'default :height 1.5) @end example + +Note that buffer-local face remapping does not work reliably for +parent faces of basic faces (@pxref{Basic Faces}). (These are the +faces that are used in mode lines, header lines, and other basic +decorations of windows and frames.) For instance, +@code{mode-line-inactive} inherits from @code{mode-line}, but +remapping @code{mode-line} won't normally have the desired effect on +@code{mode-line-inactive}, especially if done locally for some +buffers. Instead you have to remap @code{mode-line-inactive} +directly. @end defun @defun face-remap-remove-relative cookie @@ -3428,10 +3455,10 @@ usually assign faces to around 400 to 600 characters at each call. If your Emacs Lisp program needs to assign some faces to text, it is often a good idea to use certain existing faces or inherit from them, rather than defining entirely new faces. This way, if other users -have customized the basic faces to give Emacs a certain look, your -program will fit in without additional customization. +have customized those existing faces to give Emacs a certain look, +your program will fit in without additional customization. - Some of the basic faces defined in Emacs are listed below. In + Some of the @dfn{basic faces} defined in Emacs are listed below. In addition to these, you might want to make use of the Font Lock faces for syntactic highlighting, if highlighting is not already handled by Font Lock mode, or if some Font Lock faces are not in use. @@ -3443,6 +3470,28 @@ The default face, whose attributes are all specified. All other faces implicitly inherit from it: any unspecified attribute defaults to the attribute on this face (@pxref{Face Attributes}). +@item mode-line-active +@itemx mode-line-inactive +@itemx header-line +@itemx tab-line +Basic faces used for the mode line, header line, and tab line. + +@item tool-bar +@itemx tab-bar +@itemx fringe +@itemx scroll-bar +@itemx window-divider +@itemx border +@itemx child-frame-border +Basic faces used for the corresponding decorations of GUI frames. + +@item cursor +The basic face used for the text cursor. + +@item mouse +The basic face used for displaying mouse-sensitive text when the mouse +pointer is on that text. + @item bold @itemx italic @itemx bold-italic @@ -5229,7 +5278,7 @@ is partitioned using the identity of the parameter, which is why the parameter is a list with one element. For instance: @lisp -(insert (propertize "foo" '(display (min-width (6.0))))) +(insert (propertize "foo" 'display '(min-width (6.0)))) @end lisp This will add padding after @samp{foo} bringing the total width up to @@ -6619,7 +6668,9 @@ buffer's text. The argument @var{slice} specifies a slice of the image to insert. If @var{slice} is @code{nil} or omitted the whole image is inserted. -Otherwise, @var{slice} is a list @code{(@var{x} @var{y} @var{width} +(However, note that images are chopped on display at the window's +right edge, because wrapping images is not supported.) Otherwise, +@var{slice} is a list @code{(@var{x} @var{y} @var{width} @var{height})} which specifies the @var{x} and @var{y} positions and @var{width} and @var{height} of the image area to insert. Integer values are in units of pixels. A floating-point number in the range @@ -7300,7 +7351,7 @@ current buffer, and returns it. @end defun @defun insert-button label &rest properties -This insert a button with the label @var{label} at point, +This inserts a button with the label @var{label} at point, and returns it. @end defun diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 2eeb8b7ed74..f8188708e5d 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2433,6 +2433,16 @@ opacity when it is not selected. Some window systems do not support the @code{alpha} parameter for child frames (@pxref{Child Frames}). + +@vindex alpha-background@r{, a frame parameter} +@item alpha-background +@cindex opacity, frame +@cindex transparency, frame +Sets the background transparency of the frame. Unlike the @code{alpha} +frame parameter, this only controls the transparency of the background +while keeping foreground elements such as text fully opaque. It +should be an integer between 0 and 100, where 0 means +completely transparent and 100 means completely opaque (default). @end table The following frame parameters are semi-obsolete in that they are @@ -3744,6 +3754,13 @@ still use a menu keymap to implement it. To make the contents vary, add a hook function to @code{menu-bar-update-hook} to update the contents of the menu keymap as necessary. +@defvar x-pre-popup-menu-hook + A normal hook run immediately before a pop-up menu is displayed, +either directly by calling @code{x-popup-menu}, or through a menu +keymap. It won't be called if @code{x-popup-menu} returns for some +other reason without displaying a pop-up menu. +@end defvar + @node Dialog Boxes @section Dialog Boxes @cindex dialog boxes diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 2378e9efd7e..207919ea645 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -2153,8 +2153,8 @@ worry about how many times the body uses the arguments, as you do for macros. Alternatively, you can define a function by providing the code which -will inline it as a compiler macro. The following macros make this -possible. +will inline it as a compiler macro (@pxref{Declare Form}). The +following macros make this possible. @c FIXME: Can define-inline use the interactive spec? @defmac define-inline name args [doc] [declare] body@dots{} @@ -2310,6 +2310,7 @@ which case the warning message gives no extra details). @var{when} should be a string indicating when the function or macro was first made obsolete. +@cindex compiler macro @item (compiler-macro @var{expander}) This can only be used for functions, and tells the compiler to use @var{expander} as an optimization function. When encountering a call to the diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index bc73ff28a69..0037922aeda 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1637,7 +1637,7 @@ This function returns the value of a Lisp float specified by @var{arg}, as a C @code{double} value. @end deftypefn -@deftypefn Function struct timespec extract_time (emacs_env *@var{env}, emacs_value @var{arg}) +@deftypefn Function {struct timespec} extract_time (emacs_env *@var{env}, emacs_value @var{arg}) This function, which is available since Emacs 27, interprets @var{arg} as an Emacs Lisp time value and returns the corresponding @code{struct timespec}. @xref{Time of Day}. @code{struct timespec} represents a @@ -1942,7 +1942,7 @@ garbage-collected. Don't run any expensive code in a finalizer, because GC must finish quickly to keep Emacs responsive. @end deftypefn -@deftypefn Function void *get_user_ptr (emacs_env *@var{env}, emacs_value @var{arg}) +@deftypefn Function {void *}get_user_ptr (emacs_env *@var{env}, emacs_value @var{arg}) This function extracts the C pointer from the Lisp object represented by @var{arg}. @end deftypefn diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 5957b8ac385..68cd74c7d16 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1067,13 +1067,8 @@ list elements have these forms: The symbol @var{var} was defined as a variable. @item (defun . @var{fun}) The function @var{fun} was defined. -@item (t . @var{fun}) -The function @var{fun} was previously an autoload before this library -redefined it as a function. The following element is always @code{(defun . @var{fun})}, which represents defining @var{fun} as a function. -@item (autoload . @var{fun}) -The function @var{fun} was defined as an autoload. @item (defface . @var{face}) The face @var{face} was defined. @item (require . @var{feature}) @@ -1096,6 +1091,23 @@ The value of @code{load-history} may have one element whose @sc{car} is by adding the symbols defined to the element for the file being visited, rather than replacing that element. @xref{Eval}. +@kindex function-history @r{(function symbol property)} +In addition to @code{load-history}, every function keeps track of its +own history in the symbol property @code{function-history}. +The reason why functions are treated specially in this respect is that +it is common for functions to be defined in two steps in two different +files (typically, one of them is an autoload), so in order to be +able to properly @emph{unload} a file, we need to know more precisely +what that file did to the function definition. + +The symbol property @code{function-history} holds a list of the form +@w{@code{(@var{file1} @var{def2} @var{file2} @var{def3} ...)}}, where +@var{file1} is the last file that changed the definition and +@var{def2} was the definition before @var{file1}, set by @var{file2}, +etc. Logically this list should end with the name of the first file +that defined this function, but to save space this last element +is usually omitted. + @node Unloading @section Unloading @cindex unloading packages @@ -1110,7 +1122,7 @@ It undefines all functions, macros, and variables defined in that library with @code{defun}, @code{defalias}, @code{defsubst}, @code{defmacro}, @code{defconst}, @code{defvar}, and @code{defcustom}. It then restores any autoloads formerly associated with those symbols. -(Loading saves these in the @code{autoload} property of the symbol.) +(Loading saves these in the @code{function-history} property of the symbol.) Before restoring the previous definitions, @code{unload-feature} runs @code{remove-hook} to remove functions defined by the library from certain diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index e2b39836e66..c29936d5caa 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1061,12 +1061,22 @@ very end of every properly-written major mode command. @cindex Tabulated List mode Tabulated List mode is a major mode for displaying tabulated data, -i.e., data consisting of @dfn{entries}, each entry occupying one row of -text with its contents divided into columns. Tabulated List mode +i.e., data consisting of @dfn{entries}, each entry occupying one row +of text with its contents divided into columns. Tabulated List mode provides facilities for pretty-printing rows and columns, and sorting the rows according to the values in each column. It is derived from Special mode (@pxref{Basic Major Modes}). +@findex make-vtable +@cindex variable pitch tables + Tabulated List mode is geared towards displaying text using +monospaced fonts, using a single font and text size. If you want to +display a table using variable pitch fonts or images, +@code{make-vtable} can be used instead. vtable also support having +more than a single table in a buffer, or having a buffer that contains +both a table and additional text in it. @xref{Introduction,,, vtable}, +for more information. + Tabulated List mode is intended to be used as a parent mode by a more specialized major mode. Examples include Process Menu mode (@pxref{Process Information}) and Package Menu mode (@pxref{Package @@ -1964,8 +1974,26 @@ This function also forces an update of the menu bar and frame title. @end defun The selected window's mode line is usually displayed in a different -color using the face @code{mode-line}. Other windows' mode lines appear -in the face @code{mode-line-inactive} instead. @xref{Faces}. +color using the face @code{mode-line-active}. Other windows' mode +lines appear in the face @code{mode-line-inactive} instead. +@xref{Faces}. + +@defun mode-line-window-selected-p +If you want to have more extensive differences between the mode lines +in selected and non-selected windows, you can use this predicate in an +@code{:eval} construct. For instance, if you want to display the +buffer name in bold in selected windows, but in italics in the other +windows, you can say something like: + +@lisp +(setq-default + mode-line-buffer-identification + '(:eval (propertize "%12b" + 'face (if (mode-line-window-selected-p) + 'bold + 'italic)))) +@end lisp +@end defun @vindex mode-line-compact Some modes put a lot of data in the mode line, pushing elements at diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 3750abc4e8a..9cb9bc75d04 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -363,6 +363,9 @@ Do not load the @file{site-start} library. @itemx -Q Equivalent to @samp{-q --no-site-file --no-splash}. @c and --no-site-lisp, but let's not mention that here. + +@item --init-directory +Specify the directory to use when finding the Emacs init files. @end table diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 37cf376bd53..7897adeb053 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -1731,8 +1731,9 @@ filling when @var{justify} is non-@code{nil}. If @var{nosqueeze} is non-@code{nil}, that means to leave whitespace other than line breaks untouched. If @var{squeeze-after} is -non-@code{nil}, it specifies a position in the region, and means don't -canonicalize spaces before that position. +non-@code{nil}, it specifies a position in the region, and means +that whitespace other than line breaks should be left untouched before +that position. In Adaptive Fill mode, this command calls @code{fill-context-prefix} to choose a fill prefix by default. @xref{Adaptive Fill}. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 34c73e70b72..d991ae9e277 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -861,6 +861,40 @@ error is signaled. @end example @end defun +@defmac setopt [symbol form]@dots{} +This is like @code{setq} (see above), but meant for user options. +This macro uses the Customize machinery to set the variable(s). In +particular, @code{setopt} will run the setter function associated with +the variable. For instance, if you have: + +@example +@group +(defcustom my-var 1 + "My var." + :type 'number + :set (lambda (var val) + (set-default var val) + (message "We set %s to %s" var val))) +@end group +@end example + +@noindent +then the following, in addition to setting @code{my-var} to @samp{2}, +will also issue a message: + +@example +(setopt my-var 2) +@end example + +@code{setopt} also checks whether the value is valid for the user +option. For instance, using @code{setopt} to set a user option +defined with a @code{number} type to a string will signal an error. + +The @code{setopt} macro can be used on regular, non-user option +variables, but is much less efficient than @code{setq}. The main use +case for this macro is setting user options in the user's init file. +@end defmac + @node Watching Variables @section Running a function when a variable is changed. @cindex variable watchpoints @@ -2263,11 +2297,11 @@ list in @var{variables} is an alist of the form @end example @end defun -@defvar connection-local-profile-alist +@deffn {User Option} connection-local-profile-alist This alist holds the connection profile symbols and the associated variable settings. It is updated by @code{connection-local-set-profile-variables}. -@end defvar +@end deffn @defun connection-local-set-profiles criteria &rest profiles This function assigns @var{profiles}, which are symbols, to all remote @@ -2321,11 +2355,11 @@ Therefore, the example above would be equivalent to defined by @code{connection-local-set-profile-variables}. @end defun -@defvar connection-local-criteria-alist +@deffn {User Option} connection-local-criteria-alist This alist contains connection criteria and their assigned profile names. The function @code{connection-local-set-profiles} updates this list. -@end defvar +@end deffn @defun hack-connection-local-variables criteria This function collects applicable connection-local variables diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index bbf8988e5c4..43f222d57ff 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3377,8 +3377,8 @@ functions it should try instead as, for example: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-same-window display-buffer-in-previous-window display-buffer-use-some-window))) @@ -3392,8 +3392,8 @@ Instead of customizing this variable to @code{t}, customize @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . 0))) @end group @@ -3409,8 +3409,8 @@ specifying the action function @code{display-buffer-same-window}. @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist (cons '("\\*foo\\*" (display-buffer-same-window)) display-buffer-alist)) @end group @@ -3483,8 +3483,8 @@ another frame. Such a user might provide the following customization: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '((display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . 0))) @end group @@ -3529,8 +3529,8 @@ In fact, this: @example @group -(customize-set-variable - 'display-buffer-base-action +(setopt + display-buffer-base-action '(display-buffer-pop-up-frame (reusable-frames . 0))) @end group @end example @@ -3586,8 +3586,8 @@ by customizing the option @code{display-buffer-alist} as follows: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-reuse-window display-buffer-pop-up-frame)))) @end group @@ -3609,8 +3609,8 @@ we would have to specify that separately, however: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-reuse-window display-buffer-pop-up-frame) (reusable-frames . visible)))) @@ -3716,8 +3716,8 @@ written that as @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-reuse-window display-buffer-pop-up-frame) (inhibit-same-window . t) @@ -3860,8 +3860,8 @@ follows: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-below-selected display-buffer-at-bottom) (inhibit-same-window . t) @@ -3874,8 +3874,8 @@ To add a customization for a second buffer one would then write: @example @group -(customize-set-variable - 'display-buffer-alist +(setopt + display-buffer-alist '(("\\*foo\\*" (display-buffer-below-selected display-buffer-at-bottom) (inhibit-same-window . t) diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index d348dbc194b..d9c5173c072 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -73,8 +73,8 @@ INFO_COMMON = auth autotype bovine calc ccmode cl \ flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \ mairix-el message mh-e modus-themes newsticker nxml-mode octave-mode \ org pcl-cvs pgg rcirc remember reftex sasl \ - sc semantic ses sieve smtpmail speedbar srecode todo-mode tramp \ - url vhdl-mode vip viper widget wisent woman + sc semantic ses sieve smtpmail speedbar srecode todo-mode transient \ + tramp url vhdl-mode vip viper vtable widget wisent woman ## Info files to install on current platform. INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_W32) diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index d81ba158a19..39b09b29b3f 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -1866,7 +1866,8 @@ These variables specify the options to pass to the above utilities. In @code{ediff-diff-options}, it may be useful to specify options such as @samp{-w} that ignore certain kinds of changes. However, Ediff does not let you use the option @samp{-c}, as it doesn't recognize this -format yet. +format yet. (If you alter this variable, it should be done via the +Customize interface instead of using @code{setq} directly.) @item ediff-coding-system-for-read @vindex ediff-coding-system-for-read diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index ed8a919ac7e..5d4d378d82a 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3376,56 +3376,13 @@ bottom of files by setting the variable @code{enable-local-eval}. @xref{File Variables,,, emacs, The GNU Emacs Manual}. @item -Synthetic X events. (Yes, a risk; use @samp{MIT-MAGIC-COOKIE-1} or -better.) - -Emacs accepts synthetic X events generated by the @code{SendEvent} -request as though they were regular events. As a result, if you are -using the trivial host-based authentication, other users who can open X -connections to your X workstation can make your Emacs process do -anything, including run other processes with your privileges. - -The only fix for this is to prevent other users from being able to open -X connections. The standard way to prevent this is to use a real -authentication mechanism, such as @samp{MIT-MAGIC-COOKIE-1}. If using -the @code{xauth} program has any effect, then you are probably using -@samp{MIT-MAGIC-COOKIE-1}. Your site may be using a superior -authentication method; ask your system administrator. - -If real authentication is not a possibility, you may be satisfied by -just allowing hosts access for brief intervals while you start your X -programs, then removing the access. This reduces the risk somewhat by -narrowing the time window when hostile users would have access, but -@emph{does not eliminate the risk}. - -On most computers running Unix and X, you enable and disable -access using the @code{xhost} command. To allow all hosts access to -your X server, use +Browsing the web. -@example -xhost + -@end example - -@noindent -at the shell prompt, which (on an HP machine, at least) produces the -following message: - -@example -access control disabled, clients can connect from any host -@end example - -To deny all hosts access to your X server (except those explicitly -allowed by name), use - -@example -xhost - -@end example - -On the test HP computer, this command generated the following message: - -@example -access control enabled, only authorized clients can connect -@end example +Emacs relies on C libraries to parse images, and historically, many of +these have had exploitable weaknesses. If you're browsing the web +with the eww browser, it will usually download and display images +using these libraries. If an image library has a weakness, it may be +used by an attacker to gain access. @end itemize diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index e9cf4cfade9..7c37ae55055 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -286,14 +286,14 @@ LDAP: @lisp (with-eval-after-load "message" (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) -(customize-set-variable 'eudc-server-hotlist - '(("" . bbdb) - ("ldaps://ldap.gnu.org" . ldap))) -(customize-set-variable 'ldap-host-parameters-alist - '(("ldaps://ldap.gnu.org" - base "ou=people,dc=gnu,dc=org" - binddn "gnu\\emacsuser" - passwd ldap-password-read))) +(setopt eudc-server-hotlist + '(("" . bbdb) + ("ldaps://ldap.gnu.org" . ldap))) +(setopt 'ldap-host-parameters-alist + '(("ldaps://ldap.gnu.org" + base "ou=people,dc=gnu,dc=org" + binddn "gnu\\emacsuser" + passwd ldap-password-read))) @end lisp @findex ldap-password-read @@ -342,12 +342,12 @@ configure EUDC for LDAP: @lisp (with-eval-after-load "message" (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) -(customize-set-variable 'eudc-server-hotlist - '(("" . bbdb) - ("ldaps://ldap.gnu.org" . ldap))) -(customize-set-variable 'ldap-host-parameters-alist - '(("ldaps://ldap.gnu.org" - auth-source t))) +(setopt 'eudc-server-hotlist + '(("" . bbdb) + ("ldaps://ldap.gnu.org" . ldap))) +(setopt 'ldap-host-parameters-alist + '(("ldaps://ldap.gnu.org" + auth-source t))) @end lisp For this example where we only care about one server, the server name @@ -371,10 +371,10 @@ and the @file{.emacs} expressions become: @lisp (with-eval-after-load "message" (define-key message-mode-map (kbd "TAB") 'eudc-expand-inline)) -(customize-set-variable 'eudc-server-hotlist - '(("" . bbdb) ("" . ldap))) -(customize-set-variable 'ldap-host-parameters-alist - '(("" auth-source t))) +(setopt 'eudc-server-hotlist + '(("" . bbdb) ("" . ldap))) +(setopt 'ldap-host-parameters-alist + '(("" auth-source t))) @end lisp @node Troubleshooting diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 14a8c4c12d6..630aaa282ff 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -100,10 +100,9 @@ misprints are the Gnus team's fault, sorry. * FAQ 1-1:: What is the latest version of Gnus? * FAQ 1-2:: What's new in 5.10? * FAQ 1-3:: Where and how to get Gnus? -* FAQ 1-4:: What to do with the tarball now? -* FAQ 1-5:: I sometimes read references to No Gnus and Oort Gnus, +* FAQ 1-4:: I sometimes read references to No Gnus and Oort Gnus, what are those? -* FAQ 1-6:: Which version of Emacs do I need? +* FAQ 1-5:: Which version of Emacs do I need? @end menu @node FAQ 1-1 @@ -165,34 +164,6 @@ Gnus is bundled with Emacs. @node FAQ 1-4 @subsubheading Question 1.4 -What to do with the tarball now? - -@subsubheading Answer - -Untar it via @samp{tar xvzf gnus.tar.gz} and do the common -@samp{./configure; make; make install} circle. -(under MS-Windows either get the Cygwin environment from -@uref{https://www.cygwin.com} -which allows you to do what's described above or unpack the -tarball with some packer (e.g., Winace) -and use the batch-file make.bat included in the tarball to install -Gnus.) If you don't want to (or aren't allowed to) install Gnus -system-wide, you can install it in your home directory and add the -following lines to your ~/.emacs: - -@example -(add-to-list 'load-path "/path/to/gnus/lisp") -(add-to-list 'Info-default-directory-list "/path/to/gnus/texi/") -@end example -@noindent - -Make sure that you don't have any Gnus related stuff -before this line, on MS Windows use something like -"C:/path/to/lisp" (yes, "/"). - -@node FAQ 1-5 -@subsubheading Question 1.5 - I sometimes read references to No Gnus and Oort Gnus, what are those? @@ -205,8 +176,8 @@ once become Gnus 5.12 or Gnus 6. (If you're wondering why not 5.11, the odd version numbers are normally used for the Gnus versions bundled with Emacs) -@node FAQ 1-6 -@subsubheading Question 1.6 +@node FAQ 1-5 +@subsubheading Question 1.5 Which version of Emacs do I need? @@ -653,8 +624,7 @@ about the server there. (add-to-list 'gnus-secondary-select-methods '(nnimap "Give the baby a name" (nnimap-address "imap.yourProvider.net") - (nnimap-port 143) - (nnimap-list-pattern "archive.*"))) + (nnimap-port 143))) @end example @noindent diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 306d66de64e..a3def495c44 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -21674,7 +21674,9 @@ engine. @item remove-prefix The directory part to be removed from the filenames returned by the search query. This absolute path should include everything up to the -top level of the message store. +top level of the message store. Note that this is the path to the +location of the actual messages, not to the search engine's indexes +(nor, in the case of Mairix, to its symlink directories). @item switches Additional command-line switches to be fed to the search program. The @@ -24139,37 +24141,22 @@ If you want to see them in the Cc and To fields, set: @end lisp -@subsubsection Toolbar +@subsubsection Tool bar @table @code -@item gnus-use-toolbar -@vindex gnus-use-toolbar -This variable specifies the position to display the toolbar. If -@code{nil}, don't display toolbars. If it is non-@code{nil}, it should -be one of the symbols @code{default}, @code{top}, @code{bottom}, -@code{right}, and @code{left}. @code{default} means to use the default -toolbar, the rest mean to display the toolbar on the place which those -names show. The default is @code{default}. - -@item gnus-toolbar-thickness -@vindex gnus-toolbar-thickness -Cons of the height and the width specifying the thickness of a toolbar. -The height is used for the toolbar displayed on the top or the bottom, -the width is used for the toolbar displayed on the right or the left. -The default is that of the default toolbar. - -@item gnus-group-toolbar -@vindex gnus-group-toolbar -The toolbar in the group buffer. - -@item gnus-summary-toolbar -@vindex gnus-summary-toolbar -The toolbar in the summary buffer. - -@item gnus-summary-mail-toolbar -@vindex gnus-summary-mail-toolbar -The toolbar in the summary buffer of mail groups. +@item gnus-group-tool-bar +@vindex gnus-group-tool-bar +Specifies the tool bar in the group buffer. It can be either a list +or a symbol referring to a list. Pre-defined symbols include +@code{gnus-group-tool-bar-gnome} and @code{gnus-group-tool-bar-retro}. + +@item gnus-summary-tool-bar +@vindex gnus-summary-tool-bar +Specifies the tool bar in the summary buffer. It can be either a list +or a symbol referring to a list. Pre-defined symbols include +@code{gnus-summary-tool-bar-gnome} and +@code{gnus-summary-tool-bar-retro}. @end table diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index 35bc8853fd3..a3bc4684135 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.0.0 -#+macro: release-date 2021-12-24 -#+macro: development-version 2.1.0-dev +#+macro: stable-version 2.1.0 +#+macro: release-date 2022-02-17 +#+macro: development-version 2.2.0-dev #+macro: file @@texinfo:@file{@@$1@@texinfo:}@@ #+macro: space @@texinfo:@: @@ #+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@ @@ -42,7 +42,7 @@ Current development target is {{{development-version}}}. :custom_id: h:b14c3fcb-13dd-4144-9d92-2c58b3ed16d3 :end: -Copyright (C) 2020-2022 Free Software Foundation, Inc. +Copyright (C) 2020-2022 Free Software Foundation, Inc. #+begin_quote Permission is granted to copy, distribute and/or modify this document @@ -416,7 +416,6 @@ this manual. modus-themes-bold-constructs nil modus-themes-mixed-fonts nil modus-themes-subtle-line-numbers nil - modus-themes-intense-markup t modus-themes-deuteranopia t modus-themes-tabs-accented t modus-themes-variable-pitch-ui nil @@ -435,6 +434,11 @@ this manual. ;; `accented', and a natural number for extra padding modus-themes-mode-line '(4 accented borderless) + ;; Options for `modus-themes-markup' are either nil, or a list + ;; that can combine any of `bold', `italic', `background', + ;; `intense'. + modus-themes-markup '(background italic) + ;; Options for `modus-themes-syntax' are either nil (the default), ;; or a list of properties that may include any of those symbols: ;; `faint', `yellow-comments', `green-strings', `alt-syntax' @@ -456,14 +460,21 @@ this manual. ;; `bold', `italic', `background' modus-themes-links '(neutral-underline background) + ;; Options for `modus-themes-box-buttons' are either nil (the + ;; default), or a list that can combine any of `flat', `accented', + ;; `faint', `variable-pitch', `underline', the symbol of any font + ;; weight as listed in `modus-themes-weights', and a floating + ;; point number (e.g. 0.9) for the height of the button's text. + modus-themes-box-buttons '(variable-pitch flat faint 0.9) + ;; Options for `modus-themes-prompts' are either nil (the ;; default), or a list of properties that may include any of those ;; symbols: `background', `bold', `gray', `intense', `italic' modus-themes-prompts '(intense bold) - modus-themes-completions 'moderate ; {nil,'moderate,'opinionated} + modus-themes-completions 'moderate ; {nil,'moderate,'opinionated,'super-opinionated} - modus-themes-mail-citations nil ; {nil,'faint,'monochrome} + modus-themes-mail-citations nil ; {nil,'intense,'faint,'monochrome} ;; Options for `modus-themes-region' are either nil (the default), ;; or a list of properties that may include any of those symbols: @@ -711,7 +722,7 @@ possible options are ~org-variable-pitch~ and ~mixed-pitch~. :properties: :alt_title: Link styles :description: Choose among several styles, with or without underline -:custom_id: h:c119d7b2-fcd4-4e44-890e-5e25733d5e52 +:custom_id: h:5808be52-361a-4d18-88fd-90129d206f9b :end: #+vindex: modus-themes-links @@ -780,6 +791,89 @@ controlled by ~x-use-underline-position-properties~, ~x-underline-at-descent-line~, ~underline-minimum-offset~. Please refer to their documentation strings. +** Option for box buttons +:properties: +:alt_title: Box buttons +:description: Choose among several styles for buttons +:custom_id: h:8b85f711-ff40-45b0-b7fc-4727503cd2ec +:end: +#+vindex: modus-themes-box-buttons + +Brief: Control the style of buttons in the Custom UI and related. + +Symbol: ~modus-themes-box-buttons~ (=choice= type, list of properties) + +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: + ++ ~flat~ ++ ~accented~ ++ ~faint~ ++ ~variable-pitch~ ++ ~underline~ ++ A font weight, which must be supported by the underlying typeface: + - ~thin~ + - ~ultralight~ + - ~extralight~ + - ~light~ + - ~semilight~ + - ~regular~ + - ~medium~ + - ~semibold~ + - ~bold~ + - ~heavy~ + - ~extrabold~ + - ~ultrabold~ ++ A floating point as a height multiple of the default (e.g. =0.9=) + +The default (a nil value or an empty list) is a gray background combined +with a pseudo three-dimensional effect. + +The ~flat~ property makes the button two dimensional. + +The ~accented~ property changes the background from gray to an accent +color. + +The ~faint~ property reduces the overall coloration. + +The ~variable-pitch~ property applies a proportionately spaced typeface +to the button~s text. + +[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. + +The ~underline~ property draws a line below the affected text and +removes whatever box effect. This is optimal when Emacs runs inside a +terminal emulator ([[#h:fbb5e254-afd6-4313-bb05-93b3b4f67358][More accurate colors in terminal emulators]]). If +~flat~ and ~underline~ are defined together, the latter takes +precedence. + +The symbol of a weight attribute adjusts the font of the button +accordingly, such as ~light~, ~semibold~, etc. Valid symbols are +defined in the variable ~modus-themes-weights~. + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. + +A number, expressed as a floating point (e.g. =0.9=), adjusts the height +of the button's text to that many times the base font size. The default +height is the same as =1.0=, though it need not be explicitly stated. + +Combinations of any of those properties are expressed as a list, +like in these examples: + +#+begin_src emacs-lisp +(flat) +(variable-pitch flat) +(variable-pitch flat 0.9 semibold) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-box-buttons '(variable-pitch flat 0.9)) +#+end_src + ** Option for command prompt styles :properties: :alt_title: Command prompts @@ -978,35 +1072,39 @@ Possible values: 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, as -well as pattern matching styles like Orderless and Flx. The latter +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 +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, Ivy et al appear slightly different than their -original looks, as they are toned down a bit. +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 emulate those of -Helm, Ivy and co. in their original style. Whereas the other group of -packages will revert to an even more nuanced aesthetic with some +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 the ~nil~ (default), ~moderate~, and ~opinionated~ -possibilities. +some time with every one of those presets. ** Option for mail citations :properties: @@ -1024,17 +1122,21 @@ Symbol: ~modus-themes-mail-citations~ (=choice= type) Possible values: 1. ~nil~ (default) -2. ~faint~ -3. ~monochrome~ +2. ~intense~ +3. ~faint~ +4. ~monochrome~ + +By default (a nil value) citations are styled with contrasting hues to +denote their depth. Colors are easy to tell apart because they +complement each other, but they otherwise are not very prominent. -By default, citations in email-related buffers apply contrasting hues to -different levels of depth in cited text. The colors are fairly easy to -tell apart. +Option ~intense~ is similar to the default in terms of using contrasting +and complementary hues, but applies more saturated colors. -A value of ~faint~ makes all citation levels less intense, while retaining -the default style of contrasting hues (albeit very subtle ones). +Option ~faint~ maintains the same color-based distinction between citation +levels though the colors it uses have subtle differences between them. -Option ~monochrome~ turns all citations in to a uniform shade of gray. +Option ~monochrome~ turns all quotes into a shade of gray. Whatever the value assigned to this variable, citations in emails are controlled by typographic elements or indentation, which the themes do @@ -1220,29 +1322,60 @@ Instead they retain the primary background of the theme, blending with the rest of the buffer. Foreground values for all relevant faces are updated to accommodate this aesthetic. -** Option for intense markup in Org and others +** Option for markup style in Org and others :properties: -:alt_title: Intense markup -:description: Toggle intense style for markup in Org and others +:alt_title: Markup +:description: Choose style for markup in Org and others :custom_id: h:9d9a4e64-99ac-4018-8f66-3051b9c43fd7 :end: -#+vindex: modus-themes-intense-markup +#+vindex: modus-themes-markup -Brief: Toggle intense style for inline code and related markup. +Brief: Choose style of markup in Org, Markdown, and others (affects +constructs such as Org's ==verbatim== and =~code~=). -Symbol: ~modus-themes-intense-markup~ (=boolean= type) +Symbol: ~modus-themes-markup~ (=boolean= type) -Possible value: +Possible values are expressed as a list of properties (default is ~nil~ or +an empty list). The list can include any of the following symbols: -1. ~nil~ (default) -2. ~t~ +1. ~bold~ +2. ~italic~ +3. ~background~ +4. ~intense~ + +The ~italic~ property applies a typographic slant (italics). + +The ~bold~ property applies a heavier typographic weight. + +[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. + +The ~background~ property adds a background color. The background is a +shade of gray, unless the ~intense~ property is also set. -The default style for certain markup types like inline code and verbatim -constructs in Org and related major modes is a subtle foreground color -combined with a subtle background. +The ~intense~ property amplifies the existing coloration. When +~background~ is used, the background color is enhanced as well and +becomes tinted instead of being gray. -With a non-nil value (~t~), these constructs will use a more prominent -background and foreground color combination instead. +Combinations of any of those properties are expressed as a list, +like in these examples: + +#+begin_src emacs-lisp +(bold) +(bold italic) +(bold italic intense) +(bold italic intense background) +#+end_src + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + +#+begin_src emacs-lisp +(setq modus-themes-markup '(bold italic)) +#+end_src + +Also check the variables ~org-hide-emphasis-markers~, +~org-hide-macro-markers~. ** Option for parenthesis matching :properties: @@ -1387,6 +1520,8 @@ contrast threshold. [[#h:e2aed9eb-5e1e-45ec-bbd7-bc4faeab3236][Diffs with only the foreground]]. +[[#h:b0b31802-0216-427e-b071-1a47adcfe608][Ediff without diff color-coding]]. + ** Option for org-mode block styles :properties: :alt_title: Org mode blocks @@ -1405,20 +1540,28 @@ Possible values: 2. ~gray-background~ (value ~grayscale~ exists for backward compatibility) 3. ~tinted-background~ (value ~rainbow~ exists for backward compatibility) -The default means that the block has no distinct background of its own -and uses the one that applies to the rest of the buffer. +Nil (the default) means that the block has no background of its own: it +uses the one that applies to the rest of the buffer. In this case, the +delimiter lines have a gray color for their text, making them look +exactly like all other Org properties. Option ~gray-background~ applies a subtle gray background to the block's -contents. It also affects the begin and end lines of the block: their -background extends to the edge of the window for Emacs version >= 27 -where the ~:extend~ keyword is recognized by ~set-face-attribute~ (this is -contingent on the variable ~org-fontify-whole-block-delimiter-line~). +contents. It also affects the begin and end lines of the block as they +get another shade of gray as their background, which differentiates them +from the contents of the block. All background colors extend to the +edge of the window, giving the area a rectangular, "blocky" +presentation. Option ~tinted-background~ uses a slightly colored background for the contents of the block. The exact color will depend on the programming language and is controlled by the variable ~org-src-block-faces~ (refer to the theme's source code for the current association list). For this to -take effect, Org must be restarted with {{{kbd(M-x org-mode-restart)}}}. +take effect, the Org buffer needs to be restarted with ~org-mode-restart~. +In this scenario, it may be better to inhibit the extension of the +delimiter lines' background to the edge of the window because Org does +not provide a mechanism to update their colors depending on the contents +of the block. Disable the extension of such backgrounds by setting +~org-fontify-whole-block-delimiter-line~ to nil. Code blocks use their major mode's colors only when the variable ~org-src-fontify-natively~ is non-nil. While quote/verse blocks require @@ -1471,10 +1614,10 @@ properties: are present, the default is a small increase in height (a value of 1.15). - The symbol of a weight attribute adjusts the font of the heading - accordingly, such as ~light~, ~semibold~, etc. Valid symbols are defined - in the internal variable ~modus-themes--heading-weights~. The absence - of a weight means that bold will be used by virtue of inheriting the - ~bold~ face. + accordingly, such as ~light~, ~semibold~, etc. Valid symbols are + defined in the variable ~modus-themes-weights~. The absence of a + weight means that bold will be used by virtue of inheriting the ~bold~ + face. [[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. @@ -1594,10 +1737,10 @@ passed as a symbol. Those are: being too late. The difference between ready and clear states is attenuated by painting both of them using shades of green. This option thus highlights the alert and overdue states. -- When ~modus-themes-deuteranopia~ is non-nil the habit graph uses a - three-color style like the aforementioned ~traffic-light~ variant, - except that shades of blue are applied instead of green. This is - suitable for users with red-green color deficiency (deuteranopia). +- When ~modus-themes-deuteranopia~ is non-nil the exact style of the habit + graph adapts to the needs of users with red-green colour deficiency by + substituting every instance of green with blue or cyan (depending on + the specifics). [[#h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe][Option for red-green color deficiency or deuteranopia]]. @@ -1674,7 +1817,7 @@ Properties: - ~extrabold~ - ~ultrabold~ + ~no-bold~ (deprecated alias of a ~regular~ weight) -+ A floating point as a height multiple of the default ++ A floating point as a height multiple of the default (e.g. =1.1=) By default (a ~nil~ value for this variable), all headings have a bold typographic weight and use a desaturated text color. @@ -1695,10 +1838,10 @@ A ~variable-pitch~ property changes the font family of the heading to that of the ~variable-pitch~ face (normally a proportionately spaced typeface). The symbol of a weight attribute adjusts the font of the heading -accordingly, such as ~light~, ~semibold~, etc. Valid symbols are defined in -the internal variable ~modus-themes--heading-weights~. The absence of a -weight means that bold will be used by virtue of inheriting the ~bold~ -face. For backward compatibility, the ~no-bold~ value is accepted, though +accordingly, such as ~light~, ~semibold~, etc. Valid symbols are +defined in the variable ~modus-themes-weights~. The absence of a weight +means that bold will be used by virtue of inheriting the ~bold~ face. +For backward compatibility, the ~no-bold~ value is accepted, though users are encouraged to specify a ~regular~ weight instead. [[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]. @@ -1793,6 +1936,57 @@ their own local tweaks and who are willing to deal with any possible incompatibilities between versioned releases of the themes. As such, they are labelled as "do-it-yourself" or "DIY". +** More accurate colors in terminal emulators +:PROPERTIES: +:CUSTOM_ID: h:fbb5e254-afd6-4313-bb05-93b3b4f67358 +:END: +#+cindex: Color accuracy of terminal emulators + +[ This is based on partial information. Please help verify and/or + expand these findings. ] + +The graphical version of Emacs can reproduce color values accurately. +Whereas things get more tricky when Emacs is used in a terminal +emulator, because the terminals' own capabilities determine the number +of colors that may be displayed: the Modus themes don't look as good in +that case. + +There is, however, a way to instruct supported terminal emulators to use +more accurate colors. In a shell prompt type =toe -a | grep direct= to +get a list of relevant terminfo entries. There should be items such as +=xterm-direct=, =alacritty-direct=, =kitty-direct=. Once you find the one +that corresponds to your terminal, call Emacs with an environment +variable like =TERM=xterm-direct=. Example that can be adapted to shell +aliases: + +: TERM=xterm-direct emacsclient -nw + +Another example that can be bound to a key: + +: TERM=xterm-direct uxterm -e emacsclient -nw + +** Visualize the active Modus theme's palette +:properties: +:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d +:end: +#+findex: modus-themes-list-colors +#+findex: modus-themes-list-colors-current +#+cindex: Preview color values + +The command ~modus-themes-list-colors~ prompts for a choice between +=modus-operandi= and =modus-vivendi= to produce a help buffer that shows a +preview of each variable in the given theme's color palette. The +command ~modus-themes-list-colors-current~ skips the prompt, using the +current Modus theme. + +Each row shows a foreground and background coloration using the +underlying value it references. For example a line with =#a60000= (a +shade of red) will show red text followed by a stripe with that same +color as a backdrop. + +The name of the buffer describes the given Modus theme. It is thus +called =*modus-operandi-list-colors*= or =*modus-vivendi-list-colors*=. + ** Per-theme customization settings :properties: :custom_id: h:a897b302-8e10-4a26-beab-3caaee1e1193 @@ -1868,7 +2062,11 @@ The function always extracts the color value of the active Modus theme. #+end_src Do {{{kbd(C-h v)}}} on the aforementioned variables to check all the available -symbols that can be passed to this function. +symbols that can be passed to this function. Or simply invoke the +command ~modus-themes-list-colors~ to produce a buffer with a preview of +each entry in the palette. + +[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. With that granted, let us expand the example to actually change the ~cursor~ face's background property. We employ the built-in function of @@ -1947,7 +2145,10 @@ The ~modus-themes-with-colors~ macro lets you retrieve multiple color values by employing the backquote/backtick and comma notation. The values are stored in the alists ~modus-themes-operandi-colors~ and ~modus-themes-vivendi-colors~, while the macro always queries that of the -active Modus theme. +active Modus theme (preview the current palette with the command +~modus-themes-list-colors~). + +[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. Here is an abstract example that just returns a list of color values while ~modus-operandi~ is enabled: @@ -2288,6 +2489,8 @@ mirror a subset of the associations in ~modus-themes-operandi-colors~ and ~modus-themes-vivendi-colors~ respectively. As with all customisations, overriding must be done before loading the affected theme. +[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. + Let us approach the present topic one step at a time. Here is a simplified excerpt of the default palette for Modus Operandi with some basic background values that apply to buffers and the mode line @@ -2509,6 +2712,71 @@ inspiration from the ~modus-themes-toggle~ we already provide: ('modus-vivendi (modus-themes-load-vivendi)))) #+end_src +** Override colors through blending +:properties: +:custom_id: h:80c326bf-fe32-47b2-8c59-58022256fd6e +:end: +#+cindex: Change theme colors through blending + +This is yet another method of overriding color values. + +[[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override colors]]. + +[[#h:4589acdc-2505-41fc-9f5e-699cfc45ab00][Override color saturation]]. + +Building on ideas and concepts from the previous sections, this method +blends the entire palette at once with the chosen colors. The function +~my-modus-themes-interpolate~ blends two colors, taking a value from the +themes and mixing it with a user-defined color to arrive at a midpoint. +This scales to all background and foreground colors with the help of the +~my-modus-themes-tint-palette~ function. + +#+begin_src emacs-lisp +(setq my-modus-operandi-bg-blend "#fbf1c7" + my-modus-operandi-fg-blend "#3a6084" + my-modus-vivendi-bg-blend "#3a4042" + my-modus-vivendi-fg-blend "#d7b765") + +;; Adapted from the `kurecolor-interpolate' function of kurecolor.el +(defun my-modus-themes-interpolate (color1 color2) + (cl-destructuring-bind (r g b) + (mapcar #'(lambda (n) (* (/ n 2) 255.0)) + (cl-mapcar '+ (color-name-to-rgb color1) (color-name-to-rgb color2))) + (format "#%02X%02X%02X" r g b))) + +(defun my-modus-themes-tint-palette (palette bg-blend fg-blend) + "Modify Modus PALETTE programmatically and return a new palette. +Blend background colors with BG-BLEND and foreground colors with FG-BLEND." + (let (name cons colors) + (dolist (cons palette) + (let ((blend (if (string-match "bg" (symbol-name (car cons))) + bg-blend + fg-blend))) + (setq name (my-modus-themes-interpolate (cdr cons) blend))) + (setq name (format "%s" name)) + (setq cons `(,(car cons) . ,name)) + (push cons colors)) + colors)) + +(define-minor-mode modus-themes-tinted-mode + "Tweak some Modus themes colors." + :init-value nil + :global t + (if modus-themes-tinted-mode + (setq modus-themes-operandi-color-overrides + (my-modus-themes-tint-palette modus-themes-operandi-colors + my-modus-operandi-bg-blend + my-modus-operandi-fg-blend) + modus-themes-vivendi-color-overrides + (my-modus-themes-tint-palette modus-themes-vivendi-colors + my-modus-vivendi-bg-blend + my-modus-vivendi-fg-blend)) + (setq modus-themes-operandi-color-overrides nil + modus-themes-vivendi-color-overrides nil))) + +(modus-themes-tinted-mode 1) +#+end_src + ** Font configurations for Org and others :properties: :custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929 @@ -2670,11 +2938,11 @@ of the themes, which can make it easier to redefine faces in bulk). [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]. -** Custom Org user faces +** Custom Org todo keyword and priority faces :properties: :custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad :end: -#+cindex: Org extra faces +#+cindex: Org custom todo faces Users of ~org-mode~ have the option to configure various keywords and priority cookies to better match their workflow. User options are @@ -2758,6 +3026,139 @@ it if you plan to control face attributes. [[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]]. +** Custom Org emphasis faces +:properties: +:custom_id: h:26026302-47f4-4471-9004-9665470e7029 +:end: +#+cindex: Org custom emphasis faces + +Org provides the user option ~org-emphasis-alist~ which assosiates a +character with a face, list of faces, or face attributes. The default +specification of that variable looks like this: + +#+begin_src emacs-lisp +(setq org-emphasis-alist + '(("*" bold) + ("/" italic) + ("_" underline) + ("=" org-verbatim verbatim) + ("~" org-code verbatim) + ("+" (:strike-through t)))) +#+end_src + +With the exception of ~org-verbatim~ and ~org-code~ faces, everything else +uses the corresponding type of emphasis: a bold typographic weight, or +italicised, underlined, and struck through text. + +The best way for users to add some extra attributes, such as a +foreground color, is to define their own faces and assign them to the +given emphasis marker/character. + +This is a custom face that extends the standard ~bold~ face with a red +foreground value (so it colorises the text in addition to the bold +weight): + +#+begin_src emacs-lisp +(defface my-org-emphasis-bold + '((default :inherit bold) + (((class color) (min-colors 88) (background light)) + :foreground "#a60000") + (((class color) (min-colors 88) (background dark)) + :foreground "#ff8059")) + "My bold emphasis for Org.") +#+end_src + +This face definition reads as follows: + ++ Always inherit the ~bold~ face ([[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]]). ++ For versions of Emacs that support at least 88 colors (graphical + Emacs, for example) and use a light background, apply the =#a60000= + value. ++ For the same kind of Emacs that has a dark background use the =#ff8059= + color instead. + +Same principle for how to extend ~italic~ and ~underline~ with, for example, +green and yellow hues, respectively: + +#+begin_src emacs-lisp +(defface my-org-emphasis-italic + '((default :inherit italic) + (((class color) (min-colors 88) (background light)) + :foreground "#005e00") + (((class color) (min-colors 88) (background dark)) + :foreground "#44bc44")) + "My italic emphasis for Org.") + +(defface my-org-emphasis-underline + '((default :inherit underline) + (((class color) (min-colors 88) (background light)) + :foreground "#813e00") + (((class color) (min-colors 88) (background dark)) + :foreground "#d0bc00")) + "My underline emphasis for Org.") +#+end_src + +In the case of a strike-through effect, we have no generic face to +inherit from, so we can write it as follows to also change the +foreground to a more subtle gray: + +#+begin_src emacs-lisp +(defface my-org-emphasis-strike-through + '((default :strike-through t) + (((class color) (min-colors 88) (background light)) + :foreground "#505050") + (((class color) (min-colors 88) (background dark)) + :foreground "#a8a8a8")) + "My strike-through emphasis for Org.") +#+end_src + +Or we can just change the color of the line that strikes through the +text to, for example, a shade of red: + +#+begin_src emacs-lisp +(defface my-org-emphasis-strike-through + '((((class color) (min-colors 88) (background light)) + :strike-through "#972500") + (((class color) (min-colors 88) (background dark)) + :strike-through "#ef8b50")) + "My strike-through emphasis for Org.") +#+end_src + +It is possible to combine those effects: + +#+begin_src emacs-lisp +(defface my-org-emphasis-strike-through + '((((class color) (min-colors 88) (background light)) + :strike-through "#972500" :foreground "#505050") + (((class color) (min-colors 88) (background dark)) + :strike-through "#ef8b50" :foreground "#a8a8a8")) + "My strike-through emphasis for Org.") +#+end_src + +One may inspect the variables ~modus-themes-operandi-colors~ and +~modus-themes-vivendi-colors~ for possible color values. Or call the +command ~modus-themes-list-colors~ to show a buffer that previews each +entry in the palette. + +[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. + +Once we have defined the faces we need, we must update the +~org-emphasis-alist~. Given that ~org-verbatim~ and ~org-code~ are already +styled by the themes, it probably is best not to edit them: + +#+begin_src emacs-lisp +(setq org-emphasis-alist + '(("*" my-org-emphasis-bold) + ("/" my-org-emphasis-italic) + ("_" my-org-emphasis-underline) + ("=" org-verbatim verbatim) + ("~" org-code verbatim) + ("+" my-org-emphasis-strike-through))) +#+end_src + +That's it! For changes to take effect in already visited Org files, +invoke {{{kbd(M-x org-mode-restart)}}}. + ** Update Org block delimiter fontification :properties: :custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50 @@ -2954,13 +3355,20 @@ at something like the following, which builds on the above example: (pdf-view-midnight-minor-mode -1)) (my-pdf-tools-backdrop))) +(defun my-pdf-tools-themes-toggle () + (mapc + (lambda (buf) + (with-current-buffer buf + (my-pdf-tools-midnight-mode-toggle))) + (buffer-list))) + (add-hook 'pdf-tools-enabled-hook #'my-pdf-tools-midnight-mode-toggle) -(add-hook 'modus-themes-after-load-theme-hook #'my-pdf-tools-midnight-mode-toggle) +(add-hook 'modus-themes-after-load-theme-hook #'my-pdf-tools-themes-toggle) #+end_src With those in place, PDFs have a distinct backdrop for their page, while -they automatically switch to their dark mode when ~modus-themes-toggle~ is -called from inside a buffer whose major-mode is ~pdf-view-mode~. +buffers with major-mode as ~pdf-view-mode~ automatically switches to dark +mode when ~modus-themes-toggle~ is called. ** Decrease mode line height :properties: @@ -3161,6 +3569,45 @@ This used to be an optional style of ~modus-themes-diffs~, but has been removed since version =2.0.0= to ensure that the accessibility standard and aesthetic quality of the themes is not compromised. +** Ediff without diff color-coding +:properties: +:custom_id: h:b0b31802-0216-427e-b071-1a47adcfe608 +:end: + +Ediff uses the same color-coding as ordinary diffs in ~diff-mode~, Magit, +etc. ([[#h:ea7ac54f-5827-49bd-b09f-62424b3b6427][Option for diff buffer looks]]). This is consistent with the +principle of least surprise. + +Users may, however, prefer to treat Ediff differently on the premise +that it does not need any particular color-coding to show added or +removed lines/words: it does not use the =+= or =-= markers, after all. + +This can be achieved by customizing the Ediff faces with color +combinations that do not carry the same connotations as those of diffs. +Consider this example, which leverages the ~modus-themes-with-colors~ +macro ([[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]): + +#+begin_src emacs-lisp +(defun my-modus-themes-custom-faces () + (modus-themes-with-colors + (custom-set-faces + `(ediff-current-diff-A ((,class :inherit unspecified :background ,bg-special-faint-cold :foreground ,fg-special-cold))) + `(ediff-current-diff-B ((,class :inherit unspecified :background ,bg-special-faint-warm :foreground ,fg-special-warm))) + `(ediff-current-diff-C ((,class :inherit unspecified :background ,bg-special-faint-calm :foreground ,fg-special-calm))) + `(ediff-fine-diff-A ((,class :inherit unspecified :background ,bg-special-cold :foreground ,fg-special-cold))) + `(ediff-fine-diff-B ((,class :inherit unspecified :background ,bg-special-warm :foreground ,fg-special-warm))) + `(ediff-fine-diff-C ((,class :inherit unspecified :background ,bg-special-calm :foreground ,fg-special-calm)))))) + +;; This is so that the changes persist when switching between +;; `modus-operandi' and `modus-vivendi'. +(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces) +#+end_src + +Remove the =:foreground= and its value to preserve the underlying +coloration. + +[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Visualize the active Modus theme's palette]]. + * Face coverage :properties: :custom_id: h:a9c8f29d-7f72-4b54-b74b-ddefe15d6a19 @@ -3186,6 +3633,8 @@ have lots of extensions, so the "full support" may not be 100% true… + ace-window + alert + all-the-icons ++ all-the-icons-dired ++ all-the-icons-ibuffer + annotate + ansi-color + anzu @@ -3209,6 +3658,7 @@ have lots of extensions, so the "full support" may not be 100% true… + change-log and log-view (such as ~vc-print-log~, ~vc-print-root-log~) + cider + circe ++ citar + color-rg + column-enforce-mode + company-mode* @@ -3257,6 +3707,7 @@ have lots of extensions, so the "full support" may not be 100% true… + elfeed-score + elpher + embark ++ ement + emms + enh-ruby-mode (enhanced-ruby-mode) + epa @@ -3348,6 +3799,7 @@ have lots of extensions, so the "full support" may not be 100% true… + marginalia + markdown-mode + markup-faces (~adoc-mode~) ++ mct + mentor + messages + minimap @@ -3395,6 +3847,7 @@ have lots of extensions, so the "full support" may not be 100% true… + proced + prodigy + pulse ++ pyim + quick-peek + racket-mode + rainbow-blocks @@ -3417,6 +3870,8 @@ have lots of extensions, so the "full support" may not be 100% true… + side-notes + sieve-mode + skewer-mode ++ slime (slbd) ++ sly + smart-mode-line + smartparens + smerge @@ -3438,6 +3893,7 @@ have lots of extensions, so the "full support" may not be 100% true… + telephone-line + terraform-mode + term ++ textsec + tomatinho + transient (pop-up windows such as Magit's) + trashed @@ -3492,6 +3948,7 @@ supported by the themes. + counsel-org-capture-string + define-word + disk-usage ++ dtache + easy-kill + edit-indirect + evil-owl @@ -3504,6 +3961,7 @@ supported by the themes. + i3wm-config-mode + minibuffer-line + no-emoji ++ org-remark + parrot + perl-mode + php-mode @@ -3597,14 +4055,15 @@ Various buffers that produce compilation results or run tests on code apply an underline to the file names they reference or to relevant messages. Users may consider this unnecessary or excessive. -To outright disable the effect, use this: +To outright disable the effect, use this (buffers need to be generated +anew): #+begin_src emacs-lisp (setq compilation-message-face nil) #+end_src If some element of differentiation is still desired, a good option is to -render the affected text using the ~italic~ face: +render the affected text with the ~italic~ face: #+begin_src emacs-lisp (setq compilation-message-face 'italic) @@ -4075,20 +4534,66 @@ specifications the webpage provides. Consult {{{kbd(C-h v shr-use-colors)}}}. -** Note on EWW and Elfeed fonts +** Note on SHR fonts :properties: :custom_id: h:e6c5451f-6763-4be7-8fdb-b4706a422a4c :end: +#+cindex: Fonts in EWW, Elfeed, Ement, and SHR -EWW and Elfeed rely on the Simple HTML Renderer to display their -content. The {{{file(shr.el)}}} library contains the variable ~shr-use-fonts~ -that controls whether the text in the buffer is set to a ~variable-pitch~ -typeface (proportionately spaced) or if just retains whatever the -default font family is. Its default value is non-nil, which means that -~variable-pitch~ is applied. +By default, packages that build on top of the Simple HTML Remember (=shr=) +use proportionately spaced fonts. This is controlled by the user option +~shr-use-fonts~, which is set to non-nil by default. To use the standard +font instead, set that variable to nil. [[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]]. +Packages affected by this are: + ++ elfeed ++ ement ++ eww + +This is a non-exhaustive list. + +** Note on Ement colors and fonts +:properties: +:custom_id: h:8e636056-356c-4ca7-bc78-ebe61031f585 +:end: + +The =ement.el= library by Adam Porter (also known as "alphapapa") defaults +to a method of colorizing usernames in a rainbow style. This is +controlled by the user option ~ement-room-prism~ and can be disabled with: + +#+begin_src emacs-lisp +(setq ement-room-prism nil) +#+end_src + +The contrast ratio of these colors is governed by another user option: +~ement-room-prism-minimum-contrast~. By default, it is set to 6 which is +slightly below our nominal target. Try this instead: + +#+begin_src emacs-lisp +(setq ement-room-prism-minimum-contrast 7) +#+end_src + +With regard to fonts, Ement depends on =shr= ([[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note on SHR fonts]]). + +Since we are here, here is an excerpt from Ement's source code: + +#+begin_src emacs-lisp +(defcustom ement-room-prism-minimum-contrast 6 + "Attempt to enforce this minimum contrast ratio for user faces. +This should be a reasonable number from, e.g. 0-7 or so." + ;; Prot would almost approve of this default. :) I would go all the way + ;; to 7, but 6 already significantly dilutes the colors in some cases. + :type 'number) +#+end_src + +Yes, I do approve of that default. Even a 4.5 (the WCAG AA rating) +would be a good baseline for many themes and/or user configurations. +Our target is the highest of the sort, though we do not demand that +everyone conforms with it. + ** Note on Helm grep :properties: :custom_id: h:d28879a2-8e4b-4525-986e-14c0f873d229 @@ -4400,6 +4905,139 @@ The color combinations may have been optimized for accessibility, though the remaining contributing factors in each case need to be considered in full. +** Are these color schemes? +:properties: +:custom_id: h:a956dbd3-8fd2-4f5d-8b01-5f881268cf2b +:end: +#+cindex: Themes, not color schemes + +No, the Modus themes are not color schemes. + +A color scheme is a collection of colors. A good color scheme is a +combination of colors with an inner logic or abstract structure. + +A theme is a set of patterns that are applied across different contexts. +A good theme is one that does so with consistency, though not +uniformity. + +In practical terms, a color scheme is what one uses when, for example, +they edit the first sixteen escape sequences of a terminal emulator to +the hues of their preference. The terminal offers the option to choose, +say, the exact value of what counts as "red", but does not provide the +means to control where that is mapped to and whether it should also have +other qualities such as a bold weight for the underlying text or an +added background color. In contradistinction, Emacs uses constructs +known as "faces" which allow the user/developer to specify where a given +color will be used and whether it should be accompanied by other +typographic or stylistic attributes. + +By configuring the multitude of faces on offer we thus control both +which colors are applied and how they appear in their context. When a +package wants to render each instance of "foo" with the "bar" face, it +is not requesting a specific color, which makes things considerably more +flexible as we can treat "bar" in its own right without necessarily +having to use some color value that we hardcoded somewhere. + +Which brings us to the distinction between consistency and uniformity +where our goal is always the former: we want things to look similar +across all interfaces, but we must never force a visual identity where +that runs contrary to the functionality of the given interface. For +instance, all links are underlined by default yet there are cases such +as when viewing listings of emails in Gnus (and Mu4e, Notmuch) where (i) +it is already understood that one must follow the indicator or headline +to view its contents and (ii) underlining everything would make the +interface virtually unusable. + +[[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]]. + +Again, one must exercise judgement in order to avoid discrimination, +where "discrimination" refers to: + ++ The treatment of substantially different magnitudes as if they were of + the same class. ++ Or the treatment of the same class of magnitudes as if they were of a + different class. + +(To treat similar things differently; to treat dissimilar things alike.) + +If, in other words, one was to enforce uniformity without accounting for +the particular requirements of each case---the contextual demands for +usability beyond matters of color---they would be making a +not-so-obvious error of treating different cases as if they were the +same. + +The Modus themes prioritise "thematic consistency" over abstract harmony +or regularity among their applicable colors. In concrete terms, we do +not claim that, say, our yellows are the best complements for our blues +because we generally avoid using complementary colors side-by-side, so +it is wrong to optimise for a decontextualised blue+yellow combination. +Not to imply that our colors do not work well together because they do, +just to clarify that consistency of context is what themes must strive +for, and that requires widening the scope of the design beyond the +particularities of a color scheme. + +Long story short: color schemes and themes have different requirements. +Please do not conflate the two. + +** Port the Modus themes to other platforms? +:properties: +:custom_id: h:7156b949-917d-488e-9a72-59f70d80729c +:end: +#+cindex: Porting the themes to other editors + +There is no plan to port the themes to other platforms or text editors. +I (Protesilaos) only use GNU Emacs and thus cannot maintain code that +targets software I am either not familiar with or am not using on a +daily basis. + +While it is possible to produce a simulacrum based on a given template, +doing so would run contrary to how this project is maintained where +details matter greatly. + +Each program has its own requirements so it won't always be +possible---or indeed desirable---to have 1:1 correspondence between what +applies to Emacs and what should be done elsewhere. No port should ever +strive to be a faithful copy of the Emacs implementation, as no other +program is an Emacs equivalent, but instead try to follow the spirit of +the design. For example, some of the customization options accept a +list as their value, or an alist, which may not be possible to reproduce +on other platforms. + +[[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization options]]. + +In other words, if something must be done differently on a certain +editor then that is acceptable so long as (i) the accessibility +standards are not compromised and (ii) the overall character of the +themes remains consistent. + +The former criterion should be crystal clear as it pertains to the +scientific foundations of the themes: high legibility and taking care of +the needs of users with red-green colour deficiency (deuteranopia) by +avoiding red+green colour coding paradigms and/or by providing red+blue +variants. + +The latter criterion is the "je ne sais quoi" of the artistic aspect of +the themes, which is partially fleshed out in this manual. + +[[#h:b3384767-30d3-4484-ba7f-081729f03a47][Frequently Asked Questions]]. + +With regard to the artistic aspect (where "art" qua skill may amount to +an imprecise science), there is no hard-and-fast rule in effect as it +requires one to exercise discretion and make decisions based on +context-dependent information or constraints. As is true with most +things in life, when in doubt, do not cling on to the letter of the law +but try to understand its spirit. + +For a trivial example: the curly underline that Emacs draws for spelling +errors is thinner than, e.g., what a graphical web browser has, so if I +was to design for an editor than has a thicker curly underline I would +make the applicable colours less intense to counterbalance the +typographic intensity of the added thickness. + +With those granted, if anyone is willing to develop a port of the +themes, they are welcome to contact me and I will do my best to help +them in their efforts. + * Contributing :properties: :custom_id: h:9c3cd842-14b7-44d7-84b2-a5c8bc3fc3b1 @@ -4523,17 +5161,18 @@ The Modus themes are a collective effort. Every bit of work matters. + Author/maintainer :: Protesilaos Stavrou. -+ Contributions to code or documentation :: Anders Johansson, Basil - L.{{{space()}}} Contovounesios, Björn Lindström, Carlo Zancanaro, Christian - Tietze, Daniel Mendler, Eli Zaretskii, Fritz Grabo, Illia Ostapyshyn, - Kévin Le Gouguec, Kostadin Ninev, Madhavan Krishnan, Markus Beppler, - Matthew Stevenson, Mauro Aranda, Nicolas De Jaeghere, Philip - Kaludercic, Rudolf Adamkovič, Stephen Gildea, Shreyas Ragavan, Stefan - Kangas, Vincent Murphy, Xinglu Chen. ++ Contributions to code or documentation :: Alex Griffin, Anders + Johansson, Basil L.{{{space()}}} Contovounesios, Björn Lindström, Carlo + Zancanaro, Christian Tietze, Daniel Mendler, Eli Zaretskii, Fritz + Grabo, Illia Ostapyshyn, Kévin Le Gouguec, Kostadin Ninev, Madhavan + Krishnan, Markus Beppler, Matthew Stevenson, Mauro Aranda, Nicolas De + Jaeghere, Philip Kaludercic, Rudolf Adamkovič, Stephen Gildea, Shreyas + Ragavan, Stefan Kangas, Utkarsh Singh, Vincent Murphy, Xinglu Chen, + Yuanchen Xie. + Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers, - Adrian Manea, Alex Griffin, Alex Peitsinis, Alexey Shmalko, Alok - Singh, Anders Johansson, André Alexandre Gomes, Arif Rezai, Basil + 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 @@ -4541,17 +5180,18 @@ The Modus themes are a collective effort. Every bit of work matters. 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, Manuel Uberti, 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, Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut - Verron, Thomas Heartman, Trey Merkley, Togan Muftuoglu, Toon Claes, - Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben, - CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, - Nick, TheBlob42, Trey, bepolymathe, doolio, fleimgruber, iSeeU, - jixiuf, okamsn, pRot0ta1p. + 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), @@ -4589,6 +5229,8 @@ of this sort): + [[https://protesilaos.com/codelog/2021-01-11-modus-themes-review-select-faint-colours/][Modus themes: review of select "faint" colours]] (2021-01-11) + [[https://protesilaos.com/codelog/2021-02-25-modus-themes-diffs-deuteranopia/][The Modus themes now cover deuteranopia in diffs]] (2021-02-25) + [[https://protesilaos.com/codelog/2021-06-02-modus-themes-org-agenda/][Introducing the variable modus-themes-org-agenda]] (2021-06-02) ++ [[https://protesilaos.com/codelog/2022-01-02-review-modus-themes-org-habit-colours/][Modus themes: review of the org-habit graph colours]] (2022-01-02) ++ [[https://protesilaos.com/codelog/2022-01-03-modus-themes-port-faq/][Re: VSCode or Vim ports of the Emacs modus-themes?]] (2022-01-03) And here are the canonical sources of this project's documentation: diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ea544218ecd..ce377e12234 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1808,6 +1808,17 @@ Access of a hadoop/hdfs file system. A file is accessed via the user that you want to use, and @samp{node} is the name of the hadoop server. +@item tramp-nspawn +@cindex method @option{nspawn} +@cindex @option{nspawn} method +Access to environments provided by systemd-nspawn. A file is accessed +via @file{@trampfn{nspawn,user@@container,/path/to/file}}, where +@samp{user} is the (optional) user that you want to use, and +@samp{container} is the container to connect to. systemd-nspawn and +its container utilities often require super user access to run, use +multi-hop file names with @option{doas} or @option{sudo} to raise your +privileges. + @item vagrant-tramp @cindex method @option{vagrant} @cindex @option{vagrant} method @@ -1986,6 +1997,20 @@ file name syntax, must be appended to the machine and login items: machine melancholia#4711 port davs login daniel%BIZARRE password geheim @end example +For the methods @option{doas}, @option{sudo} and @option{sudoedit} the +password of the user requesting the connection is needed, and not the +password of the target user. If these connections happen on the local +host, an entry with the local user and local host is used: + +@example +machine @var{HOST} port sudo login @var{USER} password secret +@end example + +@var{USER} and @var{HOST} are the strings returned by +@code{(user-login-name)} and @code{(system-name)}. If one of these +methods is connected via a multi hop (@pxref{Multi-hops}), the +credentials of the previous hop are used. + @vindex auth-source-save-behavior If no proper entry exists, the password is read interactively. After successful login (verification of the password), @@ -3960,8 +3985,8 @@ Furthermore, this approach has the following limitations: @itemize @item -It works only for connection methods defined in @file{tramp-sh.el} and -@file{tramp-adb.el}. +It works only for connection methods defined in @file{tramp-adb.el}, +@file{tramp-sh.el} and @file{tramp-sshfs.el}. @item It does not support interactive user authentication. With @@ -4164,8 +4189,10 @@ methods}. Internally, file archives are mounted via the @acronym{GVFS} @option{archive} method. A file archive is a regular file of kind @file{/path/to/dir/file.EXT}. -The extension @samp{.EXT} identifies the type of the file archive. A -file inside a file archive, called archive file name, has the name +The extension @samp{.EXT} identifies the type of the file archive. To +examine the contents of an archive with Dired, open file name as if it +were a directory (i.e., open @file{/path/to/dir/file.EXT/}). A file +inside a file archive, called archive file name, has the name @file{/path/to/dir/file.EXT/dir/file}. Most of the @ref{Magic File Names, , magic file name operations, diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi new file mode 100644 index 00000000000..bf048841a65 --- /dev/null +++ b/doc/misc/transient.texi @@ -0,0 +1,2560 @@ +\input texinfo @c -*- texinfo -*- +@c %**start of header +@setfilename transient.info +@settitle Transient User and Developer Manual +@documentencoding UTF-8 +@documentlanguage en +@c %**end of header + +@copying +@quotation +Copyright (C) 2018-2022 Free Software Foundation, Inc. + +You can redistribute this document 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. + +This document 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. + +@end quotation +@end copying + +@dircategory Emacs +@direntry +* Transient: (transient). Transient Commands. +@end direntry + +@finalout +@titlepage +@title Transient User and Developer Manual +@subtitle for version 0.3.7 +@author Jonas Bernoulli +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@ifnottex +@node Top +@top Transient User and Developer Manual + +Taking inspiration from prefix keys and prefix arguments, Transient +implements a similar abstraction involving a prefix command, infix +arguments and suffix commands. We could call this abstraction a +``transient command'', but because it always involves at least two +commands (a prefix and a suffix) we prefer to call it just a +``transient''. + +When the user calls a transient prefix command, a transient +(temporary) keymap is activated, which binds the transient's infix +and suffix commands, and functions that control the transient state +are added to @code{pre-command-hook} and @code{post-command-hook}. The available +suffix and infix commands and their state are shown in a popup buffer +until the transient is exited by invoking a suffix command. + +Calling an infix command causes its value to be changed, possibly by +reading a new value in the minibuffer. + +Calling a suffix command usually causes the transient to be exited +but suffix commands can also be configured to not exit the transient. + +@noindent +This manual is for Transient version 0.3.7. + +@insertcopying +@end ifnottex + +@menu +* Introduction:: +* Usage:: +* Modifying Existing Transients:: +* Defining New Commands:: +* Classes and Methods:: +* Related Abstractions and Packages:: +* FAQ:: +* Keystroke Index:: +* Command and Function Index:: +* Variable Index:: +* Concept Index:: +* GNU General Public License:: + +@detailmenu +--- The Detailed Node Listing --- + +Usage + +* Invoking Transients:: +* Aborting and Resuming Transients:: +* Common Suffix Commands:: +* Saving Values:: +* Using History:: +* Getting Help for Suffix Commands:: +* Enabling and Disabling Suffixes:: +* Other Commands:: +* Other Options:: + +Defining New Commands + +* Defining Transients:: +* Binding Suffix and Infix Commands:: +* Defining Suffix and Infix Commands:: +* Using Infix Arguments:: +* Transient State:: + +Binding Suffix and Infix Commands + +* Group Specifications:: +* Suffix Specifications:: + + +Classes and Methods + +* Group Classes:: +* Group Methods:: +* Prefix Classes:: +* Suffix Classes:: +* Suffix Methods:: +* Prefix Slots:: +* Suffix Slots:: +* Predicate Slots:: + +Suffix Methods + +* Suffix Value Methods:: +* Suffix Format Methods:: + + +Related Abstractions and Packages + +* Comparison With Prefix Keys and Prefix Arguments:: +* Comparison With Other Packages:: + +@end detailmenu +@end menu + +@node Introduction +@chapter Introduction + +Taking inspiration from prefix keys and prefix arguments, Transient +implements a similar abstraction involving a prefix command, infix +arguments and suffix commands. We could call this abstraction a +``transient command'', but because it always involves at least two +commands (a prefix and a suffix) we prefer to call it just a +``transient''. + +@quotation +Transient keymaps are a feature provided by Emacs. Transients as +implemented by this package involve the use of transient keymaps. + +@cindex transient prefix command +Emacs provides a feature that it calls @dfn{prefix commands}. When we +talk about ``prefix commands'' in this manual, then we mean our own kind +of ``prefix commands'', unless specified otherwise. To avoid ambiguity +we sometimes use the terms @dfn{transient prefix command} for our kind and +``regular prefix command'' for the Emacs' kind. + +@end quotation + +When the user calls a transient prefix command, a transient +(temporary) keymap is activated, which binds the transient's infix and +suffix commands, and functions that control the transient state are +added to @code{pre-command-hook} and @code{post-command-hook}. The available suffix +and infix commands and their state are shown in a popup buffer until +the transient state is exited by invoking a suffix command. + +Calling an infix command causes its value to be changed. How that is +done depends on the type of the infix command. The simplest case is +an infix command that represents a command-line argument that does not +take a value. Invoking such an infix command causes the switch to be +toggled on or off. More complex infix commands may read a value from +the user, using the minibuffer. + +Calling a suffix command usually causes the transient to be exited; +the transient keymaps and hook functions are removed, the popup buffer +no longer shows information about the (no longer bound) suffix +commands, the values of some public global variables are set, while +some internal global variables are unset, and finally the command is +actually called. Suffix commands can also be configured to not exit +the transient. + +A suffix command can, but does not have to, use the infix arguments in +much the same way any command can choose to use or ignore the prefix +arguments. For a suffix command that was invoked from a transient, the +variable @code{transient-current-suffixes} and the function @code{transient-args} +serve about the same purpose as the variables @code{prefix-arg} and +@code{current-prefix-arg} do for any command that was called after the prefix +arguments have been set using a command such as @code{universal-argument}. + +The information shown in the popup buffer while a transient is active +looks a bit like this: + +@example +,----------------------------------------- +|Arguments +| -f Force (--force) +| -a Annotate (--annotate) +| +|Create +| t tag +| r release +`----------------------------------------- +@end example + +@quotation +This is a simplified version of @code{magit-tag}. Info manuals do not +support images or colored text, so the above ``screenshot'' lacks some +information; in practice you would be able to tell whether the +arguments @code{--force} and @code{--annotate} are enabled or not based on their +color. + +@end quotation + +@cindex command dispatchers +Transient can be used to implement simple ``command dispatchers''. The +main benefit then is that the user can see all the available commands +in a popup buffer. That is useful by itself because it frees the user +from having to remember all the keys that are valid after a certain +prefix key or command. Magit's @code{magit-dispatch} (on @code{C-x M-g}) command is +an example of using Transient to merely implement a command +dispatcher. + +In addition to that, Transient also allows users to interactively pass +arguments to commands. These arguments can be much more complex than +what is reasonable when using prefix arguments. There is a limit to +how many aspects of a command can be controlled using prefix +arguments. Furthermore, what a certain prefix argument means for +different commands can be completely different, and users have to read +documentation to learn and then commit to memory what a certain prefix +argument means to a certain command. + +Transient suffix commands, on the other hand, can accept dozens of +different arguments without the user having to remember anything. +When using Transient, one can call a command with arguments that +are just as complex as when calling the same function non-interactively +from Lisp. + +Invoking a transient command with arguments is similar to invoking a +command in a shell with command-line completion and history enabled. +One benefit of the Transient interface is that it remembers history +not only on a global level (``this command was invoked using these +arguments, and previously it was invoked using those other arguments''), +but also remembers the values of individual arguments independently. +@xref{Using History}. + +After a transient prefix command is invoked, @kbd{C-h @var{key}} can be used to +show the documentation for the infix or suffix command that @kbd{@var{key}} is +bound to (@pxref{Getting Help for Suffix Commands}), and infixes and +suffixes can be removed from the transient using @kbd{C-x l @var{key}}. Infixes +and suffixes that are disabled by default can be enabled the same way. +@xref{Enabling and Disabling Suffixes}. + +Transient ships with support for a few different types of specialized +infix commands. A command that sets a command line option, for example, +has different needs than a command that merely toggles a boolean flag. +Additionally, Transient provides abstractions for defining new types, +which the author of Transient did not anticipate (or didn't get around +to implementing yet). + +@node Usage +@chapter Usage + +@menu +* Invoking Transients:: +* Aborting and Resuming Transients:: +* Common Suffix Commands:: +* Saving Values:: +* Using History:: +* Getting Help for Suffix Commands:: +* Enabling and Disabling Suffixes:: +* Other Commands:: +* Other Options:: +@end menu + +@node Invoking Transients +@section Invoking Transients +@cindex invoking transients + +A transient prefix command is invoked like any other command by +pressing the key that is bound to that command. The main difference +to other commands is that a transient prefix command activates a +transient keymap, which temporarily binds the transient's infix and +suffix commands. Bindings from other keymaps may, or may not, be +disabled while the transient state is in effect. + +There are two kinds of commands that are available after invoking a +transient prefix command; infix and suffix commands. Infix commands +set some value (which is then shown in a popup buffer), without +leaving the transient. Suffix commands, on the other hand, usually quit +the transient and they may use the values set by the infix commands, +i.e.@: the infix @strong{arguments}. + +Instead of setting arguments to be used by a suffix command, infix +commands may also set some value by side-effect, e.g., by setting the +value of some variable. + +@node Aborting and Resuming Transients +@section Aborting and Resuming Transients +@cindex aborting transients +@cindex resuming transients + +@cindex quit transient +To quit the transient without invoking a suffix command press @code{C-g}. + +Key bindings in transient keymaps may be longer than a single event. +After pressing a valid prefix key, all commands whose bindings do not +begin with that prefix key are temporarily unavailable and grayed out. +To abort the prefix key press @kbd{C-g} (which in this case only quits the +prefix key, but not the complete transient). + +A transient prefix command can be bound as a suffix of another +transient. Invoking such a suffix replaces the current transient +state with a new transient state, i.e.@: the available bindings change +and the information displayed in the popup buffer is updated +accordingly. Pressing @kbd{C-g} while a nested transient is active only +quits the innermost transient, causing a return to the previous +transient. + +@kbd{C-q} or @kbd{C-z} on the other hand always exits all transients. If you use +the latter, then you can later resume the stack of transients using +@kbd{M-x transient-resume}. + +@table @asis +@kindex C-g +@findex transient-quit-seq +@item @kbd{C-g} @tie{}@tie{}@tie{}@tie{}(@code{transient-quit-seq}) +@kindex C-g +@findex transient-quit-one +@item @kbd{C-g} @tie{}@tie{}@tie{}@tie{}(@code{transient-quit-one}) + +This key quits the currently active incomplete key sequence, if any, +or else the current transient. When quitting the current transient, +it returns to the previous transient, if any. +@end table + +Transient's predecessor bound @kbd{q} instead of @kbd{C-g} to the quit command. +To learn how to get that binding back see @code{transient-bind-q-to-quit}'s +doc string. + +@table @asis +@kindex C-q +@findex transient-quit-all +@item @kbd{C-q} @tie{}@tie{}@tie{}@tie{}(@code{transient-quit-all}) + +This command quits the currently active incomplete key sequence, if +any, and all transients, including the active transient and all +suspended transients, if any. + +@kindex C-z +@findex transient-suspend +@item @kbd{C-z} @tie{}@tie{}@tie{}@tie{}(@code{transient-suspend}) + +Like @code{transient-quit-all}, this command quits an incomplete key +sequence, if any, and all transients. Additionally, it saves the +stack of transients so that it can easily be resumed (which is +particularly useful if you quickly need to do ``something else'', and +the stack is deeper than a single transient, and/or you have already +changed the values of some infix arguments). + +Note that only a single stack of transients can be saved at a time. +If another stack is already saved, then saving a new stack discards +the previous stack. + +@kindex M-x transient-resume +@findex transient-resume +@item @kbd{M-x transient-resume} @tie{}@tie{}@tie{}@tie{}(@code{transient-resume}) + +This command resumes the previously suspended stack of transients, +if any. +@end table + +@node Common Suffix Commands +@section Common Suffix Commands +@cindex common suffix commands + +A few shared suffix commands are available in all transients. These +suffix commands are not shown in the popup buffer by default. + +This includes the aborting commands mentioned in the previous section, as +well as some other commands that are all bound to @kbd{C-x @var{key}}. After +@kbd{C-x} is pressed, a section featuring all these common commands is +temporarily shown in the popup buffer. After invoking one of them, +the section disappears again. Note, however, that one of these commands +is described as ``Show common permanently''; invoke that if you want the +common commands to always be shown for all transients. + +@table @asis +@kindex C-x t +@findex transient-toggle-common +@item @kbd{C-x t} @tie{}@tie{}@tie{}@tie{}(@code{transient-toggle-common}) + +This command toggles whether the generic commands that are common to +all transients are always displayed or only after typing the +incomplete prefix key sequence @kbd{C-x}. This only affects the current +Emacs session. + +@end table + +@defopt transient-show-common-commands + +This option controls whether shared suffix commands are shown +alongside the transient-specific infix and suffix commands. By +default, the shared commands are not shown to avoid overwhelming +the user with too many options. + +While a transient is active, pressing @kbd{C-x} always shows the common +commands. The value of this option can be changed for the current +Emacs session by typing @kbd{C-x t} while a transient is active. +@end defopt + +The other common commands are described in either the previous or +in one of the following sections. + +Some of Transient's key bindings differ from the respective bindings +of Magit-Popup; see @ref{FAQ} for more information. + +@node Saving Values +@section Saving Values +@cindex saving values of arguments + +After setting the infix arguments in a transient, the user can save +those arguments for future invocations. + +Most transients will start out with the saved arguments when they are +invoked. There are a few exceptions, though. Some transients are +designed so that the value that they use is stored externally as the +buffer-local value of some variable. Invoking such a transient again +uses the buffer-local value.@footnote{ +@code{magit-diff} and @code{magit-log} are two prominent examples, and their +handling of buffer-local values is actually a bit more complicated +than outlined above and even customizable.} + +If the user does not save the value and just exits using a regular +suffix command, then the value is merely saved to the transient's +history. That value won't be used when the transient is next invoked, +but it is easily accessible (@pxref{Using History}). + +@table @asis +@kindex C-x s +@findex transient-set +@item @kbd{C-x s} @tie{}@tie{}@tie{}@tie{}(@code{transient-set}) + +This command saves the value of the active transient for this Emacs +session. + +@kindex C-x C-s +@findex transient-save +@item @kbd{C-x C-s} @tie{}@tie{}@tie{}@tie{}(@code{transient-save}) + +Save the value of the active transient persistently across Emacs +sessions. + +@end table + +@defopt transient-values-file + +This option names the file that is used to persist the values of +transients between Emacs sessions. +@end defopt + +@node Using History +@section Using History +@cindex value history + +Every time the user invokes a suffix command the transient's current +value is saved to its history. These values can be cycled through the +same way one can cycle through the history of commands that read +user-input in the minibuffer. + +@table @asis +@kindex C-M-p +@findex transient-history-prev +@item @kbd{C-M-p} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-prev}) +@kindex C-x p +@findex transient-history-prev +@item @kbd{C-x p} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-prev}) + +This command switches to the previous value used for the active +transient. + +@kindex C-M-n +@findex transient-history-next +@item @kbd{C-M-n} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-next}) +@kindex C-x n +@findex transient-history-next +@item @kbd{C-x n} @tie{}@tie{}@tie{}@tie{}(@code{transient-history-next}) + +This command switches to the next value used for the active +transient. +@end table + +In addition to the transient-wide history, Transient of course +supports per-infix history. When an infix reads user-input using the +minibuffer, the user can use the regular minibuffer history +commands to cycle through previously used values. Usually the same +keys as those mentioned above are bound to those commands. + +Authors of transients should arrange for different infix commands that +read the same kind of value to also use the same history key +(@pxref{Suffix Slots}). + +Both kinds of history are saved to a file when Emacs is exited. + +@defopt transient-history-file + +This option names the file that is used to persist the history of +transients and their infixes between Emacs sessions. +@end defopt + +@defopt transient-history-limit + +This option controls how many history elements are kept at the time +the history is saved in @code{transient-history-file}. +@end defopt + +@node Getting Help for Suffix Commands +@section Getting Help for Suffix Commands +@cindex getting help + +Transients can have many suffixes and infixes that the user might not +be familiar with. To make it trivial to get help for these, Transient +provides access to the documentation directly from the active +transient. + +@table @asis +@kindex C-h +@findex transient-help +@item @kbd{C-h} @tie{}@tie{}@tie{}@tie{}(@code{transient-help}) + +This command enters help mode. When help mode is active, +typing a key shows information about the suffix command that the key +is normally bound to (instead of invoking it). Pressing @kbd{C-h} a +second time shows information about the @emph{prefix} command. + +After typing a key, the stack of transient states is suspended and +information about the suffix command is shown instead. Typing @kbd{q} in +the help buffer buries that buffer and resumes the transient state. +@end table + +What sort of documentation is shown depends on how the transient was +defined. For infix commands that represent command-line arguments +this ideally shows the appropriate manpage. @code{transient-help} then tries +to jump to the correct location within that. Info manuals are also +supported. The fallback is to show the command's doc string, for +non-infix suffixes this is usually appropriate. + +@node Enabling and Disabling Suffixes +@section Enabling and Disabling Suffixes +@cindex enabling suffixes +@cindex disabling suffixes + +The user base of a package that uses transients can be very diverse. +This is certainly the case for Magit; some users have been using it and +Git for a decade, while others are just getting started now. + +@cindex levels +For that reason a mechanism is needed that authors can use to classify a +transient's infixes and suffixes along the essentials@dots{}everything +spectrum. We use the term @dfn{levels} to describe that mechanism. + +@cindex transient-level +Each suffix command is placed on a level and each transient has a +level (called @dfn{transient-level}), which controls which suffix commands +are available. Integers between 1 and 7 (inclusive) are valid levels. +For suffixes, 0 is also valid; it means that the suffix is not +displayed at any level. + +The levels of individual transients and/or their individual suffixes +can be changed interactively, by invoking the transient and then +pressing @kbd{C-x l} to enter the ``edit'' mode, see below. + +The default level for both transients and their suffixes is 4. The +@code{transient-default-level} option only controls the default for +transients. The default suffix level is always 4. The authors of +transients should place certain suffixes on a higher level, if they +expect that it won't be of use to most users, and they should place +very important suffixes on a lower level, so that they remain +available even if the user lowers the transient level. + +@defopt transient-default-level + +This option controls which suffix levels are made available by +default. It sets the transient-level for transients for which the +user has not set that individually. +@end defopt + +@defopt transient-levels-file + +This option names the file that is used to persist the levels of +transients and their suffixes between Emacs sessions. +@end defopt + +@table @asis +@kindex C-x l +@findex transient-set-level +@item @kbd{C-x l} @tie{}@tie{}@tie{}@tie{}(@code{transient-set-level}) + +This command enters edit mode. When edit mode is active, then all +infixes and suffixes that are currently usable are displayed along +with their levels. The colors of the levels indicate whether they +are enabled or not. The level of the transient is also displayed +along with some usage information. + +In edit mode, pressing the key that would usually invoke a certain +suffix instead prompts the user for the level that suffix should be +placed on. + +Help mode is available in edit mode. + +To change the transient level press @kbd{C-x l} again. + +To exit edit mode press @kbd{C-g}. + +Note that edit mode does not display any suffixes that are not +currently usable. @code{magit-rebase}, for example, shows different suffixes +depending on whether a rebase is already in progress or not. The +predicates also apply in edit mode. + +Therefore, to control which suffixes are available given a certain +state, you have to make sure that that state is currently active. +@end table + +@node Other Commands +@section Other Commands + +When invoking a transient in a small frame, the transient window may +not show the complete buffer, making it necessary to scroll, using the +following commands. These commands are never shown in the transient +window, and the key bindings are the same as for @code{scroll-up-command} and +@code{scroll-down-command} in other buffers. + +@findex transient-scroll-up arg +@deffn Command transient-scroll-up arg + +This command scrolls text of transient popup window upward @var{arg} +lines. If @var{arg} is @code{nil}, then it scrolls near full screen. This +is a wrapper around @code{scroll-up-command} (which see). +@end deffn + +@findex transient-scroll-down arg +@deffn Command transient-scroll-down arg + +This command scrolls text of transient popup window down @var{arg} +lines. If @var{arg} is @code{nil}, then it scrolls near full screen. This +is a wrapper around @code{scroll-down-command} (which see). +@end deffn + +@node Other Options +@section Other Options + +@defopt transient-show-popup + +This option controls whether the current transient's infix and +suffix commands are shown in the popup buffer. + +@itemize +@item +If @code{t} (the default) then the popup buffer is shown as soon as a +transient prefix command is invoked. + + +@item +If @code{nil}, then the popup buffer is not shown unless the user +explicitly requests it, by pressing an incomplete prefix key +sequence. + + +@item +If a number, then the a brief one-line summary is shown instead of +the popup buffer. If zero or negative, then not even that summary +is shown; only the pressed key itself is shown. + +The popup is shown when the user explicitly requests it by +pressing an incomplete prefix key sequence. Unless this is zero, +the popup is shown after that many seconds of inactivity +(using the absolute value). +@end itemize +@end defopt + +@defopt transient-enable-popup-navigation + +This option controls whether navigation commands are enabled in the +transient popup buffer. + +While a transient is active the transient popup buffer is not the +current buffer, making it necessary to use dedicated commands to act +on that buffer itself. This is disabled by default. If this option +is non-nil, then the following features are available: + +@itemize +@item +@key{UP} moves the cursor to the previous suffix. +@key{DOWN} moves the cursor to the next suffix. +@key{RET} invokes the suffix the cursor is on. + +@item +@key{mouse-1} invokes the clicked on suffix. + +@item +@kbd{C-s} and @kbd{C-r} start isearch in the popup buffer. +@end itemize +@end defopt + +@defopt transient-display-buffer-action + +This option specifies the action used to display the transient popup +buffer. The transient popup buffer is displayed in a window using +@code{(display-buffer @var{buffer} transient-display-buffer-action)}. + +The value of this option has the form @code{(@var{function} . @var{alist})}, +where @var{function} is a function or a list of functions. Each such +function should accept two arguments: a buffer to display and an +alist of the same form as @var{alist}. @xref{Choosing Window,,,elisp,}, +for details. + +The default is: + +@lisp +(display-buffer-in-side-window + (side . bottom) + (inhibit-same-window . t) + (window-parameters (no-other-window . t))) +@end lisp + +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 +Action Alists,,,elisp,}. + +Note that the buffer that was current before the transient buffer +is shown should remain the current buffer. Many suffix commands +act on the thing at point, if appropriate, and if the transient +buffer became the current buffer, then that would change what is +at point. To that effect @code{inhibit-same-window} ensures that the +selected window is not used to show the transient buffer. + +It may be possible to display the window in another frame, but +whether that works in practice depends on the window-manager. +If the window manager selects the new window (Emacs frame), +then that unfortunately changes which buffer is current. + +If you change the value of this option, then you might also +want to change the value of @code{transient-mode-line-format}. +@end defopt + +@defopt transient-mode-line-format + +This option controls whether the transient popup buffer has a +mode-line, separator line, or neither. + +If @code{nil}, then the buffer has no mode-line. If the buffer is not +displayed right above the echo area, then this probably is not a +good value. + +If @code{line} (the default), then the buffer also has no mode-line, but a +thin line is drawn instead, using the background color of the face +@code{transient-separator}. Text-mode frames cannot display thin lines, and +therefore fall back to treating @code{line} like @code{nil}. + +Otherwise this can be any mode-line format. @xref{Mode Line +Format,,,elisp,}, for details. +@end defopt + +@defopt transient-read-with-initial-input + +This option controls whether the last history element is used as the +initial minibuffer input when reading the value of an infix argument +from the user. If @code{nil}, there is no initial input and the first +element has to be accessed the same way as the older elements. +@end defopt + +@defopt transient-highlight-mismatched-keys + +This option controls whether key bindings of infix commands that do +not match the respective command-line argument should be highlighted. +For other infix commands this option has no effect. + +When this option is non-@code{nil}, the key binding for an infix argument +is highlighted when only a long argument (e.g., @code{--verbose}) is +specified but no shorthand (e.g., @code{-v}). In the rare case that a +shorthand is specified but the key binding does not match, then it +is highlighted differently. + +Highlighting mismatched key bindings is useful when learning the +arguments of the underlying command-line tool; you wouldn't want to +learn any short-hands that do not actually exist. + +The highlighting is done using one of the faces +@code{transient-mismatched-key} and @code{transient-nonstandard-key}. +@end defopt + +@defopt transient-substitute-key-function + +This function is used to modify key bindings. If the value of this +option is @code{nil} (the default), then no substitution is performed. + +This function is called with one argument, the prefix object, and +must return a key binding description, either the existing key +description it finds in the @code{key} slot, or the key description that +replaces the prefix key. It could be used to make other +substitutions, but that is discouraged. + +For example, @kbd{=} is hard to reach using my custom keyboard layout, +so I substitute @kbd{(} for that, which is easy to reach using a layout +optimized for lisp. + +@lisp +(setq transient-substitute-key-function + (lambda (obj) + (let ((key (oref obj key))) + (if (string-match "\\`\\(=\\)[a-zA-Z]" key) + (replace-match "(" t t key 1) + key)))) +@end lisp +@end defopt + +@defopt transient-detect-key-conflicts + +This option controls whether key binding conflicts should be +detected at the time the transient is invoked. If so, this +results in an error, which prevents the transient from being used. +Because of that, conflicts are ignored by default. + +Conflicts cannot be determined earlier, i.e.@: when the transient is +being defined and when new suffixes are being added, because at that +time there can be false-positives. It is actually valid for +multiple suffixes to share a common key binding, provided the +predicates of those suffixes prevent that more than one of them is +enabled at a time. +@end defopt + +@defopt transient-force-fixed-pitch + +This option controls whether to force the use of a monospaced font +in popup buffer. Even if you use a proportional font for the +@code{default} face, you might still want to use a monospaced font in +transient's popup buffer. Setting this option to @code{t} causes @code{default} +to be remapped to @code{fixed-pitch} in that buffer. +@end defopt + +@node Modifying Existing Transients +@chapter Modifying Existing Transients +@cindex modifying existing transients + +To an extent, transients can be customized interactively, see @ref{Enabling and Disabling Suffixes}. This section explains how existing transients +can be further modified non-interactively. + +The following functions share a few arguments: + +@itemize +@item +@var{prefix} is a transient prefix command, a symbol. + + +@item +@var{suffix} is a transient infix or suffix specification in the same form +as expected by @code{transient-define-prefix}. Note that an infix is a +special kind of suffix. Depending on context ``suffixes'' means +``suffixes (including infixes)'' or ``non-infix suffixes''. Here it +means the former. @xref{Suffix Specifications}. + +@var{suffix} may also be a group in the same form as expected by +@code{transient-define-prefix}. @xref{Group Specifications}. + + +@item +@var{loc} is a command, a key vector, a key description (a string as +returned by @code{key-description}), or a list specifying coordinates (the +last element may also be a command or key). For example @code{(1 0 -1)} +identifies the last suffix (@code{-1}) of the first subgroup (@code{0}) of the +second group (@code{1}). + +If @var{loc} is a list of coordinates, then it can be used to identify a +group, not just an individual suffix command. + +The function @code{transient-get-suffix} can be useful to determine whether +a certain coordination list identifies the suffix or group that you +expect it to identify. In hairy cases it may be necessary to look +at the definition of the transient prefix command. +@end itemize + +These functions operate on the information stored in the +@code{transient--layout} property of the @var{prefix} symbol. Suffix entries in +that tree are not objects but have the form @code{(@var{level} +@var{class} @var{plist})}, where +@var{plist} should set at least @code{:key}, @code{:description} and +@code{:command}. + +@defun transient-insert-suffix prefix loc suffix + +This function inserts suffix or group @var{suffix} into @var{prefix} +before @var{loc}. +@end defun + +@defun transient-append-suffix prefix loc suffix + +This function inserts suffix or group @var{suffix} into @var{prefix} +after @var{loc}. +@end defun + +@defun transient-replace-suffix prefix loc suffix + +This function replaces the suffix or group at @var{loc} in @var{prefix} with +suffix or group @var{suffix}. +@end defun + +@defun transient-remove-suffix prefix loc + +This function removes the suffix or group at @var{loc} in @var{prefix}. +@end defun + +@defun transient-get-suffix prefix loc + +This function returns the suffix or group at @var{loc} in @var{prefix}. The +returned value has the form mentioned above. +@end defun + +@defun transient-suffix-put prefix loc prop value + +This function edits the suffix or group at @var{loc} in @var{prefix}, +by setting the @var{prop} of its plist to @var{value}. +@end defun + +Most of these functions do not signal an error if they cannot perform +the requested modification. The functions that insert new suffixes +show a warning if @var{loc} cannot be found in @var{prefix}, without +signaling an error. The reason for doing it like this is that +establishing a key binding (and that is what we essentially are trying +to do here) should not prevent the rest of the configuration from +loading. Among these functions only @code{transient-get-suffix} and +@code{transient-suffix-put} may signal an error. + +@node Defining New Commands +@chapter Defining New Commands + +@menu +* Defining Transients:: +* Binding Suffix and Infix Commands:: +* Defining Suffix and Infix Commands:: +* Using Infix Arguments:: +* Transient State:: +@end menu + +@node Defining Transients +@section Defining Transients + +A transient consists of a prefix command and at least one suffix +command, though usually a transient has several infix and suffix +commands. The below macro defines the transient prefix command @strong{and} +binds the transient's infix and suffix commands. In other words, it +defines the complete transient, not just the transient prefix command +that is used to invoke that transient. + +@defmac transient-define-prefix name arglist [docstring] [keyword value]@dots{} group@dots{} [body@dots{}] + +This macro defines @var{name} as a transient prefix command and binds the +transient's infix and suffix commands. + +@var{arglist} are the arguments that the prefix command takes. +@var{docstring} is the documentation string and is optional. + +These arguments can optionally be followed by keyword-value pairs. +Each key has to be a keyword symbol, either @code{:class} or a keyword +argument supported by the constructor of that class. The +@code{transient-prefix} class is used if the class is not specified +explicitly. + +@var{group}s add key bindings for infix and suffix commands and specify +how these bindings are presented in the popup buffer. At least one +@var{group} has to be specified. @xref{Binding Suffix and Infix Commands}. + +The @var{body} is optional. If it is omitted, then @var{arglist} is ignored and +the function definition becomes: + +@lisp +(lambda () + (interactive) + (transient-setup 'NAME)) +@end lisp + +If @var{body} is specified, then it must begin with an @code{interactive} form +that matches @var{arglist}, and it must call @code{transient-setup}. It may, +however, call that function only when some condition is satisfied. + +@cindex scope of a transient +All transients have a (possibly @code{nil}) value, which is exported when +suffix commands are called, so that they can consume that value. +For some transients it might be necessary to have a sort of +secondary value, called a ``scope''. Such a scope would usually be +set in the command's @code{interactive} form and has to be passed to the +setup function: + +@lisp +(transient-setup 'NAME nil nil :scope SCOPE) +@end lisp + +For example, the scope of the @code{magit-branch-configure} transient is +the branch whose variables are being configured. +@end defmac + +@node Binding Suffix and Infix Commands +@section Binding Suffix and Infix Commands + +The macro @code{transient-define-prefix} is used to define a transient. +This defines the actual transient prefix command (@pxref{Defining +Transients}) and adds the transient's infix and suffix bindings, as +described below. + +Users and third-party packages can add additional bindings using +functions such as @code{transient-insert-suffix} (@pxref{Modifying +Existing Transients}). These functions take a ``suffix +specification'' as one of their arguments, which has the same form as +the specifications used in @code{transient-define-prefix}. + +@menu +* Group Specifications:: +* Suffix Specifications:: +@end menu + +@node Group Specifications +@subsection Group Specifications +@cindex group specifications + +The suffix and infix commands of a transient are organized in groups. +The grouping controls how the descriptions of the suffixes are +outlined visually but also makes it possible to set certain properties +for a set of suffixes. + +Several group classes exist, some of which organize suffixes in +subgroups. In most cases the class does not have to be specified +explicitly, but see @ref{Group Classes}. + +Groups are specified in the call to @code{transient-define-prefix}, using +vectors. Because groups are represented using vectors, we cannot use +square brackets to indicate an optional element and instead use curly +brackets to do the latter. + +Group specifications then have this form: + +@lisp +[@{@var{level}@} @{@var{description}@} + @{@var{keyword} @var{value}@}... + @var{element}...] +@end lisp + +The @var{level} is optional and defaults to 4. @xref{Enabling and +Disabling Suffixes}. + +The @var{description} is optional. If present, it is used as the heading of +the group. + +The @var{keyword}-@var{value} pairs are optional. Each keyword has to be a +keyword symbol, either @code{:class} or a keyword argument supported by the +constructor of that class. + +@itemize +@item +One of these keywords, @code{:description}, is equivalent to specifying +@var{description} at the very beginning of the vector. The recommendation +is to use @code{:description} if some other keyword is also used, for +consistency, or @var{description} otherwise, because it looks better. + +@item +Likewise @code{:level} is equivalent to @var{level}. + +@item +Other important keywords include the @code{:if...} keywords. These +keywords control whether the group is available in a certain +situation. + +For example, one group of the @code{magit-rebase} transient uses +@code{:if magit-rebase-in-progress-p}, which contains the suffixes +that are useful while rebase is already in progress; and another that uses +@code{:if-not magit-rebase-in-progress-p}, which contains the suffixes that +initiate a rebase. + +These predicates can also be used on individual suffixes and are +only documented once, see @ref{Predicate Slots}. + +@item +The value of @code{:hide}, if non-@code{nil}, is a predicate that controls +whether the group is hidden by default. The key bindings for +suffixes of a hidden group should all use the same prefix key. +Pressing that prefix key should temporarily show the group and its +suffixes, which assumes that a predicate like this is used: + +@lisp +(lambda () + (eq (car transient--redisplay-key) + ?\C-c)) ; the prefix key shared by all bindings +@end lisp + +@item +The value of @code{:setup-children}, if non-@code{nil}, is a function +that takes two arguments the group object itself and a list of children. +The children are given as a, potentially empty, list consisting +of either group or suffix specifications. It can make arbitrary +changes to the children including constructing new children from +scratch. Also see @code{transient-setup-children}. + +@item +The boolean @code{:pad-keys} argument controls whether keys of all suffixes +contained in a group are right padded, effectively aligning the +descriptions. +@end itemize + +The @var{element}s are either all subgroups (vectors), or all suffixes +(lists) and strings. (At least currently no group type exists that +would allow mixing subgroups with commands at the same level, though +in principle there is nothing that prevents that.) + +If the @var{element}s are not subgroups, then they can be a mixture of lists +that specify commands and strings. Strings are inserted verbatim. +The empty string can be used to insert gaps between suffixes, which is +particularly useful if the suffixes are outlined as a table. + +Variables are supported inside group specifications. For example in +place of a direct subgroup specification, a variable can be used whose +value is a vector that qualifies as a group specification. Likewise, a +variable can be used where a suffix specification is expected. Lists +of group or suffix specifications are also supported. Indirect +specifications are resolved when the transient prefix is being +defined. + +The form of suffix specifications is documented in the next node. + +@node Suffix Specifications +@subsection Suffix Specifications +@cindex suffix specifications + +A transient's suffix and infix commands are bound when the transient +prefix command is defined using @code{transient-define-prefix}, see +@ref{Defining Transients}. The commands are organized into groups, see +@ref{Group Specifications}. Here we describe the form used to bind an +individual suffix command. + +The same form is also used when later binding additional commands +using functions such as @code{transient-insert-suffix}, +see @ref{Modifying Existing Transients}. + +Note that an infix is a special kind of suffix. Depending on context +``suffixes'' means ``suffixes (including infixes)'' or ``non-infix +suffixes''. Here it means the former. + +Suffix specifications have this form: + +@lisp +([@var{level}] + [@var{key}] [@var{description}] + @var{command}|@var{argument} [@var{keyword} @var{value}]...) +@end lisp + +@var{level}, @var{key} and @var{description} can also be specified using the @var{keyword}s +@code{:level}, @code{:key} and @code{:description}. If the object that is associated with +@var{command} sets these properties, then they do not have to be specified +here. You can however specify them here anyway, possibly overriding +the object's values just for the binding inside this transient. + +@itemize +@item +@var{level} is the suffix level, an integer between 1 and 7. +@xref{Enabling and Disabling Suffixes}. + +@item +@var{key} is the key binding, either a vector or key description string. + +@item +@var{description} is the description, either a string or a function that +returns a string. The function should be a lambda expression to +avoid ambiguity. In some cases a symbol that is bound as a function +would also work but to be safe you should use @code{:description} in that +case. +@end itemize + +The next element is either a command or an argument. This is the only +argument that is mandatory in all cases. + +@itemize +@item +Usually @var{command} is a symbol that is bound as a function, which has +to be defined or at least autoloaded as a command by the time the +containing prefix command is invoked. + +Any command will do; it does not need to have an object associated +with it (as would be the case if @code{transient-define-suffix} or +@code{transient-define-infix} were used to define it). + +The command can also be a closure or lambda expression, but that +should only be used for dynamic transients whose suffixes are +defined when the prefix command is invoked. See information about +the @code{:setup-children} function in @ref{Group Specifications}. + +As mentioned above, the object that is associated with a command can +be used to set the default for certain values that otherwise have to +be set in the suffix specification. Therefore if there is no object, +then you have to make sure to specify the @var{key} and the @var{description}. + +As a special case, if you want to add a command that might be neither +defined nor autoloaded, you can use a workaround like: + +@lisp +(transient-insert-suffix 'some-prefix "k" + '("!" "Ceci n'est pas une commande" no-command + :if (lambda () (featurep 'no-library)))) +@end lisp + +Instead of @code{featurep} you could also use @code{require} with a +non-nil value for @var{noerror}. + +@item +The mandatory argument can also be a command-line argument, a +string. In that case an anonymous command is defined and bound. + +Instead of a string, this can also be a list of two strings, in +which case the first string is used as the short argument (which can +also be specified using @code{:shortarg}) and the second as the long argument +(which can also be specified using @code{:argument}). + +Only the long argument is displayed in the popup buffer. See +@code{transient-detect-key-conflicts} for how the short argument may be +used. + +Unless the class is specified explicitly, the appropriate class is +guessed based on the long argument. If the argument ends with @samp{=} +(e.g. @samp{--format=}) then @code{transient-option} is used, otherwise +@code{transient-switch}. +@end itemize + +Finally, details can be specified using optional +@var{keyword}-@var{value} pairs. +Each keyword has to be a keyword symbol, either @code{:class} or a keyword +argument supported by the constructor of that class. See @ref{Suffix Slots}. + +@node Defining Suffix and Infix Commands +@section Defining Suffix and Infix Commands +@cindex defining suffix commands +@cindex defining infix commands + +Note that an infix is a special kind of suffix. Depending on context +``suffixes'' means ``suffixes (including infixes)'' or ``non-infix +suffixes''. + +@defmac transient-define-suffix name arglist [docstring] [keyword value]@dots{} body@dots{} + +This macro defines @var{name} as a transient suffix command. + +@var{arglist} are the arguments that the command takes. +@var{docstring} is the documentation string and is optional. + +These arguments can optionally be followed by keyword-value pairs. +Each keyword has to be a keyword symbol, either @code{:class} or a keyword +argument supported by the constructor of that class. The +@code{transient-suffix} class is used if the class is not specified +explicitly. + +The @var{body} must begin with an @code{interactive} form that matches @var{arglist}. +The infix arguments are usually accessed by using @code{transient-args} +inside @code{interactive}. +@end defmac + +@defmac transient-define-infix name arglist [docstring] [keyword value]@dots{} + +This macro defines @var{name} as a transient infix command. + +@var{arglist} is always ignored (but mandatory never-the-less) and +reserved for future use. @var{docstring} is the documentation string and +is optional. + +The keyword-value pairs are mandatory. All transient infix commands +are @code{equal} to each other (but not @code{eq}), so it is meaningless to define +an infix command without also setting at least @code{:class} and one other +keyword (which it is depends on the used class, usually @code{:argument} or +@code{:variable}). + +Each keyword has to be a keyword symbol, either @code{:class} or a keyword +argument supported by the constructor of that class. The +@code{transient-switch} class is used if the class is not specified +explicitly. + +The function definition is always: + +@lisp +(lambda () + (interactive) + (let ((obj (transient-suffix-object))) + (transient-infix-set obj (transient-infix-read obj))) + (transient--show)) +@end lisp + +@code{transient-infix-read} and @code{transient-infix-set} are generic functions. +Different infix commands behave differently because the concrete +methods are different for different infix command classes. In rare +cases the above command function might not be suitable, even if you +define your own infix command class. In that case you have to use +@code{transient-suffix-command} to define the infix command and use @code{t} as +the value of the @code{:transient} keyword. +@end defmac + +@defmac transient-define-argument name arglist [docstring] [keyword value]@dots{} + +This macro defines @var{name} as a transient infix command. + +This is an alias for @code{transient-define-infix}. Only use this alias +to define an infix command that actually sets an infix argument. +To define an infix command that, for example, sets a variable, use +@code{transient-define-infix} instead. +@end defmac + +@node Using Infix Arguments +@section Using Infix Arguments +@cindex using infix arguments + +The functions and the variables described below allow suffix commands +to access the value of the transient from which they were invoked; +which is the value of its infix arguments. These variables are set +when the user invokes a suffix command that exits the transient, but +before actually calling the command. + +When returning to the command-loop after calling the suffix command, +the arguments are reset to @code{nil} (which causes the function to return +@code{nil} too). + +Like for Emacs' prefix arguments, it is advisable, but not mandatory, +to access the infix arguments inside the command's @code{interactive} form. +The preferred way of doing that is to call the @code{transient-args} +function, which for infix arguments serves about the same purpose as +@code{prefix-arg} serves for prefix arguments. + +@defun transient-args prefix + +This function returns the value of the transient prefix command +@var{prefix}. + +If the current command was invoked from the transient prefix command +@var{prefix}, then it returns the active infix arguments. If the current +command was not invoked from @var{prefix}, then it returns the set, saved +or default value for @var{prefix}. +@end defun + +@defun transient-arg-value arg args + +This function return the value of @var{arg} as it appears in @var{args}. + +For a switch a boolean is returned. For an option the value is +returned as a string, using the empty string for the empty value, +or @code{nil} if the option does not appear in @var{args}. +@end defun + +@defun transient-suffixes prefix + +This function returns the suffixes of the transient prefix command +@var{prefix}. This is a list of objects. This function should only be +used if you need the objects (as opposed to just their values) and +if the current command is not being invoked from @var{prefix}. +@end defun + +@defvar transient-current-suffixes + +The suffixes of the transient from which this suffix command was +invoked. This is a list of objects. Usually it is sufficient to +instead use the function @code{transient-args}, which returns a list of +values. In complex cases it might be necessary to use this variable +instead, i.e.@: if you need access to information beside the value. +@end defvar + +@defvar transient-current-prefix + +The transient from which this suffix command was invoked. The +returned value is a @code{transient-prefix} object, which holds information +associated with the transient prefix command. +@end defvar + +@defvar transient-current-command + +The transient from which this suffix command was invoked. The +returned value is a symbol, the transient prefix command. +@end defvar + +@node Transient State +@section Transient State +@cindex transient state + +Invoking a transient prefix command ``activates'' the respective +transient, i.e.@: it puts a transient keymap into effect, which binds +the transient's infix and suffix commands. + +The default behavior while a transient is active is as follows: + +@itemize +@item +Invoking an infix command does not affect the transient state; the +transient remains active. + +@item +Invoking a (non-infix) suffix command ``deactivates'' the transient +state by removing the transient keymap and performing some +additional cleanup. + +@item +Invoking a command that is bound in a keymap other than the +transient keymap is disallowed and trying to do so results in a +warning. This does not ``deactivate'' the transient. +@end itemize + +But these are just the defaults. Whether a certain command +deactivates or ``exits'' the transient is configurable. There is more +than one way in which a command can be ``transient'' or ``non-transient''; +the exact behavior is implemented by calling a so-called ``pre-command'' +function. Whether non-suffix commands are allowed to be called is +configurable per transient. + +@itemize +@item +The transient-ness of suffix commands (including infix commands) is +controlled by the value of their @code{transient} slot, which can be set +either when defining the command or when adding a binding to a +transient while defining the respective transient prefix command. + +Valid values are booleans and the pre-commands described below. + +@itemize +@item +@code{t} is equivalent to @code{transient--do-stay}. + +@item +@code{nil} is equivalent to @code{transient--do-exit}. + +@item +If @code{transient} is unbound (and that is actually the default for +non-infix suffixes) then the value of the prefix's +@code{transient-suffix} slot is used instead. The default value of that +slot is @code{nil}, so the suffix's @code{transient} slot being unbound is +essentially equivalent to it being @code{nil}. +@end itemize + +@item +A suffix command can be a prefix command itself, i.e. a +``sub-prefix''. While a sub-prefix is active we nearly always want +@kbd{C-g} to take the user back to the ``super-prefix''. However in rare +cases this may not be desirable, and that makes the following +complication necessary: + +For @code{transient-suffix} objects the @code{transient} slot is unbound. We can +ignore that for the most part because, as stated above, @code{nil} and the +slot being unbound are equivalent, and mean ``do exit''. That isn't +actually true for suffixes that are sub-prefixes though. For such +suffixes unbound means ``do exit but allow going back'', which is the +default, while @code{nil} means ``do exit permanently'', which requires that +slot to be explicitly set to that value. + +@item +The transient-ness of certain built-in suffix commands is specified +using @code{transient-predicate-map}. This is a special keymap, which +binds commands to pre-commands (as opposed to keys to commands) and +takes precedence over the @code{transient} slot. +@end itemize + +The available pre-command functions are documented below. They are +called by @code{transient--pre-command}, a function on @code{pre-command-hook} and +the value that they return determines whether the transient is exited. +To do so the value of one of the constants @code{transient--exit} or +@code{transient--stay} is used (that way we don't have to remember if @code{t} means +``exit'' or ``stay''). + +Additionally, these functions may change the value of @code{this-command} +(which explains why they have to be called using @code{pre-command-hook}), +call @code{transient-export}, @code{transient--stack-zap} or @code{transient--stack-push}; +and set the values of @code{transient--exitp}, @code{transient--helpp} or +@code{transient--editp}. + +@anchor{Pre-commands for Infixes} +@subheading Pre-commands for Infixes + +The default for infixes is @code{transient--do-stay}. This is also the only +function that makes sense for infixes. + +@defun transient--do-stay + +Call the command without exporting variables and stay transient. +@end defun + +@anchor{Pre-commands for Suffixes} +@subheading Pre-commands for Suffixes + +The default for suffixes is @code{transient--do-exit}. + +@defun transient--do-exit + +Call the command after exporting variables and exit the transient. +@end defun + +@defun transient--do-call + +Call the command after exporting variables and stay transient. +@end defun + +@defun transient--do-replace + +Call the transient prefix command, replacing the active transient. + +This is used for suffixes that are prefixes themselves, i.e.@: for +sub-prefixes. +@end defun + +@anchor{Pre-commands for Non-Suffixes} +@subheading Pre-commands for Non-Suffixes + +The default for non-suffixes, i.e@: commands that are bound in other +keymaps beside the transient keymap, is @code{transient--do-warn}. Silently +ignoring the user-error is also an option, though probably not a good +one. + +If you want to let the user invoke non-suffix commands, then use +@code{transient--do-stay} as the value of the prefix's @code{transient-non-suffix} +slot. + +@defun transient--do-warn + +Call @code{transient-undefined} and stay transient. +@end defun + +@defun transient--do-noop + +Call @code{transient-noop} and stay transient. +@end defun + +@anchor{Special Pre-Commands} +@subheading Special Pre-Commands + +@defun transient--do-quit-one + +If active, quit help or edit mode, else exit the active transient. + +This is used when the user pressed @kbd{C-g}. +@end defun + +@defun transient--do-quit-all + +Exit all transients without saving the transient stack. + +This is used when the user pressed @kbd{C-q}. +@end defun + +@defun transient--do-suspend + +Suspend the active transient, saving the transient stack. + +This is used when the user pressed @kbd{C-z}. +@end defun + +@node Classes and Methods +@chapter Classes and Methods +@cindex classes and methods + +Transient uses classes and generic functions to make it possible to +define new types of suffix commands that are similar to existing +types, but behave differently in some aspects. It does the same for +groups and prefix commands, though at least for prefix commands that +@strong{currently} appears to be less important. + +Every prefix, infix and suffix command is associated with an object, +which holds information that controls certain aspects of its behavior. +This happens in two ways. + +@itemize +@item +Associating a command with a certain class gives the command a type. +This makes it possible to use generic functions to do certain things +that have to be done differently depending on what type of command +it acts on. + +That in turn makes it possible for third-parties to add new types +without having to convince the maintainer of Transient that that new +type is important enough to justify adding a special case to a dozen +or so functions. + +@item +Associating a command with an object makes it possible to easily +store information that is specific to that particular command. + +Two commands may have the same type, but obviously their key +bindings and descriptions still have to be different, for example. + +The values of some slots are functions. The @code{reader} slot for example +holds a function that is used to read a new value for an infix +command. The values of such slots are regular functions. + +Generic functions are used when a function should do something +different based on the type of the command, i.e. when all commands +of a certain type should behave the same way but different from the +behavior for other types. Object slots that hold a regular function +as value are used when the task that they perform is likely to +differ even between different commands of the same type. +@end itemize + +@menu +* Group Classes:: +* Group Methods:: +* Prefix Classes:: +* Suffix Classes:: +* Suffix Methods:: +* Prefix Slots:: +* Suffix Slots:: +* Predicate Slots:: +@end menu + +@node Group Classes +@section Group Classes + +The type of a group can be specified using the @code{:class} property at the +beginning of the class specification, e.g. @code{[:class transient-columns +...]} in a call to @code{transient-define-prefix}. + +@itemize +@item +The abstract @code{transient-child} class is the base class of both +@code{transient-group} (and therefore all groups) as well as of +@code{transient-suffix} (and therefore all suffix and infix commands). + +This class exists because the elements (a.k.a.@: ``children'') of certain +groups can be other groups instead of suffix and infix commands. + +@item +The abstract @code{transient-group} class is the superclass of all other +group classes. + +@item +The @code{transient-column} class is the simplest group. + +This is the default ``flat'' group. If the class is not specified +explicitly and the first element is not a vector (i.e. not a group), +then this class is used. + +This class displays each element on a separate line. + +@item +The @code{transient-row} class displays all elements on a single line. + +@item +The @code{transient-columns} class displays commands organized in columns. + +Direct elements have to be groups whose elements have to be commands +or strings. Each subgroup represents a column. This class takes +care of inserting the subgroups' elements. + +This is the default ``nested'' group. If the class is not specified +explicitly and the first element is a vector (i.e.@: a group), then +this class is used. + +@item +The @code{transient-subgroups} class wraps other groups. + +Direct elements have to be groups whose elements have to be commands +or strings. This group inserts an empty line between subgroups. +The subgroups themselves are responsible for displaying their +elements. +@end itemize + +@node Group Methods +@section Group Methods + +@defun transient-setup-children group children + +This generic function can be used to setup the children or a group. + +The default implementation usually just returns the children +unchanged, but if the @code{setup-children} slot of @var{group} is non-nil, then +it calls that function with @var{children} as the only argument and +returns the value. + +The children are given as a (potentially empty) list consisting of +either group or suffix specifications. These functions can make +arbitrary changes to the children including constructing new +children from scratch. +@end defun + +@defun transient--insert-group group + +This generic function formats the group and its elements and inserts +the result into the current buffer, which is a temporary buffer. +The contents of that buffer are later inserted into the popup buffer. + +Functions that are called by this function may need to operate in +the buffer from which the transient was called. To do so they can +temporarily make the @code{transient--source-buffer} the current buffer. +@end defun + +@node Prefix Classes +@section Prefix Classes + +Currently the @code{transient-prefix} class is being used for all prefix +commands and there is only a single generic function that can be +specialized based on the class of a prefix command. + +@defun transient--history-init obj + +This generic function is called while setting up the transient and +is responsible for initializing the @code{history} slot. This is the +transient-wide history; many individual infixes also have a history +of their own. + +The default (and currently only) method extracts the value from the +global variable @code{transient-history}. +@end defun + +A transient prefix command's object is stored in the @code{transient--prefix} +property of the command symbol. While a transient is active, a clone +of that object is stored in the variable @code{transient--prefix}. A clone +is used because some changes that are made to the active transient's +object should not affect later invocations. + +@node Suffix Classes +@section Suffix Classes + +@itemize +@item +All suffix and infix classes derive from @code{transient-suffix}, which in +turn derives from @code{transient-child}, from which @code{transient-group} also +derives (@pxref{Group Classes}). + +@item +All infix classes derive from the abstract @code{transient-infix} class, +which in turn derives from the @code{transient-suffix} class. + +Infixes are a special type of suffixes. The primary difference is +that infixes always use the @code{transient--do-stay} pre-command, while +non-infix suffixes use a variety of pre-commands (see @ref{Transient State}). Doing that is most easily achieved by using this class, +though theoretically it would be possible to define an infix class +that does not do so. If you do that then you get to implement many +methods. + +Also, infixes and non-infix suffixes are usually defined using +different macros (@pxref{Defining Suffix and Infix Commands}). + +@item +Classes used for infix commands that represent arguments should +be derived from the abstract @code{transient-argument} class. + +@item +The @code{transient-switch} class (or a derived class) is used for infix +arguments that represent command-line switches (arguments that do +not take a value). + +@item +The @code{transient-option} class (or a derived class) is used for infix +arguments that represent command-line options (arguments that do +take a value). + +@item +The @code{transient-switches} class can be used for a set of mutually +exclusive command-line switches. + +@item +The @code{transient-files} class can be used for a @samp{--} argument that +indicates that all remaining arguments are files. + +@item +Classes used for infix commands that represent variables should +derived from the abstract @code{transient-variables} class. +@end itemize + +Magit defines additional classes, which can serve as examples for the +fancy things you can do without modifying Transient. Some of these +classes will likely get generalized and added to Transient. For now +they are very much subject to change and not documented. + +@node Suffix Methods +@section Suffix Methods + +To get information about the methods implementing these generic +functions use @code{describe-function}. + +@menu +* Suffix Value Methods:: +* Suffix Format Methods:: +@end menu + +@node Suffix Value Methods +@subsection Suffix Value Methods + +@defun transient-init-value obj + +This generic function sets the initial value of the object @var{obj}. + +This function is called for all suffix commands, but unless a +concrete method is implemented this falls through to the default +implementation, which is a noop. In other words this usually +only does something for infix commands, but note that this is +not implemented for the abstract class @code{transient-infix}, so if +your class derives from that directly, then you must implement +a method. +@end defun + +@defun transient-infix-read obj + +This generic function determines the new value of the infix object +@var{obj}. + +This function merely determines the value; @code{transient-infix-set} is +used to actually store the new value in the object. + +For most infix classes this is done by reading a value from the +user using the reader specified by the @code{reader} slot (using the +@code{transient-infix-value} method described below). + +For some infix classes the value is changed without reading +anything in the minibuffer, i.e.@: the mere act of invoking the +infix command determines what the new value should be, based +on the previous value. +@end defun + +@defun transient-prompt obj + +This generic function returns the prompt to be used to read infix +object @var{obj}'s value. +@end defun + +@defun transient-infix-set obj value + +This generic function sets the value of infix object @var{obj} to @var{value}. +@end defun + +@defun transient-infix-value obj + +This generic function returns the value of the suffix object @var{obj}. + +This function is called by @code{transient-args} (which see), meaning this +function is how the value of a transient is determined so that the +invoked suffix command can use it. + +Currently most values are strings, but that is not set in stone. +@code{nil} is not a value, it means ``no value''. + +Usually only infixes have a value, but see the method for +@code{transient-suffix}. +@end defun + +@defun transient-init-scope obj + +This generic function sets the scope of the suffix object @var{obj}. + +The scope is actually a property of the transient prefix, not of +individual suffixes. However it is possible to invoke a suffix +command directly instead of from a transient. In that case, if +the suffix expects a scope, then it has to determine that itself +and store it in its @code{scope} slot. + +This function is called for all suffix commands, but unless a +concrete method is implemented this falls through to the default +implementation, which is a noop. +@end defun + +@node Suffix Format Methods +@subsection Suffix Format Methods + +@defun transient-format obj + +This generic function formats and returns @var{obj} for display. + +When this function is called, then the current buffer is some +temporary buffer. If you need the buffer from which the prefix +command was invoked to be current, then do so by temporarily +making @code{transient--source-buffer} current. +@end defun + +@defun transient-format-key obj + +This generic function formats @var{obj}'s @code{key} for display and returns the +result. +@end defun + +@defun transient-format-description obj + +This generic function formats @var{obj}'s @code{description} for display and +returns the result. +@end defun + +@defun transient-format-value obj + +This generic function formats @var{obj}'s value for display and returns +the result. +@end defun + +@defun transient-show-help obj + +Show help for the prefix, infix or suffix command represented by +@var{obj}. + +For prefixes, show the info manual, if that is specified using the +@code{info-manual} slot. Otherwise, show the manpage if that is specified +using the @code{man-page} slot. Otherwise, show the command's doc string. + +For suffixes, show the command's doc string. + +For infixes, show the manpage if that is specified. Otherwise show +the command's doc string. +@end defun + +@node Prefix Slots +@section Prefix Slots + +@itemize +@item +@code{man-page} or @code{info-manual} can be used to specify the documentation for +the prefix and its suffixes. The command @code{transient-help} uses the +method @code{transient-show-help} (which see) to lookup and use these +values. + +@item +@code{history-key} If multiple prefix commands should share a single value, +then this slot has to be set to the same value for all of them. You +probably don't want that. + +@item +@code{transient-suffix} and @code{transient-non-suffix} play a part when +determining whether the currently active transient prefix command +remains active/transient when a suffix or abitrary non-suffix +command is invoked. @xref{Transient State}. + +@item +@code{incompatible} A list of lists. Each sub-list specifies a set of +mutually exclusive arguments. Enabling one of these arguments +causes the others to be disabled. An argument may appear in +multiple sub-lists. + +@item +@code{scope} For some transients it might be necessary to have a sort of +secondary value, called a ``scope''. See @code{transient-define-prefix}. +@end itemize + +@anchor{Internal Prefix Slots} +@subheading Internal Prefix Slots + +These slots are mostly intended for internal use. They should not be +set in calls to @code{transient-define-prefix}. + +@itemize +@item +@code{prototype} When a transient prefix command is invoked, then a clone +of that object is stored in the global variable @code{transient--prefix} +and the prototype is stored in the clone's @code{prototype} slot. + +@item +@code{command} The command, a symbol. Each transient prefix command +consists of a command, which is stored in a symbol's function slot +and an object, which is stored in the @code{transient--prefix} property +of the same symbol. + +@item +@code{level} The level of the prefix commands. The suffix commands whose +layer is equal or lower are displayed. @pxref{Enabling and Disabling Suffixes}. + +@item +@code{value} The likely outdated value of the prefix. Instead of accessing +this slot directly you should use the function @code{transient-get-value}, +which is guaranteed to return the up-to-date value. + +@item +@code{history} and @code{history-pos} are used to keep track of historic values. +Unless you implement your own @code{transient-infix-read} method you should +not have to deal with these slots. +@end itemize + +@node Suffix Slots +@section Suffix Slots + +Here we document most of the slots that are only available for suffix +objects. Some slots are shared by suffix and group objects, they are +documented in @ref{Predicate Slots}. + +Also see @ref{Suffix Classes}. + +@anchor{Slots of @code{transient-suffix}} +@subheading Slots of @code{transient-suffix} + +@itemize +@item +@code{key} The key, a key vector or a key description string. + +@item +@code{command} The command, a symbol. + +@item +@code{transient} Whether to stay transient. @xref{Transient State}. + +@item +@code{format} The format used to display the suffix in the popup buffer. +It must contain the following %-placeholders: + +@itemize +@item +@code{%k} For the key. + +@item +@code{%d} For the description. + +@item +@code{%v} For the infix value. Non-infix suffixes don't have a value. +@end itemize + +@item +@code{description} The description, either a string or a function that is +called with no argument and returns a string. +@end itemize + +@anchor{Slots of @code{transient-infix}} +@subheading Slots of @code{transient-infix} + +Some of these slots are only meaningful for some of the subclasses. +They are defined here anyway to allow sharing certain methods. + +@itemize +@item +@code{argument} The long argument, e.g. @code{--verbose}. + +@item +@code{shortarg} The short argument, e.g. @code{-v}. + +@item +@code{value} The value. Should not be accessed directly. + +@item +@code{init-value} Function that is responsable for setting the object's +value. If bound, then this is called with the object as the only +argument. Usually this is not bound, in which case the object's +primary @code{transient-init-value} method is called instead. + +@item +@code{unsavable} Whether the value of the suffix is not saved as part of +the prefixes. + +@item +@code{multi-value} For options, whether the option can have multiple +values. If non-nil, then default to use @code{completing-read-multiple}. + +@item +@code{always-read} For options, whether to read a value on every invocation. +If this is nil, then options that have a value are simply unset and +have to be invoked a second time to set a new value. + +@item +@code{allow-empty} For options, whether the empty string is a valid value. + +@item +@code{history-key} The key used to store the history. This defaults to the +command name. This is useful when multiple infixes should share the +same history because their values are of the same kind. + +@item +@code{reader} The function used to read the value of an infix. Not used +for switches. The function takes three arguments, @var{prompt}, +@var{initial-input} and @var{history}, and must return a string. + +@item +@code{prompt} The prompt used when reading the value, either a string or a +function that takes the object as the only argument and which +returns a prompt string. + +@item +@code{choices} A list of valid values. How exactly that is used depends on +the class of the object. +@end itemize + +@anchor{Slots of @code{transient-variable}} +@subheading Slots of @code{transient-variable} + +@itemize +@item +@code{variable} The variable. +@end itemize + +@anchor{Slots of @code{transient-switches}} +@subheading Slots of @code{transient-switches} + +@itemize +@item +@code{argument-format} The display format. Must contain @code{%s}, one of the +@code{choices} is substituted for that. E.g., @code{--%s-order}. + +@item +@code{argument-regexp} The regexp used to match any one of the switches. +E.g., @code{\\(--\\(topo\\|author-date\\|date\\)-order\\)}. +@end itemize + +@node Predicate Slots +@section Predicate Slots + +Suffix and group objects share some predicate slots that control +whether a group or suffix should be available depending on some state. +Only one of these slots can be used at the same time. It is undefined +what happens if you use more than one. + +@itemize +@item +@code{if} Enable if predicate returns non-@code{nil}. + +@item +@code{if-not} Enable if predicate returns @code{nil}. + +@item +@code{if-non-nil} Enable if variable's value is non-@code{nil}. + +@item +@code{if-nil} Enable if variable's value is @code{nil}. + +@item +@code{if-mode} Enable if major-mode matches value. + +@item +@code{if-not-mode} Enable if major-mode does not match value. + +@item +@code{if-derived} Enable if major-mode derives from value. + +@item +@code{if-not-derived} Enable if major-mode does not derive from value. +@end itemize + +One more slot is shared between group and suffix classes, @code{level}. Like +the slots documented above, it is a predicate, but it is used for a +different purpose. The value has to be an integer between 1 +and 7. @code{level} controls whether a suffix or a group should be +available depending on user preference. +@xref{Enabling and Disabling Suffixes}. + +@node Related Abstractions and Packages +@chapter Related Abstractions and Packages + +@menu +* Comparison With Prefix Keys and Prefix Arguments:: +* Comparison With Other Packages:: +@end menu + +@node Comparison With Prefix Keys and Prefix Arguments +@section Comparison With Prefix Keys and Prefix Arguments + +While transient commands were inspired by regular prefix keys and +prefix arguments, they are also quite different and much more complex. + +The following diagrams illustrate some of the differences. + +@itemize +@item +@code{(c)} represents a return to the command loop. + +@item +@code{(+)} represents the user's choice to press one key or another. + +@item +@code{@{@var{word}@}} are possible behaviors. + +@item +@code{@{@var{number}@}} is a footnote. +@end itemize + +@anchor{Regular Prefix Commands} +@subheading Regular Prefix Commands + +@xref{Prefix Keys,,,elisp,}. + +@example + ,--> command1 --> (c) + | +(c)-(+)-> prefix command or key --+--> command2 --> (c) + | + `--> command3 --> (c) +@end example + +@anchor{Regular Prefix Arguments} +@subheading Regular Prefix Arguments + +@xref{Prefix Command Arguments,,,elisp,}. + +@example + ,----------------------------------, + | | + v | +(c)-(+)---> prefix argument command --(c)-(+)-> any command --> (c) + | ^ | + | | | + `-- sets or changes --, ,-- maybe used --' | + | | | + v | | + prefix argument state | + ^ | + | | + `-------- discards --------' +@end example + +@anchor{Transients} +@subheading Transients + +(∩｀-´)⊃━☆ﾟ.*･｡ﾟ + +This diagram ignores the infix value and external state: + +@example +(c) + | ,- @{stay@} ------<-,-<------------<-,-<---, +(+) | | | | + | | | | | + | | ,--> infix1 --| | | + | | | | | | + | | |--> infix2 --| | | + v v | | | | + prefix -(c)-(+)-> infix3 --' ^ | + | | | + |---------------> suffix1 -->--| | + | | | + |---------------> suffix2 ----@{1@}------> @{exit@} --> (c) + | | + |---------------> suffix3 -------------> @{exit@} --> (c) + | | + `--> any command --@{2@}-> @{warn@} -->--| + | | + |--> @{noop@} -->--| + | | + |--> @{call@} -->--' + | + `------------------> @{exit@} --> (c) +@end example + +This diagram takes the infix value into account to an extend, while +still ignoring external state: + +@example +(c) + | ,- @{stay@} ------<-,-<------------<-,-<---, +(+) | | | | + | | | | | + | | ,--> infix1 --| | | + | | | | | | | + | | ,--> infix2 --| | | + v v | | | | | + prefix -(c)-(+)-> infix3 --' | | + | | ^ | + | | | | + |---------------> suffix1 -->--| | + | | ^ | | + | | | | | + |---------------> suffix2 ----@{1@}------> @{exit@} --> (c) + | | ^ | | + | | | | v + | | | | | + |---------------> suffix3 -------------> @{exit@} --> (c) + | | ^ | | + | sets | | v + | | maybe | | + | | used | | + | | | | | + | | infix --' | | + | `---> value | | + | ^ | | + | | | | + | hides | | + | | | | + | `--------------------------<---| + | | | + `--> any command --@{2@}-> @{warn@} -->--| | + | | | + |--> @{noop@} -->--| | + | | | + |--> @{call@} -->--' ^ + | | + `------------------> @{exit@} --> (c) +@end example + +This diagram provides more information about the infix value +and also takes external state into account. + +@example + ,----sets--- "anything" + | + v + ,---------> external + | state + | | | + | initialized | ☉‿⚆ + sets from | + | | maybe + | ,----------' used + | | | +(c) | | v + | ,- @{stay@} --|---<-,-<------|-----<-,-<---, +(+) | | | | | | | + | | | v | | | | + | | ,--> infix1 --| | | | + | | | | | | | | | + | | | | v | | | | + | | ,--> infix2 --| | | | + | | | | ^ | | | | + v v | | | | | | | + prefix -(c)-(+)-> infix3 --' | | | + | | ^ | ^ | + | | | v | | + |---------------> suffix1 -->--| | + | | | ^ | | | + | | | | v | | + |---------------> suffix2 ----@{1@}------> @{exit@} --> (c) + | | | ^ | | | + | | | | | | v + | | | | v | | + |---------------> suffix3 -------------> @{exit@} --> (c) + | | | ^ | | + | sets | | | v + | | initialized maybe | | + | | from used | | + | | | | | | + | | `-- infix ---' | | + | `---> value -----------------------------> persistent + | ^ ^ | | across + | | | | | invocations -, + | hides | | | | + | | `----------------------------------------------' + | | | | + | `--------------------------<---| + | | | + `--> any command --@{2@}-> @{warn@} -->--| | + | | | + |--> @{noop@} -->--| | + | | | + |--> @{call@} -->--' ^ + | | + `------------------> @{exit@} --> (c) +@end example + +@itemize +@item +@code{@{1@}} Transients can be configured to be exited when a suffix command +is invoked. The default is to do so for all suffixes except for +those that are common to all transients and which are used to +perform tasks such as providing help and saving the value of the +infix arguments for future invocations. The behavior can also be +specified for individual suffix commands and may even depend on +state. + +@item +@code{@{2@}} Transients can be configured to allow the user to invoke +non-suffix commands. The default is to not allow that and instead +warn the user. +@end itemize + +Despite already being rather complex, even the last diagram leaves out +many details. Most importantly it implies that the decision whether +to remain transient is made later than it actually is made (for the +most part a function on @code{pre-command-hook} is responsible). But such +implementation details are of little relevance to users and are +covered elsewhere. + +@node Comparison With Other Packages +@section Comparison With Other Packages + +@anchor{Magit-Popup} +@subheading Magit-Popup + +Transient is the successor to Magit-Popup (@pxref{Top,,,magit-popup,}). + +One major difference between these two implementations of the same +ideas is that while Transient uses transient keymaps and embraces the +command-loop, Magit-Popup implemented an inferior mechanism that does +not use transient keymaps and that instead of using the command-loop +implements a naive alternative based on @code{read-char}. + +Magit-Popup does not use classes and generic functions and defining a +new command type is near impossible as it involves adding hard-coded +special-cases to many functions. Because of that only a single new +type was added, which was not already part of Magit-Popup's initial +release. + +A lot of things are hard-coded in Magit-Popup. One random example is +that the key bindings for switches must begin with @code{-} and those for +options must begin with @code{=}. + +@anchor{Hydra} +@subheading Hydra + +Hydra (see @uref{https://github.com/abo-abo/hydra}) is another package that +provides features similar to those of Transient. + +Both packages use transient keymaps to make a set of commands +temporarily available and show the available commands in a popup +buffer. + +A Hydra ``body'' is equivalent to a Transient ``prefix'' and a Hydra +``head'' is equivalent to a Transient ``suffix''. Hydra has no equivalent +of a Transient ``infix''. + +Both hydras and transients can be used as simple command dispatchers. +Used like this they are similar to regular prefix commands and prefix +keys, except that the available commands are shown in the popup buffer. + +(Another package that does this is @code{which-key}. It does so automatically +for any incomplete key sequence. The advantage of that approach is +that no additional work is necessary; the disadvantage is that the +available commands are not organized semantically.) + +Both Hydra and Transient provide features that go beyond simple +command dispatchers: + +@itemize +@item +Invoking a command from a hydra does not necessarily exit the hydra. +That makes it possible to invoke the same command again, but using a +shorter key sequence (i.e. the key that was used to enter the hydra +does not have to be pressed again). + +Transient supports that too, but for now this feature is not a focus +and the interface is a bit more complicated. A very basic example +using the current interface: + +@lisp +(transient-define-prefix outline-navigate () + :transient-suffix 'transient--do-stay + :transient-non-suffix 'transient--do-warn + [("p" "previous visible heading" outline-previous-visible-heading) + ("n" "next visible heading" outline-next-visible-heading)]) +@end lisp + + +@item +Transient supports infix arguments; values that are set by infix +commands and then consumed by the invoked suffix command(s). + +To my knowledge, Hydra does not support that. +@end itemize + +Both packages make it possible to specify how exactly the available +commands are outlined: + +@itemize +@item +With Hydra this is often done using an explicit format string, which +gives authors a lot of flexibility and makes it possible to do fancy +things. + +The downside of this is that it becomes harder for a user to add +additional commands to an existing hydra and to change key bindings. + +@item +Transient allows the author of a transient to organize the commands +into groups and the use of generic functions allows authors of +transients to control exactly how a certain command type is +displayed. + +However while Transient supports giving sections a heading it does +not currently support giving the displayed information more +structure by, for example, using box-drawing characters. + +That could be implemented by defining a new group class, which lets +the author specify a format string. It should be possible to +implement that without modifying any existing code, but it does not +currently exist. +@end itemize + +@node FAQ +@appendix FAQ + + + +@anchor{Can I control how the popup buffer is displayed?} +@appendixsec Can I control how the popup buffer is displayed? + +Yes, see @code{transient-display-buffer-action} in @ref{Other Options}. + +@anchor{Why did some of the key bindings change?} +@appendixsec Why did some of the key bindings change? + +You may have noticed that the bindings for some of the common commands +do @strong{not} have the prefix @code{C-x} and that furthermore some of these commands +are grayed out while others are not. That unfortunately is a bit +confusing if the section of common commands is not shown permanently, +making the following explanation necessary. + +The purpose of usually hiding that section but showing it after the +user pressed the respective prefix key is to conserve space and not +overwhelm users with too much noise, while allowing the user to +quickly list common bindings on demand. + +That however should not keep us from using the best possible key +bindings. The bindings that do use a prefix do so to avoid wasting +too many non-prefix bindings, keeping them available for use in +individual transients. The bindings that do not use a prefix and that +are @strong{not} grayed out are very important bindings that are @strong{always} +available, even when invoking the ``common command key prefix'' or @strong{any +other} transient-specific prefix. The non-prefix keys that @strong{are} grayed +out however, are not available when any incomplete prefix key sequence +is active. They do not use the ``common command key prefix'' because it +is likely that users want to invoke them several times in a row and +e.g. @kbd{M-p M-p M-p} is much more convenient than +@kbd{C-x M-p C-x M-p C-x M-p}. + +You may also have noticed that the "Set" command is bound to @kbd{C-x s}, +while Magit-Popup used to bind @kbd{C-c C-c} instead. I have seen several +users praise the latter binding (sic), so I did not change it +willy-nilly. The reason that I changed it is that using different +prefix keys for different common commands, would have made the +temporary display of the common commands even more confusing, +i.e. after pressing @kbd{C-c} all the @kbd{C-x ...} bindings would be grayed out. + +Using a single prefix for common commands key means that all other +potential prefix keys can be used for transient-specific commands +@strong{without} the section of common commands also popping up. @code{C-c} in +particular is a prefix that I want to (and already do) use for Magit, and +also using that for a common command would prevent me from doing so. + +(Also see the next question.) + +@anchor{Why does @code{q} not quit popups anymore?} +@appendixsec Why does @code{q} not quit popups anymore? + +I agree that @kbd{q} is a good binding for commands that quit something. +This includes quitting whatever transient is currently active, but it +also includes quitting whatever it is that some specific transient is +controlling. The transient @code{magit-blame} for example binds @code{q} to the +command that turns @code{magit-blame-mode} off. + +So I had to decide if @kbd{q} should quit the active transient (like +Magit-Popup used to) or whether @kbd{C-g} should do that instead, so +that @kbd{q} +could be bound in individual transient to whatever commands make sense +for them. Because all other letters are already reserved for use by +individual transients, I have decided to no longer make an exception +for @kbd{q}. + +If you want to get @kbd{q}'s old binding back then you can do so. Doing +that is a bit more complicated than changing a single key binding, so +I have implemented a function, @code{transient-bind-q-to-quit} that makes the +necessary changes. See its doc string for more information. + +@node Keystroke Index +@appendix Keystroke Index + +@printindex ky + +@node Command and Function Index +@appendix Command and Function Index + +@printindex fn + +@node Variable Index +@appendix Variable Index + +@printindex vr + +@node Concept Index +@appendix Concept and Feature Index + +@printindex cp + +@node GNU General Public License +@appendix GNU General Public License + +@include gpl.texi + +@bye diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi new file mode 100644 index 00000000000..472dee70ec0 --- /dev/null +++ b/doc/misc/vtable.texi @@ -0,0 +1,552 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename ../../info/vtable.info +@settitle Variable Pitch Tables +@include docstyle.texi +@c Merge all indexes into a single Index node. +@syncodeindex fn cp +@syncodeindex vr cp +@syncodeindex ky cp +@c %**end of header + +@copying +This file documents the GNU vtable.el package. + +Copyright @copyright{} 2022 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,'' +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled ``GNU Free Documentation License.'' + +(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and +modify this GNU manual.'' +@end quotation +@end copying + +@dircategory Emacs misc features +@direntry +* vtable: (vtable). Variable Pitch Tables. +@end direntry + +@finalout + +@titlepage +@title Variable Pitch Tables +@subtitle Columnar Display of Data. + +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@ifnottex +@node Top +@top vtable + +@insertcopying +@end ifnottex + +@menu +* Introduction:: Introduction and examples. +* Concepts:: vtable concepts. +* Making A Table:: The main interface function. +* Commands:: vtable commands. +* Interface Functions:: Interface functions. + +Appendices +* GNU Free Documentation License:: The license for this documentation. + +Indices +* Index:: +@end menu + +@node Introduction +@chapter Introduction and Tutorial + +Most modes that display tabular data in Emacs use +@code{tabulated-list-mode}, but it has some limitations: It assumes +that the text it's displaying is monospaced, which makes it difficult +to mix fonts and images in a single list. The @dfn{vtable} (``variable +pitch tables'') package tackles this instead. + +@code{tabulated-list-mode} is a major mode, and assumes that it +controls the entire buffer. A vtable doesn't assume that---you can have +a vtable in the middle of other data, or have several vtables in the +same buffer. + +Here's just about the simplest vtable that can be created: + +@lisp +(make-vtable + :objects '(("Foo" 1034) + ("Gazonk" 45))) +@end lisp + +By default, vtable uses the @code{variable-pitch} font, and +right-aligns columns that have only numerical data (and left-aligns +the rest). + +You'd normally want to name the columns: + +@lisp +(make-vtable + :columns '("Name" "ID") + :objects '(("Foo" 1034) + ("Gazonk" 45))) +@end lisp + +Clicking on the column names will sort the table based on the data in +each column (which, in this example, corresponds to an element in a +list). + +By default, the data is displayed ``as is'', that is, the way +@samp{(format "%s" ...)} would display it, but you can override that. + +@lisp +(make-vtable + :columns '("Name" "ID") + :objects '(("Foo" 1034) + ("Gazonk" 45)) + :formatter (lambda (value column &rest _) + (if (= column 1) + (file-size-human-readable value) + value))) +@end lisp + +In this case, that @samp{1034} will be displayed as @samp{1k}---but +will still sort after @samp{45}, because sorting is done on the actual +data, and not the displayed data. + +Alternatively, instead of having a general formatter for the table, +you can put the formatter in the column definition: + +@lisp +(make-vtable + :columns '("Name" + (:name "ID" :formatter file-size-human-readable)) + :objects '(("Foo" 1034) + ("Gazonk" 45))) +@end lisp + +The data doesn't have to be simple lists---you can give any type of +object to vtable, but then you also have to write a function that +returns the data for each column. For instance, here's a very simple +version of @kbd{M-x list-buffers}: + +@lisp +(make-vtable + :columns '("Name" "Size" "File") + :objects (buffer-list) + :actions '("k" kill-buffer + "RET" display-buffer) + :getter (lambda (object column vtable) + (pcase (vtable-column vtable column) + ("Name" (buffer-name object)) + ("Size" (buffer-size object)) + ("File" (or (buffer-file-name object) ""))))) +@end lisp + +@var{objects} in this case is a list of buffers. To get the data to +be displayed, vtable calls the @dfn{getter} function, which is called +for each column of every object, and which should return the data that +will eventually be displayed. + +Also note the @dfn{actions}: These are simple commands that will be +called with the object under point. So hitting @kbd{@key{RET}} on a line +will result in @code{display-buffer} being called with a buffer object +as the parameter. (You can also supply a keymap to be used, but then +you have to write commands that call @code{vtable-current-object} to +get at the object.) + +Note that the actions aren't called with the data displayed in the +buffer---they're called with the original objects. + +Finally, here's an example that uses just about all the features: + +@lisp +(make-vtable + :columns `(( :name "Thumb" :width "500px" + :displayer + ,(lambda (value max-width table) + (propertize "*" 'display + (create-image value nil nil + :max-width max-width)))) + (:name "Size" :width 10 + :formatter file-size-human-readable) + (:name "Time" :width 10 :primary ascend) + "Name") + :objects-function (lambda () + (directory-files "/tmp/" t "\\.jpg\\'")) + :actions '("RET" find-file) + :getter (lambda (object column table) + (pcase (vtable-column table column) + ("Name" (file-name-nondirectory object)) + ("Thumb" object) + ("Size" (file-attribute-size (file-attributes object))) + ("Time" (format-time-string + "%F" (file-attribute-modification-time + (file-attributes object)))))) + :separator-width 5 + :keymap (define-keymap + "q" #'kill-buffer)) +@end lisp + +This vtable implements a simple image browser that displays image +thumbnails (that change sizes dynamically depending on the width of +the column), human-readable file sizes, date and file name. The +separator width is 5 typical characters wide. Hitting @kbd{@key{RET}} on a +line will open the image in a new window, and hitting @kbd{q} will +kill a buffer. + +@node Concepts +@chapter Concepts + +@cindex vtable +A vtable lists data about a number of @dfn{objects}. Each object can +be a list or a vector, but it can also be anything else. + +@cindex getter of a vtable +To get the @dfn{value} for a particular column, the @dfn{getter} +function is called on the object. If no getter function is defined, +the default is to try to index the object as a sequence. In any case, +we end up with a value that is then used for sorting. + +@cindex formatter of a vtable +This value is then @dfn{formatted} via a @dfn{formatter} function, +which is called with the @dfn{value} as the argument. The formatter +commonly makes the value more reader friendly. + +@cindex displayer of a vtable +Finally, the formatted value is passed to the @dfn{displayer} +function, which is responsible for putting the table face on the +formatted value, and also ensuring that it's not wider than the column +width. The displayer will commonly truncate too-long strings and +scale image sizes. + +All these three transforms, the getter, the formatter and the display +functions, can be defined on a per-column basis, and also on a +per-table basis. (The per-column transform takes precedence over the +per-table transform.) + +User commands that are defined on a table does not work on the +displayed data. Instead they are called with the original object as +the argument. + +@node Making A Table +@chapter Making A Table + +@findex make-vtable +The interface function for making (and optionally inserting a table +into a buffer) is @code{make-vtable}. It returns a table object. + +The keyword parameters are described below. + +There are many callback interface functions possible in +@code{make-vtable}, and many of them take a @var{object} argument (an +object from the @code{:objects} list), a column index argument (an +integer starting at zero), and a table argument (the object returned +by @code{make-vtable}). + +@table @code +@item :objects +This is a list of objects to be displayed. It should either be a list +of strings (which will then be displayed as a single-column table), or +a list where each element is a sequence containing a mixture of +strings, numbers, and other objects that can be displayed ``simply''. + +In the latter case, if @code{:columns} is non-@code{nil} and there's +more elements in the sequence than there is in @code{:columns}, only +the @code{:columns} first elements are displayed. + +@item :objects-function +It's often convenient to generate the objects dynamically (for +instance, to make reversion work automatically). In that case, this +should be a function (which will be called with no arguments), and +should return a value as accepted as an @code{:objects} list. + +@item :columns +This is a list where each element is either a string (the column +name), a plist of keyword/values (to make a @code{vtable-column} +object), or a full @code{vtable-column} object. A +@code{vtable-column} object has the following slots: + +@table @code +@item name +The name of the column. + +@item width +The width of the column. This is either a number (the width of that +many @samp{x} characters in the table's face), or a string on the form +@samp{Xe@var{x}}, where @var{x} is a number of @samp{x} characters, or a +string on the form @samp{Xp@var{x}} (denoting a number of pixels), or a +string on the form @samp{X%} (a percentage of the window's width). + +@item min-width +This uses the same format as @code{width}, but specifies the minimum +width (and overrides @code{width} if @code{width} is smaller than this. + +@item max-width +This uses the same format as @code{width}, but specifies the maximum +width (and overrides @code{width} if @code{width} is larger than this. +@code{min-width}/@code{max-width} can be useful if @code{width} is +given as a percentage of the window width, and you want to ensure that +the column doesn't grow pointlessly large or unreadably narrow. + +@item primary +Whether this is the primary column---this will be used for initial +sorting. This should be either @code{ascend} or @code{descend} to say +in which order the table should be sorted. + +@item getter +If present, this function will be called to return the column value. + +@defun column-getter object table +It's called with two parameters: the object and the table. +@end defun + +@item formatter +If present, this function will be called to format the value. + +@defun column-formatter value +It's called with one parameter: the column value. +@end defun + +@item displayer +If present, this function will be called to prepare the formatted +value for display. This function should return a string with the +table face applied, and also limit the width of the string to the +display width. + +@defun column-displayer fvalue max-width table +@var{fvalue} is the formatted value; @var{max-width} is the maximum +width (in pixels), and @var{table} is the table. +@end defun + +@item align +Should be either @code{right} or @code{left}. +@end table + +@item :getter +If given, this is a function that should return the values to use in +the table, and will be called once for each element in the table +(unless overridden by a column getter function). + +@defun getter object index table +For a simple object (like a sequence), this function will typically +just return the element corresponding to the column index (zero-based), but the +function can do any computation it wants. If it's more convenient to +write the function based on column names rather than the column index, +the @code{vtable-column} function can be used to map from index to name. +@end defun + +@item :formatter +If present, this is a function that should format the value, and it +will be called on all values in the table (unless overridden by a +column formatter). + +@defun formatter value index table +This function is called with three parameters: the value (as returned +by the getter); the column index, and the table. It can return any +value. + +This can be used to (for instance) format numbers in a human-readable +form. +@end defun + +@item :displayer +Before displaying an element, it's passed to the displaying function +(if any). + +@defun displayer fvalue index max-width table +This is called with four arguments: the formatted value of the element +(as returned by the formatter function); the column index; the display +width (in pixels); and the table. + +This function should return a string with the table face applied, and +truncated to the display width. + +This can be used to (for instance) change the size of images that are +displayed in the table. +@end defun + +@item :use-header-line +If non-@code{nil} (which is the default), display the column names on +the header line. This is the most common use +case, but if there's other text in the buffer before the table, or +there are several tables in the same buffer, then this should be +@code{nil}. + +@item :face +The face to be used. This defaults to @code{variable-pitch}. This +face doesn't override the faces in the data, or the faces supplied by +the getter and formatter functions. + +@item :actions +This uses the same syntax as @code{define-keymap}, but doesn't refer +to commands directly. Instead each key is bound to a command that +picks out the current object, and then calls the function specified +with that as the argument. + +@item :keymap +This is a keymap used on the table. The commands here are called as +usual, and if they're supposed to work on the object displayed on the +current line, they can use the @code{vtable-current-object} function +(@pxref{Interface Functions}) to determine what that object is. + +@item :separator-width +The width of the blank space between columns. + +@item :sort-by +This should be a list of tuples, and specifies how the table is to be +sorted. Each tuple should consist of an integer (the column index) +and either @code{ascend} or @code{descend}. + +The table is first sorted by the first element in this list, and then +the next, until the end is reached. + +@item :ellipsis +By default, when shortening displayed values, an ellipsis will be +shown. If this is @code{nil}, no ellipsis is shown. (The text to use +as the ellipsis is determined by the @code{truncate-string-ellipsis} +function.) + +@findex vtable-insert +@item :insert +By default, @code{make-vtable} will insert the table at point. If this +is @code{nil}, nothing is inserted, but the vtable object is returned, +and you can insert it later with the @code{vtable-insert} function. +@end table + +@code{make-table} returns a @code{vtable} object. You can access the +slots in that object by using accessor functions that have names based +on the keywords described above. For instance, to access the face, +use @code{vtable-face}. + +@node Commands +@chapter Commands +@cindex vtable commands + +When point is placed on a vtable, the following keys are bound: + +@table @kbd +@findex vtable-sort-by-current-column +@item S +Sort the table by the current column +(@code{vtable-sort-by-current-column}). Note that the table is sorted +according to the data returned by the getter function (@pxref{Making A +Table}), not by how it's +displayed in the buffer. Columns that have only numerical data is +sorted as numbers, the rest are sorted as strings. + +@findex vtable-narrow-current-column +@item @{ +Make the current column narrower +(@code{vtable-narrow-current-column}). + +@findex vtable-widen-current-column +@item @} +Make the current column wider +(@code{vtable-widen-current-column}). + +@findex vtable-previous-column +@item M-<left> +Move to the previous column (@code{vtable-previous-column}). + +@findex vtable-next-column +@item M-<right> +Move to the next column (@code{vtable-next-column}). + +@findex vtable-revert-command +@item g +Regenerate the table (@code{vtable-revert-command}). This command +mostly makes sense if the table has a @code{:objects-function} that +can fetch new data. +@end table + +@node Interface Functions +@chapter Interface Functions + +If you need to write a mode based on vtable, you will have to interact +with the table in +various ways---for instance, you'll need to write commands that +updates an object +and then displays the result. This chapter describes functions for +such interaction. + +@defun vtable-current-table +This function returns the table under point. +@end defun + +@defun vtable-current-object +This function returns the object on the current line. (Note that this +is the original object, not the characters displayed in the +buffer.) +@end defun + +@defun vtable-current-column +This function returns the column index of the column under point. +@end defun + +@defun vtable-goto-table table +Move point to the start of @var{table} and return the position. If +@var{table} can't be found in the current buffer, don't move point and +return @code{nil}. +@end defun + +@defun vtable-goto-object object +Move point to the start of the line where @var{object} is displayed in +the current table and return the position. If @var{object} can't be found, +don't move point and return @code{nil}. +@end defun + +@defun vtable-goto-column index +Move point to the start of the @var{index}th column. (The first +column is numbered zero.) +@end defun + +@defun vtable-beginning-of-table +Move to the beginning of the current table. +@end defun + +@defun vtable-end-of-table +Move to the end of the current table. +@end defun + +@defun vtable-remove-object table object +Remove @var{object} from @var{table}. This also updates the displayed +table. +@end defun + +@defun vtable-insert-object table object &optional after-object +Insert @var{object} into @var{table}. If @var{after-object}, insert +the object after this object; otherwise append to @var{table}. This +also updates the displayed table. +@end defun + +@defun vtable-update-object table object old-object +Change @var{old-object} into @var{object} in @var{table}. This also +updates the displayed table. + +This has the same effect as calling @code{vtable-remove-object} and +then @code{vtable-insert-object}, but is more efficient. +@end defun + +@defun vtable-column table index +Return the column name of the @var{index}th column in @var{table}. +@end defun + +@node GNU Free Documentation License +@chapter GNU Free Documentation License +@include doclicense.texi + +@node Index +@unnumbered Index +@printindex cp + +@bye diff --git a/etc/DEVEL.HUMOR b/etc/DEVEL.HUMOR index 6db69bb4b58..bd51845cb11 100644 --- a/etc/DEVEL.HUMOR +++ b/etc/DEVEL.HUMOR @@ -188,3 +188,19 @@ wouldn't worry about it too much." "Kind of late, but thanks for letting us know. I've just revoked your write access to the repository for the obvious safety reasons," -- Bastien Guerry and Stefan Monnier + +---------------------------------------------------------------------- + + "I should have known better than to think I could be right and you +wrong about some Emacs code I've just started looking at. Sorry about +that." + + "No problem. It's one of the many joys of working on a code base +that's up to almost 40 years old: First you have to figure out what +the (no doubt smart) programmer meant to achieve with the code, and +then try to figure out whether it ever even did that, and then whether +it's still working the same way, and then whether it's still relevant +due to changes elsewhere, and then finally whether it can be improved +without breaking odd edge cases on obscure systems you don't have +access to. 🙃" + -- Ignacio Casso and Lars Ingebrigtsen diff --git a/etc/HELLO b/etc/HELLO index 5b2002ff933..da9b388f363 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -66,6 +66,7 @@ Maldivian (ދިވެހި) އައްސަލާމު ޢަލައިކުމް / ކިހިނ Maltese (il-Malti) Bonġu / Saħħa Mathematics ∀ p ∈ world • hello p □ Mongolian (монгол хэл) Сайн байна уу? +Northern Thai (ᨣᩣᩴᨾᩮᩬᩥᨦ / ᨽᩣᩈᩣᩃ᩶ᩣ᩠ᨶᨶᩣ) ᩈ᩠ᩅᩢᩔ᩠ᨯᩦᨣᩕᩢ᩠ᨸ Norwegian (norsk) Hei / God dag Oriya (ଓଡ଼ିଆ) ଶୁଣିବେ Polish (język polski) Dzień dobry! / Cześć! @@ -68,8 +68,12 @@ XInput 2 support from Lisp programs. To use this option, make sure the GTK 3 and Cairo development files are installed, and configure Emacs with the option '--with-pgtk'. Unlike the default X and GTK build, the resulting Emacs binary will -work on any underlying window system supported by GDK, such as -Wayland and Broadway. +work on any underlying window system supported by GDK, such as Wayland +and Broadway. We do not recommend that you use this configuration, +unless you are running a window system that's supported by GDK other +than X. Running this configuration on X is known to have problems, +such as undesirable frame positioning and various issues with keyboard +input of sequences such as 'C-;' and 'C-S-u'. --- ** The docstrings of preloaded files are not in "etc/DOC" any more. @@ -80,6 +84,9 @@ as was already the case for all the non-preloaded files. * Startup Changes in Emacs 29.1 +++ +** Emacs now supports setting 'user-emacs-directory' via '--init-directory'. + ++++ ** Emacs now has a '--fingerprint' option. This will output a string identifying the current Emacs build. @@ -89,10 +96,26 @@ This is run at the end of the Emacs startup process, and it meant to be used to reinitialize structures that would normally be done at load time. +--- +** New function 'startup-redirect-eln-cache'. +This function can be called in your init files to change the +user-specific directory where Emacs stores the "*.eln" files produced +by native compilation of Lisp packages Emacs loads. The default +eln-cache directory is unchanged: it is the 'eln-cache' subdirectory +of 'user-emacs-directory'. + * Incompatible changes in Emacs 29.1 --- +** 'C-k' no longer deletes files in 'ido-mode'. +To get the previous action back, put something like the following in +your init file: + + (require 'ido) + (keymap-set ido-file-completion-map "C-k" #'ido-delete-file-at-head) + +--- ** New user option 'term-clear-full-screen-programs'. By default, term will now work like most terminals when displaying full-screen programs: When they exit, the output is cleared, leaving @@ -116,9 +139,44 @@ This is to open up the 'C-x 8 .' map to bind further characters there. This is for compatibility with the shell versions of these commands, which don't handle options like '--help' in any special way. +--- +** The 'delete-forward-char' command now deletes by grapheme clusters. +This command is by default bound to the <Delete> function key +(a.k.a. <deletechar>). When invoked without a prefix argument or with +a positive prefix numeric argument, the command will now delete +complete grapheme clusters produced by character composition. For +example, if point is before an Emoji sequence, pressing <Delete> will +delete the entire sequence, not just a single character at its +beginning. + +** 'load-history' does not treat autoloads specially any more. +An autoload definition appears just as a '(defun . NAME)' and the +'(t . NAME)' entries are not generated any more. + * Changes in Emacs 29.1 ++++ +** New function 'command-query'. +This function makes its argument command prompt the user for +confirmation before executing. + ++++ +** The 'disabled' property of a command's symbol can now be a list. +The first element of the list should be the symbol 'query', which will +cause the command disabled this way prompt the user with a y/n or a +yes/no question before executing. The new function 'command-query' is +a convenient method of making commands disabled in this way. + +--- +** 'count-lines' will now report buffer totals if given a prefix. + +--- +** New user option 'find-library-include-other-files'. +If set to nil, commands like 'find-library' will only include library +files in the completion candidates. The default is t, which preserves +previous behavior, whereby non-library files could also be included. + ** New command 'sqlite-mode-open-file' for examining an sqlite3 file. This uses the new 'sqlite-mode' which allows listing the tables in a DB file, and examining and modifying the columns and the contents of @@ -161,6 +219,19 @@ and pop-up menus. This controls the style of the pre-edit and status areas of X input methods. ++++ +** On X11, Emacs now tries to synchronize window resize with the window manager. +This leads to less flicker and empty areas of a frame being displayed +when a frame is being resized. Unfortunately, it does not work on +some ancient buggy window managers, so if Emacs appears to freeze, but +is still responsive to input, you can turn it off by setting the X +resource "synchronizeResize" to "off". + ++++ +** New frame parameter 'alpha-background' and X resource "alphaBackground". +This controls the opacity of the text background when running on a +composited display. + --- ** New user option 'x-gtk-use-native-input'. This controls whether or not GTK input methods are used by Emacs, @@ -175,6 +246,12 @@ defaults to t, which makes Emacs use the toolkit tooltips. The existing GTK-specific option 'x-gtk-use-system-tooltips' is now an alias of this new option. ++++ +** Some connection-local variables are now user options. +The variables 'connection-local-profile-alist' and +'connection-local-criteria-alist' are now user options, in order to +make it more convenient to inspect and modify them. + --- ** New minor mode 'pixel-scroll-precision-mode'. When enabled, and if your mouse supports it, you can scroll the @@ -265,7 +342,7 @@ These will take you (respectively) to the next and previous "page". *** 'describe-char' now also outputs the name of emoji combinations. +++ -*** New key binding in *Help* buffers: 'I'. +*** New key binding in "*Help*" buffer: 'I'. This will take you to the Emacs Lisp manual entry for the item displayed, if any. @@ -404,6 +481,11 @@ When non-nil, if the point is in a closing delimiter and the opening delimiter is offscreen, shows some context around the opening delimiter in the echo area. Default nil. +May also be set to the symbols 'overlay' or 'child-frame' in which +case the context is shown in an overlay or child-frame at the top-left +of the current window. The latter option requires a graphical frame. +On non-graphical frames, the context is shown in the echo area. + ** Comint +++ @@ -421,9 +503,30 @@ The options 'mouse-wheel-down-alternate-event', 'mouse-wheel-up-alternate-event' been added to better support systems where two kinds of wheel events can be received. +** Editing complex text layout (CTL) scripts + +*** The <Delete> function key now allows deleting the entire composed sequence. +For the details, see the item about the 'delete-forward-char' command +above. + +*** New user option 'composition-break-at-point'. +Setting it to a non-nil value temporarily disables automatic +composition of character sequences at point, and thus makes it easier +to edit such sequences by allowing point to "enter" the sequence. + +*** New language environment "Northern Thai". +This uses the Tai Tham script, whose support has been enhanced. + * Changes in Specialized Modes and Packages in Emacs 29.1 +--- +** 'savehist.el' can now truncate variables that are too long. +An element of 'savehist-additional-variables' can now be of the form +'(VARIABLE . MAX-ELTS)', which means to truncate the VARIABLE's value to +at most MAX-ELTS elements (if the value is a list) before saving the +value. + ** Minibuffer and Completions *** The "*Completions*" buffer can now be automatically selected. @@ -438,7 +541,7 @@ the "*Completions*" buffer. *** New user option 'completions-sort'. This option controls the sorting of the completion candidates in -the *Completions* buffer. Available styles are no sorting, +the "*Completions*" buffer. Available styles are no sorting, alphabetical (the default), or a custom sort function. ** Isearch and Replace @@ -642,6 +745,10 @@ replacing entire matches. *** New command 'xref-find-references-and-replace' to rename one identifier. +*** New variable 'xref-current-item' (renamed from a private version). + +*** New function 'xref-show-xrefs'. + ** File notifications +++ @@ -780,9 +887,9 @@ option to nil to disable this confirmation completely. --- *** Make 'image-dired-rotate-thumbnail-(left|right)' obsolete. -Instead, use 'M-x image-dired-refresh-thumb' to generate a new -thumbnail, or 'M-x image-rotate' to rotate the thumbnail without -updating the thumbnail file. +Instead, use commands 'image-dired-refresh-thumb' to generate a new +thumbnail, or 'image-rotate' to rotate the thumbnail without updating +the thumbnail file. ** Dired @@ -859,6 +966,13 @@ When set to non-nil, Tramp does not copy files between two remote hosts via a local copy in its temporary directory, but let the 'scp' command do this job. ++++ +*** Proper password prompts for methods "doas", "sudo" and "sudoedit". +The password prompts for these methods reflect now the credentials of +the user requesting such a connection, and not of the user who is the +target. This has always been needed, just the password prompt and the +related 'auth-sources' entry were wrong. + ** Browse URL --- @@ -882,20 +996,43 @@ the Galeon web browser was released in September, 2008. Prefixing '|', '<' or '>' with an asterisk, i.e. '*|', '*<' or '*>', will cause the whole command to be passed to the operating system shell. This is particularly useful to bypass Eshell's own pipelining -support for pipelines which will move a lot of data. See "Running -Shell Pipelines Natively" in the Eshell manual. +support for pipelines which will move a lot of data. See section +"Running Shell Pipelines Natively" in the Eshell manual, node +"(eshell) Input/Output". ** Miscellaneous ++++ +*** New package vtable.el for formatting tabular data. +This package allows formatting data using variable-pitch fonts. +The resulting tables can display text in variable pitch fonts, text +using fonts of different sizes, and images. See the '(vtable)Top' +manual for more details. + +--- +*** 'list-bookmarks' now includes a type column. +Types are registered via a 'bookmark-handler-type' symbol property on +the jumping function. + --- *** New minor mode 'elide-head-mode'. Enabling this minor mode turns on hiding header material, like 'elide-head' does; disabling it shows the header. The commands 'elide-head' and 'elide-head-show' are now obsolete. +--- +** The autoarg.el library is now marked obsolete. +This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor +modes to emulate the behavior of the historical editor Twenex Emacs. +It is believed to no longer be useful. + * New Modes and Packages in Emacs 29.1 +--- +** New theme 'leuven-dark'. +This is a dark version of the 'leuven' theme. + +++ ** New mode 'erts-mode'. This mode is used to edit files geared towards testing actions in @@ -905,6 +1042,12 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 ++++ +** Remapping 'mode-line' no longer works as expected. +'mode-line' is now the parent face of the new 'mode-line-active' face, +and remapping parent of basic faces does not work reliably. +Instead of remapping 'mode-line', you have to remap 'mode-line-active'. + ** User option 'mail-source-ignore-errors' is now obsolete. The whole mechanism for prompting users to continue in case of mail-source errors has been removed, so this option is no longer @@ -1011,6 +1154,21 @@ functions. * Lisp Changes in Emacs 29.1 +++ +** New macro 'setopt'. +This is like 'setq', but uses 'customize-set-variable' to set the +variable(s). + ++++ +** New utility predicate 'mode-line-window-selected-p'. +This is meant to be used from ':eval' mode line constructs to create +different mode line looks for selected and unselected windows. + ++++ +** New variable 'messages-buffer-name'. +This variable (defaulting to "*Messages*") allows packages to override +where messages are logged. + ++++ ** New function 'readablep'. This function says whether an object can be written out and then read back by the Emacs Lisp reader. @@ -1044,7 +1202,7 @@ is, the alias chain is returned. +++ ** New facility for handling session state: 'multisession-value'. This can be used as a convenient way to store (simple) application -state, and 'M-x list-multisession-values' allows users to list +state, and the command 'list-multisession-values' allows users to list (and edit) this data. +++ @@ -1072,6 +1230,11 @@ This event is sent when a user performs a pinch gesture on a touchpad, which is comprised of placing two fingers on the touchpad and moving them towards or away from each other. ++++ +** New hook 'x-pre-popup-menu-hook'. +This hook is run before 'x-popup-menu' is about to display a +deck-of-cards menu on screen. + ** Text security and suspiciousness +++ @@ -1208,6 +1371,20 @@ inhibits 'isearch' matching the STRING parameter. It can be used to implement own regexp syntax for search/replace. --- +** New variables to customize defaults of FROM for 'query-replace*' commands. +The new variable 'query-replace-read-from-default' can be set to a +function that returns the default value of FROM when 'query-replace' +prompts for a string to be replaced. An example of such a function is +'find-tag-default'. + +The new variable 'query-replace-read-from-regexp-default' can be set +to a function (such as 'find-tag-default-as-regexp') that returns the +default value of FROM when 'query-replace-regexp' prompts for a regexp +whose matches are to be replaced. If these variables are nil (which +is the default), 'query-replace' and 'query-replace-regexp' take the +default value from the previous FROM-TO pair. + +--- ** New user option 'pp-use-max-width'. If non-nil, 'pp' will attempt to limit the line length when formatting long lists and vectors. @@ -1444,6 +1621,9 @@ The property ':position' now specifies the position of the underline when used as part of a property list specification for the ':underline' attribute. +** 'defalias' records a more precise history of definitions. +This is recorded in the `function-history` symbol property. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 1e882883b5a..58c7c44a2bf 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -33,8 +33,8 @@ more details. If you build Emacs with native compilation, but without zlib, be sure to configure with the '--without-compress-install' option, so that the -installed *.el files are not compressed; otherwise, you will not be -able to use JIT native compilation of the installed *.el files. +installed "*.el" files are not compressed; otherwise, you will not be +able to use JIT native compilation of the installed "*.el" files. Note that JIT native compilation is done in a fresh session of Emacs that is run in a subprocess, so it can legitimately report some @@ -650,12 +650,12 @@ functions. *** The 'help-for-help' ('C-h C-h') screen has been redesigned. +++ -*** New convenience commands with short keys in the Help buffer. +*** New convenience commands with short keys in the "*Help*" buffer. New command 'help-view-source' ('s') will view the source file (if any) of the current help topic. New command 'help-goto-info' ('i') will look up the current symbol (if any) in Info. New command 'help-customize' ('c') will customize the user option or the face -(if any) whose doc string is being shown in the Help buffer. +(if any) whose doc string is being shown in the "*Help*" buffer. --- *** New user option 'describe-bindings-outline'. @@ -664,9 +664,9 @@ can provide a better overview in a long list of available bindings. +++ *** New commands to describe buttons and widgets. -'widget-describe' (on a widget) will pop up a help buffer and give a -description of the properties. Likewise 'button-describe' does the -same for a button. +'widget-describe' (on a widget) will pop up the "*Help*" buffer and +give a description of the properties. Likewise 'button-describe' does +the same for a button. --- *** Improved "find definition" feature of "*Help*" buffers. @@ -731,7 +731,7 @@ result of this command. +++ *** New desktop integration for connecting to the server. -If your operating system’s desktop environment is +If your operating system's desktop environment is freedesktop.org-compatible (which is true of most GNU/Linux and other recent Unix-like desktops), you may use the new "Emacs (Client)" desktop menu entry to open files in an existing Emacs instance rather @@ -987,7 +987,7 @@ This is to keep the same behavior as Eshell. --- ** In 'nroff-mode', 'center-line' is no longer bound to a key. -The original key binding was 'M-s', which interfered with I-search, +The original key binding was 'M-s', which interfered with Isearch, since the latter uses 'M-s' as a prefix key of the search prefix map. --- @@ -1193,7 +1193,7 @@ When called interactively, 'goto-char' now offers the position at point as the default. ** Auto-saving via 'auto-save-visited-mode' can now be inhibited. -Set the variable 'auto-save-visited-mode' buffer-locally to nil to +Set the user option 'auto-save-visited-mode' buffer-locally to nil to achieve that. +++ @@ -1264,11 +1264,11 @@ end of the current match. *** New user option 'isearch-allow-motion'. When 'isearch-allow-motion' is set, the commands 'beginning-of-buffer', 'end-of-buffer', 'scroll-up-command' and 'scroll-down-command', when -invoked during I-search, move respectively to the first occurrence of +invoked during Isearch, move respectively to the first occurrence of the current search string in the buffer, the last one, the first one after the current window, and the last one before the current window. Additionally, users can change the meaning of other motion commands -during I-search by using their 'isearch-motion' property. The user +during Isearch by using their 'isearch-motion' property. The user option 'isearch-motion-changes-direction' controls whether the direction of the search changes after a motion command. @@ -1294,9 +1294,9 @@ directory to display. +++ *** Behavior change on 'dired-do-chmod'. -As a security precaution, Dired's M command no longer follows symbolic -links. Instead, it changes the symbolic link's own mode; this always -fails on platforms where such modes are immutable. +As a security precaution, Dired's 'M' command no longer follows +symbolic links. Instead, it changes the symbolic link's own mode; +this always fails on platforms where such modes are immutable. --- *** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'. @@ -1471,7 +1471,7 @@ key binding / v package-menu-filter-by-version / m package-menu-filter-marked / u package-menu-filter-upgradable -/ / package-menu-filter-clear +/ / package-menu-clear-filter *** Option to automatically native-compile packages upon installation. Customize the user option 'package-native-compile' to enable automatic @@ -1589,7 +1589,7 @@ time zones will use a form like "+0100" instead of "CET". If creating the imenu index takes longer than specified by this option (default 5 seconds), imenu indexing is stopped. -** ido +** Ido --- *** Switching on 'ido-mode' now also overrides 'ffap-file-finder'. @@ -1662,7 +1662,7 @@ buffers. ** Shell --- -*** New command in 'shell-mode': 'narrow-to-prompt'. +*** New command in 'shell-mode': 'shell-narrow-to-prompt'. This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the command line under point (and any following output). @@ -1672,7 +1672,7 @@ If non-nil, 'shell-mode' handles implicit "cd" commands, changing the directory if the command is a directory. Useful for shells like "zsh" that has this feature. -** term-mode +** Term mode --- *** New user option 'term-scroll-snap-to-bottom'. @@ -1681,7 +1681,7 @@ that the prompt is on the final line in the window. Setting this new user option to nil inhibits this behavior. --- -*** New user option 'term-set-terminal-size' +*** New user option 'term-set-terminal-size'. If non-nil, the 'LINES' and 'COLUMNS' environment variables will be set based on the current window size. In previous versions of Emacs, this was always done (and that could lead to odd displays when resizing the @@ -1706,7 +1706,7 @@ emacs-version)'. Other package names, like "tramp", could also be included. --- *** Eshell no longer re-initializes its keymap every call. -This allows users to use (define-key eshell-mode-map ...) as usual. +This allows users to use '(define-key eshell-mode-map ...)' as usual. Some modules have their own minor mode now to account for these changes. @@ -1717,7 +1717,7 @@ will create a bookmark that opens the current directory in Eshell. ** Archive mode --- -*** Archive Mode can now parse ".squashfs" files. +*** Archive mode can now parse ".squashfs" files. *** Can now modify members of 'ar' archives. @@ -1733,7 +1733,7 @@ and which are kept hidden. This command extracts the file at point and writes its data to a file. -** browse-url +** Browse URL *** Added support for custom URL handlers. There is a new variable 'browse-url-default-handlers' and a user @@ -1769,7 +1769,7 @@ passed to the browser. *** Support for the Mosaic browser has been removed. This support has been obsolete since 25.1. -** Completion List Mode +** Completion list mode *** Improved navigation in the "*Completions*" buffer. New key bindings have been added to 'completion-list-mode': 'n' and @@ -1777,7 +1777,7 @@ New key bindings have been added to 'completion-list-mode': 'n' and minibuffer and back to the completion list buffer. +++ -** profiler.el +** Profiler The results displayed by 'profiler-report' now have the usage figures at the left hand side followed by the function name. This is intended to make better use of the horizontal space, in particular eliminating @@ -1793,8 +1793,8 @@ prompt prefix. +++ *** New minor modes 'icomplete-vertical-mode' and 'fido-vertical-mode'. -These modes modify Icomplete ('M-x icomplete-mode') and Fido ('M-x -fido-mode'), to display completion candidates vertically instead of +These modes modify Icomplete ('icomplete-mode') and Fido +('fido-mode'), to display completion candidates vertically instead of horizontally. In Icomplete, completions are rotated and selection kept at the top. In Fido, completions scroll like a typical dropdown widget. Both these new minor modes will turn on their non-vertical @@ -1834,7 +1834,7 @@ Also new mode 'windmove-mode' enables the customized keybindings. ** Occur mode --- -*** New bindings in occur-mode. +*** New bindings in 'occur-mode'. The command 'next-error-no-select' is now bound to 'n' and 'previous-error-no-select' is bound to 'p'. @@ -1856,8 +1856,8 @@ The method of highlighting is specified by the user options The value was previously always a marker set to the start of the first match on the line but can now also be a list of '(BEGIN . END)' pairs of markers delimiting each match on the line. -This is a fully compatible change to the internal occur-mode -implementation, and code creating their own occur-mode buffers will +This is a fully compatible change to the internal 'occur-mode' +implementation, and code creating their own 'occur-mode' buffers will work as before. ** Emacs Lisp mode @@ -1871,7 +1871,7 @@ The presence of a space between an open paren and a symbol now is taken as a statement by the programmer that this should be indented as a data list rather than as a piece of code. -** Lisp Mode +** Lisp mode *** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'. The mode provides refined highlighting of built-in functions, types, @@ -2159,8 +2159,8 @@ take the actual screenshot, and defaults to "ImageMagick import". +++ *** New user option 'smtpmail-store-queue-variables'. If non-nil, SMTP variables will be stored together with the queued -messages, and will then be used when sending with -'M-x smtpmail-send-queued-mail'. +messages, and will then be used when sending with command +'smtpmail-send-queued-mail'. +++ *** Allow direct selection of smtp authentication mechanism. @@ -2263,7 +2263,7 @@ set user option 'tramp-allow-unsafe-temporary-files' to t. +++ *** 'make-directory' of a remote directory honors the default file modes. -** gdb-mi +** GDB/MI *** New user option 'gdb-registers-enable-filter'. If non-nil, apply a register filter based on @@ -2377,7 +2377,7 @@ prefix on the Subject line in various languages. If set non-nil, showing an unseen message will set the Rmail buffer's modified flag. The default is nil, to preserve the old behavior. -** CC Mode +** CC mode +++ *** Added support for Doxygen documentation style. @@ -2527,7 +2527,7 @@ However, if "~/Downloads/" already exists, that will continue to be used. --- -*** The command 'eww-follow-link' now supports custom mailto: handlers. +*** The command 'eww-follow-link' now supports custom 'mailto:' handlers. The function that is invoked when clicking on or otherwise following a 'mailto:' link in an EWW buffer can now be customized. For more information, see the related entry about 'shr-browse-url' below. @@ -2540,9 +2540,9 @@ will create a bookmark that opens the current URL in EWW. ** SHR --- -*** The command 'shr-browse-url' now supports custom mailto handlers. +*** The command 'shr-browse-url' now supports custom 'mailto:' handlers. Clicking on or otherwise following a 'mailto:' link in an HTML buffer -rendered by SHR previously invoked the command 'browse-url-mailto'. +rendered by SHR previously invoked the command 'browse-url-mail'. This is still the case by default, but if you customize 'browse-url-mailto-function' or 'browse-url-handlers' to call some other function, it will now be called instead of the default. @@ -2652,7 +2652,7 @@ behavior of Xref commands such as 'xref-find-references', display many matches that the user would like to visit. 'xref-auto-jump-to-first-xref' changes their behavior much in the same way as 'xref-auto-jump-to-first-definition' affects the -"find-definitions" commands. +'xref-find-definitions*' commands. --- *** New user options 'xref-search-program' and 'xref-search-program-alist'. @@ -2730,7 +2730,7 @@ the function 'format-spec' documented under node "(elisp) Custom Format Strings". The new syntax includes specifiers for padding and truncation, amongst other things. -** bug-reference.el +** Bug Reference --- *** Bug reference mode uses auto-setup. @@ -2747,7 +2747,7 @@ variables 'bug-reference-setup-from-vc-alist', 'bug-reference-setup-from-mail-alist', and 'bug-reference-setup-from-irc-alist'. -** HTML Mode +** HTML mode --- *** A new skeleton for adding relative URLs has been added. @@ -2781,7 +2781,7 @@ This face is used for error messages from 'diff'. *** New command 'diff-refresh-hunk'. This new command (bound to 'C-c C-l') regenerates the current hunk. -** thing-at-point +** Thing at point +++ *** New 'thing-at-point' target: 'existing-filename'. @@ -2797,7 +2797,7 @@ If point is inside a string, it returns that string. This allows mode-specific alterations to how 'thing-at-point' works. --- -*** thing-at-point now respects fields. +*** 'thing-at-point' now respects fields. 'thing-at-point' (and all functions that use it, like 'symbol-at-point') will narrow to the current field (if any) before trying to identify the thing at point. @@ -2806,7 +2806,7 @@ trying to identify the thing at point. *** New function 'thing-at-mouse'. This is like 'thing-at-point', but uses the mouse event position instead. -** Image-Dired +** Image Dired +++ *** New user option 'image-dired-thumb-visible-marks'. @@ -2886,7 +2886,7 @@ The command previously extended the start of the region to the start of the line, but will now actually send the marked region, as documented. -** Ruby Mode +** Ruby mode --- *** 'ruby-use-smie' is declared obsolete. @@ -2899,7 +2899,7 @@ This previously used to align subsequent lines with the last sibling, but it now aligns with the first sibling (which is the preferred style in Ruby). -** CPerl Mode +** CPerl mode --- *** New face 'perl-heredoc', used for heredoc elements. @@ -2916,7 +2916,7 @@ of conditionals. *** New face 'perl-non-scalar-variable'. This is used to fontify non-scalar variables. -** Octave Mode +** Octave mode +++ *** Line continuations in double-quoted strings now use a backslash. @@ -2928,7 +2928,7 @@ everywhere else. +++ ** EasyPG GPG key servers can now be queried for keys with the -'M-x epa-search-keys' command. Keys can then be added to your +'epa-search-keys' command. Keys can then be added to your personal key ring. ** Etags @@ -2948,7 +2948,7 @@ invoked with the '--declarations' command-line option. +++ *** Support for OSC escape sequences. -Adding the new 'comint-osc-process-output' to +Adding the new function 'comint-osc-process-output' to 'comint-output-filter-functions' enables the interpretation of OSC ("Operating System Command") escape sequences in comint buffers. By default, only OSC 8, for hyperlinks, and OSC 7, for directory @@ -2960,7 +2960,7 @@ sequences. *** 'comint-delete-output' can now save deleted text in the kill-ring. Interactively, 'C-u C-c C-o' triggers this new optional behavior. -** ansi-color.el +** ANSI color --- *** Colors are now defined by faces. @@ -2980,7 +2980,7 @@ non-nil. *** Starting with Emacs 28.1 and ERC 5.4, see the ERC-NEWS file for user-visible changes in ERC. -** xwidget-webkit mode +** Xwidget Webkit mode --- *** New xwidget commands. @@ -3062,7 +3062,7 @@ Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. --- *** New user option 'gravatar-service' for host to query for gravatars. -Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options. +Defaults to 'gravatar', with 'unicornify' and 'libravatar' as options. ** MH-E mail handler for Emacs @@ -3199,8 +3199,8 @@ user-defined sorting schemes. --- *** New user option 'reveal-auto-hide'. If non-nil (the default), revealed text is automatically hidden when -point leaves the text. If nil, the text is not hidden again. Instead -'M-x reveal-hide-revealed' can be used to hide all the revealed text. +point leaves the text. If nil, the text is not hidden again. Instead the +command 'reveal-hide-revealed' can be used to hide all the revealed text. --- *** New user option 'ffap-file-name-with-spaces'. @@ -3241,7 +3241,7 @@ different timezone causing a difference in the date. --- *** Loading dunnet.el in batch mode doesn't start the game any more. -Instead you need to do "emacs -f dun-batch" to start the game in +Instead you need to do "emacs --batch -f dunnet" to start the game in batch mode. @@ -3270,7 +3270,7 @@ window navigation direction with 'C-x o M-- o o' or to set a new step with 'C-x { C-5 { { {', which will set the window resizing step to 5 columns. -'M-x describe-repeat-maps' will display a buffer showing +Command 'describe-repeat-maps' will display a buffer showing which commands are repeatable in 'repeat-mode'. --- @@ -3713,7 +3713,7 @@ user option has been renamed to 'find-library-source-path', and --- ** The macro 'vc-call' no longer evaluates its second argument twice. -** Xref migrated from EIEIO to cl-defstruct for its core objects. +** Xref migrated from EIEIO to 'cl-defstruct' for its core objects. This means that 'oref' and 'with-slots' no longer works on them, and 'make-instance' can no longer be used to create those instances (which wasn't recommended anyway). Packages should restrict themselves to @@ -3738,8 +3738,8 @@ or if the mode is a minor mode, when the current buffer has that minor mode activated. Note that using this form will create byte code that is not compatible with byte code in previous Emacs versions. Also note that by default these annotations have no effect, unless the -new option 'read-extended-command-predicate' option is customized to call -'command-completion-default-include-p' or a similar function. +new user option 'read-extended-command-predicate' option is customized +to call 'command-completion-default-include-p' or a similar function. +++ ** New 'declare' forms to control completion of commands in 'M-x'. @@ -3754,14 +3754,14 @@ MODE..., or, if it's a minor mode, when that minor mode is enabled in the current buffer. Note that these forms will only have their effect if the -'read-extended-command-predicate' option is customized to call +'read-extended-command-predicate' user option is customized to call 'command-completion-default-include-p' or a similar function. The default value of 'read-extended-command-predicate' is nil, which means no commands that match what you have typed are excluded from being completion candidates. +++ -** 'define-minor-mode' now takes an ':interactive' argument. +** 'define-minor-mode' now takes an ':interactive' argument. This can be used for specifying which modes this minor mode is meant for, or to make the new minor mode non-interactive. The default value is t. @@ -3841,7 +3841,7 @@ presented to users or passed on to other applications. This does the same as the old command 'update-directory-autoloads', but has different semantics: Instead of passing in the output file via the dynamically bound 'generated-autoload-file' variable, the output -file is now a explicit parameter. +file is now an explicit parameter. --- ** Dragging a file into Emacs pushes the file name onto 'file-name-history'. @@ -3874,11 +3874,11 @@ summaries will include the failing condition. *** New byte-compiler check for missing dynamic variable declarations. It is meant as an (experimental) aid for converting Emacs Lisp code to lexical binding, where dynamic (special) variables bound in one -file can affect code in another. For details, see the manual section +file can affect code in another. For details, see the Info node "(elisp) Converting to Lexical Binding". +++ -*** 'byte-recompile-directory' can now compile symlinked ".el" files. +*** 'byte-recompile-directory' can now compile symlinked "*.el" files. This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter. --- @@ -3932,7 +3932,7 @@ always coincide with the keys that were actually merged, which could be 'equal' instead. The function argument is now called whenever keys are merged, for greater consistency with 'map-merge' and 'map-elt'. -** pcase +** Pcase +++ *** The 'or' pattern now binds the union of the vars of its sub-patterns. @@ -3963,8 +3963,8 @@ destructuring patterns in a 'setq' form. *** Edebug specification lists can use some new keywords: +++ -**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC. -More specifically, FUN is called with 'HEAD PF ARGS..' where +**** '&interpose SPEC FUN ARGS...' lets FUN control parsing after SPEC. +More specifically, FUN is called with 'HEAD PF ARGS...' where PF is a parsing function that expects a single argument (the specs to use) and HEAD is the code that matched SPEC. @@ -3978,7 +3978,7 @@ use) and HEAD is the code that matched SPEC. +++ *** Type aliases for module functions and finalizers. -The module header 'emacs-module.h' now contains type aliases +The module header "emacs-module.h" now contains type aliases 'emacs_function' and 'emacs_finalizer' for module functions and finalizers, respectively. @@ -4012,8 +4012,8 @@ symbolic form found in Lisp source that "abbreviates" a symbol's print name. Among other applications, this feature can be used to avoid name clashes and namespace pollution by renaming an entire file's worth of symbols with proper and longer prefixes, without actually -touching the Lisp source. For details, see the manual section -"(elisp) Shorthands". +touching the Lisp source. For details, see the Info node "(elisp) +Shorthands". +++ ** New function 'string-search'. @@ -4286,7 +4286,7 @@ Signaling it has almost the same effect as 'quit' except that it doesn't cause keyboard macro termination. +++ -** New error 'remote-file-error', a subcategory of 'file-error'. +** New error symbol 'remote-file-error', a subcategory of 'file-error'. It is signaled if a remote file operation fails due to internal reasons, and could block Emacs. It does not replace 'file-error' signals for the usual cases. Timers, process filters and process @@ -4296,10 +4296,11 @@ against this error. If such an error occurs, please report this as bug via 'M-x report-emacs-bug'. Until it is solved you could ignore such errors by performing - (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) + (setq debug-ignored-errors + (cons 'remote-file-error debug-ignored-errors)) +++ -** New macro 'named-let' added to subr-x.el. +** New macro 'named-let'. It provides Scheme's "named let" looping construct. --- @@ -4329,12 +4330,12 @@ and display the result. +++ ** 'read-number' now has its own history variable. -Additionally, the function now accepts a HIST argument which can be -used to specify a custom history variable. +Additionally, the function now accepts an optional HIST argument which +can be used to specify a custom history variable. +++ ** 'set-window-configuration' now takes two optional parameters, -'dont-set-frame' and 'dont-set-miniwindow'. The first of these, when +DONT-SET-FRAME and DONT-SET-MINIWINDOW. The first of these, when non-nil, instructs the function not to select the frame recorded in the configuration. The second prevents the current minibuffer being replaced by the one stored in the configuration. @@ -4445,7 +4446,7 @@ has been the case since Emacs 24.4 but was not announced or documented until now. (Checkdoc has also been updated to accept this convention.) +++ -** The 'uniquify' argument in 'auto-save-file-name-transforms' can be a symbol. +** The UNIQUIFY argument in 'auto-save-file-name-transforms' can be a symbol. If this symbol is one of the members of 'secure-hash-algorithms', Emacs constructs the nondirectory part of the auto-save file name by applying that 'secure-hash' to the buffer file name. This avoids any @@ -4533,7 +4534,7 @@ locales. They are also available as aliases 'ebcdic-cp-*' (e.g., support these coding-systems. +++ -** New 'Bindat type expression' description language. +** New "Bindat type expression" description language. This new system is provided by the new macro 'bindat-type' and obsoletes the old data layout specifications. It supports arbitrary-size integers, recursive types, and more. See the Info node @@ -4581,7 +4582,7 @@ to select previous/next frame are still bound to 's-~' and 's-`'. --- ** On macOS, Xwidget is now supported. If Emacs was built with xwidget support, you can access the embedded -webkit browser with 'M-x xwidget-webkit-browse-url'. Viewing two +webkit browser with command 'xwidget-webkit-browse-url'. Viewing two instances of xwidget webkit is not supported. --- diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 2358203c3d3..4e4ec6d353d 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1709,7 +1709,75 @@ actual version of libXi installed does not. The solution is to upgrade your libXi binaries to libXi 1.8.0 or later, to correspond with your XInput headers. -* Runtime problems on character terminals +*** Requesting a private colormap makes Emacs hang. + +The part of Xlib that provides this feature is broken in modern +incarnations of Xlib, so it cannot possibly work. The solution is to +remove anything that looks like this: + + Emacs.privateColormap: on + +From your X defaults file. Your X server might also provide a +different visual class that will do what you want. You can experiment +with `TrueColor-8', by placing this: + + Emacs.visualClass: TrueColor-8 + +in your ~/.Xresources, and loading that file. + +*** Colors messed up on Cairo or GTK builds. + +If your display defaults to a visual where pixel values cannot be +directly converted to their corresponding real colors, a build with +Cairo drawing or GTK will display colors incorrectly. This is because +Cairo and GTK foolishly assume that all RGB values can be converted +directly from their individual components, without asking the X server +to allocate the color. + +Your X server might have a different visual which is decomposed and +not colormapped. Try the following in your ~/.Xresources: + + Emacs.visualClass: TrueColor-N + +where "N" is the bit depth of the visual your X server defaults to. +If that does not work, you lose. Configure Emacs '--without-cairo' +and '--with-x-toolkit=lucid' instead. + +*** GUI widgets don't display on GTK builds, except for scrollbars. + +This can happen if your visual does not have a decomposed colormap, +and your X server has the X rendering extension. + +To solve the problem, disable the X rendering extension on your X +server, or rebuild Emacs without GTK+. + +*** On Accelerated X, the GTK 3 menu bar does not select items. + +The solution is to run Emacs with the environment variable 'GDK_DEBUG' +set to "nograbs", like this (where "..." stands for the other +command-line arguments you intend to pass to Emacs): + + GDK_DEBUG=nograbs emacs ... + +Accelerated X is a proprietary X server. Aside from being +proprietary, it has many other disadvantages, such as not supporting +most recent hardware and most modern extensions to the X protocol. +Consider switching to a free X server, such as X.Org. + +If setting GDK_DEBUG causes GTK to complain about not being built with +support for debugging options, then there is nothing you can do, +except switch to a free X server. + +*** 'set-mouse-position' does not move the pointer on Xwayland. + +This is because Wayland does not allow programs to warp the pointer. +There is nothing that can be done about this problem, except to switch +to an X session. + +Some versions of the Xwayland server will pretend to warp the pointer, +so mouse-motion events might be sent to the position the mouse was +supposed to have moved to, even though the cursor displays at the same +on-screen position. *** With X forwarding, mouse highlighting can make Emacs slow. @@ -1718,6 +1786,8 @@ remote X server, try this: (setq mouse-highlight nil) +* Runtime problems on character terminals + ** The meta key does not work on xterm. Typing M-x rings the terminal bell, and inserts a string like ";120~". @@ -2837,6 +2907,11 @@ when started from the command line. Especially, PGTK Emacs needs environment variables LANG and GTK_IM_MODULE. +** 'set-mouse-position' does nothing. + +GTK does not allow programs to warp the pointer anymore. There is +nothing that can be done about this problem. + * Build-time problems ** Configuration @@ -907,17 +907,17 @@ It would make it easy to add (and remove) mappings like *** Missing features This sections contains features found in other official Emacs ports. -**** Support for xwidgets -Emacs 25 has support for xwidgets, a system to include operating -system components into an Emacs buffer. The components range from -simple buttons to webkit (effectively, a web browser). +**** Improved xwidgets support +Emacs 25 has support for xwidgets, a system to include WebKit widgets +into an Emacs buffer. -Currently, xwidgets work only for the gtk+ framework but they are -designed to be compatible with multiple Emacs ports. +They work on NS, but not very well. For example, trying to display a +xwidget in the "killed" state will make Emacs crash. This is because +the NS code has not been updated to keep with recent changes to the +X11 and GTK code. -(See the scratch/nsxwidget branch, and the discussion around -Objective-C code and GCC at -https://lists.gnu.org/r/emacs-devel/2019-08/msg00072.html ) +Many features such as xwidget-webkit-edit-mode do not work correctly +on NS either. **** Respect 'frame-inhibit-implied-resize' When the variable 'frame-inhibit-implied-resize' is non-nil, frames @@ -990,29 +990,16 @@ It has been maintained in parallel to the official Cocoa-based NS interface. The Carbon interface has been enhanced, and a number of the features of that interface could be implemented NS. -**** Smooth scrolling -- maybe not a good idea -Today, by default, scrolling with a trackpad makes the text move in -steps of one line. (Scrolling with SHIFT scrolls horizontally.) - -The "mac" port provides smooth, pixel-based, scrolling. This is a very -popular feature. However, there are drawbacks to this method: what -happens if only a fraction of a line is visible at the top of a -window, is the partially visible text considered part of the window or -not? (Technically, what should 'window-start' return.) - -Note: This feature might not be allowed to be implemented until also -implemented in Emacs for a free system. - **** Mouse gestures The "mac" port defines the gestures 'swipe-left/right/up/down', 'magnify-up/down', and 'rotate-left/right'. -It also binds the magnification commands to change the font -size. (This should be not be done in a specific interface, instead -Emacs should do this binding globally.) +The magnify gestures have now been implemented on X11 and NS. The +event is named differently: it is named `pinch', but it does the same +thing. -Note: This feature might not be allowed to be implemented until also -implemented in Emacs for a free system. +Someone needs to figure out what the other gestures do in the Mac +port, implement them on X, and then following that, on NS. **** Synthesize bold fonts diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index fb018d626a7..c67235fae02 100644 --- a/etc/publicsuffix.txt +++ b/etc/publicsuffix.txt @@ -3765,11 +3765,10 @@ org.kw // ky : http://www.icta.ky/da_ky_reg_dom.php // Confirmed by registry <kysupport@perimeterusa.com> 2008-06-17 ky -edu.ky -gov.ky com.ky -org.ky +edu.ky net.ky +org.ky // kz : https://en.wikipedia.org/wiki/.kz // see also: http://www.nic.kz/rules/index.jsp @@ -11106,6 +11105,10 @@ cloudns.us // Submitted by Angelo Gladding <angelo@lahacker.net> cnpy.gdn +// Codeberg e. V. : https://codeberg.org +// Submitted by Moritz Marquardt <git@momar.de> +codeberg.page + // CoDNS B.V. co.nl co.no @@ -11965,6 +11968,10 @@ futuremailing.at // Submitted by David Illsley <david.illsley@digital.cabinet-office.gov.uk> service.gov.uk +// CDDO : https://www.gov.uk/guidance/get-an-api-domain-on-govuk +// Submitted by Jamie Tanna <jamie.tanna@digital.cabinet-office.gov.uk> +api.gov.uk + // Gehirn Inc. : https://www.gehirn.co.jp/ // Submitted by Kohei YOSHIDA <tech@gehirn.co.jp> gehirn.ne.jp @@ -13480,6 +13487,10 @@ gdynia.pl med.pl sopot.pl +// team.blue https://team.blue +// Submitted by Cedric Dubois <cedric.dubois@team.blue> +site.tb-hosting.com + // Teckids e.V. : https://www.teckids.org // Submitted by Dominik George <dominik.george@teckids.org> edugit.io diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el new file mode 100644 index 00000000000..d85f8f1aa9b --- /dev/null +++ b/etc/themes/leuven-dark-theme.el @@ -0,0 +1,1095 @@ +;;; leuven-dark-theme.el --- Awesome Emacs color theme on dark background + +;; Copyright (C) 2003-2022 Free Software Foundation, Inc. + +;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> +;; Contributor: Thibault Polge <(concat "thibault" at-sign "thb.lt")> +;; URL: https://github.com/fniessen/emacs-leuven-dark-theme +;; Version: 20220202.1126 +;; Keywords: color theme + +;; 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: + +;; This elegant Org-enhancing color theme "leuven-dark" ROCKS! +;; ... and not just for Org mode. +;; +;; To use it, put the following in your Emacs configuration file: +;; +;; (load-theme 'leuven-dark t) +;; +;; Requirements: Emacs 24+. +;; +;; NOTE -- Would you like implement a version of this for dark backgrounds, +;; please do so! I'm willing to integrate it... + +;;; Code: + +;;; Options. + +(defgroup leuven-dark nil + "Leuven theme options. +The theme has to be reloaded after changing anything in this group." + :group 'faces) + +(defcustom leuven-dark-scale-org-document-title t + "Scale Org document title. +This can be nil for unscaled, t for using the theme default, or a scaling +number." + :type '(choice + (const :tag "Unscaled" nil) + (const :tag "Default provided by theme" t) + (number :tag "Set scaling"))) + +(defcustom leuven-dark-scale-outline-headlines t + "Scale `outline' (and `org') level-1 headlines. +This can be nil for unscaled, t for using the theme default, or a scaling +number." + :type '(choice + (const :tag "Unscaled" nil) + (const :tag "Default provided by theme" t) + (number :tag "Set scaling"))) + +(defcustom leuven-dark-scale-org-agenda-structure t + "Scale Org agenda structure lines, like dates. +This can be nil for unscaled, t for using the theme default, or a scaling +number." + :type '(choice + (const :tag "Unscaled" nil) + (const :tag "Default provided by theme" t) + (number :tag "Set scaling"))) + +(defcustom leuven-dark-scale-volatile-highlight t + "Increase size in the `next-error' face. +This can be nil for unscaled, t for using the theme default, or a scaling +number." + :type '(choice + (const :tag "Unscaled" nil) + (const :tag "Default provided by theme" t) + (number :tag "Set scaling"))) + +;;;###autoload +(defun leuven-dark-scale-font (control default-height) + "Function for splicing optional font heights into face descriptions. +CONTROL can be a number, nil, or t. When t, use DEFAULT-HEIGHT." + (cond + ((numberp control) (list :height control)) + ((eq t control) (list :height default-height)) + (t nil))) + +;;; Theme Faces. + +(deftheme leuven-dark + "Face colors with a light background. +Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff, +Flyspell, Semantic, and Ansi-Color faces are included -- and much +more...") + +(let ((class '((class color) (min-colors 89))) + + ;; Leuven generic colors. + (cancel '(:slant italic :strike-through t :foreground "#5b5660")) + (clock-line '(:box (:line-width 1 :color "#cfa161") :foreground "#ffffff" :background "#1636ff")) + (code-block '(:foreground "#ffff7f" :background "#252046")) + (code-inline '(:foreground "#ff9bff" :background "#262031")) + (column '(:height 1.0 :weight normal :slant normal :underline nil :strike-through nil :foreground "#1e52b8" :background "#252c48")) + (completion-inline '(:weight normal :foreground "#443f49" :inherit hl-line)) ; Like Google. + (completion-other-candidates '(:weight bold :foreground "#ffffff" :background "#372a2a")) + (completion-selected-candidate '(:weight bold :foreground "#25202a" :background "#ffad65")) + (diff-added '(:background "#442049")) + (diff-changed '(:foreground "#ffff0b" :background "#443f2a")) + (diff-header '(:weight bold :foreground "#83ffff" :background "#252073")) + (diff-hunk-header '(:foreground "#6bff6f" :background "#252f2a")) + (diff-none '(:foreground "#7b777f")) + (diff-refine-added '(:background "#6d0d73")) + (diff-refine-removed '(:background "#06494f")) + (diff-removed '(:background "#25353e")) + (directory '(:weight bold :foreground "#ffff0b" :background "#252053")) + (file '(:foreground "#ffffff")) + (function-param '(:foreground "#de8d83")) + (grep-file-name '(:weight bold :foreground "#d8b76b")) ; Used for grep hits. + (grep-line-number '(:weight bold :foreground "#5fca5b")) + (highlight-blue '(:background "#3c312a")) + (highlight-blue2 '(:background "#3e2d2f")) + (highlight-gray '(:background "#3e3944")) + (highlight-green '(:background "#2f0e3a")) + (highlight-red '(:background "#063741")) + (highlight-yellow '(:background "#2d2058")) + (link '(:weight normal :underline t :foreground "#ff925a")) + (link-no-underline '(:weight normal :foreground "#ff925a")) + (mail-header-name '(:family "Sans Serif" :weight normal :foreground "#615c67")) + (mail-header-other '(:family "Sans Serif" :slant normal :foreground "#9d99a1")) + (mail-read '(:foreground "#77737b")) + (mail-read-high '(:foreground "#837f87")) + (mail-ticked '(:foreground "#06ccff")) + (mail-to '(:family "Sans Serif" :underline nil :foreground "#ff925a")) + (mail-unread '(:weight bold :foreground "#ffffff")) + (mail-unread-high '(:weight bold :foreground "#eea682")) + (marked-line '(:foreground "#5affff" :background "#06555f")) + (match '(:weight bold :background "#0601ff")) ; occur patterns + match in helm for files + match in Org files. + (ol1 `(,@(leuven-dark-scale-font leuven-dark-scale-outline-headlines 1.3) :weight bold :overline "#5d5862" :foreground "#c7c3cb" :background "#322d37")) + (ol2 '(:height 1.0 :weight bold :overline "#efcab2" :foreground "#efcab2" :background "#3d2a2d")) + (ol3 '(:height 1.0 :weight bold :foreground "#ffaae3" :background "#332038")) + (ol4 '(:height 1.0 :weight bold :slant normal :foreground "#1a9cff")) + (ol5 '(:height 1.0 :weight bold :slant normal :foreground "#21da7a")) + (ol6 '(:height 1.0 :weight bold :slant italic :foreground "#ff883d")) + (ol7 '(:height 1.0 :weight bold :slant italic :foreground "#d451d9")) + (ol8 '(:height 1.0 :weight bold :slant italic :foreground "#077ffa")) + (paren-matched '(:background "#7B4B98")) ; XXX Edited by hqnd. + (paren-unmatched '(:weight bold :underline "#06ffff" :foreground "#ffffff" :background "#065a64")) + (region '(:background "#752c0b")) + (shadow '(:foreground "#848088")) + (string '(:foreground "#ff7fff")) ; or #34c8d8 + (subject '(:family "Sans Serif" :weight bold :foreground "#ffffff")) + (symlink '(:foreground "#e37233")) + (tab '(:foreground "#3a353f" :background "#25202a")) + (trailing '(:foreground "#3a353f" :background "#252076")) + (volatile-highlight '(:underline nil :foreground "#25202a" :background "#66c96f")) + (volatile-highlight-supersize `(,@(leuven-dark-scale-font leuven-dark-scale-volatile-highlight 1.1) :underline nil :foreground "#25202a" :background "#66c96f")) ; flash-region + (vc-branch '(:box (:line-width 1 :color "#ff33d2") :foreground "#ffffff" :background "#5a015f")) + (xml-attribute '(:foreground "#119cd0")) + (xml-tag '(:foreground "#56e46f")) + (highlight-current-tag '(:background "#3a352a")) ; #342b32 or #0614df + ) + + (custom-theme-set-faces + 'leuven-dark + `(default ((,class (:foreground "#cfccd2" :background "#25202a")))) + `(bold ((,class (:weight bold :foreground "#ffffff")))) + `(bold-italic ((,class (:weight bold :slant italic :foreground "#ffffff")))) + `(italic ((,class (:slant italic :foreground "#e8e5eb")))) + `(underline ((,class (:underline t)))) + `(cursor ((,class (:background "#e1420b")))) + + ;; Lucid toolkit emacs menus. + `(menu ((,class (:foreground "#25202a" :background "#cfccd2")))) + + ;; Highlighting faces. + `(fringe ((,class (:foreground "#b76130" :background "#25202a")))) + `(highlight ((,class ,highlight-blue))) + `(region ((,class ,region))) + `(secondary-selection ((,class ,match))) ; Used by Org-mode for highlighting matched entries and keywords. + `(isearch ((,class (:underline "#ffffff" :foreground "#25202a" :background "#aa8b5e")))) + `(isearch-fail ((,class (:weight bold :foreground "#ffffff" :background "#06333d")))) + `(lazy-highlight ((,class (:foreground "#ffffff" :background "#0601ff")))) ; Isearch others (see `match'). + `(trailing-whitespace ((,class ,trailing))) + `(query-replace ((,class (:inherit isearch)))) + `(whitespace-hspace ((,class (:foreground "#322d37")))) ; see also `nobreak-space' + `(whitespace-indentation ((,class ,tab))) + `(whitespace-line ((,class (:foreground "#38ffff" :background "#06017f")))) + `(whitespace-tab ((,class ,tab))) + `(whitespace-trailing ((,class ,trailing))) + + ;; Mode line faces. + `(mode-line ((,class (:box (:line-width 1 :color "#e8d0b3") :foreground "#7e311e" :background "#cfa161")))) + `(mode-line-inactive ((,class (:box (:line-width 1 :color "#b5b1bb") :foreground "#322d38" :background "#696371")))) + `(mode-line-buffer-id ((,class (:weight bold :foreground "#25202a")))) + `(mode-line-emphasis ((,class (:weight bold :foreground "#25202a")))) + `(mode-line-highlight ((,class (:foreground "#0601ff")))) + + ;; Escape and prompt faces. + `(minibuffer-prompt ((,class (:weight bold :foreground "#ffffff" :background "#0628ff")))) + `(minibuffer-noticeable-prompt ((,class (:weight bold :foreground "#ffffff" :background "#0628ff")))) + `(escape-glyph ((,class (:foreground "#ff7138")))) + `(error ((,class (:foreground "#06ffff")))) + `(warning ((,class (:weight bold :foreground "#065aff")))) + `(success ((,class (:foreground "#ff01ff")))) + + ;; Font lock faces. + `(font-lock-builtin-face ((,class (:foreground "#ff9029")))) + `(font-lock-comment-delimiter-face ((,class (:foreground "#767283")))) ; #9a969e + `(font-lock-comment-face ((,class (:slant italic :foreground "#767283")))) ; #9a969e + `(font-lock-constant-face ((,class (:foreground "#34c8d8")))) + `(font-lock-doc-face ((,class (:foreground "#fd95fa")))) + ;; `(font-lock-doc-string-face ((,class (:foreground "#ff7fff")))) ; XEmacs only, but is used for HTML exports from org2html (and not interactively) + `(font-lock-function-name-face ((,class (:weight normal :foreground "#ff996f")))) + `(font-lock-keyword-face ((,class (:bold nil :foreground "#ffff0b")))) ; #ccab2d + `(font-lock-preprocessor-face ((,class (:foreground "#837f87")))) + `(font-lock-regexp-grouping-backslash ((,class (:weight bold :inherit nil)))) + `(font-lock-regexp-grouping-construct ((,class (:weight bold :inherit nil)))) + `(font-lock-string-face ((,class ,string))) + `(font-lock-type-face ((,class (:weight normal :foreground "#9fcb66")))) + `(font-lock-variable-name-face ((,class (:weight normal :foreground "#4ac964")))) ; #83ff87 + `(font-lock-warning-face ((,class (:weight bold :foreground "#06ffff")))) + + ;; Button and link faces. + `(link ((,class ,link))) + `(link-visited ((,class (:underline t :foreground "#1f879a")))) + `(button ((,class (:underline t :foreground "#ff925a")))) + `(header-line ((,class (:box (:line-width 1 :color "#ffffff") :foreground "#ffffff" :background "#322d37")))) + + ;; Gnus faces. + `(gnus-button ((,class (:weight normal)))) + `(gnus-cite-attribution-face ((,class (:foreground "#b3af59")))) + `(gnus-cite-1 ((,class (:foreground "#b3af59" :background "#2d2832")))) + `(gnus-cite-2 ((,class (:foreground "#9dffa1" :background "#2d2832")))) + `(gnus-cite-3 ((,class (:foreground "#ff8890" :background "#2d2832")))) + `(gnus-cite-4 ((,class (:foreground "#6bffff" :background "#2d2832")))) + `(gnus-cite-5 ((,class (:foreground "#ffff6f" :background "#2d2832")))) + `(gnus-cite-6 ((,class (:foreground "#4999ff" :background "#2d2832")))) + `(gnus-cite-7 ((,class (:foreground "#b3af59" :background "#2d2832")))) + `(gnus-cite-8 ((,class (:foreground "#9dffa1" :background "#2d2832")))) + `(gnus-cite-9 ((,class (:foreground "#ff8890" :background "#2d2832")))) + `(gnus-cite-10 ((,class (:foreground "#6bffff" :background "#2d2832")))) + `(gnus-emphasis-bold ((,class (:weight bold)))) + `(gnus-emphasis-highlight-words ((,class (:foreground "#0601ff" :background "#ffffff")))) + `(gnus-group-mail-1 ((,class (:weight bold :foreground "#06af59")))) + `(gnus-group-mail-1-empty ((,class (:foreground "#b3af59")))) + `(gnus-group-mail-2 ((,class (:weight bold :foreground "#06ffa1")))) + `(gnus-group-mail-2-empty ((,class (:foreground "#9dffa1")))) + `(gnus-group-mail-3 ((,class ,mail-unread))) + `(gnus-group-mail-3-empty ((,class ,mail-read))) + `(gnus-group-mail-low ((,class ,cancel))) + `(gnus-group-mail-low-empty ((,class ,cancel))) + `(gnus-group-news-1 ((,class (:weight bold :foreground "#06af59")))) + `(gnus-group-news-1-empty ((,class (:foreground "#b3af59")))) + `(gnus-group-news-2 ((,class (:weight bold :foreground "#06ffa1")))) + `(gnus-group-news-2-empty ((,class (:foreground "#9dffa1")))) + `(gnus-group-news-3 ((,class ,mail-unread))) + `(gnus-group-news-3-empty ((,class ,mail-read))) + `(gnus-group-news-4 ((,class (:weight bold :foreground "#06ffff")))) + `(gnus-group-news-4-empty ((,class (:foreground "#6bffff")))) + `(gnus-group-news-5 ((,class (:weight bold :foreground "#06ff6f")))) + `(gnus-group-news-5-empty ((,class (:foreground "#ffff6f")))) + `(gnus-group-news-6 ((,class (:weight bold :foreground "#848088")))) + `(gnus-group-news-6-empty ((,class (:foreground "#837f87")))) + `(gnus-header-content ((,class ,mail-header-other))) + `(gnus-header-from ((,class (:family "Sans Serif" :foreground "#ffffff")))) + `(gnus-header-name ((,class ,mail-header-name))) + `(gnus-header-newsgroups ((,class (:family "Sans Serif" :foreground "#cf663d")))) + `(gnus-header-subject ((,class ,subject))) + `(gnus-picon ((,class (:foreground "#0601ff" :background "#25202a")))) + `(gnus-picon-xbm ((,class (:foreground "#0601ff" :background "#25202a")))) + `(gnus-server-closed ((,class (:slant italic :foreground "#ffff0b" :background "#25202a")))) + `(gnus-server-denied ((,class (:weight bold :foreground "#06ffff" :background "#25202a")))) + `(gnus-server-opened ((,class (:family "Sans Serif" :foreground "#25202a" :foreground "#bd9432")))) + `(gnus-signature ((,class (:slant italic :foreground "#787279")))) + `(gnus-splash ((,class (:foreground "#0673ff")))) + `(gnus-summary-cancelled ((,class ,cancel))) + `(gnus-summary-high-ancient ((,class ,mail-unread-high))) + `(gnus-summary-high-read ((,class ,mail-read-high))) + `(gnus-summary-high-ticked ((,class ,mail-ticked))) + `(gnus-summary-high-unread ((,class ,mail-unread-high))) + `(gnus-summary-low-ancient ((,class (:slant italic :foreground "#ffffff")))) + `(gnus-summary-low-read ((,class (:slant italic :foreground "#6b666f" :background "#413c46")))) + `(gnus-summary-low-ticked ((,class ,mail-ticked))) + `(gnus-summary-low-unread ((,class (:slant italic :foreground "#ffffff")))) + `(gnus-summary-normal-ancient ((,class ,mail-read))) + `(gnus-summary-normal-read ((,class ,mail-read))) + `(gnus-summary-normal-ticked ((,class ,mail-ticked))) + `(gnus-summary-normal-unread ((,class ,mail-unread))) + `(gnus-summary-selected ((,class (:foreground "#25202a" :background "#ff7332")))) + `(gnus-x-face ((,class (:foreground "#ffffff" :background "#25202a")))) + + ;; Message faces. + `(message-header-name ((,class ,mail-header-name))) + `(message-header-cc ((,class ,mail-to))) + `(message-header-other ((,class ,mail-header-other))) + `(message-header-subject ((,class ,subject))) + `(message-header-to ((,class ,mail-to))) + `(message-cited-text ((,class (:foreground "#b3af59" :background "#2d2832")))) + `(message-separator ((,class (:family "Sans Serif" :weight normal :foreground "#473d43")))) + `(message-header-newsgroups ((,class (:family "Sans Serif" :foreground "#cf663d")))) + `(message-header-xheader ((,class ,mail-header-other))) + `(message-mml ((,class (:foreground "#e074e3")))) + + ;; Diff. + `(diff-added ((,class ,diff-added))) + `(diff-changed ((,class ,diff-changed))) + `(diff-context ((,class ,diff-none))) + `(diff-file-header ((,class ,diff-header))) + `(diff-file1-hunk-header ((,class (:foreground "#78ff7c" :background "#382c33")))) + `(diff-file2-hunk-header ((,class (:foreground "#d781db" :background "#382c33")))) + `(diff-function ((,class (:foreground "#38663d")))) + `(diff-header ((,class ,diff-header))) + `(diff-hunk-header ((,class ,diff-hunk-header))) + `(diff-index ((,class ,diff-header))) + `(diff-indicator-added ((,class (:foreground "#c966cc" :background "#53204e")))) + `(diff-indicator-changed ((,class (:background "#46302a")))) + `(diff-indicator-removed ((,class (:foreground "#38ccd2" :background "#254046")))) + `(diff-refine-added ((,class ,diff-refine-added))) + `(diff-refine-change ((,class (:background "#443f2a")))) + `(diff-refine-removed ((,class ,diff-refine-removed))) + `(diff-removed ((,class ,diff-removed))) + + ;; SMerge. + `(smerge-mine ((,class ,diff-changed))) + `(smerge-other ((,class ,diff-added))) + `(smerge-base ((,class ,diff-removed))) + `(smerge-markers ((,class (:background "#253859")))) + `(smerge-refined-change ((,class (:background "#5a550b")))) + + ;; Ediff. + `(ediff-current-diff-A ((,class (:background "#253f49")))) + `(ediff-current-diff-B ((,class (:background "#442049")))) + `(ediff-current-diff-C ((,class (:background "#ff010b")))) + `(ediff-even-diff-A ((,class (:background "#312c36")))) + `(ediff-even-diff-B ((,class (:background "#312c36")))) + `(ediff-fine-diff-A ((,class (:background "#06555f")))) + `(ediff-fine-diff-B ((,class (:background "#ae01b2")))) + `(ediff-odd-diff-A ((,class (:background "#312c36")))) + `(ediff-odd-diff-B ((,class (:background "#312c36")))) + + ;; Flyspell. + (if (version< emacs-version "24.4") + `(flyspell-duplicate ((,class (:underline "#101487" :inherit nil)))) + `(flyspell-duplicate ((,class (:underline (:style wave :color "#101487") :background "#292759" :inherit nil))))) + (if (version< emacs-version "24.4") + `(flyspell-incorrect ((,class (:underline "#0a5864" :inherit nil)))) + `(flyspell-incorrect ((,class (:underline (:style wave :color "#0a5864") :background "#2f454c":inherit nil))))) + + ;; ;; Semantic faces. + ;; `(semantic-decoration-on-includes ((,class (:underline ,cham-4)))) + ;; `(semantic-decoration-on-private-members-face ((,class (:background ,alum-2)))) + ;; `(semantic-decoration-on-protected-members-face ((,class (:background ,alum-2)))) + `(semantic-decoration-on-unknown-includes ((,class (:background "#252630")))) + ;; `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3)))) + `(semantic-highlight-func-current-tag-face ((,class ,highlight-current-tag))) + `(semantic-tag-boundary-face ((,class (:overline "#8c8890")))) ; Method separator. + ;; `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) + + `(Info-title-1-face ((,class ,ol1))) + `(Info-title-2-face ((,class ,ol2))) + `(Info-title-3-face ((,class ,ol3))) + `(Info-title-4-face ((,class ,ol4))) + `(ace-jump-face-foreground ((,class (:weight bold :foreground "#ffffff" :background "#065aff")))) + `(ahs-face ((,class (:background "#3e392a")))) + `(ahs-definition-face ((,class (:background "#064943")))) + `(ahs-plugin-defalt-face ((,class (:background "#25392a")))) ; Current. + `(anzu-match-1 ((,class (:foreground "#ffffff" :background "#840135")))) + `(anzu-match-2 ((,class (:foreground "#ffffff" :background "springgreen")))) + `(anzu-match-3 ((,class (:foreground "#ffffff" :background "#06ffff")))) + `(anzu-mode-line ((,class (:foreground "#ffffff" :background "#830187")))) + `(anzu-mode-line-no-match ((,class (:foreground "#ffffff" :background "#067f87")))) + `(anzu-replace-highlight ((,class (:inherit query-replace)))) + `(anzu-replace-to ((,class (:weight bold :foreground "#47cc0c" :background "#0742d2")))) + `(auto-dim-other-buffers-face ((,class (:background "#2c2731")))) + `(avy-background-face ((,class (:background "#5b5660")))) + `(avy-lead-face ((,class (:weight bold :foreground "#ffffff" :background "#065aff")))) + `(bbdb-company ((,class (:slant italic :foreground "#bd7d55")))) + `(bbdb-field-name ((,class (:weight bold :foreground "#bd7d55")))) + `(bbdb-field-value ((,class (:foreground "#bd7d55")))) + `(bbdb-name ((,class (:underline t :foreground "#0699d2")))) + `(bmkp-light-autonamed ((,class (:background "#322d37")))) + `(bmkp-light-fringe-autonamed ((,class (:foreground "#a9a5ad" :background "#302b35")))) + `(bmkp-light-fringe-non-autonamed ((,class (:foreground "#252059" :background "#fe010e")))) ; default + `(bmkp-light-non-autonamed ((,class (:background "#60202a")))) + `(bmkp-no-local ((,class (:background "#063f3e")))) + `(browse-kill-ring-separator-face ((,class (:foreground "#06ffff")))) + `(calendar-month-header ((,class (:weight bold :foreground "#b4b5ca" :background "#252059")))) + `(calendar-today ((,class (:weight bold :foreground "#b4b5ca" :background "#252059")))) + `(calendar-weekday-header ((,class (:weight bold :foreground "#ec9d5a")))) + `(calendar-weekend-header ((,class (:weight bold :foreground "#b5b1b9")))) + `(cfw:face-annotation ((,class (:foreground "#ff01ff" :background "#06ffff")))) + `(cfw:face-day-title ((,class (:foreground "#3b3640")))) + `(cfw:face-default-content ((,class (:foreground "#d9ad66")))) + `(cfw:face-default-day ((,class (:weight bold)))) + `(cfw:face-disable ((,class (:foreground "#5b5660")))) + `(cfw:face-grid ((,class (:foreground "#27222c")))) + `(cfw:face-header ((,class (:foreground "#ec9d5a" :background "#25202a" :weight bold)))) + `(cfw:face-holiday ((,class (:foreground "#8c8890" :background "#3e322a")))) + `(cfw:face-periods ((,class (:foreground "#25202a" :background "#9d7330" :slant italic)))) + `(cfw:face-saturday ((,class (:foreground "#b5b1b9" :background "#25202a" :weight bold)))) + `(cfw:face-select ((,class (:foreground "#b96a1e" :background "#352d2e")))) + `(cfw:face-sunday ((,class (:foreground "#b5b1b9" :background "#25202a" :weight bold)))) + `(cfw:face-title ((,class (:height 2.0 :foreground "#9c98a0" :weight bold :inherit variable-pitch)))) + `(cfw:face-today ((,class (:foreground "#b4b5ca" :background "#252059")))) + `(cfw:face-today-title ((,class (:foreground "#25202a" :background "#eb9958")))) + `(cfw:face-toolbar ((,class (:background "#25202a")))) + `(cfw:face-toolbar-button-off ((,class (:foreground "#35303a" :background "#25202a")))) + `(cfw:face-toolbar-button-on ((,class (:foreground "#a5a1a9" :background "#2d2832")))) + `(change-log-date ((,class (:foreground "#64df19")))) + `(change-log-file ((,class (:weight bold :foreground "#c27c45")))) + `(change-log-list ((,class (:foreground "#ffffff" :background "#8e1142")))) + `(change-log-name ((,class (:foreground "#ff7fff")))) + `(circe-highlight-all-nicks-face ((,class (:foreground "#ffff0b" :background "#322d37")))) ; other nick names + `(circe-highlight-nick-face ((,class (:foreground "#ff6cff" :background "#322d37")))) ; messages with my nick cited + `(circe-my-message-face ((,class (:foreground "#78747c" :background "#322d37")))) + `(circe-originator-face ((,class (:foreground "#ffff0b")))) + `(circe-prompt-face ((,class (:foreground "#06ffff")))) + `(circe-server-face ((,class (:foreground "#6b3524")))) + `(comint-highlight-input ((,class (:weight bold :foreground "#ffff0b" :inherit nil)))) + ;; `(comint-highlight-prompt ((,class (:weight bold :foreground "#ffffff" :background "#0628ff")))) + `(comint-highlight-prompt ((,class (:weight bold :foreground "#ffff0b" :inherit nil)))) + + ;; `(ac-selection-face ((,class ,completion-selected-candidate))) + `(ac-selection-face ((,class (:weight bold :foreground "#25202a" :background "#065aff")))) ; TEMP For diff'ing AC from Comp. + `(ac-candidate-face ((,class ,completion-other-candidates))) + `(ac-completion-face ((,class ,completion-inline))) + `(ac-candidate-mouse-face ((,class (:inherit highlight)))) + `(popup-scroll-bar-background-face ((,class (:background "#372a2a")))) + `(popup-scroll-bar-foreground-face ((,class (:background "#332525")))) ; Scrollbar (visible). + + ;; Company. + `(company-tooltip-common-selection ((,class (:weight normal :foreground "#2a3159" :inherit company-tooltip-selection)))) ; Prefix + common part in tooltip (for selection). + `(company-tooltip-selection ((,class ,completion-selected-candidate))) ; Suffix in tooltip (for selection). + `(company-tooltip-annotation-selection ((,class (:weight normal :foreground "#2a3159")))) ; Annotation (for selection). + + `(company-tooltip-common ((,class (:weight normal :foreground "#54ff59" :inherit company-tooltip)))) ; Prefix + common part in tooltip. + `(company-tooltip ((,class ,completion-other-candidates))) ; Suffix in tooltip. + `(company-tooltip-annotation ((,class (:weight normal :foreground "#deea0b")))) ; Annotation. + `(company-preview ((,class ,completion-inline))) + `(company-preview-common ((,class ,completion-inline))) + `(company-scrollbar-bg ((,class (:background "#372a2a")))) + `(company-scrollbar-fg ((,class (:background "#332525")))) ; Scrollbar (visible). + + `(compare-windows ((,class (:background "#0601ff")))) + ;; `(completions-common-part ((,class (:foreground "#06ffff" :weight bold)))) + ;; `(completions-first-difference ((,class (:foreground "#ff01ff" :weight bold)))) + `(compilation-error ((,class (:weight bold :foreground "#06ffff")))) ; Used for grep error messages. + `(compilation-info ((,class ,grep-file-name))) + `(compilation-line-number ((,class ,grep-line-number))) + `(compilation-warning ((,class (:weight bold :foreground "#065aff")))) + `(compilation-mode-line-exit ((,class (:weight bold :foreground "#ff01ff")))) ; :exit[matched] + `(compilation-mode-line-fail ((,class (:weight bold :foreground "#167d1b")))) ; :exit[no match] + `(compilation-mode-line-run ((,class (:weight bold :foreground "#065aff")))) ; :run + `(css-property ((,class (:foreground "#ff55ff")))) + `(css-selector ((,class (:weight bold :foreground "#ffff0b")))) + `(custom-button ((,class (:box (:line-width 2 :style released-button) :foreground "gray20" :background "lightgrey")))) + `(custom-button-mouse ((,class (:box (:line-width 2 :style released-button) :foreground "#ffffff" :background "#3d3842")))) + `(custom-button-pressed ((,class (:box (:line-width 2 :style pressed-button) :foreground "#ffffff" :background "#312c36")))) + `(custom-button-pressed-unraised ((,class (:underline t :foreground "#78ff7c")))) + `(custom-button-unraised ((,class (:underline t)))) + `(custom-changed ((,class (:foreground "#25202a" :background "#ffff0b")))) + `(custom-comment ((,class (:background "#2b2630")))) + `(custom-comment-tag ((,class (:foreground "#ffff7c")))) + `(custom-documentation ((,class (nil)))) + `(custom-face-tag ((,class (:family "Sans Serif" :height 1.2 :weight bold)))) + `(custom-group-tag ((,class (:height 1.2 :weight bold :foreground "#ffff0b")))) + `(custom-group-tag-1 ((,class (:family "Sans Serif" :height 1.2 :weight bold :foreground "#06ffff")))) + `(custom-invalid ((,class (:foreground "#0601ff" :background "#06ffff")))) + `(custom-link ((,class (:underline t :foreground "#ffff0b")))) + `(custom-modified ((,class (:foreground "#25202a" :background "#ffff0b")))) + `(custom-rogue ((,class (:foreground "#063f3e" :background "#ffffff")))) + `(custom-saved ((,class (:underline t)))) + `(custom-set ((,class (:foreground "#ffff0b" :background "#25202a")))) + `(custom-state ((,class (:foreground "#ff74ff")))) + `(custom-themed ((,class (:foreground "#25202a" :background "#ffff0b")))) + `(custom-variable-button ((,class (:weight bold :underline t)))) + `(custom-variable-tag ((,class (:family "Sans Serif" :height 1.2 :weight bold :foreground "#ffff0b")))) + `(custom-visibility ((,class ,link))) + `(diff-hl-change ((,class (:foreground "#ffff3c" :background "#46302a")))) + `(diff-hl-delete ((,class (:foreground "#37ffff" :background "#254046")))) + `(diff-hl-dired-change ((,class (:weight bold :foreground "#ffffff" :background "#065cd0")))) + `(diff-hl-dired-delete ((,class (:weight bold :foreground "#2dc6ef")))) + `(diff-hl-dired-ignored ((,class (:weight bold :foreground "#25202a" :background "#44445e")))) + `(diff-hl-dired-insert ((,class (:weight bold :foreground "#4b464f")))) + `(diff-hl-dired-unknown ((,class (:foreground "#25202a" :background "#c4c455")))) + `(diff-hl-insert ((,class (:foreground "#ff74ff" :background "#53204e")))) + `(diff-hl-unknown ((,class (:foreground "#25202a" :background "#c4c455")))) + `(diary-face ((,class (:foreground "#7c360d")))) + `(dircolors-face-asm ((,class (:foreground "#ffffff")))) + `(dircolors-face-backup ((,class (:foreground "#ffffff")))) + `(dircolors-face-compress ((,class (:foreground "#06ffff")))) + `(dircolors-face-dir ((,class ,directory))) + `(dircolors-face-doc ((,class (:foreground "#ffffff")))) + `(dircolors-face-dos ((,class (:foreground "#e074e3")))) + `(dircolors-face-emacs ((,class (:foreground "#ffffff")))) + `(dircolors-face-exec ((,class (:foreground "#e074e3")))) + `(dircolors-face-html ((,class (:foreground "#ffffff")))) + `(dircolors-face-img ((,class (:foreground "#37ff3c")))) + `(dircolors-face-lang ((,class (:foreground "#ffffff")))) + `(dircolors-face-lang-interface ((,class (:foreground "#ffffff")))) + `(dircolors-face-make ((,class (:foreground "#ffffff")))) + `(dircolors-face-objet ((,class (:foreground "#ffffff")))) + `(dircolors-face-package ((,class (:foreground "#ffffff")))) + `(dircolors-face-paddb ((,class (:foreground "#ffffff")))) + `(dircolors-face-ps ((,class (:foreground "#ffffff")))) + `(dircolors-face-sound ((,class (:foreground "#ff400b")))) + `(dircolors-face-tar ((,class (:foreground "#06ffff")))) + `(dircolors-face-text ((,class (:foreground "#ffffff")))) + `(dircolors-face-yacc ((,class (:foreground "#ffffff")))) + `(dired-directory ((,class ,directory))) + `(dired-header ((,class ,directory))) + `(dired-ignored ((,class (:strike-through t :foreground "#06ffff")))) + `(dired-mark ((,class ,marked-line))) + `(dired-marked ((,class ,marked-line))) + `(dired-symlink ((,class ,symlink))) + `(diredfl-compressed-file-suffix ((,class (:foreground "#ffffff" :background "#2526c0")))) + `(diredp-compressed-file-suffix ((,class (:foreground "#06ffff")))) + `(diredp-date-time ((,class (:foreground "#64df19")))) + `(diredp-dir-heading ((,class ,directory))) + `(diredp-dir-name ((,class ,directory))) + `(diredp-dir-priv ((,class ,directory))) + `(diredp-exec-priv ((,class (:background "#fd3fcb")))) + `(diredp-executable-tag ((,class (:foreground "#e074e3" :background "#25202a")))) + `(diredp-file-name ((,class ,file))) + `(diredp-file-suffix ((,class (:foreground "#443f49")))) + `(diredp-flag-mark-line ((,class ,marked-line))) + `(diredp-ignored-file-name ((,class ,shadow))) + `(diredp-read-priv ((,class (:background "#f7660b")))) + `(diredp-write-priv ((,class (:foreground "#25202a" :background "#06bfc7")))) + `(doom-modeline-panel ((,class (:foreground "#ffffff" :background "#2526c0")))) + `(eldoc-highlight-function-argument ((,class (:weight bold :foreground "#06ffff" :background "#25392a")))) + `(elfeed-search-filter-face ((,class (:foreground "#46414b")))) + ;; `(eww-form-checkbox ((,class ()))) + ;; `(eww-form-select ((,class ()))) + ;; `(eww-form-submit ((,class ()))) + `(eww-form-text ((,class (:weight bold :foreground "#c3a798" :background "#5d3218")))) + ;; `(eww-form-textarea ((,class ()))) + `(file-name-shadow ((,class ,shadow))) + `(flycheck-error ((,class (:underline (:color "#06dae7" :style wave) :weight bold :background "#253c46")))) + `(flycheck-error-list-line-number ((,class (:foreground "#5fca5b")))) + `(flycheck-fringe-error ((,class (:foreground "#06dae7")))) + `(flycheck-fringe-info ((,class (:foreground "#ed75ef")))) + `(flycheck-fringe-warning ((,class (:foreground "#1056cd")))) + `(flycheck-info ((,class (:underline (:color "#ed75ef" :style wave) :weight bold)))) + `(flycheck-warning ((,class (:underline (:color "#1056cd" :style wave) :weight bold :background "#252066")))) + `(font-latex-bold-face ((,class (:weight bold :foreground "#ffffff")))) + `(fancy-narrow-blocked-face ((,class (:foreground "#6b6765")))) + `(flycheck-color-mode-line-error-face ((, class (:background "#35a4b1")))) + `(flycheck-color-mode-line-warning-face ((, class (:background "#1938ff")))) + `(flycheck-color-mode-line-info-face ((, class (:background "#0601ff")))) + `(font-latex-italic-face ((,class (:slant italic :foreground "#e8e5eb")))) + `(font-latex-math-face ((,class (:foreground "#ffff0b")))) + `(font-latex-sectioning-1-face ((,class (:family "Sans Serif" :height 2.7 :weight bold :foreground "#9f6a1c")))) + `(font-latex-sectioning-2-face ((,class ,ol1))) + `(font-latex-sectioning-3-face ((,class ,ol2))) + `(font-latex-sectioning-4-face ((,class ,ol3))) + `(font-latex-sectioning-5-face ((,class ,ol4))) + `(font-latex-sedate-face ((,class (:foreground "#06aaff")))) + `(font-latex-string-face ((,class (:weight bold :foreground "#ff990b")))) + `(font-latex-verbatim-face ((,class (:foreground "#ffff7f" :background "#252046" :inherit nil)))) + `(git-commit-summary-face ((,class (:foreground "#ffffff")))) + `(git-commit-comment-face ((,class (:slant italic :foreground "#9a969e")))) + `(git-timemachine-commit ((,class ,diff-removed))) + `(git-timemachine-minibuffer-author-face ((,class ,diff-added))) + `(git-timemachine-minibuffer-detail-face ((,class ,diff-header))) + `(google-translate-text-face ((,class (:foreground "#8c8890" :background "#2e2933")))) + `(google-translate-phonetic-face ((,class (:inherit shadow)))) + `(google-translate-translation-face ((,class (:weight normal :foreground "#d2861c" :background "#3f3336")))) + `(google-translate-suggestion-label-face ((,class (:foreground "#06ffff")))) + `(google-translate-suggestion-face ((,class (:slant italic :underline t)))) + `(google-translate-listen-button-face ((,class (:height 0.8)))) + `(helm-action ((,class (:foreground "#ffffff")))) + `(helm-bookmark-file ((,class ,file))) + `(helm-bookmarks-su-face ((,class (:foreground "#06ffff")))) + `(helm-buffer-directory ((,class ,directory))) + ;; `(helm-non-file-buffer ((,class (:slant italic :foreground "#ffff0b")))) + ;; `(helm-buffer-file ((,class (:foreground "#cfccd2")))) + `(helm-buffer-modified ((,class (:slant italic :foreground "#4ac964")))) + `(helm-buffer-process ((,class (:foreground "#ff7dff")))) + `(helm-candidate-number ((,class (:foreground "#ffffff" :background "#0601a1")))) + `(helm-dir-heading ((,class (:foreground "#ffff0b" :background "#063f3e")))) + `(helm-dir-priv ((,class (:foreground "#78ffff" :background "#312c36")))) + `(helm-ff-directory ((,class ,directory))) + `(helm-ff-dotted-directory ((,class ,directory))) + `(helm-ff-executable ((,class (:foreground "#ff32ff" :background "#25202a")))) + `(helm-ff-file ((,class (:foreground "#ffffff")))) + `(helm-ff-invalid-symlink ((,class (:foreground "#0601ff" :background "#06ffff")))) + `(helm-ff-symlink ((,class ,symlink))) + `(helm-file-name ((,class (:foreground "#ffff0b")))) + `(helm-gentoo-match-face ((,class (:foreground "#06ffff")))) + `(helm-grep-file ((,class ,grep-file-name))) + `(helm-grep-lineno ((,class ,grep-line-number))) + `(helm-grep-match ((,class ,match))) + `(helm-grep-running ((,class (:weight bold :foreground "#25202a")))) + `(helm-isearch-match ((,class (:background "#38013d")))) + `(helm-lisp-show-completion ((,class ,volatile-highlight-supersize))) ; See `helm-dabbrev'. + ;; `(helm-ls-git-added-copied-face ((,class (:foreground "")))) + ;; `(helm-ls-git-added-modified-face ((,class (:foreground "")))) + ;; `(helm-ls-git-conflict-face ((,class (:foreground "")))) + ;; `(helm-ls-git-deleted-and-staged-face ((,class (:foreground "")))) + ;; `(helm-ls-git-deleted-not-staged-face ((,class (:foreground "")))) + ;; `(helm-ls-git-modified-and-staged-face ((,class (:foreground "")))) + `(helm-ls-git-modified-not-staged-face ((,class (:foreground "#4ac964")))) + ;; `(helm-ls-git-renamed-modified-face ((,class (:foreground "")))) + ;; `(helm-ls-git-untracked-face ((,class (:foreground "")))) + `(helm-match ((,class ,match))) + `(helm-moccur-buffer ((,class (:foreground "#ff993d")))) + `(helm-selection ((,class (:background "#cb8a33" :foreground "#25202a")))) + `(helm-selection-line ((,class ,highlight-gray))) ; ??? + `(helm-separator ((,class (:foreground "#06ffff")))) + `(helm-source-header ((,class (:weight bold :box (:line-width 1 :color "#3d3842") :background "#433e48" :foreground "#ffffff")))) + `(helm-swoop-target-line-block-face ((,class (:background "#3833ff" :foreground "#e0dde3")))) + `(helm-swoop-target-line-face ((,class (:background "#38330b")))) + `(helm-swoop-target-word-face ((,class (:weight bold :foreground nil :background "#0742d2")))) + `(helm-visible-mark ((,class ,marked-line))) + `(helm-w3m-bookmarks-face ((,class (:underline t :foreground "#ff010b")))) + `(highlight-changes ((,class (:foreground nil)))) ;; blue "#d4f754" + `(highlight-changes-delete ((,class (:strike-through nil :foreground nil)))) ;; red "#4ff7d7" + `(highlight-symbol-face ((,class (:background "#252080")))) + `(hl-line ((,class ,highlight-yellow))) ; Highlight current line. + `(hl-tags-face ((,class ,highlight-current-tag))) ; ~ Pair highlighting (matching tags). + `(holiday-face ((,class (:foreground "#8c8890" :background "#3e322a")))) + `(html-helper-bold-face ((,class (:weight bold :foreground "#ffffff")))) + `(html-helper-italic-face ((,class (:slant italic :foreground "#ffffff")))) + `(html-helper-underline-face ((,class (:underline t :foreground "#ffffff")))) + `(html-tag-face ((,class (:foreground "#ffff0b")))) + `(ilog-non-change-face ((,class (:height 2.0 :foreground "#9fcb66")))) + `(ilog-change-face ((,class (:height 2.0 :foreground "#ff7dff")))) + `(ilog-echo-face ((,class (:height 2.0 :foreground "#ff9029")))) + `(ilog-load-face ((,class (:foreground "#4ac964")))) + `(ilog-message-face ((,class (:foreground "#837f87")))) + `(indent-guide-face ((,class (:foreground "#312c36")))) + `(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#ffff3d") :foreground "#9f6a1c" :background "#563c2a")))) + `(info-header-node ((,class (:underline t :foreground "#065aff")))) ; nodes in header + `(info-header-xref ((,class (:underline t :foreground "#e46f0b")))) ; cross references in header + `(info-index-match ((,class (:weight bold :foreground nil :background "#0742d2")))) ; when using `i' + `(info-menu-header ((,class ,ol2))) ; menu titles (headers) -- major topics + `(info-menu-star ((,class (:foreground "#ffffff")))) ; every 3rd menu item + `(info-node ((,class (:underline t :foreground "#ffff0b")))) ; node names + `(info-quoted-name ((,class ,code-inline))) + `(info-string ((,class ,string))) + `(info-title-1 ((,class ,ol1))) + `(info-xref ((,class (:underline t :foreground "#ff925a")))) ; unvisited cross-references + `(info-xref-visited ((,class (:underline t :foreground "#78ff7c")))) ; previously visited cross-references + ;; js2-highlight-vars-face (~ auto-highlight-symbol) + `(js2-error ((,class (:box (:line-width 1 :color "#06c8cf") :background "#063741")))) ; DONE. + `(js2-external-variable ((,class (:foreground "#06ffff" :background "#252630")))) ; DONE. + `(js2-function-param ((,class ,function-param))) + `(js2-instance-member ((,class (:foreground "#6bcd3d")))) + `(js2-jsdoc-html-tag-delimiter ((,class (:foreground "#34c8d8")))) + `(js2-jsdoc-html-tag-name ((,class (:foreground "#34c8d8")))) + `(js2-jsdoc-tag ((,class (:weight normal :foreground "#9fcb66")))) + `(js2-jsdoc-type ((,class (:foreground "#bd7d55")))) + `(js2-jsdoc-value ((,class (:weight normal :foreground "#4ac964")))) ; #83ff87 + `(js2-magic-paren ((,class (:underline t)))) + `(js2-private-function-call ((,class (:foreground "#2a5ae5")))) + `(js2-private-member ((,class (:foreground "#375073")))) + `(js2-warning ((,class (:underline "#065aff")))) + + ;; Org non-standard faces. + `(leuven-dark-org-deadline-overdue ((,class (:foreground "#12d9ae")))) + `(leuven-dark-org-deadline-today ((,class (:weight bold :foreground "#b4b5ca" :background "#252059")))) + `(leuven-dark-org-deadline-tomorrow ((,class (:foreground "#c357f8")))) + `(leuven-dark-org-deadline-future ((,class (:foreground "#c357f8")))) + `(leuven-dark-gnus-unseen ((,class (:weight bold :foreground "#088dfd")))) + `(leuven-dark-gnus-date ((,class (:foreground "#067f4a")))) + `(leuven-dark-gnus-size ((,class (:foreground "#7440a7")))) + `(leuven-dark-todo-items-face ((,class (:weight bold :foreground "#06cee0" :background "#06017f")))) + + `(light-symbol-face ((,class (:background "#252080")))) + `(linum ((,class (:foreground "#6a656f" :background "#35303a")))) + `(log-view-file ((,class (:foreground "#ffff3d" :background "#382c33")))) + `(log-view-message ((,class (:foreground "#ffffff" :background "#171593")))) + `(lsp-modeline-code-actions-preferred-face ((,class (:foreground "#ffffff" :background "#2526c0")))) + `(lsp-ui-doc-background ((,class (:background "#2d2058")))) + `(lsp-ui-sideline-code-action ((,class (:foreground "#ffffff" :background "#2526c0")))) + `(lui-button-face ((,class ,link))) + `(lui-highlight-face ((,class (:box '(:line-width 1 :color "#38ffff") :foreground "#38ffff" :background "#06017f")))) ; my nickname + `(lui-time-stamp-face ((,class (:foreground "#64df19")))) + `(magit-blame-header ((,class (:inherit magit-diff-file-header)))) + `(magit-blame-heading ((,class (:overline "#5d5862" :foreground "#06ffff" :background "#3c3741")))) + `(magit-blame-hash ((,class (:overline "#5d5862" :foreground "#06ffff" :background "#3c3741")))) + `(magit-blame-name ((,class (:overline "#5d5862" :foreground "#fd95fa" :background "#3c3741")))) + `(magit-blame-date ((,class (:overline "#5d5862" :foreground "#ffff0b" :background "#3c3741")))) + `(magit-blame-summary ((,class (:overline "#5d5862" :weight bold :foreground "#938f97" :background "#3c3741")))) + `(magit-branch ((,class ,vc-branch))) + `(magit-diff-add ((,class ,diff-added))) + `(magit-diff-del ((,class ,diff-removed))) + `(magit-diff-file-header ((,class (:height 1.1 :weight bold :foreground "#c27c45")))) + `(magit-diff-hunk-header ((,class ,diff-hunk-header))) + `(magit-diff-none ((,class ,diff-none))) + `(magit-header ((,class (:foreground "#25202a" :background "#06bfc7")))) + `(magit-item-highlight ((,class (:background "#382c33")))) + `(magit-item-mark ((,class ,marked-line))) + `(magit-log-head-label ((,class (:box (:line-width 1 :color "#ffff0b" :style nil))))) + `(magit-log-tag-label ((,class (:box (:line-width 1 :color "#ff33ff" :style nil))))) + `(magit-section-highlight ((,class (:background "#2d2058")))) + `(magit-section-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "#9f6a1c" :inherit nil)))) + `(makefile-space-face ((,class (:background "#069655")))) + `(makefile-targets ((,class (:weight bold :foreground "#ffff0b")))) + ;; `(markdown-blockquote-face ((,class ()))) + `(markdown-bold-face ((,class (:inherit bold)))) + ;; `(markdown-comment-face ((,class ()))) + ;; `(markdown-footnote-face ((,class ()))) + ;; `(markdown-header-delimiter-face ((,class ()))) + ;; `(markdown-header-face ((,class ()))) + `(markdown-header-face-1 ((,class ,ol1))) + `(markdown-header-face-2 ((,class ,ol2))) + `(markdown-header-face-3 ((,class ,ol3))) + `(markdown-header-face-4 ((,class ,ol4))) + `(markdown-header-face-5 ((,class ,ol5))) + `(markdown-header-face-6 ((,class ,ol6))) + ;; `(markdown-header-rule-face ((,class ()))) + `(markdown-inline-code-face ((,class ,code-inline))) + `(markdown-italic-face ((,class (:inherit italic)))) + `(markdown-language-keyword-face ((,class (:inherit org-block-begin-line)))) + ;; `(markdown-line-break-face ((,class ()))) + `(markdown-link-face ((,class ,link-no-underline))) + ;; `(markdown-link-title-face ((,class ()))) + ;; `(markdown-list-face ((,class ()))) + ;; `(markdown-math-face ((,class ()))) + ;; `(markdown-metadata-key-face ((,class ()))) + ;; `(markdown-metadata-value-face ((,class ()))) + ;; `(markdown-missing-link-face ((,class ()))) + `(markdown-pre-face ((,class (:inherit org-block-background)))) + ;; `(markdown-reference-face ((,class ()))) + ;; `(markdown-strike-through-face ((,class ()))) + `(markdown-url-face ((,class ,link))) + `(match ((,class ,match))) ; Used for grep matches. + `(mc/cursor-bar-face ((,class (:height 1.0 :foreground "#ec9b45" :background "#ec9b45")))) + `(mc/cursor-face ((,class (:inverse-video t)))) + `(mc/region-face ((,class (:inherit region)))) + `(mm-uu-extract ((,class ,code-block))) + `(moccur-current-line-face ((,class (:foreground "#ffffff" :background "#252059")))) + `(moccur-face ((,class (:foreground "#ffffff" :background "#06016f")))) + `(next-error ((,class ,volatile-highlight-supersize))) + `(nobreak-space ((,class (:background "#543532")))) + `(nxml-attribute-local-name-face ((,class ,xml-attribute))) + `(nxml-attribute-value-delimiter-face ((,class (:foreground "#ff74ff")))) + `(nxml-attribute-value-face ((,class (:foreground "#ff74ff")))) + `(nxml-comment-content-face ((,class (:slant italic :foreground "#06ffff")))) + `(nxml-comment-delimiter-face ((,class (:foreground "#06ffff")))) + `(nxml-element-local-name ((,class ,xml-tag))) + `(nxml-element-local-name-face ((,class (:foreground "#ffff0b")))) + `(nxml-processing-instruction-target-face ((,class (:foreground "#69cf0b")))) + `(nxml-tag-delimiter-face ((,class (:foreground "#ffff0b")))) + `(nxml-tag-slash-face ((,class (:foreground "#ffff0b")))) + `(org-agenda-block-count ((,class (:weight bold :foreground "#5f5a64")))) + `(org-agenda-calendar-event ((,class (:weight bold :foreground "#cc8b3d" :background "#3e322a")))) + `(org-agenda-calendar-sexp ((,class (:foreground "#d0853c" :background "#30272c")))) + `(org-agenda-clocking ((,class (:foreground "#ffffff" :background "#1636ff")))) + `(org-agenda-column-dateline ((,class ,column))) + `(org-agenda-current-time ((,class (:underline t :foreground "#ec9d5a")))) + `(org-agenda-date ((,class (,@(leuven-dark-scale-font leuven-dark-scale-org-agenda-structure 1.6) :weight bold :foreground "#ec9d5a")))) + `(org-agenda-date-today ((,class (,@(leuven-dark-scale-font leuven-dark-scale-org-agenda-structure 1.6) :weight bold :foreground "#b4b5ca" :background "#252059")))) + `(org-agenda-date-weekend ((,class (,@(leuven-dark-scale-font leuven-dark-scale-org-agenda-structure 1.6) :weight bold :foreground "#b5b1b9")))) + `(org-agenda-diary ((,class (:weight bold :foreground "#ff74ff" :background "#572723")))) + `(org-agenda-dimmed-todo-face ((,class (:foreground "#1636ff")))) + `(org-agenda-done ((,class (:foreground "#aeaab2")))) + `(org-agenda-filter-category ((,class (:weight bold :foreground "#065aff")))) + `(org-agenda-filter-effort ((,class (:weight bold :foreground "#065aff")))) + `(org-agenda-filter-regexp ((,class (:weight bold :foreground "#065aff")))) + `(org-agenda-filter-tags ((,class (:weight bold :foreground "#065aff")))) + `(org-agenda-restriction-lock ((,class (:background "#1d82a4")))) + `(org-agenda-structure ((,class (,@(leuven-dark-scale-font leuven-dark-scale-org-agenda-structure 1.6) :weight bold :foreground "#e37233")))) + `(org-archived ((,class (:foreground "#514c56")))) + `(org-beamer-tag ((,class (:box (:line-width 1 :color "#0a43ed") :foreground "#d6d3d9" :background "#252655")))) + `(org-block ((,class ,code-block))) + `(org-block-background ((,class (:background "#252046")))) ;; :inherit fixed-pitch)))) + `(org-block-begin-line ((,class (:underline "#5d595f" :foreground "#aeaab2" :background "#221e34")))) + `(org-block-end-line ((,class (:overline "#5d595f" :foreground "#aeaab2" :background "#221e34")))) + `(org-checkbox ((,class (:weight bold :box (:line-width 1 :style pressed-button) :foreground "#efcab2" :background "#615c66")))) + `(org-clock-overlay ((,class (:foreground "#25202a" :background "#b98f7c")))) + `(org-code ((,class ,code-inline))) + `(org-column ((,class ,column))) + `(org-column-title ((,class ,column))) + `(org-date ((,class (:underline t :foreground "#ffba6b")))) + `(org-default ((,class (:foreground "#cfccd2" :background "#25202a")))) + `(org-dim ((,class (:foreground "#5a555f")))) + `(org-document-info ((,class (:foreground "#bbb7bf")))) + `(org-document-info-keyword ((,class (:foreground "#ff7138" :background "#38332a")))) + `(org-document-title ((,class (,@(leuven-dark-scale-font leuven-dark-scale-org-document-title 1.8) :weight bold :foreground "#ffffff")))) + `(org-done ((,class (:weight bold :box (:line-width 1 :color "#49444e") :foreground "#49444e" :background "#322d37")))) + `(org-drawer ((,class (:weight bold :foreground "#ff44ff" :background "#38203d")))) + `(org-ellipsis ((,class (:underline nil :foreground "#6b666f")))) ; #0611a5 + `(org-example ((,class (:foreground "#ffff0b" :background "#38203d")))) + `(org-footnote ((,class (:underline t :foreground "#ff7138")))) + `(org-formula ((,class (:foreground "#0680e1")))) + ;; org-habit colours are thanks to zenburn + `(org-habit-ready-face ((t :background "#7F9F7F"))) ; ,zenburn-green + `(org-habit-alert-face ((t :background "#E0CF9F" :foreground "#3F3F3F"))) ; ,zenburn-yellow-1 fg ,zenburn-bg + `(org-habit-clear-face ((t :background "#5C888B"))) ; ,zenburn-blue-3 + `(org-habit-overdue-face ((t :background "#9C6363"))) ; ,zenburn-red-3 + `(org-habit-clear-future-face ((t :background "#4C7073"))) ; ,zenburn-blue-4 + `(org-habit-ready-future-face ((t :background "#5F7F5F"))) ; ,zenburn-green-2 + `(org-habit-alert-future-face ((t :background "#D0BF8F" :foreground "#3F3F3F"))) ; ,zenburn-yellow-2 fg ,zenburn-bg + `(org-habit-overdue-future-face ((t :background "#8C5353"))) ; ,zenburn-red-4 + `(org-headline-done ((,class (:height 1.0 :weight normal :foreground "#57525c")))) + `(org-hide ((,class (:foreground "#403b45")))) + `(org-inlinetask ((,class (:box (:line-width 1 :color "#37323c") :foreground "#8c8890" :background "#252050")))) + `(org-latex-and-related ((,class (:foreground "#cf996f" :background "#25202a")))) + `(org-level-1 ((,class ,ol1))) + `(org-level-2 ((,class ,ol2))) + `(org-level-3 ((,class ,ol3))) + `(org-level-4 ((,class ,ol4))) + `(org-level-5 ((,class ,ol5))) + `(org-level-6 ((,class ,ol6))) + `(org-level-7 ((,class ,ol7))) + `(org-level-8 ((,class ,ol8))) + `(org-link ((,class ,link))) + `(org-list-dt ((,class (:weight bold :foreground "#cfa161")))) + `(org-macro ((,class (:weight bold :foreground "#1747fd")))) + `(org-meta-line ((,class (:slant normal :foreground "#ff7138" :background "#38332a")))) + `(org-mode-line-clock ((,class (:box (:line-width 1 :color "#cfa161") :foreground "#ffffff" :background "#065cd0")))) + `(org-mode-line-clock-overrun ((,class (:weight bold :box (:line-width 1 :color "#cfa161") :foreground "#25202a" :background "#06bfc7")))) + `(org-number-of-items ((,class (:weight bold :foreground "#25202a" :background "#8a458e")))) + `(org-property-value ((,class (:foreground "#ff5fff")))) + `(org-quote ((,class (:slant italic :foreground "#9a969e" :background "#252046")))) + `(org-scheduled ((,class (:foreground "#cfccd2")))) + `(org-scheduled-previously ((,class (:foreground "#ed9943")))) + `(org-scheduled-today ((,class (:weight bold :foreground "#b4b5ca" :background "#252059")))) + `(org-sexp-date ((,class (:foreground "#cc8b3d")))) + `(org-special-keyword ((,class (:weight bold :foreground "#ff44ff" :background "#38203d")))) + `(org-table ((,class (:foreground "#ff9bff" :background "#38203d")))) ;; :inherit fixed-pitch)))) + `(org-tag ((,class (:weight normal :slant italic :foreground "#6a6065" :background "#25202a")))) + `(org-target ((,class (:foreground "#06925a")))) + `(org-time-grid ((,class (:foreground "#35303a")))) + `(org-todo ((,class (:weight bold :box (:line-width 1 :color "#2c5462") :foreground "#2c5462" :background "#253743")))) + `(org-upcoming-deadline ((,class (:foreground "#06aab2")))) + `(org-verbatim ((,class (:foreground "#ff993d" :background "#2c212a")))) + `(org-verse ((,class (:slant italic :foreground "#9a969e" :background "#342f39")))) + `(org-warning ((,class (:weight bold :foreground "#ffffff" :background "#54362a")))) + `(outline-1 ((,class ,ol1))) + `(outline-2 ((,class ,ol2))) + `(outline-3 ((,class ,ol3))) + `(outline-4 ((,class ,ol4))) + `(outline-5 ((,class ,ol5))) + `(outline-6 ((,class ,ol6))) + `(outline-7 ((,class ,ol7))) + `(outline-8 ((,class ,ol8))) + `(pabbrev-debug-display-label-face ((,class (:foreground "#25202a" :background "#5edeb3")))) + `(pabbrev-suggestions-face ((,class (:weight bold :foreground "#25202a" :background "#06ffff")))) + `(pabbrev-suggestions-label-face ((,class (:weight bold :foreground "#25202a" :background "#64df19")))) + `(paren-face-match ((,class ,paren-matched))) + `(paren-face-mismatch ((,class ,paren-unmatched))) + `(paren-face-no-match ((,class ,paren-unmatched))) + `(persp-selected-face ((,class (:weight bold :foreground "#34292a")))) + `(powerline-active1 ((,class (:foreground "#7e311e" :background "#cbc7ce" :inherit mode-line)))) + `(powerline-active2 ((,class (:foreground "#7e311e" :background "#c38f53" :inherit mode-line)))) + `(powerline-inactive1 ((,class (:foreground "#322d38" :background "#9b979f" :inherit mode-line-inactive)))) + `(powerline-inactive2 ((,class (:foreground "#322d38" :background "#5b5660" :inherit mode-line-inactive)))) + `(rainbow-delimiters-depth-1-face ((,class (:foreground "#938e84")))) + `(rainbow-delimiters-depth-2-face ((,class (:foreground "#907733")))) + `(rainbow-delimiters-depth-3-face ((,class (:foreground "#736e84")))) + `(rainbow-delimiters-depth-4-face ((,class (:foreground "#936797")))) + `(rainbow-delimiters-depth-5-face ((,class (:foreground "#738c94")))) + `(rainbow-delimiters-depth-6-face ((,class (:foreground "#a1894f")))) + `(rainbow-delimiters-depth-7-face ((,class (:foreground "#7e7a87")))) + `(rainbow-delimiters-depth-8-face ((,class (:foreground "#835787")))) + `(rainbow-delimiters-depth-9-face ((,class (:foreground "#7b8f97")))) + `(rainbow-delimiters-mismatched-face ((,class ,paren-unmatched))) + `(rainbow-delimiters-unmatched-face ((,class ,paren-unmatched))) + `(recover-this-file ((,class (:weight bold :background "#06c0c8")))) + `(rng-error ((,class (:weight bold :foreground "#06ffff" :background "#283a43")))) + `(sh-heredoc ((,class (:foreground "#ffff0b" :background "#34292a")))) + `(sh-quoted-exec ((,class (:foreground "#06eb74")))) + `(shadow ((,class ,shadow))) ; Used for grep context lines. + `(shell-option-face ((,class (:foreground "#e074e3")))) + `(shell-output-2-face ((,class (:foreground "#ffff0b")))) + `(shell-output-3-face ((,class (:foreground "#64df19")))) + `(shell-output-face ((,class (:foreground "#ffffff")))) + ;; `(shell-prompt-face ((,class (:weight bold :foreground "#0601ff")))) + `(shm-current-face ((,class (:background "#343551")))) + `(shm-quarantine-face ((,class (:background "lemonchiffon")))) + `(show-paren-match ((,class ,paren-matched))) + `(show-paren-mismatch ((,class ,paren-unmatched))) + `(sml-modeline-end-face ((,class (:background "#985213")))) ; #cfa161 + `(sml-modeline-vis-face ((,class (:background "#e9863f")))) + `(term ((,class (:foreground "#cfccd2" :background "#25202a")))) + + ;; `(sp-pair-overlay-face ((,class ()))) + ;; `(sp-show-pair-enclosing ((,class ()))) + ;; `(sp-show-pair-match-face ((,class ()))) ; ~ Pair highlighting (matching tags). + ;; `(sp-show-pair-mismatch-face ((,class ()))) + ;; `(sp-wrap-overlay-closing-pair ((,class ()))) + ;; `(sp-wrap-overlay-face ((,class ()))) + ;; `(sp-wrap-overlay-opening-pair ((,class ()))) + ;; `(sp-wrap-tag-overlay-face ((,class ()))) + + `(speedbar-button-face ((,class (:foreground "#ff74ff")))) + `(speedbar-directory-face ((,class (:foreground "#ffff7c")))) + `(speedbar-file-face ((,class (:foreground "#ff747c")))) + `(speedbar-highlight-face ((,class ,volatile-highlight))) + `(speedbar-selected-face ((,class (:underline t :foreground "#06ffff")))) + `(speedbar-tag-face ((,class (:foreground "#5fd5db")))) + `(svn-status-directory-face ((,class ,directory))) + `(svn-status-filename-face ((,class (:weight bold :foreground "#c27c45")))) + `(svn-status-locked-face ((,class (:weight bold :foreground "#06ffff")))) + `(svn-status-marked-face ((,class ,marked-line))) + `(svn-status-marked-popup-face ((,class (:weight bold :foreground "#ff32ff")))) + `(svn-status-switched-face ((,class (:slant italic :foreground "#77737b")))) + `(svn-status-symlink-face ((,class ,symlink))) + `(svn-status-update-available-face ((,class (:foreground "#065aff")))) + `(tex-verbatim ((,class (:foreground "#ffff0b")))) + `(tool-bar ((,class (:box (:line-width 1 :style released-button) :foreground "#ffffff" :background "#45404a")))) + `(tooltip ((,class (:foreground "#ffffff" :background "#252046")))) + `(traverse-match-face ((,class (:weight bold :foreground "#79d427")))) + `(vc-annotate-face-3F3FFF ((,class (:foreground "#c4c00b" :background "#ffffff")))) + `(vc-annotate-face-3F6CFF ((,class (:foreground "#c4c00b" :background "#ffffff")))) + `(vc-annotate-face-3F99FF ((,class (:foreground "#c4660b" :background "#ffffff")))) + `(vc-annotate-face-3FC6FF ((,class (:foreground "#c4660b" :background "#ffffff")))) + `(vc-annotate-face-3FF3FF ((,class (:foreground "#c40c0b" :background "#ffffff")))) + `(vc-annotate-face-3FFF56 ((,class (:foreground "#b801bc" :background "#ffffff")))) + `(vc-annotate-face-3FFF83 ((,class (:foreground "#c40159" :background "#ffffff")))) + `(vc-annotate-face-3FFFB0 ((,class (:foreground "#c40159" :background "#ffffff")))) + `(vc-annotate-face-3FFFDD ((,class (:foreground "#c40c0b" :background "#ffffff")))) + `(vc-annotate-face-56FF3F ((,class (:foreground "#b801bc" :background "#ffffff")))) + `(vc-annotate-face-83FF3F ((,class (:foreground "#5401c8" :background "#ffffff")))) + `(vc-annotate-face-B0FF3F ((,class (:foreground "#5401c8" :background "#ffffff")))) + `(vc-annotate-face-DDFF3F ((,class (:foreground "#060cc8" :background "#ffffff")))) + `(vc-annotate-face-F6FFCC ((,class (:foreground "#ffffff" :background "#252064")))) + `(vc-annotate-face-FF3F3F ((,class (:foreground "#06c0c8" :background "#ffffff")))) + `(vc-annotate-face-FF6C3F ((,class (:foreground "#06c0c8" :background "#ffffff")))) + `(vc-annotate-face-FF993F ((,class (:foreground "#0666c8" :background "#ffffff")))) + `(vc-annotate-face-FFC63F ((,class (:foreground "#0666c8" :background "#ffffff")))) + `(vc-annotate-face-FFF33F ((,class (:foreground "#060cc8" :background "#ffffff")))) + + ;; ;; vc + ;; (vc-up-to-date-state ((,c :foreground ,(gc 'green-1)))) + ;; (vc-edited-state ((,c :foreground ,(gc 'yellow+1)))) + ;; (vc-missing-state ((,c :foreground ,(gc 'red)))) + ;; (vc-conflict-state ((,c :foreground ,(gc 'red+2) :weight bold))) + ;; (vc-locked-state ((,c :foreground ,(gc 'cyan-1)))) + ;; (vc-locally-added-state ((,c :foreground ,(gc 'blue)))) + ;; (vc-needs-update-state ((,c :foreground ,(gc 'magenta)))) + ;; (vc-removed-state ((,c :foreground ,(gc 'red-1)))) + + `(vhl/default-face ((,class ,volatile-highlight))) ; `volatile-highlights.el' (for undo, yank). + `(w3m-anchor ((,class ,link))) + `(w3m-arrived-anchor ((,class (:foreground "#69cf0b")))) + `(w3m-bitmap-image-face ((,class (:foreground "#f7f5f9" :background "#ff01ff")))) + `(w3m-bold ((,class (:weight bold :foreground "#ffffff")))) + `(w3m-current-anchor ((,class (:weight bold :underline t :foreground "#ffff0b")))) + `(w3m-form ((,class (:underline t :foreground "#065ab8")))) + `(w3m-form-button-face ((,class (:weight bold :underline t :foreground "#f7f5f9" :background "#312c36")))) + `(w3m-form-button-mouse-face ((,class (:underline t :foreground "#312c36" :background "#d781db")))) + `(w3m-form-button-pressed-face ((,class (:weight bold :underline t :foreground "#f7f5f9" :background "#312c36")))) + `(w3m-header-line-location-content-face ((,class (:foreground "#848088":background "#2c2731")))) + `(w3m-header-line-location-title-face ((,class (:foreground "#d6aa58" :background "#2c2731")))) + `(w3m-history-current-url-face ((,class (:foreground "#252458")))) + `(w3m-image-face ((,class (:weight bold :foreground "#501155")))) + `(w3m-link-numbering ((,class (:foreground "#50381e")))) ; mouseless browsing + `(w3m-strike-through-face ((,class (:strike-through t)))) + `(w3m-underline-face ((,class (:underline t)))) + + ;; `(web-mode-block-attr-name-face ((,class ()))) + ;; `(web-mode-block-attr-value-face ((,class ()))) + ;; `(web-mode-block-comment-face ((,class ()))) + ;; `(web-mode-block-control-face ((,class ()))) + ;; `(web-mode-block-delimiter-face ((,class ()))) + ;; `(web-mode-block-face ((,class ()))) + ;; `(web-mode-block-string-face ((,class ()))) + ;; `(web-mode-bold-face ((,class ()))) + ;; `(web-mode-builtin-face ((,class ()))) + ;; `(web-mode-comment-face ((,class ()))) + ;; `(web-mode-comment-keyword-face ((,class ()))) + ;; `(web-mode-constant-face ((,class ()))) + ;; `(web-mode-css-at-rule-face ((,class ()))) + ;; `(web-mode-css-color-face ((,class ()))) + ;; `(web-mode-css-comment-face ((,class ()))) + ;; `(web-mode-css-function-face ((,class ()))) + ;; `(web-mode-css-priority-face ((,class ()))) + ;; `(web-mode-css-property-name-face ((,class ()))) + ;; `(web-mode-css-pseudo-class-face ((,class ()))) + ;; `(web-mode-css-selector-face ((,class ()))) + ;; `(web-mode-css-string-face ((,class ()))) + ;; `(web-mode-css-variable-face ((,class ()))) + ;; `(web-mode-current-column-highlight-face ((,class ()))) + `(web-mode-current-element-highlight-face ((,class (:background "#6b330b")))) ; #061187 + ;; `(web-mode-doctype-face ((,class ()))) + ;; `(web-mode-error-face ((,class ()))) + ;; `(web-mode-filter-face ((,class ()))) + `(web-mode-folded-face ((,class (:box (:line-width 1 :color "#8c8890") :foreground "#6a659d" :background "#110cbe")))) + ;; `(web-mode-function-call-face ((,class ()))) + ;; `(web-mode-function-name-face ((,class ()))) + ;; `(web-mode-html-attr-custom-face ((,class ()))) + ;; `(web-mode-html-attr-engine-face ((,class ()))) + ;; `(web-mode-html-attr-equal-face ((,class ()))) + `(web-mode-html-attr-name-face ((,class ,xml-attribute))) + ;; `(web-mode-html-attr-value-face ((,class ()))) + ;; `(web-mode-html-entity-face ((,class ()))) + `(web-mode-html-tag-bracket-face ((,class ,xml-tag))) + ;; `(web-mode-html-tag-custom-face ((,class ()))) + `(web-mode-html-tag-face ((,class ,xml-tag))) + ;; `(web-mode-html-tag-namespaced-face ((,class ()))) + ;; `(web-mode-inlay-face ((,class ()))) + ;; `(web-mode-italic-face ((,class ()))) + ;; `(web-mode-javascript-comment-face ((,class ()))) + ;; `(web-mode-javascript-string-face ((,class ()))) + ;; `(web-mode-json-comment-face ((,class ()))) + ;; `(web-mode-json-context-face ((,class ()))) + ;; `(web-mode-json-key-face ((,class ()))) + ;; `(web-mode-json-string-face ((,class ()))) + ;; `(web-mode-jsx-depth-1-face ((,class ()))) + ;; `(web-mode-jsx-depth-2-face ((,class ()))) + ;; `(web-mode-jsx-depth-3-face ((,class ()))) + ;; `(web-mode-jsx-depth-4-face ((,class ()))) + ;; `(web-mode-keyword-face ((,class ()))) + ;; `(web-mode-param-name-face ((,class ()))) + ;; `(web-mode-part-comment-face ((,class ()))) + `(web-mode-part-face ((,class (:background "#252046")))) + ;; `(web-mode-part-string-face ((,class ()))) + ;; `(web-mode-preprocessor-face ((,class ()))) + `(web-mode-script-face ((,class (:background "#332d37")))) + ;; `(web-mode-sql-keyword-face ((,class ()))) + ;; `(web-mode-string-face ((,class ()))) + ;; `(web-mode-style-face ((,class ()))) + ;; `(web-mode-symbol-face ((,class ()))) + ;; `(web-mode-type-face ((,class ()))) + ;; `(web-mode-underline-face ((,class ()))) + ;; `(web-mode-variable-name-face ((,class ()))) + ;; `(web-mode-warning-face ((,class ()))) + ;; `(web-mode-whitespace-face ((,class ()))) + + `(which-func ((,class (:weight bold :slant italic :foreground "#25202a")))) + ;; `(which-key-command-description-face) + ;; `(which-key-group-description-face) + ;; `(which-key-highlighted-command-face) + ;; `(which-key-key-face) + `(which-key-local-map-description-face ((,class (:weight bold :background "#30272c" :inherit which-key-command-description-face)))) + ;; `(which-key-note-face) + ;; `(which-key-separator-face) + ;; `(which-key-special-key-face) + `(widget-button ((,class ,link))) + `(widget-button-pressed ((,class (:foreground "#06ffff")))) + `(widget-documentation ((,class (:foreground "#ff74ff")))) + `(widget-field ((,class (:background "#2b2630")))) + `(widget-inactive ((,class (:foreground "#9a969e")))) + `(widget-single-line-field ((,class (:background "#2b2630")))) + `(woman-bold ((,class (:weight bold :foreground "#13c2ca")))) + `(woman-italic ((,class (:weight bold :slant italic :foreground "#bd41ea")))) + `(woman-symbol ((,class (:weight bold :foreground "#64df19")))) + `(yas-field-debug-face ((,class (:foreground "#25202a" :background "#5edeb3")))) + `(yas-field-highlight-face ((,class (:box (:line-width 1 :color "#807c84") :foreground "#ffffff" :background "#302331")))) + + ;; `(ztreep-arrow-face ((,class ()))) + ;; `(ztreep-diff-header-face ((,class ()))) + ;; `(ztreep-diff-header-small-face ((,class ()))) + `(ztreep-diff-model-add-face ((,class (:weight bold :foreground "#ff77ff")))) + `(ztreep-diff-model-diff-face ((,class (:weight bold :foreground "#ffbb2c")))) + `(ztreep-diff-model-ignored-face ((,class (:strike-through t :foreground "#66616b")))) + `(ztreep-diff-model-normal-face ((,class (:foreground "#ffffff")))) + ;; `(ztreep-expand-sign-face ((,class ()))) + ;; `(ztreep-header-face ((,class ()))) + ;; `(ztreep-leaf-face ((,class ()))) + ;; `(ztreep-node-face ((,class ()))) + + )) + +(custom-theme-set-variables 'leuven-dark + + ;; highlight-sexp-mode. + '(hl-sexp-background-color "#33323e") + + '(ansi-color-faces-vector + [default default default italic underline success warning error]) + + ;; Colors used in Shell mode. + '(ansi-color-names-vector + ["#ffffff" "#37ffff" "#e074e3" "#3732ff" "#ffff0b" "#37ff3c" "#ff400b" "#848088"]) + ) + +;;;###autoload +(when (and (boundp 'custom-theme-load-path) + load-file-name) + ;; Add theme folder to `custom-theme-load-path' when installing over MELPA. + (add-to-list 'custom-theme-load-path + (file-name-as-directory (file-name-directory load-file-name)))) + +(provide-theme 'leuven-dark) + +;; This is for the sake of Emacs. +;; Local Variables: +;; time-stamp-end: "$" +;; time-stamp-format: "%:y%02m%02d.%02H%02M" +;; time-stamp-start: "Version: " +;; End: + +;;; leuven-dark-theme.el ends here diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el index a5e8fc701c4..aac5b04c6a4 100644 --- a/etc/themes/modus-operandi-theme.el +++ b/etc/themes/modus-operandi-theme.el @@ -1,10 +1,10 @@ -;;; modus-operandi-theme.el --- Accessible light theme (WCAG AAA) -*- lexical-binding:t -*- +;;; modus-operandi-theme.el --- Accessible and customizable light theme (WCAG AAA) -*- lexical-binding:t -*- -;; Copyright (C) 2019-2022 Free Software Foundation, Inc. +;; Copyright (C) 2019-2022 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.0.0 +;; Version: 2.1.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 8afa961ba3c..a902cc8ca23 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -1,11 +1,11 @@ -;;; modus-themes.el --- Highly accessible themes (WCAG AAA) -*- lexical-binding:t -*- +;;; modus-themes.el --- Highly accessible and customizable themes (WCAG AAA) -*- lexical-binding:t -*- -;; Copyright (C) 2019-2022 Free Software Foundation, Inc. +;; Copyright (C) 2019-2022 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.0.0 -;; Last-Modified: <2021-12-24 12:35:25 +0200> +;; Version: 2.1.0 +;; Last-Modified: <2022-02-17 10:36:27 +0200> ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility @@ -40,11 +40,11 @@ ;; modus-themes-bold-constructs (boolean) ;; modus-themes-deuteranopia (boolean) ;; modus-themes-inhibit-reload (boolean) -;; modus-themes-intense-markup (boolean) ;; modus-themes-italic-constructs (boolean) ;; modus-themes-mixed-fonts (boolean) ;; 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) @@ -52,6 +52,7 @@ ;; modus-themes-lang-checkers (choice) ;; modus-themes-links (choice) ;; modus-themes-mail-citations (choice) +;; modus-themes-markup (choice) ;; modus-themes-mode-line (choice) ;; modus-themes-org-blocks (choice) ;; modus-themes-paren-match (choice) @@ -74,6 +75,8 @@ ;; ace-window ;; alert ;; all-the-icons +;; all-the-icons-dired +;; all-the-icons-ibuffer ;; annotate ;; ansi-color ;; anzu @@ -97,6 +100,7 @@ ;; change-log and log-view (`vc-print-log' and `vc-print-root-log') ;; cider ;; circe +;; citar ;; color-rg ;; column-enforce-mode ;; company-mode @@ -146,6 +150,7 @@ ;; elfeed-score ;; elpher ;; embark +;; ement (ement.el) ;; emms ;; enh-ruby-mode (enhanced-ruby-mode) ;; epa @@ -235,6 +240,7 @@ ;; marginalia ;; markdown-mode ;; markup-faces (`adoc-mode') +;; mct ;; mentor ;; messages ;; minimap @@ -281,6 +287,7 @@ ;; proced ;; prodigy ;; pulse +;; pyim ;; quick-peek ;; racket-mode ;; rainbow-blocks @@ -303,6 +310,8 @@ ;; side-notes ;; sieve-mode ;; skewer-mode +;; slime (sldb) +;; sly ;; smart-mode-line ;; smartparens ;; smerge @@ -323,6 +332,7 @@ ;; telephone-line ;; terraform-mode ;; term +;; textsec ;; tomatinho ;; transient (pop-up windows like Magit's) ;; trashed @@ -412,10 +422,10 @@ cover the blue-cyan-magenta side of the spectrum." ;; highlighted constructs; they must either be used as pairs based ;; on their name or each can be combined with {fg,bg}-{main,alt,dim} ;; always in accordance with their role as background or foreground - (bg-special-cold . "#dde3f4") (fg-special-cold . "#093060") - (bg-special-mild . "#c4ede0") (fg-special-mild . "#184034") - (bg-special-warm . "#f0e0d4") (fg-special-warm . "#5d3026") - (bg-special-calm . "#f8ddea") (fg-special-calm . "#61284f") + (bg-special-cold . "#dde3f4") (bg-special-faint-cold . "#f0f1ff") (fg-special-cold . "#093060") + (bg-special-mild . "#c4ede0") (bg-special-faint-mild . "#ebf5eb") (fg-special-mild . "#184034") + (bg-special-warm . "#f0e0d4") (bg-special-faint-warm . "#fef2ea") (fg-special-warm . "#5d3026") + (bg-special-calm . "#f8ddea") (bg-special-faint-calm . "#faeff9") (fg-special-calm . "#61284f") ;; foregrounds that can be combined with bg-main, bg-dim, bg-alt (red . "#a60000") (red-alt . "#972500") @@ -495,18 +505,18 @@ cover the blue-cyan-magenta side of the spectrum." ;; those background values should only be used for graphs or similar ;; applications where colored blocks are expected to be positioned ;; next to each other - (red-graph-0-bg . "#ef6f79") - (red-graph-1-bg . "#ff9f9f") - (green-graph-0-bg . "#49d239") - (green-graph-1-bg . "#6dec6d") - (yellow-graph-0-bg . "#efec08") - (yellow-graph-1-bg . "#dbff4e") - (blue-graph-0-bg . "#55a2f0") - (blue-graph-1-bg . "#7fcfff") - (magenta-graph-0-bg . "#ba86ef") - (magenta-graph-1-bg . "#e7afff") - (cyan-graph-0-bg . "#30d3f0") - (cyan-graph-1-bg . "#6fefff") + (red-graph-0-bg . "#ef7969") + (red-graph-1-bg . "#ffaab4") + (green-graph-0-bg . "#4faa09") + (green-graph-1-bg . "#8fef00") + (yellow-graph-0-bg . "#ffcf00") + (yellow-graph-1-bg . "#f9ff00") + (blue-graph-0-bg . "#7090ff") + (blue-graph-1-bg . "#9fc6ff") + (magenta-graph-0-bg . "#e07fff") + (magenta-graph-1-bg . "#fad0ff") + (cyan-graph-0-bg . "#70d3f0") + (cyan-graph-1-bg . "#afefff") ;; the following are for cases where both the foreground and the ;; background need to have a similar hue and so must be combined ;; with themselves, even though the foregrounds can be paired with @@ -545,6 +555,8 @@ cover the blue-cyan-magenta side of the spectrum." ;; while bg-tab-inactive should be combined with fg-dim, whereas ;; bg-tab-inactive-alt goes together with fg-main ;; + ;; bg-completion-* variants are meant to be combined with fg-main + ;; ;; fg-escape-char-construct and fg-escape-char-backslash can ;; be combined bg-main, bg-dim, bg-alt ;; @@ -564,7 +576,7 @@ cover the blue-cyan-magenta side of the spectrum." ;; all pairs are combinable with themselves (bg-hl-line . "#f2eff3") (bg-hl-line-intense . "#e0e0e0") - (bg-hl-line-intense-accent . "#b9e1ef") + (bg-hl-line-intense-accent . "#cfe2ff") (bg-hl-alt . "#fbeee0") (bg-hl-alt-intense . "#e8dfd1") (bg-paren-match . "#e0af82") @@ -574,6 +586,10 @@ 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-tab-active . "#f6f6f6") (bg-tab-inactive . "#b7b7b7") (bg-tab-inactive-accent . "#a9b4f6") @@ -653,10 +669,10 @@ symbol and the latter as a string.") ;; highlighted constructs; they must either be used as pairs based ;; on their name or each can be combined with {fg,bg}-{main,alt,dim} ;; always in accordance with their role as background or foreground - (bg-special-cold . "#203448") (fg-special-cold . "#c6eaff") - (bg-special-mild . "#00322e") (fg-special-mild . "#bfebe0") - (bg-special-warm . "#382f27") (fg-special-warm . "#f8dec0") - (bg-special-calm . "#392a48") (fg-special-calm . "#fbd6f4") + (bg-special-cold . "#203448") (bg-special-faint-cold . "#0e183a") (fg-special-cold . "#c6eaff") + (bg-special-mild . "#00322e") (bg-special-faint-mild . "#001f1a") (fg-special-mild . "#bfebe0") + (bg-special-warm . "#382f27") (bg-special-faint-warm . "#241613") (fg-special-warm . "#f8dec0") + (bg-special-calm . "#392a48") (bg-special-faint-calm . "#251232") (fg-special-calm . "#fbd6f4") ;; foregrounds that can be combined with bg-main, bg-dim, bg-alt (red . "#ff8059") (red-alt . "#ef8b50") @@ -736,18 +752,18 @@ symbol and the latter as a string.") ;; those background values should only be used for graphs or similar ;; applications where colored blocks are expected to be positioned ;; next to each other - (red-graph-0-bg . "#af0404") - (red-graph-1-bg . "#801f2f") - (green-graph-0-bg . "#24ba2f") - (green-graph-1-bg . "#0f8f07") - (yellow-graph-0-bg . "#ffd03e") - (yellow-graph-1-bg . "#d7d800") - (blue-graph-0-bg . "#406fff") - (blue-graph-1-bg . "#2f50c8") - (magenta-graph-0-bg . "#af7bee") - (magenta-graph-1-bg . "#7f59cf") - (cyan-graph-0-bg . "#47dcfa") - (cyan-graph-1-bg . "#0bc0df") + (red-graph-0-bg . "#b52c2c") + (red-graph-1-bg . "#702020") + (green-graph-0-bg . "#4fd100") + (green-graph-1-bg . "#007800") + (yellow-graph-0-bg . "#f1e00a") + (yellow-graph-1-bg . "#b08600") + (blue-graph-0-bg . "#2fafef") + (blue-graph-1-bg . "#1f2f8f") + (magenta-graph-0-bg . "#bf94fe") + (magenta-graph-1-bg . "#5f509f") + (cyan-graph-0-bg . "#47dfea") + (cyan-graph-1-bg . "#00808f") ;; the following are for cases where both the foreground and the ;; background need to have a similar hue and so must be combined ;; with themselves, even though the foregrounds can be paired with @@ -786,6 +802,8 @@ symbol and the latter as a string.") ;; while bg-tab-inactive should be combined with fg-dim, whereas ;; bg-tab-inactive-alt goes together with fg-main ;; + ;; bg-completion-* variants are meant to be combined with fg-main + ;; ;; fg-escape-char-construct and fg-escape-char-backslash can ;; be combined bg-main, bg-dim, bg-alt ;; @@ -805,16 +823,20 @@ symbol and the latter as a string.") ;; all pairs are combinable with themselves (bg-hl-line . "#151823") (bg-hl-line-intense . "#292929") - (bg-hl-line-intense-accent . "#00353f") + (bg-hl-line-intense-accent . "#002a4f") (bg-hl-alt . "#181732") (bg-hl-alt-intense . "#282e46") - (bg-paren-match . "#5f362f") + (bg-paren-match . "#6f3355") (bg-paren-match-intense . "#7416b5") (bg-paren-expression . "#221044") (bg-region . "#3c3c3c") (bg-region-accent . "#4f3d88") (bg-region-accent-subtle . "#240f55") + (bg-completion-nuanced . "#1a2854") + (bg-completion-subtle . "#282878") + (bg-completion-intense . "#323da2") + (bg-tab-active . "#0e0e0e") (bg-tab-inactive . "#424242") (bg-tab-inactive-accent . "#35398f") @@ -888,7 +910,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-subtle-green nil "Subtle green background combined with a dimmed foreground. @@ -896,7 +918,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-subtle-yellow nil "Subtle yellow background combined with a dimmed foreground. @@ -904,7 +926,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-subtle-blue nil "Subtle blue background combined with a dimmed foreground. @@ -912,7 +934,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-subtle-magenta nil "Subtle magenta background combined with a dimmed foreground. @@ -920,7 +942,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-subtle-cyan nil "Subtle cyan background combined with a dimmed foreground. @@ -928,7 +950,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-subtle-neutral nil "Subtle gray background combined with a dimmed foreground. @@ -936,7 +958,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-intense-red nil "Intense red background combined with the main foreground. @@ -944,7 +966,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-intense-green nil "Intense green background combined with the main foreground. @@ -952,7 +974,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-intense-yellow nil "Intense yellow background combined with the main foreground. @@ -960,7 +982,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-intense-blue nil "Intense blue background combined with the main foreground. @@ -968,7 +990,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-intense-magenta nil "Intense magenta background combined with the main foreground. @@ -976,7 +998,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-intense-cyan nil "Intense cyan background combined with the main foreground. @@ -984,7 +1006,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-intense-neutral nil "Intense gray background combined with the main foreground. @@ -992,7 +1014,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-refine-red nil "Combination of accented red background and foreground. @@ -1000,7 +1022,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-refine-green nil "Combination of accented green background and foreground. @@ -1008,7 +1030,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-refine-yellow nil "Combination of accented yellow background and foreground. @@ -1016,7 +1038,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-refine-blue nil "Combination of accented blue background and foreground. @@ -1024,7 +1046,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-refine-magenta nil "Combination of accented magenta background and foreground. @@ -1032,7 +1054,7 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-refine-cyan nil "Combination of accented cyan background and foreground. @@ -1040,91 +1062,91 @@ This is used for general purpose highlighting, mostly in buffers or for completion interfaces. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-active-red nil "A red background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-active-green nil "A green background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-active-yellow nil "A yellow background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-active-blue nil "A blue background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-active-magenta nil "A magenta background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-active-cyan nil "A cyan background meant for use on the mode line or similar. This is combined with the mode lines primary foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-fringe-red nil "A red background meant for use on the fringe or similar. This is combined with the main foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-fringe-green nil "A green background meant for use on the fringe or similar. This is combined with the main foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-fringe-yellow nil "A yellow background meant for use on the fringe or similar. This is combined with the main foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-fringe-blue nil "A blue background meant for use on the fringe or similar. This is combined with the main foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-fringe-magenta nil "A magenta background meant for use on the fringe or similar. This is combined with the main foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-fringe-cyan nil "A cyan background meant for use on the fringe or similar. This is combined with the main foreground value. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-nuanced-red nil "A nuanced red background. @@ -1134,7 +1156,7 @@ headings, and any other surface that needs to retain the colors on display. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-nuanced-green nil "A nuanced green background. @@ -1144,7 +1166,7 @@ headings, and any other surface that needs to retain the colors on display. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-nuanced-yellow nil "A nuanced yellow background. @@ -1154,7 +1176,7 @@ headings, and any other surface that needs to retain the colors on display. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-nuanced-blue nil "A nuanced blue background. @@ -1164,7 +1186,7 @@ headings, and any other surface that needs to retain the colors on display. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-nuanced-magenta nil "A nuanced magenta background. @@ -1174,7 +1196,7 @@ headings, and any other surface that needs to retain the colors on display. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-nuanced-cyan nil "A nuanced cyan background. @@ -1184,7 +1206,7 @@ headings, and any other surface that needs to retain the colors on display. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-special-cold nil "Combines the 'special cold' background and foreground values. @@ -1193,7 +1215,7 @@ suitable and where a combination of more saturated colors would not be appropriate. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-special-mild nil "Combines the 'special mild' background and foreground values. @@ -1202,7 +1224,7 @@ suitable and where a combination of more saturated colors would not be appropriate. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-special-warm nil "Combines the 'special warm' background and foreground values. @@ -1211,7 +1233,7 @@ suitable and where a combination of more saturated colors would not be appropriate. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-special-calm nil "Combines the 'special calm' background and foreground values. @@ -1220,7 +1242,7 @@ suitable and where a combination of more saturated colors would not be appropriate. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-added nil "Combines green colors for the 'added' state in diffs. @@ -1228,7 +1250,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-changed nil "Combines yellow colors for the 'changed' state in diffs. @@ -1236,7 +1258,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-removed nil "Combines red colors for the 'removed' state in diffs. @@ -1244,7 +1266,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-refine-added nil "Combines green colors for word-wise 'added' state in diffs. @@ -1252,7 +1274,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-refine-changed nil "Combines yellow colors for word-wise 'changed' state in diffs. @@ -1260,7 +1282,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-refine-removed nil "Combines red colors for word-wise 'removed' state in diffs. @@ -1268,7 +1290,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-focus-added nil "Combines green colors for the focused 'added' state in diffs. @@ -1276,7 +1298,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-focus-changed nil "Combines yellow colors for the focused 'changed' state in. @@ -1284,7 +1306,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-focus-removed nil "Combines red colors for the focused 'removed' state in diffs. @@ -1292,7 +1314,7 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-diff-heading nil "Combines blue colors for the diff hunk heading. @@ -1300,40 +1322,40 @@ The applied colors are contingent on the value assigned to `modus-themes-diffs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-pseudo-header nil "Generic style for some elements that function like headings. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-mark-alt nil "Combines yellow colors for marking special lines. This is intended for use in modes such as Dired, Ibuffer, Proced. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-mark-del nil "Combines red colors for marking deletable lines. This is intended for use in modes such as Dired, Ibuffer, Proced. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-mark-sel nil "Combines green colors for marking lines. This is intended for use in modes such as Dired, Ibuffer, Proced. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-mark-symbol nil "Applies a blue color and other styles for mark indicators. This is intended for use in modes such as Dired, Ibuffer, Proced. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-1 nil "General purpose face for use in headings level 1. @@ -1341,7 +1363,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-2 nil "General purpose face for use in headings level 2. @@ -1349,7 +1371,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-3 nil "General purpose face for use in headings level 3. @@ -1357,7 +1379,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-4 nil "General purpose face for use in headings level 4. @@ -1365,7 +1387,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-5 nil "General purpose face for use in headings level 5. @@ -1373,7 +1395,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-6 nil "General purpose face for use in headings level 6. @@ -1381,7 +1403,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-7 nil "General purpose face for use in headings level 7. @@ -1389,7 +1411,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-heading-8 nil "General purpose face for use in headings level 8. @@ -1397,7 +1419,7 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-headings' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-hl-line nil "General purpose face for the current line. @@ -1405,21 +1427,21 @@ The exact attributes assigned to this face are contingent on the values assigned to the `modus-themes-hl-line' variable. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-bold nil "Generic face for applying a conditional bold weight. This behaves in accordance with `modus-themes-bold-constructs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-slant nil "Generic face for applying a conditional slant (italics). This behaves in accordance with `modus-themes-italic-constructs'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-variable-pitch nil "Generic face for applying a conditional `variable-pitch'. @@ -1428,127 +1450,19 @@ This behaves in accordance with `modus-themes-mixed-fonts', and `modus-themes-variable-pitch-ui'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-fixed-pitch nil "Generic face for applying a conditional `fixed-pitch'. This behaves in accordance with `modus-themes-mixed-fonts'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-ui-variable-pitch nil "Face for `modus-themes-variable-pitch-ui'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-red-0 nil - "Special subdued red face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-red-1 nil - "Special prominent red face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-green-0 nil - "Special subdued green face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-green-1 nil - "Special prominent green face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-yellow-0 nil - "Special subdued yellow face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-yellow-1 nil - "Special prominent yellow face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-blue-0 nil - "Special subdued blue face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-blue-1 nil - "Special prominent blue face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-magenta-0 nil - "Special subdued magenta face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-magenta-1 nil - "Special prominent magenta face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-cyan-0 nil - "Special subdued cyan face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) - -(defface modus-themes-graph-cyan-1 nil - "Special prominent cyan face for use in graphs. -This is intended to be applied in contexts such as the Org agenda -habit graph where faithfulness to the semantics of a color value -is of paramount importance. - -The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-lang-note nil "Generic face for linter or spell checker notes. @@ -1556,7 +1470,7 @@ The exact attributes and color combinations are controlled by `modus-themes-lang-checkers'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-lang-warning nil "Generic face for linter or spell checker warnings. @@ -1564,7 +1478,7 @@ The exact attributes and color combinations are controlled by `modus-themes-lang-checkers'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-lang-error nil "Generic face for linter or spell checker errors. @@ -1572,7 +1486,7 @@ The exact attributes and color combinations are controlled by `modus-themes-lang-checkers'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-reset-soft nil "Generic face to set most face properties to nil. @@ -1583,7 +1497,7 @@ text should not be underlined as well) yet still blend in. Also see `modus-themes-reset-hard'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-reset-hard nil "Generic face to set all face properties to nil. @@ -1594,32 +1508,32 @@ text should not be underlined as well) and not blend in. Also see `modus-themes-reset-soft'. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-key-binding nil "Generic face for key bindings. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-search-success nil "Generic face for successful search. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-search-success-modeline nil "Generic mode line indicator for successful search. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-search-success-lazy nil "Generic face for successful, lazily highlighted search. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) (defface modus-themes-prompt nil "Generic face for command prompts. The actual styling of the face is done by `modus-themes-faces'." - :group 'modus-theme-faces) + :group 'modus-themes-faces) ;; "Grue" is "green" and "blue". (defface modus-themes-grue nil @@ -1682,11 +1596,51 @@ 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-markup-code nil + "Face of inline code markup. +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-themes-faces) + +(defface modus-themes-markup-macro nil + "Face of macro markup. +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-themes-faces) + (defface modus-themes-markup-verbatim nil "Face of verbatim markup. 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. +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. +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. +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. +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-themes-faces) + +(defface modus-themes-box-button nil + "Face for widget buttons (e.g. in the Custom UI). +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-themes-faces) + +(defface modus-themes-box-button-pressed nil + "Face for pressed widget buttons (e.g. in the Custom UI). +The actual styling of the face is done by `modus-themes-faces'." + :group 'modus-themes-faces) + ;;; Customization variables @@ -1827,6 +1781,7 @@ Users may need to explicitly configure the font family of (defconst modus-themes--headings-choice '(set :tag "Properties" :greedy t (const :tag "Background color" background) + (const :tag "Proportionately spaced font (variable-pitch)" variable-pitch) (const :tag "Overline" overline) (choice :tag "Font weight (must be supported by the typeface)" (const :tag "Bold (default)" nil) @@ -1890,12 +1845,12 @@ proportionately spaced typeface). The symbol of a weight attribute adjusts the font of the heading accordingly, such as `light', `semibold', etc. Valid symbols are -defined in the internal variable `modus-themes--heading-weights'. -The absence of a weight means that bold will be used by virtue of -inheriting the `bold' face (check the manual for tweaking bold -and italic faces). For backward compatibility, the `no-bold' -value is accepted, though users are encouraged to specify a -`regular' weight instead. +defined in the variable `modus-themes-weights'. The absence of a +weight means that bold will be used by virtue of inheriting the +`bold' face (check the manual for tweaking bold and italic +faces). For backward compatibility, the `no-bold' value is +accepted, though users are encouraged to specify a `regular' +weight instead. A number, expressed as a floating point (e.g. 1.5), adjusts the height of the heading to that many times the base font size. The @@ -1979,10 +1934,10 @@ include either or both of those properties: small increase in height (a value of 1.15). - The symbol of a weight attribute adjusts the font of the heading accordingly, such as `light', `semibold', etc. Valid - symbols are defined in the internal variable - `modus-themes--heading-weights'. The absence of a weight means - that bold will be used by virtue of inheriting the `bold' - face (check the manual for tweaking bold and italic faces). + symbols are defined in the variable `modus-themes-weights'. + The absence of a weight means that bold will be used by virtue + of inheriting the `bold' face (check the manual for tweaking + bold and italic faces). In case both a number and `no-scale' are in the list, the latter takes precedence. If two numbers are specified, the first one is @@ -2100,11 +2055,10 @@ value are passed as a symbol. Those are: The difference between ready and clear states is attenuated by painting both of them using shades of green. This option thus highlights the alert and overdue states. -- When `modus-themes-deuteranopia' is non-nil the habit graph - uses a three-color style like the aforementioned - `traffic-light' variant, except that shades of blue are applied - instead of green. This is suitable for users with red-green - color deficiency (deuteranopia). +- When `modus-themes-deuteranopia' is non-nil the exact style of + the habit graph adapts to the needs of users with red-green + colour deficiency by substituting every instance of green with + blue or cyan (depending on the specifics). For example: @@ -2112,7 +2066,7 @@ For example: (habit . simplified) (habit . traffic-light)" :group 'modus-themes - :package-version '(modus-themes . "2.0.0") + :package-version '(modus-themes . "2.1.0") :version "29.1" :type '(set (cons :tag "Block header" @@ -2323,25 +2277,32 @@ variables `flymake-fringe-indicator-position' and :link '(info-link "(modus-themes) Language checkers")) (defcustom modus-themes-org-blocks nil - "Use a subtle gray or color-coded background for Org blocks. + "Set the overall style of Org code blocks, quotes, and the like. -Nil (the default) means that the block has no distinct background -of its own and uses the one that applies to the rest of the -buffer. +Nil (the default) means that the block has no background of its +own: it uses the one that applies to the rest of the buffer. In +this case, the delimiter lines have a gray color for their text, +making them look exactly like all other Org properties. Option `gray-background' applies a subtle gray background to the block's contents. It also affects the begin and end lines of the -block: their background extends to the edge of the window for -Emacs version >= 27 where the ':extend' keyword is recognized by -`set-face-attribute' (this is contingent on the variable -`org-fontify-whole-block-delimiter-line'). +block as they get another shade of gray as their background, +which differentiates them from the contents of the block. All +background colors extend to the edge of the window, giving the +area a rectangular, \"blocky\" presentation. Option `tinted-background' uses a slightly colored background for the contents of the block. The exact color will depend on the programming language and is controlled by the variable `org-src-block-faces' (refer to the theme's source code for the current association list). For this to take effect, the Org -buffer needs to be restarted with `org-mode-restart'. +buffer needs to be restarted with `org-mode-restart'. In this +scenario, it may be better to inhibit the extension of the +delimiter lines' background to the edge of the window because Org +does not provide a mechanism to update their colors depending on +the contents of the block. Disable the extension of such +backgrounds by setting `org-fontify-whole-block-delimiter-line' +to nil. Code blocks use their major mode's colors only when the variable `org-src-fontify-natively' is non-nil. While quote/verse blocks @@ -2353,7 +2314,7 @@ Older versions of the themes provided options `grayscale' (or are aliases for `gray-background' and `tinted-background', respectively." :group 'modus-themes - :package-version '(modus-themes . "1.4.0") + :package-version '(modus-themes . "2.1.0") :version "28.1" :type '(choice (const :format "[%v] %t\n" :tag "No Org block background (default)" nil) @@ -2509,8 +2470,9 @@ 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, as well as pattern matching -styles like Orderless and Flx. The latter covers Helm and Ivy. +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. @@ -2518,28 +2480,32 @@ 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, Ivy et al appear slightly +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 emulate those of Helm, Ivy and company 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. +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 the nil (default), `moderate', -and `opinionated' possibilities." +spend some time with each of those presets." :group 'modus-themes - :package-version '(modus-themes . "1.0.0") - :version "28.1" + :package-version '(modus-themes . "2.1.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 "Radical alternative to the framework's looks" opinionated)) + (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)) :set #'modus-themes--set-option :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Completion UIs")) @@ -2646,21 +2612,56 @@ results with underlines." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Line numbers")) -(defcustom modus-themes-intense-markup nil - "Use more intense markup in Org, Markdown, and related. -The default style for certain markup types like inline code and -verbatim constructs in Org and related major modes is a subtle -foreground color combined with a subtle background. +(defcustom modus-themes-markup nil + "Style markup in Org, Markdown, and others. + +This affects constructs such as Org's =verbatim= and ~code~. + +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is a foreground +color. + +The `italic' property applies a typographic slant (italics). + +The `bold' property applies a heavier typographic weight. + +The `background' property adds a background color. The +background is a shade of gray, unless the `intense' property is +also set. -With a non-nil value (t), these constructs will use a more -prominent background and foreground color combination instead." +The `intense' property amplifies the existing coloration. When +`background' is used, the background color is enhanced as well +and becomes tinted instead of being gray. + +Combinations of any of those properties are expressed as a list, +like in these examples: + + (bold) + (bold italic) + (bold italic intense) + (bold italic intense background) + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-markup (quote (bold italic))) + +Also check the variables `org-hide-emphasis-markers', +`org-hide-macro-markers'." :group 'modus-themes - :package-version '(modus-themes . "1.7.0") + :package-version '(modus-themes . "2.1.0") :version "29.1" - :type 'boolean + :type '(set :tag "Properties" :greedy t + (const :tag "Added background" background) + (const :tag "Intense colors" intense) + (const :tag "Bold weight" bold) + (const :tag "Italics (slanted text)" italic)) :set #'modus-themes--set-option :initialize #'custom-initialize-default - :link '(info-link "(modus-themes) Intense markup")) + :link '(info-link "(modus-themes) Markup")) + +(make-obsolete 'modus-themes-intense-markup 'modus-themes-markup "2.1.0") (defcustom modus-themes-paren-match nil "Control the style of matching parentheses or delimiters. @@ -2895,23 +2896,32 @@ the spectrum." :link '(info-link "(modus-themes) Deuteranopia style")) (defcustom modus-themes-mail-citations nil - "Control the color of citations in messages or email clients. + "Control the color of citations/quotes in messages or emails. + +By default (a nil value) citations are styled with contrasting +hues to denote their depth. Colors are easy to tell apart +because they complement each other, but they otherwise are not +very prominent. + +Option `intense' is similar to the default in terms of using +contrasting and complementary hues, but applies more saturated +colors. -Nil (the default) means to use a variety of contrasting hues to -denote depth in nested citations. Colors are fairly easy to tell -apart. +Option `faint' maintains the same color-based distinction between +citation levels though the colors it uses have subtle differences +between them. -Option `faint' maintains a color-based distinction between -citation levels but the colors it applies have very subtle -differences between them. +Option `monochrome' turns all quotes into a shade of gray. -Option `monochrome' turns all citations that would otherwise be -colored into a uniform shade of shade of gray." +Whatever the value assigned to this variable, citations in emails +are controlled by typographic elements and/or indentation, which +the themes do not touch." :group 'modus-themes - :package-version '(modus-themes . "1.4.0") - :version "28.1" + :package-version '(modus-themes . "2.1.0") + :version "29.1" :type '(choice - (const :format "[%v] %t\n" :tag "Colorful mail citations with contrasting hues (default)" nil) + (const :format "[%v] %t\n" :tag "Colorful email citations with contrasting hues (default)" nil) + (const :format "[%v] %t\n" :tag "Like the default, but with more saturated colors" intense) (const :format "[%v] %t\n" :tag "Like the default, but with less saturated colors" faint) (const :format "[%v] %t\n" :tag "Deprecated alias of `faint'" desaturated) (const :format "[%v] %t\n" :tag "Uniformly gray mail citations" monochrome)) @@ -2931,6 +2941,75 @@ as the Centaur tabs package." :initialize #'custom-initialize-default :link '(info-link "(modus-themes) Tab style")) +(defcustom modus-themes-box-buttons nil + "Control the style of buttons in the Custom UI and related. + +The value is a list of properties, each designated by a symbol. +The default (a nil value or an empty list) is a gray background +combined with a pseudo three-dimensional effect. + +The `flat' property makes the button two dimensional. + +The `accented' property changes the background from gray to an +accent color. + +The `faint' property reduces the overall coloration. + +The `variable-pitch' property applies a proportionately spaced +typeface to the button's text. + +The `underline' property draws a line below the affected text and +removes whatever box effect. This is optimal when Emacs runs +inside a terminal emulator. If `flat' and `underline' are +defined together, the latter takes precedence. + +The symbol of a weight attribute adjusts the font of the button +accordingly, such as `light', `semibold', etc. Valid symbols are +defined in the variable `modus-themes-weights'. + +A number, expressed as a floating point (e.g. 0.9), adjusts the +height of the button's text to that many times the base font +size. The default height is the same as 1.0, though it need not +be explicitly stated. + +Combinations of any of those properties are expressed as a list, +like in these examples: + + (flat) + (variable-pitch flat) + (variable-pitch flat 0.9 semibold) + +The order in which the properties are set is not significant. + +In user configuration files the form may look like this: + + (setq modus-themes-box-buttons (quote (variable-pitch flat 0.9)))" + :group 'modus-themes + :package-version '(modus-themes . "2.1.0") + :version "29.1" + :type '(set :tag "Properties" :greedy t + (const :tag "Two-dimensional button" flat) + (const :tag "Accented background instead of gray" accented) + (const :tag "Reduce overall coloration" faint) + (const :tag "Proportionately spaced font (variable-pitch)" variable-pitch) + (const :tag "Underline instead of a box effect" underline) + (choice :tag "Font weight (must be supported by the typeface)" + (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 "Regulat (default)" nil) + (const :tag "Medium" medium) + (const :tag "Bold" bold) + (const :tag "Semi-bold" semibold) + (const :tag "Extra-bold" extrabold) + (const :tag "Ultra-bold" ultrabold)) + (float :tag "Number (float) to adjust height by" :value 0.9)) + :set #'modus-themes--set-option + :initialize #'custom-initialize-default + :link '(info-link "(modus-themes) Box buttons")) + ;;; Internal functions @@ -2985,9 +3064,8 @@ Those are stored in `modus-themes-faces' and (defun modus-themes--slant () "Conditional use of italics for slant attribute." - (if modus-themes-italic-constructs - (list 'italic) - (list 'normal))) + (when modus-themes-italic-constructs + (list :inherit 'italic))) (defun modus-themes--fixed-pitch () "Conditional application of `fixed-pitch' inheritance." @@ -3016,14 +3094,41 @@ combines with the theme's primary background (white/black)." (list :background (or altbg 'unspecified) :foreground altfg) (list :background mainbg :foreground mainfg))) -(defun modus-themes--markup (mainfg intensefg &optional mainbg intensebg) +(defun modus-themes--markup (mainfg intensefg subtlebg intensebg) "Conditional use of colors for markup in Org and others. -MAINBG is the default background. MAINFG is the default -foreground. INTENSEBG and INTENSEFG must be more colorful -variants." - (if modus-themes-intense-markup - (list :background (or intensebg 'unspecified) :foreground intensefg) - (list :background (or mainbg 'unspecified) :foreground mainfg))) +MAINFG is the default foreground. SUBTLEBG is a gray background. +INTENSEBG is a colorful background for use with the main +foreground. INTENSEFG is an alternative to the default." + (let ((properties modus-themes-markup)) + (list + :inherit + (cond + ((and (memq 'bold properties) + (memq 'italic properties)) + (list 'modus-themes-fixed-pitch 'bold-italic)) + ((memq 'italic properties) + (list 'modus-themes-fixed-pitch 'italic)) + ((memq 'bold properties) + (list 'modus-themes-fixed-pitch 'bold)) + (t 'modus-themes-fixed-pitch)) + :background + (cond + ((and (memq 'background properties) + (memq 'intense properties)) + intensebg) + ((memq 'background properties) + subtlebg) + (t + 'unspecified)) + :foreground + (cond + ((and (memq 'background properties) + (memq 'intense properties)) + mainfg) + ((memq 'intense properties) + intensefg) + (t + mainfg))))) (defun modus-themes--lang-check (underline subtlefg intensefg intensefg-alt subtlebg intensebg faintfg) "Conditional use of foreground colors for language checkers. @@ -3090,19 +3195,7 @@ should be combinable with INTENSEBG-FG. SUBTLEBGGRAY and INTENSEBGGRAY are background values. The former can be combined with GRAYFG, while the latter only works with the theme's fallback text color." - (let ((properties - (if (listp modus-themes-prompts) - modus-themes-prompts - ;; translation layer for legacy values - (pcase modus-themes-prompts - ;; `subtle' is the same as `subtle-accented', while `intense' is - ;; equal to `intense-accented' for backward compatibility - ('subtle '(background)) - ('subtle-accented '(background)) - ('subtle-gray '(background gray)) - ('intense '(background intense)) - ('intense-accented '(background intense)) - ('intense-gray '(background intense gray)))))) + (let ((properties modus-themes-prompts)) (list :foreground (cond ((and (memq 'gray properties) @@ -3148,16 +3241,7 @@ NORMALBG should be the special palette color 'bg-paren-match' or something similar. INTENSEBG must be easier to discern next to other backgrounds, such as the special palette color 'bg-paren-match-intense'." - (let ((properties - (if (listp modus-themes-paren-match) - modus-themes-paren-match - ;; translation layer for legacy values - (pcase modus-themes-paren-match - ;; `subtle' is the same as `subtle-accented', while `intense' is - ;; equal to `intense-accented' for backward compatibility - ('intense-bold '(intense bold)) - ('subtle-bold '(bold)) - ('intense '(intense)))))) + (let ((properties modus-themes-paren-match)) (list :inherit (if (memq 'bold properties) 'bold @@ -3175,18 +3259,7 @@ other backgrounds, such as the special palette color "Apply foreground value to code syntax. FG is the default. FAINT is typically the same color in its desaturated version." - (let ((properties - (if (listp modus-themes-syntax) - modus-themes-syntax - ;; translation layer for legacy values - (pcase modus-themes-syntax - ('faint '(faint)) - ('faint-yellow-comments '(faint yellow-comments)) - ('green-strings '(green-strings)) - ('yellow-comments '(yellow-comments)) - ('yellow-comments-green-strings '(green-strings yellow-comments)) - ('alt-syntax '(alt-syntax)) - ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (let ((properties modus-themes-syntax)) (list :foreground (cond ((memq 'faint properties) @@ -3198,18 +3271,7 @@ desaturated version." FG is the default. FAINT is typically the same color in its desaturated version. ALT is another hue while optional FAINT-ALT is its subtle alternative." - (let ((properties - (if (listp modus-themes-syntax) - modus-themes-syntax - ;; translation layer for legacy values - (pcase modus-themes-syntax - ('faint '(faint)) - ('faint-yellow-comments '(faint yellow-comments)) - ('green-strings '(green-strings)) - ('yellow-comments '(yellow-comments)) - ('yellow-comments-green-strings '(green-strings yellow-comments)) - ('alt-syntax '(alt-syntax)) - ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (let ((properties modus-themes-syntax)) (list :foreground (cond ((and (memq 'alt-syntax properties) @@ -3228,18 +3290,7 @@ desaturated version. GREEN is a color variant in that side of the spectrum. ALT is another hue. Optional FAINT-GREEN is a subtle alternative to GREEN. Optional FAINT-ALT is a subtle alternative to ALT." - (let ((properties - (if (listp modus-themes-syntax) - modus-themes-syntax - ;; translation layer for legacy values - (pcase modus-themes-syntax - ('faint '(faint)) - ('faint-yellow-comments '(faint yellow-comments)) - ('green-strings '(green-strings)) - ('yellow-comments '(yellow-comments)) - ('yellow-comments-green-strings '(green-strings yellow-comments)) - ('alt-syntax '(alt-syntax)) - ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (let ((properties modus-themes-syntax)) (list :foreground (cond ((and (memq 'faint properties) @@ -3261,18 +3312,7 @@ alternative to ALT." FG is the default. YELLOW is a color variant of that name while optional FAINT-YELLOW is its subtle variant. Optional FAINT is an alternative to the default value." - (let ((properties - (if (listp modus-themes-syntax) - modus-themes-syntax - ;; translation layer for legacy values - (pcase modus-themes-syntax - ('faint '(faint)) - ('faint-yellow-comments '(faint yellow-comments)) - ('green-strings '(green-strings)) - ('yellow-comments '(yellow-comments)) - ('yellow-comments-green-strings '(green-strings yellow-comments)) - ('alt-syntax '(alt-syntax)) - ('alt-syntax-yellow-comments '(alt-syntax yellow-comments)))))) + (let ((properties modus-themes-syntax)) (list :foreground (cond ((and (memq 'faint properties) @@ -3292,12 +3332,17 @@ an alternative to the default value." "Get cdr of KEY in ALIST." (cdr (assoc key alist))) -(defvar modus-themes--heading-weights +(define-obsolete-variable-alias + 'modus-themes--heading-weights + 'modus-themes-weights + "2.1.0") + +(defconst modus-themes-weights '( thin ultralight extralight light semilight regular medium semibold bold heavy extrabold ultrabold) - "List of font weights used by `modus-themes--heading'.") + "List of font weights.") -(defun modus-themes--heading-weight (list) +(defun modus-themes--weight (list) "Search for `modus-themes--heading' weight in LIST." (catch 'found (dolist (elt list) @@ -3316,33 +3361,12 @@ that combines well with the background and foreground." (let* ((key (modus-themes--key-cdr level modus-themes-headings)) (style (or key (modus-themes--key-cdr t modus-themes-headings))) (style-listp (listp style)) - (properties - (if style-listp - style - ;; translation layer for legacy values - (pcase style - ('highlight '(background)) - ('highlight-no-bold '(background no-bold)) - ('line '(overline)) - ('line-no-bold '(no-bold overline)) - ('no-bold '(no-bold)) - ('no-color '(monochrome)) - ('no-color-no-bold '(no-bold monochrome)) - ('rainbow '(rainbow)) - ('rainbow-highlight '(rainbow background)) - ('rainbow-highlight-no-bold '(no-bold rainbow background)) - ('rainbow-line '(rainbow overline)) - ('rainbow-no-bold '(no-bold rainbow)) - ('rainbow-line-no-bold '(rainbow overline no-bold)) - ('rainbow-section '(rainbow overline background)) - ('rainbow-section-no-bold '(no-bold rainbow background overline)) - ('section '(background overline)) - ('section-no-bold '(background overline no-bold))))) + (properties style) (var (when (memq 'variable-pitch properties) 'variable-pitch)) (varbold (if var (append (list 'bold) (list var)) 'bold)) - (weight (when style-listp (modus-themes--heading-weight style)))) + (weight (when style-listp (modus-themes--weight style)))) (list :inherit (cond ;; `no-bold' is for backward compatibility because we cannot @@ -3378,7 +3402,7 @@ that combines well with the background and foreground." "Control the style of the Org agenda structure. FG is the foreground color to use." (let* ((properties (modus-themes--key-cdr 'header-block modus-themes-org-agenda)) - (weight (modus-themes--heading-weight properties))) + (weight (modus-themes--weight properties))) (list :inherit (cond ((and weight (memq 'variable-pitch properties)) @@ -3479,18 +3503,28 @@ clearly distinguishes past, present, future tasks." ('rainbow (list :foreground rainbowfg)) (_ (list :foreground defaultfg)))) -(defun modus-themes--agenda-habit (default traffic simple &optional traffic-deuteran) +(defun modus-themes--agenda-habit (default traffic simple &optional default-d traffic-d simple-d) "Specify background values for `modus-themes-org-agenda' habits. DEFAULT is the original foregrounc color. TRAFFIC is to be used when the 'traffic-light' style is applied, while SIMPLE -corresponds to the 'simplified style'. Optional TRAFFIC-DEUTERAN -is an alternative to TRAFFIC, meant for deuteranopia." - (if modus-themes-deuteranopia - (list :background (or traffic-deuteran traffic)) - (pcase (modus-themes--key-cdr 'habit modus-themes-org-agenda) - ('traffic-light (list :background traffic)) - ('simplified (list :background simple)) - (_ (list :background default))))) +corresponds to the 'simplified style'. + +Optional DEFAULT-D, TRAFFIC-D, SIMPLE-D are alternatives to the +main colors, meant for dopia when `modus-themes-deuteranopia' is +non-nil." + (let ((habit (modus-themes--key-cdr 'habit modus-themes-org-agenda))) + (cond + ((and modus-themes-deuteranopia (null habit)) + (list :background (or default-d default))) + ((and modus-themes-deuteranopia (eq habit 'traffic-light)) + (list :background (or traffic-d traffic))) + ((and modus-themes-deuteranopia (eq habit 'simplified)) + (list :background (or simple-d simple))) + (t + (pcase habit + ('traffic-light (list :background traffic)) + ('simplified (list :background simple)) + (_ (list :background default))))))) (defun modus-themes--org-block (bgblk fgdefault &optional fgblk) "Conditionally set the background of Org blocks. @@ -3526,8 +3560,9 @@ set to `rainbow'." ('gray-background (list :background bg :foreground fg :extend t)) ('grayscale (list :background bg :foreground fg :extend t)) ('greyscale (list :background bg :foreground fg :extend t)) + ('tinted-background (list :background bgaccent :foreground fgaccent :extend nil)) ('rainbow (list :background bgaccent :foreground fgaccent :extend nil)) - (_ (list :background bg :foreground fg :extend nil)))) + (_ (list :foreground fg :extend nil)))) (defun modus-themes--mode-line-attrs (fg bg fg-alt bg-alt fg-accent bg-accent border border-3d &optional alt-style fg-distant) @@ -3545,22 +3580,7 @@ line's box property. Optional FG-DISTANT should be close to the main background values. It is intended to be used as a distant-foreground property." - (let* ((properties - (if (listp modus-themes-mode-line) - modus-themes-mode-line - ;; translation layer for legacy values - (alist-get modus-themes-mode-line - '((3d . (3d)) - (moody . (moody)) - (borderless . (borderless)) - (borderless-3d . (borderless 3d)) - (borderless-moody . (borderless moody)) - (accented . (accented)) - (accented-3d . (accented 3d)) - (accented-moody . (accented moody)) - (borderless-accented . (borderless accented)) - (borderless-accented-3d . (borderless accented 3d)) - (borderless-accented-moody . (borderless accented moody)))))) + (let* ((properties modus-themes-mode-line) (padding (seq-find #'natnump properties 1)) (padded (> padding 1)) (base (cond ((memq 'accented properties) @@ -3622,6 +3642,12 @@ property." fg-distant 'unspecified)))) +;; Basically this is just for the keycast key indicator. +(defun modus-themes--mode-line-padded-box (color) + "Set padding of mode line box attribute with given COLOR." + (let ((padding (seq-find #'natnump modus-themes-mode-line 1))) + (list :box (list :line-width padding :color color)))) + (defun modus-themes--diff (mainbg mainfg altbg altfg &optional deuteranbg deuteranfg bg-only-fg) "Color combinations for `modus-themes-diffs'. @@ -3650,39 +3676,47 @@ unspecified." (list deuteran) (list main))) -(defun modus-themes--standard-completions (mainfg subtlebg intensebg intensefg) +(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 MAINFG. INTENSEBG and -INTENSEFG are accented colors that are designed to be used in -tandem. +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 mainfg)) + ('moderate (list :background subtlebg :foreground subtlefg)) (_ (list :foreground mainfg)))) -(defun modus-themes--extra-completions (subtleface intenseface altface &optional altfg bold) +(defun modus-themes--extra-completions (default moderate opinionated) "Combinations for `modus-themes-completions'. -SUBTLEFACE and INTENSEFACE are custom theme faces that combine a -background and foreground value. The difference between the two -is a matter of degree. +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))))) -ALTFACE is a combination of colors that represents a departure -from the UI's default aesthetics. Optional ALTFG is meant to be -used in tandem with it. +(defun modus-themes--extra-completions-line (mainfg mainbg modbg opbg sopbg) + "Combinations for `modus-themes-completions'. -Optional BOLD will apply a heavier weight to the text. +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 Helm, Ivy, etc." +These are intended for Ivy and Helm." (pcase modus-themes-completions - ('opinionated (list :inherit (list altface bold) - :foreground (or altfg 'unspecified))) - ('moderate (list :inherit (list subtleface bold))) - (_ (list :inherit (list intenseface bold))))) + ('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--link (fg fgfaint underline bg bgneutral) "Conditional application of link styles. @@ -3690,17 +3724,7 @@ FG is the link's default color for its text and underline property. FGFAINT is a desaturated color for the text and underline. UNDERLINE is a gray color only for the undeline. BG is a background color and BGNEUTRAL is its fallback value." - (let ((properties - (if (listp modus-themes-links) - modus-themes-links - ;; translation layer for legacy values - (pcase modus-themes-links - ('faint '(faint)) - ('neutral-underline '(neutral-underline)) - ('faint-neutral-underline '(neutral-underline faint)) - ('no-underline '(no-underline)) - ('underline-only '(no-color)) - ('neutral-underline-only '(no-color neutral-underline)))))) + (let ((properties modus-themes-links)) (list :inherit (cond ((and (memq 'bold properties) @@ -3738,17 +3762,7 @@ is a background color and BGNEUTRAL is its fallback value." "Extend `modus-themes--link'. FG is the main accented foreground. FGFAINT is also accented, yet desaturated. Optional NEUTRALFG is a gray value." - (let ((properties - (if (listp modus-themes-links) - modus-themes-links - ;; translation layer for legacy values - (pcase modus-themes-links - ('faint '(faint)) - ('neutral-underline '(neutral-underline)) - ('faint-neutral-underline '(neutral-underline faint)) - ('no-underline '(no-underline)) - ('underline-only '(no-color)) - ('neutral-underline-only '(no-color neutral-underline)))))) + (let ((properties modus-themes-links)) (list :foreground (cond ((memq 'no-color properties) @@ -3772,16 +3786,7 @@ is a subtle background value that can be combined with all colors used to fontify text and code syntax. BGACCENT is a colored background that combines well with FG. BGACCENTSUBTLE can be combined with all colors used to fontify text." - (let ((properties - (if (listp modus-themes-region) - modus-themes-region - ;; translation layer for legacy values - (pcase modus-themes-region - ('bg-only '(bg-only)) - ('bg-only-no-extend '(bg-only no-extend)) - ('accent '(accented)) - ('accent-no-extend '(accented no-extend)) - ('no-extend '(no-extend)))))) + (let ((properties modus-themes-region)) (list :background (cond ((and (memq 'accented properties) @@ -3817,17 +3822,7 @@ LINEACCENT are color values that can remain distinct against the buffer's possible backgrounds: the former is neutral, the latter is accented. LINENEUTRALINTENSE and LINEACCENTINTENSE are their more prominent alternatives." - (let ((properties - (if (listp modus-themes-hl-line) - modus-themes-hl-line - ;; translation layer for legacy values - (pcase modus-themes-hl-line - ('intense-background '(intense)) - ('accented-background '(accented)) - ('underline-neutral '(underline)) - ('underline-accented '(underline accented)) - ('underline-only-neutral '(underline)) ; only underline styles have been removed - ('underline-only-accented '(underline accented)))))) + (let ((properties modus-themes-hl-line)) (list :background (cond ((and (memq 'intense properties) @@ -3855,13 +3850,14 @@ more prominent alternatives." lineneutral) ('unspecified))))) -(defun modus-themes--mail-cite (mainfg subtlefg) +(defun modus-themes--mail-cite (mainfg intensefg subtlefg) "Combinations for `modus-themes-mail-citations'. MAINFG is an accented foreground value. SUBTLEFG is its -desaturated counterpart." +desaturated counterpart. INTENSEFG is a more saturated variant." (pcase modus-themes-mail-citations ('monochrome (list :inherit 'shadow)) + ('intense (list :foreground intensefg)) ('faint (list :foreground subtlefg)) ('desaturated (list :foreground subtlefg)) (_ (list :foreground mainfg)))) @@ -3890,10 +3886,118 @@ application of a variable-pitch font." :foreground (or foreground 'unspecified) :box (if box-p (list :line-width 2 :color background) 'unspecified)))) +(defun modus-themes--button (bg bgfaint bgaccent bgaccentfaint border &optional pressed-button-p) + "Apply `modus-themes-box-buttons' styles. + +Work in progress. BG BGFAINT BGACCENT BGACCENTFAINT BORDER PRESSED-BUTTON-P." + (let* ((properties modus-themes-box-buttons) + (weight (modus-themes--weight properties))) + (list :inherit + (cond + ((and (memq 'variable-pitch properties) + (eq weight 'bold)) + (list 'bold 'variable-pitch)) + ((memq 'variable-pitch properties) + 'variable-pitch) + ((eq weight 'bold) + 'bold) + ('unspecified)) + :background + (cond + ((and (memq 'accented properties) + (memq 'faint properties) + bgaccentfaint)) + ((memq 'faint properties) + bgfaint) + ((memq 'accented properties) + bgaccent) + (bg)) + :box + (cond + ((memq 'underline properties) + 'unspecified) + ((memq 'flat properties) + (list :line-width -1 :color border)) + ((list :line-width -1 + :style (if pressed-button-p + 'pressed-button + 'released-button) + :color border))) + :weight + (cond + ((eq weight 'bold) + 'unspecified) ; we :inherit the `bold' face above + (weight weight) + ('unspecified)) + :height + (seq-find #'floatp properties 'unspecified) + :underline + (if (memq 'underline properties) + t + 'unspecified)))) + ;;;; Utilities for DIY users +;;;;; List colors (a respin of M-x list-colors-display) + +(defun modus-themes--list-colors-render (buffer palette) + "Render colors in BUFFER from PALETTE. +Routine for `modus-themes-list-colors'." + (with-help-window buffer + (with-current-buffer standard-output + (erase-buffer) + ;; We need this to properly render the first line. + (insert " ") + (dolist (cell palette) + (let* ((name (car cell)) + (color (cdr cell)) + (fg (readable-foreground-color color)) + (pad (make-string 5 ?\s))) + (let ((old-point (point))) + (insert (format "%s %s" color pad)) + (put-text-property old-point (point) 'face `( :foreground ,color))) + (let ((old-point (point))) + (insert (format " %s %s %s\n" color pad name)) + (put-text-property old-point (point) + 'face `( :background ,color + :foreground ,fg + :extend t))) + ;; We need this to properly render the last line. + (insert " ")))))) + +(defvar modus-themes--list-colors-prompt-history '() + "Minibuffer history for `modus-themes--list-colors-prompt'.") + +(defun modus-themes--list-colors-prompt () + "Prompt for Modus theme. +Helper function for `modus-themes-list-colors'." + (let ((def (format "%s" (modus-themes--current-theme)))) + (completing-read + (format "Use palette from theme [%s]: " def) + '(modus-operandi modus-vivendi) nil t nil + 'modus-themes--list-colors-prompt-history def))) + +(defun modus-themes-list-colors (theme) + "Preview palette of the Modus THEME of choice." + (interactive + (list (intern (modus-themes--list-colors-prompt)))) + (let ((palette (pcase theme + ('modus-operandi modus-themes-operandi-colors) + ('modus-vivendi modus-themes-vivendi-colors) + (_ (user-error "`%s' is not a Modus theme" theme))))) + (modus-themes--list-colors-render + (format "*%s-list-colors*" theme) + palette))) + +(defun modus-themes-list-colors-current () + "Call `modus-themes-list-colors' for the current Modus theme." + (interactive) + (modus-themes-list-colors (modus-themes--current-theme))) + +;;;;; Formula to measure relative luminance + ;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html (defun modus-themes-wcag-formula (hex) "Get WCAG value of color value HEX. @@ -3913,6 +4017,8 @@ C1 and C2 are color values written in hexadecimal RGB." (+ (modus-themes-wcag-formula c2) 0.05)))) (max ct (/ ct)))) +;;;;; Retrieve colors from the themes + (defun modus-themes-current-palette () "Return current color palette." (modus-themes--palette (modus-themes--current-theme))) @@ -4215,19 +4321,6 @@ by virtue of calling either of `modus-themes-load-operandi' and ((,class ,@(modus-themes--heading 8 magenta-nuanced-fg magenta bg-alt bg-alt bg-region)))) -;;;;; graph-specific faces - `(modus-themes-graph-red-0 ((,class :background ,red-graph-0-bg))) - `(modus-themes-graph-red-1 ((,class :background ,red-graph-1-bg))) - `(modus-themes-graph-green-0 ((,class :background ,green-graph-0-bg))) - `(modus-themes-graph-green-1 ((,class :background ,green-graph-1-bg))) - `(modus-themes-graph-yellow-0 ((,class :background ,yellow-graph-0-bg))) - `(modus-themes-graph-yellow-1 ((,class :background ,yellow-graph-1-bg))) - `(modus-themes-graph-blue-0 ((,class :background ,blue-graph-0-bg))) - `(modus-themes-graph-blue-1 ((,class :background ,blue-graph-1-bg))) - `(modus-themes-graph-magenta-0 ((,class :background ,magenta-graph-0-bg))) - `(modus-themes-graph-magenta-1 ((,class :background ,magenta-graph-1-bg))) - `(modus-themes-graph-cyan-0 ((,class :background ,cyan-graph-0-bg))) - `(modus-themes-graph-cyan-1 ((,class :background ,cyan-graph-1-bg))) ;;;;; language checkers `(modus-themes-lang-error ((,class ,@(modus-themes--lang-check fg-lang-underline-error fg-lang-error @@ -4241,21 +4334,72 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; links `(modus-themes-link-broken ((,class :inherit button ,@(modus-themes--link-color red red-faint)))) `(modus-themes-link-symlink ((,class :inherit button ,@(modus-themes--link-color cyan cyan-faint)))) +;;;;; markup + `(modus-themes-markup-code + ((,class ,@(modus-themes--markup cyan-alt-other cyan-intense bg-alt + bg-special-faint-mild)))) + `(modus-themes-markup-macro + ((,class ,@(modus-themes--markup magenta-alt-other purple-intense bg-alt + bg-special-faint-cold)))) + `(modus-themes-markup-verbatim + ((,class ,@(modus-themes--markup magenta-alt magenta-intense bg-alt + bg-special-faint-calm)))) +;;;;; search + `(modus-themes-search-success ((,class :inherit ,@(modus-themes--deuteran + 'modus-themes-intense-blue + 'modus-themes-intense-green)))) + `(modus-themes-search-success-lazy ((,class :inherit ,@(modus-themes--deuteran + 'modus-themes-special-mild + 'modus-themes-refine-cyan)))) + `(modus-themes-search-success-modeline ((,class :foreground ,@(modus-themes--deuteran + blue-active + green-active)))) ;;;;; tabs `(modus-themes-tab-active ((,class ,@(modus-themes--tab bg-tab-active nil nil nil t t)))) `(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)))) -;;;;; other custom faces +;;;;; 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))))) +;;;;; buttons + `(modus-themes-box-button + ((,class ,@(modus-themes--button bg-active bg-main bg-active-accent + bg-special-cold bg-region)))) + `(modus-themes-box-button-pressed + ((,class ,@(modus-themes--button bg-active bg-main bg-active-accent + bg-special-cold bg-region t)))) +;;;;; typography `(modus-themes-bold ((,class ,@(modus-themes--bold-weight)))) + `(modus-themes-fixed-pitch ((,class ,@(modus-themes--fixed-pitch)))) + `(modus-themes-slant ((,class ,@(modus-themes--slant)))) + `(modus-themes-ui-variable-pitch ((,class ,@(modus-themes--variable-pitch-ui)))) +;;;;; other custom faces `(modus-themes-hl-line ((,class ,@(modus-themes--hl-line bg-hl-line bg-hl-line-intense bg-hl-line-intense-accent blue-nuanced-bg bg-region blue-intense-bg - fg-alt cyan-intense) + fg-alt blue-intense) :extend t))) - `(modus-themes-key-binding ((,class ,@(if (facep 'help-key-binding) ; check emacs28 face - (list :inherit 'help-key-binding) - (list :inherit 'bold :foreground blue-alt-other))))) + `(modus-themes-key-binding ((,class :inherit bold :foreground ,blue-alt-other))) `(modus-themes-prompt ((,class ,@(modus-themes--prompt cyan-alt-other blue-alt-other fg-alt cyan-nuanced-bg blue-refine-bg fg-main @@ -4264,21 +4408,6 @@ by virtue of calling either of `modus-themes-load-operandi' and `(modus-themes-reset-soft ((,class :background ,bg-main :foreground ,fg-main :weight normal :slant normal :strike-through nil :box nil :underline nil :overline nil :extend nil))) - `(modus-themes-search-success ((,class :inherit ,@(modus-themes--deuteran - 'modus-themes-intense-blue - 'modus-themes-intense-green)))) - `(modus-themes-search-success-lazy ((,class :inherit ,@(modus-themes--deuteran - 'modus-themes-special-mild - 'modus-themes-refine-cyan)))) - `(modus-themes-search-success-modeline ((,class :foreground ,@(modus-themes--deuteran - blue-active - green-active)))) - `(modus-themes-slant ((,class :inherit italic :slant ,@(modus-themes--slant)))) - `(modus-themes-ui-variable-pitch ((,class ,@(modus-themes--variable-pitch-ui)))) - `(modus-themes-fixed-pitch ((,class ,@(modus-themes--fixed-pitch)))) - `(modus-themes-markup-verbatim ((,class :inherit modus-themes-fixed-pitch - ,@(modus-themes--markup fg-special-calm magenta-alt - bg-alt magenta-nuanced-bg)))) ;;;; standard faces ;;;;; absolute essentials `(default ((,class :background ,bg-main :foreground ,fg-main))) @@ -4290,28 +4419,31 @@ by virtue of calling either of `modus-themes-load-operandi' and `(bold ((,class :weight bold))) `(bold-italic ((,class :inherit (bold italic)))) `(buffer-menu-buffer ((,class :inherit bold))) + `(child-frame-border ((,class :background ,fg-window-divider-inner))) `(comint-highlight-input ((,class :inherit bold))) `(comint-highlight-prompt ((,class :inherit modus-themes-prompt))) `(confusingly-reordered ((,class :inherit modus-themes-lang-error))) + `(elisp-shorthand-font-lock-face ((,class :inherit font-lock-variable-name-face))) `(error ((,class :inherit bold :foreground ,red))) `(escape-glyph ((,class :foreground ,fg-escape-char-construct))) `(file-name-shadow ((,class :inherit (shadow italic)))) `(header-line ((,class :inherit modus-themes-ui-variable-pitch :background ,bg-header :foreground ,fg-header))) - `(header-line-highlight ((,class :inherit modus-themes-active-blue))) + `(header-line-highlight ((,class :inherit highlight))) `(help-argument-name ((,class :inherit modus-themes-slant :foreground ,cyan))) - `(help-key-binding ((,class :box (:line-width (-1 . -1) :color ,bg-active) ; NOTE: box syntax is for Emacs28 - :background ,bg-alt))) + `(help-key-binding ((,class :inherit modus-themes-key-binding))) `(homoglyph ((,class :foreground ,red-alt-faint))) `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other-faint))) `(italic ((,class :slant italic))) `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct))) `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t))) + `(menu ((,class :inverse-video unspecified :inherit modus-themes-intense-neutral))) `(minibuffer-prompt ((,class :inherit modus-themes-prompt))) `(mm-command-output ((,class :foreground ,red-alt-other))) `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild))) `(next-error ((,class :inherit modus-themes-subtle-red :extend t))) - `(rectangle-preview ((,class :inherit modus-themes-special-mild))) + `(pgtk-im-0 ((,class :inherit modus-themes-fringe-blue :underline t))) + `(rectangle-preview ((,class :background ,bg-special-faint-warm :foreground ,fg-special-warm))) `(region ((,class ,@(modus-themes--region bg-region fg-main bg-hl-alt-intense bg-region-accent bg-region-accent-subtle)))) @@ -4332,7 +4464,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(widget-button ((,class :inherit bold :foreground ,blue-alt))) `(widget-button-pressed ((,class :inherit widget-button :foreground ,magenta))) `(widget-documentation ((,class :foreground ,green))) - `(widget-field ((,class :background ,bg-alt :foreground ,fg-dim))) + `(widget-field ((,class :background ,bg-alt :foreground ,fg-main :extend nil))) `(widget-inactive ((,class :inherit shadow :background ,bg-dim))) `(widget-single-line-field ((,class :inherit widget-field))) ;;;;; alert @@ -4342,41 +4474,47 @@ by virtue of calling either of `modus-themes-load-operandi' and `(alert-trivial-face ((,class :foreground ,fg-special-calm))) `(alert-urgent-face ((,class :inherit bold :foreground ,red-intense))) ;;;;; all-the-icons - `(all-the-icons-blue ((,class :foreground ,blue))) + `(all-the-icons-blue ((,class :foreground ,blue-alt-other))) `(all-the-icons-blue-alt ((,class :foreground ,blue-alt))) - `(all-the-icons-cyan ((,class :foreground ,cyan))) + `(all-the-icons-cyan ((,class :foreground ,cyan-intense))) `(all-the-icons-cyan-alt ((,class :foreground ,cyan-alt))) - `(all-the-icons-dblue ((,class :foreground ,blue-alt-other))) - `(all-the-icons-dcyan ((,class :foreground ,cyan-alt-other))) - `(all-the-icons-dgreen ((,class :foreground ,green-alt-other))) - `(all-the-icons-dired-dir-face ((,class :foreground ,blue))) - `(all-the-icons-dmaroon ((,class :foreground ,magenta-alt-other))) - `(all-the-icons-dorange ((,class :foreground ,red-alt-other))) - `(all-the-icons-dpink ((,class :foreground ,magenta))) - `(all-the-icons-dpurple ((,class :foreground ,magenta-alt))) - `(all-the-icons-dred ((,class :foreground ,red))) - `(all-the-icons-dsilver ((,class :foreground ,fg-special-cold))) - `(all-the-icons-dyellow ((,class :foreground ,yellow))) - `(all-the-icons-green ((,class :foreground ,green))) - `(all-the-icons-lblue ((,class :foreground ,blue-refine-fg))) - `(all-the-icons-lcyan ((,class :foreground ,cyan-refine-fg))) - `(all-the-icons-lgreen ((,class :foreground ,green-refine-fg))) - `(all-the-icons-lmaroon ((,class :foreground ,magenta-refine-fg))) - `(all-the-icons-lorange ((,class :foreground ,red-refine-fg))) - `(all-the-icons-lpink ((,class :foreground ,magenta-refine-fg))) - `(all-the-icons-lpurple ((,class :foreground ,magenta-refine-fg))) - `(all-the-icons-lred ((,class :foreground ,red-refine-fg))) - `(all-the-icons-lsilver ((,class :foreground ,fg-special-cold))) - `(all-the-icons-lyellow ((,class :foreground ,yellow-refine-fg))) - `(all-the-icons-maroon ((,class :foreground ,magenta))) - `(all-the-icons-orange ((,class :foreground ,red-alt))) - `(all-the-icons-pink ((,class :foreground ,magenta))) - `(all-the-icons-purple ((,class :foreground ,magenta-alt))) - `(all-the-icons-purple-alt ((,class :foreground ,magenta-alt-other))) - `(all-the-icons-red ((,class :foreground ,red))) - `(all-the-icons-red-alt ((,class :foreground ,red-alt))) + `(all-the-icons-dblue ((,class :foreground ,blue-faint))) + `(all-the-icons-dcyan ((,class :foreground ,cyan-faint))) + `(all-the-icons-dgreen ((,class :foreground ,green))) + `(all-the-icons-dmaroon ((,class :foreground ,magenta-alt-faint))) + `(all-the-icons-dorange ((,class :foreground ,red-alt-faint))) + `(all-the-icons-dpink ((,class :foreground ,magenta-faint))) + `(all-the-icons-dpurple ((,class :foreground ,magenta-alt-other-faint))) + `(all-the-icons-dred ((,class :foreground ,red-faint))) + `(all-the-icons-dsilver ((,class :foreground ,cyan-alt-faint))) + `(all-the-icons-dyellow ((,class :foreground ,yellow-alt-faint))) + `(all-the-icons-green ((,class :foreground ,green-intense))) + `(all-the-icons-lblue ((,class :foreground ,blue-alt-other))) + `(all-the-icons-lcyan ((,class :foreground ,cyan))) + `(all-the-icons-lgreen ((,class :foreground ,green-alt-other))) + `(all-the-icons-lmaroon ((,class :foreground ,magenta-alt))) + `(all-the-icons-lorange ((,class :foreground ,red-alt))) + `(all-the-icons-lpink ((,class :foreground ,magenta))) + `(all-the-icons-lpurple ((,class :foreground ,magenta-faint))) + `(all-the-icons-lred ((,class :foreground ,red))) + `(all-the-icons-lsilver ((,class :foreground ,fg-docstring))) + `(all-the-icons-lyellow ((,class :foreground ,yellow-alt))) + `(all-the-icons-maroon ((,class :foreground ,magenta-intense))) + `(all-the-icons-orange ((,class :foreground ,orange-intense))) + `(all-the-icons-pink ((,class :foreground ,fg-special-calm))) + `(all-the-icons-purple ((,class :foreground ,magenta-alt-other))) + `(all-the-icons-purple-alt ((,class :foreground ,purple-intense))) + `(all-the-icons-red ((,class :foreground ,red-intense))) + `(all-the-icons-red-alt ((,class :foreground ,red-alt-other))) `(all-the-icons-silver ((,class :foreground ,fg-special-cold))) `(all-the-icons-yellow ((,class :foreground ,yellow))) +;;;;; all-the-icons-dired + `(all-the-icons-dired-dir-face ((,class :foreground ,cyan-faint))) +;;;;; all-the-icons-ibuffer + `(all-the-icons-ibuffer-dir-face ((,class :foreground ,cyan-faint))) + `(all-the-icons-ibuffer-file-face ((,class :foreground ,blue-faint))) + `(all-the-icons-ibuffer-mode-face ((,class :foreground ,cyan))) + `(all-the-icons-ibuffer-size-face ((,class :foreground ,cyan-alt-other))) ;;;;; annotate `(annotate-annotation ((,class :inherit modus-themes-subtle-blue))) `(annotate-annotation-secondary ((,class :inherit modus-themes-subtle-green))) @@ -4430,12 +4568,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(font-latex-italic-face ((,class :inherit italic))) `(font-latex-math-face ((,class :inherit font-lock-constant-face))) `(font-latex-script-char-face ((,class :inherit font-lock-builtin-face))) - `(font-latex-sectioning-0-face ((,class :inherit modus-themes-heading-1))) - `(font-latex-sectioning-1-face ((,class :inherit modus-themes-heading-2))) - `(font-latex-sectioning-2-face ((,class :inherit modus-themes-heading-3))) - `(font-latex-sectioning-3-face ((,class :inherit modus-themes-heading-4))) - `(font-latex-sectioning-4-face ((,class :inherit modus-themes-heading-5))) - `(font-latex-sectioning-5-face ((,class :inherit modus-themes-heading-6))) + `(font-latex-sectioning-5-face ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,blue-nuanced-fg))) `(font-latex-sedate-face ((,class :inherit font-lock-keyword-face))) `(font-latex-slide-title-face ((,class :inherit modus-themes-heading-1))) `(font-latex-string-face ((,class :inherit font-lock-string-face))) @@ -4617,6 +4750,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(lui-button-face ((,class :inherit button))) `(lui-highlight-face ((,class :foreground ,magenta-alt))) `(lui-time-stamp-face ((,class :foreground ,blue-nuanced-fg))) +;;;;; citar + `(citar ((,class :inherit shadow))) + `(citar-highlight (( ))) ;;;;; color-rg `(color-rg-font-lock-column-number ((,class :foreground ,magenta-alt-other))) `(color-rg-font-lock-command ((,class :inherit bold :foreground ,fg-main))) @@ -4656,23 +4792,23 @@ by virtue of calling either of `modus-themes-load-operandi' and `(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))) `(company-posframe-metadata ((,class :background ,bg-inactive :foreground ,fg-inactive))) -;;;;; compilation feedback - `(compilation-column-number ((,class :foreground ,magenta-alt-other))) +;;;;; compilation + `(compilation-column-number ((,class :inherit compilation-line-number))) `(compilation-error ((,class :inherit modus-themes-bold :foreground ,red))) `(compilation-info ((,class :inherit modus-themes-bold :foreground ,fg-special-cold))) `(compilation-line-number ((,class :foreground ,fg-special-warm))) - `(compilation-mode-line-exit ((,class :inherit modus-themes-bold :foreground ,blue-active))) + `(compilation-mode-line-exit ((,class :inherit bold))) `(compilation-mode-line-fail ((,class :inherit modus-themes-bold :foreground ,red-active))) - `(compilation-mode-line-run ((,class :inherit modus-themes-bold :foreground ,magenta-active))) - `(compilation-warning ((,class :inherit modus-themes-bold :foreground ,yellow))) + `(compilation-mode-line-run ((,class :inherit modus-themes-bold :foreground ,cyan-active))) + `(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 blue-nuanced-bg + 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 blue-nuanced-bg + magenta-alt bg-special-calm fg-special-calm magenta-intense-bg fg-main)))) ;;;;; consult `(consult-async-running ((,class :inherit bold :foreground ,blue))) @@ -4736,12 +4872,9 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; cursor-flash `(cursor-flash-face ((,class :inherit modus-themes-intense-blue))) ;;;;; custom (M-x customize) - `(custom-button ((,class :box (:line-width 2 :color nil :style released-button) - :background ,bg-active :foreground ,fg-main))) - `(custom-button-mouse ((,class :box (:line-width 2 :color nil :style released-button) - :background ,bg-active :foreground ,fg-active))) - `(custom-button-pressed ((,class :box (:line-width 2 :color nil :style pressed-button) - :background ,bg-active :foreground ,fg-main))) + `(custom-button ((,class :inherit modus-themes-box-button))) + `(custom-button-mouse ((,class :inherit (highlight custom-button)))) + `(custom-button-pressed ((,class :inherit modus-themes-box-button-pressed))) `(custom-changed ((,class :inherit modus-themes-subtle-cyan))) `(custom-comment ((,class :inherit shadow))) `(custom-comment-tag ((,class :background ,bg-alt :foreground ,yellow-alt-other))) @@ -4752,9 +4885,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(custom-modified ((,class :inherit modus-themes-subtle-cyan))) `(custom-rogue ((,class :inherit modus-themes-refine-magenta))) `(custom-set ((,class :foreground ,blue-alt))) - `(custom-state ((,class :foreground ,cyan-alt-other))) + `(custom-state ((,class :foreground ,red-alt-faint))) `(custom-themed ((,class :inherit modus-themes-subtle-blue))) - `(custom-variable-tag ((,class :inherit bold :foreground ,cyan))) + `(custom-variable-tag ((,class :foreground ,cyan))) ;;;;; dap-mode `(dap-mouse-eval-thing-face ((,class :box (:line-width -1 :color ,blue-active :style nil) :background ,bg-active :foreground ,fg-main))) @@ -5032,7 +5165,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(el-search-occur-match ((,class :inherit modus-themes-special-calm))) ;;;;; eldoc ;; NOTE: see https://github.com/purcell/package-lint/issues/187 - (list 'eldoc-highlight-function-argument `((,class :inherit bold :foreground ,blue-alt-other))) + (list 'eldoc-highlight-function-argument `((,class :inherit bold + :background ,yellow-nuanced-bg + :foreground ,yellow-alt-other))) ;;;;; eldoc-box `(eldoc-box-body ((,class :background ,bg-alt :foreground ,fg-main))) `(eldoc-box-border ((,class :background ,fg-alt))) @@ -5045,10 +5180,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(elfeed-search-date-face ((,class :foreground ,cyan))) `(elfeed-search-feed-face ((,class :foreground ,blue-faint))) `(elfeed-search-filter-face ((,class :inherit bold :foreground ,magenta-active))) - `(elfeed-search-last-update-face ((,class :foreground ,cyan-active))) - `(elfeed-search-tag-face ((,class :foreground ,cyan-alt-other))) + `(elfeed-search-last-update-face ((,class :inherit bold :foreground ,cyan-active))) + `(elfeed-search-tag-face ((,class :foreground ,magenta-alt-faint))) `(elfeed-search-title-face ((,class :foreground ,fg-dim))) - `(elfeed-search-unread-count-face ((,class :foreground ,green-active))) + `(elfeed-search-unread-count-face ((,class :inherit bold :foreground ,fg-active))) `(elfeed-search-unread-title-face ((,class :inherit bold :foreground ,fg-main))) ;;;;; elfeed-score `(elfeed-score-date-face ((,class :foreground ,blue))) @@ -5061,7 +5196,19 @@ 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-key-binding))) + `(embark-keybinding ((,class :inherit modus-themes-completion-key-binding))) +;;;;; ement (ement.el) + `(ement-room-fully-read-marker ((,class :background ,cyan-subtle-bg))) + `(ement-room-membership ((,class :inherit shadow))) + `(ement-room-mention (( ))) + `(ement-room-name ((,class :inherit bold))) + `(ement-room-reactions ((,class :inherit shadow))) + `(ement-room-read-receipt-marker ((,class :background ,yellow-subtle-bg))) + `(ement-room-self ((,class :inherit bold :foreground ,magenta))) + `(ement-room-self-message ((,class :foreground ,magenta-faint))) + `(ement-room-timestamp ((,class :inherit shadow))) + `(ement-room-timestamp-header ((,class :inherit bold :foreground ,cyan))) + `(ement-room-user ((,class :inherit bold :foreground ,blue))) ;;;;; emms `(emms-browser-album-face ((,class :foreground ,magenta-alt-other))) `(emms-browser-artist-face ((,class :foreground ,cyan))) @@ -5239,10 +5386,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(eww-form-checkbox ((,class :inherit eww-form-text))) `(eww-form-file ((,class :inherit eww-form-submit))) `(eww-form-select ((,class :inherit eww-form-submit))) - `(eww-form-submit ((,class :box (:line-width 2 :style released-button) - :background ,bg-active))) - `(eww-form-text ((,class :box ,bg-active :background ,bg-alt))) - `(eww-form-textarea ((,class :background ,bg-alt))) + `(eww-form-submit ((,class :inherit modus-themes-box-button))) + `(eww-form-text ((,class :inherit widget-field))) + `(eww-form-textarea ((,class :inherit eww-form-text))) ;;;;; eyebrowse `(eyebrowse-mode-line-active ((,class :inherit bold :foreground ,blue-active))) ;;;;; fancy-dabbrev @@ -5295,11 +5441,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(flyspell-incorrect ((,class :inherit modus-themes-lang-error))) ;;;;; flx `(flx-highlight-face ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-magenta 'modus-themes-intense-magenta - 'modus-themes-nuanced-magenta - magenta-alt - 'bold)))) + 'modus-themes-subtle-magenta + 'modus-themes-special-calm)))) ;;;;; freeze-it `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm))) ;;;;; frog-menu @@ -5346,17 +5490,17 @@ by virtue of calling either of `modus-themes-load-operandi' and `(font-lock-regexp-grouping-backslash ((,class :inherit bold ,@(modus-themes--syntax-string fg-escape-char-backslash yellow-alt-faint - yellow magenta-alt - yellow-faint red-faint)))) + yellow-alt magenta-alt + red-faint green-alt-other-faint)))) `(font-lock-regexp-grouping-construct ((,class :inherit bold ,@(modus-themes--syntax-string fg-escape-char-construct red-alt-other-faint - blue blue-alt-other + red-alt-other blue-alt-other blue-faint blue-alt-other-faint)))) `(font-lock-string-face ((,class ,@(modus-themes--syntax-string blue-alt blue-alt-faint - green red - green-faint red-faint)))) + green-alt-other red-alt + green-alt-faint red-alt-faint)))) `(font-lock-type-face ((,class :inherit modus-themes-bold ,@(modus-themes--syntax-foreground cyan-alt-other cyan-alt-faint)))) @@ -5395,8 +5539,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(fountain-synopsis ((,class :foreground ,cyan-alt))) `(fountain-trans ((,class :foreground ,yellow-alt-other))) ;;;;; geiser - `(geiser-font-lock-autodoc-current-arg ((,class :inherit font-lock-function-name-face))) - `(geiser-font-lock-autodoc-identifier ((,class :inherit font-lock-constant-face))) + `(geiser-font-lock-autodoc-current-arg ((,class :inherit bold + :background ,yellow-nuanced-bg + :foreground ,yellow-alt-other))) + `(geiser-font-lock-autodoc-identifier ((,class :foreground ,cyan))) `(geiser-font-lock-doc-button ((,class :inherit button :foreground ,fg-docstring))) `(geiser-font-lock-doc-link ((,class :inherit button))) `(geiser-font-lock-error-link ((,class :inherit button :foreground ,red))) @@ -5550,10 +5696,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(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-subtle-red 'modus-themes-intense-red - 'modus-themes-nuanced-red - red)))) + 'modus-themes-subtle-red + 'modus-themes-special-warm)))) `(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))) @@ -5565,19 +5710,16 @@ by virtue of calling either of `modus-themes-load-operandi' and `(helm-ff-pipe ((,class ,@(modus-themes--extra-completions 'modus-themes-refine-magenta 'modus-themes-subtle-magenta - 'modus-themes-nuanced-magenta - magenta)))) + 'modus-themes-special-calm)))) `(helm-ff-prefix ((,class ,@(modus-themes--extra-completions 'modus-themes-refine-yellow 'modus-themes-subtle-yellow - 'modus-themes-nuanced-yellow - yellow-alt-other)))) + 'modus-themes-special-warm)))) `(helm-ff-socket ((,class :foreground ,red-alt-other))) `(helm-ff-suid ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-red 'modus-themes-refine-red - 'modus-themes-nuanced-yellow - red-alt)))) + 'modus-themes-subtle-red + '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))) @@ -5589,57 +5731,39 @@ by virtue of calling either of `modus-themes-load-operandi' and `(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-subtle-red 'modus-themes-intense-red - 'modus-themes-nuanced-red - red - 'bold)))) + 'modus-themes-subtle-red + 'modus-themes-special-warm)))) `(helm-history-remote ((,class :foreground ,red-alt-other))) - `(helm-lisp-completion-info ((,class :foreground ,fg-special-warm))) + `(helm-lisp-completion-info ((,class :inherit compilation-info))) `(helm-lisp-show-completion ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-yellow 'modus-themes-refine-yellow - 'modus-themes-nuanced-yellow - yellow - 'bold)))) - `(helm-locate-finish ((,class :foreground ,green-active))) + 'modus-themes-subtle-yellow + 'modus-themes-special-warm)))) + `(helm-locate-finish ((,class :inherit success))) `(helm-match ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-cyan 'modus-themes-refine-cyan - 'modus-themes-nuanced-cyan - cyan - 'bold)))) - `(helm-match-item ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-neutral - 'modus-themes-subtle-cyan - 'modus-themes-nuanced-cyan - cyan-alt-other)))) + 'modus-themes-subtle-cyan + 'modus-themes-special-mild)))) + `(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-subtle-magenta 'modus-themes-intense-magenta - 'modus-themes-nuanced-magenta - magenta-alt - 'bold)))) + 'modus-themes-subtle-magenta + '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-subtle-magenta 'modus-themes-refine-magenta - 'modus-themes-nuanced-magenta - magenta-alt-other)))) - `(helm-selection ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-blue - 'modus-themes-refine-blue - 'modus-themes-special-cold - nil - 'bold)))) + '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-separator ((,class :foreground ,fg-special-mild))) `(helm-time-zone-current ((,class :foreground ,green))) `(helm-time-zone-home ((,class :foreground ,magenta))) - `(helm-source-header ((,class :inherit modus-themes-pseudo-header :foreground ,fg-special-cold))) + `(helm-source-header ((,class :inherit modus-themes-pseudo-header :foreground ,fg-special-warm))) `(helm-top-columns ((,class :inherit helm-header))) `(helm-ucs-char ((,class :foreground ,yellow-alt-other))) `(helm-visible-mark ((,class :inherit modus-themes-subtle-cyan))) @@ -5655,14 +5779,11 @@ by virtue of calling either of `modus-themes-load-operandi' and `(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-subtle-magenta 'modus-themes-refine-magenta - 'modus-themes-nuanced-magenta - magenta-alt-other - 'bold)))) + 'modus-themes-subtle-magenta + 'modus-themes-nuanced-magenta)))) ;;;;; helm-xref - `(helm-xref-file-name ((,class :inherit bold :foreground ,fg-special-cold))) - `(helm-xref-file-name ((,class :foreground ,fg-special-warm))) + `(helm-xref-file-name ((,class :inherit compilation-info))) ;;;;; helpful `(helpful-heading ((,class :inherit modus-themes-heading-1))) ;;;;; highlight region or ad-hoc regexp @@ -5678,7 +5799,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(hi-red-b ((,class :inherit bold :background ,red-intense-bg :foreground ,fg-main))) `(hi-salmon ((,class :background ,red-subtle-bg :foreground ,fg-main))) `(hi-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-main))) - `(highlight ((,class :background ,blue-subtle-bg :foreground ,fg-main))) + `(highlight ((,class :background ,cyan-subtle-bg :foreground ,fg-main))) `(highlight-changes ((,class :foreground ,red-alt :underline nil))) `(highlight-changes-delete ((,class :background ,red-nuanced-bg :foreground ,red :underline t))) @@ -5705,27 +5826,15 @@ 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 bold - ,@(modus-themes--standard-completions - magenta bg-alt - bg-active fg-main)))) - `(icomplete-selected-match ((,class :inherit bold :foreground ,fg-main - :background ,@(pcase modus-themes-completions - ('opinionated (list bg-active)) - (_ (list bg-inactive)))))) + `(icomplete-first-match ((,class :inherit modus-themes-completion-standard-first-match))) + `(icomplete-selected-match ((,class :inherit modus-themes-completion-standard-selected))) ;;;;; icomplete-vertical `(icomplete-vertical-separator ((,class :inherit shadow))) ;;;;; ido-mode - `(ido-first-match ((,class :inherit bold - ,@(modus-themes--standard-completions - magenta bg-alt - bg-active fg-main)))) + `(ido-first-match ((,class :inherit modus-themes-completion-standard-first-match))) `(ido-incomplete-regexp ((,class :inherit error))) `(ido-indicator ((,class :inherit modus-themes-subtle-yellow))) - `(ido-only-match ((,class :inherit bold - ,@(modus-themes--standard-completions - green green-nuanced-bg - green-intense-bg fg-main)))) + `(ido-only-match ((,class :inherit ido-first-match))) `(ido-subdir ((,class :foreground ,blue))) `(ido-virtual ((,class :foreground ,fg-special-warm))) ;;;;; iedit @@ -5759,7 +5868,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(info-header-node ((,class :inherit (shadow bold)))) `(info-header-xref ((,class :foreground ,blue-active))) `(info-index-match ((,class :inherit match))) - `(info-menu-header ((,class :inherit modus-themes-heading-3))) + `(info-menu-header ((,class :inherit modus-themes-pseudo-header))) `(info-menu-star ((,class :foreground ,red))) `(info-node ((,class :inherit bold))) `(info-title-1 ((,class :inherit modus-themes-heading-1))) @@ -5803,62 +5912,32 @@ by virtue of calling either of `modus-themes-load-operandi' and `(match ((,class :inherit modus-themes-special-calm))) `(query-replace ((,class :inherit (modus-themes-intense-yellow bold)))) ;;;;; ivy - `(ivy-action ((,class :inherit bold :foreground ,red-alt))) - `(ivy-completions-annotations ((,class :inherit completions-annotations))) - `(ivy-confirm-face ((,class :foreground ,cyan))) - `(ivy-current-match ((,class ,@(modus-themes--extra-completions - 'modus-themes-refine-cyan - 'modus-themes-intense-cyan - 'modus-themes-special-cold - nil - 'bold)))) + `(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-cursor ((,class :background ,fg-main :foreground ,bg-main))) - `(ivy-grep-info ((,class :foreground ,cyan-alt))) - `(ivy-grep-line-number ((,class :foreground ,fg-special-warm))) `(ivy-highlight-face ((,class :foreground ,magenta))) `(ivy-match-required-face ((,class :inherit error))) - `(ivy-minibuffer-match-face-1 ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-neutral - 'modus-themes-intense-neutral - 'modus-themes-nuanced-cyan - fg-alt)))) + `(ivy-minibuffer-match-face-1 ((,class :inherit modus-themes-subtle-neutral))) `(ivy-minibuffer-match-face-2 ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-green 'modus-themes-refine-green - 'modus-themes-nuanced-green - green-alt-other - 'bold)))) + 'modus-themes-subtle-green + 'modus-themes-special-mild)))) `(ivy-minibuffer-match-face-3 ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-blue 'modus-themes-refine-blue - 'modus-themes-nuanced-blue - blue-alt-other - 'bold)))) + 'modus-themes-subtle-blue + 'modus-themes-special-cold)))) `(ivy-minibuffer-match-face-4 ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-magenta 'modus-themes-refine-magenta - 'modus-themes-nuanced-magenta - magenta-alt-other - 'bold)))) - `(ivy-minibuffer-match-highlight ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-cyan - 'modus-themes-intense-cyan - 'modus-themes-nuanced-cyan - cyan-alt-other - 'bold)))) + '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 ,yellow-alt))) + `(ivy-modified-outside-buffer ((,class :inherit modus-themes-slant :foreground ,red-alt))) `(ivy-org ((,class :foreground ,cyan-alt-other))) - `(ivy-prompt-match ((,class :inherit ivy-current-match))) `(ivy-remote ((,class :foreground ,magenta))) `(ivy-separator ((,class :inherit shadow))) - `(ivy-subdir ((,class :foreground ,blue-alt-other))) + `(ivy-subdir ((,class :foreground ,blue))) `(ivy-virtual ((,class :foreground ,magenta-alt-other))) - `(ivy-yanked-word ((,class ,@(modus-themes--extra-completions - 'modus-themes-subtle-blue - 'modus-themes-refine-blue - 'modus-themes-nuanced-blue - blue-alt)))) ;;;;; ivy-posframe `(ivy-posframe ((,class :background ,bg-dim :foreground ,fg-main))) `(ivy-posframe-border ((,class :background ,fg-window-divider-inner))) @@ -5910,7 +5989,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(kaocha-runner-warning-face ((,class :inherit warning))) ;;;;; keycast `(keycast-command ((,class :inherit bold :foreground ,blue-active))) - `(keycast-key ((,class :background ,blue-active :foreground ,bg-main))) + `(keycast-key ((,class ,@(modus-themes--mode-line-padded-box blue-active) + :background ,blue-active :foreground ,bg-main))) ;;;;; ledger-mode `(ledger-font-auto-xact-face ((,class :foreground ,magenta))) `(ledger-font-account-name-face ((,class :foreground ,fg-special-cold))) @@ -5992,9 +6072,9 @@ by virtue of calling either of `modus-themes-load-operandi' and `(macrostep-gensym-5 ((,class :inherit bold :foreground ,magenta :box t))) `(macrostep-macro-face ((,class :inherit button :foreground ,green-alt))) ;;;;; magit - `(magit-bisect-bad ((,class :foreground ,red-alt-other))) - `(magit-bisect-good ((,class :foreground ,green-alt-other))) - `(magit-bisect-skip ((,class :foreground ,yellow-alt-other))) + `(magit-bisect-bad ((,class :inherit error))) + `(magit-bisect-good ((,class :inherit success))) + `(magit-bisect-skip ((,class :inherit warning))) `(magit-blame-date ((,class :foreground ,blue))) `(magit-blame-dimmed ((,class :inherit (shadow modus-themes-reset-hard)))) `(magit-blame-hash ((,class :foreground ,fg-special-warm))) @@ -6073,19 +6153,19 @@ by virtue of calling either of `modus-themes-load-operandi' and `(magit-log-author ((,class :foreground ,cyan))) `(magit-log-date ((,class :inherit shadow))) `(magit-log-graph ((,class :foreground ,fg-dim))) - `(magit-mode-line-process ((,class :inherit bold :foreground ,blue-active))) + `(magit-mode-line-process ((,class :inherit bold :foreground ,cyan-active))) `(magit-mode-line-process-error ((,class :inherit bold :foreground ,red-active))) `(magit-process-ng ((,class :inherit error))) `(magit-process-ok ((,class :inherit success))) - `(magit-reflog-amend ((,class :background ,bg-main :foreground ,magenta-intense))) - `(magit-reflog-checkout ((,class :background ,bg-main :foreground ,blue-intense))) - `(magit-reflog-cherry-pick ((,class :background ,bg-main :foreground ,green-intense))) - `(magit-reflog-commit ((,class :background ,bg-main :foreground ,green-intense))) - `(magit-reflog-merge ((,class :background ,bg-main :foreground ,green-intense))) - `(magit-reflog-other ((,class :background ,bg-main :foreground ,cyan-intense))) - `(magit-reflog-rebase ((,class :background ,bg-main :foreground ,magenta-intense))) - `(magit-reflog-remote ((,class :background ,bg-main :foreground ,cyan-intense))) - `(magit-reflog-reset ((,class :background ,bg-main :foreground ,red-intense))) + `(magit-reflog-amend ((,class :inherit warning))) + `(magit-reflog-checkout ((,class :inherit bold :foreground ,blue-alt))) + `(magit-reflog-cherry-pick ((,class :inherit success))) + `(magit-reflog-commit ((,class :inherit bold))) + `(magit-reflog-merge ((,class :inherit success))) + `(magit-reflog-other ((,class :inherit bold :foreground ,cyan))) + `(magit-reflog-rebase ((,class :inherit bold :foreground ,magenta))) + `(magit-reflog-remote ((,class :inherit bold :foreground ,magenta-alt-other))) + `(magit-reflog-reset ((,class :inherit error))) `(magit-refname ((,class :inherit shadow))) `(magit-refname-pullreq ((,class :inherit shadow))) `(magit-refname-stash ((,class :inherit shadow))) @@ -6094,21 +6174,21 @@ by virtue of calling either of `modus-themes-load-operandi' and `(magit-section-heading ((,class :inherit bold :foreground ,cyan))) `(magit-section-heading-selection ((,class :inherit (modus-themes-refine-cyan bold)))) `(magit-section-highlight ((,class :background ,bg-alt))) - `(magit-sequence-done ((,class :inherit modus-themes-grue))) - `(magit-sequence-drop ((,class :foreground ,red-alt))) - `(magit-sequence-exec ((,class :foreground ,magenta-alt))) - `(magit-sequence-head ((,class :foreground ,cyan-alt))) - `(magit-sequence-onto ((,class :inherit shadow))) - `(magit-sequence-part ((,class :foreground ,yellow-alt))) - `(magit-sequence-pick ((,class :foreground ,blue-alt))) - `(magit-sequence-stop ((,class :foreground ,red))) - `(magit-signature-bad ((,class :inherit bold :foreground ,red))) - `(magit-signature-error ((,class :foreground ,red-alt))) - `(magit-signature-expired ((,class :foreground ,yellow))) + `(magit-sequence-done ((,class :inherit success))) + `(magit-sequence-drop ((,class :inherit error))) + `(magit-sequence-exec ((,class :inherit bold :foreground ,magenta-alt))) + `(magit-sequence-head ((,class :inherit bold :foreground ,cyan-alt))) + `(magit-sequence-onto ((,class :inherit (bold shadow)))) + `(magit-sequence-part ((,class :inherit warning))) + `(magit-sequence-pick ((,class :inherit bold))) + `(magit-sequence-stop ((,class :inherit error))) + `(magit-signature-bad ((,class :inherit error))) + `(magit-signature-error ((,class :inherit error))) + `(magit-signature-expired ((,class :inherit warning))) `(magit-signature-expired-key ((,class :foreground ,yellow))) - `(magit-signature-good ((,class :inherit modus-themes-grue))) - `(magit-signature-revoked ((,class :foreground ,magenta))) - `(magit-signature-untrusted ((,class :foreground ,cyan))) + `(magit-signature-good ((,class :inherit success))) + `(magit-signature-revoked ((,class :inherit bold :foreground ,magenta))) + `(magit-signature-untrusted ((,class :inherit (bold shadow)))) `(magit-tag ((,class :foreground ,yellow-alt-other))) ;;;;; magit-imerge `(magit-imerge-overriding-value ((,class :inherit bold :foreground ,red-alt))) @@ -6116,9 +6196,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(makefile-makepp-perl ((,class :background ,cyan-nuanced-bg))) `(makefile-space ((,class :background ,magenta-nuanced-bg))) ;;;;; man - `(Man-overstrike ((,class :inherit bold :foreground ,magenta))) + `(Man-overstrike ((,class :inherit bold :foreground ,fg-special-calm))) `(Man-reverse ((,class :inherit modus-themes-subtle-magenta))) - `(Man-underline ((,class :foreground ,cyan :underline t))) ;;;;; marginalia `(marginalia-archive ((,class :foreground ,cyan-alt-other))) `(marginalia-char ((,class :foreground ,magenta))) @@ -6134,14 +6213,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(marginalia-file-priv-rare ((,class :foreground ,red))) `(marginalia-file-priv-read ((,class :foreground ,fg-main))) `(marginalia-file-priv-write ((,class :foreground ,cyan))) - ;; Here we make an exception of not applying the bespoke - ;; `modus-themes-key-binding' for two reasons: (1) completion - ;; highlights can be fairly intense, so we do not want more - ;; components to compete with them for attention, (2) the - ;; `marginalia-key' may not be used for key bindings specifically, - ;; so we might end up applying styles in places we should not. `(marginalia-function ((,class :foreground ,magenta-alt-faint))) - `(marginalia-key ((,class :foreground ,magenta-alt-other))) + `(marginalia-key ((,class :inherit modus-themes-completion-key-binding))) `(marginalia-lighter ((,class :foreground ,blue-alt))) `(marginalia-list ((,class :foreground ,magenta-alt-other-faint))) `(marginalia-mode ((,class :foreground ,cyan))) @@ -6172,6 +6245,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markdown-header-face-5 ((,class :inherit modus-themes-heading-5))) `(markdown-header-face-6 ((,class :inherit modus-themes-heading-6))) `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm))) + `(markdown-highlighting-face ((,class :inherit modus-themes-refine-yellow))) `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm))) `(markdown-html-attr-name-face ((,class :inherit modus-themes-fixed-pitch :foreground ,cyan))) @@ -6237,6 +6311,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(markup-title-4-face ((,class :inherit modus-themes-heading-5))) `(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))) ;;;;; mentor `(mentor-download-message ((,class :foreground ,fg-special-warm))) `(mentor-download-name ((,class :foreground ,fg-special-cold))) @@ -6248,10 +6324,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(mentor-highlight-face ((,class :inherit modus-themes-subtle-blue))) `(mentor-tracker-name ((,class :foreground ,magenta-alt))) ;;;;; messages - `(message-cited-text-1 ((,class ,@(modus-themes--mail-cite blue-faint fg-alt)))) - `(message-cited-text-2 ((,class ,@(modus-themes--mail-cite green-faint fg-comment-yellow)))) - `(message-cited-text-3 ((,class ,@(modus-themes--mail-cite red-faint fg-special-cold)))) - `(message-cited-text-4 ((,class ,@(modus-themes--mail-cite yellow-faint fg-special-calm)))) + `(message-cited-text-1 ((,class ,@(modus-themes--mail-cite blue-faint blue fg-special-cold)))) + `(message-cited-text-2 ((,class ,@(modus-themes--mail-cite yellow-faint yellow yellow-alt-faint)))) + `(message-cited-text-3 ((,class ,@(modus-themes--mail-cite magenta-alt-faint magenta-alt fg-special-calm)))) + `(message-cited-text-4 ((,class ,@(modus-themes--mail-cite cyan-alt-other-faint cyan-alt-other fg-special-mild)))) `(message-header-cc ((,class :foreground ,blue-alt-other))) `(message-header-name ((,class :inherit bold :foreground ,cyan))) `(message-header-newsgroups ((,class :inherit message-header-other))) @@ -6283,8 +6359,8 @@ by virtue of calling either of `modus-themes-load-operandi' and 'alt-style bg-main)))) `(mode-line-active ((,class :inherit mode-line))) `(mode-line-buffer-id ((,class :inherit bold))) - `(mode-line-emphasis ((,class :inherit bold :foreground ,blue-active))) - `(mode-line-highlight ((,class :inherit modus-themes-active-blue :box (:line-width -1 :style pressed-button)))) + `(mode-line-emphasis ((,class :inherit bold :foreground ,magenta-active))) + `(mode-line-highlight ((,class :inherit highlight))) `(mode-line-inactive ((,class :inherit modus-themes-ui-variable-pitch ,@(modus-themes--mode-line-attrs fg-inactive bg-inactive @@ -6436,19 +6512,19 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; orderless `(orderless-match-face-0 ((,class :inherit bold ,@(modus-themes--standard-completions - blue-alt-other blue-nuanced-bg + 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 magenta-nuanced-bg + 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 green-nuanced-bg + 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 yellow-nuanced-bg + yellow bg-special-warm fg-special-warm yellow-refine-bg yellow-refine-fg)))) ;;;;; org `(org-agenda-calendar-event ((,class ,@(modus-themes--agenda-event blue-alt)))) @@ -6489,10 +6565,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(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))) - `(org-code ((,class :inherit modus-themes-fixed-pitch - ,@(modus-themes--markup fg-special-mild green-alt-other - bg-alt green-nuanced-bg) - :extend t))) + `(org-code ((,class :inherit modus-themes-markup-code :extend t))) `(org-column ((,class :inherit (modus-themes-fixed-pitch default) :background ,bg-alt))) `(org-column-title ((,class :inherit (bold modus-themes-fixed-pitch default) @@ -6515,7 +6588,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-habit-alert-face ((,class ,@(modus-themes--agenda-habit yellow-graph-0-bg yellow-graph-0-bg - yellow-graph-1-bg)))) + yellow-graph-1-bg) + :foreground "black"))) ; special case `(org-habit-alert-future-face ((,class ,@(modus-themes--agenda-habit yellow-graph-1-bg yellow-graph-0-bg @@ -6524,11 +6598,14 @@ by virtue of calling either of `modus-themes-load-operandi' and blue-graph-0-bg green-graph-1-bg blue-graph-1-bg - blue-graph-1-bg)))) + blue-graph-1-bg + blue-graph-1-bg) + :foreground "black"))) ; special case `(org-habit-clear-future-face ((,class ,@(modus-themes--agenda-habit blue-graph-1-bg green-graph-1-bg blue-graph-1-bg + blue-graph-1-bg blue-graph-1-bg)))) `(org-habit-overdue-face ((,class ,@(modus-themes--agenda-habit red-graph-0-bg @@ -6542,12 +6619,17 @@ by virtue of calling either of `modus-themes-load-operandi' and green-graph-0-bg green-graph-0-bg green-graph-1-bg - blue-graph-0-bg)))) + cyan-graph-0-bg + blue-graph-0-bg + cyan-graph-1-bg) + :foreground "black"))) ; special case `(org-habit-ready-future-face ((,class ,@(modus-themes--agenda-habit green-graph-1-bg green-graph-0-bg green-graph-1-bg - blue-graph-0-bg)))) + cyan-graph-1-bg + blue-graph-0-bg + cyan-graph-1-bg)))) `(org-headline-done ((,class :inherit (modus-themes-variable-pitch modus-themes-grue-nuanced)))) `(org-headline-todo ((,class :inherit modus-themes-variable-pitch :foreground ,red-nuanced-fg))) `(org-hide ((,class :foreground ,bg-main))) @@ -6564,9 +6646,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(org-level-8 ((,class :inherit modus-themes-heading-8))) `(org-link ((,class :inherit button))) `(org-list-dt ((,class :inherit bold))) - `(org-macro ((,class :inherit modus-themes-fixed-pitch - ,@(modus-themes--markup cyan-nuanced-fg cyan - cyan-nuanced-bg cyan-nuanced-bg)))) + `(org-macro ((,class :inherit modus-themes-markup-macro))) `(org-meta-line ((,class :inherit (shadow modus-themes-fixed-pitch)))) `(org-mode-line-clock ((,class :foreground ,fg-main))) `(org-mode-line-clock-overrun ((,class :inherit bold :foreground ,red-active))) @@ -6734,6 +6814,10 @@ by virtue of calling either of `modus-themes-load-operandi' and `(prodigy-yellow-face ((,class :inherit warning))) ;;;;; pulse `(pulse-highlight-start-face ((,class :background ,bg-active-accent :extend t))) +;;;;; pyim + `(pyim-page ((,class :background ,bg-active :foreground ,fg-active))) + `(pyim-page-selection ((,class :inherit bold :background ,bg-active :foreground ,blue-active))) + `(pyim-page-subword ((,class :background ,bg-inactive))) ;;;;; quick-peek `(quick-peek-background-face ((,class :background ,bg-alt))) `(quick-peek-border-face ((,class :background ,fg-window-divider-inner :height 1))) @@ -6834,11 +6918,7 @@ 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 bold :foreground ,fg-main - :background ,@(pcase modus-themes-completions - ('opinionated (list bg-active)) - (_ (list bg-inactive)))))) + `(selectrum-current-candidate ((,class :inherit modus-themes-completion-standard-selected))) `(selectrum-mouse-highlight ((,class :inherit highlight))) `(selectrum-quick-keys-highlight ((,class :inherit modus-themes-refine-red))) @@ -6848,12 +6928,12 @@ by virtue of calling either of `modus-themes-load-operandi' and `(selectrum-prescient-primary-highlight ((,class :inherit bold ,@(modus-themes--standard-completions - magenta-alt magenta-nuanced-bg + 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 cyan-nuanced-bg + cyan-alt-other bg-special-cold fg-special-cold cyan-refine-bg cyan-refine-fg)))) ;;;;; semantic `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t))) @@ -6903,6 +6983,33 @@ by virtue of calling either of `modus-themes-load-operandi' and `(sieve-test-commands ((,class :inherit font-lock-function-name-face))) ;;;;; skewer-mode `(skewer-error-face ((,class :foreground ,red :underline t))) +;;;;; slime (sldb) + `(sldb-condition-face ((,class :inherit font-lock-preprocessor-face))) + `(sldb-restart-number-face ((,class :inherit bold))) + `(sldb-restart-type-face ((,class :inherit font-lock-type-face))) + `(sldb-restartable-frame-line-face ((,class :inherit success))) + `(sldb-section-face ((,class :inherit modus-themes-pseudo-header))) + `(slime-error-face ((,class :inherit modus-themes-lang-error))) + `(slime-note-face ((,class :underline t))) + `(slime-repl-input-face ((,class :inherit bold))) + `(slime-repl-inputed-output-face ((,class :inherit font-lock-string-face))) + `(slime-repl-output-mouseover-face ((,class :inherit highlight))) + `(slime-repl-prompt-face ((,class :inherit modus-themes-prompt))) + `(slime-style-warning-face ((,class :inherit modus-themes-lang-note))) + `(slime-warning-face ((,class :inherit modus-themes-lang-warning))) +;;;;; sly + `(sly-action-face ((,class :inherit font-lock-type-face))) + `(sly-db-condition-face ((,class :inherit font-lock-preprocessor-face))) + `(sly-db-restartable-frame-line-face ((,class :inherit success))) + `(sly-error-face ((,class :inherit modus-themes-lang-error))) + `(sly-mode-line ((,class :inherit mode-line-emphasis))) + `(sly-mrepl-output-face ((,class :inherit font-lock-string-face))) + `(sly-mrepl-output-face ((,class :inherit font-lock-string-face))) + `(sly-mrepl-prompt-face ((,class :inherit modus-themes-prompt))) + `(sly-note-face ((,class :inherit modus-themes-lang-note))) + `(sly-stickers-placed-face ((,class :inherit modus-themes-subtle-neutral))) + `(sly-style-warning-face ((,class :inherit modus-themes-lang-note))) + `(sly-warning-face ((,class :inherit modus-themes-lang-warning))) ;;;;; smart-mode-line `(sml/charging ((,class :foreground ,green-active))) `(sml/discharging ((,class :foreground ,red-active))) @@ -7082,6 +7189,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(telega-entity-type-code ((,class :inherit modus-themes-fixed-pitch))) `(telega-entity-type-mention ((,class :foreground ,cyan))) `(telega-entity-type-pre ((,class :inherit modus-themes-fixed-pitch))) + `(telega-entity-type-spoiler ((,class :background ,fg-main :foreground ,fg-main))) `(telega-msg-heading ((,class :background ,bg-alt))) `(telega-msg-self-title ((,class :inherit bold))) `(telega-root-heading ((,class :inherit modus-themes-subtle-neutral))) @@ -7128,6 +7236,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(term-color-white ((,class :background "gray65" :foreground "gray65"))) `(term-color-yellow ((,class :background ,yellow :foreground ,yellow))) `(term-underline ((,class :underline t))) +;;;;; textsec + `(textsec-suspicious ((,class :inherit modus-themes-refine-red))) ;;;;; tomatinho `(tomatinho-ok-face ((,class :foreground ,blue-intense))) `(tomatinho-pause-face ((,class :foreground ,yellow-intense))) @@ -7135,7 +7245,7 @@ by virtue of calling either of `modus-themes-load-operandi' and ;;;;; transient `(transient-active-infix ((,class :inherit modus-themes-special-mild))) `(transient-amaranth ((,class :inherit bold :foreground ,yellow-alt))) - `(transient-argument ((,class :inherit bold :foreground ,green))) + `(transient-argument ((,class :inherit bold :background ,cyan-nuanced-bg :foreground ,cyan))) `(transient-blue ((,class :inherit bold :foreground ,blue))) `(transient-disabled-suffix ((,class :inherit modus-themes-intense-red))) `(transient-enabled-suffix ((,class :inherit modus-themes-grue-background-subtle))) @@ -7146,11 +7256,12 @@ by virtue of calling either of `modus-themes-load-operandi' and `(transient-mismatched-key ((,class :underline t))) `(transient-nonstandard-key ((,class :underline t))) `(transient-pink ((,class :inherit bold :foreground ,magenta-alt-faint))) + `(transient-purple ((,class :inherit bold :foreground ,magenta-alt-other))) `(transient-red ((,class :inherit bold :foreground ,red-faint))) `(transient-teal ((,class :inherit bold :foreground ,cyan-alt-other))) - `(transient-unreachable ((,class :foreground ,fg-unfocused))) - `(transient-unreachable-key ((,class :foreground ,fg-unfocused))) - `(transient-value ((,class :inherit bold :foreground ,magenta-alt-other))) + `(transient-unreachable ((,class :inherit shadow))) + `(transient-unreachable-key ((,class :inherit shadow))) + `(transient-value ((,class :inherit bold :background ,yellow-nuanced-bg :foreground ,yellow-alt-other))) ;;;;; trashed `(trashed-deleted ((,class :inherit modus-themes-mark-del))) `(trashed-directory ((,class :foreground ,blue))) @@ -7237,10 +7348,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 bold :foreground ,fg-main - :background ,@(pcase modus-themes-completions - ('opinionated (list bg-active)) - (_ (list bg-inactive)))))) + `(vertico-current ((,class :inherit modus-themes-completion-standard-selected))) ;;;;; vertico-quick `(vertico-quick1 ((,class :inherit (modus-themes-intense-magenta bold)))) `(vertico-quick2 ((,class :inherit (modus-themes-refine-cyan bold)))) @@ -7365,7 +7473,7 @@ by virtue of calling either of `modus-themes-load-operandi' and `(which-key-local-map-description-face ((,class :foreground ,fg-main))) `(which-key-note-face ((,class :foreground ,fg-special-warm))) `(which-key-separator-face ((,class :inherit shadow))) - `(which-key-special-key-face ((,class :inherit bold :foreground ,orange-intense))) + `(which-key-special-key-face ((,class :inherit bold :foreground ,red-alt))) ;;;;; whitespace-mode `(whitespace-big-indent ((,class :inherit modus-themes-subtle-red))) `(whitespace-empty ((,class :inherit modus-themes-intense-magenta))) @@ -7390,9 +7498,8 @@ by virtue of calling either of `modus-themes-load-operandi' and `(writegood-weasels-face ((,class :inherit modus-themes-lang-error))) ;;;;; woman `(woman-addition ((,class :foreground ,magenta-alt-other))) - `(woman-bold ((,class :inherit bold :foreground ,magenta))) - `(woman-italic ((,class :inherit italic :foreground ,cyan))) - `(woman-unknown ((,class :inherit italic :foreground ,yellow))) + `(woman-bold ((,class :inherit bold :foreground ,fg-special-calm))) + `(woman-unknown ((,class :foreground ,cyan))) ;;;;; xah-elisp-mode `(xah-elisp-at-symbol ((,class :inherit font-lock-warning-face))) `(xah-elisp-cap-variable ((,class :inherit font-lock-preprocessor-face))) diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el index 738753741cf..3e78a6c9598 100644 --- a/etc/themes/modus-vivendi-theme.el +++ b/etc/themes/modus-vivendi-theme.el @@ -1,10 +1,10 @@ -;;; modus-vivendi-theme.el --- Accessible dark theme (WCAG AAA) -*- lexical-binding:t -*- +;;; modus-vivendi-theme.el --- Accessible and customizable dark theme (WCAG AAA) -*- lexical-binding:t -*- -;; Copyright (C) 2019-2022 Free Software Foundation, Inc. +;; Copyright (C) 2019-2022 Free Software Foundation, Inc. ;; Author: Protesilaos Stavrou <info@protesilaos.com> ;; URL: https://gitlab.com/protesilaos/modus-themes -;; Version: 2.0.0 +;; Version: 2.1.0 ;; Package-Requires: ((emacs "27.1")) ;; Keywords: faces, theme, accessibility diff --git a/leim/Makefile.in b/leim/Makefile.in index 2a477d868b3..6cf0abb40ca 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -122,6 +122,7 @@ leim-list.el: ${leimdir}/leim-list.el ${leimdir}/leim-list.el: ${srcdir}/leim-ext.el ${TIT_MISC} $(AM_V_GEN)rm -f $@ $(AM_V_at)${RUN_EMACS} -l international/quail \ + --eval "(setq max-specpdl-size 5000)" \ --eval "(update-leim-list-file (unmsys--file-name \"${leimdir}\"))" $(AM_V_at)sed -n -e '/^[^;]/p' -e 's/^;\(;*\)inc /;\1 /p' < $< >> $@ diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 44328a2b283..214f7435d91 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -475,7 +475,8 @@ PROPS is a list of properties." (defun abbrev-table-p (object) "Return non-nil if OBJECT is an abbrev table." (and (obarrayp object) - (numberp (abbrev-table-get object :abbrev-table-modiff)))) + (numberp (ignore-error 'wrong-type-argument + (abbrev-table-get object :abbrev-table-modiff))))) (defun abbrev-table-empty-p (object &optional ignore-system) "Return nil if there are no abbrev symbols in OBJECT. diff --git a/lisp/align.el b/lisp/align.el index 2279c659b43..b054b1bac47 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -160,7 +160,8 @@ string), this heuristic is used to determine how far before and after point we should search in looking for a region separator. Larger values can mean slower performance in large files, although smaller values may cause unexpected behavior at times." - :type 'integer + :type '(choice (const :tag "Don't use heuristic when aligning a region" nil) + integer) :group 'align) (defcustom align-highlight-change-face 'highlight @@ -176,7 +177,7 @@ values may cause unexpected behavior at times." (defcustom align-large-region 10000 "If an integer, defines what constitutes a \"large\" region. If nil, then no messages will ever be printed to the minibuffer." - :type 'integer + :type '(choice (const :tag "Align a large region silently" nil) integer) :group 'align) (defcustom align-c++-modes '(c++-mode c-mode java-mode) @@ -356,11 +357,11 @@ The possible settings for `align-region-separate' are: (cons :tag "Valid" (const :tag "(Return non-nil if rule is valid)" valid) - (function :value t)) + (function :value always)) (cons :tag "Run If" (const :tag "(Return non-nil if rule should run)" run-if) - (function :value t)) + (function :value always)) (cons :tag "Column" (const :tag "(Column to fix alignment at)" column) (choice :value comment-column diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 3973d9db08e..b273e1f6340 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -347,6 +347,10 @@ version of that color." "\e\\[[\x30-\x3F]*[\x20-\x2F]*[\x40-\x7E]" "Regexp matching an ANSI control sequence.") +(defconst ansi-color--control-seq-fragment-regexp + "\e\\[[\x30-\x3F]*[\x20-\x2F]*\\|\e" + "Regexp matching a partial ANSI control sequence.") + (defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]" "Regexp that matches SGR control sequence parameters.") @@ -492,7 +496,11 @@ This function can be added to `comint-preoutput-filter-functions'." ;; save context, add the remainder of the string to the result (let ((fragment "")) (push (substring string start - (if (string-match "\033" string start) + (if (string-match + (concat "\\(?:" + ansi-color--control-seq-fragment-regexp + "\\)\\'") + string start) (let ((pos (match-beginning 0))) (setq fragment (substring string pos)) pos) @@ -549,7 +557,9 @@ This function can be added to `comint-preoutput-filter-functions'." (put-text-property start (length string) 'font-lock-face face string)) ;; save context, add the remainder of the string to the result - (if (string-match "\033" string start) + (if (string-match + (concat "\\(?:" ansi-color--control-seq-fragment-regexp "\\)\\'") + string start) (let ((pos (match-beginning 0))) (setcar (cdr context) (substring string pos)) (push (substring string start pos) result)) @@ -685,7 +695,11 @@ it will override BEGIN, the start of the region. Set (while (re-search-forward ansi-color-control-seq-regexp end-marker t) (delete-region (match-beginning 0) (match-end 0))) ;; save context, add the remainder of the string to the result - (if (re-search-forward "\033" end-marker t) + (set-marker start (point)) + (while (re-search-forward ansi-color--control-seq-fragment-regexp + end-marker t)) + (if (and (/= (point) start) + (= (point) end-marker)) (set-marker start (match-beginning 0)) (set-marker start nil))))) @@ -742,10 +756,12 @@ being deleted." ;; Otherwise, strip. (delete-region esc-beg esc-end)))) ;; search for the possible start of a new escape sequence - (if (re-search-forward "\033" end-marker t) + (while (re-search-forward ansi-color--control-seq-fragment-regexp + end-marker t)) + (if (and (/= (point) start-marker) + (= (point) end-marker)) (progn - (while (re-search-forward "\033" end-marker t)) - (backward-char) + (goto-char (match-beginning 0)) (funcall ansi-color-apply-face-function start-marker (point) (ansi-color--face-vec-face face-vec)) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 97a122b7bcf..918c0c7f19d 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -692,7 +692,7 @@ system.") (defun auto-revert-notify-handler (event) "Handle an EVENT returned from file notification." - (with-demoted-errors + (with-demoted-errors "Error while auto-reverting: %S" (let* ((descriptor (car event)) (action (nth 1 event)) (file (nth 2 event)) diff --git a/lisp/bindings.el b/lisp/bindings.el index 86c0ea1a908..8ae8c3d60ef 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -654,6 +654,18 @@ By default, this shows the information specified by `global-mode-string'.") (with-selected-window (posn-window (event-start event)) (previous-buffer))) +(defun mode-line-window-selected-p () + "Return non-nil if we're updating the mode line for the selected window. +This function is meant to be called in `:eval' mode line +constructs to allow altering the look of the mode line depending +on whether the mode line belongs to the currently selected window +or not." + (let ((window (selected-window))) + (or (eq window (old-selected-window)) + (and (minibuffer-window-active-p (minibuffer-window)) + (with-selected-window (minibuffer-window) + (eq window (minibuffer-selected-window))))))) + (defmacro bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil. Note that if `lexical-binding' is in effect, this function isn't @@ -1148,7 +1160,9 @@ if `inhibit-field-text-motion' is non-nil." ;(define-key global-map [delete] 'backward-delete-char) ;; natural bindings for terminal keycaps --- defined in X keysym order -(define-key global-map [Scroll_Lock] 'scroll-lock-mode) +(define-key global-map + (if (eq system-type 'windows-nt) [scroll] [Scroll_Lock]) + #'scroll-lock-mode) (define-key global-map [C-S-backspace] 'kill-whole-line) (define-key global-map [home] 'move-beginning-of-line) (define-key global-map [C-home] 'beginning-of-buffer) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 0279d5ea83a..27517318171 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -344,6 +344,17 @@ This point is in `bookmark-current-buffer'.") BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'." (car bookmark-record)) +(defun bookmark-type-from-full-record (bookmark-record) + "Return then type of BOOKMARK-RECORD. +BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. It's +type is read from the symbol property named +`bookmark-handler-type' read on the record handler function." + (let ((handler (bookmark-get-handler bookmark-record))) + (when (autoloadp (symbol-function handler)) + (autoload-do-load (symbol-function handler))) + (if (symbolp handler) + (get handler 'bookmark-handler-type) + ""))) (defun bookmark-all-names () "Return a list of all current bookmark names." @@ -1274,7 +1285,10 @@ then offer interactively to relocate BOOKMARK-NAME-OR-RECORD." (defun bookmark-default-handler (bmk-record) "Default handler to jump to a particular bookmark location. BMK-RECORD is a bookmark record, not a bookmark name (i.e., not a string). -Changes current buffer and point and returns nil, or signals a `file-error'." +Changes current buffer and point and returns nil, or signals a `file-error'. + +If BMK-RECORD has a property called `buffer', it should be a live +buffer object, and this buffer will be selected." (let ((file (bookmark-get-filename bmk-record)) (buf (bookmark-prop-get bmk-record 'buffer)) (forward-str (bookmark-get-front-context-string bmk-record)) @@ -1348,7 +1362,6 @@ minibuffer history list `bookmark-history'." (bookmark-get-filename bookmark-name-or-record) "-- Unknown location --")) - ;;;###autoload (defun bookmark-rename (old-name &optional new-name) "Change the name of OLD-NAME bookmark to NEW-NAME name. @@ -1787,6 +1800,7 @@ Don't affect the buffer ring order." (let (entries) (dolist (full-record (bookmark-maybe-sort-alist)) (let* ((name (bookmark-name-from-full-record full-record)) + (type (bookmark-type-from-full-record full-record)) (annotation (bookmark-get-annotation full-record)) (location (bookmark-location full-record))) (push (list @@ -1800,6 +1814,7 @@ Don't affect the buffer ring order." 'follow-link t 'help-echo "mouse-2: go to this bookmark in other window") name) + ,(or type "") ,@(if bookmark-bmenu-toggle-filenames (list location))]) entries))) @@ -1888,6 +1903,7 @@ Bookmark names preceded by a \"*\" have annotations. (setq tabulated-list-format `[("" 1) ;; Space to add "*" for bookmark with annotation ("Bookmark" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate) + ("Type" 8 bookmark-bmenu--type-predicate) ,@(if bookmark-bmenu-toggle-filenames '(("File" 0 bookmark-bmenu--file-predicate)))]) (setq tabulated-list-padding bookmark-bmenu-marks-width) @@ -1902,6 +1918,10 @@ Bookmark names preceded by a \"*\" have annotations. This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." (string< (caar a) (caar b))) +(defun bookmark-bmenu--type-predicate (a b) + "Predicate to sort \"*Bookmark List*\" buffer by the type column. +This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." + (string< (elt (cadr a) 2) (elt (cadr b) 2))) (defun bookmark-bmenu--file-predicate (a b) "Predicate to sort \"*Bookmark List*\" buffer by the file column. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 48d308afade..7804ce0ee94 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1861,7 +1861,9 @@ concatenated and the result truncated." buffs)) (defun calendar-exit (&optional kill) - "Get out of the calendar window and hide it and related buffers." + "Get out of the calendar window and hide it and related buffers. +If KILL (interactively, the prefix), kill the buffers instead of +hiding them." (interactive "P") (let ((diary-buffer (get-file-buffer diary-file)) (calendar-buffers (calendar-buffer-list))) @@ -1880,7 +1882,12 @@ concatenated and the result truncated." (iconify-frame (window-frame w))) (quit-window kill w)))) (dolist (b calendar-buffers) - (quit-windows-on b kill)))))) + (quit-windows-on b kill))) + ;; Finally, kill non-displayed buffers (if requested). + (when kill + (dolist (b calendar-buffers) + (when (buffer-live-p b) + (kill-buffer b))))))) (defun calendar-current-date (&optional offset) "Return the current date in a list (month day year). diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 73ef37ea2aa..02ebde40785 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -213,9 +213,7 @@ TOKTYPE is a hint to the type of tag desired." (symbol-name sym) nil ;; return type (semantic-elisp-desymbolify arglist) - :user-visible-flag (condition-case nil - (interactive-form sym) - (error nil))))) + :user-visible-flag (commandp sym)))) ((and (eq toktype 'variable) (boundp sym)) (semantic-tag-new-variable (symbol-name sym) diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index f842b3c364b..ba67d250604 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -65,6 +65,7 @@ (defmacro wisent-defcontext (name &rest vars) "Define a context NAME that will bind variables VARS." (declare (indent 1)) + (declare-function wisent-context-name nil (name)) (let* ((context (wisent-context-name name)) (declarations (mapcar (lambda (v) (list 'defvar v)) vars))) `(progn @@ -75,6 +76,7 @@ (defmacro wisent-with-context (name &rest body) "Bind variables in context NAME then eval BODY." (declare (indent 1)) + (declare-function wisent-context-bindings nil (name)) `(dlet ,(wisent-context-bindings name) ,@body)) diff --git a/lisp/comint.el b/lisp/comint.el index fdea3e33bb4..4c82e74e4bc 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3191,8 +3191,8 @@ inside of a \"[...]\" (see `skip-chars-forward'), plus all non-ASCII characters. (while (not giveup) (let ((startpoint (point))) (skip-chars-backward (concat "\\\\" word-chars)) - (if (and comint-file-name-quote-list - (eq (char-before (1- (point))) ?\\)) + (if (and (eq (char-before (1- (point))) ?\\) + (memq (char-before) comint-file-name-quote-list)) (forward-char -2)) ;; FIXME: This isn't consistent with Bash, at least -- not ;; all non-ASCII chars should be word constituents. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 3e350c611a3..bec7348099a 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1045,6 +1045,35 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." value) ;;;###autoload +(defmacro setopt (&rest pairs) + "Set VARIABLE/VALUE pairs, and return the final VALUE. +This is like `setq', but is meant for user options instead of +plain variables. This means that `setopt' will execute any +`custom-set' form associated with VARIABLE. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + (let ((expr nil)) + (while pairs + (unless (symbolp (car pairs)) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(setopt--set ',(car pairs) ,(cadr pairs)) + expr) + (setq pairs (cddr pairs))) + (macroexp-progn (nreverse expr)))) + +;;;###autoload +(defun setopt--set (variable value) + (custom-load-symbol variable) + ;; Check that the type is correct. + (when-let ((type (get variable 'custom-type))) + (unless (widget-apply (widget-convert type) :match value) + (user-error "Value `%S' does not match type %s" value type))) + (funcall (or (get variable 'custom-set) #'set-default) variable value)) + +;;;###autoload (defun customize-save-variable (variable value &optional comment) "Set the default for VARIABLE to VALUE, and save it for future sessions. Return VALUE. @@ -3976,6 +4005,18 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) + ;; When modifying the default face, we need to save the standard or themed + ;; attrs, in case the user asks to revert to them in the future. + ;; In GUIs, when resetting the attributes of the default face, the frame + ;; parameters associated with this face won't change, unless explicitly + ;; passed a value. Storing this known attrs allows us to tell faces.el to + ;; set those attributes to specified values, making the relevant frame + ;; parameters stay in sync with the default face. + (when (and (eq symbol 'default) + (not (get symbol 'custom-face-default-attrs)) + (memq (custom-face-state symbol) '(standard themed))) + (put symbol 'custom-face-default-attrs + (custom-face-get-current-spec symbol))) (custom-push-theme 'theme-face symbol 'user 'set value) (face-spec-set symbol value 'customized-face) (put symbol 'face-comment comment) @@ -3994,6 +4035,12 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) + ;; See the comments in `custom-face-set'. + (when (and (eq symbol 'default) + (not (get symbol 'custom-face-default-attrs)) + (memq (custom-face-state symbol) '(standard themed))) + (put symbol 'custom-face-default-attrs + (custom-face-get-current-spec symbol))) (custom-push-theme 'theme-face symbol 'user 'set value) (face-spec-set symbol value (if standard 'reset 'saved-face)) (put symbol 'face-comment comment) @@ -4007,7 +4054,14 @@ Optional EVENT is the location for the menu." (defun custom-face-save (widget) "Save the face edited by WIDGET." - (let ((form (widget-get widget :custom-form))) + (let ((form (widget-get widget :custom-form)) + (symbol (widget-value widget))) + ;; See the comments in `custom-face-set'. + (when (and (eq symbol 'default) + (not (get symbol 'custom-face-default-attrs)) + (memq (custom-face-state symbol) '(standard themed))) + (put symbol 'custom-face-default-attrs + (custom-face-get-current-spec symbol))) (if (memq form '(all lisp)) (custom-face-mark-to-save widget) ;; The user is working on only a selected terminal type; @@ -4035,10 +4089,20 @@ uncustomized (themed or standard) face." (saved-face (get face 'saved-face)) (comment (get face 'saved-face-comment)) (comment-widget (widget-get widget :comment-widget))) + ;; If resetting the default face and there isn't a saved value, + ;; push a fake user setting, so that reverting to the default + ;; attributes works. (custom-push-theme 'theme-face face 'user - (if saved-face 'set 'reset) - saved-face) + (if (or saved-face (eq face 'default)) 'set 'reset) + (or saved-face + ;; If this is t, then MODE is 'reset, + ;; and `custom-push-theme' ignores this argument. + (not (eq face 'default)) + (get face 'custom-face-default-attrs))) (face-spec-set face saved-face 'saved-face) + (when (and (not saved-face) (eq face 'default)) + ;; Remove the fake user setting. + (custom-push-theme 'theme-face face 'user 'reset)) (put face 'face-comment comment) (put face 'customized-face-comment nil) (widget-value-set child saved-face) @@ -4060,8 +4124,15 @@ redraw the widget immediately." (comment-widget (widget-get widget :comment-widget))) (unless value (user-error "No standard setting for this face")) - (custom-push-theme 'theme-face symbol 'user 'reset) + ;; If erasing customizations for the default face, push a fake user setting, + ;; so that reverting to the default attributes works. + (custom-push-theme 'theme-face symbol 'user + (if (eq symbol 'default) 'set 'reset) + (or (not (eq symbol 'default)) + (get symbol 'custom-face-default-attrs))) (face-spec-set symbol value 'reset) + ;; Remove the fake user setting. + (custom-push-theme 'theme-face symbol 'user 'reset) (put symbol 'face-comment nil) (put symbol 'customized-face-comment nil) (if (and custom-reset-standard-faces-list diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 12ad3910fcb..80d0aaa0d51 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -133,7 +133,7 @@ :help-echo "Control text underlining." (const :tag "Off" nil) (list :tag "On" - :value (:color foreground-color :style line) + :value (:color foreground-color :style line :position nil) (const :format "" :value :color) (choice :tag "Color" (const :tag "Foreground Color" foreground-color) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index afdbd82457b..83ab61b28b5 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -811,6 +811,7 @@ since it could result in memory overflow and make Emacs crash." character) "27.1" :safe (lambda (value) (or (characterp value) (null value)))) + (composition-break-at-point display boolean "29.1") ;; xfaces.c (scalable-fonts-allowed display (choice (const :tag "Don't allow scalable fonts" nil) @@ -857,6 +858,8 @@ since it could result in memory overflow and make Emacs crash." (featurep 'ns)) ((string-match "\\`haiku-" (symbol-name symbol)) (featurep 'haiku)) + ((eq symbol 'process-error-pause-time) + (not (eq system-type 'ms-dos))) ((eq symbol 'x-gtk-use-native-input) (and (featurep 'x) (featurep 'gtk))) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 41c45b4e514..56897826cbc 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -954,6 +954,13 @@ prompted for the shell command to use interactively." (setq retval (replace-match x t t retval 2))) retval)) (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) + ;; If a file name starts with "-", add a "./" to avoid the command + ;; interpreting it as a command line switch. + (setq file-list (mapcar (lambda (file) + (if (string-match "\\`-" file) + (concat "./" file) + file)) + file-list)) (concat (cond (on-each @@ -3245,7 +3252,6 @@ with the command \\[tags-loop-continue]." delimited) (fileloop-continue)) -(declare-function xref--show-xrefs "xref") (declare-function xref-query-replace-in-results "xref") (declare-function project--files-in-directory "project") @@ -3289,7 +3295,7 @@ REGEXP should use constructs supported by your local `grep' command." (user-error "No matches for: %s" regexp)) (message "Searching...done") xrefs)))) - (xref--show-xrefs fetcher nil))) + (xref-show-xrefs fetcher nil))) ;;;###autoload (defun dired-do-find-regexp-and-replace (from to) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index bdf416b3edc..56036b6c166 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -639,8 +639,8 @@ you can relist single subdirs using \\[dired-do-redisplay]." ":\n")) (dired-mode dirname (or switches dired-listing-switches)) (setq mode-name "Virtual Dired" - revert-buffer-function 'dired-virtual-revert) - (setq-local dired-subdir-alist nil) + revert-buffer-function 'dired-virtual-revert + dired-subdir-alist nil) (dired-build-subdir-alist) (goto-char (point-min)) (dired-initial-position dirname)) diff --git a/lisp/dired.el b/lisp/dired.el index 9813fca4359..bca30189230 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -408,7 +408,7 @@ action argument symbol is `window-height' and its value is nil." "24.3") (defvar dired-file-version-alist) ;;;###autoload -(defvar dired-directory nil +(defvar-local dired-directory nil "The directory name or wildcard spec that this Dired directory lists. Local to each Dired buffer. May be a list, in which case the car is the directory name and the cdr is the list of files to mention. @@ -455,7 +455,7 @@ The directory name must be absolute, but need not be fully expanded.") (defvar dired-re-dot "^.* \\.\\.?/?$") ;; The subdirectory names in the next two lists are expanded. -(defvar dired-subdir-alist nil +(defvar-local dired-subdir-alist nil "Alist of listed directories and their buffer positions. Alist elements have the form (DIRNAME . STARTMARKER), where DIRNAME is the absolute name of the directory and STARTMARKER is @@ -1336,7 +1336,7 @@ wildcards, erases the buffer, and builds the subdir-alist anew (goto-char (point-min)) ;; Must first make alist buffer local and set it to nil because ;; dired-build-subdir-alist will call dired-clear-alist first - (setq-local dired-subdir-alist nil) + (setq dired-subdir-alist nil) (dired-build-subdir-alist)) (let ((attributes (file-attributes dirname))) (if (eq (car attributes) t) @@ -2365,7 +2365,7 @@ Keybindings: (setq-local buffer-stale-function #'dired-buffer-stale-p) (setq-local buffer-auto-revert-by-notification t) (setq-local page-delimiter "\n\n") - (setq-local dired-directory (or dirname default-directory)) + (setq dired-directory (or dirname default-directory)) ;; list-buffers uses this to display the dir being edited in this buffer. (setq list-buffers-directory (expand-file-name (if (listp dired-directory) @@ -2756,7 +2756,7 @@ permissions are hidden from view. See options: `dired-hide-details-hide-symlink-targets' and `dired-hide-details-hide-information-lines'." :group 'dired - (unless (derived-mode-p 'dired-mode) + (unless (derived-mode-p 'dired-mode 'wdired-mode) (error "Not a Dired buffer")) (dired-hide-details-update-invisibility-spec) (if dired-hide-details-mode diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 5e160f5dff1..193cf42ea42 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2007-2022 Free Software Foundation, Inc. ;; ;; Author: Tassilo Horn <tsdh@gnu.org> -;; Keywords: files, pdf, ps, dvi +;; Keywords: files, pdf, ps, dvi, djvu, epub, cbz, fb2, xps, openxps ;; This file is part of GNU Emacs. @@ -25,17 +25,19 @@ ;; Viewing PS/PDF/DVI files requires Ghostscript, `dvipdf' (comes with ;; Ghostscript) or `dvipdfm' (comes with teTeX or TeXLive) and ;; `pdftotext', which comes with xpdf (https://www.foolabs.com/xpdf/) -;; or poppler (https://poppler.freedesktop.org/). -;; Djvu documents require `ddjvu' (from DjVuLibre). -;; ODF files require `soffice' (from LibreOffice). +;; or poppler (https://poppler.freedesktop.org/). EPUB, CBZ, FB2, XPS +;; and OXPS documents require `mutool' which comes with mupdf +;; (https://mupdf.com/index.html). Djvu documents require `ddjvu' +;; (from DjVuLibre). ODF files require `soffice' (from LibreOffice). ;;; Commentary: ;; DocView is a document viewer for Emacs. It converts a number of -;; document formats (including PDF, PS, DVI, Djvu and ODF files) to a -;; set of PNG files, one PNG for each page, and displays the PNG -;; images inside an Emacs buffer. This buffer uses `doc-view-mode' -;; which provides convenient key bindings for browsing the document. +;; document formats (including PDF, PS, DVI, Djvu, ODF, EPUB, CBZ, +;; FB2, XPS and OXPS files) to a set of PNG (or TIFF for djvu) files, +;; one image for each page, and displays the images inside an Emacs +;; buffer. This buffer uses `doc-view-mode' which provides convenient +;; key bindings for browsing the document. ;; ;; To use it simply open a document file with ;; @@ -147,7 +149,10 @@ ;;;; Customization Options (defgroup doc-view nil - "In-buffer viewer for PDF, PostScript, DVI, and DJVU files." + "In-buffer document viewer. +The viewer handles PDF, PostScript, DVI, DJVU, ODF, EPUB, CBZ, +FB2, XPS and OXPS files, if the appropriate converter programs +are available (see Info node `(emacs)Document View')" :link '(function-link doc-view) :version "22.2" :group 'applications @@ -221,6 +226,38 @@ Higher values result in larger images." :type 'number) +(defvar doc-view-doc-type nil + "The type of document in the current buffer. +Can be `dvi', `pdf', `ps', `djvu', `odf', 'epub', `cbz', `fb2', +`'xps' or `oxps'.") + +;; FIXME: The doc-view-current-* definitions below are macros because they +;; map to accessors which we want to use via `setf' as well! +(defmacro doc-view-current-page (&optional win) + `(image-mode-window-get 'page ,win)) +(defmacro doc-view-current-info () '(image-mode-window-get 'info)) +(defmacro doc-view-current-overlay () '(image-mode-window-get 'overlay)) +(defmacro doc-view-current-image () '(image-mode-window-get 'image)) +(defmacro doc-view-current-slice () '(image-mode-window-get 'slice)) + +(defvar-local doc-view--current-cache-dir nil + "Only used internally.") + +(defun doc-view-custom-set-epub-font-size (option-name new-value) + (set-default option-name new-value) + (dolist (x (buffer-list)) + (with-current-buffer x + (when (eq doc-view-doc-type 'epub) + (delete-directory doc-view--current-cache-dir t) + (doc-view-initiate-display) + (doc-view-goto-page (doc-view-current-page)))))) + +(defcustom doc-view-epub-font-size nil + "Font size in points for EPUB layout." + :type '(choice (const nil) integer) + :set #'doc-view-custom-set-epub-font-size + :version "29.1") + (defcustom doc-view-scale-internally t "Whether we should try to rescale images ourselves. If nil, the document is re-rendered every time the scaling factor is modified. @@ -256,9 +293,7 @@ If this and `doc-view-dvipdfm-program' are set, `doc-view-dvipdf-program' will be preferred." :type 'file) -(define-obsolete-variable-alias 'doc-view-unoconv-program - 'doc-view-odf->pdf-converter-program - "24.4") +(define-obsolete-variable-alias 'doc-view-unoconv-program 'doc-view-odf->pdf-converter-program "24.4") (defcustom doc-view-odf->pdf-converter-program (cond @@ -363,9 +398,6 @@ of the page moves to the previous page." (defvar-local doc-view--current-timer nil "Only used internally.") -(defvar-local doc-view--current-cache-dir nil - "Only used internally.") - (defvar-local doc-view--current-search-matches nil "Only used internally.") @@ -380,10 +412,6 @@ files inside an archive it is a temporary copy of the (uncompressed, extracted) file residing in `doc-view-cache-directory'.") -(defvar doc-view-doc-type nil - "The type of document in the current buffer. -Can be `dvi', `pdf', `ps', `djvu' or `odf'.") - (defvar doc-view-single-page-converter-function nil "Function to call to convert a single page of the document to a bitmap file. May operate on the source document or on some intermediate (typically PDF) @@ -464,17 +492,17 @@ Typically \"page-%s.png\".") ;; It's normal for this operation to result in a very large undo entry. (setq-local undo-outer-limit (* 2 (buffer-size)))) (cl-labels ((revert () - (let ((revert-buffer-preserve-modes t)) - (apply orig-fun args) - ;; Update the cached version of the pdf file, - ;; too. This is the one that's used when - ;; rendering (bug#26996). - (unless (equal buffer-file-name - doc-view--buffer-file-name) - ;; FIXME: Lars says he needed to recreate - ;; the dir, we should figure out why. - (doc-view-make-safe-dir doc-view-cache-directory) - (write-region nil nil doc-view--buffer-file-name))))) + (let ((revert-buffer-preserve-modes t)) + (apply orig-fun args) + ;; Update the cached version of the pdf file, + ;; too. This is the one that's used when + ;; rendering (bug#26996). + (unless (equal buffer-file-name + doc-view--buffer-file-name) + ;; FIXME: Lars says he needed to recreate + ;; the dir, we should figure out why. + (doc-view-make-safe-dir doc-view-cache-directory) + (write-region nil nil doc-view--buffer-file-name))))) (if (and (eq 'pdf doc-view-doc-type) (executable-find "pdfinfo")) ;; We don't want to revert if the PDF file is corrupted which @@ -577,15 +605,6 @@ Typically \"page-%s.png\".") ;;;; Navigation Commands -;; FIXME: The doc-view-current-* definitions below are macros because they -;; map to accessors which we want to use via `setf' as well! -(defmacro doc-view-current-page (&optional win) - `(image-mode-window-get 'page ,win)) -(defmacro doc-view-current-info () '(image-mode-window-get 'info)) -(defmacro doc-view-current-overlay () '(image-mode-window-get 'overlay)) -(defmacro doc-view-current-image () '(image-mode-window-get 'image)) -(defmacro doc-view-current-slice () '(image-mode-window-get 'slice)) - (defun doc-view-last-page-number () (length doc-view--current-files)) @@ -738,7 +757,7 @@ at the top edge of the page moves to the previous page." (interactive) (while (consp doc-view--current-converter-processes) (ignore-errors ;; Some entries might not be processes, and maybe - ;; some are dead already? + ; some are dead already? (kill-process (pop doc-view--current-converter-processes)))) (when doc-view--current-timer (cancel-timer doc-view--current-timer) @@ -799,8 +818,8 @@ It's a subdirectory of `doc-view-cache-directory'." ;;;###autoload (defun doc-view-mode-p (type) "Return non-nil if document type TYPE is available for `doc-view'. -Document types are symbols like `dvi', `ps', `pdf', or `odf' (any -OpenDocument format)." +Document types are symbols like `dvi', `ps', `pdf', `epub', +`cbz', `fb2', `xps', `oxps', or`odf' (any OpenDocument format)." (and (display-graphic-p) (image-type-available-p 'png) (cond @@ -811,16 +830,22 @@ OpenDocument format)." (and doc-view-dvipdfm-program (executable-find doc-view-dvipdfm-program))))) ((memq type '(postscript ps eps pdf)) - (or (and doc-view-ghostscript-program + (or (and doc-view-ghostscript-program (executable-find doc-view-ghostscript-program)) - (and doc-view-pdfdraw-program - (executable-find doc-view-pdfdraw-program)))) + ;; for pdf also check for `doc-view-pdfdraw-program' + (when (eq type 'pdf) + (and doc-view-pdfdraw-program + (executable-find doc-view-pdfdraw-program))))) ((eq type 'odf) (and doc-view-odf->pdf-converter-program (executable-find doc-view-odf->pdf-converter-program) (doc-view-mode-p 'pdf))) ((eq type 'djvu) (executable-find "ddjvu")) + ((memq type '(epub cbz fb2 xps oxps)) + ;; first check if `doc-view-pdfdraw-program' is set to mutool + (and (string= doc-view-pdfdraw-program "mutool") + (executable-find "mutool"))) (t ;; unknown image type nil)))) @@ -1053,7 +1078,7 @@ Should be invoked when the cached images aren't up-to-date." ;; some file-name-handler-managed dir, for example). (let* ((default-directory (or (unhandled-file-name-directory default-directory) - (expand-file-name "~/"))) + (expand-file-name "~/"))) (proc (apply #'start-process name doc-view-conversion-buffer program args))) (push proc doc-view--current-converter-processes) @@ -1139,14 +1164,17 @@ The test is performed using `doc-view-pdfdraw-program'." (search-forward "error: cannot authenticate password" nil t))) (defun doc-view-pdf->png-converter-mupdf (pdf png page callback) - (let ((pdf-passwd (if (doc-view-pdf-password-protected-pdfdraw-p pdf) - (read-passwd "Enter password for PDF file: ")))) + (let* ((pdf-passwd (if (doc-view-pdf-password-protected-pdfdraw-p pdf) + (read-passwd "Enter password for PDF file: "))) + (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))))) (doc-view-start-process "pdf->png" doc-view-pdfdraw-program `(,@(doc-view-pdfdraw-program-subcommand) - ,(concat "-o" png) - ,(format "-r%d" (round doc-view-resolution)) - ,@(if pdf-passwd `("-p" ,pdf-passwd)) + ,@options ,pdf ,@(if page `(,(format "%d" page)))) callback))) @@ -1189,7 +1217,8 @@ is named like ODF with the extension turned to pdf." "Convert PDF-PS to PNG asynchronously." (funcall (pcase doc-view-doc-type - ((or 'pdf 'odf) doc-view-pdf->png-converter-function) + ((or 'pdf 'odf 'epub 'cbz 'fb2 'xps 'oxps) + doc-view-pdf->png-converter-function) ('djvu #'doc-view-djvu->tiff-converter-ddjvu) (_ #'doc-view-ps->png-converter-ghostscript)) pdf-ps png nil @@ -1227,20 +1256,20 @@ Start by converting PAGES, and then the rest." (let ((rest (cdr pages))) (funcall doc-view-single-page-converter-function pdf (format png (car pages)) (car pages) - (lambda () - (if rest - (doc-view-document->bitmap pdf png rest) - ;; Yippie, the important pages are done, update the display. - (clear-image-cache) - ;; For the windows that have a message (like "Welcome to - ;; DocView") display property, clearing the image cache is - ;; not sufficient. - (dolist (win (get-buffer-window-list (current-buffer) nil 'visible)) - (with-selected-window win - (when (stringp (overlay-get (doc-view-current-overlay) 'display)) - (doc-view-goto-page (doc-view-current-page))))) - ;; Convert the rest of the pages. - (doc-view-pdf/ps->png pdf png))))))) + (lambda () + (if rest + (doc-view-document->bitmap pdf png rest) + ;; Yippie, the important pages are done, update the display. + (clear-image-cache) + ;; For the windows that have a message (like "Welcome to + ;; DocView") display property, clearing the image cache is + ;; not sufficient. + (dolist (win (get-buffer-window-list (current-buffer) nil 'visible)) + (with-selected-window win + (when (stringp (overlay-get (doc-view-current-overlay) 'display)) + (doc-view-goto-page (doc-view-current-page))))) + ;; Convert the rest of the pages. + (doc-view-pdf/ps->png pdf png))))))) (defun doc-view-pdf->txt (pdf txt callback) "Convert PDF to TXT asynchronously and call CALLBACK when finished." @@ -1337,7 +1366,9 @@ Those files are saved in the directory given by the function ;; Rename to doc.pdf (rename-file opdf pdf) (doc-view-pdf/ps->png pdf png-file))))) - ((or 'pdf 'djvu) + ;; The doc-view-mode-p check ensures that epub, cbz, fb2 and + ;; (o)xps are handled with mutool + ((or 'pdf 'djvu 'epub 'cbz 'fb2 'xps 'oxps) (let ((pages (doc-view-active-pages))) ;; Convert doc to bitmap images starting with the active pages. (doc-view-document->bitmap doc-view--buffer-file-name png-file pages))) @@ -1432,7 +1463,7 @@ dragging it to its bottom-right corner. See also (defun doc-view-guess-paper-size (iw ih) "Guess the paper size according to the aspect ratio." (cl-labels ((div (x y) - (round (/ (* 100.0 x) y)))) + (round (/ (* 100.0 x) y)))) (let ((ar (div iw ih)) (al (mapcar (lambda (l) (list (div (nth 1 l) (nth 2 l)) (car l))) @@ -1869,6 +1900,8 @@ If BACKWARD is non-nil, jump to the previous match." ("dvi" dvi) ;; PDF ("pdf" pdf) ("epdf" pdf) + ;; EPUB + ("epub" epub) ;; PostScript ("ps" ps) ("eps" ps) ;; DjVu @@ -1880,7 +1913,13 @@ If BACKWARD is non-nil, jump to the previous match." ;; Microsoft Office formats (also handled by the odf ;; conversion chain). ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) - ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf)) + ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf) + ;; CBZ + ("cbz" cbz) + ;; FB2 + ("fb2" fb2) + ;; (Open)XPS + ("xps" xps) ("oxps" oxps)) t)))) (content-types (save-excursion @@ -1889,7 +1928,13 @@ If BACKWARD is non-nil, jump to the previous match." ((looking-at "%!") '(ps)) ((looking-at "%PDF") '(pdf)) ((looking-at "\367\002") '(dvi)) - ((looking-at "AT&TFORM") '(djvu)))))) + ((looking-at "AT&TFORM") '(djvu)) + ;; The following pattern actually is for recognizing + ;; zip-archives, so that this same association is used for + ;; cbz files. This is fine, as cbz files should be handled + ;; like epub anyway. + ((looking-at "PK") '(epub)) + )))) (setq-local doc-view-doc-type (car (or (nreverse (seq-intersection name-types content-types #'eq)) @@ -2202,6 +2247,8 @@ See the command `doc-view-mode' for more information on this mode." (add-hook 'bookmark-after-jump-hook show-fn-sym) (bookmark-default-handler bmk))) +(put 'doc-view-bookmark-jump 'bookmark-handler-type "Docview") + ;; Obsolete. (defun doc-view-intersection (l1 l2) diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index c5f621c6c86..882b1d68c48 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -121,7 +121,11 @@ result. The overhead of the `lambda's is accounted for." (unless (or (natnump repetitions) (and repetitions (symbolp repetitions))) (setq forms (cons repetitions forms) repetitions 1)) - `(benchmark-call (byte-compile '(lambda () ,@forms)) ,repetitions)) + `(benchmark-call (,(if (native-comp-available-p) + 'native-compile + 'byte-compile) + '(lambda () ,@forms)) + ,repetitions)) ;;;###autoload (defun benchmark (repetitions form) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 04c5b9f0808..c6d64975eca 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -804,7 +804,6 @@ is the name of a variable that will hold the value we need to pack.") (if (or (eq label '_) (not (assq label labels))) code (macroexp-warn-and-return - code (format "Duplicate label: %S" label) code)))) (`(,_ ,val) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 25898285faa..0a79bf9b797 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -34,7 +34,6 @@ ;; still not going to make it go faster than 70 mph, but it might be easier ;; to get it there. ;; - ;; TO DO: ;; ;; ;; An awful lot of functions always return a non-nil value. If they're @@ -74,10 +73,6 @@ (eval-when-compile (require 'subr-x)) (defun byte-compile-log-lap-1 (format &rest args) - ;; Newer byte codes for stack-ref make the slot 0 non-nil again. - ;; But the "old disassembler" is *really* ancient by now. - ;; (if (aref byte-code-vector 0) - ;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well")) (byte-compile-log-1 (apply #'format-message format (let (c a) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index fedc10cea44..c542c550169 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -37,24 +37,6 @@ the corresponding new element of the same type. The purpose of this is to detect circular structures.") -(defalias 'byte-run--circular-list-p - #'(lambda (l) - "Return non-nil when the list L is a circular list. -Note that this algorithm doesn't check any circularity in the -CARs of list elements." - (let ((hare l) - (tortoise l)) - (condition-case err - (progn - (while (progn - (setq hare (cdr (cdr hare)) - tortoise (cdr tortoise)) - (not (or (eq tortoise hare) - (null hare))))) - (eq tortoise hare)) - (wrong-type-argument nil) - (error (signal (car err) (cdr err))))))) - (defalias 'byte-run--strip-s-p-1 #'(lambda (arg) "Strip all positions from symbols in ARG, modifying ARG. @@ -64,41 +46,36 @@ Return the modified ARG." (bare-symbol arg)) ((consp arg) - (let* ((round (byte-run--circular-list-p arg)) - (hash (and round (gethash arg byte-run--ssp-seen)))) - (or hash - (let ((a arg) new) - (while - (progn - (when round - (puthash a new byte-run--ssp-seen)) - (setq new (byte-run--strip-s-p-1 (car a))) - (when (not (eq new (car a))) ; For read-only things. - (setcar a new)) - (and (consp (cdr a)) - (not - (setq hash - (and round - (gethash (cdr a) byte-run--ssp-seen)))))) - (setq a (cdr a))) - (setq new (byte-run--strip-s-p-1 (cdr a))) - (when (not (eq new (cdr a))) - (setcdr a (or hash new))) - 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)))) ((or (vectorp arg) (recordp arg)) (let ((hash (gethash arg byte-run--ssp-seen))) - (or hash - (let* ((len (length arg)) - (i 0) - new) - (puthash arg arg byte-run--ssp-seen) - (while (< i len) - (setq new (byte-run--strip-s-p-1 (aref arg i))) - (when (not (eq new (aref arg i))) - (aset arg i new)) - (setq i (1+ i))) - arg)))) + (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)))) (t arg)))) @@ -334,11 +311,10 @@ The return value is undefined. (let ((f (cdr (assq (car x) macro-declarations-alist)))) (if f (apply (car f) name arglist (cdr x)) (macroexp-warn-and-return - (car x) (format-message "Unknown macro property %S in %S" (car x) name) - nil)))) + nil nil nil (car x))))) decls))) ;; Refresh font-lock if this is a new macro, or it is an ;; existing macro whose 'no-font-lock-keyword declaration @@ -408,10 +384,9 @@ The return value is undefined. nil) (t (macroexp-warn-and-return - (car x) (format-message "Unknown defun property `%S' in %S" (car x) name) - nil))))) + nil nil nil (car x)))))) decls)) (def (list 'defalias (list 'quote name) @@ -656,7 +631,7 @@ For the `mapcar' case, only the `mapcar' function can be used in the symbol list. For `suspicious', only `set-buffer' can be used." ;; Note: during compilation, this definition is overridden by the one in ;; byte-compile-initial-macro-environment. - (declare (debug (sexp &optional body)) (indent 1)) + (declare (debug (sexp body)) (indent 1)) (if (not (and (featurep 'macroexp) (boundp 'byte-compile--suppressed-warnings))) ;; If `macroexp' is not yet loaded, we're in the middle of diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2f4bf663438..c59bb292f8f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1031,30 +1031,23 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (hist-nil-orig current-load-list)) (prog1 (eval form lexical-binding) (when (byte-compile-warning-enabled-p 'noruntime) - (let ((hist-new load-history) - (hist-nil-new current-load-list)) + (let* ((hist-new + ;; Get new `current-load-list' for the locally defined funs. + (cons (butlast current-load-list + (length hist-nil-orig)) + load-history))) ;; Go through load-history, look for newly loaded files ;; and mark all the functions defined therein. (while (and hist-new (not (eq hist-new hist-orig))) - (let ((xs (pop hist-new)) - old-autoloads) + (let ((xs (pop hist-new))) ;; Make sure the file was not already loaded before. (unless (assoc (car xs) hist-orig) (dolist (s xs) - (cond - ((and (consp s) (eq t (car s))) - (push (cdr s) old-autoloads)) - ((and (consp s) (memq (car s) '(autoload defun))) - (unless (memq (cdr s) old-autoloads) - (push (cdr s) byte-compile-noruntime-functions)))))))) - ;; Go through current-load-list for the locally defined funs. - (let (old-autoloads) - (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) - (let ((s (pop hist-nil-new))) - (when (and (symbolp s) (not (memq s old-autoloads))) - (push s byte-compile-noruntime-functions)) - (when (and (consp s) (eq t (car s))) - (push (cdr s) old-autoloads)))))))))) + (pcase s + (`(defun . ,f) + (unless (seq-some #'autoloadp + (get (cdr s) 'function-history)) + (push f byte-compile-noruntime-functions))))))))))))) (defun byte-compile-eval-before-compile (form) "Evaluate FORM for `eval-and-compile'." @@ -2205,20 +2198,20 @@ With argument ARG, insert value in current buffer after the form." (save-excursion (end-of-defun) (beginning-of-defun) - (let* ((print-symbols-bare t) + (let* ((print-symbols-bare t) ; For the final `message'. (byte-compile-current-file (current-buffer)) (byte-compile-current-buffer (current-buffer)) (start-read-position (point)) (byte-compile-last-warned-form 'nothing) + (symbols-with-pos-enabled t) (value (eval - (let ((symbols-with-pos-enabled t)) - (displaying-byte-compile-warnings - (byte-compile-sexp - (let ((form (read-positioning-symbols (current-buffer)))) - (push form byte-compile-form-stack) - (eval-sexp-add-defvars - form - start-read-position))))) + (displaying-byte-compile-warnings + (byte-compile-sexp + (let ((form (read-positioning-symbols (current-buffer)))) + (push form byte-compile-form-stack) + (eval-sexp-add-defvars + form + start-read-position)))) lexical-binding))) (cond (arg (message "Compiling from buffer... done.") @@ -2617,15 +2610,9 @@ list that represents a doc string reference. nil (byte-compile-docstring-length-warn form) (setq form (copy-sequence form)) - (cond ((consp (nth 2 form)) - (setcar (cdr (cdr form)) - (byte-compile-top-level (nth 2 form) nil 'file))) - ((symbolp (nth 2 form)) - (setcar (cddr form) (bare-symbol (nth 2 form)))) - (t (setcar (cddr form) (nth 2 form)))) - (setcar form (bare-symbol (car form))) - (if (symbolp (nth 1 form)) - (setcar (cdr form) (bare-symbol (nth 1 form)))) + (when (consp (nth 2 form)) + (setcar (cdr (cdr form)) + (byte-compile-top-level (nth 2 form) nil 'file))) form)) (put 'define-abbrev-table 'byte-hunk-handler @@ -3041,7 +3028,8 @@ lambda-expression." (byte-compile-docstring-length-warn fun) (byte-compile-check-lambda-list (nth 1 fun)) (let* ((arglist (nth 1 fun)) - (arglistvars (byte-compile-arglist-vars arglist)) + (arglistvars (byte-run-strip-symbol-positions + (byte-compile-arglist-vars arglist))) (byte-compile-bound-variables (append (if (not lexical-binding) arglistvars) byte-compile-bound-variables)) @@ -3344,12 +3332,10 @@ lambda-expression." (cond ((not (consp form)) (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form)) - (byte-compile-constant - (if (symbolp form) (bare-symbol form) form))) + (byte-compile-constant form)) ((and byte-compile--for-effect byte-compile-delete-errors) (setq byte-compile--for-effect nil)) - (t - (byte-compile-variable-ref (bare-symbol form))))) + (t (byte-compile-variable-ref form)))) ((symbolp (car form)) (let* ((fn (car form)) (handler (get fn 'byte-compile)) @@ -3579,7 +3565,6 @@ lambda-expression." (byte-compile-warn-obsolete var)))) (defsubst byte-compile-dynamic-variable-op (base-op var) - (if (symbolp var) (setq var (bare-symbol var))) (let ((tmp (assq var byte-compile-variables))) (unless tmp (setq tmp (list var)) @@ -3653,14 +3638,11 @@ assignment (i.e. `setq')." (defun byte-compile-constant (const) (if byte-compile--for-effect (setq byte-compile--for-effect nil) - (inline (byte-compile-push-constant - (if (symbolp const) (bare-symbol const) const))))) + (inline (byte-compile-push-constant const)))) ;; Use this for a constant that is not the value of its containing form. ;; This ignores byte-compile--for-effect. (defun byte-compile-push-constant (const) - (when (symbolp const) - (setq const (bare-symbol const))) (byte-compile-out 'byte-constant (byte-compile-get-constant const))) @@ -5127,6 +5109,7 @@ 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 (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/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 334988e7135..72eb776b993 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -166,7 +166,7 @@ (require 'help-mode) ;; for help-xref-info-regexp (require 'thingatpt) ;; for handy thing-at-point-looking-at (require 'lisp-mode) ;; for lisp-mode-symbol-regexp -(require 'dired) ;; for dired-get-filename and dired-map-over-marks +(eval-when-compile (require 'dired)) ;; for dired-map-over-marks (require 'lisp-mnt) (defvar compilation-error-regexp-alist) @@ -1124,12 +1124,20 @@ Skip anything that doesn't have the Emacs Lisp library file extension (\".el\"). When called from Lisp, FILES is a list of filenames." (interactive - (list - (delq nil - (mapcar - ;; skip anything that doesn't look like an Emacs Lisp library - (lambda (f) (if (equal (file-name-extension f) "el") f nil)) - (nreverse (dired-map-over-marks (dired-get-filename) nil))))) + (progn + ;; These Dired functions must be defined since we're in a Dired buffer. + (declare-function dired-get-filename "dired" + (&optional localp no-error-if-not-filep bof)) + ;; These functions are used by the expansion of `dired-map-over-marks'. + (declare-function dired-move-to-filename "dired" + (&optional raise-error eol)) + (declare-function dired-marker-regexp "dired" ()) + (list + (delq nil + (mapcar + ;; skip anything that doesn't look like an Emacs Lisp library + (lambda (f) (if (equal (file-name-extension f) "el") f nil)) + (nreverse (dired-map-over-marks (dired-get-filename) nil)))))) dired-mode) (if (null files) (error "No files to run checkdoc on") @@ -1275,27 +1283,27 @@ TEXT, START, END and UNFIXABLE conform to (let ((map (make-sparse-keymap)) (pmap (make-sparse-keymap))) ;; Override some bindings - (define-key map "\C-\M-x" 'checkdoc-eval-defun) - (define-key map "\C-x`" 'checkdoc-continue) + (define-key map "\C-\M-x" #'checkdoc-eval-defun) + (define-key map "\C-x`" #'checkdoc-continue) (define-key map [menu-bar emacs-lisp eval-buffer] - 'checkdoc-eval-current-buffer) + #'checkdoc-eval-current-buffer) ;; Add some new bindings under C-c ? - (define-key pmap "x" 'checkdoc-defun) - (define-key pmap "X" 'checkdoc-ispell-defun) - (define-key pmap "`" 'checkdoc-continue) - (define-key pmap "~" 'checkdoc-ispell-continue) - (define-key pmap "s" 'checkdoc-start) - (define-key pmap "S" 'checkdoc-ispell-start) - (define-key pmap "d" 'checkdoc) - (define-key pmap "D" 'checkdoc-ispell) - (define-key pmap "b" 'checkdoc-current-buffer) - (define-key pmap "B" 'checkdoc-ispell-current-buffer) - (define-key pmap "e" 'checkdoc-eval-current-buffer) - (define-key pmap "m" 'checkdoc-message-text) - (define-key pmap "M" 'checkdoc-ispell-message-text) - (define-key pmap "c" 'checkdoc-comments) - (define-key pmap "C" 'checkdoc-ispell-comments) - (define-key pmap " " 'checkdoc-rogue-spaces) + (define-key pmap "x" #'checkdoc-defun) + (define-key pmap "X" #'checkdoc-ispell-defun) + (define-key pmap "`" #'checkdoc-continue) + (define-key pmap "~" #'checkdoc-ispell-continue) + (define-key pmap "s" #'checkdoc-start) + (define-key pmap "S" #'checkdoc-ispell-start) + (define-key pmap "d" #'checkdoc) + (define-key pmap "D" #'checkdoc-ispell) + (define-key pmap "b" #'checkdoc-current-buffer) + (define-key pmap "B" #'checkdoc-ispell-current-buffer) + (define-key pmap "e" #'checkdoc-eval-current-buffer) + (define-key pmap "m" #'checkdoc-message-text) + (define-key pmap "M" #'checkdoc-ispell-message-text) + (define-key pmap "c" #'checkdoc-comments) + (define-key pmap "C" #'checkdoc-ispell-comments) + (define-key pmap " " #'checkdoc-rogue-spaces) ;; bind our submap into map (define-key map "\C-c?" pmap) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 53691881ec2..b44dda6f9d4 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -381,9 +381,9 @@ the specializer used will be the one returned by BODY." . ,(lambda () spec-args)) macroexpand-all-environment))) (require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'. - (when (interactive-form (cadr fun)) - (message "Interactive forms unsupported in generic functions: %S" - (interactive-form (cadr fun)))) + (when (assq 'interactive (cadr fun)) + (message "Interactive forms not supported in generic functions: %S" + (assq 'interactive (cadr fun)))) ;; First macroexpand away the cl-function stuff (e.g. &key and ;; destructuring args, `declare' and whatnot). (pcase (macroexpand fun macroenv) @@ -499,7 +499,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined lambda-doc ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil) - (org-name name)) + (orig-name name)) (while (cl-generic--method-qualifier-p args) (push args qualifiers) (setq args (pop body))) @@ -514,9 +514,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (byte-compile-warning-enabled-p 'obsolete name)) (let* ((obsolete (get name 'byte-obsolete-info))) (macroexp-warn-and-return - org-name (macroexp--obsolete-warning name obsolete "generic function") - nil))) + nil nil nil orig-name))) ;; You could argue that `defmethod' modifies rather than defines the ;; function, so warnings like "not known to be defined" are fair game. ;; But in practice, it's common to use `cl-defmethod' diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 470168177ca..50852172505 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2431,10 +2431,9 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (if malformed-bindings (let ((rev-malformed-bindings (nreverse malformed-bindings))) (macroexp-warn-and-return - rev-malformed-bindings (format-message "Malformed `cl-symbol-macrolet' binding(s): %S" rev-malformed-bindings) - expansion)) + expansion nil nil rev-malformed-bindings)) expansion))) (unless advised (advice-remove 'macroexpand #'cl--sm-macroexpand))))) @@ -3118,20 +3117,18 @@ To see the documentation for a defined struct type, use (when (cl-oddp (length desc)) (push (macroexp-warn-and-return - (car (last desc)) (format "Missing value for option `%S' of slot `%s' in struct %s!" (car (last desc)) slot name) - 'nil) + nil nil nil (car (last desc))) forms) (when (and (keywordp (car defaults)) (not (keywordp (car desc)))) (let ((kw (car defaults))) (push (macroexp-warn-and-return - kw (format " I'll take `%s' to be an option rather than a default value." kw) - 'nil) + nil nil nil kw) forms) (push kw desc) (setcar defaults nil)))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index ef60b266f9e..6aa45526d84 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -1,6 +1,6 @@ ;;; cl-preloaded.el --- Preloaded part of the CL library -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2021 Free Software Foundation, Inc +;; Copyright (C) 2015-2022 Free Software Foundation, Inc ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Package: emacs diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index ad956dabd8a..9eaf38067f6 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -454,18 +454,20 @@ Return them as multiple value." (declare (debug (range-body)) (indent defun)) `(with-comp-cstr-accessors - (when-let ((r1 (range ,src1)) - (r2 (range ,src2))) - (let* ((l1 (comp-cstr-smallest-in-range r1)) - (l2 (comp-cstr-smallest-in-range r2)) - (h1 (comp-cstr-greatest-in-range r1)) - (h2 (comp-cstr-greatest-in-range r2))) - (setf (typeset ,dst) (when (cl-some (lambda (x) - (comp-subtype-p 'float x)) - (append (typeset src1) - (typeset src2))) - '(float)) - (range ,dst) ,@range-body))))) + (if (or (neg src1) (neg src2)) + (setf (typeset ,dst) '(number)) + (when-let ((r1 (range ,src1)) + (r2 (range ,src2))) + (let* ((l1 (comp-cstr-smallest-in-range r1)) + (l2 (comp-cstr-smallest-in-range r2)) + (h1 (comp-cstr-greatest-in-range r1)) + (h2 (comp-cstr-greatest-in-range r2))) + (setf (typeset ,dst) (when (cl-some (lambda (x) + (comp-subtype-p 'float x)) + (append (typeset src1) + (typeset src2))) + '(float)) + (range ,dst) ,@range-body)))))) (defun comp-cstr-add-2 (dst src1 src2) "Sum SRC1 and SRC2 into DST." diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 3c61063a3cb..122638077ce 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1767,6 +1767,7 @@ This is responsible for generating the proper stack adjustment, when known, and the annotation emission." (declare (debug (body)) (indent defun)) + (declare-function comp-body-eff nil (body op-name sp-delta)) `(pcase op ,@(cl-loop for (op . body) in cases for sp-delta = (gethash op comp-op-stack-info) @@ -1831,7 +1832,9 @@ and the annotation emission." (byte-listp auto) (byte-eq auto) (byte-memq auto) - (byte-not null) + (byte-not + (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp)) + (make-comp-mvar :constant nil)))) (byte-car auto) (byte-cdr auto) (byte-cons auto) @@ -4195,9 +4198,9 @@ last directory in `native-comp-eln-load-path')." if (or (null byte+native-compile) (cl-notany (lambda (re) (string-match re file)) native-comp-bootstrap-deny-list)) - do (comp--native-compile file) + collect (comp--native-compile file) else - do (byte-compile-file file)))) + collect (byte-compile-file file)))) ;;;###autoload (defun batch-byte+native-compile () @@ -4211,14 +4214,19 @@ variable 'NATIVE_DISABLED' is set, only byte compile." (if (equal (getenv "NATIVE_DISABLED") "1") (batch-byte-compile) (cl-assert (length= command-line-args-left 1)) - (let ((byte+native-compile t) - (byte-to-native-output-buffer-file nil)) - (batch-native-compile) + (let* ((byte+native-compile t) + (byte-to-native-output-buffer-file nil) + (eln-file (car (batch-native-compile)))) (pcase byte-to-native-output-buffer-file (`(,temp-buffer . ,target-file) (unwind-protect - (byte-write-target-file temp-buffer target-file)) - (kill-buffer temp-buffer))) + (progn + (byte-write-target-file temp-buffer target-file) + ;; Touch the .eln in order to have it older than the + ;; corresponding .elc. + (when (stringp eln-file) + (set-file-times eln-file))) + (kill-buffer temp-buffer)))) (setq command-line-args-left (cdr command-line-args-left))))) ;;;###autoload diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 09c6ded2950..e5087672ae7 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -150,9 +150,11 @@ This function sets the match data that `copyright-update-year' uses." (when (copyright-re-search regexp (copyright-limit) t) ;; We may accidentally have landed in the middle of a ;; copyright line, so re-perform the search without the - ;; search. (Otherwise we may be inserting the new year in the + ;; limit. (Otherwise we may be inserting the new year in the ;; middle of the list of years.) - (goto-char (match-beginning 0)) + (if copyright-at-end-flag + (goto-char (match-end 0)) + (goto-char (match-beginning 0))) (copyright-re-search regexp nil t))))) (defun copyright-find-end () @@ -311,7 +313,7 @@ independently replaces consecutive years with a range." (> prev-year first-year)) (goto-char range-end) (delete-region range-start range-end) - (insert (format "%c%d" sep prev-year)) + (insert (format "-%d" prev-year)) (goto-char p)) (setq first-year year range-start (point))))) diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el new file mode 100644 index 00000000000..85ed5f2176c --- /dev/null +++ b/lisp/emacs-lisp/debug-early.el @@ -0,0 +1,87 @@ +;;; debug-early.el --- Dump a Lisp backtrace without frills -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Alan Mackenzie <acm@muc.de> +;; Maintainer: emacs-devel@gnu.org +;; Keywords: internal, backtrace, bootstrap. +;; Package: emacs + +;; 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: + +;; This file dumps a backtrace on stderr when an error is thrown. It +;; has no dependencies on any Lisp libraries and is thus used for +;; generating backtraces for bugs in the early parts of bootstrapping. +;; It is also always used in batch model. It was introduced in Emacs +;; 29, before which there was no backtrace available during early +;; bootstrap. + +;;; Code: + +(defalias 'debug-early-backtrace + #'(lambda () + "Print a trace of Lisp function calls currently active. +The output stream used is the value of `standard-output'. + +This is a simplified version of the standard `backtrace' +function, intended for use in debugging the early parts +of the build process." + (princ "\n") + (mapbacktrace + #'(lambda (evald func args _flags) + (let ((args args)) + (if evald + (progn + (princ " ") + (prin1 func) + (princ "(")) + (progn + (princ " (") + (setq args (cons func args)))) + (if args + (while (progn + (prin1 (car args)) + (setq args (cdr args))) + (princ " "))) + (princ ")\n")))))) + +(defalias 'debug-early + #'(lambda (&rest args) + "Print an error message with a backtrace of active Lisp function calls. +The output stream used is the value of `standard-output'. + +The Emacs core calls this function after an error has been +signaled, and supplies two ARGS. These are the symbol +`error' (which is ignored) and a cons of the error symbol and the +error data. + +`debug-early' is a simplified version of `debug', and is +available during the early parts of the build process. It is +superseded by `debug' after enough Lisp has been loaded to +support the latter, except in batch mode which always uses +`debug-early'. + +(In versions of Emacs prior to Emacs 29, no backtrace was +available before `debug' was usable.)" + (princ "\nError: ") + (prin1 (car (car (cdr args)))) ; The error symbol. + (princ " ") + (prin1 (cdr (car (cdr args)))) ; The error data. + (debug-early-backtrace))) + +;;; debug-early.el ends here. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 7bcb2f2936d..688c76e0c54 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -230,7 +230,6 @@ INIT-VALUE LIGHTER KEYMAP. (warnwrap (if (or (null body) (keywordp (car body))) #'identity (lambda (exp) (macroexp-warn-and-return - exp "Use keywords rather than deprecated positional arguments to `define-minor-mode'" exp)))) keyw keymap-sym tmp) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1720393b3e5..722283b88ff 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2577,6 +2577,13 @@ See `edebug-behavior-alist' for implementations.") ;; Let's at least show a backtrace so the user can figure out ;; which function we're talking about. (debug)) + ;; If we're in a `track-mouse' setting, then any previous mouse + ;; movements will make `input-pending-p' later return true. So + ;; discard the inputs in that case. (And `discard-input' doesn't + ;; work here.) + (when track-mouse + (while (input-pending-p) + (read-event))) ;; Setup windows for edebug, determine mode, maybe enter recursive-edit. ;; Uses local variables of edebug-enter, edebug-before, edebug-after ;; and edebug-debugger. @@ -3907,8 +3914,8 @@ Also see bindings for the eval list buffer *edebug* in `edebug-eval-mode'. The edebug buffer commands: \\{edebug-mode-map} -Global commands prefixed by `global-edebug-prefix': -\\{global-edebug-map} +Global commands prefixed by `edebug-global-prefix': +\\{edebug-global-map} Options: `edebug-setup-hook' @@ -4075,8 +4082,8 @@ buffer and \\<global-map>\\[edebug-step-mode] in any buffer. Eval list buffer commands: \\{edebug-eval-mode-map} -Global commands prefixed by `global-edebug-prefix': -\\{global-edebug-map}") +Global commands prefixed by `edebug-global-prefix': +\\{edebug-global-map}") ;;; Interface with standard debugger. diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 33aabf4a48e..19aa20fa086 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -215,7 +215,7 @@ It creates an autoload function for CNAME's constructor." (when eieio-backward-compatibility (set cname cname) (make-obsolete-variable cname (format "\ -use \\='%s or turn off `eieio-backward-compatibility' instead" cname) +use '%s or turn off `eieio-backward-compatibility' instead" cname) "25.1")) (setf (cl--find-class cname) newc) @@ -340,7 +340,7 @@ See `defclass' for more information." ;; turn this into a usable self-pointing symbol; FIXME: Why? (when eieio-backward-compatibility (set cname cname) - (make-obsolete-variable cname (format "use \\='%s instead" cname) + (make-obsolete-variable cname (format "use '%s instead" cname) "25.1")) ;; Create a handy list of the class test too @@ -362,7 +362,7 @@ See `defclass' for more information." (setq obj (cdr obj))) ans)))) (make-obsolete csym (format - "use (cl-typep ... \\='(list-of %s)) instead" + "use (cl-typep ... '(list-of %s)) instead" cname) "25.1"))) @@ -420,7 +420,7 @@ See `defclass' for more information." (progn (set initarg initarg) (make-obsolete-variable - initarg (format "use \\='%s instead" initarg) "25.1")))) + initarg (format "use '%s instead" initarg) "25.1")))) ;; The customgroup should be a list of symbols. (cond ((and (null customg) custom) @@ -748,9 +748,8 @@ Argument FN is the function calling this verifier." ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) (macroexp-warn-and-return - name (format-message "Unknown slot `%S'" name) - exp nil 'compile-only)) + exp nil 'compile-only name)) (_ exp)))) (gv-setter eieio-oset)) (cl-check-type slot symbol) @@ -785,15 +784,13 @@ Fills in CLASS's SLOT with its default value." ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) (macroexp-warn-and-return - name (format-message "Unknown slot `%S'" name) - exp nil 'compile-only)) + exp nil 'compile-only name)) ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-class-slot-names)))) (macroexp-warn-and-return - name (format-message "Slot `%S' is not class-allocated" name) - exp nil 'compile-only)) + exp nil 'compile-only name)) (_ exp))))) (cl-check-type class (or eieio-object class)) (cl-check-type slot symbol) @@ -849,15 +846,13 @@ Fills in the default value in CLASS' in SLOT with VALUE." ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-slot-names)))) (macroexp-warn-and-return - name (format-message "Unknown slot `%S'" name) - exp nil 'compile-only)) + exp nil 'compile-only name)) ((and (or `',name (and name (pred keywordp))) (guard (not (memq name eieio--known-class-slot-names)))) (macroexp-warn-and-return - name (format-message "Slot `%S' is not class-allocated" name) - exp nil 'compile-only)) + exp nil 'compile-only name)) (_ exp))))) (setq class (eieio--class-object class)) (cl-check-type class eieio--class) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 820e8383d86..1315ca0c627 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -246,7 +246,7 @@ This method is obsolete." `(progn ,@(mapcar (lambda (w) (macroexp-warn-and-return - (car w) (cdr w) `(progn ',(cdr w)) nil 'compile-only)) + (cdr w) `(progn ',(cdr w)) nil 'compile-only (car w))) warnings) ;; This test must be created right away so we can have self- ;; referencing classes. ei, a class whose slot can contain only @@ -260,7 +260,7 @@ This method is obsolete." (let ((f (intern (format "%s-child-p" name)))) `((defalias ',f #',testsym2) (make-obsolete - ',f ,(format "use (cl-typep ... \\='%s) instead" name) + ',f ,(format "use (cl-typep ... '%s) instead" name) "25.1")))) ;; When using typep, (typep OBJ 'myclass) returns t for objects which @@ -296,13 +296,13 @@ This method is obsolete." (if (not (stringp (car slots))) whole (macroexp-warn-and-return - (car slots) (format "Obsolete name arg %S to constructor %S" (car slots) (car whole)) ;; Keep the name arg, for backward compatibility, ;; but hide it so we don't trigger indefinitely. `(,(car whole) (identity ,(car slots)) - ,@(cdr slots))))))) + ,@(cdr slots)) + nil nil (car slots)))))) (apply #'make-instance ',name slots)))))) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 74a20b8a8b7..73713a3dec9 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -387,6 +387,10 @@ Also store it in `eldoc-last-message' and return that value." ;; conflicts with eldoc. (and (boundp 'show-paren-context-when-offscreen) show-paren-context-when-offscreen + ;; There's no conflict with the child-frame and + ;; overlay versions. + (not (memq show-paren-context-when-offscreen + '(child-frame overlay))) (not (pos-visible-in-window-p (overlay-end show-paren--overlay))))))) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index e5c94c09c27..385ddb3f414 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -287,7 +287,12 @@ type \"nil\" to use `elp-function-list'." "Instrument for profiling, all functions which start with PREFIX. For example, to instrument all ELP functions, do the following: - \\[elp-instrument-package] RET elp- RET" + \\[elp-instrument-package] RET elp- RET + +Note that only functions that are currently loaded will be +instrumented. If you run this function, and then later load +further functions that start with PREFIX, they will not be +instrumented automatically." (interactive (list (completing-read "Prefix of package to instrument: " obarray 'elp-profilable-p))) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 2818d4b6cc7..0e412a8d34e 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -475,6 +475,14 @@ The same keyword arguments are supported as in :directory t ,@body)) +(defun ert-gcc-is-clang-p () + "Return non-nil if the `gcc' command actually runs the Clang compiler." + ;; Some macOS machines run llvm when you type gcc. (!) + ;; We can't even check if it's a symlink; it's a binary placed in + ;; "/usr/bin/gcc". So we need to check the output. + (string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app" + (shell-command-to-string "gcc --version"))) + (provide 'ert-x) ;;; ert-x.el ends here diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 6eac25c1004..571087c963d 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -183,6 +183,16 @@ See the functions `find-function' and `find-variable'." :group 'find-function :version "20.3") +(defcustom find-library-include-other-files t + "If non-nil, `read-library-name' will also include non-library files. +This affects commands like `read-library'. + +If nil, only library files (i.e., \".el\" files) will be offered +for completion." + :type 'boolean + :version "29.1" + :group 'find-function) + ;;; Functions: (defun find-library-suffixes () @@ -302,7 +312,10 @@ TYPE should be nil to find a function, or `defvar' to find a variable." Interactively, prompt for LIBRARY using the one at or near point. This function searches `find-library-source-path' if non-nil, and -`load-path' otherwise." +`load-path' otherwise. + +See the `find-library-include-other-files' user option for +customizing the candidate completions." (interactive (list (read-library-name))) (prog1 (switch-to-buffer (find-file-noselect (find-library-name library))) @@ -317,8 +330,6 @@ in a directory under `load-path' (or `find-library-source-path', if non-nil)." (let* ((dirs (or find-library-source-path load-path)) (suffixes (find-library-suffixes)) - (table (apply-partially 'locate-file-completion-table - dirs suffixes)) (def (if (eq (function-called-at-point) 'require) ;; `function-called-at-point' may return 'require ;; with `point' anywhere on this line. So wrap the @@ -332,10 +343,28 @@ if non-nil)." (thing-at-point 'symbol)) (error nil)) (thing-at-point 'symbol)))) - (when (and def (not (test-completion def table))) - (setq def nil)) - (completing-read (format-prompt "Library name" def) - table nil nil nil nil def))) + (if find-library-include-other-files + (let ((table (apply-partially #'locate-file-completion-table + dirs suffixes))) + (when (and def (not (test-completion def table))) + (setq def nil)) + (completing-read (format-prompt "Library name" def) + table nil nil nil nil def)) + (let ((files (read-library-name--find-files dirs suffixes))) + (when (and def (not (member def files))) + (setq def nil)) + (completing-read (format-prompt "Library name" def) + files nil t nil nil def))))) + +(defun read-library-name--find-files (dirs suffixes) + "Return a list of all files in DIRS that match SUFFIXES." + (let ((files nil) + (regexp (concat (regexp-opt suffixes) "\\'"))) + (dolist (dir dirs) + (dolist (file (ignore-errors (directory-files dir nil regexp t))) + (and (string-match regexp file) + (push (substring file 0 (match-beginning 0)) files)))) + files)) ;;;###autoload (defun find-library-other-window (library) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 91538d1f06e..7cfa1f2dadc 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -581,9 +581,7 @@ This is like the `&' operator of the C language. Note: this only works reliably with lexical binding mode, except for very simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic binding mode." - (let ((org-place place) ; It's too difficult to determine by inspection whether - ; the functions modify place. - (code + (let ((code (gv-letplace (getter setter) place `(cons (lambda () ,getter) (lambda (gv--val) ,(funcall setter 'gv--val)))))) @@ -595,9 +593,8 @@ binding mode." (eq (car-safe code) 'cons)) code (macroexp-warn-and-return - org-place "Use of gv-ref probably requires lexical-binding" - code)))) + code nil nil place)))) (defsubst gv-deref (ref) "Dereference REF, returning the referenced value. diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index b871a832466..7c6f89deb11 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -111,8 +111,6 @@ ;;; Code: -(require 'mail-parse) - ;;; Variables: (defgroup lisp-mnt nil @@ -361,6 +359,8 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")" (defun lm-crack-address (x) "Split up email address(es) X into full name and real email address. The value is a list of elements of the form (FULLNAME . ADDRESS)." + (require 'mail-parse) + (declare-function mail-header-parse-addresses-lax "mail-parse" (string)) (mapcar (lambda (elem) (cons (cdr elem) (car elem))) (mail-header-parse-addresses-lax x))) @@ -505,7 +505,7 @@ absent, return nil." (if (and page (string-match (rx bol "<" (+ nonl) ">" eol) page)) (substring page 1 -1) page))) -(defalias 'lm-homepage 'lm-website) ; for backwards-compatibility +(defalias 'lm-homepage #'lm-website) ; for backwards-compatibility ;;; Verification and synopses diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 256092599b2..e91b302af10 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -160,14 +160,14 @@ Other uses risk returning non-nil value that point to the wrong file." (define-obsolete-function-alias 'macroexp--warn-and-return #'macroexp-warn-and-return "28.1") -(defun macroexp-warn-and-return (arg msg form &optional category compile-only) +(defun macroexp-warn-and-return (msg form &optional category compile-only arg) "Return code equivalent to FORM labeled with warning MSG. -ARG is a symbol (or a form) giving the source code position of FORM -for the message. It should normally be a symbol with position. CATEGORY is the category of the warning, like the categories that can appear in `byte-compile-warnings'. COMPILE-ONLY non-nil means no warning should be emitted if the code -is executed without being compiled first." +is executed without being compiled first. +ARG is a symbol (or a form) giving the source code position for the message. +It should normally be a symbol with position and it defaults to FORM." (cond ((null msg) form) ((macroexp-compiling-p) @@ -177,7 +177,7 @@ is executed without being compiled first." ;; macroexpand-all gets right back to macroexpanding `form'. form (puthash form form macroexp--warned) - (macroexp--warn-wrap arg msg form category))) + (macroexp--warn-wrap (or arg form) msg form category))) (t (unless compile-only (message "%sWarning: %s" @@ -233,12 +233,11 @@ is executed without being compiled first." (let* ((fun (car form)) (obsolete (get fun 'byte-obsolete-info))) (macroexp-warn-and-return - fun (macroexp--obsolete-warning fun obsolete (if (symbolp (symbol-function fun)) "alias" "macro")) - new-form (list 'obsolete fun))) + new-form (list 'obsolete fun) nil fun)) new-form))) (defun macroexp--unfold-lambda (form &optional name) @@ -289,12 +288,11 @@ is executed without being compiled first." (setq arglist (cdr arglist))) (if values (macroexp-warn-and-return - arglist (format (if (eq values 'too-few) "attempt to open-code `%s' with too few arguments" "attempt to open-code `%s' with too many arguments") name) - form) + form nil nil arglist) ;; The following leads to infinite recursion when loading a ;; file containing `(defsubst f () (f))', and then trying to @@ -365,9 +363,8 @@ Assumes the caller has bound `macroexpand-all-environment'." (if (null body) (macroexp-unprogn (macroexp-warn-and-return - fun (format "Empty %s body" fun) - nil nil 'compile-only)) + nil nil 'compile-only fun)) (macroexp--all-forms body)) (cdr form)) form))) @@ -405,11 +402,10 @@ Assumes the caller has bound `macroexpand-all-environment'." (eq 'lambda (car-safe (cadr arg)))) (setcar (nthcdr funarg form) (macroexp-warn-and-return - (cadr arg) (format "%S quoted with ' rather than with #'" (let ((f (cadr arg))) (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) - arg))))) + arg nil nil (cadr arg)))))) ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can ;; use macros. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bd688404eb8..fe6b1e639fc 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1006,7 +1006,8 @@ untar into a directory named DIR; otherwise, signal an error." "Make sure that the autoload file FILE exists and if not create it." (unless (file-exists-p file) (require 'autoload) - (write-region (autoload-rubric file "package" nil) nil file nil 'silent)) + (let ((coding-system-for-write 'utf-8-emacs-unix)) + (write-region (autoload-rubric file "package" nil) nil file nil 'silent))) file) (defvar autoload-timestamps) @@ -2040,6 +2041,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." package-alist)))) (setf (package-desc-signed (car pkg-descs)) t)))))))))) +;;;###autoload (defun package-installed-p (package &optional min-version) "Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed. If PACKAGE is a symbol, it is the package name and MIN-VERSION diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index c3dbfe29473..0330a2a0aba 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -433,10 +433,9 @@ how many time this CODEGEN is called." (memq (car case) pcase--dontwarn-upats)) (setq main (macroexp-warn-and-return - (car case) (format "pcase pattern %S shadowed by previous pcase pattern" (car case)) - main)))) + main nil nil (car case))))) main))) (defun pcase--expand (exp cases) @@ -941,9 +940,8 @@ Otherwise, it defers to REST which is a list of branches of the form (let ((code (pcase--u1 matches code vars rest))) (if (eq upat '_) code (macroexp-warn-and-return - upat "Pattern t is deprecated. Use `_' instead" - code)))) + code nil nil upat)))) ((eq upat 'pcase--dontcare) :pcase--dontcare) ((memq (car-safe upat) '(guard pred)) (if (eq (car upat) 'pred) (pcase--mark-used sym)) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 38726ca048e..24770fac67f 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -323,7 +323,10 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (reb-lisp-mode)) (t (reb-mode))) (reb-restart-font-lock) - (reb-do-update)) + ;; When using `rx' syntax, the initial syntax () is invalid. But + ;; don't signal an error in that case. + (ignore-errors + (reb-do-update))) (defun reb-mode-buffer-p () "Return non-nil if the current buffer is a RE Builder buffer." diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index b2283e66e4f..2bab1319132 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1301,9 +1301,9 @@ Only meaningful when called from within `smie-rules-function'." (let ((afterpos (save-excursion (let ((tok (funcall smie-forward-token-function))) (unless tok - (with-demoted-errors - (error "smie-rule-separator: Can't skip token %s" - smie--token)))) + (funcall (if debug-on-error #'error #'message) + "smie-rule-separator: Can't skip token %s" + smie--token))) (skip-chars-forward " ") (unless (eolp) (point))))) (or (and afterpos @@ -1820,7 +1820,7 @@ to which that point should be aligned, if we were to reindent it.") "Indent current line using the SMIE indentation engine." (interactive) (let* ((savep (point)) - (indent (or (with-demoted-errors + (indent (or (with-demoted-errors "SMIE Error: %S" (save-excursion (forward-line 0) (skip-chars-forward " \t") @@ -1846,7 +1846,7 @@ to which that point should be aligned, if we were to reindent it.") (move-to-column fc) (syntax-ppss)))) (while - (and (with-demoted-errors + (and (with-demoted-errors "SMIE Error: %S" (save-excursion (let ((end (point)) (bsf nil) ;Best-so-far. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 1f69850958c..7ad4e9ba2ab 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -444,9 +444,14 @@ is inserted before adjusting the number of empty lines." ;;;###autoload (defun string-pixel-width (string) "Return the width of STRING in pixels." - (with-temp-buffer - (insert string) - (car (buffer-text-pixel-size nil nil t)))) + (if (zerop (length string)) + 0 + ;; Keeping a work buffer around is more efficient than creating a + ;; new temporary buffer. + (with-current-buffer (get-buffer-create " *string-pixel-width*") + (delete-region (point-min) (point-max)) + (insert string) + (car (buffer-text-pixel-size nil nil t))))) ;;;###autoload (defun string-glyph-split (string) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index a242ac1899d..b740a7457af 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -745,13 +745,19 @@ Interactively, N is the prefix numeric argument, and defaults to (max (setq col-width (cadr (aref tabulated-list-format col-nb))) - (string-width (aref entry col-nb))) + (let ((desc (aref entry col-nb))) + (string-width (if (stringp desc) + desc + (car desc))))) (or (plist-get (nthcdr 3 (aref tabulated-list-format col-nb)) :pad-right) 1)))) (setq col-nb (1+ col-nb)) (setq found t) + ;; `tabulated-list-format' may be a constant (sharing list + ;; structures), so copy it before mutating. + (setq tabulated-list-format (copy-tree tabulated-list-format t)) (setf (cadr (aref tabulated-list-format col-nb)) (max 1 (+ col-width n))) (tabulated-list-print t) diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el new file mode 100644 index 00000000000..2c61996637f --- /dev/null +++ b/lisp/emacs-lisp/vtable.el @@ -0,0 +1,758 @@ +;;; vtable.el --- Displaying data in tables -*- 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: + +;; + +;;; Code: + +(require 'cl-lib) +(require 'eieio) +(require 'text-property-search) +(require 'mule-util) + +(cl-defstruct vtable-column + "A vtable column." + name + width + min-width + max-width + primary + align + getter + formatter + displayer + -numerical) + +(defclass vtable () + ((columns :initarg :columns :accessor vtable-columns) + (objects :initarg :objects :accessor vtable-objects) + (objects-function :initarg :objects-function + :accessor vtable-objects-function) + (getter :initarg :getter :accessor vtable-getter) + (formatter :initarg :formatter :accessor vtable-formatter) + (displayer :initarg :displayer :accessor vtable-displayer) + (use-header-line :initarg :use-header-line + :accessor vtable-use-header-line) + (face :initarg :face :accessor vtable-face) + (actions :initarg :actions :accessor vtable-actions) + (keymap :initarg :keymap :accessor vtable-keymap) + (separator-width :initarg :separator-width :accessor vtable-separator-width) + (sort-by :initarg :sort-by :accessor vtable-sort-by) + (ellipsis :initarg :ellipsis :accessor vtable-ellipsis) + (-cache :initform (make-hash-table :test #'equal))) + "A object to hold the data for a table.") + +(defvar-keymap vtable-map + "S" #'vtable-sort-by-current-column + "{" #'vtable-narrow-current-column + "}" #'vtable-widen-current-column + "g" #'vtable-revert-command + "M-<left>" #'vtable-previous-column + "M-<right>" #'vtable-next-column) + +(defvar-keymap vtable-header-line-map + :parent vtable-map + "<follow-link>" 'mouse-face + "<mouse-2>" #'vtable-header-line-sort) + +(cl-defun make-vtable (&key columns objects objects-function + getter + formatter + displayer + (use-header-line t) + (face 'variable-pitch) + actions keymap + (separator-width 1) + sort-by + (ellipsis t) + (insert t)) + "Create and insert a vtable at point. +The vtable object is returned. If INSERT is nil, the table won't +be inserted." + (when objects-function + (setq objects (funcall objects-function))) + ;; Auto-generate the columns. + (unless columns + (unless objects + (error "Can't auto-generate columns; no objects")) + (setf columns (make-list (length (car objects)) ""))) + (setq columns (mapcar (lambda (column) + (cond + ;; We just have the name (as a string). + ((stringp column) + (make-vtable-column :name column)) + ;; A plist of keywords/values. + ((listp column) + (apply #'make-vtable-column column)) + ;; A full `vtable-column' object. + (t + column))) + columns)) + ;; We'll be altering the list, so create a copy. + (setq objects (copy-sequence objects)) + (let ((table + (make-instance 'vtable + :columns columns + :objects objects + :objects-function objects-function + :getter getter + :formatter formatter + :displayer displayer + :use-header-line use-header-line + :face face + :actions actions + :keymap keymap + :separator-width separator-width + :sort-by sort-by + :ellipsis ellipsis))) + ;; Compute missing column data. + (setf (vtable-columns table) (vtable--compute-columns table)) + (unless sort-by + (seq-do-indexed (lambda (column index) + (when (vtable-column-primary column) + (push (cons index (vtable-column-primary column)) + (vtable-sort-by table)))) + (vtable-columns table))) + (when insert + (vtable-insert table)) + table)) + +;;; Interface utility functions. + +(defun vtable-current-table () + "Return the table under point." + (get-text-property (point) 'vtable)) + +(defun vtable-current-object () + "Return the object under point." + (get-text-property (point) 'vtable-object)) + +(defun vtable-current-column () + "Return the index of the column under point." + (get-text-property (point) 'vtable-column)) + +(defun vtable-beginning-of-table () + "Go to the start of the current table." + (if (text-property-search-backward 'vtable (vtable-current-table)) + (point) + (goto-char (point-min)))) + +(defun vtable-end-of-table () + "Go to the end of the current table." + (if (text-property-search-forward 'vtable (vtable-current-table)) + (point) + (goto-char (point-max)))) + +(defun vtable-goto-object (object) + "Go to OBJECT in the current table. +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)) + (if (text-property-search-forward 'vtable-object object #'eq) + (progn + (forward-line -1) + (point)) + (goto-char start) + nil)))) + +(defun vtable-goto-table (table) + "Go to TABLE in the current buffer. +If TABLE is found, return the position of the start of the table. +If it can't be found, return nil and don't move point." + (let ((start (point))) + (goto-char (point-min)) + (if-let ((match (text-property-search-forward 'vtable table t))) + (goto-char (prop-match-beginning match)) + (goto-char start) + nil))) + +(defun vtable-goto-column (column) + "Go to COLUMN on the current line." + (beginning-of-line) + (if-let ((match (text-property-search-forward 'vtable-column column t))) + (goto-char (prop-match-beginning match)) + (end-of-line))) + +(defun vtable-update-object (table object old-object) + "Replace OLD-OBJECT in TABLE with OBJECT." + (let* ((objects (vtable-objects table)) + (inhibit-read-only t)) + ;; First replace the object in the object storage. + (if (eq old-object (car objects)) + ;; It's at the head, so replace it there. + (setf (vtable-objects table) + (cons object (cdr objects))) + ;; Otherwise splice into the list. + (while (and (cdr objects) + (not (eq (cadr objects) old-object))) + (setq objects (cdr objects))) + (unless objects + (error "Can't find the old object")) + (setcar (cdr objects) object)) + ;; Then update the cache... + (let ((line (assq old-object (car (vtable--cache table))))) + (unless line + (error "Can't find cached object")) + (setcar line object) + (setcdr line (vtable--compute-cached-line table object)) + ;; ... and redisplay the line in question. + (save-excursion + (vtable-goto-object old-object) + (let ((keymap (get-text-property (point) 'keymap)) + (start (point))) + (delete-line) + (vtable--insert-line table line (nth 1 (vtable--cache table)) + (vtable--spacer table)) + (add-text-properties start (point) (list 'keymap keymap + 'vtable table)))) + ;; We may have inserted a non-numerical value into a previously + ;; all-numerical table, so recompute. + (vtable--recompute-numerical table (cdr line))))) + +(defun vtable-remove-object (table object) + "Remove OBJECT from TABLE. +This will also remove the displayed line." + ;; First remove from the objects. + (setf (vtable-objects table) (delq object (vtable-objects table))) + ;; Then adjust the cache and display. + (let ((cache (vtable--cache table)) + (inhibit-read-only t)) + (setcar cache (delq (assq object (car cache)) (car cache))) + (save-excursion + (vtable-goto-table table) + (when (vtable-goto-object object) + (delete-line))))) + +(defun vtable-insert-object (table object &optional after-object) + "Insert OBJECT into TABLE after AFTER-OBJECT. +If AFTER-OBJECT is nil (or doesn't exist in the table), insert +OBJECT at the end. +This also updates the displayed table." + ;; First insert into the objects. + (let (pos) + (if (and after-object + (setq pos (memq after-object (vtable-objects table)))) + ;; Splice into list. + (setcdr pos (cons object (cdr pos))) + ;; Append. + (nconc (vtable-objects table) (list object)))) + ;; Then adjust the cache and display. + (save-excursion + (vtable-goto-table table) + (let* ((cache (vtable--cache table)) + (inhibit-read-only t) + (keymap (get-text-property (point) 'keymap)) + (elem (and after-object + (assq after-object (car cache)))) + (line (cons object (vtable--compute-cached-line table object)))) + (if (not elem) + ;; Append. + (progn + (setcar cache (nconc (car cache) (list line))) + (vtable-end-of-table)) + ;; Splice into list. + (let ((pos (memq elem (car cache)))) + (setcdr pos (cons line (cdr pos))) + (unless (vtable-goto-object after-object) + (vtable-end-of-table)))) + (let ((start (point))) + (vtable--insert-line table line (nth 1 cache) (vtable--spacer table)) + (add-text-properties start (point) (list 'keymap keymap + 'vtable table))) + ;; We may have inserted a non-numerical value into a previously + ;; all-numerical table, so recompute. + (vtable--recompute-numerical table (cdr line))))) + +(defun vtable-column (table index) + "Return the name of the INDEXth column in TABLE." + (vtable-column-name (elt (vtable-columns table) index))) + +;;; Generating the table. + +(defun vtable--get-value (object index column table) + "Compute a cell value." + (cond + ((vtable-column-getter column) + (funcall (vtable-column-getter column) + object table)) + ((vtable-getter table) + (funcall (vtable-getter table) + object index table)) + ;; No getter functions; standard getters. + ((stringp object) + object) + (t + (elt object index)))) + +(defun vtable--compute-columns (table) + (let ((numerical (make-vector (length (vtable-columns table)) t)) + (columns (vtable-columns table))) + ;; First determine whether there are any all-numerical columns. + (dolist (object (vtable-objects table)) + (seq-do-indexed + (lambda (_elem index) + (unless (numberp (vtable--get-value object index (elt columns index) + table)) + (setf (elt numerical index) nil))) + (vtable-columns table))) + ;; Then fill in defaults. + (seq-map-indexed + (lambda (column index) + ;; This is used when displaying. + (unless (vtable-column-align column) + (setf (vtable-column-align column) + (if (elt numerical index) + 'right + 'left))) + ;; This is used for sorting. + (setf (vtable-column--numerical column) + (elt numerical index)) + column) + (vtable-columns table)))) + +(defun vtable--spacer (table) + (vtable--compute-width table (vtable-separator-width table))) + +(defun vtable-insert (table) + (let* ((spacer (vtable--spacer table)) + (start (point)) + (ellipsis (if (vtable-ellipsis table) + (propertize (truncate-string-ellipsis) + 'face (vtable-face table)) + "")) + (ellipsis-width (string-pixel-width ellipsis)) + data widths) + ;; We maintain a cache per screen/window width, so that we render + ;; correctly if Emacs is open on two different screens (or the + ;; user resizes the frame). + (if-let ((cache (vtable--cache table))) + (setq data (nth 0 cache) + widths (nth 1 cache)) + (setq data (vtable--compute-cache table) + widths (vtable--compute-widths table data)) + (setf (gethash (vtable--cache-key) (slot-value table '-cache)) + (list data widths))) + (if (vtable-use-header-line table) + (vtable--set-header-line table widths spacer) + ;; Insert the header line directly into the buffer, and put a + ;; keymap to be able to sort the columns there (by clicking on + ;; them). + (vtable--insert-header-line table widths spacer) + (add-text-properties start (point) + (list 'keymap vtable-header-line-map + 'rear-nonsticky t + 'vtable table)) + (setq start (point))) + (vtable--sort table) + ;; Insert the data. + (dolist (line (car (vtable--cache table))) + (vtable--insert-line table line widths spacer + ellipsis ellipsis-width)) + (add-text-properties start (point) + (list 'keymap (vtable--make-keymap table) + 'rear-nonsticky t + 'vtable table)) + (goto-char start))) + +(defun vtable--insert-line (table line widths spacer + &optional ellipsis ellipsis-width) + (let ((start (point)) + (columns (vtable-columns table))) + (seq-do-indexed + (lambda (elem index) + (let ((value (nth 0 elem)) + (column (elt columns index)) + (pre-computed (nth 2 elem))) + ;; See if we have any formatters here. + (cond + ((vtable-column-formatter column) + (setq value (funcall (vtable-column-formatter column) value) + pre-computed nil)) + ((vtable-formatter table) + (setq value (funcall (vtable-formatter table) + value index table) + pre-computed nil))) + (let ((displayed + ;; Allow any displayers to have their say. + (cond + ((vtable-column-displayer column) + (funcall (vtable-column-displayer column) + value (elt widths index) table)) + ((vtable-displayer table) + (funcall (vtable-displayer table) + value index (elt widths index) table)) + (pre-computed + ;; If we don't have a displayer, use the pre-made + ;; (cached) string value. + (if (> (nth 1 elem) (elt widths index)) + (concat + (vtable--limit-string + pre-computed (- (elt widths index) ellipsis-width)) + ellipsis) + pre-computed)) + ;; Recompute widths. + (t + (if (> (string-pixel-width value) (elt widths index)) + (concat + (vtable--limit-string + value (- (elt widths index) ellipsis-width)) + ellipsis) + value)))) + (start (point))) + (if (eq (vtable-column-align column) 'left) + (insert displayed + (propertize + " " 'display + (list 'space + :width (list + (+ (- (elt widths index) + (string-pixel-width displayed)) + spacer))))) + ;; Align to the right. + (insert (propertize " " 'display + (list 'space + :width (list (- (elt widths index) + (string-pixel-width + displayed))))) + displayed + (propertize " " 'display + (list 'space + :width (list spacer))))) + (put-text-property start (point) 'vtable-column index)))) + (cdr line)) + (insert "\n") + (put-text-property start (point) 'vtable-object (car line)))) + +(defun vtable--cache-key () + (cons (frame-terminal) (window-width))) + +(defun vtable--cache (table) + (gethash (vtable--cache-key) (slot-value table '-cache))) + +(defun vtable--clear-cache (table) + (setf (gethash (vtable--cache-key) (slot-value table '-cache)) nil)) + +(defun vtable--sort (table) + (pcase-dolist (`(,index . ,direction) (vtable-sort-by table)) + (let ((cache (vtable--cache table)) + (numerical (vtable-column--numerical + (elt (vtable-columns table) index)))) + (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))))))) + +(defun vtable--indicator (table index) + (let ((order (car (last (vtable-sort-by table))))) + (if (eq index (car order)) + ;; We're sorting by this column last, so return an indicator. + (catch 'found + (dolist (candidate (nth (if (eq (cdr order) 'ascend) + 1 + 0) + '((?▼ ?v) + (?▲ ?^)))) + (when (char-displayable-p candidate) + (throw 'found (string candidate))))) + ""))) + +(defun vtable--insert-header-line (table widths spacer) + ;; Insert the header directly into the buffer. + (let* ((start (point))) + (seq-do-indexed + (lambda (column index) + (let* ((name (propertize + (vtable-column-name column) + 'face (list 'header-line (vtable-face table)))) + (start (point)) + (indicator (vtable--indicator table index)) + (indicator-width (string-pixel-width indicator)) + displayed) + (insert + (setq displayed + (concat + (if (> (string-pixel-width name) + (- (elt widths index) indicator-width)) + (vtable--limit-string + name (- (elt widths index) indicator-width)) + name) + indicator)) + (propertize " " 'display + (list 'space :width + (list (+ (- (elt widths index) + (string-pixel-width displayed)) + spacer))))) + (put-text-property start (point) 'vtable-column index))) + (vtable-columns table)) + (insert "\n") + (add-face-text-property start (point) 'header-line))) + +(defun vtable--recompute-numerical (table line) + "Recompute numericalness of columns if necessary." + (let ((columns (vtable-columns table)) + (recompute nil)) + (seq-do-indexed + (lambda (elem index) + (when (and (vtable-column--numerical (elt columns index)) + (not (numberp elem))) + (setq recompute t))) + line) + (when recompute + (vtable--compute-columns table)))) + +(defun vtable--set-header-line (table widths spacer) + (setq header-line-format + (string-replace + "%" "%%" + (with-temp-buffer + (insert " ") + (vtable--insert-header-line table widths spacer) + ;; Align the header with the (possibly) fringed buffer text. + (put-text-property + (point-min) (1+ (point-min)) + 'display '(space :align-to 0)) + (buffer-substring (point-min) (1- (point-max)))))) + (vtable-header-mode 1)) + +(defun vtable--limit-string (string pixels) + (while (and (length> string 0) + (> (string-pixel-width string) pixels)) + (setq string (substring string 0 (1- (length string))))) + string) + +(defun vtable--char-width (table) + (string-pixel-width (propertize "x" 'face (vtable-face table)))) + +(defun vtable--compute-width (table spec) + (cond + ((numberp spec) + (* spec (vtable--char-width table))) + ((string-match "\\([0-9.]+\\)ex" spec) + (* (string-to-number (match-string 1 spec)) (vtable--char-width table))) + ((string-match "\\([0-9.]+\\)px" spec) + (string-to-number (match-string 1 spec))) + ((string-match "\\([0-9.]+\\)%" spec) + (* (string-to-number (match-string 1 spec)) (window-width nil t))) + (t + (error "Invalid spec: %s" spec)))) + +(defun vtable--compute-widths (table cache) + "Compute the display widths for TABLE." + (seq-into + (seq-map-indexed + (lambda (column index) + (let ((width + (or + ;; Explicit widths. + (and (vtable-column-width column) + (vtable--compute-width table (vtable-column-width column))) + ;; Compute based on the displayed widths of + ;; the data. + (seq-max (seq-map (lambda (elem) + (nth 1 (elt (cdr elem) index))) + cache))))) + ;; Let min-width/max-width specs have their say. + (when-let ((min-width (and (vtable-column-min-width column) + (vtable--compute-width + table (vtable-column-min-width column))))) + (setq width (max width min-width))) + (when-let ((max-width (and (vtable-column-max-width column) + (vtable--compute-width + table (vtable-column-max-width column))))) + (setq width (min width max-width))) + width)) + (vtable-columns table)) + 'vector)) + +(defun vtable--compute-cache (table) + (seq-map + (lambda (object) + (cons object (vtable--compute-cached-line table object))) + (vtable-objects table))) + +(defun vtable--compute-cached-line (table object) + (seq-map-indexed + (lambda (column index) + (let* ((value (vtable--get-value object index column table)) + (string (if (stringp value) + (copy-sequence value) + (format "%s" value)))) + (add-face-text-property 0 (length string) + (vtable-face table) + t string) + ;; We stash the computed width and string here -- if there are + ;; no formatters/displayers, we'll be using the string, and + ;; then won't have to recreate it. + (list value (string-pixel-width string) string))) + (vtable-columns table))) + +(defun vtable--make-keymap (table) + (let ((map (if (or (vtable-actions table) + (vtable-keymap table)) + (copy-keymap vtable-map) + vtable-map))) + (when-let ((actions (vtable-actions table))) + (while actions + (funcall (lambda (key binding) + (keymap-set map key + (lambda (object) + (interactive (list (vtable-current-object))) + (funcall binding object)))) + (car actions) (cadr actions)) + (setq actions (cddr actions)))) + (if (vtable-keymap table) + (progn + (setf (vtable-keymap table) + (copy-keymap (vtable-keymap table))) + ;; Respect any previously set parent keymaps. + (set-keymap-parent (vtable-keymap table) + (if (keymap-parent (vtable-keymap table)) + (append (ensure-list + (vtable-keymap table)) + (list map)) + map)) + (vtable-keymap table)) + map))) + +(defun vtable-revert () + "Regenerate the table under point." + (let ((table (vtable-current-table)) + (object (vtable-current-object)) + (column (vtable-current-column)) + (inhibit-read-only t)) + (unless table + (user-error "No table under point")) + (delete-region (vtable-beginning-of-table) (vtable-end-of-table)) + (vtable-insert table) + (when object + (vtable-goto-object object)) + (when column + (vtable-goto-column column)))) + +(defun vtable--widths (table) + (nth 1 (vtable--cache table))) + +;;; Commands. + +(defvar-keymap vtable-header-mode-map + "<header-line> <mouse-1>" 'vtable-header-line-sort + "<header-line> <mouse-2>" 'vtable-header-line-sort) + +(define-minor-mode vtable-header-mode + "Minor mode for buffers with vtables with headers." + :keymap vtable-header-mode-map) + +(defun vtable-narrow-current-column () + "Narrow the current column." + (interactive) + (let* ((table (vtable-current-table)) + (column (vtable-current-column)) + (widths (vtable--widths table))) + (setf (aref widths column) + (max (* (vtable--char-width table) 2) + (- (aref widths column) (vtable--char-width table)))) + (vtable-revert))) + +(defun vtable-widen-current-column () + "Widen the current column." + (interactive) + (let* ((table (vtable-current-table)) + (column (vtable-current-column)) + (widths (nth 1 (vtable--cache table)))) + (cl-incf (aref widths column) (vtable--char-width table)) + (vtable-revert))) + +(defun vtable-previous-column () + "Go to the previous column." + (interactive) + (vtable-goto-column + (max 0 (1- (or (vtable-current-column) + (length (vtable--widths (vtable-current-table)))))))) + +(defun vtable-next-column () + "Go to the next column." + (interactive) + (when (vtable-current-column) + (vtable-goto-column + (min (1- (length (vtable--widths (vtable-current-table)))) + (1+ (vtable-current-column)))))) + +(defun vtable-revert-command () + "Re-query data and regenerate the table under point." + (interactive) + (let ((table (vtable-current-table))) + (when (vtable-objects-function table) + (setf (vtable-objects table) (funcall (vtable-objects-function table)))) + (vtable--clear-cache table)) + (vtable-revert)) + +(defun vtable-sort-by-current-column () + "Sort the table under point by the column under point." + (interactive) + (unless (vtable-current-column) + (user-error "No current column")) + (let* ((table (vtable-current-table)) + (last (car (last (vtable-sort-by table)))) + (index (vtable-current-column))) + ;; First prune any previous appearance of this column. + (setf (vtable-sort-by table) + (delq (assq index (vtable-sort-by table)) + (vtable-sort-by table))) + ;; Then insert this as the last sort key. + (setf (vtable-sort-by table) + (append (vtable-sort-by table) + (list (cons index + (if (eq (car last) index) + (if (eq (cdr last) 'ascend) + 'descend + 'ascend) + 'ascend)))))) + (vtable-revert)) + +(defun vtable-header-line-sort (e) + "Sort a vtable from the header line." + (interactive "e") + (let* ((pos (event-start e)) + (obj (posn-object pos))) + (with-current-buffer (window-buffer (posn-window pos)) + (goto-char (point-min)) + (vtable-goto-column + (get-text-property (if obj (cdr obj) (posn-point pos)) + 'vtable-column + (car obj))) + (vtable-sort-by-current-column)))) + +(provide 'vtable) + +;;; vtable.el ends here diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index c6a51b1793e..b79475f6e07 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -314,7 +314,7 @@ to writing a completion function." (defun eshell-complete-parse-arguments () "Parse the command line arguments for `pcomplete-argument'." (when (and eshell-no-completion-during-jobs - (eshell-interactive-process)) + (eshell-interactive-process-p)) (insert-and-inherit "\t") (throw 'pcompleted t)) (let ((end (point-marker)) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 893cad7b4fb..3998026d7f4 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -391,6 +391,10 @@ in the minibuffer: (unless (equal curdir newdir) (eshell-add-to-dir-ring curdir)) (let ((result (cd newdir))) + ;; If we're in "/" and cd to ".." or the like, make things + ;; less confusing by changing "/.." to "/". + (when (equal (file-truename result) "/") + (setq result (cd "/"))) (and eshell-cd-shows-directory (eshell-printn result))) (run-hooks 'eshell-directory-change-hook) diff --git a/lisp/eshell/em-extpipe.el b/lisp/eshell/em-extpipe.el index 57aeec38ff6..eb5b3bfe1df 100644 --- a/lisp/eshell/em-extpipe.el +++ b/lisp/eshell/em-extpipe.el @@ -30,6 +30,7 @@ (require 'cl-lib) (require 'esh-arg) +(require 'esh-cmd) (require 'esh-io) (require 'esh-util) @@ -97,15 +98,21 @@ as though it were Eshell syntax." (while (> bound (point)) (let* ((found (save-excursion - (re-search-forward "['\"\\]" bound t))) + (re-search-forward + "\\(?:#?'\\|\"\\|\\\\\\)" bound t))) (next (or (and found (match-beginning 0)) bound))) (if (re-search-forward pat next t) (throw 'found (match-beginning 1)) (goto-char next) - (while (or (eshell-parse-backslash) + (while (or (eshell-parse-lisp-argument) + (eshell-parse-backslash) (eshell-parse-double-quote) - (eshell-parse-literal-quote))))))))) + (eshell-parse-literal-quote))) + ;; Guard against an infinite loop if none of + ;; the parsers moved us forward. + (unless (or (> (point) next) (eobp)) + (forward-char 1)))))))) (goto-char (if (and result go) (match-end 0) start)) result))) (unless (or eshell-current-argument eshell-current-quoted) diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index f24758d4e34..2b56c9e8444 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -238,7 +238,7 @@ lock it at that." Sends an EOF only if point is at the end of the buffer and there is no input." (interactive "p") - (let ((proc (eshell-interactive-process))) + (let ((proc (eshell-head-process))) (if (eobp) (cond ((/= (point) eshell-last-output-end) diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index e34c5ae47ce..d150c07b030 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -224,7 +224,7 @@ the buffer." ; (defun eshell-term-send-raw-string (chars) ; (goto-char eshell-last-output-end) -; (process-send-string (eshell-interactive-process) chars)) +; (process-send-string (eshell-head-process) chars)) ; (defun eshell-term-send-raw () ; "Send the last character typed through the terminal-emulator diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index e9018bdb934..aebbc36e71d 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -61,37 +61,33 @@ "Alias \"su\" to call TRAMP. Uses the system su through TRAMP's su method." - (setq args (eshell-stringify-list (flatten-tree args))) - (let ((orig-args (copy-tree args))) - (eshell-eval-using-options - "su" args - '((?h "help" nil nil "show this usage screen") - (?l "login" nil login "provide a login environment") - (? nil nil login "provide a login environment") - :usage "[- | -l | --login] [USER] + (eshell-eval-using-options + "su" args + '((?h "help" nil nil "show this usage screen") + (?l "login" nil login "provide a login environment") + (? nil nil login "provide a login environment") + :usage "[- | -l | --login] [USER] Become another USER during a login session.") - (throw 'eshell-replace-command - (let ((user "root") - (host (or (file-remote-p default-directory 'host) - "localhost")) - (dir (file-local-name (expand-file-name default-directory))) - (prefix (file-remote-p default-directory))) - (dolist (arg args) - (if (string-equal arg "-") (setq login t) (setq user arg))) - ;; `eshell-eval-using-options' does not handle "-". - (if (member "-" orig-args) (setq login t)) - (if login (setq dir "~/")) - (if (and prefix - (or - (not (string-equal - "su" (file-remote-p default-directory 'method))) - (not (string-equal - user (file-remote-p default-directory 'user))))) - (eshell-parse-command - "cd" (list (format "%s|su:%s@%s:%s" - (substring prefix 0 -1) user host dir))) - (eshell-parse-command - "cd" (list (format "/su:%s@%s:%s" user host dir))))))))) + (throw 'eshell-replace-command + (let ((user "root") + (host (or (file-remote-p default-directory 'host) + tramp-default-host)) + (dir (file-local-name (expand-file-name default-directory))) + (prefix (file-remote-p default-directory))) + (dolist (arg args) + (if (string-equal arg "-") (setq login t) (setq user arg))) + (when login (setq dir "~/")) + (if (and prefix + (or + (not (string-equal + "su" (file-remote-p default-directory 'method))) + (not (string-equal + user (file-remote-p default-directory 'user))))) + (eshell-parse-command + "cd" (list (format "%s|su:%s@%s:%s" + (substring prefix 0 -1) user host dir))) + (eshell-parse-command + "cd" (list (format "/su:%s@%s:%s" user host dir)))))))) (put 'eshell/su 'eshell-no-numeric-conversions t) @@ -99,41 +95,35 @@ Become another USER during a login session.") "Alias \"sudo\" to call Tramp. Uses the system sudo through TRAMP's sudo method." - (setq args (eshell-stringify-list (flatten-tree args))) - (let ((orig-args (copy-tree args))) - (eshell-eval-using-options - "sudo" args - '((?h "help" nil nil "show this usage screen") - (?u "user" t user "execute a command as another USER") - :show-usage - :parse-leading-options-only - :usage "[(-u | --user) USER] COMMAND + (eshell-eval-using-options + "sudo" args + '((?h "help" nil nil "show this usage screen") + (?u "user" t user "execute a command as another USER") + :show-usage + :parse-leading-options-only + :usage "[(-u | --user) USER] COMMAND Execute a COMMAND as the superuser or another USER.") - (throw 'eshell-external - (let ((user (or user "root")) - (host (or (file-remote-p default-directory 'host) - "localhost")) - (dir (file-local-name (expand-file-name default-directory))) - (prefix (file-remote-p default-directory))) - ;; `eshell-eval-using-options' reads options of COMMAND. - (while (and (stringp (car orig-args)) - (member (car orig-args) '("-u" "--user"))) - (setq orig-args (cddr orig-args))) - (let ((default-directory - (if (and prefix - (or - (not - (string-equal - "sudo" - (file-remote-p default-directory 'method))) - (not - (string-equal - user - (file-remote-p default-directory 'user))))) - (format "%s|sudo:%s@%s:%s" - (substring prefix 0 -1) user host dir) - (format "/sudo:%s@%s:%s" user host dir)))) - (eshell-named-command (car orig-args) (cdr orig-args)))))))) + (throw 'eshell-external + (let* ((user (or user "root")) + (host (or (file-remote-p default-directory 'host) + tramp-default-host)) + (dir (file-local-name (expand-file-name default-directory))) + (prefix (file-remote-p default-directory)) + (default-directory + (if (and prefix + (or + (not + (string-equal + "sudo" + (file-remote-p default-directory 'method))) + (not + (string-equal + user + (file-remote-p default-directory 'user))))) + (format "%s|sudo:%s@%s:%s" + (substring prefix 0 -1) user host dir) + (format "/sudo:%s@%s:%s" user host dir)))) + (eshell-named-command (car args) (cdr args)))))) (put 'eshell/sudo 'eshell-no-numeric-conversions t) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 04d65df4f33..dceb061c8f4 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -279,14 +279,33 @@ otherwise t.") (defvar eshell-in-subcommand-p nil) (defvar eshell-last-arguments nil) (defvar eshell-last-command-name nil) -(defvar eshell-last-async-proc nil - "When this foreground process completes, resume command evaluation.") +(defvar eshell-last-async-procs nil + "The currently-running foreground process(es). +When executing a pipeline, this is a cons cell whose CAR is the +first process (usually reading from stdin) and whose CDR is the +last process (usually writing to stdout). Otherwise, the CAR and +CDR are the same process. + +When the process in the CDR completes, resume command evaluation.") ;;; Functions: -(defsubst eshell-interactive-process () - "Return currently running command process, if non-Lisp." - eshell-last-async-proc) +(defsubst eshell-interactive-process-p () + "Return non-nil if there is a currently running command process." + eshell-last-async-procs) + +(defsubst eshell-head-process () + "Return the currently running process at the head of any pipeline. +This only returns external (non-Lisp) processes." + (car-safe eshell-last-async-procs)) + +(defsubst eshell-tail-process () + "Return the currently running process at the tail of any pipeline. +This only returns external (non-Lisp) processes." + (cdr-safe eshell-last-async-procs)) + +(define-obsolete-function-alias 'eshell-interactive-process + 'eshell-tail-process "29.1") (defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft! "Initialize the Eshell command processing module." @@ -295,7 +314,7 @@ otherwise t.") (setq-local eshell-command-arguments nil) (setq-local eshell-last-arguments nil) (setq-local eshell-last-command-name nil) - (setq-local eshell-last-async-proc nil) + (setq-local eshell-last-async-procs nil) (add-hook 'eshell-kill-hook #'eshell-resume-command nil t) @@ -306,7 +325,7 @@ otherwise t.") (add-hook 'eshell-post-command-hook (lambda () (setq eshell-current-command nil - eshell-last-async-proc nil)) + eshell-last-async-procs nil)) nil t) (add-hook 'eshell-parse-argument-hook @@ -764,8 +783,7 @@ This macro calls itself recursively, with NOTFIRST non-nil." (eshell-set-output-handle ,eshell-output-handle 'append nextproc) (eshell-set-output-handle ,eshell-error-handle - 'append nextproc) - (setq tailproc (or tailproc nextproc)))) + 'append nextproc))) ,(let ((head (car pipeline))) (if (memq (car head) '(let progn)) (setq head (car (last head)))) @@ -781,7 +799,10 @@ This macro calls itself recursively, with NOTFIRST non-nil." ,(cond ((not notfirst) (quote 'first)) ((cdr pipeline) t) (t (quote 'last))))) - ,(car pipeline)))))) + (let ((proc ,(car pipeline))) + (setq headproc (or proc headproc)) + (setq tailproc (or tailproc proc)) + proc)))))) (defmacro eshell-do-pipelines-synchronously (pipeline) "Execute the commands in PIPELINE in sequence synchronously. @@ -822,7 +843,7 @@ This is used on systems where async subprocesses are not supported." (defmacro eshell-execute-pipeline (pipeline) "Execute the commands in PIPELINE, connecting each to one another." - `(let ((eshell-in-pipeline-p t) tailproc) + `(let ((eshell-in-pipeline-p t) headproc tailproc) (progn ,(if (fboundp 'make-process) `(eshell-do-pipelines ,pipeline) @@ -832,7 +853,7 @@ This is used on systems where async subprocesses are not supported." (car (aref eshell-current-handles ,eshell-error-handle)) nil))) (eshell-do-pipelines-synchronously ,pipeline))) - (eshell-process-identity tailproc)))) + (eshell-process-identity (cons headproc tailproc))))) (defmacro eshell-as-subcommand (command) "Execute COMMAND using a temp buffer. @@ -992,24 +1013,24 @@ produced by `eshell-parse-command'." (unless (or (not (stringp status)) (string= "stopped" status) (string-match eshell-reset-signals status)) - (if (eq proc (eshell-interactive-process)) + (if (eq proc (eshell-tail-process)) (eshell-resume-eval))))) (defun eshell-resume-eval () "Destructively evaluate a form which may need to be deferred." (eshell-condition-case err (progn - (setq eshell-last-async-proc nil) + (setq eshell-last-async-procs nil) (when eshell-current-command (let* (retval - (proc (catch 'eshell-defer + (procs (catch 'eshell-defer (ignore (setq retval (eshell-do-eval eshell-current-command)))))) - (if (eshell-processp proc) - (ignore (setq eshell-last-async-proc proc)) - (cadr retval))))) + (if (eshell-process-pair-p procs) + (ignore (setq eshell-last-async-procs procs)) + (cadr retval))))) (error (error (error-message-string err))))) @@ -1172,17 +1193,16 @@ be finished later after the completion of an asynchronous subprocess." (setcar form (car new-form)) (setcdr form (cdr new-form))) (eshell-do-eval form synchronous-p)) - (if (and (memq (car form) eshell-deferrable-commands) - (not eshell-current-subjob-p) - result - (eshell-processp result)) - (if synchronous-p - (eshell/wait result) + (if-let (((memq (car form) eshell-deferrable-commands)) + ((not eshell-current-subjob-p)) + (procs (eshell-make-process-pair result))) + (if synchronous-p + (eshell/wait (cdr procs)) (eshell-manipulate "inserting ignore form" (setcar form 'ignore) (setcdr form nil)) - (throw 'eshell-defer result)) - (list 'quote result)))))))))))) + (throw 'eshell-defer procs)) + (list 'quote result)))))))))))) ;; command invocation @@ -1272,8 +1292,9 @@ or an external command." (defun eshell-exec-lisp (printer errprint func-or-form args form-p) "Execute a Lisp FUNC-OR-FORM, maybe passing ARGS. PRINTER and ERRPRINT are functions to use for printing regular -messages, and errors. FORM-P should be non-nil if FUNC-OR-FORM -represent a Lisp form; ARGS will be ignored in that case." +messages and errors, respectively. FORM-P should be non-nil if +FUNC-OR-FORM represent a Lisp form; ARGS will be ignored in that +case." (eshell-condition-case err (let ((result (save-current-buffer @@ -1296,44 +1317,56 @@ represent a Lisp form; ARGS will be ignored in that case." (defsubst eshell-apply* (printer errprint func args) "Call FUNC, with ARGS, trapping errors and return them as output. PRINTER and ERRPRINT are functions to use for printing regular -messages, and errors." +messages and errors, respectively." (eshell-exec-lisp printer errprint func args nil)) (defsubst eshell-funcall* (printer errprint func &rest args) - "Call FUNC, with ARGS, trapping errors and return them as output." + "Call FUNC, with ARGS, trapping errors and return them as output. +PRINTER and ERRPRINT are functions to use for printing regular +messages and errors, respectively." (eshell-apply* printer errprint func args)) (defsubst eshell-eval* (printer errprint form) - "Evaluate FORM, trapping errors and returning them." + "Evaluate FORM, trapping errors and returning them. +PRINTER and ERRPRINT are functions to use for printing regular +messages and errors, respectively." (eshell-exec-lisp printer errprint form nil t)) (defsubst eshell-apply (func args) "Call FUNC, with ARGS, trapping errors and return them as output. -PRINTER and ERRPRINT are functions to use for printing regular -messages, and errors." - (eshell-apply* 'eshell-print 'eshell-error func args)) +Print the result using `eshell-print'; if an error occurs, print +it via `eshell-error'." + (eshell-apply* #'eshell-print #'eshell-error func args)) (defsubst eshell-funcall (func &rest args) - "Call FUNC, with ARGS, trapping errors and return them as output." + "Call FUNC, with ARGS, trapping errors and return them as output. +Print the result using `eshell-print'; if an error occurs, print +it via `eshell-error'." (eshell-apply func args)) (defsubst eshell-eval (form) - "Evaluate FORM, trapping errors and returning them." - (eshell-eval* 'eshell-print 'eshell-error form)) + "Evaluate FORM, trapping errors and returning them. +Print the result using `eshell-print'; if an error occurs, print +it via `eshell-error'." + (eshell-eval* #'eshell-print #'eshell-error form)) (defsubst eshell-applyn (func args) "Call FUNC, with ARGS, trapping errors and return them as output. -PRINTER and ERRPRINT are functions to use for printing regular -messages, and errors." - (eshell-apply* 'eshell-printn 'eshell-errorn func args)) +Print the result using `eshell-printn'; if an error occurs, print it +via `eshell-errorn'." + (eshell-apply* #'eshell-printn #'eshell-errorn func args)) (defsubst eshell-funcalln (func &rest args) - "Call FUNC, with ARGS, trapping errors and return them as output." + "Call FUNC, with ARGS, trapping errors and return them as output. +Print the result using `eshell-printn'; if an error occurs, print it +via `eshell-errorn'." (eshell-applyn func args)) (defsubst eshell-evaln (form) - "Evaluate FORM, trapping errors and returning them." - (eshell-eval* 'eshell-printn 'eshell-errorn form)) + "Evaluate FORM, trapping errors and returning them. +Print the result using `eshell-printn'; if an error occurs, print it +via `eshell-errorn'." + (eshell-eval* #'eshell-printn #'eshell-errorn form)) (defvar eshell-last-output-end) ;Defined in esh-mode.el. diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 2e0f312f4a6..3644c1a18b5 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -150,6 +150,8 @@ not be added to this variable." :risky t :group 'eshell-io) +(define-error 'eshell-pipe-broken "Pipe broken") + ;;; Internal Variables: (defvar eshell-current-handles nil) @@ -375,8 +377,6 @@ it defaults to `insert'." (error "Invalid redirection target: %s" (eshell-stringify target))))) -(defvar grep-null-device) - (defun eshell-set-output-handle (index mode &optional target) "Set handle INDEX, using MODE, to point to TARGET." (when target @@ -483,24 +483,31 @@ Returns what was actually sent, or nil if nothing was sent." (goto-char target)))))) ((eshell-processp target) - (when (eq (process-status target) 'run) - (unless (stringp object) - (setq object (eshell-stringify object))) - (process-send-string target object))) + (unless (stringp object) + (setq object (eshell-stringify object))) + (condition-case nil + (process-send-string target object) + ;; If `process-send-string' raises an error, treat it as a broken pipe. + (error (signal 'eshell-pipe-broken target)))) ((consp target) (apply (car target) object (cdr target)))) object) (defun eshell-output-object (object &optional handle-index handles) - "Insert OBJECT, using HANDLE-INDEX specifically)." + "Insert OBJECT, using HANDLE-INDEX specifically. +If HANDLE-INDEX is nil, output to `eshell-output-handle'. +HANDLES is the set of file handles to use; if nil, use +`eshell-current-handles'." (let ((target (car (aref (or handles eshell-current-handles) (or handle-index eshell-output-handle))))) - (if (and target (not (listp target))) - (eshell-output-object-to-target object target) - (while target - (eshell-output-object-to-target object (car target)) - (setq target (cdr target)))))) + (if (listp target) + (while target + (eshell-output-object-to-target object (car target)) + (setq target (cdr target))) + (eshell-output-object-to-target object target) + ;; Explicitly return nil to match the list case above. + nil))) (provide 'esh-io) ;;; esh-io.el ends here diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 8302eefe1e6..59c8f8034fe 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -423,13 +423,13 @@ and the hook `eshell-exit-hook'." (defun eshell-self-insert-command () (interactive) (process-send-string - (eshell-interactive-process) + (eshell-head-process) (char-to-string (if (symbolp last-command-event) (get last-command-event 'ascii-character) last-command-event)))) (defun eshell-intercept-commands () - (when (and (eshell-interactive-process) + (when (and (eshell-interactive-process-p) (not (and (integerp last-input-event) (memq last-input-event '(?\C-x ?\C-c))))) (let ((possible-events (where-is-internal this-command)) @@ -595,13 +595,13 @@ If NO-NEWLINE is non-nil, the input is sent without an implied final newline." (interactive "P") ;; Note that the input string does not include its terminal newline. - (let ((proc-running-p (and (eshell-interactive-process) + (let ((proc-running-p (and (eshell-head-process) (not queue-p))) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t)) (unless (and proc-running-p (not (eq (process-status - (eshell-interactive-process)) + (eshell-head-process)) 'run))) (if (or proc-running-p (>= (point) eshell-last-output-end)) @@ -627,8 +627,8 @@ newline." (if (or eshell-send-direct-to-subprocesses (= eshell-last-input-start eshell-last-input-end)) (unless no-newline - (process-send-string (eshell-interactive-process) "\n")) - (process-send-region (eshell-interactive-process) + (process-send-string (eshell-head-process) "\n")) + (process-send-region (eshell-head-process) eshell-last-input-start eshell-last-input-end))) (if (= eshell-last-output-end (point)) @@ -665,6 +665,16 @@ newline." (run-hooks 'eshell-post-command-hook) (insert-and-inherit input))))))))) +(defun eshell-send-eof-to-process () + "Send EOF to the currently-running \"head\" process." + (interactive) + (require 'esh-mode) + (declare-function eshell-send-input "esh-mode" + (&optional use-region queue-p no-newline)) + (eshell-send-input nil nil t) + (when (eshell-head-process) + (process-send-eof (eshell-head-process)))) + (defsubst eshell-kill-new () "Add the last input text to the kill ring." (kill-ring-save eshell-last-input-start eshell-last-input-end)) @@ -924,9 +934,9 @@ Then send it to the process running in the current buffer." (interactive) ; Don't pass str as argument, to avoid snooping via C-x ESC ESC (let ((str (read-passwd (format "%s Password: " - (process-name (eshell-interactive-process)))))) + (process-name (eshell-head-process)))))) (if (stringp str) - (process-send-string (eshell-interactive-process) + (process-send-string (eshell-head-process) (concat str "\n")) (message "Warning: text will be echoed")))) @@ -937,7 +947,7 @@ buffer's process if STRING contains a password prompt defined by `eshell-password-prompt-regexp'. This function could be in the list `eshell-output-filter-functions'." - (when (eshell-interactive-process) + (when (eshell-interactive-process-p) (save-excursion (let ((case-fold-search t)) (goto-char eshell-last-output-block-begin) diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index c802bee3af5..0961e214f4f 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -97,10 +97,10 @@ let-bound variable `args'." (declare (debug (form form sexp body))) `(let* ((temp-args ,(if (memq ':preserve-args (cadr options)) - macro-args + (list 'copy-tree macro-args) (list 'eshell-stringify-list (list 'flatten-tree macro-args)))) - (processed-args (eshell--do-opts ,name ,options temp-args)) + (processed-args (eshell--do-opts ,name ,options temp-args ,macro-args)) ,@(delete-dups (delq nil (mapcar (lambda (opt) (and (listp opt) (nth 3 opt) @@ -117,7 +117,7 @@ let-bound variable `args'." ;; Documented part of the interface; see eshell-eval-using-options. (defvar eshell--args) -(defun eshell--do-opts (name options args) +(defun eshell--do-opts (name options args orig-args) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." (require 'esh-ext) @@ -135,7 +135,7 @@ This code doesn't really need to be macro expanded everywhere." (error "%s" usage-msg)))))) (if ext-command (throw 'eshell-external - (eshell-external-command ext-command args)) + (eshell-external-command ext-command orig-args)) args))) (defun eshell-show-usage (name options) @@ -283,6 +283,9 @@ triggered to say that the switch is unrecognized." (memq :parse-leading-options-only options)))) (setq arg (nth ai eshell--args)) (if (not (and (stringp arg) + ;; A string of length 1 can't be an option; (if + ;; it's "-", that generally means stdin). + (> (length arg) 1) (string-match "^-\\(-\\)?\\(.*\\)" arg))) ;; Positional argument found, skip (setq ai (1+ ai) @@ -295,9 +298,9 @@ triggered to say that the switch is unrecognized." (if (> (length switch) 0) (eshell--process-option name switch 1 ai options opt-vals) (setq ai (length eshell--args))) - (while (> (length switch) 0) - (setq switch (eshell--process-option name switch 0 - ai options opt-vals))))))) + (while (> (length switch) 0) + (setq switch (eshell--process-option name switch 0 + ai options opt-vals))))))) (nconc (mapcar #'cdr opt-vals) eshell--args))) (provide 'esh-opt) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 5ed692fb5a3..ed37de85f7a 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -101,6 +101,8 @@ information, for example." (defvar eshell-process-list nil "A list of the current status of subprocesses.") +(declare-function eshell-send-eof-to-process "esh-mode") + (defvar-keymap eshell-proc-mode-map "C-c M-i" #'eshell-insert-process "C-c C-c" #'eshell-interrupt-process @@ -384,8 +386,27 @@ output." (let ((data (nth 3 entry))) (setcar (nthcdr 3 entry) nil) (setcar (nthcdr 4 entry) t) - (eshell-output-object data nil (cadr entry)) - (setcar (nthcdr 4 entry) nil))))))))) + (unwind-protect + (condition-case nil + (eshell-output-object data nil (cadr entry)) + ;; FIXME: We want to send SIGPIPE to the process + ;; here. However, remote processes don't + ;; currently support that, and not all systems + ;; have SIGPIPE in the first place (e.g. MS + ;; Windows). In these cases, just delete the + ;; process; this is reasonably close to the + ;; right behavior, since the default action for + ;; SIGPIPE is to terminate the process. For use + ;; cases where SIGPIPE is truly needed, using an + ;; external pipe operator (`*|') may work + ;; instead (e.g. when working with remote + ;; processes). + (eshell-pipe-broken + (if (or (process-get proc 'remote-pid) + (eq system-type 'windows-nt)) + (delete-process proc) + (signal-process proc 'SIGPIPE)))) + (setcar (nthcdr 4 entry) nil)))))))))) (defun eshell-sentinel (proc string) "Generic sentinel for command processes. Reports only signals. @@ -414,8 +435,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) - (when str (eshell-output-object str nil handles)) - (eshell-close-handles status 'nil handles))))) + (unwind-protect + (when str + (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))))) @@ -542,14 +567,5 @@ See the variable `eshell-kill-processes-on-exit'." ; ;; `eshell-resume-eval'. ; (eshell-kill-process-function nil "continue"))) -(defun eshell-send-eof-to-process () - "Send EOF to process." - (interactive) - (require 'esh-mode) - (declare-function eshell-send-input "esh-mode" - (&optional use-region queue-p no-newline)) - (eshell-send-input nil nil t) - (eshell-process-interact 'process-send-eof)) - (provide 'esh-proc) ;;; esh-proc.el ends here diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 0e04dbc7c9f..788404fc43a 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -609,6 +609,20 @@ gid format. Valid values are `string' and `integer', defaulting to "If the `processp' function does not exist, PROC is not a process." (and (fboundp 'processp) (processp proc))) +(defun eshell-process-pair-p (procs) + "Return non-nil if PROCS is a pair of process objects." + (and (consp procs) + (eshell-processp (car procs)) + (eshell-processp (cdr procs)))) + +(defun eshell-make-process-pair (procs) + "Make a pair of process objects from PROCS if possible. +This represents the head and tail of a pipeline of processes, +where the head and tail may be the same process." + (pcase procs + ((pred eshell-processp) (cons procs procs)) + ((pred eshell-process-pair-p) procs))) + ;; (defun eshell-copy-file ;; (file newname &optional ok-if-already-exists keep-date) ;; "Copy FILE to NEWNAME. See docs for `copy-file'." diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 5c356e89289..2c472a2afad 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -332,9 +332,9 @@ With prefix ARG, insert output into the current buffer at point." ;; make the output as attractive as possible, with no ;; extraneous newlines (when intr - (if (eshell-interactive-process) - (eshell-wait-for-process (eshell-interactive-process))) - (cl-assert (not (eshell-interactive-process))) + (if (eshell-interactive-process-p) + (eshell-wait-for-process (eshell-tail-process))) + (cl-assert (not (eshell-interactive-process-p))) (goto-char (point-max)) (while (and (bolp) (not (bobp))) (delete-char -1))) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 3675ea14b4c..eb4f6b9534c 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -70,16 +70,28 @@ :foreground :background :stipple :overline :strike-through :box :font :inherit :fontset :distant-foreground :extend :vector]) +(defun face-remap--copy-face (val) + "Return a copy of the `face' property value VAL." + ;; A `face' property can be either a face name (a symbol), or a face + ;; property list like (:foreground "red" :inherit default), + ;; or a list of such things. + ;; FIXME: This should probably be shared to some extent with + ;; `add-face-text-property'. + (if (or (not (listp val)) (keywordp (car val))) + val + (copy-sequence val))) + (defun face-attrs--make-indirect-safe () "Deep-copy the buffer's `face-remapping-alist' upon cloning the buffer." (setq-local face-remapping-alist - (mapcar #'copy-sequence face-remapping-alist))) + (mapcar #'face-remap--copy-face face-remapping-alist))) (add-hook 'clone-indirect-buffer-hook #'face-attrs--make-indirect-safe) (defun face-attrs-more-relative-p (attrs1 attrs2) - "Return true if ATTRS1 contains a greater number of relative -face-attributes than ATTRS2. A face attribute is considered + "Return non-nil if ATTRS1 is \"more relative\" than ATTRS2. +We define this as meaning that ATTRS1 contains a greater number of +relative face-attributes than ATTRS2. A face attribute is considered relative if `face-attribute-relative-p' returns non-nil. ATTRS1 and ATTRS2 may be any value suitable for a `face' text @@ -106,7 +118,7 @@ face lists so that more specific faces are located near the end." "Order ENTRY so that more relative face specs are near the beginning. The list structure of ENTRY may be destructively modified." (setq entry (nreverse entry)) - (setcdr entry (sort (cdr entry) 'face-attrs-more-relative-p)) + (setcdr entry (sort (cdr entry) #'face-attrs-more-relative-p)) (nreverse entry)) ;;;###autoload @@ -395,7 +407,11 @@ a top-level keymap, `text-scale-increase' or (dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +. (define-key map (vector (append mods (list key))) (lambda () (interactive) (text-scale-adjust (abs inc)))))) - map))))) ;; ) + map) + nil + ;; Clear the prompt after exiting. + (lambda () + (message "")))))) (defvar-local text-scale--pinch-start-scale 0 "The text scale at the start of a pinch sequence.") diff --git a/lisp/faces.el b/lisp/faces.el index 5e0be118282..3a434b3251c 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1065,6 +1065,9 @@ of the default face. Value is FACE." (defvar crm-separator) ; from crm.el +(defconst read-face-name-sample-text "SAMPLE" + "Text string to display as the sample text for `read-face-name'.") + (defun read-face-name (prompt &optional default multiple) "Read one or more face names, prompting with PROMPT. PROMPT should not end in a space or a colon. @@ -1114,10 +1117,11 @@ returned. Otherwise, DEFAULT is returned verbatim." (lambda (faces) (mapcar (lambda (face) - (list (concat (propertize "SAMPLE" 'face face) + (list face + (concat (propertize read-face-name-sample-text + 'face face) "\t") - "" - face)) + "")) faces)))) aliasfaces nonaliasfaces faces) ;; Build up the completion tables. diff --git a/lisp/files-x.el b/lisp/files-x.el index e86ba8f8d04..319bfe05655 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -579,15 +579,22 @@ changed by the user.") (setq ignored-local-variables (cons 'connection-local-variables-alist ignored-local-variables)) -(defvar connection-local-profile-alist nil +(defcustom connection-local-profile-alist nil "Alist mapping connection profiles to variable lists. Each element in this list has the form (PROFILE VARIABLES). PROFILE is the name of a connection profile (a symbol). VARIABLES is a list that declares connection-local variables for PROFILE. An element in VARIABLES is an alist whose elements are -of the form (VAR . VALUE).") - -(defvar connection-local-criteria-alist nil +of the form (VAR . VALUE)." + :type '(repeat (cons (symbol :tag "Profile") + (repeat :tag "Variables" + (cons (symbol :tag "Variable") + (sexp :tag "Value"))))) + :group 'files + :group 'tramp + :version "29.1") + +(defcustom connection-local-criteria-alist nil "Alist mapping connection criteria to connection profiles. Each element in this list has the form (CRITERIA PROFILES). CRITERIA is a plist identifying a connection and the application @@ -596,7 +603,19 @@ using this connection. Property names might be `:application', `:application' is a symbol, all other property values are strings. All properties are optional; if CRITERIA is nil, it always applies. -PROFILES is a list of connection profiles (symbols).") +PROFILES is a list of connection profiles (symbols)." + :type '(repeat (cons (plist :tag "Criteria" + ;; Give the most common options as checkboxes. + :options (((const :format "%v " :application) + symbol) + ((const :format "%v " :protocol) string) + ((const :format "%v " :user) string) + ((const :format "%v " :machine) string))) + (repeat :tag "Profiles" + (symbol :tag "Profile")))) + :group 'files + :group 'tramp + :version "29.1") (defsubst connection-local-normalize-criteria (criteria) "Normalize plist CRITERIA according to properties. @@ -649,7 +668,9 @@ variables for a connection profile are defined using (setcdr slot (delete-dups (append (cdr slot) profiles))) (setq connection-local-criteria-alist (cons (cons criteria (delete-dups profiles)) - connection-local-criteria-alist))))) + connection-local-criteria-alist)))) + (customize-set-variable + 'connection-local-criteria-alist connection-local-criteria-alist)) (defsubst connection-local-get-profile-variables (profile) "Return the connection-local variable list for PROFILE." @@ -668,7 +689,9 @@ connection profile using `connection-local-set-profiles'. Then variables are set in the server's process buffer according to the VARIABLES list of the connection profile. The list is processed in order." - (setf (alist-get profile connection-local-profile-alist) variables)) + (setf (alist-get profile connection-local-profile-alist) variables) + (customize-set-variable + 'connection-local-profile-alist connection-local-profile-alist)) (defun hack-connection-local-variables (criteria) "Read connection-local variables according to CRITERIA. diff --git a/lisp/files.el b/lisp/files.el index aabe8f445e0..a0501cffa1a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1493,8 +1493,13 @@ in all cases, since that is the standard symbol for byte." (if (string= prefix "") "" "i") (or unit "B")) (concat prefix unit)))) - (format (if (and (>= (mod file-size 1.0) 0.05) + ;; Mimic what GNU "ls -lh" does: + ;; If the formatted size will have just one digit before the decimal... + (format (if (and (< file-size 10) + ;; ...and its fractional part is not too small... + (>= (mod file-size 1.0) 0.05) (< (mod file-size 1.0) 0.95)) + ;; ...then emit one digit after the decimal. "%.1f%s%s" "%.0f%s%s") file-size @@ -2757,8 +2762,7 @@ since only a single case-insensitive search through the alist is made." (defvar auto-mode-alist ;; Note: The entries for the modes defined in cc-mode.el (c-mode, ;; c++-mode, java-mode and more) are added through autoload - ;; directives in that file. That way is discouraged since it - ;; spreads out the definition of the initial value. + ;; directives in that file. (mapcar (lambda (elt) (cons (purecopy (car elt)) (cdr elt))) @@ -2929,7 +2933,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS ("\\.[eE]?[pP][sS]\\'" . ps-mode) - ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) + ("\\.\\(?:PDF\\|EPUB\\|CBZ\\|FB2\\|O?XPS\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|epub\\|cbz\\|fb2\\|o?xps\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode) ("BROWSE\\'" . ebrowse-tree-mode) @@ -3056,8 +3060,7 @@ and `magic-mode-alist', which determines modes based on file contents.") (defvar interpreter-mode-alist ;; Note: The entries for the modes defined in cc-mode.el (awk-mode ;; and pike-mode) are added through autoload directives in that - ;; file. That way is discouraged since it spreads out the - ;; definition of the initial value. + ;; file. (mapcar (lambda (l) (cons (purecopy (car l)) (cdr l))) @@ -4063,7 +4066,8 @@ It is safe if any of these conditions are met: (and (functionp safep) ;; If the function signals an error, that means it ;; can't assure us that the value is safe. - (with-demoted-errors (funcall safep val)))))) + (with-demoted-errors "Local variable error: %S" + (funcall safep val)))))) (defun risky-local-variable-p (sym &optional _ignored) "Non-nil if SYM could be dangerous as a file-local variable. @@ -4939,7 +4943,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." nil))) ;; If set-file-extended-attributes fails, fall back on set-file-modes. (unless (and extended-attributes - (with-demoted-errors + (with-demoted-errors "Error setting attributes: %S" (set-file-extended-attributes to-name extended-attributes))) (and modes (set-file-modes to-name (logand modes #o1777) nofollow-flag))))) @@ -5560,7 +5564,8 @@ Before and after saving the buffer, this function runs (goto-char (point-max)) (insert ?\n)))) ;; Don't let errors prevent saving the buffer. - (with-demoted-errors (run-hooks 'before-save-hook)) + (with-demoted-errors "Before-save hook error: %S" + (run-hooks 'before-save-hook)) ;; Give `write-contents-functions' a chance to ;; short-circuit the whole process. (unless (run-hook-with-args-until-success 'write-contents-functions) @@ -5608,7 +5613,7 @@ Before and after saving the buffer, this function runs (condition-case () (progn (unless - (with-demoted-errors + (with-demoted-errors "Error setting file modes: %S" (set-file-modes buffer-file-name (car setmodes))) (set-file-extended-attributes buffer-file-name (nth 1 setmodes)))) @@ -5723,7 +5728,7 @@ Before and after saving the buffer, this function runs ;; If set-file-extended-attributes fails, fall back on ;; set-file-modes. (unless - (with-demoted-errors + (with-demoted-errors "Error setting attributes: %s" (set-file-extended-attributes buffer-file-name (nth 1 setmodes))) (set-file-modes buffer-file-name @@ -5818,6 +5823,30 @@ of the directory that was default during command invocation." (lambda () (file-in-directory-p default-directory root)))) (put 'save-some-buffers-root 'save-some-buffers-function t) +(defun files--buffers-needing-to-be-saved (pred) + "Return a list of buffers to save according to PRED. +See `save-some-buffers' for PRED values." + (let ((buffers + (mapcar (lambda (buffer) + (if + ;; Note that killing some buffers may kill others via + ;; hooks (e.g. Rmail and its viewing buffer). + (and (buffer-live-p buffer) + (buffer-modified-p buffer) + (not (buffer-base-buffer buffer)) + (or + (buffer-file-name buffer) + (with-current-buffer buffer + (or (eq buffer-offer-save 'always) + (and pred buffer-offer-save + (> (buffer-size) 0))))) + (or (not (functionp pred)) + (with-current-buffer buffer + (funcall pred)))) + buffer)) + (buffer-list)))) + (delq nil buffers))) + (defun save-some-buffers (&optional arg pred) "Save some modified file-visiting buffers. Asks user about each one. You can answer \\`y' or \\`SPC' to save, \\`n' or \\`DEL' not to save, \\`C-r' @@ -5874,49 +5903,36 @@ change the additional actions you can take on files." (setq files-done (map-y-or-n-p (lambda (buffer) - ;; Note that killing some buffers may kill others via - ;; hooks (e.g. Rmail and its viewing buffer). - (and (buffer-live-p buffer) - (buffer-modified-p buffer) - (not (buffer-base-buffer buffer)) - (or - (buffer-file-name buffer) - (with-current-buffer buffer - (or (eq buffer-offer-save 'always) - (and pred buffer-offer-save - (> (buffer-size) 0))))) - (or (not (functionp pred)) - (with-current-buffer buffer (funcall pred))) - (if arg - t - (setq queried t) - (if (buffer-file-name buffer) - (if (or - (equal (buffer-name buffer) - (file-name-nondirectory - (buffer-file-name buffer))) - (string-match - (concat "\\<" - (regexp-quote - (file-name-nondirectory - (buffer-file-name buffer))) - "<[^>]*>\\'") - (buffer-name buffer))) - ;; The buffer name is similar to the - ;; file name. - (format "Save file %s? " - (buffer-file-name buffer)) - ;; The buffer and file names are - ;; dissimilar; display both. - (format "Save file %s (buffer %s)? " - (buffer-file-name buffer) - (buffer-name buffer))) - ;; No file name - (format "Save buffer %s? " (buffer-name buffer)))))) + (if arg + t + (setq queried t) + (if (buffer-file-name buffer) + (if (or + (equal (buffer-name buffer) + (file-name-nondirectory + (buffer-file-name buffer))) + (string-match + (concat "\\<" + (regexp-quote + (file-name-nondirectory + (buffer-file-name buffer))) + "<[^>]*>\\'") + (buffer-name buffer))) + ;; The buffer name is similar to the file + ;; name. + (format "Save file %s? " + (buffer-file-name buffer)) + ;; The buffer and file names are dissimilar; + ;; display both. + (format "Save file %s (buffer %s)? " + (buffer-file-name buffer) + (buffer-name buffer))) + ;; No file name. + (format "Save buffer %s? " (buffer-name buffer))))) (lambda (buffer) (with-current-buffer buffer (save-buffer))) - (buffer-list) + (files--buffers-needing-to-be-saved pred) '("buffer" "buffers" "save") save-some-buffers-action-alist)) ;; Maybe to save abbrevs, and record whether @@ -7754,7 +7770,16 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (interactive "P") ;; Don't use save-some-buffers-default-predicate, because we want ;; to ask about all the buffers before killing Emacs. - (save-some-buffers arg t) + (when (files--buffers-needing-to-be-saved t) + (if (use-dialog-box-p) + (pcase (x-popup-dialog + t `("Unsaved Buffers" + ("Close Without Saving" . no-save) + ("Save All" . save-all) + ("Cancel" . cancel))) + ('cancel (user-error "Exit cancelled")) + ('save-all (save-some-buffers t))) + (save-some-buffers arg t))) (let ((confirm confirm-kill-emacs)) (and (or (not (memq t (mapcar (lambda (buf) diff --git a/lisp/filesets.el b/lisp/filesets.el index 0bc44ecd912..83a914d58cc 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1761,7 +1761,7 @@ Use LOOKUP-NAME for deducing the save-function, if provided." (defun filesets-add-buffer (&optional name buffer) "Add BUFFER (or current buffer) to the fileset called NAME. -User will be queried, if no fileset name is provided." +If no fileset name is provided, prompt for NAME." (interactive) (let* ((buffer (or buffer (current-buffer))) @@ -1796,8 +1796,8 @@ User will be queried, if no fileset name is provided." (message "Filesets: Can't add `%s' to fileset `%s'" this name))))))) (defun filesets-remove-buffer (&optional name buffer) - "Remove BUFFER (or current buffer) to fileset NAME. -User will be queried, if no fileset name is provided." + "Remove BUFFER (or current buffer) from the fileset called NAME. +If no fileset name is provided, prompt for NAME." (interactive) (let* ((buffer (or buffer (current-buffer))) diff --git a/lisp/find-dired.el b/lisp/find-dired.el index c67138a8006..c04545e44e9 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -234,8 +234,8 @@ it finishes, type \\[kill-find]." (dired-simple-subdir-alist) ;; else we have an ancient tree dired (or classic dired, where ;; this does no harm) - (setq-local dired-subdir-alist - (list (cons default-directory (point-min-marker))))) + (setq dired-subdir-alist + (list (cons default-directory (point-min-marker))))) (setq-local dired-subdir-switches find-ls-subdir-switches) (setq buffer-read-only nil) ;; Subdir headlerline must come first because the first marker in diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index d4d899aced7..0a712c0b811 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -231,8 +231,8 @@ It is a function which takes two arguments, the directory and its parent." (dired-simple-subdir-alist) ;; else we have an ancient tree dired (or classic dired, where ;; this does no harm) - (setq-local dired-subdir-alist - (list (cons default-directory (point-min-marker))))) + (setq dired-subdir-alist + (list (cons default-directory (point-min-marker))))) (find-lisp-insert-directory dir file-predicate directory-predicate 'ignore) (goto-char (point-min)) diff --git a/lisp/finder.el b/lisp/finder.el index 5a6fe451928..a40f8c64f24 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -454,7 +454,8 @@ Quit the window and kill all Finder-related buffers." (defun finder-unload-function () "Unload the Finder library." - (with-demoted-errors (unload-feature 'finder-inf t)) + (with-demoted-errors "Error unloading finder: %S" + (unload-feature 'finder-inf t)) ;; continue standard unloading nil) diff --git a/lisp/frame.el b/lisp/frame.el index 599ffe591a5..b681a971aa3 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -702,7 +702,9 @@ Return nil if we don't know how to interpret DISPLAY." The optional argument PARAMETERS specifies additional frame parameters." (interactive (if (fboundp 'x-display-list) (list (completing-read "Make frame on display: " - (x-display-list))) + (x-display-list) nil + nil (car (x-display-list)) + nil (car (x-display-list)))) (user-error "This Emacs build does not support X displays"))) (make-frame (cons (cons 'display display) parameters))) @@ -798,8 +800,9 @@ also select the new frame." (windows (unless no-windows (window-state-get (frame-root-window frame)))) (default-frame-alist - (seq-remove (lambda (elem) (eq (car elem) 'name)) - (frame-parameters frame))) + (seq-remove (lambda (elem) + (memq (car elem) frame-internal-parameters)) + (frame-parameters frame))) (new-frame (make-frame))) (when windows (window-state-put windows (frame-root-window new-frame) 'safe)) @@ -882,7 +885,6 @@ the new frame according to its own rules." (error "Don't know how to interpret display %S" display))) (t window-system))) - (oldframe (selected-frame)) (params parameters) frame child-frame) @@ -900,8 +902,12 @@ the new frame according to its own rules." (dolist (p default-frame-alist) (unless (assq (car p) params) (push p params))) - -;; (setq frame-size-history '(1000)) + ;; Add parameters from `frame-inherited-parameters' unless they are + ;; overridden by explicit parameters. + (dolist (param frame-inherited-parameters) + (unless (assq param parameters) + (let ((val (frame-parameter nil param))) + (when val (push (cons param val) params))))) (when (eq (cdr (or (assq 'minibuffer params) '(minibuffer . t))) 'child-frame) @@ -934,12 +940,6 @@ the new frame according to its own rules." frame 'minibuffer (frame-root-window child-frame)))) (normal-erase-is-backspace-setup-frame frame) - ;; Inherit original frame's parameters unless they are overridden - ;; by explicit parameters. - (dolist (param frame-inherited-parameters) - (unless (assq param parameters) - (let ((val (frame-parameter oldframe param))) - (when val (set-frame-parameter frame param val))))) ;; We can run `window-configuration-change-hook' for this frame now. (frame-after-make-frame frame t) @@ -1589,6 +1589,11 @@ acquires focus to be automatically raised. Note that this minor mode controls Emacs's own auto-raise feature. Window managers that switch focus on mouse movement often have their own auto-raise feature." + ;; This isn't really a global minor mode; rather, it's local to the + ;; selected frame, but declaring it as global prevents a misleading + ;; "Auto-Raise mode enabled in current buffer" message from being + ;; displayed when it is turned on. + :global t :variable (frame-parameter nil 'auto-raise) (if (frame-parameter nil 'auto-raise) (raise-frame))) @@ -2529,31 +2534,29 @@ deleting them." (if iconify (iconify-frame this) (delete-frame this))) (setq this next)))) -(eval-when-compile (require 'frameset)) - (defvar undelete-frame--deleted-frames nil - "Internal variable used by `undelete-frame--handle-delete-frame'.") + "Internal variable used by `undelete-frame--save-deleted-frame'.") -(defun undelete-frame--handle-delete-frame (frame) +(defun undelete-frame--save-deleted-frame (frame) "Save the configuration of frames deleted with `delete-frame'. Only the 16 most recently deleted frames are saved." - (when (frame-live-p frame) + (when (and after-init-time (frame-live-p frame)) (setq undelete-frame--deleted-frames (cons - (cons + (list (display-graphic-p) - (frameset-save - (list frame) - ;; When the daemon is started from a graphical - ;; environment, TTY frames have a 'display' parameter set - ;; to the value of $DISPLAY (see the note in - ;; `server--on-display-p'). Do not store that parameter - ;; in the frameset, otherwise `frameset-restore' attempts - ;; to restore a graphical frame. - :filters (if (display-graphic-p) - frameset-filter-alist - (cons '(display . :never) - frameset-filter-alist)))) + (seq-remove + (lambda (elem) + (or (memq (car elem) frame-internal-parameters) + ;; When the daemon is started from a graphical + ;; environment, TTY frames have a 'display' parameter set + ;; to the value of $DISPLAY (see the note in + ;; `server--on-display-p'). Do not store that parameter + ;; in the frame data, otherwise `undelete-frame' attempts + ;; to restore a graphical frame. + (and (eq (car elem) 'display) (not (display-graphic-p))))) + (frame-parameters frame)) + (window-state-get (frame-root-window frame))) undelete-frame--deleted-frames)) (if (> (length undelete-frame--deleted-frames) 16) (setq undelete-frame--deleted-frames @@ -2565,9 +2568,9 @@ Only the 16 most recently deleted frames are saved." :global t (if undelete-frame-mode (add-hook 'delete-frame-functions - #'undelete-frame--handle-delete-frame -75) + #'undelete-frame--save-deleted-frame -75) (remove-hook 'delete-frame-functions - #'undelete-frame--handle-delete-frame) + #'undelete-frame--save-deleted-frame) (setq undelete-frame--deleted-frames nil))) (defun undelete-frame (&optional arg) @@ -2583,26 +2586,25 @@ When called from Lisp, returns the new frame." (if (consp arg) (user-error "Missing deleted frame number argument") (let* ((number (pcase arg ('nil 1) ('- -1) (_ arg))) - (frames (frame-list)) - (frameset (nth (1- number) undelete-frame--deleted-frames)) + (frame-data (nth (1- number) undelete-frame--deleted-frames)) (graphic (display-graphic-p))) (if (not (<= 1 number 16)) (user-error "%d is not a valid deleted frame number argument" number) - (if (not frameset) + (if (not frame-data) (user-error "No deleted frame with number %d" number) - (if (not (eq graphic (car frameset))) + (if (not (eq graphic (nth 0 frame-data))) (user-error "Cannot undelete a %s display frame on a %s display" (if graphic "non-graphic" "graphic") (if graphic "graphic" "non-graphic")) (setq undelete-frame--deleted-frames - (delq frameset undelete-frame--deleted-frames)) - (frameset-restore (cdr frameset)) - (let ((frame (car (seq-difference (frame-list) frames)))) - (when frame - (select-frame-set-input-focus frame) - frame))))))))) + (delq frame-data undelete-frame--deleted-frames)) + (let* ((default-frame-alist (nth 1 frame-data)) + (frame (make-frame))) + (window-state-put (nth 2 frame-data) (frame-root-window frame) 'safe) + (select-frame-set-input-focus frame) + frame)))))))) ;;; Window dividers. (defgroup window-divider nil diff --git a/lisp/frameset.el b/lisp/frameset.el index 10714af1fa5..05884eed3a8 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -436,10 +436,11 @@ Properties can be set with ;;;###autoload (defvar frameset-session-filter-alist - '((name . :never) - (left . frameset-filter-iconified) - (minibuffer . frameset-filter-minibuffer) - (top . frameset-filter-iconified)) + (append + '((left . frameset-filter-iconified) + (minibuffer . frameset-filter-minibuffer) + (top . frameset-filter-iconified)) + (mapcar (lambda (p) (cons p :never)) frame-internal-parameters)) "Minimum set of parameters to filter for live (on-session) framesets. DO NOT MODIFY. See `frameset-filter-alist' for a full description.") @@ -468,14 +469,11 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) - (outer-window-id . :never) (parent-frame . :never) - (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) - (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "Parameters to filter for persistent framesets. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 08e1a6f93ea..59c3bbc76ed 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2659,7 +2659,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (dolist (header (mail-header-parse-addresses addresses t)) (when-let* ((address (car (ignore-errors (mail-header-parse-address header)))) - (warning (textsec-suspicious-p address 'email-address))) + (warning (and (string-match "@" address) + (textsec-suspicious-p address 'email-address)))) (goto-char (point-min)) (while (search-forward address nil t) (put-text-property (match-beginning 0) (match-end 0) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d3a94e9f4e0..550f4e940a8 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3135,9 +3135,9 @@ If SOLID (the prefix), create a solid group." (if (derived-mode-p 'gnus-summary-mode) 'summary 'group)))))) (defvar nnrss-group-alist) -(eval-when-compile - (defun nnrss-discover-feed (_arg)) - (defun nnrss-save-server-data (_arg))) +(declare-function nnrss-discover-feed "nnrss" (url)) +(declare-function nnrss-save-server-data "nnrss" (server)) + (defun gnus-group-make-rss-group (&optional url) "Given a URL, discover if there is an RSS feed. If there is, use Gnus to create an nnrss group" @@ -3226,7 +3226,11 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (if (gnus-server-server-name) (list (list (gnus-server-server-name))) (seq-group-by - (lambda (elt) (gnus-group-server elt)) + (lambda (elt) + (if (gnus-group-native-p elt) + (gnus-group-server elt) + (gnus-method-to-server + (gnus-find-method-for-group elt)))) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) @@ -3277,7 +3281,11 @@ non-nil SPECS arg must be an alist with `search-query-spec' and (if (gnus-server-server-name) (list (list (gnus-server-server-name))) (seq-group-by - (lambda (elt) (gnus-group-server elt)) + (lambda (elt) + (if (gnus-group-native-p elt) + (gnus-group-server elt) + (gnus-method-to-server + (gnus-find-method-for-group elt)))) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 754a1d91cb5..1bffdf3513a 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -830,11 +830,12 @@ These will be used to retrieve the RSVP information from ical events." (defmacro gnus-icalendar-with-decoded-handle (handle &rest body) "Execute BODY in buffer containing the decoded contents of HANDLE." (let ((charset (make-symbol "charset"))) - `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) + `(let ((,charset (downcase + (or (cdr (assoc 'charset (mm-handle-type ,handle))) + "utf-8")))) (with-temp-buffer (mm-insert-part ,handle) - (when (and ,charset (string= (downcase ,charset) "utf-8")) - (decode-coding-region (point-min) (point-max) 'utf-8)) + (decode-coding-region (point-min) (point-max) (intern ,charset)) ,@body)))) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index ccdaabe3c61..8cefb09b66a 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -163,7 +163,9 @@ nnmairix groups are specifically excluded because they are ephemeral." :type 'boolean :version "28.1") -(defvar gnus-registry-enabled nil) +(make-obsolete-variable + 'gnus-registry-enabled + "Check for non-nil value of `gnus-registry-db'" "29.1") (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning. @@ -360,8 +362,7 @@ This is not required after changing `gnus-registry-cache-file'." (progn (gnus-registry-read file) (gnus-registry-install-hooks) - (gnus-registry-install-shortcuts) - (setq gnus-registry-enabled t)) + (gnus-registry-install-shortcuts)) (file-error ;; Fix previous mis-naming of the registry file. (let ((old-file-name @@ -851,7 +852,7 @@ Overrides existing keywords with FORCE set non-nil." (defun gnus-registry-register-message-ids () "Register the Message-ID of every article in the group." - (unless (or (null gnus-registry-enabled) + (unless (or (null gnus-registry-db) (null gnus-registry-register-all) (gnus-parameter-registry-ignore gnus-newsgroup-name)) (dolist (article gnus-newsgroup-articles) @@ -1010,7 +1011,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install." ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-chars) (defun gnus-registry-article-marks-to-chars (headers) "Show the marks for an article by the :char property." - (if gnus-registry-enabled + (if gnus-registry-db (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-get-id-key id 'mark)))) (concat (delq nil @@ -1026,7 +1027,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install." ;; (defalias 'gnus-user-format-function-M #'gnus-registry-article-marks-to-names) (defun gnus-registry-article-marks-to-names (headers) "Show the marks for an article by name." - (if gnus-registry-enabled + (if gnus-registry-db (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-get-id-key id 'mark)))) (mapconcat #'symbol-name marks ",")) @@ -1177,8 +1178,7 @@ non-nil." (defun gnus-registry-clear () "Clear the registry." (gnus-registry-unload-hook) - (setq gnus-registry-db nil - gnus-registry-enabled nil)) + (setq gnus-registry-db nil)) (gnus-add-shutdown 'gnus-registry-clear 'gnus) @@ -1220,7 +1220,7 @@ non-nil." If the registry is not already enabled, then if `gnus-registry-install' is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it." (interactive) - (unless gnus-registry-enabled + (unless gnus-registry-db (when (if (eq gnus-registry-install 'ask) (gnus-y-or-n-p (concat "Enable the Gnus registry? " @@ -1228,7 +1228,7 @@ is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it." "to get rid of this query permanently. ")) gnus-registry-install) (gnus-registry-initialize))) - gnus-registry-enabled) + (null (null gnus-registry-db))) ;; largely based on nnselect-warp-to-article (defun gnus-try-warping-via-registry () diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index bf88abae76c..4ca873eeec9 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -167,10 +167,9 @@ Instead, use this: This variable can also be set per-server." :type '(repeat string)) -(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-swish++-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by swish++ -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :type 'regexp) @@ -204,10 +203,9 @@ This variable can also be set per-server." :type '(repeat string) :version "28.1") -(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-swish-e-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by swish-e -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :type 'regexp @@ -252,7 +250,7 @@ This variable can also be set per-server." :type '(repeat string) :version "28.1") -(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-namazu-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by Namazu in order to get a group name (albeit with / instead of .). @@ -296,10 +294,9 @@ This variable can also be set per-server." :type '(repeat string) :version "28.1") -(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-notmuch-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by notmuch -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :type 'regexp @@ -339,10 +336,9 @@ This variable can also be set per-server." :version "28.1" :type '(repeat string)) -(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/") +(defcustom gnus-search-mairix-remove-prefix (expand-file-name "Mail/" "~") "The prefix to remove from each file name returned by mairix -in order to get a group name (albeit with / instead of .). This is a -regular expression. +in order to get a group name (albeit with / instead of .). This variable can also be set per-server." :version "28.1" @@ -762,6 +758,9 @@ the files in ARTLIST by that search key.") (generate-new-buffer " *gnus-search-"))) (cl-call-next-method engine slots)) +(defclass gnus-search-nnselect (gnus-search-engine) + nil) + (defclass gnus-search-imap (gnus-search-engine) ((literal-plus :initarg :literal-plus @@ -823,7 +822,7 @@ quirks.") :documentation "Location of the config file, if any.") (remove-prefix :initarg :remove-prefix - :initform (concat (getenv "HOME") "/Mail/") + :initform (expand-file-name "Mail/" "~") :type string :documentation "The path to the directory where the indexed mails are @@ -907,13 +906,15 @@ quirks.") (define-obsolete-variable-alias 'nnir-method-default-engines 'gnus-search-default-engines "28.1") -(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap)) +(defcustom gnus-search-default-engines '((nnimap . gnus-search-imap) + (nnselect . gnus-search-nnselect)) "Alist of default search engines keyed by server method." :version "26.1" :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) - (const nnfolder) (const nnmaildir)) + (const nnfolder) (const nnmaildir) + (const nnselect)) (choice ,@(mapcar (lambda (el) (list 'const (intern (car el)))) @@ -1010,6 +1011,33 @@ Responsible for handling and, or, and parenthetical expressions.") unseen all old new or not) "Known IMAP search keys.") +(autoload 'nnselect-categorize "nnselect") +(autoload 'nnselect-get-artlist "nnselect" nil nil 'macro) +(autoload 'ids-by-group "nnselect") +;; nnselect interface +(cl-defmethod gnus-search-run-search ((_engine gnus-search-nnselect) + _srv query-spec groups) + (let ((artlist [])) + (dolist (group groups) + (let* ((gnus-newsgroup-selection (nnselect-get-artlist group)) + (group-spec + (nnselect-categorize + (mapcar 'car + (ids-by-group + (number-sequence 1 + (length gnus-newsgroup-selection)))) + (lambda (x) + (gnus-group-server x))))) + (setq artlist + (vconcat artlist + (seq-intersection + gnus-newsgroup-selection + (gnus-search-run-query + (list (cons 'search-query-spec query-spec) + (cons 'search-group-spec group-spec)))))))) + artlist)) + + ;; imap interface (cl-defmethod gnus-search-run-search ((engine gnus-search-imap) srv query groups) @@ -1318,16 +1346,14 @@ This method is common to all indexed search engines. Returns a list of [group article score] vectors." - (save-excursion - (let* ((qstring (gnus-search-make-query-string engine query)) - (program (slot-value engine 'program)) - (buffer (slot-value engine 'proc-buffer)) - (cp-list (gnus-search-indexed-search-command - engine qstring query groups)) - proc exitstatus) - (set-buffer buffer) + (let* ((qstring (gnus-search-make-query-string engine query)) + (program (slot-value engine 'program)) + (buffer (slot-value engine 'proc-buffer)) + (cp-list (gnus-search-indexed-search-command + engine qstring query groups)) + proc exitstatus) + (with-current-buffer buffer (erase-buffer) - (if groups (gnus-message 7 "Doing %s query on %s..." program groups) (gnus-message 7 "Doing %s query..." program)) @@ -1346,7 +1372,7 @@ Returns a list of [group article score] vectors." ;; wants it. (when (> gnus-verbose 6) (display-buffer buffer)) - nil)))) + nil)))) (cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed) server query &optional groups) @@ -1367,18 +1393,27 @@ Returns a list of [group article score] vectors." (when (and f-name (file-readable-p f-name) (null (file-directory-p f-name))) - (setq group - (replace-regexp-in-string - "[/\\]" "." - (replace-regexp-in-string - "/?\\(cur\\|new\\|tmp\\)?/\\'" "" + ;; `expand-file-name' canoncalizes the file name, + ;; specifically collapsing multiple consecutive directory + ;; separators. + (setq f-name (expand-file-name f-name) + group + (delete + "" ; forward slash at root leaves an empty string + (file-name-split (replace-regexp-in-string - "\\`\\." "" - (string-remove-prefix + "\\`\\." "" ; why do we do this? + (string-remove-prefix prefix (file-name-directory f-name)) - nil t) - nil t) - nil t)) + nil t))) + ;; Turn file name segments into a Gnus group name. + group (mapconcat + #'identity + (if (member (car (last group)) + '("new" "tmp" "cur")) + (nbutlast group) + group) + ".")) (setq article (file-name-nondirectory f-name) article ;; TODO: Provide a cleaner way of producing final @@ -1600,19 +1635,26 @@ Namazu provides a little more information, for instance a score." (cp-list (gnus-search-indexed-search-command engine qstring query groups)) thread-ids proc) - (set-buffer proc-buffer) - (erase-buffer) - (setq proc (apply #'start-process (format "search-%s" server) - proc-buffer program cp-list)) - (while (process-live-p proc) - (accept-process-output proc)) - (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t) - (push (match-string 1) thread-ids)) + (with-current-buffer proc-buffer + (erase-buffer) + (setq proc (apply #'start-process (format "search-%s" server) + proc-buffer program cp-list)) + (while (process-live-p proc) + (accept-process-output proc)) + (goto-char (point-min)) + (while (re-search-forward + "^thread:\\([^[:space:]\n]+\\)" + (point-max) t) + (cl-pushnew (match-string 1) thread-ids :test #'equal))) (cl-call-next-method engine server - ;; Completely replace the query with our new thread-based one. - (mapconcat (lambda (thrd) (concat "thread:" thrd)) - thread-ids " or ") + ;; If we found threads, completely replace the query with + ;; our new thread-based one. + (if thread-ids + `((query . ,(mapconcat (lambda (thrd) + (concat "thread:" thrd)) + thread-ids " or "))) + query) nil))) (cl-call-next-method engine server query groups))) @@ -1625,16 +1667,16 @@ Namazu provides a little more information, for instance a score." (let ((limit (alist-get 'limit query)) (thread (alist-get 'thread query))) (with-slots (switches config-file) engine - `(,(format "--config=%s" config-file) - "search" - ,(if thread - "--output=threads" - "--output=files") - "--duplicate=1" ; I have found this necessary, I don't know why. - ,@switches - ,(if limit (format "--limit=%d" limit) "") - ,qstring - )))) + (append + (list (format "--config=%s" config-file) + "search" + (if thread + "--output=threads" + "--output=files")) + (unless thread '("--duplicate=1")) + (when limit (list (format "--limit=%d" limit))) + switches + (list qstring))))) ;;; Mairix interface diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 2cf11fb12f9..dd9c2778056 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2867,12 +2867,6 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (princ "(setq gnus-newsrc-file-version ") (princ (gnus-prin1-to-string gnus-version)) (princ ")\n")) - ;; Sort `gnus-newsrc-alist' according to order in - ;; `gnus-group-list'. - (setq gnus-newsrc-alist - (mapcar (lambda (g) - (nth 1 (gethash g gnus-newsrc-hashtb))) - (delete "dummy.group" gnus-group-list))) (let* ((print-quoted t) (print-escape-multibyte nil) (print-escape-nonascii t) @@ -2891,17 +2885,20 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." ;; Remove the `gnus-killed-list' from the list of variables ;; to be saved, if required. (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) - ;; Encode group names in `gnus-newsrc-alist' and - ;; `gnus-topic-alist' in order to keep newsrc.eld files - ;; compatible with older versions of Gnus. At some point, - ;; if/when a new version of Gnus is released, stop doing - ;; this and move the corresponding decode in - ;; `gnus-read-newsrc-el-file' into a conversion routine. + ;; Sort `gnus-newsrc-alist' according to order in + ;; `gnus-group-list'. Encode group names in + ;; `gnus-newsrc-alist' and `gnus-topic-alist' in order to + ;; keep newsrc.eld files compatible with older versions of + ;; Gnus. At some point, if/when a new version of Gnus is + ;; released, stop doing this and move the corresponding + ;; decode in `gnus-read-newsrc-el-file' into a conversion + ;; routine. (gnus-newsrc-alist - (mapcar (lambda (info) - (cons (encode-coding-string (car info) 'utf-8-emacs) - (cdr info))) - gnus-newsrc-alist)) + (mapcar (lambda (group) + (cons (encode-coding-string group 'utf-8-emacs) + (cdadr (gethash group + gnus-newsrc-hashtb)))) + (remove "dummy.group" gnus-group-list))) (gnus-topic-alist (when (memq 'gnus-topic-alist variables) (mapcar (lambda (elt) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 8fb07d5905c..1be5a48068c 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -13278,6 +13278,8 @@ BOOKMARK is a bookmark name or a bookmark record." (buffer . ,(current-buffer)) . ,(bookmark-get-bookmark-record bookmark))))) +(put 'gnus-summary-bookmark-jump 'bookmark-handler-type "Gnus") + (gnus-summary-make-all-marking-commands) (provide 'gnus-sum) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a6c6a16653d..800c7dcea03 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8369,7 +8369,11 @@ regular text mode tabbing command." (defcustom message-expand-name-standard-ui nil "If non-nil, use the standard completion UI in `message-expand-name'. -E.g. this means it will obey `completion-styles' and other such settings." +E.g. this means it will obey `completion-styles' and other such settings. + +If this variable is non-nil and `message-mail-alias-type' is +`ecomplete', `message-self-insert-commands' should probably be +set to nil." :version "27.1" :type 'boolean) @@ -8621,26 +8625,23 @@ From headers in the original article." message-hidden-headers)) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) - (end-of-headers (point-min))) + end-of-headers) (when regexps (save-excursion (save-restriction (message-narrow-to-headers) + (setq end-of-headers (point-min-marker)) (goto-char (point-min)) (while (not (eobp)) (if (not (message-hide-header-p regexps)) (message-next-header) - (let ((begin (point)) - header header-len) + (let ((begin (point))) (message-next-header) - (setq header (buffer-substring begin (point)) - header-len (- (point) begin)) - (delete-region begin (point)) - (goto-char end-of-headers) - (insert header) - (setq end-of-headers - (+ end-of-headers header-len)))))))) - (narrow-to-region end-of-headers (point-max)))) + (let ((header (delete-and-extract-region begin (point)))) + (save-excursion + (goto-char end-of-headers) + (insert-before-markers header)))))))) + (narrow-to-region end-of-headers (point-max))))) (defun message-hide-header-p (regexps) (let ((result nil) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index c40c38a95f9..57ce36a9442 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -519,17 +519,17 @@ If MODE is not set, try to find mode automatically." ;; setting now, but it seems harmless and potentially still useful. (setq-local font-lock-mode-hook nil) (setq buffer-file-name (mm-handle-filename handle)) - (with-demoted-errors - (if mode - (save-window-excursion - ;; According to Katsumi Yamaoka <yamaoka@jpl.org>, org-mode - ;; requires the buffer to be temporarily displayed here, but - ;; I could not reproduce this problem. Furthermore, if - ;; there's such a problem, we should fix org-mode rather than - ;; use switch-to-buffer which can have undesirable - ;; side-effects! - ;;(switch-to-buffer (current-buffer)) - (funcall mode)) + (with-demoted-errors "Error setting mode: %S" + (if mode + (save-window-excursion + ;; According to Katsumi Yamaoka <yamaoka@jpl.org>, org-mode + ;; requires the buffer to be temporarily displayed here, but + ;; I could not reproduce this problem. Furthermore, if + ;; there's such a problem, we should fix org-mode rather than + ;; use switch-to-buffer which can have undesirable + ;; side-effects! + ;;(switch-to-buffer (current-buffer)) + (funcall mode)) (let ((auto-mode-alist (delq (rassq 'doc-view-mode-maybe auto-mode-alist) (copy-sequence auto-mode-alist)))) diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el index d042981ca98..4a799acad98 100644 --- a/lisp/gnus/nnregistry.el +++ b/lisp/gnus/nnregistry.el @@ -36,7 +36,7 @@ (nnoo-declare nnregistry) (deffoo nnregistry-server-opened (_server) - gnus-registry-enabled) + gnus-registry-db) (deffoo nnregistry-close-server (_server &optional _defs) t) @@ -45,7 +45,7 @@ nil) (deffoo nnregistry-open-server (_server &optional _defs) - gnus-registry-enabled) + gnus-registry-db) (defvar nnregistry-within-nnregistry nil) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 205456a57df..f5be477d26d 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -47,7 +47,8 @@ ;;; Setup: (require 'gnus-art) -(require 'gnus-search) +(autoload 'gnus-search-run-query "gnus-search") +(autoload 'gnus-search-server-to-engine "gnus-search") (eval-when-compile (require 'cl-lib)) @@ -79,30 +80,33 @@ ;;; Helper routines. (defun nnselect-compress-artlist (artlist) "Compress ARTLIST." - (let (selection) - (pcase-dolist (`(,artgroup . ,arts) - (nnselect-categorize artlist #'nnselect-artitem-group)) - (let (list) - (pcase-dolist (`(,rsv . ,articles) - (nnselect-categorize - arts #'nnselect-artitem-rsv #'nnselect-artitem-number)) - (push (cons rsv (gnus-compress-sequence (sort articles #'<))) - list)) - (push (cons artgroup list) selection))) - selection)) + (if (consp artlist) + artlist + (let (selection) + (pcase-dolist (`(,artgroup . ,arts) + (nnselect-categorize artlist #'nnselect-artitem-group)) + (let (list) + (pcase-dolist (`(,rsv . ,articles) + (nnselect-categorize + arts #'nnselect-artitem-rsv #'nnselect-artitem-number)) + (push (cons rsv (gnus-compress-sequence (sort articles #'<))) + list)) + (push (cons artgroup list) selection))) + selection))) (defun nnselect-uncompress-artlist (artlist) "Uncompress ARTLIST." (if (vectorp artlist) artlist (let (selection) - (pcase-dolist (`(,artgroup (,artrsv . ,artseq)) artlist) - (setq selection - (vconcat - (cl-map 'vector - (lambda (art) - (vector artgroup art artrsv)) - (gnus-uncompress-sequence artseq)) selection))) + (pcase-dolist (`(,artgroup . ,list) artlist) + (pcase-dolist (`(,artrsv . ,artseq) list) + (setq selection + (vconcat + (cl-map 'vector + (lambda (art) + (vector artgroup art artrsv)) + (gnus-uncompress-sequence artseq)) selection)))) selection))) (make-obsolete 'nnselect-group-server 'gnus-group-server "28.1") @@ -528,68 +532,65 @@ If this variable is nil, or if the provided function returns nil, (deffoo nnselect-request-update-info (group info &optional _server) (let* ((group (nnselect-add-prefix group)) - (gnus-newsgroup-selection - (or gnus-newsgroup-selection (nnselect-get-artlist group))) - newmarks) + (gnus-newsgroup-selection + (or gnus-newsgroup-selection (nnselect-get-artlist group))) + newmarks) (gnus-info-set-marks info nil) (setf (gnus-info-read info) nil) (pcase-dolist (`(,artgroup . ,nartids) - (ids-by-group - (number-sequence 1 (nnselect-artlist-length - gnus-newsgroup-selection)))) + (ids-by-group + (number-sequence 1 (nnselect-artlist-length + gnus-newsgroup-selection)))) (let* ((gnus-newsgroup-active nil) - (artids (cl-sort nartids #'< :key 'car)) - (group-info (gnus-get-info artgroup)) - (marks (gnus-info-marks group-info)) - (unread (gnus-uncompress-sequence - (range-difference (gnus-active artgroup) - (gnus-info-read group-info))))) + (idmap (make-hash-table :test 'eql)) + (gactive (sort (mapcar 'cdr nartids) '<)) + (group-info (gnus-get-info artgroup)) + (marks (gnus-info-marks group-info))) + (pcase-dolist (`(,val . ,key) nartids) + (puthash key val idmap)) (setf (gnus-info-read info) - (range-add-list - (gnus-info-read info) - (delq nil (mapcar - (lambda (art) - (unless (memq (cdr art) unread) (car art))) - artids)))) - (pcase-dolist (`(,type . ,mark-list) marks) - (let ((mark-type (gnus-article-mark-to-type type)) new) - (when - (setq new - (delq nil - (cond - ((eq mark-type 'tuple) - (mapcar - (lambda (id) - (let (mark) - (when - (setq mark (assq (cdr id) mark-list)) - (cons (car id) (cdr mark))))) - artids)) - (t - (setq mark-list - (range-uncompress mark-list)) - (mapcar - (lambda (id) - (when (memq (cdr id) mark-list) - (car id))) artids))))) - (let ((previous (alist-get type newmarks))) - (if previous - (nconc previous new) - (push (cons type new) newmarks)))))))) + (range-add-list + (gnus-info-read info) + (sort (mapcar (lambda (art) (gethash art idmap)) + (gnus-sorted-intersection + gactive + (range-uncompress (gnus-info-read group-info)))) + '<))) + (pcase-dolist (`(,type . ,mark-list) marks) + (let ((mark-type (gnus-article-mark-to-type type)) new) + (when + (setq new + (if (not mark-list) nil + (cond + ((eq mark-type 'tuple) + (delq nil + (mapcar + (lambda (mark) + (let ((id (gethash (car mark) idmap))) + (when id (cons id (cdr mark))))) + mark-list))) + (t + (mapcar (lambda (art) (gethash art idmap)) + (gnus-sorted-intersection + gactive (range-uncompress mark-list))))))) + (let ((previous (alist-get type newmarks))) + (if previous + (nconc previous new) + (push (cons type new) newmarks)))))))) ;; Clean up the marks: compress lists; (pcase-dolist (`(,type . ,mark-list) newmarks) (let ((mark-type (gnus-article-mark-to-type type))) - (unless (eq mark-type 'tuple) - (setf (alist-get type newmarks) - (gnus-compress-sequence mark-list))))) + (unless (eq mark-type 'tuple) + (setf (alist-get type newmarks) + (gnus-compress-sequence (sort mark-list '<)))))) ;; and ensure an unexist key. (unless (assq 'unexist newmarks) (push (cons 'unexist nil) newmarks)) (gnus-info-set-marks info newmarks) (gnus-set-active group (cons 1 (nnselect-artlist-length - gnus-newsgroup-selection))))) + gnus-newsgroup-selection))))) (deffoo nnselect-request-thread (header &optional group server) @@ -750,8 +751,8 @@ If this variable is nil, or if the provided function returns nil, (deffoo nnselect-request-group-scan (group &optional _server _info) (let* ((group (nnselect-add-prefix group)) - (artlist (nnselect-run - (gnus-group-get-parameter group 'nnselect-specs t)))) + (artlist (nnselect-uncompress-artlist (nnselect-run + (gnus-group-get-parameter group 'nnselect-specs t))))) (gnus-set-active group (cons 1 (nnselect-artlist-length artlist))) (gnus-group-set-parameter @@ -863,9 +864,6 @@ 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 artgroup) - (not (gnus-article-unpropagatable-p type))) (let* ((old (range-list-intersection artlist (alist-get type (gnus-info-marks group-info)))) @@ -877,7 +875,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 diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 98a1b11e088..80d7d5cb028 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -33,6 +33,7 @@ ;;; Code: (require 'cl-lib) +(require 'seq) (require 'help-mode) (require 'radix-tree) (eval-when-compile (require 'subr-x)) ;For when-let. @@ -395,7 +396,7 @@ if the variable `help-downcase-arguments' is non-nil." ;; `describe-face' (instead of `describe-simplify-lib-file-name'). ;;;###autoload -(defun find-lisp-object-file-name (object type) +(defun find-lisp-object-file-name (object type &optional also-c-source) "Guess the file that defined the Lisp object OBJECT, of type TYPE. OBJECT should be a symbol associated with a function, variable, or face; alternatively, it can be a function definition. @@ -406,8 +407,13 @@ If TYPE is not a symbol, search for a function definition. The return value is the absolute name of a readable file where OBJECT is defined. If several such files exist, preference is given to a file found via `load-path'. The return value can also be `C-source', which -means that OBJECT is a function or variable defined in C. If no -suitable file is found, return nil." +means that OBJECT is a function or variable defined in C, but +it's currently unknown where. If no suitable file is found, +return nil. + +If ALSO-C-SOURCE is non-nil, instead of returning `C-source', +this function will attempt to locate the definition of OBJECT in +the C sources, too." (let* ((autoloaded (autoloadp type)) (file-name (or (and autoloaded (nth 1 type)) (symbol-file @@ -444,14 +450,18 @@ suitable file is found, return nil." (cond ((and (not file-name) (subrp type)) ;; A built-in function. The form is from `describe-function-1'. - (if (get-buffer " *DOC*") + (if (or (get-buffer " *DOC*") + (and also-c-source + (get-buffer-create " *DOC*"))) (help-C-file-name type 'subr) 'C-source)) ((and (not file-name) (symbolp object) (eq type 'defvar) (integerp (get object 'variable-documentation))) ;; A variable defined in C. The form is from `describe-variable'. - (if (get-buffer " *DOC*") + (if (or (get-buffer " *DOC*") + (and also-c-source + (get-buffer-create " *DOC*"))) (help-C-file-name object 'var) 'C-source)) ((not (stringp file-name)) @@ -678,19 +688,9 @@ suitable file is found, return nil." (terpri))) ;; We could use `symbol-file' but this is a wee bit more efficient. -(defun help-fns--autoloaded-p (function file) - "Return non-nil if FUNCTION has previously been autoloaded. -FILE is the file where FUNCTION was probably defined." - (let* ((file (file-name-sans-extension (file-truename file))) - (load-hist load-history) - (target (cons t function)) - found) - (while (and load-hist (not found)) - (and (stringp (caar load-hist)) - (equal (file-name-sans-extension (caar load-hist)) file) - (setq found (member target (cdar load-hist)))) - (setq load-hist (cdr load-hist))) - found)) +(defun help-fns--autoloaded-p (function) + "Return non-nil if FUNCTION has previously been autoloaded." + (seq-some #'autoloadp (get function 'function-history))) (defun help-fns--interactive-only (function) "Insert some help blurb if FUNCTION should only be used interactively." @@ -873,13 +873,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." "Print a line describing FUNCTION to `standard-output'." (pcase-let* ((`(,_real-function ,def ,aliased ,real-def) (help-fns--analyze-function function)) - (file-name (find-lisp-object-file-name function (if aliased 'defun - def))) + (file-name (find-lisp-object-file-name + function (if aliased 'defun def))) (beg (if (and (or (byte-code-function-p def) (keymapp def) (memq (car-safe def) '(macro lambda closure))) (stringp file-name) - (help-fns--autoloaded-p function file-name)) + (help-fns--autoloaded-p function)) (concat "an autoloaded " (if (commandp def) "interactive ")) @@ -968,12 +968,18 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." ;;;###autoload (defun describe-function-1 (function) - (let ((pt1 (with-current-buffer (help-buffer) (point)))) + (let ((pt1 (with-current-buffer standard-output (point)))) (help-fns-function-description-header function) - (with-current-buffer (help-buffer) - (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) - (point)))) - (terpri)(terpri) + (with-current-buffer standard-output + (let ((inhibit-read-only t)) + (fill-region-as-paragraph + (save-excursion + (goto-char pt1) + (forward-line 0) + (point)) + (point) + nil t) + (ensure-empty-lines)))) (pcase-let* ((`(,real-function ,def ,_aliased ,real-def) (help-fns--analyze-function function)) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 5fb5dcfb195..d1b9357f3c9 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -936,6 +936,7 @@ BOOKMARK is a bookmark name or a bookmark record." (pop-to-buffer "*Help*") (goto-char position))) +(put 'help-bookmark-jump 'bookmark-handler-type "Help") (provide 'help-mode) diff --git a/lisp/help.el b/lisp/help.el index 983f39479cb..975be497e77 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -650,15 +650,21 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (if insert (if (> (length keys) 0) (if remapped - (format "%s (%s) (remapped from %s)" - keys remapped symbol) - (format "%s (%s)" keys symbol)) + (format "%s, remapped to %s (%s)" + symbol remapped keys) + (format "%s (%s)" symbol keys)) (format "M-x %s RET" symbol)) (if (> (length keys) 0) (if remapped - (format "%s is remapped to %s which is on %s" - symbol remapped keys) - (format "%s is on %s" symbol keys)) + (if (eq symbol (symbol-function definition)) + (format + "%s, which is remapped to %s, which is on %s" + symbol remapped keys) + (format "%s is remapped to %s, which is on %s" + symbol remapped keys)) + (if (eq symbol (symbol-function definition)) + (format "%s, which is on %s" symbol keys) + (format "%s is on %s" symbol keys))) ;; If this is the command the user asked about, ;; and it is not on any key, say so. ;; For other symbols, its aliases, say nothing @@ -667,7 +673,9 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (format "%s is not on any key" symbol))))) (when string (unless (eq symbol definition) - (princ ";\n its alias ")) + (if (eq definition (symbol-function symbol)) + (princ ";\n its alias ") + (princ ";\n it's an alias for "))) (princ string))))) nil) @@ -899,6 +907,12 @@ While reading KEY-LIST interactively, this command temporarily enables menu items or tool-bar buttons that are disabled to allow getting help on them. +Interactively, this command can't describe prefix commands, but +will always wait for the user to type the complete key sequence. +For instance, entering \"C-x\" will wait until the command has +been completed, but `M-: (describe-key (kbd \"C-x\")) RET' will +tell you what this prefix command is bound to. + BUFFER is the buffer in which to lookup those keys; it defaults to the current buffer." (declare (advertised-calling-convention (key-list &optional buffer) "27.1")) diff --git a/lisp/ido.el b/lisp/ido.el index 58cec3deb0e..e068028d919 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -978,7 +978,6 @@ The fallback command is passed as an argument to the functions." (defvar-keymap ido-file-completion-map :doc "Keymap for Ido file commands." :parent ido-file-dir-completion-map - "C-k" #'ido-delete-file-at-head "C-o" #'ido-copy-current-word "C-w" #'ido-copy-current-file-name "M-l" #'ido-toggle-literal) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 9b0bbb70df9..d8bd2937db8 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -2792,6 +2792,7 @@ tags to their respective image file. Internal function used by ;; (bookmark-prop-get bookmark 'image-dired-file) (goto-char (point-min)))) +(put 'image-dired-bookmark-jump 'bookmark-handler-type "Image") ;;; Obsolete diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 5bee155460f..b2af3f06a27 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -645,9 +645,11 @@ Key bindings: ;; Bail out early if we have no image data. (if (zerop (buffer-size)) (funcall (if (called-interactively-p 'any) 'error 'message) - (if (file-exists-p buffer-file-name) - "Empty file" - "(New file)")) + (if (stringp buffer-file-name) + (if (file-exists-p buffer-file-name) + "Empty file" + "(New file)") + "Empty buffer")) (image-mode--display))) (defun image-mode--display () diff --git a/lisp/image.el b/lisp/image.el index c9165f77814..ec4ee06eb14 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -171,18 +171,16 @@ or \"ffmpeg\") is installed." (define-error 'unknown-image-type "Unknown image type") -;; Map put into text properties on images. -(defvar image-map - (let ((map (make-sparse-keymap))) - (define-key map "-" 'image-decrease-size) - (define-key map "+" 'image-increase-size) - (define-key map [C-wheel-down] 'image-mouse-decrease-size) - (define-key map [C-mouse-5] 'image-mouse-decrease-size) - (define-key map [C-wheel-up] 'image-mouse-increase-size) - (define-key map [C-mouse-4] 'image-mouse-increase-size) - (define-key map "r" 'image-rotate) - (define-key map "o" 'image-save) - map)) +(defvar-keymap image-map + :doc "Map put into text properties on images." + "-" #'image-decrease-size + "+" #'image-increase-size + "r" #'image-rotate + "o" #'image-save + "C-<wheel-down>" #'image-mouse-decrease-size + "C-<mouse-5>" #'image-mouse-decrease-size + "C-<wheel-up>" #'image-mouse-increase-size + "C-<mouse-4>" #'image-mouse-increase-size) (defun image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -894,8 +892,9 @@ Frames are indexed from 0. Optional argument NOCHECK non-nil means do not check N is within the range of frames present in the image." (unless nocheck (if (< n 0) (setq n 0) - (setq n (min n (1- (car (plist-get (cdr image) - :animate-multi-frame-data))))))) + (setq n (min n (1- (car (or (plist-get (cdr image) + :animate-multi-frame-data) + (image-multi-frame-p image)))))))) (plist-put (cdr image) :index n) (force-window-update (plist-get (cdr image) :animate-buffer))) diff --git a/lisp/info-look.el b/lisp/info-look.el index 42e758360ea..aa07c3f5e70 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -1074,6 +1074,7 @@ Return nil if there is nothing appropriate in the buffer near point." ("url" "Variable Index" "Function Index") ("vhdl" "(vhdl-mode)Variable Index" "(vhdl-mode)Command Index") ("viper" "Variable Index" "Function Index") + ("vtable" "Index") ("widget" "Index") ("wisent" "Index") ("woman" "Variable Index" "Command Index"))) diff --git a/lisp/info.el b/lisp/info.el index bb8cd0d312f..0565663c38e 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -5449,6 +5449,7 @@ type returned by `Info-bookmark-make-record', which see." (bookmark-default-handler `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk))))) +(put 'Info-bookmark-jump 'bookmark-handler-type "Info") ;;;###autoload (defun info-display-manual (manual) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index bd557df180c..1950a409354 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -184,6 +184,7 @@ (runic #x16A0) (khmer #x1780) (mongolian #x1826) + (tai-tham #x1A20 #x1A55 #x1A61 #x1A80) (symbol . [#x201C #x2200 #x2500]) (braille #x2800) (ideographic-description #x2FF0) @@ -282,7 +283,7 @@ (defvar otf-script-alist) -;; The below was synchronized with the latest Oct 8, 2020 version of +;; The below was synchronized with the latest Sep 12, 2021 version of ;; https://docs.microsoft.com/en-us/typography/opentype/spec/scripttags (setq otf-script-alist '((adlm . adlam) @@ -315,6 +316,7 @@ (copt . coptic) (xsux . cuneiform) (cprt . cypriot) + (cpmn . cypro-minoan) (cyrl . cyrillic) (dsrt . deseret) (deva . devanagari) @@ -338,7 +340,7 @@ (gur2 . gurmukhi) (hani . han) (hang . hangul) - (jamo . hangul) + (jamo . hangul) ; Not recommended; use 'hang' instead. (rohg . hanifi-rohingya) (hano . hanunoo) (hatr . hatran) @@ -388,6 +390,7 @@ (musc . musical-symbol) (mym2 . burmese) (mymr . burmese) + (nand . nandinagari) (nbat . nabataean) (newa . newa) (nko\ . nko) @@ -402,6 +405,7 @@ (sogo . old-sogdian) (sarb . old-south-arabian) (orkh . old-turkic) + (ougr . old-uyghur) (orya . oriya) (ory2 . oriya) (osge . osage) @@ -438,6 +442,7 @@ (takr . takri) (taml . tamil) (tml2 . tamil) + (tnsa . tangsa) (tang . tangut) (telu . telugu) (tel2 . telugu) @@ -446,7 +451,9 @@ (tibt . tibetan) (tfng . tifinagh) (tirh . tirhuta) + (toto . toto) (ugar . ugaritic) + (vith . vithkuqi) (vai\ . vai) (wcho . wancho) (wara . warang-citi) @@ -779,6 +786,7 @@ counting-rod-numeral toto adlam + tai-tham mahjong-tile domino-tile emoji)) @@ -1133,7 +1141,7 @@ Internal use only. Should be called at startup time." (defconst xlfd-regexp-pointsize-subnum 6) ; POINT_SIZE (defconst xlfd-regexp-resx-subnum 7) ; RESOLUTION_X (defconst xlfd-regexp-resy-subnum 8) ; RESOLUTION_Y -(defconst xlfd-regexp-spacing-subnum 8) ; SPACING +(defconst xlfd-regexp-spacing-subnum 9) ; SPACING (defconst xlfd-regexp-avgwidth-subnum 10) ; AVERAGE_WIDTH (defconst xlfd-regexp-registry-subnum 11) ; REGISTRY and ENCODING diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index c8ff93aeb21..7054077fb02 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -1,4 +1,4 @@ -;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*- lexical-binding: t; -*- +;;; latin1-disp.el --- display tables for non-ASCII on Latin-1 terminals -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2022 Free Software Foundation, Inc. @@ -22,18 +22,23 @@ ;;; Commentary: -;; This package sets up display of ISO 8859-n for n>1 by substituting -;; Latin-1 characters and sequences of them for characters which can't -;; be displayed, either because we're on a tty or because we don't -;; have the relevant window system fonts available. For instance, -;; Latin-9 is very similar to Latin-1, so we can display most Latin-9 -;; characters using the Latin-1 characters at the same code point and -;; fall back on more-or-less mnemonic ASCII sequences for the rest. +;; This package sets up display of many non-ASCII characters by +;; substituting ASCII and Latin-1 characters and sequences of them for +;; characters which can't be displayed, either because we're on a tty +;; or because we don't have the relevant window system fonts +;; available. For instance, Latin-9 is very similar to Latin-1, so we +;; can display most Latin-9 characters using the Latin-1 characters at +;; the same code point and fall back on more-or-less mnemonic ASCII +;; sequences for the rest. ;; For the Latin charsets the ASCII sequences are mostly consistent ;; with the Quail prefix input sequences. Latin-4 uses the Quail ;; postfix sequences since a prefix method isn't defined for Latin-4. +;; Non-Latin non-ASCII characters are generally displayed as ASCII +;; strings remotely reminiscent of the original characters, as best as +;; possible. See `latin1-display-ucs-per-lynx'. + ;; [A different approach is taken in the DOS display tables in ;; term/internal.el, and the relevant ASCII sequences from there are ;; available as an alternative; see `latin1-display-mnemonic'. Only @@ -759,2426 +764,2425 @@ turn it off and display Unicode characters literally. The display isn't changed if the display can render Unicode characters." (interactive "p") (if (> arg 0) - (unless (char-displayable-p #x101) ; a with macron - ;; It doesn't look as though we have a Unicode font. - (let ((latin1-display-format "%s")) - (mapc - (lambda (l) - (apply 'latin1-display-char l)) - ;; Table derived by running Lynx on a suitable list of - ;; characters in a utf-8 file, except for some added by - ;; hand at the end. - '((?\Ā "A") - (?\ā "a") - (?\Ă "A") - (?\ă "a") - (?\Ą "A") - (?\ą "a") - (?\Ć "C") - (?\ć "c") - (?\Ĉ "C") - (?\ĉ "c") - (?\Ċ "C") - (?\ċ "c") - (?\Č "C") - (?\č "c") - (?\Ď "D") - (?\ď "d") - (?\Đ "Ð") - (?\đ "d/") - (?\Ē "E") - (?\ē "e") - (?\Ĕ "E") - (?\ĕ "e") - (?\Ė "E") - (?\ė "e") - (?\Ę "E") - (?\ę "e") - (?\Ě "E") - (?\ě "e") - (?\Ĝ "G") - (?\ĝ "g") - (?\Ğ "G") - (?\ğ "g") - (?\Ġ "G") - (?\ġ "g") - (?\Ģ "G") - (?\ģ "g") - (?\Ĥ "H") - (?\ĥ "h") - (?\Ħ "H/") - (?\ħ "H") - (?\Ĩ "I") - (?\ĩ "i") - (?\Ī "I") - (?\ī "i") - (?\Ĭ "I") - (?\ĭ "i") - (?\Į "I") - (?\į "i") - (?\İ "I") - (?\ı "i") - (?\IJ "IJ") - (?\ij "ij") - (?\Ĵ "J") - (?\ĵ "j") - (?\Ķ "K") - (?\ķ "k") - (?\ĸ "kk") - (?\Ĺ "L") - (?\ĺ "l") - (?\Ļ "L") - (?\ļ "l") - (?\Ľ "L") - (?\ľ "l") - (?\Ŀ "L.") - (?\ŀ "l.") - (?\Ł "L/") - (?\ł "l/") - (?\Ń "N") - (?\ń "n") - (?\Ņ "N") - (?\ņ "n") - (?\Ň "N") - (?\ň "n") - (?\ʼn "'n") - (?\Ŋ "NG") - (?\ŋ "N") - (?\Ō "O") - (?\ō "o") - (?\Ŏ "O") - (?\ŏ "o") - (?\Ő "O\"") - (?\ő "o\"") - (?\Œ "OE") - (?\œ "oe") - (?\Ŕ "R") - (?\ŕ "r") - (?\Ŗ "R") - (?\ŗ "r") - (?\Ř "R") - (?\ř "r") - (?\Ś "S") - (?\ś "s") - (?\Ŝ "S") - (?\ŝ "s") - (?\Ş "S") - (?\ş "s") - (?\Š "S") - (?\š "s") - (?\Ţ "T") - (?\ţ "t") - (?\Ť "T") - (?\ť "t") - (?\Ŧ "T/") - (?\ŧ "t/") - (?\Ũ "U") - (?\ũ "u") - (?\Ū "U") - (?\ū "u") - (?\Ŭ "U") - (?\ŭ "u") - (?\Ů "U") - (?\ů "u") - (?\Ű "U\"") - (?\ű "u\"") - (?\Ų "U") - (?\ų "u") - (?\Ŵ "W") - (?\ŵ "w") - (?\Ŷ "Y") - (?\ŷ "y") - (?\Ÿ "Y") - (?\Ź "Z") - (?\ź "z") - (?\Ż "Z") - (?\ż "z") - (?\Ž "Z") - (?\ž "z") - (?\ſ "s1") - (?\Ƈ "C2") - (?\ƈ "c2") - (?\Ƒ "F2") - (?\ƒ " f") - (?\Ƙ "K2") - (?\ƙ "k2") - (?\Ơ "O9") - (?\ơ "o9") - (?\Ƣ "OI") - (?\ƣ "oi") - (?\Ʀ "yr") - (?\Ư "U9") - (?\ư "u9") - (?\Ƶ "Z/") - (?\ƶ "z/") - (?\Ʒ "ED") - (?\Ǎ "A") - (?\ǎ "a") - (?\Ǐ "I") - (?\ǐ "i") - (?\Ǒ "O") - (?\ǒ "o") - (?\Ǔ "U") - (?\ǔ "u") - (?\Ǖ "U:-") - (?\ǖ "u:-") - (?\Ǘ "U:'") - (?\ǘ "u:'") - (?\Ǚ "U:<") - (?\ǚ "u:<") - (?\Ǜ "U:!") - (?\ǜ "u:!") - (?\Ǟ "A1") - (?\ǟ "a1") - (?\Ǡ "A7") - (?\ǡ "a7") - (?\Ǣ "A3") - (?\ǣ "a3") - (?\Ǥ "G/") - (?\ǥ "g/") - (?\Ǧ "G") - (?\ǧ "g") - (?\Ǩ "K") - (?\ǩ "k") - (?\Ǫ "O") - (?\ǫ "o") - (?\Ǭ "O1") - (?\ǭ "o1") - (?\Ǯ "EZ") - (?\ǯ "ez") - (?\ǰ "j") - (?\Ǵ "G") - (?\ǵ "g") - (?\Ǻ "AA'") - (?\ǻ "aa'") - (?\Ǽ "AE'") - (?\ǽ "ae'") - (?\Ǿ "O/'") - (?\ǿ "o/'") - (?\Ȁ "A!!") - (?\ȁ "a!!") - (?\Ȃ "A)") - (?\ȃ "a)") - (?\Ȅ "E!!") - (?\ȅ "e!!") - (?\Ȇ "E)") - (?\ȇ "e)") - (?\Ȉ "I!!") - (?\ȉ "i!!") - (?\Ȋ "I)") - (?\ȋ "i)") - (?\Ȍ "O!!") - (?\ȍ "o!!") - (?\Ȏ "O)") - (?\ȏ "o)") - (?\Ȑ "R!!") - (?\ȑ "r!!") - (?\Ȓ "R)") - (?\ȓ "r)") - (?\Ȕ "U!!") - (?\ȕ "u!!") - (?\Ȗ "U)") - (?\ȗ "u)") - (?\ȝ "Z") - (?\ɑ "A") - (?\ɒ "A.") - (?\ɓ "b`") - (?\ɔ "O") - (?\ɖ "d.") - (?\ɗ "d`") - (?\ɘ "@<umd>") - (?\ə "@") - (?\ɚ "R") - (?\ɛ "E") - (?\ɜ "V\"") - (?\ɝ "R<umd>") - (?\ɞ "O\"") - (?\ɟ "J") - (?\ɠ "g`") - (?\ɡ "g") - (?\ɢ "G") - (?\ɣ "Q") - (?\ɤ "o-") - (?\ɥ "j<rnd>") - (?\ɦ "h<?>") - (?\ɨ "i\"") - (?\ɩ "I") - (?\ɪ "I") - (?\ɫ "L") - (?\ɬ "L") - (?\ɭ "l.") - (?\ɮ "z<lat>") - (?\ɯ "u-") - (?\ɰ "j<vel>") - (?\ɱ "M") - (?\ɳ "n.") - (?\ɴ "n\"") - (?\ɵ "@.") - (?\ɶ "&.") - (?\ɷ "U") - (?\ɹ "r") - (?\ɺ "*<lat>") - (?\ɻ "r.") - (?\ɽ "*.") - (?\ɾ "*") - (?\ʀ "R") - (?\ʁ "g\"") - (?\ʂ "s.") - (?\ʃ "S") - (?\ʄ "J`") - (?\ʇ "t!") - (?\ʈ "t.") - (?\ʉ "u\"") - (?\ʊ "U") - (?\ʋ "r<lbd>") - (?\ʌ "V") - (?\ʍ "w<vls>") - (?\ʎ "l^") - (?\ʏ "I.") - (?\ʐ "z.") - (?\ʒ "Z") - (?\ʔ "?") - (?\ʕ "H<vcd>") - (?\ʖ "l!") - (?\ʗ "c!") - (?\ʘ "p!") - (?\ʙ "b<trl>") - (?\ʛ "G`") - (?\ʝ "j") - (?\ʞ "k!") - (?\ʟ "L") - (?\ʠ "q`") - (?\ʤ "d3") - (?\ʦ "ts") - (?\ʧ "tS") - (?\ʰ "<h>") - (?\ʱ "<?>") - (?\ʲ ";") - (?\ʳ "<r>") - (?\ʷ "<w>") - (?\ʻ ";S") - (?\ʼ "`") - (?\ˆ "^") - (?\ˇ "'<") - (?\ˈ "|") - (?\ˉ "1-") - (?\ˋ "1!") - (?\ː ":") - (?\ˑ ":\\") - (?\˖ "+") - (?\˗ "-") - (?\˘ "'(") - (?\˙ "'.") - (?\˚ "'0") - (?\˛ "';") - (?\˜ "~") - (?\˝ "'\"") - (?\˥ "_T") - (?\˦ "_H") - (?\˧ "_M") - (?\˨ "_L") - (?\˩ "_B") - (?\ˬ "_v") - (?\ˮ "''") - (?\̀ "`") - (?\́ "'") - (?\̂ "^") - (?\̃ "~") - (?\̄ "¯") - (?\̇ "·") - (?\̈ "¨") - (?\̊ "°") - (?\̋ "''") - (?\̍ "|") - (?\̎ "||") - (?\̏ "``") - (?\̡ ";") - (?\̢ ".") - (?\̣ ".") - (?\̤ "<?>") - (?\̥ "<o>") - (?\̦ ",") - (?\̧ "¸") - (?\̩ "-") - (?\̪ "[") - (?\̫ "<w>") - (?\̴ "~") - (?\̷ "/") - (?\̸ "/") - (?\̀ "`") - (?\́ "'") - (?\͂ "~") - (?\̈́ "'%") - (?\ͅ "j3") - (?\͇ "=") - (?\͠ "~~") - (?\ʹ "'") - (?\͵ ",") - (?\ͺ "j3") - (?\; "?%") - (?\΄ "'*") - (?\΅ "'%") - (?\Ά "A'") - (?\· "·") - (?\Έ "E'") - (?\Ή "Y%") - (?\Ί "I'") - (?\Ό "O'") - (?\Ύ "U%") - (?\Ώ "W%") - (?\ΐ "i3") - (?\Α "A") - (?\Β "B") - (?\Γ "G") - (?\Δ "D") - (?\Ε "E") - (?\Ζ "Z") - (?\Η "Y") - (?\Θ "TH") - (?\Ι "I") - (?\Κ "K") - (?\Λ "L") - (?\Μ "M") - (?\Ν "N") - (?\Ξ "C") - (?\Ο "O") - (?\Π "P") - (?\Ρ "R") - (?\Σ "S") - (?\Τ "T") - (?\Υ "U") - (?\Φ "F") - (?\Χ "X") - (?\Ψ "Q") - (?\Ω "W*") - (?\Ϊ "J") - (?\Ϋ "V*") - (?\ά "a'") - (?\έ "e'") - (?\ή "y%") - (?\ί "i'") - (?\ΰ "u3") - (?\α "a") - (?\β "b") - (?\γ "g") - (?\δ "d") - (?\ε "e") - (?\ζ "z") - (?\η "y") - (?\θ "th") - (?\ι "i") - (?\κ "k") - (?\λ "l") - (?\μ "µ") - (?\ν "n") - (?\ξ "c") - (?\ο "o") - (?\π "p") - (?\ρ "r") - (?\ς "*s") - (?\σ "s") - (?\τ "t") - (?\υ "u") - (?\φ "f") - (?\χ "x") - (?\ψ "q") - (?\ω "w") - (?\ϊ "j") - (?\ϋ "v*") - (?\ό "o'") - (?\ύ "u%") - (?\ώ "w%") - (?\ϐ "beta ") - (?\ϑ "theta ") - (?\ϒ "upsi ") - (?\ϕ "phi ") - (?\ϖ "pi ") - (?\ϗ "k.") - (?\Ϛ "T3") - (?\ϛ "t3") - (?\Ϝ "M3") - (?\ϝ "m3") - (?\Ϟ "K3") - (?\ϟ "k3") - (?\Ϡ "P3") - (?\ϡ "p3") - (?\ϰ "kappa ") - (?\ϱ "rho ") - (?\ϳ "J") - (?\ϴ "'%") - (?\ϵ "j3") - (?\Ё "IO") - (?\Ђ "D%") - (?\Ѓ "G%") - (?\Є "IE") - (?\Ѕ "DS") - (?\І "II") - (?\Ї "YI") - (?\Ј "J%") - (?\Љ "LJ") - (?\Њ "NJ") - (?\Ћ "Ts") - (?\Ќ "KJ") - (?\Ў "V%") - (?\Џ "DZ") - (?\А "A") - (?\Б "B") - (?\В "V") - (?\Г "G") - (?\Д "D") - (?\Е "E") - (?\Ж "ZH") - (?\З "Z") - (?\И "I") - (?\Й "J") - (?\К "K") - (?\Л "L") - (?\М "M") - (?\Н "N") - (?\О "O") - (?\П "P") - (?\Р "R") - (?\С "S") - (?\Т "T") - (?\У "U") - (?\Ф "F") - (?\Х "H") - (?\Ц "C") - (?\Ч "CH") - (?\Ш "SH") - (?\Щ "SCH") - (?\Ъ "\"") - (?\Ы "Y") - (?\Ь "'") - (?\Э "`E") - (?\Ю "YU") - (?\Я "YA") - (?\а "a") - (?\б "b") - (?\в "v") - (?\г "g") - (?\д "d") - (?\е "e") - (?\ж "zh") - (?\з "z") - (?\и "i") - (?\й "j") - (?\к "k") - (?\л "l") - (?\м "m") - (?\н "n") - (?\о "o") - (?\п "p") - (?\р "r") - (?\с "s") - (?\т "t") - (?\у "u") - (?\ф "f") - (?\х "h") - (?\ц "c") - (?\ч "ch") - (?\ш "sh") - (?\щ "sch") - (?\ъ "\"") - (?\ы "y") - (?\ь "'") - (?\э "`e") - (?\ю "yu") - (?\я "ya") - (?\ё "io") - (?\ђ "d%") - (?\ѓ "g%") - (?\є "ie") - (?\ѕ "ds") - (?\і "ii") - (?\ї "yi") - (?\ј "j%") - (?\љ "lj") - (?\њ "nj") - (?\ћ "ts") - (?\ќ "kj") - (?\ў "v%") - (?\џ "dz") - (?\Ѣ "Y3") - (?\ѣ "y3") - (?\Ѫ "O3") - (?\ѫ "o3") - (?\Ѳ "F3") - (?\ѳ "f3") - (?\Ѵ "V3") - (?\ѵ "v3") - (?\Ҁ "C3") - (?\ҁ "c3") - (?\Ґ "G3") - (?\ґ "g3") - (?\Ӕ "AE") - (?\ӕ "ae") - (?\ִ "i") - (?\ַ "a") - (?\ָ "o") - (?\ּ "u") - (?\ֿ "h") - (?\ׂ ":") - (?\א "#") - (?\ב "B+") - (?\ג "G+") - (?\ד "D+") - (?\ה "H+") - (?\ו "W+") - (?\ז "Z+") - (?\ח "X+") - (?\ט "Tj") - (?\י "J+") - (?\ך "K%") - (?\כ "K+") - (?\ל "L+") - (?\ם "M%") - (?\מ "M+") - (?\ן "N%") - (?\נ "N+") - (?\ס "S+") - (?\ע "E+") - (?\ף "P%") - (?\פ "P+") - (?\ץ "Zj") - (?\צ "ZJ") - (?\ק "Q+") - (?\ר "R+") - (?\ש "Sh") - (?\ת "T+") - (?\װ "v") - (?\ױ "oy") - (?\ײ "ey") - (?\، ",+") - (?\؛ ";+") - (?\؟ "?+") - (?\ء "H'") - (?\آ "aM") - (?\أ "aH") - (?\ؤ "wH") - (?\إ "ah") - (?\ئ "yH") - (?\ا "a+") - (?\ب "b+") - (?\ة "tm") - (?\ت "t+") - (?\ث "tk") - (?\ج "g+") - (?\ح "hk") - (?\خ "x+") - (?\د "d+") - (?\ذ "dk") - (?\ر "r+") - (?\ز "z+") - (?\س "s+") - (?\ش "sn") - (?\ص "c+") - (?\ض "dd") - (?\ط "tj") - (?\ظ "zH") - (?\ع "e+") - (?\غ "i+") - (?\ـ "++") - (?\ف "f+") - (?\ق "q+") - (?\ك "k+") - (?\ل "l+") - (?\م "m+") - (?\ن "n+") - (?\ه "h+") - (?\و "w+") - (?\ى "j+") - (?\ي "y+") - (?\ً ":+") - (?\ٌ "\"+") - (?\ٍ "=+") - (?\َ "/+") - (?\ُ "'+") - (?\ِ "1+") - (?\ّ "3+") - (?\ْ "0+") - (?\٠ "0a") - (?\١ "1a") - (?\٢ "2a") - (?\٣ "3a") - (?\٤ "4a") - (?\٥ "5a") - (?\٦ "6a") - (?\٧ "7a") - (?\٨ "8a") - (?\٩ "9a") - (?\ٰ "aS") - (?\پ "p+") - (?\ځ "hH") - (?\چ "tc") - (?\ژ "zj") - (?\ڤ "v+") - (?\گ "gf") - (?\۰ "0a") - (?\۱ "1a") - (?\۲ "2a") - (?\۳ "3a") - (?\۴ "4a") - (?\۵ "5a") - (?\۶ "6a") - (?\۷ "7a") - (?\۸ "8a") - (?\۹ "9a") - (?\ሀ "he") - (?\ሁ "hu") - (?\ሂ "hi") - (?\ሃ "ha") - (?\ሄ "hE") - (?\ህ "h") - (?\ሆ "ho") - (?\ለ "le") - (?\ሉ "lu") - (?\ሊ "li") - (?\ላ "la") - (?\ሌ "lE") - (?\ል "l") - (?\ሎ "lo") - (?\ሏ "lWa") - (?\ሐ "He") - (?\ሑ "Hu") - (?\ሒ "Hi") - (?\ሓ "Ha") - (?\ሔ "HE") - (?\ሕ "H") - (?\ሖ "Ho") - (?\ሗ "HWa") - (?\መ "me") - (?\ሙ "mu") - (?\ሚ "mi") - (?\ማ "ma") - (?\ሜ "mE") - (?\ም "m") - (?\ሞ "mo") - (?\ሟ "mWa") - (?\ሠ "`se") - (?\ሡ "`su") - (?\ሢ "`si") - (?\ሣ "`sa") - (?\ሤ "`sE") - (?\ሥ "`s") - (?\ሦ "`so") - (?\ሧ "`sWa") - (?\ረ "re") - (?\ሩ "ru") - (?\ሪ "ri") - (?\ራ "ra") - (?\ሬ "rE") - (?\ር "r") - (?\ሮ "ro") - (?\ሯ "rWa") - (?\ሰ "se") - (?\ሱ "su") - (?\ሲ "si") - (?\ሳ "sa") - (?\ሴ "sE") - (?\ስ "s") - (?\ሶ "so") - (?\ሷ "sWa") - (?\ሸ "xe") - (?\ሹ "xu") - (?\ሺ "xi") - (?\ሻ "xa") - (?\ሼ "xE") - (?\ሽ "xa") - (?\ሾ "xo") - (?\ሿ "xWa") - (?\ቀ "qe") - (?\ቁ "qu") - (?\ቂ "qi") - (?\ቃ "qa") - (?\ቄ "qE") - (?\ቅ "q") - (?\ቆ "qo") - (?\ቈ "qWe") - (?\ቊ "qWi") - (?\ቋ "qWa") - (?\ቌ "qWE") - (?\ቍ "qW") - (?\ቐ "Qe") - (?\ቑ "Qu") - (?\ቒ "Qi") - (?\ቓ "Qa") - (?\ቔ "QE") - (?\ቕ "Q") - (?\ቖ "Qo") - (?\ቘ "QWe") - (?\ቚ "QWi") - (?\ቛ "QWa") - (?\ቜ "QWE") - (?\ቝ "QW") - (?\በ "be") - (?\ቡ "bu") - (?\ቢ "bi") - (?\ባ "ba") - (?\ቤ "bE") - (?\ብ "b") - (?\ቦ "bo") - (?\ቧ "bWa") - (?\ቨ "ve") - (?\ቩ "vu") - (?\ቪ "vi") - (?\ቫ "va") - (?\ቬ "vE") - (?\ቭ "v") - (?\ቮ "vo") - (?\ቯ "vWa") - (?\ተ "te") - (?\ቱ "tu") - (?\ቲ "ti") - (?\ታ "ta") - (?\ቴ "tE") - (?\ት "t") - (?\ቶ "to") - (?\ቷ "tWa") - (?\ቸ "ce") - (?\ቹ "cu") - (?\ቺ "ci") - (?\ቻ "ca") - (?\ቼ "cE") - (?\ች "c") - (?\ቾ "co") - (?\ቿ "cWa") - (?\ኀ "`he") - (?\ኁ "`hu") - (?\ኂ "`hi") - (?\ኃ "`ha") - (?\ኄ "`hE") - (?\ኅ "`h") - (?\ኆ "`ho") - (?\ኈ "hWe") - (?\ኊ "hWi") - (?\ኋ "hWa") - (?\ኌ "hWE") - (?\ኍ "hW") - (?\ነ "na") - (?\ኑ "nu") - (?\ኒ "ni") - (?\ና "na") - (?\ኔ "nE") - (?\ን "n") - (?\ኖ "no") - (?\ኗ "nWa") - (?\ኘ "Ne") - (?\ኙ "Nu") - (?\ኚ "Ni") - (?\ኛ "Na") - (?\ኜ "NE") - (?\ኝ "N") - (?\ኞ "No") - (?\ኟ "NWa") - (?\አ "e") - (?\ኡ "u") - (?\ኢ "i") - (?\ኣ "a") - (?\ኤ "E") - (?\እ "I") - (?\ኦ "o") - (?\ኧ "e3") - (?\ከ "ke") - (?\ኩ "ku") - (?\ኪ "ki") - (?\ካ "ka") - (?\ኬ "kE") - (?\ክ "k") - (?\ኮ "ko") - (?\ኰ "kWe") - (?\ኲ "kWi") - (?\ኳ "kWa") - (?\ኴ "kWE") - (?\ኵ "kW") - (?\ኸ "Ke") - (?\ኹ "Ku") - (?\ኺ "Ki") - (?\ኻ "Ka") - (?\ኼ "KE") - (?\ኽ "K") - (?\ኾ "Ko") - (?\ዀ "KWe") - (?\ዂ "KWi") - (?\ዃ "KWa") - (?\ዄ "KWE") - (?\ዅ "KW") - (?\ወ "we") - (?\ዉ "wu") - (?\ዊ "wi") - (?\ዋ "wa") - (?\ዌ "wE") - (?\ው "w") - (?\ዎ "wo") - (?\ዐ "`e") - (?\ዑ "`u") - (?\ዒ "`i") - (?\ዓ "`a") - (?\ዔ "`E") - (?\ዕ "`I") - (?\ዖ "`o") - (?\ዘ "ze") - (?\ዙ "zu") - (?\ዚ "zi") - (?\ዛ "za") - (?\ዜ "zE") - (?\ዝ "z") - (?\ዞ "zo") - (?\ዟ "zWa") - (?\ዠ "Ze") - (?\ዡ "Zu") - (?\ዢ "Zi") - (?\ዣ "Za") - (?\ዤ "ZE") - (?\ዥ "Z") - (?\ዦ "Zo") - (?\ዧ "ZWa") - (?\የ "ye") - (?\ዩ "yu") - (?\ዪ "yi") - (?\ያ "ya") - (?\ዬ "yE") - (?\ይ "y") - (?\ዮ "yo") - (?\ዯ "yWa") - (?\ደ "de") - (?\ዱ "du") - (?\ዲ "di") - (?\ዳ "da") - (?\ዴ "dE") - (?\ድ "d") - (?\ዶ "do") - (?\ዷ "dWa") - (?\ዸ "De") - (?\ዹ "Du") - (?\ዺ "Di") - (?\ዻ "Da") - (?\ዼ "DE") - (?\ዽ "D") - (?\ዾ "Do") - (?\ዿ "DWa") - (?\ጀ "je") - (?\ጁ "ju") - (?\ጂ "ji") - (?\ጃ "ja") - (?\ጄ "jE") - (?\ጅ "j") - (?\ጆ "jo") - (?\ጇ "jWa") - (?\ገ "ga") - (?\ጉ "gu") - (?\ጊ "gi") - (?\ጋ "ga") - (?\ጌ "gE") - (?\ግ "g") - (?\ጎ "go") - (?\ጐ "gWu") - (?\ጒ "gWi") - (?\ጓ "gWa") - (?\ጔ "gWE") - (?\ጕ "gW") - (?\ጘ "Ge") - (?\ጙ "Gu") - (?\ጚ "Gi") - (?\ጛ "Ga") - (?\ጜ "GE") - (?\ጝ "G") - (?\ጞ "Go") - (?\ጟ "GWa") - (?\ጠ "Te") - (?\ጡ "Tu") - (?\ጢ "Ti") - (?\ጣ "Ta") - (?\ጤ "TE") - (?\ጥ "T") - (?\ጦ "To") - (?\ጧ "TWa") - (?\ጨ "Ce") - (?\ጩ "Ca") - (?\ጪ "Cu") - (?\ጫ "Ca") - (?\ጬ "CE") - (?\ጭ "C") - (?\ጮ "Co") - (?\ጯ "CWa") - (?\ጰ "Pe") - (?\ጱ "Pu") - (?\ጲ "Pi") - (?\ጳ "Pa") - (?\ጴ "PE") - (?\ጵ "P") - (?\ጶ "Po") - (?\ጷ "PWa") - (?\ጸ "SWe") - (?\ጹ "SWu") - (?\ጺ "SWi") - (?\ጻ "SWa") - (?\ጼ "SWE") - (?\ጽ "SW") - (?\ጾ "SWo") - (?\ጿ "SWa") - (?\ፀ "`Sa") - (?\ፁ "`Su") - (?\ፂ "`Si") - (?\ፃ "`Sa") - (?\ፄ "`SE") - (?\ፅ "`S") - (?\ፆ "`So") - (?\ፈ "fa") - (?\ፉ "fu") - (?\ፊ "fi") - (?\ፋ "fa") - (?\ፌ "fE") - (?\ፍ "o") - (?\ፎ "fo") - (?\ፏ "fWa") - (?\ፐ "pe") - (?\ፑ "pu") - (?\ፒ "pi") - (?\ፓ "pa") - (?\ፔ "pE") - (?\ፕ "p") - (?\ፖ "po") - (?\ፗ "pWa") - (?\ፘ "mYa") - (?\ፙ "rYa") - (?\ፚ "fYa") - (?\፠ " ") - (?\፡ ":") - (?\። "::") - (?\፣ ",") - (?\፤ ";") - (?\፥ "-:") - (?\፦ ":-") - (?\፧ "`?") - (?\፨ ":|:") - (?\፩ "`1") - (?\፪ "`2") - (?\፫ "`3") - (?\፬ "`4") - (?\፭ "`5") - (?\፮ "`6") - (?\፯ "`7") - (?\፰ "`8") - (?\፱ "`9") - (?\፲ "`10") - (?\፳ "`20") - (?\፴ "`30") - (?\፵ "`40") - (?\፶ "`50") - (?\፷ "`60") - (?\፸ "`70") - (?\፹ "`80") - (?\፺ "`90") - (?\፻ "`100") - (?\፼ "`10000") - (?\Ḁ "A-0") - (?\ḁ "a-0") - (?\Ḃ "B.") - (?\ḃ "b.") - (?\Ḅ "B-.") - (?\ḅ "b-.") - (?\Ḇ "B_") - (?\ḇ "b_") - (?\Ḉ "C,'") - (?\ḉ "c,'") - (?\Ḋ "D.") - (?\ḋ "d.") - (?\Ḍ "D-.") - (?\ḍ "d-.") - (?\Ḏ "D_") - (?\ḏ "d_") - (?\Ḑ "D,") - (?\ḑ "d,") - (?\Ḓ "D->") - (?\ḓ "d->") - (?\Ḕ "E-!") - (?\ḕ "e-!") - (?\Ḗ "E-'") - (?\ḗ "e-'") - (?\Ḙ "E->") - (?\ḙ "e->") - (?\Ḛ "E-?") - (?\ḛ "e-?") - (?\Ḝ "E,(") - (?\ḝ "e,(") - (?\Ḟ "F.") - (?\ḟ "f.") - (?\Ḡ "G-") - (?\ḡ "g-") - (?\Ḣ "H.") - (?\ḣ "h.") - (?\Ḥ "H-.") - (?\ḥ "h-.") - (?\Ḧ "H:") - (?\ḧ "h:") - (?\Ḩ "H,") - (?\ḩ "h,") - (?\Ḫ "H-(") - (?\ḫ "h-(") - (?\Ḭ "I-?") - (?\ḭ "i-?") - (?\Ḯ "I:'") - (?\ḯ "i:'") - (?\Ḱ "K'") - (?\ḱ "k'") - (?\Ḳ "K-.") - (?\ḳ "k-.") - (?\Ḵ "K_") - (?\ḵ "k_") - (?\Ḷ "L-.") - (?\ḷ "l-.") - (?\Ḹ "L--.") - (?\ḹ "l--.") - (?\Ḻ "L_") - (?\ḻ "l_") - (?\Ḽ "L->") - (?\ḽ "l->") - (?\Ḿ "M'") - (?\ḿ "m'") - (?\Ṁ "M.") - (?\ṁ "m.") - (?\Ṃ "M-.") - (?\ṃ "m-.") - (?\Ṅ "N.") - (?\ṅ "n.") - (?\Ṇ "N-.") - (?\ṇ "n-.") - (?\Ṉ "N_") - (?\ṉ "n_") - (?\Ṋ "N->") - (?\ṋ "n->") - (?\Ṍ "O?'") - (?\ṍ "o?'") - (?\Ṏ "O?:") - (?\ṏ "o?:") - (?\Ṑ "O-!") - (?\ṑ "o-!") - (?\Ṓ "O-'") - (?\ṓ "o-'") - (?\Ṕ "P'") - (?\ṕ "p'") - (?\Ṗ "P.") - (?\ṗ "p.") - (?\Ṙ "R.") - (?\ṙ "r.") - (?\Ṛ "R-.") - (?\ṛ "r-.") - (?\Ṝ "R--.") - (?\ṝ "r--.") - (?\Ṟ "R_") - (?\ṟ "r_") - (?\Ṡ "S.") - (?\ṡ "s.") - (?\Ṣ "S-.") - (?\ṣ "s-.") - (?\Ṥ "S'.") - (?\ṥ "s'.") - (?\Ṧ "S<.") - (?\ṧ "s<.") - (?\Ṩ "S.-.") - (?\ṩ "s.-.") - (?\Ṫ "T.") - (?\ṫ "t.") - (?\Ṭ "T-.") - (?\ṭ "t-.") - (?\Ṯ "T_") - (?\ṯ "t_") - (?\Ṱ "T->") - (?\ṱ "t->") - (?\Ṳ "U--:") - (?\ṳ "u--:") - (?\Ṵ "U-?") - (?\ṵ "u-?") - (?\Ṷ "U->") - (?\ṷ "u->") - (?\Ṹ "U?'") - (?\ṹ "u?'") - (?\Ṻ "U-:") - (?\ṻ "u-:") - (?\Ṽ "V?") - (?\ṽ "v?") - (?\Ṿ "V-.") - (?\ṿ "v-.") - (?\Ẁ "W!") - (?\ẁ "w!") - (?\Ẃ "W'") - (?\ẃ "w'") - (?\Ẅ "W:") - (?\ẅ "w:") - (?\Ẇ "W.") - (?\ẇ "w.") - (?\Ẉ "W-.") - (?\ẉ "w-.") - (?\Ẋ "X.") - (?\ẋ "x.") - (?\Ẍ "X:") - (?\ẍ "x:") - (?\Ẏ "Y.") - (?\ẏ "y.") - (?\Ẑ "Z>") - (?\ẑ "z>") - (?\Ẓ "Z-.") - (?\ẓ "z-.") - (?\Ẕ "Z_") - (?\ẕ "z_") - (?\ẖ "h_") - (?\ẗ "t:") - (?\ẘ "w0") - (?\ẙ "y0") - (?\Ạ "A-.") - (?\ạ "a-.") - (?\Ả "A2") - (?\ả "a2") - (?\Ấ "A>'") - (?\ấ "a>'") - (?\Ầ "A>!") - (?\ầ "a>!") - (?\Ẩ "A>2") - (?\ẩ "a>2") - (?\Ẫ "A>?") - (?\ẫ "a>?") - (?\Ậ "A>-.") - (?\ậ "a>-.") - (?\Ắ "A('") - (?\ắ "a('") - (?\Ằ "A(!") - (?\ằ "a(!") - (?\Ẳ "A(2") - (?\ẳ "a(2") - (?\Ẵ "A(?") - (?\ẵ "a(?") - (?\Ặ "A(-.") - (?\ặ "a(-.") - (?\Ẹ "E-.") - (?\ẹ "e-.") - (?\Ẻ "E2") - (?\ẻ "e2") - (?\Ẽ "E?") - (?\ẽ "e?") - (?\Ế "E>'") - (?\ế "e>'") - (?\Ề "E>!") - (?\ề "e>!") - (?\Ể "E>2") - (?\ể "e>2") - (?\Ễ "E>?") - (?\ễ "e>?") - (?\Ệ "E>-.") - (?\ệ "e>-.") - (?\Ỉ "I2") - (?\ỉ "i2") - (?\Ị "I-.") - (?\ị "i-.") - (?\Ọ "O-.") - (?\ọ "o-.") - (?\Ỏ "O2") - (?\ỏ "o2") - (?\Ố "O>'") - (?\ố "o>'") - (?\Ồ "O>!") - (?\ồ "o>!") - (?\Ổ "O>2") - (?\ổ "o>2") - (?\Ỗ "O>?") - (?\ỗ "o>?") - (?\Ộ "O>-.") - (?\ộ "o>-.") - (?\Ớ "O9'") - (?\ớ "o9'") - (?\Ờ "O9!") - (?\ờ "o9!") - (?\Ở "O92") - (?\ở "o92") - (?\Ỡ "O9?") - (?\ỡ "o9?") - (?\Ợ "O9-.") - (?\ợ "o9-.") - (?\Ụ "U-.") - (?\ụ "u-.") - (?\Ủ "U2") - (?\ủ "u2") - (?\Ứ "U9'") - (?\ứ "u9'") - (?\Ừ "U9!") - (?\ừ "u9!") - (?\Ử "U92") - (?\ử "u92") - (?\Ữ "U9?") - (?\ữ "u9?") - (?\Ự "U9-.") - (?\ự "u9-.") - (?\Ỳ "Y!") - (?\ỳ "y!") - (?\Ỵ "Y-.") - (?\ỵ "y-.") - (?\Ỷ "Y2") - (?\ỷ "y2") - (?\Ỹ "Y?") - (?\ỹ "y?") - (?\ἀ "a") - (?\ἁ "ha") - (?\ἂ "`a") - (?\ἃ "h`a") - (?\ἄ "a'") - (?\ἅ "ha'") - (?\ἆ "a~") - (?\ἇ "ha~") - (?\Ἀ "A") - (?\Ἁ "hA") - (?\Ἂ "`A") - (?\Ἃ "h`A") - (?\Ἄ "A'") - (?\Ἅ "hA'") - (?\Ἆ "A~") - (?\Ἇ "hA~") - (?\ἑ "he") - (?\Ἑ "hE") - (?\ἱ "hi") - (?\Ἱ "hI") - (?\ὁ "ho") - (?\Ὁ "hO") - (?\ὑ "hu") - (?\Ὑ "hU") - (?\᾿ ",,") - (?\῀ "?*") - (?\῁ "?:") - (?\῍ ",!") - (?\῎ ",'") - (?\῏ "?,") - (?\῝ ";!") - (?\῞ ";'") - (?\῟ "?;") - (?\ῥ "rh") - (?\Ῥ "Rh") - (?\῭ "!:") - (?\` "!*") - (?\῾ ";;") - (?\ " ") - (?\ " ") - (?\ " ") - (?\ " ") - (?\ " ") - (?\ " ") - (?\ " ") - (?\ " ") - (?\ " ") - (?\ " ") - (?\‐ "-") - (?\‑ "-") - (?\– "-") - (?\— "--") - (?\― "-") - (?\‖ "||") - (?\‗ "=2") - (?\‘ "`") - (?\’ "'") - (?\‚ "'") - (?\‛ "'") - (?\“ "\"") - (?\” "\"") - (?\„ "\"") - (?\‟ "\"") - (?\† "/-") - (?\‡ "/=") - (?\• " o ") - (?\․ ".") - (?\‥ "..") - (?\… "...") - (?\‧ "·") - (?\‰ " 0/00") - (?\′ "'") - (?\″ "''") - (?\‴ "'''") - (?\‵ "`") - (?\‶ "``") - (?\‷ "```") - (?\‸ "Ca") - (?\‹ "<") - (?\› ">") - (?\※ ":X") - (?\‼ "!!") - (?\‾ "'-") - (?\⁃ "-") - (?\⁄ "/") - (?\⁈ "?!") - (?\⁉ "!?") - (?\⁰ "^0") - (?\⁴ "^4") - (?\⁵ "^5") - (?\⁶ "^6") - (?\⁷ "^7") - (?\⁸ "^8") - (?\⁹ "^9") - (?\⁺ "^+") - (?\⁻ "^-") - (?\⁼ "^=") - (?\⁽ "^(") - (?\⁾ "^)") - (?\ⁿ "^n") - (?\₀ "_0") - (?\₁ "_1") - (?\₂ "_2") - (?\₃ "_3") - (?\₄ "_4") - (?\₅ "_5") - (?\₆ "_6") - (?\₇ "_7") - (?\₈ "_8") - (?\₉ "_9") - (?\₊ "_+") - (?\₋ "_-") - (?\₌ "_=") - (?\₍ "(") - (?\₎ ")") - (?\₣ "Ff") - (?\₤ "Li") - (?\₧ "Pt") - (?\₩ "W=") - (?\€ "EUR") - (?\℀ "a/c") - (?\℁ "a/s") - (?\℃ "oC") - (?\℅ "c/o") - (?\℆ "c/u") - (?\℉ "oF") - (?\ℊ "g") - (?\ℎ "h") - (?\ℏ "\\hbar") - (?\ℑ "Im") - (?\ℓ "l") - (?\№ "No.") - (?\℗ "PO") - (?\℘ "P") - (?\ℜ "Re") - (?\℞ "Rx") - (?\℠ "(SM)") - (?\℡ "TEL") - (?\™ "(TM)") - (?\Ω "Ohm") - (?\K "K") - (?\Å "Ang.") - (?\℮ "est.") - (?\ℴ "o") - (?\ℵ "Aleph ") - (?\ℶ "Bet ") - (?\ℷ "Gimel ") - (?\ℸ "Dalet ") - (?\⅓ " 1/3") - (?\⅔ " 2/3") - (?\⅕ " 1/5") - (?\⅖ " 2/5") - (?\⅗ " 3/5") - (?\⅘ " 4/5") - (?\⅙ " 1/6") - (?\⅚ " 5/6") - (?\⅛ " 1/8") - (?\⅜ " 3/8") - (?\⅝ " 5/8") - (?\⅞ " 7/8") - (?\⅟ " 1/") - (?\Ⅰ "I") - (?\Ⅱ "II") - (?\Ⅲ "III") - (?\Ⅳ "IV") - (?\Ⅴ "V") - (?\Ⅵ "VI") - (?\Ⅶ "VII") - (?\Ⅷ "VIII") - (?\Ⅸ "IX") - (?\Ⅹ "X") - (?\Ⅺ "XI") - (?\Ⅻ "XII") - (?\Ⅼ "L") - (?\Ⅽ "C") - (?\Ⅾ "D") - (?\Ⅿ "M") - (?\ⅰ "i") - (?\ⅱ "ii") - (?\ⅲ "iii") - (?\ⅳ "iv") - (?\ⅴ "v") - (?\ⅵ "vi") - (?\ⅶ "vii") - (?\ⅷ "viii") - (?\ⅸ "ix") - (?\ⅹ "x") - (?\ⅺ "xi") - (?\ⅻ "xii") - (?\ⅼ "l") - (?\ⅽ "c") - (?\ⅾ "d") - (?\ⅿ "m") - (?\ↀ "1000RCD") - (?\ↁ "5000R") - (?\ↂ "10000R") - (?\← "<-") - (?\↑ "-^") - (?\→ "->") - (?\↓ "-v") - (?\↔ "<->") - (?\↕ "UD") - (?\↖ "<!!") - (?\↗ "//>") - (?\↘ "!!>") - (?\↙ "<//") - (?\↨ "UD-") - (?\↵ "RET") - (?\⇀ ">V") - (?\⇐ "<=") - (?\⇑ "^^") - (?\⇒ "=>") - (?\⇓ "vv") - (?\⇔ "<=>") - (?\∀ "FA") - (?\∂ "\\partial") - (?\∃ "TE") - (?\∅ "{}") - (?\∆ "Delta") - (?\∇ "Nabla") - (?\∈ "(-") - (?\∉ "!(-") - (?\∊ "(-") - (?\∋ "-)") - (?\∌ "!-)") - (?\∍ "-)") - (?\∎ " qed") - (?\∏ "\\prod") - (?\∑ "\\sum") - (?\− " -") - (?\∓ "-/+") - (?\∔ ".+") - (?\∕ "/") - (?\∖ " - ") - (?\∗ "*") - (?\∘ " ° ") - (?\∙ "sb") - (?\√ " SQRT ") - (?\∛ " ROOT³ ") - (?\∜ " ROOT4 ") - (?\∝ "0(") - (?\∞ "infty") - (?\∟ "-L") - (?\∠ "-V") - (?\∥ "PP") - (?\∦ " !PP ") - (?\∧ "AND") - (?\∨ "OR") - (?\∩ "(U") - (?\∪ ")U") - (?\∫ "\\int ") - (?\∬ "DI") - (?\∮ "Io") - (?\∴ ".:") - (?\∵ ":.") - (?\∶ ":R") - (?\∷ "::") - (?\∼ "?1") - (?\∾ "CG") - (?\≃ "?-") - (?\≅ "?=") - (?\≈ "~=") - (?\≉ " !~= ") - (?\≌ "=?") - (?\≓ "HI") - (?\≔ ":=") - (?\≕ "=:") - (?\≠ "!=") - (?\≡ "=3") - (?\≢ " !=3 ") - (?\≤ "=<") - (?\≥ ">=") - (?\≦ ".LE.") - (?\≧ ".GE.") - (?\≨ ".LT.NOT.EQ.") - (?\≩ ".GT.NOT.EQ.") - (?\≪ "<<") - (?\≫ ">>") - (?\≮ "!<") - (?\≯ "!>") - (?\≶ " <> ") - (?\≷ " >< ") - (?\⊂ "(C") - (?\⊃ ")C") - (?\⊄ " !(C ") - (?\⊅ " !)C ") - (?\⊆ "(_") - (?\⊇ ")_") - (?\⊕ "(+)") - (?\⊖ "(-)") - (?\⊗ "(×)") - (?\⊘ "(/)") - (?\⊙ "(·)") - (?\⊚ "(°)") - (?\⊛ "(*)") - (?\⊜ "(=)") - (?\⊝ "(-)") - (?\⊞ "[+]") - (?\⊟ "[-]") - (?\⊠ "[×]") - (?\⊡ "[·]") - (?\⊥ "-T") - (?\⊧ " MODELS ") - (?\⊨ " TRUE ") - (?\⊩ " FORCES ") - (?\⊬ " !PROVES ") - (?\⊭ " NOT TRUE ") - (?\⊮ " !FORCES ") - (?\⊲ " NORMAL SUBGROUP OF ") - (?\⊳ " CONTAINS AS NORMAL SUBGROUP ") - (?\⊴ " NORMAL SUBGROUP OF OR EQUAL TO ") - (?\⊵ " CONTAINS AS NORMAL SUBGROUP OR EQUAL TO ") - (?\⊸ " MULTIMAP ") - (?\⊺ " INTERCALATE ") - (?\⊻ " XOR ") - (?\⊼ " NAND ") - (?\⋅ " · ") - (?\⋖ "<.") - (?\⋗ ">.") - (?\⋘ "<<<") - (?\⋙ ">>>") - (?\⋮ ":3") - (?\⋯ ".3") - (?\⌂ "Eh") - (?\⌇ "~~") - (?\⌈ "<7") - (?\⌉ ">7") - (?\⌊ "7<") - (?\⌋ "7>") - (?\⌐ "NI") - (?\⌒ "(A") - (?\⌕ "TR") - (?\⌘ "88") - (?\⌠ "Iu") - (?\⌡ "Il") - (?\⌢ ":(") - (?\⌣ ":)") - (?\⌤ "|^|") - (?\⌧ "[X]") - (?\〈 "</") - (?\〉 "/>") - (?\␣ "Vs") - (?\⑀ "1h") - (?\⑁ "3h") - (?\⑂ "2h") - (?\⑃ "4h") - (?\⑆ "1j") - (?\⑇ "2j") - (?\⑈ "3j") - (?\⑉ "4j") - (?\① "1-o") - (?\② "2-o") - (?\③ "3-o") - (?\④ "4-o") - (?\⑤ "5-o") - (?\⑥ "6-o") - (?\⑦ "7-o") - (?\⑧ "8-o") - (?\⑨ "9-o") - (?\⑩ "10-o") - (?\⑪ "11-o") - (?\⑫ "12-o") - (?\⑬ "13-o") - (?\⑭ "14-o") - (?\⑮ "15-o") - (?\⑯ "16-o") - (?\⑰ "17-o") - (?\⑱ "18-o") - (?\⑲ "19-o") - (?\⑳ "20-o") - (?\⑴ "(1)") - (?\⑵ "(2)") - (?\⑶ "(3)") - (?\⑷ "(4)") - (?\⑸ "(5)") - (?\⑹ "(6)") - (?\⑺ "(7)") - (?\⑻ "(8)") - (?\⑼ "(9)") - (?\⑽ "(10)") - (?\⑾ "(11)") - (?\⑿ "(12)") - (?\⒀ "(13)") - (?\⒁ "(14)") - (?\⒂ "(15)") - (?\⒃ "(16)") - (?\⒄ "(17)") - (?\⒅ "(18)") - (?\⒆ "(19)") - (?\⒇ "(20)") - (?\⒈ "1.") - (?\⒉ "2.") - (?\⒊ "3.") - (?\⒋ "4.") - (?\⒌ "5.") - (?\⒍ "6.") - (?\⒎ "7.") - (?\⒏ "8.") - (?\⒐ "9.") - (?\⒑ "10.") - (?\⒒ "11.") - (?\⒓ "12.") - (?\⒔ "13.") - (?\⒕ "14.") - (?\⒖ "15.") - (?\⒗ "16.") - (?\⒘ "17.") - (?\⒙ "18.") - (?\⒚ "19.") - (?\⒛ "20.") - (?\⒜ "(a)") - (?\⒝ "(b)") - (?\⒞ "(c)") - (?\⒟ "(d)") - (?\⒠ "(e)") - (?\⒡ "(f)") - (?\⒢ "(g)") - (?\⒣ "(h)") - (?\⒤ "(i)") - (?\⒥ "(j)") - (?\⒦ "(k)") - (?\⒧ "(l)") - (?\⒨ "(m)") - (?\⒩ "(n)") - (?\⒪ "(o)") - (?\⒫ "(p)") - (?\⒬ "(q)") - (?\⒭ "(r)") - (?\⒮ "(s)") - (?\⒯ "(t)") - (?\⒰ "(u)") - (?\⒱ "(v)") - (?\⒲ "(w)") - (?\⒳ "(x)") - (?\⒴ "(y)") - (?\⒵ "(z)") - (?\Ⓐ "A-o") - (?\Ⓑ "B-o") - (?\Ⓒ "C-o") - (?\Ⓓ "D-o") - (?\Ⓔ "E-o") - (?\Ⓕ "F-o") - (?\Ⓖ "G-o") - (?\Ⓗ "H-o") - (?\Ⓘ "I-o") - (?\Ⓙ "J-o") - (?\Ⓚ "K-o") - (?\Ⓛ "L-o") - (?\Ⓜ "M-o") - (?\Ⓝ "N-o") - (?\Ⓞ "O-o") - (?\Ⓟ "P-o") - (?\Ⓠ "Q-o") - (?\Ⓡ "R-o") - (?\Ⓢ "S-o") - (?\Ⓣ "T-o") - (?\Ⓤ "U-o") - (?\Ⓥ "V-o") - (?\Ⓦ "W-o") - (?\Ⓧ "X-o") - (?\Ⓨ "Y-o") - (?\Ⓩ "Z-o") - (?\ⓐ "a-o") - (?\ⓑ "b-o") - (?\ⓒ "c-o") - (?\ⓓ "d-o") - (?\ⓔ "e-o") - (?\ⓕ "f-o") - (?\ⓖ "g-o") - (?\ⓗ "h-o") - (?\ⓘ "i-o") - (?\ⓙ "j-o") - (?\ⓚ "k-o") - (?\ⓛ "l-o") - (?\ⓜ "m-o") - (?\ⓝ "n-o") - (?\ⓞ "o-o") - (?\ⓟ "p-o") - (?\ⓠ "q-o") - (?\ⓡ "r-o") - (?\ⓢ "s-o") - (?\ⓣ "t-o") - (?\ⓤ "u-o") - (?\ⓥ "v-o") - (?\ⓦ "w-o") - (?\ⓧ "x-o") - (?\ⓨ "y-o") - (?\ⓩ "z-o") - (?\⓪ "0-o") - (?\─ "-") - (?\━ "=") - (?\│ "|") - (?\┃ "|") - (?\┄ "-") - (?\┅ "=") - (?\┆ "|") - (?\┇ "|") - (?\┈ "-") - (?\┉ "=") - (?\┊ "|") - (?\┋ "|") - (?\┌ "+") - (?\┍ "+") - (?\┎ "+") - (?\┏ "+") - (?\┐ "+") - (?\┑ "+") - (?\┒ "+") - (?\┓ "+") - (?\└ "+") - (?\┕ "+") - (?\┖ "+") - (?\┗ "+") - (?\┘ "+") - (?\┙ "+") - (?\┚ "+") - (?\┛ "+") - (?\├ "+") - (?\┝ "+") - (?\┞ "+") - (?\┟ "+") - (?\┠ "+") - (?\┡ "+") - (?\┢ "+") - (?\┣ "+") - (?\┤ "+") - (?\┥ "+") - (?\┦ "+") - (?\┧ "+") - (?\┨ "+") - (?\┩ "+") - (?\┪ "+") - (?\┫ "+") - (?\┬ "+") - (?\┭ "+") - (?\┮ "+") - (?\┯ "+") - (?\┰ "+") - (?\┱ "+") - (?\┲ "+") - (?\┳ "+") - (?\┴ "+") - (?\┵ "+") - (?\┶ "+") - (?\┷ "+") - (?\┸ "+") - (?\┹ "+") - (?\┺ "+") - (?\┻ "+") - (?\┼ "+") - (?\┽ "+") - (?\┾ "+") - (?\┿ "+") - (?\╀ "+") - (?\╁ "+") - (?\╂ "+") - (?\╃ "+") - (?\╄ "+") - (?\╅ "+") - (?\╆ "+") - (?\╇ "+") - (?\╈ "+") - (?\╉ "+") - (?\╊ "+") - (?\╋ "+") - (?\╌ "+") - (?\╍ "+") - (?\╎ "+") - (?\╏ "+") - (?\═ "+") - (?\║ "+") - (?\╒ "+") - (?\╓ "+") - (?\╔ "+") - (?\╕ "+") - (?\╖ "+") - (?\╗ "+") - (?\╘ "+") - (?\╙ "+") - (?\╚ "+") - (?\╛ "+") - (?\╜ "+") - (?\╝ "+") - (?\╞ "+") - (?\╟ "+") - (?\╠ "+") - (?\╡ "+") - (?\╢ "+") - (?\╣ "+") - (?\╤ "+") - (?\╥ "+") - (?\╦ "+") - (?\╧ "+") - (?\╨ "+") - (?\╩ "+") - (?\╪ "+") - (?\╫ "+") - (?\╬ "+") - (?\╱ "/") - (?\╲ "\\") - (?\▀ "TB") - (?\▄ "LB") - (?\█ "FB") - (?\▌ "lB") - (?\▐ "RB") - (?\░ ".S") - (?\▒ ":S") - (?\▓ "?S") - (?\■ "fS") - (?\□ "OS") - (?\▢ "RO") - (?\▣ "Rr") - (?\▤ "RF") - (?\▥ "RY") - (?\▦ "RH") - (?\▧ "RZ") - (?\▨ "RK") - (?\▩ "RX") - (?\▪ "sB") - (?\▬ "SR") - (?\▭ "Or") - (?\▲ "^") - (?\△ "uT") - (?\▶ "|>") - (?\▷ "Tr") - (?\► "|>") - (?\▼ "v") - (?\▽ "dT") - (?\◀ "<|") - (?\◁ "Tl") - (?\◄ "<|") - (?\◆ "Db") - (?\◇ "Dw") - (?\◊ "LZ") - (?\○ "0m") - (?\◎ "0o") - (?\● "0M") - (?\◐ "0L") - (?\◑ "0R") - (?\◘ "Sn") - (?\◙ "Ic") - (?\◢ "Fd") - (?\◣ "Bd") - (?\◯ "Ci") - (?\★ "*2") - (?\☆ "*1") - (?\☎ "TEL") - (?\☏ "tel") - (?\☜ "<--") - (?\☞ "-->") - (?\☡ "CAUTION ") - (?\☧ "XP") - (?\☹ ":-(") - (?\☺ ":-)") - (?\☻ "(-:") - (?\☼ "SU") - (?\♀ "f.") - (?\♂ "m.") - (?\♠ "cS") - (?\♡ "cH") - (?\♢ "cD") - (?\♣ "cC") - (?\♤ "cS-") - (?\♥ "cH-") - (?\♦ "cD-") - (?\♧ "cC-") - (?\♩ "Md") - (?\♪ "M8") - (?\♫ "M2") - (?\♬ "M16") - (?\♭ "b") - (?\♮ "Mx") - (?\♯ "#") - (?\✓ "X") - (?\✗ "X") - (?\✠ "-X") - (?\ " ") - (?\、 ",_") - (?\。 "._") - (?\〃 "+\"") - (?\〄 "JIS") - (?\々 "*_") - (?\〆 ";_") - (?\〇 "0_") - (?\《 "<+") - (?\》 ">+") - (?\「 "<'") - (?\」 ">'") - (?\『 "<\"") - (?\』 ">\"") - (?\【 "(\"") - (?\】 ")\"") - (?\〒 "=T") - (?\〓 "=_") - (?\〔 "('") - (?\〕 ")'") - (?\〖 "(I") - (?\〗 ")I") - (?\〚 "[[") - (?\〛 "]]") - (?\〜 "-?") - (?\〠 "=T:)") - (?\〿 " ") - (?\ぁ "A5") - (?\あ "a5") - (?\ぃ "I5") - (?\い "i5") - (?\ぅ "U5") - (?\う "u5") - (?\ぇ "E5") - (?\え "e5") - (?\ぉ "O5") - (?\お "o5") - (?\か "ka") - (?\が "ga") - (?\き "ki") - (?\ぎ "gi") - (?\く "ku") - (?\ぐ "gu") - (?\け "ke") - (?\げ "ge") - (?\こ "ko") - (?\ご "go") - (?\さ "sa") - (?\ざ "za") - (?\し "si") - (?\じ "zi") - (?\す "su") - (?\ず "zu") - (?\せ "se") - (?\ぜ "ze") - (?\そ "so") - (?\ぞ "zo") - (?\た "ta") - (?\だ "da") - (?\ち "ti") - (?\ぢ "di") - (?\っ "tU") - (?\つ "tu") - (?\づ "du") - (?\て "te") - (?\で "de") - (?\と "to") - (?\ど "do") - (?\な "na") - (?\に "ni") - (?\ぬ "nu") - (?\ね "ne") - (?\の "no") - (?\は "ha") - (?\ば "ba") - (?\ぱ "pa") - (?\ひ "hi") - (?\び "bi") - (?\ぴ "pi") - (?\ふ "hu") - (?\ぶ "bu") - (?\ぷ "pu") - (?\へ "he") - (?\べ "be") - (?\ぺ "pe") - (?\ほ "ho") - (?\ぼ "bo") - (?\ぽ "po") - (?\ま "ma") - (?\み "mi") - (?\む "mu") - (?\め "me") - (?\も "mo") - (?\ゃ "yA") - (?\や "ya") - (?\ゅ "yU") - (?\ゆ "yu") - (?\ょ "yO") - (?\よ "yo") - (?\ら "ra") - (?\り "ri") - (?\る "ru") - (?\れ "re") - (?\ろ "ro") - (?\ゎ "wA") - (?\わ "wa") - (?\ゐ "wi") - (?\ゑ "we") - (?\を "wo") - (?\ん "n5") - (?\ゔ "vu") - (?\゛ "\"5") - (?\゜ "05") - (?\ゝ "*5") - (?\ゞ "+5") - (?\ァ "a6") - (?\ア "A6") - (?\ィ "i6") - (?\イ "I6") - (?\ゥ "u6") - (?\ウ "U6") - (?\ェ "e6") - (?\エ "E6") - (?\ォ "o6") - (?\オ "O6") - (?\カ "Ka") - (?\ガ "Ga") - (?\キ "Ki") - (?\ギ "Gi") - (?\ク "Ku") - (?\グ "Gu") - (?\ケ "Ke") - (?\ゲ "Ge") - (?\コ "Ko") - (?\ゴ "Go") - (?\サ "Sa") - (?\ザ "Za") - (?\シ "Si") - (?\ジ "Zi") - (?\ス "Su") - (?\ズ "Zu") - (?\セ "Se") - (?\ゼ "Ze") - (?\ソ "So") - (?\ゾ "Zo") - (?\タ "Ta") - (?\ダ "Da") - (?\チ "Ti") - (?\ヂ "Di") - (?\ッ "TU") - (?\ツ "Tu") - (?\ヅ "Du") - (?\テ "Te") - (?\デ "De") - (?\ト "To") - (?\ド "Do") - (?\ナ "Na") - (?\ニ "Ni") - (?\ヌ "Nu") - (?\ネ "Ne") - (?\ノ "No") - (?\ハ "Ha") - (?\バ "Ba") - (?\パ "Pa") - (?\ヒ "Hi") - (?\ビ "Bi") - (?\ピ "Pi") - (?\フ "Hu") - (?\ブ "Bu") - (?\プ "Pu") - (?\ヘ "He") - (?\ベ "Be") - (?\ペ "Pe") - (?\ホ "Ho") - (?\ボ "Bo") - (?\ポ "Po") - (?\マ "Ma") - (?\ミ "Mi") - (?\ム "Mu") - (?\メ "Me") - (?\モ "Mo") - (?\ャ "YA") - (?\ヤ "Ya") - (?\ュ "YU") - (?\ユ "Yu") - (?\ョ "YO") - (?\ヨ "Yo") - (?\ラ "Ra") - (?\リ "Ri") - (?\ル "Ru") - (?\レ "Re") - (?\ロ "Ro") - (?\ヮ "WA") - (?\ワ "Wa") - (?\ヰ "Wi") - (?\ヱ "We") - (?\ヲ "Wo") - (?\ン "N6") - (?\ヴ "Vu") - (?\ヵ "KA") - (?\ヶ "KE") - (?\ヷ "Va") - (?\ヸ "Vi") - (?\ヹ "Ve") - (?\ヺ "Vo") - (?\・ ".6") - (?\ー "-6") - (?\ヽ "*6") - (?\ヾ "+6") - (?\ㄅ "b4") - (?\ㄆ "p4") - (?\ㄇ "m4") - (?\ㄈ "f4") - (?\ㄉ "d4") - (?\ㄊ "t4") - (?\ㄋ "n4") - (?\ㄌ "l4") - (?\ㄍ "g4") - (?\ㄎ "k4") - (?\ㄏ "h4") - (?\ㄐ "j4") - (?\ㄑ "q4") - (?\ㄒ "x4") - (?\ㄓ "zh") - (?\ㄔ "ch") - (?\ㄕ "sh") - (?\ㄖ "r4") - (?\ㄗ "z4") - (?\ㄘ "c4") - (?\ㄙ "s4") - (?\ㄚ "a4") - (?\ㄛ "o4") - (?\ㄜ "e4") - (?\ㄝ "eh4") - (?\ㄞ "ai") - (?\ㄟ "ei") - (?\ㄠ "au") - (?\ㄡ "ou") - (?\ㄢ "an") - (?\ㄣ "en") - (?\ㄤ "aN") - (?\ㄥ "eN") - (?\ㄦ "er") - (?\ㄧ "i4") - (?\ㄨ "u4") - (?\ㄩ "iu") - (?\ㄪ "v4") - (?\ㄫ "nG") - (?\ㄬ "gn") - (?\㈜ "(JU)") - (?\㈠ "1c") - (?\㈡ "2c") - (?\㈢ "3c") - (?\㈣ "4c") - (?\㈤ "5c") - (?\㈥ "6c") - (?\㈦ "7c") - (?\㈧ "8c") - (?\㈨ "9c") - (?\㈩ "10c") - (?\㉿ "KSC") - (?\㏂ "am") - (?\㏘ "pm") - (?\ff "ff") - (?\fi "fi") - (?\fl "fl") - (?\ffi "ffi") - (?\ffl "ffl") - (?\ſt "St") - (?\st "st") - (?\ﹽ "3+;") - (?\ﺂ "aM.") - (?\ﺄ "aH.") - (?\ﺈ "ah.") - (?\ﺍ "a+-") - (?\ﺎ "a+.") - (?\ﺏ "b+-") - (?\ﺐ "b+.") - (?\ﺑ "b+,") - (?\ﺒ "b+;") - (?\ﺓ "tm-") - (?\ﺔ "tm.") - (?\ﺕ "t+-") - (?\ﺖ "t+.") - (?\ﺗ "t+,") - (?\ﺘ "t+;") - (?\ﺙ "tk-") - (?\ﺚ "tk.") - (?\ﺛ "tk,") - (?\ﺜ "tk;") - (?\ﺝ "g+-") - (?\ﺞ "g+.") - (?\ﺟ "g+,") - (?\ﺠ "g+;") - (?\ﺡ "hk-") - (?\ﺢ "hk.") - (?\ﺣ "hk,") - (?\ﺤ "hk;") - (?\ﺥ "x+-") - (?\ﺦ "x+.") - (?\ﺧ "x+,") - (?\ﺨ "x+;") - (?\ﺩ "d+-") - (?\ﺪ "d+.") - (?\ﺫ "dk-") - (?\ﺬ "dk.") - (?\ﺭ "r+-") - (?\ﺮ "r+.") - (?\ﺯ "z+-") - (?\ﺰ "z+.") - (?\ﺱ "s+-") - (?\ﺲ "s+.") - (?\ﺳ "s+,") - (?\ﺴ "s+;") - (?\ﺵ "sn-") - (?\ﺶ "sn.") - (?\ﺷ "sn,") - (?\ﺸ "sn;") - (?\ﺹ "c+-") - (?\ﺺ "c+.") - (?\ﺻ "c+,") - (?\ﺼ "c+;") - (?\ﺽ "dd-") - (?\ﺾ "dd.") - (?\ﺿ "dd,") - (?\ﻀ "dd;") - (?\ﻁ "tj-") - (?\ﻂ "tj.") - (?\ﻃ "tj,") - (?\ﻄ "tj;") - (?\ﻅ "zH-") - (?\ﻆ "zH.") - (?\ﻇ "zH,") - (?\ﻈ "zH;") - (?\ﻉ "e+-") - (?\ﻊ "e+.") - (?\ﻋ "e+,") - (?\ﻌ "e+;") - (?\ﻍ "i+-") - (?\ﻎ "i+.") - (?\ﻏ "i+,") - (?\ﻐ "i+;") - (?\ﻑ "f+-") - (?\ﻒ "f+.") - (?\ﻓ "f+,") - (?\ﻔ "f+;") - (?\ﻕ "q+-") - (?\ﻖ "q+.") - (?\ﻗ "q+,") - (?\ﻘ "q+;") - (?\ﻙ "k+-") - (?\ﻚ "k+.") - (?\ﻛ "k+,") - (?\ﻜ "k+;") - (?\ﻝ "l+-") - (?\ﻞ "l+.") - (?\ﻟ "l+,") - (?\ﻠ "l+;") - (?\ﻡ "m+-") - (?\ﻢ "m+.") - (?\ﻣ "m+,") - (?\ﻤ "m+;") - (?\ﻥ "n+-") - (?\ﻦ "n+.") - (?\ﻧ "n+,") - (?\ﻨ "n+;") - (?\ﻩ "h+-") - (?\ﻪ "h+.") - (?\ﻫ "h+,") - (?\ﻬ "h+;") - (?\ﻭ "w+-") - (?\ﻮ "w+.") - (?\ﻯ "j+-") - (?\ﻰ "j+.") - (?\ﻱ "y+-") - (?\ﻲ "y+.") - (?\ﻳ "y+,") - (?\ﻴ "y+;") - (?\ﻵ "lM-") - (?\ﻶ "lM.") - (?\ﻷ "lH-") - (?\ﻸ "lH.") - (?\ﻹ "lh-") - (?\ﻺ "lh.") - (?\ﻻ "la-") - (?\ﻼ "la.") - (?\！ "!") - (?\＂ "\"") - (?\＃ "#") - (?\＄ "$") - (?\％ "%") - (?\＆ "&") - (?\＇ "'") - (?\（ "(") - (?\） ")") - (?\＊ "*") - (?\＋ "+") - (?\， ",") - (?\－ "-") - (?\． ".") - (?\／ "/") - (?\０ "0") - (?\１ "1") - (?\２ "2") - (?\３ "3") - (?\４ "4") - (?\５ "5") - (?\６ "6") - (?\７ "7") - (?\８ "8") - (?\９ "9") - (?\： ":") - (?\； ";") - (?\＜ "<") - (?\＝ "=") - (?\＞ ">") - (?\？ "?") - (?\＠ "@") - (?\Ａ "A") - (?\Ｂ "B") - (?\Ｃ "C") - (?\Ｄ "D") - (?\Ｅ "E") - (?\Ｆ "F") - (?\Ｇ "G") - (?\Ｈ "H") - (?\Ｉ "I") - (?\Ｊ "J") - (?\Ｋ "K") - (?\Ｌ "L") - (?\Ｍ "M") - (?\Ｎ "N") - (?\Ｏ "O") - (?\Ｐ "P") - (?\Ｑ "Q") - (?\Ｒ "R") - (?\Ｓ "S") - (?\Ｔ "T") - (?\Ｕ "U") - (?\Ｖ "V") - (?\Ｗ "W") - (?\Ｘ "X") - (?\Ｙ "Y") - (?\Ｚ "Z") - (?\［ "[") - (?\＼ "\\") - (?\］ "]") - (?\＾ "^") - (?\＿ "_") - (?\｀ "`") - (?\ａ "a") - (?\ｂ "b") - (?\ｃ "c") - (?\ｄ "d") - (?\ｅ "e") - (?\ｆ "f") - (?\ｇ "g") - (?\ｈ "h") - (?\ｉ "i") - (?\ｊ "j") - (?\ｋ "k") - (?\ｌ "l") - (?\ｍ "m") - (?\ｎ "n") - (?\ｏ "o") - (?\ｐ "p") - (?\ｑ "q") - (?\ｒ "r") - (?\ｓ "s") - (?\ｔ "t") - (?\ｕ "u") - (?\ｖ "v") - (?\ｗ "w") - (?\ｘ "x") - (?\ｙ "y") - (?\ｚ "z") - (?\｛ "{") - (?\｜ "|") - (?\｝ "}") - (?\～ "~") - (?\｡ ".") - (?\｢ "\"") - (?\｣ "\"") - (?\､ ",") - ;; Not from Lynx - (? "") - (?� "?"))))) + (let ((latin1-display-format "%s")) + (mapc + (lambda (l) + (or (char-displayable-p (car l)) + (apply 'latin1-display-char l))) + ;; Table derived by running Lynx on a suitable list of + ;; characters in a utf-8 file, except for some added by + ;; hand at the end. + '((?\Ā "A") + (?\ā "a") + (?\Ă "A") + (?\ă "a") + (?\Ą "A") + (?\ą "a") + (?\Ć "C") + (?\ć "c") + (?\Ĉ "C") + (?\ĉ "c") + (?\Ċ "C") + (?\ċ "c") + (?\Č "C") + (?\č "c") + (?\Ď "D") + (?\ď "d") + (?\Đ "Ð") + (?\đ "d/") + (?\Ē "E") + (?\ē "e") + (?\Ĕ "E") + (?\ĕ "e") + (?\Ė "E") + (?\ė "e") + (?\Ę "E") + (?\ę "e") + (?\Ě "E") + (?\ě "e") + (?\Ĝ "G") + (?\ĝ "g") + (?\Ğ "G") + (?\ğ "g") + (?\Ġ "G") + (?\ġ "g") + (?\Ģ "G") + (?\ģ "g") + (?\Ĥ "H") + (?\ĥ "h") + (?\Ħ "H/") + (?\ħ "H") + (?\Ĩ "I") + (?\ĩ "i") + (?\Ī "I") + (?\ī "i") + (?\Ĭ "I") + (?\ĭ "i") + (?\Į "I") + (?\į "i") + (?\İ "I") + (?\ı "i") + (?\IJ "IJ") + (?\ij "ij") + (?\Ĵ "J") + (?\ĵ "j") + (?\Ķ "K") + (?\ķ "k") + (?\ĸ "kk") + (?\Ĺ "L") + (?\ĺ "l") + (?\Ļ "L") + (?\ļ "l") + (?\Ľ "L") + (?\ľ "l") + (?\Ŀ "L.") + (?\ŀ "l.") + (?\Ł "L/") + (?\ł "l/") + (?\Ń "N") + (?\ń "n") + (?\Ņ "N") + (?\ņ "n") + (?\Ň "N") + (?\ň "n") + (?\ʼn "'n") + (?\Ŋ "NG") + (?\ŋ "N") + (?\Ō "O") + (?\ō "o") + (?\Ŏ "O") + (?\ŏ "o") + (?\Ő "O\"") + (?\ő "o\"") + (?\Œ "OE") + (?\œ "oe") + (?\Ŕ "R") + (?\ŕ "r") + (?\Ŗ "R") + (?\ŗ "r") + (?\Ř "R") + (?\ř "r") + (?\Ś "S") + (?\ś "s") + (?\Ŝ "S") + (?\ŝ "s") + (?\Ş "S") + (?\ş "s") + (?\Š "S") + (?\š "s") + (?\Ţ "T") + (?\ţ "t") + (?\Ť "T") + (?\ť "t") + (?\Ŧ "T/") + (?\ŧ "t/") + (?\Ũ "U") + (?\ũ "u") + (?\Ū "U") + (?\ū "u") + (?\Ŭ "U") + (?\ŭ "u") + (?\Ů "U") + (?\ů "u") + (?\Ű "U\"") + (?\ű "u\"") + (?\Ų "U") + (?\ų "u") + (?\Ŵ "W") + (?\ŵ "w") + (?\Ŷ "Y") + (?\ŷ "y") + (?\Ÿ "Y") + (?\Ź "Z") + (?\ź "z") + (?\Ż "Z") + (?\ż "z") + (?\Ž "Z") + (?\ž "z") + (?\ſ "s1") + (?\Ƈ "C2") + (?\ƈ "c2") + (?\Ƒ "F2") + (?\ƒ " f") + (?\Ƙ "K2") + (?\ƙ "k2") + (?\Ơ "O9") + (?\ơ "o9") + (?\Ƣ "OI") + (?\ƣ "oi") + (?\Ʀ "yr") + (?\Ư "U9") + (?\ư "u9") + (?\Ƶ "Z/") + (?\ƶ "z/") + (?\Ʒ "ED") + (?\Ǎ "A") + (?\ǎ "a") + (?\Ǐ "I") + (?\ǐ "i") + (?\Ǒ "O") + (?\ǒ "o") + (?\Ǔ "U") + (?\ǔ "u") + (?\Ǖ "U:-") + (?\ǖ "u:-") + (?\Ǘ "U:'") + (?\ǘ "u:'") + (?\Ǚ "U:<") + (?\ǚ "u:<") + (?\Ǜ "U:!") + (?\ǜ "u:!") + (?\Ǟ "A1") + (?\ǟ "a1") + (?\Ǡ "A7") + (?\ǡ "a7") + (?\Ǣ "A3") + (?\ǣ "a3") + (?\Ǥ "G/") + (?\ǥ "g/") + (?\Ǧ "G") + (?\ǧ "g") + (?\Ǩ "K") + (?\ǩ "k") + (?\Ǫ "O") + (?\ǫ "o") + (?\Ǭ "O1") + (?\ǭ "o1") + (?\Ǯ "EZ") + (?\ǯ "ez") + (?\ǰ "j") + (?\Ǵ "G") + (?\ǵ "g") + (?\Ǻ "AA'") + (?\ǻ "aa'") + (?\Ǽ "AE'") + (?\ǽ "ae'") + (?\Ǿ "O/'") + (?\ǿ "o/'") + (?\Ȁ "A!!") + (?\ȁ "a!!") + (?\Ȃ "A)") + (?\ȃ "a)") + (?\Ȅ "E!!") + (?\ȅ "e!!") + (?\Ȇ "E)") + (?\ȇ "e)") + (?\Ȉ "I!!") + (?\ȉ "i!!") + (?\Ȋ "I)") + (?\ȋ "i)") + (?\Ȍ "O!!") + (?\ȍ "o!!") + (?\Ȏ "O)") + (?\ȏ "o)") + (?\Ȑ "R!!") + (?\ȑ "r!!") + (?\Ȓ "R)") + (?\ȓ "r)") + (?\Ȕ "U!!") + (?\ȕ "u!!") + (?\Ȗ "U)") + (?\ȗ "u)") + (?\ȝ "Z") + (?\ɑ "A") + (?\ɒ "A.") + (?\ɓ "b`") + (?\ɔ "O") + (?\ɖ "d.") + (?\ɗ "d`") + (?\ɘ "@<umd>") + (?\ə "@") + (?\ɚ "R") + (?\ɛ "E") + (?\ɜ "V\"") + (?\ɝ "R<umd>") + (?\ɞ "O\"") + (?\ɟ "J") + (?\ɠ "g`") + (?\ɡ "g") + (?\ɢ "G") + (?\ɣ "Q") + (?\ɤ "o-") + (?\ɥ "j<rnd>") + (?\ɦ "h<?>") + (?\ɨ "i\"") + (?\ɩ "I") + (?\ɪ "I") + (?\ɫ "L") + (?\ɬ "L") + (?\ɭ "l.") + (?\ɮ "z<lat>") + (?\ɯ "u-") + (?\ɰ "j<vel>") + (?\ɱ "M") + (?\ɳ "n.") + (?\ɴ "n\"") + (?\ɵ "@.") + (?\ɶ "&.") + (?\ɷ "U") + (?\ɹ "r") + (?\ɺ "*<lat>") + (?\ɻ "r.") + (?\ɽ "*.") + (?\ɾ "*") + (?\ʀ "R") + (?\ʁ "g\"") + (?\ʂ "s.") + (?\ʃ "S") + (?\ʄ "J`") + (?\ʇ "t!") + (?\ʈ "t.") + (?\ʉ "u\"") + (?\ʊ "U") + (?\ʋ "r<lbd>") + (?\ʌ "V") + (?\ʍ "w<vls>") + (?\ʎ "l^") + (?\ʏ "I.") + (?\ʐ "z.") + (?\ʒ "Z") + (?\ʔ "?") + (?\ʕ "H<vcd>") + (?\ʖ "l!") + (?\ʗ "c!") + (?\ʘ "p!") + (?\ʙ "b<trl>") + (?\ʛ "G`") + (?\ʝ "j") + (?\ʞ "k!") + (?\ʟ "L") + (?\ʠ "q`") + (?\ʤ "d3") + (?\ʦ "ts") + (?\ʧ "tS") + (?\ʰ "<h>") + (?\ʱ "<?>") + (?\ʲ ";") + (?\ʳ "<r>") + (?\ʷ "<w>") + (?\ʻ ";S") + (?\ʼ "`") + (?\ˆ "^") + (?\ˇ "'<") + (?\ˈ "|") + (?\ˉ "1-") + (?\ˋ "1!") + (?\ː ":") + (?\ˑ ":\\") + (?\˖ "+") + (?\˗ "-") + (?\˘ "'(") + (?\˙ "'.") + (?\˚ "'0") + (?\˛ "';") + (?\˜ "~") + (?\˝ "'\"") + (?\˥ "_T") + (?\˦ "_H") + (?\˧ "_M") + (?\˨ "_L") + (?\˩ "_B") + (?\ˬ "_v") + (?\ˮ "''") + (?\̀ "`") + (?\́ "'") + (?\̂ "^") + (?\̃ "~") + (?\̄ "¯") + (?\̇ "·") + (?\̈ "¨") + (?\̊ "°") + (?\̋ "''") + (?\̍ "|") + (?\̎ "||") + (?\̏ "``") + (?\̡ ";") + (?\̢ ".") + (?\̣ ".") + (?\̤ "<?>") + (?\̥ "<o>") + (?\̦ ",") + (?\̧ "¸") + (?\̩ "-") + (?\̪ "[") + (?\̫ "<w>") + (?\̴ "~") + (?\̷ "/") + (?\̸ "/") + (?\̀ "`") + (?\́ "'") + (?\͂ "~") + (?\̈́ "'%") + (?\ͅ "j3") + (?\͇ "=") + (?\͠ "~~") + (?\ʹ "'") + (?\͵ ",") + (?\ͺ "j3") + (?\; "?%") + (?\΄ "'*") + (?\΅ "'%") + (?\Ά "A'") + (?\· "·") + (?\Έ "E'") + (?\Ή "Y%") + (?\Ί "I'") + (?\Ό "O'") + (?\Ύ "U%") + (?\Ώ "W%") + (?\ΐ "i3") + (?\Α "A") + (?\Β "B") + (?\Γ "G") + (?\Δ "D") + (?\Ε "E") + (?\Ζ "Z") + (?\Η "Y") + (?\Θ "TH") + (?\Ι "I") + (?\Κ "K") + (?\Λ "L") + (?\Μ "M") + (?\Ν "N") + (?\Ξ "C") + (?\Ο "O") + (?\Π "P") + (?\Ρ "R") + (?\Σ "S") + (?\Τ "T") + (?\Υ "U") + (?\Φ "F") + (?\Χ "X") + (?\Ψ "Q") + (?\Ω "W*") + (?\Ϊ "J") + (?\Ϋ "V*") + (?\ά "a'") + (?\έ "e'") + (?\ή "y%") + (?\ί "i'") + (?\ΰ "u3") + (?\α "a") + (?\β "b") + (?\γ "g") + (?\δ "d") + (?\ε "e") + (?\ζ "z") + (?\η "y") + (?\θ "th") + (?\ι "i") + (?\κ "k") + (?\λ "l") + (?\μ "µ") + (?\ν "n") + (?\ξ "c") + (?\ο "o") + (?\π "p") + (?\ρ "r") + (?\ς "*s") + (?\σ "s") + (?\τ "t") + (?\υ "u") + (?\φ "f") + (?\χ "x") + (?\ψ "q") + (?\ω "w") + (?\ϊ "j") + (?\ϋ "v*") + (?\ό "o'") + (?\ύ "u%") + (?\ώ "w%") + (?\ϐ "beta ") + (?\ϑ "theta ") + (?\ϒ "upsi ") + (?\ϕ "phi ") + (?\ϖ "pi ") + (?\ϗ "k.") + (?\Ϛ "T3") + (?\ϛ "t3") + (?\Ϝ "M3") + (?\ϝ "m3") + (?\Ϟ "K3") + (?\ϟ "k3") + (?\Ϡ "P3") + (?\ϡ "p3") + (?\ϰ "kappa ") + (?\ϱ "rho ") + (?\ϳ "J") + (?\ϴ "'%") + (?\ϵ "j3") + (?\Ё "IO") + (?\Ђ "D%") + (?\Ѓ "G%") + (?\Є "IE") + (?\Ѕ "DS") + (?\І "II") + (?\Ї "YI") + (?\Ј "J%") + (?\Љ "LJ") + (?\Њ "NJ") + (?\Ћ "Ts") + (?\Ќ "KJ") + (?\Ў "V%") + (?\Џ "DZ") + (?\А "A") + (?\Б "B") + (?\В "V") + (?\Г "G") + (?\Д "D") + (?\Е "E") + (?\Ж "ZH") + (?\З "Z") + (?\И "I") + (?\Й "J") + (?\К "K") + (?\Л "L") + (?\М "M") + (?\Н "N") + (?\О "O") + (?\П "P") + (?\Р "R") + (?\С "S") + (?\Т "T") + (?\У "U") + (?\Ф "F") + (?\Х "H") + (?\Ц "C") + (?\Ч "CH") + (?\Ш "SH") + (?\Щ "SCH") + (?\Ъ "\"") + (?\Ы "Y") + (?\Ь "'") + (?\Э "`E") + (?\Ю "YU") + (?\Я "YA") + (?\а "a") + (?\б "b") + (?\в "v") + (?\г "g") + (?\д "d") + (?\е "e") + (?\ж "zh") + (?\з "z") + (?\и "i") + (?\й "j") + (?\к "k") + (?\л "l") + (?\м "m") + (?\н "n") + (?\о "o") + (?\п "p") + (?\р "r") + (?\с "s") + (?\т "t") + (?\у "u") + (?\ф "f") + (?\х "h") + (?\ц "c") + (?\ч "ch") + (?\ш "sh") + (?\щ "sch") + (?\ъ "\"") + (?\ы "y") + (?\ь "'") + (?\э "`e") + (?\ю "yu") + (?\я "ya") + (?\ё "io") + (?\ђ "d%") + (?\ѓ "g%") + (?\є "ie") + (?\ѕ "ds") + (?\і "ii") + (?\ї "yi") + (?\ј "j%") + (?\љ "lj") + (?\њ "nj") + (?\ћ "ts") + (?\ќ "kj") + (?\ў "v%") + (?\џ "dz") + (?\Ѣ "Y3") + (?\ѣ "y3") + (?\Ѫ "O3") + (?\ѫ "o3") + (?\Ѳ "F3") + (?\ѳ "f3") + (?\Ѵ "V3") + (?\ѵ "v3") + (?\Ҁ "C3") + (?\ҁ "c3") + (?\Ґ "G3") + (?\ґ "g3") + (?\Ӕ "AE") + (?\ӕ "ae") + (?\ִ "i") + (?\ַ "a") + (?\ָ "o") + (?\ּ "u") + (?\ֿ "h") + (?\ׂ ":") + (?\א "#") + (?\ב "B+") + (?\ג "G+") + (?\ד "D+") + (?\ה "H+") + (?\ו "W+") + (?\ז "Z+") + (?\ח "X+") + (?\ט "Tj") + (?\י "J+") + (?\ך "K%") + (?\כ "K+") + (?\ל "L+") + (?\ם "M%") + (?\מ "M+") + (?\ן "N%") + (?\נ "N+") + (?\ס "S+") + (?\ע "E+") + (?\ף "P%") + (?\פ "P+") + (?\ץ "Zj") + (?\צ "ZJ") + (?\ק "Q+") + (?\ר "R+") + (?\ש "Sh") + (?\ת "T+") + (?\װ "v") + (?\ױ "oy") + (?\ײ "ey") + (?\، ",+") + (?\؛ ";+") + (?\؟ "?+") + (?\ء "H'") + (?\آ "aM") + (?\أ "aH") + (?\ؤ "wH") + (?\إ "ah") + (?\ئ "yH") + (?\ا "a+") + (?\ب "b+") + (?\ة "tm") + (?\ت "t+") + (?\ث "tk") + (?\ج "g+") + (?\ح "hk") + (?\خ "x+") + (?\د "d+") + (?\ذ "dk") + (?\ر "r+") + (?\ز "z+") + (?\س "s+") + (?\ش "sn") + (?\ص "c+") + (?\ض "dd") + (?\ط "tj") + (?\ظ "zH") + (?\ع "e+") + (?\غ "i+") + (?\ـ "++") + (?\ف "f+") + (?\ق "q+") + (?\ك "k+") + (?\ل "l+") + (?\م "m+") + (?\ن "n+") + (?\ه "h+") + (?\و "w+") + (?\ى "j+") + (?\ي "y+") + (?\ً ":+") + (?\ٌ "\"+") + (?\ٍ "=+") + (?\َ "/+") + (?\ُ "'+") + (?\ِ "1+") + (?\ّ "3+") + (?\ْ "0+") + (?\٠ "0a") + (?\١ "1a") + (?\٢ "2a") + (?\٣ "3a") + (?\٤ "4a") + (?\٥ "5a") + (?\٦ "6a") + (?\٧ "7a") + (?\٨ "8a") + (?\٩ "9a") + (?\ٰ "aS") + (?\پ "p+") + (?\ځ "hH") + (?\چ "tc") + (?\ژ "zj") + (?\ڤ "v+") + (?\گ "gf") + (?\۰ "0a") + (?\۱ "1a") + (?\۲ "2a") + (?\۳ "3a") + (?\۴ "4a") + (?\۵ "5a") + (?\۶ "6a") + (?\۷ "7a") + (?\۸ "8a") + (?\۹ "9a") + (?\ሀ "he") + (?\ሁ "hu") + (?\ሂ "hi") + (?\ሃ "ha") + (?\ሄ "hE") + (?\ህ "h") + (?\ሆ "ho") + (?\ለ "le") + (?\ሉ "lu") + (?\ሊ "li") + (?\ላ "la") + (?\ሌ "lE") + (?\ል "l") + (?\ሎ "lo") + (?\ሏ "lWa") + (?\ሐ "He") + (?\ሑ "Hu") + (?\ሒ "Hi") + (?\ሓ "Ha") + (?\ሔ "HE") + (?\ሕ "H") + (?\ሖ "Ho") + (?\ሗ "HWa") + (?\መ "me") + (?\ሙ "mu") + (?\ሚ "mi") + (?\ማ "ma") + (?\ሜ "mE") + (?\ም "m") + (?\ሞ "mo") + (?\ሟ "mWa") + (?\ሠ "`se") + (?\ሡ "`su") + (?\ሢ "`si") + (?\ሣ "`sa") + (?\ሤ "`sE") + (?\ሥ "`s") + (?\ሦ "`so") + (?\ሧ "`sWa") + (?\ረ "re") + (?\ሩ "ru") + (?\ሪ "ri") + (?\ራ "ra") + (?\ሬ "rE") + (?\ር "r") + (?\ሮ "ro") + (?\ሯ "rWa") + (?\ሰ "se") + (?\ሱ "su") + (?\ሲ "si") + (?\ሳ "sa") + (?\ሴ "sE") + (?\ስ "s") + (?\ሶ "so") + (?\ሷ "sWa") + (?\ሸ "xe") + (?\ሹ "xu") + (?\ሺ "xi") + (?\ሻ "xa") + (?\ሼ "xE") + (?\ሽ "xa") + (?\ሾ "xo") + (?\ሿ "xWa") + (?\ቀ "qe") + (?\ቁ "qu") + (?\ቂ "qi") + (?\ቃ "qa") + (?\ቄ "qE") + (?\ቅ "q") + (?\ቆ "qo") + (?\ቈ "qWe") + (?\ቊ "qWi") + (?\ቋ "qWa") + (?\ቌ "qWE") + (?\ቍ "qW") + (?\ቐ "Qe") + (?\ቑ "Qu") + (?\ቒ "Qi") + (?\ቓ "Qa") + (?\ቔ "QE") + (?\ቕ "Q") + (?\ቖ "Qo") + (?\ቘ "QWe") + (?\ቚ "QWi") + (?\ቛ "QWa") + (?\ቜ "QWE") + (?\ቝ "QW") + (?\በ "be") + (?\ቡ "bu") + (?\ቢ "bi") + (?\ባ "ba") + (?\ቤ "bE") + (?\ብ "b") + (?\ቦ "bo") + (?\ቧ "bWa") + (?\ቨ "ve") + (?\ቩ "vu") + (?\ቪ "vi") + (?\ቫ "va") + (?\ቬ "vE") + (?\ቭ "v") + (?\ቮ "vo") + (?\ቯ "vWa") + (?\ተ "te") + (?\ቱ "tu") + (?\ቲ "ti") + (?\ታ "ta") + (?\ቴ "tE") + (?\ት "t") + (?\ቶ "to") + (?\ቷ "tWa") + (?\ቸ "ce") + (?\ቹ "cu") + (?\ቺ "ci") + (?\ቻ "ca") + (?\ቼ "cE") + (?\ች "c") + (?\ቾ "co") + (?\ቿ "cWa") + (?\ኀ "`he") + (?\ኁ "`hu") + (?\ኂ "`hi") + (?\ኃ "`ha") + (?\ኄ "`hE") + (?\ኅ "`h") + (?\ኆ "`ho") + (?\ኈ "hWe") + (?\ኊ "hWi") + (?\ኋ "hWa") + (?\ኌ "hWE") + (?\ኍ "hW") + (?\ነ "na") + (?\ኑ "nu") + (?\ኒ "ni") + (?\ና "na") + (?\ኔ "nE") + (?\ን "n") + (?\ኖ "no") + (?\ኗ "nWa") + (?\ኘ "Ne") + (?\ኙ "Nu") + (?\ኚ "Ni") + (?\ኛ "Na") + (?\ኜ "NE") + (?\ኝ "N") + (?\ኞ "No") + (?\ኟ "NWa") + (?\አ "e") + (?\ኡ "u") + (?\ኢ "i") + (?\ኣ "a") + (?\ኤ "E") + (?\እ "I") + (?\ኦ "o") + (?\ኧ "e3") + (?\ከ "ke") + (?\ኩ "ku") + (?\ኪ "ki") + (?\ካ "ka") + (?\ኬ "kE") + (?\ክ "k") + (?\ኮ "ko") + (?\ኰ "kWe") + (?\ኲ "kWi") + (?\ኳ "kWa") + (?\ኴ "kWE") + (?\ኵ "kW") + (?\ኸ "Ke") + (?\ኹ "Ku") + (?\ኺ "Ki") + (?\ኻ "Ka") + (?\ኼ "KE") + (?\ኽ "K") + (?\ኾ "Ko") + (?\ዀ "KWe") + (?\ዂ "KWi") + (?\ዃ "KWa") + (?\ዄ "KWE") + (?\ዅ "KW") + (?\ወ "we") + (?\ዉ "wu") + (?\ዊ "wi") + (?\ዋ "wa") + (?\ዌ "wE") + (?\ው "w") + (?\ዎ "wo") + (?\ዐ "`e") + (?\ዑ "`u") + (?\ዒ "`i") + (?\ዓ "`a") + (?\ዔ "`E") + (?\ዕ "`I") + (?\ዖ "`o") + (?\ዘ "ze") + (?\ዙ "zu") + (?\ዚ "zi") + (?\ዛ "za") + (?\ዜ "zE") + (?\ዝ "z") + (?\ዞ "zo") + (?\ዟ "zWa") + (?\ዠ "Ze") + (?\ዡ "Zu") + (?\ዢ "Zi") + (?\ዣ "Za") + (?\ዤ "ZE") + (?\ዥ "Z") + (?\ዦ "Zo") + (?\ዧ "ZWa") + (?\የ "ye") + (?\ዩ "yu") + (?\ዪ "yi") + (?\ያ "ya") + (?\ዬ "yE") + (?\ይ "y") + (?\ዮ "yo") + (?\ዯ "yWa") + (?\ደ "de") + (?\ዱ "du") + (?\ዲ "di") + (?\ዳ "da") + (?\ዴ "dE") + (?\ድ "d") + (?\ዶ "do") + (?\ዷ "dWa") + (?\ዸ "De") + (?\ዹ "Du") + (?\ዺ "Di") + (?\ዻ "Da") + (?\ዼ "DE") + (?\ዽ "D") + (?\ዾ "Do") + (?\ዿ "DWa") + (?\ጀ "je") + (?\ጁ "ju") + (?\ጂ "ji") + (?\ጃ "ja") + (?\ጄ "jE") + (?\ጅ "j") + (?\ጆ "jo") + (?\ጇ "jWa") + (?\ገ "ga") + (?\ጉ "gu") + (?\ጊ "gi") + (?\ጋ "ga") + (?\ጌ "gE") + (?\ግ "g") + (?\ጎ "go") + (?\ጐ "gWu") + (?\ጒ "gWi") + (?\ጓ "gWa") + (?\ጔ "gWE") + (?\ጕ "gW") + (?\ጘ "Ge") + (?\ጙ "Gu") + (?\ጚ "Gi") + (?\ጛ "Ga") + (?\ጜ "GE") + (?\ጝ "G") + (?\ጞ "Go") + (?\ጟ "GWa") + (?\ጠ "Te") + (?\ጡ "Tu") + (?\ጢ "Ti") + (?\ጣ "Ta") + (?\ጤ "TE") + (?\ጥ "T") + (?\ጦ "To") + (?\ጧ "TWa") + (?\ጨ "Ce") + (?\ጩ "Ca") + (?\ጪ "Cu") + (?\ጫ "Ca") + (?\ጬ "CE") + (?\ጭ "C") + (?\ጮ "Co") + (?\ጯ "CWa") + (?\ጰ "Pe") + (?\ጱ "Pu") + (?\ጲ "Pi") + (?\ጳ "Pa") + (?\ጴ "PE") + (?\ጵ "P") + (?\ጶ "Po") + (?\ጷ "PWa") + (?\ጸ "SWe") + (?\ጹ "SWu") + (?\ጺ "SWi") + (?\ጻ "SWa") + (?\ጼ "SWE") + (?\ጽ "SW") + (?\ጾ "SWo") + (?\ጿ "SWa") + (?\ፀ "`Sa") + (?\ፁ "`Su") + (?\ፂ "`Si") + (?\ፃ "`Sa") + (?\ፄ "`SE") + (?\ፅ "`S") + (?\ፆ "`So") + (?\ፈ "fa") + (?\ፉ "fu") + (?\ፊ "fi") + (?\ፋ "fa") + (?\ፌ "fE") + (?\ፍ "o") + (?\ፎ "fo") + (?\ፏ "fWa") + (?\ፐ "pe") + (?\ፑ "pu") + (?\ፒ "pi") + (?\ፓ "pa") + (?\ፔ "pE") + (?\ፕ "p") + (?\ፖ "po") + (?\ፗ "pWa") + (?\ፘ "mYa") + (?\ፙ "rYa") + (?\ፚ "fYa") + (?\፠ " ") + (?\፡ ":") + (?\። "::") + (?\፣ ",") + (?\፤ ";") + (?\፥ "-:") + (?\፦ ":-") + (?\፧ "`?") + (?\፨ ":|:") + (?\፩ "`1") + (?\፪ "`2") + (?\፫ "`3") + (?\፬ "`4") + (?\፭ "`5") + (?\፮ "`6") + (?\፯ "`7") + (?\፰ "`8") + (?\፱ "`9") + (?\፲ "`10") + (?\፳ "`20") + (?\፴ "`30") + (?\፵ "`40") + (?\፶ "`50") + (?\፷ "`60") + (?\፸ "`70") + (?\፹ "`80") + (?\፺ "`90") + (?\፻ "`100") + (?\፼ "`10000") + (?\Ḁ "A-0") + (?\ḁ "a-0") + (?\Ḃ "B.") + (?\ḃ "b.") + (?\Ḅ "B-.") + (?\ḅ "b-.") + (?\Ḇ "B_") + (?\ḇ "b_") + (?\Ḉ "C,'") + (?\ḉ "c,'") + (?\Ḋ "D.") + (?\ḋ "d.") + (?\Ḍ "D-.") + (?\ḍ "d-.") + (?\Ḏ "D_") + (?\ḏ "d_") + (?\Ḑ "D,") + (?\ḑ "d,") + (?\Ḓ "D->") + (?\ḓ "d->") + (?\Ḕ "E-!") + (?\ḕ "e-!") + (?\Ḗ "E-'") + (?\ḗ "e-'") + (?\Ḙ "E->") + (?\ḙ "e->") + (?\Ḛ "E-?") + (?\ḛ "e-?") + (?\Ḝ "E,(") + (?\ḝ "e,(") + (?\Ḟ "F.") + (?\ḟ "f.") + (?\Ḡ "G-") + (?\ḡ "g-") + (?\Ḣ "H.") + (?\ḣ "h.") + (?\Ḥ "H-.") + (?\ḥ "h-.") + (?\Ḧ "H:") + (?\ḧ "h:") + (?\Ḩ "H,") + (?\ḩ "h,") + (?\Ḫ "H-(") + (?\ḫ "h-(") + (?\Ḭ "I-?") + (?\ḭ "i-?") + (?\Ḯ "I:'") + (?\ḯ "i:'") + (?\Ḱ "K'") + (?\ḱ "k'") + (?\Ḳ "K-.") + (?\ḳ "k-.") + (?\Ḵ "K_") + (?\ḵ "k_") + (?\Ḷ "L-.") + (?\ḷ "l-.") + (?\Ḹ "L--.") + (?\ḹ "l--.") + (?\Ḻ "L_") + (?\ḻ "l_") + (?\Ḽ "L->") + (?\ḽ "l->") + (?\Ḿ "M'") + (?\ḿ "m'") + (?\Ṁ "M.") + (?\ṁ "m.") + (?\Ṃ "M-.") + (?\ṃ "m-.") + (?\Ṅ "N.") + (?\ṅ "n.") + (?\Ṇ "N-.") + (?\ṇ "n-.") + (?\Ṉ "N_") + (?\ṉ "n_") + (?\Ṋ "N->") + (?\ṋ "n->") + (?\Ṍ "O?'") + (?\ṍ "o?'") + (?\Ṏ "O?:") + (?\ṏ "o?:") + (?\Ṑ "O-!") + (?\ṑ "o-!") + (?\Ṓ "O-'") + (?\ṓ "o-'") + (?\Ṕ "P'") + (?\ṕ "p'") + (?\Ṗ "P.") + (?\ṗ "p.") + (?\Ṙ "R.") + (?\ṙ "r.") + (?\Ṛ "R-.") + (?\ṛ "r-.") + (?\Ṝ "R--.") + (?\ṝ "r--.") + (?\Ṟ "R_") + (?\ṟ "r_") + (?\Ṡ "S.") + (?\ṡ "s.") + (?\Ṣ "S-.") + (?\ṣ "s-.") + (?\Ṥ "S'.") + (?\ṥ "s'.") + (?\Ṧ "S<.") + (?\ṧ "s<.") + (?\Ṩ "S.-.") + (?\ṩ "s.-.") + (?\Ṫ "T.") + (?\ṫ "t.") + (?\Ṭ "T-.") + (?\ṭ "t-.") + (?\Ṯ "T_") + (?\ṯ "t_") + (?\Ṱ "T->") + (?\ṱ "t->") + (?\Ṳ "U--:") + (?\ṳ "u--:") + (?\Ṵ "U-?") + (?\ṵ "u-?") + (?\Ṷ "U->") + (?\ṷ "u->") + (?\Ṹ "U?'") + (?\ṹ "u?'") + (?\Ṻ "U-:") + (?\ṻ "u-:") + (?\Ṽ "V?") + (?\ṽ "v?") + (?\Ṿ "V-.") + (?\ṿ "v-.") + (?\Ẁ "W!") + (?\ẁ "w!") + (?\Ẃ "W'") + (?\ẃ "w'") + (?\Ẅ "W:") + (?\ẅ "w:") + (?\Ẇ "W.") + (?\ẇ "w.") + (?\Ẉ "W-.") + (?\ẉ "w-.") + (?\Ẋ "X.") + (?\ẋ "x.") + (?\Ẍ "X:") + (?\ẍ "x:") + (?\Ẏ "Y.") + (?\ẏ "y.") + (?\Ẑ "Z>") + (?\ẑ "z>") + (?\Ẓ "Z-.") + (?\ẓ "z-.") + (?\Ẕ "Z_") + (?\ẕ "z_") + (?\ẖ "h_") + (?\ẗ "t:") + (?\ẘ "w0") + (?\ẙ "y0") + (?\Ạ "A-.") + (?\ạ "a-.") + (?\Ả "A2") + (?\ả "a2") + (?\Ấ "A>'") + (?\ấ "a>'") + (?\Ầ "A>!") + (?\ầ "a>!") + (?\Ẩ "A>2") + (?\ẩ "a>2") + (?\Ẫ "A>?") + (?\ẫ "a>?") + (?\Ậ "A>-.") + (?\ậ "a>-.") + (?\Ắ "A('") + (?\ắ "a('") + (?\Ằ "A(!") + (?\ằ "a(!") + (?\Ẳ "A(2") + (?\ẳ "a(2") + (?\Ẵ "A(?") + (?\ẵ "a(?") + (?\Ặ "A(-.") + (?\ặ "a(-.") + (?\Ẹ "E-.") + (?\ẹ "e-.") + (?\Ẻ "E2") + (?\ẻ "e2") + (?\Ẽ "E?") + (?\ẽ "e?") + (?\Ế "E>'") + (?\ế "e>'") + (?\Ề "E>!") + (?\ề "e>!") + (?\Ể "E>2") + (?\ể "e>2") + (?\Ễ "E>?") + (?\ễ "e>?") + (?\Ệ "E>-.") + (?\ệ "e>-.") + (?\Ỉ "I2") + (?\ỉ "i2") + (?\Ị "I-.") + (?\ị "i-.") + (?\Ọ "O-.") + (?\ọ "o-.") + (?\Ỏ "O2") + (?\ỏ "o2") + (?\Ố "O>'") + (?\ố "o>'") + (?\Ồ "O>!") + (?\ồ "o>!") + (?\Ổ "O>2") + (?\ổ "o>2") + (?\Ỗ "O>?") + (?\ỗ "o>?") + (?\Ộ "O>-.") + (?\ộ "o>-.") + (?\Ớ "O9'") + (?\ớ "o9'") + (?\Ờ "O9!") + (?\ờ "o9!") + (?\Ở "O92") + (?\ở "o92") + (?\Ỡ "O9?") + (?\ỡ "o9?") + (?\Ợ "O9-.") + (?\ợ "o9-.") + (?\Ụ "U-.") + (?\ụ "u-.") + (?\Ủ "U2") + (?\ủ "u2") + (?\Ứ "U9'") + (?\ứ "u9'") + (?\Ừ "U9!") + (?\ừ "u9!") + (?\Ử "U92") + (?\ử "u92") + (?\Ữ "U9?") + (?\ữ "u9?") + (?\Ự "U9-.") + (?\ự "u9-.") + (?\Ỳ "Y!") + (?\ỳ "y!") + (?\Ỵ "Y-.") + (?\ỵ "y-.") + (?\Ỷ "Y2") + (?\ỷ "y2") + (?\Ỹ "Y?") + (?\ỹ "y?") + (?\ἀ "a") + (?\ἁ "ha") + (?\ἂ "`a") + (?\ἃ "h`a") + (?\ἄ "a'") + (?\ἅ "ha'") + (?\ἆ "a~") + (?\ἇ "ha~") + (?\Ἀ "A") + (?\Ἁ "hA") + (?\Ἂ "`A") + (?\Ἃ "h`A") + (?\Ἄ "A'") + (?\Ἅ "hA'") + (?\Ἆ "A~") + (?\Ἇ "hA~") + (?\ἑ "he") + (?\Ἑ "hE") + (?\ἱ "hi") + (?\Ἱ "hI") + (?\ὁ "ho") + (?\Ὁ "hO") + (?\ὑ "hu") + (?\Ὑ "hU") + (?\᾿ ",,") + (?\῀ "?*") + (?\῁ "?:") + (?\῍ ",!") + (?\῎ ",'") + (?\῏ "?,") + (?\῝ ";!") + (?\῞ ";'") + (?\῟ "?;") + (?\ῥ "rh") + (?\Ῥ "Rh") + (?\῭ "!:") + (?\` "!*") + (?\῾ ";;") + (?\ " ") + (?\ " ") + (?\ " ") + (?\ " ") + (?\ " ") + (?\ " ") + (?\ " ") + (?\ " ") + (?\ " ") + (?\ " ") + (?\‐ "-") + (?\‑ "-") + (?\– "-") + (?\— "--") + (?\― "-") + (?\‖ "||") + (?\‗ "=2") + (?\‘ "`") + (?\’ "'") + (?\‚ "'") + (?\‛ "'") + (?\“ "\"") + (?\” "\"") + (?\„ "\"") + (?\‟ "\"") + (?\† "/-") + (?\‡ "/=") + (?\• " o ") + (?\․ ".") + (?\‥ "..") + (?\… "...") + (?\‧ "·") + (?\‰ " 0/00") + (?\′ "'") + (?\″ "''") + (?\‴ "'''") + (?\‵ "`") + (?\‶ "``") + (?\‷ "```") + (?\‸ "Ca") + (?\‹ "<") + (?\› ">") + (?\※ ":X") + (?\‼ "!!") + (?\‾ "'-") + (?\⁃ "-") + (?\⁄ "/") + (?\⁈ "?!") + (?\⁉ "!?") + (?\⁰ "^0") + (?\⁴ "^4") + (?\⁵ "^5") + (?\⁶ "^6") + (?\⁷ "^7") + (?\⁸ "^8") + (?\⁹ "^9") + (?\⁺ "^+") + (?\⁻ "^-") + (?\⁼ "^=") + (?\⁽ "^(") + (?\⁾ "^)") + (?\ⁿ "^n") + (?\₀ "_0") + (?\₁ "_1") + (?\₂ "_2") + (?\₃ "_3") + (?\₄ "_4") + (?\₅ "_5") + (?\₆ "_6") + (?\₇ "_7") + (?\₈ "_8") + (?\₉ "_9") + (?\₊ "_+") + (?\₋ "_-") + (?\₌ "_=") + (?\₍ "(") + (?\₎ ")") + (?\₣ "Ff") + (?\₤ "Li") + (?\₧ "Pt") + (?\₩ "W=") + (?\€ "EUR") + (?\℀ "a/c") + (?\℁ "a/s") + (?\℃ "oC") + (?\℅ "c/o") + (?\℆ "c/u") + (?\℉ "oF") + (?\ℊ "g") + (?\ℎ "h") + (?\ℏ "\\hbar") + (?\ℑ "Im") + (?\ℓ "l") + (?\№ "No.") + (?\℗ "PO") + (?\℘ "P") + (?\ℜ "Re") + (?\℞ "Rx") + (?\℠ "(SM)") + (?\℡ "TEL") + (?\™ "(TM)") + (?\Ω "Ohm") + (?\K "K") + (?\Å "Ang.") + (?\℮ "est.") + (?\ℴ "o") + (?\ℵ "Aleph ") + (?\ℶ "Bet ") + (?\ℷ "Gimel ") + (?\ℸ "Dalet ") + (?\⅓ " 1/3") + (?\⅔ " 2/3") + (?\⅕ " 1/5") + (?\⅖ " 2/5") + (?\⅗ " 3/5") + (?\⅘ " 4/5") + (?\⅙ " 1/6") + (?\⅚ " 5/6") + (?\⅛ " 1/8") + (?\⅜ " 3/8") + (?\⅝ " 5/8") + (?\⅞ " 7/8") + (?\⅟ " 1/") + (?\Ⅰ "I") + (?\Ⅱ "II") + (?\Ⅲ "III") + (?\Ⅳ "IV") + (?\Ⅴ "V") + (?\Ⅵ "VI") + (?\Ⅶ "VII") + (?\Ⅷ "VIII") + (?\Ⅸ "IX") + (?\Ⅹ "X") + (?\Ⅺ "XI") + (?\Ⅻ "XII") + (?\Ⅼ "L") + (?\Ⅽ "C") + (?\Ⅾ "D") + (?\Ⅿ "M") + (?\ⅰ "i") + (?\ⅱ "ii") + (?\ⅲ "iii") + (?\ⅳ "iv") + (?\ⅴ "v") + (?\ⅵ "vi") + (?\ⅶ "vii") + (?\ⅷ "viii") + (?\ⅸ "ix") + (?\ⅹ "x") + (?\ⅺ "xi") + (?\ⅻ "xii") + (?\ⅼ "l") + (?\ⅽ "c") + (?\ⅾ "d") + (?\ⅿ "m") + (?\ↀ "1000RCD") + (?\ↁ "5000R") + (?\ↂ "10000R") + (?\← "<-") + (?\↑ "-^") + (?\→ "->") + (?\↓ "-v") + (?\↔ "<->") + (?\↕ "UD") + (?\↖ "<!!") + (?\↗ "//>") + (?\↘ "!!>") + (?\↙ "<//") + (?\↨ "UD-") + (?\↵ "RET") + (?\⇀ ">V") + (?\⇐ "<=") + (?\⇑ "^^") + (?\⇒ "=>") + (?\⇓ "vv") + (?\⇔ "<=>") + (?\∀ "FA") + (?\∂ "\\partial") + (?\∃ "TE") + (?\∅ "{}") + (?\∆ "Delta") + (?\∇ "Nabla") + (?\∈ "(-") + (?\∉ "!(-") + (?\∊ "(-") + (?\∋ "-)") + (?\∌ "!-)") + (?\∍ "-)") + (?\∎ " qed") + (?\∏ "\\prod") + (?\∑ "\\sum") + (?\− " -") + (?\∓ "-/+") + (?\∔ ".+") + (?\∕ "/") + (?\∖ " - ") + (?\∗ "*") + (?\∘ " ° ") + (?\∙ "sb") + (?\√ " SQRT ") + (?\∛ " ROOT³ ") + (?\∜ " ROOT4 ") + (?\∝ "0(") + (?\∞ "infty") + (?\∟ "-L") + (?\∠ "-V") + (?\∥ "PP") + (?\∦ " !PP ") + (?\∧ "AND") + (?\∨ "OR") + (?\∩ "(U") + (?\∪ ")U") + (?\∫ "\\int ") + (?\∬ "DI") + (?\∮ "Io") + (?\∴ ".:") + (?\∵ ":.") + (?\∶ ":R") + (?\∷ "::") + (?\∼ "?1") + (?\∾ "CG") + (?\≃ "?-") + (?\≅ "?=") + (?\≈ "~=") + (?\≉ " !~= ") + (?\≌ "=?") + (?\≓ "HI") + (?\≔ ":=") + (?\≕ "=:") + (?\≠ "!=") + (?\≡ "=3") + (?\≢ " !=3 ") + (?\≤ "=<") + (?\≥ ">=") + (?\≦ ".LE.") + (?\≧ ".GE.") + (?\≨ ".LT.NOT.EQ.") + (?\≩ ".GT.NOT.EQ.") + (?\≪ "<<") + (?\≫ ">>") + (?\≮ "!<") + (?\≯ "!>") + (?\≶ " <> ") + (?\≷ " >< ") + (?\⊂ "(C") + (?\⊃ ")C") + (?\⊄ " !(C ") + (?\⊅ " !)C ") + (?\⊆ "(_") + (?\⊇ ")_") + (?\⊕ "(+)") + (?\⊖ "(-)") + (?\⊗ "(×)") + (?\⊘ "(/)") + (?\⊙ "(·)") + (?\⊚ "(°)") + (?\⊛ "(*)") + (?\⊜ "(=)") + (?\⊝ "(-)") + (?\⊞ "[+]") + (?\⊟ "[-]") + (?\⊠ "[×]") + (?\⊡ "[·]") + (?\⊥ "-T") + (?\⊧ " MODELS ") + (?\⊨ " TRUE ") + (?\⊩ " FORCES ") + (?\⊬ " !PROVES ") + (?\⊭ " NOT TRUE ") + (?\⊮ " !FORCES ") + (?\⊲ " NORMAL SUBGROUP OF ") + (?\⊳ " CONTAINS AS NORMAL SUBGROUP ") + (?\⊴ " NORMAL SUBGROUP OF OR EQUAL TO ") + (?\⊵ " CONTAINS AS NORMAL SUBGROUP OR EQUAL TO ") + (?\⊸ " MULTIMAP ") + (?\⊺ " INTERCALATE ") + (?\⊻ " XOR ") + (?\⊼ " NAND ") + (?\⋅ " · ") + (?\⋖ "<.") + (?\⋗ ">.") + (?\⋘ "<<<") + (?\⋙ ">>>") + (?\⋮ ":3") + (?\⋯ ".3") + (?\⌂ "Eh") + (?\⌇ "~~") + (?\⌈ "<7") + (?\⌉ ">7") + (?\⌊ "7<") + (?\⌋ "7>") + (?\⌐ "NI") + (?\⌒ "(A") + (?\⌕ "TR") + (?\⌘ "88") + (?\⌠ "Iu") + (?\⌡ "Il") + (?\⌢ ":(") + (?\⌣ ":)") + (?\⌤ "|^|") + (?\⌧ "[X]") + (?\〈 "</") + (?\〉 "/>") + (?\␣ "Vs") + (?\⑀ "1h") + (?\⑁ "3h") + (?\⑂ "2h") + (?\⑃ "4h") + (?\⑆ "1j") + (?\⑇ "2j") + (?\⑈ "3j") + (?\⑉ "4j") + (?\① "1-o") + (?\② "2-o") + (?\③ "3-o") + (?\④ "4-o") + (?\⑤ "5-o") + (?\⑥ "6-o") + (?\⑦ "7-o") + (?\⑧ "8-o") + (?\⑨ "9-o") + (?\⑩ "10-o") + (?\⑪ "11-o") + (?\⑫ "12-o") + (?\⑬ "13-o") + (?\⑭ "14-o") + (?\⑮ "15-o") + (?\⑯ "16-o") + (?\⑰ "17-o") + (?\⑱ "18-o") + (?\⑲ "19-o") + (?\⑳ "20-o") + (?\⑴ "(1)") + (?\⑵ "(2)") + (?\⑶ "(3)") + (?\⑷ "(4)") + (?\⑸ "(5)") + (?\⑹ "(6)") + (?\⑺ "(7)") + (?\⑻ "(8)") + (?\⑼ "(9)") + (?\⑽ "(10)") + (?\⑾ "(11)") + (?\⑿ "(12)") + (?\⒀ "(13)") + (?\⒁ "(14)") + (?\⒂ "(15)") + (?\⒃ "(16)") + (?\⒄ "(17)") + (?\⒅ "(18)") + (?\⒆ "(19)") + (?\⒇ "(20)") + (?\⒈ "1.") + (?\⒉ "2.") + (?\⒊ "3.") + (?\⒋ "4.") + (?\⒌ "5.") + (?\⒍ "6.") + (?\⒎ "7.") + (?\⒏ "8.") + (?\⒐ "9.") + (?\⒑ "10.") + (?\⒒ "11.") + (?\⒓ "12.") + (?\⒔ "13.") + (?\⒕ "14.") + (?\⒖ "15.") + (?\⒗ "16.") + (?\⒘ "17.") + (?\⒙ "18.") + (?\⒚ "19.") + (?\⒛ "20.") + (?\⒜ "(a)") + (?\⒝ "(b)") + (?\⒞ "(c)") + (?\⒟ "(d)") + (?\⒠ "(e)") + (?\⒡ "(f)") + (?\⒢ "(g)") + (?\⒣ "(h)") + (?\⒤ "(i)") + (?\⒥ "(j)") + (?\⒦ "(k)") + (?\⒧ "(l)") + (?\⒨ "(m)") + (?\⒩ "(n)") + (?\⒪ "(o)") + (?\⒫ "(p)") + (?\⒬ "(q)") + (?\⒭ "(r)") + (?\⒮ "(s)") + (?\⒯ "(t)") + (?\⒰ "(u)") + (?\⒱ "(v)") + (?\⒲ "(w)") + (?\⒳ "(x)") + (?\⒴ "(y)") + (?\⒵ "(z)") + (?\Ⓐ "A-o") + (?\Ⓑ "B-o") + (?\Ⓒ "C-o") + (?\Ⓓ "D-o") + (?\Ⓔ "E-o") + (?\Ⓕ "F-o") + (?\Ⓖ "G-o") + (?\Ⓗ "H-o") + (?\Ⓘ "I-o") + (?\Ⓙ "J-o") + (?\Ⓚ "K-o") + (?\Ⓛ "L-o") + (?\Ⓜ "M-o") + (?\Ⓝ "N-o") + (?\Ⓞ "O-o") + (?\Ⓟ "P-o") + (?\Ⓠ "Q-o") + (?\Ⓡ "R-o") + (?\Ⓢ "S-o") + (?\Ⓣ "T-o") + (?\Ⓤ "U-o") + (?\Ⓥ "V-o") + (?\Ⓦ "W-o") + (?\Ⓧ "X-o") + (?\Ⓨ "Y-o") + (?\Ⓩ "Z-o") + (?\ⓐ "a-o") + (?\ⓑ "b-o") + (?\ⓒ "c-o") + (?\ⓓ "d-o") + (?\ⓔ "e-o") + (?\ⓕ "f-o") + (?\ⓖ "g-o") + (?\ⓗ "h-o") + (?\ⓘ "i-o") + (?\ⓙ "j-o") + (?\ⓚ "k-o") + (?\ⓛ "l-o") + (?\ⓜ "m-o") + (?\ⓝ "n-o") + (?\ⓞ "o-o") + (?\ⓟ "p-o") + (?\ⓠ "q-o") + (?\ⓡ "r-o") + (?\ⓢ "s-o") + (?\ⓣ "t-o") + (?\ⓤ "u-o") + (?\ⓥ "v-o") + (?\ⓦ "w-o") + (?\ⓧ "x-o") + (?\ⓨ "y-o") + (?\ⓩ "z-o") + (?\⓪ "0-o") + (?\─ "-") + (?\━ "=") + (?\│ "|") + (?\┃ "|") + (?\┄ "-") + (?\┅ "=") + (?\┆ "|") + (?\┇ "|") + (?\┈ "-") + (?\┉ "=") + (?\┊ "|") + (?\┋ "|") + (?\┌ "+") + (?\┍ "+") + (?\┎ "+") + (?\┏ "+") + (?\┐ "+") + (?\┑ "+") + (?\┒ "+") + (?\┓ "+") + (?\└ "+") + (?\┕ "+") + (?\┖ "+") + (?\┗ "+") + (?\┘ "+") + (?\┙ "+") + (?\┚ "+") + (?\┛ "+") + (?\├ "+") + (?\┝ "+") + (?\┞ "+") + (?\┟ "+") + (?\┠ "+") + (?\┡ "+") + (?\┢ "+") + (?\┣ "+") + (?\┤ "+") + (?\┥ "+") + (?\┦ "+") + (?\┧ "+") + (?\┨ "+") + (?\┩ "+") + (?\┪ "+") + (?\┫ "+") + (?\┬ "+") + (?\┭ "+") + (?\┮ "+") + (?\┯ "+") + (?\┰ "+") + (?\┱ "+") + (?\┲ "+") + (?\┳ "+") + (?\┴ "+") + (?\┵ "+") + (?\┶ "+") + (?\┷ "+") + (?\┸ "+") + (?\┹ "+") + (?\┺ "+") + (?\┻ "+") + (?\┼ "+") + (?\┽ "+") + (?\┾ "+") + (?\┿ "+") + (?\╀ "+") + (?\╁ "+") + (?\╂ "+") + (?\╃ "+") + (?\╄ "+") + (?\╅ "+") + (?\╆ "+") + (?\╇ "+") + (?\╈ "+") + (?\╉ "+") + (?\╊ "+") + (?\╋ "+") + (?\╌ "+") + (?\╍ "+") + (?\╎ "+") + (?\╏ "+") + (?\═ "+") + (?\║ "+") + (?\╒ "+") + (?\╓ "+") + (?\╔ "+") + (?\╕ "+") + (?\╖ "+") + (?\╗ "+") + (?\╘ "+") + (?\╙ "+") + (?\╚ "+") + (?\╛ "+") + (?\╜ "+") + (?\╝ "+") + (?\╞ "+") + (?\╟ "+") + (?\╠ "+") + (?\╡ "+") + (?\╢ "+") + (?\╣ "+") + (?\╤ "+") + (?\╥ "+") + (?\╦ "+") + (?\╧ "+") + (?\╨ "+") + (?\╩ "+") + (?\╪ "+") + (?\╫ "+") + (?\╬ "+") + (?\╱ "/") + (?\╲ "\\") + (?\▀ "TB") + (?\▄ "LB") + (?\█ "FB") + (?\▌ "lB") + (?\▐ "RB") + (?\░ ".S") + (?\▒ ":S") + (?\▓ "?S") + (?\■ "fS") + (?\□ "OS") + (?\▢ "RO") + (?\▣ "Rr") + (?\▤ "RF") + (?\▥ "RY") + (?\▦ "RH") + (?\▧ "RZ") + (?\▨ "RK") + (?\▩ "RX") + (?\▪ "sB") + (?\▬ "SR") + (?\▭ "Or") + (?\▲ "^") + (?\△ "uT") + (?\▶ "|>") + (?\▷ "Tr") + (?\► "|>") + (?\▼ "v") + (?\▽ "dT") + (?\◀ "<|") + (?\◁ "Tl") + (?\◄ "<|") + (?\◆ "Db") + (?\◇ "Dw") + (?\◊ "LZ") + (?\○ "0m") + (?\◎ "0o") + (?\● "0M") + (?\◐ "0L") + (?\◑ "0R") + (?\◘ "Sn") + (?\◙ "Ic") + (?\◢ "Fd") + (?\◣ "Bd") + (?\◯ "Ci") + (?\★ "*2") + (?\☆ "*1") + (?\☎ "TEL") + (?\☏ "tel") + (?\☜ "<--") + (?\☞ "-->") + (?\☡ "CAUTION ") + (?\☧ "XP") + (?\☹ ":-(") + (?\☺ ":-)") + (?\☻ "(-:") + (?\☼ "SU") + (?\♀ "f.") + (?\♂ "m.") + (?\♠ "cS") + (?\♡ "cH") + (?\♢ "cD") + (?\♣ "cC") + (?\♤ "cS-") + (?\♥ "cH-") + (?\♦ "cD-") + (?\♧ "cC-") + (?\♩ "Md") + (?\♪ "M8") + (?\♫ "M2") + (?\♬ "M16") + (?\♭ "b") + (?\♮ "Mx") + (?\♯ "#") + (?\✓ "X") + (?\✗ "X") + (?\✠ "-X") + (?\ " ") + (?\、 ",_") + (?\。 "._") + (?\〃 "+\"") + (?\〄 "JIS") + (?\々 "*_") + (?\〆 ";_") + (?\〇 "0_") + (?\《 "<+") + (?\》 ">+") + (?\「 "<'") + (?\」 ">'") + (?\『 "<\"") + (?\』 ">\"") + (?\【 "(\"") + (?\】 ")\"") + (?\〒 "=T") + (?\〓 "=_") + (?\〔 "('") + (?\〕 ")'") + (?\〖 "(I") + (?\〗 ")I") + (?\〚 "[[") + (?\〛 "]]") + (?\〜 "-?") + (?\〠 "=T:)") + (?\〿 " ") + (?\ぁ "A5") + (?\あ "a5") + (?\ぃ "I5") + (?\い "i5") + (?\ぅ "U5") + (?\う "u5") + (?\ぇ "E5") + (?\え "e5") + (?\ぉ "O5") + (?\お "o5") + (?\か "ka") + (?\が "ga") + (?\き "ki") + (?\ぎ "gi") + (?\く "ku") + (?\ぐ "gu") + (?\け "ke") + (?\げ "ge") + (?\こ "ko") + (?\ご "go") + (?\さ "sa") + (?\ざ "za") + (?\し "si") + (?\じ "zi") + (?\す "su") + (?\ず "zu") + (?\せ "se") + (?\ぜ "ze") + (?\そ "so") + (?\ぞ "zo") + (?\た "ta") + (?\だ "da") + (?\ち "ti") + (?\ぢ "di") + (?\っ "tU") + (?\つ "tu") + (?\づ "du") + (?\て "te") + (?\で "de") + (?\と "to") + (?\ど "do") + (?\な "na") + (?\に "ni") + (?\ぬ "nu") + (?\ね "ne") + (?\の "no") + (?\は "ha") + (?\ば "ba") + (?\ぱ "pa") + (?\ひ "hi") + (?\び "bi") + (?\ぴ "pi") + (?\ふ "hu") + (?\ぶ "bu") + (?\ぷ "pu") + (?\へ "he") + (?\べ "be") + (?\ぺ "pe") + (?\ほ "ho") + (?\ぼ "bo") + (?\ぽ "po") + (?\ま "ma") + (?\み "mi") + (?\む "mu") + (?\め "me") + (?\も "mo") + (?\ゃ "yA") + (?\や "ya") + (?\ゅ "yU") + (?\ゆ "yu") + (?\ょ "yO") + (?\よ "yo") + (?\ら "ra") + (?\り "ri") + (?\る "ru") + (?\れ "re") + (?\ろ "ro") + (?\ゎ "wA") + (?\わ "wa") + (?\ゐ "wi") + (?\ゑ "we") + (?\を "wo") + (?\ん "n5") + (?\ゔ "vu") + (?\゛ "\"5") + (?\゜ "05") + (?\ゝ "*5") + (?\ゞ "+5") + (?\ァ "a6") + (?\ア "A6") + (?\ィ "i6") + (?\イ "I6") + (?\ゥ "u6") + (?\ウ "U6") + (?\ェ "e6") + (?\エ "E6") + (?\ォ "o6") + (?\オ "O6") + (?\カ "Ka") + (?\ガ "Ga") + (?\キ "Ki") + (?\ギ "Gi") + (?\ク "Ku") + (?\グ "Gu") + (?\ケ "Ke") + (?\ゲ "Ge") + (?\コ "Ko") + (?\ゴ "Go") + (?\サ "Sa") + (?\ザ "Za") + (?\シ "Si") + (?\ジ "Zi") + (?\ス "Su") + (?\ズ "Zu") + (?\セ "Se") + (?\ゼ "Ze") + (?\ソ "So") + (?\ゾ "Zo") + (?\タ "Ta") + (?\ダ "Da") + (?\チ "Ti") + (?\ヂ "Di") + (?\ッ "TU") + (?\ツ "Tu") + (?\ヅ "Du") + (?\テ "Te") + (?\デ "De") + (?\ト "To") + (?\ド "Do") + (?\ナ "Na") + (?\ニ "Ni") + (?\ヌ "Nu") + (?\ネ "Ne") + (?\ノ "No") + (?\ハ "Ha") + (?\バ "Ba") + (?\パ "Pa") + (?\ヒ "Hi") + (?\ビ "Bi") + (?\ピ "Pi") + (?\フ "Hu") + (?\ブ "Bu") + (?\プ "Pu") + (?\ヘ "He") + (?\ベ "Be") + (?\ペ "Pe") + (?\ホ "Ho") + (?\ボ "Bo") + (?\ポ "Po") + (?\マ "Ma") + (?\ミ "Mi") + (?\ム "Mu") + (?\メ "Me") + (?\モ "Mo") + (?\ャ "YA") + (?\ヤ "Ya") + (?\ュ "YU") + (?\ユ "Yu") + (?\ョ "YO") + (?\ヨ "Yo") + (?\ラ "Ra") + (?\リ "Ri") + (?\ル "Ru") + (?\レ "Re") + (?\ロ "Ro") + (?\ヮ "WA") + (?\ワ "Wa") + (?\ヰ "Wi") + (?\ヱ "We") + (?\ヲ "Wo") + (?\ン "N6") + (?\ヴ "Vu") + (?\ヵ "KA") + (?\ヶ "KE") + (?\ヷ "Va") + (?\ヸ "Vi") + (?\ヹ "Ve") + (?\ヺ "Vo") + (?\・ ".6") + (?\ー "-6") + (?\ヽ "*6") + (?\ヾ "+6") + (?\ㄅ "b4") + (?\ㄆ "p4") + (?\ㄇ "m4") + (?\ㄈ "f4") + (?\ㄉ "d4") + (?\ㄊ "t4") + (?\ㄋ "n4") + (?\ㄌ "l4") + (?\ㄍ "g4") + (?\ㄎ "k4") + (?\ㄏ "h4") + (?\ㄐ "j4") + (?\ㄑ "q4") + (?\ㄒ "x4") + (?\ㄓ "zh") + (?\ㄔ "ch") + (?\ㄕ "sh") + (?\ㄖ "r4") + (?\ㄗ "z4") + (?\ㄘ "c4") + (?\ㄙ "s4") + (?\ㄚ "a4") + (?\ㄛ "o4") + (?\ㄜ "e4") + (?\ㄝ "eh4") + (?\ㄞ "ai") + (?\ㄟ "ei") + (?\ㄠ "au") + (?\ㄡ "ou") + (?\ㄢ "an") + (?\ㄣ "en") + (?\ㄤ "aN") + (?\ㄥ "eN") + (?\ㄦ "er") + (?\ㄧ "i4") + (?\ㄨ "u4") + (?\ㄩ "iu") + (?\ㄪ "v4") + (?\ㄫ "nG") + (?\ㄬ "gn") + (?\㈜ "(JU)") + (?\㈠ "1c") + (?\㈡ "2c") + (?\㈢ "3c") + (?\㈣ "4c") + (?\㈤ "5c") + (?\㈥ "6c") + (?\㈦ "7c") + (?\㈧ "8c") + (?\㈨ "9c") + (?\㈩ "10c") + (?\㉿ "KSC") + (?\㏂ "am") + (?\㏘ "pm") + (?\ff "ff") + (?\fi "fi") + (?\fl "fl") + (?\ffi "ffi") + (?\ffl "ffl") + (?\ſt "St") + (?\st "st") + (?\ﹽ "3+;") + (?\ﺂ "aM.") + (?\ﺄ "aH.") + (?\ﺈ "ah.") + (?\ﺍ "a+-") + (?\ﺎ "a+.") + (?\ﺏ "b+-") + (?\ﺐ "b+.") + (?\ﺑ "b+,") + (?\ﺒ "b+;") + (?\ﺓ "tm-") + (?\ﺔ "tm.") + (?\ﺕ "t+-") + (?\ﺖ "t+.") + (?\ﺗ "t+,") + (?\ﺘ "t+;") + (?\ﺙ "tk-") + (?\ﺚ "tk.") + (?\ﺛ "tk,") + (?\ﺜ "tk;") + (?\ﺝ "g+-") + (?\ﺞ "g+.") + (?\ﺟ "g+,") + (?\ﺠ "g+;") + (?\ﺡ "hk-") + (?\ﺢ "hk.") + (?\ﺣ "hk,") + (?\ﺤ "hk;") + (?\ﺥ "x+-") + (?\ﺦ "x+.") + (?\ﺧ "x+,") + (?\ﺨ "x+;") + (?\ﺩ "d+-") + (?\ﺪ "d+.") + (?\ﺫ "dk-") + (?\ﺬ "dk.") + (?\ﺭ "r+-") + (?\ﺮ "r+.") + (?\ﺯ "z+-") + (?\ﺰ "z+.") + (?\ﺱ "s+-") + (?\ﺲ "s+.") + (?\ﺳ "s+,") + (?\ﺴ "s+;") + (?\ﺵ "sn-") + (?\ﺶ "sn.") + (?\ﺷ "sn,") + (?\ﺸ "sn;") + (?\ﺹ "c+-") + (?\ﺺ "c+.") + (?\ﺻ "c+,") + (?\ﺼ "c+;") + (?\ﺽ "dd-") + (?\ﺾ "dd.") + (?\ﺿ "dd,") + (?\ﻀ "dd;") + (?\ﻁ "tj-") + (?\ﻂ "tj.") + (?\ﻃ "tj,") + (?\ﻄ "tj;") + (?\ﻅ "zH-") + (?\ﻆ "zH.") + (?\ﻇ "zH,") + (?\ﻈ "zH;") + (?\ﻉ "e+-") + (?\ﻊ "e+.") + (?\ﻋ "e+,") + (?\ﻌ "e+;") + (?\ﻍ "i+-") + (?\ﻎ "i+.") + (?\ﻏ "i+,") + (?\ﻐ "i+;") + (?\ﻑ "f+-") + (?\ﻒ "f+.") + (?\ﻓ "f+,") + (?\ﻔ "f+;") + (?\ﻕ "q+-") + (?\ﻖ "q+.") + (?\ﻗ "q+,") + (?\ﻘ "q+;") + (?\ﻙ "k+-") + (?\ﻚ "k+.") + (?\ﻛ "k+,") + (?\ﻜ "k+;") + (?\ﻝ "l+-") + (?\ﻞ "l+.") + (?\ﻟ "l+,") + (?\ﻠ "l+;") + (?\ﻡ "m+-") + (?\ﻢ "m+.") + (?\ﻣ "m+,") + (?\ﻤ "m+;") + (?\ﻥ "n+-") + (?\ﻦ "n+.") + (?\ﻧ "n+,") + (?\ﻨ "n+;") + (?\ﻩ "h+-") + (?\ﻪ "h+.") + (?\ﻫ "h+,") + (?\ﻬ "h+;") + (?\ﻭ "w+-") + (?\ﻮ "w+.") + (?\ﻯ "j+-") + (?\ﻰ "j+.") + (?\ﻱ "y+-") + (?\ﻲ "y+.") + (?\ﻳ "y+,") + (?\ﻴ "y+;") + (?\ﻵ "lM-") + (?\ﻶ "lM.") + (?\ﻷ "lH-") + (?\ﻸ "lH.") + (?\ﻹ "lh-") + (?\ﻺ "lh.") + (?\ﻻ "la-") + (?\ﻼ "la.") + (?\！ "!") + (?\＂ "\"") + (?\＃ "#") + (?\＄ "$") + (?\％ "%") + (?\＆ "&") + (?\＇ "'") + (?\（ "(") + (?\） ")") + (?\＊ "*") + (?\＋ "+") + (?\， ",") + (?\－ "-") + (?\． ".") + (?\／ "/") + (?\０ "0") + (?\１ "1") + (?\２ "2") + (?\３ "3") + (?\４ "4") + (?\５ "5") + (?\６ "6") + (?\７ "7") + (?\８ "8") + (?\９ "9") + (?\： ":") + (?\； ";") + (?\＜ "<") + (?\＝ "=") + (?\＞ ">") + (?\？ "?") + (?\＠ "@") + (?\Ａ "A") + (?\Ｂ "B") + (?\Ｃ "C") + (?\Ｄ "D") + (?\Ｅ "E") + (?\Ｆ "F") + (?\Ｇ "G") + (?\Ｈ "H") + (?\Ｉ "I") + (?\Ｊ "J") + (?\Ｋ "K") + (?\Ｌ "L") + (?\Ｍ "M") + (?\Ｎ "N") + (?\Ｏ "O") + (?\Ｐ "P") + (?\Ｑ "Q") + (?\Ｒ "R") + (?\Ｓ "S") + (?\Ｔ "T") + (?\Ｕ "U") + (?\Ｖ "V") + (?\Ｗ "W") + (?\Ｘ "X") + (?\Ｙ "Y") + (?\Ｚ "Z") + (?\［ "[") + (?\＼ "\\") + (?\］ "]") + (?\＾ "^") + (?\＿ "_") + (?\｀ "`") + (?\ａ "a") + (?\ｂ "b") + (?\ｃ "c") + (?\ｄ "d") + (?\ｅ "e") + (?\ｆ "f") + (?\ｇ "g") + (?\ｈ "h") + (?\ｉ "i") + (?\ｊ "j") + (?\ｋ "k") + (?\ｌ "l") + (?\ｍ "m") + (?\ｎ "n") + (?\ｏ "o") + (?\ｐ "p") + (?\ｑ "q") + (?\ｒ "r") + (?\ｓ "s") + (?\ｔ "t") + (?\ｕ "u") + (?\ｖ "v") + (?\ｗ "w") + (?\ｘ "x") + (?\ｙ "y") + (?\ｚ "z") + (?\｛ "{") + (?\｜ "|") + (?\｝ "}") + (?\～ "~") + (?\｡ ".") + (?\｢ "\"") + (?\｣ "\"") + (?\､ ",") + ;; Not from Lynx + (? "") + (?� "?")))) (aset standard-display-table (make-char 'mule-unicode-0100-24ff) nil) (aset standard-display-table diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 0758359e154..1596cdb4817 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -298,13 +298,21 @@ attribute." (defvar hack-read-symbol-shorthands-function nil "Holds function to compute `read-symbol-shorthands'.") -(defun load-with-code-conversion (fullname file &optional noerror nomessage) +(defun load-with-code-conversion (fullname file &optional noerror nomessage + eval-function) "Execute a file of Lisp code named FILE whose absolute name is FULLNAME. The file contents are decoded before evaluation if necessary. -If optional third arg NOERROR is non-nil, - report no error if FILE doesn't exist. -Print messages at start and end of loading unless - optional fourth arg NOMESSAGE is non-nil. + +If optional third arg NOERROR is non-nil, report no error if FILE +doesn't exist. + +Print messages at start and end of loading unless optional fourth +arg NOMESSAGE is non-nil. + +If EVAL-FUNCTION, call that instead of calling `eval-buffer' +directly. It is called with two paramameters: The buffer object +and the file name. + Return t if file exists." (if (null (file-readable-p fullname)) (and (null noerror) @@ -353,10 +361,13 @@ Return t if file exists." ;; Have the original buffer current while we eval, ;; but consider shorthands of the eval'ed one. (let ((read-symbol-shorthands shorthands)) - (eval-buffer buffer nil - ;; This is compatible with what `load' does. - (if dump-mode file fullname) - nil t))) + (if eval-function + (funcall eval-function buffer + (if dump-mode file fullname)) + (eval-buffer buffer nil + ;; This is compatible with what `load' does. + (if dump-mode file fullname) + nil t)))) (let (kill-buffer-hook kill-buffer-query-functions) (kill-buffer buffer))) (do-after-load-evaluation fullname) diff --git a/lisp/isearch.el b/lisp/isearch.el index 833d031c562..8970216398b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -430,13 +430,13 @@ and doesn't remove full-buffer highlighting after a search." (defface lazy-highlight '((((class color) (min-colors 88) (background light)) - (:background "paleturquoise")) + (:background "paleturquoise" :distant-foreground "black")) (((class color) (min-colors 88) (background dark)) - (:background "paleturquoise4")) + (:background "paleturquoise4" :distant-foreground "white")) (((class color) (min-colors 16)) - (:background "turquoise3")) + (:background "turquoise3" :distant-foreground "white")) (((class color) (min-colors 8)) - (:background "turquoise3")) + (:background "turquoise3" :distant-foreground "white")) (t (:underline t))) "Face for lazy highlighting of matches other than the current one." :group 'lazy-highlight @@ -2934,6 +2934,7 @@ to the barrier." (put 'scroll-other-window-down 'isearch-scroll t) (put 'beginning-of-buffer-other-window 'isearch-scroll t) (put 'end-of-buffer-other-window 'isearch-scroll t) +(put 'recenter-other-window 'isearch-scroll t) ;; Commands which change the window layout (put 'delete-other-windows 'isearch-scroll t) @@ -2948,6 +2949,9 @@ to the barrier." (put 'mouse-drag-mode-line 'isearch-scroll t) (put 'mouse-drag-vertical-line 'isearch-scroll t) +;; For context menu with isearch submenu +(put 'context-menu-open 'isearch-scroll t) + ;; Aliases for split-window-* (put 'split-window-vertically 'isearch-scroll t) (put 'split-window-horizontally 'isearch-scroll t) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index 614d0767e72..e0adb0de6c3 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -354,14 +354,14 @@ South Indian language Malayalam is supported in this language environment.")) ("X" . "[\u0D00-\u0D7F]")))) ; all coverage (indian-compose-regexp (concat + ;; any sequence of 2 or more Malayalam characters, or + "XX+\\|" ;; consonant-based syllables, or "C\\(?:J?HJ?C\\)*\\(?:H[NJ]?\\|v?A?\\)\\|" ;; syllables with an independent vowel, or "V\\(?:J?HY\\)?v*?A?\\|" - ;; special consonant form, or - "JHY\\|" - ;; any other singleton characters - "X") + ;; special consonant form + "JHY") table)) "Regexp matching a composable sequence of Malayalam characters.") diff --git a/lisp/language/thai.el b/lisp/language/thai.el index 6a6289a44c7..60f5f9d2a38 100644 --- a/lisp/language/thai.el +++ b/lisp/language/thai.el @@ -82,6 +82,43 @@ This is the same as `thai-tis620' with the addition of no-break-space." (aset composition-function-table (aref chars i) elt))) (aset composition-function-table ?ำ '(["[ก-ฯ]." 1 thai-composition-function])) +;; Tai-Tham + +(set-language-info-alist + "Northern Thai" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (sample-text . + "Northern Thai (ᨣᩣᩴᨾᩮᩬᩥᨦ / ᨽᩣᩈᩣᩃ᩶ᩣ᩠ᨶᨶᩣ) ᩈ᩠ᩅᩢᩔ᩠ᨯᩦᨣᩕᩢ᩠ᨸ") + (documentation . t))) + +;; From Richard Wordingham <richard.wordingham@ntlworld.com>: +(defvar tai-tham-composable-pattern + (let ((table + ;; C is letters, independent vowels, digits, punctuation and symbols. + '(("C" . "[\u1A20-\u1A54\u1A80-\u1A89\u1A90-\u1A99\u1AA0-\u1AAD]") + ("M" . ; Marks, CGJ, ZWNJ, ZWJ + "[\u0324\u034F\u0E49\u0E4A\u0E4B\u1A55-\u1A57\u1A59-\u1A5E\u1A61-\u1A7C\u1A7F\u200C\200D]") + ("H" . "\u1A60") ; Sakot + ("S" . ; Marks commuting with sakot + "[\u0E49-\u0E4B\u0EC9\u0ECB\u1A75-\u1A7C]") + ("N" . "\u1A58"))) ; mai kang lai + (basic-syllable "C\\(N*\\(M\\|HS*C\\)\\)*") + (regexp "X\\(N\\(X\\)?\\)*H?")) ; where X is basic syllable + (let ((case-fold-search nil)) + (setq regexp (replace-regexp-in-string "X" basic-syllable regexp t t)) + (dolist (elt table) + (setq regexp (replace-regexp-in-string (car elt) (cdr elt) + regexp t t)))) + regexp)) + +(let ((elt (list (vector tai-tham-composable-pattern 0 'font-shape-gstring) + ))) + (set-char-table-range composition-function-table '(#x1A20 . #x1A54) elt) + (set-char-table-range composition-function-table '(#x1A80 . #x1A89) elt) + (set-char-table-range composition-function-table '(#x1A90 . #x1A99) elt) + (set-char-table-range composition-function-table '(#x1AA0 . #x1AAD) elt)) + (provide 'thai) ;;; thai.el ends here diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 6ddce2eba32..9f5169605b5 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -8580,8 +8580,8 @@ Locate SOA record and increment the serial field." t nil) (autoload 'doc-view-mode-p "doc-view" "\ Return non-nil if document type TYPE is available for `doc-view'. -Document types are symbols like `dvi', `ps', `pdf', or `odf' (any -OpenDocument format). +Document types are symbols like `dvi', `ps', `pdf', `epub', +`cbz', `fb2', `xps', `oxps', or`odf' (any OpenDocument format). \(fn TYPE)" nil nil) @@ -10409,6 +10409,14 @@ displayed." t nil) ;;;*** +;;;### (autoloads nil "em-extpipe" "eshell/em-extpipe.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from eshell/em-extpipe.el + +(register-definition-prefixes "em-extpipe" '("eshell-")) + +;;;*** + ;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lock.el @@ -13923,11 +13931,11 @@ and choose the directory as the fortune-file. ;;;### (autoloads nil "frameset" "frameset.el" (0 0 0 0)) ;;; Generated autoloads from frameset.el -(defvar frameset-session-filter-alist '((name . :never) (left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) "\ +(defvar frameset-session-filter-alist (append '((left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) (mapcar (lambda (p) (cons p :never)) frame-internal-parameters)) "\ Minimum set of parameters to filter for live (on-session) framesets. DO NOT MODIFY. See `frameset-filter-alist' for a full description.") -(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\ +(defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (font-backend . :never) (foreground-color . frameset-filter-sanitize-color) (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (parent-frame . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-system . :never)) frameset-session-filter-alist) "\ Parameters to filter for persistent framesets. DO NOT MODIFY. See `frameset-filter-alist' for a full description.") @@ -40107,23 +40115,24 @@ Zone out, completely." t nil) ;;;### (autoloads nil nil ("abbrev.el" "bindings.el" "buff-menu.el" ;;;;;; "button.el" "calc/calc-aent.el" "calc/calc-embed.el" "calc/calc-misc.el" -;;;;;; "calc/calc-yank.el" "case-table.el" "cedet/ede/cpp-root.el" -;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el" -;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el" -;;;;;; "cedet/ede/locate.el" "cedet/ede/make.el" "cedet/ede/speedbar.el" -;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/semantic/analyze.el" -;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/refs.el" -;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c-by.el" -;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/el.el" -;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make-by.el" -;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.el" -;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/complete.el" -;;;;;; "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" -;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-mode.el" -;;;;;; "cedet/semantic/db-typecache.el" "cedet/semantic/db.el" "cedet/semantic/debug.el" -;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el" -;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/edit.el" -;;;;;; "cedet/semantic/find.el" "cedet/semantic/format.el" "cedet/semantic/grammar-wy.el" +;;;;;; "calc/calc-yank.el" "case-table.el" "cedet/ede/base.el" "cedet/ede/config.el" +;;;;;; "cedet/ede/cpp-root.el" "cedet/ede/custom.el" "cedet/ede/dired.el" +;;;;;; "cedet/ede/emacs.el" "cedet/ede/files.el" "cedet/ede/generic.el" +;;;;;; "cedet/ede/linux.el" "cedet/ede/locate.el" "cedet/ede/make.el" +;;;;;; "cedet/ede/shell.el" "cedet/ede/speedbar.el" "cedet/ede/system.el" +;;;;;; "cedet/ede/util.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" +;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" +;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el" +;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el" +;;;;;; "cedet/semantic/bovine/make-by.el" "cedet/semantic/bovine/make.el" +;;;;;; "cedet/semantic/bovine/scm-by.el" "cedet/semantic/bovine/scm.el" +;;;;;; "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" "cedet/semantic/db-file.el" +;;;;;; "cedet/semantic/db-find.el" "cedet/semantic/db-global.el" +;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-typecache.el" +;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate/include.el" +;;;;;; "cedet/semantic/decorate/mode.el" "cedet/semantic/dep.el" +;;;;;; "cedet/semantic/doc.el" "cedet/semantic/edit.el" "cedet/semantic/find.el" +;;;;;; "cedet/semantic/format.el" "cedet/semantic/grammar-wy.el" ;;;;;; "cedet/semantic/grm-wy-boot.el" "cedet/semantic/html.el" ;;;;;; "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" "cedet/semantic/idle.el" ;;;;;; "cedet/semantic/imenu.el" "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" @@ -40142,8 +40151,8 @@ Zone out, completely." t nil) ;;;;;; "cedet/srecode/insert.el" "cedet/srecode/java.el" "cedet/srecode/map.el" ;;;;;; "cedet/srecode/mode.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el" ;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "composite.el" -;;;;;; "cus-face.el" "cus-load.el" "cus-start.el" "custom.el" "dired-aux.el" -;;;;;; "dired-x.el" "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el" +;;;;;; "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" "dired-x.el" +;;;;;; "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el" ;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el" ;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/easymenu.el" "emacs-lisp/eieio-custom.el" ;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/float-sup.el" "emacs-lisp/lisp-mode.el" @@ -40165,47 +40174,35 @@ Zone out, completely." t nil) ;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" ;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" ;;;;;; "eshell/em-tramp.el" "eshell/em-unix.el" "eshell/em-xtra.el" -;;;;;; "eshell/esh-groups.el" "faces.el" "files.el" "finder-inf.el" -;;;;;; "font-core.el" "font-lock.el" "format.el" "frame.el" "help.el" -;;;;;; "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" -;;;;;; "international/charprop.el" "international/charscript.el" -;;;;;; "international/cp51932.el" "international/emoji-labels.el" -;;;;;; "international/emoji-zwj.el" "international/eucjp-ms.el" -;;;;;; "international/idna-mapping.el" "international/iso-transl.el" -;;;;;; "international/mule-cmds.el" "international/mule-conf.el" -;;;;;; "international/mule.el" "international/uni-bidi.el" "international/uni-brackets.el" -;;;;;; "international/uni-category.el" "international/uni-combining.el" -;;;;;; "international/uni-comment.el" "international/uni-confusable.el" -;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" -;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" -;;;;;; "international/uni-mirrored.el" "international/uni-name.el" -;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" -;;;;;; "international/uni-scripts.el" "international/uni-special-lowercase.el" -;;;;;; "international/uni-special-titlecase.el" "international/uni-special-uppercase.el" -;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el" -;;;;;; "isearch.el" "jit-lock.el" "jka-cmpr-hook.el" "keymap.el" -;;;;;; "language/burmese.el" "language/cham.el" "language/chinese.el" -;;;;;; "language/cyrillic.el" "language/czech.el" "language/english.el" -;;;;;; "language/ethiopic.el" "language/european.el" "language/georgian.el" -;;;;;; "language/greek.el" "language/hebrew.el" "language/indian.el" -;;;;;; "language/japanese.el" "language/khmer.el" "language/korean.el" -;;;;;; "language/lao.el" "language/misc-lang.el" "language/romanian.el" -;;;;;; "language/sinhala.el" "language/slovak.el" "language/tai-viet.el" -;;;;;; "language/thai.el" "language/tibetan.el" "language/utf-8-lang.el" -;;;;;; "language/vietnamese.el" "ldefs-boot.el" "leim/ja-dic/ja-dic.el" -;;;;;; "leim/leim-list.el" "leim/quail/4Corner.el" "leim/quail/ARRAY30.el" -;;;;;; "leim/quail/CCDOSPY.el" "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el" -;;;;;; "leim/quail/ECDICT.el" "leim/quail/ETZY.el" "leim/quail/PY-b5.el" -;;;;;; "leim/quail/PY.el" "leim/quail/Punct-b5.el" "leim/quail/Punct.el" -;;;;;; "leim/quail/QJ-b5.el" "leim/quail/QJ.el" "leim/quail/SW.el" -;;;;;; "leim/quail/TONEPY.el" "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" -;;;;;; "leim/quail/arabic.el" "leim/quail/cham.el" "leim/quail/compose.el" -;;;;;; "leim/quail/croatian.el" "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" -;;;;;; "leim/quail/czech.el" "leim/quail/emoji.el" "leim/quail/georgian.el" -;;;;;; "leim/quail/greek.el" "leim/quail/hanja-jis.el" "leim/quail/hanja.el" -;;;;;; "leim/quail/hanja3.el" "leim/quail/hebrew.el" "leim/quail/ipa-praat.el" -;;;;;; "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" "leim/quail/latin-post.el" -;;;;;; "leim/quail/latin-pre.el" "leim/quail/persian.el" "leim/quail/programmer-dvorak.el" +;;;;;; "faces.el" "files.el" "font-core.el" "font-lock.el" "format.el" +;;;;;; "frame.el" "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" +;;;;;; "international/characters.el" "international/charscript.el" +;;;;;; "international/cp51932.el" "international/emoji-zwj.el" "international/eucjp-ms.el" +;;;;;; "international/iso-transl.el" "international/mule-cmds.el" +;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el" +;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "keymap.el" "language/burmese.el" +;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el" +;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el" +;;;;;; "language/european.el" "language/georgian.el" "language/greek.el" +;;;;;; "language/hebrew.el" "language/indian.el" "language/japanese.el" +;;;;;; "language/khmer.el" "language/korean.el" "language/lao.el" +;;;;;; "language/misc-lang.el" "language/romanian.el" "language/sinhala.el" +;;;;;; "language/slovak.el" "language/tai-viet.el" "language/thai.el" +;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el" +;;;;;; "ldefs-boot.el" "leim/ja-dic/ja-dic.el" "leim/leim-list.el" +;;;;;; "leim/quail/4Corner.el" "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el" +;;;;;; "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el" "leim/quail/ECDICT.el" +;;;;;; "leim/quail/ETZY.el" "leim/quail/PY-b5.el" "leim/quail/PY.el" +;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el" +;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el" +;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el" +;;;;;; "leim/quail/cham.el" "leim/quail/compose.el" "leim/quail/croatian.el" +;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el" +;;;;;; "leim/quail/emoji.el" "leim/quail/georgian.el" "leim/quail/greek.el" +;;;;;; "leim/quail/hanja-jis.el" "leim/quail/hanja.el" "leim/quail/hanja3.el" +;;;;;; "leim/quail/hebrew.el" "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" +;;;;;; "leim/quail/latin-ltx.el" "leim/quail/latin-post.el" "leim/quail/latin-pre.el" +;;;;;; "leim/quail/persian.el" "leim/quail/programmer-dvorak.el" ;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" ;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sami.el" ;;;;;; "leim/quail/sgml-input.el" "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 48058f40535..39481ab0684 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -157,38 +157,35 @@ documentation of `unload-feature' for details.") ;; mode, or proposed is not nil and not major-mode, and so we use it. (funcall (or proposed 'fundamental-mode))))))) +(defvar loadhist-unload-filename nil) + (cl-defgeneric loadhist-unload-element (x) - "Unload an element from the `load-history'." + "Unload an element from the `load-history'. +The variable `loadhist-unload-filename' holds the name of the file we're +unloading." (message "Unexpected element %S in load-history" x)) -;; In `load-history', the definition of a previously autoloaded -;; function is represented by 2 entries: (t . SYMBOL) comes before -;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when -;; we undefine it. -;; So we use this auxiliary variable to keep track of the last (t . SYMBOL) -;; that occurred. -(defvar loadhist--restore-autoload nil - "If non-nil, is a symbol for which to try to restore a previous autoload.") - -(cl-defmethod loadhist-unload-element ((x (head t))) - (setq loadhist--restore-autoload (cdr x))) - -(defun loadhist--unload-function (x) - (let ((fun (cdr x))) - (when (fboundp fun) - (when (fboundp 'ad-unadvise) - (ad-unadvise fun)) - (let ((aload (get fun 'autoload))) - (defalias fun - (if (and aload (eq fun loadhist--restore-autoload)) - (cons 'autoload aload) - nil))))) - (setq loadhist--restore-autoload nil)) - (cl-defmethod loadhist-unload-element ((x (head defun))) - (loadhist--unload-function x)) -(cl-defmethod loadhist-unload-element ((x (head autoload))) - (loadhist--unload-function x)) + (let* ((fun (cdr x)) + (hist (get fun 'function-history))) + (cond + ((null hist) + (defalias fun nil) + ;; Override the change that `defalias' just recorded. + (put fun 'function-history nil)) + ((equal (car hist) loadhist-unload-filename) + (defalias fun (cadr hist)) + ;; Set the history afterwards, to override the change that + ;; `defalias' records otherwise. + (put fun 'function-history (cddr hist))) + (t + ;; Unloading a file whose definition is "inactive" (i.e. has been + ;; overridden by another file): just remove it from the history, + ;; so future unloading of that other file has a chance to DTRT. + (let* ((tmp (plist-member hist loadhist-unload-filename)) + (pos (- (length hist) (length tmp)))) + (cl-assert (> pos 1)) + (setcdr (nthcdr (- pos 2) hist) (cdr tmp))))))) (cl-defmethod loadhist-unload-element ((_ (head require))) nil) (cl-defmethod loadhist-unload-element ((_ (head defface))) nil) @@ -257,6 +254,7 @@ something strange, such as redefining an Emacs function." (prin1-to-string dependents) file)))) (let* ((unload-function-defs-list (feature-symbols feature)) (file (pop unload-function-defs-list)) + (loadhist-unload-filename file) (name (symbol-name feature)) (unload-hook (intern-soft (concat name "-unload-hook"))) (unload-func (intern-soft (concat name "-unload-function")))) diff --git a/lisp/loadup.el b/lisp/loadup.el index 1be73a2090d..81172c584d7 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -128,6 +128,7 @@ (set-buffer "*scratch*") (setq buffer-undo-list t) +(load "emacs-lisp/debug-early") (load "emacs-lisp/byte-run") (load "emacs-lisp/backquote") (load "subr") diff --git a/lisp/locate.el b/lisp/locate.el index 95b66f275a1..20ef052184e 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -238,6 +238,8 @@ that is, with a prefix arg, you get the default behavior." ;; Functions (defun locate-default-make-command-line (search-string) + (unless (executable-find locate-command) + (error "Can't find the %s command" locate-command)) (list locate-command search-string)) (defun locate-word-at-point () @@ -461,13 +463,11 @@ Specific `locate-mode' commands, such as \\[locate-find-directory], do not work in subdirectories. \\{locate-mode-map}" - ;; Avoid clobbering this variable - (make-local-variable 'dired-subdir-alist) (setq default-directory "/" buffer-read-only t) (add-to-invisibility-spec '(dired . t)) (dired-alist-add-1 default-directory (point-min-marker)) - (setq-local dired-directory "/") + (setq dired-directory "/") (setq-local dired-subdir-switches locate-ls-subdir-switches) (setq dired-switches-alist nil) ;; This should support both Unix and Windoze style names diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index e7118a2a376..7a4be3c7e4c 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -784,7 +784,7 @@ SWITCHES and TIME-INDEX give the full switch list and time data." ;; In GNU ls, -h affects the size in blocks, displayed ;; by -s, as well. (if (memq ?h switches) - (format "%6s " + (format "%7s " (file-size-human-readable ;; We use 1K as "block size", although ;; most Windows volumes use 4KB to 8KB @@ -881,7 +881,7 @@ All ls time options, namely c, t and u, are handled." ls-lisp-filesize-f-fmt ls-lisp-filesize-d-fmt) file-size) - (format " %6s" (file-size-human-readable file-size)))) + (format " %7s" (file-size-human-readable file-size)))) (defun ls-lisp-unload-function () "Unload ls-lisp library." diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index f5559e39f68..1bda609d105 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -304,6 +304,9 @@ usually do not have translators for other languages.\n\n"))) (emacs-bug--system-description) (insert "Configured features:\n" system-configuration-features "\n\n") (fill-region (line-beginning-position -1) (point)) + (when (and (featurep 'native-compile) + (null (native-comp-available-p))) + (insert "(NATIVE_COMP present but libgccjit not available)\n\n")) (insert "Important settings:\n") (mapc (lambda (var) diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 4a079591890..85aa27235fc 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -25,16 +25,6 @@ ;; library is based on draft-ietf-drums-msg-fmt-05.txt, released on ;; 1998-08-05. -;; Pending a real regression self test suite, Simon Josefsson added -;; various self test expressions snipped from bug reports, and their -;; expected value, below. I you believe it could be useful, please -;; add your own test cases, or write a real self test suite, or just -;; remove this. - -;; <m3oekvfd50.fsf@whitebox.m5r.de> -;; (ietf-drums-parse-address "'foo' <foo@example.com>") -;; => ("foo@example.com" . "'foo'") - ;;; Code: (eval-when-compile (require 'cl-lib)) @@ -75,6 +65,21 @@ backslash and doublequote.") (modify-syntax-entry ?\' "_" table) table)) +(defvar ietf-drums-comment-syntax-table + (let ((table (copy-syntax-table ietf-drums-syntax-table))) + (modify-syntax-entry ?\" "w" table) + table) + "In comments, DQUOTE is normal and does not start a string.") + +(defun ietf-drums--skip-comment () + ;; From just before the start of a comment, go to the end. Returns + ;; point. If the comment is unterminated, go to point-max. + (condition-case () + (with-syntax-table ietf-drums-comment-syntax-table + (forward-sexp 1)) + (scan-error (goto-char (point-max)))) + (point)) + (defun ietf-drums-token-to-list (token) "Translate TOKEN into a list of characters." (let ((i 0) @@ -119,14 +124,7 @@ backslash and doublequote.") (forward-sexp 1) (error (goto-char (point-max))))) ((eq c ?\() - (delete-region - (point) - (condition-case nil - (with-syntax-table (copy-syntax-table ietf-drums-syntax-table) - (modify-syntax-entry ?\" "w") - (forward-sexp 1) - (point)) - (error (point-max))))) + (delete-region (point) (ietf-drums--skip-comment))) (t (forward-char 1)))) (buffer-string)))) @@ -140,9 +138,11 @@ backslash and doublequote.") (setq c (char-after)) (cond ((eq c ?\") - (forward-sexp 1)) + (condition-case () + (forward-sexp 1) + (scan-error (goto-char (point-max))))) ((eq c ?\() - (forward-sexp 1)) + (ietf-drums--skip-comment)) ((memq c '(?\ ?\t ?\n ?\r)) (delete-char 1)) (t @@ -150,7 +150,7 @@ backslash and doublequote.") (buffer-string)))) (defun ietf-drums-get-comment (string) - "Return the first comment in STRING." + "Return the last comment in STRING." (with-temp-buffer (ietf-drums-init string) (let (result c) @@ -191,6 +191,8 @@ the Content-Transfer-Encoding header of a mail." "Parse STRING and return a MAILBOX / DISPLAY-NAME pair. If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed (that's the \"=?utf...q...=?\") stuff." + (when decode + (require 'rfc2047)) (with-temp-buffer (let (display-name mailbox c display-string) (ietf-drums-init string) @@ -240,7 +242,7 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed (cons (mapconcat #'identity (nreverse display-name) "") (ietf-drums-get-comment string))) - (cons mailbox (if decode + (cons mailbox (if (and decode display-string) (rfc2047-decode-string display-string) display-string)))))) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 76c3baf4727..c55cdc8412a 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -877,7 +877,7 @@ The variable is used to trigger insertion of the \"Mail-Followup-To\" header when sending a message to a mailing list." :type '(repeat string)) -(declare-function mml-to-mime "mml" ()) +(declare-function mm-long-lines-p "mm-bodies" (length)) (defun mail-send () "Send the message in the current buffer. @@ -955,7 +955,11 @@ the user from the mailer." (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) (forward-line 1))) (goto-char opoint) - (when mail-encode-mml + (require 'mml) + (when (or mail-encode-mml + ;; When we have long lines, we have to MIME encode + ;; to get line folding. + (mm-long-lines-p 1000)) (mml-to-mime) (setq mail-encode-mml nil)) (run-hooks 'mail-send-hook) diff --git a/lisp/man.el b/lisp/man.el index a53a696c313..951e0ef9add 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1976,6 +1976,8 @@ Uses `Man-name-local-regexp'." (bookmark-default-handler `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))) +(put 'Man-bookmark-jump 'bookmark-handler-type "Man") + ;;; Mouse support (defun Man-at-mouse (e) "Open man manual at point." diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 817c2d485e8..ab64928fe76 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -131,9 +131,9 @@ :visible (fboundp 'make-frame-on-monitor) :help "Open a new frame on another monitor")) (bindings--define-key menu [make-frame-on-display] - '(menu-item "New Frame on Display..." make-frame-on-display + '(menu-item "New Frame on Display Server..." make-frame-on-display :visible (fboundp 'make-frame-on-display) - :help "Open a new frame on another display")) + :help "Open a new frame on a display server")) (bindings--define-key menu [make-frame] '(menu-item "New Frame" make-frame-command :visible (fboundp 'make-frame-command) @@ -178,17 +178,23 @@ t)) :help "Recover edits from a crashed session")) (bindings--define-key menu [revert-buffer] - '(menu-item "Revert Buffer" revert-buffer - :enable (or (not (eq revert-buffer-function - 'revert-buffer--default)) - (not (eq - revert-buffer-insert-file-contents-function - 'revert-buffer-insert-file-contents--default-function)) - (and buffer-file-number - (or (buffer-modified-p) - (not (verify-visited-file-modtime - (current-buffer)))))) - :help "Re-read current buffer from its file")) + '(menu-item + "Revert Buffer" revert-buffer + :enable + (or (not (eq revert-buffer-function + 'revert-buffer--default)) + (not (eq + revert-buffer-insert-file-contents-function + 'revert-buffer-insert-file-contents--default-function)) + (and buffer-file-number + (or (buffer-modified-p) + (not (verify-visited-file-modtime + (current-buffer))) + ;; Enable if the buffer has a different + ;; writeability than the file. + (not (eq (not buffer-read-only) + (file-writable-p buffer-file-name)))))) + :help "Re-read current buffer from its file")) (bindings--define-key menu [write-file] '(menu-item "Save As..." write-file :enable (and (menu-bar-menu-frame-live-and-visible-p) @@ -2342,9 +2348,13 @@ It must accept a buffer as its only required argument.") (and (lookup-key (current-global-map) [menu-bar buffer]) (or force (frame-or-buffer-changed-p)) (let ((buffers (buffer-list)) - (frames (frame-list)) - buffers-menu) - + frames buffers-menu) + ;; Ignore the initial frame if present. It can happen if + ;; Emacs was started as a daemon. (bug#53740) + (dolist (frame (frame-list)) + (unless (equal (terminal-name (frame-terminal frame)) + "initial_terminal") + (push frame frames))) ;; Make the menu of buffers proper. (setq buffers-menu (let ((i 0) @@ -2537,7 +2547,7 @@ Use \\[menu-bar-mode] to make the menu bar appear.")))) (put 'menu-bar-mode 'standard-value '(t)) (defun toggle-menu-bar-mode-from-frame (&optional arg) - "Toggle display of the menu bar of the current frame. + "Toggle display of the menu bar. See `menu-bar-mode' for more information." (interactive (list (or current-prefix-arg 'toggle))) (if (eq arg 'toggle) @@ -2629,8 +2639,11 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." ;; `setup-specified-language-environment', for instance, ;; expects this to be set from a menu keymap. (setq last-command-event (car (last event))) - ;; mouse-major-mode-menu was using `command-execute' instead. - (call-interactively cmd)))) + (setq from--tty-menu-p nil) + ;; Signal use-dialog-box-p this command was invoked from a menu. + (let ((from--tty-menu-p t)) + ;; mouse-major-mode-menu was using `command-execute' instead. + (call-interactively cmd))))) (defun popup-menu-normalize-position (position) "Convert the POSITION to the form which `popup-menu' expects internally. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 917879fb692..36b8d808417 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2932,26 +2932,30 @@ same as `substitute-in-file-name'." (let* ((ustr (substitute-in-file-name qstr)) (uprefix (substring ustr 0 upos)) qprefix) - ;; Main assumption: nothing after qpos should affect the text before upos, - ;; so we can work our way backward from the end of qstr, one character - ;; at a time. - ;; Second assumptions: If qpos is far from the end this can be a bit slow, - ;; so we speed it up by doing a first loop that skips a word at a time. - ;; This word-sized loop is careful not to cut in the middle of env-vars. - (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr))) - (and boundary - (progn - (setq qprefix (substring qstr 0 boundary)) + (if (eq upos (length ustr)) + ;; Easy and common case. This not only speed things up in a very + ;; common case but it also avoids problems in some cases (bug#53053). + (cons (length qstr) #'minibuffer-maybe-quote-filename) + ;; Main assumption: nothing after qpos should affect the text before upos, + ;; so we can work our way backward from the end of qstr, one character + ;; at a time. + ;; Second assumptions: If qpos is far from the end this can be a bit slow, + ;; so we speed it up by doing a first loop that skips a word at a time. + ;; This word-sized loop is careful not to cut in the middle of env-vars. + (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr))) + (and boundary + (progn + (setq qprefix (substring qstr 0 boundary)) + (string-prefix-p uprefix + (substitute-in-file-name qprefix))))) + (setq qstr qprefix)) + (let ((qpos (length qstr))) + (while (and (> qpos 0) (string-prefix-p uprefix - (substitute-in-file-name qprefix))))) - (setq qstr qprefix)) - (let ((qpos (length qstr))) - (while (and (> qpos 0) - (string-prefix-p uprefix - (substitute-in-file-name - (substring qstr 0 (1- qpos))))) - (setq qpos (1- qpos))) - (cons qpos #'minibuffer-maybe-quote-filename)))) + (substitute-in-file-name + (substring qstr 0 (1- qpos))))) + (setq qpos (1- qpos))) + (cons qpos #'minibuffer-maybe-quote-filename))))) (defalias 'completion--file-name-table (completion-table-with-quoting #'completion-file-name-table @@ -3066,7 +3070,10 @@ Fourth arg MUSTMATCH can take the following values: - anything else behaves like t except that typing RET does not exit if it does non-null completion. -Fifth arg INITIAL specifies text to start with. +Fifth arg INITIAL specifies text to start with. It will be +interpreted as the trailing part of DEFAULT-FILENAME, so using a +full file name for INITIAL will usually lead to surprising +results. Sixth arg PREDICATE, if non-nil, should be a function of one argument; then a file name is considered an acceptable completion diff --git a/lisp/mouse.el b/lisp/mouse.el index 502683d3d1e..1e205283de2 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -321,10 +321,12 @@ At the end, it's possible to modify the final menu by specifying the function `context-menu-filter-function'." (let* ((menu (make-sparse-keymap (propertize "Context Menu" 'hide t))) (click (or click last-input-event)) + (window (posn-window (event-start click))) (fun (mouse-posn-property (event-start click) 'context-menu-function))) - (select-window (posn-window (event-start click))) + (unless (eq (selected-window) window) + (select-window window)) (if (functionp fun) (setq menu (funcall fun menu click)) @@ -2755,18 +2757,72 @@ and selects that window." (declare-function generate-fontset-menu "fontset" ()) +(defun mouse-generate-font-name-for-menu (entity) + "Return a short name for font entity ENTITY. +The name should be used to describe ENTITY in the case that its +family is already known, such as in a pane generated by +`mouse-generate-font-menu'." + (let ((weight (font-get entity :weight)) + (slant (font-get entity :slant)) + (width (font-get entity :width)) + (size (font-get entity :size)) + (adstyle (font-get entity :adstyle)) + (name "")) + (when weight + (setq name (concat name (symbol-name weight) " "))) + (when (and slant + (not (eq slant 'normal))) + (setq name (concat name (symbol-name slant) " "))) + (when (and width (not (eq width 'normal))) + (setq name (concat name (symbol-name width) " "))) + (when (and size (not (zerop size))) + (setq name (concat name (number-to-string size) " "))) + (when adstyle + (setq name (concat name (if (symbolp adstyle) + (symbol-name adstyle) + (number-to-string adstyle)) + " "))) + (string-trim-right name))) + +(defun mouse-generate-font-menu () + "Return a list of menu panes for each font family." + (let ((families (font-family-list)) + (panes (list "Font families"))) + (dolist (family families) + (when family + (let* ((fonts (list-fonts (font-spec :family family))) + (pane (if fonts (list family) + (list family (cons family family))))) + (when fonts + (dolist (font fonts) + (setq pane + (nconc pane + (list (list (or (font-get font :name) + (mouse-generate-font-name-for-menu font)) + (font-xlfd-name font))))))) + (setq panes (nconc panes (list pane)))))) + panes)) + (defun mouse-select-font () "Prompt for a font name, using `x-popup-menu', and return it." (interactive) (unless (display-multi-font-p) (error "Cannot change fonts on this display")) - (car - (x-popup-menu - (if (listp last-nonmenu-event) - last-nonmenu-event - (list '(0 0) (selected-window))) - (append x-fixed-font-alist - (list (generate-fontset-menu)))))) + (let ((result (car + (x-popup-menu + (if (listp last-nonmenu-event) + last-nonmenu-event + (list '(0 0) (selected-window))) + (append x-fixed-font-alist + (list (generate-fontset-menu)) + '(("More Fonts" ("By Family" more)))))))) + (if (eq result 'more) + (car (x-popup-menu + (if (listp last-nonmenu-event) + last-nonmenu-event + (list '(0 0) (selected-window))) + (mouse-generate-font-menu))) + result))) (declare-function text-scale-mode "face-remap") @@ -2780,12 +2836,7 @@ choose a font." (interactive (progn (unless (display-multi-font-p) (error "Cannot change fonts on this display")) - (x-popup-menu - (if (listp last-nonmenu-event) - last-nonmenu-event - (list '(0 0) (selected-window))) - ;; Append list of fontsets currently defined. - (append x-fixed-font-alist (list (generate-fontset-menu)))))) + (list (mouse-select-font)))) (if fonts (let (font) (while fonts diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index a6904fc07e9..ef8527fadae 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -2547,13 +2547,16 @@ can parse the output from a DIR listing for a host of type TYPE.") (defvar ange-ftp-after-parse-ls-hook nil "Normal hook run after parsing the text of an FTP directory listing.") +(declare-function ls-lisp--sanitize-switches "ls-lisp" (switches)) + (defun ange-ftp-ls (file lsargs parse &optional no-error wildcard) "Return the output of a `DIR' or `ls' command done over FTP. 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." - (while (string-match "^--dired\\s-+" lsargs) - (setq lsargs (replace-match "" nil t lsargs))) + (when (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 ;; full directory listings. (let* ((ange-ftp-this-file (ange-ftp-expand-file-name file)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index eaa5c119385..700a6c3e82f 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -32,6 +32,7 @@ (require 'thingatpt) (require 'url) (require 'url-queue) +(require 'url-file) (require 'xdg) (eval-when-compile (require 'subr-x)) @@ -487,22 +488,21 @@ killed after rendering." (defun eww-open-file (file) "Render FILE using EWW." (interactive "fFile: ") - (eww (concat "file://" - (and (memq system-type '(windows-nt ms-dos)) - "/") - (expand-file-name file)) - nil - ;; The file name may be a non-local Tramp file. The URL - ;; library doesn't understand these file names, so use the - ;; normal Emacs machinery to load the file. - (with-current-buffer (generate-new-buffer " *eww file*") - (set-buffer-multibyte nil) - (insert "Content-type: " (or (mailcap-extension-to-mime - (url-file-extension file)) - "application/octet-stream") - "\n\n") - (insert-file-contents file) - (current-buffer)))) + (let ((url-allow-non-local-files t)) + (eww (concat "file://" + (and (memq system-type '(windows-nt ms-dos)) + "/") + (expand-file-name file))))) + +(defun eww--file-buffer (file) + (with-current-buffer (generate-new-buffer " *eww file*") + (set-buffer-multibyte nil) + (insert "Content-type: " (or (mailcap-extension-to-mime + (url-file-extension file)) + "application/octet-stream") + "\n\n") + (insert-file-contents file) + (current-buffer))) ;;;###autoload (defun eww-search-words () @@ -1204,7 +1204,8 @@ instead of `browse-url-new-window-flag'." (format "*eww-%s*" (url-host (url-generic-parse-url (eww--dwim-expand-url url)))))) (eww-mode)) - (eww url)) + (let ((url-allow-non-local-files t)) + (eww url))) (defun eww-back-url () "Go to the previously displayed page." @@ -1291,9 +1292,16 @@ just re-display the HTML already fetched." (error "No current HTML data") (eww-display-html 'utf-8 url (plist-get eww-data :dom) (point) (current-buffer))) - (let ((url-mime-accept-string eww-accept-content-types)) - (eww-retrieve url #'eww-render - (list url (point) (current-buffer) encode)))))) + (let ((parsed (url-generic-parse-url url))) + (if (equal (url-type parsed) "file") + ;; Use Tramp instead of url.el for files (since url.el + ;; doesn't work well with Tramp files). + (let ((eww-buffer (current-buffer))) + (with-current-buffer (eww--file-buffer (url-filename parsed)) + (eww-render nil url nil eww-buffer))) + (let ((url-mime-accept-string eww-accept-content-types)) + (eww-retrieve url #'eww-render + (list url (point) (current-buffer) encode)))))))) ;; Form support. @@ -2499,6 +2507,8 @@ Otherwise, the restored buffer will contain a prompt to do so by using "Default bookmark handler for EWW buffers." (eww (bookmark-prop-get bookmark 'location))) +(put 'eww-bookmark-jump 'bookmark-handler-type "EWW") + (provide 'eww) ;;; eww.el ends here diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 6e0af06bed1..386f1d6095d 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -40,6 +40,7 @@ (require 'image) (require 'puny) (require 'url-cookie) +(require 'url-file) (require 'pixel-fill) (require 'text-property-search) @@ -877,8 +878,10 @@ size, and full-buffer size." ;; A link to an anchor. (concat (nth 3 base) url)) (t - ;; Totally relative. - (url-expand-file-name url (concat (car base) (cadr base)))))) + ;; Totally relative. Allow Tramp file names if we're + ;; rendering a file:// URL. + (let ((url-allow-non-local-files (equal (nth 2 base) "file"))) + (url-expand-file-name url (concat (car base) (cadr base))))))) (defun shr-ensure-newline () (unless (bobp) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index d2092633d89..5e7bdbe6c6a 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -5,12 +5,11 @@ ;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com> ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org> ;; Created: December, 2009 -;; Version: 3.2.0 +;; Version: 3.2.1 ;; Keywords: soap, web-services, comm, hypermedia ;; Package: soap-client ;; URL: https://github.com/alex-hhh/emacs-soap-client -;; Package-Requires: ((cl-lib "0.6.1")) -;;FIXME: Put in `Package-Requires:' the Emacs version we expect. +;; Package-Requires: ((emacs "24.1") (cl-lib "0.6.1")) ;; This file is part of GNU Emacs. @@ -659,7 +658,7 @@ representing leap seconds." (if second (if second-fraction (let* ((second-fraction-significand - (string-replace "." "" second-fraction)) + (replace-regexp-in-string "\\." "" second-fraction)) (hertz (expt 10 (length second-fraction-significand))) (ticks (+ (* hertz (string-to-number second)) @@ -1937,7 +1936,7 @@ This is a specialization of `soap-decode-type' for (e-name (soap-xs-element-name element)) ;; Heuristic: guess if we need to decode using local ;; namespaces. - (use-fq-names (string-search ":" (symbol-name (car node)))) + (use-fq-names (string-match ":" (symbol-name (car node)))) (children (if e-name (if use-fq-names ;; Find relevant children diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 75e6b7179b0..a61179958ca 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -818,7 +818,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) @@ -849,7 +849,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar (cdr destination) (expand-file-name (cadr destination))) (if (tramp-equal-remote default-directory (cadr destination)) ;; stderr is on the same remote host. - (setq stderr (tramp-file-local-name (cadr destination))) + (setq stderr (tramp-unquote-file-local-name (cadr destination))) ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) @@ -986,6 +986,10 @@ implementation will be used." (name1 name) (i 0)) + (when (string-match-p "[[:multibyte:]]" command) + (tramp-error + v 'file-error "Cannot apply multi-byte command `%s'" command)) + (while (get-process name1) ;; NAME must be unique as process name. (setq i (1+ i) @@ -1264,7 +1268,7 @@ connection if a previous connection has died for some reason." (if (zerop (length device)) (tramp-error vec 'file-error "Device %s not connected" host)) (with-tramp-progress-reporter vec 3 "Opening adb shell connection" - (let* ((coding-system-for-read 'utf-8-dos) ;is this correct? + (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? (process-connection-type tramp-process-connection-type) (args (if (> (length host) 0) (list "-s" device "shell") @@ -1364,6 +1368,24 @@ connection if a previous connection has died for some reason." `(:application tramp :protocol ,tramp-adb-method) 'tramp-adb-connection-local-default-shell-profile)) +;; `shell-mode' tries to open remote files like "/adb::~/.history". +;; This fails, because the tilde cannot be expanded. Tell +;; `tramp-handle-expand-file-name' to tolerate this. +(defun tramp-adb-tolerate-tilde (orig-fun) + "Advice for `shell-mode' to tolerate tilde in remote file names." + (let ((tramp-tolerate-tilde + (or tramp-tolerate-tilde + (equal (file-remote-p default-directory 'method) + tramp-adb-method)))) + (funcall orig-fun))) + +(add-function + :around (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde) +(add-hook 'tramp-adb-unload-hook + (lambda () + (remove-function + (symbol-function #'shell-mode) #'tramp-adb-tolerate-tilde))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-adb 'force))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index d3f427932f3..c6523003b8c 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -190,6 +190,8 @@ It must be supported by libarchive(3).") "\\)" ;; \1 "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 +(put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t) + ;; In older Emacsen (prior 27.1), `tramp-archive-autoload-file-name-regexp' ;; is not autoloaded. So we cannot expect it to be known in ;; tramp-loaddefs.el. But it exists, when tramp-archive.el is loaded. @@ -366,6 +368,8 @@ arguments to pass to the OPERATION." (tramp-archive-autoload t)) (apply #'tramp-autoload-file-name-handler operation args))))) +(put #'tramp-archive-autoload-file-name-handler 'tramp-autoload t) + ;;;###autoload (progn (defun tramp-register-archive-file-name-handler () "Add archive file name handler to `file-name-handler-alist'." @@ -375,6 +379,8 @@ arguments to pass to the OPERATION." #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t)))) +(put #'tramp-register-archive-file-name-handler 'tramp-autoload t) + ;;;###autoload (progn (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 1ab8f4d335b..dc1e3d28b58 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -122,7 +122,7 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil." (puthash key (make-hash-table :test #'equal) tramp-cache-data))) (when (tramp-file-name-p key) (dolist (elt tramp-connection-properties) - (when (tramp-compat-string-search + (when (string-match-p (or (nth 0 elt) "") (tramp-make-tramp-file-name key 'noloc)) (tramp-set-connection-property key (nth 1 elt) (nth 2 elt))))) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index c2c3689c610..47c707451ed 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -193,9 +193,9 @@ If NAME doesn't belong to a crypted remote directory, retun nil." ;; `file-name-nondirectory' performed by default handler. ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-notify-add-watch . ignore) - (file-notify-rm-watch . ignore) - (file-notify-valid-p . ignore) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . tramp-crypt-handle-file-ownership-preserved-p) (file-readable-p . tramp-crypt-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) @@ -208,7 +208,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-crypt-handle-insert-directory) - ;; `insert-file-contents' performed by default handler. + (insert-file-contents . tramp-handle-insert-file-contents) (load . tramp-handle-load) (lock-file . tramp-crypt-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 221ee547a2b..23290de685e 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -916,8 +916,6 @@ or `dbus-call-method-asynchronously'." ;; when loading. (dbus-ignore-errors (tramp-dbus-function ,vec func args)))) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) - (defmacro with-tramp-dbus-get-all-properties (vec bus service path interface) "Return all properties of INTERFACE. @@ -932,8 +930,6 @@ The call will be traced by Tramp with trace level 6." (tramp-dbus-function ,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface)))) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-get-all-properties\\>")) - (defvar tramp-gvfs-dbus-event-vector nil "Current Tramp file name to be used, as vector. It is needed when D-Bus signals or errors arrive, because there @@ -1155,6 +1151,10 @@ file names." (replace-match (tramp-get-connection-property v "default-location" "~") nil t localname 1)))) + ;; 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))) ;; We do not pass "/..". @@ -1172,7 +1172,7 @@ file names." ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (if (string-match-p "\\`~" localname) + v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))) @@ -1389,7 +1389,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `file-executable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-executable-p" - (tramp-check-cached-permissions v ?x)))) + (or (tramp-check-cached-permissions v ?x) + (tramp-check-cached-permissions v ?s))))) (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -1607,8 +1608,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-file-name-user vec) (when-let ((localname (tramp-get-connection-property - (tramp-get-process vec) "share" - (tramp-get-connection-property vec "default-location" nil)))) + (tramp-get-process vec) "share" nil))) (file-attribute-user-id (file-attributes (tramp-make-tramp-file-name vec localname) id-format))))) @@ -1617,8 +1617,7 @@ ID-FORMAT valid values are `string' and `integer'." ID-FORMAT valid values are `string' and `integer'." (when-let ((localname (tramp-get-connection-property - (tramp-get-process vec) "share" - (tramp-get-connection-property vec "default-location" nil)))) + (tramp-get-process vec) "share" nil))) (file-attribute-group-id (file-attributes (tramp-make-tramp-file-name vec localname) id-format)))) @@ -2246,13 +2245,7 @@ connection if a previous connection has died for some reason." COMMAND is a command from the gvfs-* utilities. It is replaced by the corresponding gio tool call if available. `call-process' is applied, and it returns t if the return code is zero." - (let* ((locale (tramp-get-local-locale vec)) - (process-environment - (append - `(,(format "LANG=%s" locale) - ,(format "LANGUAGE=%s" locale) - ,(format "LC_ALL=%s" locale)) - process-environment))) + (let ((locale (tramp-get-local-locale vec))) (when (tramp-gvfs-gio-tool-p vec) ;; Use gio tool. (setq args (cons (cdr (assoc command tramp-gvfs-gio-mapping)) @@ -2262,7 +2255,14 @@ is applied, and it returns t if the return code is zero." (with-current-buffer (tramp-get-connection-buffer vec) (tramp-gvfs-maybe-open-connection vec) (erase-buffer) - (or (zerop (apply #'tramp-call-process vec command nil t nil args)) + (or (zerop + (apply + #'tramp-call-process vec "env" nil t nil + (append `(,(format "LANG=%s" locale) + ,(format "LANGUAGE=%s" locale) + ,(format "LC_ALL=%s" locale) + ,command) + args))) ;; Remove information about mounted connection. (and (tramp-flush-file-properties vec "/") nil))))) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 259e85a04a3..32ec19bf232 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -107,9 +107,9 @@ (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-notify-add-watch . ignore) - (file-notify-rm-watch . ignore) - (file-notify-valid-p . ignore) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-rclone-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 98192bd96d5..3c284635153 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -301,7 +301,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10) - (tramp-session-timeout 300))) + (tramp-session-timeout 300) + (tramp-password-previous-hop t))) (add-to-list 'tramp-methods `("doas" (tramp-login-program "doas") @@ -309,7 +310,8 @@ The string is used in `tramp-methods'.") (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10) - (tramp-session-timeout 300))) + (tramp-session-timeout 300) + (tramp-password-previous-hop t))) (add-to-list 'tramp-methods `("ksu" (tramp-login-program "ksu") @@ -1585,6 +1587,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. (or (tramp-check-cached-permissions v ?x) + (tramp-check-cached-permissions v ?s) (tramp-run-test "-x" filename))))) (defun tramp-sh-handle-file-readable-p (filename) @@ -3117,7 +3120,7 @@ implementation will be used." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) @@ -3148,7 +3151,7 @@ implementation will be used." (setcar (cdr destination) (expand-file-name (cadr destination))) (if (tramp-equal-remote default-directory (cadr destination)) ;; stderr is on the same remote host. - (setq stderr (tramp-file-local-name (cadr destination))) + (setq stderr (tramp-unquote-file-local-name (cadr destination))) ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) @@ -5004,8 +5007,7 @@ connection if a previous connection has died for some reason." (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) (let* ((current-host tramp-system-name) (target-alist (tramp-compute-multi-hops vec)) - ;; Needed for `tramp-get-remote-null-device'. - (previous-hop nil) + (previous-hop tramp-null-hop) ;; We will apply `tramp-ssh-controlmaster-options' ;; only for the first hop. (options (tramp-ssh-controlmaster-options vec)) @@ -5090,9 +5092,14 @@ connection if a previous connection has died for some reason." ;; Set password prompt vector. (tramp-set-connection-property p "password-vector" - (make-tramp-file-name - :method l-method :user l-user :domain l-domain - :host l-host :port l-port)) + (if (tramp-get-method-parameter + hop 'tramp-password-previous-hop) + (let ((pv (copy-tramp-file-name previous-hop))) + (setf (tramp-file-name-method pv) l-method) + pv) + (make-tramp-file-name + :method l-method :user l-user :domain l-domain + :host l-host :port l-port))) ;; Set session timeout. (when (tramp-get-method-parameter diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 6515519680c..f52fa0a93be 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1284,7 +1284,7 @@ component is used as the target of the symlink." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 72837793de4..d30c19436d5 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -55,7 +55,8 @@ ;; These are for remote processes. (tramp-login-program "ssh") (tramp-login-args (("-q")("-l" "%u") ("-p" "%p") - ("-e" "none") ("%h") ("%l"))) + ("-e" "none") ("-t" "-t") + ("%h") ("%l"))) (tramp-direct-async t) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) @@ -107,9 +108,9 @@ (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-notify-add-watch . ignore) - (file-notify-rm-watch . ignore) - (file-notify-valid-p . ignore) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) @@ -239,12 +240,13 @@ arguments to pass to the OPERATION." (error "Implementation does not handle immediate return")) (with-parsed-tramp-file-name (expand-file-name default-directory) nil - (let ((command + (let ((coding-system-for-read 'utf-8-dos) ; Is this correct? + (command (format "cd %s && exec %s" (tramp-unquote-shell-quote-argument localname) (mapconcat #'tramp-shell-quote-argument (cons program args) " "))) - input tmpinput) + input tmpinput stderr tmpstderr outbuf) ;; Determine input. (if (null infile) @@ -252,18 +254,55 @@ arguments to pass to the OPERATION." (setq infile (tramp-compat-file-name-unquote (expand-file-name infile))) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (tramp-file-local-name infile)) + (setq input (tramp-unquote-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) (copy-file infile tmpinput t))) (when input (setq command (format "%s <%s" command input))) + ;; Determine output. + (cond + ;; Just a buffer. + ((bufferp destination) + (setq outbuf destination)) + ;; A buffer name. + ((stringp destination) + (setq outbuf (get-buffer-create destination))) + ;; (REAL-DESTINATION ERROR-DESTINATION) + ((consp destination) + ;; output. + (cond + ((bufferp (car destination)) + (setq outbuf (car destination))) + ((stringp (car destination)) + (setq outbuf (get-buffer-create (car destination)))) + ((car destination) + (setq outbuf (current-buffer)))) + ;; stderr. + (cond + ((stringp (cadr destination)) + (setcar (cdr destination) (expand-file-name (cadr destination))) + (if (tramp-equal-remote default-directory (cadr destination)) + ;; stderr is on the same remote host. + (setq stderr (tramp-unquote-file-local-name (cadr destination))) + ;; stderr must be copied to remote host. The temporary + ;; file must be deleted after execution. + (setq stderr (tramp-make-tramp-temp-file v) + tmpstderr (tramp-make-tramp-file-name v stderr)))) + ;; stderr to be discarded. + ((null (cadr destination)) + (setq stderr (tramp-get-remote-null-device v))))) + ;; 't + (destination + (setq outbuf (current-buffer)))) + (when stderr (setq command (format "%s 2>%s" command stderr))) + (unwind-protect (apply #'tramp-call-process v (tramp-get-method-parameter v 'tramp-login-program) - nil destination display + nil outbuf display (tramp-expand-args v 'tramp-login-args ?h (or (tramp-file-name-host v) "") @@ -271,6 +310,15 @@ arguments to pass to the OPERATION." ?p (or (tramp-file-name-port v) "") ?l command)) + ;; Synchronize stderr. + (when tmpstderr + (tramp-cleanup-connection v 'keep-debug 'keep-password) + (tramp-fuse-unmount v)) + + ;; Provide error file. + (when tmpstderr + (rename-file tmpstderr (cadr destination) t)) + ;; Cleanup. We remove all file cache values for the ;; connection, because the remote process could have changed ;; them. @@ -341,6 +389,12 @@ arguments to pass to the OPERATION." start end (tramp-fuse-local-file-name filename) append 'nomessage) (tramp-flush-file-properties v localname)) + ;; Set file modification time. + (when (or (eq visit t) (stringp visit)) + (set-visited-file-modtime + (or (file-attribute-modification-time (file-attributes filename)) + (current-time)))) + ;; Unlock file. (when file-locked ;; `unlock-file' exists since Emacs 28.1. @@ -411,6 +465,24 @@ connection if a previous connection has died for some reason." (with-tramp-connection-property vec "gid-string" (tramp-get-local-gid 'string))) +;; `shell-mode' tries to open remote files like "/sshfs:user@host:~/.history". +;; This fails, because the tilde cannot be expanded. Tell +;; `tramp-handle-expand-file-name' to tolerate this. +(defun tramp-sshfs-tolerate-tilde (orig-fun) + "Advice for `shell-mode' to tolerate tilde in remote file names." + (let ((tramp-tolerate-tilde + (or tramp-tolerate-tilde + (equal (file-remote-p default-directory 'method) + tramp-sshfs-method)))) + (funcall orig-fun))) + +(add-function + :around (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde) +(add-hook 'tramp-sshfs-unload-hook + (lambda () + (remove-function + (symbol-function #'shell-mode) #'tramp-sshfs-tolerate-tilde))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-sshfs 'force))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 7fbe5412709..a35f9391a1d 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -45,7 +45,8 @@ (add-to-list 'tramp-methods `(,tramp-sudoedit-method (tramp-sudo-login (("sudo") ("-u" "%u") ("-S") ("-H") - ("-p" "Password:") ("--"))))) + ("-p" "Password:") ("--"))) + (tramp-password-previous-hop t))) (add-to-list 'tramp-default-user-alist '("\\`sudoedit\\'" nil "root")) @@ -100,9 +101,9 @@ See `tramp-actions-before-shell' for more info.") (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-notify-add-watch . ignore) - (file-notify-rm-watch . ignore) - (file-notify-valid-p . ignore) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) + (file-notify-valid-p . tramp-handle-file-notify-valid-p) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-sudoedit-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) @@ -168,6 +169,12 @@ arguments to pass to the OPERATION." (tramp-register-foreign-file-name-handler #'tramp-sudoedit-file-name-p #'tramp-sudoedit-file-name-handler)) +;; Needed for `tramp-read-passwd'. +(defconst tramp-sudoedit-null-hop + (make-tramp-file-name + :method tramp-sudoedit-method :user (user-login-name) :host tramp-system-name) +"Connection hop which identifies the virtual hop before the first one.") + ;; File name primitives. @@ -825,6 +832,7 @@ in case of error, t otherwise." (process-put p 'vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) + (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions) (tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string)) (prog1 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c6e55ff6889..932dfb36910 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -315,14 +315,20 @@ pair of the form (KEY VALUE). The following KEYs are defined: * `tramp-connection-timeout' This is the maximum time to be spent for establishing a connection. In general, the global default value shall be used, but for - some methods, like \"su\" or \"sudo\", a shorter timeout - might be desirable. + some methods, like \"doas\", \"su\" or \"sudo\", a shorter + timeout might be desirable. * `tramp-session-timeout' How long a Tramp connection keeps open before being disconnected. - This is useful for methods like \"su\" or \"sudo\", which + This is useful for methods like \"doas\" or \"sudo\", which shouldn't run an open connection in the background forever. + * `tramp-password-previous-hop' + The password for this connection is the same like the + password for the previous hop. If there is no previous hop, + the password of the local user is applied. This is needed + for methods like \"doas\", \"sudo\" or \"sudoedit\". + * `tramp-case-insensitive' Whether the remote file system handles file names case insensitive. Only a non-nil value counts, the default value nil means to @@ -1427,6 +1433,11 @@ calling HANDLER.") (put #'tramp-file-name-localname 'tramp-suppress-trace t) (put #'tramp-file-name-hop 'tramp-suppress-trace t) +;; Needed for `tramp-read-passwd' and `tramp-get-remote-null-device'. +(defconst tramp-null-hop + (make-tramp-file-name :user (user-login-name) :host tramp-system-name) +"Connection hop which identifies the virtual hop before the first one.") + (defun tramp-file-name-user-domain (vec) "Return user and domain components of VEC." (when (or (tramp-file-name-user vec) (tramp-file-name-domain vec)) @@ -2302,8 +2313,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (ignore ,@(mapcar #'car bindings)) ,@body))) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) - (defun tramp-progress-reporter-update (reporter &optional value suffix) "Report progress of an operation for Tramp." (let* ((parameters (cdr reporter)) @@ -2340,9 +2349,6 @@ without a visible progress reporter." (if tm (cancel-timer tm)) (tramp-message ,vec ,level "%s...%s" ,message cookie))))) -(font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) - (defmacro with-tramp-file-property (vec file property &rest body) "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. FILE must be a local file name on a connection identified via VEC." @@ -2359,8 +2365,6 @@ FILE must be a local file name on a connection identified via VEC." value) ,@body)) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) - (defmacro with-tramp-connection-property (key property &rest body) "Check in Tramp for property PROPERTY, otherwise execute BODY and set." (declare (indent 2) (debug t)) @@ -2374,9 +2378,6 @@ FILE must be a local file name on a connection identified via VEC." (tramp-set-connection-property ,key ,property value)) value)) -(font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) - (defun tramp-drop-volume-letter (name) "Cut off unnecessary drive letter from file NAME. The functions `tramp-*-handle-expand-file-name' call `expand-file-name' @@ -2742,6 +2743,8 @@ Falls back to normal file name handler if no Tramp file name handler exists." (load "tramp" 'noerror 'nomessage))) (apply operation args))) +(put #'tramp-autoload-file-name-handler 'tramp-autoload t) + ;; `tramp-autoload-file-name-handler' must be registered before ;; evaluation of site-start and init files, because there might exist ;; remote files already, f.e. files kept via recentf-mode. @@ -2753,6 +2756,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t))) +(put #'tramp-register-autoload-file-name-handlers 'tramp-autoload t) ;;;###autoload (tramp-register-autoload-file-name-handlers) (defun tramp-use-absolute-autoload-file-names () @@ -2866,6 +2870,7 @@ whether HANDLER is to be called. Add operations defined in (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) (setq file-name-handler-alist (delq fnh file-name-handler-alist)))))) +(put #'tramp-unload-file-name-handlers 'tramp-autoload t) (add-hook 'tramp-unload-hook #'tramp-unload-file-name-handlers) ;;; File name handler functions for completion mode: @@ -3341,6 +3346,10 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") +(defvar tramp-tolerate-tilde nil + "Indicator, that not expandable tilde shall be tolerated. +Let-bind it when necessary.") + ;; `directory-abbrev-apply' and `directory-abbrev-make-regexp' exists ;; since Emacs 29.1. Since this handler isn't called for older ;; Emacsen, it is save to invoke them via `tramp-compat-funcall'. @@ -3348,17 +3357,26 @@ User is always nil." "Like `abbreviate-file-name' for Tramp files." (let* ((case-fold-search (file-name-case-insensitive-p filename)) (vec (tramp-dissect-file-name filename)) + (tramp-tolerate-tilde t) (home-dir - (with-tramp-connection-property vec "home-directory" - (tramp-compat-funcall - 'directory-abbrev-apply - (expand-file-name (tramp-make-tramp-file-name vec "~")))))) + (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 "~")))) + ;; Otherwise, just use the cached value. + (tramp-get-connection-property vec "home-directory" nil)))) ;; If any elt of `directory-abbrev-alist' matches this name, ;; abbreviate accordingly. (setq filename (tramp-compat-funcall 'directory-abbrev-apply filename)) ;; Abbreviate home directory. - (if (string-match - (tramp-compat-funcall 'directory-abbrev-make-regexp home-dir) filename) + (if (and home-dir + (string-match + (tramp-compat-funcall 'directory-abbrev-make-regexp home-dir) + filename)) (tramp-make-tramp-file-name vec (concat "~" (substring filename (match-beginning 1)))) (tramp-make-tramp-file-name (tramp-dissect-file-name filename))))) @@ -3480,18 +3498,21 @@ User is always nil." (with-parsed-tramp-file-name name nil (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) + ;; 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)) ;; Do not keep "/..". (when (string-match-p "^/\\.\\.?$" localname) (setq localname "/")) - ;; Do normal `expand-file-name' (this does "/./" and "/../"), - ;; unless there are tilde characters in file name. + ;; Do normal `expand-file-name' (this does "/./" and "/../"). ;; `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 (if (string-match-p "\\`~" localname) - localname - (tramp-drop-volume-letter + v (tramp-drop-volume-letter + (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + localname (tramp-run-real-handler #'expand-file-name (list localname))))))))) (defun tramp-handle-file-accessible-directory-p (filename) @@ -4008,6 +4029,14 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; was visited. (catch 'dont-lock (unless (eq (file-locked-p file) t) ;; Locked by me. + (when (and buffer-file-truename + (not (verify-visited-file-modtime)) + (file-exists-p file)) + ;; In filelock.c, `userlock--ask-user-about-supersession-threat' + ;; is called, which also checks file contents. This is unwise + ;; for remote files. + (ask-user-about-supersession-threat file)) + (when-let ((info (tramp-get-lock-file file)) (match (string-match tramp-lock-file-info-regexp info))) (unless (ask-user-about-lock @@ -4290,7 +4319,9 @@ substitution. SPEC-LIST is a list of char/value pairs used for (command (mapconcat #'tramp-shell-quote-argument command " ")) ;; Set cwd and environment variables. (command - (append `("cd" ,localname "&&" "(" "env") env `(,command ")")))) + (append + `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") + env `(,command ")")))) ;; Check for `tramp-sh-file-name-handler', because something ;; is different between tramp-sh.el, and tramp-adb.el or @@ -4551,10 +4582,7 @@ BUFFER might be a list, in this case STDERR is separated." ;; We must disable cygwin-mount file name ;; handlers and alike. (tramp-run-real-handler - #'substitute-in-file-name (list localname)))))))) - ;; "/m:h:~" does not work for completion. We use "/m:h:~/". - (if (and (stringp localname) (string-equal "~" localname)) - (concat filename "/") + #'substitute-in-file-name (list localname))))))) filename)))) (defconst tramp-time-dont-know '(0 0 0 1000) @@ -5015,9 +5043,6 @@ Mostly useful to protect BODY from being interrupted by timers." ,@body) (tramp-flush-connection-property ,proc "locked")))) -(font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-tramp-locked-connection\\>")) - (defun tramp-accept-process-output (proc &optional timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set @@ -5401,7 +5426,8 @@ be granted." (offset (cond ((eq ?r access) 1) ((eq ?w access) 2) - ((eq ?x access) 3)))) + ((eq ?x access) 3) + ((eq ?s access) 3)))) (dolist (suffix '("string" "integer") result) (setq result @@ -5431,13 +5457,15 @@ be granted." ;; User accessible and owned by user. (and (eq access (aref (file-attribute-modes file-attr) offset)) - (or (equal remote-uid (file-attribute-user-id file-attr)) + (or (equal remote-uid unknown-id) + (equal remote-uid (file-attribute-user-id file-attr)) (equal unknown-id (file-attribute-user-id file-attr)))) ;; Group accessible and owned by user's principal group. (and (eq access (aref (file-attribute-modes file-attr) (+ offset 3))) - (or (equal remote-gid (file-attribute-group-id file-attr)) + (or (equal remote-gid unknown-id) + (equal remote-gid (file-attribute-group-id file-attr)) (equal unknown-id (file-attribute-group-id file-attr)))))))))))) (defun tramp-get-remote-uid (vec id-format) @@ -5727,17 +5755,22 @@ Consults the auth-source package." ;; adapt `default-directory'. (Bug#39389, Bug#39489) (default-directory tramp-compat-temporary-file-directory) (case-fold-search t) - (key (tramp-make-tramp-file-name - ;; In tramp-sh.el, we must use "password-vector" due to - ;; multi-hop. - (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector)) - 'noloc)) + ;; 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)) + (method (tramp-file-name-method vec)) + (user (or (tramp-file-name-user-domain vec) + (tramp-get-connection-property key "login-as" nil))) + (host (tramp-file-name-host-port vec)) (pw-prompt (or prompt (with-current-buffer (process-buffer proc) (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (format "%s for %s " (capitalize (match-string 1)) key)))) + (if (string-match-p "passphrase" (match-string 1)) + (match-string 0) + (format "%s for %s " (capitalize (match-string 1)) key))))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) @@ -5746,51 +5779,40 @@ Consults the auth-source package." auth-info auth-passwd) (unwind-protect - (with-parsed-tramp-file-name key nil - (setq tramp-password-save-function nil - user - (or user (tramp-get-connection-property key "login-as" nil))) - (prog1 - (or - ;; See if auth-sources contains something useful. - (ignore-errors - (and (tramp-get-connection-property - v "first-password-request" nil) - ;; Try with Tramp's current method. - (setq auth-info - (car - (auth-source-search - :max 1 - (and user :user) - (if domain - (concat - user tramp-prefix-domain-format domain) - user) - :host - (if port - (concat - host tramp-prefix-port-format port) - host) - :port method - :require (cons :secret (and user '(:user))) - :create t)) - tramp-password-save-function - (plist-get auth-info :save-function) - auth-passwd - (tramp-compat-auth-info-password auth-info)))) - - ;; Try the password cache. - (progn - (setq auth-passwd (password-read pw-prompt key) - tramp-password-save-function - (lambda () (password-cache-add key auth-passwd))) - auth-passwd)) + ;; We cannot use `with-parsed-tramp-file-name', because it + ;; expands the file name. + (or + (setq tramp-password-save-function nil) + ;; See if auth-sources contains something useful. + (ignore-errors + (and (tramp-get-connection-property + vec "first-password-request" nil) + ;; Try with Tramp's current method. If there is no + ;; user name, `:create' triggers to ask for. We + ;; suppress it. + (setq auth-info + (car + (auth-source-search + :max 1 :user user :host host :port method + :require (cons :secret (and user '(:user))) + :create (and user t))) + tramp-password-save-function + (plist-get auth-info :save-function) + auth-passwd + (tramp-compat-auth-info-password auth-info)))) + + ;; Try the password cache. + (progn + (setq auth-passwd (password-read pw-prompt key) + tramp-password-save-function + (lambda () (password-cache-add key auth-passwd))) + auth-passwd)) - ;; Workaround. Prior Emacs 28.1, auth-source has saved - ;; empty passwords. See discussion in Bug#50399. - (when (zerop (length auth-passwd)) - (setq tramp-password-save-function nil)) - (tramp-set-connection-property v "first-password-request" nil))) + ;; Workaround. Prior Emacs 28.1, auth-source has saved empty + ;; passwords. See discussion in Bug#50399. + (when (zerop (length auth-passwd)) + (setq tramp-password-save-function nil)) + (tramp-set-connection-property vec "first-password-request" nil) ;; Reenable the timers. (with-timeout-unsuspend stimers)))) @@ -5919,8 +5941,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, return local null device." - (if (null vec) +If VEC is nil or `tramp-null-hop', return local null device." + (if (or (null vec) (equal vec tramp-null-hop)) null-device (with-tramp-connection-property vec "null-device" (let ((default-directory (tramp-make-tramp-file-name vec))) @@ -5957,6 +5979,8 @@ BODY is the backend specific code." ;; Maybe it's not loaded yet. (ignore-errors (unload-feature 'tramp 'force)))) +(put #'tramp-unload-tramp 'tramp-autoload t) + (provide 'tramp) (run-hooks 'tramp--startup-hook) diff --git a/lisp/notifications.el b/lisp/notifications.el index 5ad64ff73b6..b58a1a02116 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -202,7 +202,7 @@ This function returns a notification id, an integer, which can be used to manipulate the notification item with `notifications-close-notification' or the `:replaces-id' argument of another `notifications-notify' call." - (with-demoted-errors + (with-demoted-errors "Notification error: %S" (let ((bus (or (plist-get params :bus) :session)) (title (plist-get params :title)) (body (plist-get params :body)) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index b8f6cb5ad36..171b7088c10 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -566,7 +566,8 @@ Many aspects this mode can be customized using (font-lock-syntactic-face-function . sgml-font-lock-syntactic-face))) - (with-demoted-errors (rng-nxml-mode-init))) + (with-demoted-errors "RNG NXML error: %S" + (rng-nxml-mode-init))) (defun nxml--buffer-substring-filter (string) ;; The `rng-state' property is huge, so don't copy it to the kill ring. diff --git a/lisp/autoarg.el b/lisp/obsolete/autoarg.el index b0d6abe0207..8d5ded93421 100644 --- a/lisp/autoarg.el +++ b/lisp/obsolete/autoarg.el @@ -5,6 +5,7 @@ ;; Author: Dave Love <fx@gnu.org> ;; Created: 1998-09-04 ;; Keywords: abbrev, emulations +;; Obsolete-since: 29.1 ;; This file is part of GNU Emacs. diff --git a/lisp/vt-control.el b/lisp/obsolete/vt-control.el index b80d3505b30..190ccbaa83c 100644 --- a/lisp/vt-control.el +++ b/lisp/obsolete/vt-control.el @@ -4,6 +4,7 @@ ;; Author: Rob Riepel <riepel@networking.stanford.edu> ;; Keywords: terminals +;; Obsolete-since: 29.1 ;; This file is part of GNU Emacs. diff --git a/lisp/vt100-led.el b/lisp/obsolete/vt100-led.el index a6a256a6a74..d741a112aa7 100644 --- a/lisp/vt100-led.el +++ b/lisp/obsolete/vt100-led.el @@ -5,6 +5,7 @@ ;; Author: Howard Gayle ;; Maintainer: emacs-devel@gnu.org ;; Keywords: hardware +;; Obsolete-since: 29.1 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index cf307aa0cb3..566258eba4a 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -43,7 +43,7 @@ (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-in-archived-heading-p "org" (&optional no-inheritance)) (declare-function outline-previous-heading "outline" ()) -(defvar org-id-link-to-org-use-id nil) ; Dynamically scoped +(defvar org-id-link-to-org-use-id) ; Dynamically scoped (defcustom org-babel-tangle-lang-exts '(("emacs-lisp" . "el") diff --git a/lisp/org/ol-bibtex.el b/lisp/org/ol-bibtex.el index 41443d79595..81b99167b8e 100644 --- a/lisp/org/ol-bibtex.el +++ b/lisp/org/ol-bibtex.el @@ -115,7 +115,7 @@ (defvar org-agenda-overriding-header) (defvar org-agenda-search-view-always-boolean) -(defvar org-bibtex-description nil) ; dynamically scoped from org.el +(defvar org-bibtex-description nil) (defvar org-id-locations) (defvar org-property-end-re) (defvar org-special-properties) @@ -655,7 +655,8 @@ With a prefix arg, query for optional fields." (defun org-bibtex-read () "Read a bibtex entry and save to `org-bibtex-entries'. -This uses `bibtex-parse-entry'." +This uses `bibtex-parse-entry'. +Return the new value of `org-bibtex-entries'." (interactive) (let ((keyword (lambda (str) (intern (concat ":" (downcase str))))) (clean-space (lambda (str) (replace-regexp-in-string @@ -678,7 +679,8 @@ This uses `bibtex-parse-entry'." (funcall clean-space (funcall strip-delim (cdr pair))))) (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) org-bibtex-entries) - (unless (car org-bibtex-entries) (pop org-bibtex-entries)))) + (unless (car org-bibtex-entries) (pop org-bibtex-entries)) + org-bibtex-entries)) (defun org-bibtex-read-buffer (buffer) "Read all bibtex entries in BUFFER and save to `org-bibtex-entries'. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 94aea1b0a32..ae0058e037e 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -99,8 +99,8 @@ ;; Defined somewhere in this file, but used before definition. (defvar org-agenda-buffer-name "*Org Agenda*") -(defvar org-agenda-overriding-header nil) (defvar org-agenda-title-append nil) +(defvar org-agenda-overriding-header) ;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el ;; (with-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defvar original-date) ; dynamically scoped, calendar.el does scope this @@ -2158,7 +2158,7 @@ string that it returns." (org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line) (defvar org-agenda-menu) ; defined later in this file. -(defvar org-agenda-restrict nil) ; defined later in this file. +(defvar org-agenda-restrict nil) (defvar org-agenda-follow-mode nil) (defvar org-agenda-entry-text-mode nil) (defvar org-agenda-clockreport-mode nil) @@ -7288,7 +7288,7 @@ When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or \"timestamp_ia\", compare within each of these type. When TYPE is the empty string, compare all timestamps without respect of their type." - (let* ((def (and (not org-agenda-sort-notime-is-late) -1)) + (let* ((def (if org-agenda-sort-notime-is-late 99999999 -1)) (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) (get-text-property 1 'ts-date a)) def)) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index d3c5094b462..2fd9a9c74da 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1453,7 +1453,8 @@ Of course, if exact position has been required, just put it there." (org-with-point-at pos (when org-capture-bookmark (let ((bookmark (plist-get org-bookmark-names-plist :last-capture))) - (when bookmark (with-demoted-errors (bookmark-set bookmark))))) + (when bookmark (with-demoted-errors "Bookmark set error: %S" + (bookmark-set bookmark))))) (move-marker org-capture-last-stored-marker (point)))))) (defun org-capture-narrow (beg end) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index ddae182791e..dce5d9d4c0c 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -2505,7 +2505,7 @@ the currently selected interval size." (when step ;; Write many tables, in steps (unless (or block (and ts te)) - (user-error "Clocktable `:step' can only be used with `:block' or `:tstart, :end'")) + (user-error "Clocktable `:step' can only be used with `:block' or `:tstart', `:tend'")) (org-clocktable-steps params) (throw 'exit nil)) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index cfccc2c0523..819ce74d93d 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -1048,9 +1048,9 @@ ELEMENT is the element at point." (cl-case (org-element-type object) ;; Prevent checks in links due to keybinding conflict with ;; Flyspell. - ((code entity export-snippet inline-babel-call - inline-src-block line-break latex-fragment link macro - statistics-cookie target timestamp verbatim) + ((citation citation-reference code entity export-snippet inline-babel-call + inline-src-block line-break latex-fragment link macro + statistics-cookie target timestamp verbatim) nil) (footnote-reference ;; Only in inline footnotes, within the definition. diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 0894951b654..83c2d08a907 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -784,8 +784,12 @@ Use \"export %s\" instead" reports)) (defun org-lint-undefined-footnote-reference (ast) - (let ((definitions (org-element-map ast 'footnote-definition - (lambda (f) (org-element-property :label f))))) + (let ((definitions + (org-element-map ast '(footnote-definition footnote-reference) + (lambda (f) + (and (or (eq 'footnote-definition (org-element-type f)) + (eq 'inline (org-element-property :type f))) + (org-element-property :label f)))))) (org-element-map ast 'footnote-reference (lambda (f) (let ((label (org-element-property :label f))) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 0dd8139a977..da309f8c6da 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -1442,7 +1442,7 @@ This function returns, destructively, the new list structure." (save-excursion (goto-char (org-list-get-last-item item struct prevs)) (point-at-eol))) - ((string-match-p "\\`[0-9]+\\'" dest) + ((and (stringp dest) (string-match-p "\\`[0-9]+\\'" dest)) (let* ((all (org-list-get-all-items item struct prevs)) (len (length all)) (index (mod (string-to-number dest) len))) diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 8e1ab7439e6..f76ebefe7b7 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -566,16 +566,16 @@ prefix argument (`C-u C-u C-u C-c C-w')." (let ((bookmark-name (plist-get org-bookmark-names-plist :last-refile))) (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) + (with-demoted-errors "Bookmark set error: %S" + (bookmark-set bookmark-name)))) ;; If we are refiling for capture, make sure that the ;; last-capture pointers point here (when (bound-and-true-p org-capture-is-refiling) (let ((bookmark-name (plist-get org-bookmark-names-plist :last-capture-marker))) (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) + (with-demoted-errors "Bookmark set error: %S" + (bookmark-set bookmark-name)))) (move-marker org-capture-last-stored-marker (point))) (when (fboundp 'deactivate-mark) (deactivate-mark)) (run-hooks 'org-after-refile-insert-hook))) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 5337d9df746..6a2aa8ca5ba 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-9-g7ba24c")) + (let ((org-git-version "release_9.5.2-17-gea6b74")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index afea529f640..2a3edaa500f 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -632,7 +632,7 @@ This option can also be set with the SELECT_TAGS keyword." (defcustom org-export-with-smart-quotes nil "Non-nil means activate smart quotes during export. This option can also be set with the OPTIONS keyword, -e.g., \"':t\". +e.g., \"\\=':t\". When setting this to non-nil, you need to take care of using the correct Babel package when exporting to LaTeX. diff --git a/lisp/outline.el b/lisp/outline.el index 4dbbaa26a0b..696d109f1ee 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -312,8 +312,11 @@ data reflects the `outline-regexp'.") (defvar outline-mode-hook nil "This hook is run when outline mode starts.") -(defvar outline-blank-line nil - "Non-nil means to leave unhidden blank line before heading.") +(defcustom outline-blank-line nil + "Non-nil means to leave an unhidden blank line before headings." + :type 'boolean + :safe #'booleanp + :version "22.1") ;;;###autoload (define-derived-mode outline-mode text-mode "Outline" diff --git a/lisp/paren.el b/lisp/paren.el index 0065bba72e7..4e67a4ea4f7 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -89,11 +89,25 @@ its position." :type 'boolean) (defcustom show-paren-context-when-offscreen nil - "If non-nil, show context in the echo area when the openparen is offscreen. + "If non-nil, show context around the opening paren if it is offscreen. The context is usually the line that contains the openparen, except if the openparen is on its own line, in which case the -context includes the previous nonblank line." - :type 'boolean +context includes the previous nonblank line. + +By default, the context is shown in the echo area. + +If set to the symbol `overlay', the context is shown in an +overlay at the top-left of the window. + +If set to the symbol `child-frame', the context is shown in a +child frame at the top-left of the window. You might want to +customize the `child-frame-border' face (especially the +background color) to give the child frame a distinguished border. +On non-graphical frames, the context is shown in the echo area." + :type '(choice (const :tag "Off" nil) + (const :tag "In echo area" t) + (const :tag "In overlay" overlay) + (const :tag "In child-frame" child-frame)) :version "29.1") (defvar show-paren--idle-timer nil) @@ -260,6 +274,136 @@ It is the default value of `show-paren-data-function'." (if (= dir 1) pos (1+ pos)) mismatch))))))) +(defvar show-paren--context-child-frame nil) + +(defun show-paren--context-child-frame-redirect-focus () + "Redirect focus from child frame." + (redirect-frame-focus + show-paren--context-child-frame + (frame-parent show-paren--context-child-frame))) + +(defun show-paren--context-child-frame-buffer (text) + (with-current-buffer + (get-buffer-create " *show-paren context*") + ;; Redirect focus to parent. + (add-hook 'pre-command-hook + #'show-paren--delete-context-child-frame + nil t) + ;; Use an empty keymap. + (use-local-map (make-keymap)) + (dolist (var '((mode-line-format . nil) + (header-line-format . nil) + (tab-line-format . nil) + (tab-bar-format . nil) ;; Emacs 28 tab-bar-format + (frame-title-format . "") + (truncate-lines . t) + (cursor-in-non-selected-windows . nil) + (cursor-type . nil) + (show-trailing-whitespace . nil) + (display-line-numbers . nil) + (left-fringe-width . nil) + (right-fringe-width . nil) + (left-margin-width . 0) + (right-margin-width . 0) + (fringes-outside-margins . 0) + (buffer-read-only . t))) + (set (make-local-variable (car var)) (cdr var))) + (let ((inhibit-modification-hooks t) + (inhibit-read-only t)) + (erase-buffer) + (insert text) + (goto-char (point-min))) + (current-buffer))) + +(defvar show-paren--context-child-frame-parameters + `((visibility . nil) + (width . 0) (height . 0) + (min-width . t) (min-height . t) + (no-accept-focus . t) + (no-focus-on-map . t) + (border-width . 0) + (child-frame-border-width . 1) + (left-fringe . 0) + (right-fringe . 0) + (vertical-scroll-bars . nil) + (horizontal-scroll-bars . nil) + (menu-bar-lines . 0) + (tool-bar-lines . 0) + (tab-bar-lines . 0) + (no-other-frame . t) + (no-other-window . t) + (no-delete-other-windows . t) + (unsplittable . t) + (undecorated . t) + (cursor-type . nil) + (no-special-glyphs . t) + (desktop-dont-save . t))) + +(defun show-paren--delete-context-child-frame () + (when show-paren--context-child-frame + (delete-frame show-paren--context-child-frame) + (setq show-paren--context-child-frame nil)) + (remove-hook 'post-command-hook + #'show-paren--delete-context-child-frame)) + +(defun show-paren--show-context-in-child-frame (text) + "Show TEXT in a child-frame at the top-left of the current window." + (let ((minibuffer (minibuffer-window (window-frame))) + (buffer (show-paren--context-child-frame-buffer text)) + (x (window-pixel-left)) + (y (window-pixel-top)) + (window-min-height 1) + (window-min-width 1) + after-make-frame-functions) + (show-paren--delete-context-child-frame) + (setq show-paren--context-child-frame + (make-frame + `((parent-frame . ,(window-frame)) + (minibuffer . ,minibuffer) + ,@show-paren--context-child-frame-parameters))) + (let ((win (frame-root-window show-paren--context-child-frame))) + (set-window-buffer win buffer) + (set-window-dedicated-p win t) + (set-frame-size show-paren--context-child-frame + (string-width text) + (length (string-lines text))) + (set-frame-position show-paren--context-child-frame x y) + (make-frame-visible show-paren--context-child-frame) + (add-hook 'post-command-hook + #'show-paren--delete-context-child-frame)))) + +(defvar-local show-paren--context-overlay nil) + +(defun show-paren--delete-context-overlay () + (when show-paren--context-overlay + (delete-overlay show-paren--context-overlay) + (setq show-paren--context-overlay nil)) + (remove-hook 'post-command-hook #'show-paren--delete-overlays + 'local)) + +(defun show-paren--show-context-in-overlay (text) + "Show TEXT in an overlay at the top-left of the current window." + (setq text (replace-regexp-in-string "\n" " " text)) + (show-paren--delete-context-overlay) + (let* ((beg (window-start)) + (end (save-excursion + (goto-char beg) + (line-end-position)))) + (setq show-paren--context-overlay (make-overlay beg end))) + (overlay-put show-paren--context-overlay 'display text) + (overlay-put show-paren--context-overlay + 'face `(:box + ( :line-width (1 . -1) + :color ,(face-attribute 'shadow :foreground)))) + (add-hook 'post-command-hook #'show-paren--delete-context-overlay + nil 'local)) + +;; The last position of point for which `show-paren-function' was +;; called. We track it in order to C-g away a context overlay or +;; child-frame without having it pop up again after +;; `show-paren-delay'. +(defvar-local show-paren--last-pos nil) + (defun show-paren-function () "Highlight the parentheses until the next input arrives." (let ((data (and show-paren-mode (funcall show-paren-data-function)))) @@ -268,7 +412,8 @@ It is the default value of `show-paren-data-function'." ;; If show-paren-mode is nil in this buffer or if not at a paren that ;; has a match, turn off any previous paren highlighting. (delete-overlay show-paren--overlay) - (delete-overlay show-paren--overlay-1)) + (delete-overlay show-paren--overlay-1) + (setq show-paren--last-pos (point))) ;; Found something to highlight. (let* ((here-beg (nth 0 data)) @@ -299,8 +444,8 @@ It is the default value of `show-paren-data-function'." ;; Otherwise, turn off any such highlighting. (if (or (not here-beg) (and (not show-paren-highlight-openparen) - (> here-end (point)) - (<= here-beg (point)) + (> here-end (point)) + (<= here-beg (point)) (integerp there-beg))) (delete-overlay show-paren--overlay-1) (move-overlay show-paren--overlay-1 @@ -315,22 +460,32 @@ It is the default value of `show-paren-data-function'." (delete-overlay show-paren--overlay) (if highlight-expression (move-overlay show-paren--overlay - (if (< there-beg here-beg) here-end here-beg) + (if (< there-beg here-beg) here-end here-beg) (if (< there-beg here-beg) there-beg there-end) (current-buffer)) (move-overlay show-paren--overlay there-beg there-end (current-buffer))) - ;; If `show-paren-open-line-when-offscreen' is t and point - ;; is at a close paren, show the line that contains the - ;; openparen in the echo area. + ;; If `show-paren-context-when-offscreen' is non-nil and + ;; point is at a closing paren, show the context around the + ;; opening paren. (let ((openparen (min here-beg there-beg))) - (if (and show-paren-context-when-offscreen - (< there-beg here-beg) - (not (pos-visible-in-window-p openparen))) - (let ((open-paren-line-string - (blink-paren-open-paren-line-string openparen)) - (message-log-max nil)) - (minibuffer-message "Matches %s" open-paren-line-string)))) + (when (and show-paren-context-when-offscreen + (not (eql show-paren--last-pos (point))) + (< there-beg here-beg) + (not (pos-visible-in-window-p openparen))) + (let ((context (blink-paren-open-paren-line-string + openparen)) + (message-log-max nil)) + (cond + ((and + (eq show-paren-context-when-offscreen 'child-frame) + (display-graphic-p)) + (show-paren--show-context-in-child-frame context)) + ((eq show-paren-context-when-offscreen 'overlay) + (show-paren--show-context-in-overlay context)) + (show-paren-context-when-offscreen + (minibuffer-message "Matches %s" context)))))) + (setq show-paren--last-pos (point)) ;; Always set the overlay face, since it varies. (overlay-put show-paren--overlay 'priority show-paren-priority) (overlay-put show-paren--overlay 'face face)))))) diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index d0ae9390e31..3c9bf1ec9d2 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -134,7 +134,7 @@ Return the new list." "Add to TARGETS the list of target names in MAKEFILE and files it includes. Return the new list." (with-temp-buffer - (with-demoted-errors ;Could be a directory or something. + (with-demoted-errors "Error inserting makefile: %S" (insert-file-contents makefile)) (let ((filenames (when pcmpl-gnu-makefile-includes (pcmpl-gnu-make-includes)))) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index e8b637ba1a1..463e106c7ac 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -32,8 +32,10 @@ ;;; Commentary: -;; This package offers a global minor mode which makes mouse-wheel -;; scroll a line smoothly. +;; This file contains two somewhat related features. + +;; The first is a global minor mode which makes Emacs try to scroll +;; each line smoothly. ;; ;; Scrolling a line up by `set-window-vscroll' and that by `scroll-up' ;; give similar display as shown below. @@ -58,6 +60,25 @@ ;; (set-window-vscroll nil vs t) (sit-for 0)) ;; (scroll-up 1) +;; The second is another global minor mode that redefines `wheel-up' +;; and `wheel-down' to a command that tries to scroll the display +;; according to the precise movement of a trackpad or mouse. + +;; But it operates in a much more intelligent manner than simply +;; setting the vscroll. It will set window start to the position +;; closest to the position at the top-left corner of the window if +;; vscroll were set accordingly, in a smart and fast manner, and only +;; set vscroll the rest of the way. There is no visible difference, +;; but it is much faster, and doesn't move the display by a huge +;; portion if vscroll is reset for some reason. + +;; It also tries to move point out of the way, so redisplay will not +;; recenter the display as it scrolls. This works well almost all of +;; the time, but is impossible to get right with images larger than +;; the window they're displayed in. A feature that will allow +;; redisplay to skip recentering is in the works, and will completely +;; resolve this problem. + ;;; Todo: ;; ;; Allowing pixel-level scrolling in Emacs requires a thorough review @@ -678,11 +699,12 @@ wheel." (message (error-message-string '(end-of-buffer)))))))))) (mwheel-scroll event nil)))) -(defun pixel-scroll-kinetic-state () - "Return the kinetic scroll state of the current window. +(defun pixel-scroll-kinetic-state (&optional window) + "Return the kinetic scroll state of WINDOW. +If WINDOW is nil, return the state of the current window. It is a vector of the form [ VELOCITY TIME SIGN ]." - (or (window-parameter nil 'kinetic-state) - (set-window-parameter nil 'kinetic-state + (or (window-parameter window 'kinetic-state) + (set-window-parameter window 'kinetic-state (vector (make-ring 30) nil nil)))) (defun pixel-scroll-accumulate-velocity (delta) @@ -716,53 +738,54 @@ It is a vector of the form [ VELOCITY TIME SIGN ]." (when pixel-scroll-precision-use-momentum (let ((window (mwheel-event-window event)) (state nil)) - (with-selected-window window - (setq state (pixel-scroll-kinetic-state)) - (when (and (aref state 1) - (listp (aref state 0))) - (condition-case nil - (while-no-input - (unwind-protect (progn - (aset state 0 (pixel-scroll-calculate-velocity state)) - (when (> (abs (aref state 0)) - pixel-scroll-precision-momentum-min-velocity) - (let* ((velocity (aref state 0)) - (original-velocity velocity) - (time-spent 0)) - (if (> velocity 0) - (while (and (> velocity 0) - (<= time-spent - pixel-scroll-precision-momentum-seconds)) - (when (> (round velocity) 0) - (pixel-scroll-precision-scroll-up (round velocity))) - (setq velocity (- velocity - (/ original-velocity - (/ pixel-scroll-precision-momentum-seconds - pixel-scroll-precision-momentum-tick)))) - (redisplay t) - (sit-for pixel-scroll-precision-momentum-tick) - (setq time-spent (+ time-spent - pixel-scroll-precision-momentum-tick)))) - (while (and (< velocity 0) - (<= time-spent - pixel-scroll-precision-momentum-seconds)) - (when (> (round (abs velocity)) 0) + (setq state (pixel-scroll-kinetic-state window)) + (when (and (aref state 1) + (listp (aref state 0))) + (condition-case nil + (while-no-input + (unwind-protect (progn + (aset state 0 (pixel-scroll-calculate-velocity state)) + (when (> (abs (aref state 0)) + pixel-scroll-precision-momentum-min-velocity) + (let* ((velocity (aref state 0)) + (original-velocity velocity) + (time-spent 0)) + (if (> velocity 0) + (while (and (> velocity 0) + (<= time-spent + pixel-scroll-precision-momentum-seconds)) + (when (> (round velocity) 0) + (with-selected-window window + (pixel-scroll-precision-scroll-up (round velocity)))) + (setq velocity (- velocity + (/ original-velocity + (/ pixel-scroll-precision-momentum-seconds + pixel-scroll-precision-momentum-tick)))) + (redisplay t) + (sit-for pixel-scroll-precision-momentum-tick) + (setq time-spent (+ time-spent + pixel-scroll-precision-momentum-tick)))) + (while (and (< velocity 0) + (<= time-spent + pixel-scroll-precision-momentum-seconds)) + (when (> (round (abs velocity)) 0) + (with-selected-window window (pixel-scroll-precision-scroll-down (round - (abs velocity)))) - (setq velocity (+ velocity - (/ (abs original-velocity) - (/ pixel-scroll-precision-momentum-seconds - pixel-scroll-precision-momentum-tick)))) - (redisplay t) - (sit-for pixel-scroll-precision-momentum-tick) - (setq time-spent (+ time-spent - pixel-scroll-precision-momentum-tick)))))) - (aset state 0 (make-ring 30)) - (aset state 1 nil))) - (beginning-of-buffer - (message (error-message-string '(beginning-of-buffer)))) - (end-of-buffer - (message (error-message-string '(end-of-buffer)))))))))) + (abs velocity))))) + (setq velocity (+ velocity + (/ (abs original-velocity) + (/ pixel-scroll-precision-momentum-seconds + pixel-scroll-precision-momentum-tick)))) + (redisplay t) + (sit-for pixel-scroll-precision-momentum-tick) + (setq time-spent (+ time-spent + pixel-scroll-precision-momentum-tick)))))) + (aset state 0 (make-ring 30)) + (aset state 1 nil))) + (beginning-of-buffer + (message (error-message-string '(beginning-of-buffer)))) + (end-of-buffer + (message (error-message-string '(end-of-buffer))))))))) (defun pixel-scroll-interpolate-down () "Interpolate a scroll downwards by one page." diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 7ef2500e46b..6bac297a298 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -71,8 +71,8 @@ "doskey" "echo" "endlocal" "erase" "fc" "find" "findstr" "format" "ftype" "label" "md" "mkdir" "more" "move" "net" "path" "pause" "popd" "prompt" "pushd" "rd" "ren" "rename" "replace" "rmdir" "set" - "setlocal" "shift" "sort" "subst" "time" "title" "tree" "type" - "ver" "vol" "xcopy")) + "setlocal" "setx" "shift" "sort" "subst" "time" "title" "tree" + "type" "ver" "vol" "xcopy")) (CONTROLFLOW '("call" "cmd" "defined" "do" "else" "equ" "exist" "exit" "for" "geq" "goto" "gtr" "if" "in" "leq" "lss" "neq" "not" "start")) @@ -82,7 +82,7 @@ (2 font-lock-constant-face t)) ("^:[^:].*" . 'bat-label-face) - ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" + ("\\_<\\(defined\\|set\\|setx\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" (2 font-lock-variable-name-face)) ("%~\\([0-9]\\)" (1 font-lock-variable-name-face)) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 230d39efeeb..15e3beb8377 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2253,12 +2253,13 @@ higher." ;; redisplay. (defvar c-re-redisplay-timer nil) -(defun c-force-redisplay (start end) +(defun c-force-redisplay (buffer start end) ;; Force redisplay immediately. This assumes `font-lock-support-mode' is ;; 'jit-lock-mode. Set the variable `c-re-redisplay-timer' to nil. - (save-excursion (c-font-lock-fontify-region start end)) - (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) - (setq c-re-redisplay-timer nil)) + (with-current-buffer buffer + (save-excursion (c-font-lock-fontify-region start end)) + (jit-lock-force-redisplay (copy-marker start) (copy-marker end)) + (setq c-re-redisplay-timer nil))) (defun c-fontify-new-found-type (type) ;; Cause the fontification of TYPE, a string, wherever it occurs in the @@ -2288,6 +2289,7 @@ higher." (not c-re-redisplay-timer)) (setq c-re-redisplay-timer (run-with-timer 0 nil #'c-force-redisplay + (current-buffer) (match-beginning 0) (match-end 0))))))))))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 3a3413dc36a..957a0b8a7c5 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -798,43 +798,44 @@ MODE is the symbol for the mode to initialize, like `c-mode'. See `c-basic-common-init' for details. It's only optional to be compatible with old code; callers should always specify it." - (unless mode - ;; Called from an old third party package. The fallback is to - ;; initialize for C. - (c-init-language-vars-for 'c-mode)) - - (c-basic-common-init mode c-default-style) - (when mode - ;; Only initialize font locking if we aren't called from an old package. - (c-font-lock-init)) - - ;; Starting a mode is a sort of "change". So call the change functions... - (save-restriction - (widen) - (setq c-new-BEG (point-min)) - (setq c-new-END (point-max)) - (save-excursion - (let (before-change-functions after-change-functions) - (mapc (lambda (fn) - (funcall fn (point-min) (point-max))) - c-get-state-before-change-functions) - (mapc (lambda (fn) - (funcall fn (point-min) (point-max) - (- (point-max) (point-min)))) - c-before-font-lock-functions)))) - - (set (make-local-variable 'outline-regexp) "[^#\n\^M]") - (set (make-local-variable 'outline-level) 'c-outline-level) - (set (make-local-variable 'add-log-current-defun-function) - (lambda () - (or (c-cpp-define-name) (car (c-defun-name-and-limits nil))))) - (let ((rfn (assq mode c-require-final-newline))) - (when rfn - (if (boundp 'mode-require-final-newline) - (and (cdr rfn) - (set (make-local-variable 'require-final-newline) - mode-require-final-newline)) - (set (make-local-variable 'require-final-newline) (cdr rfn)))))) + (let (case-fold-search) + (unless mode + ;; Called from an old third party package. The fallback is to + ;; initialize for C. + (c-init-language-vars-for 'c-mode)) + + (c-basic-common-init mode c-default-style) + (when mode + ;; Only initialize font locking if we aren't called from an old package. + (c-font-lock-init)) + + ;; Starting a mode is a sort of "change". So call the change functions... + (save-restriction + (widen) + (setq c-new-BEG (point-min)) + (setq c-new-END (point-max)) + (save-excursion + (let (before-change-functions after-change-functions) + (mapc (lambda (fn) + (funcall fn (point-min) (point-max))) + c-get-state-before-change-functions) + (mapc (lambda (fn) + (funcall fn (point-min) (point-max) + (- (point-max) (point-min)))) + c-before-font-lock-functions)))) + + (set (make-local-variable 'outline-regexp) "[^#\n\^M]") + (set (make-local-variable 'outline-level) 'c-outline-level) + (set (make-local-variable 'add-log-current-defun-function) + (lambda () + (or (c-cpp-define-name) (car (c-defun-name-and-limits nil))))) + (let ((rfn (assq mode c-require-final-newline))) + (when rfn + (if (boundp 'mode-require-final-newline) + (and (cdr rfn) + (set (make-local-variable 'require-final-newline) + mode-require-final-newline)) + (set (make-local-variable 'require-final-newline) (cdr rfn))))))) (defun c-count-cfss (lv-alist) ;; LV-ALIST is an alist like `file-local-variables-alist'. Count how many diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 8f33b3e3b73..94ecc45b15f 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3834,7 +3834,7 @@ recursive calls in starting lines of here-documents." "\\<" cperl-sub-regexp "\\>" ; sub with proto/attr "\\(" cperl-white-and-comment-rex - (rx (group (eval cperl--normal-identifier-rx))) + (rx (opt (group (eval cperl--normal-identifier-rx)))) "\\)" "\\(" cperl-maybe-white-and-comment-rex diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 0c16ddedcbe..83d7bc8641c 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -4,9 +4,9 @@ ;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> ;; Maintainer: João Távora <joaotavora@gmail.com> -;; Version: 1.2.1 +;; Version: 1.2.2 ;; Keywords: c languages tools -;; Package-Requires: ((emacs "28.1") (eldoc "1.1.0") (project "0.7.1")) +;; Package-Requires: ((emacs "26.1") (eldoc "1.1.0") (project "0.7.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not ;; compatible with the version of Emacs recorded above. @@ -267,8 +267,8 @@ If set to nil, don't suppress any zero counters." (format " [%s %s]" (or sublog 'flymake) ;; Handle file names with "%" correctly. (Bug#51549) - (string-replace "%" "%%" - (buffer-name (current-buffer)))))) + (replace-regexp-in-string "%" "%%" + (buffer-name (current-buffer)))))) (display-warning (list 'flymake sublog) (apply #'format-message msg args) (if (numberp level) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index ecc9386cae3..7b7c675873b 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -879,7 +879,8 @@ startup file, `~/.emacs-octave'." (set-process-filter proc 'comint-output-filter) ;; Just in case, to be sure a cd in the startup file won't have ;; detrimental effects. - (with-demoted-errors (inferior-octave-resync-dirs)) + (with-demoted-errors "Octave resync error: %S" + (inferior-octave-resync-dirs)) ;; Generate a proper prompt, which is critical to ;; `comint-history-isearch-backward-regexp'. Bug#14433. (comint-send-string proc "\n"))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index c812f28c1bb..880c5b55179 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. ;; Version: 0.8.1 -;; Package-Requires: ((emacs "26.1") (xref "1.0.2")) +;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that ;; not compatible with the version of Emacs recorded above. @@ -776,7 +776,6 @@ The following commands are available: (define-key tab-prefix-map "p" #'project-other-tab-command)) (declare-function grep-read-files "grep") -(declare-function xref--show-xrefs "xref") (declare-function xref--find-ignores-arguments "xref") ;;;###autoload @@ -802,7 +801,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." (project--files-in-directory dir nil (grep-read-files regexp)))))) - (xref--show-xrefs + (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) @@ -830,7 +829,7 @@ pattern to search for." (project-files pr (cons (project-root pr) (project-external-roots pr))))) - (xref--show-xrefs + (xref-show-xrefs (apply-partially #'project--find-regexp-in-files regexp files) nil))) @@ -1072,9 +1071,10 @@ Stops when a match is found and prompts for whether to replace it. If you exit the `query-replace', you can later continue the `query-replace' loop using the command \\[fileloop-continue]." (interactive - (pcase-let ((`(,from ,to) - (query-replace-read-args "Query replace (regexp)" t t))) - (list from to))) + (let ((query-replace-read-from-regexp-default 'find-tag-default-as-regexp)) + (pcase-let ((`(,from ,to) + (query-replace-read-args "Query replace (regexp)" t t))) + (list from to)))) (fileloop-initialize-replace from to (project-files (project-current t)) 'default) (fileloop-continue)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5889f2ab670..d83290fe457 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -92,7 +92,7 @@ ;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7. ;; See URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To ;; avoid this, the `python-shell-unbuffered' defaults to non-nil and -;; controls whether `python-shell-calculate-process-environment' +;; controls whether `python-shell--calculate-process-environment' ;; should set the "PYTHONUNBUFFERED" environment variable on startup: ;; See URL `https://docs.python.org/3/using/cmdline.html#cmdoption-u'. @@ -149,7 +149,7 @@ ;; (setq python-shell-process-environment ;; (list ;; (format "PATH=%s" (mapconcat -;; 'identity +;; #'identity ;; (reverse ;; (cons (getenv "PATH") ;; '("/path/to/env/bin/"))) @@ -245,7 +245,7 @@ (require 'ansi-color) (require 'cl-lib) (require 'comint) -(require 'tramp-sh) +(eval-when-compile (require 'subr-x)) ;For `string-empty-p'. ;; Avoid compiler warnings (defvar view-return-to-alist) @@ -273,39 +273,39 @@ (defvar python-mode-map (let ((map (make-sparse-keymap))) ;; Movement - (define-key map [remap backward-sentence] 'python-nav-backward-block) - (define-key map [remap forward-sentence] 'python-nav-forward-block) - (define-key map [remap backward-up-list] 'python-nav-backward-up-list) - (define-key map [remap mark-defun] 'python-mark-defun) - (define-key map "\C-c\C-j" 'imenu) + (define-key map [remap backward-sentence] #'python-nav-backward-block) + (define-key map [remap forward-sentence] #'python-nav-forward-block) + (define-key map [remap backward-up-list] #'python-nav-backward-up-list) + (define-key map [remap mark-defun] #'python-mark-defun) + (define-key map "\C-c\C-j" #'imenu) ;; Indent specific - (define-key map "\177" 'python-indent-dedent-line-backspace) - (define-key map (kbd "<backtab>") 'python-indent-dedent-line) - (define-key map "\C-c<" 'python-indent-shift-left) - (define-key map "\C-c>" 'python-indent-shift-right) + (define-key map "\177" #'python-indent-dedent-line-backspace) + (define-key map (kbd "<backtab>") #'python-indent-dedent-line) + (define-key map "\C-c<" #'python-indent-shift-left) + (define-key map "\C-c>" #'python-indent-shift-right) ;; Skeletons - (define-key map "\C-c\C-tc" 'python-skeleton-class) - (define-key map "\C-c\C-td" 'python-skeleton-def) - (define-key map "\C-c\C-tf" 'python-skeleton-for) - (define-key map "\C-c\C-ti" 'python-skeleton-if) - (define-key map "\C-c\C-tm" 'python-skeleton-import) - (define-key map "\C-c\C-tt" 'python-skeleton-try) - (define-key map "\C-c\C-tw" 'python-skeleton-while) + (define-key map "\C-c\C-tc" #'python-skeleton-class) + (define-key map "\C-c\C-td" #'python-skeleton-def) + (define-key map "\C-c\C-tf" #'python-skeleton-for) + (define-key map "\C-c\C-ti" #'python-skeleton-if) + (define-key map "\C-c\C-tm" #'python-skeleton-import) + (define-key map "\C-c\C-tt" #'python-skeleton-try) + (define-key map "\C-c\C-tw" #'python-skeleton-while) ;; Shell interaction - (define-key map "\C-c\C-p" 'run-python) - (define-key map "\C-c\C-s" 'python-shell-send-string) - (define-key map "\C-c\C-e" 'python-shell-send-statement) - (define-key map "\C-c\C-r" 'python-shell-send-region) - (define-key map "\C-\M-x" 'python-shell-send-defun) - (define-key map "\C-c\C-c" 'python-shell-send-buffer) - (define-key map "\C-c\C-l" 'python-shell-send-file) - (define-key map "\C-c\C-z" 'python-shell-switch-to-shell) + (define-key map "\C-c\C-p" #'run-python) + (define-key map "\C-c\C-s" #'python-shell-send-string) + (define-key map "\C-c\C-e" #'python-shell-send-statement) + (define-key map "\C-c\C-r" #'python-shell-send-region) + (define-key map "\C-\M-x" #'python-shell-send-defun) + (define-key map "\C-c\C-c" #'python-shell-send-buffer) + (define-key map "\C-c\C-l" #'python-shell-send-file) + (define-key map "\C-c\C-z" #'python-shell-switch-to-shell) ;; Some util commands - (define-key map "\C-c\C-v" 'python-check) - (define-key map "\C-c\C-f" 'python-eldoc-at-point) - (define-key map "\C-c\C-d" 'python-describe-at-point) + (define-key map "\C-c\C-v" #'python-check) + (define-key map "\C-c\C-f" #'python-eldoc-at-point) + (define-key map "\C-c\C-d" #'python-describe-at-point) ;; Utilities - (substitute-key-definition 'complete-symbol 'completion-at-point + (substitute-key-definition #'complete-symbol #'completion-at-point map global-map) (easy-menu-define python-menu map "Python Mode menu" '("Python" @@ -825,7 +825,6 @@ It makes underscores and dots word constituent chars.") (defcustom python-indent-offset 4 "Default indentation offset for Python." - :group 'python :type 'integer :safe 'integerp) @@ -835,21 +834,18 @@ It makes underscores and dots word constituent chars.") (defcustom python-indent-guess-indent-offset t "Non-nil tells Python mode to guess `python-indent-offset' value." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-indent-guess-indent-offset-verbose t "Non-nil means to emit a warning when indentation guessing fails." :version "25.1" :type 'boolean - :group 'python :safe' booleanp) (defcustom python-indent-trigger-commands '(indent-for-tab-command yas-expand yas/expand) "Commands that might trigger a `python-indent-line' call." - :type '(repeat symbol) - :group 'python) + :type '(repeat symbol)) (defcustom python-indent-def-block-scale 2 "Multiplier applied to indentation inside multi-line def blocks." @@ -2031,7 +2027,6 @@ position, else returns nil." (defcustom python-shell-buffer-name "Python" "Default buffer name for Python interpreter." :type 'string - :group 'python :safe 'stringp) (defcustom python-shell-interpreter @@ -2045,19 +2040,16 @@ Some Python interpreters also require changes to `python-shell-interpreter' to \"ipython3\" requires setting `python-shell-interpreter-args' to \"--simple-prompt\"." :version "28.1" - :type 'string - :group 'python) + :type 'string) (defcustom python-shell-internal-buffer-name "Python Internal" "Default buffer name for the Internal Python interpreter." :type 'string - :group 'python :safe 'stringp) (defcustom python-shell-interpreter-args "-i" "Default arguments for the Python interpreter." - :type 'string - :group 'python) + :type 'string) (defcustom python-shell-interpreter-interactive-arg "-i" "Interpreter argument to force it to run interactively." @@ -2122,7 +2114,6 @@ It should not contain a caret (^) at the beginning." "Should syntax highlighting be enabled in the Python shell buffer? Restart the Python shell after changing this variable for it to take effect." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-shell-unbuffered t @@ -2130,7 +2121,6 @@ Restart the Python shell after changing this variable for it to take effect." When non-nil, this may prevent delayed and missing output in the Python shell. See commentary for details." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-shell-process-environment nil @@ -2140,8 +2130,7 @@ When this variable is non-nil, values are exported into the process environment before starting it. Any variables already present in the current environment are superseded by variables set here." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-extra-pythonpaths nil "List of extra pythonpaths for Python shell. @@ -2150,8 +2139,7 @@ the PYTHONPATH before starting processes. Any values present here that already exists in PYTHONPATH are moved to the beginning of the list so that they are prioritized when looking for modules." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-exec-path nil "List of paths for searching executables. @@ -2159,8 +2147,7 @@ When this variable is non-nil, values added at the beginning of the PATH before starting processes. Any values present here that already exists in PATH are moved to the beginning of the list so that they are prioritized when looking for executables." - :type '(repeat string) - :group 'python) + :type '(repeat string)) (defcustom python-shell-remote-exec-path nil "List of paths to be ensured remotely for searching executables. @@ -2171,8 +2158,7 @@ here. Normally you won't use this variable directly unless you plan to ensure a particular set of paths to all Python shell executed through tramp connections." :version "25.1" - :type '(repeat string) - :group 'python) + :type '(repeat string)) (define-obsolete-variable-alias 'python-shell-virtualenv-path 'python-shell-virtualenv-root "25.1") @@ -2182,13 +2168,11 @@ executed through tramp connections." This variable, when set to a string, makes the environment to be modified such that shells are started within the specified virtualenv." - :type '(choice (const nil) directory) - :group 'python) + :type '(choice (const nil) directory)) (defcustom python-shell-setup-codes nil "List of code run by `python-shell-send-setup-code'." - :type '(repeat symbol) - :group 'python) + :type '(repeat symbol)) (defcustom python-shell-compilation-regexp-alist `((,(rx line-start (1+ (any " \t")) "File \"" @@ -2202,8 +2186,7 @@ virtualenv." "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()") 1 2)) "`compilation-error-regexp-alist' for inferior Python." - :type '(alist regexp) - :group 'python) + :type '(alist regexp)) (defvar python-shell-output-filter-in-progress nil) (defvar python-shell-output-filter-buffer nil) @@ -2221,33 +2204,34 @@ virtualenv." (or (getenv "PYTHONPATH") "") path-separator 'omit))) (python-shell--add-to-path-with-priority pythonpath python-shell-extra-pythonpaths) - (mapconcat 'identity pythonpath path-separator))) + (mapconcat #'identity pythonpath path-separator))) (defun python-shell-calculate-process-environment () - "Calculate `process-environment' or `tramp-remote-process-environment'. + (declare (obsolete python-shell--calculate-process-environment "29.1")) + (defvar tramp-remote-process-environment) + (let* ((remote-p (file-remote-p default-directory))) + (append (python-shell--calculate-process-environment) + (if remote-p + tramp-remote-process-environment + process-environment)))) + +(defun python-shell--calculate-process-environment () + "Return a list of entries to add to the `process-environment'. Prepends `python-shell-process-environment', sets extra pythonpaths from `python-shell-extra-pythonpaths' and sets a few -virtualenv related vars. If `default-directory' points to a -remote host, the returned value is intended for -`tramp-remote-process-environment'." - (let* ((remote-p (file-remote-p default-directory)) - (process-environment (if remote-p - tramp-remote-process-environment - process-environment)) - (virtualenv (when python-shell-virtualenv-root - (directory-file-name python-shell-virtualenv-root)))) - (dolist (env python-shell-process-environment) - (pcase-let ((`(,key ,value) (split-string env "="))) - (setenv key value))) +virtualenv related vars." + (let* ((virtualenv (when python-shell-virtualenv-root + (directory-file-name python-shell-virtualenv-root))) + (res python-shell-process-environment)) (when python-shell-unbuffered - (setenv "PYTHONUNBUFFERED" "1")) + (push "PYTHONUNBUFFERED=1" res)) (when python-shell-extra-pythonpaths - (setenv "PYTHONPATH" (python-shell-calculate-pythonpath))) + (push (concat "PYTHONPATH=" (python-shell-calculate-pythonpath)) res)) (if (not virtualenv) - process-environment - (setenv "PYTHONHOME" nil) - (setenv "VIRTUAL_ENV" virtualenv)) - process-environment)) + nil + (push "PYTHONHOME" res) + (push (concat "VIRTUAL_ENV=" virtualenv) res)) + res)) (defun python-shell-calculate-exec-path () "Calculate `exec-path'. @@ -2275,14 +2259,26 @@ of `exec-path'." (defun python-shell-tramp-refresh-remote-path (vec paths) "Update VEC's remote-path giving PATHS priority." + (cl-assert (featurep 'tramp)) + (declare-function tramp-set-remote-path "tramp-sh") + (declare-function tramp-set-connection-property "tramp-cache") + (declare-function tramp-get-connection-property "tramp-cache") (let ((remote-path (tramp-get-connection-property vec "remote-path" nil))) (when remote-path + ;; FIXME: This part of the Tramp code still knows about Python! (python-shell--add-to-path-with-priority remote-path paths) (tramp-set-connection-property vec "remote-path" remote-path) (tramp-set-remote-path vec)))) + (defun python-shell-tramp-refresh-process-environment (vec env) "Update VEC's process environment with ENV." + (cl-assert (featurep 'tramp)) + (defvar tramp-end-of-heredoc) + (defvar tramp-end-of-output) + ;; Do we even know that `tramp-sh' is loaded at this point? + ;; What about files accessed via FTP, sudo, ...? + (declare-function tramp-send-command "tramp-sh") ;; Stolen from `tramp-open-connection-setup-interactive-shell'. (let ((env (append (when (fboundp 'tramp-get-remote-locale) ;; Emacs<24.4 compat. @@ -2295,7 +2291,7 @@ of `exec-path'." unset vars item) (while env (setq item (split-string (car env) "=" 'omit)) - (setcdr item (mapconcat 'identity (cdr item) "=")) + (setcdr item (mapconcat #'identity (cdr item) "=")) (if (and (stringp (cdr item)) (not (string-equal (cdr item) ""))) (push (format "%s %s" (car item) (cdr item)) vars) (push (car item) unset)) @@ -2305,12 +2301,12 @@ of `exec-path'." vec (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s" tramp-end-of-heredoc - (mapconcat 'identity vars "\n") + (mapconcat #'identity vars "\n") tramp-end-of-heredoc) t)) (when unset (tramp-send-command - vec (format "unset %s" (mapconcat 'identity unset " ")) t)))) + vec (format "unset %s" (mapconcat #'identity unset " ")) t)))) (defmacro python-shell-with-environment (&rest body) "Modify shell environment during execution of BODY. @@ -2319,41 +2315,49 @@ execution of body. If `default-directory' points to a remote machine then modifies `tramp-remote-process-environment' and `python-shell-remote-exec-path' instead." (declare (indent 0) (debug (body))) - (let ((vec (make-symbol "vec"))) - `(progn - (let* ((,vec - (when (file-remote-p default-directory) - (ignore-errors - (tramp-dissect-file-name default-directory 'noexpand)))) - (process-environment - (if ,vec - process-environment - (python-shell-calculate-process-environment))) - (exec-path - (if ,vec - exec-path - (python-shell-calculate-exec-path))) - (tramp-remote-process-environment - (if ,vec - (python-shell-calculate-process-environment) - tramp-remote-process-environment))) - (when (tramp-get-connection-process ,vec) - ;; For already existing connections, the new exec path must - ;; be re-set, otherwise it won't take effect. One example - ;; of such case is when remote dir-locals are read and - ;; *then* subprocesses are triggered within the same - ;; connection. - (python-shell-tramp-refresh-remote-path - ,vec (python-shell-calculate-exec-path)) - ;; The `tramp-remote-process-environment' variable is only - ;; effective when the started process is an interactive - ;; shell, otherwise (like in the case of processes started - ;; with `process-file') the environment is not changed. - ;; This makes environment modifications effective - ;; unconditionally. - (python-shell-tramp-refresh-process-environment - ,vec tramp-remote-process-environment)) - ,(macroexp-progn body))))) + `(python-shell--with-environment + (python-shell--calculate-process-environment) + (lambda () ,@body))) + +(defun python-shell--with-environment (extraenv bodyfun) + ;; FIXME: This is where the generic code delegates to Tramp. + (let* ((vec + (and (file-remote-p default-directory) + (fboundp 'tramp-dissect-file-name) + (ignore-errors + (tramp-dissect-file-name default-directory 'noexpand))))) + (if vec + (python-shell--tramp-with-environment vec extraenv bodyfun) + (let ((process-environment + (append extraenv process-environment)) + (exec-path + ;; FIXME: This is still Python-specific. + (python-shell-calculate-exec-path))) + (funcall bodyfun))))) + +(defun python-shell--tramp-with-environment (vec extraenv bodyfun) + (defvar tramp-remote-process-environment) + (declare-function tramp-get-connection-process "tramp" (vec)) + (let* ((tramp-remote-process-environment + (append extraenv tramp-remote-process-environment))) + (when (tramp-get-connection-process vec) + ;; For already existing connections, the new exec path must + ;; be re-set, otherwise it won't take effect. One example + ;; of such case is when remote dir-locals are read and + ;; *then* subprocesses are triggered within the same + ;; connection. + (python-shell-tramp-refresh-remote-path + ;; FIXME: This is still Python-specific. + vec (python-shell-calculate-exec-path)) + ;; The `tramp-remote-process-environment' variable is only + ;; effective when the started process is an interactive + ;; shell, otherwise (like in the case of processes started + ;; with `process-file') the environment is not changed. + ;; This makes environment modifications effective + ;; unconditionally. + (python-shell-tramp-refresh-process-environment + vec tramp-remote-process-environment)) + (funcall bodyfun))) (defvar python-shell--prompt-calculated-input-regexp nil "Calculated input prompt regexp for inferior python shell. @@ -2636,7 +2640,7 @@ banner and the initial prompt are received separately." (define-obsolete-function-alias 'python-comint-output-filter-function - 'ansi-color-filter-apply + #'ansi-color-filter-apply "25.1") (defun python-comint-postoutput-scroll-to-bottom (output) @@ -2821,8 +2825,7 @@ current process to not hang while waiting. This is useful to safely attach setup code for long-running processes that eventually provide a shell." :version "25.1" - :type 'hook - :group 'python) + :type 'hook) (defconst python-shell-eval-setup-code "\ @@ -2956,7 +2959,7 @@ variable. (add-hook 'completion-at-point-functions #'python-shell-completion-at-point nil 'local) (define-key inferior-python-mode-map "\t" - 'python-shell-completion-complete-or-indent) + #'python-shell-completion-complete-or-indent) (make-local-variable 'python-shell-internal-last-output) (when python-shell-font-lock-enable (python-shell-font-lock-turn-on)) @@ -2982,7 +2985,8 @@ killed." (let* ((cmdlist (split-string-and-unquote cmd)) (interpreter (car cmdlist)) (args (cdr cmdlist)) - (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name + (buffer (apply #'make-comint-in-buffer proc-name + proc-buffer-name interpreter nil args)) (python-shell--parent-buffer (current-buffer)) (process (get-buffer-process buffer)) @@ -3131,7 +3135,7 @@ there for compatibility with CEDET.") (run-python-internal)))) (define-obsolete-function-alias - 'python-proc 'python-shell-internal-get-or-create-process "24.3") + 'python-proc #'python-shell-internal-get-or-create-process "24.3") (defun python-shell--save-temp-file (string) (let* ((temporary-file-directory @@ -3250,10 +3254,10 @@ Returns the output. See `python-shell-send-string-no-output'." (python-shell-internal-get-or-create-process)))) (define-obsolete-function-alias - 'python-send-receive 'python-shell-internal-send-string "24.3") + 'python-send-receive #'python-shell-internal-send-string "24.3") (define-obsolete-function-alias - 'python-send-string 'python-shell-internal-send-string "24.3") + 'python-send-string #'python-shell-internal-send-string "24.3") (defun python-shell-buffer-substring (start end &optional nomain no-cookie) "Send buffer substring from START to END formatted for shell. @@ -3549,8 +3553,7 @@ def __PYTHON_EL_get_completions(text): completer.print_mode = True return completions" "Code used to setup completion in inferior Python processes." - :type 'string - :group 'python) + :type 'string) (define-obsolete-variable-alias 'python-shell-completion-module-string-code @@ -3823,7 +3826,8 @@ With argument MSG show activation/deactivation message." ;; in use based on its args and uses `apply-partially' ;; to make it up for the 3 args case. (if (= (length - (help-function-arglist 'comint-redirect-filter)) 3) + (help-function-arglist 'comint-redirect-filter)) + 3) (set-process-filter process (apply-partially #'comint-redirect-filter original-filter-fn)) @@ -3932,7 +3936,7 @@ using that one instead of current buffer's process." (define-obsolete-function-alias 'python-shell-completion-complete-at-point - 'python-shell-completion-at-point + #'python-shell-completion-at-point "25.1") (defun python-shell-completion-complete-or-indent () @@ -3961,7 +3965,6 @@ considered over. The overlay arrow will be removed from the currently tracked buffer. Additionally, if `python-pdbtrack-kill-buffers' is non-nil, all files opened by pdbtracking will be killed." :type 'boolean - :group 'python :safe 'booleanp) (defcustom python-pdbtrack-stacktrace-info-regexp @@ -4170,7 +4173,7 @@ inferior Python process is updated properly." (define-obsolete-function-alias 'python-completion-complete-at-point - 'python-completion-at-point + #'python-completion-at-point "25.1") @@ -4180,29 +4183,25 @@ inferior Python process is updated properly." "Function to fill comments. This is the function used by `python-fill-paragraph' to fill comments." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-string-function 'python-fill-string "Function to fill strings. This is the function used by `python-fill-paragraph' to fill strings." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-decorator-function 'python-fill-decorator "Function to fill decorators. This is the function used by `python-fill-paragraph' to fill decorators." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-paren-function 'python-fill-paren "Function to fill parens. This is the function used by `python-fill-paragraph' to fill parens." - :type 'symbol - :group 'python) + :type 'symbol) (defcustom python-fill-docstring-style 'pep-257 "Style used to fill docstrings. @@ -4272,7 +4271,6 @@ value may result in one of the following docstring styles: (const :tag "PEP-257 with 2 newlines at end of string." pep-257) (const :tag "PEP-257 with 1 newline at end of string." pep-257-nn) (const :tag "Symmetric style." symmetric)) - :group 'python :safe (lambda (val) (memq val '(django onetwo pep-257 pep-257-nn symmetric nil)))) @@ -4431,7 +4429,6 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." This happens when pressing \"if<SPACE>\", for example, to prompt for the if condition." :type 'boolean - :group 'python :safe 'booleanp) (defvar python-skeleton-available '() @@ -4556,7 +4553,7 @@ The skeleton will be bound to python-skeleton-NAME." (defun python-skeleton-add-menu-items () "Add menu items to Python->Skeletons menu." - (let ((skeletons (sort python-skeleton-available 'string<))) + (let ((skeletons (sort python-skeleton-available #'string<))) (dolist (skeleton skeletons) (easy-menu-add-item nil '("Python" "Skeletons") @@ -4586,8 +4583,7 @@ def __FFAP_get_module_path(objstr): except: return ''" "Python code to get a module path." - :type 'string - :group 'python) + :type 'string) (defun python-ffap-module-path (module) "Function for `ffap-alist' to return path for MODULE." @@ -4615,14 +4611,12 @@ def __FFAP_get_module_path(objstr): (executable-find "epylint") "install pyflakes, pylint or something else") "Command used to check a Python file." - :type 'string - :group 'python) + :type 'string) (defcustom python-check-buffer-name "*Python check: %s*" "Buffer name used for check commands." - :type 'string - :group 'python) + :type 'string) (defvar python-check-custom-command nil "Internal use.") @@ -4689,8 +4683,7 @@ See `python-check-command' for the default." doc = '' return doc" "Python code to setup documentation retrieval." - :type 'string - :group 'python) + :type 'string) (defun python-eldoc--get-symbol-at-point () "Get the current symbol for eldoc. @@ -4737,14 +4730,13 @@ Set to nil by `python-eldoc-function' if (defcustom python-eldoc-function-timeout 1 "Timeout for `python-eldoc-function' in seconds." - :group 'python :type 'integer :version "25.1") (defcustom python-eldoc-function-timeout-permanent t - "Non-nil means that when `python-eldoc-function' times out -`python-eldoc-get-doc' will be set to nil." - :group 'python + "If non-nil, a timeout in Python-Eldoc will disable it permanently. +Python-Eldoc can be re-enabled manually by setting `python-eldoc-get-doc' +back to t in the affected buffer." :type 'boolean :version "25.1") @@ -4936,7 +4928,7 @@ To this: (\"decorator.wrapped_f\" . 393))" ;; Inspired by imenu--flatten-index-alist removed in revno 21853. (apply - 'nconc + #'nconc (mapcar (lambda (item) (let ((name (if prefix @@ -5019,7 +5011,7 @@ since it returns nil if point is not inside a defun." (and (= (current-indentation) 0) (throw 'exit t)))) (and names (concat (and type (format "%s " type)) - (mapconcat 'identity names "."))))))) + (mapconcat #'identity names "."))))))) (defun python-info-current-symbol (&optional replace-self) "Return current symbol using dotty syntax. @@ -5040,9 +5032,10 @@ parent defun name." (replace-regexp-in-string (python-rx line-start word-start "self" word-end ?.) (concat - (mapconcat 'identity + (mapconcat #'identity (butlast (split-string current-defun "\\.")) - ".") ".") + ".") + ".") name))))))) (defun python-info-statement-starts-block-p () @@ -5084,7 +5077,7 @@ parent defun name." (define-obsolete-function-alias 'python-info-closing-block - 'python-info-dedenter-opening-block-position "24.4") + #'python-info-dedenter-opening-block-position "24.4") (defun python-info-dedenter-opening-block-position () "Return the point of the closest block the current line closes. @@ -5129,7 +5122,8 @@ likely an invalid python file." (let ((indentation (current-indentation))) (when (and (not (memq indentation collected-indentations)) (or (not collected-indentations) - (< indentation (apply #'min collected-indentations))) + (< indentation + (apply #'min collected-indentations))) ;; There must be no line with indentation ;; smaller than `indentation' (except for ;; blank lines) between the found opening @@ -5157,7 +5151,7 @@ likely an invalid python file." (define-obsolete-function-alias 'python-info-closing-block-message - 'python-info-dedenter-opening-block-message "24.4") + #'python-info-dedenter-opening-block-message "24.4") (defun python-info-dedenter-opening-block-message () "Message the first line of the block the current statement closes." @@ -5459,10 +5453,12 @@ allowed files." (let ((dir-name (file-name-as-directory dir))) (apply #'nconc (mapcar (lambda (file-name) - (let ((full-file-name (expand-file-name file-name dir-name))) + (let ((full-file-name + (expand-file-name file-name dir-name))) (when (and (not (member file-name '("." ".."))) - (funcall (or predicate #'identity) full-file-name)) + (funcall (or predicate #'identity) + full-file-name)) (list full-file-name)))) (directory-files dir-name))))) @@ -5530,7 +5526,6 @@ required arguments. Once launched it will receive the Python source to be checked as its standard input. To use `flake8' you would set this to (\"flake8\" \"-\")." :version "26.1" - :group 'python-flymake :type '(repeat string)) ;; The default regexp accommodates for older pyflakes, which did not @@ -5552,7 +5547,6 @@ If COLUMN or TYPE are nil or that index didn't match, that information is not present on the matched line and a default will be used." :version "26.1" - :group 'python-flymake :type '(list regexp (integer :tag "Line's index") (choice @@ -5577,7 +5571,6 @@ configuration could be: By default messages are considered errors." :version "26.1" - :group 'python-flymake :type '(alist :key-type (regexp) :value-type (symbol))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 3ad0f0182f8..8dc55621438 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1774,21 +1774,27 @@ Does not preserve point." (n (skip-syntax-backward "."))) (if (or (zerop n) (and (eq n -1) + ;; Skip past quoted white space. (let ((p (point))) (if (eq -1 (% (skip-syntax-backward "\\") 2)) t (goto-char p) nil)))) (while - (progn (skip-syntax-backward ".w_'") - (or (not (zerop (skip-syntax-backward "\\"))) - (when (eq ?\\ (char-before (1- (point)))) - (let ((p (point))) - (forward-char -1) - (if (eq -1 (% (skip-syntax-backward "\\") 2)) - t - (goto-char p) - nil)))))) + (progn + ;; Skip past words, but stop at semicolons. + (while (and (not (zerop (skip-syntax-backward "w_'"))) + (not (eq (char-before (point)) ?\;)) + (skip-syntax-backward "."))) + (or (not (zerop (skip-syntax-backward "\\"))) + ;; Skip past quoted white space. + (when (eq ?\\ (char-before (1- (point)))) + (let ((p (point))) + (forward-char -1) + (if (eq -1 (% (skip-syntax-backward "\\") 2)) + t + (goto-char p) + nil)))))) (goto-char (- (point) (% (skip-syntax-backward "\\") 2)))) (buffer-substring-no-properties (point) pos))) @@ -1973,7 +1979,7 @@ May return nil if the line should not be treated as continued." (cons 'column (smie-indent-keyword ";")) (smie-rule-separator kind))) (`(:after . ,(or ";;" ";&" ";;&")) - (with-demoted-errors + (with-demoted-errors "SMIE rule error: %S" (smie-backward-sexp token) (cons 'column (if (or (smie-rule-bolp) diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index b1b78b4d128..e06eb9a6f70 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -264,8 +264,8 @@ Optional argument ARG is the same as for `capitalize-word'." "Toggle superword movement and editing (Superword mode). Superword mode is a buffer-local minor mode. Enabling it changes -the definition of words such that symbols characters are treated -as parts of words: e.g., in `superword-mode', +the definition of words such that characters which have symbol +syntax are treated as parts of words: e.g., in `superword-mode', \"this_is_a_symbol\" counts as one word. \\{superword-mode-map}" diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 37e2159782f..aa98aa89f15 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.3.2 +;; Version: 1.4.0 ;; Package-Requires: ((emacs "26.1")) ;; This is a GNU ELPA :core package. Avoid functionality that is not @@ -426,7 +426,7 @@ or earlier: it can break `dired-do-find-regexp-and-replace'." :version "28.1" :package-version '(xref . "1.2.0")) -(make-obsolete-variable 'xref-marker-ring nil "29.1") +(make-obsolete-variable 'xref--marker-ring 'xref--history "29.1") (defun xref-set-marker-ring-length (_var _val) (declare (obsolete nil "29.1")) @@ -485,13 +485,18 @@ To undo, use \\[xref-go-forward]." (set-marker marker nil nil) (run-hooks 'xref-after-return-hook)))) -(defvar xref--current-item nil) +(define-obsolete-variable-alias + 'xref--current-item + 'xref-current-item + "29.1") + +(defvar xref-current-item nil) (defun xref-pulse-momentarily () (pcase-let ((`(,beg . ,end) (save-excursion (or - (let ((length (xref-match-length xref--current-item))) + (let ((length (xref-match-length xref-current-item))) (and length (cons (point) (+ (point) length)))) (back-to-indentation) (if (eolp) @@ -548,7 +553,7 @@ If SELECT is non-nil, select the target window." (window (pop-to-buffer buf t)) (frame (let ((pop-up-frames t)) (pop-to-buffer buf t)))) (xref--goto-char marker)) - (let ((xref--current-item item)) + (let ((xref-current-item item)) (run-hooks 'xref-after-jump-hook))) @@ -656,7 +661,7 @@ SELECT is `quit', also quit the *xref* window." "Display the source of xref at point in the appropriate window, if any." (interactive) (let* ((xref (xref--item-at-point)) - (xref--current-item xref)) + (xref-current-item xref)) (when xref (xref--set-arrow) (xref--show-location (xref-item-location xref))))) @@ -715,7 +720,7 @@ quit the *xref* buffer." (let* ((buffer (current-buffer)) (xref (or (xref--item-at-point) (user-error "Choose a reference to visit"))) - (xref--current-item xref)) + (xref-current-item xref)) (xref--set-arrow) (xref--show-location (xref-item-location xref) (if quit 'quit t)) (if (fboundp 'next-error-found) @@ -945,7 +950,7 @@ beginning of the line." (let ((win (get-buffer-window (current-buffer)))) (and win (set-window-point win (point)))) (xref--set-arrow) - (let ((xref--current-item xref)) + (let ((xref-current-item xref)) (xref--show-location (xref-item-location xref) t))) (t (error "No %s xref" (if backward "previous" "next")))))) @@ -1102,6 +1107,13 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)." (cdr pair))) alist))) +(defun xref--ensure-default-directory (dd buffer) + ;; We might be in a let-binding which will restore the current value + ;; to a previous one (bug#53626). So do this later. + (run-with-timer + 0 nil + (lambda () (with-current-buffer buffer (setq default-directory dd))))) + (defun xref--show-xref-buffer (fetcher alist) (cl-assert (functionp fetcher)) (let* ((xrefs @@ -1112,7 +1124,7 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)." (dd default-directory) buf) (with-current-buffer (get-buffer-create xref-buffer-name) - (setq default-directory dd) + (xref--ensure-default-directory dd (current-buffer)) (xref--xref-buffer-mode) (xref--show-common-initialize xref-alist fetcher alist) (pop-to-buffer (current-buffer)) @@ -1211,7 +1223,7 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." (assoc-default 'display-action alist))) (t (with-current-buffer (get-buffer-create xref-buffer-name) - (setq default-directory dd) + (xref--ensure-default-directory dd (current-buffer)) (xref--transient-buffer-mode) (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) (pop-to-buffer (current-buffer) @@ -1335,6 +1347,13 @@ definitions." (defvar xref--read-pattern-history nil) +;;;###autoload +(defun xref-show-xrefs (fetcher display-action) + "Display some Xref values produced by FETCHER using DISPLAY-ACTION. +The meanings of both arguments are the same as documented in +`xref-show-xrefs-function'." + (xref--show-xrefs fetcher display-action)) + (defun xref--show-xrefs (fetcher display-action &optional _always-show-list) (xref--push-markers) (unless (functionp fetcher) @@ -1481,8 +1500,9 @@ is nil, prompt only if there's no usable symbol at point." (defun xref-find-references-and-replace (from to) "Replace all references to identifier FROM with TO." (interactive - (let ((common - (query-replace-read-args "Query replace identifier" nil))) + (let* ((query-replace-read-from-default 'find-tag-default) + (common + (query-replace-read-args "Query replace identifier" nil))) (list (nth 0 common) (nth 1 common)))) (require 'xref) (with-current-buffer diff --git a/lisp/replace.el b/lisp/replace.el index dd6e5a42258..06be5978554 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -186,6 +186,12 @@ See `replace-regexp' and `query-replace-regexp-eval'.") length) length))))) +(defvar query-replace-read-from-default nil + "Function to get default non-regexp value for `query-replace-read-from'.") + +(defvar query-replace-read-from-regexp-default nil + "Function to get default regexp value for `query-replace-read-from'.") + (defun query-replace-read-from-suggestions () "Return a list of standard suggestions for `query-replace-read-from'. By default, the list includes the active region, the identifier @@ -233,8 +239,12 @@ wants to replace FROM with TO." query-replace-defaults)) (symbol-value query-replace-from-history-variable))) (minibuffer-allow-text-properties t) ; separator uses text-properties + (default (when (and query-replace-read-from-default (not regexp-flag)) + (funcall query-replace-read-from-default))) (prompt - (cond ((and query-replace-defaults separator) + (cond ((and query-replace-read-from-regexp-default regexp-flag) prompt) + (default (format-prompt prompt default)) + ((and query-replace-defaults separator) (format-prompt prompt (car minibuffer-history))) (query-replace-defaults (format-prompt @@ -255,16 +265,26 @@ wants to replace FROM with TO." (append '((separator . t) (face . t)) text-property-default-nonsticky))) (if regexp-flag - (read-regexp prompt nil 'minibuffer-history) + (read-regexp + (if query-replace-read-from-regexp-default + (string-remove-suffix ": " prompt) + prompt) + query-replace-read-from-regexp-default + 'minibuffer-history) (read-from-minibuffer prompt nil nil nil nil - (query-replace-read-from-suggestions) t))))) + (if default + (delete-dups + (cons default (query-replace-read-from-suggestions))) + (query-replace-read-from-suggestions)) + t))))) (to)) - (if (and (zerop (length from)) query-replace-defaults) + (if (and (zerop (length from)) query-replace-defaults (not default)) (cons (caar query-replace-defaults) (query-replace-compile-replacement (cdar query-replace-defaults) regexp-flag)) - (setq from (query-replace--split-string from)) + (setq from (or (and (zerop (length from)) default) + (query-replace--split-string from))) (when (consp from) (setq to (cdr from) from (car from))) (add-to-history query-replace-from-history-variable from nil t) ;; Warn if user types \n or \t, but don't reject the input. @@ -1413,10 +1433,15 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (length s1))))) (prefix-len (funcall common-prefix buf-str text)) (suffix-len (funcall common-prefix - (reverse buf-str) (reverse text)))) + (reverse (substring + buf-str prefix-len)) + (reverse (substring + text prefix-len))))) (setq beg-pos (+ beg-pos prefix-len)) (setq end-pos (- end-pos suffix-len)) - (setq text (substring text prefix-len (- suffix-len))) + (setq text (substring text prefix-len + (and (not (zerop suffix-len)) + (- suffix-len)))) (delete-region beg-pos end-pos) (goto-char beg-pos) (insert text))) @@ -3208,7 +3233,13 @@ characters." (last-command 'recenter-top-bottom)) (recenter-top-bottom))) ((eq def 'edit) - (let ((opos (point-marker))) + (let ((opos (point-marker)) + ;; Restore original isearch filter to allow + ;; using isearch in a recursive edit even + ;; when perform-replace was started from + ;; `xref--query-replace-1' that let-binds + ;; `isearch-filter-predicate' (bug#53758). + (isearch-filter-predicate #'isearch-filter-visible)) (setq real-match-data (replace-match-data nil real-match-data real-match-data)) diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index afe1cd4bfda..f0efc20f037 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -279,21 +279,24 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (let ((edges (window-edges))) (- (nth 2 edges) (nth 0 edges)))) -(defsubst ruler-mode-window-col (n) +(defsubst ruler-mode-window-col (event) "Return a column number relative to the selected window. -N is a column number relative to selected frame. +EVENT is the mouse event that gives the current column. If required, account for screen estate taken by `display-line-numbers'." - (if display-line-numbers + (let ((n (car (posn-col-row event)))) + (when display-line-numbers ;; FIXME: ruler-mode relies on N being an integer, so if the ;; 'line-number' face is customized to use a font that is larger ;; or smaller than that of the default face, the alignment might ;; be off by up to half a column, unless the font width is an ;; integral multiple or divisor of the default face's font. (setq n (- n (round (line-number-display-width 'columns))))) - (- n - (or (car (window-margins)) 0) - (fringe-columns 'left) - (scroll-bar-columns 'left))) + (- n + (if (eq (posn-area event) 'header-line) + (+ (or (car (window-margins)) 0) + (fringe-columns 'left) + (scroll-bar-columns 'left)) + 0)))) (defun ruler-mode-mouse-set-left-margin (start-event) "Set left margin end to the graduation where the mouse pointer is on. @@ -370,7 +373,7 @@ dragging. See also the variable `ruler-mode-dragged-symbol'." col newc oldc) (save-selected-window (select-window (posn-window start)) - (setq col (ruler-mode-window-col (car (posn-col-row start))) + (setq col (ruler-mode-window-col start) newc (+ col (ruler-mode-text-scaled-window-hscroll))) (and (>= col 0) (< col (ruler-mode-text-scaled-window-width)) @@ -455,7 +458,7 @@ Called on each mouse motion event START-EVENT." col newc) (save-selected-window (select-window (posn-window start)) - (setq col (ruler-mode-window-col (car (posn-col-row end))) + (setq col (ruler-mode-window-col end) newc (+ col (ruler-mode-text-scaled-window-hscroll))) (when (and (>= col 0) (< col (ruler-mode-text-scaled-window-width))) (set ruler-mode-dragged-symbol newc))))) @@ -471,7 +474,7 @@ START-EVENT is the mouse click event." (when (eq start end) ;; mouse click (save-selected-window (select-window (posn-window start)) - (setq col (ruler-mode-window-col (car (posn-col-row start))) + (setq col (ruler-mode-window-col start) ts (+ col (ruler-mode-text-scaled-window-hscroll))) (and (>= col 0) (< col (ruler-mode-text-scaled-window-width)) (not (member ts tab-stop-list)) @@ -492,7 +495,7 @@ START-EVENT is the mouse click event." (when (eq start end) ;; mouse click (save-selected-window (select-window (posn-window start)) - (setq col (ruler-mode-window-col (car (posn-col-row start))) + (setq col (ruler-mode-window-col start) ts (+ col (ruler-mode-text-scaled-window-hscroll))) (and (>= col 0) (< col (ruler-mode-text-scaled-window-width)) (member ts tab-stop-list) diff --git a/lisp/savehist.el b/lisp/savehist.el index aab304007b2..172acaa4e87 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -60,14 +60,19 @@ If you want to save only specific histories, use `savehist-save-hook' to modify the value of `savehist-minibuffer-history-variables'." :type 'boolean) -(defcustom savehist-additional-variables () +(defcustom savehist-additional-variables nil "List of additional variables to save. -Each element is a symbol whose value will be persisted across Emacs -sessions that use Savehist. The contents of variables should be -printable with the Lisp printer. You don't need to add minibuffer -history variables to this list, all minibuffer histories will be -saved automatically as long as `savehist-save-minibuffer-history' is -non-nil. +Each element is a variable that will be persisted across Emacs +sessions that use Savehist. + +An element may be variable name (a symbol) or a cons cell of the form +\(VAR . MAX-SIZE), which means to truncate VAR's value to at most +MAX-SIZE elements (if the value is a list) before saving the value. + +The contents of variables should be printable with the Lisp +printer. You don't need to add minibuffer history variables to +this list, all minibuffer histories will be saved automatically +as long as `savehist-save-minibuffer-history' is non-nil. User options should be saved with the Customize interface. This list is useful for saving automatically updated variables that are not @@ -278,12 +283,21 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (delete-region (point) (1+ (point))))) (insert "))\n")))))) ;; Save the additional variables. - (dolist (symbol savehist-additional-variables) - (when (boundp symbol) - (let ((value (symbol-value symbol))) - (when (savehist-printable value) - (prin1 `(setq ,symbol ',value) (current-buffer)) - (insert ?\n)))))) + (dolist (elem savehist-additional-variables) + (let ((symbol (if (consp elem) + (car elem) + elem))) + (when (boundp symbol) + (let ((value (symbol-value symbol))) + (when (savehist-printable value) + ;; When we have a max-size, chop off the last elements. + (when (and (consp elem) + (listp value) + (length> value (cdr elem))) + (setq value (copy-sequence value)) + (setcdr (nthcdr (cdr elem) value) nil)) + (prin1 `(setq ,symbol ',value) (current-buffer)) + (insert ?\n))))))) ;; If autosaving, avoid writing if nothing has changed since the ;; last write. (let ((checksum (md5 (current-buffer) nil nil savehist-coding-system))) diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index d41e3352332..3f5f777f53f 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -55,7 +55,7 @@ will scroll the buffer by the respective amount of lines instead and point will be kept vertically fixed relative to window boundaries during scrolling. -Note that the default key binding to Scroll_Lock will not work on +Note that the default key binding to `scroll' will not work on MS-Windows systems if `w32-scroll-lock-modifier' is non-nil." :lighter " ScrLck" :keymap scroll-lock-mode-map diff --git a/lisp/select.el b/lisp/select.el index 7f29f02dab9..42b50c44e6c 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -168,20 +168,28 @@ text/plain\\;charset=utf-8)." Call `gui-get-selection' with an appropriate DATA-TYPE argument decided by `x-select-request-type'. The return value is already decoded. If `gui-get-selection' signals an error, return nil." - (let ((request-type (if (memq window-system '(x pgtk)) - (or x-select-request-type - '(UTF8_STRING COMPOUND_TEXT STRING text/plain\;charset=utf-8)) - 'STRING)) - text) - (with-demoted-errors "gui-get-selection: %S" - (if (consp request-type) - (while (and request-type (not text)) - (setq text (gui-get-selection type (car request-type))) - (setq request-type (cdr request-type))) - (setq text (gui-get-selection type request-type)))) - (if text - (remove-text-properties 0 (length text) '(foreign-selection nil) text)) - text)) + ;; The doc string of `interprogram-paste-function' says to return + ;; nil if no other program has provided text to paste. + (unless (and + ;; `gui-backend-selection-owner-p' might be unreliable on + ;; some other window systems. + (memq window-system '(x haiku)) + (eq type 'CLIPBOARD) + (gui-backend-selection-owner-p type)) + (let ((request-type (if (memq window-system '(x pgtk haiku)) + (or x-select-request-type + '(UTF8_STRING COMPOUND_TEXT STRING text/plain\;charset=utf-8)) + 'STRING)) + text) + (with-demoted-errors "gui-get-selection: %S" + (if (consp request-type) + (while (and request-type (not text)) + (setq text (gui-get-selection type (car request-type))) + (setq request-type (cdr request-type))) + (setq text (gui-get-selection type request-type)))) + (if text + (remove-text-properties 0 (length text) '(foreign-selection nil) text)) + text))) (defun gui-selection-value () (let ((clip-text diff --git a/lisp/shell.el b/lisp/shell.el index c0a82bca183..6198214abee 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -942,7 +942,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." dir (if (file-name-absolute-p dir) ;; The name is absolute, so prepend the prefix. - (concat comint-file-name-prefix dir) + (concat comint-file-name-prefix (file-local-name dir)) ;; For relative name we assume default-directory already has the prefix. (expand-file-name dir)))) diff --git a/lisp/simple.el b/lisp/simple.el index 801a3c992c8..accc119e2b3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1292,6 +1292,11 @@ If Transient Mark mode is enabled, the mark is active, and N is 1, delete the text in the region and deactivate the mark instead. To disable this, set variable `delete-active-region' to nil. +If N is positive, characters composed into a single grapheme cluster +count as a single character and are deleted together. Thus, +\"\\[universal-argument] 2 \\[delete-forward-char]\" when two grapheme clusters follow point will +delete the characters composed into both of the grapheme clusters. + Optional second arg KILLFLAG non-nil means to kill (save in kill ring) instead of delete. If called interactively, a numeric prefix argument specifies N, and KILLFLAG is also set if a prefix @@ -1312,6 +1317,21 @@ the actual saved text might be different from what was killed." (kill-region (region-beginning) (region-end) 'region) (funcall region-extract-function 'delete-only))) + ;; For forward deletion, treat composed characters as a single + ;; character to delete. + ((>= n 1) + (let ((pos (point)) + start cmp) + (setq start pos) + (while (> n 0) + ;; 'find-composition' will return (FROM TO ....) or nil. + (setq cmp (find-composition pos)) + (if cmp + (setq pos (cadr cmp)) + (setq pos (1+ pos))) + (setq n (1- n))) + (delete-char (- pos start) killflag))) + ;; Otherwise, do simple deletion. (t (delete-char n killflag)))) @@ -1457,46 +1477,59 @@ START and END." (cond ((not (called-interactively-p 'any)) (count-words start end)) (arg - (count-words--buffer-message)) + (message "%s" (count-words--buffer-format))) (t - (count-words--message "Region" start end)))) + (message "%s" (count-words--format "Region" start end))))) -(defun count-words (start end) +(defun count-words (start end &optional totals) "Count words between START and END. If called interactively, START and END are normally the start and end of the buffer; but if the region is active, START and END are the start and end of the region. Print a message reporting the -number of lines, words, and chars. +number of lines, words, and chars. With prefix argument, also +include the data for the entire (un-narrowed) buffer. If called from Lisp, return the number of words between START and -END, without printing any message." - (interactive (list nil nil)) - (cond ((not (called-interactively-p 'any)) - (let ((words 0) - ;; Count across field boundaries. (Bug#41761) - (inhibit-field-text-motion t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (forward-word-strictly 1) - (setq words (1+ words))))) - words)) - ((use-region-p) - (call-interactively 'count-words-region)) - (t - (count-words--buffer-message)))) - -(defun count-words--buffer-message () - (count-words--message +END, without printing any message. TOTALS is ignored when called +from Lisp." + (interactive (list nil nil current-prefix-arg)) + ;; When called from Lisp, return the data. + (if (not (called-interactively-p 'any)) + (let ((words 0) + ;; Count across field boundaries. (Bug#41761) + (inhibit-field-text-motion t)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (forward-word-strictly 1) + (setq words (1+ words))))) + words) + ;; When called interactively, message the data. + (let ((totals (if (and totals + (or (use-region-p) + (buffer-narrowed-p))) + (save-restriction + (widen) + (count-words--format "; buffer in total" + (point-min) (point-max))) + ""))) + (if (use-region-p) + (message "%s%s" (count-words--format + "Region" (region-beginning) (region-end)) + totals) + (message "%s%s" (count-words--buffer-format) totals))))) + +(defun count-words--buffer-format () + (count-words--format (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer") (point-min) (point-max))) -(defun count-words--message (str start end) +(defun count-words--format (str start end) (let ((lines (count-lines start end)) (words (count-words start end)) (chars (- end start))) - (message "%s has %d line%s, %d word%s, and %d character%s." + (format "%s has %d line%s, %d word%s, and %d character%s" str lines (if (= lines 1) "" "s") words (if (= words 1) "" "s") @@ -2348,12 +2381,17 @@ don't clear it." (setq current-prefix-arg prefix-arg) (setq prefix-arg nil) (when current-prefix-arg - (prefix-command-update)))))) + (prefix-command-update))))) + query) (if (and (symbolp cmd) (get cmd 'disabled) - disabled-command-function) - ;; FIXME: Weird calling convention! - (run-hooks 'disabled-command-function) + (or (and (setq query (and (consp (get cmd 'disabled)) + (eq (car (get cmd 'disabled)) 'query))) + (not (command-execute--query cmd))) + (and (not query) disabled-command-function))) + (when (not query) + ;; FIXME: Weird calling convention! + (run-hooks 'disabled-command-function)) (let ((final cmd)) (while (progn @@ -2377,6 +2415,21 @@ don't clear it." (put cmd 'command-execute-obsolete-warned t) (message "%s" (macroexp--obsolete-warning cmd (get cmd 'byte-obsolete-info) "command")))))))))) + +(defun command-execute--query (command) + "Query the user whether to run COMMAND." + (let ((query (get command 'disabled))) + (funcall (if (nth 1 query) #'yes-or-no-p #'y-or-n-p) + (nth 2 query)))) + +;;;###autoload +(defun command-query (command query &optional verbose) + "Make executing COMMAND issue QUERY to the user. +This will, by default, use `y-or-n-p', but if VERBOSE, +`yes-or-no-p' is used instead." + (put command 'disabled + (list 'query (not (not verbose)) query))) + (defvar minibuffer-history nil "Default minibuffer history list. @@ -4092,6 +4145,10 @@ interactively when the prefix argument is given), insert the output in current buffer after point leaving mark after it. This cannot be done asynchronously. +If OUTPUT-BUFFER is a buffer or buffer name different from the +current buffer, instead of outputting at point in that buffer, +the output will be appended at the end of that buffer. + The user option `shell-command-dont-erase-buffer', which see, controls whether the output buffer is erased and where to put point after the shell command. @@ -8279,7 +8336,8 @@ Just \\[universal-argument] as argument means to use the current column." ;; We used to use current-column silently, but C-x f is too easily ;; typed as a typo for C-x C-f, so we turned it into an error and ;; now an interactive prompt. - (read-number "Set fill-column to: " (current-column))))) + (read-number (format "Change fill-column from %s to: " fill-column) + (current-column))))) (if (consp arg) (setq arg (current-column))) (if (not (integerp arg)) diff --git a/lisp/sort.el b/lisp/sort.el index eb8e2787d1e..90eee01caf4 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -286,25 +286,30 @@ FIELD, BEG and END. BEG and END specify region to sort." (interactive "p\nr") (let ;; To make `end-of-line' and etc. to ignore fields. ((inhibit-field-text-motion t)) - (sort-fields-1 field beg end - (lambda () - (sort-skip-fields field) - (let* ((case-fold-search t) - (base - (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]") - (cond ((match-beginning 1) - (goto-char (match-end 1)) - 16) - ((match-beginning 2) - (goto-char (match-end 2)) - 8) - (t nil))))) - (string-to-number (buffer-substring (point) - (save-excursion - (forward-sexp 1) - (point))) - (or base sort-numeric-base)))) - nil))) + (sort-fields-1 + field beg end + (lambda () + ;; Don't try to parse blank lines (they'll be + ;; sorted at the start). + (if (looking-at "[\t ]*$") + 0 + (sort-skip-fields field) + (let* ((case-fold-search t) + (base + (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]") + (cond ((match-beginning 1) + (goto-char (match-end 1)) + 16) + ((match-beginning 2) + (goto-char (match-end 2)) + 8) + (t nil))))) + (string-to-number (buffer-substring (point) + (save-excursion + (forward-sexp 1) + (point))) + (or base sort-numeric-base))))) + nil))) ;;;;;###autoload ;;(defun sort-float-fields (field beg end) diff --git a/lisp/startup.el b/lisp/startup.el index 33e0c1c0596..09951bda953 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -519,20 +519,73 @@ DIRS are relative." xdg-dir) (t emacs-d-dir)))) +(defvar comp--compilable) (defvar comp--delayed-sources) -(defvar comp--loadable) +(defun startup--require-comp-safely () + "Require the native compiler avoiding circular dependencies." + (when (featurep 'native-compile) + ;; Require comp with `comp--compilable' set to nil to break + ;; circularity. + (let ((comp--compilable nil)) + (require 'comp)) + (native--compile-async comp--delayed-sources nil 'late) + (setq comp--delayed-sources nil))) + (declare-function native--compile-async "comp.el" (files &optional recursively load selector)) (defun startup--honor-delayed-native-compilations () "Honor pending delayed deferred native compilations." (when (and (native-comp-available-p) comp--delayed-sources) - (require 'comp) - (setq comp--loadable t) - (native--compile-async comp--delayed-sources nil 'late) - (setq comp--delayed-sources nil))) + (startup--require-comp-safely)) + (setq comp--compilable t)) (defvar native-comp-eln-load-path) +(defvar native-comp-deferred-compilation) +(defvar comp-enable-subr-trampolines) + +(defvar startup--original-eln-load-path nil + "Original value of `native-comp-eln-load-path'.") + +(defun startup-redirect-eln-cache (cache-directory) + "Redirect the user's eln-cache directory to CACHE-DIRECTORY. +CACHE-DIRECTORY must be a single directory, a string. +This function destructively changes `native-comp-eln-load-path' +so that its first element is CACHE-DIRECTORY. If CACHE-DIRECTORY +is not an absolute file name, it is interpreted relative +to `user-emacs-directory'. +For best results, call this function in your early-init file, +so that the rest of initialization and package loading uses +the updated value." + (let ((tmp-dir (and (equal (getenv "HOME") "/nonexistent") + (file-writable-p (expand-file-name + (or temporary-file-directory ""))) + (car native-comp-eln-load-path)))) + (if tmp-dir + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path))) + ;; Remove the original eln-cache. + (setq native-comp-eln-load-path + (cdr native-comp-eln-load-path)) + ;; Add the new eln-cache. + (push (expand-file-name (file-name-as-directory cache-directory) + user-emacs-directory) + native-comp-eln-load-path) + (when tmp-dir + ;; Recompute tmp-dir, in case user-emacs-directory affects it. + (setq tmp-dir (make-temp-file "emacs-testsuite-" t)) + (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) + (push tmp-dir native-comp-eln-load-path)))) + +(defun startup--update-eln-cache () + "Update the user eln-cache directory due to user customizations." + ;; Don't override user customizations! + (when (equal native-comp-eln-load-path + startup--original-eln-load-path) + (startup-redirect-eln-cache "eln-cache") + (setq startup--original-eln-load-path + (copy-sequence native-comp-eln-load-path)))) + (defun normal-top-level () "Emacs calls this function when it first starts up. It sets `command-line-processed', processes the command-line, @@ -551,6 +604,14 @@ It is the default value of the variable `top-level'." (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) (when (featurep 'native-compile) + (unless (native-comp-available-p) + ;; Disable deferred async compilation and trampoline synthesis + ;; in this session. This is necessary if libgccjit is not + ;; available on MS-Windows, but Emacs was built with + ;; native-compilation support. + (setq native-comp-deferred-compilation nil + comp-enable-subr-trampolines nil)) + ;; Form `native-comp-eln-load-path'. (let ((path-env (getenv "EMACSNATIVELOADPATH"))) (when path-env @@ -570,6 +631,7 @@ It is the default value of the variable `top-level'." (let ((tmp-dir (make-temp-file "emacs-testsuite-" t))) (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) (push tmp-dir native-comp-eln-load-path)))) + ;; Look in each dir in load-path for a subdirs.el file. If we ;; find one, load it, which will add the appropriate subdirs of ;; that dir into load-path. This needs to be done before setting @@ -665,7 +727,9 @@ It is the default value of the variable `top-level'." ;; native-comp-eln-load-path. (expand-file-name (decode-coding-string dir coding t))) - npath)))) + npath))) + (setq startup--original-eln-load-path + (copy-sequence native-comp-eln-load-path))) (dolist (filesym '(data-directory doc-directory exec-directory installation-directory invocation-directory invocation-name @@ -715,6 +779,7 @@ It is the default value of the variable `top-level'." (let ((old-face-font-rescale-alist face-font-rescale-alist)) (unwind-protect (command-line) + ;; Do this again, in case .emacs defined more abbreviations. (if default-directory (setq default-directory (abbreviate-file-name default-directory))) @@ -781,6 +846,7 @@ It is the default value of the variable `top-level'." (font-menu-add-default)) (unless inhibit-startup-hooks (run-hooks 'window-setup-hook)))) + ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. ;; We are careful to do it late (after term-setup-hook), although the @@ -1145,7 +1211,8 @@ please check its value") ("--no-x-resources") ("--debug-init") ("--user") ("--iconic") ("--icon-type") ("--quick") ("--no-blinking-cursor") ("--basic-display") - ("--dump-file") ("--temacs") ("--seccomp"))) + ("--dump-file") ("--temacs") ("--seccomp") + ("--init-directory"))) (argi (pop args)) (orig-argi argi) argval) @@ -1185,6 +1252,9 @@ please check its value") (push '(vertical-scroll-bars . nil) initial-frame-alist)) ((member argi '("-q" "-no-init-file")) (setq init-file-user nil)) + ((member argi '("-init-directory")) + (setq user-emacs-directory (or argval (pop args)) + argval nil)) ((member argi '("-u" "-user")) (setq init-file-user (or argval (pop args)) argval nil)) @@ -1261,7 +1331,8 @@ please check its value") (and (eq xdg-dir user-emacs-directory) (not (eq xdg-dir startup--xdg-config-default)))) user-emacs-directory - ;; The name is not obvious, so access more directories to calculate it. + ;; The name is not obvious, so access more directories + ;; to calculate it. (setq xdg-dir (concat "~" init-file-user "/.config/emacs/")) (startup--xdg-or-homedot xdg-dir init-file-user))) @@ -1277,6 +1348,12 @@ please check its value") startup-init-directory))) (setq early-init-file user-init-file) + ;; Amend `native-comp-eln-load-path', since the early-init file may + ;; have altered `user-emacs-directory' and/or changed the eln-cache + ;; directory. + (when (featurep 'native-compile) + (startup--update-eln-cache)) + ;; If any package directory exists, initialize the package system. (and user-init-file package-enable-at-startup @@ -1416,6 +1493,12 @@ please check its value") startup-init-directory)) t) + ;; Amend `native-comp-eln-load-path' again, since the early-init + ;; file may have altered `user-emacs-directory' and/or changed the + ;; eln-cache directory. + (when (featurep 'native-compile) + (startup--update-eln-cache)) + (when (and deactivate-mark transient-mark-mode) (with-current-buffer (window-buffer) (deactivate-mark))) @@ -2595,7 +2678,7 @@ nil default-directory" name) ;; actually exist on some systems. (when (file-exists-p truename) (setq file-ex truename)) - (load file-ex nil t t))) + (command-line--load-script file-ex))) ((equal argi "-insert") (setq inhibit-startup-screen t) @@ -2720,10 +2803,24 @@ nil default-directory" name) (nondisplayed-buffers-p nil)) (when (> displayable-buffers-len 0) (switch-to-buffer (car displayable-buffers))) - (when (> displayable-buffers-len 1) - (switch-to-buffer-other-window (car (cdr displayable-buffers))) + (cond + ;; Two buffers; display them both. + ((= displayable-buffers-len 2) + (switch-to-buffer-other-window (cadr displayable-buffers)) ;; Focus on the first buffer. (other-window -1)) + ;; More than two buffers: Ensure that the buffer display order + ;; reflects the order they were given on the command line. + ;; (This will end up with a `next-buffer' order that's in + ;; reverse order -- the final file is the focused one, and then + ;; the rest are in `next-buffer' in descending order. + ((> displayable-buffers-len 2) + (let ((bufs (reverse (cdr displayable-buffers)))) + (switch-to-buffer-other-window (pop bufs)) + (dolist (buf bufs) + (switch-to-buffer buf nil t)) + ;; Focus on the first buffer. + (other-window -1)))) (when (> displayable-buffers-len 2) (setq nondisplayed-buffers-p t)) @@ -2770,6 +2867,19 @@ nil default-directory" name) (display-startup-screen (> displayable-buffers-len 0)))))) +(defun command-line--load-script (file) + (load-with-code-conversion + file file nil t + (lambda (buffer file) + (with-current-buffer buffer + (goto-char (point-min)) + ;; Removing the #! and then calling `eval-buffer' will make the + ;; reader not signal an error if it then turns out that the + ;; buffer is empty. + (when (looking-at "#!") + (delete-line)) + (eval-buffer buffer nil file nil t))))) + (defun command-line-normalize-file-name (file) "Collapse multiple slashes to one, to handle non-Emacs file names." (save-match-data diff --git a/lisp/subr.el b/lisp/subr.el index 29b9b6dfcf5..eb9af0b36da 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1149,8 +1149,17 @@ Subkeymaps may be modified but are not canonicalized." (setq map (map-keymap ;; -internal (lambda (key item) (if (consp key) - ;; Treat char-ranges specially. - (push (cons key item) ranges) + (if (= (car key) (1- (cdr key))) + ;; If we have a two-character range, then + ;; treat it as two separate characters + ;; (because this makes `describe-bindings' + ;; look better and shouldn't affect + ;; anything else). + (progn + (push (cons (car key) item) bindings) + (push (cons (cdr key) item) bindings)) + ;; Treat char-ranges specially. + (push (cons key item) ranges)) (push (cons key item) bindings))) map))) ;; Create the new map. @@ -1896,7 +1905,9 @@ performance impact when running `add-hook' and `remove-hook'." (set (make-local-variable hook) (list t))) ;; Detect the case where make-local-variable was used on a hook ;; and do what we used to do. - (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook))) + (when (and (local-variable-if-set-p hook) + (not (and (consp (symbol-value hook)) + (memq t (symbol-value hook))))) (setq local t))) (let ((hook-value (if local (symbol-value hook) (default-value hook)))) ;; If the hook value is a single function, turn it into a list. @@ -1904,26 +1915,34 @@ performance impact when running `add-hook' and `remove-hook'." (setq hook-value (list hook-value))) ;; Do the actual addition if necessary (unless (member function hook-value) - (when (stringp function) ;FIXME: Why? - (setq function (purecopy function))) - ;; All those `equal' tests performed between functions can end up being - ;; costly since those functions may be large recursive and even cyclic - ;; structures, so we index `hook--depth-alist' with `eq'. (bug#46326) - (when (or (get hook 'hook--depth-alist) (not (zerop depth))) - ;; Note: The main purpose of the above `when' test is to avoid running - ;; this `setf' before `gv' is loaded during bootstrap. - (setf (alist-get function (get hook 'hook--depth-alist) 0) depth)) - (setq hook-value - (if (< 0 depth) - (append hook-value (list function)) - (cons function hook-value))) - (let ((depth-alist (get hook 'hook--depth-alist))) - (when depth-alist - (setq hook-value - (sort (if (< 0 depth) hook-value (copy-sequence hook-value)) - (lambda (f1 f2) - (< (alist-get f1 depth-alist 0 nil #'eq) - (alist-get f2 depth-alist 0 nil #'eq)))))))) + (let ((depth-sym (get hook 'hook--depth-alist))) + ;; While the `member' test above has to use `equal' for historical + ;; reasons, `equal' is a performance problem on large/cyclic functions, + ;; so we index `hook--depth-alist' with `eql'. (bug#46326) + (unless (zerop depth) + (unless depth-sym + (setq depth-sym (make-symbol "depth-alist")) + (set depth-sym nil) + (setf (get hook 'hook--depth-alist) depth-sym)) + (if local (make-local-variable depth-sym)) + (setf (alist-get function + (if local (symbol-value depth-sym) + (default-value depth-sym)) + 0) + depth)) + (setq hook-value + (if (< 0 depth) + (append hook-value (list function)) + (cons function hook-value))) + (when depth-sym + (let ((depth-alist (if local (symbol-value depth-sym) + (default-value depth-sym)))) + (when depth-alist + (setq hook-value + (sort (if (< 0 depth) hook-value (copy-sequence hook-value)) + (lambda (f1 f2) + (< (alist-get f1 depth-alist 0 nil #'eq) + (alist-get f2 depth-alist 0 nil #'eq)))))))))) ;; Set the actual variable (if local (progn @@ -1996,9 +2015,14 @@ one will be removed." (when old-fun ;; Remove auxiliary depth info to avoid leaks (bug#46414) ;; and to avoid the list growing too long. - (let* ((depths (get hook 'hook--depth-alist)) - (di (assq old-fun depths))) - (when di (put hook 'hook--depth-alist (delq di depths))))) + (let* ((depth-sym (get hook 'hook--depth-alist)) + (depth-alist (if depth-sym (if local (symbol-value depth-sym) + (default-value depth-sym)))) + (di (assq old-fun depth-alist))) + (when di + (setf (if local (symbol-value depth-sym) + (default-value depth-sym)) + (remq di depth-alist))))) ;; If the function is on the global hook, we need to shadow it locally ;;(when (and local (member function (default-value hook)) ;; (not (member (cons 'not function) hook-value))) @@ -2160,7 +2184,7 @@ can do the job." (not (macroexp-const-p append))) exp (let* ((sym (cadr list-var)) - (append (eval append)) + (append (eval append lexical-binding)) (msg (format-message "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'" sym)) @@ -2709,7 +2733,7 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'." (defconst read-key-full-map (let ((map (make-sparse-keymap))) - (define-key map [t] 'dummy) + (define-key map [t] #'ignore) ;Dummy binding. ;; ESC needs to be unbound so that escape sequences in ;; `input-decode-map' are still processed by `read-key-sequence'. @@ -3249,6 +3273,15 @@ switch back again to the minibuffer before entering the character. This is not possible when using `read-key', but using `read-key' may be less confusing to some users.") +(defvar from--tty-menu-p nil + "Non-nil means the current command was invoked from a TTY menu.") +(defun use-dialog-box-p () + "Say whether the current command should prompt the user via a dialog box." + (and last-input-event ; not during startup + (or (listp last-nonmenu-event) ; invoked by a mouse event + from--tty-menu-p) ; invoked via TTY menu + use-dialog-box)) + (defun y-or-n-p (prompt) "Ask user a \"y or n\" question. Return t if answer is \"y\" and nil if it is \"n\". @@ -3308,10 +3341,7 @@ like) while `y-or-n-p' is running)." ((and (member str '("h" "H")) help-form) (print help-form)) (t (setq temp-prompt (concat "Please answer y or n. " prompt)))))))) - ((and (display-popup-menus-p) - last-input-event ; not during startup - (listp last-nonmenu-event) - use-dialog-box) + ((use-dialog-box-p) (setq prompt (funcall padded prompt t) answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip))))) (y-or-n-p-use-read-key @@ -4456,7 +4486,7 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" ;; Without this, it will not be handled until the next function ;; call, and that might allow it to exit thru a condition-case ;; that intends to handle the quit signal next time. - (eval '(ignore nil))))) + (eval '(ignore nil) t)))) (defmacro while-no-input (&rest body) "Execute BODY only as long as there's no pending input. @@ -4516,19 +4546,21 @@ It should contain a single %-sequence; e.g., \"Error: %S\". If `debug-on-error' is non-nil, run BODY without catching its errors. This is to be used around code that is not expected to signal an error -but that should be robust in the unexpected case that an error is signaled. - -For backward compatibility, if FORMAT is not a constant string, it -is assumed to be part of BODY, in which case the message format -used is \"Error: %S\"." +but that should be robust in the unexpected case that an error is signaled." (declare (debug t) (indent 1)) - (let ((err (make-symbol "err")) - (format (if (and (stringp format) body) format - (prog1 "Error: %S" - (if format (push format body)))))) - `(condition-case-unless-debug ,err - ,(macroexp-progn body) - (error (message ,format ,err) nil)))) + (let* ((err (make-symbol "err")) + (orig-body body) + (format (if (and (stringp format) body) format + (prog1 "Error: %S" + (if format (push format body))))) + (exp + `(condition-case-unless-debug ,err + ,(macroexp-progn body) + (error (message ,format ,err) nil)))) + (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)))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. @@ -6574,4 +6606,11 @@ OBJECT if it is readable." (throw 'unreadable nil)))) (prin1-to-string object)))) +(defun delete-line () + "Delete the current line." + (delete-region (line-beginning-position) + (progn + (forward-line 1) + (point)))) + ;;; subr.el ends here diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index d49fc2efeab..09105027581 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -474,6 +474,9 @@ you can use the command `toggle-frame-tab-bar'." If t, start a new tab with the current buffer, i.e. the buffer that was current before calling the command that adds a new tab (this is the same what `make-frame' does by default). +If the value is the symbol `window', then keep the selected +window as a single window on the new tab, and keep all its +window parameters except 'window-atom' and 'window-side'. 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, @@ -481,6 +484,7 @@ call it with no arguments and switch to the buffer that it returns. If nil, 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) (string :tag "Buffer" "*scratch*") (directory :tag "Directory" :value "~/") (file :tag "File" :value "~/.emacs") @@ -751,9 +755,13 @@ Used by `tab-bar-format-menu-bar'." (menu-bar-keymap)) (popup-menu menu event))) +(defvar tab-bar-menu-bar-button + (propertize "Menu" 'face 'tab-bar-tab-inactive) + "Button for the menu bar.") + (defun tab-bar-format-menu-bar () "Produce the Menu button for the tab bar that shows the menu bar." - `((menu-bar menu-item (propertize "Menu" 'face 'tab-bar-tab-inactive) + `((menu-bar menu-item ,tab-bar-menu-bar-button tab-bar-menu-bar :help "Menu Bar"))) (defun tab-bar-format-history () @@ -1357,12 +1365,17 @@ After the tab is created, the hooks in ;; Handle the case when it's called in the active minibuffer. (when (minibuffer-selected-window) (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) (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)) + (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))) + (let ((buffer (if (functionp tab-bar-new-tab-choice) (funcall tab-bar-new-tab-choice) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 1c1217cdf6e..80b0aabd776 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -486,7 +486,7 @@ which the tab will represent." (funcall tab-line-tab-name-function tab tabs) (cdr (assq 'name tab)))) (face (if selected-p - (if (eq (selected-window) (old-selected-window)) + (if (mode-line-window-selected-p) 'tab-line-tab-current 'tab-line-tab) 'tab-line-tab-inactive))) @@ -558,8 +558,9 @@ inherit from `tab-line-tab-inactive-alternate'. For use in When TAB is a non-file-visiting buffer, make FACE inherit from `tab-line-tab-special'. For use in `tab-line-tab-face-functions'." - (when (and buffer-p (not (buffer-file-name tab))) - (setf face `(:inherit (tab-line-tab-special ,face)))) + (let ((buffer (if buffer-p tab (cdr (assq 'buffer tab))))) + (when (and buffer (not (buffer-file-name buffer))) + (setf face `(:inherit (tab-line-tab-special ,face))))) face) (defun tab-line-tab-face-modified (tab _tabs face buffer-p _selected-p) @@ -567,8 +568,9 @@ When TAB is a non-file-visiting buffer, make FACE inherit from When TAB is a modified, file-backed buffer, make FACE inherit from `tab-line-tab-modified'. For use in `tab-line-tab-face-functions'." - (when (and buffer-p (buffer-file-name tab) (buffer-modified-p tab)) - (setf face `(:inherit (tab-line-tab-modified ,face)))) + (let ((buffer (if buffer-p tab (cdr (assq 'buffer tab))))) + (when (and buffer (buffer-file-name buffer) (buffer-modified-p buffer)) + (setf face `(:inherit (tab-line-tab-modified ,face))))) face) (defun tab-line-tab-face-group (tab _tabs face _buffer-p _selected-p) @@ -589,7 +591,7 @@ For use in `tab-line-tab-face-functions'." ;; handle tab-line scrolling (window-parameter nil 'tab-line-hscroll) ;; for setting face 'tab-line-tab-current' - (eq (selected-window) (old-selected-window)) + (mode-line-window-selected-p) (and (memq 'tab-line-tab-face-modified tab-line-tab-face-functions) (buffer-file-name) (buffer-modified-p)))) diff --git a/lisp/term.el b/lisp/term.el index 0c8763b462a..3e05d529cd7 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -524,8 +524,8 @@ This means text can automatically reflow if the window is resized." "27.1") (defcustom term-clear-full-screen-programs t - "Whether to clear contents of full-screen TUI programs after exit. -If non-nil, output of full-screen TUI programs is cleared after + "Whether to clear contents of full-screen terminal programs after exit. +If non-nil, output of full-screen terminal programs is cleared after exiting them. Note however that a minority of such programs don't send an appropriate escape sequence to the terminal before exiting so their output isn't cleared regardless of this option." diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 4c06f7f58aa..c4810f116d2 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -86,7 +86,8 @@ DISPLAY may be set to the name of a display that will be initialized." "Convert symbolic selection type TYPE to its MIME equivalent. If TYPE is nil, return \"text/plain\"." (cond - ((memq type '(TEXT COMPOUND_TEXT STRING UTF8_STRING)) "text/plain") + ((eq type 'STRING) "text/plain;charset=iso-8859-1") + ((eq type 'UTF8_STRING) "text/plain") ((stringp type) type) ((symbolp type) (symbol-name type)) (t "text/plain"))) diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index 25f3a851dcc..8e17864284e 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -290,6 +290,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; Any display name is OK. (add-to-list 'display-format-alist '(".*" . pgtk)) + (cl-defmethod handle-args-function (args &context (window-system pgtk)) (x-handle-args args)) @@ -297,10 +298,10 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (x-create-frame-with-faces params)) (declare-function pgtk-own-selection-internal "pgtkselect.c" (selection value &optional frame)) -(declare-function pgtk-disown-selection-internal "pgtkselect.c" (selection &optional time_object terminal)) +(declare-function pgtk-disown-selection-internal "pgtkselect.c" (selection &optional terminal)) (declare-function pgtk-selection-owner-p "pgtkselect.c" (&optional selection terminal)) (declare-function pgtk-selection-exists-p "pgtkselect.c" (&optional selection terminal)) -(declare-function pgtk-get-selection-internal "pgtkselect.c" (selection-symbol target-type &optional time_stamp terminal)) +(declare-function pgtk-get-selection-internal "pgtkselect.c" (selection-symbol target-type &optional terminal)) (cl-defmethod gui-backend-set-selection (selection value &context (window-system pgtk)) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 019a01e22ca..9ae238661e0 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1563,6 +1563,19 @@ EVENT is a preedit-text event." (defvaralias 'x-gtk-use-system-tooltips 'use-system-tooltips) +(declare-function x-internal-focus-input-context (focus frame) "xfns.c") + +(defun x-gtk-use-native-input-watcher (_symbol newval &rest _ignored) + "Variable watcher for `x-gtk-use-native-input'. +If NEWVAL is non-nil, focus the GTK input context of focused +frames on all displays." + (when (and (featurep 'gtk) + (eq (framep (selected-frame)) 'x)) + (x-internal-focus-input-context newval))) + +(add-variable-watcher 'x-gtk-use-native-input + #'x-gtk-use-native-input-watcher) + (provide 'x-win) (provide 'term/x-win) diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index f41fd186e73..d3c832a40da 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -644,20 +644,27 @@ The break position will be always after LINEBEG and generally before point." (defun fill-region-as-paragraph (from to &optional justify nosqueeze squeeze-after) - "Fill the region as one paragraph. -It removes any paragraph breaks in the region and extra newlines at the end, -indents and fills lines between the margins given by the -`current-left-margin' and `current-fill-column' functions. -\(In most cases, the variable `fill-column' controls the width.) -It leaves point at the beginning of the line following the paragraph. - -Normally performs justification according to the `current-justification' -function, but with a prefix arg, does full justification instead. - -From a program, optional third arg JUSTIFY can specify any type of -justification. Fourth arg NOSQUEEZE non-nil means not to make spaces -between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, -means don't canonicalize spaces before that position. + "Fill the region as if it were a single paragraph. +This command removes any paragraph breaks in the region and +extra newlines at the end, and indents and fills lines between the +margins given by the `current-left-margin' and `current-fill-column' +functions. (In most cases, the variable `fill-column' controls the +width.) It leaves point at the beginning of the line following the +region. + +Normally, the command performs justification according to +the `current-justification' function, but with a prefix arg, it +does full justification instead. + +When called from Lisp, optional third arg JUSTIFY can specify any +type of justification; see `default-justification' for the possible +values. +Optional fourth arg NOSQUEEZE non-nil means not to make spaces +between words canonical before filling. +Fifth arg SQUEEZE-AFTER, if non-nil, should be a buffer position; it +means canonicalize spaces only starting from that position. +See `canonically-space-region' for the meaning of canonicalization +of spaces. Return the `fill-prefix' used for filling. @@ -713,8 +720,7 @@ space does not end a sentence, so don't break a line there." (or justify (setq justify (current-justification))) ;; Don't let Adaptive Fill mode alter the fill prefix permanently. - (let ((actual-fill-prefix fill-prefix) - (fill-prefix fill-prefix)) + (let ((fill-prefix fill-prefix)) ;; Figure out how this paragraph is indented, if desired. (when (and adaptive-fill-mode (or (null fill-prefix) (string= fill-prefix ""))) @@ -754,18 +760,9 @@ space does not end a sentence, so don't break a line there." ;; This is the actual filling loop. (goto-char from) - (let ((first t) - linebeg) - (while (< (point) to) - ;; On the first line, there may be text in the fill prefix - ;; zone (when `fill-prefix' is specified externally, and - ;; not computed). In that case, don't consider that area - ;; when trying to find a place to put a line break - ;; (bug#45720). - (if (not first) - (setq linebeg (point)) - (setq first nil - linebeg (+ (point) (length actual-fill-prefix)))) + (let (linebeg) + (while (< (point) to) + (setq linebeg (point)) (move-to-column (current-fill-column)) (if (when (and (< (point) to) (< linebeg to)) ;; Find the position where we'll break the line. @@ -1114,6 +1111,10 @@ space does not end a sentence, so don't break a line there." (defcustom default-justification 'left "Method of justifying text not otherwise specified. Possible values are `left', `right', `full', `center', or `none'. +The values `left' and `right' mean lines are lined up at, +respectively, left or right margin, and ragged at the other margin. +`full' means lines are lined up at both margins. `center' means each +line is centered. `none' means no justification or centering. The requested kind of justification is done whenever lines are filled. The `justification' text-property can locally override this variable." :type '(choice (const left) @@ -1143,6 +1144,7 @@ However, it returns nil rather than `none' to mean \"don't justify\"." (defun set-justification (begin end style &optional whole-par) "Set the region's justification style to STYLE. This commands prompts for the kind of justification to use. +See `default-justification' for the possible values and their meaning. If the mark is not active, this command operates on the current paragraph. If the mark is active, it operates on the region. However, if the beginning and end of the region are not at paragraph breaks, they are @@ -1194,7 +1196,8 @@ If the mark is not active, this applies to the current paragraph." (defun set-justification-left (b e) "Make paragraphs in the region left-justified. -This means they are flush at the left margin and ragged on the right. +This means lines are flush (lined up) at the left margin and ragged +on the right. This is usually the default, but see the variable `default-justification'. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) @@ -1203,7 +1206,8 @@ If the mark is not active, this applies to the current paragraph." (defun set-justification-right (b e) "Make paragraphs in the region right-justified. -This means they are flush at the right margin and ragged on the left. +This means lines are flush (lined up) at the right margin and ragged +on the left. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) @@ -1211,7 +1215,7 @@ If the mark is not active, this applies to the current paragraph." (defun set-justification-full (b e) "Make paragraphs in the region fully justified. -This makes lines flush on both margins by inserting spaces between words. +This makes lines be lined up on both margins by inserting spaces between words. If the mark is not active, this applies to the current paragraph." (interactive (list (if mark-active (region-beginning) (point)) (if mark-active (region-end) (point)))) @@ -1246,7 +1250,8 @@ If the mark is not active, this applies to the current paragraph." Normally does full justification: adds spaces to the line to make it end at the column given by `current-fill-column'. Optional first argument HOW specifies alternate type of justification: -it can be `left', `right', `full', `center', or `none'. +it can be `left', `right', `full', `center', or `none'; for their +meaning, see `default-justification'. If HOW is t, will justify however the `current-justification' function says to. If HOW is nil or missing, full justification is done by default. Second arg EOP non-nil means that this is the last line of the paragraph, so diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 6382b402c06..b58514972a1 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -797,6 +797,9 @@ See `ispell-buffer-with-debug' for an example of use." "An alist of parsed Aspell dicts and associated parameters. Internal use.") +(defvar ispell--aspell-found-dictionaries nil + "An alist of identified aspell dictionaries.") + (defun ispell-find-aspell-dictionaries () "Find Aspell's dictionaries, and record in `ispell-aspell-dictionary-alist'." (let* ((dictionaries @@ -810,7 +813,8 @@ Internal use.") (mapcar #'ispell-aspell-find-dictionary dictionaries)))) ;; Ensure aspell's alias dictionary will override standard ;; definitions. - (setq found (ispell-aspell-add-aliases found)) + (setq found (ispell-aspell-add-aliases found) + ispell--aspell-found-dictionaries (copy-sequence found)) ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist ;; which have no element in FOUND at all. (dolist (dict ispell-dictionary-base-alist) @@ -1378,9 +1382,11 @@ The variable `ispell-library-directory' defines their location." (if (and name (or ;; Include all for Aspell (we already know existing dicts) - ispell-really-aspell + (and ispell-really-aspell + (assoc name ispell--aspell-found-dictionaries)) ;; Include all if `ispell-library-directory' is nil (Hunspell) - (not ispell-library-directory) + (and (not ispell-really-aspell) + (not ispell-library-directory)) ;; If explicit (-d with an absolute path) and existing dict. (and dict-explt (file-name-absolute-p dict-explt) @@ -2986,8 +2992,7 @@ By just answering RET you can find out what the current dictionary is." (interactive (list (completing-read "Use new dictionary (RET for current, SPC to complete): " - (and (fboundp 'ispell-valid-dictionary-list) - (mapcar #'list (ispell-valid-dictionary-list))) + (mapcar #'list (ispell-valid-dictionary-list)) nil t) current-prefix-arg)) (ispell-set-spellchecker-params) ; Initialize variables and dicts alists diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 4ba3c2193ee..f6f72cec4f8 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -381,7 +381,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (- (or reftex-last-window-height (window-height)) (window-height))))) (when (> count 0) - (with-demoted-errors ;E.g. the window might be the root window! + (with-demoted-errors "Enlarge window error: %S" (enlarge-window count reftex-toc-split-windows-horizontally))))) (defun reftex-toc-dframe-p (&optional frame error) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index f41cc2c15ed..ab94036d01d 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -505,7 +505,9 @@ An alternative value is \" . \", if you use a font with a narrow period." "documentstyle" "documentclass" "verbatiminput" "includegraphics" "includegraphics*") t)) - (verbish (regexp-opt '("url" "nolinkurl" "path") t)) + (verbish (regexp-opt '("url" "nolinkurl" "path" + "href" "ProvidesFile") + t)) ;; Miscellany. (slash "\\\\") (opt " *\\(\\[[^]]*\\] *\\)*") @@ -578,9 +580,6 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; "caption" "footnote" "footnotemark" "footnotetext" ) t)) - (file-like (regexp-opt - '("href" "ProvidesFile") - t)) ;; ;; Names of commands that should be fontified. (specials-1 (regexp-opt '("\\" "\\*") t)) ;; "-" @@ -601,8 +600,6 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; ;; Citation args. (list (concat slash citations opt arg) 3 'font-lock-constant-face) - ;; File-like args. - (list (concat slash file-like opt arg) 3 'font-lock-constant-face) ;; ;; Text between `` quotes ''. (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 045264528ff..5f9ccc094af 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -508,14 +508,14 @@ If no URL is found, return nil. If optional argument LAX is non-nil, look for URLs that are not well-formed, such as foo@bar or <nobody>. -If optional arguments BOUNDS are non-nil, it should be a cons +If optional argument BOUNDS is non-nil, it should be a cons cell of the form (START . END), containing the beginning and end positions of the URI. Otherwise, these positions are detected automatically from the text around point. If the scheme component is absent, either because a URI delimited with <url:...> lacks one, or because an ill-formed URI was found -with LAX or BEG and END, try to add a scheme in the returned URI. +with LAX or BOUNDS, try to add a scheme in the returned URI. The scheme is chosen heuristically: \"mailto:\" if the address looks like an email address, \"ftp://\" if it starts with \"ftp\", etc." diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 2aa487d0454..0ee3c38e26d 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -58,9 +58,11 @@ echo area, instead of making a pop-up window." (if (and tooltip-mode (fboundp 'x-show-tip)) (progn (add-hook 'pre-command-hook 'tooltip-hide) - (add-hook 'tooltip-functions 'tooltip-help-tips)) + (add-hook 'tooltip-functions 'tooltip-help-tips) + (add-hook 'x-pre-popup-menu-hook 'tooltip-hide)) (unless (and (boundp 'gud-tooltip-mode) gud-tooltip-mode) - (remove-hook 'pre-command-hook 'tooltip-hide)) + (remove-hook 'pre-command-hook 'tooltip-hide) + (remove-hook 'x-pre-popup-menu-hook 'tooltip-hide)) (remove-hook 'tooltip-functions 'tooltip-help-tips)) (setq show-help-function (if tooltip-mode 'tooltip-show-help 'tooltip-show-help-non-mode))) @@ -375,12 +377,7 @@ It is also called if Tooltip mode is on, for text-only displays." (defun tooltip-show-help (msg) "Function installed as `show-help-function'. MSG is either a help string to display, or nil to cancel the display." - (if (and (display-graphic-p) - ;; On Haiku, system tooltips can't be displayed above - ;; menus. - (or (not (and (eq window-system 'haiku) - haiku-use-system-tooltips)) - (not (menu-or-popup-active-p)))) + (if (and (display-graphic-p)) (let ((previous-help tooltip-help-message)) (setq tooltip-help-message msg) (cond ((null msg) diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 31e5c07234c..3863ac99144 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -29,6 +29,12 @@ (require 'url-dired) (declare-function mm-disable-multibyte "mm-util" ()) +(defvar url-allow-non-local-files nil + "If non-nil, allow URL to fetch non-local files. +By default, this is not allowed, since that would allow rendering +HTML to fetch files on other systems if given a <img +src=\"/ssh:host...\"> element, which can be disturbing.") + (defconst url-file-default-port 21 "Default FTP port.") (defconst url-file-asynchronous-p t "FTP transfers are asynchronous.") (defalias 'url-file-expand-file-name 'url-default-expander) @@ -70,18 +76,15 @@ to them." buff func func args args efs)) - (let ((size (file-attribute-size (file-attributes name)))) - (with-current-buffer buff - (goto-char (point-max)) - (if (/= -1 size) - (insert (format "Content-length: %d\n" size))) - (insert "\n") - (insert-file-contents-literally name) - (if (not (url-file-host-is-local-p (url-host url-current-object))) - (condition-case () - (delete-file name) - (error nil))) - (apply func args)))) + (with-current-buffer buff + (goto-char (point-max)) + (insert-file-contents-literally name) + (insert (format "Content-length: %d\n\n" (buffer-size))) + (if (not (url-file-host-is-local-p (url-host url-current-object))) + (condition-case () + (delete-file name) + (error nil))) + (apply func args))) (declare-function ange-ftp-set-passwd "ange-ftp" (host user passwd)) (declare-function ange-ftp-copy-file-internal "ange-ftp" @@ -111,7 +114,8 @@ to them." (memq system-type '(ms-dos windows-nt))) (substring file 1)) ;; file: URL with a file:/bar:/foo-like spec. - ((string-match "\\`/[^/]+:/" file) + ((and (not url-allow-non-local-files) + (string-match "\\`/[^/]+:/" file)) (concat "/:" file)) (t file)))) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index d353f0c0117..152300bda55 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -31,6 +31,7 @@ (eval-when-compile (require 'cl-lib)) (require 'browse-url) (require 'url-parse) +(require 'url-file) (defcustom url-queue-parallel-processes 6 "The number of concurrent processes." @@ -160,6 +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. diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index e9a21825e18..beaad2e835f 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -1068,8 +1068,23 @@ the change log file in another window." (insert-before-markers "(")) (error nil))))) +;; If we're filling a line that has a whole bunch of file names, and +;; we're still in the file names, then transform this so that it'll +;; still font-lock properly. +(defun change-log-fill-file-list () + (save-excursion + (unless (bobp) + (forward-line -1) + (when (looking-at change-log-file-names-re) + (goto-char (match-end 0)) + (while (looking-at "\\=, \\([^ ,:([\n]+\\)") + (goto-char (match-end 0))) + (when (looking-at ", *\n") + (replace-match ":\n *" t t)))))) + (defun change-log-indent () (change-log-fill-parenthesized-list) + (change-log-fill-file-list) (let* ((indent (save-excursion (beginning-of-line) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 731d1e8256f..511cc89778d 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1596,8 +1596,8 @@ modified lines of the diff." nil))) (when (eq diff-buffer-type 'git) (setq diff-outline-regexp - (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)")) - (setq-local outline-level #'diff--outline-level)) + (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)"))) + (setq-local outline-level #'diff--outline-level) (setq-local outline-regexp diff-outline-regexp)) (defun diff-delete-if-empty () @@ -2603,37 +2603,75 @@ fixed, visit it in a buffer." (save-excursion ;; FIXME: Include the first space for context-style hunks! (while (re-search-forward "^[-+! ]" limit t) - (let ((spec (alist-get (char-before) - '((?+ . (left-fringe diff-fringe-add diff-indicator-added)) - (?- . (left-fringe diff-fringe-del diff-indicator-removed)) - (?! . (left-fringe diff-fringe-rep diff-indicator-changed)) - (?\s . (left-fringe diff-fringe-nul fringe)))))) - (put-text-property (match-beginning 0) (match-end 0) 'display spec)))) + (unless (eq (get-text-property (match-beginning 0) 'face) 'diff-header) + (let ((spec + (alist-get + (char-before) + '((?+ . (left-fringe diff-fringe-add diff-indicator-added)) + (?- . (left-fringe diff-fringe-del diff-indicator-removed)) + (?! . (left-fringe diff-fringe-rep diff-indicator-changed)) + (?\s . (left-fringe diff-fringe-nul fringe)))))) + (put-text-property (match-beginning 0) (match-end 0) + 'display spec))))) ;; Mimicks the output of Magit's diff. ;; FIXME: This has only been tested with Git's diff output. + ;; FIXME: Add support for Git's "rename from/to"? (while (re-search-forward "^diff " limit t) - ;; FIXME: Switching between context<->unified leads to messed up - ;; file headers by cutting the `display' property in chunks! + ;; We split the regexp match into a search plus a looking-at because + ;; we want to use LIMIT for the search but we still want to match + ;; all the header's lines even if LIMIT falls in the middle of it. (when (save-excursion (forward-line 0) (looking-at (eval-when-compile - (concat "diff.*\n" - "\\(?:\\(?:new file\\|deleted\\).*\n\\)?" - "\\(?:index.*\n\\)?" - "--- \\(?:" null-device "\\|a/\\(.*\\)\\)\n" - "\\+\\+\\+ \\(?:" null-device "\\|b/\\(.*\\)\\)\n")))) - (put-text-property (match-beginning 0) (1- (match-end 0)) - 'display - (propertize - (cond - ((null (match-string 1)) - (concat "new file " (match-string 2))) - ((null (match-string 2)) - (concat "deleted " (match-string 1))) - (t - (concat "modified " (match-string 1)))) - 'face '(diff-file-header diff-header)))))) + (let* ((index "\\(?:index.*\n\\)?") + (file4 (concat + "\\(?:" null-device "\\|[ab]/\\(?4:.*\\)\\)")) + (file5 (concat + "\\(?:" null-device "\\|[ab]/\\(?5:.*\\)\\)")) + (header (concat "--- " file4 "\n" + "\\+\\+\\+ " file5 "\n")) + (binary (concat + "Binary files " file4 + " and " file5 " \\(?7:differ\\)\n")) + (horb (concat "\\(?:" header "\\|" binary "\\)"))) + (concat "diff.*?\\(?: a/\\(.*?\\) b/\\(.*\\)\\)?\n" + "\\(?:\\(?:old\\|new\\) mode .*\n\\)*" + "\\(?:" + ;; For new/deleted files, there might be no + ;; header (and no hunk) if the file is/was empty. + "\\(?3:new\\(?6:\\)\\|deleted\\) file.*\n" + index "\\(?:" horb "\\)?" + ;; Normal case. + "\\|" index horb "\\)"))))) + ;; The file names can be extracted either from the `diff' line + ;; or from the two header lines. Prefer the header line info if + ;; available since the `diff' line is ambiguous in case the + ;; file names include " b/" or " a/". + ;; FIXME: This prettification throws away all the information + ;; about file modes (and the index hashes). + (let ((oldfile (or (match-string 4) (match-string 1))) + (newfile (or (match-string 5) (match-string 2))) + (kind (if (match-beginning 7) " BINARY" + (unless (or (match-beginning 4) (match-beginning 5)) + " empty")))) + (add-text-properties + (match-beginning 0) (1- (match-end 0)) + (list 'display + (propertize + (cond + ((match-beginning 3) + (concat (capitalize (match-string 3)) kind " file" + " " + (if (match-beginning 6) newfile oldfile))) + ((null (match-string 4)) + (concat "New" kind " file " newfile)) + ((null (match-string 2)) + (concat "Deleted" kind " file " oldfile)) + (t + (concat "Modified" kind " file " oldfile))) + 'face '(diff-file-header diff-header)) + 'font-lock-multiline t)))))) nil) ;;; Syntax highlighting from font-lock @@ -2678,7 +2716,8 @@ When OLD is non-nil, highlight the hunk from the old source." ;; Trim a trailing newline to find hunk in diff-syntax-fontify-props ;; in diffs that have no newline at end of diff file. (text (string-trim-right - (or (with-demoted-errors (diff-hunk-text hunk (not old) nil)) + (or (with-demoted-errors "Error getting hunk text: %S" + (diff-hunk-text hunk (not old) nil)) ""))) (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?") (if old (match-string 1) diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index ca56a2851db..07b853817d1 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -85,7 +85,10 @@ options after the default ones. This variable is not for customizing the look of the differences produced by the command \\[ediff-show-diff-output]. Use the variable -`ediff-custom-diff-options' for that." +`ediff-custom-diff-options' for that. + +Setting this variable directly may not yield the expected +results. It should be set via the Customize interface instead." :set #'ediff-set-diff-options :type 'string) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 6a4f6542b5e..003b26eca41 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -925,8 +925,11 @@ Its behavior has mainly two restrictions: to `smerge-refine-regions'. This only matters if `smerge-refine-weight-hack' is nil.") -(defvar smerge-refine-ignore-whitespace t - "If non-nil, `smerge-refine' should try to ignore change in whitespace.") +(defcustom smerge-refine-ignore-whitespace t + "If non-nil, `smerge-refine' should try to ignore change in whitespace." + :type 'boolean + :version "29.1" + :group 'diff) (defvar smerge-refine-weight-hack t "If non-nil, pass to diff as many lines as there are chars in the region. diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index bd4ff3e015a..4a511f1f688 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -57,7 +57,7 @@ is applied to the background." :set (lambda (symbol value) (set-default symbol value) (when (boundp 'vc-annotate-color-map) - (with-demoted-errors + (with-demoted-errors "VC color map error: %S" ;; Update the value of the dependent variable. (custom-reevaluate-setting 'vc-annotate-color-map)))) :version "25.1" diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index ba6e098d987..0d750515c3d 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1538,9 +1538,8 @@ These are the commands available for use in the file status buffer: This implements the `bookmark-make-record-function' type for `vc-dir' buffers." (let* ((bookmark-name - (concat "(" (symbol-name vc-dir-backend) ") " - (file-name-nondirectory - (directory-file-name default-directory)))) + (file-name-nondirectory + (directory-file-name default-directory))) (defaults (list bookmark-name default-directory))) `(,bookmark-name ,@(bookmark-make-record-default 'no-file) @@ -1560,6 +1559,8 @@ type returned by `vc-dir-bookmark-make-record'." (bookmark-default-handler `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk))))) +(put 'vc-dir-bookmark-jump 'bookmark-handler-type "VC") + (provide 'vc-dir) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 9c49e947810..bd2ea337b16 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -799,9 +799,10 @@ In the latter case, VC mode is deactivated for this buffer." (add-hook 'vc-mode-line-hook #'vc-mode-line nil t) (let (backend) (cond - ((setq backend (with-demoted-errors (vc-backend buffer-file-name))) - ;; Let the backend setup any buffer-local things he needs. - (vc-call-backend backend 'find-file-hook) + ((setq backend (with-demoted-errors "VC refresh error: %S" + (vc-backend buffer-file-name))) + ;; Let the backend setup any buffer-local things he needs. + (vc-call-backend backend 'find-file-hook) ;; Compute the state and put it in the mode line. (vc-mode-line buffer-file-name backend) (unless vc-make-backup-files diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 54457a21433..a6124acadd2 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1742,7 +1742,20 @@ BUFFER defaults to the current buffer." "Functions run at the end of the diff command. Each function runs in the diff output buffer without args.") -(defun vc-diff-finish (buffer messages) +(defun vc-diff-restore-buffer (original new) + "Restore point in buffer NEW to where it was in ORIGINAL. + +This function works by updating buffer ORIGINAL with the contents +of NEW (without destroying existing markers), swapping their text +objects, and finally killing buffer ORIGINAL." + (with-current-buffer original + (let ((inhibit-read-only t)) + (replace-buffer-contents new))) + (with-current-buffer new + (buffer-swap-text original)) + (kill-buffer original)) + +(defun vc-diff-finish (buffer messages &optional oldbuf) ;; The empty sync output case has already been handled, so the only ;; possibility of an empty output is for an async process. (when (buffer-live-p buffer) @@ -1754,7 +1767,11 @@ Each function runs in the diff output buffer without args.") (message "%s" (cdr messages)))) (diff-setup-whitespace) (diff-setup-buffer-type) - (goto-char (point-min)) + ;; `oldbuf' is the buffer that used to show this diff. Make + ;; sure that we restore point in it if it's given. + (if oldbuf + (vc-diff-restore-buffer oldbuf buffer) + (goto-char (point-min))) (run-hooks 'vc-diff-finish-functions)) (when (and messages (not emptyp)) (message "%sdone" (car messages)))))) @@ -1779,7 +1796,11 @@ Return t if the buffer had changes, nil otherwise." ;; but the only way to set it for each file included would ;; be to call the back end separately for each file. (coding-system-for-read - (if files (vc-coding-system-for-diff (car files)) 'undecided))) + (if files (vc-coding-system-for-diff (car files)) 'undecided)) + (orig-diff-buffer-clone + (if revert-buffer-in-progress-p + (clone-buffer + (generate-new-buffer-name " *vc-diff-clone*") nil)))) ;; On MS-Windows and MS-DOS, Diff is likely to produce DOS-style ;; EOLs, which will look ugly if (car files) happens to have Unix ;; EOLs. @@ -1840,7 +1861,8 @@ Return t if the buffer had changes, nil otherwise." ;; after `pop-to-buffer'; the former assumes the diff buffer is ;; shown in some window. (let ((buf (current-buffer))) - (vc-run-delayed (vc-diff-finish buf (when verbose messages)))) + (vc-run-delayed (vc-diff-finish buf (when verbose messages) + orig-diff-buffer-clone))) ;; In the async case, we return t even if there are no differences ;; because we don't know that yet. t))) diff --git a/lisp/version.el b/lisp/version.el index 45f72b4329f..7e360209d85 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -56,8 +56,13 @@ developing Emacs.") (declare-function haiku-get-version-string "haikufns.c") (defun emacs-version (&optional here) - "Return string describing the version of Emacs that is running. -If optional argument HERE is non-nil, insert string at point. + "Display the version of Emacs that is running in this session. +With a prefix argument, insert the Emacs version string at point +instead of displaying it. +If called from Lisp, by default return the version string; but +if the optional argument HERE is non-nil, insert the string at +point instead. + Don't use this function in programs to choose actions according to the system configuration; look at `system-configuration' instead." (interactive "P") diff --git a/lisp/wdired.el b/lisp/wdired.el index 1c02562721a..ab3b91bbe55 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -169,6 +169,7 @@ nonexistent directory will fail." "C-p" #'wdired-previous-line "<down>" #'wdired-next-line "C-n" #'wdired-next-line + "C-(" #'dired-hide-details-mode "<remap> <upcase-word>" #'wdired-upcase-word "<remap> <capitalize-word>" #'wdired-capitalize-word "<remap> <downcase-word>" #'wdired-downcase-word diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index f00a524c0c4..29b6e13bc60 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3532,13 +3532,17 @@ It reads a directory name from an editable text field." (define-widget 'key 'editable-field "A key sequence." :prompt-value 'widget-field-prompt-value - :match 'key-valid-p + :match #'widget-key-valid-p :format "%{%t%}: %v" :validate 'widget-key-validate :keymap widget-key-sequence-map :help-echo "C-q: insert KEY, EVENT, or CODE; RET: enter value" :tag "Key") +(defun widget-key-valid-p (_widget value) + "Non-nil if VALUE is a valid value for the key widget WIDGET." + (key-valid-p value)) + (defun widget-key-validate (widget) (unless (and (stringp (widget-value widget)) (key-valid-p (widget-value widget))) diff --git a/lisp/window.el b/lisp/window.el index 582600e1c69..54c9eee5f32 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6394,7 +6394,11 @@ windows can get as small as `window-safe-min-height' and (window--state-put-2 ignore pixelwise)) (while window-state-put-stale-windows (let ((window (pop window-state-put-stale-windows))) - (when (eq (window-deletable-p window) t) + ;; Avoid that 'window-deletable-p' throws an error if window + ;; was already deleted when exiting 'with-temp-buffer' above + ;; (Bug#54028). + (when (and (window-valid-p window) + (eq (window-deletable-p window) t)) (delete-window window)))) (window--check frame)))) diff --git a/lisp/woman.el b/lisp/woman.el index 2e0d9a9090d..c0c8f343484 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2280,9 +2280,9 @@ Currently set only from \\='\\\" t in the first line of the source file.") (replace-match woman-unpadded-space-string t t)) ;; Discard optional hyphen \%; concealed newlines \<newline>; - ;; point-size change function \sN,\s+N, \s-N: + ;; kerning \/, \,; point-size change function \sN,\s+N, \s-N: (goto-char from) - (while (re-search-forward "\\\\\\([%\n]\\|s[-+]?[0-9]+\\)" nil t) + (while (re-search-forward "\\\\\\([%\n/,]\\|s[-+]?[0-9]+\\)" nil t) (woman-delete-match 0)) ;; BEWARE: THIS SHOULD PROBABLY ALL BE DONE MUCH LATER!!!!! @@ -4579,6 +4579,8 @@ logging the message." (bookmark-default-handler `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))) +(put 'woman-bookmark-jump 'bookmark-handler-type "WoMan") + ;; Obsolete. (defvar woman-version "0.551 (beta)" "WoMan version information.") diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 487c6b2219d..e50324ac47c 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -987,6 +987,7 @@ You can retrieve the value with `xwidget-get'." (define-key xwidget-webkit-edit-mode-map [M-up] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [M-down] 'xwidget-webkit-pass-command-event) (define-key xwidget-webkit-edit-mode-map [M-return] 'xwidget-webkit-pass-command-event) +(define-key xwidget-webkit-edit-mode-map [C-backspace] 'xwidget-webkit-pass-command-event) (define-minor-mode xwidget-webkit-edit-mode "Minor mode for editing the content of WebKit buffers. diff --git a/lisp/yank-media.el b/lisp/yank-media.el index 9836082fb2a..5cd75eb3186 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -155,30 +155,7 @@ non-supported selection data types." (format "%s" data)) ((string-match-p "\\`text/" (symbol-name data-type)) ;; We may have utf-16, which Emacs won't detect automatically. - (let ((coding-system - (and (zerop (mod (length data) 2)) - (let ((stats (vector 0 0))) - (dotimes (i (length data)) - (when (zerop (elt data i)) - (setf (aref stats (mod i 2)) - (1+ (aref stats (mod i 2)))))) - ;; If we have more than 90% every-other nul, then it's - ;; pretty likely to be utf-16. - (cond - ((> (if (zerop (elt stats 1)) - 1 - (/ (float (elt stats 0)) - (float (elt stats 1)))) - 0.9) - ;; Big endian. - 'utf-16-be) - ((> (if (zerop (elt stats 0)) - 1 - (/ (float (elt stats 1)) - (float (elt stats 0)))) - 0.9) - ;; Little endian. - 'utf-16-le)))))) + (let ((coding-system (yank-media--utf-16-p data))) (if coding-system (decode-coding-string data coding-system) ;; Some programs add a nul character at the end of text/* @@ -189,6 +166,25 @@ non-supported selection data types." (t data))) +(defun yank-media--utf-16-p (data) + (and (zerop (mod (length data) 2)) + (let ((stats (vector 0 0))) + (dotimes (i (length data)) + (when (zerop (elt data i)) + (setf (aref stats (mod i 2)) + (1+ (aref stats (mod i 2)))))) + ;; If we have more than 90% every-other nul, then it's + ;; pretty likely to be utf-16. + (cond + ((> (/ (float (elt stats 0)) (/ (length data) 2)) + 0.9) + ;; Big endian. + 'utf-16-be) + ((> (/ (float (elt stats 1)) (/ (length data) 2)) + 0.9) + ;; Little endian. + 'utf-16-le))))) + (provide 'yank-media) ;;; yank-media.el ends here diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 369162c7fec..ace5141cdbc 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -2105,7 +2105,8 @@ XlwMenuDestroy (Widget w) ungrab_all ((Widget)w, CurrentTime); pointer_grabbed = 0; - submenu_destroyed = 1; + if (!XtIsShell (XtParent (w))) + submenu_destroyed = 1; release_drawing_gcs (mw); release_shadow_gcs (mw); @@ -2742,4 +2743,6 @@ pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent *event) ((XMotionEvent*)event)->is_hint = 0; handle_motion_event (mw, (XMotionEvent*)event); + + XlwMenuRedisplay ((Widget) mw, NULL, None); } diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index e041e4e5b8d..86f00c024a8 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -55,8 +55,10 @@ s/ *@LIBJPEG@// s/ *@LIBPNG@// s/ *@LIBGIF@// s/ *@LIBXPM@// +s/ *@WEBP_LIBS@// /^HAVE_NATIVE_COMP *=/s/@HAVE_NATIVE_COMP@/no/ /^HAVE_PDUMPER *=/s/@HAVE_PDUMPER@/no/ +/^HAVE_BE_APP *=/s/@HAVE_BE_APP@/no/ /^CHECK_STRUCTS *=/s/@CHECK_STRUCTS@// /^RUN_TEMACS \=/s/temacs/temacs.exe/ /^XFT_LIBS *=/s/@XFT_LIBS@// @@ -78,6 +80,10 @@ s/ *@LIBXPM@// /^NOTIFY_LIBS *=/s/@NOTIFY_LIBS@// /^NOTIFY_CFLAGS *=/s/@NOTIFY_CFLAGS@// /^GTK_OBJ *=/s/@GTK_OBJ@// +/^PGTK_OBJ *=/s/@PGTK_OBJ@// +/^PGTK_LIBS *=/s/@PGTK_LIBS@// +/^HAIKU_OBJ *=/s/@HAIKU_OBJ@// +/^HAIKU_CXX_OBJ *=/s/@HAIKU_CXX_OBJ@// /^LIBS_TERMCAP *=/s/@LIBS_TERMCAP@// /^TERMCAP_OBJ *=/s/@TERMCAP_OBJ@/termcap.o tparam.o/ /^LIBXMU *=/s/@LIBXMU@// @@ -110,6 +116,14 @@ s/ *@LIBXPM@// /^XFIXES_CFLAGS *=/s/@XFIXES_CFLAGS@// /^XDBE_LIBS *=/s/@XDBE_LIBS@// /^XDBE_CFLAGS *=/s/@XDBE_CFLAGS@// +/^XINPUT_LIBS *=/s/@XINPUT_LIBS@// +/^XINPUT_CFLAGS *=/s/@XINPUT_CFLAGS@// +/^XSYNC_LIBS *=/s/@XSYNC_LIBS@// +/^XSYNC_CFLAGS *=/s/@XSYNC_CFLAGS@// +/^WEBP_CFLAGS *=/s/@WEBP_CFLAGS@// +/^SQLITE3_LIBS *=/s/@SQLITE3_LIBS@// +/^HAIKU_LIBS *=/s/@HAIKU_LIBS@// +/^HAIKU_CFLAGS *=/s/@HAIKU_CFLAGS@// /^CYGWIN_OBJ *=/s/@CYGWIN_OBJ@// /^WINDOW_SYSTEM_OBJ *=/s/@WINDOW_SYSTEM_OBJ@// /^MSDOS_OBJ *=/s/= */= dosfns.o msdos.o w16select.o/ @@ -255,4 +269,4 @@ s| -I\$(top_srcdir)/lib|| s| -I\. -I\$(srcdir)| -I.| /^ *test "X/d /\$(CC) -o \$@.tmp/s/\$@.tmp/\$@/ -/mv \$@.tmp \$@/d
\ No newline at end of file +/mv \$@.tmp \$@/d diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 59ebec9e756..8602aaf449e 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -268,6 +268,8 @@ s/@PACKAGE@/emacs/ # MKDIR_P lines are edited further below # MKDIR_P is only used to create lib/malloc, and the folder is # already present in the distribution, so this should work fine. +# (No longer true as of Emacs 29, but the directories we need +# are created in config.bat!) /^MKDIR_P *=/s/@MKDIR_P@/echo/ /^NEXT_AS_FIRST_DIRECTIVE_DIRENT_H *=/s/@[^@\n]*@/<dirent.h>/ /^NEXT_AS_FIRST_DIRECTIVE_ERRNO_H *=/s/@[^@\n]*@// @@ -403,18 +405,19 @@ s/^ -*test -z.*|| rm/ -rm/ s/@echo /@djecho / # # Determine which headers to generate -s/= @GL_GENERATE_ALLOCA_H_TRUE@/= 1/ -s/= @GL_GENERATE_BYTESWAP_H@/= 1/ -s/= @GL_GENERATE_EXECINFO_H@/= 1/ -s/= @GL_GENERATE_IEEE754_H@/= 1/ -s/= @GL_GENERATE_STDALIGN_H@/= 1/ -s/= @GL_GENERATE_STDDEF_H@/= 1/ -s/= @GL_GENERATE_STDINT_H@/= 1/ -s/= @GL_GENERATE_LIMITS_H@/= 1/ -s/= @GL_GENERATE_ERRNO_H@/= / -s/= @GL_GENERATE_LIMITS_H@/= / -s/= @GL_GENERATE_GMP_GMP_H@/= 1/ -s/= @GL_GENERATE_MINI_GMP_H@/= 1/ +s/= @GL_GENERATE_ALLOCA_H_CONDITION@/= 1/ +s/= @GL_GENERATE_BYTESWAP_H_CONDITION@/= 1/ +s/= @GL_GENERATE_EXECINFO_H_CONDITION@/= 1/ +s/= @GL_GENERATE_IEEE754_H_CONDITION@/= 1/ +s/= @GL_GENERATE_STDALIGN_H_CONDITION@/= 1/ +s/= @GL_GENERATE_STDDEF_H_CONDITION@/= 1/ +s/= @GL_GENERATE_STDINT_H_CONDITION@/= 1/ +s/= @GL_GENERATE_LIMITS_H_CONDITION@/= 1/ +s/= @GL_GENERATE_ERRNO_H_CONDITION@/= / +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/\$\(MKDIR_P\) malloc// # # Determine which modules to build and which to omit diff --git a/src/Makefile.in b/src/Makefile.in index 706beb453b6..3353fb16d79 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -264,6 +264,9 @@ XFIXES_CFLAGS = @XFIXES_CFLAGS@ XINPUT_LIBS = @XINPUT_LIBS@ XINPUT_CFLAGS = @XINPUT_CFLAGS@ +XSYNC_LIBS = @XSYNC_LIBS@ +XSYNC_CFLAGS = @XSYNC_CFLAGS@ + XDBE_LIBS = @XDBE_LIBS@ XDBE_CFLAGS = @XDBE_CFLAGS@ @@ -396,7 +399,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ $(XINPUT_CFLAGS) $(WEBP_CFLAGS) $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \ $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ - $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \ + $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) $(XSYNC_CFLAGS) \ $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ $(WERROR_CFLAGS) $(HAIKU_CFLAGS) ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) @@ -548,7 +551,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE) $(LIBIMAGE $(WEBKIT_LIBS) \ $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \ $(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \ - $(XDBE_LIBS) \ + $(XDBE_LIBS) $(XSYNC_LIBS) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ @@ -678,9 +681,9 @@ $(LIBEGNU_ARCHIVE): $(config_h) $(MAKE) -C $(dir $@) all ifeq ($(HAVE_PDUMPER),yes) - MAKE_PDUMPER_FINGERPRINT = $(libsrc)/make-fingerprint$(EXEEXT) +MAKE_PDUMPER_FINGERPRINT = $(libsrc)/make-fingerprint$(EXEEXT) else - MAKE_PDUMPER_FINGERPRINT = +MAKE_PDUMPER_FINGERPRINT = endif ## We have to create $(etc) here because init_cmdargs tests its diff --git a/src/alloc.c b/src/alloc.c index e01ea36e642..9ed94dc8a1e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3891,7 +3891,7 @@ run_finalizer_handler (Lisp_Object args) static void run_finalizer_function (Lisp_Object function) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef HAVE_PDUMPER ++number_finalizers_run; #endif @@ -4925,8 +4925,8 @@ mark_maybe_pointer (void *p, bool symbol_only) miss objects if __alignof__ were used. */ #define GC_POINTER_ALIGNMENT alignof (void *) -/* Mark Lisp objects referenced from the address range START+OFFSET..END - or END+OFFSET..START. */ +/* Mark Lisp objects referenced from the address range START..END + or END..START. */ static void ATTRIBUTE_NO_SANITIZE_ADDRESS mark_memory (void const *start, void const *end) @@ -5744,10 +5744,10 @@ allow_garbage_collection (intmax_t consing) garbage_collection_inhibited--; } -ptrdiff_t +specpdl_ref inhibit_garbage_collection (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_intmax (allow_garbage_collection, consing_until_gc); garbage_collection_inhibited++; consing_until_gc = HI_THRESHOLD; @@ -6107,7 +6107,7 @@ garbage_collect (void) Lisp_Object tail, buffer; char stack_top_variable; bool message_p; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct timespec start; eassert (weak_hash_tables == NULL); @@ -6265,7 +6265,7 @@ garbage_collect (void) if (!NILP (Vpost_gc_hook)) { - ptrdiff_t gc_count = inhibit_garbage_collection (); + specpdl_ref gc_count = inhibit_garbage_collection (); safe_run_hooks (Qpost_gc_hook); unbind_to (gc_count, Qnil); } @@ -6318,7 +6318,7 @@ For further details, see Info node `(elisp)Garbage Collection'. */) if (garbage_collection_inhibited) return Qnil; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qsymbols_with_pos_enabled, Qnil); garbage_collect (); unbind_to (count, Qnil); @@ -7385,7 +7385,8 @@ Frames, windows, buffers, and subprocesses count as vectors make_int (strings_consed)); } -#if defined GNU_LINUX && defined __GLIBC__ +#if defined GNU_LINUX && defined __GLIBC__ && \ + (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 10) DEFUN ("malloc-info", Fmalloc_info, Smalloc_info, 0, 0, "", doc: /* Report malloc information to stderr. This function outputs to stderr an XML-formatted @@ -7421,7 +7422,7 @@ Lisp_Object which_symbols (Lisp_Object obj, EMACS_INT find_max) { struct symbol_block *sblk; - ptrdiff_t gc_count = inhibit_garbage_collection (); + specpdl_ref gc_count = inhibit_garbage_collection (); Lisp_Object found = Qnil; if (! deadp (obj)) @@ -7745,7 +7746,9 @@ N should be nonnegative. */); defsubr (&Sgarbage_collect_maybe); defsubr (&Smemory_info); defsubr (&Smemory_use_counts); -#if defined GNU_LINUX && defined __GLIBC__ +#if defined GNU_LINUX && defined __GLIBC__ && \ + (__GLIBC__ > 2 || __GLIBC_MINOR__ >= 10) + defsubr (&Smalloc_info); #endif defsubr (&Ssuspicious_object); diff --git a/src/bidi.c b/src/bidi.c index d6ed607f14c..16faf655b26 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -1462,7 +1462,7 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos) /* Prevent quitting inside re_match_2, as redisplay_window could have temporarily moved point. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil); @@ -1552,7 +1552,7 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) /* Prevent quitting inside re_match_2, as redisplay_window could have temporarily moved point. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); while (pos_byte > BEGV_BYTE diff --git a/src/buffer.c b/src/buffer.c index 0bdad086ddd..91ff6b946f7 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1774,7 +1774,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* Run hooks with the buffer to be killed as the current buffer. */ { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool modified; record_unwind_protect_excursion (); @@ -2097,7 +2097,6 @@ Use this function before selecting the buffer, since it may need to inspect the current buffer's major mode. */) (Lisp_Object buffer) { - ptrdiff_t count; Lisp_Object function; CHECK_BUFFER (buffer); @@ -2120,7 +2119,7 @@ the current buffer's major mode. */) `hack-local-variables' get run. */ return Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* To select a nonfundamental mode, select the buffer temporarily and then call the mode function. */ @@ -4035,7 +4034,7 @@ buffer. */) { struct buffer *b, *ob = 0; Lisp_Object obuffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t n_beg, n_end; ptrdiff_t o_beg UNINIT, o_end UNINIT; @@ -4156,7 +4155,7 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0, { Lisp_Object buffer; struct buffer *b; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); CHECK_OVERLAY (overlay); diff --git a/src/bytecode.c b/src/bytecode.c index da1855d6bab..96f1f905812 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -382,7 +382,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, unsigned char const *bytestr_data = SDATA (bytestr); unsigned char const *pc = bytestr_data; #if BYTE_CODE_SAFE || !defined NDEBUG - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #endif /* ARGS_TEMPLATE is composed of bit fields: @@ -458,17 +458,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #ifdef BYTE_CODE_THREADED - /* A convenience define that saves us a lot of typing and makes - the table clearer. */ -#define LABEL(OP) [OP] = &&insn_ ## OP - /* This is the dispatch table for the threaded interpreter. */ static const void *const targets[256] = { [0 ... (Bconstant - 1)] = &&insn_default, [Bconstant ... 255] = &&insn_Bconstant, -#define DEFINE(name, value) LABEL (name) , +#define DEFINE(name, value) [name] = &&insn_ ## name, BYTE_CODES #undef DEFINE }; @@ -650,7 +646,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object fun = TOP; Lisp_Object *args = &TOP + 1; - ptrdiff_t count1 = record_in_backtrace (fun, args, numargs); + specpdl_ref count1 = record_in_backtrace (fun, args, numargs); maybe_gc (); if (debug_on_next_call) do_debug_on_call (Qlambda, count1); @@ -678,7 +674,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, val = funcall_general (original_fun, numargs, args); lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count1)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count1))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; @@ -702,7 +698,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bunbind5): op -= Bunbind; dounbind: - unbind_to (SPECPDL_INDEX () - op, Qnil); + unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -op), Qnil); NEXT; CASE (Bgoto): @@ -796,7 +792,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bsave_window_excursion): /* Obsolete since 24.1. */ { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); record_unwind_protect (restore_window_configuration, Fcurrent_window_configuration (Qnil)); TOP = Fprogn (TOP); @@ -872,7 +868,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, temp_output_buffer_show (TOP); TOP = v1; /* pop binding of standard-output */ - unbind_to (SPECPDL_INDEX () - 1, Qnil); + unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -1), Qnil); NEXT; } @@ -1060,7 +1056,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v2 = POP; Lisp_Object v1 = TOP; if (FIXNUMP (v1) && FIXNUMP (v2)) - TOP = EQ (v1, v2) ? Qt : Qnil; + TOP = BASE_EQ(v1, v2) ? Qt : Qnil; else TOP = arithcompare (v1, v2, ARITH_EQUAL); NEXT; @@ -1585,10 +1581,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: #if BYTE_CODE_SAFE || !defined NDEBUG - if (SPECPDL_INDEX () != count) + if (!specpdl_ref_eq (SPECPDL_INDEX (), count)) { /* Binds and unbinds are supposed to be compiled balanced. */ - if (SPECPDL_INDEX () > count) + if (specpdl_ref_lt (count, SPECPDL_INDEX ())) unbind_to (count, Qnil); error ("binding stack not balanced (serious byte compiler bug)"); } diff --git a/src/callint.c b/src/callint.c index ce77c893f48..31919d6bb81 100644 --- a/src/callint.c +++ b/src/callint.c @@ -251,7 +251,7 @@ return non-nil. usage: (funcall-interactively FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t speccount = SPECPDL_INDEX (); + specpdl_ref speccount = SPECPDL_INDEX (); temporarily_switch_to_single_kboard (NULL); /* Nothing special to do here, all the work is inside @@ -279,7 +279,7 @@ invoke it (via an `interactive' spec that contains, for instance, an `this-command-keys-vector' is used. */) (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys) { - ptrdiff_t speccount = SPECPDL_INDEX (); + specpdl_ref speccount = SPECPDL_INDEX (); bool arg_from_tty = false; ptrdiff_t key_count; @@ -541,7 +541,7 @@ invoke it (via an `interactive' spec that contains, for instance, an case 'k': /* Key sequence. */ { - ptrdiff_t speccount1 = SPECPDL_INDEX (); + specpdl_ref speccount1 = SPECPDL_INDEX (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ Fput_text_property (make_fixnum (0), @@ -571,7 +571,7 @@ invoke it (via an `interactive' spec that contains, for instance, an case 'K': /* Key sequence to be defined. */ { - ptrdiff_t speccount1 = SPECPDL_INDEX (); + specpdl_ref speccount1 = SPECPDL_INDEX (); specbind (Qcursor_in_echo_area, Qt); /* Prompt in `minibuffer-prompt' face. */ Fput_text_property (make_fixnum (0), diff --git a/src/callproc.c b/src/callproc.c index 4d3b0bb8e06..018c9ce6909 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -122,7 +122,7 @@ enum CALLPROC_FDS }; -static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, ptrdiff_t); +static Lisp_Object call_process (ptrdiff_t, Lisp_Object *, int, specpdl_ref); #ifdef DOS_NT # define CHILD_SETUP_TYPE int @@ -289,7 +289,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * { Lisp_Object infile, encoded_infile; int filefd; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (nargs >= 2 && ! NILP (args[1])) { @@ -310,12 +310,13 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * if (filefd < 0) report_file_error ("Opening process input file", infile); record_unwind_protect_int (close_file_unwind, filefd); - return unbind_to (count, call_process (nargs, args, filefd, -1)); + return unbind_to (count, call_process (nargs, args, filefd, + make_invalid_specpdl_ref ())); } /* Like Fcall_process (NARGS, ARGS), except use FILEFD as the input file. - If TEMPFILE_INDEX is nonnegative, it is the specpdl index of an + If TEMPFILE_INDEX is valid, it is the specpdl index of an unwinder that is intended to remove the input temporary file; in this case NARGS must be at least 2 and ARGS[1] is the file's name. @@ -323,7 +324,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * static Lisp_Object call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, - ptrdiff_t tempfile_index) + specpdl_ref tempfile_index) { Lisp_Object buffer, current_dir, path; bool display_p; @@ -331,7 +332,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, int callproc_fd[CALLPROC_FDS]; int status; ptrdiff_t i; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); USE_SAFE_ALLOCA; char **new_argv; @@ -616,7 +617,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, callproc_fd[i] = -1; } emacs_close (filefd); - clear_unwind_protect (count - 1); + clear_unwind_protect (specpdl_ref_add (count, -1)); if (tempfile) { @@ -654,7 +655,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, if (FIXNUMP (buffer)) { - if (tempfile_index < 0) + if (!specpdl_ref_valid_p (tempfile_index)) record_deleted_pid (pid, Qnil); else { @@ -681,7 +682,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, callproc_fd[i] = -1; } emacs_close (filefd); - clear_unwind_protect (count - 1); + clear_unwind_protect (specpdl_ref_add (count, -1)); #endif /* not MSDOS */ @@ -813,7 +814,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, else { /* We have to decode the input. */ Lisp_Object curbuf; - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); XSETBUFFER (curbuf, current_buffer); /* We cannot allow after-change-functions be run @@ -957,7 +958,6 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, { Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir); char *tempfile; - ptrdiff_t count; #ifdef WINDOWSNT /* Cannot use the result of Fexpand_file_name, because it @@ -977,7 +977,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, filename_string = Fcopy_sequence (ENCODE_FILE (pattern)); tempfile = SSDATA (filename_string); - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_nothing (); fd = mkostemp (tempfile, O_BINARY | O_CLOEXEC); if (fd < 0) @@ -1009,7 +1009,7 @@ create_temp_file (ptrdiff_t nargs, Lisp_Object *args, val = complement_process_encoding_system (val); { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); specbind (intern ("coding-system-for-write"), val); /* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we @@ -1069,7 +1069,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object infile, val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object start = args[0]; Lisp_Object end = args[1]; bool empty_input; @@ -1123,7 +1123,8 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } args[1] = infile; - val = call_process (nargs, args, fd, empty_input ? -1 : count); + val = call_process (nargs, args, fd, + empty_input ? make_invalid_specpdl_ref () : count); return unbind_to (count, val); } @@ -1500,7 +1501,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err, if (pty != NULL) pid = fork (); else - pid = vfork (); + pid = VFORK (); #else pid = vfork (); #endif diff --git a/src/character.c b/src/character.c index eba417d005d..c1a1b553891 100644 --- a/src/character.c +++ b/src/character.c @@ -654,15 +654,14 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes, ptrdiff_t count_size_as_multibyte (const unsigned char *str, ptrdiff_t len) { - const unsigned char *endp = str + len; + /* Count the number of non-ASCII (raw) bytes, since they will occupy + two bytes in a multibyte string. */ + ptrdiff_t nonascii = 0; + for (ptrdiff_t i = 0; i < len; i++) + nonascii += str[i] >> 7; ptrdiff_t bytes; - - for (bytes = 0; str < endp; str++) - { - int n = *str < 0x80 ? 1 : 2; - if (INT_ADD_WRAPV (bytes, n, &bytes)) - string_overflow (); - } + if (INT_ADD_WRAPV (len, nonascii, &bytes)) + string_overflow (); return bytes; } diff --git a/src/charset.c b/src/charset.c index dec9d56df2c..d0cfe60952e 100644 --- a/src/charset.c +++ b/src/charset.c @@ -483,7 +483,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, AUTO_STRING (map, ".map"); AUTO_STRING (txt, ".txt"); AUTO_LIST2 (suffixes, map, txt); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_nothing (); specbind (Qfile_name_handler_alist, Qnil); fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil, false, false); @@ -495,7 +495,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, report_file_errno ("Loading charset map", mapfile, open_errno); } set_unwind_protect_ptr (count, fclose_unwind, fp); - unbind_to (count + 1, Qnil); + unbind_to (specpdl_ref_add (count, 1), Qnil); /* Use record_xmalloc, as `charset_map_entries' is large (larger than MAX_ALLOCA). */ diff --git a/src/coding.c b/src/coding.c index df6c423caaa..c16598d275d 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7907,7 +7907,7 @@ coding_restore_undo_list (Lisp_Object arg) void decode_coding_gap (struct coding_system *coding, ptrdiff_t bytes) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object attrs; eassert (GPT_BYTE == PT_BYTE); @@ -8071,7 +8071,7 @@ decode_coding_object (struct coding_system *coding, ptrdiff_t to, ptrdiff_t to_byte, Lisp_Object dst_object) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); unsigned char *destination UNINIT; ptrdiff_t dst_bytes UNINIT; ptrdiff_t chars = to - from; @@ -8170,7 +8170,7 @@ decode_coding_object (struct coding_system *coding, ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE; Lisp_Object val; Lisp_Object undo_list = BVAR (current_buffer, undo_list); - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); record_unwind_protect (coding_restore_undo_list, Fcons (undo_list, Fcurrent_buffer ())); @@ -8290,7 +8290,7 @@ encode_coding_object (struct coding_system *coding, ptrdiff_t to, ptrdiff_t to_byte, Lisp_Object dst_object) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t chars = to - from; ptrdiff_t bytes = to_byte - from_byte; Lisp_Object attrs; @@ -8584,7 +8584,7 @@ are lower-case). */) (Lisp_Object prompt, Lisp_Object default_coding_system) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (SYMBOLP (default_coding_system)) default_coding_system = SYMBOL_NAME (default_coding_system); diff --git a/src/comp.c b/src/comp.c index 9abc5d96906..6449eedb278 100644 --- a/src/comp.c +++ b/src/comp.c @@ -480,6 +480,10 @@ load_gccjit_if_necessary (bool mandatory) #define THIRD(x) \ XCAR (XCDR (XCDR (x))) +/* Like call0 but stringify and intern. */ +#define CALL0I(fun) \ + CALLN (Ffuncall, intern_c_string (STR (fun))) + /* Like call1 but stringify and intern. */ #define CALL1I(fun, arg) \ CALLN (Ffuncall, intern_c_string (STR (fun)), arg) @@ -1720,7 +1724,7 @@ emit_lisp_obj_rval (Lisp_Object obj) emit_comment (format_string ("const lisp obj: %s", SSDATA (Fprin1_to_string (obj, Qnil)))); - if (EQ (obj, Qnil)) + if (NILP (obj)) { gcc_jit_rvalue *n; n = emit_rvalue_from_lisp_word ((Lisp_Word) iQnil); @@ -2237,9 +2241,9 @@ emit_limple_insn (Lisp_Object insn) gcc_jit_block *target1 = retrive_block (arg[2]); gcc_jit_block *target2 = retrive_block (arg[3]); - if ((CALL1I (comp-cstr-imm-vld-p, arg[0]) + if ((!NILP (CALL1I (comp-cstr-imm-vld-p, arg[0])) && NILP (CALL1I (comp-cstr-imm, arg[0]))) - || (CALL1I (comp-cstr-imm-vld-p, arg[1]) + || (!NILP (CALL1I (comp-cstr-imm-vld-p, arg[1])) && NILP (CALL1I (comp-cstr-imm, arg[1])))) emit_cond_jump (emit_BASE_EQ (a, b), target1, target2); else @@ -2635,7 +2639,7 @@ emit_static_object (const char *name, Lisp_Object obj) strings cause of this funny bug that will affect all pre gcc10 era gccs: https://gcc.gnu.org/ml/jit/2019-q3/msg00013.html */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Preserve uninterned symbols, this is specifically necessary for CL macro expansion in dynamic scope code (bug#42088). See `byte-compile-output-file-form'. */ @@ -4991,7 +4995,7 @@ helper_temp_output_buffer_setup (Lisp_Object x) Lisp_Object helper_unbind_n (Lisp_Object n) { - return unbind_to (SPECPDL_INDEX () - XFIXNUM (n), Qnil); + return unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -XFIXNUM (n)), Qnil); } void @@ -5123,13 +5127,14 @@ maybe_defer_native_compilation (Lisp_Object function_name, return; } + Fputhash (function_name, definition, Vcomp_deferred_pending_h); + /* This is so deferred compilation is able to compile comp dependencies breaking circularity. */ - if (comp__loadable) + if (comp__compilable) { /* Startup is done, comp is usable. */ - Frequire (Qcomp, Qnil, Qnil); - Fputhash (function_name, definition, Vcomp_deferred_pending_h); + CALL0I (startup--require-comp-safely); CALLN (Ffuncall, intern_c_string ("native--compile-async"), src, Qnil, Qlate); } @@ -5265,7 +5270,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, identify is we have at least another load active on it. */ bool recursive_load = comp_u->load_ongoing; comp_u->load_ongoing = true; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!recursive_load) record_unwind_protect (unset_cu_load_ongoing, comp_u_lisp_obj); @@ -5496,19 +5501,7 @@ This gets called by top_level_run during the load phase. */) make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx, intspec, comp_u); - if (AUTOLOADP (XSYMBOL (name)->u.s.function)) - /* Remember that the function was already an autoload. */ - LOADHIST_ATTACH (Fcons (Qt, name)); - LOADHIST_ATTACH (Fcons (Qdefun, name)); - - { /* Handle automatic advice activation (bug#42038). - See `defalias'. */ - Lisp_Object hook = Fget (name, Qdefalias_fset_function); - if (!NILP (hook)) - call2 (hook, name, tem); - else - Ffset (name, tem); - } + defalias (name, tem); return tem; } @@ -5608,9 +5601,9 @@ syms_of_comp (void) DEFVAR_LISP ("comp--delayed-sources", Vcomp__delayed_sources, doc: /* List of sources to be native-compiled when startup is finished. For internal use. */); - DEFVAR_BOOL ("comp--loadable", - comp__loadable, - doc: /* Non-nil when comp.el can be loaded. + DEFVAR_BOOL ("comp--compilable", + comp__compilable, + doc: /* Non-nil when comp.el can be native compiled. For internal use. */); /* Compiler control customizes. */ DEFVAR_BOOL ("native-comp-deferred-compilation", diff --git a/src/composite.c b/src/composite.c index 711284ba6fc..3659de8900c 100644 --- a/src/composite.c +++ b/src/composite.c @@ -575,7 +575,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask) } if (min_pos < max_pos) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -892,7 +892,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t limit, struct window *win, struct face *face, Lisp_Object string, Lisp_Object direction, int ch) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object pos = make_fixnum (charpos); ptrdiff_t to; ptrdiff_t pt = PT, pt_byte = PT_BYTE; @@ -988,7 +988,9 @@ inhibit_auto_composition (void) less than CHARPOS, search backward to ENDPOS+1 assuming that set_iterator_to_next works in reverse order. In this case, if a composition closest to CHARPOS is found, set cmp_it->stop_pos to - the last character of the composition. + the last character of the composition. STRING, if non-nil, is + the string (as opposed to a buffer) whose characters should be + tested for being composable. If no composition is found, set cmp_it->ch to -2. If a static composition is found, set cmp_it->ch to -1. Otherwise, set @@ -996,7 +998,9 @@ inhibit_auto_composition (void) composition. */ void -composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t endpos, Lisp_Object string) +composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, + ptrdiff_t bytepos, ptrdiff_t endpos, + Lisp_Object string) { ptrdiff_t start, end; int c; @@ -1035,7 +1039,9 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos, cmp_it->stop_pos = endpos = start; cmp_it->ch = -1; } - if (NILP (BVAR (current_buffer, enable_multibyte_characters)) + if ((NILP (string) + && NILP (BVAR (current_buffer, enable_multibyte_characters))) + || (STRINGP (string) && !STRING_MULTIBYTE (string)) || inhibit_auto_composition ()) return; if (bytepos < 0) @@ -1292,6 +1298,16 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos, if (cmp_it->lookback > 0) { cpos = charpos - cmp_it->lookback; + /* Reject the composition if it starts before ENDPOS, + which here can only happen if + composition-break-at-point is non-nil and point is + inside the composition. */ + if (cpos < endpos) + { + eassert (composition_break_at_point); + eassert (endpos == PT); + goto no_composition; + } if (STRINGP (string)) bpos = string_char_to_byte (string, cpos); else @@ -1961,7 +1977,9 @@ See `find-composition' for more details. */) if (!find_composition (from, to, &start, &end, &prop, string)) { - if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + if (((NILP (string) + && !NILP (BVAR (current_buffer, enable_multibyte_characters))) + || (!NILP (string) && STRING_MULTIBYTE (string))) && ! inhibit_auto_composition () && find_automatic_composition (from, to, (ptrdiff_t) -1, &start, &end, &gstring, string)) @@ -2064,7 +2082,8 @@ The default value is the function `compose-chars-after'. */); Use the command `auto-composition-mode' to change this variable. If this variable is a string, `auto-composition-mode' will be disabled in -buffers displayed on a terminal whose type compares equal to this string. */); +buffers displayed on a terminal whose type, as reported by `tty-type', +compares equal to that string. */); Vauto_composition_mode = Qt; DEFVAR_LISP ("auto-composition-function", Vauto_composition_function, diff --git a/src/conf_post.h b/src/conf_post.h index 6db76a2dfad..cee5a0878a1 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -182,6 +182,20 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ # define SIZE_MAX 4294967295U #endif +/* Things that lib/reg* wants. */ + +#define mbrtowc(pwc, s, n, ps) mbtowc ((pwc), (s), (n)) +#define wcrtomb(s, wc, ps) wctomb ((s), (wc)) +#define btowc(b) ((wchar_t) (b)) +#define towupper(chr) toupper (chr) +#define towlower(chr) tolower (chr) +#define iswalnum(chr) isalnum (chr) +#define wctype(name) ((wctype_t) 0) +#define iswctype(wc, type) false +#define mbsinit(ps) 1 + +#define MALLOC_0_IS_NONNULL 1 + /* We must intercept 'opendir' calls to stash away the directory name, so we could reuse it in readlinkat; see msdos.c. */ #define opendir sys_opendir @@ -353,6 +367,19 @@ extern int emacs_setenv_TZ (char const *); # define vfork fork #endif +/* vfork is deprecated on at least macOS 11.6 and later, but it still works + and is faster than fork, so silence the warning as if we knew what we + are doing. */ +#ifdef DARWIN_OS +#define VFORK() \ + (_Pragma("clang diagnostic push") \ + _Pragma("clang diagnostic ignored \"-Wdeprecated-declarations\"") \ + vfork () \ + _Pragma("clang diagnostic pop")) +#else +#define VFORK() vfork () +#endif + #if ! (defined __FreeBSD__ || defined GNU_LINUX || defined __MINGW32__) # undef PROFILING #endif diff --git a/src/cygw32.c b/src/cygw32.c index 1b43de2c05e..759d9af94de 100644 --- a/src/cygw32.c +++ b/src/cygw32.c @@ -56,7 +56,7 @@ conv_filename_to_w32_unicode (Lisp_Object in, int absolute_p) ssize_t converted_len; Lisp_Object converted; unsigned flags; - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); chdir_to_default_directory (); @@ -85,7 +85,7 @@ conv_filename_from_w32_unicode (const wchar_t* in, int absolute_p) ssize_t converted_len; Lisp_Object converted; unsigned flags; - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); chdir_to_default_directory (); @@ -115,7 +115,7 @@ For the reverse operation, see `cygwin-convert-file-name-from-windows'. */) (Lisp_Object file, Lisp_Object absolute_p) { return from_unicode ( - conv_filename_to_w32_unicode (file, EQ (absolute_p, Qnil) ? 0 : 1)); + conv_filename_to_w32_unicode (file, NILP (absolute_p) ? 0 : 1)); } DEFUN ("cygwin-convert-file-name-from-windows", @@ -128,7 +128,7 @@ For the reverse operation, see `cygwin-convert-file-name-to-windows'. */) (Lisp_Object file, Lisp_Object absolute_p) { return conv_filename_from_w32_unicode (to_unicode (file, &file), - EQ (absolute_p, Qnil) ? 0 : 1); + NILP (absolute_p) ? 0 : 1); } void diff --git a/src/data.c b/src/data.c index 7422348e392..1526cc0c737 100644 --- a/src/data.c +++ b/src/data.c @@ -836,7 +836,6 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION. */) (register Lisp_Object symbol, Lisp_Object definition) { - register Lisp_Object function; CHECK_SYMBOL (symbol); /* Perhaps not quite the right error signal, but seems good enough. */ if (NILP (symbol) && !NILP (definition)) @@ -844,17 +843,11 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, think this one little sanity check is worth its cost, but anyway. */ xsignal1 (Qsetting_constant, symbol); - function = XSYMBOL (symbol)->u.s.function; - - if (!NILP (Vautoload_queue) && !NILP (function)) - Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); - - if (AUTOLOADP (function)) - Fput (symbol, Qautoload, XCDR (function)); - eassert (valid_lisp_object_p (definition)); #ifdef HAVE_NATIVE_COMP + register Lisp_Object function = XSYMBOL (symbol)->u.s.function; + if (comp_enable_subr_trampolines && SUBRP (function) && !SUBR_NATIVE_COMPILEDP (function)) @@ -866,6 +859,75 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, return definition; } +static void +add_to_function_history (Lisp_Object symbol, Lisp_Object olddef) +{ + eassert (!NILP (olddef)); + + Lisp_Object past = Fget (symbol, Qfunction_history); + Lisp_Object file = Qnil; + /* FIXME: Sadly, `Vload_file_name` gives less precise information + (it's sometimes non-nil when it shoujld be nil). */ + Lisp_Object tail = Vcurrent_load_list; + FOR_EACH_TAIL_SAFE (tail) + if (NILP (XCDR (tail)) && STRINGP (XCAR (tail))) + file = XCAR (tail); + + Lisp_Object tem = Fplist_member (past, file); + if (!NILP (tem)) + { /* New def from a file used before. + Overwrite the previous record associated with this file. */ + if (EQ (tem, past)) + /* The new def is from the same file as the last change, so + there's nothing to do: unloading the file should revert to + the status before the last change rather than before this load. */ + return; + Lisp_Object pastlen = Flength (past); + Lisp_Object temlen = Flength (tem); + EMACS_INT tempos = XFIXNUM (pastlen) - XFIXNUM (temlen); + eassert (tempos > 1); + Lisp_Object prev = Fnthcdr (make_fixnum (tempos - 2), past); + /* Remove the previous info for this file. + E.g. change `hist` from (... OTHERFILE DEF3 THISFILE DEF2 ...) + to (... OTHERFILE DEF2). */ + XSETCDR (prev, XCDR (tem)); + } + /* Push new def from new file. */ + Fput (symbol, Qfunction_history, Fcons (file, Fcons (olddef, past))); +} + +void +defalias (Lisp_Object symbol, Lisp_Object definition) +{ + { + bool autoload = AUTOLOADP (definition); + if (!will_dump_p () || !autoload) + { /* Only add autoload entries after dumping, because the ones before are + not useful and else we get loads of them from the loaddefs.el. + That saves us about 110KB in the pdmp file (Jan 2022). */ + LOADHIST_ATTACH (Fcons (Qdefun, symbol)); + } + } + + { + Lisp_Object olddef = XSYMBOL (symbol)->u.s.function; + if (!NILP (olddef)) + { + if (!NILP (Vautoload_queue)) + Vautoload_queue = Fcons (symbol, Vautoload_queue); + add_to_function_history (symbol, olddef); + } + } + + { /* Handle automatic advice activation. */ + Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); + if (!NILP (hook)) + call2 (hook, symbol, definition); + else + Ffset (symbol, definition); + } +} + DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, doc: /* Set SYMBOL's function definition to DEFINITION. Associates the function with the current load file, if any. @@ -885,26 +947,7 @@ The return value is undefined. */) && !KEYMAPP (definition)) definition = Fpurecopy (definition); - { - bool autoload = AUTOLOADP (definition); - if (!will_dump_p () || !autoload) - { /* Only add autoload entries after dumping, because the ones before are - not useful and else we get loads of them from the loaddefs.el. */ - - if (AUTOLOADP (XSYMBOL (symbol)->u.s.function)) - /* Remember that the function was already an autoload. */ - LOADHIST_ATTACH (Fcons (Qt, symbol)); - LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); - } - } - - { /* Handle automatic advice activation. */ - Lisp_Object hook = Fget (symbol, Qdefalias_fset_function); - if (!NILP (hook)) - call2 (hook, symbol, definition); - else - Ffset (symbol, definition); - } + defalias (symbol, definition); maybe_defer_native_compilation (symbol, definition); @@ -1794,7 +1837,7 @@ notify_variable_watchers (Lisp_Object symbol, { symbol = Findirect_variable (symbol); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (restore_symbol_trapped_write, symbol); /* Avoid recursion. */ set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE); @@ -4165,6 +4208,7 @@ syms_of_data (void) DEFSYM (Qinteractive_form, "interactive-form"); DEFSYM (Qdefalias_fset_function, "defalias-fset-function"); + DEFSYM (Qfunction_history, "function-history"); DEFSYM (Qbyte_code_function_p, "byte-code-function-p"); diff --git a/src/decompress.c b/src/decompress.c index 60f8bfd6a26..ddd8abbf27c 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -239,7 +239,7 @@ This function can be called only in unibyte buffers. */) z_stream stream; int inflate_status; struct decompress_unwind_data unwind_data; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); validate_region (&start, &end); diff --git a/src/dired.c b/src/dired.c index 7fb54f2f67b..cd50012ddc7 100644 --- a/src/dired.c +++ b/src/dired.c @@ -195,7 +195,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_ptr (directory_files_internal_unwind, d); #ifdef WINDOWSNT @@ -289,7 +289,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, #endif /* Discard the unwind protect. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); if (NILP (nosort)) list = Fsort (Fnreverse (list), @@ -455,7 +455,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, anything. */ bool includeall = 1; bool check_decoded = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); elt = Qnil; @@ -944,7 +944,7 @@ file_attributes (int fd, char const *name, Lisp_Object dirname, Lisp_Object filename, Lisp_Object id_format) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct stat s; /* An array to hold the mode string generated by filemodestring, diff --git a/src/dispextern.h b/src/dispextern.h index 368507732ce..f7755acd96b 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1853,7 +1853,6 @@ enum face_id CHILD_FRAME_BORDER_FACE_ID, TAB_BAR_FACE_ID, TAB_LINE_FACE_ID, - MODE_LINE_FACE_ID, BASIC_FACE_ID_SENTINEL }; diff --git a/src/dispnew.c b/src/dispnew.c index 6337bcf1303..0d959047f3a 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6176,15 +6176,13 @@ Return t if redisplay was performed, nil if redisplay was preempted immediately by pending input. */) (Lisp_Object force) { - ptrdiff_t count; - swallow_events (true); if ((detect_input_pending_run_timers (1) && NILP (force) && !redisplay_dont_pause) || !NILP (Vexecuting_kbd_macro)) return Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!NILP (force) && !redisplay_dont_pause) specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (2); diff --git a/src/doc.c b/src/doc.c index 0b12eb154d6..a9f77b25bfa 100644 --- a/src/doc.c +++ b/src/doc.c @@ -83,7 +83,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) { char *from, *to, *name, *p, *p1; Lisp_Object file, pos; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object dir; USE_SAFE_ALLOCA; @@ -545,7 +545,6 @@ the same file name is found in the `doc-directory'. */) EMACS_INT pos; Lisp_Object sym; char *p, *name; - ptrdiff_t count; char const *dirname; ptrdiff_t dirlen; /* Preloaded defcustoms using custom-initialize-delay are added to @@ -569,7 +568,7 @@ the same file name is found in the `doc-directory'. */) dirlen = SBYTES (Vdoc_directory); } - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); USE_SAFE_ALLOCA; name = SAFE_ALLOCA (dirlen + SBYTES (filename) + 1); lispstpcpy (stpcpy (name, dirname), filename); /*** Add this line ***/ diff --git a/src/editfns.c b/src/editfns.c index 790f66e3a02..6cb684d4d85 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -847,7 +847,7 @@ usage: (save-excursion &rest BODY) */) (Lisp_Object args) { register Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_excursion (); @@ -861,7 +861,7 @@ BODY is executed just like `progn'. usage: (save-current-buffer &rest BODY) */) (Lisp_Object args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); return unbind_to (count, Fprogn (args)); @@ -2022,7 +2022,7 @@ nil. */) return Qt; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t diags = size_a + size_b + 3; @@ -2247,7 +2247,7 @@ Both characters must have the same length of multi-byte form. */) ptrdiff_t changed = 0; unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH]; unsigned char *p; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #define COMBINING_NO 0 #define COMBINING_BEFORE 1 #define COMBINING_AFTER 2 @@ -2820,7 +2820,7 @@ usage: (save-restriction &rest BODY) */) (Lisp_Object body) { register Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (save_restriction_restore, save_restriction_save ()); val = Fprogn (body); @@ -3112,7 +3112,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) ptrdiff_t bufsize = sizeof initial_buffer; ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1; char *p; - ptrdiff_t buf_save_value_index UNINIT; + specpdl_ref buf_save_value_index UNINIT; char *format, *end; ptrdiff_t nchars; /* When we make a multibyte string, we must pay attention to the diff --git a/src/emacs-module.c b/src/emacs-module.c index 392b3ba9659..0974a199e5e 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1137,7 +1137,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, rt->private_members = &rt_priv; rt->get_environment = module_get_environment; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_module (SPECPDL_MODULE_RUNTIME, rt); record_unwind_protect_module (SPECPDL_MODULE_ENVIRONMENT, rt_priv.env); @@ -1166,7 +1166,7 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist) emacs_env pub; struct emacs_env_private priv; emacs_env *env = initialize_environment (&pub, &priv); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_module (SPECPDL_MODULE_ENVIRONMENT, env); USE_SAFE_ALLOCA; diff --git a/src/emacs.c b/src/emacs.c index f6e2c01ee74..d1060bca0b3 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -190,8 +190,11 @@ static uintmax_t heap_bss_diff; We mark being in the exec'd process by a daemon name argument of form "--daemon=\nFD0,FD1\nNAME" where FD are the pipe file descriptors, - NAME is the original daemon name, if any. */ -#if defined NS_IMPL_COCOA || defined CYGWIN + NAME is the original daemon name, if any. + + On Haiku, the table of semaphores used for looper locks doesn't + persist across forked processes. */ +#if defined NS_IMPL_COCOA || defined CYGWIN || defined HAVE_HAIKU # define DAEMON_MUST_EXEC #endif @@ -453,7 +456,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd) { int i; Lisp_Object name, dir, handler; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object raw_name; AUTO_STRING (slash_colon, "/:"); @@ -2472,6 +2475,7 @@ static const struct standard_args standard_args[] = { "-quick", 0, 55, 0 }, { "-q", "--no-init-file", 50, 0 }, { "-no-init-file", 0, 50, 0 }, + { "-init-directory", "--init-directory", 30, 1 }, { "-no-x-resources", "--no-x-resources", 40, 0 }, { "-no-site-file", "--no-site-file", 40, 0 }, { "-u", "--user", 30, 1 }, @@ -2900,7 +2904,7 @@ You must run Emacs in batch mode in order to dump it. */) { Lisp_Object tem; Lisp_Object symbol; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); check_pure_size (); diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c index a38ba35ad80..f2c9fa7b7db 100644 --- a/src/emacsgtkfixed.c +++ b/src/emacsgtkfixed.c @@ -164,11 +164,33 @@ XSetWMSizeHints (Display *d, if ((hints->flags & PMinSize) && f) { - int w = f->output_data.x->size_hints.min_width; - int h = f->output_data.x->size_hints.min_height; - - data[5] = w; - data[6] = h; + /* Overriding the size hints with our own values of min_width + and min_height used to work, but these days just results in + frames resizing unpredictably and emitting GTK warnings while + Emacs fights with GTK over the size of the frame. So instead + of doing that, just respect the hints set by GTK, but make + sure they are an integer multiple of the resize increments so + that bug#8919 stays fixed. */ + + /* int w = f->output_data.x->size_hints.min_width; + int h = f->output_data.x->size_hints.min_height; + + data[5] = w; + data[6] = h; */ + + /* Make sure min_width and min_height are multiples of width_inc + and height_inc. */ + + if (hints->flags & PResizeInc) + { + /* Some versions of GTK set PResizeInc even if the + increments are at their initial values. */ + + if (hints->width_inc && data[5] % hints->width_inc) + data[5] += (hints->width_inc - (data[5] % hints->width_inc)); + if (hints->height_inc && data[6] % hints->height_inc) + data[6] += (hints->height_inc - (data[6] % hints->height_inc)); + } } XChangeProperty (d, w, prop, XA_WM_SIZE_HINTS, 32, PropModeReplace, diff --git a/src/eval.c b/src/eval.c index 205a0b0db2a..294d79e67a0 100644 --- a/src/eval.c +++ b/src/eval.c @@ -65,7 +65,7 @@ union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); -static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t); +static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, specpdl_ref); static Lisp_Object lambda_arity (Lisp_Object); static Lisp_Object @@ -104,13 +104,6 @@ specpdl_where (union specbinding *pdl) } static Lisp_Object -specpdl_saved_value (union specbinding *pdl) -{ - eassert (pdl->kind >= SPECPDL_LET); - return pdl->let.saved_value; -} - -static Lisp_Object specpdl_arg (union specbinding *pdl) { eassert (pdl->kind == SPECPDL_UNWIND); @@ -282,11 +275,12 @@ Lisp_Object call_debugger (Lisp_Object arg) { bool debug_while_redisplaying; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; intmax_t old_depth = max_lisp_eval_depth; /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ - intmax_t old_max = max (max_specpdl_size, count); + ptrdiff_t counti = specpdl_ref_to_count (count); + intmax_t old_max = max (max_specpdl_size, counti); /* The previous value of 40 is too small now that the debugger prints using cl-prin1 instead of prin1. Printing lists nested 8 @@ -296,9 +290,9 @@ call_debugger (Lisp_Object arg) /* While debugging Bug#16603, previous value of 100 was found too small to avoid specpdl overflow in the debugger itself. */ - max_ensure_room (&max_specpdl_size, count, 200); + max_ensure_room (&max_specpdl_size, counti, 200); - if (old_max == count) + if (old_max == counti) { /* We can enter the debugger due to specpdl overflow (Bug#16603). */ specpdl_ptr--; @@ -348,10 +342,10 @@ call_debugger (Lisp_Object arg) } void -do_debug_on_call (Lisp_Object code, ptrdiff_t count) +do_debug_on_call (Lisp_Object code, specpdl_ref count) { debug_on_next_call = 0; - set_backtrace_debug_on_exit (specpdl + count, true); + set_backtrace_debug_on_exit (specpdl_ref_to_ptr (count), true); call_debugger (list1 (code)); } @@ -670,23 +664,7 @@ default_toplevel_binding (Lisp_Object symbol) binding = pdl; break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - case SPECPDL_LET_LOCAL: - break; - - default: - emacs_abort (); + default: break; } } return binding; @@ -713,23 +691,7 @@ lexbound_p (Lisp_Object symbol) } break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - case SPECPDL_LET_LOCAL: - break; - - default: - emacs_abort (); + default: break; } } return false; @@ -929,7 +891,7 @@ usage: (let* VARLIST BODY...) */) (Lisp_Object args) { Lisp_Object var, val, elt, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); lexenv = Vinternal_interpreter_environment; @@ -989,7 +951,7 @@ usage: (let VARLIST BODY...) */) { Lisp_Object *temps, tem, lexenv; Lisp_Object elt; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t argnum; USE_SAFE_ALLOCA; @@ -1093,7 +1055,7 @@ If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE is not displayed. */) (Lisp_Object timeout, Lisp_Object message, Lisp_Object function) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); CHECK_NUMBER (timeout); CHECK_STRING (message); @@ -1306,7 +1268,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) (Lisp_Object args) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect (prog_ignore, XCDR (args)); val = eval_sub (XCAR (args)); @@ -1430,7 +1392,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, /* Bind HANDLER_VAR to VAL while evaluating HANDLER_BODY. The unbind_to undoes just this binding; whoever longjumped to us unwound the stack to C->pdlcount before throwing. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, val); return unbind_to (count, Fprogn (handler_body)); } @@ -1451,7 +1413,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, handler_var = Qinternal_interpreter_environment; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (handler_var, result); return unbind_to (count, Fprogn (success_handler)); } @@ -1815,7 +1777,8 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); - max_ensure_room (&max_specpdl_size, SPECPDL_INDEX (), 40); + ptrdiff_t counti = specpdl_ref_to_count (SPECPDL_INDEX ()); + max_ensure_room (&max_specpdl_size, counti, 40); call2 (Vsignal_hook_function, error_symbol, data); } @@ -1873,18 +1836,20 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) } /* If we're in batch mode, print a backtrace unconditionally to help - with debugging. Make sure to use `debug' unconditionally to not - interfere with ERT or other packages that install custom - debuggers. Don't try to call the debugger while dumping or - bootstrapping, it wouldn't work anyway. */ + with debugging. Make sure to use `debug-early' unconditionally + to not interfere with ERT or other packages that install custom + debuggers. */ if (!debugger_called && !NILP (error_symbol) && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) && noninteractive && backtrace_on_error_noninteractive - && !will_dump_p () && !will_bootstrap_p () - && NILP (Vinhibit_debugger)) + && NILP (Vinhibit_debugger) + && !NILP (Ffboundp (Qdebug_early))) { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Vdebugger, Qdebug); + max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); + specpdl_ref count = SPECPDL_INDEX (); + ptrdiff_t counti = specpdl_ref_to_count (count); + max_ensure_room (&max_specpdl_size, counti, 200); + specbind (Qdebugger, Qdebug_early); call_debugger (list2 (Qerror, Fcons (error_symbol, data))); unbind_to (count, Qnil); } @@ -2247,28 +2212,50 @@ this does nothing and returns nil. */) Qnil); } -void +static void un_autoload (Lisp_Object oldqueue) { - Lisp_Object queue, first, second; - /* Queue to unwind is current value of Vautoload_queue. oldqueue is the shadowed value to leave in Vautoload_queue. */ - queue = Vautoload_queue; + Lisp_Object queue = Vautoload_queue; Vautoload_queue = oldqueue; while (CONSP (queue)) { - first = XCAR (queue); - second = Fcdr (first); - first = Fcar (first); - if (EQ (first, make_fixnum (0))) - Vfeatures = second; + Lisp_Object first = XCAR (queue); + if (CONSP (first) && EQ (XCAR (first), make_fixnum (0))) + Vfeatures = XCDR (first); else - Ffset (first, second); + Ffset (first, Fcar (Fcdr (Fget (first, Qfunction_history)))); queue = XCDR (queue); } } +Lisp_Object +load_with_autoload_queue + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, + Lisp_Object nosuffix, Lisp_Object must_suffix) +{ + specpdl_ref count = SPECPDL_INDEX (); + + /* If autoloading gets an error (which includes the error of failing + to define the function being called), we use Vautoload_queue + to undo function definitions and `provide' calls made by + the function. We do this in the specific case of autoloading + because autoloading is not an explicit request "load this file", + but rather a request to "call this function". + + The value saved here is to be restored into Vautoload_queue. */ + record_unwind_protect (un_autoload, Vautoload_queue); + Vautoload_queue = Qt; + Lisp_Object tem + = save_match_data_load (file, noerror, nomessage, nosuffix, must_suffix); + + /* Once loading finishes, don't undo it. */ + Vautoload_queue = Qt; + unbind_to (count, Qnil); + return tem; +} + /* Load an autoloaded function. FUNNAME is the symbol which is the function's name. FUNDEF is the autoload definition (a list). */ @@ -2281,8 +2268,6 @@ If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if it defines a macro. */) (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only) { - ptrdiff_t count = SPECPDL_INDEX (); - if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) return fundef; @@ -2299,26 +2284,12 @@ it defines a macro. */) CHECK_SYMBOL (funname); - /* If autoloading gets an error (which includes the error of failing - to define the function being called), we use Vautoload_queue - to undo function definitions and `provide' calls made by - the function. We do this in the specific case of autoloading - because autoloading is not an explicit request "load this file", - but rather a request to "call this function". - - The value saved here is to be restored into Vautoload_queue. */ - record_unwind_protect (un_autoload, Vautoload_queue); - Vautoload_queue = Qt; /* If `macro_only' is set and fundef isn't a macro, assume this autoload to be a "best-effort" (e.g. to try and find a compiler macro), so don't signal an error if autoloading fails. */ Lisp_Object ignore_errors = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only; - save_match_data_load (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); - - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; - unbind_to (count, Qnil); + load_with_autoload_queue (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); if (NILP (funname) || !NILP (ignore_errors)) return Qnil; @@ -2343,7 +2314,7 @@ LEXICAL can also be an actual lexical environment, in the form of an alist mapping symbols to their value. */) (Lisp_Object form, Lisp_Object lexical) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); return unbind_to (count, eval_sub (form)); @@ -2354,7 +2325,7 @@ grow_specpdl_allocation (void) { eassert (specpdl_ptr == specpdl + specpdl_size); - ptrdiff_t count = SPECPDL_INDEX (); + 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; @@ -2368,7 +2339,7 @@ grow_specpdl_allocation (void) pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); specpdl = pdlvec + 1; specpdl_size = pdlvecsize - 1; - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); } /* Grow the specpdl stack by one entry. @@ -2389,10 +2360,10 @@ grow_specpdl (void) grow_specpdl_allocation (); } -ptrdiff_t +specpdl_ref record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); eassert (nargs >= UNEVALLED); specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; @@ -2442,7 +2413,7 @@ eval_sub (Lisp_Object form) CHECK_LIST (original_args); /* This also protects them from gc. */ - ptrdiff_t count + specpdl_ref count = record_in_backtrace (original_fun, &original_args, UNEVALLED); if (debug_on_next_call) @@ -2491,13 +2462,13 @@ eval_sub (Lisp_Object form) vals[argnum++] = eval_sub (arg); } - set_backtrace_args (specpdl + count, vals, argnum); + set_backtrace_args (specpdl_ref_to_ptr (count), vals, argnum); val = XSUBR (fun)->function.aMANY (argnum, vals); lisp_eval_depth--; /* Do the debug-on-exit now, while VALS still exists. */ - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); SAFE_FREE (); specpdl_ptr--; @@ -2513,7 +2484,7 @@ eval_sub (Lisp_Object form) args_left = Fcdr (args_left); } - set_backtrace_args (specpdl + count, argvals, numargs); + set_backtrace_args (specpdl_ref_to_ptr (count), argvals, numargs); switch (i) { @@ -2585,7 +2556,7 @@ eval_sub (Lisp_Object form) } if (EQ (funcar, Qmacro)) { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); Lisp_Object exp; /* Bind lexical-binding during expansion of the macro, so the macro can know reliably if the code it outputs will be @@ -2617,7 +2588,7 @@ eval_sub (Lisp_Object form) } lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; @@ -3063,7 +3034,7 @@ Thus, (funcall \\='cons \\='x \\='y) returns (x . y). usage: (funcall FUNCTION &rest ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count; + specpdl_ref count; maybe_quit (); @@ -3085,7 +3056,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) Lisp_Object val = funcall_general (args[0], nargs - 1, args + 1); lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; return val; @@ -3098,80 +3069,65 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args) { - if (numargs < subr->min_args - || (subr->max_args >= 0 && subr->max_args < numargs)) + eassume (numargs >= 0); + if (numargs >= subr->min_args) { - Lisp_Object fun; - XSETSUBR (fun, subr); - xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); - } + /* Conforming call to finite-arity subr. */ + if (numargs <= subr->max_args) + { + Lisp_Object argbuf[8]; + Lisp_Object *a; + if (numargs < subr->max_args) + { + eassume (subr->max_args <= ARRAYELTS (argbuf)); + a = argbuf; + memcpy (a, args, numargs * word_size); + memclear (a + numargs, (subr->max_args - numargs) * word_size); + } + else + a = args; + switch (subr->max_args) + { + case 0: + return subr->function.a0 (); + case 1: + return subr->function.a1 (a[0]); + case 2: + return subr->function.a2 (a[0], a[1]); + case 3: + return subr->function.a3 (a[0], a[1], a[2]); + case 4: + return subr->function.a4 (a[0], a[1], a[2], a[3]); + case 5: + return subr->function.a5 (a[0], a[1], a[2], a[3], a[4]); + case 6: + return subr->function.a6 (a[0], a[1], a[2], a[3], a[4], a[5]); + case 7: + return subr->function.a7 (a[0], a[1], a[2], a[3], a[4], a[5], + a[6]); + case 8: + return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5], + a[6], a[7]); + default: + /* If a subr takes more than 8 arguments without using MANY + or UNEVALLED, we need to extend this function to support it. + Until this is done, there is no way to call the function. */ + emacs_abort (); + } + } - else if (subr->max_args == UNEVALLED) - { - Lisp_Object fun; - XSETSUBR (fun, subr); - xsignal1 (Qinvalid_function, fun); + /* Call to n-adic subr. */ + if (subr->max_args == MANY) + return subr->function.aMANY (numargs, args); } - else if (subr->max_args == MANY) - return (subr->function.aMANY) (numargs, args); + /* Anything else is an error. */ + Lisp_Object fun; + XSETSUBR (fun, subr); + if (subr->max_args == UNEVALLED) + xsignal1 (Qinvalid_function, fun); else - { - Lisp_Object internal_argbuf[8]; - Lisp_Object *internal_args; - if (subr->max_args > numargs) - { - eassert (subr->max_args <= ARRAYELTS (internal_argbuf)); - internal_args = internal_argbuf; - memcpy (internal_args, args, numargs * word_size); - memclear (internal_args + numargs, - (subr->max_args - numargs) * word_size); - } - else - internal_args = args; - switch (subr->max_args) - { - case 0: - return (subr->function.a0 ()); - case 1: - return (subr->function.a1 (internal_args[0])); - case 2: - return (subr->function.a2 - (internal_args[0], internal_args[1])); - case 3: - return (subr->function.a3 - (internal_args[0], internal_args[1], internal_args[2])); - case 4: - return (subr->function.a4 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3])); - case 5: - return (subr->function.a5 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4])); - case 6: - return (subr->function.a6 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5])); - case 7: - return (subr->function.a7 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6])); - case 8: - return (subr->function.a8 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5], - internal_args[6], internal_args[7])); - - default: - - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - emacs_abort (); - } - } + xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs)); } /* Call the compiled Lisp function FUN. If we have not yet read FUN's @@ -3191,7 +3147,7 @@ fetch_and_exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, } static Lisp_Object -apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) +apply_lambda (Lisp_Object fun, Lisp_Object args, specpdl_ref count) { Lisp_Object *arg_vector; Lisp_Object tem; @@ -3208,12 +3164,12 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) arg_vector[i] = tem; } - set_backtrace_args (specpdl + count, arg_vector, numargs); + set_backtrace_args (specpdl_ref_to_ptr (count), arg_vector, numargs); tem = funcall_lambda (fun, numargs, arg_vector); lisp_eval_depth--; /* Do the debug-on-exit now, while arg_vector still exists. */ - if (backtrace_debug_on_exit (specpdl + count)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count))) tem = call_debugger (list2 (Qexit, tem)); SAFE_FREE (); specpdl_ptr--; @@ -3230,7 +3186,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, register Lisp_Object *arg_vector) { Lisp_Object val, syms_left, next, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t i; bool optional, rest; @@ -3255,19 +3211,15 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else if (COMPILEDP (fun)) { syms_left = AREF (fun, COMPILED_ARGLIST); + /* Bytecode objects using lexical binding have an integral + ARGLIST slot value: pass the arguments to the byte-code + engine directly. */ if (FIXNUMP (syms_left)) - /* A byte-code object with an integer args template means we - shouldn't bind any arguments, instead just call the byte-code - interpreter directly; it will push arguments as necessary. - - Byte-code objects with a nil args template (the default) - have dynamically-bound arguments, and use the - argument-binding code below instead (as do all interpreted - functions, even lexically bound ones). */ - { - return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), - nargs, arg_vector); - } + return fetch_and_exec_byte_code (fun, XFIXNUM (syms_left), + nargs, arg_vector); + /* Otherwise the bytecode object uses dynamic binding and the + ARGLIST slot contains a standard formal argument list whose + variables are bound dynamically below. */ lexenv = Qnil; } #ifdef HAVE_MODULES @@ -3503,6 +3455,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, bytecode = Fstring_as_unibyte (bytecode); } + pin_string (bytecode); ASET (object, COMPILED_BYTECODE, bytecode); ASET (object, COMPILED_CONSTANTS, XCDR (tem)); } @@ -3593,9 +3546,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET; specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); - specpdl_ptr->let.saved_value = Qnil; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED: @@ -3605,7 +3555,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = ovalue; specpdl_ptr->let.where = Fcurrent_buffer (); - specpdl_ptr->let.saved_value = Qnil; eassert (sym->u.s.redirect != SYMBOL_LOCALIZED || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); @@ -3623,22 +3572,17 @@ specbind (Lisp_Object symbol, Lisp_Object value) having their own value. This is consistent with what happens with other buffer-local variables. */ if (NILP (Flocal_variable_p (symbol, Qnil))) - { - specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); - return; - } + specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; } else specpdl_ptr->let.kind = SPECPDL_LET; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; } default: emacs_abort (); } + grow_specpdl (); + do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); } /* Push unwind-protect entries of various types. */ @@ -3714,24 +3658,6 @@ record_unwind_protect_module (enum specbind_tag kind, void *ptr) grow_specpdl (); } -void -rebind_for_thread_switch (void) -{ - union specbinding *bind; - - for (bind = specpdl; bind != specpdl_ptr; ++bind) - { - if (bind->kind >= SPECPDL_LET) - { - Lisp_Object value = specpdl_saved_value (bind); - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = Qnil; - do_specbind (XSYMBOL (sym), bind, value, - SET_INTERNAL_THREAD_SWITCH); - } - } -} - static void do_one_unbind (union specbinding *this_binding, bool unwinding, enum Set_Internal_Bind bindflag) @@ -3763,6 +3689,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, this_binding->unwind_excursion.window); break; case SPECPDL_BACKTRACE: + case SPECPDL_NOP: break; #ifdef HAVE_MODULES case SPECPDL_MODULE_RUNTIME: @@ -3827,9 +3754,9 @@ record_unwind_protect_nothing (void) It need not be at the top of the stack. */ void -clear_unwind_protect (ptrdiff_t count) +clear_unwind_protect (specpdl_ref count) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind_void.kind = SPECPDL_UNWIND_VOID; p->unwind_void.func = do_nothing; } @@ -3839,10 +3766,10 @@ clear_unwind_protect (ptrdiff_t count) previous value without invoking it. */ void -set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), +set_unwind_protect (specpdl_ref count, void (*func) (Lisp_Object), Lisp_Object arg) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind.kind = SPECPDL_UNWIND; p->unwind.func = func; p->unwind.arg = arg; @@ -3850,9 +3777,9 @@ set_unwind_protect (ptrdiff_t count, void (*func) (Lisp_Object), } void -set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) +set_unwind_protect_ptr (specpdl_ref count, void (*func) (void *), void *arg) { - union specbinding *p = specpdl + count; + union specbinding *p = specpdl_ref_to_ptr (count); p->unwind_ptr.kind = SPECPDL_UNWIND_PTR; p->unwind_ptr.func = func; p->unwind_ptr.arg = arg; @@ -3862,13 +3789,13 @@ set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) depth COUNT is reached. Return VALUE. */ Lisp_Object -unbind_to (ptrdiff_t count, Lisp_Object value) +unbind_to (specpdl_ref count, Lisp_Object value) { Lisp_Object quitf = Vquit_flag; Vquit_flag = Qnil; - while (specpdl_ptr != specpdl + count) + while (specpdl_ptr != specpdl_ref_to_ptr (count)) { /* Copy the binding, and decrement specpdl_ptr, before we do the work to unbind it. We decrement first @@ -3888,22 +3815,6 @@ unbind_to (ptrdiff_t count, Lisp_Object value) return value; } -void -unbind_for_thread_switch (struct thread_state *thr) -{ - union specbinding *bind; - - for (bind = thr->m_specpdl_ptr; bind > thr->m_specpdl;) - { - if ((--bind)->kind >= SPECPDL_LET) - { - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = find_symbol_value (sym); - do_one_unbind (bind, false, SET_INTERNAL_THREAD_SWITCH); - } - } -} - DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, doc: /* Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a @@ -4059,11 +3970,13 @@ or a lambda expression for macro calls. */) value and the old value stored in the specpdl), kind of like the inplace pointer-reversal trick. As it turns out, the rewind does the same as the unwind, except it starts from the other end of the specpdl stack, so we use - the same function for both unwind and rewind. */ -static void -backtrace_eval_unrewind (int distance) + the same function for both unwind and rewind. + This same code is used when switching threads, except in that case + we unwind/rewind the whole specpdl of the threads. */ +void +specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only) { - union specbinding *tmp = specpdl_ptr; + union specbinding *tmp = pdl; int step = -1; if (distance < 0) { /* It's a rewind rather than unwind. */ @@ -4081,6 +3994,8 @@ backtrace_eval_unrewind (int distance) unwind_protect, but the problem is that we don't know how to rewind them afterwards. */ case SPECPDL_UNWIND: + if (vars_only) + break; if (tmp->unwind.func == set_buffer_if_live) { Lisp_Object oldarg = tmp->unwind.arg; @@ -4089,6 +4004,8 @@ backtrace_eval_unrewind (int distance) } break; case SPECPDL_UNWIND_EXCURSION: + if (vars_only) + break; { Lisp_Object marker = tmp->unwind_excursion.marker; Lisp_Object window = tmp->unwind_excursion.window; @@ -4096,17 +4013,6 @@ backtrace_eval_unrewind (int distance) save_excursion_restore (marker, window); } break; - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - break; case SPECPDL_LET: { /* If variable has a trivial value (no forwarding), we can just set it. No need to check for constant symbols here, @@ -4129,7 +4035,7 @@ backtrace_eval_unrewind (int distance) Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, default_value (sym)); - Fset_default (sym, old_value); + set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH); } break; case SPECPDL_LET_LOCAL: @@ -4145,21 +4051,37 @@ backtrace_eval_unrewind (int distance) { set_specpdl_old_value (tmp, buffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); + set_internal (symbol, old_value, where, + SET_INTERNAL_THREAD_SWITCH); } + else + /* If the var is not local any more, it can't be undone nor + redone, so just zap it. + This is important in case the buffer re-gains a local value + before we unrewind again, in which case we'd risk applying + this entry in the wrong direction. */ + tmp->kind = SPECPDL_NOP; } break; + + default: break; } } } +static void +backtrace_eval_unrewind (int distance) +{ + specpdl_unrewind (specpdl_ptr, distance, false); +} + DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL, doc: /* Evaluate EXP in the context of some activation frame. NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */) (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base) { union specbinding *pdl = get_backtrace_frame (nframes, base); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t distance = specpdl_ptr - pdl; eassert (distance >= 0); @@ -4233,22 +4155,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. } break; - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_ARRAY: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_INTMAX: - case SPECPDL_UNWIND_EXCURSION: - case SPECPDL_UNWIND_VOID: - case SPECPDL_BACKTRACE: -#ifdef HAVE_MODULES - case SPECPDL_MODULE_RUNTIME: - case SPECPDL_MODULE_ENVIRONMENT: -#endif - break; - - default: - emacs_abort (); + default: break; } } } @@ -4306,15 +4213,18 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) case SPECPDL_LET: mark_object (specpdl_symbol (pdl)); mark_object (specpdl_old_value (pdl)); - mark_object (specpdl_saved_value (pdl)); break; case SPECPDL_UNWIND_PTR: case SPECPDL_UNWIND_INT: case SPECPDL_UNWIND_INTMAX: case SPECPDL_UNWIND_VOID: + case SPECPDL_NOP: break; + /* While other loops that scan the specpdl use "default: break;" + for simplicity, here we explicitly list all cases and abort + if we find an unexpected value, as a sanity check. */ default: emacs_abort (); } @@ -4408,6 +4318,7 @@ before making `inhibit-quit' nil. */); DEFSYM (Qclosure, "closure"); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); + DEFSYM (Qdebug_early, "debug-early"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. @@ -4454,6 +4365,7 @@ might not be safe to continue. */); doc: /* Non-nil means display call stack frames as lists. */); debugger_stack_frame_as_list = 0; + DEFSYM (Qdebugger, "debugger"); DEFVAR_LISP ("debugger", Vdebugger, doc: /* Function to call to invoke debugger. If due to frame exit, args are `exit' and the value being returned; @@ -4461,7 +4373,7 @@ If due to frame exit, args are `exit' and the value being returned; If due to error, args are `error' and a list of the args to `signal'. If due to `apply' or `funcall' entry, one arg, `lambda'. If due to `eval' entry, one arg, t. */); - Vdebugger = Qnil; + Vdebugger = Qdebug_early; DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function, doc: /* If non-nil, this is a function for `signal' to call. diff --git a/src/fileio.c b/src/fileio.c index 9c50cbb35a6..243a87a4821 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -714,14 +714,14 @@ This function does not grok magic file names. */) bool failed = fd < 0; if (!failed) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, fd); val = DECODE_FILE (val); if (STRINGP (text) && SBYTES (text) != 0) write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd); failed = NILP (dir_flag) && emacs_close (fd) != 0; /* Discard the unwind protect. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); } if (failed) { @@ -2165,7 +2165,7 @@ permissions. */) Lisp_Object preserve_permissions) { Lisp_Object handler; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object encoded_file, encoded_newname; #if HAVE_LIBSELINUX char *con; @@ -2416,7 +2416,7 @@ permissions. */) #endif /* not WINDOWSNT */ /* Discard the unwind protects. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); return Qnil; } @@ -2718,7 +2718,7 @@ This is what happens in interactive use with M-x. */) Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); if (dirp) call2 (Qdelete_directory, file, Qt); @@ -3903,7 +3903,7 @@ by calling `format-decode', which see. */) ptrdiff_t how_much; off_t beg_offset, end_offset; int unprocessed; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object handler, val, insval, orig_filename, old_undo; Lisp_Object p; ptrdiff_t total = 0; @@ -3922,7 +3922,6 @@ by calling `format-decode', which see. */) && BEG == Z); Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark; bool we_locked_file = false; - ptrdiff_t fd_index; Lisp_Object window_markers = Qnil; /* same_at_start and same_at_end count bytes, because file access counts bytes and BEG and END count bytes. */ @@ -3984,7 +3983,7 @@ by calling `format-decode', which see. */) goto notfound; } - fd_index = SPECPDL_INDEX (); + specpdl_ref fd_index = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, fd); /* Replacement should preserve point as it preserves markers. */ @@ -4327,7 +4326,7 @@ by calling `format-decode', which see. */) if (! giveup_match_end) { ptrdiff_t temp; - ptrdiff_t this_count = SPECPDL_INDEX (); + specpdl_ref this_count = SPECPDL_INDEX (); /* We win! We can handle REPLACE the optimized way. */ @@ -4398,7 +4397,7 @@ by calling `format-decode', which see. */) unsigned char *decoded; ptrdiff_t temp; ptrdiff_t this = 0; - ptrdiff_t this_count = SPECPDL_INDEX (); + specpdl_ref this_count = SPECPDL_INDEX (); bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); Lisp_Object conversion_buffer; @@ -4704,7 +4703,7 @@ by calling `format-decode', which see. */) = Fcons (multibyte, Fcons (BVAR (current_buffer, undo_list), Fcurrent_buffer ())); - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); bset_enable_multibyte_characters (current_buffer, Qnil); bset_undo_list (current_buffer, Qt); @@ -4855,7 +4854,7 @@ by calling `format-decode', which see. */) if (inserted > 0) { /* Don't run point motion or modification hooks when decoding. */ - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); ptrdiff_t old_inserted = inserted; specbind (Qinhibit_point_motion_hooks, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -5186,8 +5185,8 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, const char *fn; struct stat st; struct timespec modtime; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count1 UNINIT; + specpdl_ref count = SPECPDL_INDEX (); + specpdl_ref count1 UNINIT; Lisp_Object handler; Lisp_Object visit_file; Lisp_Object annotations; @@ -5390,7 +5389,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, ok = 0, save_errno = errno; /* Discard the unwind protect for close_file_unwind. */ - specpdl_ptr = specpdl + count1; + specpdl_ptr = specpdl_ref_to_ptr (count1); } /* Some file systems have a bug where st_mtime is not updated @@ -5969,7 +5968,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) int do_handled_files; Lisp_Object oquit; FILE *stream = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool orig_minibuffer_auto_raise = minibuffer_auto_raise; bool old_message_p = 0; struct auto_save_unwind auto_save_unwind; diff --git a/src/filelock.c b/src/filelock.c index eb8d9ab5e01..cb548ac79bd 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -658,6 +658,7 @@ make_lock_file_name (Lisp_Object fn) static Lisp_Object lock_file (Lisp_Object fn) { + char *lfname = NULL; lock_info_type lock_info; /* Don't do locking while dumping Emacs. @@ -666,47 +667,46 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) return Qnil; - /* If the file name has special constructs in it, - call the corresponding file name handler. */ - Lisp_Object handler; - handler = Ffind_file_name_handler (fn, Qlock_file); - if (!NILP (handler)) + if (create_lockfiles) { - return call2 (handler, Qlock_file, fn); + /* Create the name of the lock-file for file fn */ + Lisp_Object lock_filename = make_lock_file_name (fn); + if (NILP (lock_filename)) + return Qnil; + lfname = SSDATA (ENCODE_FILE (lock_filename)); } - Lisp_Object lock_filename = make_lock_file_name (fn); - if (NILP (lock_filename)) - return Qnil; - char *lfname = SSDATA (ENCODE_FILE (lock_filename)); - /* See if this file is visited and has changed on disk since it was visited. */ Lisp_Object subject_buf = get_truename_buffer (fn); if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) - && current_lock_owner (NULL, lfname) != I_OWN_IT) + && !(lfname && (current_lock_owner (NULL, lfname) == I_OWN_IT))) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); - /* Try to lock the lock. FIXME: This ignores errors when - lock_if_free returns an errno value. */ - if (lock_if_free (&lock_info, lfname) == ANOTHER_OWNS_IT) + /* Don't do locking if the user has opted out. */ + if (lfname) { - /* Someone else has the lock. Consider breaking it. */ - Lisp_Object attack; - char *dot = lock_info.dot; - ptrdiff_t pidlen = lock_info.colon - (dot + 1); - static char const replacement[] = " (pid "; - int replacementlen = sizeof replacement - 1; - memmove (dot + replacementlen, dot + 1, pidlen); - strcpy (dot + replacementlen + pidlen, ")"); - memcpy (dot, replacement, replacementlen); - attack = call2 (intern ("ask-user-about-lock"), fn, - build_string (lock_info.user)); - /* Take the lock if the user said so. */ - if (!NILP (attack)) - lock_file_1 (lfname, 1); + /* Try to lock the lock. FIXME: This ignores errors when + lock_if_free returns a positive errno value. */ + if (lock_if_free (&lock_info, lfname) == ANOTHER_OWNS_IT) + { + /* Someone else has the lock. Consider breaking it. */ + Lisp_Object attack; + char *dot = lock_info.dot; + ptrdiff_t pidlen = lock_info.colon - (dot + 1); + static char const replacement[] = " (pid "; + int replacementlen = sizeof replacement - 1; + memmove (dot + replacementlen, dot + 1, pidlen); + strcpy (dot + replacementlen + pidlen, ")"); + memcpy (dot, replacement, replacementlen); + attack = call2 (intern ("ask-user-about-lock"), fn, + build_string (lock_info.user)); + /* Take the lock if the user said so. */ + if (!NILP (attack)) + lock_file_1 (lfname, 1); + } } return Qnil; } @@ -760,12 +760,16 @@ If the option `create-lockfiles' is nil, this does nothing. */) (Lisp_Object file) { #ifndef MSDOS - /* Don't do locking if the user has opted out. */ - if (create_lockfiles) - { - CHECK_STRING (file); - lock_file (file); - } + CHECK_STRING (file); + + /* If the file name has special constructs in it, + call the corresponding file name handler. */ + Lisp_Object handler; + handler = Ffind_file_name_handler (file, Qlock_file); + if (!NILP (handler)) + return call2 (handler, Qlock_file, file); + + lock_file (file); #endif /* MSDOS */ return Qnil; } diff --git a/src/fns.c b/src/fns.c index ade30fca41f..06a64563806 100644 --- a/src/fns.c +++ b/src/fns.c @@ -643,18 +643,19 @@ Do NOT use this function to compare file names for equality. */) } static Lisp_Object concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, bool last_special); + Lisp_Object last_tail, bool vector_target); +static Lisp_Object concat_strings (ptrdiff_t nargs, Lisp_Object *args); Lisp_Object concat2 (Lisp_Object s1, Lisp_Object s2) { - return concat (2, ((Lisp_Object []) {s1, s2}), Lisp_String, 0); + return concat_strings (2, ((Lisp_Object []) {s1, s2})); } Lisp_Object concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) { - return concat (3, ((Lisp_Object []) {s1, s2, s3}), Lisp_String, 0); + return concat_strings (3, ((Lisp_Object []) {s1, s2, s3})); } DEFUN ("append", Fappend, Sappend, 0, MANY, 0, @@ -665,7 +666,9 @@ The last argument is not copied, just used as the tail of the new list. usage: (append &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Lisp_Cons, 1); + if (nargs == 0) + return Qnil; + return concat (nargs - 1, args, args[nargs - 1], false); } DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0, @@ -678,7 +681,7 @@ to be `eq'. usage: (concat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Lisp_String, 0); + return concat_strings (nargs, args); } DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0, @@ -688,7 +691,7 @@ Each argument may be a list, vector or string. usage: (vconcat &rest SEQUENCES) */) (ptrdiff_t nargs, Lisp_Object *args) { - return concat (nargs, args, Lisp_Vectorlike, 0); + return concat (nargs, args, Qnil, true); } @@ -702,16 +705,48 @@ the same empty object instead of its copy. */) { if (NILP (arg)) return arg; - if (RECORDP (arg)) + if (CONSP (arg)) { - return Frecord (PVSIZE (arg), XVECTOR (arg)->contents); + Lisp_Object val = Fcons (XCAR (arg), Qnil); + Lisp_Object prev = val; + Lisp_Object tail = XCDR (arg); + FOR_EACH_TAIL (tail) + { + Lisp_Object c = Fcons (XCAR (tail), Qnil); + XSETCDR (prev, c); + prev = c; + } + CHECK_LIST_END (tail, tail); + return val; } - if (CHAR_TABLE_P (arg)) + if (STRINGP (arg)) { - return copy_char_table (arg); + ptrdiff_t bytes = SBYTES (arg); + ptrdiff_t chars = SCHARS (arg); + Lisp_Object val = STRING_MULTIBYTE (arg) + ? make_uninit_multibyte_string (chars, bytes) + : make_uninit_string (bytes); + memcpy (SDATA (val), SDATA (arg), bytes); + INTERVAL ivs = string_intervals (arg); + if (ivs) + { + INTERVAL copy = copy_intervals (ivs, 0, chars); + set_interval_object (copy, val); + set_string_intervals (val, copy); + } + return val; } + if (VECTORP (arg)) + return Fvector (ASIZE (arg), XVECTOR (arg)->contents); + + if (RECORDP (arg)) + return Frecord (PVSIZE (arg), XVECTOR (arg)->contents); + + if (CHAR_TABLE_P (arg)) + return copy_char_table (arg); + if (BOOL_VECTOR_P (arg)) { EMACS_INT nbits = bool_vector_size (arg); @@ -721,13 +756,10 @@ the same empty object instead of its copy. */) return val; } - if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) - wrong_type_argument (Qsequencep, arg); - - return concat (1, &arg, XTYPE (arg), 0); + wrong_type_argument (Qsequencep, arg); } -/* This structure holds information of an argument of `concat' that is +/* This structure holds information of an argument of `concat_strings' that is a string and has text properties to be copied. */ struct textprop_rec { @@ -737,278 +769,308 @@ struct textprop_rec }; static Lisp_Object -concat (ptrdiff_t nargs, Lisp_Object *args, - enum Lisp_Type target_type, bool last_special) +concat_strings (ptrdiff_t nargs, Lisp_Object *args) { - Lisp_Object val; - Lisp_Object tail; - Lisp_Object this; - ptrdiff_t toindex; - ptrdiff_t toindex_byte = 0; - EMACS_INT result_len; - EMACS_INT result_len_byte; - ptrdiff_t argnum; - Lisp_Object last_tail; - Lisp_Object prev; - bool some_multibyte; - /* When we make a multibyte string, we can't copy text properties - while concatenating each string because the length of resulting - string can't be decided until we finish the whole concatenation. - So, we record strings that have text properties to be copied - here, and copy the text properties after the concatenation. */ - struct textprop_rec *textprops = NULL; - /* Number of elements in textprops. */ - ptrdiff_t num_textprops = 0; USE_SAFE_ALLOCA; - tail = Qnil; - - /* In append, the last arg isn't treated like the others */ - if (last_special && nargs > 0) - { - nargs--; - last_tail = args[nargs]; - } - else - last_tail = Qnil; - - /* Check each argument. */ - for (argnum = 0; argnum < nargs; argnum++) - { - this = args[argnum]; - if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) - || COMPILEDP (this) || BOOL_VECTOR_P (this))) - wrong_type_argument (Qsequencep, this); - } - - /* Compute total length in chars of arguments in RESULT_LEN. - If desired output is a string, also compute length in bytes - in RESULT_LEN_BYTE, and determine in SOME_MULTIBYTE + /* Check types and compute total length in chars of arguments in RESULT_LEN, + length in bytes in RESULT_LEN_BYTE, and determine in DEST_MULTIBYTE whether the result should be a multibyte string. */ - result_len_byte = 0; - result_len = 0; - some_multibyte = 0; - for (argnum = 0; argnum < nargs; argnum++) + EMACS_INT result_len = 0; + EMACS_INT result_len_byte = 0; + bool dest_multibyte = false; + bool some_unibyte = false; + for (ptrdiff_t i = 0; i < nargs; i++) { + Lisp_Object arg = args[i]; EMACS_INT len; - this = args[argnum]; - len = XFIXNAT (Flength (this)); - if (target_type == Lisp_String) - { - /* We must count the number of bytes needed in the string - as well as the number of characters. */ - ptrdiff_t i; - Lisp_Object ch; - int c; - ptrdiff_t this_len_byte; - if (VECTORP (this) || COMPILEDP (this)) - for (i = 0; i < len; i++) - { - ch = AREF (this, i); - CHECK_CHARACTER (ch); - c = XFIXNAT (ch); - this_len_byte = CHAR_BYTES (c); - if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) - string_overflow (); - result_len_byte += this_len_byte; - if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c)) - some_multibyte = 1; - } - else if (BOOL_VECTOR_P (this) && bool_vector_size (this) > 0) - wrong_type_argument (Qintegerp, Faref (this, make_fixnum (0))); - else if (CONSP (this)) - for (; CONSP (this); this = XCDR (this)) - { - ch = XCAR (this); - CHECK_CHARACTER (ch); - c = XFIXNAT (ch); - this_len_byte = CHAR_BYTES (c); - if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) - string_overflow (); - result_len_byte += this_len_byte; - if (! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c)) - some_multibyte = 1; - } - else if (STRINGP (this)) + /* We must count the number of bytes needed in the string + as well as the number of characters. */ + + if (STRINGP (arg)) + { + ptrdiff_t arg_len_byte = SBYTES (arg); + len = SCHARS (arg); + if (STRING_MULTIBYTE (arg)) + dest_multibyte = true; + else + some_unibyte = true; + if (STRING_BYTES_BOUND - result_len_byte < arg_len_byte) + string_overflow (); + result_len_byte += arg_len_byte; + } + else if (VECTORP (arg)) + { + len = ASIZE (arg); + ptrdiff_t arg_len_byte = 0; + for (ptrdiff_t j = 0; j < len; j++) { - if (STRING_MULTIBYTE (this)) - { - some_multibyte = 1; - this_len_byte = SBYTES (this); - } - else - this_len_byte = count_size_as_multibyte (SDATA (this), - SCHARS (this)); - if (STRING_BYTES_BOUND - result_len_byte < this_len_byte) - string_overflow (); - result_len_byte += this_len_byte; + Lisp_Object ch = AREF (arg, j); + CHECK_CHARACTER (ch); + int c = XFIXNAT (ch); + arg_len_byte += CHAR_BYTES (c); + if (!ASCII_CHAR_P (c) && !CHAR_BYTE8_P (c)) + dest_multibyte = true; } + if (STRING_BYTES_BOUND - result_len_byte < arg_len_byte) + string_overflow (); + result_len_byte += arg_len_byte; } + else if (NILP (arg)) + continue; + else if (CONSP (arg)) + { + len = XFIXNAT (Flength (arg)); + ptrdiff_t arg_len_byte = 0; + for (; CONSP (arg); arg = XCDR (arg)) + { + Lisp_Object ch = XCAR (arg); + CHECK_CHARACTER (ch); + int c = XFIXNAT (ch); + arg_len_byte += CHAR_BYTES (c); + if (!ASCII_CHAR_P (c) && !CHAR_BYTE8_P (c)) + dest_multibyte = true; + } + if (STRING_BYTES_BOUND - result_len_byte < arg_len_byte) + string_overflow (); + result_len_byte += arg_len_byte; + } + else + wrong_type_argument (Qsequencep, arg); result_len += len; if (MOST_POSITIVE_FIXNUM < result_len) memory_full (SIZE_MAX); } - if (! some_multibyte) + if (dest_multibyte && some_unibyte) + { + /* Non-ASCII characters in unibyte strings take two bytes when + converted to multibyte -- count them and adjust the total. */ + for (ptrdiff_t i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + if (STRINGP (arg) && !STRING_MULTIBYTE (arg)) + { + ptrdiff_t bytes = SCHARS (arg); + const unsigned char *s = SDATA (arg); + ptrdiff_t nonascii = 0; + for (ptrdiff_t j = 0; j < bytes; j++) + nonascii += s[j] >> 7; + if (STRING_BYTES_BOUND - result_len_byte < nonascii) + string_overflow (); + result_len_byte += nonascii; + } + } + } + + if (!dest_multibyte) result_len_byte = result_len; /* Create the output object. */ - if (target_type == Lisp_Cons) - val = Fmake_list (make_fixnum (result_len), Qnil); - else if (target_type == Lisp_Vectorlike) - val = make_nil_vector (result_len); - else if (some_multibyte) - val = make_uninit_multibyte_string (result_len, result_len_byte); - else - val = make_uninit_string (result_len); - - /* In `append', if all but last arg are nil, return last arg. */ - if (target_type == Lisp_Cons && NILP (val)) - return last_tail; + Lisp_Object result = dest_multibyte + ? make_uninit_multibyte_string (result_len, result_len_byte) + : make_uninit_string (result_len); /* Copy the contents of the args into the result. */ - if (CONSP (val)) - tail = val, toindex = -1; /* -1 in toindex is flag we are making a list */ - else - toindex = 0, toindex_byte = 0; + ptrdiff_t toindex = 0; + ptrdiff_t toindex_byte = 0; - prev = Qnil; - if (STRINGP (val)) - SAFE_NALLOCA (textprops, 1, nargs); + /* When we make a multibyte string, we can't copy text properties + while concatenating each string because the length of resulting + string can't be decided until we finish the whole concatenation. + So, we record strings that have text properties to be copied + here, and copy the text properties after the concatenation. */ + struct textprop_rec *textprops; + /* Number of elements in textprops. */ + ptrdiff_t num_textprops = 0; + SAFE_NALLOCA (textprops, 1, nargs); - for (argnum = 0; argnum < nargs; argnum++) + for (ptrdiff_t i = 0; i < nargs; i++) { - Lisp_Object thislen; - ptrdiff_t thisleni = 0; - ptrdiff_t thisindex = 0; - ptrdiff_t thisindex_byte = 0; - - this = args[argnum]; - if (!CONSP (this)) - thislen = Flength (this), thisleni = XFIXNUM (thislen); - - /* Between strings of the same kind, copy fast. */ - if (STRINGP (this) && STRINGP (val) - && STRING_MULTIBYTE (this) == some_multibyte) + Lisp_Object arg = args[i]; + if (STRINGP (arg)) { - ptrdiff_t thislen_byte = SBYTES (this); - - memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this)); - if (string_intervals (this)) + if (string_intervals (arg)) { - textprops[num_textprops].argnum = argnum; + textprops[num_textprops].argnum = i; textprops[num_textprops].from = 0; - textprops[num_textprops++].to = toindex; + textprops[num_textprops].to = toindex; + num_textprops++; + } + ptrdiff_t nchars = SCHARS (arg); + if (STRING_MULTIBYTE (arg) == dest_multibyte) + { + /* Between strings of the same kind, copy fast. */ + ptrdiff_t arg_len_byte = SBYTES (arg); + memcpy (SDATA (result) + toindex_byte, SDATA (arg), arg_len_byte); + toindex_byte += arg_len_byte; + } + else + { + /* Copy a single-byte string to a multibyte string. */ + toindex_byte += copy_text (SDATA (arg), + SDATA (result) + toindex_byte, + nchars, 0, 1); } - toindex_byte += thislen_byte; - toindex += thisleni; + toindex += nchars; } - /* Copy a single-byte string to a multibyte string. */ - else if (STRINGP (this) && STRINGP (val)) + else if (VECTORP (arg)) { - if (string_intervals (this)) + ptrdiff_t len = ASIZE (arg); + for (ptrdiff_t j = 0; j < len; j++) { - textprops[num_textprops].argnum = argnum; - textprops[num_textprops].from = 0; - textprops[num_textprops++].to = toindex; + int c = XFIXNAT (AREF (arg, j)); + if (dest_multibyte) + toindex_byte += CHAR_STRING (c, SDATA (result) + toindex_byte); + else + SSET (result, toindex_byte++, c); + toindex++; } - toindex_byte += copy_text (SDATA (this), - SDATA (val) + toindex_byte, - SCHARS (this), 0, 1); - toindex += thisleni; } else - /* Copy element by element. */ - while (1) + for (Lisp_Object tail = arg; !NILP (tail); tail = XCDR (tail)) { - register Lisp_Object elt; - - /* Fetch next element of `this' arg into `elt', or break if - `this' is exhausted. */ - if (NILP (this)) break; - if (CONSP (this)) - elt = XCAR (this), this = XCDR (this); - else if (thisindex >= thisleni) - break; - else if (STRINGP (this)) - { - int c; - if (STRING_MULTIBYTE (this)) - c = fetch_string_char_advance_no_check (this, &thisindex, - &thisindex_byte); - else - { - c = SREF (this, thisindex); thisindex++; - if (some_multibyte && !ASCII_CHAR_P (c)) - c = BYTE8_TO_CHAR (c); - } - XSETFASTINT (elt, c); - } - else if (BOOL_VECTOR_P (this)) - { - elt = bool_vector_ref (this, thisindex); - thisindex++; - } - else - { - elt = AREF (this, thisindex); - thisindex++; - } - - /* Store this element into the result. */ - if (toindex < 0) - { - XSETCAR (tail, elt); - prev = tail; - tail = XCDR (tail); - } - else if (VECTORP (val)) - { - ASET (val, toindex, elt); - toindex++; - } + int c = XFIXNAT (XCAR (tail)); + if (dest_multibyte) + toindex_byte += CHAR_STRING (c, SDATA (result) + toindex_byte); else - { - int c; - CHECK_CHARACTER (elt); - c = XFIXNAT (elt); - if (some_multibyte) - toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte); - else - SSET (val, toindex_byte++, c); - toindex++; - } + SSET (result, toindex_byte++, c); + toindex++; } } - if (!NILP (prev)) - XSETCDR (prev, last_tail); if (num_textprops > 0) { - Lisp_Object props; ptrdiff_t last_to_end = -1; - - for (argnum = 0; argnum < num_textprops; argnum++) + for (ptrdiff_t i = 0; i < num_textprops; i++) { - this = args[textprops[argnum].argnum]; - props = text_property_list (this, - make_fixnum (0), - make_fixnum (SCHARS (this)), - Qnil); + Lisp_Object arg = args[textprops[i].argnum]; + Lisp_Object props = text_property_list (arg, + make_fixnum (0), + make_fixnum (SCHARS (arg)), + Qnil); /* If successive arguments have properties, be sure that the value of `composition' property be the copy. */ - if (last_to_end == textprops[argnum].to) + if (last_to_end == textprops[i].to) make_composition_value_copy (props); - add_text_properties_from_list (val, props, - make_fixnum (textprops[argnum].to)); - last_to_end = textprops[argnum].to + SCHARS (this); + add_text_properties_from_list (result, props, + make_fixnum (textprops[i].to)); + last_to_end = textprops[i].to + SCHARS (arg); } } SAFE_FREE (); - return val; + return result; +} + +/* Concatenate sequences into a list or vector. */ + +Lisp_Object +concat (ptrdiff_t nargs, Lisp_Object *args, Lisp_Object last_tail, + bool vector_target) +{ + /* Check argument types and compute total length of arguments. */ + EMACS_INT result_len = 0; + for (ptrdiff_t i = 0; i < nargs; i++) + { + Lisp_Object arg = args[i]; + if (!(CONSP (arg) || NILP (arg) || VECTORP (arg) || STRINGP (arg) + || COMPILEDP (arg) || BOOL_VECTOR_P (arg))) + wrong_type_argument (Qsequencep, arg); + EMACS_INT len = XFIXNAT (Flength (arg)); + result_len += len; + if (MOST_POSITIVE_FIXNUM < result_len) + memory_full (SIZE_MAX); + } + + /* When the target is a list, return the tail directly if all other + arguments are empty. */ + if (!vector_target && result_len == 0) + return last_tail; + + /* Create the output object. */ + Lisp_Object result = vector_target + ? make_nil_vector (result_len) + : Fmake_list (make_fixnum (result_len), Qnil); + + /* Copy the contents of the args into the result. */ + Lisp_Object tail = Qnil; + ptrdiff_t toindex = 0; + if (CONSP (result)) + { + tail = result; + toindex = -1; /* -1 in toindex is flag we are making a list */ + } + + Lisp_Object prev = Qnil; + + for (ptrdiff_t i = 0; i < nargs; i++) + { + ptrdiff_t arglen = 0; + ptrdiff_t argindex = 0; + ptrdiff_t argindex_byte = 0; + + Lisp_Object arg = args[i]; + if (!CONSP (arg)) + arglen = XFIXNUM (Flength (arg)); + + /* Copy element by element. */ + while (1) + { + /* Fetch next element of `arg' arg into `elt', or break if + `arg' is exhausted. */ + Lisp_Object elt; + if (CONSP (arg)) + { + elt = XCAR (arg); + arg = XCDR (arg); + } + else if (NILP (arg) || argindex >= arglen) + break; + else if (STRINGP (arg)) + { + int c; + if (STRING_MULTIBYTE (arg)) + c = fetch_string_char_advance_no_check (arg, &argindex, + &argindex_byte); + else + { + c = SREF (arg, argindex); + argindex++; + } + XSETFASTINT (elt, c); + } + else if (BOOL_VECTOR_P (arg)) + { + elt = bool_vector_ref (arg, argindex); + argindex++; + } + else + { + elt = AREF (arg, argindex); + argindex++; + } + + /* Store this element into the result. */ + if (toindex < 0) + { + XSETCAR (tail, elt); + prev = tail; + tail = XCDR (tail); + } + else + { + ASET (result, toindex, elt); + toindex++; + } + } + } + if (!NILP (prev)) + XSETCDR (prev, last_tail); + + return result; } static Lisp_Object string_char_byte_cache_string; @@ -1380,7 +1442,7 @@ Elements of ALIST that are not conses are also shared. */) { if (NILP (alist)) return alist; - alist = concat (1, &alist, Lisp_Cons, false); + alist = Fcopy_sequence (alist); for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem)) { Lisp_Object car = XCAR (tem); @@ -2998,7 +3060,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) AUTO_STRING (yes_or_no, "(yes or no) "); prompt = CALLN (Fconcat, prompt, yes_or_no); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qenable_recursive_minibuffers, Qt); while (1) @@ -3160,7 +3222,7 @@ FILENAME are suppressed. */) if (NILP (tem)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int nesting = 0; /* This is to make sure that loadup.el gives a clear picture @@ -3187,12 +3249,8 @@ FILENAME are suppressed. */) record_unwind_protect (require_unwind, require_nesting_list); require_nesting_list = Fcons (feature, require_nesting_list); - /* Value saved here is to be restored into Vautoload_queue */ - record_unwind_protect (un_autoload, Vautoload_queue); - Vautoload_queue = Qt; - /* Load the file. */ - tem = save_match_data_load + tem = load_with_autoload_queue (NILP (filename) ? Fsymbol_name (feature) : filename, noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil)); @@ -3214,8 +3272,6 @@ FILENAME are suppressed. */) SDATA (tem3), tem2); } - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; feature = unbind_to (count, feature); } @@ -4167,7 +4223,7 @@ hash_table_user_defined_call (ptrdiff_t nargs, Lisp_Object *args, { if (!h->mutable) return Ffuncall (nargs, args); - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); record_unwind_protect_ptr (restore_mutability, h); h->mutable = false; return unbind_to (count, Ffuncall (nargs, args)); @@ -4209,6 +4265,8 @@ cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, static Lisp_Object hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { + if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (key)) + key = SYMBOL_WITH_POS_SYM (key); return make_ufixnum (XHASH (key) ^ XTYPE (key)); } @@ -4487,8 +4545,6 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) ptrdiff_t start_of_bucket, i; Lisp_Object hash_code; - if (SYMBOL_WITH_POS_P (key)) - key = SYMBOL_WITH_POS_SYM (key); hash_code = h->test.hashfn (key, h); if (hash) *hash = hash_code; @@ -4926,6 +4982,8 @@ sxhash_obj (Lisp_Object obj, int depth) hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); return SXHASH_REDUCE (hash); } + else if (symbols_with_pos_enabled && pvec_type == PVEC_SYMBOL_WITH_POS) + return sxhash_obj (XSYMBOL_WITH_POS (obj)->sym, depth + 1); else /* Others are 'equal' if they are 'eq', so take their address as hash. */ diff --git a/src/frame.c b/src/frame.c index 8aaff949ba2..8750fe4889c 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3907,6 +3907,7 @@ static const struct frame_parm_table frame_parms[] = {"z-group", SYMBOL_INDEX (Qz_group)}, {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)}, + {"alpha-background", SYMBOL_INDEX (Qalpha_background)}, #ifdef NS_IMPL_COCOA {"ns-appearance", SYMBOL_INDEX (Qns_appearance)}, {"ns-transparent-titlebar", SYMBOL_INDEX (Qns_transparent_titlebar)}, @@ -5024,6 +5025,34 @@ gui_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } } +void +gui_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + double alpha = 1.0; + + if (NILP (arg)) + alpha = 1.0; + else if (FLOATP (arg)) + { + alpha = XFLOAT_DATA (arg); + if (! (0 <= alpha && alpha <= 1.0)) + args_out_of_range (make_float (0.0), make_float (1.0)); + } + else if (FIXNUMP (arg)) + { + EMACS_INT ialpha = XFIXNUM (arg); + if (! (0 <= ialpha && ialpha <= 100)) + args_out_of_range (make_fixnum (0), make_fixnum (100)); + alpha = ialpha / 100.0; + } + else + wrong_type_argument (Qnumberp, arg); + + f->alpha_background = alpha; + + recompute_basic_faces (f); + SET_FRAME_GARBAGED (f); +} /** * gui_set_no_special_glyphs: @@ -6100,6 +6129,7 @@ syms_of_frame (void) #endif DEFSYM (Qalpha, "alpha"); + DEFSYM (Qalpha_background, "alpha-background"); DEFSYM (Qauto_lower, "auto-lower"); DEFSYM (Qauto_raise, "auto-raise"); DEFSYM (Qborder_color, "border-color"); @@ -6495,6 +6525,14 @@ making the child frame unresponsive to user actions, the default is to iconify the top level frame instead. */); iconify_child_frame = Qiconify_top_level; + DEFVAR_LISP ("frame-internal-parameters", frame_internal_parameters, + doc: /* Frame parameters specific to every frame. */); +#ifdef HAVE_X_WINDOWS + frame_internal_parameters = list4 (Qname, Qparent_id, Qwindow_id, Qouter_window_id); +#else + frame_internal_parameters = list3 (Qname, Qparent_id, Qwindow_id); +#endif + defsubr (&Sframep); defsubr (&Sframe_live_p); defsubr (&Swindow_system); diff --git a/src/frame.h b/src/frame.h index cb2f58e2611..5d5f2122fbb 100644 --- a/src/frame.h +++ b/src/frame.h @@ -637,6 +637,9 @@ struct frame Negative values mean not to change alpha. */ double alpha[2]; + /* Background opacity */ + double alpha_background; + /* Exponent for gamma correction of colors. 1/(VIEWING_GAMMA * SCREEN_GAMMA) where viewing_gamma is 0.4545 and SCREEN_GAMMA is a frame parameter. 0 means don't do gamma correction. */ @@ -1669,6 +1672,7 @@ extern void gui_set_scroll_bar_height (struct frame *, Lisp_Object, Lisp_Object) extern long gui_figure_window_size (struct frame *, Lisp_Object, bool, bool); extern void gui_set_alpha (struct frame *, Lisp_Object, Lisp_Object); +extern void gui_set_alpha_background (struct frame *, Lisp_Object, Lisp_Object); extern void gui_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object); extern void validate_x_resource_name (void); diff --git a/src/fringe.c b/src/fringe.c index 1f4dd46ec5a..4ea368d215b 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -971,7 +971,7 @@ update_window_fringes (struct window *w, bool keep_current_p) if (w->pseudo_window_p) return 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* This function could be called for redisplaying non-selected windows, in which case point has been temporarily moved to that diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 558e44d5b91..98a28af5f22 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -522,12 +522,23 @@ ftcrfont_draw (struct glyph_string *s, int from, int to, int x, int y, bool with_background) { struct frame *f = s->f; - struct face *face = s->face; struct font_info *ftcrfont_info = (struct font_info *) s->font; cairo_t *cr; cairo_glyph_t *glyphs; int len = to - from; int i; +#ifdef USE_BE_CAIRO + unsigned long be_foreground, be_background; + + if (s->hl != DRAW_CURSOR) + { + be_foreground = s->face->foreground; + be_background = s->face->background; + } + else + haiku_merge_cursor_foreground (s, &be_foreground, + &be_background); +#endif block_input (); @@ -538,12 +549,12 @@ ftcrfont_draw (struct glyph_string *s, cr = pgtk_begin_cr_clip (f); #endif #else - BView_draw_lock (FRAME_HAIKU_VIEW (f)); + /* Presumably the draw lock is already held by + haiku_draw_glyph_string. */ EmacsWindow_begin_cr_critical_section (FRAME_HAIKU_WINDOW (f)); cr = haiku_begin_cr_clip (f, s); if (!cr) { - BView_draw_unlock (FRAME_HAIKU_VIEW (f)); EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); unblock_input (); return 0; @@ -555,23 +566,21 @@ ftcrfont_draw (struct glyph_string *s, { #ifndef USE_BE_CAIRO #ifdef HAVE_X_WINDOWS - x_set_cr_source_with_gc_background (f, s->gc); + x_set_cr_source_with_gc_background (f, s->gc, s->hl != DRAW_CURSOR); #else - pgtk_set_cr_source_with_color (f, s->xgcv.background); + pgtk_set_cr_source_with_color (f, s->xgcv.background, + s->hl != DRAW_CURSOR); #endif #else - struct face *face = s->face; - - uint32_t col = s->hl == DRAW_CURSOR ? - FRAME_CURSOR_COLOR (s->f).pixel : face->background; + uint32_t col = be_background; cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, GREEN_FROM_ULONG (col) / 255.0, BLUE_FROM_ULONG (col) / 255.0); #endif s->background_filled_p = 1; - cairo_rectangle (cr, x, y - FONT_BASE (face->font), - s->width, FONT_HEIGHT (face->font)); + cairo_rectangle (cr, x, y - FONT_BASE (s->font), + s->width, FONT_HEIGHT (s->font)); cairo_fill (cr); } @@ -587,13 +596,12 @@ ftcrfont_draw (struct glyph_string *s, } #ifndef USE_BE_CAIRO #ifdef HAVE_X_WINDOWS - x_set_cr_source_with_gc_foreground (f, s->gc); + x_set_cr_source_with_gc_foreground (f, s->gc, false); #else - pgtk_set_cr_source_with_color (f, s->xgcv.foreground); + pgtk_set_cr_source_with_color (f, s->xgcv.foreground, false); #endif #else - uint32_t col = s->hl == DRAW_CURSOR ? - FRAME_OUTPUT_DATA (s->f)->cursor_fg : face->foreground; + uint32_t col = be_foreground; cairo_set_source_rgb (cr, RED_FROM_ULONG (col) / 255.0, GREEN_FROM_ULONG (col) / 255.0, @@ -610,7 +618,6 @@ ftcrfont_draw (struct glyph_string *s, #else haiku_end_cr_clip (cr); EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); - BView_draw_unlock (FRAME_HAIKU_VIEW (f)); #endif unblock_input (); diff --git a/src/gtkutil.c b/src/gtkutil.c index eb148560620..d4726014c01 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -76,6 +76,23 @@ typedef struct pgtk_output xp_output; #define XG_TEXT_OPEN GTK_STOCK_OPEN #endif +#ifdef HAVE_GTK3 +static void emacs_menu_bar_get_preferred_width (GtkWidget *, gint *, gint *); +static GType emacs_menu_bar_get_type (void); + +typedef struct _EmacsMenuBar +{ + GtkMenuBar parent; +} EmacsMenuBar; + +typedef struct _EmacsMenuBarClass +{ + GtkMenuBarClass parent; +} EmacsMenuBarClass; + +G_DEFINE_TYPE (EmacsMenuBar, emacs_menu_bar, GTK_TYPE_MENU_BAR) +#endif + #ifndef HAVE_PGTK static void xg_im_context_commit (GtkIMContext *, gchar *, gpointer); static void xg_im_context_preedit_changed (GtkIMContext *, gpointer); @@ -83,6 +100,10 @@ static void xg_im_context_preedit_end (GtkIMContext *, gpointer); static bool xg_widget_key_press_event_cb (GtkWidget *, GdkEvent *, gpointer); #endif +#if GTK_CHECK_VERSION (3, 10, 0) +static void xg_widget_style_updated (GtkWidget *, gpointer); +#endif + #ifndef HAVE_GTK3 #ifdef HAVE_FREETYPE @@ -124,6 +145,45 @@ bool xg_gtk_initialized; /* Used to make sure xwidget calls are possible static GtkWidget * xg_get_widget_from_map (ptrdiff_t idx); + +#ifdef HAVE_GTK3 +static void +emacs_menu_bar_init (EmacsMenuBar *menu_bar) +{ + return; +} + +static void +emacs_menu_bar_class_init (EmacsMenuBarClass *klass) +{ + GtkWidgetClass *widget_class; + + widget_class = GTK_WIDGET_CLASS (klass); + widget_class->get_preferred_width = emacs_menu_bar_get_preferred_width; +} + +static void +emacs_menu_bar_get_preferred_width (GtkWidget *widget, + gint *minimum, gint *natural) +{ + GtkWidgetClass *widget_class; + + widget_class = GTK_WIDGET_CLASS (emacs_menu_bar_parent_class); + widget_class->get_preferred_width (widget, minimum, natural); + + if (minimum) + *minimum = 0; +} + +static GtkWidget * +emacs_menu_bar_new (void) +{ + return GTK_WIDGET (g_object_new (emacs_menu_bar_get_type (), NULL)); +} + +#endif + + /*********************************************************************** Display handling functions ***********************************************************************/ @@ -1166,7 +1226,11 @@ xg_frame_set_char_size (struct frame *f, int width, int height) else if (FRAME_PARENT_FRAME (f) && FRAME_VISIBLE_P (f)) { was_visible = true; +#ifndef HAVE_PGTK hide_child_frame = EQ (x_gtk_resize_child_frames, Qhide); +#else + hide_child_frame = false; +#endif if (outer_width != gwidth || outer_height != gheight) { @@ -1469,6 +1533,12 @@ xg_create_frame_widgets (struct frame *f) gtk_widget_add_events (wtop, GDK_ALL_EVENTS_MASK); #endif + gtk_widget_set_app_paintable (wtop, f->alpha_background != 1.0); +#if GTK_CHECK_VERSION (3, 10, 0) + g_signal_connect (G_OBJECT (wtop), "style-updated", + G_CALLBACK (xg_widget_style_updated), f); +#endif + /* gtk_window_set_has_resize_grip is a Gtk+ 3.0 function but Ubuntu has backported it to Gtk+ 2.0 and they add the resize grip for Gtk+ 2.0 applications also. But it has a bug that makes Emacs loop @@ -1587,6 +1657,21 @@ xg_create_frame_widgets (struct frame *f) #endif | GDK_VISIBILITY_NOTIFY_MASK); + GdkScreen *screen = gtk_widget_get_screen (wtop); + +#if !defined HAVE_PGTK + GdkVisual *visual = gdk_x11_screen_lookup_visual (screen, + XVisualIDFromVisual (FRAME_X_VISUAL (f))); + + if (!visual) + emacs_abort (); +#else + GdkVisual *visual = gdk_screen_get_rgba_visual (screen); +#endif + + gtk_widget_set_visual (wtop, visual); + gtk_widget_set_visual (wfixed, visual); + #ifndef HAVE_PGTK /* Must realize the windows so the X window gets created. It is used by callers of this function. */ @@ -1651,7 +1736,6 @@ xg_create_frame_widgets (struct frame *f) #endif { - GdkScreen *screen = gtk_widget_get_screen (wtop); GtkSettings *gs = gtk_settings_get_for_screen (screen); /* Only connect this signal once per screen. */ if (! g_signal_handler_find (G_OBJECT (gs), @@ -1903,12 +1987,12 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) else if (win_gravity == StaticGravity) size_hints.win_gravity = GDK_GRAVITY_STATIC; - if (x_gtk_use_window_move) - { - if (flags & PPosition) hint_flags |= GDK_HINT_POS; - if (flags & USPosition) hint_flags |= GDK_HINT_USER_POS; - if (flags & USSize) hint_flags |= GDK_HINT_USER_SIZE; - } + if (flags & PPosition) + hint_flags |= GDK_HINT_POS; + if (flags & USPosition) + hint_flags |= GDK_HINT_USER_POS; + if (flags & USSize) + hint_flags |= GDK_HINT_USER_SIZE; if (user_position) { @@ -2354,7 +2438,7 @@ xg_maybe_add_timer (gpointer data) static int xg_dialog_run (struct frame *f, GtkWidget *w) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct xg_dialog_data dd; xg_set_screen (w, f); @@ -3259,7 +3343,12 @@ create_menus (widget_value *data, } else { +#ifndef HAVE_GTK3 wmenu = gtk_menu_bar_new (); +#else + wmenu = emacs_menu_bar_new (); +#endif + #ifdef HAVE_PGTK g_signal_connect (G_OBJECT (wmenu), "button-press-event", G_CALLBACK (menu_bar_button_pressed_cb), f); @@ -4012,6 +4101,7 @@ xg_update_frame_menubar (struct frame *f) { xp_output *x = f->output_data.xp; GtkRequisition req; + int scale = xg_get_scale (f); if (!x->menubar_widget || gtk_widget_get_mapped (x->menubar_widget)) return; @@ -4029,9 +4119,21 @@ xg_update_frame_menubar (struct frame *f) gtk_widget_show_all (x->menubar_widget); gtk_widget_get_preferred_size (x->menubar_widget, NULL, &req); req.height *= xg_get_scale (f); - if (FRAME_MENUBAR_HEIGHT (f) != req.height) + +#if !defined HAVE_PGTK && defined HAVE_GTK3 + if (FRAME_DISPLAY_INFO (f)->n_planes == 32) { - FRAME_MENUBAR_HEIGHT (f) = req.height; + GdkScreen *screen = gtk_widget_get_screen (x->menubar_widget); + GdkVisual *visual = gdk_screen_get_system_visual (screen); + + gtk_widget_realize (x->menubar_widget); + gtk_widget_set_visual (x->menubar_widget, visual); + } +#endif + + if (FRAME_MENUBAR_HEIGHT (f) != (req.height * scale)) + { + FRAME_MENUBAR_HEIGHT (f) = req.height * scale; adjust_frame_size (f, -1, -1, 2, 0, Qmenu_bar_lines); } unblock_input (); @@ -4819,9 +4921,8 @@ xg_event_is_for_scrollbar (struct frame *f, const EVENT *event) && event->type == GenericEvent && (event->xgeneric.extension == FRAME_DISPLAY_INFO (f)->xi2_opcode) - && ((event->xgeneric.evtype == XI_ButtonPress - && xev->detail < 4) - || (event->xgeneric.evtype == XI_Motion))) + && (event->xgeneric.evtype == XI_ButtonPress + && xev->detail < 4)) || (event->type == ButtonPress && event->xbutton.button < 4))) #else @@ -4853,19 +4954,7 @@ xg_event_is_for_scrollbar (struct frame *f, const EVENT *event) #else gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL); #endif -#ifndef HAVE_XINPUT2 retval = gwin != gtk_widget_get_window (f->output_data.xp->edit_widget); -#else - retval = (gwin - && (gwin - != gtk_widget_get_window (f->output_data.xp->edit_widget))); -#endif -#ifdef HAVE_XINPUT2 - GtkWidget *grab = gtk_grab_get_current (); - if (event->type == GenericEvent - && event->xgeneric.evtype == XI_Motion) - retval = retval || (grab && GTK_IS_SCROLLBAR (grab)); -#endif } #ifdef HAVE_XINPUT2 else if (f && ((FRAME_DISPLAY_INFO (f)->supports_xi2 @@ -5471,6 +5560,7 @@ xg_update_tool_bar_sizes (struct frame *f) GtkRequisition req; int nl = 0, nr = 0, nt = 0, nb = 0; GtkWidget *top_widget = x->toolbar_widget; + int scale = xg_get_scale (f); gtk_widget_get_preferred_size (GTK_WIDGET (top_widget), NULL, &req); if (x->toolbar_in_hbox) @@ -5479,8 +5569,10 @@ xg_update_tool_bar_sizes (struct frame *f) gtk_container_child_get (GTK_CONTAINER (x->hbox_widget), top_widget, "position", &pos, NULL); - if (pos == 0) nl = req.width; - else nr = req.width; + if (pos == 0) + nl = req.width * scale; + else + nr = req.width * scale; } else { @@ -5488,8 +5580,10 @@ xg_update_tool_bar_sizes (struct frame *f) gtk_container_child_get (GTK_CONTAINER (x->vbox_widget), top_widget, "position", &pos, NULL); - if (pos == 0 || (pos == 1 && x->menubar_widget)) nt = req.height; - else nb = req.height; + if (pos == 0 || (pos == 1 && x->menubar_widget)) + nt = req.height * scale; + else + nb = req.height * scale; } if (nl != FRAME_TOOLBAR_LEFT_WIDTH (f) @@ -6062,29 +6156,29 @@ xg_im_context_commit (GtkIMContext *imc, gchar *str, { struct frame *f = user_data; struct input_event ie; - gunichar *ucs4_str; - ucs4_str = g_utf8_to_ucs4_fast (str, -1, NULL); + EVENT_INIT (ie); + /* This used to use g_utf8_to_ucs4_fast, which led to bad results + when STR wasn't actually a UTF-8 string, which some input method + modules commit. */ - if (!ucs4_str) - return; + ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + ie.arg = decode_string_utf_8 (Qnil, str, strlen (str), + Qnil, false, Qnil, Qnil); - for (gunichar *c = ucs4_str; *c; c++) - { - EVENT_INIT (ie); - ie.kind = (SINGLE_BYTE_CHAR_P (*c) - ? ASCII_KEYSTROKE_EVENT - : MULTIBYTE_CHAR_KEYSTROKE_EVENT); - ie.arg = Qnil; - ie.code = *c; - XSETFRAME (ie.frame_or_window, f); - ie.modifiers = 0; - ie.timestamp = 0; + /* STR is invalid and not really encoded in UTF-8. */ + if (NILP (ie.arg)) + ie.arg = build_unibyte_string (str); - kbd_buffer_store_event (&ie); - } + Fput_text_property (make_fixnum (0), + make_fixnum (SCHARS (ie.arg)), + Qcoding, Qt, ie.arg); - g_free (ucs4_str); + XSETFRAME (ie.frame_or_window, f); + ie.modifiers = 0; + ie.timestamp = 0; + + kbd_buffer_store_event (&ie); } static void @@ -6358,8 +6452,10 @@ xg_filter_key (struct frame *frame, XEvent *xkey) NULL, NULL, &consumed); xg_add_virtual_mods (dpyinfo, &xg_event->key); xg_event->key.state &= ~consumed; +#if GTK_CHECK_VERSION (3, 6, 0) xg_event->key.is_modifier = gdk_x11_keymap_key_is_modifier (keymap, xg_event->key.hardware_keycode); +#endif } #endif @@ -6371,4 +6467,28 @@ xg_filter_key (struct frame *frame, XEvent *xkey) return result; } #endif + +#if GTK_CHECK_VERSION (3, 10, 0) +static void +xg_widget_style_updated (GtkWidget *widget, gpointer user_data) +{ + struct frame *f = user_data; + + if (f->alpha_background < 1.0) + { +#ifndef HAVE_PGTK + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + NULL, 0); +#else + if (FRAME_GTK_OUTER_WIDGET (f) + && gtk_widget_get_realized (FRAME_GTK_OUTER_WIDGET (f))) + gdk_window_set_opaque_region (gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)), + NULL); +#endif + } +} +#endif #endif /* USE_GTK */ diff --git a/src/haiku_draw_support.cc b/src/haiku_draw_support.cc index 270a619b89b..f8df298958f 100644 --- a/src/haiku_draw_support.cc +++ b/src/haiku_draw_support.cc @@ -479,10 +479,9 @@ BView_SetHighColorForVisibleBell (void *view, uint32_t color) } void -BView_FillRectangleForVisibleBell (void *view, int x, int y, int width, int height) +BView_InvertRect (void *view, int x, int y, int width, int height) { - BView *vw = (BView *) view; - BRect rect = BRect (x, y, x + width - 1, y + height - 1); + BView *vw = get_view (view); - vw->FillRect (rect); + vw->InvertRect (BRect (x, y, x + width - 1, y + height - 1)); } diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index e6d21c28fe5..549c54d8649 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -68,7 +68,11 @@ estimate_font_ascii (BFont *font, int *max_width, *min_width = min; *max_width = max; - *avg_width = total / count; + + if (count) + *avg_width = total / count; + else + *avg_width = 0; } void @@ -220,7 +224,9 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) if (pattern->weight == -1) pattern->weight = HAIKU_REGULAR; } - else if (token && !strcmp (token, "SemiBold")) + else if (token && (!strcmp (token, "SemiBold") + /* Likewise, this was reported by a user. */ + || !strcmp (token, "Semibold"))) pattern->weight = HAIKU_SEMI_BOLD; else if (token && !strcmp (token, "Bold")) pattern->weight = HAIKU_BOLD; @@ -615,3 +621,27 @@ BFont_string_width (void *font, const char *utf8) { return ((BFont *) font)->StringWidth (utf8); } + +haiku_font_family_or_style * +be_list_font_families (size_t *length) +{ + int32 families = count_font_families (); + haiku_font_family_or_style *array; + int32 idx; + uint32 flags; + + array = (haiku_font_family_or_style *) malloc (sizeof *array * families); + + if (!array) + return NULL; + + for (idx = 0; idx < families; ++idx) + { + if (get_font_family (idx, &array[idx], &flags) != B_OK) + array[idx][0] = '\0'; + } + + *length = families; + + return array; +} diff --git a/src/haiku_io.c b/src/haiku_io.c index cb7750634cf..cade69f3387 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -36,6 +36,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ Emacs. */ port_id port_application_to_emacs; +/* The port used to send popup menu messages from the application + thread to Emacs. */ +port_id port_popup_menu_to_emacs; + void haiku_io_init (void) { @@ -90,6 +94,10 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_refs_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); } emacs_abort (); @@ -98,9 +106,11 @@ haiku_len (enum haiku_event_type type) /* Read the size of the next message into len, returning -1 if the query fails or there is no next message. */ void -haiku_read_size (ssize_t *len) +haiku_read_size (ssize_t *len, bool popup_menu_p) { - port_id from = port_application_to_emacs; + port_id from = (popup_menu_p + ? port_popup_menu_to_emacs + : port_application_to_emacs); ssize_t size; size = port_buffer_size_etc (from, B_TIMEOUT, 0); @@ -129,13 +139,16 @@ haiku_read (enum haiku_event_type *type, void *buf, ssize_t len) } /* The same as haiku_read, but time out after TIMEOUT microseconds. + POPUP_MENU_P means to read from the popup menu port instead. 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) + time_t timeout, bool popup_menu_p) { int32 typ; - port_id from = port_application_to_emacs; + port_id from = (popup_menu_p + ? port_popup_menu_to_emacs + : port_application_to_emacs); block_input (); if (read_port_etc (from, &typ, buf, len, @@ -165,9 +178,12 @@ haiku_write (enum haiku_event_type type, void *buf) } int -haiku_write_without_signal (enum haiku_event_type type, void *buf) +haiku_write_without_signal (enum haiku_event_type type, void *buf, + bool popup_menu_p) { - port_id to = port_application_to_emacs; + port_id to = (popup_menu_p + ? port_popup_menu_to_emacs + : port_application_to_emacs); if (write_port (to, (int32_t) type, buf, haiku_len (type)) < B_OK) return -1; @@ -193,7 +209,7 @@ record_c_unwind_protect_from_cxx (void (*fn) (void *), void *r) } /* SPECPDL_IDX that is safe from C++ code. */ -ptrdiff_t +specpdl_ref c_specpdl_idx_from_cxx (void) { return SPECPDL_INDEX (); @@ -201,7 +217,7 @@ c_specpdl_idx_from_cxx (void) /* unbind_to (IDX, Qnil), but safe from C++ code. */ void -c_unbind_to_nil_from_cxx (ptrdiff_t idx) +c_unbind_to_nil_from_cxx (specpdl_ref idx) { unbind_to (idx, Qnil); } diff --git a/src/haiku_select.cc b/src/haiku_select.cc index d39000d8bbe..011ad58036f 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -29,9 +29,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ static BClipboard *primary = NULL; static BClipboard *secondary = NULL; static BClipboard *system_clipboard = NULL; -static unsigned long count_clipboard = 0; -static unsigned long count_primary = 0; -static unsigned long count_secondary = 0; +static int64 count_clipboard = -1; +static int64 count_primary = -1; +static int64 count_secondary = -1; int selection_state_flag; @@ -176,8 +176,8 @@ BClipboard_set_system_data (const char *type, const char *data, if (!system_clipboard) return; - BClipboard_set_data (system_clipboard, type, data, len, clear); count_clipboard = system_clipboard->SystemCount (); + BClipboard_set_data (system_clipboard, type, data, len, clear); } void @@ -187,8 +187,8 @@ BClipboard_set_primary_selection_data (const char *type, const char *data, if (!primary) return; - BClipboard_set_data (primary, type, data, len, clear); count_primary = primary->SystemCount (); + BClipboard_set_data (primary, type, data, len, clear); } void @@ -198,8 +198,8 @@ BClipboard_set_secondary_selection_data (const char *type, const char *data, if (!secondary) return; - BClipboard_set_data (secondary, type, data, len, clear); count_secondary = secondary->SystemCount (); + BClipboard_set_data (secondary, type, data, len, clear); } void @@ -229,22 +229,25 @@ BClipboard_secondary_targets (char **buf, int len) bool BClipboard_owns_clipboard (void) { - return (count_clipboard - == system_clipboard->SystemCount ()); + return (count_clipboard >= 0 + && (count_clipboard + 1 + == system_clipboard->SystemCount ())); } bool BClipboard_owns_primary (void) { - return (count_primary - == primary->SystemCount ()); + return (count_primary >= 0 + && (count_primary + 1 + == primary->SystemCount ())); } bool BClipboard_owns_secondary (void) { - return (count_secondary - == secondary->SystemCount ()); + return (count_secondary >= 0 + && (count_secondary + 1 + == secondary->SystemCount ())); } void diff --git a/src/haiku_support.cc b/src/haiku_support.cc index ae2736110ec..4f6a96568cb 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -114,6 +114,9 @@ static BLocker child_frame_lock; static BLocker movement_locker; +static BMessage volatile *popup_track_message; +static int32 volatile alert_popup_value; + /* 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 *); @@ -137,6 +140,32 @@ gui_abort (const char *msg) emacs_abort (); } +struct be_popup_menu_data +{ + int x, y; + BPopUpMenu *menu; +}; + +static int32 +be_popup_menu_thread_entry (void *thread_data) +{ + struct be_popup_menu_data *data; + struct haiku_dummy_event dummy; + BMenuItem *it; + + data = (struct be_popup_menu_data *) thread_data; + + it = data->menu->Go (BPoint (data->x, data->y)); + + if (it) + popup_track_message = it->Message (); + else + popup_track_message = NULL; + + haiku_write (DUMMY_EVENT, &dummy); + return 0; +} + /* Convert a raw character RAW produced by the keycode KEY into a key symbol and place it in KEYSYM. @@ -405,9 +434,13 @@ public: int shown_flag = 0; volatile int was_shown_p = 0; bool menu_bar_active_p = false; - window_look pre_override_redirect_style; + bool override_redirect_p = false; + window_look pre_override_redirect_look; window_feel pre_override_redirect_feel; uint32 pre_override_redirect_workspaces; + pthread_mutex_t menu_update_mutex = PTHREAD_MUTEX_INITIALIZER; + pthread_cond_t menu_update_cv = PTHREAD_COND_INITIALIZER; + bool menu_updated_p = false; EmacsWindow () : BWindow (BRect (0, 0, 0, 0), "", B_TITLED_WINDOW_LOOK, B_NORMAL_WINDOW_FEEL, B_NO_SERVER_SIDE_WINDOW_MODIFIERS) @@ -433,6 +466,9 @@ public: if (this->parent) UnparentAndUnlink (); child_frame_lock.Unlock (); + + pthread_cond_destroy (&menu_update_cv); + pthread_mutex_destroy (&menu_update_mutex); } void @@ -547,7 +583,6 @@ public: fullscreen_p = 0; MakeFullscreen (1); } - this->Sync (); window->LinkChild (this); child_frame_lock.Unlock (); @@ -650,8 +685,10 @@ public: else if (msg->GetPointer ("menuptr")) { struct haiku_menu_bar_select_event rq; + rq.window = this; rq.ptr = (void *) msg->GetPointer ("menuptr"); + haiku_write (MENU_BAR_SELECT_EVENT, &rq); } else if (msg->what == 'FPSE' @@ -805,9 +842,36 @@ public: MenusBeginning () { struct haiku_menu_bar_state_event rq; + int lock_count = 0; + thread_id current_thread = find_thread (NULL); + thread_id window_thread = Thread (); rq.window = this; + rq.no_lock = false; + + if (window_thread != current_thread) + rq.no_lock = true; haiku_write (MENU_BAR_OPEN, &rq); + + if (!rq.no_lock) + { + while (IsLocked ()) + { + ++lock_count; + UnlockLooper (); + } + pthread_mutex_lock (&menu_update_mutex); + while (!menu_updated_p) + pthread_cond_wait (&menu_update_cv, + &menu_update_mutex); + menu_updated_p = false; + pthread_mutex_unlock (&menu_update_mutex); + for (; lock_count; --lock_count) + { + if (!LockLooper ()) + gui_abort ("Failed to lock after cv signal denoting menu update"); + } + } menu_bar_active_p = true; } @@ -850,7 +914,6 @@ public: DoMove (f); child_frame_lock.Unlock (); - Sync (); BWindow::FrameMoved (newPosition); } @@ -984,8 +1047,8 @@ public: zoomed_p = 0; EmacsMoveTo (pre_zoom_rect.left, pre_zoom_rect.top); - ResizeTo (BE_RECT_WIDTH (pre_zoom_rect), - BE_RECT_HEIGHT (pre_zoom_rect)); + ResizeTo (BE_RECT_WIDTH (pre_zoom_rect) - 1, + BE_RECT_HEIGHT (pre_zoom_rect) - 1); } void @@ -1065,15 +1128,15 @@ public: int w, h; EmacsMoveTo (0, 0); GetParentWidthHeight (&w, &h); - ResizeTo (w, h); + ResizeTo (w - 1, h - 1); } else { flags &= ~(B_NOT_MOVABLE | B_NOT_ZOOMABLE); EmacsMoveTo (pre_fullscreen_rect.left, pre_fullscreen_rect.top); - ResizeTo (BE_RECT_WIDTH (pre_fullscreen_rect), - BE_RECT_HEIGHT (pre_fullscreen_rect)); + ResizeTo (BE_RECT_WIDTH (pre_fullscreen_rect) - 1, + BE_RECT_HEIGHT (pre_fullscreen_rect) - 1); } SetFlags (flags); } @@ -1105,12 +1168,32 @@ public: haiku_write (MENU_BAR_RESIZE, &rq); BMenuBar::FrameResized (newWidth, newHeight); } + + void + MouseMoved (BPoint point, uint32 transit, const BMessage *msg) + { + struct haiku_menu_bar_left_event rq; + + if (transit == B_EXITED_VIEW) + { + rq.x = std::lrint (point.x); + rq.y = std::lrint (point.y); + rq.window = this->Window (); + + if (movement_locker.Lock ()) + { + haiku_write (MENU_BAR_LEFT, &rq); + movement_locker.Unlock (); + } + } + + BMenuBar::MouseMoved (point, transit, msg); + } }; class EmacsView : public BView { public: - uint32_t visible_bell_color = 0; uint32_t previous_buttons = 0; int looper_locked_count = 0; BRegion sb_region; @@ -1121,6 +1204,7 @@ public: #ifdef USE_BE_CAIRO cairo_surface_t *cr_surface = NULL; + cairo_t *cr_context = NULL; BLocker cr_surface_lock; #endif @@ -1152,8 +1236,10 @@ public: gui_abort ("Could not lock cr surface during detachment"); if (!cr_surface) gui_abort ("Trying to detach window cr surface when none exists"); + cairo_destroy (cr_context); cairo_surface_destroy (cr_surface); cr_surface = NULL; + cr_context = NULL; cr_surface_lock.Unlock (); } @@ -1173,6 +1259,10 @@ public: offscreen_draw_bitmap_1->BytesPerRow ()); if (!cr_surface) gui_abort ("Cr surface allocation failed for double-buffered view"); + + cr_context = cairo_create (cr_surface); + if (!cr_context) + gui_abort ("cairo_t allocation failed for double-buffered view"); cr_surface_lock.Unlock (); } #endif @@ -1243,29 +1333,11 @@ public: } void - Pulse (void) - { - visible_bell_color = 0; - SetFlags (Flags () & ~B_PULSE_NEEDED); - Window ()->SetPulseRate (0); - Invalidate (); - } - - void Draw (BRect expose_bounds) { struct haiku_expose_event rq; EmacsWindow *w = (EmacsWindow *) Window (); - if (visible_bell_color > 0) - { - PushState (); - BView_SetHighColorForVisibleBell (this, visible_bell_color); - FillRect (Frame ()); - PopState (); - return; - } - if (w->shown_flag && offscreen_draw_view) { PushState (); @@ -1302,18 +1374,6 @@ public: } void - DoVisibleBell (uint32_t color) - { - if (!LockLooper ()) - gui_abort ("Failed to lock looper during visible bell"); - visible_bell_color = color | (255 << 24); - SetFlags (Flags () | B_PULSE_NEEDED); - Window ()->SetPulseRate (100 * 1000); - Invalidate (); - UnlockLooper (); - } - - void FlipBuffers (void) { if (!LockLooper ()) @@ -1574,6 +1634,7 @@ class EmacsMenuItem : public BMenuItem { public: int menu_bar_id = -1; + void *menu_ptr = NULL; void *wind_ptr = NULL; char *key = NULL; char *help = NULL; @@ -1615,11 +1676,17 @@ public: if (key) { - BRect r = menu->Frame (); - int w = menu->StringWidth (key); + BRect r = Frame (); + int w; + + menu->PushState (); + menu->ClipToRect (r); + menu->SetFont (be_plain_font); + w = menu->StringWidth (key); menu->MovePenTo (BPoint (BE_RECT_WIDTH (r) - w - 4, menu->PenLocation ().y)); menu->DrawString (key); + menu->PopState (); } } @@ -1635,17 +1702,34 @@ public: Highlight (bool highlight_p) { struct haiku_menu_bar_help_event rq; + struct haiku_dummy_event dummy; + BMenu *menu = Menu (); + BRect r; + BPoint pt; + uint32 buttons; if (help) - { - Menu ()->SetToolTip (highlight_p ? help : NULL); - } - else if (menu_bar_id >= 0) + menu->SetToolTip (highlight_p ? help : NULL); + else { rq.window = wind_ptr; rq.mb_idx = highlight_p ? menu_bar_id : -1; + rq.highlight_p = highlight_p; + rq.data = menu_ptr; + + r = Frame (); + menu->GetMouse (&pt, &buttons); - haiku_write (MENU_BAR_HELP_EVENT, &rq); + if (!highlight_p || r.Contains (pt)) + { + if (menu_bar_id > 0) + haiku_write (MENU_BAR_HELP_EVENT, &rq); + else + { + haiku_write_without_signal (MENU_BAR_HELP_EVENT, &rq, true); + haiku_write (DUMMY_EVENT, &dummy); + } + } } BMenuItem::Highlight (highlight_p); @@ -1865,7 +1949,7 @@ BWindow_retitle (void *window, const char *title) void BWindow_resize (void *window, int width, int height) { - ((BWindow *) window)->ResizeTo (width, height); + ((BWindow *) window)->ResizeTo (width - 1, height - 1); } /* Activate WINDOW, making it the subject of keyboard focus and @@ -1941,7 +2025,8 @@ BCursor_create_grab (void) void BCursor_delete (void *cursor) { - delete (BCursor *) cursor; + if (cursor) + delete (BCursor *) cursor; } void @@ -2122,21 +2207,40 @@ BView_mouse_moved (void *view, int x, int y, uint32_t transit) } } -/* Import BITS into BITMAP using the B_GRAY1 colorspace. */ +/* Import fringe bitmap (short array, low bit rightmost) BITS into + BITMAP using the B_GRAY1 colorspace. */ void -BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h) +BBitmap_import_fringe_bitmap (void *bitmap, unsigned short *bits, int wd, int h) { BBitmap *bmp = (BBitmap *) bitmap; unsigned char *data = (unsigned char *) bmp->Bits (); - unsigned short *bts = (unsigned short *) bits; + int i; - for (int i = 0; i < (h * (wd / 8)); i++) + for (i = 0; i < h; i++) { - *((unsigned short *) data) = bts[i]; + if (wd <= 8) + data[0] = bits[i] & 0xff; + else + { + data[1] = bits[i] & 0xff; + data[0] = bits[i] >> 8; + } + data += bmp->BytesPerRow (); } } +void +BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h) +{ + BBitmap *bmp = (BBitmap *) bitmap; + + if (wd % 8) + wd += 8 - (wd % 8); + + bmp->ImportBits (bits, wd / 8 * h, wd / 8, 0, B_GRAY1); +} + /* Make a scrollbar at X, Y known to the view VIEW. */ void BView_publish_scroll_bar (void *view, int x, int y, int width, int height) @@ -2210,13 +2314,24 @@ BView_convert_from_screen (void *view, int *x, int *y) void BWindow_change_decoration (void *window, int decorate_p) { - BWindow *w = (BWindow *) window; + EmacsWindow *w = (EmacsWindow *) window; if (!w->LockLooper ()) gui_abort ("Failed to lock window while changing its decorations"); - if (decorate_p) - w->SetLook (B_TITLED_WINDOW_LOOK); + + if (!w->override_redirect_p) + { + if (decorate_p) + w->SetLook (B_TITLED_WINDOW_LOOK); + else + w->SetLook (B_NO_BORDER_WINDOW_LOOK); + } else - w->SetLook (B_NO_BORDER_WINDOW_LOOK); + { + if (decorate_p) + w->pre_override_redirect_look = B_TITLED_WINDOW_LOOK; + else + w->pre_override_redirect_look = B_NO_BORDER_WINDOW_LOOK; + } w->UnlockLooper (); } @@ -2314,6 +2429,7 @@ BMenu_add_item (void *menu, const char *label, void *ptr, bool enabled_p, it->menu_bar_id = (intptr_t) ptr; it->wind_ptr = mbw_ptr; } + it->menu_ptr = ptr; if (ptr) msg->AddPointer ("menuptr", ptr); m->AddItem (it); @@ -2358,20 +2474,106 @@ BMenu_new_menu_bar_submenu (void *menu, const char *label) data of the selected item (if one exists), or NULL. X, Y should be in the screen coordinate system. */ void * -BMenu_run (void *menu, int x, int y) +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), + void *run_help_callback_data) { BPopUpMenu *mn = (BPopUpMenu *) menu; + enum haiku_event_type type; + void *buf; + void *ptr = NULL; + struct be_popup_menu_data data; + struct object_wait_info infos[2]; + struct haiku_menu_bar_help_event *event; + BMessage *msg; + ssize_t stat; + + block_input_function (); + port_popup_menu_to_emacs = create_port (1800, "popup menu port"); + data.x = x; + data.y = y; + data.menu = mn; + unblock_input_function (); + + if (port_popup_menu_to_emacs < B_OK) + return NULL; + + block_input_function (); mn->SetRadioMode (0); - BMenuItem *it = mn->Go (BPoint (x, y)); - if (it) + buf = alloca (200); + + infos[0].object = port_popup_menu_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = spawn_thread (be_popup_menu_thread_entry, + "Menu tracker", B_DEFAULT_MEDIA_PRIORITY, + (void *) &data); + infos[1].type = B_OBJECT_TYPE_THREAD; + infos[1].events = B_EVENT_INVALID; + unblock_input_function (); + + if (infos[1].object < B_OK) { - BMessage *mg = it->Message (); - if (mg) - return (void *) mg->GetPointer ("menuptr"); - else - return NULL; + block_input_function (); + delete_port (port_popup_menu_to_emacs); + unblock_input_function (); + return NULL; + } + + block_input_function (); + resume_thread (infos[1].object); + unblock_input_function (); + + while (true) + { + process_pending_signals_function (); + + if ((stat = wait_for_objects_etc ((object_wait_info *) &infos, 2, + B_RELATIVE_TIMEOUT, 10000)) < B_OK) + { + if (stat == B_INTERRUPTED || stat == B_TIMED_OUT) + continue; + else + gui_abort ("Failed to wait for popup"); + } + + if (infos[0].events & B_EVENT_READ) + { + if (!haiku_read_with_timeout (&type, buf, 200, 1000000, true)) + { + switch (type) + { + case MENU_BAR_HELP_EVENT: + event = (struct haiku_menu_bar_help_event *) buf; + run_help_callback (event->highlight_p + ? event->data + : NULL, run_help_callback_data); + break; + default: + gui_abort ("Unknown popup menu event"); + } + } + } + + if (infos[1].events & B_EVENT_INVALID) + { + block_input_function (); + msg = (BMessage *) popup_track_message; + if (popup_track_message) + ptr = (void *) msg->GetPointer ("menuptr"); + + delete_port (port_popup_menu_to_emacs); + unblock_input_function (); + return ptr; + } + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_INVALID; } - return NULL; } /* Delete the entire menu hierarchy of MENU, and then delete MENU @@ -2484,12 +2686,83 @@ BAlert_add_button (void *alert, const char *text) return al->ButtonAt (al->CountButtons () - 1); } +/* Make sure the leftmost button is grouped to the left hand side of + the alert. */ +void +BAlert_set_offset_spacing (void *alert) +{ + BAlert *al = (BAlert *) alert; + + al->SetButtonSpacing (B_OFFSET_SPACING); +} + +static int32 +be_alert_thread_entry (void *thread_data) +{ + BAlert *alert = (BAlert *) thread_data; + int32 value; + + if (alert->LockLooper ()) + value = alert->Go (); + else + value = -1; + + alert_popup_value = value; + return 0; +} + /* Run ALERT, returning the number of the button that was selected, or -1 if no button was selected before the alert was closed. */ -int32_t -BAlert_go (void *alert) +int32 +BAlert_go (void *alert, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void)) { - return ((BAlert *) alert)->Go (); + struct object_wait_info infos[2]; + ssize_t stat; + BAlert *alert_object = (BAlert *) alert; + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + block_input_function (); + /* Alerts are created locked, just like other windows. */ + alert_object->UnlockLooper (); + infos[1].object = spawn_thread (be_alert_thread_entry, + "Popup tracker", + B_DEFAULT_MEDIA_PRIORITY, + alert); + infos[1].type = B_OBJECT_TYPE_THREAD; + infos[1].events = B_EVENT_INVALID; + unblock_input_function (); + + if (infos[1].object < B_OK) + return -1; + + block_input_function (); + resume_thread (infos[1].object); + unblock_input_function (); + + while (true) + { + stat = wait_for_objects ((object_wait_info *) &infos, 2); + + if (stat == B_INTERRUPTED) + continue; + else if (stat < B_OK) + gui_abort ("Failed to wait for popup dialog"); + + if (infos[1].events & B_EVENT_INVALID) + return alert_popup_value; + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_INVALID; + } } /* Enable or disable BUTTON depending on ENABLED_P. */ @@ -2785,7 +3058,7 @@ be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int void (*unblock_input_function) (void), void (*maybe_quit_function) (void)) { - ptrdiff_t idx = c_specpdl_idx_from_cxx (); + specpdl_ref idx = c_specpdl_idx_from_cxx (); /* setjmp/longjmp is UB with automatic objects. */ block_input_function (); BWindow *w = (BWindow *) window; @@ -2825,7 +3098,7 @@ be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int enum haiku_event_type type; char *ptr = NULL; - if (!haiku_read_with_timeout (&type, buf, 200, 1000000)) + if (!haiku_read_with_timeout (&type, buf, 200, 1000000, false)) { block_input_function (); if (type != FILE_PANEL_EVENT) @@ -2839,7 +3112,7 @@ be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int ssize_t b_s; block_input_function (); - haiku_read_size (&b_s); + haiku_read_size (&b_s, false); if (!b_s || ptr || panel->Window ()->IsHidden ()) { c_unbind_to_nil_from_cxx (idx); @@ -2860,14 +3133,6 @@ be_app_quit (void) } } -/* Temporarily fill VIEW with COLOR. */ -void -EmacsView_do_visible_bell (void *view, uint32_t color) -{ - EmacsView *vw = (EmacsView *) view; - vw->DoVisibleBell (color); -} - /* Zoom WINDOW. */ void BWindow_zoom (void *window) @@ -3003,12 +3268,12 @@ BView_show_tooltip (void *view) #ifdef USE_BE_CAIRO -/* Return VIEW's cairo surface. */ -cairo_surface_t * -EmacsView_cairo_surface (void *view) +/* Return VIEW's cairo context. */ +cairo_t * +EmacsView_cairo_context (void *view) { EmacsView *vw = (EmacsView *) view; - return vw->cr_surface; + return vw->cr_context; } /* Transfer each clip rectangle in VIEW to the cairo context @@ -3157,9 +3422,6 @@ be_use_subpixel_antialiasing (void) return current_subpixel_antialiasing; } -/* This isn't implemented very properly (for example: what if - decorations are changed while the window is under override - redirect?) but it works well enough for most use cases. */ void BWindow_set_override_redirect (void *window, bool override_redirect_p) { @@ -3167,19 +3429,21 @@ BWindow_set_override_redirect (void *window, bool override_redirect_p) if (w->LockLooper ()) { - if (override_redirect_p) + if (override_redirect_p && !w->override_redirect_p) { + w->override_redirect_p = true; w->pre_override_redirect_feel = w->Feel (); - w->pre_override_redirect_style = w->Look (); + w->pre_override_redirect_look = w->Look (); w->SetFeel (kMenuWindowFeel); w->SetLook (B_NO_BORDER_WINDOW_LOOK); w->pre_override_redirect_workspaces = w->Workspaces (); w->SetWorkspaces (B_ALL_WORKSPACES); } - else + else if (w->override_redirect_p) { + w->override_redirect_p = false; w->SetFeel (w->pre_override_redirect_feel); - w->SetLook (w->pre_override_redirect_style); + w->SetLook (w->pre_override_redirect_look); w->SetWorkspaces (w->pre_override_redirect_workspaces); } @@ -3206,3 +3470,14 @@ be_find_setting (const char *name) return value; } + +void +EmacsWindow_signal_menu_update_complete (void *window) +{ + EmacsWindow *w = (EmacsWindow *) window; + + pthread_mutex_lock (&w->menu_update_mutex); + w->menu_updated_p = true; + pthread_cond_signal (&w->menu_update_cv); + pthread_mutex_unlock (&w->menu_update_mutex); +} diff --git a/src/haiku_support.h b/src/haiku_support.h index 6ddc28759b5..ef433514fe7 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -86,7 +86,9 @@ enum haiku_event_type MENU_BAR_HELP_EVENT, ZOOM_EVENT, REFS_EVENT, - APP_QUIT_REQUESTED_EVENT + APP_QUIT_REQUESTED_EVENT, + DUMMY_EVENT, + MENU_BAR_LEFT }; struct haiku_quit_requested_event @@ -123,6 +125,11 @@ struct haiku_app_quit_requested_event char dummy; }; +struct haiku_dummy_event +{ + char dummy; +}; + #define HAIKU_MODIFIER_ALT (1) #define HAIKU_MODIFIER_CTRL (1 << 1) #define HAIKU_MODIFIER_SHIFT (1 << 2) @@ -154,6 +161,12 @@ struct haiku_mouse_motion_event bigtime_t time; }; +struct haiku_menu_bar_left_event +{ + void *window; + int x, y; +}; + struct haiku_button_event { void *window; @@ -200,6 +213,8 @@ struct haiku_menu_bar_help_event { void *window; int mb_idx; + void *data; + bool highlight_p; }; struct haiku_zoom_event @@ -299,6 +314,7 @@ struct haiku_menu_bar_resize_event struct haiku_menu_bar_state_event { void *window; + bool no_lock; }; #define HAIKU_THIN 0 @@ -339,6 +355,24 @@ struct haiku_menu_bar_state_event #define BE_RECT_WIDTH(rect) (ceil (((rect).right - (rect).left) + 1)) #endif /* __cplusplus */ +/* C++ code cannot include lisp.h, but file dialogs need to be able + to bind to the specpdl and handle quitting correctly. */ + +#ifdef __cplusplus + +#if SIZE_MAX > 0xffffffff +#define WRAP_SPECPDL_REF 1 +#endif +#ifdef WRAP_SPECPDL_REF +typedef struct { ptrdiff_t bytes; } specpdl_ref; +#else +typedef ptrdiff_t specpdl_ref; +#endif + +#else +#include "lisp.h" +#endif + #ifdef __cplusplus extern "C" { @@ -357,25 +391,27 @@ extern "C" #endif extern port_id port_application_to_emacs; + extern port_id port_popup_menu_to_emacs; extern void haiku_io_init (void); extern void haiku_io_init_in_app_thread (void); extern void - haiku_read_size (ssize_t *len); + haiku_read_size (ssize_t *len, bool popup_menu_p); extern int haiku_read (enum haiku_event_type *type, void *buf, ssize_t len); extern int haiku_read_with_timeout (enum haiku_event_type *type, void *buf, ssize_t len, - time_t timeout); + time_t timeout, bool popup_menu_p); extern int haiku_write (enum haiku_event_type type, void *buf); extern int - haiku_write_without_signal (enum haiku_event_type type, void *buf); + haiku_write_without_signal (enum haiku_event_type type, void *buf, + bool popup_menu_p); extern void rgb_color_hsl (uint32_t rgb, double *h, double *s, double *l); @@ -462,10 +498,6 @@ extern "C" BView_SetHighColorForVisibleBell (void *view, uint32_t color); extern void - BView_FillRectangleForVisibleBell (void *view, int x, int y, int width, - int height); - - extern void BView_SetLowColor (void *view, uint32_t color); extern void @@ -527,6 +559,9 @@ extern "C" int vx, int vy, int vwidth, int vheight, uint32_t color); + extern void + BView_InvertRect (void *view, int x, int y, int width, int height); + extern void * BBitmap_transform_bitmap (void *bitmap, void *mask, uint32_t m_color, double rot, int desw, int desh); @@ -604,6 +639,10 @@ extern "C" BView_mouse_up (void *view, int x, int y); extern void + BBitmap_import_fringe_bitmap (void *bitmap, unsigned short *bits, + int wd, int h); + + extern void BBitmap_import_mono_bits (void *bitmap, void *bits, int wd, int h); extern void @@ -678,7 +717,12 @@ extern "C" BMenu_item_at (void *menu, int idx); extern void * - BMenu_run (void *menu, int x, int y); + 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), + void *run_help_callback_data); extern void BPopUpMenu_delete (void *menu); @@ -710,8 +754,14 @@ extern "C" extern void * BAlert_add_button (void *alert, const char *text); - extern int32_t - BAlert_go (void *alert); + extern void + BAlert_set_offset_spacing (void *alert); + + extern int32 + BAlert_go (void *alert, + void (*block_input_function) (void), + void (*unblock_input_function) (void), + void (*process_pending_signals_function) (void)); extern void BButton_set_enabled (void *button, int enabled_p); @@ -772,14 +822,10 @@ extern "C" extern void record_c_unwind_protect_from_cxx (void (*) (void *), void *); - extern ptrdiff_t - c_specpdl_idx_from_cxx (void); - - extern void - c_unbind_to_nil_from_cxx (ptrdiff_t idx); + extern specpdl_ref c_specpdl_idx_from_cxx (void); extern void - EmacsView_do_visible_bell (void *view, uint32_t color); + c_unbind_to_nil_from_cxx (specpdl_ref idx); extern void BWindow_zoom (void *window); @@ -811,8 +857,8 @@ extern "C" BView_show_tooltip (void *view); #ifdef USE_BE_CAIRO - extern cairo_surface_t * - EmacsView_cairo_surface (void *view); + extern cairo_t * + EmacsView_cairo_context (void *view); extern void BView_cr_dump_clipping (void *view, cairo_t *ctx); @@ -864,6 +910,12 @@ extern "C" extern const char * be_find_setting (const char *name); + extern void + EmacsWindow_signal_menu_update_complete (void *window); + + extern haiku_font_family_or_style * + be_list_font_families (size_t *length); + #ifdef __cplusplus extern void * find_appropriate_view_for_draw (void *vw); diff --git a/src/haikufns.c b/src/haikufns.c index 58a2e1d4642..69f502fb016 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -418,13 +418,20 @@ haiku_set_parent_frame (struct frame *f, } if (!NILP (old_value)) - EmacsWindow_unparent (FRAME_HAIKU_WINDOW (f)); + { + EmacsWindow_unparent (FRAME_HAIKU_WINDOW (f)); + FRAME_OUTPUT_DATA (f)->parent_desc = NULL; + } if (!NILP (new_value)) { EmacsWindow_parent_to (FRAME_HAIKU_WINDOW (f), FRAME_HAIKU_WINDOW (p)); BWindow_set_offset (FRAME_HAIKU_WINDOW (f), f->left_pos, f->top_pos); + + /* This isn't actually used for anything, but makes the + `parent-id' parameter correct. */ + FRAME_OUTPUT_DATA (f)->parent_desc = FRAME_HAIKU_WINDOW (p); } fset_parent_frame (f, new_value); unblock_input (); @@ -563,7 +570,7 @@ haiku_create_frame (Lisp_Object parms) Lisp_Object name; bool minibuffer_only = false; long window_prompting = 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct haiku_display_info *dpyinfo = NULL; struct kboard *kb; @@ -592,8 +599,6 @@ haiku_create_frame (Lisp_Object parms) if (STRINGP (name)) Vx_resource_name = name; - block_input (); - /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ /* No need to protect DISPLAY because that's not used after passing it to make_frame_without_minibuffer. */ @@ -668,7 +673,11 @@ haiku_create_frame (Lisp_Object parms) FRAME_RIF (f)->default_font_parameter (f, parms); - unblock_input (); + if (!FRAME_FONT (f)) + { + delete_frame (frame, Qnoelisp); + error ("Invalid frame font"); + } gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), "borderwidth", "BorderWidth", RES_TYPE_NUMBER); @@ -679,9 +688,9 @@ haiku_create_frame (Lisp_Object parms) "childFrameBorderWidth", "childFrameBorderWidth", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), - NULL, NULL, RES_TYPE_NUMBER); + NULL, NULL, RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), - NULL, NULL, RES_TYPE_NUMBER); + NULL, NULL, RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qvertical_scroll_bars, Qt, "verticalScrollBars", "VerticalScrollBars", RES_TYPE_SYMBOL); @@ -749,6 +758,7 @@ haiku_create_frame (Lisp_Object parms) RES_TYPE_BOOLEAN); f->no_split = minibuffer_only || (!EQ (tem, Qunbound) && !NILP (tem)); + block_input (); #define ASSIGN_CURSOR(cursor, be_cursor) \ (FRAME_OUTPUT_DATA (f)->cursor = be_cursor) @@ -786,11 +796,15 @@ haiku_create_frame (Lisp_Object parms) f->terminal->reference_count++; FRAME_OUTPUT_DATA (f)->window = BWindow_new (&FRAME_OUTPUT_DATA (f)->view); + unblock_input (); + if (!FRAME_OUTPUT_DATA (f)->window) xsignal1 (Qerror, build_unibyte_string ("Could not create window")); + block_input (); if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) initialize_frame_menubar (f); + unblock_input (); FRAME_OUTPUT_DATA (f)->window_desc = FRAME_OUTPUT_DATA (f)->window; @@ -830,6 +844,8 @@ haiku_create_frame (Lisp_Object parms) RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qfullscreen, Qnil, "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); @@ -869,10 +885,12 @@ haiku_create_frame (Lisp_Object parms) if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); + block_input (); if (window_prompting & (USPosition | PPosition)) haiku_set_offset (f, f->left_pos, f->top_pos, 1); else BWindow_center_on_screen (FRAME_HAIKU_WINDOW (f)); + unblock_input (); /* Make sure windows on this frame appear in calls to next-window and similar functions. */ @@ -896,7 +914,7 @@ haiku_create_tip_frame (Lisp_Object parms) struct frame *f; Lisp_Object frame; Lisp_Object name; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool face_change_before = face_change; struct haiku_display_info *dpyinfo = x_display_list; @@ -1043,6 +1061,8 @@ haiku_create_tip_frame (Lisp_Object parms) "cursorType", "CursorType", RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); initial_setup_back_buffer (f); @@ -1190,10 +1210,9 @@ haiku_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -1379,7 +1398,7 @@ haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) CHECK_STRING (arg); block_input (); - Emacs_Color color; + Emacs_Color color, fore_pixel; if (haiku_get_color (SSDATA (arg), &color)) { @@ -1389,6 +1408,17 @@ haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } FRAME_CURSOR_COLOR (f) = color; + + if (STRINGP (Vx_cursor_fore_pixel)) + { + if (haiku_get_color (SSDATA (Vx_cursor_fore_pixel), + &fore_pixel)) + error ("Bad color %s", SSDATA (Vx_cursor_fore_pixel)); + FRAME_OUTPUT_DATA (f)->cursor_fg = fore_pixel.pixel; + } + else + FRAME_OUTPUT_DATA (f)->cursor_fg = FRAME_BACKGROUND_PIXEL (f); + if (FRAME_VISIBLE_P (f)) { gui_update_cursor (f, 0); @@ -1814,16 +1844,29 @@ DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) { - struct haiku_display_info *dpy_info; + struct haiku_display_info *dpyinfo; CHECK_STRING (display); if (NILP (Fstring_equal (display, build_string ("be")))) - !NILP (must_succeed) ? fatal ("Bad display") : error ("Bad display"); - dpy_info = haiku_term_init (); + { + if (!NILP (must_succeed)) + fatal ("Bad display"); + else + error ("Bad display"); + } + + if (x_display_list) + return Qnil; + + dpyinfo = haiku_term_init (); - if (!dpy_info) - !NILP (must_succeed) ? fatal ("Display not responding") : - error ("Display not responding"); + if (!dpyinfo) + { + if (!NILP (must_succeed)) + fatal ("Display not responding"); + else + error ("Display not responding"); + } return Qnil; } @@ -1898,10 +1941,8 @@ DEFUN ("x-display-visual-class", Fx_display_visual_class, if (planes == 8) return intern ("static-color"); - else if (planes == 16 || planes == 15) - return intern ("pseudo-color"); - return intern ("direct-color"); + return intern ("true-color"); } DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, @@ -1909,15 +1950,14 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) { - struct frame *tip_f; + struct frame *f, *tip_f; struct window *w; int root_x, root_y; struct buffer *old_buffer; struct text_pos pos; int width, height; int old_windows_or_buffers_changed = windows_or_buffers_changed; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count_1; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object window, size, tip_buf; AUTO_STRING (tip, " *tip*"); @@ -1929,7 +1969,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, if (NILP (frame)) frame = selected_frame; - decode_window_system_frame (frame); + f = decode_window_system_frame (frame); if (NILP (timeout)) timeout = make_fixnum (5); @@ -2133,7 +2173,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, /* Insert STRING into root window's buffer and fit the frame to the buffer. */ - count_1 = SPECPDL_INDEX (); + specpdl_ref count_1 = SPECPDL_INDEX (); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (w->contents)); bset_truncate_lines (current_buffer, Qnil); @@ -2162,12 +2202,20 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, void *wnd = FRAME_HAIKU_WINDOW (tip_f); BWindow_resize (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); BWindow_set_offset (wnd, root_x, root_y); BWindow_set_visible (wnd, true); SET_FRAME_VISIBLE (tip_f, true); FRAME_PIXEL_WIDTH (tip_f) = width; FRAME_PIXEL_HEIGHT (tip_f) = height; BWindow_sync (wnd); + + /* This is needed because the app server resets the cursor whenever + a new window is mapped, so we won't see the cursor set on the + tooltip if the mouse pointer isn't actually over it. */ + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->current_cursor); unblock_input (); w->must_be_updated_p = true; @@ -2384,7 +2432,6 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie Lisp_Object dir, Lisp_Object mustmatch, Lisp_Object dir_only_p, Lisp_Object save_text) { - ptrdiff_t idx; if (!x_display_list) error ("Be windowing not initialized"); @@ -2402,7 +2449,7 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie CHECK_LIVE_FRAME (frame); check_window_system (XFRAME (frame)); - idx = SPECPDL_INDEX (); + specpdl_ref idx = SPECPDL_INDEX (); record_unwind_protect_void (unwind_popup); struct frame *f = XFRAME (frame); @@ -2609,7 +2656,8 @@ frame_parm_handler haiku_frame_parm_handlers[] = haiku_set_no_accept_focus, NULL, /* set z group */ haiku_set_override_redirect, - gui_set_no_special_glyphs + gui_set_no_special_glyphs, + gui_set_alpha_background, }; void @@ -2672,6 +2720,10 @@ syms_of_haikufns (void) doc: /* SKIP: real doc in xfns.c. */); Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); + DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, + doc: /* SKIP: real doc in xfns.c. */); + Vx_cursor_fore_pixel = Qnil; + #ifdef USE_BE_CAIRO DEFVAR_LISP ("cairo-version-string", Vcairo_version_string, doc: /* Version info for cairo. */); diff --git a/src/haikufont.c b/src/haikufont.c index e08792be4b3..5099285f100 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "fontset.h" #include "haikuterm.h" #include "character.h" +#include "coding.h" #include "font.h" #include "termchar.h" #include "pdumper.h" @@ -439,35 +440,35 @@ haikufont_spec_or_entity_to_pattern (Lisp_Object ent, } tem = FONT_SLANT_SYMBOLIC (ent); - if (!NILP (tem)) + if (!NILP (tem) && !EQ (tem, Qunspecified)) { ptn->specified |= FSPEC_SLANT; ptn->slant = haikufont_lisp_to_slant (tem); } tem = FONT_WEIGHT_SYMBOLIC (ent); - if (!NILP (tem)) + if (!NILP (tem) && !EQ (tem, Qunspecified)) { ptn->specified |= FSPEC_WEIGHT; ptn->weight = haikufont_lisp_to_weight (tem); } tem = FONT_WIDTH_SYMBOLIC (ent); - if (!NILP (tem)) + if (!NILP (tem) && !EQ (tem, Qunspecified)) { ptn->specified |= FSPEC_WIDTH; ptn->width = haikufont_lisp_to_width (tem); } tem = AREF (ent, FONT_SPACING_INDEX); - if (FIXNUMP (tem)) + if (!NILP (tem) && !EQ (tem, Qunspecified)) { ptn->specified |= FSPEC_SPACING; ptn->mono_spacing_p = XFIXNUM (tem) != FONT_SPACING_PROPORTIONAL; } tem = AREF (ent, FONT_FAMILY_INDEX); - if (!NILP (tem) && + if (!NILP (tem) && !EQ (tem, Qunspecified) && (list_p && !haikufont_maybe_handle_special_family (tem, ptn))) { ptn->specified |= FSPEC_FAMILY; @@ -951,11 +952,21 @@ haikufont_draw (struct glyph_string *s, int from, int to, struct font_info *info = (struct font_info *) s->font; unsigned char mb[MAX_MULTIBYTE_LENGTH]; void *view = FRAME_HAIKU_VIEW (f); + unsigned long foreground, background; block_input (); prepare_face_for_display (s->f, face); - BView_draw_lock (view); + if (s->hl != DRAW_CURSOR) + { + foreground = s->face->foreground; + background = s->face->background; + } + else + haiku_merge_cursor_foreground (s, &foreground, &background); + + /* Presumably the draw lock is already held by + haiku_draw_glyph_string; */ if (with_background) { int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); @@ -976,18 +987,12 @@ haikufont_draw (struct glyph_string *s, int from, int to, s->first_glyph->slice.glyphless.lower_yoff - s->first_glyph->slice.glyphless.upper_yoff; - BView_SetHighColor (view, s->hl == DRAW_CURSOR ? - FRAME_CURSOR_COLOR (s->f).pixel : face->background); - + BView_SetHighColor (view, background); BView_FillRectangle (view, x, y - ascent, s->width, height); s->background_filled_p = 1; } - if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); - else - BView_SetHighColor (view, face->foreground); - + BView_SetHighColor (view, foreground); BView_MovePenTo (view, x, y); BView_SetFont (view, ((struct haikufont_info *) info)->be_font); @@ -999,12 +1004,13 @@ haikufont_draw (struct glyph_string *s, int from, int to, else { ptrdiff_t b_len = 0; - char *b = xmalloc (b_len); + char *b = alloca ((to - from + 1) * MAX_MULTIBYTE_LENGTH); for (int idx = from; idx < to; ++idx) { int len = CHAR_STRING (s->char2b[idx], mb); - b = xrealloc (b, b_len = (b_len + len)); + b_len += len; + if (len == 1) b[b_len - len] = mb[0]; else @@ -1012,13 +1018,40 @@ haikufont_draw (struct glyph_string *s, int from, int to, } BView_DrawString (view, b, b_len); - xfree (b); } - BView_draw_unlock (view); + unblock_input (); return 1; } +static Lisp_Object +haikufont_list_family (struct frame *f) +{ + Lisp_Object list = Qnil; + size_t length; + ptrdiff_t idx; + haiku_font_family_or_style *styles; + + block_input (); + styles = be_list_font_families (&length); + unblock_input (); + + if (!styles) + return list; + + block_input (); + for (idx = 0; idx < length; ++idx) + { + if (styles[idx][0]) + list = Fcons (intern ((char *) &styles[idx]), list); + } + + free (styles); + unblock_input (); + + return list; +} + struct font_driver const haikufont_driver = { .type = LISPSYM_INITIALLY (Qhaiku), @@ -1032,7 +1065,8 @@ struct font_driver const haikufont_driver = .prepare_face = haikufont_prepare_face, .encode_char = haikufont_encode_char, .text_extents = haikufont_text_extents, - .shape = haikufont_shape + .shape = haikufont_shape, + .list_family = haikufont_list_family }; void diff --git a/src/haikugui.h b/src/haikugui.h index b744885a42b..a6cf3a4e6ce 100644 --- a/src/haikugui.h +++ b/src/haikugui.h @@ -19,11 +19,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifndef _HAIKU_GUI_H_ #define _HAIKU_GUI_H_ -#ifdef _cplusplus -extern "C" -{ -#endif - typedef struct haiku_char_struct { int rbearing; @@ -100,7 +95,4 @@ typedef haiku Drawable; typedef haiku Window; typedef int Display; -#ifdef _cplusplus -}; -#endif #endif /* _HAIKU_GUI_H_ */ diff --git a/src/haikumenu.c b/src/haikumenu.c index 1c75e0f9a42..41db0d414dd 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -32,12 +32,6 @@ static Lisp_Object *volatile menu_item_selection; int popup_activated_p = 0; -struct submenu_stack_cell -{ - void *parent_menu; - void *pane; -}; - static void digest_menu_items (void *first_menu, int start, int menu_items_used, int mbar_p) @@ -150,11 +144,20 @@ digest_menu_items (void *first_menu, int start, int menu_items_used, else if (NILP (def) && menu_separator_name_p (SSDATA (item_name))) BMenu_add_separator (menu); else if (!mbar_p) - BMenu_add_item (menu, SSDATA (item_name), - !NILP (def) ? aref_addr (menu_items, i) : NULL, - !NILP (enable), !NILP (selected), 0, window, - !NILP (descrip) ? SSDATA (descrip) : NULL, - STRINGP (help) ? SSDATA (help) : NULL); + { + if (!use_system_tooltips || NILP (Fsymbol_value (Qtooltip_mode))) + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? aref_addr (menu_items, i) : NULL, + !NILP (enable), !NILP (selected), 0, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + NULL); + else + BMenu_add_item (menu, SSDATA (item_name), + !NILP (def) ? aref_addr (menu_items, i) : NULL, + !NILP (enable), !NILP (selected), 0, window, + !NILP (descrip) ? SSDATA (descrip) : NULL, + STRINGP (help) ? SSDATA (help) : NULL); + } else if (!use_system_tooltips || NILP (Fsymbol_value (Qtooltip_mode))) BMenu_add_item (menu, SSDATA (item_name), !NILP (def) ? (void *) (intptr_t) i : NULL, @@ -181,6 +184,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, Lisp_Object header, const char **error_name) { int i, nb_buttons = 0; + bool boundary_seen = false; + Lisp_Object pane_name, vals[10]; + void *alert, *button; + bool enabled_item_seen_p = false; + int32 val; *error_name = NULL; @@ -190,17 +198,15 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, return Qnil; } - Lisp_Object pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); + pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); i = MENU_ITEMS_PANE_LENGTH; if (STRING_MULTIBYTE (pane_name)) pane_name = ENCODE_UTF_8 (pane_name); block_input (); - void *alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT : - HAIKU_IDEA_ALERT); - - Lisp_Object vals[10]; + alert = BAlert_new (SSDATA (pane_name), NILP (header) ? HAIKU_INFO_ALERT : + HAIKU_IDEA_ALERT); while (i < menu_items_used) { @@ -220,7 +226,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, if (EQ (item_name, Qquote)) { + if (nb_buttons) + boundary_seen = true; + i++; + continue; } if (nb_buttons >= 9) @@ -236,9 +246,11 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, if (!NILP (descrip) && STRING_MULTIBYTE (descrip)) descrip = ENCODE_UTF_8 (descrip); - void *button = BAlert_add_button (alert, SSDATA (item_name)); + button = BAlert_add_button (alert, SSDATA (item_name)); BButton_set_enabled (button, !NILP (enable)); + enabled_item_seen_p |= !NILP (enable); + if (!NILP (descrip)) BView_set_tooltip (button, SSDATA (descrip)); @@ -247,15 +259,39 @@ haiku_dialog_show (struct frame *f, Lisp_Object title, i += MENU_ITEMS_ITEM_LENGTH; } - int32_t val = BAlert_go (alert); + /* Haiku only lets us specify a single button to place on the + left. */ + if (boundary_seen) + BAlert_set_offset_spacing (alert); + + /* If there isn't a single enabled item, add an "Ok" button so the + popup can be dismissed. */ + if (!enabled_item_seen_p) + BAlert_add_button (alert, "Ok"); unblock_input (); + unrequest_sigio (); + ++popup_activated_p; + val = BAlert_go (alert, block_input, unblock_input, + process_pending_signals); + --popup_activated_p; + request_sigio (); + if (val < 0) quit (); - else + else if (val < nb_buttons) return vals[val]; - return Qnil; + /* The dialog was dismissed via the button appended to dismiss popup + dialogs without a single enabled item. */ + if (nb_buttons) + quit (); + /* Otherwise, the Ok button was added because no buttons were seen + at all. */ + else + return Qt; + + emacs_abort (); } Lisp_Object @@ -264,7 +300,7 @@ haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) Lisp_Object title; const char *error_name = NULL; Lisp_Object selection; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); check_window_system (f); @@ -282,9 +318,7 @@ haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) list_of_panes (list1 (contents)); /* Display them in a dialog box. */ - block_input (); selection = haiku_dialog_show (f, title, header, &error_name); - unblock_input (); unbind_to (specpdl_count, Qnil); discard_menu_items (); @@ -294,6 +328,27 @@ haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) return selection; } +static void +haiku_menu_show_help (void *help, void *data) +{ + Lisp_Object *id = (Lisp_Object *) help; + + if (help) + show_help_echo (id[MENU_ITEMS_ITEM_HELP], + Qnil, Qnil, Qnil); + else + show_help_echo (Qnil, Qnil, Qnil, Qnil); +} + +static void +haiku_process_pending_signals_for_menu (void) +{ + process_pending_signals (); + + input_pending = false; + detect_input_pending_run_timers (true); +} + Lisp_Object haiku_menu_show (struct frame *f, int x, int y, int menuflags, Lisp_Object title, const char **error_name) @@ -327,9 +382,14 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, } digest_menu_items (menu, 0, menu_items_used, 0); BView_convert_to_screen (view, &x, &y); - menu_item_selection = BMenu_run (menu, x, y); unblock_input (); + popup_activated_p++; + menu_item_selection = BMenu_run (menu, x, y, haiku_menu_show_help, + block_input, unblock_input, + haiku_process_pending_signals_for_menu, NULL); + popup_activated_p--; + FRAME_DISPLAY_INFO (f)->grabbed = 0; if (menu_item_selection) @@ -445,7 +505,7 @@ set_frame_menubar (struct frame *f, bool deep_p) Lisp_Object items; struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); @@ -645,8 +705,10 @@ the position of the last non-menu event instead. */) if (FRAME_EXTERNAL_MENU_BAR (f)) { - if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) - set_frame_menubar (f, 1); + block_input (); + set_frame_menubar (f, 1); + BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); + unblock_input (); } else { @@ -654,10 +716,6 @@ the position of the last non-menu event instead. */) last_nonmenu_event); } - block_input (); - BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); - unblock_input (); - return Qnil; } diff --git a/src/haikuselect.c b/src/haikuselect.c index e65ab827c51..65dac0e02fa 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -97,20 +97,12 @@ fetch. */) return Qnil; Lisp_Object str = make_unibyte_string (dat, len); - Lisp_Object lispy_type = Qnil; - if (!strcmp (SSDATA (name), "text/utf-8") || - !strcmp (SSDATA (name), "text/plain")) - { - if (string_ascii_p (str)) - lispy_type = QSTRING; - else - lispy_type = QUTF8_STRING; - } - - if (!NILP (lispy_type)) - Fput_text_property (make_fixnum (0), make_fixnum (len), - Qforeign_selection, lispy_type, str); + /* `foreign-selection' just means that the selection has to be + decoded by `gui-get-selection'. It has no other meaning, + AFAICT. */ + Fput_text_property (make_fixnum (0), make_fixnum (len), + Qforeign_selection, Qt, str); block_input (); BClipboard_free_data (dat); @@ -125,10 +117,8 @@ DEFUN ("haiku-selection-put", Fhaiku_selection_put, Shaiku_selection_put, CLIPBOARD is the symbol `PRIMARY', `SECONDARY' or `CLIPBOARD'. NAME is a MIME type denoting the type of the data to add. DATA is the string that will be placed in the clipboard, or nil if the content is -to be removed. If NAME is the string "text/utf-8" or the string -"text/plain", encode it as UTF-8 before storing it into the clipboard. -CLEAR, if non-nil, means to erase all the previous contents of the -clipboard. */) +to be removed. CLEAR, if non-nil, means to erase all the previous +contents of the clipboard. */) (Lisp_Object clipboard, Lisp_Object name, Lisp_Object data, Lisp_Object clear) { @@ -138,13 +128,6 @@ clipboard. */) CHECK_STRING (data); block_input (); - /* It seems that Haiku applications counter-intuitively expect - UTF-8 data in both text/utf-8 and text/plain. */ - if (!NILP (data) && STRING_MULTIBYTE (data) && - (!strcmp (SSDATA (name), "text/utf-8") || - !strcmp (SSDATA (name), "text/plain"))) - data = ENCODE_UTF_8 (data); - char *dat = !NILP (data) ? SSDATA (data) : NULL; ptrdiff_t len = !NILP (data) ? SBYTES (data) : 0; diff --git a/src/haikuterm.c b/src/haikuterm.c index 7ab41805ead..c184501a207 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -406,7 +406,7 @@ haiku_new_focus_frame (struct frame *frame) x_display_list->focused_frame = frame; - if (frame && frame->auto_raise) + if (frame && frame->auto_raise && !popup_activated_p) haiku_frame_raise_lower (frame, 1); } unblock_input (); @@ -461,9 +461,8 @@ haiku_draw_box_rect (struct glyph_string *s, } static void -haiku_calculate_relief_colors (struct glyph_string *s, - uint32_t *rgbout_w, uint32_t *rgbout_b, - uint32_t *rgbout_c) +haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, + uint32_t *rgbout_b) { struct face *face = s->face; @@ -480,7 +479,6 @@ haiku_calculate_relief_colors (struct glyph_string *s, hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), rgbout_b); hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), rgbout_w); - hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.8), rgbout_c); } static void @@ -492,16 +490,18 @@ haiku_draw_relief_rect (struct glyph_string *s, { uint32_t color_white; uint32_t color_black; - uint32_t color_corner; - haiku_calculate_relief_colors (s, &color_white, &color_black, - &color_corner); + haiku_calculate_relief_colors (s, &color_white, &color_black); void *view = FRAME_HAIKU_VIEW (s->f); BView_SetHighColor (view, raised_p ? color_white : color_black); if (clip_rect) - BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width, - clip_rect->height); + { + BView_StartClip (view); + haiku_clip_to_string (s); + BView_ClipToRect (view, clip_rect->x, clip_rect->y, clip_rect->width, + clip_rect->height); + } if (top_p) BView_FillRectangle (view, left_x, top_y, right_x - left_x + 1, hwidth); if (left_p) @@ -546,7 +546,7 @@ haiku_draw_relief_rect (struct glyph_string *s, if (vwidth > 1 && right_p) BView_StrokeLine (view, right_x, top_y, right_x, bottom_y); - BView_SetHighColor (view, color_corner); + BView_SetHighColor (view, s->face->background); /* Omit corner pixels. */ if (hwidth > 1 || vwidth > 1) @@ -560,6 +560,9 @@ haiku_draw_relief_rect (struct glyph_string *s, if (right_p && bot_p) BView_FillRectangle (view, right_x, bottom_y, 1, 1); } + + if (clip_rect) + BView_EndClip (view); } static void @@ -601,22 +604,26 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x) static void haiku_draw_text_decoration (struct glyph_string *s, struct face *face, - uint8_t dcol, int width, int x) + int width, int x) { + unsigned long cursor_color; + if (s->for_overlaps) return; + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, &cursor_color, NULL); + void *view = FRAME_HAIKU_VIEW (s->f); - BView_draw_lock (view); if (face->underline) { if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + BView_SetHighColor (view, cursor_color); else if (!face->underline_defaulted_p) BView_SetHighColor (view, face->underline_color); else - BView_SetHighColor (view, dcol); + BView_SetHighColor (view, face->foreground); if (face->underline == FACE_UNDER_WAVE) haiku_draw_underwave (s, width, x); @@ -632,20 +639,12 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face, && (s->prev->face->underline_pixels_above_descent_line == s->face->underline_pixels_above_descent_line)) { - struct face *prev_face = s->prev->face; - - if (prev_face && prev_face->underline == FACE_UNDER_LINE) - { - /* We use the same underline style as the previous one. */ - thickness = s->prev->underline_thickness; - position = s->prev->underline_position; - } - else - goto calculate_underline_metrics; + /* We use the same underline style as the previous one. */ + thickness = s->prev->underline_thickness; + position = s->prev->underline_position; } else { - calculate_underline_metrics:; struct font *font = font_for_underline_metrics (s); unsigned long minimum_offset; bool underline_at_descent_line; @@ -717,11 +716,11 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face, { unsigned long dy = 0, h = 1; if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + BView_SetHighColor (view, cursor_color); else if (!face->overline_color_defaulted_p) BView_SetHighColor (view, face->overline_color); else - BView_SetHighColor (view, dcol); + BView_SetHighColor (view, face->foreground); BView_FillRectangle (view, s->x, s->y + dy, s->width, h); } @@ -741,26 +740,22 @@ haiku_draw_text_decoration (struct glyph_string *s, struct face *face, unsigned long dy = (glyph_height - h) / 2; if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); + BView_SetHighColor (view, cursor_color); else if (!face->strike_through_color_defaulted_p) BView_SetHighColor (view, face->strike_through_color); else - BView_SetHighColor (view, dcol); + BView_SetHighColor (view, face->foreground); BView_FillRectangle (view, s->x, glyph_y + dy, s->width, h); } - - BView_draw_unlock (view); } static void -haiku_draw_string_box (struct glyph_string *s, int clip_p) +haiku_draw_string_box (struct glyph_string *s) { int hwidth, vwidth, left_x, right_x, top_y, bottom_y, last_x; bool raised_p, left_p, right_p; struct glyph *last_glyph; - struct haiku_rect clip_rect; - struct face *face = s->face; last_x = ((s->row->full_width_p && !s->w->pseudo_window_p) @@ -808,30 +803,13 @@ haiku_draw_string_box (struct glyph_string *s, int clip_p) && (s->next == NULL || s->next->hl != s->hl))); - get_glyph_string_clip_rect (s, &clip_rect); - if (face->box == FACE_SIMPLE_BOX) haiku_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, - vwidth, left_p, right_p, &clip_rect); + vwidth, left_p, right_p, NULL); else haiku_draw_relief_rect (s, left_x, top_y, right_x, bottom_y, hwidth, vwidth, raised_p, true, true, left_p, right_p, - &clip_rect, 1); - - if (clip_p) - { - void *view = FRAME_HAIKU_VIEW (s->f); - - haiku_draw_text_decoration (s, face, face->foreground, s->width, s->x); - BView_ClipToInverseRect (view, left_x, top_y, right_x - left_x + 1, hwidth); - if (left_p) - BView_ClipToInverseRect (view, left_x, top_y, vwidth, bottom_y - top_y + 1); - BView_ClipToInverseRect (view, left_x, bottom_y - hwidth + 1, - right_x - left_x + 1, hwidth); - if (right_p) - BView_ClipToInverseRect (view, right_x - vwidth + 1, - top_y, vwidth, bottom_y - top_y + 1); - } + NULL, 1); } static void @@ -839,8 +817,12 @@ haiku_draw_plain_background (struct glyph_string *s, struct face *face, int box_line_hwidth, int box_line_vwidth) { void *view = FRAME_HAIKU_VIEW (s->f); + unsigned long cursor_color; if (s->hl == DRAW_CURSOR) - BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + { + haiku_merge_cursor_foreground (s, NULL, &cursor_color); + BView_SetHighColor (view, cursor_color); + } else BView_SetHighColor (view, face->background_defaulted_p ? FRAME_BACKGROUND_PIXEL (s->f) : @@ -1072,7 +1054,10 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) x -= width; void *view = FRAME_HAIKU_VIEW (s->f); - BView_SetHighColor (view, FRAME_CURSOR_COLOR (s->f).pixel); + unsigned long cursor_color; + + haiku_merge_cursor_foreground (s, NULL, &cursor_color); + BView_SetHighColor (view, cursor_color); BView_FillRectangle (view, x, s->y, width, s->height); if (width < background_width) @@ -1115,9 +1100,9 @@ haiku_draw_stretch_glyph_string (struct glyph_string *s) if (background_width > 0) { void *view = FRAME_HAIKU_VIEW (s->f); - uint32_t bkg; + unsigned long bkg; if (s->hl == DRAW_CURSOR) - bkg = FRAME_CURSOR_COLOR (s->f).pixel; + haiku_merge_cursor_foreground (s, NULL, &bkg); else bkg = s->face->background; @@ -1132,7 +1117,6 @@ static void haiku_start_clip (struct glyph_string *s) { void *view = FRAME_HAIKU_VIEW (s->f); - BView_draw_lock (view); BView_StartClip (view); } @@ -1141,7 +1125,6 @@ haiku_end_clip (struct glyph_string *s) { void *view = FRAME_HAIKU_VIEW (s->f); BView_EndClip (view); - BView_draw_unlock (view); } static void @@ -1475,7 +1458,11 @@ haiku_draw_image_glyph_string (struct glyph_string *s) static void haiku_draw_glyph_string (struct glyph_string *s) { + void *view; + block_input (); + view = FRAME_HAIKU_VIEW (s->f); + BView_draw_lock (view); prepare_face_for_display (s->f, s->face); struct face *face = s->face; @@ -1514,7 +1501,7 @@ haiku_draw_glyph_string (struct glyph_string *s) haiku_clip_to_string (s); haiku_maybe_draw_background (s, 1); box_filled_p = 1; - haiku_draw_string_box (s, 0); + haiku_draw_string_box (s); } else if (!s->clip_head /* draw_glyphs didn't specify a clip mask. */ && !s->clip_tail @@ -1567,10 +1554,9 @@ haiku_draw_glyph_string (struct glyph_string *s) if (!s->for_overlaps) { if (!box_filled_p && face->box != FACE_NO_BOX) - haiku_draw_string_box (s, 1); + haiku_draw_string_box (s); else - haiku_draw_text_decoration (s, face, face->foreground, - s->width, s->x); + haiku_draw_text_decoration (s, face, s->width, s->x); if (s->prev) { @@ -1625,6 +1611,7 @@ haiku_draw_glyph_string (struct glyph_string *s) } } haiku_end_clip (s); + BView_draw_unlock (view); unblock_input (); } @@ -1700,7 +1687,7 @@ haiku_draw_window_cursor (struct window *w, int cursor_width, bool on_p, bool active_p) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - + struct face *face; struct glyph *phys_cursor_glyph; struct glyph *cursor_glyph; @@ -1754,7 +1741,26 @@ haiku_draw_window_cursor (struct window *w, BView_draw_lock (view); BView_StartClip (view); - BView_SetHighColor (view, FRAME_CURSOR_COLOR (f).pixel); + + if (cursor_type == BAR_CURSOR) + { + cursor_glyph = get_phys_cursor_glyph (w); + face = FACE_FROM_ID (f, cursor_glyph->face_id); + } + + /* If the glyph's background equals the color we normally draw the + bar cursor in, our cursor in its normal color is invisible. Use + the glyph's foreground color instead in this case, on the + assumption that the glyph's colors are chosen so that the glyph + is legible. */ + + /* xterm.c only does this for bar cursors, and nobody has + complained, so it would be best to do that here as well. */ + if (cursor_type == BAR_CURSOR + && face->background == FRAME_CURSOR_COLOR (f).pixel) + BView_SetHighColor (view, face->foreground); + else + BView_SetHighColor (view, FRAME_CURSOR_COLOR (f).pixel); haiku_clip_to_row (w, glyph_row, TEXT_AREA); switch (cursor_type) @@ -1767,7 +1773,6 @@ haiku_draw_window_cursor (struct window *w, BView_FillRectangle (view, fx, fy, w->phys_cursor_width, h); break; case BAR_CURSOR: - cursor_glyph = get_phys_cursor_glyph (w); if (cursor_glyph->resolved_level & 1) BView_FillRectangle (view, fx + cursor_glyph->pixel_width - w->phys_cursor_width, fy, w->phys_cursor_width, h); @@ -1924,11 +1929,11 @@ haiku_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) last pixels differently. */ { BView_SetHighColor (view, color_first); - BView_StrokeLine (f, x0, y0, x1 - 1, y0); + BView_StrokeLine (view, x0, y0, x1 - 1, y0); BView_SetHighColor (view, color); BView_FillRectangle (view, x0, y0 + 1, x1 - x0, y1 - y0 - 2); BView_SetHighColor (view, color_last); - BView_StrokeLine (view, x0, y1, x1 - 1, y1); + BView_FillRectangle (view, x0, y1 - 1, x1 - x0, 1); } else { @@ -2287,8 +2292,12 @@ haiku_define_fringe_bitmap (int which, unsigned short *bits, fringe_bmps[i++] = NULL; } + block_input (); fringe_bmps[which] = BBitmap_new (wd, h, 1); - BBitmap_import_mono_bits (fringe_bmps[which], bits, wd, h); + if (!fringe_bmps[which]) + memory_full (SIZE_MAX); + BBitmap_import_fringe_bitmap (fringe_bmps[which], bits, wd, h); + unblock_input (); } static void @@ -2333,50 +2342,14 @@ haiku_scroll_run (struct window *w, struct run *run) height = run->height; } - if (!height) - return; - block_input (); gui_clear_cursor (w); + BView_draw_lock (view); -#ifdef USE_BE_CAIRO - if (EmacsView_double_buffered_p (view)) - { -#endif - BView_StartClip (view); - BView_CopyBits (view, x, from_y, width, height, - x, to_y, width, height); - BView_EndClip (view); -#ifdef USE_BE_CAIRO - } - else - { - EmacsWindow_begin_cr_critical_section (FRAME_HAIKU_WINDOW (f)); - cairo_surface_t *surface = FRAME_CR_SURFACE (f); - cairo_surface_t *s - = cairo_surface_create_similar (surface, - cairo_surface_get_content (surface), - width, height); - cairo_t *cr = cairo_create (s); - if (surface) - { - cairo_set_source_surface (cr, surface, -x, -from_y); - cairo_paint (cr); - cairo_destroy (cr); - - cr = haiku_begin_cr_clip (f, NULL); - cairo_save (cr); - cairo_set_source_surface (cr, s, x, to_y); - cairo_set_operator (cr, CAIRO_OPERATOR_SOURCE); - cairo_rectangle (cr, x, to_y, width, height); - cairo_fill (cr); - cairo_restore (cr); - cairo_surface_destroy (s); - haiku_end_cr_clip (cr); - } - EmacsWindow_end_cr_critical_section (FRAME_HAIKU_WINDOW (f)); - } -#endif + BView_StartClip (view); + BView_CopyBits (view, x, from_y, width, height, + x, to_y, width, height); + BView_EndClip (view); BView_draw_unlock (view); unblock_input (); @@ -2603,7 +2576,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!buf) buf = xmalloc (200); - haiku_read_size (&b_size); + haiku_read_size (&b_size, false); while (b_size >= 0) { enum haiku_event_type type; @@ -2729,7 +2702,14 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) ASCII_KEYSTROKE_EVENT; inev.timestamp = b->time / 1000; - inev.modifiers = haiku_modifiers_to_emacs (b->modifiers); + inev.modifiers = (haiku_modifiers_to_emacs (b->modifiers) + | (extra_keyboard_modifiers + & (meta_modifier + | hyper_modifier + | ctrl_modifier + | alt_modifier + | shift_modifier))); + XSETFRAME (inev.frame_or_window, f); break; } @@ -2755,15 +2735,44 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) break; } + case MENU_BAR_LEFT: + { + struct haiku_menu_bar_left_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f) + continue; + + if (b->y > 0 && b->y <= FRAME_PIXEL_HEIGHT (f) + && b->x > 0 && b->x <= FRAME_PIXEL_WIDTH (f)) + break; + + if (f->auto_lower && !popup_activated_p) + haiku_frame_raise_lower (f, 0); + + break; + } case MOUSE_MOTION: { struct haiku_mouse_motion_event *b = buf; struct frame *f = haiku_window_to_frame (b->window); Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; - if (!f || FRAME_TOOLTIP_P (f)) + if (!f) continue; + if (FRAME_TOOLTIP_P (f)) + { + /* Dismiss the tooltip if the mouse moves onto a + tooltip frame. FIXME: for some reason we don't get + leave notification events for this. */ + + if (any_help_event_p) + do_help = -1; + + break; + } + Lisp_Object frame; XSETFRAME (frame, f); @@ -2790,6 +2799,18 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) need_flush = 1; } + if (f->auto_lower && !popup_activated_p) + { + /* If we're leaving towards the menu bar, don't + auto-lower here, and wait for a exit + notification from the menu bar instead. */ + if (b->x > FRAME_PIXEL_WIDTH (f) + || b->y >= FRAME_MENU_BAR_HEIGHT (f) + || b->x < 0 + || b->y < 0) + haiku_frame_raise_lower (f, 0); + } + haiku_new_focus_frame (x_display_list->focused_frame); if (any_help_event_p) @@ -2860,9 +2881,10 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (WINDOWP (window) && !EQ (window, last_mouse_window) && !EQ (window, selected_window) + && !popup_activated_p + && !MINI_WINDOW_P (XWINDOW (selected_window)) && (!NILP (focus_follows_mouse) - || (EQ (XWINDOW (window)->frame, - XWINDOW (selected_window)->frame)))) + || f == SELECTED_FRAME ())) { inev.kind = SELECT_WINDOW_EVENT; inev.frame_or_window = window; @@ -2871,10 +2893,18 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) last_mouse_window = window; } + if (f->auto_raise) + { + if (!BWindow_is_active (FRAME_HAIKU_WINDOW (f))) + haiku_frame_raise_lower (f, 1); + } + if (!NILP (help_echo_string) || !NILP (previous_help_echo_string)) do_help = 1; } + + need_flush = FRAME_DIRTY_P (f); break; } case BUTTON_UP: @@ -2884,8 +2914,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) struct frame *f = haiku_window_to_frame (b->window); Lisp_Object tab_bar_arg = Qnil; int tab_bar_p = 0, tool_bar_p = 0; + bool up_okay_p = false; - if (!f) + if (popup_activated_p || !f) continue; struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); @@ -2936,10 +2967,12 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (type == BUTTON_UP) { inev.modifiers |= up_modifier; + up_okay_p = (dpyinfo->grabbed & (1 << b->btn_no)); dpyinfo->grabbed &= ~(1 << b->btn_no); } else { + up_okay_p = true; inev.modifiers |= down_modifier; dpyinfo->last_mouse_frame = f; dpyinfo->grabbed |= (1 << b->btn_no); @@ -2949,7 +2982,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) f->last_tool_bar_item = -1; } - if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p) + if (up_okay_p + && !(tab_bar_p && NILP (tab_bar_arg)) + && !tool_bar_p) inev.kind = MOUSE_CLICK_EVENT; inev.arg = tab_bar_arg; inev.code = b->btn_no; @@ -3178,7 +3213,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (type == MENU_BAR_OPEN) { - if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) + /* b->no_lock means that MenusBeginning was called + from the main thread, which means tracking was + started manually, and we have already updated the + menu bar. */ + if (!b->no_lock) { BView_draw_lock (FRAME_HAIKU_VIEW (f)); /* This shouldn't be here, but nsmenu does it, so @@ -3190,8 +3229,14 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) waiting_for_input = was_waiting_for_input_p; BView_draw_unlock (FRAME_HAIKU_VIEW (f)); } + + /* But set the flag anyway, because the menu will end + from the window thread. */ FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; popup_activated_p += 1; + + if (!b->no_lock) + EmacsWindow_signal_menu_update_complete (b->window); } else { @@ -3290,11 +3335,12 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) } case APP_QUIT_REQUESTED_EVENT: case KEY_UP: + case DUMMY_EVENT: default: break; } - haiku_read_size (&b_size); + haiku_read_size (&b_size, false); if (inev.kind != NO_EVENT) { @@ -3319,7 +3365,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) for (struct unhandled_event *ev = unhandled_events; ev;) { - haiku_write_without_signal (ev->type, &ev->buffer); + haiku_write_without_signal (ev->type, &ev->buffer, false); struct unhandled_event *old = ev; ev = old->next; xfree (old); @@ -3351,6 +3397,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) flush_dirty_back_buffers (); unblock_input (); + return message_count; } @@ -3374,6 +3421,94 @@ haiku_free_pixmap (struct frame *f, Emacs_Pixmap pixmap) } static void +haiku_flash (struct frame *f) +{ + /* Get the height not including a menu bar widget. */ + int height = FRAME_PIXEL_HEIGHT (f); + /* Height of each line to flash. */ + int flash_height = FRAME_LINE_HEIGHT (f); + /* These will be the left and right margins of the rectangles. */ + int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); + int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f); + int width = flash_right - flash_left; + void *view = FRAME_HAIKU_VIEW (f); + struct timespec delay, wakeup, current, timeout; + + delay = make_timespec (0, 150 * 1000 * 1000); + wakeup = timespec_add (current_timespec (), delay); + + BView_draw_lock (view); + BView_StartClip (view); + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + BView_InvertRect (view, flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + + BView_InvertRect (view, flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); + } + else + /* If it is short, flash it all. */ + BView_InvertRect (view, flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + BView_EndClip (view); + BView_draw_unlock (view); + + flush_frame (f); + + if (EmacsView_double_buffered_p (view)) + haiku_flip_buffers (f); + + /* Keep waiting until past the time wakeup or any input gets + available. */ + while (!detect_input_pending ()) + { + current = current_timespec (); + + /* Break if result would not be positive. */ + if (timespec_cmp (wakeup, current) <= 0) + break; + + /* How long `select' should wait. */ + timeout = make_timespec (0, 10 * 1000 * 1000); + + /* Try to wait that long--but we might wake up sooner. */ + pselect (0, NULL, NULL, NULL, &timeout, NULL); + } + + BView_draw_lock (view); + BView_StartClip (view); + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + BView_InvertRect (view, flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + + BView_InvertRect (view, flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); + } + else + /* If it is short, flash it all. */ + BView_InvertRect (view, flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + BView_EndClip (view); + BView_draw_unlock (view); + + flush_frame (f); + if (EmacsView_double_buffered_p (view)) + haiku_flip_buffers (f); +} + +static void haiku_beep (struct frame *f) { if (visible_bell) @@ -3382,21 +3517,7 @@ haiku_beep (struct frame *f) if (view) { block_input (); - BView_draw_lock (view); - if (!EmacsView_double_buffered_p (view)) - { - BView_SetHighColorForVisibleBell (view, FRAME_FOREGROUND_PIXEL (f)); - BView_FillRectangleForVisibleBell (view, 0, 0, FRAME_PIXEL_WIDTH (f), - FRAME_PIXEL_HEIGHT (f)); - SET_FRAME_GARBAGED (f); - expose_frame (f, 0, 0, 0, 0); - } - else - { - EmacsView_do_visible_bell (view, FRAME_FOREGROUND_PIXEL (f)); - haiku_flip_buffers (f); - } - BView_draw_unlock (view); + haiku_flash (f); unblock_input (); } } @@ -3501,7 +3622,7 @@ haiku_term_init (void) Lisp_Object color_file, color_map; block_input (); - Fset_input_interrupt_mode (Qnil); + Fset_input_interrupt_mode (Qt); baud_rate = 19200; @@ -3659,22 +3780,54 @@ haiku_set_offset (struct frame *frame, int x, int y, cairo_t * haiku_begin_cr_clip (struct frame *f, struct glyph_string *s) { - cairo_surface_t *surface = FRAME_CR_SURFACE (f); - if (!surface) + cairo_t *cr = FRAME_CR_CONTEXT (f); + + if (!cr) return NULL; - cairo_t *context = cairo_create (surface); - return context; + cairo_save (cr); + return cr; } void haiku_end_cr_clip (cairo_t *cr) { - cairo_destroy (cr); + if (!cr) + return; + + cairo_restore (cr); } #endif void +haiku_merge_cursor_foreground (struct glyph_string *s, + unsigned long *foreground_out, + unsigned long *background_out) +{ + unsigned long background = FRAME_CURSOR_COLOR (s->f).pixel; + unsigned long foreground = s->face->background; + + if (background == foreground) + foreground = s->face->background; + if (background == foreground) + foreground = FRAME_OUTPUT_DATA (s->f)->cursor_fg; + if (background == foreground) + foreground = s->face->foreground; + + if (background == s->face->background + || foreground == s->face->foreground) + { + background = s->face->foreground; + foreground = s->face->background; + } + + if (foreground_out) + *foreground_out = foreground; + if (background_out) + *background_out = background; +} + +void syms_of_haikuterm (void) { DEFVAR_BOOL ("haiku-initialized", haiku_initialized, diff --git a/src/haikuterm.h b/src/haikuterm.h index de302883e48..a2520858f54 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -32,10 +32,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "font.h" #include "systime.h" -#define C_FRAME struct frame * -#define C_FONT struct font * -#define C_TERMINAL struct terminal * - #define HAVE_CHAR_CACHE_MAX 65535 extern int popup_activated_p; @@ -64,7 +60,7 @@ struct haiku_display_info { /* Chain of all haiku_display_info structures. */ struct haiku_display_info *next; - C_TERMINAL terminal; + struct terminal *terminal; Lisp_Object name_list_element; Lisp_Object color_map; @@ -86,7 +82,6 @@ struct haiku_display_info int n_planes; int color_p; - Window root_window; Lisp_Object rdb; Emacs_Cursor vertical_scroll_bar_cursor; @@ -94,9 +89,9 @@ struct haiku_display_info Mouse_HLInfo mouse_highlight; - C_FRAME highlight_frame; - C_FRAME last_mouse_frame; - C_FRAME last_mouse_motion_frame; + struct frame *highlight_frame; + struct frame *last_mouse_frame; + struct frame *last_mouse_motion_frame; int last_mouse_motion_x; int last_mouse_motion_y; @@ -110,6 +105,8 @@ struct haiku_display_info double resx, resy; Time last_mouse_movement_time; + + Window root_window; }; struct haiku_output @@ -160,7 +157,7 @@ struct haiku_output int menu_bar_open_p; - C_FONT font; + struct font *font; int hourglass_p; uint32_t cursor_fg; @@ -234,8 +231,10 @@ struct scroll_bar #define FRAME_CURSOR_COLOR(f) (FRAME_OUTPUT_DATA (f)->cursor_color) #ifdef USE_BE_CAIRO -#define FRAME_CR_SURFACE(f) \ - (FRAME_HAIKU_VIEW (f) ? EmacsView_cairo_surface (FRAME_HAIKU_VIEW (f)) : 0); +#define FRAME_CR_CONTEXT(f) \ + (FRAME_HAIKU_VIEW (f) \ + ? EmacsView_cairo_context (FRAME_HAIKU_VIEW (f)) \ + : NULL) #endif extern void syms_of_haikuterm (void); @@ -295,4 +294,7 @@ haiku_begin_cr_clip (struct frame *f, struct glyph_string *s); extern void haiku_end_cr_clip (cairo_t *cr); #endif + +extern void haiku_merge_cursor_foreground (struct glyph_string *, unsigned long *, + unsigned long *); #endif /* _HAIKU_TERM_H_ */ diff --git a/src/image.c b/src/image.c index 951531505e6..e2ba744e0a3 100644 --- a/src/image.c +++ b/src/image.c @@ -543,6 +543,10 @@ image_create_bitmap_from_data (struct frame *f, char *bits, #ifdef HAVE_HAIKU void *bitmap = BBitmap_new (width, height, 1); + + if (!bitmap) + return -1; + BBitmap_import_mono_bits (bitmap, bits, width, height); #endif @@ -1177,7 +1181,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, return false; maybe_done: - if (EQ (XCDR (plist), Qnil)) + if (NILP (XCDR (plist))) { /* Check that all mandatory fields are present. */ for (i = 0; i < nkeywords; ++i) @@ -2848,13 +2852,12 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, { Display *display = FRAME_X_DISPLAY (f); Drawable drawable = FRAME_X_DRAWABLE (f); - Screen *screen = FRAME_X_SCREEN (f); eassert (input_blocked_p ()); if (depth <= 0) - depth = DefaultDepthOfScreen (screen); - *ximg = XCreateImage (display, DefaultVisualOfScreen (screen), + depth = FRAME_DISPLAY_INFO (f)->n_planes; + *ximg = XCreateImage (display, FRAME_X_VISUAL (f), depth, ZPixmap, 0, NULL, width, height, depth > 16 ? 32 : depth > 8 ? 16 : 8, 0); if (*ximg == NULL) @@ -2910,7 +2913,7 @@ x_create_xrender_picture (struct frame *f, Emacs_Pixmap pixmap, int depth) if (FRAME_DISPLAY_INFO (f)->xrender_supported_p) { if (depth <= 0) - depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f)); + depth = FRAME_DISPLAY_INFO (f)->n_planes; if (depth == 32 || depth == 24 || depth == 8 || depth == 4 || depth == 1) { /* FIXME: Do we need to handle all possible bit depths? @@ -3402,7 +3405,7 @@ slurp_file (int fd, ptrdiff_t *size) if (fp) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_ptr (fclose_unwind, fp); if (fstat (fileno (fp), &st) == 0 @@ -3678,6 +3681,48 @@ xbm_scan (char **s, char *end, char *sval, int *ival) *ival = value; return overflow ? XBM_TK_OVERFLOW : XBM_TK_NUMBER; } + /* Character literal. XBM images typically contain hex escape + sequences and not actual characters, so we only try to handle + that here. */ + else if (c == '\'') + { + int value = 0, digit; + bool overflow = false; + + if (*s == end) + return 0; + + c = *(*s)++; + + if (c != '\\' || *s == end) + return 0; + + c = *(*s)++; + + if (c == 'x') + { + while (*s < end) + { + c = *(*s)++; + + if (c == '\'') + { + *ival = value; + return overflow ? XBM_TK_OVERFLOW : XBM_TK_NUMBER; + } + + digit = char_hexdigit (c); + + if (digit < 0) + return 0; + + overflow |= INT_MULTIPLY_WRAPV (value, 16, &value); + value += digit; + } + } + + return 0; + } else if (c_isalpha (c) || c == '_') { *sval++ = c; @@ -3801,7 +3846,7 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data, data, img->width, img->height, fg, bg, - DefaultDepthOfScreen (FRAME_X_SCREEN (f))); + FRAME_DISPLAY_INFO (f)->n_planes); # if !defined USE_CAIRO && defined HAVE_XRENDER if (img->pixmap) img->picture = x_create_xrender_picture (f, img->pixmap, 0); @@ -3816,6 +3861,21 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data, convert_mono_to_color_image (f, img, fg, bg); #elif defined HAVE_NS img->pixmap = ns_image_from_XBM (data, img->width, img->height, fg, bg); +#elif defined HAVE_HAIKU + img->pixmap = BBitmap_new (img->width, img->height, 0); + + if (img->pixmap) + { + int bytes_per_line = (img->width + 7) / 8; + + for (int y = 0; y < img->height; y++) + { + for (int x = 0; x < img->width; x++) + PUT_PIXEL (img->pixmap, x, y, + (data[x / 8] >> (x % 8)) & 1 ? fg : bg); + data += bytes_per_line; + } + } #endif } @@ -4000,6 +4060,7 @@ xbm_load_image (struct frame *f, struct image *img, char *contents, char *end) rc = xbm_read_bitmap_data (f, contents, end, &img->width, &img->height, &data, 0); + if (rc) { unsigned long foreground = img->face_foreground; @@ -4632,8 +4693,10 @@ xpm_load (struct frame *f, struct image *img) #ifndef HAVE_NTGUI attrs.visual = FRAME_X_VISUAL (f); attrs.colormap = FRAME_X_COLORMAP (f); + attrs.depth = FRAME_DISPLAY_INFO (f)->n_planes; attrs.valuemask |= XpmVisual; attrs.valuemask |= XpmColormap; + attrs.valuemask |= XpmDepth; #endif /* HAVE_NTGUI */ #ifdef ALLOC_XPM_COLORS @@ -11024,7 +11087,7 @@ gs_load (struct frame *f, struct image *img) block_input (); img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), img->width, img->height, - DefaultDepthOfScreen (FRAME_X_SCREEN (f))); + FRAME_DISPLAY_INFO (f)->n_planes); unblock_input (); } diff --git a/src/indent.c b/src/indent.c index 5c21cd8f99d..d5ad02ae3af 100644 --- a/src/indent.c +++ b/src/indent.c @@ -468,31 +468,40 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) { Lisp_Object val, overlay; - if (CONSP (val = get_char_property_and_overlay - (make_fixnum (pos), Qdisplay, Qnil, &overlay)) - && EQ (Qspace, XCAR (val))) - { /* FIXME: Use calc_pixel_width_or_height. */ - Lisp_Object plist = XCDR (val), prop; + if (!NILP (val = get_char_property_and_overlay (make_fixnum (pos), Qdisplay, + Qnil, &overlay))) + { int width = -1; - EMACS_INT align_to_max = - (col < MOST_POSITIVE_FIXNUM - INT_MAX - ? (EMACS_INT) INT_MAX + col - : MOST_POSITIVE_FIXNUM); - - if ((prop = Fplist_get (plist, QCwidth), - RANGED_FIXNUMP (0, prop, INT_MAX)) - || (prop = Fplist_get (plist, QCrelative_width), - RANGED_FIXNUMP (0, prop, INT_MAX))) - width = XFIXNUM (prop); - else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop) - && XFLOAT_DATA (prop) <= INT_MAX) - width = (int)(XFLOAT_DATA (prop) + 0.5); - else if ((prop = Fplist_get (plist, QCalign_to), - RANGED_FIXNUMP (col, prop, align_to_max))) - width = XFIXNUM (prop) - col; - else if (FLOATP (prop) && col <= XFLOAT_DATA (prop) - && (XFLOAT_DATA (prop) <= align_to_max)) - width = (int)(XFLOAT_DATA (prop) + 0.5) - col; + Lisp_Object plist = Qnil; + + /* Handle '(space ...)' display specs. */ + if (CONSP (val) && EQ (Qspace, XCAR (val))) + { /* FIXME: Use calc_pixel_width_or_height. */ + Lisp_Object prop; + EMACS_INT align_to_max = + (col < MOST_POSITIVE_FIXNUM - INT_MAX + ? (EMACS_INT) INT_MAX + col + : MOST_POSITIVE_FIXNUM); + + plist = XCDR (val); + if ((prop = Fplist_get (plist, QCwidth), + RANGED_FIXNUMP (0, prop, INT_MAX)) + || (prop = Fplist_get (plist, QCrelative_width), + RANGED_FIXNUMP (0, prop, INT_MAX))) + width = XFIXNUM (prop); + else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop) + && XFLOAT_DATA (prop) <= INT_MAX) + width = (int)(XFLOAT_DATA (prop) + 0.5); + else if ((prop = Fplist_get (plist, QCalign_to), + RANGED_FIXNUMP (col, prop, align_to_max))) + width = XFIXNUM (prop) - col; + else if (FLOATP (prop) && col <= XFLOAT_DATA (prop) + && (XFLOAT_DATA (prop) <= align_to_max)) + width = (int)(XFLOAT_DATA (prop) + 0.5) - col; + } + /* Handle 'display' strings. */ + else if (STRINGP (val)) + width = XFIXNUM (Fstring_width (val, Qnil, Qnil)); if (width >= 0) { @@ -504,7 +513,8 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) /* For :relative-width, we need to multiply by the column width of the character at POS, if it is greater than 1. */ - if (!NILP (Fplist_get (plist, QCrelative_width)) + if (!NILP (plist) + && !NILP (Fplist_get (plist, QCrelative_width)) && !NILP (BVAR (current_buffer, enable_multibyte_characters))) { int b, wd; @@ -516,6 +526,7 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos) return width; } } + return -1; } @@ -1968,7 +1979,7 @@ line_number_display_width (struct window *w, int *width, int *pixel_width) struct text_pos startpos; bool saved_restriction = false; struct buffer *old_buf = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); SET_TEXT_POS_FROM_MARKER (startpos, w->start); void *itdata = bidi_shelve_cache (); @@ -2105,7 +2116,7 @@ whether or not it is currently displayed in some window. */) struct window *w; Lisp_Object lcols = Qnil; void *itdata = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Allow LINES to be of the form (HPOS . VPOS) aka (COLUMNS . LINES). */ if (CONSP (lines)) diff --git a/src/insdel.c b/src/insdel.c index d9ba222b1d1..6f180ac5800 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2134,7 +2134,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, Lisp_Object start, end; Lisp_Object start_marker, end_marker; Lisp_Object preserve_marker; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct rvoe_arg rvoe_arg; start = make_fixnum (start_int); @@ -2201,7 +2201,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, void signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct rvoe_arg rvoe_arg; Lisp_Object tmp, save_insert_behind_hooks, save_insert_in_from_hooks; @@ -2298,7 +2298,7 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute, doc: /* This function is for use internally in the function `combine-after-change-calls'. */) (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); ptrdiff_t beg, end, change; ptrdiff_t begpos, endpos; Lisp_Object tail; diff --git a/src/intervals.c b/src/intervals.c index ed374f16b53..687b237b9ea 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -2180,7 +2180,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type) { Lisp_Object prop, lispy_position, lispy_buffer; ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); position = clip_to_bounds (BUF_BEGV (buffer), position, BUF_ZV (buffer)); diff --git a/src/json.c b/src/json.c index 21a6df67857..db1be07f196 100644 --- a/src/json.c +++ b/src/json.c @@ -337,7 +337,7 @@ lisp_to_json_nonscalar_1 (Lisp_Object lisp, const struct json_configuration *conf) { json_t *json; - ptrdiff_t count; + specpdl_ref count; if (VECTORP (lisp)) { @@ -584,7 +584,7 @@ any JSON false values. usage: (json-serialize OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) @@ -693,7 +693,7 @@ OBJECT. usage: (json-insert OBJECT &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) @@ -950,7 +950,7 @@ represent a JSON false value. It defaults to `:false'. usage: (json-parse-string STRING &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) @@ -1047,7 +1047,7 @@ represent a JSON false value. It defaults to `:false'. usage: (json-parse-buffer &rest args) */) (ptrdiff_t nargs, Lisp_Object *args) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT if (!json_initialized) diff --git a/src/keyboard.c b/src/keyboard.c index 9242e8dc624..da8c6c54d85 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -682,7 +682,7 @@ add_command_key (Lisp_Object key) Lisp_Object recursive_edit_1 (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; if (command_loop_level > 0) @@ -776,7 +776,7 @@ throwing to \\='exit: This function is called by the editor initialization to begin editing. */) (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object buffer; /* If we enter while input is blocked, don't lock up here. @@ -939,7 +939,7 @@ static Lisp_Object cmd_error (Lisp_Object data) { Lisp_Object old_level, old_length; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object conditions; char macroerror[sizeof "After..kbd macro iterations: " + INT_STRLEN_BOUND (EMACS_INT)]; @@ -1232,7 +1232,7 @@ DEFUN ("internal--track-mouse", Finternal_track_mouse, Sinternal_track_mouse, doc: /* Call BODYFUN with mouse movement events enabled. */) (Lisp_Object bodyfun) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; record_unwind_protect (tracking_off, track_mouse); @@ -1355,7 +1355,7 @@ command_loop_1 (void) { /* Bind inhibit-quit to t so that C-g gets read in rather than quitting back to the minibuffer. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); sit_for (Vminibuffer_message_timeout, 0, 2); @@ -1487,7 +1487,7 @@ command_loop_1 (void) /* Here for a command that isn't executed directly. */ #ifdef HAVE_WINDOW_SYSTEM - ptrdiff_t scount = SPECPDL_INDEX (); + specpdl_ref scount = SPECPDL_INDEX (); if (display_hourglass_p && NILP (Vexecuting_kbd_macro)) @@ -1603,23 +1603,33 @@ command_loop_1 (void) if (current_buffer == prev_buffer && XBUFFER (XWINDOW (selected_window)->contents) == current_buffer - && last_point_position != PT - && NILP (Vdisable_point_adjustment) - && NILP (Vglobal_disable_point_adjustment)) + && last_point_position != PT) { - if (last_point_position > BEGV - && last_point_position < ZV - && (composition_adjust_point (last_point_position, - last_point_position) - != last_point_position)) - /* The last point was temporarily set within a grapheme - cluster to prevent automatic composition. To recover - the automatic composition, we must update the - display. */ - windows_or_buffers_changed = 21; - if (!already_adjusted) - adjust_point_for_property (last_point_position, - MODIFF != prev_modiff); + if (NILP (Vdisable_point_adjustment) + && NILP (Vglobal_disable_point_adjustment) + && !composition_break_at_point) + { + if (last_point_position > BEGV + && last_point_position < ZV + && (composition_adjust_point (last_point_position, + last_point_position) + != last_point_position)) + /* The last point was temporarily set within a grapheme + cluster to prevent automatic composition. To recover + the automatic composition, we must update the + display. */ + windows_or_buffers_changed = 21; + if (!already_adjusted) + adjust_point_for_property (last_point_position, + MODIFF != prev_modiff); + } + else if (PT > BEGV && PT < ZV + && (composition_adjust_point (last_point_position, PT) + != PT)) + /* Now point is within a grapheme cluster. We must update + the display so that this cluster is de-composed on the + screen and the cursor is correctly placed at point. */ + windows_or_buffers_changed = 39; } /* Install chars successfully executed in kbd macro. */ @@ -1633,7 +1643,7 @@ command_loop_1 (void) Lisp_Object read_menu_command (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* We don't want to echo the keystrokes while navigating the menus. */ @@ -1878,7 +1888,7 @@ safe_run_hook_funcall (ptrdiff_t nargs, Lisp_Object *args) void safe_run_hooks (Lisp_Object hook) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); run_hook_with_args (2, ((Lisp_Object []) {hook, hook}), safe_run_hook_funcall); @@ -2211,7 +2221,7 @@ read_event_from_main_queue (struct timespec *end_time, return c; /* Actually read a character, waiting if necessary. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); save_getcjmp (save_jump); record_unwind_protect_ptr (restore_getcjmp, save_jump); restore_getcjmp (local_getcjmp); @@ -2413,7 +2423,6 @@ read_char (int commandflag, Lisp_Object map, bool *used_mouse_menu, struct timespec *end_time) { Lisp_Object c; - ptrdiff_t jmpcount; sys_jmp_buf local_getcjmp; sys_jmp_buf save_jump; Lisp_Object tem, save; @@ -2655,7 +2664,7 @@ read_char (int commandflag, Lisp_Object map, around any call to sit_for or kbd_buffer_get_event; it *must not* be in effect when we call redisplay. */ - jmpcount = SPECPDL_INDEX (); + specpdl_ref jmpcount = SPECPDL_INDEX (); if (sys_setjmp (local_getcjmp)) { /* Handle quits while reading the keyboard. */ @@ -2738,7 +2747,7 @@ read_char (int commandflag, Lisp_Object map, { Lisp_Object tem0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); save_getcjmp (save_jump); record_unwind_protect_ptr (restore_getcjmp, save_jump); restore_getcjmp (local_getcjmp); @@ -2815,7 +2824,7 @@ read_char (int commandflag, Lisp_Object map, timeout = min (timeout, MOST_POSITIVE_FIXNUM / delay_level * 4); timeout = delay_level * timeout / 4; - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); save_getcjmp (save_jump); record_unwind_protect_ptr (restore_getcjmp, save_jump); restore_getcjmp (local_getcjmp); @@ -3059,13 +3068,12 @@ read_char (int commandflag, Lisp_Object map, /* Now wipe the echo area, except for help events which do their own stuff with the echo area. */ - if (!NILP (Vecho_keystrokes) - && (!CONSP (c) - || (!(EQ (Qhelp_echo, XCAR (c))) - && !(EQ (Qswitch_frame, XCAR (c))) - /* Don't wipe echo area for select window events: These might - get delayed via `mouse-autoselect-window' (Bug#11304). */ - && !(EQ (Qselect_window, XCAR (c)))))) + if (!CONSP (c) + || (!(EQ (Qhelp_echo, XCAR (c))) + && !(EQ (Qswitch_frame, XCAR (c))) + /* Don't wipe echo area for select window events: These might + get delayed via `mouse-autoselect-window' (Bug#11304). */ + && !(EQ (Qselect_window, XCAR (c))))) { if (!NILP (echo_area_buffer[0])) { @@ -3099,7 +3107,7 @@ read_char (int commandflag, Lisp_Object map, Lisp_Object keys; ptrdiff_t key_count; ptrdiff_t command_key_start; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Save the echo status. */ bool saved_immediate_echo = current_kboard->immediate_echo; @@ -3224,7 +3232,7 @@ read_char (int commandflag, Lisp_Object map, /* Process the help character specially if enabled. */ if (!NILP (Vhelp_form) && help_char_p (c)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); help_form_saved_window_configs = Fcons (Fcurrent_window_configuration (Qnil), @@ -3827,6 +3835,26 @@ clear_event (struct input_event *event) event->kind = NO_EVENT; } +static Lisp_Object +kbd_buffer_get_event_1 (Lisp_Object arg) +{ + Lisp_Object coding_system = Fget_text_property (make_fixnum (0), + Qcoding, arg); + + if (EQ (coding_system, Qt)) + return arg; + + return code_convert_string (arg, (!NILP (coding_system) + ? coding_system + : Vlocale_coding_system), + Qnil, 0, false, 0); +} + +static Lisp_Object +kbd_buffer_get_event_2 (Lisp_Object val) +{ + return Qnil; +} /* Read one event from the event buffer, waiting if necessary. The value is a Lisp object representing the event. @@ -3839,7 +3867,7 @@ kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu, struct timespec *end_time) { - Lisp_Object obj; + Lisp_Object obj, str; #ifdef subprocesses if (kbd_on_hold_p () && kbd_buffer_nr_stored () < KBD_BUFFER_SIZE / 4) @@ -3865,6 +3893,8 @@ kbd_buffer_get_event (KBOARD **kbp, } #endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED */ + *kbp = current_kboard; + /* Wait until there is input available. */ for (;;) { @@ -4112,6 +4142,47 @@ kbd_buffer_get_event (KBOARD **kbp, } } + if (event->kind == MULTIBYTE_CHAR_KEYSTROKE_EVENT + /* This string has to be decoded. */ + && STRINGP (event->ie.arg)) + { + str = internal_condition_case_1 (kbd_buffer_get_event_1, + event->ie.arg, Qt, + kbd_buffer_get_event_2); + + /* Decoding the string failed, so use the original, + where at least ASCII text will work. */ + if (NILP (str)) + str = event->ie.arg; + + if (!SCHARS (str)) + { + kbd_fetch_ptr = next_kbd_event (event); + obj = Qnil; + break; + } + + /* car is the index of the next character in the + string that will be sent and cdr is the string + itself. */ + event->ie.arg = Fcons (make_fixnum (0), str); + } + + if (event->kind == MULTIBYTE_CHAR_KEYSTROKE_EVENT + && CONSP (event->ie.arg)) + { + eassert (FIXNUMP (XCAR (event->ie.arg))); + eassert (STRINGP (XCDR (event->ie.arg))); + eassert (XFIXNUM (XCAR (event->ie.arg)) + < SCHARS (XCDR (event->ie.arg))); + + event->ie.code = XFIXNUM (Faref (XCDR (event->ie.arg), + XCAR (event->ie.arg))); + + XSETCAR (event->ie.arg, + make_fixnum (XFIXNUM (XCAR (event->ie.arg)) + 1)); + } + obj = make_lispy_event (&event->ie); #ifdef HAVE_EXT_MENU_BAR @@ -4134,9 +4205,15 @@ kbd_buffer_get_event (KBOARD **kbp, *used_mouse_menu = true; #endif - /* Wipe out this event, to catch bugs. */ - clear_event (&event->ie); - kbd_fetch_ptr = next_kbd_event (event); + if (event->kind != MULTIBYTE_CHAR_KEYSTROKE_EVENT + || !CONSP (event->ie.arg) + || (XFIXNUM (XCAR (event->ie.arg)) + >= SCHARS (XCDR (event->ie.arg)))) + { + /* Wipe out this event, to catch bugs. */ + clear_event (&event->ie); + kbd_fetch_ptr = next_kbd_event (event); + } } } } @@ -4440,7 +4517,7 @@ timer_check_2 (Lisp_Object timers, Lisp_Object idle_timers) { if (NILP (AREF (chosen_timer, 0))) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object old_deactivate_mark = Vdeactivate_mark; /* Mark the timer as triggered to prevent problems if the lisp @@ -7853,7 +7930,7 @@ eval_dyn (Lisp_Object form) Lisp_Object menu_item_eval_property (Lisp_Object sexpr) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; specbind (Qinhibit_redisplay, Qt); val = internal_condition_case_1 (eval_dyn, sexpr, Qerror, @@ -9520,7 +9597,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, bool dont_downcase_last, bool can_return_switch_frame, bool fix_current_buffer, bool prevent_redisplay) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* How many keys there are in the current key sequence. */ int t; @@ -10456,7 +10533,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo, Lisp_Object can_return_switch_frame, Lisp_Object cmd_loop, bool allow_string) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!NILP (prompt)) CHECK_STRING (prompt); @@ -10924,7 +11001,7 @@ Some operating systems cannot stop the Emacs process and resume it later. On such systems, Emacs starts a subshell instead of suspending. */) (Lisp_Object stuffstring) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int old_height, old_width; int width, height; @@ -12410,6 +12487,9 @@ See also `pre-command-hook'. */); DEFSYM (Qtouchscreen_end, "touchscreen-end"); DEFSYM (Qtouchscreen_update, "touchscreen-update"); DEFSYM (Qpinch, "pinch"); + + DEFSYM (Qcoding, "coding"); + Fset (Qecho_area_clear_hook, Qnil); DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag, diff --git a/src/keymap.c b/src/keymap.c index ed69b1c4277..83c54e26300 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1650,7 +1650,7 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and like in the respective argument of `key-binding'. */) (Lisp_Object olp, Lisp_Object position) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object keymaps = list1 (current_global_map); @@ -3031,7 +3031,7 @@ This is text showing the elements of vector matched against indices. DESCRIBER is the output function used; nil means use `princ'. */) (Lisp_Object vector, Lisp_Object describer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (NILP (describer)) describer = intern ("princ"); specbind (Qstandard_output, Fcurrent_buffer ()); @@ -3077,7 +3077,7 @@ the one in this keymap, we ignore this one. */) Lisp_Object partial, Lisp_Object shadow, Lisp_Object entire_map, Lisp_Object mention_shadow) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qstandard_output, Fcurrent_buffer ()); CHECK_VECTOR_OR_CHAR_TABLE (vector); diff --git a/src/lisp.h b/src/lisp.h index 9f1d093f581..deeca9bc86b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -365,26 +365,29 @@ typedef EMACS_INT Lisp_Word; ((ok) ? (void) 0 : wrong_type_argument (predicate, x)) #define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons) #define lisp_h_BASE_EQ(x, y) (XLI (x) == XLI (y)) -/* #define lisp_h_EQ(x, y) (XLI (x) == XLI (y)) */ - -#define lisp_h_EQ(x, y) ((XLI ((x)) == XLI ((y))) \ - || (symbols_with_pos_enabled \ - && (SYMBOL_WITH_POS_P ((x)) \ - ? BARE_SYMBOL_P ((y)) \ - ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y) \ - : SYMBOL_WITH_POS_P((y)) \ - && (XLI (XSYMBOL_WITH_POS((x))->sym) \ - == XLI (XSYMBOL_WITH_POS((y))->sym)) \ - : (SYMBOL_WITH_POS_P ((y)) \ - && BARE_SYMBOL_P ((x)) \ - && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym)))))) + +/* FIXME: Do we really need to inline the whole thing? + * What about keeping the part after `symbols_with_pos_enabled` in + * a separate function? */ +#define lisp_h_EQ(x, y) \ + ((XLI ((x)) == XLI ((y))) \ + || (symbols_with_pos_enabled \ + && (SYMBOL_WITH_POS_P ((x)) \ + ? (BARE_SYMBOL_P ((y)) \ + ? XLI (XSYMBOL_WITH_POS((x))->sym) == XLI (y) \ + : SYMBOL_WITH_POS_P((y)) \ + && (XLI (XSYMBOL_WITH_POS((x))->sym) \ + == XLI (XSYMBOL_WITH_POS((y))->sym))) \ + : (SYMBOL_WITH_POS_P ((y)) \ + && BARE_SYMBOL_P ((x)) \ + && (XLI (x) == XLI ((XSYMBOL_WITH_POS ((y)))->sym)))))) #define lisp_h_FIXNUMP(x) \ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \ - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \ & ((1 << INTTYPEBITS) - 1))) #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float) -#define lisp_h_NILP(x) /* x == Qnil */ /* ((XLI (x) == XLI (Qnil))) */ /* EQ (x, Qnil) */ BASE_EQ (x, Qnil) +#define lisp_h_NILP(x) BASE_EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ (sym)->u.s.val.value = (v)) @@ -617,6 +620,7 @@ extern bool symbols_with_pos_enabled; extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object default_value (Lisp_Object symbol); +extern void defalias (Lisp_Object symbol, Lisp_Object definition); /* Defined in emacs.c. */ @@ -3280,6 +3284,7 @@ enum specbind_tag { SPECPDL_UNWIND_EXCURSION, /* Likewise, on an excursion. */ SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ + SPECPDL_NOP, /* A filler. */ #ifdef HAVE_MODULES SPECPDL_MODULE_RUNTIME, /* A live module runtime. */ SPECPDL_MODULE_ENVIRONMENT, /* A live module environment. */ @@ -3333,9 +3338,6 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; /* `where' is not used in the case of SPECPDL_LET. */ Lisp_Object symbol, old_value, where; - /* Normally this is unused; but it is set to the symbol's - current value when a thread is swapped out. */ - Lisp_Object saved_value; } let; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; @@ -3346,10 +3348,102 @@ union specbinding } bt; }; +/* We use 64-bit platforms as a proxy for ones with ABIs that treat + small structs efficiently. */ +#if SIZE_MAX > 0xffffffff +#define WRAP_SPECPDL_REF 1 +#endif + +/* Abstract reference to to a specpdl entry. + The number is always a multiple of sizeof (union specbinding). */ +#ifdef WRAP_SPECPDL_REF +/* Use a proper type for specpdl_ref if it does not make the code slower, + since the type checking is quite useful. */ +typedef struct { ptrdiff_t bytes; } specpdl_ref; +#else +typedef ptrdiff_t specpdl_ref; +#endif + +/* Internal use only. */ +INLINE specpdl_ref +wrap_specpdl_ref (ptrdiff_t bytes) +{ +#ifdef WRAP_SPECPDL_REF + return (specpdl_ref){.bytes = bytes}; +#else + return bytes; +#endif +} + +/* Internal use only. */ INLINE ptrdiff_t +unwrap_specpdl_ref (specpdl_ref ref) +{ +#ifdef WRAP_SPECPDL_REF + return ref.bytes; +#else + return ref; +#endif +} + +INLINE specpdl_ref +specpdl_count_to_ref (ptrdiff_t count) +{ + return wrap_specpdl_ref (count * sizeof (union specbinding)); +} + +INLINE ptrdiff_t +specpdl_ref_to_count (specpdl_ref ref) +{ + return unwrap_specpdl_ref (ref) / sizeof (union specbinding); +} + +/* Whether two `specpdl_ref' refer to the same entry. */ +INLINE bool +specpdl_ref_eq (specpdl_ref a, specpdl_ref b) +{ + return unwrap_specpdl_ref (a) == unwrap_specpdl_ref (b); +} + +/* Whether `a' refers to an earlier entry than `b'. */ +INLINE bool +specpdl_ref_lt (specpdl_ref a, specpdl_ref b) +{ + return unwrap_specpdl_ref (a) < unwrap_specpdl_ref (b); +} + +INLINE bool +specpdl_ref_valid_p (specpdl_ref ref) +{ + return unwrap_specpdl_ref (ref) >= 0; +} + +INLINE specpdl_ref +make_invalid_specpdl_ref (void) +{ + return wrap_specpdl_ref (-1); +} + +/* Return a reference that is `delta' steps more recent than `ref'. + `delta' may be negative or zero. */ +INLINE specpdl_ref +specpdl_ref_add (specpdl_ref ref, ptrdiff_t delta) +{ + return wrap_specpdl_ref (unwrap_specpdl_ref (ref) + + delta * sizeof (union specbinding)); +} + +INLINE union specbinding * +specpdl_ref_to_ptr (specpdl_ref ref) +{ + return (union specbinding *)((char *)specpdl + unwrap_specpdl_ref (ref)); +} + +/* Return a reference to the most recent specpdl entry. */ +INLINE specpdl_ref SPECPDL_INDEX (void) { - return specpdl_ptr - specpdl; + return wrap_specpdl_ref ((char *)specpdl_ptr - (char *)specpdl); } INLINE bool @@ -3415,7 +3509,7 @@ struct handler but a few others are handled by storing their value here. */ sys_jmp_buf jmp; EMACS_INT f_lisp_eval_depth; - ptrdiff_t pdlcount; + specpdl_ref pdlcount; int poll_suppress_count; int interrupt_input_blocked; }; @@ -4174,7 +4268,7 @@ extern struct Lisp_Vector *allocate_pseudovector (int, int, int, extern bool gc_in_progress; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); -extern ptrdiff_t inhibit_garbage_collection (void); +extern specpdl_ref inhibit_garbage_collection (void); extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_cons (struct Lisp_Cons *); @@ -4352,18 +4446,20 @@ extern void record_unwind_protect_void (void (*) (void)); extern void record_unwind_protect_excursion (void); extern void record_unwind_protect_nothing (void); extern void record_unwind_protect_module (enum specbind_tag, void *); -extern void clear_unwind_protect (ptrdiff_t); -extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object); -extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *); -extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); -extern void rebind_for_thread_switch (void); -extern void unbind_for_thread_switch (struct thread_state *); +extern void clear_unwind_protect (specpdl_ref); +extern void set_unwind_protect (specpdl_ref, void (*) (Lisp_Object), + Lisp_Object); +extern void set_unwind_protect_ptr (specpdl_ref, void (*) (void *), void *); +extern Lisp_Object unbind_to (specpdl_ref, Lisp_Object); +void specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only); extern AVOID error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern AVOID verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); extern Lisp_Object vformat_string (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); -extern void un_autoload (Lisp_Object); +extern Lisp_Object load_with_autoload_queue + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, + Lisp_Object nosuffix, Lisp_Object must_suffix); extern Lisp_Object call_debugger (Lisp_Object arg); extern void init_eval_once (void); extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); @@ -4372,12 +4468,12 @@ 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 ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); +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); extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); -void do_debug_on_call (Lisp_Object code, ptrdiff_t count); +void do_debug_on_call (Lisp_Object code, specpdl_ref count); Lisp_Object funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args); @@ -5048,7 +5144,7 @@ extern void *record_xmalloc (size_t) #define USE_SAFE_ALLOCA \ ptrdiff_t sa_avail = MAX_ALLOCA; \ - ptrdiff_t sa_count = SPECPDL_INDEX () + specpdl_ref sa_count = SPECPDL_INDEX () #define AVAIL_ALLOCA(size) (sa_avail -= (size), alloca (size)) @@ -5086,9 +5182,9 @@ extern void *record_xmalloc (size_t) #define SAFE_FREE() safe_free (sa_count) INLINE void -safe_free (ptrdiff_t sa_count) +safe_free (specpdl_ref sa_count) { - while (specpdl_ptr != specpdl + sa_count) + while (specpdl_ptr != specpdl_ref_to_ptr (sa_count)) { specpdl_ptr--; if (specpdl_ptr->kind == SPECPDL_UNWIND_PTR) @@ -5114,9 +5210,9 @@ safe_free (ptrdiff_t sa_count) safe_free_unbind_to (count, sa_count, val) INLINE Lisp_Object -safe_free_unbind_to (ptrdiff_t count, ptrdiff_t sa_count, Lisp_Object val) +safe_free_unbind_to (specpdl_ref count, specpdl_ref sa_count, Lisp_Object val) { - eassert (count <= sa_count); + eassert (!specpdl_ref_lt (sa_count, count)); return unbind_to (count, val); } diff --git a/src/lread.c b/src/lread.c index ec54d2d81ad..0486a98883c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -705,13 +705,8 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, /* Read until we get an acceptable event. */ retry: do - { - ptrdiff_t count = SPECPDL_INDEX (); - specbind (Qecho_keystrokes, Qnil); - val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0, - NUMBERP (seconds) ? &end_time : NULL); - unbind_to (count, Qnil); - } + val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0, + NUMBERP (seconds) ? &end_time : NULL); while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */ if (BUFFERP (val)) @@ -1174,6 +1169,13 @@ compute_found_effective (Lisp_Object found) return concat2 (src_name, build_string ("c")); } +static void +loadhist_initialize (Lisp_Object filename) +{ + eassert (STRINGP (filename) || NILP (filename)); + specbind (Qcurrent_load_list, Fcons (filename, Qnil)); +} + DEFUN ("load", Fload, Sload, 1, 5, 0, doc: /* Execute a file of Lisp code named FILE. First try FILE with `.elc' appended, then try with `.el', then try @@ -1224,8 +1226,8 @@ Return t if the file exists and loads successfully. */) { FILE *stream UNINIT; int fd; - int fd_index UNINIT; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref fd_index UNINIT; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object found, efound, hist_file_name; /* True means we printed the ".el is newer" message. */ bool newer = 0; @@ -1557,8 +1559,7 @@ Return t if the file exists and loads successfully. */) if (is_module) { #ifdef HAVE_MODULES - specbind (Qcurrent_load_list, Qnil); - LOADHIST_ATTACH (found); + loadhist_initialize (found); Fmodule_load (found); build_load_history (found, true); #else @@ -1569,8 +1570,7 @@ Return t if the file exists and loads successfully. */) else if (is_native_elisp) { #ifdef HAVE_NATIVE_COMP - specbind (Qcurrent_load_list, Qnil); - LOADHIST_ATTACH (hist_file_name); + loadhist_initialize (hist_file_name); Fnative_elisp_load (found, Qnil); build_load_history (hist_file_name, true); #else @@ -1633,7 +1633,7 @@ save_match_data_load (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_save_match_data (); Lisp_Object result = Fload (file, noerror, nomessage, nosuffix, must_suffix); return unbind_to (count, result); @@ -2169,7 +2169,7 @@ readevalloop (Lisp_Object readcharfun, { int c; Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct buffer *b = 0; bool continue_reading_p; Lisp_Object lex_bound; @@ -2179,6 +2179,9 @@ readevalloop (Lisp_Object readcharfun, bool first_sexp = 1; Lisp_Object macroexpand = intern ("internal-macroexpand-for-load"); + if (!NILP (sourcename)) + CHECK_STRING (sourcename); + if (NILP (Ffboundp (macroexpand)) || (STRINGP (sourcename) && suffix_p (sourcename, ".elc"))) /* Don't macroexpand before the corresponding function is defined @@ -2202,7 +2205,6 @@ readevalloop (Lisp_Object readcharfun, emacs_abort (); specbind (Qstandard_input, readcharfun); - specbind (Qcurrent_load_list, Qnil); record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte); load_convert_to_unibyte = !NILP (unibyte); @@ -2220,12 +2222,12 @@ readevalloop (Lisp_Object readcharfun, && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))) sourcename = Fexpand_file_name (sourcename, Qnil); - LOADHIST_ATTACH (sourcename); + loadhist_initialize (sourcename); continue_reading_p = 1; while (continue_reading_p) { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); if (b != 0 && !BUFFER_LIVE_P (b)) error ("Reading from killed buffer"); @@ -2380,7 +2382,7 @@ will be evaluated without lexical binding. This function preserves the position of point. */) (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object tem, buf; if (NILP (buffer)) @@ -2425,7 +2427,7 @@ This function does not move point. */) (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function) { /* FIXME: Do the eval-sexp-add-defvars dance! */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object tem, cbuf; cbuf = Fcurrent_buffer (); @@ -2600,7 +2602,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) static char * grow_read_buffer (char *buf, ptrdiff_t offset, - char **buf_addr, ptrdiff_t *buf_size, ptrdiff_t count) + char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count) { char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1); if (!*buf_addr) @@ -2953,7 +2955,7 @@ read_integer (Lisp_Object readcharfun, int radix, char *p = read_buffer; char *heapbuf = NULL; int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int c = READCHAR; if (c == '-' || c == '+') @@ -3613,7 +3615,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms) case '"': { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); char *read_buffer = stackbuf; ptrdiff_t read_buffer_size = sizeof stackbuf; char *heapbuf = NULL; @@ -3757,7 +3759,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list, bool locate_syms) read_symbol: { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); char *read_buffer = stackbuf; ptrdiff_t read_buffer_size = sizeof stackbuf; char *heapbuf = NULL; @@ -4631,7 +4633,9 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff if (EQ (bucket, make_fixnum (0))) ; else if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); /* Like CADR error message. */ + /* Like CADR error message. */ + xsignal2 (Qwrong_type_argument, Qobarrayp, + build_string ("Bad data in guts of obarray")); else for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next)) { @@ -5245,12 +5249,9 @@ for symbols and features not associated with any file. The remaining ENTRIES in the alist element describe the functions and variables defined in that file, the features provided, and the features required. Each entry has the form `(provide . FEATURE)', -`(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)', -`(defface . SYMBOL)', `(define-type . SYMBOL)', -`(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'. -Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry, -and mean that SYMBOL was an autoload before this file redefined it -as a function. In addition, entries may also be single symbols, +`(require . FEATURE)', `(defun . FUNCTION)', `(defface . SYMBOL)', + `(define-type . SYMBOL)', or `(cl-defmethod METHOD SPECIALIZERS)'. +In addition, entries may also be single symbols, which means that symbol was defined by `defvar' or `defconst'. During preloading, the file name recorded is relative to the main Lisp @@ -5446,6 +5447,7 @@ This variable's value can only be set via file-local variables. See Info node `(elisp)Shorthands' for more details. */); Vread_symbol_shorthands = Qnil; DEFSYM (Qobarray_cache, "obarray-cache"); + DEFSYM (Qobarrayp, "obarrayp"); DEFSYM (Qmacroexp__dynvars, "macroexp--dynvars"); DEFVAR_LISP ("macroexp--dynvars", Vmacroexp__dynvars, diff --git a/src/macfont.m b/src/macfont.m index f623c3ca2f5..34e48afb98f 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -3570,7 +3570,10 @@ mac_font_create_preferred_family_for_attributes (CFDictionaryRef attributes) if (languages && CFArrayGetCount (languages) > 0) { - if (CTGetCoreTextVersion () >= kCTVersionNumber10_9) + if ([[NSProcessInfo processInfo] + isOperatingSystemAtLeastVersion: + ((NSOperatingSystemVersion){ + .majorVersion = 10, .minorVersion = 9})]) values[num_values++] = CFArrayGetValueAtIndex (languages, 0); else { diff --git a/src/macros.c b/src/macros.c index 3d00c28838d..0447a367fd6 100644 --- a/src/macros.c +++ b/src/macros.c @@ -287,7 +287,7 @@ buffer before the macro is executed. */) { Lisp_Object final; Lisp_Object tem; - ptrdiff_t pdlcount = SPECPDL_INDEX (); + specpdl_ref pdlcount = SPECPDL_INDEX (); EMACS_INT repeat = 1; EMACS_INT success_count = 0; diff --git a/src/menu.c b/src/menu.c index 18ecaf0b0ba..398bf9329ff 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1121,7 +1121,7 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) struct frame *f = NULL; Lisp_Object x, y, window; int menuflags = 0; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); if (NILP (position)) /* This is an obsolete call, which wants us to precompute the @@ -1391,9 +1391,9 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) } #endif -#ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */ record_unwind_protect_void (discard_menu_items); -#endif + + run_hook (Qx_pre_popup_menu_hook); /* Display them in a menu, but not if F is the initial frame that doesn't have its hooks set (e.g., in a batch session), because @@ -1402,13 +1402,13 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu) selection = FRAME_TERMINAL (f)->menu_show_hook (f, xpos, ypos, menuflags, title, &error_name); -#ifdef HAVE_NS unbind_to (specpdl_count, Qnil); -#else - discard_menu_items (); -#endif -#ifdef HAVE_NTGUI /* FIXME: Is it really w32-specific? --Stef */ +#ifdef HAVE_NTGUI /* W32 specific because other terminals clear + the grab inside their `menu_show_hook's if + it's actually required (i.e. there isn't a + way to query the buttons currently held down + after XMenuActivate). */ if (FRAME_W32_P (f)) FRAME_DISPLAY_INFO (f)->grabbed = 0; #endif @@ -1602,6 +1602,14 @@ syms_of_menu (void) staticpro (&menu_items); DEFSYM (Qhide, "hide"); + DEFSYM (Qx_pre_popup_menu_hook, "x-pre-popup-menu-hook"); + + DEFVAR_LISP ("x-pre-popup-menu-hook", Vx_pre_popup_menu_hook, + doc: /* Hook run before `x-popup-menu' displays a popup menu. +It is only run before the menu is really going to be displayed. It +won't be run if `x-popup-menu' fails or returns for some other reason +(such as the keymap is invalid). */); + Vx_pre_popup_menu_hook = Qnil; defsubr (&Sx_popup_menu); defsubr (&Sx_popup_dialog); diff --git a/src/minibuf.c b/src/minibuf.c index d0e58b61f27..49a474dd492 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -578,7 +578,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, bool allow_props, bool inherit_input_method) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object mini_frame, ambient_dir, minibuffer, input_method; Lisp_Object calling_frame = selected_frame; Lisp_Object calling_window = selected_window; @@ -833,7 +833,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Erase the buffer. */ { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -991,7 +991,7 @@ nth_minibuffer (EMACS_INT depth) static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); Fset_buffer (buf); @@ -1155,7 +1155,7 @@ read_minibuf_unwind (void) /* Erase the minibuffer we were using at this level. */ { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Prevent error in erase-buffer. */ specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -1292,8 +1292,9 @@ Fifth arg HIST, if non-nil, specifies a history list and optionally HISTPOS is the initial position for use by the minibuffer history commands. For consistency, you should also specify that element of the history as the value of INITIAL-CONTENTS. Positions are counted - starting from 1 at the beginning of the list. If HIST is t, history - is not recorded. + starting from 1 at the beginning of the list. If HIST is nil, the + default history list `minibuffer-history' is used. If HIST is t, + history is not recorded. If `history-add-new-input' is non-nil (the default), the result will be added to the history list using `add-to-history'. @@ -1384,7 +1385,7 @@ Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits (Lisp_Object prompt, Lisp_Object initial_input, Lisp_Object history, Lisp_Object default_value, Lisp_Object inherit_input_method) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Just in case we're in a recursive minibuffer, make it clear that the previous minibuffer's completion table does not apply to the new @@ -1483,7 +1484,7 @@ function, instead of the usual behavior. */) Lisp_Object result; char *s; ptrdiff_t len; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (BUFFERP (def)) def = BVAR (XBUFFER (def), name); diff --git a/src/nsfns.m b/src/nsfns.m index 11132a294a5..1900616b9de 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1004,6 +1004,7 @@ frame_parm_handler ns_frame_parm_handlers[] = ns_set_z_group, 0, /* x_set_override_redirect */ gui_set_no_special_glyphs, + gui_set_alpha_background, #ifdef NS_IMPL_COCOA ns_set_appearance, ns_set_transparent_titlebar, @@ -1105,7 +1106,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, Lisp_Object name; int minibuffer_only = 0; long window_prompting = 0; - ptrdiff_t count = specpdl_ptr - specpdl; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct ns_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; @@ -1436,6 +1437,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qfullscreen, Qnil, "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); @@ -2820,7 +2823,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) { int root_x, root_y; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct frame *f; char *str; NSSize size; diff --git a/src/nsmenu.m b/src/nsmenu.m index 5df391bcbe1..81d7cd2da13 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -164,7 +164,7 @@ ns_update_menubar (struct frame *f, bool deep_p) struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); @@ -854,7 +854,7 @@ ns_menu_show (struct frame *f, int x, int y, int menuflags, EmacsMenu *pmenu; NSPoint p; Lisp_Object tem; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); widget_value *wv, *first_wv = 0; bool keymaps = (menuflags & MENU_KEYMAPS); @@ -1552,7 +1552,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) isQuestion: isQ]; { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_ptr (pop_down_menu, dialog); popup_activated_flag = 1; diff --git a/src/nsselect.m b/src/nsselect.m index 13ca9b9c442..a7ef9df0e0e 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -250,7 +250,7 @@ ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target) NSString *type; NSEnumerator *e = [[pb types] objectEnumerator]; - while (type = [e nextObject]) + while ((type = [e nextObject])) { NSString *val = [typeLookup valueForKey:type]; if (val && ! [types containsObject:val]) diff --git a/src/nsterm.m b/src/nsterm.m index a3c7b55218c..aba26ef7585 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5974,17 +5974,15 @@ not_in_argv (NSString *arg) /* Called on font panel selection. */ - (void)changeFont: (id)sender { - NSEvent *e = [[self window] currentEvent]; struct face *face = FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID); struct font *font = face->font; id newFont; CGFloat size; NSFont *nsfont; + struct input_event ie; NSTRACE ("[EmacsView changeFont:]"); - - if (!emacs_event) - return; + EVENT_INIT (ie); #ifdef NS_IMPL_GNUSTEP nsfont = ((struct nsfont_info *)font)->nsfont; @@ -5995,16 +5993,16 @@ not_in_argv (NSString *arg) if ((newFont = [sender convertFont: nsfont])) { - SET_FRAME_GARBAGED (emacsframe); /* now needed as of 2008/10 */ - - emacs_event->kind = NS_NONKEY_EVENT; - emacs_event->modifiers = 0; - emacs_event->code = KEY_NS_CHANGE_FONT; + ie.kind = NS_NONKEY_EVENT; + ie.modifiers = 0; + ie.code = KEY_NS_CHANGE_FONT; + XSETFRAME (ie.frame_or_window, emacsframe); size = [newFont pointSize]; ns_input_fontsize = make_fixnum (lrint (size)); ns_input_font = [[newFont familyName] lispString]; - EV_TRAILER (e); + + kbd_buffer_store_event (&ie); } } @@ -6798,6 +6796,7 @@ not_in_argv (NSString *arg) if (WINDOWP (window) && !EQ (window, last_mouse_window) && !EQ (window, selected_window) + && !MINI_WINDOW_P (XWINDOW (selected_window)) && (!NILP (focus_follows_mouse) || (EQ (XWINDOW (window)->frame, XWINDOW (selected_window)->frame)))) @@ -7933,25 +7932,6 @@ not_in_argv (NSString *arg) NSRect dstRect = NSMakeRect (dest.x, dest.y, NSWidth (srcRect), NSHeight (srcRect)); - NSRect frame = [self frame]; - - /* TODO: This check is an attempt to debug a rare graphical glitch - on macOS and should be removed before the Emacs 28 release. */ - if (!NSContainsRect (frame, srcRect) - || !NSContainsRect (frame, dstRect)) - { - NSLog (@"[EmacsView copyRect:to:] Attempting to copy to or " - "from an area outside the graphics buffer."); - NSLog (@" Frame: (%f, %f) %f×%f", - NSMinX (frame), NSMinY (frame), - NSWidth (frame), NSHeight (frame)); - NSLog (@" Source: (%f, %f) %f×%f", - NSMinX (srcRect), NSMinY (srcRect), - NSWidth (srcRect), NSHeight (srcRect)); - NSLog (@" Destination: (%f, %f) %f×%f", - NSMinX (dstRect), NSMinY (dstRect), - NSWidth (dstRect), NSHeight (dstRect)); - } #ifdef NS_IMPL_COCOA if ([self wantsLayer]) diff --git a/src/pdumper.c b/src/pdumper.c index 60280fcb043..f14239f863a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2948,7 +2948,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_19F6CF5169 +#if CHECK_STRUCTS && !defined HASH_pvec_type_AFF6FED5BD # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); @@ -3032,6 +3032,8 @@ dump_vectorlike (struct dump_context *ctx, error_unsupported_dump_object (ctx, lv, "sqlite"); case PVEC_MODULE_FUNCTION: error_unsupported_dump_object (ctx, lv, "module function"); + case PVEC_SYMBOL_WITH_POS: + error_unsupported_dump_object (ctx, lv, "symbol with pos"); default: error_unsupported_dump_object(ctx, lv, "weird pseudovector"); } @@ -4044,7 +4046,7 @@ types. */) } while (number_finalizers_run); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Bind `command-line-processed' to nil before dumping, so that the dumped Emacs will process its command line diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 9c37c04810c..dd2e305965a 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -235,6 +235,24 @@ x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } static void +pgtk_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + gui_set_alpha_background (f, arg, oldval); + + /* This prevents GTK from painting the window's background, which + interferes with transparent background in some environments */ + + gtk_widget_set_app_paintable (FRAME_GTK_OUTER_WIDGET (f), + f->alpha_background != 1.0); + + if (FRAME_GTK_OUTER_WIDGET (f) + && gtk_widget_get_realized (FRAME_GTK_OUTER_WIDGET (f)) + && f->alpha_background != 1.0) + gdk_window_set_opaque_region (gtk_widget_get_window (FRAME_GTK_OUTER_WIDGET (f)), + NULL); +} + +static void x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int pix; @@ -664,40 +682,6 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { } - -static void -x_icon (struct frame *f, Lisp_Object parms) -/* -------------------------------------------------------------------------- - Strangely-named function to set icon position parameters in frame. - This is irrelevant under macOS, but might be needed under GNUstep, - depending on the window manager used. Note, this is not a standard - frame parameter-setter; it is called directly from x-create-frame. - -------------------------------------------------------------------------- */ -{ -#if 0 - Lisp_Object icon_x, icon_y; - struct pgtk_display_info *dpyinfo = check_pgtk_display_info (Qnil); - - FRAME_X_OUTPUT (f)->icon_top = -1; - FRAME_X_OUTPUT (f)->icon_left = -1; - - /* Set the position of the icon. */ - icon_x = - gui_display_get_arg (dpyinfo, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER); - icon_y = - gui_display_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); - if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) - { - CHECK_NUMBER (icon_x); - CHECK_NUMBER (icon_y); - FRAME_X_OUTPUT (f)->icon_top = XFIXNUM (icon_y); - FRAME_X_OUTPUT (f)->icon_left = XFIXNUM (icon_x); - } - else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) - error ("Both left and top icon corners of icon must be specified"); -#endif -} - /** * x_set_undecorated: * @@ -862,6 +846,9 @@ pgtk_set_scroll_bar_foreground (struct frame *f, Lisp_Object new_value, GtkCssProvider *css_provider = FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider; + if (FRAME_TOOLTIP_P (f)) + return; + if (NILP (new_value)) { gtk_css_provider_load_from_data (css_provider, "", -1, NULL); @@ -874,13 +861,10 @@ pgtk_set_scroll_bar_foreground (struct frame *f, Lisp_Object new_value, if (!pgtk_parse_color (f, SSDATA (new_value), &rgb)) error ("Unknown color."); - /* On pgtk, this frame parameter should be ignored, and honor gtk theme. */ -#if 0 char css[64]; sprintf (css, "scrollbar slider { background-color: #%06x; }", (unsigned int) rgb.pixel & 0xffffff); gtk_css_provider_load_from_data (css_provider, css, -1, NULL); -#endif update_face_from_frame_parameter (f, Qscroll_bar_foreground, new_value); } @@ -907,13 +891,13 @@ pgtk_set_scroll_bar_background (struct frame *f, Lisp_Object new_value, if (!pgtk_parse_color (f, SSDATA (new_value), &rgb)) error ("Unknown color."); - /* On pgtk, this frame parameter should be ignored, and honor gtk theme. */ -#if 0 + /* On pgtk, this frame parameter should be ignored, and honor + gtk theme. (It honors the GTK theme if not explictly set, so + I see no harm in letting users tinker a bit more.) */ char css[64]; sprintf (css, "scrollbar trough { background-color: #%06x; }", (unsigned int) rgb.pixel & 0xffffff); gtk_css_provider_load_from_data (css_provider, css, -1, NULL); -#endif update_face_from_frame_parameter (f, Qscroll_bar_background, new_value); } @@ -1043,6 +1027,7 @@ frame_parm_handler pgtk_frame_parm_handlers[] = { x_set_z_group, x_set_override_redirect, gui_set_no_special_glyphs, + pgtk_set_alpha_background, }; @@ -1259,7 +1244,7 @@ This function is an internal primitive--use `make-frame' instead. */ ) bool minibuffer_only = false; bool undecorated = false, override_redirect = false; long window_prompting = 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct pgtk_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; @@ -1359,9 +1344,6 @@ This function is an internal primitive--use `make-frame' instead. */ ) f->output_method = output_pgtk; FRAME_X_OUTPUT (f) = xzalloc (sizeof *FRAME_X_OUTPUT (f)); -#if 0 - FRAME_X_OUTPUT (f)->icon_bitmap = -1; -#endif FRAME_FONTSET (f) = -1; FRAME_X_OUTPUT (f)->white_relief.pixel = -1; FRAME_X_OUTPUT (f)->black_relief.pixel = -1; @@ -1459,12 +1441,8 @@ This function is an internal primitive--use `make-frame' instead. */ ) error ("Invalid frame font"); } - /* Frame contents get displaced if an embedded X window has a border. */ -#if 0 - if (!FRAME_X_EMBEDDED_P (f)) -#endif - gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), - "borderWidth", "BorderWidth", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderWidth", "BorderWidth", RES_TYPE_NUMBER); if (NILP (Fassq (Qinternal_border_width, parms))) { @@ -1608,15 +1586,16 @@ This function is an internal primitive--use `make-frame' instead. */ ) RES_TYPE_BOOLEAN); f->no_split = minibuffer_only || EQ (tem, Qt); -#if 0 - x_icon_verify (f, parms); -#endif - - /* Create the X widget or window. */ - /* x_window (f); */ xg_create_frame_widgets (f); pgtk_set_event_handler (f); + if (FRAME_GTK_OUTER_WIDGET (f)) + gtk_widget_realize (FRAME_GTK_OUTER_WIDGET (f)); + + /* Many callers (including the Lisp functions that call + FRAME_SCALE_FACTOR) expect the widget to be realized. */ + if (FRAME_GTK_WIDGET (f)) + gtk_widget_realize (FRAME_GTK_WIDGET (f)); #define INSTALL_CURSOR(FIELD, NAME) \ FRAME_X_OUTPUT (f)->FIELD = gdk_cursor_new_for_display (FRAME_X_DISPLAY (f), GDK_ ## NAME) @@ -1639,11 +1618,6 @@ This function is an internal primitive--use `make-frame' instead. */ ) #undef INSTALL_CURSOR - x_icon (f, parms); -#if 0 - x_make_gc (f); -#endif - /* Now consider the frame official. */ f->terminal->reference_count++; FRAME_DISPLAY_INFO (f)->reference_count++; @@ -1667,6 +1641,8 @@ This function is an internal primitive--use `make-frame' instead. */ ) RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); if (!NILP (parent_frame)) { @@ -1741,13 +1717,21 @@ This function is an internal primitive--use `make-frame' instead. */ ) cannot control visibility, so don't try. */ if (!FRAME_X_OUTPUT (f)->explicit_parent) { + /* When called from `x-create-frame-with-faces' visibility is + always explicitly nil. */ Lisp_Object visibility - = - gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, - RES_TYPE_SYMBOL); + = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, + RES_TYPE_SYMBOL); + Lisp_Object height + = gui_display_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER); + Lisp_Object width + = gui_display_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER); if (EQ (visibility, Qicon)) - pgtk_iconify_frame (f); + { + f->was_invisible = true; + pgtk_iconify_frame (f); + } else { if (EQ (visibility, Qunbound)) @@ -1755,8 +1739,17 @@ This function is an internal primitive--use `make-frame' instead. */ ) if (!NILP (visibility)) pgtk_make_frame_visible (f); + else + f->was_invisible = true; } + /* Leave f->was_invisible true only if height or width were + specified too. This takes effect only when we are not called + from `x-create-frame-with-faces' (see above comment). */ + f->was_invisible + = (f->was_invisible + && (!EQ (height, Qunbound) || !EQ (width, Qunbound))); + store_frame_param (f, Qvisibility, visibility); } @@ -1798,29 +1791,10 @@ This function is an internal primitive--use `make-frame' instead. */ ) return unbind_to (count, frame); } - -#if 0 -static int -pgtk_window_is_ancestor (PGTKWindow * win, PGTKWindow * candidate) -/* Test whether CANDIDATE is an ancestor window of WIN. */ -{ - if (candidate == NULL) - return 0; - else if (win == candidate) - return 1; - else - return pgtk_window_is_ancestor (win,[candidate parentWindow]); -} -#endif - -/** - * x_frame_restack: - * - * Restack frame F1 below frame F2, above if ABOVE_FLAG is non-nil. In - * practice this is a two-step action: The first step removes F1's - * window-system window from the display. The second step reinserts - * F1's window below (above if ABOVE_FLAG is true) that of F2. - */ +/* Restack frame F1 below frame F2, above if ABOVE_FLAG is non-nil. + In practice this is a two-step action: The first step removes F1's + window-system window from the display. The second step reinserts + F1's window below (above if ABOVE_FLAG is true) that of F2. */ static void pgtk_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) { @@ -1829,7 +1803,6 @@ pgtk_frame_restack (struct frame *f1, struct frame *f2, bool above_flag) unblock_input (); } - DEFUN ("pgtk-frame-restack", Fpgtk_frame_restack, Spgtk_frame_restack, 2, 3, 0, doc: /* Restack FRAME1 below FRAME2. This means that if both frames are visible and the display areas of @@ -2766,7 +2739,7 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct struct frame *f; Lisp_Object frame; Lisp_Object name; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool face_change_before = face_change; if (!dpyinfo->terminal->name) @@ -2796,9 +2769,6 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct counts etc. */ f->output_method = output_pgtk; f->output_data.pgtk = xzalloc (sizeof *f->output_data.pgtk); -#if 0 - f->output_data.pgtk->icon_bitmap = -1; -#endif FRAME_FONTSET (f) = -1; f->output_data.pgtk->white_relief.pixel = -1; f->output_data.pgtk->black_relief.pixel = -1; @@ -2924,10 +2894,6 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct gtk_window_set_type_hint (GTK_WINDOW (tip_window), GDK_WINDOW_TYPE_HINT_TOOLTIP); f->output_data.pgtk->current_cursor = f->output_data.pgtk->text_cursor; -#if 0 - x_make_gc (f); -#endif - gui_default_parameter (f, parms, Qauto_raise, Qnil, "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); gui_default_parameter (f, parms, Qauto_lower, Qnil, @@ -2936,6 +2902,8 @@ x_create_tip_frame (struct pgtk_display_info *dpyinfo, Lisp_Object parms, struct "cursorType", "CursorType", RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -3139,10 +3107,9 @@ x_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -3234,8 +3201,7 @@ Text larger than the specified size is clipped. */) struct text_pos pos; int width, height; int old_windows_or_buffers_changed = windows_or_buffers_changed; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count_1; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object window, size, tip_buf; AUTO_STRING (tip, " *tip*"); @@ -3430,7 +3396,7 @@ Text larger than the specified size is clipped. */) /* Insert STRING into root window's buffer and fit the frame to the buffer. */ - count_1 = SPECPDL_INDEX (); + specpdl_ref count_1 = SPECPDL_INDEX (); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (w->contents)); bset_truncate_lines (current_buffer, Qnil); @@ -3747,7 +3713,6 @@ visible. */) (Lisp_Object frames) { Lisp_Object rest, tmp; - int count; if (!CONSP (frames)) frames = list1 (frames); @@ -3766,7 +3731,7 @@ visible. */) frames = Fnreverse (tmp); /* Make sure the current matrices are up-to-date. */ - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (32); unbind_to (count, Qnil); @@ -3804,7 +3769,7 @@ value of DIR as in previous invocations; this is standard MS Windows behavior. char *fn; Lisp_Object file = Qnil; Lisp_Object decoded_file; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); char *cdef_file; check_window_system (f); @@ -3872,7 +3837,7 @@ nil, it defaults to the selected frame. */) Lisp_Object font; Lisp_Object font_param; char *default_name = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (popup_activated ()) error ("Trying to use a menu from within a menu-entry"); @@ -3926,7 +3891,7 @@ syms_of_pgtkfns (void) DEFSYM (Qresize_mode, "resize-mode"); DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, - doc: /* A string indicating the foreground color of the cursor box. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_cursor_fore_pixel = Qnil; DEFVAR_LISP ("pgtk-icon-type-alist", Vpgtk_icon_type_alist, @@ -3950,14 +3915,7 @@ When you miniaturize a Group, Summary or Article frame, Gnus.tiff will be used as the image of the icon representing the frame. */); Vpgtk_icon_type_alist = list1 (Qt); - - /* Provide x-toolkit also for GTK. Internally GTK does not use Xt so it - is not an X toolkit in that sense (USE_X_TOOLKIT is not defined). - But for a user it is a toolkit for X, and indeed, configure - accepts --with-x-toolkit=gtk. */ - Fprovide (intern_c_string ("x-toolkit"), Qnil); Fprovide (intern_c_string ("gtk"), Qnil); - Fprovide (intern_c_string ("move-toolbar"), Qnil); DEFVAR_LISP ("gtk-version-string", Vgtk_version_string, doc: /* Version info for GTK+. */); @@ -4050,52 +4008,21 @@ be used as the image of the icon representing the frame. */); /* This is not ifdef:ed, so other builds than GTK can customize it. */ DEFVAR_BOOL ("x-gtk-use-old-file-dialog", x_gtk_use_old_file_dialog, - doc: /* Non-nil means prompt with the old GTK file selection dialog. -If nil or if the file selection dialog is not available, the new GTK file -chooser is used instead. To turn off all file dialogs set the -variable `use-file-dialog'. */); + doc: /* SKIP: real doc in xfns.c. */); x_gtk_use_old_file_dialog = false; DEFVAR_BOOL ("x-gtk-show-hidden-files", x_gtk_show_hidden_files, - doc: /* If non-nil, the GTK file chooser will by default show hidden files. -Note that this is just the default, there is a toggle button on the file -chooser to show or not show hidden files on a case by case basis. */); + doc: /* SKIP: real doc in xfns.c. */); x_gtk_show_hidden_files = false; DEFVAR_BOOL ("x-gtk-file-dialog-help-text", x_gtk_file_dialog_help_text, - doc: /* If non-nil, the GTK file chooser will show additional help text. -If more space for files in the file chooser dialog is wanted, set this to nil -to turn the additional text off. */); + doc: /* SKIP: real doc in xfns.c. */); x_gtk_file_dialog_help_text = true; DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, - doc: /* Maximum size for tooltips. -Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); - DEFVAR_LISP ("x-gtk-resize-child-frames", x_gtk_resize_child_frames, - doc: /* If non-nil, resize child frames specially with GTK builds. -If this is nil, resize child frames like any other frames. This is the -default and usually works with most desktops. Some desktop environments -(GNOME shell in particular when using the mutter window manager), -however, may refuse to resize a child frame when Emacs is built with -GTK3. For those environments, the two settings below are provided. - -If this equals the symbol 'hide', Emacs temporarily hides the child -frame during resizing. This approach seems to work reliably, may -however induce some flicker when the frame is made visible again. - -If this equals the symbol 'resize-mode', Emacs uses GTK's resize mode to -always trigger an immediate resize of the child frame. This method is -deprecated by GTK and may not work in future versions of that toolkit. -It also may freeze Emacs when used with other desktop environments. It -avoids, however, the unpleasant flicker induced by the hiding approach. - -This variable is considered a temporary workaround and will be hopefully -eliminated in future versions of Emacs. */); - x_gtk_resize_child_frames = Qnil; - - DEFSYM (Qmono, "mono"); DEFSYM (Qassq_delete_all, "assq-delete-all"); diff --git a/src/pgtkim.c b/src/pgtkim.c index 8577ba2116e..e1fffafb611 100644 --- a/src/pgtkim.c +++ b/src/pgtkim.c @@ -25,7 +25,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "pgtkterm.h" static void -im_context_commit_cb (GtkIMContext * imc, gchar * str, gpointer user_data) +im_context_commit_cb (GtkIMContext *imc, + gchar *str, + gpointer user_data) { struct pgtk_display_info *dpyinfo = user_data; struct frame *f = dpyinfo->im.focused_frame; @@ -39,21 +41,21 @@ im_context_commit_cb (GtkIMContext * imc, gchar * str, gpointer user_data) } static gboolean -im_context_retrieve_surrounding_cb (GtkIMContext * imc, gpointer user_data) +im_context_retrieve_surrounding_cb (GtkIMContext *imc, gpointer user_data) { gtk_im_context_set_surrounding (imc, "", -1, 0); return TRUE; } static gboolean -im_context_delete_surrounding_cb (GtkIMContext * imc, int offset, int n_chars, +im_context_delete_surrounding_cb (GtkIMContext *imc, int offset, int n_chars, gpointer user_data) { return TRUE; } static Lisp_Object -make_color_string (PangoAttrColor * pac) +make_color_string (PangoAttrColor *pac) { char buf[256]; sprintf (buf, "#%02x%02x%02x", @@ -62,7 +64,7 @@ make_color_string (PangoAttrColor * pac) } static void -im_context_preedit_changed_cb (GtkIMContext * imc, gpointer user_data) +im_context_preedit_changed_cb (GtkIMContext *imc, gpointer user_data) { struct pgtk_display_info *dpyinfo = user_data; struct frame *f = dpyinfo->im.focused_frame; @@ -149,7 +151,7 @@ im_context_preedit_changed_cb (GtkIMContext * imc, gpointer user_data) } static void -im_context_preedit_end_cb (GtkIMContext * imc, gpointer user_data) +im_context_preedit_end_cb (GtkIMContext *imc, gpointer user_data) { struct pgtk_display_info *dpyinfo = user_data; struct frame *f = dpyinfo->im.focused_frame; @@ -163,7 +165,7 @@ im_context_preedit_end_cb (GtkIMContext * imc, gpointer user_data) } static void -im_context_preedit_start_cb (GtkIMContext * imc, gpointer user_data) +im_context_preedit_start_cb (GtkIMContext *imc, gpointer user_data) { } diff --git a/src/pgtkmenu.c b/src/pgtkmenu.c index d1b1bfffb36..7a3bfea4518 100644 --- a/src/pgtkmenu.c +++ b/src/pgtkmenu.c @@ -141,31 +141,15 @@ popup_deactivate_callback (GtkWidget *widget, gpointer client_data) static void show_help_event (struct frame *f, GtkWidget *widget, Lisp_Object help) { - /* Don't show this tooltip. - * Tooltips are always tied to main widget, so stacking order - * on Wayland is: - * (above) - * - menu - * - tooltip - * - main widget - * (below) - * This is applicable to tooltips for menu, and menu tooltips - * are shown below menus. - * As a workaround, I entrust Gtk with menu tooltips, and - * let emacs not to show menu tooltips. - */ - -#if 0 - Lisp_Object frame; - - if (f) - { - XSETFRAME (frame, f); - kbd_buffer_store_help_event (frame, help); - } - else - show_help_echo (help, Qnil, Qnil, Qnil); -#endif + /* Don't show help echo on PGTK, as tooltips are always transient + for the main widget, so on Wayland the menu will display above + and obscure the tooltip. FIXME: this is some low hanging fruit + for fixing. After you fix Fx_show_tip in pgtkterm.c so that it + can display tooltips above menus, copy the definition of this + function from xmenu.c. + + As a workaround, GTK is used to display menu tooltips, outside + the Emacs help echo machinery. */ } /* Callback called when menu items are highlighted/unhighlighted @@ -279,7 +263,7 @@ set_frame_menubar (struct frame *f, bool deep_p) { struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); @@ -558,7 +542,7 @@ create_and_show_popup_menu (struct frame *f, widget_value * first_wv, int x, int y, bool for_click) { GtkWidget *menu; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_PGTK_P (f)); @@ -625,7 +609,7 @@ pgtk_menu_show (struct frame *f, int x, int y, int menuflags, = alloca (menu_items_used * sizeof *subprefix_stack); int submenu_depth = 0; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_PGTK_P (f)); @@ -902,7 +886,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) if (menu) { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_ptr (pop_down_menu, menu); /* Display the menu. */ @@ -934,7 +918,7 @@ pgtk_dialog_show (struct frame *f, Lisp_Object title, /* Whether we've seen the boundary between left-hand elts and right-hand. */ bool boundary_seen = false; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_PGTK_P (f)); @@ -1087,7 +1071,7 @@ pgtk_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) Lisp_Object title; const char *error_name; Lisp_Object selection; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); check_window_system (f); diff --git a/src/pgtkselect.c b/src/pgtkselect.c index 23a79895d54..2660ea3ed38 100644 --- a/src/pgtkselect.c +++ b/src/pgtkselect.c @@ -36,10 +36,6 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #include "pgtkselect.h" #include <gdk/gdk.h> -#if 0 -static Lisp_Object Vselection_alist; -#endif - static GQuark quark_primary_data = 0; static GQuark quark_primary_size = 0; static GQuark quark_secondary_data = 0; @@ -234,82 +230,9 @@ pgtk_selection_usable (void) if (pgtk_enable_selection_on_multi_display) return true; - /* - * https://github.com/GNOME/gtk/blob/gtk-3-24/gdk/wayland/gdkselection-wayland.c#L1033 - * - * Gdk uses gdk_display_get_default() when handling selections, so - * selections don't work properly on multi-display environment. - * - * ---------------- - * #include <gtk/gtk.h> - * - * static GtkWidget *top1, *top2; - * - * int main (int argc, char **argv) - * { - * GtkWidget *w; - * GtkTextBuffer *buf; - * - * gtk_init (&argc, &argv); - * - * static char *text = "\ - * It is fine today.\n\ - * It will be fine tomorrow too.\n\ - * It is too hot."; - * - * top1 = gtk_window_new (GTK_WINDOW_TOPLEVEL); - * gtk_window_set_title (GTK_WINDOW (top1), "default"); - * gtk_widget_show (top1); - * w = gtk_text_view_new (); - * gtk_container_add (GTK_CONTAINER (top1), w); - * gtk_widget_show (w); - * buf = gtk_text_view_get_buffer (GTK_TEXT_VIEW (w)); - * gtk_text_buffer_insert_at_cursor (buf, text, strlen (text)); - * gtk_text_buffer_add_selection_clipboard (buf, gtk_widget_get_clipboard (w, GDK_SELECTION_PRIMARY)); - * - * unsetenv ("GDK_BACKEND"); - * GdkDisplay *gdpy; - * const char *dpyname2; - * if (strcmp (G_OBJECT_TYPE_NAME (gtk_widget_get_window (top1)), "GdkWaylandWindow") == 0) - * dpyname2 = ":0"; - * else - * dpyname2 = "wayland-0"; - * gdpy = gdk_display_open (dpyname2); - * top2 = gtk_window_new (GTK_WINDOW_TOPLEVEL); - * gtk_window_set_title (GTK_WINDOW (top2), dpyname2); - * gtk_window_set_screen (GTK_WINDOW (top2), gdk_display_get_default_screen (gdpy)); - * gtk_widget_show (top2); - * w = gtk_text_view_new (); - * gtk_container_add (GTK_CONTAINER (top2), w); - * gtk_widget_show (w); - * buf = gtk_text_view_get_buffer (GTK_TEXT_VIEW (w)); - * gtk_text_buffer_insert_at_cursor (buf, text, strlen (text)); - * gtk_text_buffer_add_selection_clipboard (buf, gtk_widget_get_clipboard (w, GDK_SELECTION_PRIMARY)); - * - * gtk_main (); - * - * return 0; - * } - * ---------------- - * - * This code fails if - * GDK_BACKEND=x11 ./test - * and select on both of windows. - * - * ---------------- - * (test:15345): GLib-GObject-CRITICAL **: 01:56:38.041: g_object_ref: assertion 'G_IS_OBJECT (object)' failed - * - * (test:15345): GLib-GObject-CRITICAL **: 01:56:38.042: g_object_ref: assertion 'G_IS_OBJECT (object)' failed - * - * (test:15345): GLib-GObject-CRITICAL **: 01:56:39.113: g_object_ref: assertion 'G_IS_OBJECT (object)' failed - * - * (test:15345): GLib-GObject-CRITICAL **: 01:56:39.113: g_object_ref: assertion 'G_IS_OBJECT (object)' failed - * ---------------- - * (gtk-3.24.10) - * - * This function checks whether selections work by the number of displays. - * If you use more than 2 displays, then selection is disabled. - */ + /* Gdk uses `gdk_display_get_default' when handling selections, so + selections don't work properly when Emacs is connected to + multiple displays. */ GdkDisplayManager *dpyman = gdk_display_manager_get (); GSList *list = gdk_display_manager_list_displays (dpyman); @@ -412,21 +335,15 @@ nil, it defaults to the selected frame. */) } -DEFUN ("pgtk-disown-selection-internal", Fpgtk_disown_selection_internal, Spgtk_disown_selection_internal, 1, 3, 0, +DEFUN ("pgtk-disown-selection-internal", Fpgtk_disown_selection_internal, + Spgtk_disown_selection_internal, 1, 2, 0, doc: /* If we own the selection SELECTION, disown it. Disowning it means there is no such selection. -Sets the last-change time for the selection to TIME-OBJECT (by default -the time of the last event). - TERMINAL should be a terminal object or a frame specifying the X server to query. If omitted or nil, that stands for the selected -frame's display, or the first available X display. - -On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused. -On MS-DOS, all this does is return non-nil if we own the selection. -On PGTK, the TIME-OBJECT is unused. */) - (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal) +frame's display, or the first available X display. */) + (Lisp_Object selection, Lisp_Object terminal) { struct frame *f = frame_for_pgtk_selection (terminal); GtkClipboard *cb; @@ -507,29 +424,25 @@ On Nextstep, TERMINAL is unused. */) } -DEFUN ("pgtk-get-selection-internal", Fpgtk_get_selection_internal, Spgtk_get_selection_internal, 2, 4, 0, - doc: /* Return text selected from some X window. +DEFUN ("pgtk-get-selection-internal", Fpgtk_get_selection_internal, + Spgtk_get_selection_internal, 2, 3, 0, + doc: /* Return text selected from some program. SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. \(Those are literal upper-case symbol names, since that's what X expects.) TARGET-TYPE is the type of data desired, typically `STRING'. -TIME-STAMP is the time to use in the XConvertSelection call for foreign -selections. If omitted, defaults to the time for the last event. - TERMINAL should be a terminal object or a frame specifying the X server to query. If omitted or nil, that stands for the selected -frame's display, or the first available X display. - -On Nextstep, TIME-STAMP and TERMINAL are unused. -On PGTK, TIME-STAMP is unused. */) +frame's display, or the first available display. */) (Lisp_Object selection_symbol, Lisp_Object target_type, - Lisp_Object time_stamp, Lisp_Object terminal) + Lisp_Object terminal) { struct frame *f = frame_for_pgtk_selection (terminal); GtkClipboard *cb; CHECK_SYMBOL (selection_symbol); CHECK_SYMBOL (target_type); + if (EQ (target_type, QMULTIPLE)) error ("Retrieving MULTIPLE selections is currently unimplemented"); if (!f) @@ -606,27 +519,24 @@ syms_of_pgtkselect (void) defsubr (&Spgtk_selection_exists_p); defsubr (&Spgtk_selection_owner_p); -#if 0 - Vselection_alist = Qnil; - staticpro (&Vselection_alist); -#endif - DEFVAR_LISP ("pgtk-sent-selection-hooks", Vpgtk_sent_selection_hooks, - "A list of functions to be called when Emacs answers a selection request.\n\ -The functions are called with four arguments:\n\ - - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\ - - the selection-type which Emacs was asked to convert the\n\ - selection into before sending (for example, `STRING' or `LENGTH');\n\ - - a flag indicating success or failure for responding to the request.\n\ -We might have failed (and declined the request) for any number of reasons,\n\ -including being asked for a selection that we no longer own, or being asked\n\ -to convert into a type that we don't know about or that is inappropriate.\n\ -This hook doesn't let you change the behavior of Emacs's selection replies,\n\ -it merely informs you that they have happened."); + doc: /* A list of functions to be called when Emacs answers a selection request +The functions are called with four arguments: + - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); + - the selection-type which Emacs was asked to convert the + selection into before sending (for example, `STRING' or `LENGTH'); + - a flag indicating success or failure for responding to the request. +We might have failed (and declined the request) for any number of reasons, +including being asked for a selection that we no longer own, or being asked +to convert into a type that we don't know about or that is inappropriate. +This hook doesn't let you change the behavior of Emacs's selection replies, +it merely informs you that they have happened. */); Vpgtk_sent_selection_hooks = Qnil; DEFVAR_BOOL ("pgtk-enable-selection-on-multi-display", pgtk_enable_selection_on_multi_display, - doc: /* Enable selection on multi display environment. -This may cause crash. */); + doc: /* Enable selections when connected to multiple displays. +This may cause crashes due to a GTK bug, which assumes that clients +will connect to a single display. It might also cause selections to +not arrive at the correct display. */); pgtk_enable_selection_on_multi_display = false; } diff --git a/src/pgtkterm.c b/src/pgtkterm.c index efbeaafaf1a..54b65ac54e4 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -101,7 +101,8 @@ static void pgtk_delete_display (struct pgtk_display_info *dpyinfo); static void pgtk_clear_frame_area (struct frame *f, int x, int y, int width, int height); static void pgtk_fill_rectangle (struct frame *f, unsigned long color, int x, - int y, int width, int height); + int y, int width, int height, + 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); @@ -449,8 +450,6 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) External: Position the window -------------------------------------------------------------------------- */ { - int modified_top, modified_left; - if (change_gravity > 0) { f->top_pos = yoff; @@ -468,44 +467,23 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) block_input (); x_wm_set_size_hint (f, 0, false); - if (x_gtk_use_window_move) + if (change_gravity != 0) { - if (change_gravity != 0) + if (FRAME_GTK_OUTER_WIDGET (f)) { - if (FRAME_GTK_OUTER_WIDGET (f)) - { - gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - f->left_pos, f->top_pos); - } - else - { - GtkWidget *fixed = FRAME_GTK_WIDGET (f); - GtkWidget *parent = gtk_widget_get_parent (fixed); - gtk_fixed_move (GTK_FIXED (parent), fixed, - f->left_pos, f->top_pos); - } + gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + f->left_pos, f->top_pos); + } + else + { + GtkWidget *fixed = FRAME_GTK_WIDGET (f); + GtkWidget *parent = gtk_widget_get_parent (fixed); + gtk_fixed_move (GTK_FIXED (parent), fixed, + f->left_pos, f->top_pos); } - unblock_input (); - return; - } - - modified_left = f->left_pos; - modified_top = f->top_pos; - - if (FRAME_GTK_OUTER_WIDGET (f)) - { - gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - modified_left, modified_top); - } - else - { - GtkWidget *fixed = FRAME_GTK_WIDGET (f); - GtkWidget *parent = gtk_widget_get_parent (fixed); - gtk_fixed_move (GTK_FIXED (parent), fixed, - modified_left, modified_top); } - unblock_input (); + return; } static void @@ -581,10 +559,6 @@ pgtk_iconify_frame (struct frame *f) block_input (); -#if 0 - x_set_bitmap_icon (f); -#endif - if (FRAME_GTK_OUTER_WIDGET (f)) { if (!FRAME_VISIBLE_P (f)) @@ -599,21 +573,9 @@ pgtk_iconify_frame (struct frame *f) /* Make sure the X server knows where the window should be positioned, in case the user deiconifies with the window manager. */ - if (!FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f) -#if 0 - && !FRAME_X_EMBEDDED_P (f) -#endif - ) + if (!FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f)) x_set_offset (f, f->left_pos, f->top_pos, 0); -#if 0 - if (!FRAME_VISIBLE_P (f)) - { - /* If the frame was withdrawn, before, we must map it. */ - XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); - } -#endif - SET_FRAME_ICONIFIED (f, true); SET_FRAME_VISIBLE (f, 0); @@ -917,14 +879,6 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, g_object_unref (fixed); - if (FRAME_GTK_OUTER_WIDGET (f)) - { - if (EQ (x_gtk_resize_child_frames, Qresize_mode)) - gtk_container_set_resize_mode - (GTK_CONTAINER (FRAME_GTK_OUTER_WIDGET (f)), - p ? GTK_RESIZE_IMMEDIATE : GTK_RESIZE_QUEUE); - } - unblock_input (); fset_parent_frame (f, new_value); @@ -1243,7 +1197,9 @@ pgtk_compute_glyph_string_overhangs (struct glyph_string *s) static void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { - pgtk_fill_rectangle (s->f, s->xgcv.background, x, y, w, h); + pgtk_fill_rectangle (s->f, s->xgcv.background, x, y, w, h, + (s->first_glyph->type != STRETCH_GLYPH + || s->hl != DRAW_CURSOR)); } @@ -1328,12 +1284,12 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p) static void pgtk_draw_rectangle (struct frame *f, unsigned long color, int x, int y, - int width, int height) + int width, int height, bool respect_alpha_background) { cairo_t *cr; cr = pgtk_begin_cr_clip (f); - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, respect_alpha_background); cairo_rectangle (cr, x + 0.5, y + 0.5, width, height); cairo_set_line_width (cr, 1); cairo_stroke (cr); @@ -1363,7 +1319,8 @@ x_draw_glyph_string_foreground (struct glyph_string *s) struct glyph *g = s->first_glyph + i; pgtk_draw_rectangle (s->f, s->face->foreground, x, s->y, - g->pixel_width - 1, s->height - 1); + g->pixel_width - 1, s->height - 1, + false); x += g->pixel_width; } } @@ -1413,7 +1370,7 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s) { if (s->cmp_from == 0) pgtk_draw_rectangle (s->f, s->face->foreground, x, s->y, - s->width - 1, s->height - 1); + s->width - 1, s->height - 1, false); } else if (!s->first_glyph->u.cmp.automatic) { @@ -1555,7 +1512,8 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) pgtk_draw_rectangle (s->f, s->face->foreground, x, s->ybase - glyph->ascent, glyph->pixel_width - 1, - glyph->ascent + glyph->descent - 1); + glyph->ascent + glyph->descent - 1, + false); x += glyph->pixel_width; } } @@ -1658,7 +1616,7 @@ x_fill_trapezoid_for_relief (struct frame *f, unsigned long color, int x, cairo_t *cr; cr = pgtk_begin_cr_clip (f); - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, false); cairo_move_to (cr, top_p ? x : x + height, y); cairo_line_to (cr, x, y + height); cairo_line_to (cr, top_p ? x + width - height : x + width, y + height); @@ -1685,7 +1643,7 @@ x_erase_corners_for_relief (struct frame *f, unsigned long color, int x, int i; cr = pgtk_begin_cr_clip (f); - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, false); for (i = 0; i < CORNER_LAST; i++) if (corners & (1 << i)) { @@ -1818,7 +1776,7 @@ x_draw_relief_rect (struct frame *f, if (left_p) { pgtk_fill_rectangle (f, top_left_color, left_x, top_y, - vwidth, bottom_y + 1 - top_y); + vwidth, bottom_y + 1 - top_y, false); if (top_p) corners |= 1 << CORNER_TOP_LEFT; if (bot_p) @@ -1827,7 +1785,7 @@ x_draw_relief_rect (struct frame *f, if (right_p) { pgtk_fill_rectangle (f, bottom_right_color, right_x + 1 - vwidth, top_y, - vwidth, bottom_y + 1 - top_y); + vwidth, bottom_y + 1 - top_y, false); if (top_p) corners |= 1 << CORNER_TOP_RIGHT; if (bot_p) @@ -1837,7 +1795,7 @@ x_draw_relief_rect (struct frame *f, { if (!right_p) pgtk_fill_rectangle (f, top_left_color, left_x, top_y, - right_x + 1 - left_x, hwidth); + right_x + 1 - left_x, hwidth, false); else x_fill_trapezoid_for_relief (f, top_left_color, left_x, top_y, right_x + 1 - left_x, hwidth, 1); @@ -1847,7 +1805,7 @@ x_draw_relief_rect (struct frame *f, if (!left_p) pgtk_fill_rectangle (f, bottom_right_color, left_x, bottom_y + 1 - hwidth, right_x + 1 - left_x, - hwidth); + hwidth, false); else x_fill_trapezoid_for_relief (f, bottom_right_color, left_x, bottom_y + 1 - hwidth, @@ -1855,10 +1813,10 @@ x_draw_relief_rect (struct frame *f, } if (left_p && vwidth > 1) pgtk_fill_rectangle (f, bottom_right_color, left_x, top_y, - 1, bottom_y + 1 - top_y); + 1, bottom_y + 1 - top_y, false); if (top_p && hwidth > 1) pgtk_fill_rectangle (f, bottom_right_color, left_x, top_y, - right_x + 1 - left_x, 1); + right_x + 1 - left_x, 1, false); if (corners) { x_erase_corners_for_relief (f, FRAME_BACKGROUND_PIXEL (f), left_x, @@ -1893,23 +1851,25 @@ x_draw_box_rect (struct glyph_string *s, /* Top. */ pgtk_fill_rectangle (s->f, s->xgcv.foreground, - left_x, top_y, right_x - left_x + 1, hwidth); + left_x, top_y, right_x - left_x + 1, hwidth, + false); /* Left. */ if (left_p) pgtk_fill_rectangle (s->f, s->xgcv.foreground, - left_x, top_y, vwidth, bottom_y - top_y + 1); + left_x, top_y, vwidth, bottom_y - top_y + 1, + false); /* Bottom. */ pgtk_fill_rectangle (s->f, s->xgcv.foreground, left_x, bottom_y - hwidth + 1, right_x - left_x + 1, - hwidth); + hwidth, false); /* Right. */ if (right_p) pgtk_fill_rectangle (s->f, s->xgcv.foreground, right_x - vwidth + 1, top_y, vwidth, - bottom_y - top_y + 1); + bottom_y - top_y + 1, false); s->xgcv.foreground = foreground_backup; @@ -1979,7 +1939,7 @@ x_draw_horizontal_wave (struct frame *f, unsigned long color, int x, int y, int xoffset, n; cr = pgtk_begin_cr_clip (f); - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, false); cairo_rectangle (cr, x, y, width, height); cairo_clip (cr); @@ -2155,7 +2115,7 @@ x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image, cairo_rectangle (cr, dest_x, dest_y, width, height); else { - pgtk_set_cr_source_with_gc_background (f, gc); + pgtk_set_cr_source_with_gc_background (f, gc, false); cairo_rectangle (cr, dest_x, dest_y, width, height); cairo_fill_preserve (cr); } @@ -2172,7 +2132,7 @@ x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image, } else { - pgtk_set_cr_source_with_gc_foreground (f, gc); + pgtk_set_cr_source_with_gc_foreground (f, gc, false); cairo_clip (cr); cairo_mask (cr, image); } @@ -2222,7 +2182,7 @@ x_draw_image_foreground (struct glyph_string *s) int relief = eabs (s->img->relief); pgtk_draw_rectangle (s->f, s->xgcv.foreground, x - relief, y - relief, s->slice.width + relief*2 - 1, - s->slice.height + relief*2 - 1); + s->slice.height + relief*2 - 1, false); } } pgtk_end_cr_clip (s->f); @@ -2230,7 +2190,7 @@ x_draw_image_foreground (struct glyph_string *s) else /* Draw a rectangle if image could not be loaded. */ pgtk_draw_rectangle (s->f, s->xgcv.foreground, x, y, - s->slice.width - 1, s->slice.height - 1); + s->slice.width - 1, s->slice.height - 1, false); } /* Draw image glyph string S. @@ -2375,7 +2335,8 @@ x_draw_stretch_glyph_string (struct glyph_string *s) } else { - pgtk_fill_rectangle (s->f, color, x, y, w, h); + pgtk_fill_rectangle (s->f, color, x, y, w, h, + true); } pgtk_end_cr_clip (s->f); @@ -2601,11 +2562,13 @@ pgtk_draw_glyph_string (struct glyph_string *s) y = s->ybase + position; if (s->face->underline_defaulted_p) pgtk_fill_rectangle (s->f, s->xgcv.foreground, - s->x, y, s->width, thickness); + s->x, y, s->width, thickness, + false); else { pgtk_fill_rectangle (s->f, s->face->underline_color, - s->x, y, s->width, thickness); + s->x, y, s->width, thickness, + false); } } } @@ -2616,11 +2579,11 @@ pgtk_draw_glyph_string (struct glyph_string *s) if (s->face->overline_color_defaulted_p) pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, s->y + dy, - s->width, h); + s->width, h, false); else { pgtk_fill_rectangle (s->f, s->face->overline_color, s->x, - s->y + dy, s->width, h); + s->y + dy, s->width, h, false); } } @@ -2641,11 +2604,11 @@ pgtk_draw_glyph_string (struct glyph_string *s) if (s->face->strike_through_color_defaulted_p) pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, glyph_y + dy, - s->width, h); + s->width, h, false); else { pgtk_fill_rectangle (s->f, s->face->strike_through_color, s->x, - glyph_y + dy, s->width, h); + glyph_y + dy, s->width, h, false); } } @@ -2778,7 +2741,7 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row) /* The foreground of cursor_gc is typically the same as the normal background color, which can cause the cursor box to be invisible. */ cairo_t *cr = pgtk_begin_cr_clip (f); - pgtk_set_cr_source_with_color (f, FRAME_X_OUTPUT (f)->cursor_color); + pgtk_set_cr_source_with_color (f, FRAME_X_OUTPUT (f)->cursor_color, false); /* When on R2L character, show cursor at the right edge of the glyph, unless the cursor box is as wide as the glyph or wider @@ -2792,7 +2755,7 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row) } /* Set clipping, draw the rectangle, and reset clipping again. */ pgtk_clip_to_row (w, row, TEXT_AREA, cr); - pgtk_draw_rectangle (f, FRAME_X_OUTPUT (f)->cursor_color, x, y, wd, h - 1); + pgtk_draw_rectangle (f, FRAME_X_OUTPUT (f)->cursor_color, x, y, wd, h - 1, false); pgtk_end_cr_clip (f); } @@ -2866,7 +2829,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, pgtk_fill_rectangle (f, color, x, WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), - width, row->height); + width, row->height, false); } else /* HBAR_CURSOR */ { @@ -2887,7 +2850,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, pgtk_fill_rectangle (f, color, x, WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y + row->height - width), - w->phys_cursor_width - 1, width); + w->phys_cursor_width - 1, width, false); } pgtk_end_cr_clip (f); @@ -2958,17 +2921,24 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, } static void -pgtk_copy_bits (struct frame *f, cairo_rectangle_t * src_rect, - cairo_rectangle_t * dst_rect) +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 = - cairo_surface_create_similar (FRAME_CR_SURFACE (f), - CAIRO_CONTENT_COLOR_ALPHA, - (int) src_rect->width, - (int) src_rect->height); + 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); cr = cairo_create (surface); cairo_set_source_surface (cr, FRAME_CR_SURFACE (f), -src_rect->x, @@ -2980,6 +2950,7 @@ pgtk_copy_bits (struct frame *f, cairo_rectangle_t * src_rect, cr = pgtk_begin_cr_clip (f); cairo_set_source_surface (cr, surface, dst_rect->x, dst_rect->y); + cairo_set_operator (cr, CAIRO_OPERATOR_SOURCE); cairo_rectangle (cr, dst_rect->x, dst_rect->y, dst_rect->width, dst_rect->height); cairo_clip (cr); @@ -3241,7 +3212,7 @@ pgtk_draw_vertical_window_border (struct window *w, int x, int y0, int y1) face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); if (face) - pgtk_set_cr_source_with_color (f, face->foreground); + pgtk_set_cr_source_with_color (f, face->foreground, false); cairo_rectangle (cr, x, y0, 1, y1 - y0); cairo_fill (cr); @@ -3272,32 +3243,32 @@ pgtk_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) if (y1 - y0 > x1 - x0 && x1 - x0 > 2) /* Vertical. */ { - pgtk_set_cr_source_with_color (f, color_first); + pgtk_set_cr_source_with_color (f, color_first, false); cairo_rectangle (cr, x0, y0, 1, y1 - y0); cairo_fill (cr); - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, false); cairo_rectangle (cr, x0 + 1, y0, x1 - x0 - 2, y1 - y0); cairo_fill (cr); - pgtk_set_cr_source_with_color (f, color_last); + pgtk_set_cr_source_with_color (f, color_last, false); cairo_rectangle (cr, x1 - 1, y0, 1, y1 - y0); cairo_fill (cr); } else if (x1 - x0 > y1 - y0 && y1 - y0 > 3) /* Horizontal. */ { - pgtk_set_cr_source_with_color (f, color_first); + pgtk_set_cr_source_with_color (f, color_first, false); cairo_rectangle (cr, x0, y0, x1 - x0, 1); cairo_fill (cr); - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, false); cairo_rectangle (cr, x0, y0 + 1, x1 - x0, y1 - y0 - 2); cairo_fill (cr); - pgtk_set_cr_source_with_color (f, color_last); + pgtk_set_cr_source_with_color (f, color_last, false); cairo_rectangle (cr, x0, y1 - 1, x1 - x0, 1); cairo_fill (cr); } else { - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, false); cairo_rectangle (cr, x0, y0, x1 - x0, y1 - y0); cairo_fill (cr); } @@ -3520,7 +3491,7 @@ pgtk_cr_draw_image (struct frame *f, Emacs_GC * gc, cairo_pattern_t * image, cairo_rectangle (cr, dest_x, dest_y, width, height); else { - pgtk_set_cr_source_with_gc_background (f, gc); + pgtk_set_cr_source_with_gc_background (f, gc, false); cairo_rectangle (cr, dest_x, dest_y, width, height); cairo_fill_preserve (cr); } @@ -3536,7 +3507,7 @@ pgtk_cr_draw_image (struct frame *f, Emacs_GC * gc, cairo_pattern_t * image, } else { - pgtk_set_cr_source_with_gc_foreground (f, gc); + pgtk_set_cr_source_with_gc_foreground (f, gc, false); cairo_clip (cr); cairo_mask (cr, image); } @@ -3568,7 +3539,7 @@ pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row, } else { - pgtk_set_cr_source_with_color (f, face->background); + pgtk_set_cr_source_with_color (f, face->background, true); cairo_rectangle (cr, p->bx, p->by, p->nx, p->ny); cairo_fill (cr); } @@ -4588,22 +4559,6 @@ x_set_frame_alpha (struct frame *f) else if (alpha < alpha_min && alpha_min <= 1.0) alpha = alpha_min; -#if 0 - /* If there is a parent from the window manager, put the property there - also, to work around broken window managers that fail to do that. - Do this unconditionally as this function is called on reparent when - alpha has not changed on the frame. */ - - if (!FRAME_PARENT_FRAME (f)) - { - Window parent = x_find_topmost_parent (f); - if (parent != None) - XChangeProperty (dpy, parent, dpyinfo->Xatom_net_wm_window_opacity, - XA_CARDINAL, 32, PropModeReplace, - (unsigned char *) &opac, 1); - } -#endif - set_opacity_recursively (FRAME_WIDGET (f), &alpha); /* without this, blending mode is strange on wayland. */ gtk_widget_queue_resize_no_redraw (FRAME_WIDGET (f)); @@ -4970,11 +4925,11 @@ pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data) static void pgtk_fill_rectangle (struct frame *f, unsigned long color, int x, int y, - int width, int height) + int width, int height, bool respect_alpha_background) { cairo_t *cr; cr = pgtk_begin_cr_clip (f); - pgtk_set_cr_source_with_color (f, color); + pgtk_set_cr_source_with_color (f, color, respect_alpha_background); cairo_rectangle (cr, x, y, width, height); cairo_fill (cr); pgtk_end_cr_clip (f); @@ -5587,6 +5542,7 @@ configure_event (GtkWidget *widget, gpointer *user_data) { struct frame *f = pgtk_any_window_to_frame (event->configure.window); + if (f && widget == FRAME_GTK_OUTER_WIDGET (f)) { if (any_help_event_p) @@ -5599,6 +5555,15 @@ configure_event (GtkWidget *widget, help_echo_string = Qnil; gen_help_event (Qnil, frame, Qnil, Qnil, 0); } + + if (f->win_gravity == NorthWestGravity) + gtk_window_get_position (GTK_WINDOW (widget), + &f->left_pos, &f->top_pos); + else + { + f->top_pos = event->configure.y; + f->left_pos = event->configure.x; + } } return FALSE; } @@ -5682,6 +5647,32 @@ window_state_event (GtkWidget *widget, } } + if (event->window_state.new_window_state + & GDK_WINDOW_STATE_FULLSCREEN) + store_frame_param (f, Qfullscreen, Qfullboth); + else if (event->window_state.new_window_state + & GDK_WINDOW_STATE_MAXIMIZED) + store_frame_param (f, Qfullscreen, Qmaximized); + else + store_frame_param (f, Qfullscreen, Qnil); + + if (event->window_state.new_window_state + & GDK_WINDOW_STATE_ICONIFIED) + SET_FRAME_ICONIFIED (f, true); + else + { + FRAME_X_OUTPUT (f)->has_been_visible = true; + inev.ie.kind = DEICONIFY_EVENT; + XSETFRAME (inev.ie.frame_or_window, f); + SET_FRAME_ICONIFIED (f, false); + } + + if (event->window_state.new_window_state + & GDK_WINDOW_STATE_STICKY) + store_frame_param (f, Qsticky, Qt); + else + store_frame_param (f, Qsticky, Qnil); + if (inev.ie.kind != NO_EVENT) evq_enqueue (&inev); return FALSE; @@ -6114,9 +6105,6 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) dpyinfo = FRAME_DISPLAY_INFO (frame); dpyinfo->last_mouse_glyph_frame = NULL; -#if 0 - x_display_set_last_user_time (dpyinfo, event->button.time); -#endif if (gui_mouse_grabbed (dpyinfo)) f = dpyinfo->last_mouse_frame; @@ -6145,14 +6133,6 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) } } - /* xg_event_is_for_scrollbar() doesn't work correctly on sway, and - * we shouldn't need it. - */ -#if 0 - if (f && xg_event_is_for_scrollbar (f, event)) - f = 0; -#endif - if (f) { /* Is this in the tab-bar? */ @@ -6194,11 +6174,6 @@ button_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) if (!NILP (tab_bar_arg)) inev.ie.arg = tab_bar_arg; } -#if 0 - if (FRAME_X_EMBEDDED_P (f)) - xembed_send_message (f, event->button.time, - XEMBED_REQUEST_FOCUS, 0, 0, 0); -#endif } if (event->type == GDK_BUTTON_PRESS) @@ -6913,7 +6888,8 @@ pgtk_clear_area (struct frame *f, int x, int y, int width, int height) eassert (width > 0 && height > 0); cr = pgtk_begin_cr_clip (f); - pgtk_set_cr_source_with_color (f, FRAME_X_OUTPUT (f)->background_color); + pgtk_set_cr_source_with_color (f, FRAME_X_OUTPUT (f)->background_color, + true); cairo_rectangle (cr, x, y, width, height); cairo_fill (cr); pgtk_end_cr_clip (f); @@ -6951,80 +6927,46 @@ syms_of_pgtkterm (void) Fput (Qcontrol, Qmodifier_value, make_fixnum (ctrl_modifier)); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, - doc: /* Which keys Emacs uses for the ctrl modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `ctrl' means use the Ctrl_L and Ctrl_R keysyms. -The default is nil, which is the same as `ctrl'. */ ); + doc: /* SKIP: real doc in xterm.c. */); Vx_ctrl_keysym = Qnil; DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym, - doc: /* Which keys Emacs uses for the alt modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `alt' means use the Alt_L and Alt_R keysyms. -The default is nil, which is the same as `alt'. */ ); + doc: /* SKIP: real doc in xterm.c. */); Vx_alt_keysym = Qnil; DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym, - doc: /* Which keys Emacs uses for the hyper modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `hyper' means use the Hyper_L and Hyper_R -keysyms. The default is nil, which is the same as `hyper'. */ ); + doc: /* SKIP: real doc in xterm.c. */); Vx_hyper_keysym = Qnil; DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym, - doc: /* Which keys Emacs uses for the meta modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `meta' means use the Meta_L and Meta_R keysyms. -The default is nil, which is the same as `meta'. */ ); + doc: /* SKIP: real doc in xterm.c. */); Vx_meta_keysym = Qnil; DEFVAR_LISP ("x-super-keysym", Vx_super_keysym, - doc: /* Which keys Emacs uses for the super modifier. -This should be one of the symbols `ctrl', `alt', `hyper', `meta', -`super'. For example, `super' means use the Super_L and Super_R -keysyms. The default is nil, which is the same as `super'. */ ); + doc: /* SKIP: real doc in xterm.c. */); Vx_super_keysym = Qnil; - /* TODO: move to common code */ - DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, - doc: /* Which toolkit scroll bars Emacs uses, if any. -A value of nil means Emacs doesn't use toolkit scroll bars. -With the X Window system, the value is a symbol describing the -X toolkit. Possible values are: gtk, motif, xaw, or xaw3d. -With MS Windows or Nextstep, the value is t. */ ); - /* Vx_toolkit_scroll_bars = Qt; */ - Vx_toolkit_scroll_bars = intern_c_string ("gtk"); + DEFVAR_BOOL ("x-use-underline-position-properties", + x_use_underline_position_properties, + doc: /* SKIP: real doc in xterm.c. */); + x_use_underline_position_properties = 1; - DEFVAR_BOOL ("x-use-underline-position-properties", x_use_underline_position_properties, - doc: /*Non-nil means make use of UNDERLINE_POSITION font properties. -A value of nil means ignore them. If you encounter fonts with bogus -UNDERLINE_POSITION font properties, for example 7x13 on XFree prior -to 4.1, set this to nil. */); - x_use_underline_position_properties = 0; - - DEFVAR_BOOL ("x-underline-at-descent-line", x_underline_at_descent_line, - doc: /* Non-nil means to draw the underline at the same place as the descent line. -A value of nil means to draw the underline according to the value of the -variable `x-use-underline-position-properties', which is usually at the -baseline level. The default value is nil. */); + DEFVAR_BOOL ("x-underline-at-descent-line", + x_underline_at_descent_line, + doc: /* SKIP: real doc in xterm.c. */); x_underline_at_descent_line = 0; - DEFVAR_BOOL ("x-gtk-use-window-move", x_gtk_use_window_move, - doc: /* Non-nil means rely on gtk_window_move to set frame positions. -If this variable is t (the default), the GTK build uses the function -gtk_window_move to set or store frame positions and disables some time -consuming frame position adjustments. In newer versions of GTK, Emacs -always uses gtk_window_move and ignores the value of this variable. */); - x_gtk_use_window_move = true; - + DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, + doc: /* SKIP: real doc in xterm.c. */); + Vx_toolkit_scroll_bars = intern_c_string ("gtk"); DEFVAR_LISP ("pgtk-wait-for-event-timeout", Vpgtk_wait_for_event_timeout, - doc: /* How long to wait for X events. + doc: /* How long to wait for GTK events. -Emacs will wait up to this many seconds to receive X events after -making changes which affect the state of the graphical interface. -Under some window managers this can take an indefinite amount of time, -so it is important to limit the wait. +Emacs will wait up to this many seconds to receive some GTK events +after making changes which affect the state of the graphical +interface. Under some window managers this can take an indefinite +amount of time, so it is important to limit the wait. If set to a non-float value, there will be no wait at all. */); Vpgtk_wait_for_event_timeout = make_float (0.1); @@ -7095,25 +7037,39 @@ pgtk_end_cr_clip (struct frame *f) } void -pgtk_set_cr_source_with_gc_foreground (struct frame *f, Emacs_GC * gc) +pgtk_set_cr_source_with_gc_foreground (struct frame *f, Emacs_GC *gc, + bool respects_alpha_background) { - pgtk_set_cr_source_with_color (f, gc->foreground); + pgtk_set_cr_source_with_color (f, gc->foreground, + respects_alpha_background); } void -pgtk_set_cr_source_with_gc_background (struct frame *f, Emacs_GC * gc) +pgtk_set_cr_source_with_gc_background (struct frame *f, Emacs_GC *gc, + bool respects_alpha_background) { - pgtk_set_cr_source_with_color (f, gc->background); + pgtk_set_cr_source_with_color (f, gc->background, + respects_alpha_background); } void -pgtk_set_cr_source_with_color (struct frame *f, unsigned long color) +pgtk_set_cr_source_with_color (struct frame *f, unsigned long color, + bool respects_alpha_background) { Emacs_Color col; col.pixel = color; pgtk_query_color (f, &col); - cairo_set_source_rgb (FRAME_CR_CONTEXT (f), col.red / 65535.0, - col.green / 65535.0, col.blue / 65535.0); + + if (!respects_alpha_background) + cairo_set_source_rgb (FRAME_CR_CONTEXT (f), col.red / 65535.0, + col.green / 65535.0, col.blue / 65535.0); + else + { + cairo_set_source_rgba (FRAME_CR_CONTEXT (f), col.red / 65535.0, + col.green / 65535.0, col.blue / 65535.0, + f->alpha_background); + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_SOURCE); + } } void @@ -7163,7 +7119,7 @@ pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) int width, height; void (*surface_set_size_func) (cairo_surface_t *, double, double) = NULL; Lisp_Object acc = Qnil; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (31); diff --git a/src/pgtkterm.h b/src/pgtkterm.h index 42b03e315ef..4d2285cdb0a 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -591,12 +591,9 @@ extern void x_set_z_group (struct frame *f, Lisp_Object new_value, extern void pgtk_cr_update_surface_desired_size (struct frame *, int, int, bool); extern cairo_t *pgtk_begin_cr_clip (struct frame *f); extern void pgtk_end_cr_clip (struct frame *f); -extern void pgtk_set_cr_source_with_gc_foreground (struct frame *f, - Emacs_GC * gc); -extern void pgtk_set_cr_source_with_gc_background (struct frame *f, - Emacs_GC * gc); -extern void pgtk_set_cr_source_with_color (struct frame *f, - unsigned long color); +extern void pgtk_set_cr_source_with_gc_foreground (struct frame *, Emacs_GC *, bool); +extern void pgtk_set_cr_source_with_gc_background (struct frame *, Emacs_GC *, bool); +extern void pgtk_set_cr_source_with_color (struct frame *, unsigned long, bool); extern void pgtk_cr_draw_frame (cairo_t * cr, struct frame *f); extern void pgtk_cr_destroy_frame_context (struct frame *f); extern Lisp_Object pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type); diff --git a/src/print.c b/src/print.c index 04a271ce456..8cce8a1ad83 100644 --- a/src/print.c +++ b/src/print.c @@ -101,7 +101,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; struct buffer *old = current_buffer; \ ptrdiff_t old_point = -1, start_point = -1; \ ptrdiff_t old_point_byte = -1, start_point_byte = -1; \ - ptrdiff_t specpdl_count = SPECPDL_INDEX (); \ + specpdl_ref specpdl_count = SPECPDL_INDEX (); \ bool free_print_buffer = 0; \ bool multibyte \ = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \ @@ -556,7 +556,7 @@ write_string (const char *data, Lisp_Object printcharfun) void temp_output_buffer_setup (const char *bufname) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); register struct buffer *old = current_buffer; register Lisp_Object buf; @@ -669,7 +669,7 @@ a list, a buffer, a window, a frame, etc. A printed representation of an object is text which describes that object. */) (Lisp_Object object, Lisp_Object noescape) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_modification_hooks, Qt); @@ -1612,7 +1612,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, if (!NILP (Vprint_unreadable_function) && FUNCTIONP (Vprint_unreadable_function)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Bind `print-unreadable-function' to nil to avoid accidental infinite recursion in the function called. */ Lisp_Object func = Vprint_unreadable_function; diff --git a/src/process.c b/src/process.c index 79e5896a20a..94cc8800970 100644 --- a/src/process.c +++ b/src/process.c @@ -1752,7 +1752,7 @@ usage: (make-process &rest ARGS) */) { Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem; Lisp_Object xstderr, stderrproc; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (nargs == 0) return Qnil; @@ -2173,7 +2173,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) && !EQ (p->filter, Qt)) add_process_read_fd (inchannel); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* This may signal an error. */ setup_process_coding_systems (process); @@ -2340,7 +2340,6 @@ usage: (make-pipe-process &rest ARGS) */) struct Lisp_Process *p; Lisp_Object name, buffer; Lisp_Object tem; - ptrdiff_t specpdl_count; int inchannel, outchannel; if (nargs == 0) @@ -2351,7 +2350,7 @@ usage: (make-pipe-process &rest ARGS) */) name = Fplist_get (contact, QCname); CHECK_STRING (name); proc = make_process (name); - specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect (remove_process, proc); p = XPROCESS (proc); @@ -2471,7 +2470,7 @@ usage: (make-pipe-process &rest ARGS) */) eassert (p->decoding_carryover == 0); pset_encoding_buf (p, empty_unibyte_string); - specpdl_ptr = specpdl + specpdl_count; + specpdl_ptr = specpdl_ref_to_ptr (specpdl_count); return proc; } @@ -3079,7 +3078,6 @@ usage: (make-serial-process &rest ARGS) */) struct Lisp_Process *p; Lisp_Object name, buffer; Lisp_Object tem, val; - ptrdiff_t specpdl_count; if (nargs == 0) return Qnil; @@ -3101,7 +3099,7 @@ usage: (make-serial-process &rest ARGS) */) name = port; CHECK_STRING (name); proc = make_process (name); - specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect (remove_process, proc); p = XPROCESS (proc); @@ -3179,7 +3177,7 @@ usage: (make-serial-process &rest ARGS) */) Fserial_process_configure (nargs, args); - specpdl_ptr = specpdl + specpdl_count; + specpdl_ptr = specpdl_ref_to_ptr (specpdl_count); return proc; } @@ -3341,9 +3339,9 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, s = -1; struct sockaddr *sa = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_nothing (); - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); while (!NILP (addrinfos)) { @@ -3528,7 +3526,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, #endif /* !WINDOWSNT */ /* Discard the unwind protect closing S. */ - specpdl_ptr = specpdl + count1; + specpdl_ptr = specpdl_ref_to_ptr (count1); emacs_close (s); s = -1; if (0 <= socket_to_use) @@ -3599,7 +3597,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, { Lisp_Object data = get_file_errno_data (err, contact, xerrno); - pset_status (p, list2 (Fcar (data), Fcdr (data))); + pset_status (p, list2 (Qfailed, data)); unbind_to (count, Qnil); return; } @@ -3621,7 +3619,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos, p->outfd = outch; /* Discard the unwind protect for closing S, if any. */ - specpdl_ptr = specpdl + count1; + specpdl_ptr = specpdl_ref_to_ptr (count1); if (p->is_server && p->socktype != SOCK_DGRAM) pset_status (p, Qlisten); @@ -3879,7 +3877,7 @@ usage: (make-network-process &rest ARGS) */) #ifdef HAVE_GETADDRINFO_A struct gaicb *dns_request = NULL; #endif - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (nargs == 0) return Qnil; @@ -4208,7 +4206,7 @@ usage: (make-network-process &rest ARGS) */) if (! postpone_connection) connect_network_socket (proc, addrinfos, use_external_socket_p); - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); return proc; } @@ -4380,7 +4378,6 @@ network_interface_info (Lisp_Object ifname) Lisp_Object elt; int s; bool any = false; - ptrdiff_t count; #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \ && defined HAVE_GETIFADDRS && defined LLADDR) struct ifaddrs *ifap; @@ -4395,7 +4392,7 @@ network_interface_info (Lisp_Object ifname) s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); if (s < 0) return Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, s); elt = Qnil; @@ -4644,7 +4641,7 @@ error displays the error message. */) struct addrinfo hints; memset (&hints, 0, sizeof hints); - if (EQ (family, Qnil)) + if (NILP (family)) hints.ai_family = AF_UNSPEC; else if (EQ (family, Qipv4)) hints.ai_family = AF_INET; @@ -4839,7 +4836,6 @@ server_accept_connection (Lisp_Object server, int channel) int s; union u_sockaddr saddr; socklen_t len = sizeof saddr; - ptrdiff_t count; s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC); @@ -4861,7 +4857,7 @@ server_accept_connection (Lisp_Object server, int channel) return; } - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_int (close_file_unwind, s); connect_counter++; @@ -4980,7 +4976,7 @@ server_accept_connection (Lisp_Object server, int channel) eassert (p->pid == 0); /* Discard the unwind protect for closing S. */ - specpdl_ptr = specpdl + count; + specpdl_ptr = specpdl_ref_to_ptr (count); p->open_fd[SUBPROCESS_STDIN] = s; p->infd = s; @@ -5177,7 +5173,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS bool retry_for_async; #endif - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Close to the current time if known, an invalid timespec otherwise. */ struct timespec now = invalid_timespec (); @@ -6027,7 +6023,7 @@ read_process_output (Lisp_Object proc, int channel) struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = p->decoding_carryover; ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object odeactivate; char *chars; @@ -7438,7 +7434,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) { Lisp_Object sentinel, odeactivate; struct Lisp_Process *p = XPROCESS (proc); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool outer_running_asynch_code = running_asynch_code; int waiting = waiting_for_user_input_p; diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 7c172fe63a2..700a6c357de 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -3963,7 +3963,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, INIT_FAIL_STACK (); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Prevent shrinking and relocation of buffer text if GC happens while we are inside this function. The calls to diff --git a/src/search.c b/src/search.c index a1adfa2d8ce..816a757c188 100644 --- a/src/search.c +++ b/src/search.c @@ -310,7 +310,7 @@ looking_at_1 (Lisp_Object string, bool posix, bool modify_data) s2 = 0; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); freeze_buffer_relocation (); freeze_pattern (cache_entry); re_match_object = Qnil; @@ -568,7 +568,7 @@ fast_looking_at (Lisp_Object regexp, ptrdiff_t pos, ptrdiff_t pos_byte, struct regexp_cache *cache_entry = compile_pattern (regexp, 0, Qnil, 0, multibyte); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); freeze_buffer_relocation (); freeze_pattern (cache_entry); re_match_object = STRINGP (string) ? string : Qnil; @@ -1198,7 +1198,7 @@ search_buffer_re (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, s2 = 0; } - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); freeze_buffer_relocation (); freeze_pattern (cache_entry); @@ -2827,6 +2827,14 @@ All the elements are markers or nil (nil if the Nth pair didn't match) if the last match was on a buffer; integers or nil if a string was matched. Use `set-match-data' to reinstate the data in this list. +Note that non-matching optional groups at the end of the regexp are +elided instead of being represented with two `nil's each. For instance: + + (progn + (string-match "^\\(a\\)?\\(b\\)\\(c\\)?$" "b") + (match-data)) + => (0 1 nil nil 0 1) + If INTEGERS (the optional first argument) is non-nil, always use integers (rather than markers) to represent buffer positions. In this case, and if the last match was in a buffer, the buffer will get diff --git a/src/sound.c b/src/sound.c index 9681a136e4b..93c84a03b1f 100644 --- a/src/sound.c +++ b/src/sound.c @@ -1359,7 +1359,7 @@ Internal use only, use `play-sound' instead. */) (Lisp_Object sound) { Lisp_Object attrs[SOUND_ATTR_SENTINEL]; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #ifdef WINDOWSNT unsigned long ui_volume_tmp = UINT_MAX; diff --git a/src/sysdep.c b/src/sysdep.c index d682e87cc71..95f77febcbf 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -664,7 +664,7 @@ sys_subshell (void) #else { char *volatile str_volatile = str; - pid = vfork (); + pid = VFORK (); str = str_volatile; } #endif @@ -3365,7 +3365,6 @@ system_process_attributes (Lisp_Object pid) double pcpu, pmem; Lisp_Object attrs = Qnil; Lisp_Object decoded_cmd; - ptrdiff_t count; CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); @@ -3390,7 +3389,7 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/stat"); @@ -3512,7 +3511,7 @@ system_process_attributes (Lisp_Object pid) do { cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1); - set_unwind_protect_ptr (count + 1, xfree, cmdline); + set_unwind_protect_ptr (specpdl_ref_add (count, 1), xfree, cmdline); /* Leave room even if every byte needs escaping below. */ readsize = (cmdline_size >> 1) - nread; @@ -3546,7 +3545,7 @@ system_process_attributes (Lisp_Object pid) nread = cmdsize + 2; cmdline_size = nread + 1; q = cmdline = xrealloc (cmdline, cmdline_size); - set_unwind_protect_ptr (count + 1, xfree, cmdline); + set_unwind_protect_ptr (specpdl_ref_add (count, 1), xfree, cmdline); sprintf (cmdline, "[%.*s]", cmdsize, cmd); } /* Command line is encoded in locale-coding-system; decode it. */ @@ -3595,7 +3594,6 @@ system_process_attributes (Lisp_Object pid) gid_t gid; Lisp_Object attrs = Qnil; Lisp_Object decoded_cmd; - ptrdiff_t count; CHECK_NUMBER (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); @@ -3620,7 +3618,7 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/psinfo"); diff --git a/src/term.c b/src/term.c index 4c7a90a5773..bad1127c93b 100644 --- a/src/term.c +++ b/src/term.c @@ -1632,9 +1632,13 @@ produce_glyphs (struct it *it) } else { - Lisp_Object charset_list = FRAME_TERMINAL (it->f)->charset_list; + struct terminal *t = FRAME_TERMINAL (it->f); + Lisp_Object charset_list = t->charset_list, char_glyph; - if (char_charset (it->char_to_display, charset_list, NULL)) + if (char_charset (it->char_to_display, charset_list, NULL) + && (char_glyph = terminal_glyph_code (t, it->char_to_display), + NILP (char_glyph) + || (FIXNUMP (char_glyph) && XFIXNUM (char_glyph) >= 0))) { it->pixel_width = CHARACTER_WIDTH (it->char_to_display); it->nglyphs = it->pixel_width; @@ -3500,7 +3504,7 @@ tty_menu_show (struct frame *f, int x, int y, int menuflags, int dispwidth, dispheight; int i, j, lines, maxlines; int maxwidth; - ptrdiff_t specpdl_count; + specpdl_ref specpdl_count; eassert (FRAME_TERMCAP_P (f)); diff --git a/src/termhooks.h b/src/termhooks.h index 518e855eae1..b7696fed4f8 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -80,10 +80,29 @@ enum event_kind which the key was typed. .timestamp gives a timestamp (in milliseconds) for the keystroke. */ - MULTIBYTE_CHAR_KEYSTROKE_EVENT, /* The multibyte char code is in .code, - perhaps with modifiers applied. - The others are the same as - ASCII_KEYSTROKE_EVENT. */ + MULTIBYTE_CHAR_KEYSTROKE_EVENT, /* The multibyte char code is + in .code, perhaps with + modifiers applied. The + others are the same as + ASCII_KEYSTROKE_EVENT, + except when ARG is a + string, which will be + decoded and the decoded + string's characters will be + used as .code + individually. + + The string can have a + property `coding', which + should be a symbol + describing a coding system + to use to decode the string. + + If it is nil, then the + locale coding system will + be used. If it is t, then + no decoding will take + place. */ NON_ASCII_KEYSTROKE_EVENT, /* .code is a number identifying the function key. A code N represents a key whose name is diff --git a/src/terminal.c b/src/terminal.c index 3db80f4b1ff..80f3aed7006 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -622,6 +622,8 @@ init_initial_terminal (void) emacs_abort (); initial_terminal = create_terminal (output_initial, NULL); + /* Note: menu-bar.el:menu-bar-update-buffers knows about this + special name of the initial terminal. */ initial_terminal->name = xstrdup ("initial_terminal"); initial_terminal->kboard = initial_kboard; initial_terminal->delete_terminal_hook = &delete_initial_terminal; diff --git a/src/textprop.c b/src/textprop.c index 2d1e34d5867..c6c9e102e34 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -792,7 +792,7 @@ The property values are compared with `eq'. */) else { Lisp_Object initial_value, value; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (! NILP (object)) CHECK_BUFFER (object); @@ -879,7 +879,7 @@ first valid position in OBJECT. */) } else { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (! NILP (object)) CHECK_BUFFER (object); @@ -1164,7 +1164,7 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, add_text_properties_1 (start, end, properties, @@ -1379,7 +1379,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, @@ -1462,7 +1462,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); @@ -1558,7 +1558,7 @@ Use `set-text-properties' if you want to remove all text properties. */) buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, @@ -1683,7 +1683,7 @@ Return t if any property was actually removed, nil otherwise. */) buffers is slow and often unnecessary. */ if (BUFFERP (object) && XBUFFER (object) != current_buffer) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); set_buffer_internal (XBUFFER (object)); return unbind_to (count, diff --git a/src/thread.c b/src/thread.c index bfcac91982d..4c98d590b7a 100644 --- a/src/thread.c +++ b/src/thread.c @@ -83,6 +83,22 @@ release_global_lock (void) sys_mutex_unlock (&global_lock); } +static void +rebind_for_thread_switch (void) +{ + ptrdiff_t distance + = current_thread->m_specpdl_ptr - current_thread->m_specpdl; + specpdl_unrewind (specpdl_ptr, -distance, true); +} + +static void +unbind_for_thread_switch (struct thread_state *thr) +{ + ptrdiff_t distance = thr->m_specpdl_ptr - thr->m_specpdl; + specpdl_unrewind (thr->m_specpdl_ptr, distance, true); +} + + /* You must call this after acquiring the global lock. acquire_global_lock does it for you. */ static void @@ -329,7 +345,7 @@ Note that calls to `mutex-lock' and `mutex-unlock' must be paired. */) (Lisp_Object mutex) { struct Lisp_Mutex *lmutex; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); CHECK_MUTEX (mutex); lmutex = XMUTEX (mutex); @@ -709,7 +725,7 @@ DEFUN ("thread-yield", Fthread_yield, Sthread_yield, 0, 0, 0, static Lisp_Object invoke_thread_function (void) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); current_thread->result = Ffuncall (1, ¤t_thread->function); return unbind_to (count, Qnil); diff --git a/src/undo.c b/src/undo.c index 5d705945c4c..36664d16424 100644 --- a/src/undo.c +++ b/src/undo.c @@ -295,7 +295,7 @@ truncate_undo_list (struct buffer *b) /* Make sure that calling undo-outer-limit-function won't cause another GC. */ - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); /* Make the buffer current to get its local values of variables such as undo_limit. Also so that Vundo_outer_limit_function can diff --git a/src/w16select.c b/src/w16select.c index f6bc3dd8d47..b878481e469 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -651,7 +651,7 @@ frame's display, or the first available X display. */) by the X interface code. (On MSDOS, killed text is only put into the clipboard if we run under Windows, so we cannot check the clipboard alone.) */ - if ((EQ (selection, Qnil) || EQ (selection, QPRIMARY)) + if ((NILP (selection) || EQ (selection, QPRIMARY)) && ! NILP (Fsymbol_value (Fintern_soft (build_string ("kill-ring"), Qnil)))) return Qt; diff --git a/src/w32fns.c b/src/w32fns.c index 37f9b813c6c..a880136d0ac 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1217,7 +1217,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) #endif int mask_color; - if (!EQ (Qnil, arg)) + if (!NILP (arg)) f->output_data.w32->mouse_pixel = w32_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); mask_color = FRAME_BACKGROUND_PIXEL (f); @@ -1233,7 +1233,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) /* It's not okay to crash if the user selects a screwy cursor. */ count = x_catch_errors (FRAME_W32_DISPLAY (f)); - if (!EQ (Qnil, Vx_pointer_shape)) + if (!NILP (Vx_pointer_shape)) { CHECK_FIXNUM (Vx_pointer_shape); cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XFIXNUM (Vx_pointer_shape)); @@ -1242,7 +1242,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s"); - if (!EQ (Qnil, Vx_nontext_pointer_shape)) + if (!NILP (Vx_nontext_pointer_shape)) { CHECK_FIXNUM (Vx_nontext_pointer_shape); nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), @@ -1252,7 +1252,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr); x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s"); - if (!EQ (Qnil, Vx_hourglass_pointer_shape)) + if (!NILP (Vx_hourglass_pointer_shape)) { CHECK_FIXNUM (Vx_hourglass_pointer_shape); hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), @@ -1263,7 +1263,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s"); x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s"); - if (!EQ (Qnil, Vx_mode_pointer_shape)) + if (!NILP (Vx_mode_pointer_shape)) { CHECK_FIXNUM (Vx_mode_pointer_shape); mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), @@ -1273,7 +1273,7 @@ w32_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s"); - if (!EQ (Qnil, Vx_sensitive_text_pointer_shape)) + if (!NILP (Vx_sensitive_text_pointer_shape)) { CHECK_FIXNUM (Vx_sensitive_text_pointer_shape); hand_cursor @@ -5771,7 +5771,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, Lisp_Object name; bool minibuffer_only = false; long window_prompting = 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct w32_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; @@ -6018,6 +6018,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, NULL, NULL, RES_TYPE_BOOLEAN); gui_default_parameter (f, parameters, Qno_special_glyphs, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parameters, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Process alpha here (Bug#16619). On XP this fails with child frames. For `no-focus-on-map' frames delay processing of alpha @@ -6155,6 +6157,9 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, gui_default_parameter (f, parameters, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); + gui_default_parameter (f, parameters, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs cannot control visibility, so don't try. */ @@ -6941,7 +6946,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) struct frame *f; Lisp_Object frame; Lisp_Object name; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct kboard *kb; bool face_change_before = face_change; @@ -7089,6 +7094,8 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) /* Process alpha here (Bug#17344). */ gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -7266,10 +7273,9 @@ w32_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -7310,8 +7316,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, struct text_pos pos; int width, height; int old_windows_or_buffers_changed = windows_or_buffers_changed; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count_1; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object window, size, tip_buf; AUTO_STRING (tip, " *tip*"); @@ -7510,7 +7515,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, /* Insert STRING into the root window's buffer and fit the frame to the buffer. */ - count_1 = SPECPDL_INDEX (); + specpdl_ref count_1 = SPECPDL_INDEX (); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (w->contents)); bset_truncate_lines (current_buffer, Qnil); @@ -7945,7 +7950,7 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, #endif /* !NTGUI_UNICODE */ { - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); w32_dialog_in_progress (Qt); @@ -10436,6 +10441,7 @@ frame_parm_handler w32_frame_parm_handlers[] = w32_set_z_group, 0, /* x_set_override_redirect */ gui_set_no_special_glyphs, + gui_set_alpha_background, }; void diff --git a/src/w32font.c b/src/w32font.c index c4a89446b98..1f93f6d5e05 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -2660,7 +2660,7 @@ in the font selection dialog. */) ReleaseDC (FRAME_W32_WINDOW (f), hdc); { - int count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object value = Qnil; w32_dialog_in_progress (Qt); diff --git a/src/w32menu.c b/src/w32menu.c index 42e27babbc9..5cd6c3310e3 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -188,7 +188,7 @@ menubar_selection_callback (struct frame *f, void * client_data) i = 0; while (i < f->menu_bar_items_used) { - if (EQ (AREF (vector, i), Qnil)) + if (NILP (AREF (vector, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; @@ -285,7 +285,7 @@ set_frame_menubar (struct frame *f, bool deep_p) struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = (Lisp_Object *) alloca (previous_menu_items_used @@ -587,7 +587,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, i = 0; while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; @@ -779,7 +779,7 @@ w32_menu_show (struct frame *f, int x, int y, int menuflags, i = 0; while (i < menu_items_used) { - if (EQ (AREF (menu_items, i), Qnil)) + if (NILP (AREF (menu_items, i))) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; diff --git a/src/widget.c b/src/widget.c index c13ec504981..4231aa71b53 100644 --- a/src/widget.c +++ b/src/widget.c @@ -260,9 +260,8 @@ set_frame_size (EmacsFrame ew) } static void -update_wm_hints (EmacsFrame ew) +update_wm_hints (Widget wmshell, EmacsFrame ew) { - Widget wmshell = get_wm_shell ((Widget) ew); int cw; int ch; Dimension rounded_width; @@ -272,9 +271,6 @@ update_wm_hints (EmacsFrame ew) int base_width; int base_height; - /* This happens when the frame is just created. */ - if (! wmshell) return; - pixel_to_char_size (ew, ew->core.width, ew->core.height, &char_width, &char_height); char_to_pixel_size (ew, char_width, char_height, @@ -302,10 +298,9 @@ update_wm_hints (EmacsFrame ew) } void -widget_update_wm_size_hints (Widget widget) +widget_update_wm_size_hints (Widget widget, Widget frame) { - EmacsFrame ew = (EmacsFrame) widget; - update_wm_hints (ew); + update_wm_hints (widget, (EmacsFrame) frame); } static void @@ -386,7 +381,8 @@ EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs frame_size_history_plain (f, build_string ("EmacsFrameRealize")); - update_wm_hints (ew); + if (get_wm_shell (widget)) + update_wm_hints (get_wm_shell (widget), ew); } static void @@ -410,7 +406,8 @@ EmacsFrameResize (Widget widget) change_frame_size (f, ew->core.width, ew->core.height, false, true, false); - update_wm_hints (ew); + if (get_wm_shell (widget)) + update_wm_hints (get_wm_shell (widget), ew); update_various_frame_slots (ew); cancel_mouse_face (f); diff --git a/src/widget.h b/src/widget.h index dbf21a64cb9..2906d5ff9ec 100644 --- a/src/widget.h +++ b/src/widget.h @@ -97,6 +97,6 @@ extern struct _DisplayContext *display_context; /* Special entry points */ void EmacsFrameSetCharSize (Widget, int, int); void widget_store_internal_border (Widget widget); -void widget_update_wm_size_hints (Widget widget); +void widget_update_wm_size_hints (Widget widget, Widget frame); #endif /* _EmacsFrame_h */ diff --git a/src/window.c b/src/window.c index 2a5e4042a48..59e21f11cb1 100644 --- a/src/window.c +++ b/src/window.c @@ -481,7 +481,9 @@ Return WINDOW. */) DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0, doc: /* Return the selected window. The selected window is the window in which the standard cursor for -selected windows appears and to which many commands apply. */) +selected windows appears and to which many commands apply. + +Also see `old-selected-window' and `minibuffer-selected-window'. */) (void) { return selected_window; @@ -2574,7 +2576,7 @@ window_list (void) if (!CONSP (Vwindow_list)) { Lisp_Object tail, frame; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Vwindow_list = Qnil; /* Don't allow quitting in Fnconc. Otherwise we might end up @@ -2732,7 +2734,7 @@ static Lisp_Object next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames, bool next_p) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); decode_next_window_args (&window, &minibuf, &all_frames); @@ -2886,7 +2888,7 @@ static Lisp_Object window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames) { Lisp_Object tail, list, rest; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); decode_next_window_args (&window, &minibuf, &all_frames); list = Qnil; @@ -3505,7 +3507,7 @@ select_frame_norecord (Lisp_Object frame) static void run_window_configuration_change_hook (struct frame *f) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object frame, global_wcch = Fdefault_value (Qwindow_configuration_change_hook); XSETFRAME (frame, f); @@ -3538,7 +3540,7 @@ run_window_configuration_change_hook (struct frame *f) if (!NILP (Flocal_variable_p (Qwindow_configuration_change_hook, buffer))) { - ptrdiff_t inner_count = SPECPDL_INDEX (); + specpdl_ref inner_count = SPECPDL_INDEX (); record_unwind_protect (select_window_norecord, selected_window); select_window_norecord (window); run_funs (Fbuffer_local_value (Qwindow_configuration_change_hook, @@ -3575,7 +3577,7 @@ has established the size of the new window. */) (Lisp_Object window) { struct window *w = decode_live_window (window); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_current_buffer (); Fset_buffer (w->contents); @@ -3815,7 +3817,7 @@ run_window_change_functions (void) Lisp_Object tail, frame; bool selected_frame_change = !EQ (selected_frame, old_selected_frame); bool run_window_state_change_hook = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); window_change_record_frames = false; record_unwind_protect_void (window_change_record); @@ -4012,7 +4014,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, { struct window *w = XWINDOW (window); struct buffer *b = XBUFFER (buffer); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool samebuf = EQ (buffer, w->contents); wset_buffer (w, buffer); @@ -4232,7 +4234,7 @@ temp_output_buffer_show (register Lisp_Object buf) /* Run temp-buffer-show-hook, with the chosen window selected and its buffer current. */ { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object prev_window, prev_buffer; prev_window = selected_window; XSETBUFFER (prev_buffer, old); @@ -5486,7 +5488,7 @@ window_internal_height (struct window *w) static void window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); n = clip_to_bounds (INT_MIN, n, INT_MAX); @@ -6212,7 +6214,7 @@ scroll_command (Lisp_Object window, Lisp_Object n, int direction) { struct window *w; bool other_window; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); eassert (eabs (direction) == 1); @@ -6343,7 +6345,7 @@ It is determined by the function `other-window-for-scrolling', which see. */) (Lisp_Object arg) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); scroll_command (Fother_window_for_scrolling (), arg, 1); return unbind_to (count, Qnil); } @@ -6354,7 +6356,7 @@ DEFUN ("scroll-other-window-down", Fscroll_other_window_down, For more details, see the documentation for `scroll-other-window'. */) (Lisp_Object arg) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); scroll_command (Fother_window_for_scrolling (), arg, -1); return unbind_to (count, Qnil); } diff --git a/src/xdisp.c b/src/xdisp.c index 9c0764be690..b00343daa7e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -741,10 +741,6 @@ int update_mode_lines; static bool line_number_displayed; -/* The name of the *Messages* buffer, a string. */ - -static Lisp_Object Vmessages_buffer_name; - /* Current, index 0, and last displayed echo area message. Either buffers from echo_buffers, or nil to indicate no message. */ @@ -3002,7 +2998,7 @@ safe__call (bool inhibit_quit, ptrdiff_t nargs, Lisp_Object func, va_list ap) else { ptrdiff_t i; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object *args; USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (args, nargs); @@ -3988,6 +3984,12 @@ compute_stop_pos (struct it *it) pos = next_overlay_change (charpos); if (pos < it->stop_charpos) it->stop_charpos = pos; + /* If we are breaking compositions at point, stop at point. */ + if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + && !NILP (Vauto_composition_mode) + && composition_break_at_point + && charpos < PT && PT < it->stop_charpos) + it->stop_charpos = PT; /* Set up variables for computing the stop position from text property changes. */ @@ -3999,7 +4001,8 @@ compute_stop_pos (struct it *it) chunks. We play safe here by assuming that only SPC, TAB, FF, and NL cannot be in some composition; in particular, most ASCII punctuation characters could be composed into ligatures. */ - if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) + if (!composition_break_at_point + && !NILP (BVAR (current_buffer, enable_multibyte_characters)) && !NILP (Vauto_composition_mode)) { ptrdiff_t endpos = charpos + 10 * TEXT_PROP_DISTANCE_LIMIT; @@ -4308,7 +4311,7 @@ handle_fontified_prop (struct it *it) no amount of fontifying will be able to change it. */ NILP (prop) && IT_CHARPOS (*it) < Z)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; struct buffer *obuf = current_buffer; ptrdiff_t begv = BEGV, zv = ZV; @@ -4503,7 +4506,7 @@ face_at_pos (const struct it *it, enum lface_attribute_index attr_filter) static enum prop_handled handle_face_prop (struct it *it) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Don't allow the user to quit out of face-merging code, in case this is called when redisplaying a non-selected window, with point temporarily moved to window-point. */ @@ -5548,7 +5551,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, form = Qnil; if (!NILP (form) && !EQ (form, Qt)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Bind `object' to the object having the `display' property, a buffer or string. Bind `position' to the position in the @@ -5625,7 +5628,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, { /* Evaluate IT->font_height with `height' bound to the current specified height to get the new height. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct face *face = FACE_FROM_ID (it->f, it->face_id); specbind (Qheight, face->lface[LFACE_HEIGHT_INDEX]); @@ -5826,7 +5829,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, /* Don't allow quitting from lookup_derived_face, for when we are displaying a non-selected window, and the buffer's point was temporarily moved to the window-point. */ - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); face_id2 = lookup_derived_face (it->w, it->f, face_name, FRINGE_FACE_ID, false); @@ -5999,7 +6002,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, #ifdef HAVE_WINDOW_SYSTEM else { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); it->what = IT_IMAGE; /* Don't allow quitting from lookup_image, for when we are @@ -9190,7 +9193,19 @@ next_element_from_buffer (struct it *it) && IT_CHARPOS (*it) >= it->redisplay_end_trigger_charpos) run_redisplay_end_trigger_hook (it); - stop = it->bidi_it.scan_dir < 0 ? -1 : it->end_charpos; + if (composition_break_at_point + && !NILP (BVAR (current_buffer, enable_multibyte_characters)) + && !NILP (Vauto_composition_mode)) + { + /* Limit search for composable characters to point's position. */ + if (it->bidi_it.scan_dir < 0) + stop = (PT <= IT_CHARPOS (*it)) ? PT : -1; + else + stop = (IT_CHARPOS (*it) < PT + && PT < it->end_charpos) ? PT : it->end_charpos; + } + else + stop = it->bidi_it.scan_dir < 0 ? -1 : it->end_charpos; if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it), stop) && next_element_from_composition (it)) @@ -10216,7 +10231,8 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos could have both positions after TO_CHARPOS or both positions before it, due to bidi reordering.) */ - if (IT_CHARPOS (*it) != to_charpos + if (to_charpos > 0 + && IT_CHARPOS (*it) != to_charpos && ((IT_CHARPOS (it_backup) > to_charpos) == (IT_CHARPOS (*it) > to_charpos))) { @@ -11215,7 +11231,7 @@ WINDOW. */) ? current_buffer : XBUFFER (Fget_buffer (buffer_or_name))); Lisp_Object buffer, value; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); XSETBUFFER (buffer, b); @@ -11377,6 +11393,10 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) old_deactivate_mark = Vdeactivate_mark; oldbuf = current_buffer; + /* Sanity check, in case the variable has been set to something + invalid. */ + if (! STRINGP (Vmessages_buffer_name)) + Vmessages_buffer_name = build_string ("*Messages*"); /* Ensure the Messages buffer exists, and switch to it. If we created it, set the major-mode. */ bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name)); @@ -11447,7 +11467,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool nlflag, bool multibyte) we aren't prepared to run modification hooks (we could end up calling modification hooks from another buffer and only with AFTER=t, Bug#21824). */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_modification_hooks, Qt); insert_1_both ("\n", 1, 1, true, false, false); @@ -11902,7 +11922,7 @@ with_echo_area_buffer (struct window *w, int which, { Lisp_Object buffer; bool this_one, the_other, clear_buffer_p, rc; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* If buffers aren't live, make new ones. */ ensure_echo_area_buffers (); @@ -12087,7 +12107,7 @@ setup_echo_area_for_printing (bool multibyte_p) if (Z > BEG) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_read_only, Qt); /* Note that undo recording is always disabled. */ del_range (BEG, Z); @@ -12155,7 +12175,7 @@ display_echo_area (struct window *w) That message would modify the echo area buffer's contents while a redisplay of the buffer is going on, and seriously confuse redisplay. */ - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); /* If there is no message, we must call display_echo_area_1 nevertheless because it resizes the window. But we will have to @@ -12535,7 +12555,7 @@ set_message (Lisp_Object string) if (FUNCTIONP (Vset_message_function)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); message = safe_call1 (Vset_message_function, string); unbind_to (count, Qnil); @@ -12613,7 +12633,7 @@ clear_message (bool current_p, bool last_displayed_p) if (FUNCTIONP (Vclear_message_function)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); safe_call (1, Vclear_message_function); unbind_to (count, Qnil); @@ -12748,7 +12768,7 @@ echo_area_display (bool update_frame_p) /* Must update other windows. Likewise as in other cases, don't let this update be interrupted by pending input. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); fset_redisplay (f); redisplay_internal (); @@ -13084,7 +13104,7 @@ gui_consider_frame_title (Lisp_Object frame) char *title; ptrdiff_t len; struct it it; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); FOR_EACH_FRAME (tail, other_frame) { @@ -13242,7 +13262,7 @@ prepare_menu_bars (void) if (all_windows) { Lisp_Object tail, frame; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* True means that update_menu_bar has run its hooks so any further calls to update_menu_bar shouldn't do so again. */ bool menu_bar_hooks_run = false; @@ -13339,7 +13359,7 @@ update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run) || window_buffer_changed (w)) { struct buffer *prev = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_menubar_update, Qt); @@ -13509,7 +13529,7 @@ update_tab_bar (struct frame *f, bool save_match_data) || window_buffer_changed (w)) { struct buffer *prev = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object new_tab_bar; int new_n_tab_bar; @@ -14422,7 +14442,7 @@ update_tool_bar (struct frame *f, bool save_match_data) || window_buffer_changed (w)) { struct buffer *prev = current_buffer; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object frame, new_tool_bar; int new_n_tool_bar; @@ -15973,7 +15993,6 @@ redisplay_internal (void) bool must_finish = false, match_p; struct text_pos tlbufpos, tlendpos; int number_of_visible_frames; - ptrdiff_t count; struct frame *sf; bool polling_stopped_here = false; Lisp_Object tail, frame; @@ -16036,7 +16055,7 @@ redisplay_internal (void) /* Record a function that clears redisplaying_p when we leave this function. */ - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_void (unwind_redisplay); redisplaying_p = true; block_buffer_flips (); @@ -16239,6 +16258,14 @@ redisplay_internal (void) /* Point must be on the line that we have info recorded about. */ && PT >= CHARPOS (tlbufpos) && PT <= Z - CHARPOS (tlendpos) + /* FIXME: The following condition is only needed when + significant parts of the buffer are hidden (e.g., under + hs-minor-mode), but there doesn't seem to be a simple way of + detecting that, so we always disable the one-line redisplay + optimizations whenever display-line-numbers-mode is turned on + in the buffer. */ + && (NILP (Vdisplay_line_numbers) + || EQ (Vdisplay_line_numbers, Qvisual)) /* All text outside that line, including its final newline, must be unchanged. */ && text_outside_line_unchanged_p (w, CHARPOS (tlbufpos), @@ -16390,7 +16417,8 @@ redisplay_internal (void) /* If highlighting the region, or if the cursor is in the echo area, then we can't just move the cursor. */ else if (NILP (Vshow_trailing_whitespace) - && !cursor_in_echo_area) + && !cursor_in_echo_area + && !composition_break_at_point) { struct it it; struct glyph_row *row; @@ -16825,7 +16853,7 @@ redisplay_preserve_echo_area (int from_where) redisplay_trace ("redisplay_preserve_echo_area (%d)\n", from_where); block_input (); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); record_unwind_protect_void (unwind_redisplay_preserve_echo_area); block_buffer_flips (); unblock_input (); @@ -17699,7 +17727,7 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp) if (!NILP (Vwindow_scroll_functions)) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); run_hook_with_args_2 (Qwindow_scroll_functions, window, make_fixnum (CHARPOS (startp))); @@ -18738,6 +18766,33 @@ set_horizontal_scroll_bar (struct window *w) (w, portion, whole, start); } +/* Subroutine of redisplay_window, to determine whether a window-start + point STARTP of WINDOW should be rejected. */ +static bool +window_start_acceptable_p (Lisp_Object window, ptrdiff_t startp) +{ + if (!make_window_start_visible) + return true; + + struct window *w = XWINDOW (window); + struct frame *f = XFRAME (w->frame); + Lisp_Object startpos = make_fixnum (startp); + Lisp_Object invprop, disp_spec; + struct text_pos ignored; + + /* Is STARTP in invisible text? */ + if ((invprop = Fget_char_property (startpos, Qinvisible, window)), + TEXT_PROP_MEANS_INVISIBLE (invprop) != 0) + return false; + + /* Is STARTP covered by a replacing 'display' property? */ + if (!NILP (disp_spec = Fget_char_property (startpos, Qdisplay, window)) + && handle_display_spec (NULL, disp_spec, Qnil, Qnil, &ignored, startp, + FRAME_WINDOW_P (f)) > 0) + return false; + + return true; +} /* Redisplay leaf window WINDOW. JUST_THIS_ONE_P means only selected_window is redisplayed. @@ -18807,7 +18862,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) It indicates that the buffer contents and narrowing are unchanged. */ bool buffer_unchanged_p = false; bool temp_scroll_step = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int rc; int centering_position = -1; bool last_line_misfit = false; @@ -18901,6 +18956,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p && !window_outdated (w) + && !composition_break_at_point && !hscrolling_current_line_p (w)); beg_unchanged = BEG_UNCHANGED; @@ -19069,6 +19125,11 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) else if (CHARPOS (startp) > ZV) SET_TEXT_POS (startp, ZV, ZV_BYTE); + /* Reject the specified start location if it is invisible, and + the buffer wants it always visible. */ + if (!window_start_acceptable_p (window, CHARPOS (startp))) + goto ignore_start; + /* Redisplay, then check if cursor has been set during the redisplay. Give up if new fonts were loaded. */ /* We used to issue a CHECK_MARGINS argument to try_window here, @@ -19226,6 +19287,8 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto done; } + ignore_start: + /* Handle case where text has not changed, only point, and it has not moved off the frame, and we are not retrying after hscroll. (current_matrix_up_to_date_p is true when retrying.) */ @@ -19247,10 +19310,14 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) } } /* If current starting point was originally the beginning of a line - but no longer is, find a new starting point. */ + but no longer is, or if the starting point is invisible but the + buffer wants it always visible, find a new starting point. */ else if (w->start_at_line_beg - && !(CHARPOS (startp) <= BEGV - || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n')) + && ((CHARPOS (startp) > BEGV + && FETCH_BYTE (BYTEPOS (startp) - 1) != '\n') + || (CHARPOS (startp) >= BEGV + && CHARPOS (startp) <= ZV + && !window_start_acceptable_p (window, CHARPOS (startp))))) { #ifdef GLYPH_DEBUG debug_method_add (w, "recenter 1"); @@ -19326,6 +19393,17 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) goto force_start; } + /* Don't use the same window-start if it is invisible or covered + by a replacing 'display' property and the buffer requested + the window-start to be always visible. */ + if (!window_start_acceptable_p (window, CHARPOS (startp))) + { +#ifdef GLYPH_DEBUG + debug_method_add (w, "recenter 2"); +#endif + goto recenter; + } + #ifdef GLYPH_DEBUG debug_method_add (w, "same window start"); #endif @@ -19731,7 +19809,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) || window_wants_header_line (w) || window_wants_tab_line (w))) { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); display_mode_lines (w); @@ -22551,7 +22629,7 @@ extend_face_to_end_of_line (struct it *it) || WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0)) return; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Don't allow the user to quit out of face-merging code, in case this is called when redisplaying a non-selected window, with @@ -23449,7 +23527,7 @@ display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte, return display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); ptrdiff_t val; - ptrdiff_t pdl_count = SPECPDL_INDEX (); + specpdl_ref pdl_count = SPECPDL_INDEX (); record_unwind_protect (save_restriction_restore, save_restriction_save ()); Fwiden (); val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr); @@ -23475,7 +23553,7 @@ display_count_lines_visually (struct it *it) return it->lnum + 1; else { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (IT_CHARPOS (*it) <= PT) { @@ -25911,7 +25989,7 @@ display_mode_lines (struct window *w) { Lisp_Object old_selected_window = selected_window; Lisp_Object new_frame = w->frame; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); int n = 0; record_unwind_protect (restore_selected_window, selected_window); @@ -26003,7 +26081,7 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) { struct it it; struct face *face; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); init_iterator (&it, w, -1, -1, NULL, face_id); /* Don't extend on a previously drawn mode-line. @@ -26768,7 +26846,7 @@ are the selected window and the WINDOW's buffer). */) struct buffer *old_buffer = NULL; int face_id; bool no_props = FIXNUMP (face); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object str; int string_start = 0; @@ -27481,7 +27559,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, case '@': { - ptrdiff_t count = inhibit_garbage_collection (); + specpdl_ref count = inhibit_garbage_collection (); Lisp_Object curdir = BVAR (current_buffer, directory); Lisp_Object val = Qnil; @@ -35625,8 +35703,13 @@ be let-bound around code that needs to disable messages temporarily. */); staticpro (&echo_area_buffer[0]); staticpro (&echo_area_buffer[1]); - Vmessages_buffer_name = build_pure_c_string ("*Messages*"); - staticpro (&Vmessages_buffer_name); + DEFVAR_LISP ("messages-buffer-name", Vmessages_buffer_name, + doc: /* The name of the buffer where messages are logged. +This is normally \"\*Messages*\", but can be rebound by packages that +wish to redirect messages to a different buffer. (If the buffer +doesn't exist, it will be created and put into +`messages-buffer-mode'.) */); + Vmessages_buffer_name = build_string ("*Messages*"); mode_line_proptrans_alist = Qnil; staticpro (&mode_line_proptrans_alist); @@ -35967,6 +36050,12 @@ window, nil if it's okay to leave the cursor partially-visible. */); Vmake_cursor_line_fully_visible = Qt; DEFSYM (Qmake_cursor_line_fully_visible, "make-cursor-line-fully-visible"); + DEFVAR_BOOL ("make-window-start-visible", make_window_start_visible, + doc: /* Whether to ensure `window-start' position is never invisible. */); + make_window_start_visible = false; + DEFSYM (Qmake_window_start_visible, "make-window-start-visible"); + Fmake_variable_buffer_local (Qmake_window_start_visible); + DEFSYM (Qclose_tab, "close-tab"); DEFVAR_LISP ("tab-bar-border", Vtab_bar_border, doc: /* Border below tab-bar in pixels. @@ -36467,6 +36556,12 @@ Otherwise, use custom-tailored code after resizing minibuffer windows to try and display the most important part of the minibuffer. */); /* See bug#43519 for some discussion around this. */ redisplay_adhoc_scroll_in_resize_mini_windows = true; + + DEFVAR_BOOL ("composition-break-at-point", composition_break_at_point, + doc: /* If non-nil, prevent auto-composition of characters around point. +This makes it easier to edit character sequences that are +composed on display. */); + composition_break_at_point = false; } diff --git a/src/xfaces.c b/src/xfaces.c index 6a279f87192..55a9bed8f22 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4151,9 +4151,9 @@ If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). The font default for a face is either nil, or a list of the form (bold), (italic) or (bold italic). -If FRAME is omitted or nil, use the selected frame. And, in this case, -if the optional third argument CHARACTER is given, -return the font name used for CHARACTER. */) +If FRAME is omitted or nil, use the selected frame. +If FRAME is anything but t, and the optional third argument CHARACTER +is given, return the font name used by FACE for CHARACTER on FRAME. */) (Lisp_Object face, Lisp_Object frame, Lisp_Object character) { if (EQ (frame, Qt)) @@ -5593,7 +5593,6 @@ realize_basic_faces (struct frame *f) if (realize_default_face (f)) { - realize_named_face (f, Qmode_line, MODE_LINE_FACE_ID); realize_named_face (f, Qmode_line_active, MODE_LINE_ACTIVE_FACE_ID); realize_named_face (f, Qmode_line_inactive, MODE_LINE_INACTIVE_FACE_ID); realize_named_face (f, Qtool_bar, TOOL_BAR_FACE_ID); diff --git a/src/xfns.c b/src/xfns.c index 33d8d98e70b..9afadd16e98 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -610,7 +610,7 @@ x_relative_mouse_position (struct frame *f, int *x, int *y) block_input (); XQueryPointer (FRAME_X_DISPLAY (f), - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, /* The root window which contains the pointer. */ &root, @@ -687,7 +687,7 @@ x_defined_color (struct frame *f, const char *color_name, is a monochrome frame, return MONO_COLOR regardless of what ARG says. Signal an error if color can't be allocated. */ -static int +static unsigned long x_decode_color (struct frame *f, Lisp_Object color_name, int mono_color) { XColor cdef; @@ -728,6 +728,46 @@ x_set_wait_for_wm (struct frame *f, Lisp_Object new_value, Lisp_Object old_value } static void +x_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ +#ifndef HAVE_GTK3 + unsigned long opaque_region[] = {0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)}; +#endif + + gui_set_alpha_background (f, arg, oldval); + +#ifdef USE_GTK + /* This prevents GTK from painting the window's background, which + interferes with transparent background in some environments */ + + if (!FRAME_TOOLTIP_P (f)) + gtk_widget_set_app_paintable (FRAME_GTK_OUTER_WIDGET (f), + f->alpha_background != 1.0); +#endif + + if (!FRAME_DISPLAY_INFO (f)->alpha_bits) + return; + + if (f->alpha_background != 1.0) + { + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + NULL, 0); + } +#ifndef HAVE_GTK3 + else + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opaque_region, 4); +#endif +} + +static void x_set_tool_bar_position (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) @@ -870,7 +910,7 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu block_input (); XReparentWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - p ? FRAME_X_WINDOW (p) : DefaultRootWindow (FRAME_X_DISPLAY (f)), + p ? FRAME_X_WINDOW (p) : FRAME_DISPLAY_INFO (f)->root_window, f->left_pos, f->top_pos); #ifdef USE_GTK if (EQ (x_gtk_resize_child_frames, Qresize_mode)) @@ -1415,7 +1455,7 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) F has an x-window. */ static void -x_set_border_pixel (struct frame *f, int pix) +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; @@ -1445,7 +1485,7 @@ x_set_border_pixel (struct frame *f, int pix) static void x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - int pix; + unsigned long pix; CHECK_STRING (arg); pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); @@ -1925,7 +1965,7 @@ x_set_scroll_bar_background (struct frame *f, Lisp_Object value, Lisp_Object old /* Encode Lisp string STRING as a text in a format appropriate for - XICCC (X Inter Client Communication Conventions). + the ICCCM (Inter Client Communication Conventions Manual). If STRING contains only ASCII characters, do no conversion and return the string data of STRING. Otherwise, encode the text by @@ -2331,6 +2371,67 @@ hack_wm_protocols (struct frame *f, Widget widget) } #endif +static void +append_wm_protocols (struct x_display_info *dpyinfo, + struct frame *f) +{ + unsigned char *existing = NULL; + int format = 0; + unsigned long nitems = 0; + Atom type; + Atom *existing_protocols; + Atom protos[10]; + int num_protos = 0; + bool found_wm_ping = false; +#if !defined HAVE_GTK3 && defined HAVE_XSYNC + bool found_wm_sync_request = false; +#endif + unsigned long bytes_after; + + block_input (); + if ((XGetWindowProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_wm_protocols, + 0, 100, False, XA_ATOM, &type, &format, &nitems, + &bytes_after, &existing) == Success) + && format == 32 && type == XA_ATOM) + { + existing_protocols = (Atom *) existing; + + while (nitems) + { + nitems--; + + if (existing_protocols[nitems] + == dpyinfo->Xatom_net_wm_ping) + found_wm_ping = true; +#if !defined HAVE_GTK3 && defined HAVE_XSYNC + else if (existing_protocols[nitems] + == dpyinfo->Xatom_net_wm_sync_request) + found_wm_sync_request = true; +#endif + } + } + + if (existing) + XFree (existing); + + if (!found_wm_ping) + protos[num_protos++] = dpyinfo->Xatom_net_wm_ping; +#if !defined HAVE_GTK3 && defined HAVE_XSYNC + if (!found_wm_sync_request && dpyinfo->xsync_supported_p) + protos[num_protos++] = dpyinfo->Xatom_net_wm_sync_request; +#endif + + if (num_protos) + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_wm_protocols, + XA_ATOM, 32, PropModeAppend, + (unsigned char *) protos, + num_protos); + unblock_input (); +} + /* Support routines for XIC (X Input Context). */ @@ -2342,14 +2443,19 @@ static void xic_preedit_caret_callback (XIC, XPointer, XIMPreeditCaretCallbackSt static void xic_preedit_done_callback (XIC, XPointer, XPointer); static int xic_preedit_start_callback (XIC, XPointer, XPointer); +#ifndef HAVE_XICCALLBACK_CALLBACK +#define XICCallback XIMCallback +#define XICProc XIMProc +#endif + static XIMCallback Xxic_preedit_draw_callback = { NULL, (XIMProc) xic_preedit_draw_callback }; static XIMCallback Xxic_preedit_caret_callback = { NULL, (XIMProc) xic_preedit_caret_callback }; static XIMCallback Xxic_preedit_done_callback = { NULL, (XIMProc) xic_preedit_done_callback }; -static XIMCallback Xxic_preedit_start_callback = { NULL, - (void *) xic_preedit_start_callback }; +static XICCallback Xxic_preedit_start_callback = { NULL, + (XICProc) xic_preedit_start_callback }; #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT /* Create an X fontset on frame F with base font name BASE_FONTNAME. */ @@ -2843,15 +2949,20 @@ xic_set_preeditarea (struct window *w, int x, int y) XFree (attr); } #ifdef USE_GTK + if (f->tooltip) + return; + GdkRectangle rect; + int scale = xg_get_scale (f); + rect.x = (WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w) - + WINDOW_LEFT_MARGIN_WIDTH (w)); + + WINDOW_LEFT_MARGIN_WIDTH (w)) / scale; rect.y = (WINDOW_TO_FRAME_PIXEL_Y (w, y) + FRAME_TOOLBAR_HEIGHT (f) - + FRAME_MENUBAR_HEIGHT (f)); - rect.width = w->phys_cursor_width; - rect.height = w->phys_cursor_height; + + FRAME_MENUBAR_HEIGHT (f)) / scale; + rect.width = w->phys_cursor_width / scale; + rect.height = w->phys_cursor_height / scale; gtk_im_context_set_cursor_location (FRAME_X_OUTPUT (f)->im_context, &rect); @@ -3028,14 +3139,64 @@ xic_preedit_done_callback (XIC xic, XPointer client_data, } } +struct x_xim_text_conversion_data +{ + struct coding_system *coding; + char *source; +}; + +static Lisp_Object +x_xim_text_to_utf8_unix_1 (ptrdiff_t nargs, + Lisp_Object *args) +{ + struct x_xim_text_conversion_data *data; + ptrdiff_t nbytes; + + data = xmint_pointer (args[0]); + nbytes = strlen (data->source); + + data->coding->destination = NULL; + + setup_coding_system (Vlocale_coding_system, + data->coding); + data->coding->mode |= (CODING_MODE_LAST_BLOCK + | CODING_MODE_SAFE_ENCODING); + data->coding->source = (const unsigned char *) data->source; + data->coding->dst_bytes = 2048; + data->coding->destination = xmalloc (2048); + decode_coding_object (data->coding, Qnil, 0, 0, + nbytes, nbytes, Qnil); + + return Qnil; +} + +static Lisp_Object +x_xim_text_to_utf8_unix_2 (Lisp_Object val, + ptrdiff_t nargs, + Lisp_Object *args) +{ + struct x_xim_text_conversion_data *data; + + data = xmint_pointer (args[0]); + + if (data->coding->destination) + xfree (data->coding->destination); + + data->coding->destination = NULL; + + return Qnil; +} + /* The string returned is not null-terminated. */ static char * x_xim_text_to_utf8_unix (XIMText *text, ptrdiff_t *length) { unsigned char *wchar_buf; ptrdiff_t wchar_actual_length, i; - ptrdiff_t nbytes; struct coding_system coding; + struct x_xim_text_conversion_data data; + bool was_waiting_for_input_p; + Lisp_Object arg; if (text->encoding_is_wchar) { @@ -3050,17 +3211,16 @@ x_xim_text_to_utf8_unix (XIMText *text, ptrdiff_t *length) return (char *) wchar_buf; } - nbytes = strlen (text->string.multi_byte); - setup_coding_system (Vlocale_coding_system, &coding); - coding.mode |= (CODING_MODE_LAST_BLOCK - | CODING_MODE_SAFE_ENCODING); - coding.source = (const unsigned char *) text->string.multi_byte; - coding.dst_bytes = 2048; - coding.destination = xmalloc (2048); - decode_coding_object (&coding, Qnil, 0, 0, nbytes, nbytes, Qnil); + data.coding = &coding; + data.source = text->string.multi_byte; - /* coding.destination has either been allocated by us, or - reallocated by decode_coding_object. */ + was_waiting_for_input_p = waiting_for_input; + /* Otherwise Fsignal will crash. */ + waiting_for_input = false; + arg = make_mint_ptr (&data); + internal_condition_case_n (x_xim_text_to_utf8_unix_1, 1, &arg, + Qt, x_xim_text_to_utf8_unix_2); + waiting_for_input = was_waiting_for_input_p; *length = coding.produced; return (char *) coding.destination; @@ -3088,7 +3248,13 @@ xic_preedit_draw_callback (XIC xic, XPointer client_data, return; if (call_data->text) - text = x_xim_text_to_utf8_unix (call_data->text, &text_length); + { + text = x_xim_text_to_utf8_unix (call_data->text, &text_length); + + if (!text) + /* Decoding the IM text failed. */ + goto im_abort; + } else text = NULL; @@ -3399,13 +3565,13 @@ setup_xi_event_mask (struct frame *f) XISetMask (m, XI_PropertyEvent); XISetMask (m, XI_HierarchyChanged); XISetMask (m, XI_DeviceChanged); -#ifdef XI_TouchBegin +#ifdef HAVE_XINPUT2_2 if (FRAME_DISPLAY_INFO (f)->xi2_version >= 2) { XISetMask (m, XI_TouchBegin); XISetMask (m, XI_TouchUpdate); XISetMask (m, XI_TouchEnd); -#ifdef XI_GesturePinchBegin +#ifdef HAVE_XINPUT2_4 if (FRAME_DISPLAY_INFO (f)->xi2_version >= 4) { XISetMask (m, XI_GesturePinchBegin); @@ -3596,6 +3762,7 @@ x_window (struct frame *f, long window_prompting) &f->output_data.x->wm_hints); hack_wm_protocols (f, shell_widget); + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); #ifdef X_TOOLKIT_EDITRES XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0); @@ -3716,6 +3883,8 @@ x_window (struct frame *f) } #endif + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); + #ifdef HAVE_XINPUT2 if (FRAME_DISPLAY_INFO (f)->supports_xi2) setup_xi_event_mask (f); @@ -3751,7 +3920,7 @@ x_window (struct frame *f) f->top_pos, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), f->border_width, - CopyFromParent, /* depth */ + FRAME_DISPLAY_INFO (f)->n_planes, /* depth */ InputOutput, /* class */ FRAME_X_VISUAL (f), attribute_mask, &attributes); @@ -3804,6 +3973,8 @@ x_window (struct frame *f) XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2); } + append_wm_protocols (FRAME_DISPLAY_INFO (f), f); + /* x_set_name normally ignores requests to set the name if the requested name is the same as the current name. This is the one place where that assumption isn't correct; f->name is set, but @@ -3955,11 +4126,9 @@ x_make_gc (struct frame *f) /* Cursor has cursor-color background, background-color foreground. */ gc_values.foreground = FRAME_BACKGROUND_PIXEL (f); gc_values.background = f->output_data.x->cursor_pixel; - gc_values.fill_style = FillOpaqueStippled; f->output_data.x->cursor_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - (GCForeground | GCBackground - | GCFillStyle | GCLineWidth), + (GCForeground | GCBackground | GCLineWidth), &gc_values); /* Create the gray border tile used when the pointer is not in @@ -4188,7 +4357,7 @@ This function is an internal primitive--use `make-frame' instead. */) bool minibuffer_only = false; bool undecorated = false, override_redirect = false; long window_prompting = 0; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object display; struct x_display_info *dpyinfo = NULL; Lisp_Object parent, parent_frame; @@ -4591,6 +4760,8 @@ This function is an internal primitive--use `make-frame' instead. */) RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); if (!NILP (parent_frame)) { @@ -4706,6 +4877,46 @@ This function is an internal primitive--use `make-frame' instead. */) (unsigned char *) &dpyinfo->client_leader_window, 1); } +#ifdef HAVE_XSYNC + if (dpyinfo->xsync_supported_p) + { +#ifndef HAVE_GTK3 + XSyncValue initial_value; + XSyncCounter counters[2]; + + AUTO_STRING (synchronizeResize, "synchronizeResize"); + AUTO_STRING (SynchronizeResize, "SynchronizeResize"); + + Lisp_Object value = gui_display_get_resource (dpyinfo, + synchronizeResize, + SynchronizeResize, + Qnil, Qnil); + + XSyncIntToValue (&initial_value, 0); + counters[0] + = FRAME_X_BASIC_COUNTER (f) + = XSyncCreateCounter (FRAME_X_DISPLAY (f), + initial_value); + + if (STRINGP (value) && !strcmp (SSDATA (value), "extended")) + counters[1] + = FRAME_X_EXTENDED_COUNTER (f) + = XSyncCreateCounter (FRAME_X_DISPLAY (f), + initial_value); + + FRAME_X_OUTPUT (f)->current_extended_counter_value + = initial_value; + + XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_sync_request_counter, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &counters, + ((STRINGP (value) + && !strcmp (SSDATA (value), "extended")) ? 2 : 1)); +#endif + } +#endif + unblock_input (); /* Works iff frame has been already mapped. */ @@ -5564,10 +5775,7 @@ x_get_monitor_attributes (struct x_display_info *dpyinfo) #ifdef HAVE_XINERAMA if (NILP (attributes_list)) { - int xin_event_base, xin_error_base; - bool xin_ok = false; - xin_ok = XineramaQueryExtension (dpy, &xin_event_base, &xin_error_base); - if (xin_ok && XineramaIsActive (dpy)) + if (dpyinfo->xinerama_supported_p && XineramaIsActive (dpy)) attributes_list = x_get_monitor_attributes_xinerama (dpyinfo); } #endif /* HAVE_XINERAMA */ @@ -6211,7 +6419,7 @@ selected frame's display. */) block_input (); XQueryPointer (FRAME_X_DISPLAY (f), - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, &root, &dummy_window, &x, &y, &dummy, &dummy, (unsigned int *) &dummy); unblock_input (); @@ -6245,14 +6453,15 @@ The coordinates X and Y are interpreted in pixels relative to a position &deviceid)) { XIWarpPointer (FRAME_X_DISPLAY (f), deviceid, None, - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, 0, 0, 0, 0, xval, yval); } XUngrabServer (FRAME_X_DISPLAY (f)); } else #endif - XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY (f)), + XWarpPointer (FRAME_X_DISPLAY (f), None, + FRAME_DISPLAY_INFO (f)->root_window, 0, 0, 0, 0, xval, yval); unblock_input (); @@ -6289,8 +6498,7 @@ visual_classes[] = the X function with the same name when that doesn't exist. */ int -XScreenNumberOfScreen (scr) - register Screen *scr; +XScreenNumberOfScreen (Screen *scr) { Display *dpy = scr->display; int i; @@ -6364,10 +6572,49 @@ select_visual (struct x_display_info *dpyinfo) int n_visuals; XVisualInfo *vinfo, vinfo_template; - dpyinfo->visual = DefaultVisualOfScreen (screen); + vinfo_template.screen = XScreenNumberOfScreen (screen); + +#if !defined USE_X_TOOLKIT && !(defined USE_GTK && !defined HAVE_GTK3) \ + && defined HAVE_XRENDER + int i; + XRenderPictFormat *format; + + /* First attempt to find a visual with an alpha mask if + available. That information is only available when the + render extension is present, and we cannot do much with such + a visual if it isn't. */ + + if (dpyinfo->xrender_supported_p) + { + + vinfo = XGetVisualInfo (dpy, VisualScreenMask, + &vinfo_template, &n_visuals); + + for (i = 0; i < n_visuals; ++i) + { + format = XRenderFindVisualFormat (dpy, vinfo[i].visual); + + if (format && format->type == PictTypeDirect + && format->direct.alphaMask) + { + dpyinfo->n_planes = vinfo[i].depth; + dpyinfo->visual = vinfo[i].visual; + dpyinfo->pict_format = format; + + XFree (vinfo); + return; + } + } + + if (vinfo) + XFree (vinfo); + } +#endif /* !USE_X_TOOLKIT */ + /* Visual with alpha channel (or the Render extension) not + available, fallback to default visual. */ + dpyinfo->visual = DefaultVisualOfScreen (screen); vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual); - vinfo_template.screen = XScreenNumberOfScreen (screen); vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask, &vinfo_template, &n_visuals); if (n_visuals <= 0) @@ -6959,7 +7206,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) struct frame *f; Lisp_Object frame; Lisp_Object name; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); bool face_change_before = face_change; if (!dpyinfo->terminal->name) @@ -7121,19 +7368,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); - /* Init faces before gui_default_parameter is called for the - scroll-bar-width parameter because otherwise we end up in - init_iterator with a null face cache, which should not happen. */ - init_frame_faces (f); - - f->output_data.x->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; - - gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, - "inhibitDoubleBuffering", "InhibitDoubleBuffering", - RES_TYPE_BOOLEAN); - - gui_figure_window_size (f, parms, false, false); - { #ifndef USE_XCB XSetWindowAttributes attrs; @@ -7141,7 +7375,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) Atom type = FRAME_DISPLAY_INFO (f)->Xatom_net_window_type_tooltip; block_input (); - mask = CWBackPixel | CWOverrideRedirect | CWEventMask | CWCursor; + mask = (CWBackPixel | CWOverrideRedirect | CWEventMask + | CWCursor | CWColormap | CWBorderPixel); if (DoesSaveUnders (dpyinfo->screen)) mask |= CWSaveUnder; @@ -7151,9 +7386,11 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) attrs.override_redirect = True; attrs.save_under = True; attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f); + attrs.colormap = FRAME_X_COLORMAP (f); attrs.cursor = f->output_data.x->current_cursor = f->output_data.x->text_cursor; + attrs.border_pixel = f->output_data.x->border_pixel; /* Arrange for getting MapNotify and UnmapNotify events. */ attrs.event_mask = StructureNotifyMask; tip_window @@ -7164,7 +7401,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) 0, 0, 1, 1, /* Border. */ f->border_width, - CopyFromParent, InputOutput, CopyFromParent, + dpyinfo->n_planes, InputOutput, + FRAME_X_VISUAL (f), mask, &attrs); initial_set_up_x_back_buffer (f); XChangeProperty (FRAME_X_DISPLAY (f), tip_window, @@ -7173,17 +7411,21 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) (unsigned char *)&type, 1); unblock_input (); #else - uint32_t value_list[4]; + uint32_t value_list[6]; xcb_atom_t net_wm_window_type_tooltip = (xcb_atom_t) dpyinfo->Xatom_net_window_type_tooltip; + xcb_visualid_t visual_id + = (xcb_visualid_t) XVisualIDFromVisual (FRAME_X_VISUAL (f)); f->output_data.x->current_cursor = f->output_data.x->text_cursor; /* Values are set in the order of their enumeration in `enum xcb_cw_t'. */ value_list[0] = FRAME_BACKGROUND_PIXEL (f); - value_list[1] = true; - value_list[2] = XCB_EVENT_MASK_STRUCTURE_NOTIFY; - value_list[3] = (xcb_cursor_t) f->output_data.x->text_cursor; + value_list[1] = f->output_data.x->border_pixel; + value_list[2] = true; + value_list[3] = XCB_EVENT_MASK_STRUCTURE_NOTIFY; + value_list[4] = (xcb_colormap_t) FRAME_X_COLORMAP (f); + value_list[5] = (xcb_cursor_t) f->output_data.x->text_cursor; block_input (); tip_window @@ -7191,15 +7433,17 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) = (Window) xcb_generate_id (dpyinfo->xcb_connection); xcb_create_window (dpyinfo->xcb_connection, - XCB_COPY_FROM_PARENT, + dpyinfo->n_planes, (xcb_window_t) tip_window, (xcb_window_t) dpyinfo->root_window, 0, 0, 1, 1, f->border_width, XCB_WINDOW_CLASS_INPUT_OUTPUT, - XCB_COPY_FROM_PARENT, + visual_id, (XCB_CW_BACK_PIXEL + | XCB_CW_BORDER_PIXEL | XCB_CW_OVERRIDE_REDIRECT | XCB_CW_EVENT_MASK + | XCB_CW_COLORMAP | XCB_CW_CURSOR), &value_list); @@ -7215,6 +7459,19 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) #endif } + /* Init faces before gui_default_parameter is called for the + scroll-bar-width parameter because otherwise we end up in + init_iterator with a null face cache, which should not happen. */ + init_frame_faces (f); + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + gui_figure_window_size (f, parms, false, false); + + f->output_data.x->parent_desc = FRAME_DISPLAY_INFO (f)->root_window; + x_make_gc (f); gui_default_parameter (f, parms, Qauto_raise, Qnil, @@ -7225,6 +7482,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) "cursorType", "CursorType", RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qalpha, Qnil, "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -7448,10 +7707,9 @@ x_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -7510,10 +7768,9 @@ x_hide_tip (bool delete) return Qnil; else { - ptrdiff_t count; Lisp_Object was_open = Qnil; - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -7608,9 +7865,11 @@ Text larger than the specified size is clipped. */) struct text_pos pos; int width, height; int old_windows_or_buffers_changed = windows_or_buffers_changed; - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count_1; + specpdl_ref count = SPECPDL_INDEX (); Lisp_Object window, size, tip_buf; + Window child; + XWindowAttributes child_attrs; + int dest_x_return, dest_y_return; AUTO_STRING (tip, " *tip*"); specbind (Qinhibit_redisplay, Qt); @@ -7809,7 +8068,7 @@ Text larger than the specified size is clipped. */) /* Insert STRING into root window's buffer and fit the frame to the buffer. */ - count_1 = SPECPDL_INDEX (); + specpdl_ref count_1 = SPECPDL_INDEX (); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (w->contents)); bset_truncate_lines (current_buffer, Qnil); @@ -7835,6 +8094,41 @@ Text larger than the specified size is clipped. */) /* Show tooltip frame. */ block_input (); + /* If the display is composited, then WM_TRANSIENT_FOR must be set + as well, or else the compositing manager won't display + decorations correctly, even though the tooltip window is override + redirect. See + https://specifications.freedesktop.org/wm-spec/1.4/ar01s08.html + + Perhaps WM_TRANSIENT_FOR should be used in place of + override-redirect anyway. The ICCCM only recommends + override-redirect if the pointer will be grabbed. */ + + if (XTranslateCoordinates (FRAME_X_DISPLAY (f), + FRAME_DISPLAY_INFO (f)->root_window, + FRAME_DISPLAY_INFO (f)->root_window, + root_x, root_y, &dest_x_return, + &dest_y_return, &child) + && child != None) + { + /* But only if the child is not override-redirect, which can + happen if the pointer is above a menu. */ + + if (XGetWindowAttributes (FRAME_X_DISPLAY (f), + child, &child_attrs) + || child_attrs.override_redirect) + XDeleteProperty (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), + FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); + else + XSetTransientForHint (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), child); + } + else + XDeleteProperty (FRAME_X_DISPLAY (tip_f), + FRAME_X_WINDOW (tip_f), + FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); + #ifndef USE_XCB XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f), root_x, root_y, width, height); @@ -7964,7 +8258,7 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, Arg al[10]; int ac = 0; XmString dir_xmstring, pattern_xmstring; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); check_window_system (f); @@ -8131,7 +8425,7 @@ value of DIR as in previous invocations; this is standard MS Windows behavior. char *fn; Lisp_Object file = Qnil; Lisp_Object decoded_file; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); char *cdef_file; check_window_system (f); @@ -8192,7 +8486,7 @@ nil, it defaults to the selected frame. */) Lisp_Object font; Lisp_Object font_param; char *default_name = NULL; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (popup_activated ()) error ("Trying to use a menu from within a menu-entry"); @@ -8444,7 +8738,6 @@ Note: Text drawn with the `x' font backend is shown with hollow boxes. */) (Lisp_Object frames) { Lisp_Object rest, tmp; - int count; if (!CONSP (frames)) frames = list1 (frames); @@ -8463,7 +8756,7 @@ Note: Text drawn with the `x' font backend is shown with hollow boxes. */) frames = Fnreverse (tmp); /* Make sure the current matrices are up-to-date. */ - count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (32); unbind_to (count, Qnil); @@ -8495,6 +8788,47 @@ DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, #endif /* GTK_CHECK_VERSION (3, 14, 0) */ #endif /* HAVE_GTK3 */ #endif /* USE_GTK */ + +DEFUN ("x-internal-focus-input-context", Fx_internal_focus_input_context, + Sx_internal_focus_input_context, 1, 1, 0, + doc: /* Focus and set the client window of all focused frames' GTK input context. +If FOCUS is nil, focus out and remove the client window instead. +This should be called from a variable watcher for `x-gtk-use-native-input'. */) + (Lisp_Object focus) +{ +#ifdef USE_GTK + struct x_display_info *dpyinfo; + struct frame *f; + GtkWidget *widget; + + block_input (); + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { + f = dpyinfo->x_focus_frame; + + if (f) + { + widget = FRAME_GTK_OUTER_WIDGET (f); + + if (!NILP (focus)) + { + gtk_im_context_focus_in (FRAME_X_OUTPUT (f)->im_context); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (f)->im_context, + gtk_widget_get_window (widget)); + } + else + { + gtk_im_context_focus_out (FRAME_X_OUTPUT (f)->im_context); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (f)->im_context, + NULL); + } + } + } + unblock_input (); +#endif + + return Qnil; +} /*********************************************************************** Initialization @@ -8553,8 +8887,57 @@ frame_parm_handler x_frame_parm_handlers[] = x_set_z_group, x_set_override_redirect, gui_set_no_special_glyphs, + x_set_alpha_background, }; +/* Some versions of libX11 don't have symbols for a few functions we + need, so define replacements here. */ + +#ifdef HAVE_XKB +#ifndef HAVE_XKBREFRESHKEYBOARDMAPPING +Status +XkbRefreshKeyboardMapping (XkbMapNotifyEvent *event) +{ + return Success; +} +#endif + +#ifndef HAVE_XKBFREENAMES +void +XkbFreeNames (XkbDescPtr xkb, unsigned int which, Bool free_map) +{ + return; +} +#endif +#endif + +#ifndef HAVE_XDISPLAYCELLS +int +XDisplayCells (Display *dpy, int screen_number) +{ + return 1677216; +} +#endif + +#ifndef HAVE_XDESTROYSUBWINDOWS +int +XDestroySubwindows (Display *dpy, Window w) +{ + Window root, parent, *children; + unsigned int nchildren, i; + + if (XQueryTree (dpy, w, &root, &parent, &children, + &nchildren)) + { + for (i = 0; i < nchildren; ++i) + XDestroyWindow (dpy, children[i]); + XFree (children); + } + + return 0; +} +#endif + void syms_of_xfns (void) { @@ -8871,6 +9254,8 @@ eliminated in future versions of Emacs. */); defsubr (&Sx_select_font); #endif + defsubr (&Sx_internal_focus_input_context); + #ifdef USE_CAIRO defsubr (&Sx_export_frames); #ifdef USE_GTK diff --git a/src/xfont.c b/src/xfont.c index b5765cfa7b8..684c28ab21a 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -1003,6 +1003,32 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, unblock_input (); } +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (with_background + && FRAME_DISPLAY_INFO (s->f)->alpha_bits + && FRAME_CHECK_XR_VERSION (s->f, 0, 2)) + { + x_xr_ensure_picture (s->f); + + if (FRAME_X_PICTURE (s->f) != None) + { + XRenderColor xc; + int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); + + x_xr_apply_ext_clip (s->f, gc); + x_xrender_color_from_gc_background (s->f, gc, &xc, + s->hl != DRAW_CURSOR); + XRenderFillRectangle (FRAME_X_DISPLAY (s->f), + PictOpSrc, FRAME_X_PICTURE (s->f), + &xc, x, y - ascent, s->width, height); + x_xr_reset_ext_clip (s->f); + x_mark_frame_dirty (s->f); + + with_background = false; + } + } +#endif + if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) { USE_SAFE_ALLOCA; diff --git a/src/xftfont.c b/src/xftfont.c index c2175d96141..e27c6cf3146 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -33,6 +33,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "ftfont.h" #include "pdumper.h" +#ifdef HAVE_XRENDER +#include <X11/extensions/Xrender.h> +#endif + #ifndef FC_LCD_FILTER /* Older fontconfig versions don't have FC_LCD_FILTER. */ # define FC_LCD_FILTER "lcdfilter" @@ -45,19 +49,26 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ struct xftface_info { + bool bg_allocated_p; + bool fg_allocated_p; XftColor xft_fg; /* color for face->foreground */ XftColor xft_bg; /* color for face->background */ }; /* Setup foreground and background colors of GC into FG and BG. If XFTFACE_INFO is not NULL, reuse the colors in it if possible. BG - may be NULL. */ + may be NULL. Return whether or not colors were allocated in + BG_ALLOCATED_P and FG_ALLOCATED_P. */ static void xftfont_get_colors (struct frame *f, struct face *face, GC gc, struct xftface_info *xftface_info, - XftColor *fg, XftColor *bg) + XftColor *fg, XftColor *bg, + bool *bg_allocated_p, bool *fg_allocated_p) { + *bg_allocated_p = false; + *fg_allocated_p = false; + if (xftface_info && face->gc == gc) { *fg = xftface_info->xft_fg; @@ -90,20 +101,39 @@ xftfont_get_colors (struct frame *f, struct face *face, GC gc, { XColor colors[2]; - colors[0].pixel = fg->pixel = xgcv.foreground; + colors[0].pixel = xgcv.foreground; if (bg) - colors[1].pixel = bg->pixel = xgcv.background; + colors[1].pixel = xgcv.background; x_query_colors (f, colors, bg ? 2 : 1); fg->color.alpha = 0xFFFF; fg->color.red = colors[0].red; fg->color.green = colors[0].green; fg->color.blue = colors[0].blue; + + if (!XftColorAllocValue (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &fg->color, fg)) + /* This color should've been allocated when creating the + GC. */ + emacs_abort (); + else + *fg_allocated_p = true; + if (bg) { bg->color.alpha = 0xFFFF; bg->color.red = colors[1].red; bg->color.green = colors[1].green; bg->color.blue = colors[1].blue; + + if (!XftColorAllocValue (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &bg->color, bg)) + emacs_abort (); + else + *bg_allocated_p = true; } } unblock_input (); @@ -356,9 +386,12 @@ xftfont_prepare_face (struct frame *f, struct face *face) } #endif - xftface_info = xmalloc (sizeof *xftface_info); + xftface_info = xzalloc (sizeof *xftface_info); xftfont_get_colors (f, face, face->gc, NULL, - &xftface_info->xft_fg, &xftface_info->xft_bg); + &xftface_info->xft_fg, + &xftface_info->xft_bg, + &xftface_info->bg_allocated_p, + &xftface_info->fg_allocated_p); face->extra = xftface_info; } @@ -377,6 +410,18 @@ xftfont_done_face (struct frame *f, struct face *face) xftface_info = (struct xftface_info *) face->extra; if (xftface_info) { + if (xftface_info->fg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &xftface_info->xft_fg); + + if (xftface_info->bg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &xftface_info->xft_bg); + xfree (xftface_info); face->extra = NULL; } @@ -465,13 +510,16 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, XftDraw *xft_draw = xftfont_get_xft_draw (f); FT_UInt *code; XftColor fg, bg; + bool bg_allocated_p, fg_allocated_p; int len = to - from; int i; if (s->font == face->font) xftface_info = (struct xftface_info *) face->extra; xftfont_get_colors (f, face, s->gc, xftface_info, - &fg, with_background ? &bg : NULL); + &fg, with_background ? &bg : NULL, + &bg_allocated_p, &fg_allocated_p); + if (s->num_clips > 0) XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips); else @@ -496,7 +544,40 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, height = ascent = s->first_glyph->slice.glyphless.lower_yoff - s->first_glyph->slice.glyphless.upper_yoff; - XftDrawRect (xft_draw, &bg, x, y - ascent, s->width, height); + +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (with_background + && FRAME_DISPLAY_INFO (s->f)->alpha_bits + && FRAME_CHECK_XR_VERSION (s->f, 0, 2)) + { + x_xr_ensure_picture (s->f); + + if (FRAME_X_PICTURE (s->f) != None) + { + XRenderColor xc; + int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); + + if (s->num_clips > 0) + XRenderSetPictureClipRectangles (FRAME_X_DISPLAY (s->f), + FRAME_X_PICTURE (s->f), + 0, 0, s->clip, s->num_clips); + else + x_xr_reset_ext_clip (f); + x_xrender_color_from_gc_background (s->f, s->gc, &xc, s->hl != DRAW_CURSOR); + XRenderFillRectangle (FRAME_X_DISPLAY (s->f), + PictOpSrc, FRAME_X_PICTURE (s->f), + &xc, x, y - ascent, s->width, height); + x_xr_reset_ext_clip (f); + x_mark_frame_dirty (s->f); + + with_background = false; + } + else + XftDrawRect (xft_draw, &bg, x, y - ascent, s->width, height); + } + else +#endif + XftDrawRect (xft_draw, &bg, x, y - ascent, s->width, height); } code = alloca (sizeof (FT_UInt) * len); for (i = 0; i < len; i++) @@ -513,6 +594,19 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, FRAME_X_DRAWABLE in order to draw: we cached the drawable in the XftDraw structure. */ x_mark_frame_dirty (f); + + if (bg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &bg); + + if (fg_allocated_p) + XftColorFree (FRAME_X_DISPLAY (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f), + &fg); + unblock_input (); return len; } diff --git a/src/xgselect.c b/src/xgselect.c index d22340fc9bc..7252210c686 100644 --- a/src/xgselect.c +++ b/src/xgselect.c @@ -96,15 +96,18 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, int n_gfds, retval = 0, our_fds = 0, max_fds = fds_lim - 1; int i, nfds, tmo_in_millisec, must_free = 0; bool need_to_dispatch; -#ifdef HAVE_PGTK +#ifdef USE_GTK bool already_has_events; #endif context = g_main_context_default (); acquire_select_lock (context); -#ifdef HAVE_PGTK +#ifdef USE_GTK already_has_events = g_main_context_pending (context); +#ifndef HAVE_PGTK + already_has_events = already_has_events && x_gtk_use_native_input; +#endif #endif if (rfds) all_rfds = *rfds; @@ -153,21 +156,26 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds, tmop = &tmo; } -#ifndef HAVE_PGTK +#ifndef USE_GTK fds_lim = max_fds + 1; nfds = thread_select (pselect, fds_lim, &all_rfds, have_wfds ? &all_wfds : NULL, efds, tmop, sigmask); #else - /* - On PGTK, when you type a key, the key press event are received, - and one more key press event seems to be received internally. - The second event is not via a socket, so there are weird status: - - socket read buffer is empty - - a key press event is pending - In that case, we should not sleep, and dispatch the event immediately. - Bug#52761 - */ + /* On PGTK, when you type a key, the key press event are received, + and one more key press event seems to be received internally. + + The same can happen with GTK native input, which makes input + slow. + + The second event is not sent via the display connection, so the + following is the case: + + - socket read buffer is empty + - a key press event is pending + + In that case, we should not sleep in pselect, and dispatch the + event immediately. (Bug#52761) */ if (!already_has_events) { fds_lim = max_fds + 1; diff --git a/src/xmenu.c b/src/xmenu.c index 9e4e6b62fce..21e8f0f9ec7 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -52,6 +52,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #endif #ifdef HAVE_XINPUT2 +#include <math.h> #include <X11/extensions/XInput2.h> #endif @@ -240,18 +241,25 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, LWLIB_ID id, bool do_timers) { XEvent event; + XEvent copy; +#ifdef HAVE_XINPUT2 + bool cookie_claimed_p = false; + XIDeviceEvent *xev; + struct xi_device_t *device; +#endif while (popup_activated_flag) { if (initial_event) { - event = *initial_event; + copy = event = *initial_event; initial_event = 0; } else { if (do_timers) x_menu_wait_for_event (0); XtAppNextEvent (Xt_app_con, &event); + copy = event; } /* Make sure we don't consider buttons grabbed after menu goes. @@ -271,6 +279,7 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, so Motif thinks this is the case. */ event.xbutton.state = 0; #endif + copy = event; } /* Pop down on C-g and Escape. */ else if (event.type == KeyPress @@ -281,9 +290,114 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, if ((keysym == XK_g && (event.xkey.state & ControlMask) != 0) || keysym == XK_Escape) /* Any escape, ignore modifiers. */ popup_activated_flag = 0; + + copy = event; } +#ifdef HAVE_XINPUT2 + else if (event.type == GenericEvent + && dpyinfo->supports_xi2 + && event.xgeneric.display == dpyinfo->display + && event.xgeneric.extension == dpyinfo->xi2_opcode) + { + if (event.xcookie.data) + { + switch (event.xgeneric.evtype) + { + case XI_ButtonRelease: + { + if (!event.xcookie.data + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + + xev = (XIDeviceEvent *) event.xcookie.data; + device = xi_device_from_id (dpyinfo, xev->deviceid); + + dpyinfo->grabbed &= ~(1 << xev->detail); + device->grab &= ~(1 << xev->detail); + + copy.xbutton.type = 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; + +#ifdef USE_MOTIF /* Pretending that the event came from a + Btn1Down seems the only way to convince Motif to + activate its callbacks; setting the XmNmenuPost + isn't working. --marcus@sysc.pdx.edu. */ + copy.xbutton.button = 1; + /* Motif only pops down menus when no Ctrl, Alt or Mod + key is pressed and the button is released. So reset key state + so Motif thinks this is the case. */ + copy.xbutton.state = 0; +#endif + + 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; + } + + break; + } + case XI_KeyPress: + { + KeySym keysym; + + if (!event.xcookie.data + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + + xev = (XIDeviceEvent *) event.xcookie.data; + + copy.xkey.type = KeyPress; + copy.xkey.serial = xev->serial; + copy.xkey.send_event = xev->send_event; + copy.xkey.display = dpyinfo->display; + 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) + || keysym == XK_Escape) /* Any escape, ignore modifiers. */ + popup_activated_flag = 0; + + break; + } + } + } + } - x_dispatch_event (&event, event.xany.display); + if (cookie_claimed_p) + XFreeEventData (dpyinfo->display, &event.xcookie); +#endif + + x_dispatch_event (©, copy.xany.display); } } @@ -458,7 +572,9 @@ 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); } @@ -745,7 +861,7 @@ set_frame_menubar (struct frame *f, bool deep_p) struct buffer *prev = current_buffer; Lisp_Object buffer; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = alloca (previous_menu_items_used * sizeof *previous_items); @@ -1285,7 +1401,7 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, GtkWidget *menu; GtkMenuPositionFunc pos_func = 0; /* Pop up at pointer. */ struct next_popup_x_y popup_x_y; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); bool use_pos_func = ! for_click; #ifdef HAVE_GTK3 @@ -1465,27 +1581,60 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, /* Don't allow any geometry request from the user. */ XtSetArg (av[ac], (char *) XtNgeometry, 0); ac++; XtSetValues (menu, av, ac); -#if defined HAVE_XINPUT2 && defined USE_LUCID + +#if defined HAVE_XINPUT2 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); - /* Clear the XI2 grab so lwlib can set a core grab. */ + bool any_xi_grab_p = false; + + /* Clear the XI2 grab, and if any XI2 grab was set, place a core + grab on the frame's edit widget. */ + + if (dpyinfo->supports_xi2) + XGrabServer (dpyinfo->display); if (dpyinfo->num_devices) { for (int i = 0; i < dpyinfo->num_devices; ++i) { if (dpyinfo->devices[i].grab) - XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, - CurrentTime); + { + any_xi_grab_p = true; + dpyinfo->devices[i].grab = 0; + + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); + } } } + + if (any_xi_grab_p) + XGrabPointer (dpyinfo->display, + FRAME_X_WINDOW (f), + False, (PointerMotionMask + | PointerMotionHintMask + | ButtonReleaseMask + | ButtonPressMask), + GrabModeSync, GrabModeAsync, + None, None, CurrentTime); + + if (dpyinfo->supports_xi2) + XUngrabServer (dpyinfo->display); #endif + /* Display the menu. */ lw_popup_menu (menu, &dummy); popup_activated_flag = 1; + +#ifdef HAVE_XINPUT2 + if (any_xi_grab_p) + XAllowEvents (dpyinfo->display, AsyncPointer, CurrentTime); +#endif + x_activate_timeout_atimer (); { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_int (pop_down_menu, (int) menu_id); @@ -1516,7 +1665,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, = alloca (menu_items_used * sizeof *subprefix_stack); int submenu_depth = 0; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f)); @@ -1803,7 +1952,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) if (menu) { - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); record_unwind_protect_ptr (pop_down_menu, menu); /* Display the menu. */ @@ -1858,7 +2007,7 @@ create_and_show_dialog (struct frame *f, widget_value *first_wv) /* Process events that apply to the dialog box. Also handle timers. */ { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* xdialog_show_unwind is responsible for popping the dialog box down. */ @@ -1890,7 +2039,7 @@ x_dialog_show (struct frame *f, Lisp_Object title, /* Whether we've seen the boundary between left-hand elts and right-hand. */ bool boundary_seen = false; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f)); @@ -2042,7 +2191,7 @@ xw_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents) Lisp_Object title; const char *error_name; Lisp_Object selection; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); check_window_system (f); @@ -2163,7 +2312,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, int maxwidth; int dummy_int; unsigned int dummy_uint; - ptrdiff_t specpdl_count = SPECPDL_INDEX (); + specpdl_ref specpdl_count = SPECPDL_INDEX (); eassert (FRAME_X_P (f) || FRAME_MSDOS_P (f)); diff --git a/src/xselect.c b/src/xselect.c index cfe028a1696..979f4549488 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -52,7 +52,7 @@ static void unexpect_property_change (struct prop_location *); static void wait_for_property_change (struct prop_location *); static Lisp_Object x_get_window_property_as_lisp_data (struct x_display_info *, Window, Atom, - Lisp_Object, Atom); + Lisp_Object, Atom, bool); static Lisp_Object selection_data_to_lisp_data (struct x_display_info *, const unsigned char *, ptrdiff_t, Atom, int); @@ -376,7 +376,7 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, /* Don't allow a quit within the converter. When the user types C-g, he would be surprised if by luck it came during a converter. */ - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); CHECK_SYMBOL (target_type); @@ -564,7 +564,7 @@ x_reply_selection_request (struct selection_input_event *event, Window window = SELECTION_EVENT_REQUESTOR (event); ptrdiff_t bytes_remaining; int max_bytes = selection_quantum (display); - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); struct selection_data *cs; reply->type = SelectionNotify; @@ -758,7 +758,7 @@ x_handle_selection_request (struct selection_input_event *event) Atom property = SELECTION_EVENT_PROPERTY (event); Lisp_Object local_selection_data; bool success = false; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); if (!dpyinfo) goto DONE; @@ -795,11 +795,12 @@ x_handle_selection_request (struct selection_input_event *event) Window requestor = SELECTION_EVENT_REQUESTOR (event); Lisp_Object multprop; ptrdiff_t j, nselections; + struct selection_data cs; if (property == None) goto DONE; multprop = x_get_window_property_as_lisp_data (dpyinfo, requestor, property, - QMULTIPLE, selection); + QMULTIPLE, selection, true); if (!VECTORP (multprop) || ASIZE (multprop) % 2) goto DONE; @@ -811,11 +812,19 @@ x_handle_selection_request (struct selection_input_event *event) Lisp_Object subtarget = AREF (multprop, 2*j); Atom subproperty = symbol_to_x_atom (dpyinfo, AREF (multprop, 2*j+1)); + bool subsuccess = false; if (subproperty != None) - x_convert_selection (selection_symbol, subtarget, - subproperty, true, dpyinfo); + subsuccess = x_convert_selection (selection_symbol, subtarget, + subproperty, true, dpyinfo); + if (!subsuccess) + ASET (multprop, 2*j+1, Qnil); } + /* Save conversion results */ + lisp_data_to_selection_data (dpyinfo, multprop, &cs); + XChangeProperty (dpyinfo->display, requestor, property, + cs.type, cs.format, PropModeReplace, + cs.data, cs.size); success = true; } else @@ -1073,7 +1082,7 @@ wait_for_property_change_unwind (void *loc) static void wait_for_property_change (struct prop_location *location) { - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); /* Make sure to do unexpect_property_change if we quit or err. */ record_unwind_protect_ptr (wait_for_property_change_unwind, location); @@ -1210,7 +1219,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, return x_get_window_property_as_lisp_data (dpyinfo, requestor_window, target_property, target_type, - selection_atom); + selection_atom, false); } /* Subroutines of x_get_window_property_as_lisp_data */ @@ -1461,7 +1470,8 @@ static Lisp_Object x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, Window window, Atom property, Lisp_Object target_type, - Atom selection_atom) + Atom selection_atom, + bool for_multiple) { Atom actual_type; int actual_format; @@ -1477,6 +1487,8 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, &actual_type, &actual_format, &actual_size); if (! data) { + if (for_multiple) + return Qnil; block_input (); bool there_is_a_selection_owner = XGetSelectionOwner (display, selection_atom) != 0; @@ -1499,7 +1511,7 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, } } - if (actual_type == dpyinfo->Xatom_INCR) + if (!for_multiple && actual_type == dpyinfo->Xatom_INCR) { /* That wasn't really the data, just the beginning. */ @@ -1515,11 +1527,14 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, &actual_size); } - block_input (); - TRACE1 (" Delete property %s", XGetAtomName (display, property)); - XDeleteProperty (display, window, property); - XFlush (display); - unblock_input (); + if (!for_multiple) + { + block_input (); + TRACE1 (" Delete property %s", XGetAtomName (display, property)); + XDeleteProperty (display, window, property); + XFlush (display); + unblock_input (); + } /* It's been read. Now convert it to a lisp object in some semi-rational manner. */ diff --git a/src/xterm.c b/src/xterm.c index bf611db6bca..caacf8336c4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -26,6 +26,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ contains subroutines comprising the redisplay interface, setting up scroll bars and widgets, and handling input. + Some of what is explained below also applies to the other window + systems that Emacs supports, to varying degrees. YMMV. + INPUT Emacs handles input by running pselect in a loop, which returns @@ -84,7 +87,119 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ is no focus window, we treat each frame as having the input focus whenever the pointer enters it, and undo that treatment when the pointer leaves it. See the callers of x_detect_focus_change for - more details. */ + more details. + + REDISPLAY + + The redisplay engine communicates with X through the "redisplay + interface", which is a structure containing pointers to functions + which output graphics to a frame. + + Some of the functions included in the redisplay interface include + `x_clear_frame_area', which is called by the display engine when it + determines that a part of the display has to be cleared, + x_draw_window_cursor, which is called to perform the calculations + necessary to display the cursor glyph with a special "highlight" + (more on that later) and to set the input method spot location. + + Most of the actual display is performed by the function + `x_draw_glyph_string', also included in the redisplay interface. + It takes a list of glyphs of the same type and face, computes the + correct graphics context for the string through the function + `x_set_glyph_string_gc', and draws whichever glyphs it might + contain, along with decorations such as the box face, underline and + overline. That list is referred to as a "glyph string". + + GRAPHICS CONTEXTS + + A graphics context ("GC") is an X server-side object which contains + drawing attributes such as fill style, stipple, and foreground and + 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). + + However, when drawing glyph strings for special display elements + such as the cursor, or mouse sensitive text, different GCs may be + used. When displaying the cursor, for example, the frame's cursor + graphics context is used for the common case where the cursor is + drawn with the default font, and the colors of the string's face + are the same as the default face. In all other cases, a temporary + graphics context is created with the foreground and background + colors of the cursor face adjusted to ensure that the cursor can be + distinguished from its surroundings and that the text inside the + cursor stays visible. + + Various graphics contexts are also calculated when the frame is + created by the function `x_make_gcs' in xfns.c, and are adjusted + whenever the foreground or background colors change. The "normal" + graphics context is used for operations performed without a face, + and always corresponds to the foreground and background colors of + the frame's default face, the "reverse" graphics context is used to + draw text in inverse video, and the cursor graphics context is used + to display the cursor in the most common case. + + COLOR ALLOCATION + + In X, pixel values for colors are not guaranteed to correspond to + their individual components. The rules for converting colors into + pixel values are defined by the visual class of each display opened + by Emacs. When a display is opened, a suitable visual is obtained + from the X server, and a colormap is created based on that visual, + which is then used for each frame created. + + The colormap is then used by the X server to convert pixel values + from a frame created by Emacs into actual colors which are output + 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. + + 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 + that corresponds to a "color cell" containing the color (or a close + approximation) from the colormap. Exactly how this is accomplished + further depends on the visual class, since some visuals have + immutable colormaps which contain color cells with pre-defined + values, while others have colormaps where the color cells are + dynamically allocated by individual X clients. + + With visuals that have a visual class of StaticColor and StaticGray + (where the former is the case), the X server is asked to procure + the pixel value of a color cell that contains the closest + approximation of the color which Emacs wants. On the other hand, + when the visual class is DirectColor, PseudoColor, or GrayScale, + where color cells are dynamically allocated by clients, Emacs asks + the X server to allocate a color cell containing the desired color, + and uses its pixel value. + + (If the color already exists, the X server returns an existing color + cell, but increases its reference count, so it still has to be + freed afterwards.) + + Otherwise, if no color could be allocated (due to the colormap + being full), Emacs looks for a color cell inside the colormap + closest to the desired color, and uses its pixel value instead. + + Since the capacity of a colormap is finite, X clients have to take + special precautions in order to not allocate too many color cells + that are never used. Emacs allocates its color cells when a face + is being realized or when a frame changes its foreground and + background colors, and releases them alongside the face or frame. + See calls to `unload_color' and `load_color' in xterm.c, xfaces.c + and xfns.c for more details. + + The driving logic behind color allocation is in + `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. */ #include <config.h> #include <stdlib.h> @@ -122,6 +237,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/extensions/Xrandr.h> #endif +#ifdef HAVE_XSYNC +#include <X11/extensions/sync.h> +#endif + +#ifdef HAVE_XINERAMA +#include <X11/extensions/Xinerama.h> +#endif + /* Load sys/types.h if not already loaded. In some systems loading it twice is suicidal. */ #ifndef makedev @@ -341,6 +464,7 @@ 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 void x_update_opaque_region (struct frame *, XEvent *); /* Flush display of frame F. */ @@ -358,19 +482,35 @@ x_flush (struct frame *f) unblock_input (); } +static void +x_drop_xrender_surfaces (struct frame *f) +{ + font_drop_xrender_surfaces (f); + #ifdef HAVE_XRENDER -MAYBE_UNUSED static void + if (f && FRAME_X_DOUBLE_BUFFERED_P (f) + && FRAME_X_PICTURE (f) != None) + { + XRenderFreePicture (FRAME_X_DISPLAY (f), + FRAME_X_PICTURE (f)); + FRAME_X_PICTURE (f) = None; + } +#endif +} + +#ifdef HAVE_XRENDER +void x_xr_ensure_picture (struct frame *f) { if (FRAME_X_PICTURE (f) == None && FRAME_X_PICTURE_FORMAT (f)) { XRenderPictureAttributes attrs; attrs.clip_mask = None; + XRenderPictFormat *fmt = FRAME_X_PICTURE_FORMAT (f); FRAME_X_PICTURE (f) = XRenderCreatePicture (FRAME_X_DISPLAY (f), FRAME_X_RAW_DRAWABLE (f), - FRAME_X_PICTURE_FORMAT (f), - CPClipMask, &attrs); + fmt, CPClipMask, &attrs); } } #endif @@ -417,6 +557,41 @@ record_event (char *locus, int type) #endif +static void +x_update_opaque_region (struct frame *f, XEvent *configure) +{ +#ifndef HAVE_GTK3 + unsigned long opaque_region[] = {0, 0, + (configure + ? configure->xconfigure.width + : FRAME_PIXEL_WIDTH (f)), + (configure + ? configure->xconfigure.height + : FRAME_PIXEL_HEIGHT (f))}; +#endif + + if (!FRAME_DISPLAY_INFO (f)->alpha_bits) + return; + + block_input (); + if (f->alpha_background < 1.0) + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + NULL, 0); +#ifndef HAVE_GTK3 + else + XChangeProperty (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &opaque_region, 4); +#endif + unblock_input (); +} + + #if defined USE_CAIRO || defined HAVE_XRENDER static struct x_gc_ext_data * x_gc_get_ext_data (struct frame *f, GC gc, int create_if_not_found_p) @@ -521,6 +696,11 @@ x_free_xi_devices (struct x_display_info *dpyinfo) /* Setup valuator tracking for XI2 master devices on DPYINFO->display. */ +/* This function's name is a misnomer: these days, it keeps a + client-side record of all devices, which includes basic information + about the device and also touchscreen tracking information, instead + of just scroll valuators. */ + static void x_init_master_valuators (struct x_display_info *dpyinfo) { @@ -564,28 +744,26 @@ x_init_master_valuators (struct x_display_info *dpyinfo) { switch (device->classes[c]->type) { -#ifdef XIScrollClass /* XInput 2.1 */ +#ifdef HAVE_XINPUT2_1 case XIScrollClass: { XIScrollClassInfo *info = (XIScrollClassInfo *) device->classes[c]; struct xi_scroll_valuator_t *valuator; - if (xi_device->master_p) - { - valuator = &xi_device->valuators[actual_valuator_count++]; - valuator->horizontal - = (info->scroll_type == XIScrollTypeHorizontal); - valuator->invalid_p = true; - valuator->emacs_value = DBL_MIN; - valuator->increment = info->increment; - valuator->number = info->number; - } + valuator = &xi_device->valuators[actual_valuator_count++]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; + valuator->pending_enter_reset = false; break; } #endif -#ifdef XITouchClass /* XInput 2.2 */ +#ifdef HAVE_XINPUT2_2 case XITouchClass: { XITouchClassInfo *info; @@ -626,7 +804,7 @@ x_get_scroll_valuator_delta (struct x_display_info *dpyinfo, int device_id, { struct xi_device_t *device = &dpyinfo->devices[i]; - if (device->device_id == device_id && device->master_p) + if (device->device_id == device_id) { for (int j = 0; j < device->scroll_valuator_count; ++j) { @@ -664,7 +842,7 @@ x_get_scroll_valuator_delta (struct x_display_info *dpyinfo, int device_id, return DBL_MAX; } -static struct xi_device_t * +struct xi_device_t * xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) { for (int i = 0; i < dpyinfo->num_devices; ++i) @@ -676,7 +854,7 @@ xi_device_from_id (struct x_display_info *dpyinfo, int deviceid) return NULL; } -#ifdef XI_TouchBegin +#ifdef HAVE_XINPUT2_2 static void xi_link_touch_point (struct xi_device_t *device, @@ -734,12 +912,13 @@ xi_find_touch_point (struct xi_device_t *device, int detail) #endif /* XI_TouchBegin */ static void -xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id) +xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id, + bool pending_only) { struct xi_device_t *device = xi_device_from_id (dpyinfo, id); struct xi_scroll_valuator_t *valuator; - if (!device || !device->master_p) + if (!device) return; if (!device->scroll_valuator_count) @@ -748,6 +927,11 @@ xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int id) for (int i = 0; i < device->scroll_valuator_count; ++i) { valuator = &device->valuators[i]; + + if (pending_only && !valuator->pending_enter_reset) + continue; + + valuator->pending_enter_reset = false; valuator->invalid_p = true; valuator->emacs_value = 0.0; } @@ -841,29 +1025,59 @@ x_end_cr_clip (struct frame *f) } void -x_set_cr_source_with_gc_foreground (struct frame *f, GC gc) +x_set_cr_source_with_gc_foreground (struct frame *f, GC gc, + bool respect_alpha_background) { XGCValues xgcv; XColor color; + unsigned int depth; XGetGCValues (FRAME_X_DISPLAY (f), gc, GCForeground, &xgcv); color.pixel = xgcv.foreground; x_query_colors (f, &color, 1); - cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, - color.green / 65535.0, color.blue / 65535.0); + depth = FRAME_DISPLAY_INFO (f)->n_planes; + + if (f->alpha_background < 1.0 && depth == 32 + && respect_alpha_background) + { + cairo_set_source_rgba (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0, + f->alpha_background); + + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_SOURCE); + } + else + cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0); } void -x_set_cr_source_with_gc_background (struct frame *f, GC gc) +x_set_cr_source_with_gc_background (struct frame *f, GC gc, + bool respect_alpha_background) { XGCValues xgcv; XColor color; + unsigned int depth; XGetGCValues (FRAME_X_DISPLAY (f), gc, GCBackground, &xgcv); color.pixel = xgcv.background; + x_query_colors (f, &color, 1); - cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, - color.green / 65535.0, color.blue / 65535.0); + + depth = FRAME_DISPLAY_INFO (f)->n_planes; + + if (f->alpha_background < 1.0 && depth == 32 + && respect_alpha_background) + { + cairo_set_source_rgba (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0, + f->alpha_background); + + cairo_set_operator (FRAME_CR_CONTEXT (f), CAIRO_OPERATOR_SOURCE); + } + else + cairo_set_source_rgb (FRAME_CR_CONTEXT (f), color.red / 65535.0, + color.green / 65535.0, color.blue / 65535.0); } static const cairo_user_data_key_t xlib_surface_key, saved_drawable_key; @@ -1048,7 +1262,7 @@ x_cr_draw_image (struct frame *f, GC gc, cairo_pattern_t *image, cairo_rectangle (cr, dest_x, dest_y, width, height); else { - x_set_cr_source_with_gc_background (f, gc); + x_set_cr_source_with_gc_background (f, gc, false); cairo_rectangle (cr, dest_x, dest_y, width, height); cairo_fill_preserve (cr); } @@ -1065,7 +1279,7 @@ x_cr_draw_image (struct frame *f, GC gc, cairo_pattern_t *image, } else { - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_clip (cr); cairo_mask (cr, image); } @@ -1116,7 +1330,7 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) int width, height; void (*surface_set_size_func) (cairo_surface_t *, double, double) = NULL; Lisp_Object acc = Qnil; - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); redisplay_preserve_echo_area (31); @@ -1202,8 +1416,8 @@ x_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) #endif /* USE_CAIRO */ -#if defined HAVE_XRENDER && !defined USE_CAIRO -MAYBE_UNUSED static void +#if defined HAVE_XRENDER +void x_xr_apply_ext_clip (struct frame *f, GC gc) { eassert (FRAME_X_PICTURE (f) != None); @@ -1217,7 +1431,7 @@ x_xr_apply_ext_clip (struct frame *f, GC gc) data->n_clip_rects); } -MAYBE_UNUSED static void +void x_xr_reset_ext_clip (struct frame *f) { XRenderPictureAttributes attrs = { .clip_mask = None }; @@ -1259,7 +1473,8 @@ x_reset_clip_rectangles (struct frame *f, GC gc) } static void -x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) +x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height, + bool respect_alpha_background) { #ifdef USE_CAIRO Display *dpy = FRAME_X_DISPLAY (f); @@ -1275,7 +1490,7 @@ x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) regarded as Pixmap of unspecified size filled with ones. */ || (xgcv.stipple & ((Pixmap) 7 << (sizeof (Pixmap) * CHAR_BIT - 3)))) { - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, respect_alpha_background); cairo_rectangle (cr, x, y, width, height); cairo_fill (cr); } @@ -1283,25 +1498,139 @@ x_fill_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) { eassert (xgcv.fill_style == FillOpaqueStippled); eassert (xgcv.stipple != None); - x_set_cr_source_with_gc_background (f, gc); + x_set_cr_source_with_gc_background (f, gc, respect_alpha_background); cairo_rectangle (cr, x, y, width, height); cairo_fill_preserve (cr); cairo_pattern_t *pattern = x_bitmap_stipple (f, xgcv.stipple); if (pattern) { - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, respect_alpha_background); cairo_clip (cr); cairo_mask (cr, pattern); } } x_end_cr_clip (f); #else +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (respect_alpha_background + && f->alpha_background != 1.0 + && FRAME_DISPLAY_INFO (f)->alpha_bits + && FRAME_CHECK_XR_VERSION (f, 0, 2)) + { + x_xr_ensure_picture (f); + + if (FRAME_X_PICTURE (f) != None) + { + XRenderColor xc; + +#if RENDER_MAJOR > 0 || (RENDER_MINOR >= 10) + XGCValues xgcv; + XRenderPictureAttributes attrs; + XRenderColor alpha; + Picture stipple, fill; +#endif + + x_xr_apply_ext_clip (f, gc); + +#if RENDER_MAJOR > 0 || (RENDER_MINOR >= 10) + XGetGCValues (FRAME_X_DISPLAY (f), + gc, GCFillStyle | GCStipple, &xgcv); + + if (xgcv.fill_style == FillOpaqueStippled + && FRAME_CHECK_XR_VERSION (f, 0, 10)) + { + x_xrender_color_from_gc_background (f, gc, &alpha, true); + x_xrender_color_from_gc_foreground (f, gc, &xc, true); + attrs.repeat = RepeatNormal; + + stipple = XRenderCreatePicture (FRAME_X_DISPLAY (f), + xgcv.stipple, + XRenderFindStandardFormat (FRAME_X_DISPLAY (f), + PictStandardA1), + CPRepeat, &attrs); + + XRenderFillRectangle (FRAME_X_DISPLAY (f), PictOpSrc, + FRAME_X_PICTURE (f), + &alpha, x, y, width, height); + + fill = XRenderCreateSolidFill (FRAME_X_DISPLAY (f), &xc); + + XRenderComposite (FRAME_X_DISPLAY (f), PictOpOver, fill, stipple, + FRAME_X_PICTURE (f), 0, 0, x, y, x, y, width, height); + + XRenderFreePicture (FRAME_X_DISPLAY (f), stipple); + XRenderFreePicture (FRAME_X_DISPLAY (f), fill); + } + else +#endif + { + x_xrender_color_from_gc_foreground (f, gc, &xc, true); + XRenderFillRectangle (FRAME_X_DISPLAY (f), + PictOpSrc, FRAME_X_PICTURE (f), + &xc, x, y, width, height); + } + x_xr_reset_ext_clip (f); + x_mark_frame_dirty (f); + + return; + } + } +#endif XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), gc, x, y, width, height); #endif } + +static void +x_clear_rectangle (struct frame *f, GC gc, int x, int y, int width, int height, + bool respect_alpha_background) +{ +#ifdef USE_CAIRO + cairo_t *cr; + + cr = x_begin_cr_clip (f, gc); + x_set_cr_source_with_gc_background (f, gc, respect_alpha_background); + cairo_rectangle (cr, x, y, width, height); + cairo_fill (cr); + x_end_cr_clip (f); +#else +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (respect_alpha_background + && f->alpha_background != 1.0 + && FRAME_DISPLAY_INFO (f)->alpha_bits + && FRAME_CHECK_XR_VERSION (f, 0, 2)) + { + x_xr_ensure_picture (f); + + if (FRAME_X_PICTURE (f) != None) + { + XRenderColor xc; + + x_xr_apply_ext_clip (f, gc); + x_xrender_color_from_gc_background (f, gc, &xc, true); + XRenderFillRectangle (FRAME_X_DISPLAY (f), + PictOpSrc, FRAME_X_PICTURE (f), + &xc, x, y, width, height); + x_xr_reset_ext_clip (f); + x_mark_frame_dirty (f); + + return; + } + } +#endif + + XGCValues xgcv; + Display *dpy = FRAME_X_DISPLAY (f); + XGetGCValues (dpy, gc, GCBackground | GCForeground, &xgcv); + XSetForeground (dpy, gc, xgcv.background); + XFillRectangle (dpy, FRAME_X_DRAWABLE (f), + gc, x, y, width, height); + XSetForeground (dpy, gc, xgcv.foreground); +#endif +} + static void x_draw_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) { @@ -1309,7 +1638,7 @@ x_draw_rectangle (struct frame *f, GC gc, int x, int y, int width, int height) cairo_t *cr; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_rectangle (cr, x + 0.5, y + 0.5, width, height); cairo_set_line_width (cr, 1); cairo_stroke (cr); @@ -1327,12 +1656,12 @@ x_clear_window (struct frame *f) cairo_t *cr; cr = x_begin_cr_clip (f, NULL); - x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc); + x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc, true); cairo_paint (cr); x_end_cr_clip (f); #else #ifndef USE_GTK - if (FRAME_X_DOUBLE_BUFFERED_P (f)) + if (FRAME_X_DOUBLE_BUFFERED_P (f) || (f->alpha_background != 1.0)) #endif x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); #ifndef USE_GTK @@ -1350,7 +1679,7 @@ x_fill_trapezoid_for_relief (struct frame *f, GC gc, int x, int y, cairo_t *cr; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_move_to (cr, top_p ? x : x + height, y); cairo_line_to (cr, x, y + height); cairo_line_to (cr, top_p ? x + width - height : x + width, y + height); @@ -1377,7 +1706,7 @@ x_erase_corners_for_relief (struct frame *f, GC gc, int x, int y, int i; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_background (f, gc); + x_set_cr_source_with_gc_background (f, gc, false); for (i = 0; i < CORNER_LAST; i++) if (corners & (1 << i)) { @@ -1410,7 +1739,7 @@ x_draw_horizontal_wave (struct frame *f, GC gc, int x, int y, int xoffset, n; cr = x_begin_cr_clip (f, gc); - x_set_cr_source_with_gc_foreground (f, gc); + x_set_cr_source_with_gc_foreground (f, gc, false); cairo_rectangle (cr, x, y, width, height); cairo_clip (cr); @@ -1590,7 +1919,7 @@ x_draw_vertical_window_border (struct window *w, int x, int y0, int y1) face->foreground); #ifdef USE_CAIRO - x_fill_rectangle (f, f->output_data.x->normal_gc, x, y0, 1, y1 - y0); + x_fill_rectangle (f, f->output_data.x->normal_gc, x, y0, 1, y1 - y0, false); #else XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), f->output_data.x->normal_gc, x, y0, x, y1); @@ -1623,13 +1952,13 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) { XSetForeground (display, f->output_data.x->normal_gc, color_first); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0, 1, y1 - y0); + x0, y0, 1, y1 - y0, false); XSetForeground (display, f->output_data.x->normal_gc, color); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0 + 1, y0, x1 - x0 - 2, y1 - y0); + x0 + 1, y0, x1 - x0 - 2, y1 - y0, false); XSetForeground (display, f->output_data.x->normal_gc, color_last); x_fill_rectangle (f, f->output_data.x->normal_gc, - x1 - 1, y0, 1, y1 - y0); + x1 - 1, y0, 1, y1 - y0, false); } else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) /* A horizontal divider, at least three pixels high: Draw first and @@ -1637,13 +1966,13 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) { XSetForeground (display, f->output_data.x->normal_gc, color_first); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0, x1 - x0, 1); + x0, y0, x1 - x0, 1, false); XSetForeground (display, f->output_data.x->normal_gc, color); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0 + 1, x1 - x0, y1 - y0 - 2); + x0, y0 + 1, x1 - x0, y1 - y0 - 2, false); XSetForeground (display, f->output_data.x->normal_gc, color_last); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y1 - 1, x1 - x0, 1); + x0, y1 - 1, x1 - x0, 1, false); } else { @@ -1651,7 +1980,7 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) differently. */ XSetForeground (display, f->output_data.x->normal_gc, color); x_fill_rectangle (f, f->output_data.x->normal_gc, - x0, y0, x1 - x0, y1 - y0); + x0, y0, x1 - x0, y1 - y0, false); } } @@ -1727,11 +2056,70 @@ x_update_end (struct frame *f) static void XTframe_up_to_date (struct frame *f) { +#if defined HAVE_XSYNC && !defined HAVE_GTK3 + XSyncValue add; + XSyncValue current; + Bool overflow_p; +#elif defined HAVE_XSYNC + GtkWidget *widget; + GdkWindow *window; + GdkFrameClock *clock; +#endif + eassert (FRAME_X_P (f)); block_input (); FRAME_MOUSE_UPDATE (f); if (!buffer_flipping_blocked_p () && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); + +#ifdef HAVE_XSYNC +#ifndef HAVE_GTK3 + if (FRAME_X_OUTPUT (f)->sync_end_pending_p + && FRAME_X_BASIC_COUNTER (f) != None) + { + XSyncSetCounter (FRAME_X_DISPLAY (f), + FRAME_X_BASIC_COUNTER (f), + FRAME_X_OUTPUT (f)->pending_basic_counter_value); + FRAME_X_OUTPUT (f)->sync_end_pending_p = false; + } + + if (FRAME_X_OUTPUT (f)->ext_sync_end_pending_p + && FRAME_X_EXTENDED_COUNTER (f) != None) + { + current = FRAME_X_OUTPUT (f)->current_extended_counter_value; + + if (XSyncValueLow32 (current) % 2) + XSyncIntToValue (&add, 1); + else + XSyncIntToValue (&add, 2); + + XSyncValueAdd (&FRAME_X_OUTPUT (f)->current_extended_counter_value, + current, add, &overflow_p); + + if (overflow_p) + emacs_abort (); + + XSyncSetCounter (FRAME_X_DISPLAY (f), + FRAME_X_EXTENDED_COUNTER (f), + FRAME_X_OUTPUT (f)->current_extended_counter_value); + + FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = false; + } +#else + if (FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) + { + widget = FRAME_GTK_OUTER_WIDGET (f); + window = gtk_widget_get_window (widget); + eassert (window); + clock = gdk_window_get_frame_clock (window); + eassert (clock); + + gdk_frame_clock_request_phase (clock, + GDK_FRAME_CLOCK_PHASE_AFTER_PAINT); + FRAME_X_OUTPUT (f)->xg_sync_end_pending_p = false; + } +#endif +#endif unblock_input (); } @@ -1776,10 +2164,10 @@ x_clear_under_internal_border (struct frame *f) GC gc = f->output_data.x->normal_gc; XSetForeground (display, gc, color); - x_fill_rectangle (f, gc, 0, margin, width, border); - x_fill_rectangle (f, gc, 0, 0, border, height); - x_fill_rectangle (f, gc, width - border, 0, border, height); - x_fill_rectangle (f, gc, 0, height - border, width, border); + x_fill_rectangle (f, gc, 0, margin, width, border, false); + x_fill_rectangle (f, gc, 0, 0, border, height, false); + x_fill_rectangle (f, gc, width - border, 0, border, height, false); + x_fill_rectangle (f, gc, 0, height - border, width, border, false); XSetForeground (display, gc, FRAME_FOREGROUND_PIXEL (f)); } else @@ -1846,9 +2234,9 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) GC gc = f->output_data.x->normal_gc; XSetForeground (display, gc, color); - x_fill_rectangle (f, gc, 0, y, width, height); + x_fill_rectangle (f, gc, 0, y, width, height, true); x_fill_rectangle (f, gc, FRAME_PIXEL_WIDTH (f) - width, y, - width, height); + width, height, true); XSetForeground (display, gc, FRAME_FOREGROUND_PIXEL (f)); } else @@ -1882,9 +2270,10 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring if (face->stipple) XSetFillStyle (display, face->gc, FillOpaqueStippled); else - XSetForeground (display, face->gc, face->background); + XSetBackground (display, face->gc, face->background); - x_fill_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny); + x_clear_rectangle (f, face->gc, p->bx, p->by, p->nx, p->ny, + true); if (!face->stipple) XSetForeground (display, face->gc, face->foreground); @@ -1911,15 +2300,40 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring { Drawable drawable = FRAME_X_DRAWABLE (f); char *bits; - Pixmap pixmap, clipmask = (Pixmap) 0; - int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f)); + Pixmap pixmap, clipmask = None; + int depth = FRAME_DISPLAY_INFO (f)->n_planes; XGCValues gcv; + unsigned long background = face->background; + XColor bg; +#ifdef HAVE_XRENDER + Picture picture = None; + XRenderPictureAttributes attrs; + + memset (&attrs, 0, sizeof attrs); +#endif if (p->wd > 8) bits = (char *) (p->bits + p->dh); else bits = (char *) p->bits + p->dh; + if (FRAME_DISPLAY_INFO (f)->alpha_bits + && f->alpha_background < 1.0) + { + bg.pixel = background; + x_query_colors (f, &bg, 1); + bg.red *= f->alpha_background; + bg.green *= f->alpha_background; + bg.blue *= f->alpha_background; + + background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), + bg.red, bg.green, bg.blue); + background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; + background |= (((unsigned long) (f->alpha_background * 0xffff) + >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) + << FRAME_DISPLAY_INFO (f)->alpha_offset); + } + /* Draw the bitmap. I believe these small pixmaps can be cached by the server. */ pixmap = XCreatePixmapFromBitmapData (display, drawable, bits, p->wd, p->h, @@ -1927,7 +2341,15 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring ? (p->overlay_p ? face->background : f->output_data.x->cursor_pixel) : face->foreground), - face->background, depth); + background, depth); + +#ifdef HAVE_XRENDER + if (FRAME_X_PICTURE_FORMAT (f) + && (x_xr_ensure_picture (f), FRAME_X_PICTURE (f))) + picture = XRenderCreatePicture (display, pixmap, + FRAME_X_PICTURE_FORMAT (f), + 0, &attrs); +#endif if (p->overlay_p) { @@ -1935,14 +2357,43 @@ x_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fring FRAME_DISPLAY_INFO (f)->root_window, bits, p->wd, p->h, 1, 0, 1); - gcv.clip_mask = clipmask; - gcv.clip_x_origin = p->x; - gcv.clip_y_origin = p->y; - XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv); + +#ifdef HAVE_XRENDER + if (picture != None) + { + attrs.clip_mask = clipmask; + attrs.clip_x_origin = p->x; + attrs.clip_y_origin = p->y; + + XRenderChangePicture (display, FRAME_X_PICTURE (f), + CPClipMask | CPClipXOrigin | CPClipYOrigin, + &attrs); + } + else +#endif + { + gcv.clip_mask = clipmask; + gcv.clip_x_origin = p->x; + gcv.clip_y_origin = p->y; + XChangeGC (display, gc, GCClipMask | GCClipXOrigin | GCClipYOrigin, &gcv); + } } - XCopyArea (display, pixmap, drawable, gc, 0, 0, - p->wd, p->h, p->x, p->y); +#ifdef HAVE_XRENDER + if (picture != None) + { + x_xr_apply_ext_clip (f, gc); + XRenderComposite (display, PictOpSrc, picture, + None, FRAME_X_PICTURE (f), + 0, 0, 0, 0, p->x, p->y, p->wd, p->h); + x_xr_reset_ext_clip (f); + + XRenderFreePicture (display, picture); + } + else +#endif + XCopyArea (display, pixmap, drawable, gc, 0, 0, + p->wd, p->h, p->x, p->y); XFreePixmap (display, pixmap); if (p->overlay_p) @@ -1969,6 +2420,34 @@ static void x_scroll_bar_clear (struct frame *); static void x_check_font (struct frame *, struct font *); #endif +void +x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time) +{ +#ifndef USE_GTK + struct frame *focus_frame = dpyinfo->x_focus_frame; +#endif + +#ifdef ENABLE_CHECKING + eassert (time <= X_ULONG_MAX); +#endif + dpyinfo->last_user_time = time; + +#ifndef USE_GTK + if (focus_frame) + { + while (FRAME_PARENT_FRAME (focus_frame)) + focus_frame = FRAME_PARENT_FRAME (focus_frame); + + if (FRAME_X_OUTPUT (focus_frame)->user_time_window != None) + XChangeProperty (dpyinfo->display, + FRAME_X_OUTPUT (focus_frame)->user_time_window, + dpyinfo->Xatom_net_wm_user_time, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &time, 1); + } +#endif +} + /* Set S->gc to a suitable GC for drawing glyph string S in cursor face. */ @@ -2185,12 +2664,7 @@ x_compute_glyph_string_overhangs (struct glyph_string *s) static void x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) { - Display *display = FRAME_X_DISPLAY (s->f); - XGCValues xgcv; - XGetGCValues (display, s->gc, GCForeground | GCBackground, &xgcv); - XSetForeground (display, s->gc, xgcv.background); - x_fill_rectangle (s->f, s->gc, x, y, w, h); - XSetForeground (display, s->gc, xgcv.foreground); + x_clear_rectangle (s->f, s->gc, x, y, w, h, s->hl != DRAW_CURSOR); } @@ -2216,9 +2690,10 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p) /* Fill background with a stipple pattern. */ XSetFillStyle (display, s->gc, FillOpaqueStippled); x_fill_rectangle (s->f, s->gc, s->x, - s->y + box_line_width, - s->background_width, - s->height - 2 * box_line_width); + s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_width, + s->hl != DRAW_CURSOR); XSetFillStyle (display, s->gc, FillSolid); s->background_filled_p = true; } @@ -2313,7 +2788,8 @@ x_draw_glyph_string_foreground (struct glyph_string *s) x_fill_rectangle (s->f, s->gc, s->x, s->y + box_line_width, s->background_width, - s->height - 2 * box_line_width); + s->height - 2 * box_line_width, + false); XSetFillStyle (display, s->gc, FillSolid); } else @@ -2763,12 +3239,12 @@ void x_query_colors (struct frame *f, XColor *colors, int ncolors) { struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + int i; if (dpyinfo->red_bits > 0) { /* For TrueColor displays, we can decompose the RGB value directly. */ - int i; unsigned int rmult, gmult, bmult; unsigned int rmask, gmask, bmask; @@ -2824,12 +3300,45 @@ x_query_colors (struct frame *f, XColor *colors, int ncolors) XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, ncolors); } -/* Store F's background color into *BGCOLOR. */ +/* Store F's real background color into *BGCOLOR. */ static void x_query_frame_background_color (struct frame *f, XColor *bgcolor) { - bgcolor->pixel = FRAME_BACKGROUND_PIXEL (f); + unsigned long background = FRAME_BACKGROUND_PIXEL (f); +#ifndef USE_CAIRO + XColor bg; +#endif + + if (FRAME_DISPLAY_INFO (f)->alpha_bits) + { +#ifdef USE_CAIRO + background = (background & ~FRAME_DISPLAY_INFO (f)->alpha_mask); + background |= (((unsigned long) (f->alpha_background * 0xffff) + >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) + << FRAME_DISPLAY_INFO (f)->alpha_offset); +#else + if (FRAME_DISPLAY_INFO (f)->alpha_bits + && f->alpha_background < 1.0) + { + bg.pixel = background; + x_query_colors (f, &bg, 1); + bg.red *= f->alpha_background; + bg.green *= f->alpha_background; + bg.blue *= f->alpha_background; + + background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f), + bg.red, bg.green, bg.blue); + background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask; + background |= (((unsigned long) (f->alpha_background * 0xffff) + >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits)) + << FRAME_DISPLAY_INFO (f)->alpha_offset); + } +#endif + } + + bgcolor->pixel = background; + x_query_colors (f, bgcolor, 1); } @@ -2897,40 +3406,67 @@ x_parse_color (struct frame *f, const char *color_name, static bool x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) { + struct x_display_info *dpyinfo = x_display_info_for_display (dpy); bool rc; + eassume (dpyinfo); rc = XAllocColor (dpy, cmap, color) != 0; + + if (dpyinfo->visual->class == DirectColor) + return rc; + if (rc == 0) { /* If we got to this point, the colormap is full, so we're going - to try to get the next closest color. The algorithm used is + to try and get the next closest color. The algorithm used is a least-squares matching, which is what X uses for closest color matching with StaticColor visuals. */ - int nearest, i; - int max_color_delta = 255; - int max_delta = 3 * max_color_delta; - int nearest_delta = max_delta + 1; - int ncells; - const XColor *cells = x_color_cells (dpy, &ncells); - - for (nearest = i = 0; i < ncells; ++i) - { - int dred = (color->red >> 8) - (cells[i].red >> 8); - int dgreen = (color->green >> 8) - (cells[i].green >> 8); - int dblue = (color->blue >> 8) - (cells[i].blue >> 8); - int delta = dred * dred + dgreen * dgreen + dblue * dblue; - if (delta < nearest_delta) + const XColor *cells; + int no_cells; + int nearest; + long nearest_delta, trial_delta; + int x; + Status status; + + cells = x_color_cells (dpy, &no_cells); + + nearest = 0; + /* I'm assuming CSE so I'm not going to condense this. */ + nearest_delta = ((((color->red >> 8) - (cells[0].red >> 8)) + * ((color->red >> 8) - (cells[0].red >> 8))) + + (((color->green >> 8) - (cells[0].green >> 8)) + * ((color->green >> 8) - (cells[0].green >> 8))) + + (((color->blue >> 8) - (cells[0].blue >> 8)) + * ((color->blue >> 8) - (cells[0].blue >> 8)))); + for (x = 1; x < no_cells; x++) + { + trial_delta = ((((color->red >> 8) - (cells[x].red >> 8)) + * ((color->red >> 8) - (cells[x].red >> 8))) + + (((color->green >> 8) - (cells[x].green >> 8)) + * ((color->green >> 8) - (cells[x].green >> 8))) + + (((color->blue >> 8) - (cells[x].blue >> 8)) + * ((color->blue >> 8) - (cells[x].blue >> 8)))); + if (trial_delta < nearest_delta) { - nearest = i; - nearest_delta = delta; + XColor temp; + temp.red = cells[x].red; + temp.green = cells[x].green; + temp.blue = cells[x].blue; + status = XAllocColor (dpy, cmap, &temp); + if (status) + { + nearest = x; + nearest_delta = trial_delta; + } } } - - color->red = cells[nearest].red; + color->red = cells[nearest].red; color->green = cells[nearest].green; - color->blue = cells[nearest].blue; - rc = XAllocColor (dpy, cmap, color) != 0; + color->blue = cells[nearest].blue; + status = XAllocColor (dpy, cmap, color); + + rc = status != 0; } else { @@ -3229,7 +3765,7 @@ x_draw_relief_rect (struct frame *f, if (left_p) { x_fill_rectangle (f, top_left_gc, left_x, top_y, - vwidth, bottom_y + 1 - top_y); + vwidth, bottom_y + 1 - top_y, false); if (top_p) corners |= 1 << CORNER_TOP_LEFT; if (bot_p) @@ -3238,7 +3774,7 @@ x_draw_relief_rect (struct frame *f, if (right_p) { x_fill_rectangle (f, bottom_right_gc, right_x + 1 - vwidth, top_y, - vwidth, bottom_y + 1 - top_y); + vwidth, bottom_y + 1 - top_y, false); if (top_p) corners |= 1 << CORNER_TOP_RIGHT; if (bot_p) @@ -3248,7 +3784,7 @@ x_draw_relief_rect (struct frame *f, { if (!right_p) x_fill_rectangle (f, top_left_gc, left_x, top_y, - right_x + 1 - left_x, hwidth); + right_x + 1 - left_x, hwidth, false); else x_fill_trapezoid_for_relief (f, top_left_gc, left_x, top_y, right_x + 1 - left_x, hwidth, 1); @@ -3257,7 +3793,7 @@ x_draw_relief_rect (struct frame *f, { if (!left_p) x_fill_rectangle (f, bottom_right_gc, left_x, bottom_y + 1 - hwidth, - right_x + 1 - left_x, hwidth); + right_x + 1 - left_x, hwidth, false); else x_fill_trapezoid_for_relief (f, bottom_right_gc, left_x, bottom_y + 1 - hwidth, @@ -3265,10 +3801,10 @@ x_draw_relief_rect (struct frame *f, } if (left_p && vwidth > 1) x_fill_rectangle (f, bottom_right_gc, left_x, top_y, - 1, bottom_y + 1 - top_y); + 1, bottom_y + 1 - top_y, false); if (top_p && hwidth > 1) x_fill_rectangle (f, bottom_right_gc, left_x, top_y, - right_x + 1 - left_x, 1); + right_x + 1 - left_x, 1, false); if (corners) { XSetBackground (FRAME_X_DISPLAY (f), top_left_gc, @@ -3390,21 +3926,25 @@ x_draw_box_rect (struct glyph_string *s, /* Top. */ x_fill_rectangle (s->f, s->gc, - left_x, top_y, right_x - left_x + 1, hwidth); + left_x, top_y, right_x - left_x + 1, hwidth, + false); /* Left. */ if (left_p) x_fill_rectangle (s->f, s->gc, - left_x, top_y, vwidth, bottom_y - top_y + 1); + left_x, top_y, vwidth, bottom_y - top_y + 1, + false); /* Bottom. */ x_fill_rectangle (s->f, s->gc, - left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth); + left_x, bottom_y - hwidth + 1, right_x - left_x + 1, hwidth, + false); /* Right. */ if (right_p) x_fill_rectangle (s->f, s->gc, - right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1); + right_x - vwidth + 1, top_y, vwidth, bottom_y - top_y + 1, + false); XSetForeground (display, s->gc, xgcv.foreground); x_reset_clip_rectangles (s->f, s->gc); @@ -3819,7 +4359,7 @@ x_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, int h) /* Fill background with a stipple pattern. */ XSetFillStyle (display, s->gc, FillOpaqueStippled); - x_fill_rectangle (s->f, s->gc, x, y, w, h); + x_fill_rectangle (s->f, s->gc, x, y, w, h, true); XSetFillStyle (display, s->gc, FillSolid); } else @@ -3875,8 +4415,7 @@ x_draw_image_glyph_string (struct glyph_string *s) /* Create a pixmap as large as the glyph string. Fill it with the background color. Copy the image to it, using its mask. Copy the temporary pixmap to the display. */ - Screen *screen = FRAME_X_SCREEN (s->f); - int depth = DefaultDepthOfScreen (screen); + int depth = FRAME_DISPLAY_INFO (s->f)->n_planes; /* Create a pixmap as large as the glyph string. */ pixmap = XCreatePixmap (display, FRAME_X_DRAWABLE (s->f), @@ -3901,12 +4440,35 @@ x_draw_image_glyph_string (struct glyph_string *s) else { XGCValues xgcv; - XGetGCValues (display, s->gc, GCForeground | GCBackground, - &xgcv); - XSetForeground (display, s->gc, xgcv.background); - XFillRectangle (display, pixmap, s->gc, - 0, 0, s->background_width, s->height); - XSetForeground (display, s->gc, xgcv.foreground); +#if defined HAVE_XRENDER && (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) + if (FRAME_DISPLAY_INFO (s->f)->alpha_bits + && s->f->alpha_background != 1.0 + && FRAME_CHECK_XR_VERSION (s->f, 0, 2) + && FRAME_X_PICTURE_FORMAT (s->f)) + { + XRenderColor xc; + XRenderPictureAttributes attrs; + Picture pict; + memset (&attrs, 0, sizeof attrs); + + pict = XRenderCreatePicture (display, pixmap, + FRAME_X_PICTURE_FORMAT (s->f), + 0, &attrs); + x_xrender_color_from_gc_background (s->f, s->gc, &xc, true); + XRenderFillRectangle (FRAME_X_DISPLAY (s->f), PictOpSrc, pict, + &xc, 0, 0, s->background_width, s->height); + XRenderFreePicture (display, pict); + } + else +#endif + { + XGetGCValues (display, s->gc, GCForeground | GCBackground, + &xgcv); + XSetForeground (display, s->gc, xgcv.background); + XFillRectangle (display, pixmap, s->gc, + 0, 0, s->background_width, s->height); + XSetForeground (display, s->gc, xgcv.foreground); + } } } else @@ -4025,7 +4587,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) { /* Fill background with a stipple pattern. */ XSetFillStyle (display, gc, FillOpaqueStippled); - x_fill_rectangle (s->f, gc, x, y, w, h); + x_fill_rectangle (s->f, gc, x, y, w, h, true); XSetFillStyle (display, gc, FillSolid); } else @@ -4033,7 +4595,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) XGCValues xgcv; XGetGCValues (display, gc, GCForeground | GCBackground, &xgcv); XSetForeground (display, gc, xgcv.background); - x_fill_rectangle (s->f, gc, x, y, w, h); + x_fill_rectangle (s->f, gc, x, y, w, h, true); XSetForeground (display, gc, xgcv.foreground); } @@ -4383,7 +4945,8 @@ x_draw_glyph_string (struct glyph_string *s) y = s->ybase + position; if (s->face->underline_defaulted_p) x_fill_rectangle (s->f, s->gc, - s->x, y, decoration_width, thickness); + s->x, y, decoration_width, thickness, + false); else { Display *display = FRAME_X_DISPLAY (s->f); @@ -4391,7 +4954,8 @@ x_draw_glyph_string (struct glyph_string *s) XGetGCValues (display, s->gc, GCForeground, &xgcv); XSetForeground (display, s->gc, s->face->underline_color); x_fill_rectangle (s->f, s->gc, - s->x, y, decoration_width, thickness); + s->x, y, decoration_width, thickness, + false); XSetForeground (display, s->gc, xgcv.foreground); } } @@ -4403,7 +4967,7 @@ x_draw_glyph_string (struct glyph_string *s) if (s->face->overline_color_defaulted_p) x_fill_rectangle (s->f, s->gc, s->x, s->y + dy, - decoration_width, h); + decoration_width, h, false); else { Display *display = FRAME_X_DISPLAY (s->f); @@ -4411,7 +4975,7 @@ x_draw_glyph_string (struct glyph_string *s) XGetGCValues (display, s->gc, GCForeground, &xgcv); XSetForeground (display, s->gc, s->face->overline_color); x_fill_rectangle (s->f, s->gc, s->x, s->y + dy, - decoration_width, h); + decoration_width, h, false); XSetForeground (display, s->gc, xgcv.foreground); } } @@ -4433,7 +4997,7 @@ x_draw_glyph_string (struct glyph_string *s) if (s->face->strike_through_color_defaulted_p) x_fill_rectangle (s->f, s->gc, s->x, glyph_y + dy, - s->width, h); + s->width, h, false); else { Display *display = FRAME_X_DISPLAY (s->f); @@ -4441,7 +5005,7 @@ x_draw_glyph_string (struct glyph_string *s) XGetGCValues (display, s->gc, GCForeground, &xgcv); XSetForeground (display, s->gc, s->face->strike_through_color); x_fill_rectangle (s->f, s->gc, s->x, glyph_y + dy, - decoration_width, h); + decoration_width, h, false); XSetForeground (display, s->gc, xgcv.foreground); } } @@ -4547,26 +5111,30 @@ x_clear_area (struct frame *f, int x, int y, int width, int height) eassert (width > 0 && height > 0); cr = x_begin_cr_clip (f, NULL); - x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc); + x_set_cr_source_with_gc_background (f, f->output_data.x->normal_gc, + true); cairo_rectangle (cr, x, y, width, height); cairo_fill (cr); x_end_cr_clip (f); #else #ifndef USE_GTK - if (FRAME_X_DOUBLE_BUFFERED_P (f)) + if (FRAME_X_DOUBLE_BUFFERED_P (f) + || f->alpha_background != 1.0) #endif { #if defined HAVE_XRENDER && \ (RENDER_MAJOR > 0 || (RENDER_MINOR >= 2)) x_xr_ensure_picture (f); - if (FRAME_X_PICTURE (f) != None + if (FRAME_DISPLAY_INFO (f)->alpha_bits + && FRAME_X_PICTURE (f) != None + && f->alpha_background != 1.0 && FRAME_CHECK_XR_VERSION (f, 0, 2)) { XRenderColor xc; - GC gc = f->output_data.x->reverse_gc; + GC gc = f->output_data.x->normal_gc; x_xr_apply_ext_clip (f, gc); - x_xrender_color_from_gc_foreground (f, gc, &xc); + x_xrender_color_from_gc_background (f, gc, &xc, true); XRenderFillRectangle (FRAME_X_DISPLAY (f), PictOpSrc, FRAME_X_PICTURE (f), &xc, x, y, width, height); @@ -4713,16 +5281,13 @@ x_hide_hourglass (struct frame *f) static void XTflash (struct frame *f) { - block_input (); + GC gc; + XGCValues values; - { - GC gc; + block_input (); - /* Create a GC that will use the GXxor function to flip foreground - pixels into background pixels. */ + if (FRAME_X_VISUAL (f)->class == TrueColor) { - XGCValues values; - values.function = GXxor; values.foreground = (FRAME_FOREGROUND_PIXEL (f) ^ FRAME_BACKGROUND_PIXEL (f)); @@ -4730,85 +5295,86 @@ XTflash (struct frame *f) gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCFunction | GCForeground, &values); } + else + gc = FRAME_X_OUTPUT (f)->normal_gc; + + + /* Get the height not including a menu bar widget. */ + int height = FRAME_PIXEL_HEIGHT (f); + /* Height of each line to flash. */ + int flash_height = FRAME_LINE_HEIGHT (f); + /* These will be the left and right margins of the rectangles. */ + int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); + int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f); + int width = flash_right - flash_left; + + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) { - /* Get the height not including a menu bar widget. */ - int height = FRAME_PIXEL_HEIGHT (f); - /* Height of each line to flash. */ - int flash_height = FRAME_LINE_HEIGHT (f); - /* These will be the left and right margins of the rectangles. */ - int flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); - int flash_right = FRAME_PIXEL_WIDTH (f) - FRAME_INTERNAL_BORDER_WIDTH (f); - int width = flash_right - flash_left; - - /* If window is tall, flash top and bottom line. */ - if (height > 3 * FRAME_LINE_HEIGHT (f)) - { - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (FRAME_INTERNAL_BORDER_WIDTH (f) - + FRAME_TOP_MARGIN_HEIGHT (f)), - width, flash_height); - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (height - flash_height - - FRAME_INTERNAL_BORDER_WIDTH (f)), - width, flash_height); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); - } - else - /* If it is short, flash it all. */ - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), - width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + } + else + /* If it is short, flash it all. */ + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); - x_flush (f); + x_flush (f); - { - struct timespec delay = make_timespec (0, 150 * 1000 * 1000); - struct timespec wakeup = timespec_add (current_timespec (), delay); + struct timespec delay = make_timespec (0, 150 * 1000 * 1000); + struct timespec wakeup = timespec_add (current_timespec (), delay); - /* Keep waiting until past the time wakeup or any input gets - available. */ - while (! detect_input_pending ()) - { - struct timespec current = current_timespec (); - struct timespec timeout; + /* Keep waiting until past the time wakeup or any input gets + available. */ + while (! detect_input_pending ()) + { + struct timespec current = current_timespec (); + struct timespec timeout; - /* Break if result would not be positive. */ - if (timespec_cmp (wakeup, current) <= 0) - break; + /* Break if result would not be positive. */ + if (timespec_cmp (wakeup, current) <= 0) + break; - /* How long `select' should wait. */ - timeout = make_timespec (0, 10 * 1000 * 1000); + /* How long `select' should wait. */ + timeout = make_timespec (0, 10 * 1000 * 1000); - /* Try to wait that long--but we might wake up sooner. */ - pselect (0, NULL, NULL, NULL, &timeout, NULL); - } - } + /* Try to wait that long--but we might wake up sooner. */ + pselect (0, NULL, NULL, NULL, &timeout, NULL); + } - /* If window is tall, flash top and bottom line. */ - if (height > 3 * FRAME_LINE_HEIGHT (f)) - { - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (FRAME_INTERNAL_BORDER_WIDTH (f) - + FRAME_TOP_MARGIN_HEIGHT (f)), - width, flash_height); - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, - (height - flash_height - - FRAME_INTERNAL_BORDER_WIDTH (f)), - width, flash_height); - } - else - /* If it is short, flash it all. */ - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, - flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), - width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); - XFreeGC (FRAME_X_DISPLAY (f), gc); - x_flush (f); + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); } - } + else + /* If it is short, flash it all. */ + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + + if (FRAME_X_VISUAL (f)->class == TrueColor) + XFreeGC (FRAME_X_DISPLAY (f), gc); + x_flush (f); unblock_input (); } @@ -5159,10 +5725,13 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra #ifdef USE_GTK GtkWidget *widget; - gtk_im_context_focus_in (FRAME_X_OUTPUT (frame)->im_context); - widget = FRAME_GTK_OUTER_WIDGET (frame); - gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, - gtk_widget_get_window (widget)); + if (x_gtk_use_native_input) + { + gtk_im_context_focus_in (FRAME_X_OUTPUT (frame)->im_context); + widget = FRAME_GTK_OUTER_WIDGET (frame); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, + gtk_widget_get_window (widget)); + } #endif #endif } @@ -5179,14 +5748,21 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra XSETFRAME (bufp->frame_or_window, frame); } + if (!frame->output_data.x->focus_state) + { #ifdef HAVE_X_I18N - if (FRAME_XIC (frame)) - XUnsetICFocus (FRAME_XIC (frame)); + if (FRAME_XIC (frame)) + XUnsetICFocus (FRAME_XIC (frame)); #ifdef USE_GTK - gtk_im_context_focus_out (FRAME_X_OUTPUT (frame)->im_context); - gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, NULL); + if (x_gtk_use_native_input) + { + gtk_im_context_focus_out (FRAME_X_OUTPUT (frame)->im_context); + gtk_im_context_set_client_window (FRAME_X_OUTPUT (frame)->im_context, NULL); + } #endif #endif + } + if (frame->pointer_invisible) XTtoggle_invisible_pointer (frame, false); } @@ -5260,6 +5836,13 @@ x_any_window_to_frame (struct x_display_info *dpyinfo, int wdesc) if (wdesc == None) return NULL; +#ifdef HAVE_XWIDGETS + struct xwidget_view *xv = xwidget_view_from_window (wdesc); + + if (xv) + return xv->frame; +#endif + FOR_EACH_FRAME (tail, frame) { if (found) @@ -5551,7 +6134,8 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) dpyinfo->hyper_mod_mask = 0; #ifdef HAVE_XKB - if (dpyinfo->xkb_desc) + if (dpyinfo->xkb_desc + && dpyinfo->xkb_desc->server) { for (i = 0; i < XkbNumVirtualMods; i++) { @@ -5593,6 +6177,14 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) syms = XGetKeyboardMapping (dpyinfo->display, min_code, max_code - min_code + 1, &syms_per_code); + + if (!syms) + { + dpyinfo->meta_mod_mask = Mod1Mask; + dpyinfo->super_mod_mask = Mod2Mask; + return; + } + mods = XGetModifierMapping (dpyinfo->display); /* Scan the modifier table to see which modifier bits the Meta and @@ -5678,8 +6270,17 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask; } + /* If some keys are both super and hyper, make them just super. + Many X servers are misconfigured so that super and hyper are both + Mod4, but most users have no hyper key. */ + if (dpyinfo->hyper_mod_mask & dpyinfo->super_mod_mask) + dpyinfo->hyper_mod_mask &= ~dpyinfo->super_mod_mask; + XFree (syms); - XFreeModifiermap (mods); + + if (dpyinfo->modmap) + XFreeModifiermap (dpyinfo->modmap); + dpyinfo->modmap = mods; } /* Convert between the modifier bits X uses and the modifier bits @@ -8080,6 +8681,9 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) /* x, y, width, height */ 0, 0, bar->width - 1, bar->height - 1); + XDrawPoint (FRAME_X_DISPLAY (f), w, gc, + bar->width - 1, bar->height - 1); + /* 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, @@ -8685,7 +9289,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, int do_help = 0; ptrdiff_t nbytes = 0; struct frame *any, *f = NULL; - struct coding_system coding; Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; /* This holds the state XLookupString needs to implement dead keys and other tricks known as "compose processing". _X Window System_ @@ -8694,8 +9297,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, static XComposeStatus compose_status; XEvent configureEvent; XEvent next_event; - - USE_SAFE_ALLOCA; + Lisp_Object coding; *finish = X_EVENT_NORMAL; @@ -8818,6 +9420,73 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto done; } + + if (event->xclient.data.l[0] == dpyinfo->Xatom_net_wm_ping + && event->xclient.format == 32) + { + XEvent send_event = *event; + + send_event.xclient.window = dpyinfo->root_window; + XSendEvent (dpyinfo->display, dpyinfo->root_window, False, + SubstructureRedirectMask | SubstructureNotifyMask, + &send_event); + + *finish = X_EVENT_DROP; + goto done; + } + +#if defined HAVE_XSYNC + if (event->xclient.data.l[0] == dpyinfo->Xatom_net_wm_sync_request + && event->xclient.format == 32 + && dpyinfo->xsync_supported_p) + { + struct frame *f + = x_top_window_to_frame (dpyinfo, + event->xclient.window); +#if defined HAVE_GTK3 + GtkWidget *widget; + GdkWindow *window; + GdkFrameClock *frame_clock; +#endif + + if (f) + { +#ifndef HAVE_GTK3 + if (event->xclient.data.l[4] == 0) + { + XSyncIntsToValue (&FRAME_X_OUTPUT (f)->pending_basic_counter_value, + event->xclient.data.l[2], event->xclient.data.l[3]); + FRAME_X_OUTPUT (f)->sync_end_pending_p = true; + } + else if (event->xclient.data.l[4] == 1) + { + XSyncIntsToValue (&FRAME_X_OUTPUT (f)->current_extended_counter_value, + event->xclient.data.l[2], event->xclient.data.l[3]); + FRAME_X_OUTPUT (f)->ext_sync_end_pending_p = true; + } + + *finish = X_EVENT_DROP; +#else + widget = FRAME_GTK_OUTER_WIDGET (f); + + if (widget && !FRAME_X_OUTPUT (f)->xg_sync_end_pending_p) + { + window = gtk_widget_get_window (widget); + eassert (window); + frame_clock = gdk_window_get_frame_clock (window); + eassert (frame_clock); + + gdk_frame_clock_request_phase (frame_clock, + GDK_FRAME_CLOCK_PHASE_BEFORE_PAINT); + + FRAME_X_OUTPUT (f)->xg_sync_end_pending_p = true; + } +#endif + goto done; + } + } +#endif + goto done; } @@ -8908,7 +9577,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case SelectionNotify: - x_display_set_last_user_time (dpyinfo, event->xselection.time); #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event->xselection.requestor)) goto OTHER; @@ -8917,7 +9585,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case SelectionClear: /* Someone has grabbed ownership. */ - x_display_set_last_user_time (dpyinfo, event->xselectionclear.time); #ifdef USE_X_TOOLKIT if (! x_window_to_frame (dpyinfo, event->xselectionclear.window)) goto OTHER; @@ -8933,7 +9600,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case SelectionRequest: /* Someone wants our selection. */ - x_display_set_last_user_time (dpyinfo, event->xselectionrequest.time); #ifdef USE_X_TOOLKIT if (!x_window_to_frame (dpyinfo, event->xselectionrequest.owner)) goto OTHER; @@ -8952,7 +9618,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; case PropertyNotify: - x_display_set_last_user_time (dpyinfo, event->xproperty.time); f = x_top_window_to_frame (dpyinfo, event->xproperty.window); if (f && event->xproperty.atom == dpyinfo->Xatom_net_wm_state) { @@ -9061,7 +9726,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, } if (FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); f->output_data.x->has_been_visible = true; SET_FRAME_GARBAGED (f); unblock_input (); @@ -9272,6 +9937,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, f->output_data.x->has_been_visible = true; } + x_update_opaque_region (f, NULL); + if (not_hidden && iconified) { inev.ie.kind = DEICONIFY_EVENT; @@ -9281,9 +9948,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto OTHER; case KeyPress: - x_display_set_last_user_time (dpyinfo, event->xkey.time); ignore_next_mouse_click_timeout = 0; + coding = Qlatin_1; #if defined (USE_X_TOOLKIT) || defined (USE_GTK) /* Dispatch KeyPress events when in menu. */ @@ -9340,11 +10007,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, unsigned char *copy_bufptr = copy_buffer; int copy_bufsiz = sizeof (copy_buffer); int modifiers; - Lisp_Object coding_system = Qlatin_1; Lisp_Object c; /* `xkey' will be modified, but it's not important to modify `event' itself. */ XKeyEvent xkey = event->xkey; + int i; #ifdef USE_GTK /* Don't pass keys to GTK. A Tab will shift focus to the @@ -9376,16 +10043,37 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (modifiers & dpyinfo->meta_mod_mask) memset (&compose_status, 0, sizeof (compose_status)); +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->xkb_desc) + { + XkbDescRec *rec = FRAME_DISPLAY_INFO (f)->xkb_desc; + + if (rec->map->modmap && rec->map->modmap[xkey.keycode]) + goto done_keysym; + } + else +#endif + { + if (dpyinfo->modmap) + { + for (i = 0; i < 8 * dpyinfo->modmap->max_keypermod; i++) + { + if (xkey.keycode == dpyinfo->modmap->modifiermap[i]) + goto done_keysym; + } + } + } + #ifdef HAVE_X_I18N if (FRAME_XIC (f)) { Status status_return; - coding_system = Vlocale_coding_system; nbytes = XmbLookupString (FRAME_XIC (f), &xkey, (char *) copy_bufptr, copy_bufsiz, &keysym, &status_return); + coding = Qnil; if (status_return == XBufferOverflow) { copy_bufsiz = nbytes + 1; @@ -9548,60 +10236,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, { /* Raw bytes, not keysym. */ ptrdiff_t i; - int nchars, len; - for (i = 0, nchars = 0; i < nbytes; i++) + for (i = 0; i < nbytes; i++) { - if (ASCII_CHAR_P (copy_bufptr[i])) - nchars++; STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); } - if (nchars < nbytes) + if (nbytes) { - /* Decode the input data. */ - - /* The input should be decoded with `coding_system' - which depends on which X*LookupString function - we used just above and the locale. */ - setup_coding_system (coding_system, &coding); - coding.src_multibyte = false; - coding.dst_multibyte = true; - /* The input is converted to events, thus we can't - handle composition. Anyway, there's no XIM that - gives us composition information. */ - coding.common_flags &= ~CODING_ANNOTATION_MASK; - - SAFE_NALLOCA (coding.destination, MAX_MULTIBYTE_LENGTH, - nbytes); - coding.dst_bytes = MAX_MULTIBYTE_LENGTH * nbytes; - coding.mode |= CODING_MODE_LAST_BLOCK; - decode_coding_c_string (&coding, copy_bufptr, nbytes, Qnil); - nbytes = coding.produced; - nchars = coding.produced_char; - copy_bufptr = coding.destination; - } + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.arg = make_unibyte_string ((char *) copy_bufptr, nbytes); - /* Convert the input data to a sequence of - character events. */ - for (i = 0; i < nbytes; i += len) - { - int ch; - if (nchars == nbytes) - ch = copy_bufptr[i], len = 1; - else - ch = string_char_and_length (copy_bufptr + i, &len); - inev.ie.kind = (SINGLE_BYTE_CHAR_P (ch) - ? ASCII_KEYSTROKE_EVENT - : MULTIBYTE_CHAR_KEYSTROKE_EVENT); - inev.ie.code = ch; - kbd_buffer_store_buffered_event (&inev, hold_quit); + Fput_text_property (make_fixnum (0), make_fixnum (nbytes), + Qcoding, coding, inev.ie.arg); } - count += nchars; - - inev.ie.kind = NO_EVENT; /* Already stored above. */ - if (keysym == NoSymbol) break; } @@ -9617,7 +10266,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif case KeyRelease: - x_display_set_last_user_time (dpyinfo, event->xkey.time); #ifdef HAVE_X_I18N /* Don't dispatch this event since XtDispatchEvent calls XFilterEvent, and two calls in a row may freeze the @@ -9724,8 +10372,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (x_top_window_to_frame (dpyinfo, event->xcrossing.window)) x_detect_focus_change (dpyinfo, any, event, &inev.ie); +#if defined USE_X_TOOLKIT + /* If the mouse leaves the edit widget, then any mouse highlight + should be cleared. */ + f = x_window_to_frame (dpyinfo, event->xcrossing.window); + + if (!f) + f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); +#else f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); -#if defined HAVE_X_TOOLKIT && defined HAVE_XINPUT2 +#endif +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 /* The XI2 event mask is set on the frame widget, so this event likely originates from the shell widget, which we aren't interested in. */ @@ -9762,7 +10419,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, case MotionNotify: { - x_display_set_last_user_time (dpyinfo, event->xmotion.time); previous_help_echo_string = help_echo_string; help_echo_string = Qnil; @@ -9885,23 +10541,14 @@ handle_one_xevent (struct x_display_info *dpyinfo, } f = x_top_window_to_frame (dpyinfo, configureEvent.xconfigure.window); - /* Unfortunately, we need to call font_drop_xrender_surfaces for + /* Unfortunately, we need to call x_drop_xrender_surfaces for _all_ ConfigureNotify events, otherwise we miss some and flicker. Don't try to optimize these calls by looking only for size changes: that's not sufficient. We miss some surface invalidations and flicker. */ block_input (); if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); -#ifdef HAVE_XRENDER - if (f && FRAME_X_DOUBLE_BUFFERED_P (f) - && FRAME_X_PICTURE (f) != None) - { - XRenderFreePicture (FRAME_X_DISPLAY (f), - FRAME_X_PICTURE (f)); - FRAME_X_PICTURE (f) = None; - } -#endif + x_drop_xrender_surfaces (f); unblock_input (); #if defined USE_CAIRO && !defined USE_GTK if (f) @@ -9911,6 +10558,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_cr_update_surface_desired_size (any, configureEvent.xconfigure.width, configureEvent.xconfigure.height); + if (f || (any && configureEvent.xconfigure.window == FRAME_X_WINDOW (any))) + x_update_opaque_region (f ? f : any, &configureEvent); #endif #ifdef USE_GTK if (!f @@ -9931,7 +10580,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) - font_drop_xrender_surfaces (f); + x_drop_xrender_surfaces (f); unblock_input (); xg_frame_resized (f, configureEvent.xconfigure.width, configureEvent.xconfigure.height); @@ -9939,6 +10588,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_cr_update_surface_desired_size (f, configureEvent.xconfigure.width, configureEvent.xconfigure.height); #endif + x_update_opaque_region (f, &configureEvent); f = 0; } #endif @@ -10081,7 +10731,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, memset (&compose_status, 0, sizeof (compose_status)); dpyinfo->last_mouse_glyph_frame = NULL; - x_display_set_last_user_time (dpyinfo, event->xbutton.time); + + if (event->xbutton.type == ButtonPress) + x_display_set_last_user_time (dpyinfo, event->xbutton.time); f = mouse_or_wdesc_frame (dpyinfo, event->xmotion.window); if (f && event->xbutton.type == ButtonPress @@ -10302,6 +10954,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, 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; @@ -10350,10 +11003,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, } 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; + case XI_Enter: any = x_top_window_to_frame (dpyinfo, enter->event); @@ -10372,47 +11027,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!any) any = x_any_window_to_frame (dpyinfo, enter->event); + xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid, + true); + { #ifdef HAVE_XWIDGETS struct xwidget_view *xwidget_view = xwidget_view_from_window (enter->event); -#else - bool xwidget_view = false; -#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 - re-enters a frame after its valuators have potentially - been changed elsewhere. */ - if (enter->detail != XINotifyInferior - && enter->mode != XINotifyPassiveUngrab - /* See the comment under FocusIn in - `x_detect_focus_change'. The main relevant culprit - these days seems to be XFCE. */ - && enter->mode != XINotifyUngrab - && (xwidget_view - || (any && enter->event == FRAME_X_WINDOW (any)))) - xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid); +#endif #ifdef HAVE_XWIDGETS if (xwidget_view) { - /* Don't send an enter event to the xwidget if the - first button is pressed, to avoid it releasing - the passive grab. I don't know why that happens, - but this workaround makes dragging to select text - work again. */ - if (!(enter->buttons.mask_len - && XIMaskIsSet (enter->buttons.mask, 1))) - xwidget_motion_or_crossing (xwidget_view, event); + xwidget_motion_or_crossing (xwidget_view, event); goto XI_OTHER; } @@ -10442,6 +11068,34 @@ handle_one_xevent (struct x_display_info *dpyinfo, ev.window = leave->event; 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); + #ifdef HAVE_XWIDGETS { struct xwidget_view *xvw @@ -10462,15 +11116,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (any) x_detect_focus_change (dpyinfo, any, event, &inev.ie); - if (!any) - any = x_any_window_to_frame (dpyinfo, leave->event); - #ifndef USE_X_TOOLKIT 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); + + if (!f) + f = x_top_window_to_frame (dpyinfo, leave->event); #endif if (f) { @@ -10495,31 +11149,30 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_note_mouse_movement (dpyinfo->last_mouse_glyph_frame, &ev); #endif goto XI_OTHER; + case XI_Motion: { struct xi_device_t *device; - bool touch_end_event_seen = false; states = &xev->valuators; values = states->values; device = xi_device_from_id (dpyinfo, xev->deviceid); - if (!device || !device->master_p) + if (!device) goto XI_OTHER; -#ifdef XI_TouchBegin - if (xev->flags & XIPointerEmulated - && dpyinfo->xi2_version >= 2) +#ifdef HAVE_XINPUT2_2 + if (xev->flags & XIPointerEmulated) goto XI_OTHER; #endif - x_display_set_last_user_time (dpyinfo, xi_event->time); - #ifdef HAVE_XWIDGETS struct xwidget_view *xv = xwidget_view_from_window (xev->event); double xv_total_x = 0.0; double xv_total_y = 0.0; #endif + double total_x = 0.0; + double total_y = 0.0; for (int i = 0; i < states->mask_len * 8; i++) { @@ -10536,19 +11189,21 @@ handle_one_xevent (struct x_display_info *dpyinfo, scroll wheel movement is reported on XInput 2. */ delta = x_get_scroll_valuator_delta (dpyinfo, xev->deviceid, i, *values, &val); + values++; if (delta != DBL_MAX) { + if (!f) + { + f = x_any_window_to_frame (dpyinfo, xev->event); + + if (!f) + goto XI_OTHER; + } + #ifdef HAVE_XWIDGETS if (xv) { - /* FIXME: figure out what in GTK is - causing interval values to jump by - >100 at the end of a touch sequence - when an xwidget gets a scroll event - where is_stop is TRUE. */ - if (fabs (delta) > 100) - continue; if (val->horizontal) xv_total_x += delta; else @@ -10558,15 +11213,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, continue; } #endif - if (!f) - { - f = x_any_window_to_frame (dpyinfo, xev->event); - if (!f) - goto XI_OTHER; - } - - found_valuator = true; + if (delta == 0.0) + found_valuator = true; if (signbit (delta) != signbit (val->emacs_value)) val->emacs_value = 0; @@ -10578,26 +11227,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, && (fabs (delta) > 0)) continue; - bool s = signbit (val->emacs_value); - inev.ie.kind = (fabs (delta) > 0 - ? (val->horizontal - ? HORIZ_WHEEL_EVENT - : WHEEL_EVENT) - : TOUCH_END_EVENT); - inev.ie.timestamp = xev->time; - - XSETINT (inev.ie.x, lrint (xev->event_x)); - XSETINT (inev.ie.y, lrint (xev->event_y)); - XSETFRAME (inev.ie.frame_or_window, f); - - if (fabs (delta) > 0) - { - inev.ie.modifiers = !s ? up_modifier : down_modifier; - inev.ie.modifiers - |= x_x_to_emacs_modifiers (dpyinfo, - xev->mods.effective); - } - window = window_from_coordinates (f, xev->event_x, xev->event_y, NULL, false, false); @@ -10615,41 +11244,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (NUMBERP (Vx_scroll_event_delta_factor)) scroll_unit *= XFLOATINT (Vx_scroll_event_delta_factor); - if (fabs (delta) > 0) - { - if (val->horizontal) - { - inev.ie.arg - = list3 (Qnil, - make_float (val->emacs_value - * scroll_unit), - make_float (0)); - } - else - { - inev.ie.arg = list3 (Qnil, make_float (0), - make_float (val->emacs_value - * scroll_unit)); - } - } + if (val->horizontal) + total_x += delta * scroll_unit; else - { - inev.ie.arg = Qnil; - } - - if (inev.ie.kind != TOUCH_END_EVENT - || !touch_end_event_seen) - { - kbd_buffer_store_event_hold (&inev.ie, hold_quit); - touch_end_event_seen = inev.ie.kind == TOUCH_END_EVENT; - } + total_y += delta * scroll_unit; + found_valuator = true; val->emacs_value = 0; } - values++; } - - inev.ie.kind = NO_EVENT; } #ifdef HAVE_XWIDGETS @@ -10679,15 +11282,51 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; } -#endif - if (found_valuator) + else { +#endif + if (found_valuator) + { + 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)); + XSETFRAME (inev.ie.frame_or_window, f); + + inev.ie.modifiers = (signbit (fabs (total_y) >= fabs (total_x) + ? total_y : total_x) + ? down_modifier : up_modifier); + inev.ie.modifiers + |= x_x_to_emacs_modifiers (dpyinfo, + xev->mods.effective); + 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; + if (f && xg_event_is_for_scrollbar (f, event)) + *finish = X_EVENT_DROP; #endif - goto XI_OTHER; + } + 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)); + XSETFRAME (inev.ie.frame_or_window, f); + } + + goto XI_OTHER; + } +#ifdef HAVE_XWIDGETS } +#endif ev.x = lrint (xev->event_x); ev.y = lrint (xev->event_y); @@ -10775,6 +11414,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, do_help = 1; goto XI_OTHER; } + case XI_ButtonRelease: case XI_ButtonPress: { @@ -10791,11 +11431,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef XIPointerEmulated /* Ignore emulated scroll events when XI2 native scroll events are present. */ - if (((dpyinfo->xi2_version == 1 - && xev->detail >= 4 - && xev->detail <= 8) - || (dpyinfo->xi2_version >= 2)) - && xev->flags & XIPointerEmulated) + if (xev->flags & XIPointerEmulated) { *finish = X_EVENT_DROP; goto XI_OTHER; @@ -10823,7 +11459,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, device = xi_device_from_id (dpyinfo, xev->deviceid); - if (!device || !device->master_p) + if (!device) goto XI_OTHER; bv.button = xev->detail; @@ -10835,7 +11471,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, bv.time = xev->time; dpyinfo->last_mouse_glyph_frame = NULL; - x_display_set_last_user_time (dpyinfo, xev->time); + + if (xev->evtype == XI_ButtonPress) + x_display_set_last_user_time (dpyinfo, xev->time); f = mouse_or_wdesc_frame (dpyinfo, xev->event); @@ -10868,6 +11506,31 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (f) { + if (xev->detail >= 4 && xev->detail <= 8) + { + if (xev->evtype == XI_ButtonRelease) + { + 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, lrint (xev->event_x)); + XSETINT (inev.ie.y, lrint (xev->event_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; + } + + goto XI_OTHER; + } + /* Is this in the tab-bar? */ if (WINDOWP (f->tab_bar_window) && WINDOW_TOTAL_LINES (XWINDOW (f->tab_bar_window))) @@ -10974,6 +11637,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif goto XI_OTHER; } + case XI_KeyPress: { int state = xev->mods.effective; @@ -10985,15 +11649,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, KeySym keysym; char copy_buffer[81]; char *copy_bufptr = copy_buffer; - unsigned char *copy_ubufptr; int copy_bufsiz = sizeof (copy_buffer); ptrdiff_t i; - int nchars, len; struct xi_device_t *device; + coding = Qlatin_1; + device = xi_device_from_id (dpyinfo, xev->deviceid); - if (!device || !device->master_p) + if (!device) goto XI_OTHER; #if defined (USE_X_TOOLKIT) || defined (USE_GTK) @@ -11051,6 +11715,29 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif + state |= x_emacs_to_x_modifiers (dpyinfo, extra_keyboard_modifiers); + +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->xkb_desc) + { + XkbDescRec *rec = FRAME_DISPLAY_INFO (f)->xkb_desc; + + if (rec->map->modmap && rec->map->modmap[xev->detail]) + goto xi_done_keysym; + } + else +#endif + { + if (dpyinfo->modmap) + { + for (i = 0; i < 8 * dpyinfo->modmap->max_keypermod; i++) + { + if (xkey.keycode == dpyinfo->modmap->modifiermap[xev->detail]) + goto xi_done_keysym; + } + } + } + #ifdef HAVE_XKB if (dpyinfo->xkb_desc) { @@ -11118,6 +11805,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, &xkey, (char *) copy_bufptr, copy_bufsiz, &keysym, &status_return); + coding = Qnil; if (status_return == XBufferOverflow) { @@ -11164,6 +11852,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (overflow) nbytes = 0; } + + coding = Qnil; } else #endif @@ -11290,63 +11980,28 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto xi_done_keysym; } - for (i = 0, nchars = 0; i < nbytes; i++) + for (i = 0; i < nbytes; i++) { - if (ASCII_CHAR_P (copy_bufptr[i])) - nchars++; STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); } - if (nchars < nbytes) + if (nbytes) { - /* Decode the input data. */ - - setup_coding_system (Vlocale_coding_system, &coding); - coding.src_multibyte = false; - coding.dst_multibyte = true; - /* The input is converted to events, thus we can't - handle composition. Anyway, there's no XIM that - gives us composition information. */ - coding.common_flags &= ~CODING_ANNOTATION_MASK; - - SAFE_NALLOCA (coding.destination, MAX_MULTIBYTE_LENGTH, - nbytes); - coding.dst_bytes = MAX_MULTIBYTE_LENGTH * nbytes; - coding.mode |= CODING_MODE_LAST_BLOCK; - decode_coding_c_string (&coding, (unsigned char *) copy_bufptr, - nbytes, Qnil); - nbytes = coding.produced; - nchars = coding.produced_char; - copy_bufptr = (char *) coding.destination; - } - - copy_ubufptr = (unsigned char *) copy_bufptr; + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.arg = make_unibyte_string (copy_bufptr, nbytes); - /* Convert the input data to a sequence of - character events. */ - for (i = 0; i < nbytes; i += len) - { - int ch; - if (nchars == nbytes) - ch = copy_ubufptr[i], len = 1; - else - ch = string_char_and_length (copy_ubufptr + i, &len); - inev.ie.kind = (SINGLE_BYTE_CHAR_P (ch) - ? ASCII_KEYSTROKE_EVENT - : MULTIBYTE_CHAR_KEYSTROKE_EVENT); - inev.ie.code = ch; - kbd_buffer_store_buffered_event (&inev, hold_quit); + Fput_text_property (make_fixnum (0), make_fixnum (nbytes), + Qcoding, coding, inev.ie.arg); } - - inev.ie.kind = NO_EVENT; goto xi_done_keysym; } + goto XI_OTHER; } - case XI_KeyRelease: - x_display_set_last_user_time (dpyinfo, xev->time); + case XI_KeyRelease: #if defined HAVE_X_I18N || defined USE_GTK + { XKeyPressedEvent xkey; memset (&xkey, 0, sizeof xkey); @@ -11373,23 +12028,140 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (f && xg_filter_key (f, event)) *finish = X_EVENT_DROP; #endif + } #endif goto XI_OTHER; case XI_PropertyEvent: + goto XI_OTHER; + case XI_HierarchyChanged: + x_init_master_valuators (dpyinfo); + goto XI_OTHER; + case XI_DeviceChanged: + { + struct xi_device_t *device; + struct xi_touch_point_t *tem, *last; + int c; +#ifdef HAVE_XINPUT2_1 + int i; +#endif -#ifdef XISlaveSwitch - if (xi_event->evtype == XI_DeviceChanged - && (((XIDeviceChangedEvent *) xi_event)->reason - == XISlaveSwitch)) - goto XI_OTHER; + device = xi_device_from_id (dpyinfo, device_changed->deviceid); + + if (!device) + { + /* An existing device might have been enabled. */ + x_init_master_valuators (dpyinfo); + + /* Now try to find the device again, in case it was + just enabled. */ + device = xi_device_from_id (dpyinfo, device_changed->deviceid); + } + + /* If it wasn't enabled, then stop handling this event. */ + if (!device) + goto XI_OTHER; + + /* Free data that we will regenerate from new + information. */ + device->valuators = xrealloc (device->valuators, + (device_changed->num_classes + * sizeof *device->valuators)); + device->scroll_valuator_count = 0; + device->direct_p = false; + + for (c = 0; c < device_changed->num_classes; ++c) + { + switch (device_changed->classes[c]->type) + { +#ifdef HAVE_XINPUT2_1 + case XIScrollClass: + { + XIScrollClassInfo *info; + + info = (XIScrollClassInfo *) device_changed->classes[c]; + struct xi_scroll_valuator_t *valuator; + + valuator = &device->valuators[device->scroll_valuator_count++]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; + + break; + } #endif - x_init_master_valuators (dpyinfo); - goto XI_OTHER; -#ifdef XI_TouchBegin + +#ifdef HAVE_XINPUT2_2 + case XITouchClass: + { + XITouchClassInfo *info; + + info = (XITouchClassInfo *) device_changed->classes[c]; + device->direct_p = info->mode == XIDirectTouch; + } +#endif + default: + break; + } + } + +#ifdef HAVE_XINPUT2_1 + for (c = 0; c < device_changed->num_classes; ++c) + { + if (device_changed->classes[c]->type == XIValuatorClass) + { + XIValuatorClassInfo *info; + + info = (XIValuatorClassInfo *) device_changed->classes[c]; + + for (i = 0; i < device->scroll_valuator_count; ++i) + { + if (device->valuators[i].number == info->number) + { + device->valuators[i].invalid_p = false; + device->valuators[i].current_value = info->value; + + /* Make sure that this is reset if the + pointer moves into a window of ours. + + Otherwise the valuator state could be + left invalid if the DeviceChange + event happened with the pointer + outside any Emacs frame. */ + device->valuators[i].pending_enter_reset = true; + } + } + } + } +#endif + + /* The device is no longer a DirectTouch device, so + remove any touchpoints that we might have + recorded. */ + if (!device->direct_p) + { + tem = device->touchpoints; + + while (tem) + { + last = tem; + tem = tem->next; + xfree (last); + } + + device->touchpoints = NULL; + } + + goto XI_OTHER; + } + +#ifdef HAVE_XINPUT2_2 case XI_TouchBegin: { struct xi_device_t *device; @@ -11475,6 +12247,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; } + case XI_TouchUpdate: { struct xi_device_t *device; @@ -11517,6 +12290,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; } + case XI_TouchEnd: { struct xi_device_t *device; @@ -11547,18 +12321,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, goto XI_OTHER; } + #endif -#ifdef XI_GesturePinchBegin + +#ifdef HAVE_XINPUT2_4 case XI_GesturePinchBegin: case XI_GesturePinchUpdate: { x_display_set_last_user_time (dpyinfo, xi_event->time); -#ifdef HAVE_USABLE_XI_GESTURE_PINCH_EVENT XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event; struct xi_device_t *device = xi_device_from_id (dpyinfo, pev->deviceid); - if (!device || !device->master_p) + if (!device) goto XI_OTHER; #ifdef HAVE_XWIDGETS @@ -11586,16 +12361,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, make_float (pev->scale), make_float (pev->delta_angle)); } -#endif + /* Once again GTK seems to crash when confronted by events it doesn't understand. */ *finish = X_EVENT_DROP; goto XI_OTHER; } + case XI_GesturePinchEnd: { - x_display_set_last_user_time (dpyinfo, xi_event->time); - #if defined HAVE_XWIDGETS && HAVE_USABLE_XI_GESTURE_PINCH_EVENT XIGesturePinchEvent *pev = (XIGesturePinchEvent *) xi_event; struct xwidget_view *xvw = xwidget_view_from_window (pev->event); @@ -11610,6 +12384,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, default: goto XI_OTHER; } + xi_done_keysym: #ifdef HAVE_X_I18N if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMStatusArea)) @@ -11618,6 +12393,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (must_free_data) XFreeEventData (dpyinfo->display, &event->xcookie); goto done_keysym; + XI_OTHER: if (must_free_data) XFreeEventData (dpyinfo->display, &event->xcookie); @@ -11676,9 +12452,17 @@ handle_one_xevent (struct x_display_info *dpyinfo, OTHER: #ifdef USE_X_TOOLKIT block_input (); - if (*finish != X_EVENT_DROP) - XtDispatchEvent ((XEvent *) event); - unblock_input (); + if (*finish != X_EVENT_DROP) + { + /* Ignore some obviously bogus ConfigureNotify events that + other clients have been known to send Emacs. + (bug#54051)*/ + if (event->type != ConfigureNotify + || (event->xconfigure.width != 0 + && event->xconfigure.height != 0)) + XtDispatchEvent ((XEvent *) event); + } + unblock_input (); #endif /* USE_X_TOOLKIT */ break; } @@ -11717,7 +12501,6 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Sometimes event processing draws to the frame outside redisplay. To ensure that these changes become visible, draw them here. */ flush_dirty_back_buffers (); - SAFE_FREE (); return count; } @@ -12027,8 +12810,8 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text x += cursor_glyph->pixel_width - width; x_fill_rectangle (f, gc, x, - WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), - width, row->height); + WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), + width, row->height, false); } else /* HBAR_CURSOR */ { @@ -12049,7 +12832,7 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text x_fill_rectangle (f, gc, x, WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y + row->height - width), - w->phys_cursor_width - 1, width); + w->phys_cursor_width - 1, width, false); } x_reset_clip_rectangles (f, gc); @@ -12446,7 +13229,7 @@ x_connection_closed (Display *dpy, const char *error_message, bool ioerror) { struct x_display_info *dpyinfo = x_display_info_for_display (dpy); Lisp_Object frame, tail; - ptrdiff_t idx = SPECPDL_INDEX (); + specpdl_ref idx = SPECPDL_INDEX (); error_msg = alloca (strlen (error_message) + 1); strcpy (error_msg, error_message); @@ -12970,7 +13753,7 @@ x_calc_absolute_position (struct frame *f) which means, do adjust for borders but don't change the gravity. */ static void -x_set_offset (struct frame *f, register int xoff, register int yoff, int change_gravity) +x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) { int modified_top, modified_left; #ifdef USE_GTK @@ -14001,7 +14784,7 @@ x_focus_frame (struct frame *f, bool noactivate) } else { - XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, CurrentTime); if (!noactivate) x_ewmh_activate_frame (f); @@ -14069,6 +14852,11 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg, void x_make_frame_visible (struct frame *f) { +#ifndef USE_GTK + struct x_display_info *dpyinfo; + struct x_output *output; +#endif + if (FRAME_PARENT_FRAME (f)) { if (!FRAME_VISIBLE_P (f)) @@ -14093,6 +14881,10 @@ x_make_frame_visible (struct frame *f) gui_set_bitmap_icon (f); +#ifndef USE_GTK + dpyinfo = FRAME_DISPLAY_INFO (f); +#endif + if (! FRAME_VISIBLE_P (f)) { /* We test asked_for_visible here to make sure we don't @@ -14104,6 +14896,60 @@ x_make_frame_visible (struct frame *f) && ! f->output_data.x->asked_for_visible) x_set_offset (f, f->left_pos, f->top_pos, 0); +#ifndef USE_GTK + output = FRAME_X_OUTPUT (f); + + if (!x_wm_supports (f, dpyinfo->Xatom_net_wm_user_time_window)) + { + if (output->user_time_window == None) + output->user_time_window = FRAME_OUTER_WINDOW (f); + else if (output->user_time_window != FRAME_OUTER_WINDOW (f)) + { + XDestroyWindow (dpyinfo->display, + output->user_time_window); + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time_window); + output->user_time_window = FRAME_OUTER_WINDOW (f); + } + } + else + { + if (output->user_time_window == FRAME_OUTER_WINDOW (f) + || output->user_time_window == None) + { + XSetWindowAttributes attrs; + memset (&attrs, 0, sizeof attrs); + + output->user_time_window + = XCreateWindow (dpyinfo->display, FRAME_X_WINDOW (f), + -1, -1, 1, 1, 0, 0, InputOnly, + CopyFromParent, 0, &attrs); + + XDeleteProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time); + XChangeProperty (dpyinfo->display, + FRAME_OUTER_WINDOW (f), + dpyinfo->Xatom_net_wm_user_time_window, + XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &output->user_time_window, + 1); + } + } + + if (dpyinfo->last_user_time) + XChangeProperty (dpyinfo->display, + output->user_time_window, + dpyinfo->Xatom_net_wm_user_time, + XA_CARDINAL, 32, PropModeReplace, + (unsigned char *) &dpyinfo->last_user_time, 1); + else + XDeleteProperty (dpyinfo->display, + output->user_time_window, + dpyinfo->Xatom_net_wm_user_time); +#endif + f->output_data.x->asked_for_visible = true; if (! EQ (Vx_no_window_manager, Qt)) @@ -14377,7 +15223,7 @@ x_iconify_frame (struct frame *f) msg.xclient.data.l[0] = IconicState; if (! XSendEvent (FRAME_X_DISPLAY (f), - DefaultRootWindow (FRAME_X_DISPLAY (f)), + FRAME_DISPLAY_INFO (f)->root_window, False, SubstructureRedirectMask | SubstructureNotifyMask, &msg)) @@ -14488,9 +15334,19 @@ x_free_frame_resources (struct frame *f) tear_down_x_back_buffer (f); if (FRAME_X_WINDOW (f)) - XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); + XDestroyWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif /* !USE_X_TOOLKIT */ +#ifdef HAVE_XSYNC + if (FRAME_X_BASIC_COUNTER (f) != None) + XSyncDestroyCounter (FRAME_X_DISPLAY (f), + FRAME_X_BASIC_COUNTER (f)); + + if (FRAME_X_EXTENDED_COUNTER (f) != None) + XSyncDestroyCounter (FRAME_X_DISPLAY (f), + FRAME_X_EXTENDED_COUNTER (f)); +#endif + unload_color (f, FRAME_FOREGROUND_PIXEL (f)); unload_color (f, FRAME_BACKGROUND_PIXEL (f)); unload_color (f, f->output_data.x->cursor_pixel); @@ -14618,7 +15474,8 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) #ifdef USE_X_TOOLKIT if (f->output_data.x->widget) { - widget_update_wm_size_hints (f->output_data.x->widget); + widget_update_wm_size_hints (f->output_data.x->widget, + f->output_data.x->edit_widget); return; } #endif @@ -15341,6 +16198,18 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #else dpyinfo->display->db = xrdb; #endif + +#ifdef HAVE_XRENDER + int event_base, error_base; + dpyinfo->xrender_supported_p + = XRenderQueryExtension (dpyinfo->display, &event_base, &error_base); + + if (dpyinfo->xrender_supported_p) + dpyinfo->xrender_supported_p + = XRenderQueryVersion (dpyinfo->display, &dpyinfo->xrender_major, + &dpyinfo->xrender_minor); +#endif + /* Put the rdb where we can find it in a way that works on all versions. */ dpyinfo->rdb = xrdb; @@ -15355,16 +16224,48 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) reset_mouse_highlight (&dpyinfo->mouse_highlight); - /* See if we can construct pixel values from RGB values. */ - if (dpyinfo->visual->class == TrueColor) - { - get_bits_and_offset (dpyinfo->visual->red_mask, - &dpyinfo->red_bits, &dpyinfo->red_offset); - get_bits_and_offset (dpyinfo->visual->blue_mask, - &dpyinfo->blue_bits, &dpyinfo->blue_offset); - get_bits_and_offset (dpyinfo->visual->green_mask, - &dpyinfo->green_bits, &dpyinfo->green_offset); - } +#ifdef HAVE_XRENDER + if (dpyinfo->xrender_supported_p + /* This could already have been initialized by + `select_visual'. */ + && !dpyinfo->pict_format) + dpyinfo->pict_format = XRenderFindVisualFormat (dpyinfo->display, + dpyinfo->visual); +#endif + +#ifdef HAVE_XSYNC + int xsync_event_base, xsync_error_base; + dpyinfo->xsync_supported_p + = XSyncQueryExtension (dpyinfo->display, + &xsync_event_base, + &xsync_error_base); + + if (dpyinfo->xsync_supported_p) + dpyinfo->xsync_supported_p = XSyncInitialize (dpyinfo->display, + &dpyinfo->xsync_major, + &dpyinfo->xsync_minor); + + { + AUTO_STRING (synchronizeResize, "synchronizeResize"); + AUTO_STRING (SynchronizeResize, "SynchronizeResize"); + + Lisp_Object value = gui_display_get_resource (dpyinfo, + synchronizeResize, + SynchronizeResize, + Qnil, Qnil); + + if (STRINGP (value) && + (!strcmp (SSDATA (value), "false") + || !strcmp (SSDATA (value), "off"))) + dpyinfo->xsync_supported_p = false; + } +#endif + +#ifdef HAVE_XINERAMA + int xin_event_base, xin_error_base; + dpyinfo->xinerama_supported_p + = XineramaQueryExtension (dpy, &xin_event_base, &xin_error_base); +#endif /* See if a private colormap is requested. */ if (dpyinfo->visual == DefaultVisualOfScreen (dpyinfo->screen)) @@ -15386,6 +16287,52 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->cmap = XCreateColormap (dpyinfo->display, dpyinfo->root_window, dpyinfo->visual, AllocNone); + /* See if we can construct pixel values from RGB values. */ + if (dpyinfo->visual->class == TrueColor) + { + get_bits_and_offset (dpyinfo->visual->red_mask, + &dpyinfo->red_bits, &dpyinfo->red_offset); + get_bits_and_offset (dpyinfo->visual->blue_mask, + &dpyinfo->blue_bits, &dpyinfo->blue_offset); + get_bits_and_offset (dpyinfo->visual->green_mask, + &dpyinfo->green_bits, &dpyinfo->green_offset); + +#ifdef HAVE_XRENDER + if (dpyinfo->pict_format) + { + unsigned long channel_mask + = ((unsigned long) dpyinfo->pict_format->direct.alphaMask + << dpyinfo->pict_format->direct.alpha); + + if (channel_mask) + get_bits_and_offset (channel_mask, &dpyinfo->alpha_bits, + &dpyinfo->alpha_offset); + dpyinfo->alpha_mask = channel_mask; + } + else +#endif + { + XColor xc; + unsigned long alpha_mask; + xc.red = 65535; + xc.green = 65535; + xc.blue = 65535; + + if (XAllocColor (dpyinfo->display, + dpyinfo->cmap, &xc) != 0) + { + alpha_mask = xc.pixel & ~(dpyinfo->visual->red_mask + | dpyinfo->visual->blue_mask + | dpyinfo->visual->green_mask); + + if (alpha_mask) + get_bits_and_offset (alpha_mask, &dpyinfo->alpha_bits, + &dpyinfo->alpha_offset); + dpyinfo->alpha_mask = alpha_mask; + } + } + } + #ifdef HAVE_XDBE dpyinfo->supports_xdbe = false; int xdbe_major; @@ -15432,23 +16379,53 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->supports_xi2 = false; int rc; int major = 2; -#ifdef XI_GesturePinchBegin /* XInput 2.4 */ + int xi_first_event, xi_first_error; + +#ifdef HAVE_XINPUT2_4 int minor = 4; -#elif XI_BarrierHit /* XInput 2.3 */ +#elif defined HAVE_XINPUT2_3 /* XInput 2.3 */ int minor = 3; -#elif defined XI_TouchBegin /* XInput 2.2 */ +#elif defined HAVE_XINPUT2_2 /* XInput 2.2 */ int minor = 2; -#elif defined XIScrollClass /* XInput 2.1 */ +#elif defined HAVE_XINPUT2_1 /* XInput 2.1 */ int minor = 1; #else /* Some old version of XI2 we're not interested in. */ int minor = 0; #endif - int fer, fee; if (XQueryExtension (dpyinfo->display, "XInputExtension", - &dpyinfo->xi2_opcode, &fer, &fee)) + &dpyinfo->xi2_opcode, &xi_first_event, + &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); + + query: +#endif + rc = XIQueryVersion (dpyinfo->display, &major, &minor); + +#ifdef HAVE_GTK3 + if (x_had_errors_p (dpyinfo->display)) + { + /* Some unreasonable value that will probably not be + exceeded in the future. */ + if (minor > 100) + rc = BadRequest; + else + { + /* Increase the minor version until we find one the X server + agrees with. */ + minor++; + goto query; + } + } + + x_uncatch_errors (); +#endif + if (rc == Success) { dpyinfo->supports_xi2 = true; @@ -15498,22 +16475,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } #endif -#ifdef HAVE_XRENDER - int event_base, error_base; - dpyinfo->xrender_supported_p - = XRenderQueryExtension (dpyinfo->display, &event_base, &error_base); - - if (dpyinfo->xrender_supported_p) - { - if (!XRenderQueryVersion (dpyinfo->display, &dpyinfo->xrender_major, - &dpyinfo->xrender_minor)) - dpyinfo->xrender_supported_p = false; - else - dpyinfo->pict_format = XRenderFindVisualFormat (dpyinfo->display, - dpyinfo->visual); - } -#endif - #ifdef HAVE_XFIXES int xfixes_event_base, xfixes_error_base; dpyinfo->xfixes_supported_p @@ -15580,6 +16541,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("WM_CONFIGURE_DENIED", Xatom_wm_configure_denied) ATOM_REFS_INIT ("WM_MOVED", Xatom_wm_window_moved) ATOM_REFS_INIT ("WM_CLIENT_LEADER", Xatom_wm_client_leader) + ATOM_REFS_INIT ("WM_TRANSIENT_FOR", Xatom_wm_transient_for) ATOM_REFS_INIT ("Editres", Xatom_editres) ATOM_REFS_INIT ("CLIPBOARD", Xatom_CLIPBOARD) ATOM_REFS_INIT ("TIMESTAMP", Xatom_TIMESTAMP) @@ -15595,6 +16557,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("ATOM", Xatom_ATOM) ATOM_REFS_INIT ("ATOM_PAIR", Xatom_ATOM_PAIR) ATOM_REFS_INIT ("CLIPBOARD_MANAGER", Xatom_CLIPBOARD_MANAGER) + ATOM_REFS_INIT ("XATOM_COUNTER", Xatom_XEMBED_INFO) ATOM_REFS_INIT ("_XEMBED_INFO", Xatom_XEMBED_INFO) /* For properties of font. */ ATOM_REFS_INIT ("PIXEL_SIZE", Xatom_PIXEL_SIZE) @@ -15629,6 +16592,11 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("_NET_FRAME_EXTENTS", Xatom_net_frame_extents) ATOM_REFS_INIT ("_NET_CURRENT_DESKTOP", Xatom_net_current_desktop) ATOM_REFS_INIT ("_NET_WORKAREA", Xatom_net_workarea) + ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST", Xatom_net_wm_sync_request) + ATOM_REFS_INIT ("_NET_WM_SYNC_REQUEST_COUNTER", Xatom_net_wm_sync_request_counter) + ATOM_REFS_INIT ("_NET_WM_FRAME_DRAWN", Xatom_net_wm_frame_drawn) + ATOM_REFS_INIT ("_NET_WM_USER_TIME", Xatom_net_wm_user_time) + ATOM_REFS_INIT ("_NET_WM_USER_TIME_WINDOW", Xatom_net_wm_user_time_window) /* Session management */ ATOM_REFS_INIT ("SM_CLIENT_ID", Xatom_SM_CLIENT_ID) ATOM_REFS_INIT ("_XSETTINGS_SETTINGS", Xatom_xsettings_prop) @@ -15636,6 +16604,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) ATOM_REFS_INIT ("_NET_WM_STATE_SKIP_TASKBAR", Xatom_net_wm_state_skip_taskbar) ATOM_REFS_INIT ("_NET_WM_STATE_ABOVE", Xatom_net_wm_state_above) ATOM_REFS_INIT ("_NET_WM_STATE_BELOW", Xatom_net_wm_state_below) + ATOM_REFS_INIT ("_NET_WM_OPAQUE_REGION", Xatom_net_wm_opaque_region) + ATOM_REFS_INIT ("_NET_WM_PING", Xatom_net_wm_ping) #ifdef HAVE_XKB ATOM_REFS_INIT ("Meta", Xatom_Meta) ATOM_REFS_INIT ("Super", Xatom_Super) @@ -15853,6 +16823,11 @@ x_delete_display (struct x_display_info *dpyinfo) xfree (dpyinfo->x_dnd_atoms); xfree (dpyinfo->color_cells); xfree (dpyinfo); + +#ifdef HAVE_XINPUT2 + if (dpyinfo->supports_xi2) + x_free_xi_devices (dpyinfo); +#endif } #ifdef USE_X_TOOLKIT @@ -15998,10 +16973,6 @@ x_delete_terminal (struct terminal *terminal) if (dpyinfo->xkb_desc) XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True); #endif -#ifdef HAVE_XINPUT2 - if (dpyinfo->supports_xi2) - x_free_xi_devices (dpyinfo); -#endif #ifdef USE_GTK xg_display_close (dpyinfo->display); #else @@ -16011,6 +16982,9 @@ x_delete_terminal (struct terminal *terminal) XCloseDisplay (dpyinfo->display); #endif #endif /* ! USE_GTK */ + + if (dpyinfo->modmap) + XFreeModifiermap (dpyinfo->modmap); /* Do not close the connection here because it's already closed by X(t)CloseDisplay (Bug#18403). */ dpyinfo->display = NULL; @@ -16165,14 +17139,19 @@ init_xterm (void) /* Emacs can handle only core input events when built without XI2 support, so make sure Gtk doesn't use Xinput or Xinput2 extensions. */ +#ifndef HAVE_GTK3 xputenv ("GDK_CORE_DEVICE_EVENTS=1"); +#else + gdk_disable_multidevice (); +#endif #endif } #endif #ifdef HAVE_XRENDER void -x_xrender_color_from_gc_foreground (struct frame *f, GC gc, XRenderColor *color) +x_xrender_color_from_gc_foreground (struct frame *f, GC gc, XRenderColor *color, + bool apply_alpha_background) { XGCValues xgcv; XColor xc; @@ -16181,26 +17160,51 @@ x_xrender_color_from_gc_foreground (struct frame *f, GC gc, XRenderColor *color) xc.pixel = xgcv.foreground; x_query_colors (f, &xc, 1); - color->alpha = 65535; - color->red = xc.red; - color->blue = xc.blue; - color->green = xc.green; + color->alpha = (apply_alpha_background + ? 65535 * f->alpha_background + : 65535); + + if (color->alpha == 65535) + { + color->red = xc.red; + color->blue = xc.blue; + color->green = xc.green; + } + else + { + color->red = (xc.red * color->alpha) / 65535; + color->blue = (xc.blue * color->alpha) / 65535; + color->green = (xc.green * color->alpha) / 65535; + } } void -x_xrender_color_from_gc_background (struct frame *f, GC gc, XRenderColor *color) +x_xrender_color_from_gc_background (struct frame *f, GC gc, XRenderColor *color, + bool apply_alpha_background) { XGCValues xgcv; XColor xc; XGetGCValues (FRAME_X_DISPLAY (f), gc, GCBackground, &xgcv); - xc.pixel = xgcv.foreground; + xc.pixel = xgcv.background; x_query_colors (f, &xc, 1); - color->alpha = 65535; - color->red = xc.red; - color->blue = xc.blue; - color->green = xc.green; + color->alpha = (apply_alpha_background + ? 65535 * f->alpha_background + : 65535); + + if (color->alpha == 65535) + { + color->red = xc.red; + color->blue = xc.blue; + color->green = xc.green; + } + else + { + color->red = (xc.red * color->alpha) / 65535; + color->blue = (xc.blue * color->alpha) / 65535; + color->green = (xc.green * color->alpha) / 65535; + } } #endif diff --git a/src/xterm.h b/src/xterm.h index 33887be52b0..7303565ec2a 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -32,6 +32,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/Xatom.h> #include <X11/Xresource.h> +#ifdef HAVE_XINPUT2 +#include <X11/extensions/XInput2.h> +#endif + #ifdef USE_X_TOOLKIT #include <X11/StringDefs.h> #include <X11/IntrinsicP.h> /* CoreP.h needs this */ @@ -99,6 +103,10 @@ typedef GtkWidget *xt_or_gtk_widget; #include <X11/XKBlib.h> #endif +#ifdef HAVE_XSYNC +#include <X11/extensions/sync.h> +#endif + #include "dispextern.h" #include "termhooks.h" @@ -180,6 +188,7 @@ struct color_name_cache_entry struct xi_scroll_valuator_t { bool invalid_p; + bool pending_enter_reset; double current_value; double emacs_value; double increment; @@ -360,15 +369,17 @@ struct x_display_info Atom Xatom_wm_configure_denied; /* When our config request is denied */ Atom Xatom_wm_window_moved; /* When the WM moves us. */ Atom Xatom_wm_client_leader; /* Id of client leader window. */ + Atom Xatom_wm_transient_for; /* Id of whatever window we are + transient for. */ /* EditRes protocol */ Atom Xatom_editres; /* More atoms, which are selection types. */ 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_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; /* More atoms for font properties. The last three are private properties, see the comments in src/fontset.h. */ @@ -460,8 +471,9 @@ struct x_display_info int ncolor_cells; /* Bits and shifts to use to compose pixel values on TrueColor visuals. */ - int red_bits, blue_bits, green_bits; - int red_offset, blue_offset, green_offset; + int red_bits, blue_bits, green_bits, alpha_bits; + int red_offset, blue_offset, green_offset, alpha_offset; + unsigned long alpha_mask; /* The type of window manager we have. If we move FRAME_OUTER_WINDOW to x/y 0/0, some window managers (type A) puts the window manager @@ -496,7 +508,10 @@ 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_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; @@ -515,6 +530,9 @@ struct x_display_info Atom Xatom_Meta, Xatom_Super, Xatom_Hyper, Xatom_ShiftLock, Xatom_Alt; #endif + /* Core modifier map when XKB is not present. */ + XModifierKeymap *modmap; + #ifdef HAVE_XRANDR int xrandr_major_version; int xrandr_minor_version; @@ -563,6 +581,16 @@ struct x_display_info int xfixes_major; int xfixes_minor; #endif + +#ifdef HAVE_XSYNC + bool xsync_supported_p; + int xsync_major; + int xsync_minor; +#endif + +#ifdef HAVE_XINERAMA + bool xinerama_supported_p; +#endif }; #ifdef HAVE_X_I18N @@ -661,6 +689,12 @@ struct x_output Widget menubar_widget; #endif +#ifndef USE_GTK + /* A window used to store the user time property. May be None or + the frame's outer window. */ + Window user_time_window; +#endif + #ifdef USE_GTK /* The widget of this screen. This is the window of a top widget. */ GtkWidget *widget; @@ -799,6 +833,19 @@ struct x_output XFontSet xic_xfs; #endif +#ifdef HAVE_XSYNC + XSyncCounter basic_frame_counter; + XSyncCounter extended_frame_counter; + XSyncValue pending_basic_counter_value; + XSyncValue current_extended_counter_value; + + bool_bf sync_end_pending_p : 1; + bool_bf ext_sync_end_pending_p : 1; +#ifdef HAVE_GTK3 + bool_bf xg_sync_end_pending_p : 1; +#endif +#endif + /* Relief GCs, colors etc. */ struct relief { @@ -961,6 +1008,10 @@ extern void x_mark_frame_dirty (struct frame *f); || (FRAME_DISPLAY_INFO (f)->xrender_major > (major)))) #endif +#ifdef HAVE_XSYNC +#define FRAME_X_BASIC_COUNTER(f) FRAME_X_OUTPUT (f)->basic_frame_counter +#define FRAME_X_EXTENDED_COUNTER(f) FRAME_X_OUTPUT (f)->extended_frame_counter +#endif /* This is the Colormap which frame F uses. */ #define FRAME_X_COLORMAP(f) FRAME_DISPLAY_INFO (f)->cmap @@ -1235,17 +1286,24 @@ extern void x_cr_destroy_frame_context (struct frame *); extern void x_cr_update_surface_desired_size (struct frame *, int, int); extern cairo_t *x_begin_cr_clip (struct frame *, GC); extern void x_end_cr_clip (struct frame *); -extern void x_set_cr_source_with_gc_foreground (struct frame *, GC); -extern void x_set_cr_source_with_gc_background (struct frame *, GC); +extern void x_set_cr_source_with_gc_foreground (struct frame *, GC, bool); +extern void x_set_cr_source_with_gc_background (struct frame *, GC, bool); extern void x_cr_draw_frame (cairo_t *, struct frame *); extern Lisp_Object x_cr_export_frames (Lisp_Object, cairo_surface_type_t); #endif #ifdef HAVE_XRENDER -extern void x_xrender_color_from_gc_foreground (struct frame *, GC, XRenderColor *); -extern void x_xrender_color_from_gc_background (struct frame *, GC, XRenderColor *); +extern void x_xrender_color_from_gc_foreground (struct frame *, GC, + XRenderColor *, bool); +extern void x_xrender_color_from_gc_background (struct frame *, GC, + XRenderColor *, bool); +extern void x_xr_ensure_picture (struct frame *f); +extern void x_xr_apply_ext_clip (struct frame *f, GC gc); +extern void x_xr_reset_ext_clip (struct frame *f); #endif +extern void x_display_set_last_user_time (struct x_display_info *, Time); + INLINE int x_display_pixel_height (struct x_display_info *dpyinfo) { @@ -1258,19 +1316,10 @@ x_display_pixel_width (struct x_display_info *dpyinfo) return WidthOfScreen (dpyinfo->screen); } -INLINE void -x_display_set_last_user_time (struct x_display_info *dpyinfo, Time t) -{ -#ifdef ENABLE_CHECKING - eassert (t <= X_ULONG_MAX); -#endif - dpyinfo->last_user_time = t; -} - INLINE unsigned long x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) { - unsigned long pr, pg, pb; + unsigned long pr, pg, pb, pa = dpyinfo->alpha_mask; /* Scale down RGB values to the visual's bits per RGB, and shift them to the right position in the pixel color. Note that the @@ -1280,7 +1329,7 @@ x_make_truecolor_pixel (struct x_display_info *dpyinfo, int r, int g, int b) pb = (b >> (16 - dpyinfo->blue_bits)) << dpyinfo->blue_offset; /* Assemble the pixel color. */ - return pr | pg | pb; + return pr | pg | pb | pa; } /* If display has an immutable color map, freeing colors is not @@ -1406,6 +1455,10 @@ extern void x_session_close (void); extern struct input_event xg_pending_quit_event; #endif +#ifdef HAVE_XINPUT2 +struct xi_device_t *xi_device_from_id (struct x_display_info *, int); +#endif + /* Is the frame embedded into another application? */ #define FRAME_X_EMBEDDED_P(f) (FRAME_X_OUTPUT(f)->explicit_parent != 0) @@ -1416,6 +1469,21 @@ extern struct input_event xg_pending_quit_event; (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 822bed03494..e812b13f23b 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -62,6 +62,9 @@ static uint32_t xwidget_counter = 0; #ifdef USE_GTK #ifdef HAVE_X_WINDOWS static Lisp_Object x_window_to_xwv_map; +#if WEBKIT_CHECK_VERSION (2, 34, 0) +static Lisp_Object dummy_tooltip_string; +#endif #endif static gboolean offscreen_damage_event (GtkWidget *, GdkEvent *, gpointer); static void synthesize_focus_in_event (GtkWidget *); @@ -107,7 +110,8 @@ webkit_decide_policy_cb (WebKitWebView *, WebKitPolicyDecision *, WebKitPolicyDecisionType, gpointer); -static GtkWidget *find_widget_at_pos (GtkWidget *, int, int, int *, int *); +static GtkWidget *find_widget_at_pos (GtkWidget *, int, int, int *, int *, bool, + struct xwidget_view *); static gboolean run_file_chooser_cb (WebKitWebView *, WebKitFileChooserRequest *, gpointer); @@ -122,11 +126,12 @@ struct widget_search_data }; static void find_widget (GtkWidget *t, struct widget_search_data *); -static void mouse_target_changed (WebKitWebView *, WebKitHitTestResult *, guint, - gpointer); #endif #ifdef HAVE_PGTK +static void mouse_target_changed (WebKitWebView *, WebKitHitTestResult *, guint, + gpointer); + static int xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv, struct xwidget *xw) @@ -143,7 +148,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv, widget = find_widget_at_pos (xw->widgetwindow_osr, lrint (event->button.x - xv->clip_left), lrint (event->button.y - xv->clip_top), - &new_x, &new_y); + &new_x, &new_y, false, NULL); if (widget) { event->any.window = gtk_widget_get_window (widget); @@ -156,7 +161,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv, widget = find_widget_at_pos (xw->widgetwindow_osr, lrint (event->scroll.x - xv->clip_left), lrint (event->scroll.y - xv->clip_top), - &new_x, &new_y); + &new_x, &new_y, false, NULL); if (widget) { event->any.window = gtk_widget_get_window (widget); @@ -169,7 +174,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv, widget = find_widget_at_pos (xw->widgetwindow_osr, lrint (event->motion.x - xv->clip_left), lrint (event->motion.y - xv->clip_top), - &new_x, &new_y); + &new_x, &new_y, false, NULL); if (widget) { event->any.window = gtk_widget_get_window (widget); @@ -183,7 +188,7 @@ xw_forward_event_translate (GdkEvent *event, struct xwidget_view *xv, widget = find_widget_at_pos (xw->widgetwindow_osr, lrint (event->crossing.x - xv->clip_left), lrint (event->crossing.y - xv->clip_top), - &new_x, &new_y); + &new_x, &new_y, false, NULL); if (widget) { event->any.window = gtk_widget_get_window (widget); @@ -224,6 +229,13 @@ xw_forward_event_from_view (GtkWidget *widget, GdkEvent *event, #endif #ifdef HAVE_X_WINDOWS +enum xw_crossing_mode + { + XW_CROSSING_LEFT, + XW_CROSSING_ENTERED, + XW_CROSSING_NONE + }; + static guint xw_translate_x_modifiers (struct x_display_info *dpyinfo, unsigned int modifiers) @@ -253,6 +265,17 @@ xw_translate_x_modifiers (struct x_display_info *dpyinfo, return mods; } + +static bool xw_maybe_synthesize_crossing (struct xwidget_view *, + GdkWindow *, int, int, int, + Time, unsigned int, + GdkCrossingMode, GdkCrossingMode); +static void xw_notify_virtual_upwards_until (struct xwidget_view *, GdkWindow *, + GdkWindow *, GdkWindow *, unsigned int, + int, int, Time, GdkEventType, bool, + GdkCrossingMode); +static void window_coords_from_toplevel (GdkWindow *, GdkWindow *, int, + int, int *, int *); #endif DEFUN ("make-xwidget", @@ -403,11 +426,12 @@ fails. */) G_CALLBACK (webkit_decide_policy_cb), xw); - +#ifdef HAVE_PGTK g_signal_connect (G_OBJECT (xw->widget_osr), "mouse-target-changed", G_CALLBACK (mouse_target_changed), xw); +#endif g_signal_connect (G_OBJECT (xw->widget_osr), "create", G_CALLBACK (webkit_create_cb), @@ -710,7 +734,7 @@ pick_embedded_child (GdkWindow *window, double x, double y, return NULL; child = find_widget_at_pos (widget, lrint (x), lrint (y), - &xout, &yout); + &xout, &yout, false, NULL); if (!child) return NULL; @@ -919,9 +943,9 @@ find_widget (GtkWidget *widget, } } - if ((data->x >= new_allocation.x) && (data->y >= new_allocation.y) && - (data->x < new_allocation.x + new_allocation.width) && - (data->y < new_allocation.y + new_allocation.height)) + if ((data->x >= new_allocation.x) && (data->y >= new_allocation.y) + && (data->x < new_allocation.x + new_allocation.width) + && (data->y < new_allocation.y + new_allocation.height)) { /* First, check if the drag is in a valid drop site in one of our children. */ @@ -955,9 +979,27 @@ find_widget (GtkWidget *widget, static GtkWidget * find_widget_at_pos (GtkWidget *w, int x, int y, - int *new_x, int *new_y) + int *new_x, int *new_y, + bool pointer_grabs, + struct xwidget_view *vw) { struct widget_search_data data; +#ifdef HAVE_X_WINDOWS + GtkWidget *grab = NULL; + + if (pointer_grabs) + { + grab = vw->passive_grab; + + if (grab && gtk_widget_get_window (grab)) + { + gtk_widget_translate_coordinates (w, grab, x, + y, new_x, new_y); + + return grab; + } + } +#endif data.x = x; data.y = y; @@ -979,6 +1021,7 @@ find_widget_at_pos (GtkWidget *w, int x, int y, return NULL; } +#ifdef HAVE_PGTK static Emacs_Cursor cursor_for_hit (guint result, struct frame *frame) { @@ -1002,9 +1045,7 @@ static void define_cursors (struct xwidget *xw, WebKitHitTestResult *res) { struct xwidget_view *xvw; -#ifdef HAVE_PGTK GdkWindow *wdesc; -#endif xw->hit_result = webkit_hit_test_result_get_context (res); @@ -1018,16 +1059,12 @@ define_cursors (struct xwidget *xw, WebKitHitTestResult *res) if (XXWIDGET (xvw->model) == xw) { xvw->cursor = cursor_for_hit (xw->hit_result, xvw->frame); -#ifdef HAVE_X_WINDOWS - if (xvw->wdesc != None) - XDefineCursor (xvw->dpy, xvw->wdesc, xvw->cursor); -#else + if (gtk_widget_get_realized (xvw->widget)) { wdesc = gtk_widget_get_window (xvw->widget); gdk_window_set_cursor (wdesc, xvw->cursor); } -#endif } } } @@ -1040,6 +1077,7 @@ mouse_target_changed (WebKitWebView *webview, { define_cursors (xw, hitresult); } +#endif static gboolean run_file_chooser_cb (WebKitWebView *webview, @@ -1104,23 +1142,49 @@ run_file_chooser_cb (WebKitWebView *webview, #ifdef HAVE_X_WINDOWS static void +xv_drag_begin_cb (GtkWidget *widget, + GdkDragContext *context, + gpointer user_data) +{ + struct xwidget_view *view = user_data; + + if (view->passive_grab) + { + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_destruction_signal); + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_drag_signal); + view->passive_grab = NULL; + } +} + +static void xwidget_button_1 (struct xwidget_view *view, bool down_p, int x, int y, int button, int modifier_state, Time time) { - GdkEvent *xg_event = gdk_event_new (down_p ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE); + GdkEvent *xg_event; struct xwidget *model = XXWIDGET (view->model); GtkWidget *target; + GtkWidget *ungrab_target; + GdkWindow *toplevel, *target_window; + int view_x, view_y; /* X and Y should be relative to the origin of view->wdesc. */ x += view->clip_left; y += view->clip_top; - target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y); + view_x = x; + view_y = y; + + target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y, + true, view); if (!target) target = model->widget_osr; + xg_event = gdk_event_new (down_p ? GDK_BUTTON_PRESS : GDK_BUTTON_RELEASE); + xg_event->any.window = gtk_widget_get_window (target); g_object_ref (xg_event->any.window); /* The window will be unrefed later by gdk_event_free. */ @@ -1136,6 +1200,86 @@ xwidget_button_1 (struct xwidget_view *view, gtk_main_do_event (xg_event); gdk_event_free (xg_event); + + + if (down_p && !view->passive_grab) + { + view->passive_grab = target; + view->passive_grab_destruction_signal + = g_signal_connect (G_OBJECT (view->passive_grab), + "destroy", G_CALLBACK (gtk_widget_destroyed), + &view->passive_grab); + view->passive_grab_drag_signal + = g_signal_connect (G_OBJECT (view->passive_grab), + "drag-begin", G_CALLBACK (xv_drag_begin_cb), + view); + } + else + { + ungrab_target = find_widget_at_pos (model->widgetwindow_osr, + view_x, view_y, &x, &y, + false, NULL); + + if (view->last_crossing_window && ungrab_target) + { + xw_maybe_synthesize_crossing (view, gtk_widget_get_window (ungrab_target), + view_x, view_y, XW_CROSSING_NONE, + time, modifier_state, GDK_CROSSING_UNGRAB, + GDK_CROSSING_UNGRAB); + } + else + { + toplevel = gtk_widget_get_window (model->widgetwindow_osr); + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + target_window = gtk_widget_get_window (target); + window_coords_from_toplevel (target_window, toplevel, view_x, + view_y, &x, &y); + + xg_event->crossing.x = x; + xg_event->crossing.y = y; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = GDK_NOTIFY_ANCESTOR; + xg_event->crossing.mode = GDK_CROSSING_UNGRAB; + xg_event->crossing.window = g_object_ref (target_window); + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + + xw_notify_virtual_upwards_until (view, target_window, toplevel, toplevel, + modifier_state, view_x, view_y, time, + GDK_LEAVE_NOTIFY, false, + GDK_CROSSING_UNGRAB); + + if (target_window != toplevel) + { + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + + xg_event->crossing.x = view_y; + xg_event->crossing.y = view_y; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = GDK_NOTIFY_VIRTUAL; + xg_event->crossing.mode = GDK_CROSSING_UNGRAB; + xg_event->crossing.window = g_object_ref (toplevel); + + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } + + } + + if (view->passive_grab) + { + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_destruction_signal); + g_signal_handler_disconnect (view->passive_grab, + view->passive_grab_drag_signal); + view->passive_grab = NULL; + } + } } void @@ -1150,51 +1294,50 @@ xwidget_button (struct xwidget_view *view, if (button < 4 || button > 8) xwidget_button_1 (view, down_p, x, y, button, modifier_state, time); -#ifndef HAVE_XINPUT2 else -#else - else if (!FRAME_DISPLAY_INFO (view->frame)->supports_xi2 - || FRAME_DISPLAY_INFO (view->frame)->xi2_version < 1) -#endif { - GdkEvent *xg_event = gdk_event_new (GDK_SCROLL); - struct xwidget *model = XXWIDGET (view->model); - GtkWidget *target; - - x += view->clip_left; - y += view->clip_top; - - target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y); - - if (!target) - target = model->widget_osr; - - xg_event->any.window = gtk_widget_get_window (target); - g_object_ref (xg_event->any.window); /* The window will be unrefed - later by gdk_event_free. */ - if (button == 4) - xg_event->scroll.direction = GDK_SCROLL_UP; - else if (button == 5) - xg_event->scroll.direction = GDK_SCROLL_DOWN; - else if (button == 6) - xg_event->scroll.direction = GDK_SCROLL_LEFT; - else - xg_event->scroll.direction = GDK_SCROLL_RIGHT; + if (!down_p) + { + GdkEvent *xg_event = gdk_event_new (GDK_SCROLL); + struct xwidget *model = XXWIDGET (view->model); + GtkWidget *target; + + x += view->clip_left; + y += view->clip_top; + + target = find_widget_at_pos (model->widgetwindow_osr, x, y, &x, &y, + true, view); + + if (!target) + target = model->widget_osr; + + xg_event->any.window = gtk_widget_get_window (target); + g_object_ref (xg_event->any.window); /* The window will be unrefed + later by gdk_event_free. */ + if (button == 4) + xg_event->scroll.direction = GDK_SCROLL_UP; + else if (button == 5) + xg_event->scroll.direction = GDK_SCROLL_DOWN; + else if (button == 6) + xg_event->scroll.direction = GDK_SCROLL_LEFT; + else + xg_event->scroll.direction = GDK_SCROLL_RIGHT; - xg_event->scroll.device = find_suitable_pointer (view->frame); + xg_event->scroll.device = find_suitable_pointer (view->frame); - xg_event->scroll.x = x; - xg_event->scroll.x_root = x; - xg_event->scroll.y = y; - xg_event->scroll.y_root = y; - xg_event->scroll.state = modifier_state; - xg_event->scroll.time = time; + xg_event->scroll.x = x; + xg_event->scroll.x_root = x; + xg_event->scroll.y = y; + xg_event->scroll.y_root = y; + xg_event->scroll.state = modifier_state; + xg_event->scroll.time = time; - xg_event->scroll.delta_x = 0; - xg_event->scroll.delta_y = 0; + xg_event->scroll.delta_x = 0; + xg_event->scroll.delta_y = 0; - gtk_main_do_event (xg_event); - gdk_event_free (xg_event); + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } } } @@ -1218,14 +1361,23 @@ xwidget_motion_notify (struct xwidget_view *view, target = find_widget_at_pos (model->widgetwindow_osr, lrint (x + view->clip_left), lrint (y + view->clip_top), - &target_x, &target_y); + &target_x, &target_y, + true, view); if (!target) { - target_x = lrint (x); - target_y = lrint (y); + target_x = lrint (x + view->clip_left); + target_y = lrint (y + view->clip_top); target = model->widget_osr; } + else if (xw_maybe_synthesize_crossing (view, gtk_widget_get_window (target), + x + view->clip_left, y + view->clip_top, + XW_CROSSING_NONE, time, state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + return; xg_event = gdk_event_new (GDK_MOTION_NOTIFY); xg_event->any.window = gtk_widget_get_window (target); @@ -1261,7 +1413,8 @@ xwidget_scroll (struct xwidget_view *view, double x, double y, target = find_widget_at_pos (model->widgetwindow_osr, lrint (x + view->clip_left), lrint (y + view->clip_top), - &target_x, &target_y); + &target_x, &target_y, + true, view); if (!target) { @@ -1310,7 +1463,8 @@ xwidget_pinch (struct xwidget_view *view, XIGesturePinchEvent *xev) target = find_widget_at_pos (model->widgetwindow_osr, lrint (x + view->clip_left), lrint (y + view->clip_top), - &target_x, &target_y); + &target_x, &target_y, + true, view); if (!target) { @@ -1377,13 +1531,374 @@ xi_translate_notify_detail (int detail) } #endif +static void +window_coords_from_toplevel (GdkWindow *window, GdkWindow *toplevel, + int x, int y, int *out_x, int *out_y) +{ + GdkWindow *parent; + GList *children, *l; + gdouble x_out, y_out; + + if (window == toplevel) + { + *out_x = x; + *out_y = y; + return; + } + + children = NULL; + while ((parent = gdk_window_get_parent (window)) != toplevel) + { + children = g_list_prepend (children, window); + window = parent; + } + + for (l = children; l != NULL; l = l->next) + gdk_window_coords_from_parent (l->data, x, y, &x_out, &y_out); + + g_list_free (children); + + *out_x = x_out; + *out_y = y_out; +} + +static GdkWindow * +xw_find_common_ancestor (GdkWindow *window, + GdkWindow *other, + GdkWindow *toplevel) +{ + GdkWindow *tem; + GList *l1 = NULL; + GList *l2 = NULL; + GList *i1, *i2; + + tem = window; + while (tem && tem != toplevel) + { + l1 = g_list_prepend (l1, tem); + tem = gdk_window_get_parent (tem); + } + + tem = other; + while (tem && tem != toplevel) + { + l2 = g_list_prepend (l2, tem); + tem = gdk_window_get_parent (tem); + } + + tem = NULL; + i1 = l1; + i2 = l2; + + while (i1 && i2 && (i1->data == i2->data)) + { + tem = i1->data; + i1 = i1->next; + i2 = i2->next; + } + + g_list_free (l1); + g_list_free (l2); + + return tem; +} + +static void +xw_notify_virtual_upwards_until (struct xwidget_view *xv, + GdkWindow *window, + GdkWindow *until, + GdkWindow *toplevel, + unsigned int state, + int x, int y, Time time, + GdkEventType type, + bool nonlinear_p, + GdkCrossingMode crossing) +{ + GdkEvent *xg_event; + GdkWindow *tem; + int cx, cy; + + for (tem = gdk_window_get_parent (window); + tem && (tem != until); + tem = gdk_window_get_parent (tem)) + { + xg_event = gdk_event_new (type); + + gdk_event_set_device (xg_event, find_suitable_pointer (xv->frame)); + window_coords_from_toplevel (tem, toplevel, x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR_VIRTUAL + : GDK_NOTIFY_VIRTUAL); + xg_event->crossing.mode = crossing; + xg_event->crossing.window = g_object_ref (tem); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } +} + +static void +xw_notify_virtual_downwards_until (struct xwidget_view *xv, + GdkWindow *window, + GdkWindow *until, + GdkWindow *toplevel, + unsigned int state, + int x, int y, Time time, + GdkEventType type, + bool nonlinear_p, + GdkCrossingMode crossing) +{ + GdkEvent *xg_event; + GdkWindow *tem; + int cx, cy; + GList *path = NULL, *it; + + tem = gdk_window_get_parent (window); + + while (tem && tem != until) + { + path = g_list_prepend (path, tem); + tem = gdk_window_get_parent (tem); + } + + for (it = path; it; it = it->next) + { + tem = it->data; + xg_event = gdk_event_new (type); + + gdk_event_set_device (xg_event, find_suitable_pointer (xv->frame)); + window_coords_from_toplevel (tem, toplevel, x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR_VIRTUAL + : GDK_NOTIFY_VIRTUAL); + xg_event->crossing.mode = crossing; + xg_event->crossing.window = g_object_ref (tem); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + } + + g_list_free (path); +} + +static void +xw_update_cursor_for_view (struct xwidget_view *xv, + GdkWindow *crossing_window) +{ + GdkCursor *xg_cursor; + Cursor cursor; + + xg_cursor = gdk_window_get_cursor (crossing_window); + + if (xg_cursor) + { + cursor = gdk_x11_cursor_get_xcursor (xg_cursor); + + if (gdk_x11_cursor_get_xdisplay (xg_cursor) == xv->dpy) + xv->cursor = cursor; + } + else + xv->cursor = FRAME_OUTPUT_DATA (xv->frame)->nontext_cursor; + + if (xv->wdesc != None) + XDefineCursor (xv->dpy, xv->wdesc, xv->cursor); +} + +static void +xw_last_crossing_cursor_cb (GdkWindow *window, + GParamSpec *spec, + gpointer user_data) +{ + xw_update_cursor_for_view (user_data, window); +} + +static bool +xw_maybe_synthesize_crossing (struct xwidget_view *view, + GdkWindow *current_window, + int x, int y, int crossing, + Time time, unsigned int state, + GdkCrossingMode entry_crossing, + GdkCrossingMode exit_crossing) +{ + GdkWindow *last_crossing, *toplevel, *ancestor; + GdkEvent *xg_event; + int cx, cy; + bool nonlinear_p; + bool retention_flag; + +#if WEBKIT_CHECK_VERSION (2, 34, 0) + /* Work around a silly bug in WebKitGTK+ that tries to make tooltip + windows transient for our offscreen window. */ + int tooltip_width, tooltip_height; + + xg_prepare_tooltip (view->frame, dummy_tooltip_string, + &tooltip_width, &tooltip_height); +#endif + + toplevel = gtk_widget_get_window (XXWIDGET (view->model)->widgetwindow_osr); + retention_flag = false; + + if (crossing == XW_CROSSING_LEFT + && (view->last_crossing_window + && !gdk_window_is_destroyed (view->last_crossing_window))) + { + xw_notify_virtual_upwards_until (view, view->last_crossing_window, + toplevel, toplevel, + state, x, y, time, + GDK_LEAVE_NOTIFY, false, + exit_crossing); + } + + if (view->last_crossing_window + && (gdk_window_is_destroyed (view->last_crossing_window) + || crossing == XW_CROSSING_LEFT)) + { + if (!gdk_window_is_destroyed (view->last_crossing_window) + && view->last_crossing_window != toplevel) + { + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + window_coords_from_toplevel (view->last_crossing_window, + toplevel, x, y, &cx, &cy); + + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.detail = GDK_NOTIFY_ANCESTOR; + xg_event->crossing.mode = exit_crossing; + xg_event->crossing.window = g_object_ref (view->last_crossing_window); + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + + xw_notify_virtual_upwards_until (view, view->last_crossing_window, + gdk_window_get_parent (toplevel), + toplevel, state, x, y, time, + GDK_LEAVE_NOTIFY, false, exit_crossing); + retention_flag = true; + } + + g_signal_handler_disconnect (view->last_crossing_window, + view->last_crossing_cursor_signal); + g_clear_pointer (&view->last_crossing_window, + g_object_unref); + } + last_crossing = view->last_crossing_window; + + if (!last_crossing) + { + if (current_window) + { + view->last_crossing_window = g_object_ref (current_window); + xw_update_cursor_for_view (view, current_window); + view->last_crossing_cursor_signal + = g_signal_connect (G_OBJECT (current_window), "notify::cursor", + G_CALLBACK (xw_last_crossing_cursor_cb), view); + + xw_notify_virtual_downwards_until (view, current_window, + toplevel, toplevel, + state, x, y, time, + GDK_ENTER_NOTIFY, + false, entry_crossing); + } + return retention_flag; + } + + if (last_crossing != current_window) + { + view->last_crossing_window = g_object_ref (current_window); + g_signal_handler_disconnect (last_crossing, view->last_crossing_cursor_signal); + + xw_update_cursor_for_view (view, current_window); + view->last_crossing_cursor_signal + = g_signal_connect (G_OBJECT (current_window), "notify::cursor", + G_CALLBACK (xw_last_crossing_cursor_cb), view); + + ancestor = xw_find_common_ancestor (last_crossing, current_window, toplevel); + + if (!ancestor) + emacs_abort (); + + nonlinear_p = (last_crossing != ancestor) && (current_window != ancestor); + + if (nonlinear_p || (last_crossing != ancestor)) + xw_notify_virtual_upwards_until (view, last_crossing, + ancestor, toplevel, + state, x, y, time, + GDK_LEAVE_NOTIFY, + nonlinear_p, + exit_crossing); + + xg_event = gdk_event_new (GDK_LEAVE_NOTIFY); + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + window_coords_from_toplevel (last_crossing, toplevel, + x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.state = state; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR + : (last_crossing == ancestor + ? GDK_NOTIFY_INFERIOR + : GDK_NOTIFY_ANCESTOR)); + xg_event->crossing.mode = exit_crossing; + xg_event->crossing.window = g_object_ref (last_crossing); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + + if (nonlinear_p || (current_window != ancestor)) + xw_notify_virtual_downwards_until (view, current_window, + ancestor, toplevel, + state, x, y, time, + GDK_ENTER_NOTIFY, + nonlinear_p, + entry_crossing); + + xg_event = gdk_event_new (GDK_ENTER_NOTIFY); + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); + window_coords_from_toplevel (current_window, toplevel, + x, y, &cx, &cy); + xg_event->crossing.x = cx; + xg_event->crossing.y = cy; + xg_event->crossing.time = time; + xg_event->crossing.focus = FALSE; + xg_event->crossing.state = state; + xg_event->crossing.detail = (nonlinear_p + ? GDK_NOTIFY_NONLINEAR + : (current_window == ancestor + ? GDK_NOTIFY_INFERIOR + : GDK_NOTIFY_ANCESTOR)); + xg_event->crossing.mode = entry_crossing; + xg_event->crossing.window = g_object_ref (current_window); + + gtk_main_do_event (xg_event); + gdk_event_free (xg_event); + g_object_unref (last_crossing); + + return true; + } + + return false; +} + void xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) { GdkEvent *xg_event; struct xwidget *model = XXWIDGET (view->model); - int x; - int y; + int x, y, toplevel_x, toplevel_y; GtkWidget *target; #ifdef HAVE_XINPUT2 XIEnterEvent *xev = NULL; @@ -1401,14 +1916,15 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) : (event->type == LeaveNotify ? GDK_LEAVE_NOTIFY : GDK_ENTER_NOTIFY)); + toplevel_x = (event->type == MotionNotify + ? event->xmotion.x + view->clip_left + : event->xcrossing.x + view->clip_left); + toplevel_y = (event->type == MotionNotify + ? event->xmotion.y + view->clip_top + : event->xcrossing.y + view->clip_top); target = find_widget_at_pos (model->widgetwindow_osr, - (event->type == MotionNotify - ? event->xmotion.x + view->clip_left - : event->xcrossing.x + view->clip_left), - (event->type == MotionNotify - ? event->xmotion.y + view->clip_top - : event->xcrossing.y + view->clip_top), - &x, &y); + toplevel_x, toplevel_y, &x, &y, + true, view); } #ifdef HAVE_XINPUT2 else @@ -1421,9 +1937,11 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) ? GDK_ENTER_NOTIFY : GDK_LEAVE_NOTIFY); target = find_widget_at_pos (model->widgetwindow_osr, - lrint (xev->event_x + view->clip_left), - lrint (xev->event_y + view->clip_top), - &x, &y); + (toplevel_x + = lrint (xev->event_x + view->clip_left)), + (toplevel_y + = lrint (xev->event_y + view->clip_top)), + &x, &y, true, view); } #endif @@ -1437,13 +1955,28 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) if (event->type == MotionNotify) { - xg_event->motion.x = x; - xg_event->motion.y = y; - xg_event->motion.x_root = event->xmotion.x_root; - xg_event->motion.y_root = event->xmotion.y_root; - xg_event->motion.time = event->xmotion.time; - xg_event->motion.state = event->xmotion.state; - xg_event->motion.device = find_suitable_pointer (view->frame); + if (!xw_maybe_synthesize_crossing (view, xg_event->any.window, + toplevel_x, toplevel_y, + XW_CROSSING_NONE, event->xmotion.time, + event->xmotion.state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + { + xg_event->motion.x = x; + xg_event->motion.y = y; + xg_event->motion.x_root = event->xmotion.x_root; + xg_event->motion.y_root = event->xmotion.y_root; + xg_event->motion.time = event->xmotion.time; + xg_event->motion.state = event->xmotion.state; + xg_event->motion.device = find_suitable_pointer (view->frame); + } + else + { + gdk_event_free (xg_event); + return; + } } #ifdef HAVE_XINPUT2 else if (event->type == GenericEvent) @@ -1468,11 +2001,44 @@ xwidget_motion_or_crossing (struct xwidget_view *view, const XEvent *event) xg_event->crossing.state |= GDK_BUTTON3_MASK; } + if (view->passive_grab + || xw_maybe_synthesize_crossing (view, xg_event->any.window, + toplevel_x, toplevel_y, + (xev->type == XI_Enter + ? XW_CROSSING_ENTERED + : XW_CROSSING_LEFT), + xev->time, xg_event->crossing.state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + { + gdk_event_free (xg_event); + return; + } + gdk_event_set_device (xg_event, find_suitable_pointer (view->frame)); } #endif else { + if (view->passive_grab + || xw_maybe_synthesize_crossing (view, xg_event->any.window, + toplevel_x, toplevel_y, + (event->type == EnterNotify + ? XW_CROSSING_ENTERED + : XW_CROSSING_LEFT), + event->xcrossing.time, + event->xcrossing.state, + (view->passive_grab + ? GDK_CROSSING_GRAB + : GDK_CROSSING_NORMAL), + GDK_CROSSING_NORMAL)) + { + gdk_event_free (xg_event); + return; + } + xg_event->crossing.detail = min (5, event->xcrossing.detail); xg_event->crossing.time = event->xcrossing.time; xg_event->crossing.x = x; @@ -2133,8 +2699,10 @@ xwidget_init_view (struct xwidget *xww, xv->wdesc = None; xv->frame = s->f; - xv->cursor = cursor_for_hit (xww->hit_result, s->f); + xv->cursor = FRAME_OUTPUT_DATA (s->f)->nontext_cursor; xv->just_resized = false; + xv->last_crossing_window = NULL; + xv->passive_grab = NULL; #elif defined HAVE_PGTK xv->dpyinfo = FRAME_DISPLAY_INFO (s->f); xv->widget = gtk_drawing_area_new (); @@ -2285,7 +2853,7 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) XISetMask (m, XI_ButtonRelease); XISetMask (m, XI_Enter); XISetMask (m, XI_Leave); -#ifdef XI_GesturePinchBegin +#ifdef HAVE_XINPUT2_4 if (FRAME_DISPLAY_INFO (s->f)->xi2_version >= 4) { XISetMask (m, XI_GesturePinchBegin); @@ -2407,8 +2975,11 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) #endif #if defined HAVE_XINPUT2 || defined HAVE_PGTK - record_osr_embedder (xv); - synthesize_focus_in_event (xww->widget_osr); + if (!NILP (xww->buffer)) + { + record_osr_embedder (xv); + synthesize_focus_in_event (xww->widget_osr); + } #endif #ifdef USE_GTK @@ -2757,6 +3328,22 @@ DEFUN ("delete-xwidget-view", XDestroyWindow (xv->dpy, xv->wdesc); Fremhash (make_fixnum (xv->wdesc), x_window_to_xwv_map); } + + if (xv->last_crossing_window) + g_signal_handler_disconnect (xv->last_crossing_window, + xv->last_crossing_cursor_signal); + g_clear_pointer (&xv->last_crossing_window, + g_object_unref); + + if (xv->passive_grab) + { + g_signal_handler_disconnect (xv->passive_grab, + xv->passive_grab_destruction_signal); + g_signal_handler_disconnect (xv->passive_grab, + xv->passive_grab_drag_signal); + xv->passive_grab = NULL; + } + #else gtk_widget_destroy (xv->widget); #endif @@ -3356,6 +3943,11 @@ syms_of_xwidget (void) x_window_to_xwv_map = CALLN (Fmake_hash_table, QCtest, Qeq); staticpro (&x_window_to_xwv_map); + +#if WEBKIT_CHECK_VERSION (2, 34, 0) + dummy_tooltip_string = build_string (""); + staticpro (&dummy_tooltip_string); +#endif #endif } diff --git a/src/xwidget.h b/src/xwidget.h index ee74e53c4d1..be1460ede5b 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -118,6 +118,12 @@ struct xwidget_view #ifndef HAVE_PGTK Display *dpy; Window wdesc; + + GdkWindow *last_crossing_window; + guint last_crossing_cursor_signal; + GtkWidget *passive_grab; + guint passive_grab_destruction_signal; + guint passive_grab_drag_signal; #else struct pgtk_display_info *dpyinfo; GtkWidget *widget; diff --git a/test/Makefile.in b/test/Makefile.in index 9ad994e1101..708c4b2fb0f 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -53,15 +53,6 @@ REPLACE_FREE = @REPLACE_FREE@ -include ${top_builddir}/src/verbose.mk -# Load any GNU ELPA dependencies that are present, for optional tests. -GNU_ELPA_DIRECTORY ?= $(srcdir)/../../elpa -# Keep elpa_dependencies dependency-ordered. -elpa_dependencies = \ - url-http-ntlm/url-http-ntlm.el \ - web-server/web-server.el -elpa_els = $(addprefix $(GNU_ELPA_DIRECTORY)/packages/,$(elpa_dependencies)) -elpa_opts = $(foreach el,$(elpa_els),$(and $(wildcard $(el)),-L $(dir $(el)) -l $(el))) - # We never change directory before running Emacs, so a relative file # name is fine, and makes life easier. If we need to change # directory, we can use emacs --chdir. @@ -72,7 +63,7 @@ EMACS_EXTRAOPT = # Command line flags for Emacs. # Apparently MSYS bash would convert "-L :" to "-L ;" anyway, # but we might as well be explicit. -EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(elpa_opts) $(EMACS_EXTRAOPT) +EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT) # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH GREP_OPTIONS XDG_CONFIG_HOME @@ -101,7 +92,7 @@ export TEST_LOAD_EL ?= \ $(if $(findstring $(MAKECMDGOALS), all check check-maybe),no,yes) # Additional settings for ert. -ert_opts += $(elpa_opts) +ert_opts = # Maximum length of lines in ert backtraces; nil for no limit. # (if empty, use the default ert-batch-backtrace-right-margin). @@ -243,7 +234,7 @@ define test_template .PHONY: $(1) $(notdir $(1)) $(1): @test ! -f $(1).log || mv $(1).log $(1).log~ - @$(MAKE) $(1).log WRITE_LOG= + +@$(MAKE) $(1).log WRITE_LOG= $(notdir $(1)): $(1) endef diff --git a/test/README b/test/README index 2ab34ba20ee..3d865de78b4 100644 --- a/test/README +++ b/test/README @@ -126,12 +126,6 @@ to a suitable value in order to overwrite the default value: env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... -Some optional tests require packages from GNU ELPA. By default -../../elpa will be checked for these packages. If GNU ELPA is checked -out somewhere else, use - - make GNU_ELPA_DIRECTORY=/path/to/elpa ... - There are also continuous integration tests on <https://hydra.nixos.org/jobset/gnu/emacs-trunk> (see diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index 394eae48ee3..947178473e4 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -301,6 +301,10 @@ (inverse-add-abbrev table "Global" -1))) (should (string= (abbrev-expansion "text" table) "bar")))) +(ert-deftest test-abbrev-table-p () + (should-not (abbrev-table-p translation-table-vector)) + (should (abbrev-table-p (make-abbrev-table)))) + (provide 'abbrev-tests) ;;; abbrev-tests.el ends here diff --git a/test/lisp/ansi-color-tests.el b/test/lisp/ansi-color-tests.el index 71b706c763f..2ff7fc6aaf6 100644 --- a/test/lisp/ansi-color-tests.el +++ b/test/lisp/ansi-color-tests.el @@ -171,7 +171,25 @@ strings with `eq', this function compares them with `equal'." (insert str) (ansi-color-apply-on-region opoint (point)))) (should (ansi-color-tests-equal-props - propertized-str (buffer-string)))))) + propertized-str (buffer-string)))) + + ;; \e not followed by '[' and invalid ANSI escape seqences + (dolist (fun (list ansi-filt ansi-app)) + (with-temp-buffer + (should (equal (funcall fun "\e") "")) + (should (equal (funcall fun "\e[33m test \e[0m") + (with-temp-buffer + (concat "\e" (funcall fun "\e[33m test \e[0m")))))) + (with-temp-buffer + (should (equal (funcall fun "\e[") "")) + (should (equal (funcall fun "\e[33m Z \e[0m") + (with-temp-buffer + (concat "\e[" (funcall fun "\e[33m Z \e[0m")))))) + (with-temp-buffer + (should (equal (funcall fun "\e a \e\e[\e[") "\e a \e\e[")) + (should (equal (funcall fun "\e[33m Z \e[0m") + (with-temp-buffer + (concat "\e[" (funcall fun "\e[33m Z \e[0m"))))))))) (provide 'ansi-color-tests) diff --git a/test/lisp/cedet/semantic/bovine/gcc-tests.el b/test/lisp/cedet/semantic/bovine/gcc-tests.el index 2e61f91e58c..041773a0c80 100644 --- a/test/lisp/cedet/semantic/bovine/gcc-tests.el +++ b/test/lisp/cedet/semantic/bovine/gcc-tests.el @@ -26,6 +26,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'semantic/bovine/gcc) ;;; From bovine-gcc: @@ -122,14 +123,9 @@ gcc version 2.95.2 19991024 (release)" (ert-deftest semantic-gcc-test-output-parser-this-machine () "Test the output parser against the machine currently running Emacs." - (skip-unless (executable-find "gcc")) + (skip-unless (and (executable-find "gcc") + (not (ert-gcc-is-clang-p)))) (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v")))) - ;; Some macOS machines run llvm when you type gcc. (!) - ;; We can't even check if it's a symlink; it's a binary placed in - ;; "/usr/bin/gcc". So check the output and just skip this test if - ;; it looks like that's the case. - (unless (string-match "Apple \\(LLVM\\|clang\\)\\|Xcode\\.app" - (car semantic-gcc-test-strings)) - (semantic-gcc-test-output-parser)))) + (semantic-gcc-test-output-parser))) ;;; gcc-tests.el ends here diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 01a1407dcaa..0ef5168109b 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -76,5 +76,14 @@ (customize-saved) (should (search-forward cus-edit-tests--obsolete-option-tag nil t))))) +(defcustom cus-edit-test-foo1 0 + "" + :type 'number) + +(ert-deftest test-setopt () + (should (= (setopt cus-edit-test-foo1 1) 1)) + (should (= cus-edit-test-foo1 1)) + (should-error (setopt cus-edit-test-foo1 :foo))) + (provide 'cus-edit-tests) ;;; cus-edit-tests.el ends here diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index e10ed04f9d3..5d7e905cfa3 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -79,7 +79,7 @@ (should (equal (point) expected-point)))) -(eval-when-compile +(eval-and-compile (defun electric-pair-define-test-form (name fixture char pos diff --git a/test/lisp/emacs-lisp/copyright-tests.el b/test/lisp/emacs-lisp/copyright-tests.el index dc82974a99e..b00d697aa64 100644 --- a/test/lisp/emacs-lisp/copyright-tests.el +++ b/test/lisp/emacs-lisp/copyright-tests.el @@ -50,5 +50,47 @@ (dolist (test copyright-tests--data) (with-copyright-test (car test) (cdr test)))) +(ert-deftest test-end-chop () + (should + (equal + (with-temp-buffer + (let ((copyright-query nil)) + (insert (make-string (- copyright-limit 14) ?x) "\n" + "\nCopyright 2006, 2007, 2008 Foo Bar\n\n") + (copyright-update) + (buffer-substring (- (point-max) 42) (point-max)))) + "Copyright 2006, 2007, 2008, 2022 Foo Bar\n\n"))) + +(ert-deftest test-correct-notice () + (should (equal + (with-temp-buffer + (dotimes (_ 2) + (insert "Copyright 2021 FSF\n")) + (let ((copyright-at-end-flag t) + (copyright-query nil)) + (copyright-update)) + (buffer-string)) + "Copyright 2021 FSF\nCopyright 2021, 2022 FSF\n"))) + +(defmacro with-copyright-fix-years-test (orig result) + `(let ((copyright-year-ranges t)) + (with-temp-buffer + (insert ,orig) + (copyright-fix-years) + (should (equal (buffer-string) ,result))))) + +(defvar copyright-fix-years-tests--data + '((";; Copyright (C) 2008, 2010, 2012" + . ";; Copyright (C) 2008, 2010, 2012") + (";; Copyright (C) 2008, 2009, 2010, 2013, 2014, 2015, 2016, 2018" + . ";; Copyright (C) 2008-2010, 2013-2016, 2018") + (";; Copyright (C) 2008-2010, 2011, 2015, 2016, 2017" + . ";; Copyright (C) 2008-2010, 2011, 2015-2017"))) + +(ert-deftest text-copyright-fix-years () + "Test basics of \\[copyright-fix-years]." + (dolist (test copyright-fix-years-tests--data) + (with-copyright-fix-years-test (car test) (cdr test)))) + (provide 'copyright-tests) ;;; copyright-tests.el ends here diff --git a/test/lisp/emacs-lisp/derived-tests.el b/test/lisp/emacs-lisp/derived-tests.el index 0589819ccc1..547b16843d4 100644 --- a/test/lisp/emacs-lisp/derived-tests.el +++ b/test/lisp/emacs-lisp/derived-tests.el @@ -40,6 +40,9 @@ (derived-tests--child-mode) (should (equal (buffer-string) "PB CB MH AFP=S AFC=S "))))) +(declare-function mode-a "derived-tests") +(declare-function mode-b "derived-tests") +(declare-function mode-c "derived-tests") (ert-deftest test-add-font-lock () (define-derived-mode mode-a fundamental-mode "mode-a" (font-lock-add-keywords nil `(("a" 0 'font-lock-keyword-face)))) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 270cca1c2e7..dd12e3764ce 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -865,7 +865,7 @@ This macro is used to test if macroexpansion in `should' works." (ert-deftest ert-test-with-demoted-errors () "Check that ERT correctly handles `with-demoted-errors'." :expected-result :failed ;; FIXME! Bug#11218 - (should-not (with-demoted-errors (error "Foo")))) + (should-not (with-demoted-errors "FOO: %S" (error "Foo")))) (ert-deftest ert-test-fail-inside-should () "Check that `ert-fail' inside `should' works correctly." diff --git a/test/lisp/emacs-lisp/range-tests.el b/test/lisp/emacs-lisp/range-tests.el index d3abbf9da31..660110aa1fb 100644 --- a/test/lisp/emacs-lisp/range-tests.el +++ b/test/lisp/emacs-lisp/range-tests.el @@ -1,6 +1,6 @@ ;;; range-tests.el --- Tests for range.el -*- lexical-binding: t; -*- -;; Copyright (C) 2021 Free Software Foundation, Inc. +;; Copyright (C) 2021-2022 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/lisp/emacs-lisp/vtable-tests.el b/test/lisp/emacs-lisp/vtable-tests.el new file mode 100644 index 00000000000..627d9f9c5df --- /dev/null +++ b/test/lisp/emacs-lisp/vtable-tests.el @@ -0,0 +1,42 @@ +;;; vtable-tests.el --- Tests for vtable.el -*- 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: + +;; + +;;; Code: + +(require 'vtable) +(require 'ert) +(require 'ert-x) + +(ert-deftest test-vstable-compute-columns () + (should + (equal (mapcar + (lambda (column) + (vtable-column-align column)) + (vtable--compute-columns + (make-vtable :columns '("a" "b" "c") + :objects '(("foo" 1 2) + ("bar" 3 :zot)) + :insert nil))) + '(left right left)))) + +;;; vtable-tests.el ends here diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index 1283b6b361f..a1d15fe73a4 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -28,14 +28,10 @@ (require 'ert) (require 'ert-x) (require 'em-extpipe) -(eval-and-compile - (load (expand-file-name "eshell-tests-helpers" - (file-name-directory (or load-file-name - default-directory))))) - -(defvar eshell-history-file-name) -(defvar eshell-test--max-subprocess-time) -(declare-function eshell-command-result-p "eshell-tests-helpers") +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) (defmacro em-extpipe-tests--deftest (name input &rest body) (declare (indent 2)) @@ -202,4 +198,8 @@ (eshell-command-result-p input "rab") (eshell-command-result-p "echo \"bar\" | rev" "nonsense")))) +;; Confirm we don't break input of sharp-quoted symbols (Bug#53518). +(em-extpipe-tests--deftest em-extpipe-test-17 "funcall #'upcase foo" + (eshell-command-result-p input "FOO")) + ;;; em-extpipe-tests.el ends here diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el new file mode 100644 index 00000000000..8969c1e2294 --- /dev/null +++ b/test/lisp/eshell/em-tramp-tests.el @@ -0,0 +1,88 @@ +;;; em-tramp-tests.el --- em-tramp 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/>. + +;;; Code: + +(require 'ert) +(require 'em-tramp) +(require 'tramp) + +(ert-deftest em-tramp-test/su-default () + "Test Eshell `su' command with no arguments." + (should (equal + (catch 'eshell-replace-command (eshell/su)) + `(eshell-trap-errors + (eshell-named-command + "cd" + (list ,(format "/su:root@%s:%s" + tramp-default-host default-directory))))))) + +(ert-deftest em-tramp-test/su-user () + "Test Eshell `su' command with USER argument." + (should (equal + (catch 'eshell-replace-command (eshell/su "USER")) + `(eshell-trap-errors + (eshell-named-command + "cd" + (list ,(format "/su:USER@%s:%s" + tramp-default-host default-directory))))))) + +(ert-deftest em-tramp-test/su-login () + "Test Eshell `su' command with -/-l/--login option." + (dolist (args '(("--login") + ("-l") + ("-"))) + (should (equal + (catch 'eshell-replace-command (apply #'eshell/su args)) + `(eshell-trap-errors + (eshell-named-command + "cd" + (list ,(format "/su:root@%s:~/" tramp-default-host)))))))) + +(defun mock-eshell-named-command (&rest args) + "Dummy function to test Eshell `sudo' command rewriting." + (list default-directory args)) + +(ert-deftest em-tramp-test/sudo-basic () + "Test Eshell `sudo' command with default user." + (cl-letf (((symbol-function 'eshell-named-command) + #'mock-eshell-named-command)) + (should (equal + (catch 'eshell-external (eshell/sudo "echo" "hi")) + `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) + ("echo" ("hi"))))) + (should (equal + (catch 'eshell-external (eshell/sudo "echo" "-u" "hi")) + `(,(format "/sudo:root@%s:%s" tramp-default-host default-directory) + ("echo" ("-u" "hi"))))))) + +(ert-deftest em-tramp-test/sudo-user () + "Test Eshell `sudo' command with specified user." + (cl-letf (((symbol-function 'eshell-named-command) + #'mock-eshell-named-command)) + (should (equal + (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "hi")) + `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) + ("echo" ("hi"))))) + (should (equal + (catch 'eshell-external (eshell/sudo "-u" "USER" "echo" "-u" "hi")) + `(,(format "/sudo:USER@%s:%s" tramp-default-host default-directory) + ("echo" ("-u" "hi"))))))) + +;;; em-tramp-tests.el ends here diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el index b76ed8866df..5b30de414a3 100644 --- a/test/lisp/eshell/esh-opt-tests.el +++ b/test/lisp/eshell/esh-opt-tests.el @@ -22,8 +22,8 @@ (require 'ert) (require 'esh-opt) -(ert-deftest esh-opt-process-args-test () - "Unit tests which verify correct behavior of `eshell--process-args'." +(ert-deftest esh-opt-test/process-args () + "Test behavior of `eshell--process-args'." (should (equal '(t) (eshell--process-args @@ -35,7 +35,10 @@ (eshell--process-args "sudo" '("-u" "root" "world") '((?u "user" t user - "execute a command as another USER"))))) + "execute a command as another USER")))))) + +(ert-deftest esh-opt-test/process-args-parse-leading-options-only () + "Test behavior of :parse-leading-options-only in `eshell--process-args'." (should (equal '(nil "emerge" "-uDN" "world") (eshell--process-args @@ -55,9 +58,10 @@ (eshell--process-args "sudo" '("-u" "root" "emerge" "-uDN" "world") '((?u "user" t user - "execute a command as another USER"))))) + "execute a command as another USER")))))) - ;; Test :external. +(ert-deftest esh-opt-test/process-args-external () + "Test behavior of :external in `eshell--process-args'." (cl-letf (((symbol-function 'eshell-search-path) #'ignore)) (should (equal '(nil "/some/path") @@ -85,9 +89,8 @@ :external "ls")) :type 'error))) -(ert-deftest test-eshell-eval-using-options () - "Tests for `eshell-eval-using-options'." - ;; Test short options. +(ert-deftest esh-opt-test/eval-using-options-short () + "Test `eshell-eval-using-options' with short options." (eshell-eval-using-options "ls" '("-a" "/some/path") '((?a "all" nil show-all @@ -99,17 +102,19 @@ '((?a "all" nil show-all "do not ignore entries starting with .")) (should (eq show-all nil)) - (should (equal args '("/some/path")))) + (should (equal args '("/some/path"))))) - ;; Test long options. +(ert-deftest esh-opt-test/eval-using-options-long () + "Test `eshell-eval-using-options' with long options." (eshell-eval-using-options "ls" '("--all" "/some/path") '((?a "all" nil show-all "do not ignore entries starting with .")) (should (eq show-all t)) - (should (equal args '("/some/path")))) + (should (equal args '("/some/path"))))) - ;; Test options with constant values. +(ert-deftest esh-opt-test/eval-using-options-constant () + "Test `eshell-eval-using-options' with options with constant values." (eshell-eval-using-options "ls" '("/some/path" "-h") '((?h "human-readable" 1024 human-readable @@ -127,9 +132,10 @@ '((?h "human-readable" 1024 human-readable "print sizes in human readable format")) (should (eq human-readable nil)) - (should (equal args '("/some/path")))) + (should (equal args '("/some/path"))))) - ;; Test options with user-specified values. +(ert-deftest esh-opt-test/eval-using-options-user-specified () + "Test `eshell-eval-using-options' with options with user-specified values." (eshell-eval-using-options "ls" '("-I" "*.txt" "/some/path") '((?I "ignore" t ignore-pattern @@ -153,9 +159,10 @@ '((?I "ignore" t ignore-pattern "do not list implied entries matching pattern")) (should (equal ignore-pattern "*.txt")) - (should (equal args '("/some/path")))) + (should (equal args '("/some/path"))))) - ;; Test multiple short options in a single token. +(ert-deftest esh-opt-test/eval-using-options-short-single-token () + "Test `eshell-eval-using-options' with multiple short options in one token." (eshell-eval-using-options "ls" '("-al" "/some/path") '((?a "all" nil show-all @@ -173,9 +180,31 @@ "do not list implied entries matching pattern")) (should (eq t show-all)) (should (equal ignore-pattern "*.txt")) - (should (equal args '("/some/path")))) + (should (equal args '("/some/path"))))) + +(ert-deftest esh-opt-test/eval-using-options-stdin () + "Test that \"-\" is a positional arg in `eshell-eval-using-options'." + (eshell-eval-using-options + "cat" '("-") + '((?A "show-all" nil show-all + "show all characters")) + (should (eq show-all nil)) + (should (equal args '("-")))) + (eshell-eval-using-options + "cat" '("-A" "-") + '((?A "show-all" nil show-all + "show all characters")) + (should (eq show-all t)) + (should (equal args '("-")))) + (eshell-eval-using-options + "cat" '("-" "-A") + '((?A "show-all" nil show-all + "show all characters")) + (should (eq show-all t)) + (should (equal args '("-"))))) - ;; Test that "--" terminates options. +(ert-deftest esh-opt-test/eval-using-options-terminate-options () + "Test that \"--\" terminates options in `eshell-eval-using-options'." (eshell-eval-using-options "ls" '("--" "-a") '((?a "all" nil show-all @@ -187,9 +216,10 @@ '((?a "all" nil show-all "do not ignore entries starting with .")) (should (eq show-all nil)) - (should (equal args '("--all")))) + (should (equal args '("--all"))))) - ;; Test :parse-leading-options-only. +(ert-deftest esh-opt-test/eval-using-options-parse-leading-options-only () + "Test :parse-leading-options-only in `eshell-eval-using-options'." (eshell-eval-using-options "sudo" '("-u" "root" "whoami") '((?u "user" t user "execute a command as another USER") @@ -212,27 +242,47 @@ '((?u "user" t user "execute a command as another USER") :parse-leading-options-only) (should (eq user nil)) - (should (equal args '("emerge" "-uDN" "world")))) + (should (equal args '("emerge" "-uDN" "world"))))) - ;; Test unrecognized options. +(ert-deftest esh-opt-test/eval-using-options-unrecognized () + "Test `eshell-eval-using-options' with unrecognized options." (should-error (eshell-eval-using-options "ls" '("-u" "/some/path") - '((?a "all" nil show-all - "do not ignore entries starting with .")) - (ignore show-all))) + '((?a "all" nil _show-all + "do not ignore entries starting with .")))) (should-error (eshell-eval-using-options "ls" '("-au" "/some/path") - '((?a "all" nil show-all - "do not ignore entries starting with .")) - (ignore show-all))) + '((?a "all" nil _show-all + "do not ignore entries starting with .")))) (should-error (eshell-eval-using-options "ls" '("--unrecognized" "/some/path") - '((?a "all" nil show-all - "do not ignore entries starting with .")) - (ignore show-all)))) + '((?a "all" nil _show-all + "do not ignore entries starting with ."))))) + +(ert-deftest esh-opt-test/eval-using-options-external () + "Test :external in `eshell-eval-using-options'." + (cl-letf (((symbol-function 'eshell-search-path) #'identity) + ((symbol-function 'eshell-external-command) #'list)) + (should + (equal (catch 'eshell-external + (eshell-eval-using-options + "ls" '("/some/path" "-u") + '((?a "all" nil _show-all + "do not ignore entries starting with .") + :external "ls"))) + '("ls" ("/some/path" "-u")))) + (should + (equal (catch 'eshell-external + (eshell-eval-using-options + "ls" '("/some/path2" "-u") + '((?a "all" nil _show-all + "do not ignore entries starting with .") + :preserve-args + :external "ls"))) + '("ls" ("/some/path2" "-u")))))) (provide 'esh-opt-tests) diff --git a/test/lisp/eshell/esh-proc-tests.el b/test/lisp/eshell/esh-proc-tests.el new file mode 100644 index 00000000000..e7ea6c00d6f --- /dev/null +++ b/test/lisp/eshell/esh-proc-tests.el @@ -0,0 +1,45 @@ +;;; esh-proc-tests.el --- esh-proc 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/>. + +;;; 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)))) + +(ert-deftest esh-proc-test/sigpipe-exits-process () + "Test that a SIGPIPE is properly sent to a process if a pipe closes" + (skip-unless (and (executable-find "sh") + (executable-find "echo") + (executable-find "sleep"))) + (with-temp-eshell + (eshell-command-result-p + ;; The first command is like `yes' but slower. This is to prevent + ;; it from taxing Emacs's process filter too much and causing a + ;; hang. + (concat "sh -c 'while true; do echo y; sleep 1; done' | " + "sh -c 'read NAME; echo ${NAME}'") + "y\n") + (eshell-wait-for-subprocess t) + (should (eq (process-list) nil)))) diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index 77f5313d57a..f944194a2b1 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -30,6 +30,8 @@ (require 'esh-mode) (require 'eshell) +(defvar eshell-history-file-name nil) + (defvar eshell-test--max-subprocess-time 5 "The maximum amount of time to wait for a subprocess to finish, in seconds. See `eshell-wait-for-subprocess'.") @@ -48,15 +50,18 @@ See `eshell-wait-for-subprocess'.") (let (kill-buffer-query-functions) (kill-buffer eshell-buffer)))))) -(defun eshell-wait-for-subprocess () +(defun eshell-wait-for-subprocess (&optional all) "Wait until there is no interactive subprocess running in Eshell. +If ALL is non-nil, wait until there are no Eshell subprocesses at +all running. + If this takes longer than `eshell-test--max-subprocess-time', raise an error." (let ((start (current-time))) - (while (eshell-interactive-process) + (while (if all eshell-process-list (eshell-interactive-process-p)) (when (> (float-time (time-since start)) eshell-test--max-subprocess-time) - (error "timed out waiting for subprocess")) + (error "timed out waiting for subprocess(es)")) (sit-for 0.1)))) (defun eshell-insert-command (text &optional func) diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 542815df809..d6ee1bdb175 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -29,16 +29,10 @@ (require 'ert-x) (require 'esh-mode) (require 'eshell) -(eval-and-compile - (load (expand-file-name "eshell-tests-helpers" - (file-name-directory (or load-file-name - default-directory))))) - -(defvar eshell-history-file-name) -(defvar eshell-test--max-subprocess-time) -(declare-function eshell-insert-command "eshell-tests-helpers") -(declare-function eshell-match-result "eshell-tests-helpers") -(declare-function eshell-command-result-p "eshell-tests-helpers") +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) ;;; Tests: @@ -129,6 +123,31 @@ e.g. \"{(+ 1 2)} 3\" => 3" (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")) + (with-temp-eshell + (eshell-command-result-p "echo hi | *cat" + "hi"))) + +(ert-deftest eshell-test/pipe-tailproc () + "Check that piping a process to a non-process command waits for the process" + (skip-unless (executable-find "echo")) + (with-temp-eshell + (eshell-command-result-p "*echo hi | echo bye" + "bye\nhi\n"))) + +(ert-deftest eshell-test/pipe-headproc-stdin () + "Check that standard input is sent to the head process in a pipeline" + (skip-unless (and (executable-find "tr") + (executable-find "rev"))) + (with-temp-eshell + (eshell-insert-command "tr a-z A-Z | rev") + (eshell-insert-command "hello") + (eshell-send-eof-to-process) + (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)"))) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 57d1ef1682d..42b09201de8 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1411,7 +1411,10 @@ See <https://debbugs.gnu.org/35241>." (equal tmpfile (executable-find (file-name-nondirectory tmpfile))))))) -(ert-deftest files-tests-dont-rewrite-precious-files () +;; Note: we call this test "...-zzdont..." so that it runs near the +;; end, because otherwise the advice it adds to write-region doesn't +;; get removed(??) and breaks the revert-file tests on MS-Windows. +(ert-deftest files-tests-zzdont-rewrite-precious-files () "Test that `file-precious-flag' forces files to be saved by renaming only, rather than modified in-place." (ert-with-temp-file temp-file-name @@ -1457,7 +1460,7 @@ renaming only, rather than modified in-place." (should (equal (file-size-human-readable-iec 0) "0 B")) (should (equal (file-size-human-readable-iec 1) "1 B")) (should (equal (file-size-human-readable-iec 9621) "9.4 KiB")) - (should (equal (file-size-human-readable-iec 72528034765) "67.5 GiB"))) + (should (equal (file-size-human-readable-iec 72528034765) "68 GiB"))) (ert-deftest files-test-magic-mode-alist-re-baseline () "Test magic-mode-alist with RE, expected behavior for match." @@ -1540,13 +1543,10 @@ The door of all subtleties! (ert-with-temp-file temp-file-name (with-temp-buffer (insert files-tests-lao) - ;; Disable lock files, since that barfs in - ;; userlock--check-content-unchanged on MS-Windows. - (let (create-lockfiles) - (write-file temp-file-name) - (erase-buffer) - (insert files-tests-tzu) - (revert-buffer t t t)) + (write-file temp-file-name) + (erase-buffer) + (insert files-tests-tzu) + (revert-buffer t t t) (should (compare-strings files-tests-lao nil nil (buffer-substring (point-min) (point-max)) nil nil))))) @@ -1556,13 +1556,10 @@ The door of all subtleties! (ert-with-temp-file temp-file-name (with-temp-buffer (insert files-tests-lao) - ;; Disable lock files, since that barfs in - ;; userlock--check-content-unchanged on MS-Windows. - (let (create-lockfiles) - (write-file temp-file-name) - (erase-buffer) - (insert files-tests-tzu) - (should (revert-buffer-with-fine-grain t t))) + (write-file temp-file-name) + (erase-buffer) + (insert files-tests-tzu) + (should (revert-buffer-with-fine-grain t t)) (should (compare-strings files-tests-lao nil nil (buffer-substring (point-min) (point-max)) nil nil))))) diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el index 182d82b9618..f308a617645 100644 --- a/test/lisp/gnus/mml-sec-tests.el +++ b/test/lisp/gnus/mml-sec-tests.el @@ -605,6 +605,9 @@ In this test, the encryption key needs to fixed among multiple ones." (ert-deftest mml-secure-en-decrypt-3 () "Encrypt message; then decrypt and test for expected result. In this test, encrypt-to-self variables are set to t." + ;; Random failures with "wrong-type-argument stringp nil". + ;; Seems unlikely to be specific to hydra.nixos.org... + :tags (if (getenv "EMACS_HYDRA_CI") '(:unstable)) (skip-unless (test-conf)) (skip-unless (ignore-errors (epg-find-configuration 'CMS))) ;; sub@example.org with multiple candidate keys, diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 4df8e3c9ef6..e3fed60b4cb 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -25,6 +25,7 @@ (require 'ert) (require 'help-fns) +(require 'subr-x) (autoload 'help-fns-test--macro "foo" nil nil t) diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index d27e3d7cd4d..9c9dddcd19c 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -286,11 +286,11 @@ M-g M-c switch-to-completions " Key Binding -+ -( .. ) short-range 1 .. 4 foo-range a .. c foo-other-range C-e foo-something +( .. ) short-range x foo-original <F1> foo-function-key1 ")))) @@ -304,12 +304,12 @@ x foo-original " Key Binding -+ -( .. ) short-range 1 .. 4 foo-range a .. c foo-other-range C-e foo-something (this binding is currently shadowed) +( .. ) short-range x foo-original (this binding is currently shadowed) <F1> foo-function-key1 diff --git a/test/lisp/international/textsec-tests.el b/test/lisp/international/textsec-tests.el index ee0af66d992..5bf9a3dcfb3 100644 --- a/test/lisp/international/textsec-tests.el +++ b/test/lisp/international/textsec-tests.el @@ -169,8 +169,8 @@ (textsec-email-address-header-suspicious-p "Lars Ingebrigtsen <larsi@\N{RIGHT-TO-LEFT OVERRIDE}gnus.org>")) - (should (textsec-email-address-header-suspicious-p - "דגבא <foo@bar.com>")) + (should-not (textsec-email-address-header-suspicious-p + "דגבא <foo@bar.com>")) (should (textsec-email-address-suspicious-p "Bob_Norbolwits@GCSsafetyACE.com"))) diff --git a/test/lisp/loadhist-resources/loadhist--bar.el b/test/lisp/loadhist-resources/loadhist--bar.el new file mode 100644 index 00000000000..5c8914ed573 --- /dev/null +++ b/test/lisp/loadhist-resources/loadhist--bar.el @@ -0,0 +1,27 @@ +;;; loadhist--bar.el --- Dummy package for loadhist-tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> + +;; 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 +;; (at your option) any later version. + +;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(autoload 'loadhist--foo-inc "loadhist--foo") + +(defun loadhist--bar-dec (x) (1- x)) + +(provide 'loadhist--bar) +;;; loadhist--bar.el ends here diff --git a/test/lisp/loadhist-resources/loadhist--foo.el b/test/lisp/loadhist-resources/loadhist--foo.el new file mode 100644 index 00000000000..3574c220135 --- /dev/null +++ b/test/lisp/loadhist-resources/loadhist--foo.el @@ -0,0 +1,29 @@ +;;; loadhist--foo.el --- Dummy package for loadhist-tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> + +;; 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 +;; (at your option) any later version. + +;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(autoload 'loadhist--bar-dec "loadhist--bar") + +(defun loadhist--foo-inc (x) (1+ x)) + +(provide 'loadhist--foo) +;;; loadhist--foo.el ends here diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el index a941ac06320..ef5fc164d34 100644 --- a/test/lisp/loadhist-tests.el +++ b/test/lisp/loadhist-tests.el @@ -54,4 +54,51 @@ (should-error (unload-feature 'dired)) (unload-feature 'dired-x)) +(defvar loadhist--tests-dir (file-name-directory (macroexp-file-name))) + +(ert-deftest loadhist-tests-unload-feature-nested () + (add-to-list 'load-path (expand-file-name + "loadhist-resources/" + loadhist--tests-dir)) + (declare-function loadhist--foo-inc "loadhist--foo") + (declare-function loadhist--bar-dec "loadhist--dec") + (load "loadhist--foo" nil t) + (should (and (functionp 'loadhist--bar-dec) (functionp 'loadhist--foo-inc))) + (should (autoloadp (symbol-function 'loadhist--bar-dec))) + (load "loadhist--bar" nil t) + (should (and (functionp 'loadhist--bar-dec) (functionp 'loadhist--foo-inc))) + (should (not (autoloadp (symbol-function 'loadhist--bar-dec)))) + (should (not (autoloadp (symbol-function 'loadhist--foo-inc)))) + (should (equal (list 40 42) + (list (loadhist--bar-dec 41) (loadhist--foo-inc 41)))) + (unload-feature 'loadhist--bar) + (should (and (functionp 'loadhist--bar-dec) (functionp 'loadhist--foo-inc))) + (should (autoloadp (symbol-function 'loadhist--bar-dec))) + (should (not (autoloadp (symbol-function 'loadhist--foo-inc)))) + (unload-feature 'loadhist--foo) + (should (null (symbol-function 'loadhist--bar-dec))) + (should (null (symbol-function 'loadhist--foo-inc))) + (should (null (get 'loadhist--bar-dec 'function-history))) + (should (null (get 'loadhist--foo-inc 'function-history)))) + +(ert-deftest loadhist-tests-unload-feature-notnested () + (add-to-list 'load-path (expand-file-name + "loadhist-resources/" + loadhist--tests-dir)) + (load "loadhist--foo" nil t) + (load "loadhist--bar" nil t) + (should (equal (list 40 42) + (list (loadhist--bar-dec 41) (loadhist--foo-inc 41)))) + (unload-feature 'loadhist--foo) + (should (functionp 'loadhist--bar-dec)) + (should (not (autoloadp (symbol-function 'loadhist--bar-dec)))) + (should (let ((f (symbol-function 'loadhist--foo-inc))) + ;; Both choices seem acceptable. + (or (null f) (autoloadp f)))) + (unload-feature 'loadhist--bar) + (should (null (symbol-function 'loadhist--bar-dec))) + (should (null (symbol-function 'loadhist--foo-inc))) + (should (null (get 'loadhist--bar-dec 'function-history))) + (should (null (get 'loadhist--foo-inc 'function-history)))) + ;;; loadhist-tests.el ends here diff --git a/test/lisp/mail/ietf-drums-tests.el b/test/lisp/mail/ietf-drums-tests.el new file mode 100644 index 00000000000..b13937bf736 --- /dev/null +++ b/test/lisp/mail/ietf-drums-tests.el @@ -0,0 +1,178 @@ +;;; ietf-drums-tests.el --- Test suite for ietf-drums.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) + +(ert-deftest ietf-drums-tests () + "Test ietf-drums functionality." + + ;; ietf-drums-remove-comments + (should (equal (ietf-drums-remove-comments "random string") "random string")) + (should (equal (ietf-drums-remove-comments "random \"non comment\" string") + "random \"non comment\" string")) + (should (equal (ietf-drums-remove-comments "random (comment) string") + "random string")) + (should (equal (ietf-drums-remove-comments "random (comment) (string)") + "random ")) + (should (equal (ietf-drums-remove-comments + "random (first) (second (and)) (third) not fourth") + "random not fourth")) + ;; Test some unterminated comments. + (should (equal (ietf-drums-remove-comments "test an (unterminated comment") + "test an ")) + (should (equal (ietf-drums-remove-comments "test an \"unterminated quote") + ;; returns the string unchanged (and doesn't barf). + "test an \"unterminated quote")) + (should (equal (ietf-drums-remove-comments + ;; note that double-quote is not special. + "test (unterminated comments with \"quoted (\" )stuff") + "test ")) + + ;; ietf-drums-remove-whitespace + (should (equal (ietf-drums-remove-whitespace "random string") + "randomstring")) + (should (equal (ietf-drums-remove-whitespace "random (comment) string") + "random(comment)string")) + (should (equal (ietf-drums-remove-whitespace "random \"non comment\" string") + "random\"non comment\"string")) + (should (equal (ietf-drums-remove-whitespace "random (comment)\r\n(string)") + "random(comment)(string)")) + (should (equal (ietf-drums-remove-whitespace + "random (first) (second (and)) (third) not fourth") + "random(first)(second (and))(third)notfourth")) + ;; Test some unterminated comments and quotes. + (should (equal (ietf-drums-remove-whitespace + "random (first) (second (and)) (third unterminated") + "random(first)(second (and))(third unterminated")) + (should (equal (ietf-drums-remove-whitespace "random \"non terminated string") + "random\"non terminated string")) + + ;; ietf-drums-strip + (should (equal (ietf-drums-strip "random string") "randomstring")) + (should (equal (ietf-drums-strip "random \"non comment\" string") + "random\"non comment\"string")) + (should (equal (ietf-drums-strip "random (comment) string") + "randomstring")) + (should (equal (ietf-drums-strip "random (comment) (string)") + "random")) + (should (equal (ietf-drums-strip + "random (first) (second (and)) (third) not fourth") + "randomnotfourth")) + + ;; ietf-drums-strip-cte + (should (equal (ietf-drums-strip-cte "random \"non comment\" string") + ;; [the " " is still in there because it was quoted + ;; through the "strip". -- rgr, 5-Feb-22.] + "randomnon commentstring")) + (should (equal (ietf-drums-strip-cte "ran(d)do<m@>[s;t:r],,in=g") + "randomstring")) + + ;; ietf-drums-quote-string + (should (equal (ietf-drums-quote-string "Bob") "Bob")) + (should (equal (ietf-drums-quote-string "Foo Bar") "\"Foo Bar\"")) + + ;; ietf-drums-get-comment + (should (equal (ietf-drums-get-comment "random string") nil)) + (should (equal (ietf-drums-get-comment "random (comment) string") "comment")) + (should (equal (ietf-drums-get-comment "random \"non comment\" string") nil)) + (should (equal (ietf-drums-get-comment "\"still (non) comment\" string") + nil)) + (should (equal (ietf-drums-get-comment "random (comment)\r\nstring") + "comment")) + (should (equal (ietf-drums-get-comment "random (comment) (string)") "string")) + (should (equal (ietf-drums-get-comment + "random (first) (second (and)) (third) not fourth") + "third")) + + ;; ietf-drums-make-address + (should (equal (ietf-drums-make-address "Bob Rogers" "rogers@rgrjr.com") + "\"Bob Rogers\" <rogers@rgrjr.com>")) + (should (equal (ietf-drums-make-address nil "rogers@rgrjr.com") + "rogers@rgrjr.com")) + + ;; ietf-drums-parse-address + (should (equal (ietf-drums-parse-address "foo@example.com") + '("foo@example.com"))) + (should (equal (ietf-drums-parse-address "<foo@example.com>") + '("foo@example.com"))) + (should (equal (ietf-drums-parse-address "'foo' <foo@example.com>") + '("foo@example.com" . "'foo'"))) + (should (equal (ietf-drums-parse-address "foo <foo@example.com>") + '("foo@example.com" . "foo"))) + (should (equal (ietf-drums-parse-address "foo <foo@example.com> bar") + ;; [contrary to RFC2822, which wants the display-name + ;; before the address. -- rgr, 5-Feb-22.] + '("foo@example.com" . "foo bar"))) + (should (equal (ietf-drums-parse-address " <foo@example.com> foo ") + ;; [ditto. -- rgr, 5-Feb-22.] + '("foo@example.com" . "foo"))) + (should (equal (ietf-drums-parse-address "foo@example.com (foo)") + '("foo@example.com" . "foo"))) + (should (equal (ietf-drums-parse-address "Bar Baz <barbaz@example.com>") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address "barbaz@example.com (Bar Baz)") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address + "Bar Baz (ignored) <barbaz@example.com>") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address "<barbaz@example.com> Bar Baz") + '("barbaz@example.com" . "Bar Baz"))) + (should (equal (ietf-drums-parse-address + "(Bar Baz not ignored) barbaz@example.com") + ;; [not strictly RFC2822, which expects the name + ;; comment after the address. -- rgr, 5-Feb-22.] + '("barbaz@example.com" . "Bar Baz not ignored"))) + (should (equal (ietf-drums-parse-address + "(ignored) <barbaz@example.com> (Bar Baz not ignored)") + '("barbaz@example.com" . "Bar Baz not ignored"))) + (should (equal (ietf-drums-parse-address + "(ignored) barbaz@example.com (Bar Baz not ignored)") + '("barbaz@example.com" . "Bar Baz not ignored"))) + ;; Test for RFC2047 token decoding. + (should (equal (ietf-drums-parse-address + "=?utf-8?B?0JfQtNGA0LDMgdCy0YHRgtCy0YPQudGC0LUh?= <foo@goo.ru>" + t) + '("foo@goo.ru" . "Здра́вствуйте!"))) + + ;; ietf-drums-parse-addresses + ;; Note that it's not worth getting too elaborate here, as the heavy + ;; lifting is all done by ietf-drums-parse-address. + (should (equal (ietf-drums-parse-addresses "foo@example.com") + '(("foo@example.com")))) + (should (equal (ietf-drums-parse-addresses + "foo@example.com, bar@example.com") + '(("foo@example.com") ("bar@example.com")))) + (should (equal (ietf-drums-parse-addresses + "foo@example.com, quux, bar@example.com") + '(("foo@example.com") ("bar@example.com")))) + (should (equal (ietf-drums-parse-addresses + "foo@example.com, Quux Dude <quux@noop.org>, bar@example.com") + '(("foo@example.com") ("quux@noop.org" . "Quux Dude") + ("bar@example.com"))))) + +(provide 'ietf-drums-tests) + +;;; ietf-drums-tests.el ends here diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index f7407032323..a02d97f19a8 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -234,8 +234,13 @@ This string will be returned from the NTLM server to the NTLM client." (declare-function ws-start nil) (declare-function ws-stop-all nil) -(require 'web-server nil t) -(require 'url-http-ntlm nil t) +(eval-and-compile + (push (expand-file-name "../elpa/packages/web-server/" source-directory) + load-path) + (require 'web-server nil t) + (push (expand-file-name "../elpa/packages/url-http-ntlm/" source-directory) + load-path) + (require 'url-http-ntlm nil t)) (defun ntlm-server-do-token (request _process) "Process an NTLM client's REQUEST. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 1651ee4846e..4e74f2aa73f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4398,6 +4398,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) (fnnd (file-name-nondirectory tmp-name)) (default-directory tramp-test-temporary-file-directory) + (buffer (get-buffer-create "*tramp-tests*")) kill-buffer-query-functions) (unwind-protect (progn @@ -4430,31 +4431,47 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp--test-shell-file-name) nil nil nil "-c" "kill -2 $$"))))) - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (should (zerop (process-file "ls" nil t nil fnnd))) - ;; "ls" could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should (string-equal (format "%s\n" fnnd) (buffer-string))) - (should-not (get-buffer-window (current-buffer) t)) + ;; Check DESTINATION. + (dolist (destination `(nil t ,buffer)) + (when (bufferp destination) + (with-current-buffer destination + (delete-region (point-min) (point-max)))) + (with-temp-buffer + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (should (zerop (process-file "ls" nil destination nil fnnd))) + (with-current-buffer + (if (bufferp destination) destination (current-buffer)) + ;; "ls" could produce colorized output. + (goto-char (point-min)) + (while (re-search-forward + tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should + (string-equal (if destination (format "%s\n" fnnd) "") + (buffer-string))) + (should-not (get-buffer-window (current-buffer) t)) + (goto-char (point-max))) + + ;; Second run. The output must be appended. + (should (zerop (process-file "ls" nil destination t fnnd))) + (with-current-buffer + (if (bufferp destination) destination (current-buffer)) + ;; "ls" could produce colorized output. + (goto-char (point-min)) + (while (re-search-forward + tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) + (should + (string-equal + (if destination (format "%s\n%s\n" fnnd fnnd) "") + (buffer-string)))) - ;; Second run. The output must be appended. - (goto-char (point-max)) - (should (zerop (process-file "ls" nil t t fnnd))) - ;; "ls" could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string))) - ;; A non-nil DISPLAY must not raise the buffer. - (should-not (get-buffer-window (current-buffer) t)) - (delete-file tmp-name)) + (unless (eq destination t) + (should (string-empty-p (buffer-string)))) + ;; A non-nil DISPLAY must not raise the buffer. + (should-not (get-buffer-window (current-buffer) t)) + (delete-file tmp-name))) ;; Check remote and local INFILE. (dolist (local '(nil t)) @@ -4464,10 +4481,37 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-exists-p tmp-name)) (should (zerop (process-file "cat" tmp-name t))) (should (string-equal "foo" (buffer-string))) - (should-not (get-buffer-window (current-buffer) t))) - (delete-file tmp-name))) + (should-not (get-buffer-window (current-buffer) t)) + (delete-file tmp-name))) + + ;; Check remote and local DESTNATION file. This isn't + ;; implemented yet ina all file name handler backends. + ;; (dolist (local '(nil t)) + ;; (setq tmp-name (tramp--test-make-temp-name local quoted)) + ;; (should + ;; (zerop (process-file "echo" nil `(:file ,tmp-name) nil "foo"))) + ;; (with-temp-buffer + ;; (insert-file-contents tmp-name) + ;; (should (string-equal "foo" (buffer-string))) + ;; (should-not (get-buffer-window (current-buffer) t)) + ;; (delete-file tmp-name))) + + ;; Check remote and local STDERR. + (dolist (local '(nil t)) + (setq tmp-name (tramp--test-make-temp-name local quoted)) + (should-not + (zerop + (process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist"))) + (with-temp-buffer + (insert-file-contents tmp-name) + (should + (string-match-p + "cat:.* No such file or directory" (buffer-string))) + (should-not (get-buffer-window (current-buffer) t)) + (delete-file tmp-name)))) ;; Cleanup. + (ignore-errors (kill-buffer buffer)) (ignore-errors (delete-file tmp-name)))))) ;; Must be a command, because used as `sigusr1' handler. @@ -6018,6 +6062,78 @@ Use direct async.") (ignore-errors (delete-file tmp-name1)) (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))) +;; The functions were introduced in Emacs 28.1. +(ert-deftest tramp-test39-detect-external-change () + "Check that an external file modification is reported." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-ange-ftp-p))) + ;; Since Emacs 28.1. + (skip-unless (and (fboundp 'lock-file) (fboundp 'file-locked-p))) + + (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) + (dolist (create-lockfiles '(nil t)) + (let ((tmp-name (tramp--test-make-temp-name nil quoted)) + (remote-file-name-inhibit-cache t) + (remote-file-name-inhibit-locks nil) + tramp-allow-unsafe-temporary-files + (inhibit-message t) + ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files. + (tramp-fuse-unmount-on-cleanup t) + auto-save-default + (backup-inhibited t) + noninteractive) + (with-temp-buffer + (unwind-protect + (progn + (setq buffer-file-name tmp-name + buffer-file-truename tmp-name) + (insert "foo") + ;; Bug#53207: with `create-lockfiles' nil, saving the + ;; buffer results in a prompt. + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (_) (ert-fail "Test failed unexpectedly")))) + (save-buffer)) + (should-not (file-locked-p tmp-name)) + + ;; For local files, just changing the file + ;; modification on disk doesn't hurt, because file + ;; contents in buffer and on disk are equal. For + ;; remote files, file contents is not compared. We + ;; mock an older modification time in buffer, because + ;; Tramp regards modification times equal if they + ;; differ for less than 2 seconds. + (set-visited-file-modtime (time-add (current-time) -60)) + ;; Some Tramp methods cannot check the file + ;; modification time properly, for them it doesn't + ;; make sense to test. + (when (not (verify-visited-file-modtime)) + (cl-letf (((symbol-function 'read-char-choice) + (lambda (prompt &rest _) (message "%s" prompt) ?y))) + (ert-with-message-capture captured-messages + (insert "bar") + (when create-lockfiles + (should (string-match-p + (format + "^%s changed on disk; really edit the buffer\\?" + (if (tramp--test-crypt-p) + ".+" (file-name-nondirectory tmp-name))) + captured-messages)) + (should (file-locked-p tmp-name))))) + + ;; `save-buffer' removes the file lock. + (cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always) + ((symbol-function 'read-char-choice) + (lambda (&rest _) ?y))) + (save-buffer)) + (should-not (file-locked-p tmp-name)))) + + ;; Cleanup. + (set-buffer-modified-p nil) + (ignore-errors (delete-file tmp-name)) + (tramp-cleanup-connection + tramp-test-vec 'keep-debug 'keep-password))))))) + +;; The functions were introduced in Emacs 26.1. (ert-deftest tramp-test40-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) @@ -6082,10 +6198,14 @@ This requires restrictions of file name syntax." "Whether asynchronous processes tests are run. This is used in tests which we dont't want to tag `:tramp-asynchronous-processes' completely." - (ert-select-tests - (ert--stats-selector ert--current-run-stats) - (list (make-ert-test :name (ert-test-name (ert-running-test)) - :body nil :tags '(:tramp-asynchronous-processes))))) + (and + (ert-select-tests + (ert--stats-selector ert--current-run-stats) + (list (make-ert-test :name (ert-test-name (ert-running-test)) + :body nil :tags '(:tramp-asynchronous-processes)))) + ;; tramp-adb.el cannot apply multi-byte commands. + (not (and (tramp--test-adb-p) + (string-match-p "[[:multibyte:]]" default-directory))))) (defun tramp--test-crypt-p () "Check, whether the remote directory is crypted." @@ -6134,7 +6254,7 @@ If optional METHOD is given, it is checked first." Several special characters do not work properly there." ;; We must refill the cache. `file-truename' does it. (file-truename tramp-test-temporary-file-directory) - (tramp-check-remote-uname tramp-test-vec "^HP-UX")) + (ignore-errors (tramp-check-remote-uname tramp-test-vec "^HP-UX"))) (defun tramp--test-ksh-p () "Check, whether the remote shell is ksh. @@ -6149,7 +6269,7 @@ a $'' syntax." "Check, whether the remote host runs macOS." ;; We must refill the cache. `file-truename' does it. (file-truename tramp-test-temporary-file-directory) - (tramp-check-remote-uname tramp-test-vec "Darwin")) + (ignore-errors (tramp-check-remote-uname tramp-test-vec "Darwin"))) (defun tramp--test-mock-p () "Check, whether the mock method is used. @@ -6403,6 +6523,31 @@ This requires restrictions of file name syntax." (delete-file file3) (should-not (file-exists-p file3)))) + ;; Check, that a process runs on a remote + ;; `default-directory' with special characters. See + ;; Bug#53846. + (when (and (tramp--test-expensive-test-p) + (tramp--test-supports-processes-p) + ;; Prior Emacs 27, `shell-file-name' was + ;; hard coded as "/bin/sh" for remote + ;; processes in Emacs. That doesn't work + ;; for tramp-adb.el. tramp-sshfs.el times + ;; out for older Emacsen, reason unknown. + (or (and (not (tramp--test-adb-p)) + (not (tramp--test-sshfs-p))) + (tramp--test-emacs27-p))) + (let ((default-directory file1)) + (dolist (this-shell-command + (append + ;; Synchronously. + '(shell-command) + ;; Asynchronously. + (and (tramp--test-asynchronous-processes-p) + '(tramp--test-async-shell-command)))) + (with-temp-buffer + (funcall this-shell-command "cat -- *" (current-buffer)) + (should (string-equal elt (buffer-string))))))) + (delete-file file2) (should-not (file-exists-p file2)) (delete-directory file1) @@ -6472,7 +6617,7 @@ This requires restrictions of file name syntax." (unless (or (tramp--test-ftp-p) (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) - "*foo*bar*baz*") + "*foo+bar*baz+") (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p)) "'foo'bar'baz'" "'foo\"bar'baz\"") @@ -7118,28 +7263,34 @@ Since it unloads Tramp, it shall be the last test to run." (should (featurep 'tramp-archive)) ;; This unloads also tramp-archive.el and tramp-theme.el if needed. (unload-feature 'tramp 'force) - ;; No Tramp feature must be left. + + ;; No Tramp feature must be left except the test packages. (should-not (featurep 'tramp)) (should-not (featurep 'tramp-archive)) (should-not (featurep 'tramp-theme)) (should-not (all-completions "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features)))) + ;; `file-name-handler-alist' must be clean. (should-not (all-completions "tramp" (mapcar #'cdr file-name-handler-alist))) + ;; There shouldn't be left a bound symbol, except buffer-local - ;; variables, and autoload functions. We do not regard our test + ;; variables, and autoloaded functions. We do not regard our test ;; symbols, and the Tramp unload hooks. (mapatoms (lambda (x) (and (or (and (boundp x) (null (local-variable-if-set-p x))) - (and (functionp x) (null (autoloadp (symbol-function x))))) + (and (functionp x) (null (autoloadp (symbol-function x)))) + (macrop x)) (string-match-p "^tramp" (symbol-name x)) ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. (not (eq 'tramp-completion-mode x)) (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x))) (not (string-match-p "unload-hook$" (symbol-name x))) + (not (get x 'tramp-autoload)) (ert-fail (format "`%s' still bound" x))))) + ;; The defstruct `tramp-file-name' and all its internal functions ;; shall be purged. (should-not (cl--find-class 'tramp-file-name)) @@ -7148,6 +7299,7 @@ Since it unloads Tramp, it shall be the last test to run." (and (functionp x) (string-match-p "tramp-file-name" (symbol-name x)) (ert-fail (format "Structure function `%s' still exists" x))))) + ;; There shouldn't be left a hook function containing a Tramp ;; function. We do not regard the Tramp unload hooks. (mapatoms @@ -7157,7 +7309,18 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match-p "unload-hook$" (symbol-name x))) (consp (symbol-value x)) (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x)))))) + (ert-fail (format "Hook `%s' still contains Tramp function" x))))) + + ;; There shouldn't be left an advice function from Tramp. + (mapatoms + (lambda (x) + (and (functionp x) + (advice-mapc + (lambda (fun _symbol) + (and (string-match-p "^tramp" (symbol-name fun)) + (ert-fail + (format "Function `%s' still contains Tramp advice" x)))) + x))))) (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]. diff --git a/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl new file mode 100644 index 00000000000..7138bf631df --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/proto-and-attrs.pl @@ -0,0 +1,50 @@ +# The next two lines are required as of 2022, but obsolescent +# as soon as signatures leave their "experimental" state +use feature 'signatures'; +no warnings 'experimental::signatures'; + +# Tests for subroutine prototypes, signatures and the like + +# Prototypes have syntactical properties different from "normal" Perl: +# Perl has a variable $), so ($)) is not an unbalanced parenthesis. +# On the other hand, in a prototype ($) is _not_ an open paren +# followed by the variable $), so the parens are balanced. Prototypes +# are somewhat frowned upon most of the times, but they are required +# for some Perl magic + +# FIXME: 2022-02-02 CPerl mode does not handle subroutine signatures. +# In simple cases it mistakes them as prototypes, when attributes are +# present, it doesn't handle them at all. Variables in signatures +# SHOULD be fontified like variable declarations. + +# Part 1: Named subroutines +# A prototype and a trivial subroutine attribute +{ + no feature 'signatures'; # that's a prototype, not a signature + sub sub_1 ($) :lvalue { local $); } +} + +# A prototype as an attribute (how it should be written these days) +sub sub_2 :prototype($) { ...; } + +# A signature (these will soon-ish leave the experimental state) +sub sub_3 ($foo,$bar) { ...; } + +# Attribute plus signature FIXME: Not yet supported +sub bad_sub_4 :prototype($$$) ($foo,$bar,$baz) { ...; } + +# Part 2: Same constructs for anonymous subs +# A prototype and a trivial subroutine attribute +{ + no feature 'signatures'; # that's a prototype, not a signature + my $subref_1 = sub ($) :lvalue { local $); }; +} + +# A prototype as an attribute (how it should be written these days) +my $subref_2 = sub :prototype($) { ...; }; + +# A signature (these will soon-ish leave the experimental state) +my $subref_3 = sub ($foo,$bar) { ...; }; + +# Attribute plus signature +my $subref_4 = sub :prototype($$$) ($foo,$bar,$baz) { ...; }; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 0124dad6f17..b8a3bd97d8d 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -154,6 +154,55 @@ point in the distant past, and is still broken in perl-mode. " (should (equal (get-text-property (match-beginning 0) 'face) 'font-lock-keyword-face)))) +(ert-deftest cperl-test-fontify-attrs-and-signatures () + "Test fontification of the various combinations of subroutine +attributes, prototypes and signatures." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((file (ert-resource-file "proto-and-attrs.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + + ;; Named subroutines + (while (search-forward-regexp "\\_<sub_[[:digit:]]+" nil t) + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-function-name-face)) + (let ((start-of-sub (match-beginning 0)) + (end-of-sub (save-excursion (search-forward "}") (point)))) + + ;; Prototypes are shown as strings + (when (search-forward-regexp " ([$%@*]*) " end-of-sub t) + (should (equal (get-text-property (1+ (match-beginning 0)) 'face) + 'font-lock-string-face))) + (goto-char start-of-sub) + (when (search-forward-regexp "\\(:[a-z]+\\)\\((.*?)\\)?" end-of-sub t) + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) + (when (match-beginning 2) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-string-face)))) + (goto-char end-of-sub))) + + ;; Anonymous subroutines + (while (search-forward-regexp "= sub" nil t) + (let ((start-of-sub (match-beginning 0)) + (end-of-sub (save-excursion (search-forward "}") (point)))) + + ;; Prototypes are shown as strings + (when (search-forward-regexp " ([$%@*]*) " end-of-sub t) + (should (equal (get-text-property (1+ (match-beginning 0)) 'face) + 'font-lock-string-face))) + (goto-char start-of-sub) + (when (search-forward-regexp "\\(:[a-z]+\\)\\((.*?)\\)?" end-of-sub t) + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) + (when (match-beginning 2) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-string-face)))) + (goto-char end-of-sub)))))) + (ert-deftest cperl-test-fontify-special-variables () "Test fontification of variables like $^T or ${^ENCODING}. These can occur as \"local\" aliases." diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index ced7b5aaced..71b03b21e5c 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -140,15 +140,10 @@ SEVERITY-PREDICATE is used to setup (flymake-goto-next-error) (should (eq 'flymake-error (face-at-point))))))) -(defun flymake-tests--gcc-is-clang () - "Whether the `gcc' command actually runs the Clang compiler." - (string-match "[Cc]lang version " - (shell-command-to-string "gcc --version"))) - (ert-deftest different-diagnostic-types () "Test GCC warning via function predicate." (skip-unless (and (executable-find "gcc") - (not (flymake-tests--gcc-is-clang)) + (not (ert-gcc-is-clang-p)) (version<= "5" (string-trim (shell-command-to-string "gcc -dumpversion"))) @@ -173,7 +168,7 @@ SEVERITY-PREDICATE is used to setup (ert-deftest included-c-header-files () "Test inclusion of .h header files." (skip-unless (and (executable-find "gcc") - (not (flymake-tests--gcc-is-clang)) + (not (ert-gcc-is-clang-p)) (executable-find "make"))) (let ((flymake-wrap-around nil)) (flymake-tests--with-flymake diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 0eb1c087f4c..1a6a7dc176d 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -2634,58 +2634,59 @@ if x: "Test `python-shell-process-environment' modification." (let* ((python-shell-process-environment '("TESTVAR1=value1" "TESTVAR2=value2")) - (process-environment (python-shell-calculate-process-environment))) - (should (equal (getenv "TESTVAR1") "value1")) - (should (equal (getenv "TESTVAR2") "value2")))) + (env (python-shell--calculate-process-environment))) + (should (equal (getenv-internal "TESTVAR1" env) "value1")) + (should (equal (getenv-internal "TESTVAR2" env) "value2")))) (ert-deftest python-shell-calculate-process-environment-2 () "Test `python-shell-extra-pythonpaths' modification." (let* ((process-environment process-environment) (_original-pythonpath (setenv "PYTHONPATH" "/path0")) (python-shell-extra-pythonpaths '("/path1" "/path2")) - (process-environment (python-shell-calculate-process-environment))) - (should (equal (getenv "PYTHONPATH") + (env (python-shell--calculate-process-environment))) + (should (equal (getenv-internal "PYTHONPATH" env) (concat "/path1" path-separator "/path2" path-separator "/path0"))))) (ert-deftest python-shell-calculate-process-environment-3 () "Test `python-shell-virtualenv-root' modification." (let* ((python-shell-virtualenv-root "/env") - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONHOME" "/home") (setenv "VIRTUAL_ENV") - (python-shell-calculate-process-environment)))) - (should (not (getenv "PYTHONHOME"))) - (should (string= (getenv "VIRTUAL_ENV") "/env")))) + (python-shell--calculate-process-environment)))) + (should (member "PYTHONHOME" env)) + (should (string= (getenv-internal "VIRTUAL_ENV" env) "/env")))) (ert-deftest python-shell-calculate-process-environment-4 () "Test PYTHONUNBUFFERED when `python-shell-unbuffered' is non-nil." (let* ((python-shell-unbuffered t) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED") - (python-shell-calculate-process-environment)))) - (should (string= (getenv "PYTHONUNBUFFERED") "1")))) + (python-shell--calculate-process-environment)))) + (should (string= (getenv-internal "PYTHONUNBUFFERED" env) "1")))) (ert-deftest python-shell-calculate-process-environment-5 () "Test PYTHONUNBUFFERED when `python-shell-unbuffered' is nil." (let* ((python-shell-unbuffered nil) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED") - (python-shell-calculate-process-environment)))) - (should (not (getenv "PYTHONUNBUFFERED"))))) + (python-shell--calculate-process-environment)))) + (should (not (getenv-internal "PYTHONUNBUFFERED" env))))) (ert-deftest python-shell-calculate-process-environment-6 () "Test PYTHONUNBUFFERED=1 when `python-shell-unbuffered' is nil." (let* ((python-shell-unbuffered nil) - (process-environment + (env (let ((process-environment process-environment)) (setenv "PYTHONUNBUFFERED" "1") - (python-shell-calculate-process-environment)))) + (append (python-shell--calculate-process-environment) + process-environment)))) ;; User default settings must remain untouched: - (should (string= (getenv "PYTHONUNBUFFERED") "1")))) + (should (string= (getenv-internal "PYTHONUNBUFFERED" env) "1")))) (ert-deftest python-shell-calculate-process-environment-7 () "Test no side-effects on `process-environment'." @@ -2695,7 +2696,7 @@ if x: (python-shell-unbuffered t) (python-shell-extra-pythonpaths'("/path1" "/path2")) (original-process-environment (copy-sequence process-environment))) - (python-shell-calculate-process-environment) + (python-shell--calculate-process-environment) (should (equal process-environment original-process-environment)))) (ert-deftest python-shell-calculate-process-environment-8 () @@ -2708,7 +2709,7 @@ if x: (python-shell-extra-pythonpaths'("/path1" "/path2")) (original-process-environment (copy-sequence tramp-remote-process-environment))) - (python-shell-calculate-process-environment) + (python-shell--calculate-process-environment) (should (equal tramp-remote-process-environment original-process-environment)))) (ert-deftest python-shell-calculate-exec-path-1 () @@ -2780,23 +2781,43 @@ if x: (should (string= (getenv "VIRTUAL_ENV") "/env"))) (should (equal exec-path original-exec-path)))) +(defun python--tests-process-env-canonical (pe) + ;; `process-environment' can contain various entries for the same + ;; var, and the first in the list hides the others. + (let ((process-environment '())) + (dolist (x (reverse pe)) + (if (string-match "=" x) + (setenv (substring x 0 (match-beginning 0)) + (substring x (match-end 0))) + (setenv x nil))) + process-environment)) + +(defun python--tests-process-env-eql (pe1 pe2) + (equal (python--tests-process-env-canonical pe1) + (python--tests-process-env-canonical pe2))) + (ert-deftest python-shell-with-environment-2 () "Test environment with remote `default-directory'." (let* ((default-directory "/ssh::/example/dir/") (python-shell-remote-exec-path '("/remote1" "/remote2")) (python-shell-exec-path '("/path1" "/path2")) (tramp-remote-process-environment '("EMACS=t")) - (original-process-environment (copy-sequence tramp-remote-process-environment)) + (original-process-environment + (copy-sequence tramp-remote-process-environment)) (python-shell-virtualenv-root "/env")) (python-shell-with-environment (should (equal (python-shell-calculate-exec-path) (list (python-virt-bin) "/path1" "/path2" "/remote1" "/remote2"))) - (let ((process-environment (python-shell-calculate-process-environment))) + (let ((process-environment + (append (python-shell--calculate-process-environment) + tramp-remote-process-environment))) (should (not (getenv "PYTHONHOME"))) (should (string= (getenv "VIRTUAL_ENV") "/env")) - (should (equal tramp-remote-process-environment process-environment)))) - (should (equal tramp-remote-process-environment original-process-environment)))) + (should (python--tests-process-env-eql + tramp-remote-process-environment process-environment)))) + (should (equal tramp-remote-process-environment + original-process-environment)))) (ert-deftest python-shell-with-environment-3 () "Test `python-shell-with-environment' is idempotent." @@ -2805,11 +2826,14 @@ if x: (python-shell-virtualenv-root "/home/user/env") (single-call (python-shell-with-environment - (list exec-path process-environment))) + (list exec-path + (python--tests-process-env-canonical process-environment)))) (nested-call (python-shell-with-environment (python-shell-with-environment - (list exec-path process-environment))))) + (list exec-path + (python--tests-process-env-canonical + process-environment)))))) (should (equal single-call nested-call)))) (ert-deftest python-shell-make-comint-1 () diff --git a/test/lisp/progmodes/sh-script-resources/sh-indents.erts b/test/lisp/progmodes/sh-script-resources/sh-indents.erts new file mode 100644 index 00000000000..1f92610b3aa --- /dev/null +++ b/test/lisp/progmodes/sh-script-resources/sh-indents.erts @@ -0,0 +1,40 @@ +Code: + (lambda () + (shell-script-mode) + (indent-region (point-min) (point-max))) + +Name: sh-indents1 + +=-= +if test;then + something +fi +other +=-=-= + +Name: sh-indents2 + +=-= +if test; then + something +fi +other +=-=-= + +Name: sh-indents3 + +=-= +if test ; then + something +fi +other +=-=-= + +Name: sh-indents4 + +=-= +if test ;then + something +fi +other +=-=-= diff --git a/test/lisp/progmodes/sh-script-tests.el b/test/lisp/progmodes/sh-script-tests.el index ebd26ab4295..5d01cc1c226 100644 --- a/test/lisp/progmodes/sh-script-tests.el +++ b/test/lisp/progmodes/sh-script-tests.el @@ -23,6 +23,7 @@ (require 'sh-script) (require 'ert) +(require 'ert-x) (ert-deftest test-sh-script-indentation () (with-temp-buffer @@ -48,4 +49,24 @@ } ")))) +(ert-deftest test-indentation () + (ert-test-erts-file (ert-resource-file "sh-indents.erts"))) + +(defun test-sh-back (string &optional pos) + (with-temp-buffer + (shell-script-mode) + (insert string) + (sh-smie--default-backward-token) + (= (point) (or pos 1)))) + +(ert-deftest test-backward-token () + (should (test-sh-back "foo")) + (should (test-sh-back "foo.bar")) + (should (test-sh-back "foo\\1bar")) + (should (test-sh-back "foo\\\nbar")) + (should (test-sh-back "foo\\\n\\\n\\\nbar")) + (should (test-sh-back "foo")) + (should-not (test-sh-back "foo;bar")) + (should (test-sh-back "foo#zot"))) + ;;; sh-script-tests.el ends here diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el index a3265e24451..b730de5a690 100644 --- a/test/lisp/textmodes/fill-tests.el +++ b/test/lisp/textmodes/fill-tests.el @@ -45,6 +45,8 @@ (should (string= (buffer-string) "Abc\nd efg\n(h ijk).")))) (ert-deftest fill-test-unbreakable-paragraph () + ;; See bug#45720 and bug#53537. + :expected-result :failed (with-temp-buffer (let ((string "aaa = baaaaaaaaaaaaaaaaaaaaaaaaaaaa\n")) (insert string) @@ -98,6 +100,27 @@ "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eius. Foo"))) +(ert-deftest test-fill-haskell () + (should + (equal + (with-temp-buffer + (asm-mode) + (dolist (line '(" ;; a b c" + " ;; d e f" + " ;; x y z" + " ;; w")) + (insert line "\n")) + (goto-char (point-min)) + (end-of-line) + (setf fill-column 10) + (fill-paragraph nil) + (buffer-string)) + " ;; a b c + ;; d e f + ;; x y z + ;; w +"))) + (provide 'fill-tests) ;;; fill-tests.el ends here diff --git a/test/lisp/yank-media-tests.el b/test/lisp/yank-media-tests.el new file mode 100644 index 00000000000..4487ae150da --- /dev/null +++ b/test/lisp/yank-media-tests.el @@ -0,0 +1,38 @@ +;;; yank-media-tests.el --- Tests for yank-media.el -*- 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: + +;; + +;;; Code: + +(require 'yank-media) +(require 'ert) +(require 'ert-x) + +(ert-deftest test-utf-16 () + (should-not (yank-media--utf-16-p "f")) + (should-not (yank-media--utf-16-p "fo")) + (should-not (yank-media--utf-16-p "\000ofo")) + (should (eq (yank-media--utf-16-p "\000o\000o") 'utf-16-be)) + (should (eq (yank-media--utf-16-p "o\000o\000") 'utf-16-le)) + (should-not (yank-media--utf-16-p "o\000\000o"))) + +;;; yank-media-tests.el ends here diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 31a4b1ac71b..c1e5d0ebed3 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -101,7 +101,7 @@ with parameters from the *Messages* buffer modification." ;; | Overlay test setup ;; +==========================================================================+ -(eval-when-compile +(eval-and-compile (defun buffer-tests--make-test-name (fn x y) (intern (format "buffer-tests--%s-%s-%s" fn x y)))) diff --git a/test/src/comp-resources/comp-test-45603.el b/test/src/comp-resources/comp-test-45603.el index f1c0dafb68d..65147ee0156 100644 --- a/test/src/comp-resources/comp-test-45603.el +++ b/test/src/comp-resources/comp-test-45603.el @@ -7,7 +7,7 @@ (defvar comp-test-45603-directory) (defvar comp-test-45603-marked-candidates) -(defun comp-test-45603--call-marked (action) +(defun comp-test-45603--call-marked (_action) (let* ((prefix-len (length comp-test-45603-mark-prefix)) (marked-candidates (mapcar @@ -17,7 +17,8 @@ (expand-file-name cand comp-test-45603-directory) cand))) comp-test-45603-marked-candidates)) - (multi-action (comp-test-45603--get-multi-action comp-test-45603-last))))) + (_multi-action (comp-test-45603--get-multi-action comp-test-45603-last))) + marked-candidates)) (defalias 'comp-test-45603--file-local-name (if (fboundp 'file-local-name) diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index d740a5f8107..0a60f4d6cc4 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -189,7 +189,7 @@ ;; Bnumberp (numberp x)) -(defun comp-tests-discardn-f (x) +(defun comp-tests-discardn-f (_x) ;; BdiscardN (1+ (let ((a 1) (_b) @@ -297,8 +297,8 @@ ;; potentially use all registers and that is modifying local ;; variables inside condition-case. (let ((str-len (length str)) - (str-width 14) - (ellipsis-width 3) + (_str-width 14) + (_ellipsis-width 3) (idx 0) (column 0) (head-padding "") (tail-padding "") @@ -489,7 +489,7 @@ (cl-defun comp-test-46824-1-f () (let ((next-repos '(1))) (while t - (let ((recipe (car next-repos))) + (let ((_recipe (car next-repos))) (cl-block loop (while t (let ((err @@ -640,7 +640,7 @@ (2 2)) 3)))) -(defun comp-test-silly-frame2 (token) +(defun comp-test-silly-frame2 (_token) ;; Check robustness against dead code. (while c (cl-case c @@ -677,7 +677,7 @@ (progn (if (and noninteractive (not byte-compile-verbose)) (message "Compiling %s..." filename)) - (byte-compile-file filename load)) + (byte-compile-file filename)) (when load (load (if (file-exists-p dest) dest filename))) 'no-byte-compile))) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 89cb3d153d8..212d9e999f2 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1369,7 +1369,14 @@ Return a list of results." (when (eql x 1.0) (error "")) x) - t))) + t) + + ;; 74 + ((defun comp-tests-ret-type-spec-f (x) + (if (eq x 0) + (error "") + (1+ x))) + number))) (defun comp-tests-define-type-spec-test (number x) `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) () diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el index 8dabba90352..ee4f02347ec 100644 --- a/test/src/doc-tests.el +++ b/test/src/doc-tests.el @@ -29,8 +29,8 @@ (ert-deftest doc-tests-documentation/autoloaded-macro () (skip-unless noninteractive) - (should (autoloadp (symbol-function 'rx))) - (should (stringp (documentation 'rx)))) ; See Bug#52969. + (should (autoloadp (symbol-function 'benchmark-run))) + (should (stringp (documentation 'benchmark-run)))) ; See Bug#52969. (ert-deftest doc-tests-documentation/autoloaded-defun () (skip-unless noninteractive) diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 2ff33644a8e..ec83f91f003 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -308,7 +308,8 @@ local reference." "Check that Bug#30163 is fixed." (with-temp-buffer (let ((standard-output (current-buffer)) - (text-quoting-style 'grave)) + (text-quoting-style 'grave) + (fill-column 200)) ; prevent line breaks when filling (describe-function-1 #'mod-test-sum) (goto-char (point-min)) (while (re-search-forward "`[^']*/src/emacs-module-resources/" nil t) diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index 21478a1a0f2..97642669a0d 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -31,26 +31,26 @@ (require 'ert-x) (require 'seq) -(defun filelock-tests--fixture (test-function) - "Call TEST-FUNCTION under a test fixture. +(defmacro filelock-tests--fixture (&rest body) + "Call BODY under a test fixture. Create a test directory and a buffer whose `buffer-file-name' and -`buffer-file-truename' are a file within it, then call -TEST-FUNCTION. Finally, delete the buffer and the test -directory." - (ert-with-temp-directory temp-dir - (let ((name (concat (file-name-as-directory temp-dir) - "userfile")) - (create-lockfiles t)) - (with-temp-buffer - (setq buffer-file-name name - buffer-file-truename name) - (unwind-protect - (save-current-buffer - (funcall test-function)) - ;; Set `buffer-file-truename' nil to prevent unlocking, - ;; which might prompt the user and/or signal errors. - (setq buffer-file-name nil - buffer-file-truename nil)))))) +`buffer-file-truename' are a file within it, then call BODY. +Finally, delete the buffer and the test directory." + (declare (debug (body))) + `(ert-with-temp-directory temp-dir + (let ((name (concat (file-name-as-directory temp-dir) + "userfile")) + (create-lockfiles t)) + (with-temp-buffer + (setq buffer-file-name name + buffer-file-truename name) + (unwind-protect + (save-current-buffer + ,@body) + ;; Set `buffer-file-truename' nil to prevent unlocking, + ;; which might prompt the user and/or signal errors. + (setq buffer-file-name nil + buffer-file-truename nil)))))) (defun filelock-tests--make-lock-name (file-name) "Return the lock file name for FILE-NAME. @@ -86,105 +86,132 @@ the case)." (ert-deftest filelock-tests-lock-unlock-no-errors () "Check that locking and unlocking works without error." (filelock-tests--fixture - (lambda () - (should-not (file-locked-p (buffer-file-name))) + (should-not (file-locked-p (buffer-file-name))) - ;; inserting text should lock the buffer's file. - (insert "this locks the buffer's file") - (filelock-tests--should-be-locked) - (unlock-buffer) - (set-buffer-modified-p nil) - (should-not (file-locked-p (buffer-file-name))) + ;; Inserting text should lock the buffer's file. + (insert "this locks the buffer's file") + (filelock-tests--should-be-locked) + (unlock-buffer) + (set-buffer-modified-p nil) + (should-not (file-locked-p (buffer-file-name))) - ;; `set-buffer-modified-p' should lock the buffer's file. - (set-buffer-modified-p t) - (filelock-tests--should-be-locked) - (unlock-buffer) - (should-not (file-locked-p (buffer-file-name))) + ;; `set-buffer-modified-p' should lock the buffer's file. + (set-buffer-modified-p t) + (filelock-tests--should-be-locked) + (unlock-buffer) + (should-not (file-locked-p (buffer-file-name))) - (should-not (file-locked-p (buffer-file-name)))))) + (should-not (file-locked-p (buffer-file-name))))) (ert-deftest filelock-tests-lock-spoiled () - "Check `lock-buffer' ." + "Check `lock-buffer'." (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support (filelock-tests--fixture - (lambda () - (filelock-tests--spoil-lock-file buffer-file-truename) - ;; FIXME: errors when locking a file are ignored; should they be? - (set-buffer-modified-p t) - (filelock-tests--unspoil-lock-file buffer-file-truename) - (should-not (file-locked-p buffer-file-truename))))) + (filelock-tests--spoil-lock-file buffer-file-truename) + ;; FIXME: errors when locking a file are ignored; should they be? + (set-buffer-modified-p t) + (filelock-tests--unspoil-lock-file buffer-file-truename) + (should-not (file-locked-p buffer-file-truename)))) (ert-deftest filelock-tests-file-locked-p-spoiled () "Check that `file-locked-p' fails if the lockfile is \"spoiled\"." (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support (filelock-tests--fixture - (lambda () - (filelock-tests--spoil-lock-file buffer-file-truename) - (let ((err (should-error (file-locked-p (buffer-file-name))))) - (should (equal (seq-subseq err 0 2) - (if (eq system-type 'windows-nt) - '(permission-denied "Testing file lock") - '(file-error "Testing file lock")))))))) + (filelock-tests--spoil-lock-file buffer-file-truename) + (let ((err (should-error (file-locked-p (buffer-file-name))))) + (should (equal (seq-subseq err 0 2) + (if (eq system-type 'windows-nt) + '(permission-denied "Testing file lock") + '(file-error "Testing file lock"))))))) (ert-deftest filelock-tests-unlock-spoiled () "Check that `unlock-buffer' fails if the lockfile is \"spoiled\"." (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support (filelock-tests--fixture - (lambda () - ;; Set the buffer modified with file locking temporarily - ;; disabled. - (let ((create-lockfiles nil)) - (set-buffer-modified-p t)) - (should-not (file-locked-p buffer-file-truename)) - (filelock-tests--spoil-lock-file buffer-file-truename) - - ;; Errors from `unlock-buffer' should call - ;; `userlock--handle-unlock-error' (bug#46397). - (let (errors) - (cl-letf (((symbol-function 'userlock--handle-unlock-error) - (lambda (err) (push err errors)))) - (unlock-buffer)) - (should (consp errors)) - (should (equal - (if (eq system-type 'windows-nt) - '(permission-denied "Unlocking file") - '(file-error "Unlocking file")) - (seq-subseq (car errors) 0 2))) - (should (equal (length errors) 1)))))) + ;; Set the buffer modified with file locking temporarily disabled. + (let ((create-lockfiles nil)) + (set-buffer-modified-p t)) + (should-not (file-locked-p buffer-file-truename)) + (filelock-tests--spoil-lock-file buffer-file-truename) + + ;; Errors from `unlock-buffer' should call + ;; `userlock--handle-unlock-error' (bug#46397). + (cl-letf (((symbol-function 'userlock--handle-unlock-error) + (lambda (err) (signal (car err) (cdr err))))) + (should (equal + (if (eq system-type 'windows-nt) + '(permission-denied "Unlocking file") + '(file-error "Unlocking file")) + (seq-subseq (should-error (unlock-buffer)) 0 2)))))) (ert-deftest filelock-tests-kill-buffer-spoiled () "Check that `kill-buffer' fails if a lockfile is \"spoiled\"." (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support (filelock-tests--fixture - (lambda () - ;; Set the buffer modified with file locking temporarily - ;; disabled. - (let ((create-lockfiles nil)) - (set-buffer-modified-p t)) - (should-not (file-locked-p buffer-file-truename)) - (filelock-tests--spoil-lock-file buffer-file-truename) - - ;; Kill the current buffer. Because the buffer is modified Emacs - ;; will attempt to unlock it. Temporarily bind `yes-or-no-p' to - ;; a function that fakes a "yes" answer for the "Buffer modified; - ;; kill anyway?" prompt. - ;; - ;; File errors from unlocking files should call - ;; `userlock--handle-unlock-error' (bug#46397). - (let (errors) + ;; Set the buffer modified with file locking temporarily disabled. + (let ((create-lockfiles nil)) + (set-buffer-modified-p t)) + (should-not (file-locked-p buffer-file-truename)) + (filelock-tests--spoil-lock-file buffer-file-truename) + + ;; Kill the current buffer. Because the buffer is modified Emacs + ;; will attempt to unlock it. Temporarily bind `yes-or-no-p' to a + ;; function that fakes a "yes" answer for the "Buffer modified; + ;; kill anyway?" prompt. + ;; + ;; File errors from unlocking files should call + ;; `userlock--handle-unlock-error' (bug#46397). + (cl-letf (((symbol-function 'yes-or-no-p) #'always) + ((symbol-function 'userlock--handle-unlock-error) + (lambda (err) (signal (car err) (cdr err))))) + (should (equal + (if (eq system-type 'windows-nt) + '(permission-denied "Unlocking file") + '(file-error "Unlocking file")) + (seq-subseq (should-error (kill-buffer)) 0 2)))))) + +(ert-deftest filelock-tests-detect-external-change () + "Check that an external file modification is reported." + (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support + (skip-unless (executable-find "touch")) + (skip-unless (executable-find "echo")) + (dolist (cl '(t nil)) + (filelock-tests--fixture + (let ((create-lockfiles cl)) + (write-region "foo" nil (buffer-file-name)) + (revert-buffer nil 'noconfirm) + (should-not (file-locked-p (buffer-file-name))) + + ;; Just changing the file modification on disk doesn't hurt, + ;; because file contents in buffer and on disk look equal. + (shell-command (format "touch %s" (buffer-file-name))) + (insert "bar") + (when cl (filelock-tests--should-be-locked)) + + ;; Bug#53207: with `create-lockfiles' nil, saving the buffer + ;; results in a prompt. (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (&rest _) t)) - ((symbol-function 'userlock--handle-unlock-error) - (lambda (err) (push err errors)))) - (kill-buffer)) - (should (consp errors)) - (should (equal - (if (eq system-type 'windows-nt) - '(permission-denied "Unlocking file") - '(file-error "Unlocking file")) - (seq-subseq (car errors) 0 2))) - (should (equal (length errors) 1)))))) + (lambda (_) (ert-fail "Test failed unexpectedly")))) + (save-buffer)) + (should-not (file-locked-p (buffer-file-name))) + + ;; Changing the file contents on disk hurts when buffer is + ;; modified. There shall be a query, which we answer. + ;; *Messages* buffer is checked for prompt. + (shell-command (format "echo bar >>%s" (buffer-file-name))) + (cl-letf (((symbol-function 'read-char-choice) + (lambda (prompt &rest _) (message "%s" prompt) ?y))) + (ert-with-message-capture captured-messages + ;; `ask-user-about-supersession-threat' does not work in + ;; batch mode, let's simulate interactiveness. + (let (noninteractive) + (insert "baz")) + (should (string-match-p + (format + "^%s changed on disk; really edit the buffer\\?" + (file-name-nondirectory (buffer-file-name))) + captured-messages)))) + (when cl (filelock-tests--should-be-locked)))))) (provide 'filelock-tests) ;;; filelock-tests.el ends here diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index f74e925d3b6..723ef4c710f 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1192,4 +1192,74 @@ (should-error (line-number-at-pos -1)) (should-error (line-number-at-pos 100)))) +(defun fns-tests-concat (&rest args) + ;; Dodge the byte-compiler's partial evaluation of `concat' with + ;; constant arguments. + (apply #'concat args)) + +(ert-deftest fns-concat () + (should (equal (fns-tests-concat) "")) + (should (equal (fns-tests-concat "") "")) + (should (equal (fns-tests-concat nil) "")) + (should (equal (fns-tests-concat []) "")) + (should (equal (fns-tests-concat [97 98]) "ab")) + (should (equal (fns-tests-concat '(97 98)) "ab")) + (should (equal (fns-tests-concat "ab" '(99 100) nil [101 102] "gh") + "abcdefgh")) + (should (equal (fns-tests-concat "Ab" "\200" "cd") "Ab\200cd")) + (should (equal (fns-tests-concat "aB" "\200" "çd") "aB\200çd")) + (should (equal (fns-tests-concat "AB" (string-to-multibyte "\200") "cd") + (string-to-multibyte "AB\200cd"))) + (should (equal (fns-tests-concat "ab" '(#xe5) [255] "cd") "abåÿcd")) + (should (equal (fns-tests-concat '(#x3fffff) [#x3fff80] "xy") "\377\200xy")) + (should (equal (fns-tests-concat '(#x3fffff) [#x3fff80] "xy§") "\377\200xy§")) + (should (equal-including-properties + (fns-tests-concat #("abc" 0 3 (a 1)) #("de" 0 2 (a 1))) + #("abcde" 0 5 (a 1)))) + (should (equal-including-properties + (fns-tests-concat #("abc" 0 3 (a 1)) "§ü" #("çå" 0 2 (b 2))) + #("abc§üçå" 0 3 (a 1) 5 7 (b 2)))) + (should-error (fns-tests-concat "a" '(98 . 99)) + :type 'wrong-type-argument) + (let ((loop (list 66 67))) + (setcdr (cdr loop) loop) + (should-error (fns-tests-concat "A" loop) + :type 'circular-list))) + +(ert-deftest fns-vconcat () + (should (equal (vconcat) [])) + (should (equal (vconcat nil) [])) + (should (equal (vconcat "") [])) + (should (equal (vconcat [1 2 3]) [1 2 3])) + (should (equal (vconcat '(1 2 3)) [1 2 3])) + (should (equal (vconcat "ABC") [65 66 67])) + (should (equal (vconcat "ü§") [252 167])) + (should (equal (vconcat [1 2 3] nil '(4 5) "AB" "å" + "\377" (string-to-multibyte "\377") + (bool-vector t nil nil t nil)) + [1 2 3 4 5 65 66 #xe5 255 #x3fffff t nil nil t nil])) + (should-error (vconcat [1] '(2 . 3)) + :type 'wrong-type-argument) + (let ((loop (list 1 2))) + (setcdr (cdr loop) loop) + (should-error (vconcat [1] loop) + :type 'circular-list))) + +(ert-deftest fns-append () + (should (equal (append) nil)) + (should (equal (append 'tail) 'tail)) + (should (equal (append [1 2 3] nil '(4 5) "AB" "å" + "\377" (string-to-multibyte "\377") + (bool-vector t nil nil t nil) + '(9 10)) + '(1 2 3 4 5 65 66 #xe5 255 #x3fffff t nil nil t nil 9 10))) + (should (equal (append '(1 2) '(3 4) 'tail) + '(1 2 3 4 . tail))) + (should-error (append '(1 . 2) '(3)) + :type 'wrong-type-argument) + (let ((loop (list 1 2))) + (setcdr (cdr loop) loop) + (should-error (append loop '(end)) + :type 'circular-list))) + ;;; fns-tests.el ends here diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index b7ab31120aa..75d67140a90 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -393,4 +393,29 @@ (let ((th (make-thread 'ignore))) (should-not (equal th main-thread)))) +(defvar threads-test--var 'global) + +(ert-deftest threads-test-bug48990 () + (skip-unless (fboundp 'make-thread)) + (let ((buf1 (generate-new-buffer " thread-test")) + (buf2 (generate-new-buffer " thread-test"))) + (with-current-buffer buf1 + (setq-local threads-test--var 'local1)) + (with-current-buffer buf2 + (setq-local threads-test--var 'local2)) + (let ((seen nil)) + (with-current-buffer buf1 + (should (eq threads-test--var 'local1)) + (make-thread (lambda () (setq seen threads-test--var)))) + (with-current-buffer buf2 + (should (eq threads-test--var 'local2)) + (let ((threads-test--var 'let2)) + (should (eq threads-test--var 'let2)) + (while (not seen) + (thread-yield)) + (should (eq threads-test--var 'let2)) + (should (eq seen 'local1))) + (should (eq threads-test--var 'local2))) + (should (eq threads-test--var 'global))))) + ;;; thread-tests.el ends here diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index 0870dc9de4d..6ff64d0431a 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -170,4 +170,13 @@ int main () { (should (equal (get-display-property 2 'height) 2.0)) (should (equal (get-display-property 2 'space-width) 20)))) +(ert-deftest test-messages-buffer-name () + (should + (equal + (let ((messages-buffer-name "test-message")) + (message "foo") + (with-current-buffer messages-buffer-name + (buffer-string))) + "foo\n"))) + ;;; xdisp-tests.el ends here |